1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00

fix a bug loading functions with 8 or more arguments

* libguile/vm-i-loader.c: A combination of superstition and a bugfix:
  make sure that we treat bits as being of a type as wide as we think it
  is, and, more importantly, allow for programs with 8 <= nargs < 16.
This commit is contained in:
Andy Wingo 2008-09-02 00:13:08 -07:00
parent 124c52d8bb
commit 7950b4cffb

View file

@ -144,19 +144,21 @@ VM_DEFINE_LOADER (load_program, "load-program")
int i = SCM_I_INUM (x); int i = SCM_I_INUM (x);
if (-128 <= i && i <= 127) if (-128 <= i && i <= 127)
{ {
scm_t_uint8 c = (scm_t_uint8)i;
/* 8-bit representation */ /* 8-bit representation */
p->nargs = (i >> 6) & 0x03; /* 7-6 bits */ p->nargs = (c >> 6) & 0x03; /* 7-6 bits */
p->nrest = (i >> 5) & 0x01; /* 5 bit */ p->nrest = (c >> 5) & 0x01; /* 5 bit */
p->nlocs = (i >> 2) & 0x07; /* 4-2 bits */ p->nlocs = (c >> 2) & 0x07; /* 4-2 bits */
p->nexts = i & 0x03; /* 1-0 bits */ p->nexts = c & 0x03; /* 1-0 bits */
} }
else else
{ {
scm_t_uint16 s = (scm_t_uint16)i;
/* 16-bit representation */ /* 16-bit representation */
p->nargs = (i >> 12) & 0x07; /* 15-12 bits */ p->nargs = (s >> 12) & 0x0f; /* 15-12 bits */
p->nrest = (i >> 11) & 0x01; /* 11 bit */ p->nrest = (s >> 11) & 0x01; /* 11 bit */
p->nlocs = (i >> 4) & 0x7f; /* 10-04 bits */ p->nlocs = (s >> 4) & 0x7f; /* 10-04 bits */
p->nexts = i & 0x0f; /* 03-00 bits */ p->nexts = s & 0x0f; /* 03-00 bits */
} }
} }
else else