diff --git a/bin/main.c b/bin/main.c index ef6bc45..8479e21 100644 --- a/bin/main.c +++ b/bin/main.c @@ -97,6 +97,7 @@ struct xtn_t const char* udo_path; int vm_running; + int extra_cflags; /*hcl_oop_t sym_errstr;*/ }; @@ -447,11 +448,18 @@ static hcl_oop_t execute_in_batch_mode (hcl_t* hcl, int verbose) static int on_fed_cnode_in_interactive_mode (hcl_t* hcl, hcl_cnode_t* obj) { - if (hcl_compile(hcl, obj, HCL_COMPILE_CLEAR_CODE | HCL_COMPILE_CLEAR_FNBLK) <= -1) return -1; + xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl); + if (hcl_compile(hcl, obj, HCL_COMPILE_CLEAR_CODE | HCL_COMPILE_CLEAR_FNBLK | xtn->extra_cflags) <= -1) return -1; execute_in_interactive_mode (hcl); return 0; } +static int on_fed_cnode_in_batch_mode (hcl_t* hcl, hcl_cnode_t* obj) +{ + xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl); + return hcl_compile(hcl, obj, xtn->extra_cflags); +} + static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose) { FILE* fp = HCL_NULL; @@ -468,7 +476,8 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose) /* override the default cnode handler. the default one simply * compiles the expression node without execution */ - if (hcl_beginfeed(hcl, is_tty? on_fed_cnode_in_interactive_mode: HCL_NULL) <= -1) + /*if (hcl_beginfeed(hcl, is_tty? on_fed_cnode_in_interactive_mode: HCL_NULL) <= -1)*/ + if (hcl_beginfeed(hcl, is_tty? on_fed_cnode_in_interactive_mode: on_fed_cnode_in_batch_mode) <= -1) { hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot begin feed - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); goto oops; @@ -477,37 +486,41 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose) /* [NOTE] it isn't a very nice idea to get this internal data and use it with read_input() */ while (1) { - #if 0 - hcl_bch_t buf[1024]; - hcl_oow_t xlen; - xlen = fread(buf, HCL_SIZEOF(buf[0]), HCL_COUNTOF(buf), fp); - if (xlen > 0 && hcl_feedbchars(hcl, buf, xlen) <= -1) goto feed_error; - if (xlen < HCL_COUNTOF(buf)) + if (is_tty) { - if (ferror(fp)) + hcl_bch_t bch; + int ch = fgetc(fp); + if (ch == EOF) { - hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno)); - goto oops; + if (ferror(fp)) + { + hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno)); + goto oops; + } + break; } - break; - } - #else - hcl_bch_t bch; - int ch = fgetc(fp); - if (ch == EOF) - { - if (ferror(fp)) - { - hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno)); - goto oops; - } - break; - } - bch = ch; - if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error; - #endif + bch = ch; + if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error; + } + else + { + hcl_bch_t buf[1024]; + hcl_oow_t xlen; + + xlen = fread(buf, HCL_SIZEOF(buf[0]), HCL_COUNTOF(buf), fp); + if (xlen > 0 && hcl_feedbchars(hcl, buf, xlen) <= -1) goto feed_error; + if (xlen < HCL_COUNTOF(buf)) + { + if (ferror(fp)) + { + hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno)); + goto oops; + } + break; + } + } } if (hcl_endfeed(hcl) <= -1) @@ -549,7 +562,7 @@ int main (int argc, char* argv[]) }; static hcl_bopt_t opt = { - "l:v", + "l:xv", lopt }; @@ -557,7 +570,7 @@ int main (int argc, char* argv[]) hcl_oow_t heapsize = DEFAULT_HEAPSIZE; int verbose = 0; int show_info = 0; - /*int experimental = 0;*/ + int experimental = 0; #if defined(HCL_BUILD_DEBUG) const char* dbgopt = HCL_NULL; @@ -581,9 +594,9 @@ int main (int argc, char* argv[]) logopt = opt.arg; break; - /*case 'x': + case 'x': experimental = 1; - break;*/ + break; case 'v': verbose = 1; @@ -695,6 +708,7 @@ int main (int argc, char* argv[]) goto oops; } + if (experimental) xtn->extra_cflags |= HCL_COMPILE_ENABLE_BLOCK; xtn->cci_path = argv[opt.ind++]; /* input source code file */ if (opt.ind < argc) xtn->udo_path = argv[opt.ind++]; diff --git a/lib/bigint.c b/lib/bigint.c index 710e5f3..bf46064 100644 --- a/lib/bigint.c +++ b/lib/bigint.c @@ -48,7 +48,7 @@ static char* _digitc_array[] = }; /* exponent table for pow2 between 1 and 32 inclusive. */ -static hcl_uint8_t _exp_tab[32] = +static hcl_uint8_t _exp_tab[32] = { 0, 1, 0, 2, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 4, @@ -56,15 +56,15 @@ static hcl_uint8_t _exp_tab[32] = 0, 0, 0, 0, 0, 0, 0, 5 }; -static const hcl_uint8_t debruijn_32[32] = +static const hcl_uint8_t debruijn_32[32] = { 0, 1, 28, 2, 29, 14, 24, 3, - 30, 22, 20, 15, 25, 17, 4, 8, + 30, 22, 20, 15, 25, 17, 4, 8, 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 }; -static const hcl_uint8_t debruijn_64[64] = +static const hcl_uint8_t debruijn_64[64] = { 0, 1, 2, 53, 3, 7, 54, 27, 4, 38, 41, 8, 34, 55, 48, 28, @@ -83,7 +83,7 @@ static const hcl_uint8_t debruijn_64[64] = #if defined(HCL_HAVE_UINT64_T) # define LOG2_FOR_POW2_64(x) (debruijn_64[(hcl_uint64_t)((hcl_uint64_t)(x) * 0x022fdd63cc95386d) >> 58]) #endif - + #if defined(HCL_HAVE_UINT32_T) && (HCL_SIZEOF_OOW_T == HCL_SIZEOF_UINT32_T) # define LOG2_FOR_POW2(x) LOG2_FOR_POW2_32(x) #elif defined(HCL_HAVE_UINT64_T) && (HCL_SIZEOF_OOW_T == HCL_SIZEOF_UINT64_T) @@ -164,11 +164,11 @@ static HCL_INLINE int shcli_mul_overflow (hcl_t* hcl, hcl_ooi_t a, hcl_ooi_t b, ub = (b >= 0)? b: -b; ua = (a >= 0)? a: -a; - /* though this fomula basically works for unsigned types in principle, + /* though this fomula basically works for unsigned types in principle, * the values used here are all absolute values and they fall in * a safe range to apply this fomula. the safe range is guaranteed because * the sources are supposed to be shclis. */ - return ub != 0 && ua > HCL_TYPE_MAX(hcl_ooi_t) / ub; + return ub != 0 && ua > HCL_TYPE_MAX(hcl_ooi_t) / ub; #endif } #endif @@ -257,7 +257,7 @@ static HCL_INLINE int bigint_to_oow (hcl_t* hcl, hcl_oop_t num, hcl_oow_t* w) static HCL_INLINE int integer_to_oow (hcl_t* hcl, hcl_oop_t x, hcl_oow_t* w) { - /* return value + /* return value * 1 - a positive number including 0 that can fit into hcl_oow_t * -1 - a negative number whose absolute value can fit into hcl_oow_t * 0 - number too large or too small @@ -325,9 +325,9 @@ int hcl_inttoooi (hcl_t* hcl, hcl_oop_t x, hcl_ooi_t* i) } *i = -w; } - else if (n > 0) + else if (n > 0) { - if (w > HCL_TYPE_MAX(hcl_ooi_t)) + if (w > HCL_TYPE_MAX(hcl_ooi_t)) { hcl_seterrnum (hcl, HCL_ERANGE); /* not convertable. number too big */ return 0; @@ -376,7 +376,7 @@ static HCL_INLINE int bigint_to_uintmax (hcl_t* hcl, hcl_oop_t num, hcl_uintmax_ goto done; case 4: - *w = ((hcl_uintmax_t)HCL_OBJ_GET_HALFWORD_VAL(num, 0) << HCL_LIW_BITS * 3) | + *w = ((hcl_uintmax_t)HCL_OBJ_GET_HALFWORD_VAL(num, 0) << HCL_LIW_BITS * 3) | ((hcl_uintmax_t)HCL_OBJ_GET_HALFWORD_VAL(num, 1) << HCL_LIW_BITS * 2) | ((hcl_uintmax_t)HCL_OBJ_GET_HALFWORD_VAL(num, 2) << HCL_LIW_BITS * 1) | HCL_OBJ_GET_HALFWORD_VAL(num, 3); @@ -428,7 +428,7 @@ int hcl_inttointmax (hcl_t* hcl, hcl_oop_t x, hcl_intmax_t* i) int n; n = hcl_inttouintmax(hcl, x, &w); - if (n < 0) + if (n < 0) { HCL_STATIC_ASSERT (HCL_TYPE_MAX(hcl_intmax_t) + HCL_TYPE_MIN(hcl_intmax_t) == -1); /* assume 2's complement */ if (w > (hcl_uintmax_t)HCL_TYPE_MAX(hcl_intmax_t) + 1) @@ -438,9 +438,9 @@ int hcl_inttointmax (hcl_t* hcl, hcl_oop_t x, hcl_intmax_t* i) } *i = -w; } - else if (n > 0) + else if (n > 0) { - if (w > HCL_TYPE_MAX(hcl_intmax_t)) + if (w > HCL_TYPE_MAX(hcl_intmax_t)) { hcl_seterrnum (hcl, HCL_ERANGE); /* not convertable. number too big */ return 0; @@ -518,7 +518,7 @@ static HCL_INLINE hcl_oop_t make_bloated_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t hcl_oow_t w; hcl_oop_t z; - HCL_ASSERT (hcl, extra <= HCL_OBJ_SIZE_MAX - 1); + HCL_ASSERT (hcl, extra <= HCL_OBJ_SIZE_MAX - 1); HCL_STATIC_ASSERT (hcl, HCL_SIZEOF(hcl_oow_t) == HCL_SIZEOF(hcl_liw_t)); if (i >= 0) { @@ -540,7 +540,7 @@ static HCL_INLINE hcl_oop_t make_bloated_bigint_with_ooi (hcl_t* hcl, hcl_ooi_t hcl_oow_t w; hcl_oop_t z; - HCL_ASSERT (hcl, extra <= HCL_OBJ_SIZE_MAX - 2); + HCL_ASSERT (hcl, extra <= HCL_OBJ_SIZE_MAX - 2); if (i >= 0) { w = i; @@ -572,7 +572,7 @@ static HCL_INLINE hcl_oop_t make_bigint_with_intmax (hcl_t* hcl, hcl_intmax_t v) hcl_uintmax_t ui; int brand; - /* this is not a generic function. it can't handle v + /* this is not a generic function. it can't handle v * if it's HCL_TYPE_MIN(hcl_intmax_t) */ HCL_ASSERT (hcl, v > HCL_TYPE_MIN(hcl_intmax_t)); @@ -725,7 +725,7 @@ static HCL_INLINE hcl_oop_t clone_bigint_negated (hcl_t* hcl, hcl_oop_t oop, hcl int brand; HCL_ASSERT (hcl, HCL_IS_BIGINT(hcl,oop)); - + if (HCL_IS_PBIGINT(hcl, oop)) { brand = HCL_BRAND_NBIGINT; @@ -851,7 +851,7 @@ static HCL_INLINE int is_less_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs, static HCL_INLINE int is_less_unsigned (hcl_oop_t x, hcl_oop_t y) { return is_less_unsigned_array ( - ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), + ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), ((hcl_oop_liword_t)y)->slot, HCL_OBJ_GET_SIZE(y)); } @@ -889,7 +889,7 @@ static HCL_INLINE int is_greater_unsigned_array (const hcl_liw_t* x, hcl_oow_t x static HCL_INLINE int is_greater_unsigned (hcl_oop_t x, hcl_oop_t y) { return is_greater_unsigned_array ( - ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), + ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), ((hcl_oop_liword_t)y)->slot, HCL_OBJ_GET_SIZE(y)); } @@ -918,7 +918,7 @@ static HCL_INLINE int is_equal_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs, static HCL_INLINE int is_equal_unsigned (hcl_oop_t x, hcl_oop_t y) { return is_equal_unsigned_array( - ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), + ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), ((hcl_oop_liword_t)y)->slot, HCL_OBJ_GET_SIZE(y)); } @@ -938,7 +938,7 @@ static void complement2_unsigned_array (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_ /* get 2's complement (~x + 1) */ - carry = 1; + carry = 1; for (i = 0; i < xs; i++) { w = (hcl_lidw_t)(~x[i]) + carry; @@ -951,9 +951,9 @@ static void complement2_unsigned_array (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_ * 1 here and it actually requires 1 more slot. Let't take this 8-bit * zero for instance: * 2r00000000 -> 2r11111111 + 1 => 2r0000000100000000 - * + * * this function is not designed to handle such a case. - * in fact, 0 is a small integer and it must not stand a change + * in fact, 0 is a small integer and it must not stand a change * to be given to this function */ HCL_ASSERT (hcl, carry == 0); } @@ -1114,14 +1114,14 @@ static HCL_INLINE hcl_oow_t subtract_unsigned_array (hcl_t* hcl, const hcl_liw_t } else { - z[i] = (borrowed_word + (hcl_lidw_t)x[i]) - w; + z[i] = (borrowed_word + (hcl_lidw_t)x[i]) - w; borrow = 1; } } for (; i < xs; i++) { - if (x[i] >= borrow) + if (x[i] >= borrow) { z[i] = x[i] - (hcl_liw_t)borrow; borrow = 0; @@ -1164,14 +1164,14 @@ static HCL_INLINE void multiply_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs hcl_lidw_t dw; hcl_liw_t carry = 0; hcl_oow_t i; - + for (i = 0; i < xs; i++) { dw = ((hcl_lidw_t)x[i] * y[0]) + carry; carry = (hcl_liw_t)(dw >> HCL_LIW_BITS); z[i] = (hcl_liw_t)dw; } - + z[i] = carry; return; } @@ -1234,7 +1234,7 @@ static HCL_INLINE void multiply_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs } /* KARATSUBA MULTIPLICATION - * + * * c = |a| * |b| * * Let B represent the radix(2^DIGIT_BITS) @@ -1262,7 +1262,7 @@ static HCL_INLINE void multiply_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs * -------------------------------------------------------------------- * (A6FE * 10000) + (((1BC * 178) - (985A + A6FE)) * 100) + 9B5A = * (A6FE << (8 * 2)) + (((1BC * 178) - (985A + A6FE)) << (8 * 1)) = - * A6FE0000 + 14CC800 + 9B5A = 9848635A + * A6FE0000 + 14CC800 + 9B5A = 9848635A * -------------------------------------------------------------------- * * 0xABCD9876 * 0xEFEFABAB => 0xA105C97C9755A8D2 @@ -1290,7 +1290,7 @@ static HCL_INLINE void multiply_unsigned_array (const hcl_liw_t* x, hcl_oow_t xs * X * B^2n => X << (HCL_LIW_BITS * n * 2) * -------------------------------------------------------------------- */ - + #if defined(HCL_BUILD_DEBUG) #define CANNOT_KARATSUBA(hcl,xs,ys) \ ((xs) < (hcl)->option.karatsuba_cutoff || (ys) < (hcl)->option.karatsuba_cutoff || \ @@ -1310,7 +1310,7 @@ static HCL_INLINE hcl_oow_t multiply_unsigned_array_karatsuba (hcl_t* hcl, const hcl_lidw_t ndigits_xh, ndigits_xl; hcl_lidw_t ndigits_yh, ndigits_yl; hcl_liw_t* tmp[2] = { HCL_NULL, HCL_NULL}; - hcl_liw_t* zsp; + hcl_liw_t* zsp; hcl_oow_t tmplen[2]; hcl_oow_t xlen, zcapa; @@ -1335,18 +1335,18 @@ static HCL_INLINE hcl_oow_t multiply_unsigned_array_karatsuba (hcl_t* hcl, const hcl_lidw_t dw; hcl_liw_t carry = 0; hcl_oow_t i; - + for (i = 0; i < xs; i++) { dw = ((hcl_lidw_t)x[i] * y[0]) + carry; carry = (hcl_liw_t)(dw >> HCL_LIW_BITS); z[i] = (hcl_liw_t)dw; } - + z[i] = carry; return count_effective(z, xs + 1); } - + /* calculate value of nshifts, that is 2^(HCL_LIW_BITS*nshifts) */ nshifts = (xs + 1) / 2; @@ -1360,7 +1360,7 @@ static HCL_INLINE hcl_oow_t multiply_unsigned_array_karatsuba (hcl_t* hcl, const /* make a temporary buffer for (b0 + b1) and (a1 * b1) */ tmplen[0] = ndigits_xh + ndigits_yh; - tmplen[1] = ndigits_yl + ndigits_yh + 1; + tmplen[1] = ndigits_yl + ndigits_yh + 1; if (tmplen[1] < tmplen[0]) tmplen[1] = tmplen[0]; tmp[1] = (hcl_liw_t*)hcl_callocmem(hcl, HCL_SIZEOF(hcl_liw_t) * tmplen[1]); /* TODO: should i use the object memory? */ if (!tmp[1]) goto oops; @@ -1386,7 +1386,7 @@ static HCL_INLINE hcl_oow_t multiply_unsigned_array_karatsuba (hcl_t* hcl, const multiply_unsigned_array (tmp[0], tmplen[0], tmp[1], tmplen[1], zsp); xlen = count_effective(zsp, tmplen[0] + tmplen[1]); } - else + else { xlen = multiply_unsigned_array_karatsuba(hcl, tmp[0], tmplen[0], tmp[1], tmplen[1], zsp); if (xlen == 0) goto oops; @@ -1447,7 +1447,7 @@ oops: hcl_lidw_t ndigits_xh, ndigits_xl; hcl_lidw_t ndigits_yh, ndigits_yl; hcl_liw_t* tmp[3] = { HCL_NULL, HCL_NULL, HCL_NULL }; - hcl_liw_t* zsp; + hcl_liw_t* zsp; hcl_oow_t tmplen[3]; hcl_oow_t xlen, zcapa; @@ -1472,14 +1472,14 @@ oops: hcl_lidw_t dw; hcl_liw_t carry = 0; hcl_oow_t i; - + for (i = 0; i < xs; i++) { dw = ((hcl_lidw_t)x[i] * y[0]) + carry; carry = (hcl_liw_t)(dw >> HCL_LIW_BITS); z[i] = (hcl_liw_t)dw; } - + z[i] = carry; return; } @@ -1496,7 +1496,7 @@ oops: HCL_ASSERT (hcl, ndigits_yl >= ndigits_yh); /* make a temporary buffer for (b0 + b1) and (a1 * b1) */ - tmplen[0] = ndigits_yl + ndigits_yh + 1; + tmplen[0] = ndigits_yl + ndigits_yh + 1; tmplen[1] = ndigits_xh + ndigits_yh; if (tmplen[1] < tmplen[0]) tmplen[1] = tmplen[0]; tmp[1] = hcl_callocmem(hcl, HCL_SIZEOF(hcl_liw_t) * tmplen[1]); @@ -1514,7 +1514,7 @@ oops: tmplen[1] = add_unsigned_array(y, ndigits_yl, y + nshifts, ndigits_yh, tmp[1]); /* tmp[2] = (a0 + a1) * (b0 + b1) */ - tmplen[2] = tmplen[0] + tmplen[1]; + tmplen[2] = tmplen[0] + tmplen[1]; tmp[2] = hcl_callocmem (hcl, HCL_SIZEOF(hcl_liw_t) * tmplen[2]); if (!tmp[2]) goto oops; if (CANNOT_KARATSUBA(hcl, tmplen[0], tmplen[1])) @@ -1522,7 +1522,7 @@ oops: multiply_unsigned_array (tmp[0], tmplen[0], tmp[1], tmplen[1], tmp[2]); xlen = count_effective(tmp[2], tmplen[2]); } - else + else { xlen = multiply_unsigned_array_karatsuba(hcl, tmp[0], tmplen[0], tmp[1], tmplen[1], tmp[2]); if (xlen == 0) goto oops; @@ -1659,35 +1659,35 @@ static HCL_INLINE void rshift_unsigned_array (hcl_liw_t* x, hcl_oow_t xs, hcl_oo static void divide_unsigned_array (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs, const hcl_liw_t* y, hcl_oow_t ys, hcl_liw_t* q, hcl_liw_t* r) { -/* TODO: this function needs to be rewritten for performance improvement. +/* TODO: this function needs to be rewritten for performance improvement. * the binary long division is extremely slow for a big number */ /* Perform binary long division. * http://en.wikipedia.org/wiki/Division_algorithm * --------------------------------------------------------------------- * Q := 0 initialize quotient and remainder to zero - * R := 0 + * R := 0 * for i = n-1...0 do where n is number of bits in N - * R := R << 1 left-shift R by 1 bit + * R := R << 1 left-shift R by 1 bit * R(0) := X(i) set the least-significant bit of R equal to bit i of the numerator * if R >= Y then - * R = R - Y + * R = R - Y * Q(i) := 1 * end - * end + * end */ hcl_oow_t rs, rrs, i , j; - + HCL_ASSERT (hcl, xs >= ys); - + /* the caller must ensure: * - q and r are all zeros. can skip memset() with zero. * - q is as large as xs in size. * - r is as large as ys + 1 in size */ /*HCL_MEMSET (q, 0, HCL_SIZEOF(*q) * xs); HCL_MEMSET (r, 0, HCL_SIZEOF(*q) * ys);*/ - + rrs = ys + 1; for (i = xs; i > 0; ) { @@ -1695,13 +1695,13 @@ static void divide_unsigned_array (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs, for (j = HCL_LIW_BITS; j > 0;) { --j; - - /* the value of the remainder 'r' may get bigger than the + + /* the value of the remainder 'r' may get bigger than the * divisor 'y' temporarily until subtraction is performed * below. so ys + 1(kept in rrs) is needed for shifting here. */ - lshift_unsigned_array (r, rrs, 1); + lshift_unsigned_array (r, rrs, 1); HCL_SETBITS (hcl_liw_t, r[0], 0, 1, HCL_GETBITS(hcl_liw_t, x[i], j, 1)); - + rs = count_effective(r, rrs); if (!is_less_unsigned_array(r, rs, y, ys)) { @@ -1717,40 +1717,40 @@ static HCL_INLINE hcl_liw_t calculate_remainder (hcl_t* hcl, hcl_liw_t* qr, hcl_ hcl_lidw_t dw; hcl_liw_t b, c, c2, qyk; hcl_oow_t j, k; - + for (b = 0, c = 0, c2 = 0, j = qr_start, k = 0; k < stop; j++, k++) { dw = (hcl_lidw_t)qr[j] - b; b = (hcl_liw_t)((dw >> HCL_LIW_BITS) & 1); /* b = -(dw mod BASE) */ qr[j] = (hcl_liw_t)dw; - + dw = ((hcl_lidw_t)y[k] * quo) + c; c = (hcl_liw_t)(dw >> HCL_LIW_BITS); qyk = (hcl_liw_t)dw; - + dw = (hcl_lidw_t)qr[j] - qyk; c2 = (hcl_liw_t)((dw >> HCL_LIW_BITS) & 1); qr[j] = (hcl_liw_t)dw; - + dw = (hcl_lidw_t)b + c2 + c; c = (hcl_liw_t)(dw >> HCL_LIW_BITS); b = (hcl_liw_t)dw; - + HCL_ASSERT (hcl, c == 0); } return b; } - + static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs, const hcl_liw_t* y, hcl_oow_t ys, hcl_liw_t* q, hcl_liw_t* r) { hcl_oow_t i; hcl_liw_t d, y1, y2; - + /* the caller must ensure: - * - q can hold 'xs + 1' words and r can hold 'ys' words. + * - q can hold 'xs + 1' words and r can hold 'ys' words. * - q and r are set to all zeros. */ HCL_ASSERT (hcl, xs >= ys); - + if (ys == 1) { /* the divisor has a single word only. perform simple division */ @@ -1766,23 +1766,23 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs r[0] = carry; return; } - + for (i = 0; i < xs; i++) q[i] = x[i]; /* copy x to q */ q[xs] = 0; /* store zero in the last extra word */ for (i = 0; i < ys; i++) r[i] = y[i]; /* copy y to r */ - + y1 = r[ys - 1]; /* highest divisor word */ - + /*d = (y1 == HCL_TYPE_MAX(hcl_liw_t)? ((hcl_liw_t)1): ((hcl_liw_t)(((hcl_lidw_t)1 << HCL_LIW_BITS) / (y1 + 1))));*/ d = (hcl_liw_t)(((hcl_lidw_t)1 << HCL_LIW_BITS) / ((hcl_lidw_t)y1 + 1)); if (d > 1) { hcl_lidw_t dw; hcl_liw_t carry; - + /* shift the divisor such that its high-order bit is on. * shift the dividend the same amount as the previous step */ - + /* r = r * d */ for (carry = 0, i = 0; i < ys; i++) { @@ -1791,7 +1791,7 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs r[i] = (hcl_liw_t)dw; } HCL_ASSERT (hcl, carry == 0); - + /* q = q * d */ for (carry = 0, i = 0; i < xs; i++) { @@ -1801,28 +1801,28 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs } q[xs] = carry; } - + y1 = r[ys - 1]; y2 = r[ys - 2]; - + for (i = xs; i >= ys; --i) { hcl_lidw_t dw, quo, rem; hcl_liw_t b, xhi, xlo; - + /* ---------------------------------------------------------- */ /* estimate the quotient. * 2-current-dividend-words / 2-most-significant-divisor-words */ - + xhi = q[i]; xlo = q[i - 1]; - + /* adjust the quotient if over-estimated */ dw = ((hcl_lidw_t)xhi << HCL_LIW_BITS) + xlo; /* TODO: optimize it with ASM - no seperate / and % */ quo = dw / y1; rem = dw % y1; - + adjust_quotient: if (quo > HCL_TYPE_MAX(hcl_liw_t) || (quo * y2) > ((rem << HCL_LIW_BITS) + q[i - 2])) { @@ -1830,10 +1830,10 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs rem += y1; if (rem <= HCL_TYPE_MAX(hcl_liw_t)) goto adjust_quotient; } - + /* ---------------------------------------------------------- */ b = calculate_remainder(hcl, q, r, quo, i - ys, ys); - + b = (hcl_liw_t)((((hcl_lidw_t)xhi - b) >> HCL_LIW_BITS) & 1); /* is the sign bit set? */ if (b) { @@ -1841,14 +1841,14 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs hcl_lidw_t dw; hcl_liw_t carry; hcl_oow_t j, k; - + for (carry = 0, j = i - ys, k = 0; k < ys; j++, k++) { dw = (hcl_lidw_t)q[j] + r[k] + carry; carry = (hcl_liw_t)(dw >> HCL_LIW_BITS); q[j] = (hcl_liw_t)dw; } - + HCL_ASSERT (hcl, carry == 1); q[i] = quo - 1; } @@ -1857,7 +1857,7 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs q[i] = quo; } } - + if (d > 1) { hcl_lidw_t dw; @@ -1871,28 +1871,28 @@ static void divide_unsigned_array2 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs carry = (hcl_liw_t)(dw % d); } } - - /* split quotient and remainder held in q to q and r respectively + + /* split quotient and remainder held in q to q and r respectively * q [<--- quotient ---->|<-- remainder -->] * index |xs xs-1 ... ys+1 ys|ys-1 ys-2 ... 1 0| */ for (i = 0; i < ys; i++) { r[i] = q[i]; q[i] = 0; } for (; i <= xs; i++) { q[i - ys] = q[i]; q[i] = 0; } - + } - + static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs, const hcl_liw_t* y, hcl_oow_t ys, hcl_liw_t* q, hcl_liw_t* r) { hcl_oow_t s, i, j, g, k; hcl_lidw_t dw, qhat, rhat; hcl_lidi_t di, ci; hcl_liw_t* qq, y1, y2; - + /* the caller must ensure: - * - q can hold 'xs + 1' words and r can hold 'ys' words. + * - q can hold 'xs + 1' words and r can hold 'ys' words. * - q and r are set to all zeros. */ HCL_ASSERT (hcl, xs >= ys); - + if (ys == 1) { /* the divisor has a single word only. perform simple division */ @@ -1908,9 +1908,9 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs r[0] = carry; return; } - + #define SHARED_QQ - + #if defined(SHARED_QQ) /* as long as q is 2 words longer than x, this algorithm can store * both quotient and remainder in q at the same time. */ @@ -1922,18 +1922,18 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs { hcl_liw_t* t; hcl_oow_t reqcapa; - + reqcapa = HCL_ALIGN_POW2(xs + 1, 32); t = (hcl_liw_t*)hcl_reallocmem(hcl, hcl->inttostr.t.ptr, reqcapa * HCL_SIZEOF(*t)); /* TODO: TODO: TODO: ERROR HANDLING if (!t) return -1; */ - + hcl->inttostr.t.capa = xs + 1; hcl->inttostr.t.ptr = t; } qq = hcl->inttostr.t.ptr; #endif - + y1 = y[ys - 1]; /*s = HCL_LIW_BITS - ((y1 == 0)? -1: hcl_get_pos_of_msb_set(y1)) - 1;*/ HCL_ASSERT (hcl, y1 > 0); /* the highest word can't be non-zero in the context where this function is called */ @@ -1944,7 +1944,7 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs r[i] = (y[i] << s) | ((hcl_lidw_t)y[i - 1] >> (HCL_LIW_BITS - s)); } r[0] = y[0] << s; - + qq[xs] = (hcl_lidw_t)x[xs - 1] >> (HCL_LIW_BITS - s); for (i = xs; i > 1; ) { @@ -1952,19 +1952,19 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs qq[i] = (x[i] << s) | ((hcl_lidw_t)x[i - 1] >> (HCL_LIW_BITS - s)); } qq[0] = x[0] << s; - + y1 = r[ys - 1]; y2 = r[ys - 2]; - + for (j = xs; j >= ys; --j) { g = j - ys; /* position where remainder begins in qq */ - + /* estimate */ dw = ((hcl_lidw_t)qq[j] << HCL_LIW_BITS) + qq[j - 1]; qhat = dw / y1; rhat = dw - (qhat * y1); - + adjust_quotient: if (qhat > HCL_TYPE_MAX(hcl_liw_t) || (qhat * y2) > ((rhat << HCL_LIW_BITS) + qq[j - 2])) { @@ -1972,7 +1972,7 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs rhat = rhat + y1; if (rhat <= HCL_TYPE_MAX(hcl_liw_t)) goto adjust_quotient; } - + /* multiply and subtract */ for (ci = 0, i = g, k = 0; k < ys; i++, k++) { @@ -1984,7 +1984,7 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs HCL_ASSERT (hcl, i == j); di = qq[i] - ci; qq[i] = di; - + /* test remainder */ if (di < 0) { @@ -1994,11 +1994,11 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs ci = (hcl_liw_t)(di >> HCL_LIW_BITS); qq[i] = (hcl_liw_t)di; } - + HCL_ASSERT (hcl, i == j); /*HCL_ASSERT (hcl, ci == 1);*/ qq[i] += ci; - + #if defined(SHARED_QQ) /* store the quotient word right after the remainder in q */ q[i + 1] = qhat - 1; @@ -2016,22 +2016,22 @@ static void divide_unsigned_array3 (hcl_t* hcl, const hcl_liw_t* x, hcl_oow_t xs #endif } } - + for (i = 0; i < ys - 1; i++) { r[i] = (qq[i] >> s) | ((hcl_lidw_t)qq[i + 1] << (HCL_LIW_BITS - s)); } r[i] = qq[i] >> s; - + #if defined(SHARED_QQ) for (i = 0; i <= ys; i++) { q[i] = 0; } for (; i <= xs + 1; i++) { q[i - ys - 1] = q[i]; q[i] = 0; } #endif - + } - + /* ======================================================================== */ - + static hcl_oop_t add_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) { hcl_oow_t as, bs, zs; @@ -2075,7 +2075,7 @@ static hcl_oop_t subtract_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; - subtract_unsigned_array (hcl, + subtract_unsigned_array (hcl, ((hcl_oop_liword_t)x)->slot, HCL_OBJ_GET_SIZE(x), ((hcl_oop_liword_t)y)->slot, HCL_OBJ_GET_SIZE(y), ((hcl_oop_liword_t)z)->slot); @@ -2154,7 +2154,7 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, } /* the caller must ensure that x >= y */ - HCL_ASSERT (hcl, !is_less_unsigned(x, y)); + HCL_ASSERT (hcl, !is_less_unsigned(x, y)); hcl_pushvolat (hcl, &x); hcl_pushvolat (hcl, &y); @@ -2168,7 +2168,7 @@ static hcl_oop_t divide_unsigned_integers (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, #else qq = hcl_makebigint(hcl, HCL_BRAND_PBIGINT, HCL_NULL, HCL_OBJ_GET_SIZE(x)); #endif - if (!qq) + if (!qq) { hcl_popvolats (hcl, 2); return HCL_NULL; @@ -2334,7 +2334,7 @@ hcl_oop_t hcl_subints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl,y)) goto oops_einval; v = HCL_OOP_TO_SMOOI(x); - if (v == 0) + if (v == 0) { /* switch the sign to the opposite and return it */ return clone_bigint_negated (hcl, y, HCL_OBJ_GET_SIZE(y)); @@ -2528,20 +2528,20 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop /* In C89, integer division with a negative number is * implementation dependent. In C99, it truncates towards zero. - * + * * http://python-history.blogspot.kr/2010/08/why-pythons-integer-division-floors.html - * The integer division operation (//) and its sibling, + * The integer division operation (//) and its sibling, * the modulo operation (%), go together and satisfy a nice * mathematical relationship (all variables are integers): * a/b = q with remainder r * such that * b*q + r = a and 0 <= r < b (assuming- a and b are >= 0). - * + * * If you want the relationship to extend for negative a * (keeping b positive), you have two choices: if you truncate q * towards zero, r will become negative, so that the invariant * changes to 0 <= abs(r) < abs(b). otherwise, you can floor q - * towards negative infinity, and the invariant remains 0 <= r < b. + * towards negative infinity, and the invariant remains 0 <= r < b. */ q = xv / yv; @@ -2562,7 +2562,7 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop -7 -3 2 -1 */ - /* r must be floored. that is, it rounds away from zero + /* r must be floored. that is, it rounds away from zero * and towards negative infinity */ if (IS_SIGN_DIFF(yv, ri)) { @@ -2584,7 +2584,7 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop 7 -3 -2 1 -7 -3 2 -1 */ - if (xv && IS_SIGN_DIFF(xv, ri)) + if (xv && IS_SIGN_DIFF(xv, ri)) { /* if the dividend has a different sign from r, * change the sign of r to the dividend's sign. @@ -2607,18 +2607,18 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop return HCL_SMOOI_TO_OOP((hcl_ooi_t)q); } - else + else { if (HCL_OOP_IS_SMOOI(x)) { hcl_ooi_t xv; - + if (!hcl_isbigint(hcl,y)) goto oops_einval; - - /* divide a small integer by a big integer. + + /* divide a small integer by a big integer. * the dividend is guaranteed to be greater than the divisor * if both are positive. */ - + xv = HCL_OOP_TO_SMOOI(x); x_neg_sign = (xv < 0); y_neg_sign = HCL_IS_NBIGINT(hcl, y); @@ -2629,7 +2629,7 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop if (rem) *rem = x; return HCL_SMOOI_TO_OOP(0); } - + /* carry on to the full bigint division */ hcl_pushvolat (hcl, &y); x = make_bigint_with_ooi(hcl, xv); @@ -2670,18 +2670,18 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop hcl_liw_t* zw; hcl_oow_t zs, i; hcl_ooi_t yv_abs, ri; - + yv_abs = (yv < 0)? -yv: yv; #if (HCL_LIW_BITS < HCL_OOI_BITS) if (yv_abs > HCL_TYPE_MAX(hcl_liw_t)) break; #endif - + x_neg_sign = (HCL_IS_NBIGINT(hcl, x)); y_neg_sign = (yv < 0); - + z = clone_bigint_to_positive(hcl, x, HCL_OBJ_GET_SIZE(x)); if (!z) return HCL_NULL; - + zw = ((hcl_oop_liword_t)z)->slot; zs = HCL_OBJ_GET_SIZE(z); for (i = zs; i > 0; ) @@ -2693,36 +2693,36 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop carry = (hcl_liw_t)(dw % yv_abs); } /*if (zw[zs - 1] == 0) zs--;*/ - + HCL_ASSERT (hcl, carry <= HCL_SMOOI_MAX); ri = carry; if (x_neg_sign) ri = -ri; - + z = normalize_bigint(hcl, z); if (!z) return HCL_NULL; - + if (x_neg_sign != y_neg_sign) { HCL_OBJ_SET_FLAGS_BRAND (z, HCL_BRAND_NBIGINT); if (ri && modulo) { - z = hcl_subints(hcl, z, HCL_SMOOI_TO_OOP(1)); + z = hcl_subints(hcl, z, HCL_SMOOI_TO_OOP(1)); if (!z) return HCL_NULL; if (rem) { hcl_pushvolat (hcl, &z); r = hcl_addints(hcl, HCL_SMOOI_TO_OOP(ri), HCL_SMOOI_TO_OOP(yv)); - + hcl_popvolat (hcl); if (!r) return HCL_NULL; - + *rem = r; } - + return z; } } - + if (rem) *rem = HCL_SMOOI_TO_OOP(ri); return z; } @@ -2750,9 +2750,9 @@ hcl_oop_t hcl_divints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int modulo, hcl_oop hcl_popvolats (hcl, 2); if (!z) return HCL_NULL; - if (x_neg_sign) + if (x_neg_sign) { - /* the class on r must be set before normalize_bigint() + /* the class on r must be set before normalize_bigint() * because it can get changed to a small integer */ HCL_OBJ_SET_FLAGS_BRAND (r, HCL_BRAND_NBIGINT); } @@ -2854,7 +2854,7 @@ hcl_oop_t hcl_bitatint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (v2 < 0) return HCL_SMOOI_TO_OOP(0); if (v1 >= 0) { - /* the absolute value may be composed of up to + /* the absolute value may be composed of up to * HCL_SMOOI_BITS - 1 bits as there is a sign bit.*/ if (v2 >= HCL_SMOOI_BITS - 1) return HCL_SMOOI_TO_OOP(0); v3 = ((hcl_oow_t)v1 >> v2) & 1; @@ -2873,9 +2873,9 @@ hcl_oop_t hcl_bitatint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (HCL_IS_NBIGINT(hcl, y)) return HCL_SMOOI_TO_OOP(0); /* y is definitely >= HCL_SMOOI_BITS */ - if (HCL_OOP_TO_SMOOI(x) >= 0) + if (HCL_OOP_TO_SMOOI(x) >= 0) return HCL_SMOOI_TO_OOP(0); - else + else return HCL_SMOOI_TO_OOP(1); } else if (HCL_OOP_IS_SMOOI(y)) @@ -3180,20 +3180,20 @@ hcl_oop_t hcl_bitandints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) HCL_ASSERT (hcl, carry == 0); /* handle the longer part in x than y - * + * * For example, * x => + 1010 1100 * y => - 0011 - * - * If y is extended to the same length as x, - * it is a negative 0000 0001. + * + * If y is extended to the same length as x, + * it is a negative 0000 0001. * 2's complement is performed on this imaginary extension. * the result is '1111 1101' (1111 1100 + 1). - * + * * when y is shorter and negative, the lacking part can be * treated as all 1s in the 2's complement format. - * - * the remaining part in x can be just copied to the + * + * the remaining part in x can be just copied to the * final result 'z'. */ for (; i < xs; i++) @@ -3405,7 +3405,7 @@ hcl_oop_t hcl_bitorints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) * extended to the width of x. but those 1s are inverted to * 0s when another 2's complement is performed over the final * result after the jump to 'adjust_to_negative'. - * setting zs to 'xs + 1' and performing the following loop is + * setting zs to 'xs + 1' and performing the following loop is * redundant. for (; i < xs; i++) { @@ -3829,8 +3829,8 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint_and_normalize (hcl_t* hcl, hc HCL_ASSERT (hcl, HCL_IS_NBIGINT(hcl, x)); HCL_ASSERT (hcl, HCL_IS_NBIGINT(hcl, y)); - /* for convenience in subtraction below. - * it could be HCL_TYPE_MAX(hcl_oow_t) + /* for convenience in subtraction below. + * it could be HCL_TYPE_MAX(hcl_oow_t) * if make_bigint_with_intmax() or something * similar were used instead of HCL_SMOOI_TO_OOP().*/ shift = HCL_SMOOI_MAX; @@ -3849,7 +3849,7 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint_and_normalize (hcl_t* hcl, hc sign = integer_to_oow (hcl, y, &shift); if (sign == 0) shift = HCL_SMOOI_MAX; - else + else { if (shift == 0) { @@ -3873,19 +3873,19 @@ static HCL_INLINE hcl_oop_t rshift_negative_bigint_and_normalize (hcl_t* hcl, hc HCL_ASSERT (hcl, v < 0); /* normal right shift of a small negative integer */ - if (shift >= HCL_OOI_BITS - 1) + if (shift >= HCL_OOI_BITS - 1) { /* when y is still a large integer, this condition is met - * met as HCL_SMOOI_MAX > HCL_OOI_BITS. so i can simly + * met as HCL_SMOOI_MAX > HCL_OOI_BITS. so i can simly * terminate the loop after this */ return HCL_SMOOI_TO_OOP(-1); } - else + else { v = (hcl_ooi_t)(((hcl_oow_t)v >> shift) | HCL_HBMASK(hcl_oow_t, shift)); - if (HCL_IN_SMOOI_RANGE(v)) + if (HCL_IN_SMOOI_RANGE(v)) return HCL_SMOOI_TO_OOP(v); - else + else return make_bigint_with_ooi (hcl, v); } } @@ -3914,8 +3914,8 @@ static HCL_INLINE hcl_oop_t rshift_positive_bigint_and_normalize (hcl_t* hcl, hc hcl_popvolat (hcl); if (!z) return HCL_NULL; - /* for convenience in subtraction below. - * it could be HCL_TYPE_MAX(hcl_oow_t) + /* for convenience in subtraction below. + * it could be HCL_TYPE_MAX(hcl_oow_t) * if make_bigint_with_intmax() or something * similar were used instead of HCL_SMOOI_TO_OOP().*/ shift = HCL_SMOOI_MAX; @@ -3923,7 +3923,7 @@ static HCL_INLINE hcl_oop_t rshift_positive_bigint_and_normalize (hcl_t* hcl, hc { rshift_unsigned_array (((hcl_oop_liword_t)z)->slot, zs, shift); if (count_effective (((hcl_oop_liword_t)z)->slot, zs) == 1 && - HCL_OBJ_GET_LIWORD_VAL(z, 0) == 0) + HCL_OBJ_GET_LIWORD_VAL(z, 0) == 0) { /* if z is 0, i don't have to go on */ break; @@ -3937,7 +3937,7 @@ static HCL_INLINE hcl_oop_t rshift_positive_bigint_and_normalize (hcl_t* hcl, hc sign = integer_to_oow (hcl, y, &shift); if (sign == 0) shift = HCL_SMOOI_MAX; - else + else { if (shift == 0) break; HCL_ASSERT (hcl, sign <= -1); @@ -3959,12 +3959,12 @@ static HCL_INLINE hcl_oop_t lshift_bigint_and_normalize (hcl_t* hcl, hcl_oop_t x /* this loop is very inefficient as shifting is repeated * with lshift_unsigned_array(). however, this part of the * code is not likey to be useful because the amount of - * memory available is certainly not enough to support + * memory available is certainly not enough to support * huge shifts greater than HCL_TYPE_MAX(hcl_oow_t) */ shift = HCL_SMOOI_MAX; do { - /* for convenience only in subtraction below. + /* for convenience only in subtraction below. * should it be between HCL_SMOOI_MAX and HCL_TYPE_MAX(hcl_oow_t), * the second parameter to hcl_subints() can't be composed * using HCL_SMOOI_TO_OOP() */ @@ -3992,7 +3992,7 @@ static HCL_INLINE hcl_oop_t lshift_bigint_and_normalize (hcl_t* hcl, hcl_oop_t x if (sign == 0) shift = HCL_SMOOI_MAX; else { - if (shift == 0) + if (shift == 0) { HCL_ASSERT (hcl, is_normalized_integer (hcl, x)); return x; @@ -4021,10 +4021,10 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) v1 = HCL_OOP_TO_SMOOI(x); v2 = HCL_OOP_TO_SMOOI(y); - if (v1 == 0 || v2 == 0) + if (v1 == 0 || v2 == 0) { /* return without cloning as x is a small integer */ - return x; + return x; } if (v2 > 0) @@ -4065,12 +4065,12 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) * 11111111 (-1) 7 * 11111111 (-1) 8 */ - + if (v2 >= HCL_OOI_BITS - 1) v = -1; - else + else { /* HCL_HBMASK_SAFE(hcl_oow_t, v2 + 1) could also be - * used as a mask. but the sign bit is shifted in. + * used as a mask. but the sign bit is shifted in. * so, masking up to 'v2' bits is sufficient */ v = (hcl_ooi_t)(((hcl_oow_t)v1 >> v2) | HCL_HBMASK(hcl_oow_t, v2)); } @@ -4131,7 +4131,7 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) shift = v; goto bigint_and_positive_oow; } - else + else { sign = -1; negy = 1; @@ -4158,7 +4158,7 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) /* right shift */ #if defined(HCL_LIMIT_OBJ_SIZE) /* the maximum number of bit shifts are guaranteed to be - * small enough to fit into the hcl_oow_t type. so i can + * small enough to fit into the hcl_oow_t type. so i can * easily assume that all bits are shifted out */ HCL_ASSERT (hcl, HCL_OBJ_SIZE_BITS_MAX <= HCL_TYPE_MAX(hcl_oow_t)); return (negx)? HCL_SMOOI_TO_OOP(-1): HCL_SMOOI_TO_OOP(0); @@ -4174,8 +4174,8 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) /* left shift */ #if defined(HCL_LIMIT_OBJ_SIZE) /* the maximum number of bit shifts are guaranteed to be - * small enough to fit into the hcl_oow_t type. so i can - * simply return a failure here becuase it's surely too + * small enough to fit into the hcl_oow_t type. so i can + * simply return a failure here becuase it's surely too * large after shifting */ HCL_ASSERT (hcl, HCL_TYPE_MAX(hcl_oow_t) >= HCL_OBJ_SIZE_BITS_MAX); hcl_seterrnum (hcl, HCL_EOOMEM); /* is it a soft failure or a hard failure? is this error code proper? */ @@ -4199,7 +4199,7 @@ hcl_oop_t hcl_bitshiftint (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) lshift_unsigned_array (((hcl_oop_liword_t)z)->slot, HCL_OBJ_GET_SIZE(z), shift); } - else + else { /* right shift */ bigint_and_negative_oow: @@ -4249,7 +4249,7 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra hcl_oow_t hwlen, outlen; hcl_oop_t res; - if (radix < 0) + if (radix < 0) { /* when radix is less than 0, it treats it as if '-' is preceeding */ sign = -1; @@ -4264,16 +4264,16 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra if (ptr < end) { if (*ptr == '+') ptr++; - else if (*ptr == '-') + else if (*ptr == '-') { - ptr++; + ptr++; sign = -1; } } if (ptr >= end) goto oops_einval; /* no digits */ - while (ptr < end && *ptr == '0') + while (ptr < end && *ptr == '0') { /* skip leading zeros */ ptr++; @@ -4299,11 +4299,11 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra exp = _exp_tab[radix - 1]; /* bytes */ - outlen = ((hcl_oow_t)(end - str) * exp + 7) / 8; + outlen = ((hcl_oow_t)(end - str) * exp + 7) / 8; /* number of hcl_liw_t */ outlen = (outlen + HCL_SIZEOF(hw[0]) - 1) / HCL_SIZEOF(hw[0]); - if (outlen > HCL_COUNTOF(hw)) + if (outlen > HCL_COUNTOF(hw)) { hwp = (hcl_liw_t*)hcl_allocmem(hcl, outlen * HCL_SIZEOF(hw[0])); if (!hwp) return HCL_NULL; @@ -4351,7 +4351,7 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra multiplier = (hcl_liw_t)hcl->bigint[radix].multiplier; outlen = (end - str) / safe_ndigits + 1; - if (outlen > HCL_COUNTOF(hw)) + if (outlen > HCL_COUNTOF(hw)) { hwp = (hcl_liw_t*)hcl_allocmem(hcl, outlen * HCL_SIZEOF(hcl_liw_t)); if (!hwp) return HCL_NULL; @@ -4367,7 +4367,7 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra r1 = 0; for (dg = 0; dg < safe_ndigits; dg++) { - if (ptr >= end) + if (ptr >= end) { multiplier = 1; for (i = 0; i < dg; i++) multiplier *= radix; @@ -4411,14 +4411,14 @@ hcl_oop_t hcl_strtoint (hcl_t* hcl, const hcl_ooch_t* str, hcl_oow_t len, int ra HCL_ASSERT (hcl, hwlen >= 1); #if (HCL_LIW_BITS == HCL_OOW_BITS) - if (hwlen == 1) + if (hwlen == 1) { w = hwp[0]; HCL_ASSERT (hcl, -HCL_SMOOI_MAX == HCL_SMOOI_MIN); if (w <= HCL_SMOOI_MAX) return HCL_SMOOI_TO_OOP((hcl_ooi_t)w * sign); } #elif (HCL_LIW_BITS == HCL_OOHW_BITS) - if (hwlen == 1) + if (hwlen == 1) { HCL_ASSERT (hcl, hwp[0] <= HCL_SMOOI_MAX); return HCL_SMOOI_TO_OOP((hcl_ooi_t)hwp[0] * sign); @@ -4485,11 +4485,11 @@ hcl_oop_t hcl_eqints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) { return (HCL_OOP_TO_SMOOI(x) == HCL_OOP_TO_SMOOI(y))? hcl->_true: hcl->_false; } - else if (HCL_OOP_IS_SMOOI(x) || HCL_OOP_IS_SMOOI(y)) + else if (HCL_OOP_IS_SMOOI(x) || HCL_OOP_IS_SMOOI(y)) { return hcl->_false; } - else + else { if (!hcl_isbigint(hcl, x) || !hcl_isbigint(hcl, y)) goto oops_einval; return is_equal(hcl, x, y)? hcl->_true: hcl->_false; @@ -4506,11 +4506,11 @@ hcl_oop_t hcl_neints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) { return (HCL_OOP_TO_SMOOI(x) != HCL_OOP_TO_SMOOI(y))? hcl->_true: hcl->_false; } - else if (HCL_OOP_IS_SMOOI(x) || HCL_OOP_IS_SMOOI(y)) + else if (HCL_OOP_IS_SMOOI(x) || HCL_OOP_IS_SMOOI(y)) { return hcl->_true; } - else + else { if (!hcl_isbigint(hcl, x) || !hcl_isbigint(hcl, y)) goto oops_einval; return !is_equal(hcl, x, y)? hcl->_true: hcl->_false; @@ -4532,12 +4532,12 @@ hcl_oop_t hcl_gtints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl, y)) goto oops_einval; return (HCL_IS_NBIGINT(hcl, y))? hcl->_true: hcl->_false; } - else if (HCL_OOP_IS_SMOOI(y)) + else if (HCL_OOP_IS_SMOOI(y)) { if (!hcl_isbigint(hcl, x)) goto oops_einval; return (HCL_IS_PBIGINT(hcl, x))? hcl->_true: hcl->_false; } - else + else { if (!hcl_isbigint(hcl, x) || !hcl_isbigint(hcl, y)) goto oops_einval; return is_greater(hcl, x, y)? hcl->_true: hcl->_false; @@ -4559,12 +4559,12 @@ hcl_oop_t hcl_geints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl, y)) goto oops_einval; return (HCL_IS_NBIGINT(hcl, y))? hcl->_true: hcl->_false; } - else if (HCL_OOP_IS_SMOOI(y)) + else if (HCL_OOP_IS_SMOOI(y)) { if (!hcl_isbigint(hcl, x)) goto oops_einval; return (HCL_IS_PBIGINT(hcl, x))? hcl->_true: hcl->_false; } - else + else { if (!hcl_isbigint(hcl, x) || !hcl_isbigint(hcl, y)) goto oops_einval; return (is_greater(hcl, x, y) || is_equal(hcl, x, y))? hcl->_true: hcl->_false; @@ -4586,12 +4586,12 @@ hcl_oop_t hcl_ltints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl, y)) goto oops_einval; return (HCL_IS_PBIGINT(hcl, y))? hcl->_true: hcl->_false; } - else if (HCL_OOP_IS_SMOOI(y)) + else if (HCL_OOP_IS_SMOOI(y)) { if (!hcl_isbigint(hcl, x)) goto oops_einval; return (HCL_IS_NBIGINT(hcl, x))? hcl->_true: hcl->_false; } - else + else { if (!hcl_isbigint(hcl, x) || !hcl_isbigint(hcl, y)) goto oops_einval; return is_less(hcl, x, y)? hcl->_true: hcl->_false; @@ -4613,12 +4613,12 @@ hcl_oop_t hcl_leints (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) if (!hcl_isbigint(hcl, y)) goto oops_einval; return (HCL_IS_PBIGINT(hcl, y))? hcl->_true: hcl->_false; } - else if (HCL_OOP_IS_SMOOI(y)) + else if (HCL_OOP_IS_SMOOI(y)) { if (!hcl_isbigint(hcl, x)) goto oops_einval; return (HCL_IS_NBIGINT(hcl, x))? hcl->_true: hcl->_false; } - else + else { if (!hcl_isbigint(hcl, x) || !hcl_isbigint(hcl, y)) goto oops_einval; return (is_less(hcl, x, y) || is_equal(hcl, x, y))? hcl->_true: hcl->_false; @@ -4635,7 +4635,7 @@ hcl_oop_t hcl_sqrtint (hcl_t* hcl, hcl_oop_t x) hcl_oop_t a, b, m, m2, t; int neg; - if (!hcl_isint(hcl, x)) + if (!hcl_isint(hcl, x)) { hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O", x); return HCL_NULL; @@ -4715,7 +4715,7 @@ hcl_oop_t hcl_absint (hcl_t* hcl, hcl_oop_t x) { hcl_ooi_t v; v = HCL_OOP_TO_SMOOI(x); - if (v < 0) + if (v < 0) { v = -v; x = HCL_SMOOI_TO_OOP(v); @@ -4746,9 +4746,9 @@ static HCL_INLINE hcl_liw_t get_last_digit (hcl_t* hcl, hcl_liw_t* x, hcl_oow_t* hcl_liw_t carry = 0; hcl_oow_t i; hcl_lidw_t dw; - + HCL_ASSERT (hcl, oxs > 0); - + for (i = oxs; i > 0; ) { --i; @@ -4769,24 +4769,24 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) hcl_liw_t* t = HCL_NULL; hcl_ooch_t* xbuf = HCL_NULL; hcl_oow_t xlen = 0, reqcapa; - + int radix; const char* _digitc; - + radix = flagged_radix & HCL_INTTOSTR_RADIXMASK; _digitc = _digitc_array[!!(flagged_radix & HCL_INTTOSTR_LOWERCASE)]; HCL_ASSERT (hcl, radix >= 2 && radix <= 36); - + if (!hcl_isint(hcl,num)) goto oops_einval; v = integer_to_oow(hcl, num, &w); - + if (v) { /* The largest buffer is required for radix 2. * For a binary conversion(radix 2), the number of bits is * the maximum number of digits that can be produced. +1 is * needed for the sign. */ - + reqcapa = HCL_OOW_BITS + 1; if (hcl->inttostr.xbuf.capa < reqcapa) { @@ -4799,10 +4799,10 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) { xbuf = hcl->inttostr.xbuf.ptr; } - + xlen = oow_to_text(hcl, w, flagged_radix, xbuf); if (v < 0) xbuf[xlen++] = '-'; - + reverse_string (xbuf, xlen); if (flagged_radix & HCL_INTTOSTR_NONEWOBJ) { @@ -4810,13 +4810,13 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) * the caller can use the data left in hcl->inttostr.xbuf */ hcl->inttostr.xbuf.len = xlen; return hcl->_nil; - } + } return hcl_makestring(hcl, xbuf, xlen, 0); } - + as = HCL_OBJ_GET_SIZE(num); - - reqcapa = as * HCL_LIW_BITS + 1; + + reqcapa = as * HCL_LIW_BITS + 1; if (hcl->inttostr.xbuf.capa < reqcapa) { xbuf = (hcl_ooch_t*)hcl_reallocmem(hcl, hcl->inttostr.xbuf.ptr, reqcapa * HCL_SIZEOF(*xbuf)); @@ -4828,7 +4828,7 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) { xbuf = hcl->inttostr.xbuf.ptr; } - + if (hcl->inttostr.t.capa < as) { t = (hcl_liw_t*)hcl_reallocmem(hcl, hcl->inttostr.t.ptr, reqcapa * HCL_SIZEOF(*t)); @@ -4836,20 +4836,20 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) hcl->inttostr.t.capa = as; hcl->inttostr.t.ptr = t; } - else + else { t = hcl->inttostr.t.ptr; } - + HCL_MEMCPY (t, ((hcl_oop_liword_t)num)->slot, HCL_SIZEOF(*t) * as); - + do { hcl_liw_t dv = get_last_digit(hcl, t, &as, radix); xbuf[xlen++] = _digitc[dv]; } while (as > 0); - + if (HCL_IS_NBIGINT(hcl, num)) xbuf[xlen++] = '-'; reverse_string (xbuf, xlen); if (flagged_radix & HCL_INTTOSTR_NONEWOBJ) @@ -4861,7 +4861,7 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) } return hcl_makestring(hcl, xbuf, xlen, 0); - + oops_einval: hcl_seterrnum (hcl, HCL_EINVAL); return HCL_NULL; diff --git a/lib/cnode.c b/lib/cnode.c index c858bd4..191173e 100644 --- a/lib/cnode.c +++ b/lib/cnode.c @@ -32,7 +32,7 @@ static hcl_cnode_t* make_cnode (hcl_t* hcl, hcl_cnode_type_t type, const hcl_loc hcl_oocs_t empty; hcl_ooch_t dummy; - if (!tok) + if (!tok) { empty.ptr = &dummy; empty.len = 0; @@ -193,9 +193,7 @@ redo: HCL_ASSERT (hcl, tmp1 != HCL_NULL); hcl_freemem (hcl, c); - hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */ - if (tmp2) { c = tmp2; @@ -210,9 +208,7 @@ redo: hcl_cnode_t* tmp; tmp = c->u.shell.obj; - hcl_freemem (hcl, c); - if (tmp) { c = tmp; diff --git a/lib/comp.c b/lib/comp.c index 4e9da49..b0f55e3 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -36,7 +36,7 @@ enum VAR_CLASS_IM, /* class variable in instance method scope */ }; -enum +enum { VAR_ACCESS_PUSH, VAR_ACCESS_POP, @@ -56,11 +56,11 @@ enum /* -------------------------------------------- - -(defun plus(x y) + +(defun plus(x y) (printf "plus %d %d\n" x y) (defun minus(x y) - (printf "minus %d %d\n" x y) + (printf "minus %d %d\n" x y) (- x y) ) (+ x y) @@ -74,7 +74,7 @@ enum <---- minus is now available (minus 10 1) - + literals --> // // characeter 'A' @@ -126,7 +126,7 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, h static int __find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* name, int last, hcl_oow_t* xindex) { /* this function is inefficient. but considering the typical number - * of arguments and temporary variables, the inefficiency can be + * of arguments and temporary variables, the inefficiency can be * ignored in my opinion. the overhead to maintain the reverse lookup * table from a name to an index should be greater than this simple * inefficient lookup */ @@ -148,7 +148,7 @@ static int __find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* if (t >= e || name->ptr[i] != *t) goto unmatched; t++; } - if (t >= e || *t == ' ') + if (t >= e || *t == ' ') { if (last) { @@ -176,7 +176,7 @@ static int __find_word_in_string (const hcl_oocs_t* haystack, const hcl_oocs_t* index++; } - if (found != HCL_TYPE_MAX(hcl_oow_t)) + if (found != HCL_TYPE_MAX(hcl_oow_t)) { if (xindex) *xindex = found; return 0; /* found */ @@ -264,7 +264,7 @@ static int find_variable_backward (hcl_t* hcl, const hcl_cnode_t* token, hcl_var name = HCL_CNODE_GET_TOK(token); - /* depth begins at -1. so it is the actual index. let the looping begin at depth + 1 + /* depth begins at -1. so it is the actual index. let the looping begin at depth + 1 * to avoid an extra exit check without it */ for (i = hcl->c->fnblk.depth + 1; i > 0; ) { @@ -276,7 +276,7 @@ static int find_variable_backward (hcl_t* hcl, const hcl_cnode_t* token, hcl_var if (fbi->clsblk_top >= 0) { - /* this function block has a class defined. + /* this function block has a class defined. * that is, it is in a class defintion. * variable lookup must be limited to the class scope */ hcl_clsblk_info_t* clsbi; @@ -346,7 +346,7 @@ HCL_INFO6 (hcl, "FOUND CLASS VAR [%.*js]...[%.*js]................ ===> ctx_offs #if 0 } - if (i == hcl->c->fnblk.depth) + if (i == hcl->c->fnblk.depth) { /* this condition indicates that the current function level contains a class defintion * and this variable is looked up inside the class defintion */ @@ -356,7 +356,7 @@ HCL_INFO2 (hcl, "CLASS NAMED VAR [%.*js]\n", name->len, name->ptr); vi->index_in_ctx = 0; } #endif - + break; /* stop searching beyond class definition */ } @@ -386,9 +386,9 @@ HCL_INFO2 (hcl, "CLASS NAMED VAR [%.*js]\n", name->len, name->ptr); if (vi->ctx_offset > 0) { /* the current function block accesses temporaries in an outer function block */ - hcl->c->fnblk.info[hcl->c->fnblk.depth].access_outer = 1; + hcl->c->fnblk.info[hcl->c->fnblk.depth].access_outer = 1; /* temporaries in an outer function block is accessed by the current function block */ - hcl->c->fnblk.info[i - 1].accessed_by_inner = 1; + hcl->c->fnblk.info[i - 1].accessed_by_inner = 1; } return 1; @@ -506,7 +506,7 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc, const hcl_loc_t* src return 0; } -/* +/* COMMENTED OUT TEMPORARILY int hcl_emitbyteinstruction (hcl_t* hcl, hcl_oob_t bc) { @@ -621,7 +621,7 @@ write_short: return 0; write_long: - if (param_1 > MAX_CODE_PARAM) + if (param_1 > MAX_CODE_PARAM) { hcl_seterrbfmt (hcl, HCL_ERANGE, "parameter too large to single-parameter instruction %u", (unsigned int)cmd); return -1; @@ -637,7 +637,7 @@ write_long: return 0; write_long2: - if (param_1 > MAX_CODE_PARAM2) + if (param_1 > MAX_CODE_PARAM2) { hcl_seterrbfmt (hcl, HCL_ERANGE, "parameter too large to single-parameter instruction %u", (unsigned int)cmd); return -1; @@ -677,16 +677,16 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1 else { /* convert the code to a long version */ - bc = cmd | 0x80; + bc = cmd | 0x80; goto write_long; } - /* MAKE_FUNCTION is a quad-parameter instruction. + /* MAKE_FUNCTION is a quad-parameter instruction. * The caller must emit two more parameters after the call to this function. * however the instruction format is the same up to the second - * parameters between MAKE_FUNCTION and MAKE_BLOCK. + * parameters between MAKE_FUNCTION and MAKE_LAMBDA. */ - case HCL_CODE_MAKE_BLOCK: + case HCL_CODE_MAKE_LAMBDA: case HCL_CODE_MAKE_FUNCTION: case HCL_CODE_CALL_R: case HCL_CODE_SEND_R: @@ -793,7 +793,7 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum { /* switch to JUMP2 instruction to allow a bigger jump offset. * up to twice MAX_CODE_JUMP only */ - + HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2); HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X || @@ -805,7 +805,7 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum hcl->code.bc.ptr[jip] == HCL_CODE_TRY_ENTER); /* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */ - patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1); + patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1); jump_offset -= MAX_CODE_JUMP; } @@ -894,7 +894,7 @@ static int push_cblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_cblk_type_t type) if (hcl->c->cblk.depth == HCL_TYPE_MAX(hcl_ooi_t)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "control block depth too deep"); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "control block depth too deep"); return -1; } @@ -903,11 +903,11 @@ static int push_cblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_cblk_type_t type) { hcl_cblk_info_t* tmp; hcl_oow_t newcapa; - + newcapa = HCL_ALIGN(new_depth + 1, BLK_INFO_BUFFER_ALIGN); tmp = (hcl_cblk_info_t*)hcl_reallocmem(hcl, hcl->c->cblk.info, newcapa * HCL_SIZEOF(*tmp)); if (HCL_UNLIKELY(!tmp)) return -1; - + hcl->c->cblk.info_capa = newcapa; hcl->c->cblk.info = tmp; } @@ -921,9 +921,9 @@ static int push_cblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_cblk_type_t type) static void pop_cblk (hcl_t* hcl) { HCL_ASSERT (hcl, hcl->c->cblk.depth >= 0); /* depth is of a signed type */ - + /* a control block stays inside a function block. - * the control block stack must not be popped past the starting base + * the control block stack must not be popped past the starting base * of the owning function block */ HCL_ASSERT (hcl, hcl->c->cblk.depth - 1 >= hcl->c->fnblk.info[hcl->c->fnblk.depth].cblk_base); hcl->c->cblk.depth--; @@ -939,7 +939,7 @@ static int push_clsblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_oow_t nivars, h if (hcl->c->clsblk.depth == HCL_TYPE_MAX(hcl_ooi_t)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "class block depth too deep"); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "class block depth too deep"); return -1; } @@ -980,7 +980,7 @@ static int push_clsblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_oow_t nivars, h } /* remember the function block depth before the class block is entered */ - ci->fnblk_base = hcl->c->fnblk.depth; + ci->fnblk_base = hcl->c->fnblk.depth; /* attach the class block to the current function block */ fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; @@ -1002,7 +1002,7 @@ static void pop_clsblk (hcl_t* hcl) fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; HCL_ASSERT (hcl, fbi->clsblk_base >= 0 && fbi->clsblk_top >= 0 && fbi->clsblk_top >= fbi->clsblk_base); HCL_ASSERT (hcl, fbi->clsblk_top == hcl->c->clsblk.depth); - if (fbi->clsblk_top == fbi->clsblk_base) + if (fbi->clsblk_top == fbi->clsblk_base) { /* the first class block inside a function block */ fbi->clsblk_base = -1; @@ -1028,7 +1028,7 @@ static void pop_clsblk (hcl_t* hcl) } -static int push_fnblk (hcl_t* hcl, const hcl_loc_t* errloc, +static int push_fnblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_oow_t tmpr_va, hcl_oow_t tmpr_nargs, hcl_oow_t tmpr_nrvars, hcl_oow_t tmpr_nlvars, hcl_oow_t tmpr_count, hcl_oow_t tmpr_len, hcl_oow_t make_inst_pos, hcl_oow_t lfbase, int fun_type) { @@ -1038,7 +1038,7 @@ static int push_fnblk (hcl_t* hcl, const hcl_loc_t* errloc, HCL_ASSERT (hcl, hcl->c->fnblk.depth >= -1); if (hcl->c->fnblk.depth == HCL_TYPE_MAX(hcl_ooi_t)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "function block depth too deep"); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "function block depth too deep"); return -1; } @@ -1069,7 +1069,7 @@ static int push_fnblk (hcl_t* hcl, const hcl_loc_t* errloc, fbi->tmpr_nlvars = tmpr_nlvars; /* remember the control block depth before the function block is entered */ - fbi->cblk_base = hcl->c->cblk.depth; + fbi->cblk_base = hcl->c->cblk.depth; /* no class block when the funtion block is entered */ fbi->clsblk_base = -1; @@ -1111,7 +1111,7 @@ static void pop_fnblk (hcl_t* hcl) /* keep hcl->code.lit.len without restoration */ hcl->c->fnblk.depth--; - + if (hcl->c->fnblk.depth >= 0) { /* restore the string length and the word count to the values captured @@ -1129,16 +1129,16 @@ static void pop_fnblk (hcl_t* hcl) { hcl_oow_t attr_mask; - /* patch the temporaries mask parameter for the MAKE_BLOCK or MAKE_FUNCTION instruction */ - HCL_ASSERT (hcl, hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_BLOCK || - hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_FUNCTION); + /* patch the temporaries mask parameter for the MAKE_LAMBDA or MAKE_FUNCTION instruction */ + HCL_ASSERT (hcl, hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_LAMBDA || + hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_FUNCTION); - /* the total number of temporaries in this function block must be the sum of + /* the total number of temporaries in this function block must be the sum of * the number of arguments, return variables and local variables */ HCL_ASSERT (hcl, fbi->tmprcnt - hcl->c->tv.wcount == fbi->tmpr_nargs + fbi->tmpr_nrvars + fbi->tmpr_nlvars); /* the temporaries mask is a bit-mask that encodes the counts of different temporary variables. - * and it's split to two intruction parameters when used with MAKE_BLOCK and MAKE_FUNCTION */ + * and it's split to two intruction parameters when used with MAKE_LAMBDA and MAKE_FUNCTION */ attr_mask = ENCODE_BLK_MASK((fbi->fun_type == FUN_CIM), fbi->tmpr_va, fbi->tmpr_nargs, fbi->tmpr_nrvars, fbi->tmpr_nlvars); patch_double_long_params_with_oow (hcl, fbi->make_inst_pos + 1, attr_mask); } @@ -1150,7 +1150,7 @@ static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, h hcl_cframe_t* tmp; HCL_ASSERT (hcl, index >= 0); - + hcl->c->cfs.top++; HCL_ASSERT (hcl, hcl->c->cfs.top >= 0); HCL_ASSERT (hcl, index <= hcl->c->cfs.top); @@ -1161,7 +1161,7 @@ static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, h newcapa = HCL_ALIGN (hcl->c->cfs.top + 256, 256); /* TODO: adjust this capacity */ tmp = (hcl_cframe_t*)hcl_reallocmem (hcl, hcl->c->cfs.ptr, newcapa * HCL_SIZEOF(*tmp)); - if (HCL_UNLIKELY(!tmp)) + if (HCL_UNLIKELY(!tmp)) { hcl->c->cfs.top--; return -1; @@ -1310,7 +1310,7 @@ static int collect_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t** nextobj, HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_PLAIN(var)); #endif - if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(var), tv_dup_check_start) <= -1) + if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(var), tv_dup_check_start) <= -1) { if (hcl->errnum == HCL_EEXIST) { @@ -1323,7 +1323,7 @@ static int collect_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t** nextobj, dcl = HCL_CNODE_CONS_CDR(dcl); if (!dcl) break; - if (!HCL_CNODE_IS_CONS(dcl)) + if (!HCL_CNODE_IS_CONS(dcl)) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(dcl), HCL_CNODE_GET_TOK(dcl), "redundant cdr in %hs variable list", desc); return -1; @@ -1381,7 +1381,7 @@ static int check_if_plain_cnode (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t* prev /* ========================================================================= */ -enum +enum { COP_COMPILE_OBJECT, COP_COMPILE_OBJECT_R, @@ -1402,7 +1402,7 @@ enum COP_COMPILE_ELIF, COP_COMPILE_ELSE, COP_COMPILE_CATCH, - + COP_COMPILE_AND_P1, COP_COMPILE_AND_P2, @@ -1452,7 +1452,7 @@ enum COP_POST_WHILE_COND, COP_POST_TRY, - COP_POST_CATCH, + COP_POST_CATCH, COP_POST_LAMBDA, }; @@ -1496,7 +1496,7 @@ static HCL_INLINE int compile_and_p1 (hcl_t* hcl) hcl_cnode_t* obj, * expr; hcl_cframe_t* cf; hcl_ooi_t jump_inst_pos; - + cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_P1); HCL_ASSERT (hcl, cf->operand != HCL_NULL); @@ -1514,13 +1514,13 @@ static HCL_INLINE int compile_and_p1 (hcl_t* hcl) /* this conditional jump make evaluation short-circuited. the actual jump point is to be patched in compile_and_p2() */ if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; - if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; + if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; expr = HCL_CNODE_CONS_CAR(obj); obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 - compile the current part */ - + PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P2, expr); /* 3 - patch the conditional jump instruction */ cf = GET_SUBCFRAME(hcl); cf->u.post_and.jump_inst_pos = jump_inst_pos; @@ -1542,7 +1542,7 @@ static HCL_INLINE int compile_and_p2 (hcl_t* hcl) HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); jip = cf->u.post_and.jump_inst_pos; - /* patch the jump insruction emitted after each expression inside the 'and' expression + /* patch the jump insruction emitted after each expression inside the 'and' expression * the jump make evaluation short-circuited. */ jump_offset = hcl->code.bc.len - jip - (HCL_CODE_LONG_PARAM_SIZE + 1); patch_long_jump (hcl, jip, jump_offset); @@ -1590,7 +1590,7 @@ static HCL_INLINE int compile_or_p1 (hcl_t* hcl) hcl_cnode_t* obj, * expr; hcl_cframe_t* cf; hcl_ooi_t jump_inst_pos; - + cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_P1); HCL_ASSERT (hcl, cf->operand != HCL_NULL); @@ -1609,7 +1609,7 @@ static HCL_INLINE int compile_or_p1 (hcl_t* hcl) /* this conditional jump makes evaluation short-circuited. the actual jump point is to be patched in compile_or_p2() */ if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_TRUE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; - if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; + if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; expr = HCL_CNODE_CONS_CAR(obj); obj = HCL_CNODE_CONS_CDR(obj); @@ -1796,7 +1796,7 @@ inside_loop: } } - /* this part must no be reached. if a loop control block is found, + /* this part must no be reached. if a loop control block is found, * there must exist a COP_POST_UNTIL_BODY or COP_POST_WHILE_BODY frame */ hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(src), HCL_NULL, "internal error in compiling %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; @@ -1895,7 +1895,7 @@ inside_loop: } } - /* this part must no be reached. if a loop control block is found, + /* this part must no be reached. if a loop control block is found, * there must exist a COP_POST_UNTIL_BODY or COP_POST_WHILE_BODY frame */ hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(src), HCL_NULL, "internal error in compiling %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; @@ -1911,11 +1911,11 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src) hcl_cframe_t* cf; - /* (do + /* (do * (+ 10 20) * (* 2 30) * ... - * ) + * ) * you can use this to combine multiple expressions to a single expression */ @@ -1928,7 +1928,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src) if (!obj) { /* no value */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } else if (!HCL_CNODE_IS_CONS(obj)) @@ -1943,7 +1943,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src) if (nlvars > MAX_CODE_NBLKLVARS) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } @@ -1981,7 +1981,7 @@ static int compile_if (hcl_t* hcl, hcl_cnode_t* src) HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_IF)); - /* (if (< 20 30) + /* (if (< 20 30) * (perform this) * (perform that) * elif (< 20 30) @@ -2016,7 +2016,7 @@ static int compile_if (hcl_t* hcl, hcl_cnode_t* src) cf->u.post_if.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: OPTIMIZATION: * pass information on the conditional if it's an absoluate true or absolute false to - * eliminate some code .. i can't eliminate code because there can be else or elif... + * eliminate some code .. i can't eliminate code because there can be else or elif... * if absoluate true, don't need else or other elif part * if absoluate false, else or other elif part is needed. */ @@ -2063,7 +2063,7 @@ static HCL_INLINE int patch_nearest_post_if_body (hcl_t* hcl, hcl_cnode_t* cmd) /* beginning of the elif/else block code */ /* to drop the result of the conditional when the conditional is false */ - if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; + if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; /* this is the actual beginning */ HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); @@ -2167,9 +2167,9 @@ static HCL_INLINE int compile_else (hcl_t* hcl) (return obj) ) ) - + (defclass B ::: A ; A is a parent class - | p q | + | p q | .... ) @@ -2220,7 +2220,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src) /* if the tricolons symbol is followed by a variable declaration list, * there is no superclass */ dcl = HCL_CNODE_CONS_CAR(obj); - if (HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST)) + if (HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST)) { obj = tmp; /* rewind to the cons cell of the triple colons */ goto no_superclass; @@ -2275,7 +2275,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) ivar_len = cvar_len = 0; nivars = ncvars = 0; - /* use the temporary variable collection buffer for convenience when scanning + /* use the temporary variable collection buffer for convenience when scanning * instance variables and class variables */ while (obj && HCL_CNODE_IS_CONS(obj)) { @@ -2293,7 +2293,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) ) */ tmp = HCL_CNODE_CONS_CAR(obj); - if (HCL_CNODE_IS_TRPCOLONS(tmp)) + if (HCL_CNODE_IS_TRPCOLONS(tmp)) { /* class variables */ hcl_oow_t checkpoint; @@ -2306,7 +2306,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) } tmp = HCL_CNODE_CONS_CAR(obj); - if (!HCL_CNODE_IS_CONS_CONCODED(tmp, HCL_CONCODE_VLIST)) + if (!HCL_CNODE_IS_CONS_CONCODED(tmp, HCL_CONCODE_VLIST)) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_EOX, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "no declaration after triple colons"); return -1; @@ -2334,11 +2334,11 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) if (cvar_len > 0) { - /* place the instance variables before the class variables + /* place the instance variables before the class variables * if class variables "a b" has been collected before instance variables "cc dd ee" * the rotation below manipulates the buffer to contain "cc dd ee a b". - */ - hcl_rotate_oochars (&hcl->c->tv.s.ptr[cvar_start], hcl->c->tv.s.len - cvar_start, -1, cvar_len); + */ + hcl_rotate_oochars (&hcl->c->tv.s.ptr[cvar_start], hcl->c->tv.s.len - cvar_start, -1, cvar_len); cvar_start += hcl->c->tv.s.len - checkpoint; } } @@ -2357,7 +2357,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) /* set starting point past the added space (+1 to index, -1 to length) */ adj = (hcl->c->tv.s.ptr[ivar_start] == ' '); - tmp = hcl_makestring(hcl, &hcl->c->tv.s.ptr[ivar_start + adj], ivar_len - adj, 0); + tmp = hcl_makestring(hcl, &hcl->c->tv.s.ptr[ivar_start + adj], ivar_len - adj, 0); if (HCL_UNLIKELY(!tmp)) goto oops; if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) goto oops; } @@ -2370,7 +2370,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) if (ncvars > HCL_SMOOI_MAX) { /* TOOD: change the error location ?? */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(cf->operand), HCL_NULL, "too many(%zu) class variables", ncvars); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(cf->operand), HCL_NULL, "too many(%zu) class variables", ncvars); goto oops; } @@ -2394,7 +2394,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) if (emit_long_param(hcl, nivars) <= -1) goto oops; if (emit_long_param(hcl, ncvars) <= -1) goto oops; - /* remember the first byte code position to be emitted for the body of + /* remember the first byte code position to be emitted for the body of * this class. this posistion is used for empty class body check at the * end of the class before 'class_exit' is generated */ hcl->c->clsblk.info[hcl->c->clsblk.depth].class_start_inst_pos = hcl->code.bc.len; @@ -2438,7 +2438,7 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl) if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; } - pop_cblk (hcl); + pop_cblk (hcl); pop_clsblk (hcl); /* end of the class block */ if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PEXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; @@ -2460,7 +2460,7 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl) x = find_variable_backward(hcl, class_name, &vi); if (x <= -1) return -1; - + if (x == 0) { SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, class_name); @@ -2469,7 +2469,7 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl) } else { - SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, class_name); + SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, class_name); cf = GET_TOP_CFRAME(hcl); cf->u.set.vi = vi; } @@ -2502,7 +2502,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); - saved_tv_wcount = hcl->c->tv.wcount; + saved_tv_wcount = hcl->c->tv.wcount; cmd = HCL_CNODE_CONS_CAR(src); obj = HCL_CNODE_CONS_CDR(src); @@ -2615,7 +2615,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) return -1; } - if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) + if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) { if (hcl->errnum == HCL_EEXIST) { @@ -2639,7 +2639,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) } else { - if (HCL_CNODE_IS_TRPCOLONS(arg)) + if (HCL_CNODE_IS_TRPCOLONS(arg)) { in_ret_args = 1; } @@ -2660,7 +2660,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) return -1; } - if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) + if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) { if (hcl->errnum == HCL_EEXIST) { @@ -2675,7 +2675,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) dcl = HCL_CNODE_CONS_CDR(dcl); if (!dcl) break; - if (!HCL_CNODE_IS_CONS(dcl)) + if (!HCL_CNODE_IS_CONS(dcl)) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(dcl), HCL_CNODE_GET_TOK(dcl), "redundant cdr in argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; @@ -2690,25 +2690,55 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) * block arguments, evaluation which is done by message passing * limits the number of arguments that can be passed. so the * check is implemented */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) arguments in %.*js", nargs, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) arguments in %.*js", nargs, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } if (nrvars > MAX_CODE_NBLKLVARS) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) return variables in %.*js", nrvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) return variables in %.*js", nrvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } HCL_ASSERT (hcl, nargs + nrvars == hcl->c->tv.wcount - saved_tv_wcount); obj = HCL_CNODE_CONS_CDR(obj); - tv_dup_start = hcl->c->tv.s.len; - if (collect_vardcls(hcl, obj, &obj, tv_dup_start, &nlvars, "local") <= -1) return -1; - - if (nlvars > MAX_CODE_NBLKLVARS) + + if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); - return -1; + hcl_cnode_t* bdy; + + if (!obj || !HCL_CNODE_IS_CONS(obj)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(args), HCL_NULL, "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + return -1; + } + + bdy = HCL_CNODE_CONS_CAR(obj); + if (!bdy || !HCL_CNODE_IS_CONS_CONCODED(bdy, HCL_CONCODE_BLOCK)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(obj), HCL_NULL, "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + return -1; + } + + if (HCL_CNODE_CONS_CDR(bdy)) + { + /* TODO: change error code */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(obj), HCL_NULL, "redundant code prohibited after body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + return -1; + } + + nlvars = 0; /* no known local variables until the actual block is processed */ + } + else + { + tv_dup_start = hcl->c->tv.s.len; + if (collect_vardcls(hcl, obj, &obj, tv_dup_start, &nlvars, "local") <= -1) return -1; + + if (nlvars > MAX_CODE_NBLKLVARS) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + return -1; + } } HCL_ASSERT (hcl, nargs + nrvars + nlvars == hcl->c->tv.wcount - saved_tv_wcount); @@ -2726,13 +2756,13 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) } else { - /* MAKE_BLOCK attr_mask_1 attr_mask_2 - will patch attr_mask in pop_fnblk() */ - if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; + /* MAKE_LAMBDA attr_mask_1 attr_mask_2 - will patch attr_mask in pop_fnblk() */ + if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_LAMBDA, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; } HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */ jump_inst_pos = hcl->code.bc.len; - /* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to + /* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to * produce the long jump instruction (HCL_CODE_JUMP_FORWARD_X) */ if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; @@ -2763,7 +2793,7 @@ static int compile_return (hcl_t* hcl, hcl_cnode_t* src, int ret_from_home) hcl_ooi_t i; HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); - HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) || + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) || HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN_FROM_HOME)); fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; @@ -2907,7 +2937,7 @@ static int compile_set (hcl_t* hcl, hcl_cnode_t* src) x = find_variable_backward(hcl, var, &vi); if (x <= -1) return -1; - + if (x == 0) { PUSH_SUBCFRAME (hcl, COP_EMIT_SET, var); /* set doesn't evaluate the variable name */ @@ -2917,7 +2947,7 @@ static int compile_set (hcl_t* hcl, hcl_cnode_t* src) else { /* the check in compile_lambda() must ensure this condition */ - PUSH_SUBCFRAME (hcl, COP_EMIT_SET, cmd); + PUSH_SUBCFRAME (hcl, COP_EMIT_SET, cmd); cf = GET_SUBCFRAME(hcl); cf->u.set.vi = vi; } @@ -3001,12 +3031,12 @@ static int compile_set_r (hcl_t* hcl, hcl_cnode_t* src) for (i = 0, obj = var_start; i < nvars; i++, obj = HCL_CNODE_CONS_CDR(obj)) { int x; - + var = HCL_CNODE_CONS_CAR(obj); x = find_variable_backward(hcl, var, &vi); if (x <= -1) return -1; - + if (x == 0) { PUSH_SUBCFRAME (hcl, COP_EMIT_SET, var); /* set_r doesn't evaluate the variable name */ @@ -3015,23 +3045,23 @@ static int compile_set_r (hcl_t* hcl, hcl_cnode_t* src) } else { - PUSH_SUBCFRAME (hcl, COP_EMIT_SET, cmd); + PUSH_SUBCFRAME (hcl, COP_EMIT_SET, cmd); cf = GET_SUBCFRAME(hcl); cf->u.set.vi = vi; } - /* - * (defun f(x y ::: aa bb cc) ....) + /* + * (defun f(x y ::: aa bb cc) ....) * (set_r a b c (f 1 2)) * - * the call to f + * the call to f * call 2 3 ; 2 arguments, 3 return variables (CALL_R) * ; 3 to be emitted from cf->u.obj_r.nrets * ; this gets remembered in req_nrvars of the created context. - * + * * the return from f must push 3 values. * push_return_r ; as remembered in the ctx->req_nrvars - * + * * emit store_into_xxx instruction for the first return variable assignment. * emit pop_into_xxx instructions for the rest. * pop_into c @@ -3071,7 +3101,7 @@ static int compile_try (hcl_t* hcl, hcl_cnode_t* src) if (!obj) { /* no value */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } else if (!HCL_CNODE_IS_CONS(obj)) @@ -3119,12 +3149,12 @@ static HCL_INLINE int patch_nearest_post_try (hcl_t* hcl, hcl_ooi_t* catch_skip_ if (emit_byte_instruction(hcl, HCL_CODE_TRY_EXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; - *catch_skip_jip = hcl->code.bc.len; + *catch_skip_jip = hcl->code.bc.len; if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; /* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */ block_code_size = hcl->code.bc.len - jip - (HCL_CODE_LONG_PARAM_SIZE + 1); - + if (block_code_size > MAX_CODE_JUMP * 2) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKFLOOD, HCL_CNODE_GET_LOC(cf->operand), HCL_NULL, "code too big - size %zu", block_code_size); @@ -3189,13 +3219,13 @@ static HCL_INLINE int compile_catch (hcl_t* hcl) fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth - 1]; /* parent block */ par_tmprcnt = fbi->tmprcnt; } - else + else { par_tmprcnt = 0; } /* fill the variable information structure as if it's found by find_variable_backward(). - * we know it's the last variable as add_temporary_variable() is called below. + * we know it's the last variable as add_temporary_variable() is called below. * there is no need to call find_variable_backward() */ vi.type = VAR_INDEXED; vi.ctx_offset = 0; @@ -3214,7 +3244,7 @@ static HCL_INLINE int compile_catch (hcl_t* hcl) obj = HCL_CNODE_CONS_CDR(obj); /* jump_inst_pos hold the instruction pointer that skips the catch block at the end of the try block */ - patch_nearest_post_try (hcl, &jump_inst_pos); + patch_nearest_post_try (hcl, &jump_inst_pos); /* produce an instruction to store the exception value to an exception variable pushed by the 'throw' instruction */ if (emit_variable_access(hcl, VAR_ACCESS_POP, &vi, HCL_CNODE_GET_LOC(src)) <= -1) return -1; @@ -3311,7 +3341,7 @@ static int compile_throw (hcl_t* hcl, hcl_cnode_t* src) return -1; } - /* throw can be located anywhere, however, + /* throw can be located anywhere, however, * if there is no outer try-catch, it ends up with a fatal runtime error */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val); @@ -3324,7 +3354,7 @@ static int compile_throw (hcl_t* hcl, hcl_cnode_t* src) static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop) { - /* (while (xxxx) ... ) + /* (while (xxxx) ... ) * (until (xxxx) ... ) */ hcl_cnode_t* cmd, * obj, * cond; hcl_oow_t cond_pos; @@ -3379,9 +3409,9 @@ static int compile_cons_array_expression (hcl_t* hcl, hcl_cnode_t* obj) hcl_cframe_t* cf; nargs = hcl_countcnodecons(hcl, obj); - if (nargs > MAX_CODE_PARAM) + if (nargs > MAX_CODE_PARAM) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements in array", nargs); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements in array", nargs); return -1; } @@ -3404,9 +3434,9 @@ static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_cnode_t* obj) hcl_cframe_t* cf; nargs = hcl_countcnodecons(hcl, obj); - if (nargs > MAX_CODE_PARAM) + if (nargs > MAX_CODE_PARAM) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements in byte-array", nargs); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements in byte-array", nargs); return -1; } @@ -3429,9 +3459,9 @@ static int compile_cons_dic_expression (hcl_t* hcl, hcl_cnode_t* obj) hcl_cframe_t* cf; nargs = hcl_countcnodecons(hcl, obj); - if (nargs > MAX_CODE_PARAM) + if (nargs > MAX_CODE_PARAM) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements in dictionary", nargs); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements in dictionary", nargs); return -1; } @@ -3447,7 +3477,7 @@ static int compile_cons_dic_expression (hcl_t* hcl, hcl_cnode_t* obj) static int compile_cons_qlist_expression (hcl_t* hcl, hcl_cnode_t* obj) { - /* #( 1 2 3 ) + /* #( 1 2 3 ) * #(1 (+ 2 3) 5) --> #(1 5 5) * */ SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_CONS, obj); @@ -3465,7 +3495,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret * function-name can be: * a symbol. * another function call. - * if the name is another function call, i can't know if the + * if the name is another function call, i can't know if the * function name will be valid at the compile time. */ HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_XLIST)); @@ -3537,7 +3567,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret break; case HCL_SYNCODE_SET: - /* (set x 10) + /* (set x 10) * (set x (lambda (x y) (+ x y)) */ if (compile_set(hcl, obj) <= -1) return -1; break; @@ -3579,11 +3609,11 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret return -1; } } - else if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_DSYMBOL(car) || + else if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_DSYMBOL(car) || HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST) || HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_MLIST)) { - /* normal function call + /* normal function call * ( ...) */ hcl_ooi_t nargs; hcl_ooi_t oldtop; @@ -3594,9 +3624,9 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret * many operations can be performed without taking GC into account */ /* store the position of COP_EMIT_CALL to be produced with - * SWITCH_TOP_CFRAME() in oldtop for argument count patching + * SWITCH_TOP_CFRAME() in oldtop for argument count patching * further down */ - oldtop = GET_TOP_CFRAME_INDEX(hcl); + oldtop = GET_TOP_CFRAME_INDEX(hcl); HCL_ASSERT (hcl, oldtop >= 0); SWITCH_TOP_CFRAME (hcl, COP_EMIT_CALL, car); /* <4> */ @@ -3607,7 +3637,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret /* compile ... etc */ cdr = HCL_CNODE_CONS_CDR(obj); - if (!cdr) + if (!cdr) { nargs = 0; } @@ -3621,9 +3651,9 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret } nargs = hcl_countcnodecons(hcl, cdr); - if (nargs > MAX_CODE_PARAM) + if (nargs > MAX_CODE_PARAM) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(cdr), HCL_NULL, "too many(%zd) parameters in function call", nargs); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(cdr), HCL_NULL, "too many(%zd) parameters in function call", nargs); return -1; } } @@ -3632,7 +3662,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret { hcl_oop_cons_t sdc; - /* only symbols are added to the system dictionary. + /* only symbols are added to the system dictionary. * perform this lookup only if car is a symbol */ sdc = hcl_lookupsysdicforsymbol_noseterr(hcl, HCL_CNODE_GET_TOK(car)); if (sdc) @@ -3643,8 +3673,8 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret { if (nargs < sdv->slot[1] || nargs > sdv->slot[2]) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL, - "parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters", nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL, + "parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters", nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]); return -1; } } @@ -3682,7 +3712,7 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret hcl_cframe_t* cf; int syncode; /* syntax code of the first element */ - /* message sending + /* message sending * (: ...) */ HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST)); @@ -3696,9 +3726,9 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret } /* store the position of COP_EMIT_CALL to be produced with - * SWITCH_TOP_CFRAME() in oldtop for argument count patching + * SWITCH_TOP_CFRAME() in oldtop for argument count patching * further down */ - oldtop = GET_TOP_CFRAME_INDEX(hcl); + oldtop = GET_TOP_CFRAME_INDEX(hcl); HCL_ASSERT (hcl, oldtop >= 0); /* compile */ @@ -3731,7 +3761,7 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret /* compile ... etc */ cdr = HCL_CNODE_CONS_CDR(cdr); - if (!cdr) + if (!cdr) { nargs = 0; } @@ -3745,9 +3775,9 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret } nargs = hcl_countcnodecons(hcl, cdr); - if (nargs > MAX_CODE_PARAM) + if (nargs > MAX_CODE_PARAM) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(cdr), HCL_NULL, "too many(%zd) parameters in function call", nargs); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(cdr), HCL_NULL, "too many(%zd) parameters in function call", nargs); return -1; } } @@ -3757,7 +3787,7 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret { hcl_oop_cons_t sdc; - /* only symbols are added to the system dictionary. + /* only symbols are added to the system dictionary. * perform this lookup only if car is a symbol */ sdc = hcl_lookupsysdicforsymbol_noseterr(hcl, HCL_CNODE_GET_TOK(car)); if (sdc) @@ -3768,8 +3798,8 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret { if (nargs < sdv->slot[1] || nargs > sdv->slot[2]) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL, - "parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters", nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL, + "parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters", nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]); return -1; } } @@ -3791,6 +3821,10 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret return 0; } +static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets) +{ +} + static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) { hcl_var_info_t vi; @@ -3807,7 +3841,7 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) /* check if a symbol is a local variable */ x = find_variable_backward(hcl, obj, &vi); if (x <= -1) return -1; - + if (x == 0) { hcl_oop_t sym, cons; @@ -3819,7 +3853,7 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) if (HCL_UNLIKELY(!sym)) return -1; cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym); - if (!cons) + if (!cons) { cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_undef); if (HCL_UNLIKELY(!cons)) return -1; @@ -4112,9 +4146,12 @@ redo: break; case HCL_CONCODE_BLOCK: - /* TODO: not implemented yet */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - block not implemented"); - return -1; + if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCKBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "block expression disallowed"); + return -1; + } + if (compile_cons_block_expression(hcl, oprnd, 0) <= -1) return -1; break; case HCL_CONCODE_ARRAY: @@ -4158,6 +4195,11 @@ redo: hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty message send list"); return -1; + case HCL_CONCODE_BLOCK: + /* TODO: may have to allow it.. */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block list"); + return -1; + case HCL_CONCODE_ARRAY: if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; goto done; @@ -4204,7 +4246,7 @@ redo: return -1; } - /* the control reaches here in case a compile_xxxx() functionse.g. compile_cons_xlist_expression) is called. + /* the control reaches here in case a compile_xxxx() functionse.g. compile_cons_xlist_expression) is called. * such a function removes the top cframe. so POP_CFRAME() needs not be called here */ return 0; @@ -4234,7 +4276,7 @@ static int compile_object_r (hcl_t* hcl) { return compile_cons_mlist_expression(hcl, oprnd, cf->u.obj_r.nrets); } - + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "non-function call/non-message send disallowed"); return -1; } @@ -4246,7 +4288,7 @@ static int compile_object_list (hcl_t* hcl) int cop; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_ARGUMENT_LIST || + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_ARGUMENT_LIST || cf->opcode == COP_COMPILE_OBJECT_LIST || cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL || cf->opcode == COP_COMPILE_IF_OBJECT_LIST || @@ -4326,14 +4368,14 @@ static int compile_object_list (hcl_t* hcl) if (cdr) { - /* there is a next statement to compile + /* there is a next statement to compile * - * (+ 1 2 3) - argument list. 1, 2, 3 pushed must remain in + * (+ 1 2 3) - argument list. 1, 2, 3 pushed must remain in * the stack until the function '+' is called. * - * (lambda (x y) (+ x 10) (+ y 20)) + * (lambda (x y) (+ x 10) (+ y 20)) * - the result of (+ x 10) should be popped before (+ y 20) - * is executed + * is executed * * for the latter, inject POP_STACKTOP after each object evaluation * except the last. @@ -4349,7 +4391,7 @@ static int compile_object_list (hcl_t* hcl) cop == COP_COMPILE_IF_OBJECT_LIST_TAIL || cop == COP_COMPILE_TRY_OBJECT_LIST_TAIL) { - /* emit POP_STACKTOP before evaluating the second objects + /* emit POP_STACKTOP before evaluating the second objects * and onwards. this goes above COP_COMPILE_OBJECT.*/ /* TODO: if the previous operators is known to divert execution flow, it may skip this. @@ -4488,7 +4530,7 @@ static int compile_dic_list (hcl_t* hcl) hcl_setsynerrbfmt (hcl, HCL_SYNERR_UNBALKV, HCL_CNODE_GET_LOC(car), HCL_NULL, "no value for key %.*js", HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car)); return -1; } - + cadr = HCL_CNODE_CONS_CAR(cdr); cddr = HCL_CNODE_CONS_CDR(cdr); @@ -4573,7 +4615,7 @@ static HCL_INLINE int post_if_cond (hcl_t* hcl) if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, &cf->u.post_if.start_loc) <= -1) return -1; /* to drop the result of the conditional when it is true */ - if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, &cf->u.post_if.start_loc) <= -1) return -1; + if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, &cf->u.post_if.start_loc) <= -1) return -1; HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); body_pos = hcl->code.bc.len; @@ -4639,11 +4681,11 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl) HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_COND || cf->opcode == COP_POST_WHILE_COND); HCL_ASSERT (hcl, cf->operand != HCL_NULL); - /* the caller must pass the cons cell branching to the conditinal and the body + /* the caller must pass the cons cell branching to the conditinal and the body * if the body cell is given, things gets complicated because the body part can be HCL_NULL. * for instance, the body part is empty in (while (< i 1) ) */ cond = HCL_CNODE_CONS_CAR(cf->operand); - body = HCL_CNODE_CONS_CDR(cf->operand); + body = HCL_CNODE_CONS_CDR(cf->operand); cond_pos = cf->u.post_while.cond_pos; start_loc = cf->u.post_while.start_loc; @@ -4679,7 +4721,7 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl) SWITCH_TOP_CFRAME (hcl, next_cop, cond); /* 2 */ cf = GET_TOP_CFRAME(hcl); } - cf->u.post_while.cond_pos = cond_pos; + cf->u.post_while.cond_pos = cond_pos; cf->u.post_while.body_pos = body_pos; cf->u.post_while.jump_inst_pos = jump_inst_pos; cf->u.post_while.start_loc = start_loc; @@ -4953,7 +4995,7 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl) fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; jip = cf->u.lambda.jump_inst_pos; - if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) + if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) lfsize = hcl->code.lit.len - hcl->c->fnblk.info[hcl->c->fnblk.depth].lfbase; /* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */ @@ -4991,7 +5033,7 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl) } patch_long_jump (hcl, jip, block_code_size); - if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) + if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) patch_long_param (hcl, cf->u.lambda.lfsize_pos, lfsize); POP_CFRAME (hcl); @@ -5072,7 +5114,7 @@ static HCL_INLINE int post_lambda (hcl_t* hcl) } else { - SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name); + SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name); cf = GET_TOP_CFRAME(hcl); cf->u.set.vi = vi; } @@ -5138,7 +5180,7 @@ static HCL_INLINE int emit_set (hcl_t* hcl) if (HCL_UNLIKELY(!sym)) return -1; cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym); - if (!cons) + if (!cons) { cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_nil); if (HCL_UNLIKELY(!cons)) return -1; @@ -5231,12 +5273,14 @@ static HCL_INLINE int emit_throw (hcl_t* hcl) /* ========================================================================= */ -int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) +int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) { hcl_oow_t saved_bc_len, saved_lit_len; hcl_bitmask_t log_default_type_mask; hcl_fnblk_info_t top_fnblk_saved; + hcl->c->flags = flags; + HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0); if (flags & HCL_COMPILE_CLEAR_CODE) { @@ -5250,15 +5294,15 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) log_default_type_mask = hcl->log.default_type_mask; hcl->log.default_type_mask |= HCL_LOG_COMPILER; - /* + /* * In the non-INTERACTIVE mode, the literal frame base doesn't matter. - * Only the initial function object contains the literal frame. + * Only the initial function object contains the literal frame. * No other function objects are created. All lambda defintions are * translated to base context objects instead. - * + * * In the INTERACTIVE mode, the literal frame base plays a key role. * hcl_compile() is called for the top-level expression and the literal - * frame base can be 0. The means it is ok for a top-level code to + * frame base can be 0. The means it is ok for a top-level code to * reference part of the literal frame reserved for a lambda function. * * (set b 1) @@ -5266,7 +5310,7 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) * (set a 2) * (set-a 4) * (printf "%d\n" a) - * + * * the global literal frame looks like this: * @0 (b) * @1 (a) @@ -5275,10 +5319,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) * @4 "%d\n" * * @1 to @2 will be copied to a function object when defun is executed. - * The literal frame of the created function object for set-a looks + * The literal frame of the created function object for set-a looks * like this * @0 (a) - * @1 (set-a) + * @1 (set-a) */ /* TODO: in case i implement all global variables as block arguments at the top level...what should i do? */ @@ -5291,8 +5335,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) HCL_ASSERT (hcl, hcl->c->tv.wcount == 0); /* keep a virtual function block for the top-level compilation. - * pass HCL_TYPE_MAX(hcl_oow_t) as make_inst_pos because there is - * no actual MAKE_BLOCK/MAKE_FUNCTION instruction which otherwise + * pass HCL_TYPE_MAX(hcl_oow_t) as make_inst_pos because there is + * no actual MAKE_LAMBDA/MAKE_FUNCTION instruction which otherwise * would be patched in pop_fnblk(). */ if (push_fnblk(hcl, HCL_NULL, 0, 0, 0, hcl->c->tv.wcount, hcl->c->tv.wcount, hcl->c->tv.s.len, HCL_TYPE_MAX(hcl_oow_t), 0, FUN_PLAIN) <= -1) return -1; /* must not goto oops */ } diff --git a/lib/decode.c b/lib/decode.c index 4b24482..53c1b80 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -376,7 +376,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) case HCL_CODE_CLASS_ENTER: { hcl_oow_t b3; - + FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b2); FETCH_PARAM_CODE_TO (hcl, b3); @@ -545,8 +545,8 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "pop_into_cvar_i %zu", b1); break; - - /* -------------------------------------------------------- */ + + /* -------------------------------------------------------- */ case HCL_CODE_PUSH_CVAR_M_X: FETCH_PARAM_CODE_TO (hcl, b1); @@ -690,7 +690,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) case HCL_CODE_MAKE_FUNCTION: { hcl_oow_t b3, b4; - /* b1 - block mask + /* b1 - block mask * b2 - block mask * b3 - base literal frame start * b4 - base literal frame end */ @@ -700,7 +700,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) FETCH_PARAM_CODE_TO (hcl, b4); b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2; - LOG_INST_7 (hcl, "make_function %zu %zu %zu %zu %zu %zu %zu", + LOG_INST_7 (hcl, "make_function %zu %zu %zu %zu %zu %zu %zu", GET_BLK_MASK_INSTA(b1), GET_BLK_MASK_VA(b1), GET_BLK_MASK_NARGS(b1), @@ -712,14 +712,14 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) break; } - case HCL_CODE_MAKE_BLOCK: + case HCL_CODE_MAKE_LAMBDA: /* b1 - block mask * b2 - block mask */ FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b2); b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2; - LOG_INST_5 (hcl, "make_block %zu %zu %zu %zu %zu", + LOG_INST_5 (hcl, "make_lambda %zu %zu %zu %zu %zu", GET_BLK_MASK_INSTA(b1), GET_BLK_MASK_VA(b1), GET_BLK_MASK_NARGS(b1), diff --git a/lib/dic.c b/lib/dic.c index b678bf9..a7c3069 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -48,13 +48,13 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) else if (oldsz < 400000) newsz = oldsz + (oldsz / 16); else if (oldsz < 800000) newsz = oldsz + (oldsz / 32); else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64); - else + else { hcl_oow_t inc, inc_max; inc = oldsz / 128; inc_max = HCL_OBJ_SIZE_MAX - oldsz; - if (inc > inc_max) + if (inc > inc_max) { if (inc_max > 0) inc = inc_max; else @@ -67,7 +67,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) } hcl_pushvolat (hcl, (hcl_oop_t*)&oldbuc); - newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0); + newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0); hcl_popvolat (hcl); if (!newbuc) return HCL_NULL; @@ -120,7 +120,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k #endif /* find */ - while (dic->bucket->slot[index] != hcl->_nil) + while (dic->bucket->slot[index] != hcl->_nil) { #if defined(SYMBOL_ONLY_KEY) ass = (hcl_oop_cons_t)dic->bucket->slot[index]; @@ -128,7 +128,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car)); if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(ass->car) && - hcl_equal_oochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(key))) + hcl_equal_oochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(key))) { /* the value of HCL_NULL indicates no insertion or update. */ if (value) ass->cdr = value; /* update */ @@ -166,7 +166,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k tally = HCL_OOP_TO_SMOOI(dic->tally); if (tally >= HCL_SMOOI_MAX) { - /* this built-in dictionary is not allowed to hold more than + /* this built-in dictionary is not allowed to hold more than * HCL_SMOOI_MAX items for efficiency sake */ hcl_seterrnum (hcl, HCL_EDFULL); return HCL_NULL; @@ -178,7 +178,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k /* no conversion to hcl_oow_t is necessary for tally + 1. * the maximum value of tally is checked to be HCL_SMOOI_MAX - 1. - * tally + 1 can produce at most HCL_SMOOI_MAX. above all, + * tally + 1 can produce at most HCL_SMOOI_MAX. above all, * HCL_SMOOI_MAX is way smaller than HCL_TYPE_MAX(hcl_ooi_t). */ if (tally + 1 >= HCL_OBJ_GET_SIZE(dic->bucket)) { @@ -205,11 +205,11 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k index %= HCL_OBJ_GET_SIZE(dic->bucket); #endif - while (dic->bucket->slot[index] != hcl->_nil) + while (dic->bucket->slot[index] != hcl->_nil) index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket); } - /* create a new assocation of a key and a value since + /* create a new assocation of a key and a value since * the key isn't found in the root dictionary */ ass = (hcl_oop_cons_t)hcl_makecons(hcl, (hcl_oop_t)key, value); if (!ass) goto oops; @@ -241,13 +241,13 @@ static hcl_oop_cons_t lookupdic_noseterr (hcl_t* hcl, hcl_oop_dic_t dic, const h index = hcl_hash_oochars(name->ptr, name->len) % HCL_OBJ_GET_SIZE(dic->bucket); - while ((hcl_oop_t)(ass = (hcl_oop_cons_t)HCL_OBJ_GET_OOP_VAL(dic->bucket, index)) != hcl->_nil) + while ((hcl_oop_t)(ass = (hcl_oop_cons_t)HCL_OBJ_GET_OOP_VAL(dic->bucket, index)) != hcl->_nil) { HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass)); if (HCL_IS_SYMBOL(hcl, ass->car)) { if (name->len == HCL_OBJ_GET_SIZE(ass->car) && - hcl_equal_oochars(name->ptr, HCL_OBJ_GET_CHAR_SLOT(ass->car), name->len)) + hcl_equal_oochars(name->ptr, HCL_OBJ_GET_CHAR_SLOT(ass->car), name->len)) { return ass; } @@ -259,8 +259,8 @@ static hcl_oop_cons_t lookupdic_noseterr (hcl_t* hcl, hcl_oop_dic_t dic, const h /* when value is HCL_NULL, perform no insertion */ - /* hcl_seterrXXX() is not called here. the dictionary lookup is very frequent - * and so is lookup failure. for instance, hcl_findmethod() calls this over + /* hcl_seterrXXX() is not called here. the dictionary lookup is very frequent + * and so is lookup failure. for instance, hcl_findmethod() calls this over * a class chain. there might be a failure at each class level. it's waste to * set the error information whenever the failure occurs. * the caller of this function must set the error information upon failure */ @@ -360,7 +360,7 @@ int hcl_zapatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) #endif /* find */ - while (dic->bucket->slot[index] != hcl->_nil) + while (dic->bucket->slot[index] != hcl->_nil) { #if defined(SYMBOL_ONLY_KEY) ass = (hcl_oop_cons_t)dic->bucket->slot[index]; @@ -368,7 +368,7 @@ int hcl_zapatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car)); if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(ass->car) && - hcl_equal_oochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(key))) + hcl_equal_oochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(key))) { /* the value of HCL_NULL indicates no insertion or update. */ goto found; diff --git a/lib/err.c b/lib/err.c index 1f19a99..487379e 100644 --- a/lib/err.c +++ b/lib/err.c @@ -160,7 +160,9 @@ static char* synerrstr[] = "unbalanced key/value pair", "unbalanced parenthesis/brace/bracket", "empty x-list", - "empty m-list" + "empty m-list", + "block expression expected" + "block expression disallowed" }; /* -------------------------------------------------------------------------- diff --git a/lib/exec.c b/lib/exec.c index 5116257..c205c6e 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -41,7 +41,7 @@ static const char* io_type_str[] = static HCL_INLINE const char* proc_state_to_string (int state) { - static const hcl_bch_t* str[] = + static const hcl_bch_t* str[] = { "TERMINATED", "SUSPENDED", @@ -156,7 +156,7 @@ static void terminate_all_processes (hcl_t* hcl); exsp++; ap->slot[exsp] = HCL_SMOOI_TO_OOP(sp_); \ ap->exsp = HCL_SMOOI_TO_OOP(exsp); \ } while (0) - + #define HCL_EXSTACK_POP(hcl) \ do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ @@ -196,7 +196,7 @@ static void terminate_all_processes (hcl_t* hcl); clsp_++; ap->slot[clsp_] = (v); \ ap->clsp = HCL_SMOOI_TO_OOP(clsp_); \ } while (0) - + #define HCL_CLSTACK_POP(hcl) \ do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ @@ -204,7 +204,7 @@ static void terminate_all_processes (hcl_t* hcl); clsp_--; \ ap->clsp = HCL_SMOOI_TO_OOP(clsp_); \ } while (0) - + #define HCL_CLSTACK_POPS(hcl, count) \ do { \ hcl_oop_process_t ap = (hcl)->processor->active; \ @@ -247,7 +247,7 @@ static HCL_INLINE int vm_startup (hcl_t* hcl) for (cb = hcl->cblist; cb; cb = cb->next) { - if (cb->vm_startup && cb->vm_startup(hcl) <= -1) + if (cb->vm_startup && cb->vm_startup(hcl) <= -1) { for (cb = cb->prev; cb; cb = cb->prev) { @@ -280,11 +280,11 @@ static void vm_cleanup (hcl_t* hcl) if (hcl->processor->total_count != HCL_SMOOI_TO_OOP(0)) { /* if there is a suspended process, your program is probably wrong */ - HCL_LOG3 (hcl, HCL_LOG_WARN, "Warning - non-zero number of processes upon VM clean-up - total: %zd runnable: %zd suspended: %zd\n", + HCL_LOG3 (hcl, HCL_LOG_WARN, "Warning - non-zero number of processes upon VM clean-up - total: %zd runnable: %zd suspended: %zd\n", (hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->total_count), (hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->runnable.count), (hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->suspended.count)); - + HCL_LOG0 (hcl, HCL_LOG_WARN, "Warning - terminating all residue processes\n"); terminate_all_processes (hcl); } @@ -314,7 +314,7 @@ static void vm_cleanup (hcl_t* hcl) HCL_ASSERT (hcl, hcl->sem_io_map[i] <= -1); } - else + else { i++; } @@ -346,7 +346,7 @@ static HCL_INLINE void vm_gettime (hcl_t* hcl, hcl_ntime_t* now) { hcl->vmprim.vm_gettime (hcl, now); /* in vm_startup(), hcl->exec_start_time has been set to the time of - * that moment. time returned here get offset by hcl->exec_start_time and + * that moment. time returned here get offset by hcl->exec_start_time and * thus becomes relative to it. this way, it is kept small such that it * can be represented in a small integer with leaving almost zero chance * of overflow. */ @@ -391,7 +391,7 @@ static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize * the byte code is placed in the trailer space */ func = (hcl_oop_function_t)hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_FUNCTION, HCL_FUNCTION_NAMED_INSTVARS + lfsize, bptr, blen); if (HCL_UNLIKELY(!func)) return HCL_NULL; - + if (dbgi) { hcl_oop_t tmp; @@ -414,7 +414,7 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, /* copy literal frames */ HCL_ASSERT (hcl, lfsize <= HCL_OBJ_GET_SIZE(func) - HCL_FUNCTION_NAMED_INSTVARS); - for (i = 0; i < lfsize; i++) + for (i = 0; i < lfsize; i++) { func->literal_frame[i] = lfptr[i]; #if 0 @@ -427,13 +427,13 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, func->attr_mask = HCL_SMOOI_TO_OOP(attr_mask); } -static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl) +static HCL_INLINE hcl_oop_lambda_t make_lambda (hcl_t* hcl) { /* create a base block used for creation of a block context */ - return (hcl_oop_block_t)hcl_allocoopobj(hcl, HCL_BRAND_BLOCK, HCL_BLOCK_NAMED_INSTVARS); + return (hcl_oop_lambda_t)hcl_allocoopobj(hcl, HCL_BRAND_LAMBDA, HCL_BLOCK_NAMED_INSTVARS); } -static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_block_t blk, hcl_ooi_t attr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx) +static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_lambda_t blk, hcl_ooi_t attr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx) { HCL_ASSERT (hcl, attr_mask >= 0 && attr_mask <= HCL_SMOOI_MAX); HCL_ASSERT (hcl, ip >= 0 && ip <= HCL_SMOOI_MAX); @@ -564,7 +564,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) //// HCL_OBJ_SET_FLAGS_PROC (proc, proc_flags); /* a special flag to indicate an object is a process instance */ //////////////////// #endif - + proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED); /* assign a process id to the process */ @@ -680,7 +680,7 @@ static HCL_INLINE void switch_to_next_runnable_process (hcl_t* hcl) static HCL_INLINE void chain_into_processor (hcl_t* hcl, hcl_oop_process_t proc, int new_state) { - /* the process is not scheduled at all. + /* the process is not scheduled at all. * link it to the processor's process list. */ hcl_ooi_t runnable_count; hcl_ooi_t suspended_count; @@ -692,7 +692,7 @@ static HCL_INLINE void chain_into_processor (hcl_t* hcl, hcl_oop_process_t proc, HCL_ASSERT (hcl, new_state == PROC_STATE_RUNNABLE || new_state == PROC_STATE_RUNNING); #if defined(HCL_DEBUG_VM_PROCESSOR) - HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - process[%zd] %hs->%hs in chain_into_processor\n", HCL_OOP_TO_SMOOI(proc->id), proc_state_to_string(HCL_OOP_TO_SMOOI(proc->state)), @@ -779,7 +779,7 @@ static HCL_INLINE void chain_into_semaphore (hcl_t* hcl, hcl_oop_process_t proc, /* append a process to the process list of a semaphore or a semaphore group */ /* a process chained to a semaphore cannot get chained to - * a semaphore again. a process can get chained to a single semaphore + * a semaphore again. a process can get chained to a single semaphore * or a single semaphore group only */ if ((hcl_oop_t)proc->sem != hcl->_nil) return; /* ignore it if it happens anyway. TODO: is it desirable???? */ @@ -809,11 +809,11 @@ static HCL_INLINE void unchain_from_semaphore (hcl_t* hcl, hcl_oop_process_t pro HCL_ASSERT (hcl, HCL_OFFSETOF(hcl_semaphore_t,waiting) == HCL_OFFSETOF(hcl_semaphore_group_t,waiting)); /* proc->sem may be one of a semaphore or a semaphore group. - * i assume that 'waiting' is defined to the same position - * in both Semaphore and SemaphoreGroup. there is no need to + * i assume that 'waiting' is defined to the same position + * in both Semaphore and SemaphoreGroup. there is no need to * write different code for each class. */ sem = (hcl_oop_semaphore_t)proc->sem; /* semgrp = (hcl_oop_semaphore_group_t)proc->sem */ - HCL_DELETE_FROM_OOP_LIST (hcl, &sem->waiting, proc, sem_wait); + HCL_DELETE_FROM_OOP_LIST (hcl, &sem->waiting, proc, sem_wait); proc->sem_wait.prev = (hcl_oop_process_t)hcl->_nil; proc->sem_wait.next = (hcl_oop_process_t)hcl->_nil; @@ -867,7 +867,7 @@ static void dump_process_info (hcl_t* hcl, hcl_bitmask_t log_mask) /* dump process IDs waiting for input signaling */ HCL_LOG0 (hcl, log_mask, "(wpi"); sem = hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_INPUT]; - if (sem) + if (sem) { hcl_oop_process_t wp; /* waiting process */ for (wp = sem->waiting.first; (hcl_oop_t)wp != hcl->_nil; wp = wp->sem_wait.next) @@ -883,7 +883,7 @@ static void dump_process_info (hcl_t* hcl, hcl_bitmask_t log_mask) /* dump process IDs waitingt for output signaling */ HCL_LOG0 (hcl, log_mask, ",wpo"); sem = hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT]; - if (sem) + if (sem) { hcl_oop_process_t wp; /* waiting process */ for (wp = sem->waiting.first; (hcl_oop_t)wp != hcl->_nil; wp = wp->sem_wait.next) @@ -906,12 +906,12 @@ static void dump_process_info (hcl_t* hcl, hcl_bitmask_t log_mask) static HCL_INLINE void reset_process_stack_pointers (hcl_t* hcl, hcl_oop_process_t proc) { #if defined(HCL_DEBUG_VM_PROCESSOR) - HCL_LOG4 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, - "Processor - process[%zd] SP: %zd(%zd) ST: %zd", + HCL_LOG4 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + "Processor - process[%zd] SP: %zd(%zd) ST: %zd", HCL_OOP_TO_SMOOI(proc->id), HCL_OOP_TO_SMOOI(proc->sp), HCL_OOP_TO_SMOOI(proc->sp) - (-1), HCL_OOP_TO_SMOOI(proc->st)); - HCL_LOG6 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, - " EXSP: %zd(%zd) EXST: %zd CLSP: %zd(%zd) CLST: %zd\n", + HCL_LOG6 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + " EXSP: %zd(%zd) EXST: %zd CLSP: %zd(%zd) CLST: %zd\n", HCL_OOP_TO_SMOOI(proc->exsp), HCL_OOP_TO_SMOOI(proc->exsp) - HCL_OOP_TO_SMOOI(proc->st), HCL_OOP_TO_SMOOI(proc->exst), HCL_OOP_TO_SMOOI(proc->clsp), HCL_OOP_TO_SMOOI(proc->clsp) - HCL_OOP_TO_SMOOI(proc->exst), HCL_OOP_TO_SMOOI(proc->clst)); #endif @@ -955,8 +955,8 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc) HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process); if (HCL_LOG_ENABLED(hcl, HCL_LOG_IC | HCL_LOG_DEBUG)) { - HCL_LOG5 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, - "No runnable process after termination of process %zd - total %zd runnable/running %zd suspended %zd - sem_io_wait_count %zu\n", + HCL_LOG5 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + "No runnable process after termination of process %zd - total %zd runnable/running %zd suspended %zd - sem_io_wait_count %zu\n", HCL_OOP_TO_SMOOI(proc->id), HCL_OOP_TO_SMOOI(hcl->processor->total_count), HCL_OOP_TO_SMOOI(hcl->processor->runnable.count), @@ -1006,7 +1006,7 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc) HCL_DEBUG1 (hcl, "terminate_process(sg) - lowered sem_io_wait_count to %zu\n", hcl->sem_io_wait_count); } } - else + else { HCL_ASSERT (hcl, HCL_IS_SEMAPHORE(hcl, proc->sem)); if (((hcl_oop_semaphore_t)proc->sem)->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)) @@ -1014,7 +1014,7 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc) HCL_ASSERT (hcl, hcl->sem_io_wait_count > 0); hcl->sem_io_wait_count--; HCL_DEBUG3 (hcl, "terminate_process(s) - lowered sem_io_wait_count to %zu for IO semaphore at index %zd handle %zd\n", - hcl->sem_io_wait_count, + hcl->sem_io_wait_count, HCL_OOP_TO_SMOOI(((hcl_oop_semaphore_t)proc->sem)->u.io.index), HCL_OOP_TO_SMOOI(((hcl_oop_semaphore_t)proc->sem)->u.io.handle) ); @@ -1042,12 +1042,12 @@ static void terminate_all_processes (hcl_t* hcl) { terminate_process (hcl, hcl->processor->suspended.first); } - + while (HCL_OOP_TO_SMOOI(hcl->processor->runnable.count) > 0) { terminate_process (hcl, hcl->processor->runnable.first); } - + HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->total_count) == 0); HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process); } @@ -1066,7 +1066,7 @@ static void resume_process (hcl_t* hcl, hcl_oop_process_t proc) /* don't switch to this process. just change the state to RUNNABLE. * process switching should be triggerd by the process scheduler. */ - chain_into_processor (hcl, proc, PROC_STATE_RUNNABLE); + chain_into_processor (hcl, proc, PROC_STATE_RUNNABLE); /*proc->current_context = proc->initial_context;*/ } #if 0 @@ -1104,7 +1104,7 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc) sleep_active_process (hcl, PROC_STATE_RUNNABLE); unchain_from_processor (hcl, proc, PROC_STATE_SUSPENDED); - /* the last running/runnable process has been unchained + /* the last running/runnable process has been unchained * from the processor and set to SUSPENDED. the active * process must be the nil process */ HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process); @@ -1121,7 +1121,7 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc) * switch_to_process() has changed the active process. */ unchain_from_processor (hcl, proc, PROC_STATE_SUSPENDED); HCL_ASSERT (hcl, hcl->processor->active != hcl->nil_process); - switch_to_process (hcl, nrp, PROC_STATE_SUSPENDED); + switch_to_process (hcl, nrp, PROC_STATE_SUSPENDED); } } else @@ -1141,10 +1141,10 @@ static void yield_process (hcl_t* hcl, hcl_oop_process_t proc) HCL_ASSERT (hcl, proc == hcl->processor->active); - nrp = find_next_runnable_process (hcl); + nrp = find_next_runnable_process (hcl); /* if there are more than 1 runnable processes, the next * runnable process must be different from proc */ - if (nrp != proc) + if (nrp != proc) { #if defined(HCL_DEBUG_VM_PROCESSOR) HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - process[%zd] %hs->RUNNABLE in yield_process\n", HCL_OOP_TO_SMOOI(proc->id), proc_state_to_string(HCL_OOP_TO_SMOOI(proc->state))); @@ -1207,17 +1207,17 @@ static hcl_oop_process_t signal_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem) * ------------------------------------------------------------ * the waiting process has been suspended after a waiting * primitive function in Semaphore or SemaphoreGroup. - * the top of the stack of the process must hold the temporary + * the top of the stack of the process must hold the temporary * return value set by await_semaphore() or await_semaphore_group(). - * change the return value forcibly to the actual signaled + * change the return value forcibly to the actual signaled * semaphore */ HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(proc->sp) < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(proc) - HCL_PROCESS_NAMED_INSTVARS)); sp = HCL_OOP_TO_SMOOI(proc->sp); proc->slot[sp] = (hcl_oop_t)sem; - /* i should decrement the counter as long as the group being + /* i should decrement the counter as long as the group being * signaled contains an IO semaphore */ - if (HCL_OOP_TO_SMOOI(sg->sem_io_count) > 0) + if (HCL_OOP_TO_SMOOI(sg->sem_io_count) > 0) { HCL_ASSERT (hcl, hcl->sem_io_wait_count > 0); hcl->sem_io_wait_count--; @@ -1227,14 +1227,14 @@ static hcl_oop_process_t signal_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem) } } - /* if the semaphore belongs to a semaphore group and the control reaches + /* if the semaphore belongs to a semaphore group and the control reaches * here, no process is waiting on the semaphore group. however, a process * may still be waiting on the semaphore. If a process waits on a semaphore - * group and another process wait on a semaphore that belongs to the - * semaphore group, the process waiting on the group always wins. - * + * group and another process wait on a semaphore that belongs to the + * semaphore group, the process waiting on the group always wins. + * * TODO: implement a fair scheduling policy. or do i simply have to disallow individual wait on a semaphore belonging to a group? - * + * * if it doesn't belong to a sempahore group, i'm free from the starvation issue. */ if ((hcl_oop_t)sem->waiting.first == hcl->_nil) @@ -1263,12 +1263,12 @@ static hcl_oop_process_t signal_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem) /* [NOTE] no GC must occur as 'proc' isn't protected with hcl_pushvolat(). */ - /* detach a process from a semaphore's waiting list and + /* detach a process from a semaphore's waiting list and * make it runnable */ unchain_from_semaphore (hcl, proc); resume_process (hcl, proc); - if (sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)) + if (sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)) { HCL_ASSERT (hcl, hcl->sem_io_wait_count > 0); hcl->sem_io_wait_count--; @@ -1322,14 +1322,14 @@ static HCL_INLINE void await_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem) proc = hcl->processor->active; /* suspend the active process */ - suspend_process (hcl, proc); + suspend_process (hcl, proc); /* link the suspended process to the semaphore's process list */ - chain_into_semaphore (hcl, proc, sem); + chain_into_semaphore (hcl, proc, sem); HCL_ASSERT (hcl, sem->waiting.last == proc); - if (sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)) + if (sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)) { hcl->sem_io_wait_count++; HCL_DEBUG3 (hcl, "await_semaphore - raised sem_io_wait_count to %zu for IO semaphore at index %zd handle %zd\n", @@ -1382,26 +1382,26 @@ static HCL_INLINE hcl_oop_t await_semaphore_group (hcl_t* hcl, hcl_oop_semaphore proc = hcl->processor->active; /* suspend the active process */ - suspend_process (hcl, proc); + suspend_process (hcl, proc); /* link the suspended process to the semaphore group's process list */ - chain_into_semaphore (hcl, proc, (hcl_oop_semaphore_t)semgrp); + chain_into_semaphore (hcl, proc, (hcl_oop_semaphore_t)semgrp); HCL_ASSERT (hcl, semgrp->waiting.last == proc); - if (HCL_OOP_TO_SMOOI(semgrp->sem_io_count) > 0) + if (HCL_OOP_TO_SMOOI(semgrp->sem_io_count) > 0) { /* there might be more than 1 IO semaphores in the group * but i increment hcl->sem_io_wait_count by 1 only */ - hcl->sem_io_wait_count++; + hcl->sem_io_wait_count++; HCL_DEBUG1 (hcl, "await_semaphore_group - raised sem_io_wait_count to %zu\n", hcl->sem_io_wait_count); } - /* the current process will get suspended after the caller (mostly a + /* the current process will get suspended after the caller (mostly a * a primitive function handler) is over as it's added to a suspened * process list above */ HCL_ASSERT (hcl, hcl->processor->active != proc); - return hcl->_nil; + return hcl->_nil; } static void sift_up_sem_heap (hcl_t* hcl, hcl_ooi_t index) @@ -1536,7 +1536,7 @@ static void delete_from_sem_heap (hcl_t* hcl, hcl_ooi_t index) lastsem->u.timed.index = HCL_SMOOI_TO_OOP(index); hcl->sem_heap[index] = lastsem; - if (SEM_HEAP_EARLIER_THAN(hcl, lastsem, sem)) + if (SEM_HEAP_EARLIER_THAN(hcl, lastsem, sem)) sift_up_sem_heap (hcl, index); else sift_down_sem_heap (hcl, index); @@ -1578,7 +1578,7 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi hcl_seterrbfmt (hcl, HCL_EINVAL, "handle %zd out of supported range", io_handle); return -1; } - + if (io_handle >= hcl->sem_io_map_capa) { hcl_oow_t new_capa, i; @@ -1588,7 +1588,7 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi new_capa = HCL_ALIGN_POW2(io_handle + 1, SEM_IO_MAP_ALIGN); tmp = hcl_reallocmem (hcl, hcl->sem_io_map, HCL_SIZEOF(*tmp) * new_capa); - if (!tmp) + if (!tmp) { const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl); hcl_seterrbfmt (hcl, hcl->errnum, "handle %zd out of supported range - %js", oldmsg); @@ -1607,7 +1607,7 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi /* this handle is not in any tuples. add it to a new tuple */ if (hcl->sem_io_tuple_count >= SEM_IO_TUPLE_MAX) { - hcl_seterrbfmt (hcl, HCL_ESEMFLOOD, "too many IO semaphore tuples"); + hcl_seterrbfmt (hcl, HCL_ESEMFLOOD, "too many IO semaphore tuples"); return -1; } @@ -1627,13 +1627,13 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi } /* this condition must be true assuming SEM_IO_TUPLE_MAX <= HCL_SMOOI_MAX */ - HCL_ASSERT (hcl, hcl->sem_io_tuple_count <= HCL_SMOOI_MAX); + HCL_ASSERT (hcl, hcl->sem_io_tuple_count <= HCL_SMOOI_MAX); index = hcl->sem_io_tuple_count; tuple_added = 1; /* safe to initialize before vm_muxadd() because - * hcl->sem_io_tuple_count has not been incremented. + * hcl->sem_io_tuple_count has not been incremented. * still no impact even if it fails. */ hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_INPUT] = HCL_NULL; hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT] = HCL_NULL; @@ -1662,7 +1662,7 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi hcl_popvolat (hcl); } - if (n <= -1) + if (n <= -1) { HCL_LOG3 (hcl, HCL_LOG_WARN, "Failed to add IO semaphore at index %zd for %hs on handle %zd\n", index, io_type_str[io_type], io_handle); return -1; @@ -1680,7 +1680,7 @@ static int add_sem_to_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, hcl_ooi hcl->sem_io_tuple[index].sem[io_type] = sem; hcl->sem_io_count++; - if (tuple_added) + if (tuple_added) { hcl->sem_io_tuple_count++; hcl->sem_io_map[io_handle] = index; @@ -1727,14 +1727,14 @@ static int delete_sem_from_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, in hcl_pushvolat (hcl, (hcl_oop_t*)&sem); x = new_mask? hcl->vmprim.vm_muxmod(hcl, io_handle, new_mask): - hcl->vmprim.vm_muxdel(hcl, io_handle); + hcl->vmprim.vm_muxdel(hcl, io_handle); hcl_popvolat (hcl); - if (x <= -1) + if (x <= -1) { HCL_LOG3 (hcl, HCL_LOG_WARN, "Failed to delete IO semaphore at index %zd handle %zd for %hs\n", index, io_handle, io_type_str[io_type]); if (!force) return -1; - /* [NOTE] + /* [NOTE] * this means there could be some issue handling the file handles. * the file handle might have been closed before reaching here. * assuming the callback works correctly, it's not likely that the @@ -1776,7 +1776,7 @@ static int delete_sem_from_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, in /* migrate the last item to the deleted slot to compact the gap */ hcl->sem_io_tuple[index] = hcl->sem_io_tuple[hcl->sem_io_tuple_count]; - if (hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_INPUT]) + if (hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_INPUT]) hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_INPUT]->u.io.index = HCL_SMOOI_TO_OOP(index); if (hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT]) hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT]->u.io.index = HCL_SMOOI_TO_OOP(index); @@ -1800,10 +1800,10 @@ static void _signal_io_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem) if (hcl->processor->active == hcl->nil_process && (hcl_oop_t)proc != hcl->_nil) { - /* this is the only runnable process. + /* this is the only runnable process. * switch the process to the running state. * it uses wake_process() instead of - * switch_to_process() as there is no running + * switch_to_process() as there is no running * process at this moment */ HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE)); HCL_ASSERT (hcl, proc == hcl->processor->runnable.first); @@ -1868,7 +1868,7 @@ void hcl_releaseiohandle (hcl_t* hcl, hcl_ooi_t io_handle) { HCL_ASSERT(hcl, hcl->sem_io_tuple[index].handle == io_handle); sem = hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_INPUT]; - if (sem) + if (sem) { HCL_ASSERT(hcl, sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)); delete_sem_from_sem_io_tuple (hcl, sem, 0); @@ -1886,7 +1886,7 @@ void hcl_releaseiohandle (hcl_t* hcl, hcl_ooi_t io_handle) { HCL_ASSERT(hcl, hcl->sem_io_tuple[index].handle == io_handle); sem = hcl->sem_io_tuple[index].sem[HCL_SEMAPHORE_IO_TYPE_OUTPUT]; - if (sem) + if (sem) { HCL_ASSERT(hcl, sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)); delete_sem_from_sem_io_tuple (hcl, sem, 0); @@ -1897,9 +1897,9 @@ void hcl_releaseiohandle (hcl_t* hcl, hcl_ooi_t io_handle) /* ------------------------------------------------------------------------- */ -static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx) +static int prepare_new_context (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx) { - /* prepare a new block context for activation. + /* prepare a new block context for activation. * the passed block context becomes the base for a new block context. */ hcl_oop_context_t blkctx; @@ -1908,7 +1908,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs; /* the receiver must be a block context */ - HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk)); + HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk)); attr_mask = HCL_OOP_TO_SMOOI(op_blk->attr_mask); @@ -1920,7 +1920,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na if (actual_nargs < fixed_nargs || (!GET_BLK_MASK_VA(attr_mask) && actual_nargs > fixed_nargs)) { - HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, + HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - wrong number of arguments to a block %O - expecting %zd, got %zd\n", op_blk, fixed_nargs, actual_nargs); hcl_seterrbfmt (hcl, HCL_ECALLARG, "wrong number of argument passed to function block - %zd expected, %zd passed", fixed_nargs, actual_nargs); @@ -1929,7 +1929,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na if (req_nrvars > fblk_nrvars) { - HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, + HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - wrong number of returns specified of a block %O - max expected %zd, requested %zd\n", op_blk, fblk_nrvars, req_nrvars); hcl_seterrbfmt (hcl, HCL_ECALLRET, "wrong number of returns requested of function block - %zd expected at most, %zd requested", fblk_nrvars, req_nrvars); @@ -1938,7 +1938,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na /* create a new block context to clone op_blk */ hcl_pushvolat (hcl, (hcl_oop_t*)&op_blk); - blkctx = make_context(hcl, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs); + blkctx = make_context(hcl, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs); hcl_popvolat (hcl); if (HCL_UNLIKELY(!blkctx)) return -1; @@ -1992,11 +1992,11 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na return 0; } -static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t nargs, hcl_ooi_t nrvars, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx) +static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl_ooi_t nargs, hcl_ooi_t nrvars, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx) { int x; - HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk)); + HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk)); x = prepare_new_context( hcl, @@ -2018,12 +2018,12 @@ static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrvars) { - hcl_oop_block_t op_blk; + hcl_oop_lambda_t op_blk; hcl_oop_context_t newctx; int x; - op_blk = (hcl_oop_block_t)HCL_STACK_GETOP(hcl, nargs); - HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk)); + op_blk = (hcl_oop_lambda_t)HCL_STACK_GETOP(hcl, nargs); + HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk)); x = __activate_block(hcl, op_blk, nargs, nrvars, 0, 0, &newctx); if (HCL_UNLIKELY(x <= -1)) return -1; @@ -2062,7 +2062,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_ if (actual_nargs < fixed_nargs || (!GET_BLK_MASK_VA(attr_mask) && actual_nargs > fixed_nargs)) { - HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, + HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - wrong number of arguments to a function %O - expecting %zd, got %zd\n", op_func, fixed_nargs, nargs); hcl_seterrnum (hcl, HCL_ECALLARG); @@ -2071,7 +2071,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_ /* create a new block context to clone op_func */ hcl_pushvolat (hcl, (hcl_oop_t*)&op_func); - functx = make_context(hcl, fixed_nargs + nrvars + nlvars + excess_nargs); + functx = make_context(hcl, fixed_nargs + nrvars + nlvars + excess_nargs); hcl_popvolat (hcl); if (HCL_UNLIKELY(!functx)) return -1; @@ -2131,7 +2131,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs) if (nargs < rcv->min_nargs && nargs > rcv->max_nargs) { /* TODO: include a primitive name... */ - HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, + HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - wrong number of arguments to a primitive - expecting %zd-%zd, got %zd\n", rcv->min_nargs, rcv->max_nargs, nargs); hcl_seterrnum (hcl, HCL_ECALLARG); @@ -2143,19 +2143,19 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs) /* ------------------------------------------------------------------------- */ -static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner) +static hcl_oop_lambda_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner) { hcl_oocs_t name; /* TODO: implement method cache */ HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_)); /*HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op_name));*/ - HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(op_name)); + HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(op_name)); name.ptr = HCL_OBJ_GET_CHAR_SLOT(op_name); name.len = HCL_OBJ_GET_SIZE(op_name); - if (to_super) + if (to_super) { class_ = (hcl_oop_class_t)class_->superclass; if (!HCL_IS_CLASS(hcl, class_)) return HCL_NULL; @@ -2165,7 +2165,7 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ { hcl_oop_t dic; - + dic = class_->mdic; HCL_ASSERT (hcl, HCL_IS_NIL(hcl, dic) || HCL_IS_DIC(hcl, dic)); @@ -2181,10 +2181,10 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ { /* TODO: futher check if it's a method block? */ *owner = class_; - /* ivaroff isn't useful for a clas smethod but is useful for class instatiation method + /* ivaroff isn't useful for a clas smethod but is useful for class instatiation method * (INSTA bit on in the mask field) */ - *ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super); - return (hcl_oop_block_t)HCL_CONS_CAR(val); /* car - class method, cdr - instance method */ + *ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super); + return (hcl_oop_lambda_t)HCL_CONS_CAR(val); /* car - class method, cdr - instance method */ } } } @@ -2195,18 +2195,18 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ return HCL_NULL; } -static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner) +static hcl_oop_lambda_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner) { hcl_oocs_t name; HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_)); /*HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op_name));*/ - HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(op_name)); + HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(op_name)); name.ptr = HCL_OBJ_GET_CHAR_SLOT(op_name); name.len = HCL_OBJ_GET_SIZE(op_name); - if (to_super) + if (to_super) { class_ = (hcl_oop_class_t)class_->superclass; if (!HCL_IS_CLASS(hcl, class_)) return HCL_NULL; @@ -2232,7 +2232,7 @@ static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ /* TODO: futher check if it's a method block? */ *owner = class_; *ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super); - return (hcl_oop_block_t)HCL_CONS_CDR(val); /* car - class method, cdr - instance method */ + return (hcl_oop_lambda_t)HCL_CONS_CDR(val); /* car - class method, cdr - instance method */ } } } @@ -2245,7 +2245,7 @@ static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, int to_super, hcl_ooi_t nargs, hcl_ooi_t nrvars) { - hcl_oop_block_t mth_blk; + hcl_oop_lambda_t mth_blk; hcl_oop_context_t newctx; hcl_oop_class_t class_, owner; hcl_ooi_t ivaroff; @@ -2338,8 +2338,8 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip) HCL_EXSTACK_POP_TO (hcl, catch_ctx, catch_ip, clsp, sp); /* discard unfinished class definitions for the exception thrown. - * - * (try + * + * (try * (defclass X * (throw "exception") * catch (x) @@ -2347,7 +2347,7 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip) * ) * 'throw' is triggered before the end of defintion of X is reached. */ - HCL_CLSTACK_CHOP (hcl, clsp); + HCL_CLSTACK_CHOP (hcl, clsp); /* the below code is similar to do_return_from_block() */ hcl->ip = -1; /* mark context dead. saved into hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT */ @@ -2427,7 +2427,7 @@ static char* find_exec (hcl_t* hcl, const char *name) if (!(path = getenv("PATH"))) path = _PATH_DEFPATH; ln = strlen(name); - do + do { /* Find the end of this path element. */ for (p = path; *path != 0 && *path != ':'; path++) ; @@ -2436,7 +2436,7 @@ static char* find_exec (hcl_t* hcl, const char *name) * It's a SHELL path -- double, leading and trailing colons * mean the current directory. */ - if (p == path) + if (p == path) { p = "."; lp = 1; @@ -2460,7 +2460,7 @@ static char* find_exec (hcl_t* hcl, const char *name) if (is_regular_executable_file_by_me(bp)) return strdup(bp); - } + } while (*path++ == ':'); /* Otherwise, *path was NUL */ @@ -2492,7 +2492,7 @@ static HCL_INLINE int exec_syscmd (hcl_t* hcl, hcl_ooi_t nargs) if (hcl_find_bchar_in_bcstr(cmd, '/')) { - if (!is_regular_executable_file_by_me(cmd)) + if (!is_regular_executable_file_by_me(cmd)) { hcl_seterrbfmt (hcl, HCL_ECALL, "cannot execute %O", rcv); goto oops; @@ -2618,7 +2618,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip, /* [NOTE] * the sender field of the initial context is nil. - * especially, the fact that the sender field is nil is used by + * especially, the fact that the sender field is nil is used by * the main execution loop for breaking out of the loop */ HCL_ASSERT (hcl, hcl->active_context == HCL_NULL); @@ -2635,11 +2635,11 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip, hcl->active_context = ctx; hcl_pushvolat (hcl, (hcl_oop_t*)&ctx); - proc = start_initial_process(hcl, ctx); + proc = start_initial_process(hcl, ctx); hcl_popvolat (hcl); if (HCL_UNLIKELY(!proc)) return -1; - /* the stack must contain nothing as it should emulate the expresssion - (the-initial-function). + /* the stack must contain nothing as it should emulate the expresssion - (the-initial-function). * for a normal function call, the function object and arguments are pushed by the caller. * __activate_function() creates a new context and pops the function object and arguments off the stack. * at this point, it should be as if the pop-off has been completed. @@ -2689,15 +2689,15 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) * wake_process() below. */ delete_from_sem_heap (hcl, 0); /* hcl->sem_heap_count is decremented in delete_from_sem_heap() */ - /* if no process is waiting on the semaphore, + /* if no process is waiting on the semaphore, * signal_semaphore() returns hcl->_nil. */ if (hcl->processor->active == hcl->nil_process && (hcl_oop_t)proc != hcl->_nil) { - /* this is the only runnable process. + /* this is the only runnable process. * switch the process to the running state. * it uses wake_process() instead of - * switch_to_process() as there is no running + * switch_to_process() as there is no running * process at this moment */ #if defined(HCL_DEBUG_VM_PROCESSOR) && (HCL_DEBUG_VM_PROCESSOR >= 2) @@ -2724,11 +2724,11 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) /* no running process but io semaphore being waited on */ vm_muxwait (hcl, &ft); - /* exit early if a process has been woken up. + /* exit early if a process has been woken up. * the break in the else part further down will get hit * eventually even if the following line doesn't exist. * having the following line causes to skip firing the - * timed semaphore that would expire between now and the + * timed semaphore that would expire between now and the * moment the next inspection occurs. */ if (hcl->processor->active != hcl->nil_process) goto switch_to_next; } @@ -2750,7 +2750,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) } vm_gettime (hcl, &now); } - else + else { /* there is a running process. go on */ break; @@ -2759,7 +2759,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) while (hcl->sem_heap_count > 0 && !hcl->abort_req); } - if (hcl->sem_io_wait_count > 0) + if (hcl->sem_io_wait_count > 0) { if (hcl->processor->active == hcl->nil_process) { @@ -2774,7 +2774,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) if (hcl->processor->suspended.count == HCL_SMOOI_TO_OOP(0)) { - /* no suspended process. the program is buggy or is probably being terminated forcibly. + /* no suspended process. the program is buggy or is probably being terminated forcibly. * the default signal handler may lead to this situation. */ hcl->abort_req = 1; } @@ -2796,14 +2796,14 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) /* [NOTE] the check with the multiplexer may happen too frequently * because this is called everytime process switching is requested. - * the actual callback implementation should try to avoid invoking + * the actual callback implementation should try to avoid invoking * actual system calls too frequently for less overhead. */ vm_muxwait (hcl, HCL_NULL); } } #if defined(ENABLE_GCFIN) - if ((hcl_oop_t)hcl->sem_gcfin != hcl->_nil) + if ((hcl_oop_t)hcl->sem_gcfin != hcl->_nil) { hcl_oop_process_t proc; @@ -2824,8 +2824,8 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) } else { - /* the gcfin semaphore signalling is not requested and there are - * no runnable processes nor no waiting semaphores. if there is + /* the gcfin semaphore signalling is not requested and there are + * no runnable processes nor no waiting semaphores. if there is * process waiting on the gcfin semaphore, i will just schedule * it to run by calling signal_semaphore() on hcl->sem_gcfin. */ @@ -2835,14 +2835,14 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) /* there is no active process. in most cases, the only process left * should be the gc finalizer process started in the System>>startup. * if there are other suspended processes at this point, the processes - * are not likely to run again. - * - * imagine the following single line program that creates a process + * are not likely to run again. + * + * imagine the following single line program that creates a process * but never start it. * * method(#class) main { | p | p := [] newProcess. } * - * the gc finalizer process and the process assigned to p exist. + * the gc finalizer process and the process assigned to p exist. * when the code reaches here, the 'p' process still is alive * despite no active process nor no process waiting on timers * and semaphores. so when the entire program terminates, there @@ -2850,14 +2850,14 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) * to schedule. */ - HCL_LOG4 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, + HCL_LOG4 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Signaled GCFIN semaphore without gcfin signal request - total %zd runnable/running %zd suspended %zd - sem_io_wait_count %zu\n", HCL_OOP_TO_SMOOI(hcl->processor->total_count), HCL_OOP_TO_SMOOI(hcl->processor->runnable.count), HCL_OOP_TO_SMOOI(hcl->processor->suspended.count), hcl->sem_io_wait_count); proc = signal_semaphore(hcl, hcl->sem_gcfin); - if ((hcl_oop_t)proc != hcl->_nil) + if ((hcl_oop_t)proc != hcl->_nil) { HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE)); HCL_ASSERT (hcl, proc == hcl->processor->runnable.first); @@ -2887,7 +2887,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) }*/ #endif - if (hcl->processor->active == hcl->nil_process) + if (hcl->processor->active == hcl->nil_process) { /* no more waiting semaphore and no more process */ HCL_ASSERT (hcl, hcl->processor->runnable.count = HCL_SMOOI_TO_OOP(0)); @@ -2897,7 +2897,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl) { /* there exist suspended processes while no processes are runnable. * most likely, the running program contains process/semaphore related bugs */ - HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_WARN, + HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - %zd suspended process(es) found in process switcher - check your program\n", HCL_OOP_TO_SMOOI(hcl->processor->suspended.count)); } @@ -2910,7 +2910,7 @@ switch_to_next: if (hcl->switch_proc) { #endif - if (!hcl->proc_switched) + if (!hcl->proc_switched) { switch_to_next_runnable_process (hcl); hcl->proc_switched = 0; @@ -2932,7 +2932,7 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl) if ((hcl_oop_t)hcl->active_context->home == hcl->_nil) { /* the active context to return from is an initial context of - * the active process. let's terminate the process. + * the active process. let's terminate the process. * the initial context has been forged over the initial function * in start_initial_process_and_context() */ HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil); @@ -3014,7 +3014,7 @@ static HCL_INLINE int do_return_from_block (hcl_t* hcl) return -1; } - /* it is a normal block return as the active block context + /* it is a normal block return as the active block context * is not the initial context of a process */ hcl->ip = -1; /* mark context dead. saved into hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT */ SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender); @@ -3029,7 +3029,7 @@ static HCL_INLINE int do_return_from_home (hcl_t* hcl, hcl_oop_t return_value, h if ((hcl_oop_t)hcl->active_context->home == hcl->_nil) { /* returning from the intial context. - * (return-from-home 999) + * (return-from-home 999) * the return-from-home is executed in the initial context */ HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil); hcl->active_context->ip = HCL_SMOOI_TO_OOP(-1); /* mark the active context dead */ @@ -3048,7 +3048,7 @@ static HCL_INLINE int do_return_from_home (hcl_t* hcl, hcl_oop_t return_value, h /*else if (hcl->active_context->home == hcl->processor->active->initial_context) // read the interactive mode note below...*/ else if ((hcl_oop_t)hcl->active_context->home->home == hcl->_nil) { - /* non-local return out of the initial context + /* non-local return out of the initial context * (defun y(x) (return-from-home (* x x))) * (y 999) */ @@ -3127,7 +3127,7 @@ static HCL_INLINE int do_return_from_home (hcl_t* hcl, hcl_oop_t return_value, h if ((hcl_oop_t)hcl->active_context->home == hcl->_nil) { /* non-local return from the intial context. - * (return-from-home 999) + * (return-from-home 999) */ /* the current active context must be the initial context of the active process */ @@ -3146,7 +3146,7 @@ static HCL_INLINE int do_return_from_home (hcl_t* hcl, hcl_oop_t return_value, h HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - stack not empty on return-from-home - SP %zd\n", hcl->sp); /* TODO: include line number and file name */ } - /* as the process is terminated here, the nonempty stack or not invalidating the + /* as the process is terminated here, the nonempty stack or not invalidating the * intermediates contexts deson't really matter. */ terminate_process (hcl, hcl->processor->active); } @@ -3186,10 +3186,10 @@ static HCL_INLINE int do_return_from_home (hcl_t* hcl, hcl_oop_t return_value, h if (HCL_UNLIKELY((hcl_oop_t)sender == hcl->_nil)) { - /* non-local return out of the initial context - * (defun y(x) (return-from-home (* x x))) + /* non-local return out of the initial context + * (defun y(x) (return-from-home (* x x))) * (y 999) - * when y is activated, y's home context is itself. but the + * when y is activated, y's home context is itself. but the * * [NOTE] * in the interactive mode, a new initial context/function/process is created @@ -3259,8 +3259,8 @@ static int execute (hcl_t* hcl) { if (hcl->ip < 0) { - /* do_return_from_home() implements a simple check against a dead context. - * but the check is far from perfect. there are many ways to return from an + /* do_return_from_home() implements a simple check against a dead context. + * but the check is far from perfect. there are many ways to return from an * active context and enter a dead context thereafter. (defun t(f) (set q (lambda() @@ -3317,7 +3317,7 @@ static int execute (hcl_t* hcl) x2 = HCL_STACK_GETTOP(hcl); HCL_STACK_POP (hcl); x1 = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl); x3 = hcl_addnums(hcl, x1, x2); - if (HCL_UNLIKELY(!x3)) + if (HCL_UNLIKELY(!x3)) { if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; goto oops_with_errmsg_supplement; @@ -3389,14 +3389,14 @@ static int execute (hcl_t* hcl) break; /* ------------------------------------------------- */ - #if 0 + #if 0 // the compiler never emits these instructions. reuse these instructions for other purposes case HCL_CODE_PUSH_TEMPVAR_X: case HCL_CODE_STORE_INTO_TEMPVAR_X: case HCL_CODE_POP_INTO_TEMPVAR_X: FETCH_PARAM_CODE_TO (hcl, b1); goto handle_tempvar; - + case HCL_CODE_PUSH_TEMPVAR_0: case HCL_CODE_PUSH_TEMPVAR_1: case HCL_CODE_PUSH_TEMPVAR_2: @@ -3428,8 +3428,8 @@ static int execute (hcl_t* hcl) b1 = bcode & 0x7; /* low 3 bits */ handle_tempvar: - /* when CTXTEMPVAR instructions are used, the above - * instructions are used only for temporary access + /* when CTXTEMPVAR instructions are used, the above + * instructions are used only for temporary access * outside a block. i can assume that the temporary * variable index is pointing to one of temporaries * in the relevant method context */ @@ -3658,9 +3658,9 @@ static int execute (hcl_t* hcl) attr_mask = HCL_OOP_TO_SMOOI(ctx->attr_mask); fixed_nargs = GET_BLK_MASK_NARGS(attr_mask); - req_nrets = HCL_OOP_TO_SMOOI(ctx->req_nrets); + req_nrets = HCL_OOP_TO_SMOOI(ctx->req_nrets); - if (req_nrets <= 0) + if (req_nrets <= 0) { /* if a function with return variables is called in the single-return value call style, * req_nrets becomes 0. but this instruction has to push one value in such a case */ @@ -3688,7 +3688,7 @@ static int execute (hcl_t* hcl) LOG_INST_2 (hcl, "call %zu %zu", b1, b2); rcv = HCL_STACK_GETOP(hcl, b1); - if (HCL_IS_BLOCK(hcl, rcv)) + if (HCL_IS_LAMBDA(hcl, rcv)) { if (activate_block(hcl, b1, b2) <= -1) goto call2_failed; break; @@ -3717,7 +3717,7 @@ static int execute (hcl_t* hcl) handle_call: LOG_INST_1 (hcl, "call %zu", b1); - /* TODO: check if the rcv is the dummy receiver + /* TODO: check if the rcv is the dummy receiver rcv = HCL_STACK_GETRCV(hcl, b1); * */ op = HCL_STACK_GETOP(hcl, b1); @@ -3729,12 +3729,12 @@ static int execute (hcl_t* hcl) if (activate_function(hcl, b1) <= -1) goto call_failed; break; - case HCL_BRAND_BLOCK: + case HCL_BRAND_LAMBDA: if (activate_block(hcl, b1, 0) <= -1) goto call_failed; break; case HCL_BRAND_PRIM: - if (call_primitive(hcl, b1) <= -1) + if (call_primitive(hcl, b1) <= -1) { /* TODO: translate a certain primitive failure to a catchable exception. this seems to work . i need to capture the throw value instead of hcl->_nil . @@ -3828,14 +3828,14 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) } else cvars_str = hcl->_nil; - if (b2 > 0) + if (b2 > 0) { HCL_STACK_POP_TO (hcl, ivars_str); HCL_ASSERT (hcl, HCL_IS_STRING(hcl, ivars_str)); } else ivars_str = hcl->_nil; - if (b1 > 0) + if (b1 > 0) { HCL_STACK_POP_TO (hcl, sc); /* TODO: support more than 1 later when the compiler supports more */ if (!HCL_IS_CLASS(hcl, sc)) @@ -3847,11 +3847,11 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) } else sc = hcl->_nil; - t = hcl_makeclass(hcl, sc, b2, b3, ivars_str, cvars_str); // TOOD: pass variable information... + t = hcl_makeclass(hcl, sc, b2, b3, ivars_str, cvars_str); // TOOD: pass variable information... if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; /* push the class created to the class stack. but don't push to the normal operation stack */ - HCL_CLSTACK_PUSH (hcl, t); + HCL_CLSTACK_PUSH (hcl, t); break; } @@ -3955,7 +3955,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) for (i = 0; i < b1; i++) { ctx = (hcl_oop_context_t)ctx->home; - /* the initial context has nil in the home field. + /* the initial context has nil in the home field. * the loop must not reach beyond the initial context */ HCL_ASSERT (hcl, (hcl_oop_t)ctx != hcl->_nil); } @@ -4088,7 +4088,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) } else if (HCL_IS_CLASS(hcl, rcv) || HCL_IS_INSTANCE(hcl, rcv)) { - if (send_message(hcl, rcv, op, ((bcode >> 2) & 1) /* to_super */, b1 /* nargs */, b2 /* nrvars */) <= -1) + if (send_message(hcl, rcv, op, ((bcode >> 2) & 1) /* to_super */, b1 /* nargs */, b2 /* nrvars */) <= -1) { const hcl_ooch_t* msg = hcl_backuperrmsg(hcl); hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - %js", op, rcv, msg); /* TODO: change to HCL_ESEND?? */ @@ -4155,7 +4155,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) HCL_STACK_POP (hcl); break; } - + /* -------------------------------------------------------- */ @@ -4502,7 +4502,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) if (t3 == hcl->_nil) { ((hcl_oop_oop_t)t2)->slot[1] = t1; - } + } else { ((hcl_oop_oop_t)t3)->slot[1] = t1; @@ -4536,7 +4536,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) break; case HCL_CODE_RETURN_STACKTOP: -/* [NOTE] this implements the non-local return. the non-local return is not compatible with stack based try-catch implementation. +/* [NOTE] this implements the non-local return. the non-local return is not compatible with stack based try-catch implementation. * [TODO] can make it compatiable? */ LOG_INST_0 (hcl, "return_stacktop"); return_value = HCL_STACK_GETTOP(hcl); @@ -4577,7 +4577,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) FETCH_PARAM_CODE_TO (hcl, b4); b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2; - LOG_INST_7 (hcl, "make_function %zu %zu %zu %zu %zu %zu %zu", + LOG_INST_7 (hcl, "make_function %zu %zu %zu %zu %zu %zu %zu", GET_BLK_MASK_INSTA(b1), GET_BLK_MASK_VA(b1), GET_BLK_MASK_NARGS(b1), @@ -4611,16 +4611,16 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) break; } - case HCL_CODE_MAKE_BLOCK: + case HCL_CODE_MAKE_LAMBDA: { - hcl_oop_block_t blkobj; + hcl_oop_lambda_t blkobj; /* b1 - block temporaries mask * b2 - block temporaries mask */ FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b2); b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2; - LOG_INST_5 (hcl, "make_block %zu %zu %zu %zu %zu", + LOG_INST_5 (hcl, "make_lambda %zu %zu %zu %zu %zu", GET_BLK_MASK_INSTA(b1), GET_BLK_MASK_VA(b1), GET_BLK_MASK_NARGS(b1), @@ -4629,11 +4629,11 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) HCL_ASSERT (hcl, b1 >= 0); - blkobj = make_block(hcl); + blkobj = make_lambda(hcl); if (HCL_UNLIKELY(!blkobj)) goto oops; - /* the long forward jump instruction has the format of - * 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK + /* the long forward jump instruction has the format of + * 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK * depending on HCL_CODE_LONG_PARAM_SIZE. change 'ip' to point to * the instruction after the jump. */ fill_block_data (hcl, blkobj, b1, hcl->ip + HCL_CODE_LONG_PARAM_SIZE + 1, hcl->active_context); @@ -4700,7 +4700,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl) { HCL_ASSERT (hcl, hcl->code.bc.ptr[hcl->code.bc.len - 1] == HCL_CODE_POP_STACKTOP); #if 1 - /* append RETURN_FROM_BLOCK + /* append RETURN_FROM_BLOCK if (hcl_emitbyteinstruction(hcl, HCL_CODE_RETURN_FROM_BLOCK) <= -1) return -1;*/ /* substitute RETURN_FROM_BLOCK for POP_STACKTOP) */ hcl->code.bc.ptr[hcl->code.bc.len - 1] = HCL_CODE_RETURN_FROM_BLOCK; @@ -4729,7 +4729,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl) if (hcl->proc_map_capa > 0 && hcl->proc_map_used == 0) { /* rechain the process map. it must be compatible with prepare_to_alloc_pid(). - * by placing the low indiced slot at the beginning of the free list, + * by placing the low indiced slot at the beginning of the free list, * the special processes (main_proc, gcfin_proc, ossig_proc) are allocated * with low process IDs. */ hcl_ooi_t i, j; @@ -4745,7 +4745,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl) #endif n = start_initial_process_and_context(hcl, 0, hcl->code.ngtmprs); /* set up the initial context over the initial function */ - if (n >= 0) + if (n >= 0) { hcl->last_retv = hcl->_nil; n = execute(hcl); @@ -4790,13 +4790,13 @@ hcl_pfrc_t hcl_pf_process_current (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { - hcl_oop_block_t blk; + hcl_oop_lambda_t blk; hcl_oop_context_t newctx; hcl_oop_process_t newprc; int x; - blk = (hcl_oop_block_t)HCL_STACK_GETARG(hcl, nargs, 0); - if (!HCL_IS_BLOCK(hcl, blk)) + blk = (hcl_oop_lambda_t)HCL_STACK_GETARG(hcl, nargs, 0); + if (!HCL_IS_LAMBDA(hcl, blk)) { hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not block - %O", blk); return HCL_PF_FAILURE; @@ -4936,7 +4936,7 @@ hcl_pfrc_t hcl_pf_semaphore_signal (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) if (nargs <= 1) { - /* signal_semaphore() may change the active process though the + /* signal_semaphore() may change the active process though the * implementation as of this writing makes runnable the process waiting * on the signal to be processed. it is safer to set the return value * before calling signal_sempahore() */ @@ -5001,11 +5001,11 @@ hcl_pfrc_t hcl_pf_semaphore_signal (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) * that can fit into a SmallInteger, even after some additions. */ vm_gettime (hcl, &now); HCL_ADD_NTIME_SNS (&ft, &now, HCL_OOP_TO_SMOOI(sec), HCL_OOP_TO_SMOOI(nsec)); - if (ft.sec < 0 || ft.sec > HCL_SMOOI_MAX) + if (ft.sec < 0 || ft.sec > HCL_SMOOI_MAX) { /* soft error - cannot represent the expiry time in a small integer. */ - HCL_LOG2 (hcl, HCL_LOG_PRIMITIVE | HCL_LOG_ERROR, - "Error - time (%ld) out of range(0 - %zd) when adding a timed semaphore\n", + HCL_LOG2 (hcl, HCL_LOG_PRIMITIVE | HCL_LOG_ERROR, + "Error - time (%ld) out of range(0 - %zd) when adding a timed semaphore\n", (unsigned long int)ft.sec, (hcl_ooi_t)HCL_SMOOI_MAX); hcl_seterrnum (hcl, HCL_ERANGE); @@ -5063,7 +5063,7 @@ static hcl_pfrc_t __semaphore_signal_on_io (hcl_t* hcl, hcl_ooi_t nargs, hcl_sem return HCL_PF_FAILURE; } - if (add_sem_to_sem_io_tuple(hcl, sem, HCL_OOP_TO_SMOOI(fd), io_type) <= -1) + if (add_sem_to_sem_io_tuple(hcl, sem, HCL_OOP_TO_SMOOI(fd), io_type) <= -1) { const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl); hcl_seterrbfmt (hcl, hcl->errnum, "unable to add the handle %zd to the multiplexer for %hs - %js", HCL_OOP_TO_SMOOI(fd), io_type_str[io_type], oldmsg); @@ -5090,7 +5090,7 @@ hcl_pfrc_t hcl_pf_semaphore_signal_on_gcfin (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi hcl_oop_semaphore_t sem; sem = (hcl_oop_semaphore_t)HCL_STACK_GETRCV(hcl, nargs); - HCL_PF_CHECK_RCV (hcl, hcl_iskindof(hcl, (hcl_oop_t)sem, hcl->_semaphore)); + HCL_PF_CHECK_RCV (hcl, hcl_iskindof(hcl, (hcl_oop_t)sem, hcl->_semaphore)); /* TODO: should i prevent overwriting? */ hcl->sem_gcfin = sem; @@ -5116,7 +5116,7 @@ hcl_pfrc_t hcl_pf_semaphore_wait (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) hcl_seterrbfmt (hcl, HCL_EPERM, "not allowed to wait on a semaphore that belongs to a semaphore group"); return HCL_PF_FAILURE; } - + /* i must set the return value before calling await_semaphore(). * await_semaphore() may switch the active process and the stack * manipulation macros target at the active process. i'm not supposed @@ -5183,7 +5183,7 @@ TODO: add this back if gcfin support is added for (wp = sem->waiting.first; (hcl_oop_t)wp != hcl->_nil; wp = wp->sem_wait.next) { HCL_ASSERT (hcl, hcl->sem_io_wait_count > 0); - hcl->sem_io_wait_count--; + hcl->sem_io_wait_count--; } } HCL_ASSERT (hcl, sem->subtype == hcl->_nil); @@ -5246,7 +5246,7 @@ hcl_pfrc_t hcl_pf_semaphore_group_add_semaphore (hcl_t* hcl, hcl_mod_t* mod, hcl if (sem->subtype == HCL_SMOOI_TO_OOP(HCL_SEMAPHORE_SUBTYPE_IO)) { /* the semaphore being added is associated with I/O operation. */ - HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(sem->u.io.index) && + HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(sem->u.io.index) && HCL_OOP_TO_SMOOI(sem->u.io.index) >= 0 && HCL_OOP_TO_SMOOI(sem->u.io.index) < hcl->sem_io_tuple_count); @@ -5259,7 +5259,7 @@ hcl_pfrc_t hcl_pf_semaphore_group_add_semaphore (hcl_t* hcl, hcl_mod_t* mod, hcl { /* the first IO semaphore is being added to the semaphore group. * but there are already processes waiting on the semaphore group. - * + * * for instance, * [Process 1] * sg := SemaphoreGroup new. @@ -5292,7 +5292,7 @@ hcl_pfrc_t hcl_pf_semaphore_group_add_semaphore (hcl_t* hcl, hcl_mod_t* mod, hcl hcl_seterrbfmt (hcl, HCL_EPERM, "not allowed to relocate a semaphore to a different group"); return HCL_PF_FAILURE; } - + return HCL_PF_SUCCESS; } @@ -5326,14 +5326,14 @@ hcl_pfrc_t hcl_pf_semaphore_group_remove_semaphore (hcl_t* hcl, hcl_mod_t* mod, /* there is a process waiting on this semaphore group. * i don't allow a semaphore to be removed from the group. * i want to dodge potential problems arising when removal is allowed. - * + * * for instance, consider this psuedo code. * sg addSemaphore: s * [ sg wait ] fork. * [ sg wait ] fork. * [ sg wait ] fork. * sg removeSemaphore: s. - * + * */ hcl_seterrbfmt (hcl, HCL_EPERM, "not allowed to remove a semaphore from a group being waited on"); return HCL_PF_FAILURE; @@ -5345,7 +5345,7 @@ hcl_pfrc_t hcl_pf_semaphore_group_remove_semaphore (hcl_t* hcl, hcl_mod_t* mod, sem->grm.prev = (hcl_oop_semaphore_t)hcl->_nil; sem->grm.next = (hcl_oop_semaphore_t)hcl->_nil; sem->group = (hcl_oop_semaphore_group_t)hcl->_nil; - + count = HCL_OOP_TO_SMOOI(sg->sem_count); HCL_ASSERT (hcl, count > 0); count--; @@ -5400,9 +5400,9 @@ hcl_pfrc_t hcl_pf_semaphore_group_wait (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t na /* i must set the return value before calling await_semaphore_group(). * HCL_STACK_SETRETTORCV() manipulates the stack of the currently active * process(hcl->processor->active). hcl->processor->active may become - * hcl->nil_process if the current active process must get suspended. + * hcl->nil_process if the current active process must get suspended. * it is safer to set the return value of the calling method here. - * but the arguments and the receiver information will be lost from + * but the arguments and the receiver information will be lost from * the stack from this moment on. */ HCL_STACK_SETRET (hcl, nargs, (hcl_oop_t)sg); diff --git a/lib/fmt-imp.h b/lib/fmt-imp.h index d7f23b5..20156e2 100644 --- a/lib/fmt-imp.h +++ b/lib/fmt-imp.h @@ -25,7 +25,7 @@ */ static int fmt_uintmax ( - char_t* buf, int size, + char_t* buf, int size, hcl_uintmax_t value, int base_and_flags, int prec, char_t fillchar, char_t signchar, const char_t* prefix) { @@ -41,10 +41,10 @@ static int fmt_uintmax ( "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ": "0123456789abcdefghijklmnopqrstuvwxyz"; - if ((base_and_flags & HCL_FMT_INTMAX_NOZERO) && value == 0) + if ((base_and_flags & HCL_FMT_INTMAX_NOZERO) && value == 0) { - p = tmp; - if (base_and_flags & HCL_FMT_INTMAX_ZEROLEAD) + p = tmp; + if (base_and_flags & HCL_FMT_INTMAX_ZEROLEAD) { /* NOZERO emits no digit, ZEROLEAD emits 1 digit. * so it emits '0' */ @@ -63,7 +63,7 @@ static int fmt_uintmax ( hcl_uintmax_t v = value; /* store the resulting numeric string into 'tmp' first */ - p = tmp; + p = tmp; do { *p++ = xbasestr[v % base]; @@ -73,11 +73,11 @@ static int fmt_uintmax ( /* reslen is the length of the resulting string without padding. */ reslen = (int)(p - tmp); - + /* precision specified the minum number of digits to produce. - * so if the precision is larger that the digits produced, + * so if the precision is larger that the digits produced, * reslen should be adjusted to precision */ - if (prec > reslen) + if (prec > reslen) { /* if the precision is greater than the actual digits * made from the value, 0 is inserted in front. @@ -86,12 +86,12 @@ static int fmt_uintmax ( preczero = prec - reslen; reslen = prec; } - else + else { preczero = 0; - if ((base_and_flags & HCL_FMT_INTMAX_ZEROLEAD) && value != 0) + if ((base_and_flags & HCL_FMT_INTMAX_ZEROLEAD) && value != 0) { - /* if value is zero, 0 is emitted from it. + /* if value is zero, 0 is emitted from it. * so ZEROLEAD don't need to add another 0. */ preczero++; reslen++; @@ -137,10 +137,10 @@ static int fmt_uintmax ( if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; /* add 0s for precision */ - while (preczero > 0 && bp < be) - { + while (preczero > 0 && bp < be) + { *bp++ = '0'; - preczero--; + preczero--; } /* copy the numeric string to the destination buffer */ @@ -169,10 +169,10 @@ static int fmt_uintmax ( if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; /* add 0s for precision */ - while (preczero > 0 && bp < be) - { + while (preczero > 0 && bp < be) + { *bp++ = '0'; - preczero--; + preczero--; } /* copy the numeric string to the destination buffer */ @@ -194,10 +194,10 @@ static int fmt_uintmax ( if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; /* add 0s for precision */ - while (preczero > 0 && bp < be) - { + while (preczero > 0 && bp < be) + { *bp++ = '0'; - preczero--; + preczero--; } /* copy the numeric string to the destination buffer */ @@ -213,10 +213,10 @@ static int fmt_uintmax ( if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; /* add 0s for precision */ - while (preczero > 0 && bp < be) - { + while (preczero > 0 && bp < be) + { *bp++ = '0'; - preczero--; + preczero--; } /* copy the numeric string to the destination buffer */ diff --git a/lib/fmt.c b/lib/fmt.c index 8937dc3..670bae8 100644 --- a/lib/fmt.c +++ b/lib/fmt.c @@ -2886,9 +2886,9 @@ static int fmt_put_bchars_to_uch_buf (hcl_fmtout_t* fmtout, const hcl_bch_t* ptr ucslen = b->capa - b->len; n = hcl_conv_bchars_to_uchars_with_cmgr(ptr, &bcslen, &b->ptr[b->len], &ucslen, b->hcl->_cmgr, 1); b->len += ucslen; - if (n <= -1) + if (n <= -1) { - if (n == -2) + if (n == -2) { return 0; /* buffer full. stop */ } diff --git a/lib/gc.c b/lib/gc.c index a7e996b..c66139c 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -31,7 +31,7 @@ #include /* getrusage */ #endif -static struct +static struct { hcl_oow_t len; hcl_ooch_t ptr[20]; @@ -97,7 +97,7 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil) } HCL_ASSERT (hcl, hcl->symtab->bucket->slot[index] != _nil); - + for (i = 0, x = index, y = index; i < bucket_size; i++) { y = (y + 1) % bucket_size; @@ -105,7 +105,7 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil) /* done if the slot at the current hash index is _nil */ if (hcl->symtab->bucket->slot[y] == _nil) break; - /* get the natural hash index for the data in the slot + /* get the natural hash index for the data in the slot * at the current hash index */ symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[y]; @@ -139,7 +139,7 @@ hcl_oow_t hcl_getobjpayloadbytes (hcl_t* hcl, hcl_oop_t oop) { hcl_oow_t nbytes; - /* only an OOP object can have the trailer. + /* only an OOP object can have the trailer. * * | _flags | * | _size | <-- if it's 3 @@ -149,7 +149,7 @@ hcl_oow_t hcl_getobjpayloadbytes (hcl_t* hcl, hcl_oop_t oop) * | X | * | Y | <-- it may exist if EXTRA is set in _flags. * | Z | <-- if TRAILER is set, it is the number of bytes in the trailer - * | | | | | + * | | | | | */ HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP); HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t)); @@ -194,8 +194,8 @@ static HCL_INLINE void gc_ms_mark (hcl_t* hcl, hcl_oop_t oop) * determine that it is an instance of process? */ if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) { - /* the stack in a process object doesn't need to be - * scanned in full. the slots above the stack pointer + /* the stack in a process object doesn't need to be + * scanned in full. the slots above the stack pointer * are garbages. */ size = HCL_PROCESS_NAMED_INSTVARS + HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1; HCL_ASSERT (hcl, size <= HCL_OBJ_GET_SIZE(oop)); @@ -246,9 +246,9 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl) if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS) { hcl_oop_process_t proc; - - /* the stack in a process object doesn't need to be - * scanned in full. the slots above the stack pointer + + /* the stack in a process object doesn't need to be + * scanned in full. the slots above the stack pointer * are garbages. */ proc = (hcl_oop_process_t)oop; @@ -292,7 +292,7 @@ static HCL_INLINE void gc_ms_mark_roots (hcl_t* hcl) hcl_oow_t gcfin_count; #endif hcl_cb_t* cb; - + #if defined(HCL_PROFILE_VM) struct rusage ru; hcl_ntime_t rut; @@ -327,7 +327,7 @@ static HCL_INLINE void gc_ms_mark_roots (hcl_t* hcl) for (i = 0; i < hcl->code.lit.len; i++) { - /* the literal array ia a NGC object. but the literal objects + /* the literal array ia a NGC object. but the literal objects * pointed by the elements of this array must be gabage-collected. */ gc_ms_mark (hcl, ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]); } @@ -552,7 +552,7 @@ hcl_oop_t hcl_moveoop (hcl_t* hcl, hcl_oop_t oop) #if 0 void hcl_gc (hcl_t* hcl) { - /* + /* * move a referenced object to the new heap. * inspect the fields of the moved object in the new heap. * move objects pointed to by the fields to the new heap. @@ -575,11 +575,11 @@ void hcl_gc (hcl_t* hcl) hcl->active_context->ip = HCL_SMOOI_TO_OOP(hcl->ip); } - HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO, + HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO, "Starting GC curheap base %p ptr %p newheap base %p ptr %p\n", - hcl->curheap->base, hcl->curheap->ptr, hcl->newheap->base, hcl->newheap->ptr); + hcl->curheap->base, hcl->curheap->ptr, hcl->newheap->base, hcl->newheap->ptr); - /* TODO: allocate common objects like _nil and the root dictionary + /* TODO: allocate common objects like _nil and the root dictionary * in the permanant heap. minimize moving around */ old_nil = hcl->_nil; @@ -603,7 +603,7 @@ void hcl_gc (hcl_t* hcl) for (i = 0; i < hcl->code.lit.len; i++) { - /* the literal array ia a NGC object. but the literal objects + /* the literal array ia a NGC object. but the literal objects * pointed by the elements of this array must be gabage-collected. */ ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i] = hcl_moveoop(hcl, ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]); @@ -665,7 +665,7 @@ void hcl_gc (hcl_t* hcl) /* traverse the symbol table for unreferenced symbols. * if the symbol has not moved to the new heap, the symbol - * is not referenced by any other objects than the symbol + * is not referenced by any other objects than the symbol * table itself */ compact_symbol_table (hcl, old_nil); @@ -673,7 +673,7 @@ void hcl_gc (hcl_t* hcl) hcl->symtab = (hcl_oop_dic_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->symtab); /* scan the new heap again from the end position of - * the previous scan to move referenced objects by + * the previous scan to move referenced objects by * the symbol table. */ ptr = scan_new_heap (hcl, ptr); @@ -696,7 +696,7 @@ void hcl_gc (hcl_t* hcl) buc = (hcl_oop_oop_t) hcl->symtab->bucket; for (index = 0; index < HCL_OBJ_GET_SIZE(buc); index++) { - if ((hcl_oop_t)buc->slot[index] != hcl->_nil) + if ((hcl_oop_t)buc->slot[index] != hcl->_nil) { HCL_LOG1 (hcl, HCL_LOG_GC | HCL_LOG_DEBUG, "\t%O\n", buc->slot[index]); } @@ -708,9 +708,9 @@ void hcl_gc (hcl_t* hcl) if (hcl->active_function) hcl->active_code = HCL_FUNCTION_GET_CODE_BYTE(hcl->active_function); /* update hcl->active_code */ /* TODO: include some gc statstics like number of live objects, gc performance, etc */ - HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO, + HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO, "Finished GC curheap base %p ptr %p newheap base %p ptr %p\n", - hcl->curheap->base, hcl->curheap->ptr, hcl->newheap->base, hcl->newheap->ptr); + hcl->curheap->base, hcl->curheap->ptr, hcl->newheap->base, hcl->newheap->ptr); } #endif @@ -774,13 +774,13 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (HCL_UNLIKELY(!hcl->_undef)) return -1; } - if (!hcl->_nil) + if (!hcl->_nil) { hcl->_nil = hcl_makenil(hcl); if (HCL_UNLIKELY(!hcl->_nil)) return -1; } - if (!hcl->_true) + if (!hcl->_true) { hcl->_true = hcl_maketrue(hcl); if (HCL_UNLIKELY(!hcl->_true)) return -1; @@ -792,7 +792,7 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) } - if (!hcl->symtab) + if (!hcl->symtab) { hcl->symtab = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_symtab_size); if (HCL_UNLIKELY(!hcl->symtab)) return -1; @@ -859,7 +859,7 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (!hcl->code.dbgi) { hcl->code.dbgi = (hcl_dbgi_t*)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.dbgi) * HCL_BC_BUFFER_INIT); - if (HCL_UNLIKELY(!hcl->code.dbgi)) + if (HCL_UNLIKELY(!hcl->code.dbgi)) { /* bc.ptr and dbgi go together. so free bc.ptr if dbgi allocation fails */ hcl_freemem (hcl, hcl->code.bc.ptr); @@ -888,7 +888,7 @@ int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name) hcl_oow_t i; for (i = 0; i < HCL_COUNTOF(syminfo); i++) { - if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, name->ptr, name->len) == 0) + if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, name->ptr, name->len) == 0) return syminfo[i].syncode; } return 0; /* 0 indicates no syntax code found */ @@ -899,7 +899,7 @@ int hcl_getsyncode_noseterr (hcl_t* hcl, const hcl_ooch_t* ptr, const hcl_oow_t hcl_oow_t i; for (i = 0; i < HCL_COUNTOF(syminfo); i++) { - if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, ptr, len) == 0) + if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, ptr, len) == 0) return syminfo[i].syncode; } return 0; /* 0 indicates no syntax code found */ diff --git a/lib/hcl-c.c b/lib/hcl-c.c index e536fc9..6a9bf38 100644 --- a/lib/hcl-c.c +++ b/lib/hcl-c.c @@ -119,9 +119,9 @@ struct hcl_client_t int in_data_part; int negated; hcl_oow_t max; /* chunk length */ - hcl_oow_t tally; + hcl_oow_t tally; hcl_oow_t total; - hcl_oow_t clcount; + hcl_oow_t clcount; } chunked_data; } u; } rep; @@ -199,7 +199,7 @@ static int add_to_reply_token (hcl_client_t* client, hcl_ooch_t ch) static HCL_INLINE int is_token (hcl_client_t* client, const hcl_bch_t* str) { return hcl_comp_oochars_bcstr(client->rep.tok.ptr, client->rep.tok.len, str) == 0; -} +} static HCL_INLINE int is_token_integer (hcl_client_t* client, hcl_oow_t* value) { @@ -216,7 +216,7 @@ static HCL_INLINE int is_token_integer (hcl_client_t* client, hcl_oow_t* value) *value = v; return 1; -} +} static HCL_INLINE hcl_ooch_t unescape (hcl_ooch_t c) { @@ -256,7 +256,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) if (add_to_reply_token(client, c) <= -1) goto oops; break; } - else if (is_spacechar(c)) + else if (is_spacechar(c)) { /* skip whitespaces at the beginning of the start line before the reply name */ break; @@ -322,7 +322,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) client->rep.u.reply_value_quoted.escaped = 0; break; } - else + else { /* the first value character has been encountered */ client->state = HCL_CLIENT_STATE_IN_REPLY_VALUE_UNQUOTED; @@ -355,7 +355,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) hcl_client_seterrbfmt (client, HCL_EFINIS, "sudden end of reply line without closing quote"); goto oops; } - else + else { if (client->rep.u.reply_value_quoted.escaped) { @@ -386,7 +386,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) else if (c == '\n') { reply_value_end: - /* short-form format. the data pointer is passed to the start_reply + /* short-form format. the data pointer is passed to the start_reply * callback. no end_reply callback is invoked. the data is assumed * to be in UTF-8 encoding. this is different from the data in the * long-format reply which is treated as octet stream */ @@ -458,7 +458,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) if (client->rep.tok.len > client->rep.last_attr_key.capa) { hcl_ooch_t* tmp; - + tmp = (hcl_ooch_t*)hcl_client_reallocmem(client, client->rep.last_attr_key.ptr, client->rep.tok.capa * HCL_SIZEOF(*tmp)); if (!tmp) goto oops; @@ -497,7 +497,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) client->rep.u.attr_value_quoted.escaped = 0; break; } - else + else { /* the first value character has been encountered */ client->state = HCL_CLIENT_STATE_IN_ATTR_VALUE_UNQUOTED; @@ -530,7 +530,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) hcl_client_seterrbfmt (client, HCL_EFINIS, "sudden end of attribute value without closing quote"); goto oops; } - else + else { if (client->rep.u.attr_value_quoted.escaped) { @@ -589,7 +589,7 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) client->state = HCL_CLIENT_STATE_IN_LENGTH_BOUNDED_DATA; /* [NOTE] the max length for the length-bounded transfer scheme is limited * by the system word size as of this implementation */ - client->rep.u.length_bounded_data.max = length; + client->rep.u.length_bounded_data.max = length; client->rep.u.length_bounded_data.tally = 0; } else @@ -630,8 +630,8 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes) } return 0; - -oops: + +oops: return -1; } @@ -707,7 +707,7 @@ static int feed_reply_data (hcl_client_t* client, const hcl_bch_t* data, hcl_oow { client->rep.u.chunked_data.negated = 1; } - else if (bc == ':') + else if (bc == ':') { if (client->rep.u.chunked_data.clcount == 0) { @@ -733,7 +733,7 @@ static int feed_reply_data (hcl_client_t* client, const hcl_bch_t* data, hcl_oow } break; } - else if (is_digitchar(bc)) + else if (is_digitchar(bc)) { client->rep.u.chunked_data.max = client->rep.u.chunked_data.max * 10 + (bc - '0'); client->rep.u.chunked_data.clcount++; @@ -803,14 +803,14 @@ hcl_client_t* hcl_client_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, hcl_client_p client_hcl_xtn_t* xtn; client = (hcl_client_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*client) + xtnsize); - if (!client) + if (!client) { if (errnum) *errnum = HCL_ESYSMEM; return HCL_NULL; } hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum); - if (!hcl) + if (!hcl) { HCL_MMGR_FREE (mmgr, client); return HCL_NULL; @@ -832,7 +832,7 @@ hcl_client_t* hcl_client_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, hcl_client_p client->cfg.logmask = ~(hcl_bitmask_t)0; /* the dummy hcl is used for this client to perform primitive operations - * such as getting system time or logging. so the heap size doesn't + * such as getting system time or logging. so the heap size doesn't * need to be changed from the tiny value set above. */ hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, &client->cfg.logmask); hcl_setcmgr (client->dummy_hcl, client->_cmgr); @@ -858,11 +858,11 @@ int hcl_client_setoption (hcl_client_t* client, hcl_client_option_t id, const vo case HCL_CLIENT_LOG_MASK: client->cfg.logmask = *(const hcl_bitmask_t*)value; - if (client->dummy_hcl) + if (client->dummy_hcl) { /* setting this affects the dummy hcl immediately. - * existing hcl instances inside worker threads won't get - * affected. new hcl instances to be created later + * existing hcl instances inside worker threads won't get + * affected. new hcl instances to be created later * is supposed to use the new value */ hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, value); } diff --git a/lib/hcl-dos.h b/lib/hcl-dos.h index d5162c2..75a1f2a 100644 --- a/lib/hcl-dos.h +++ b/lib/hcl-dos.h @@ -81,7 +81,7 @@ # define HCL_SIZEOF_MBSTATE_T HCL_SIZEOF_LONG # define HCL_MBLEN_MAX 8 -#elif defined(__TURBOC__) +#elif defined(__TURBOC__) /* TODO: be more version specific wchar_t may be available in newer BCC */ # define HCL_SIZEOF_CHAR 1 # define HCL_SIZEOF_SHORT 2 @@ -92,7 +92,7 @@ # define HCL_SIZEOF_VOID_P 4 # define HCL_SIZEOF_FLOAT 4 # define HCL_SIZEOF_DOUBLE 8 -# define HCL_SIZEOF_LONG_DOUBLE 10 +# define HCL_SIZEOF_LONG_DOUBLE 10 # define HCL_SIZEOF_WCHAR_T 0 # define HCL_SIZEOF___INT8 0 diff --git a/lib/hcl-json.h b/lib/hcl-json.h index 2c1a924..2d55bc7 100644 --- a/lib/hcl-json.h +++ b/lib/hcl-json.h @@ -29,7 +29,7 @@ #include -/** +/** * The hcl_json_t type defines a simple json parser. */ typedef struct hcl_json_t hcl_json_t; diff --git a/lib/hcl-mac.h b/lib/hcl-mac.h index d7c7197..a7b0562 100644 --- a/lib/hcl-mac.h +++ b/lib/hcl-mac.h @@ -26,7 +26,7 @@ /* This file is for class Mac OS */ /* Mac OS on PPC and m68k uses the big endian mode */ -#define HCL_ENDIAN_BIG +#define HCL_ENDIAN_BIG #if defined(__MWERKS__) # define HCL_SIZEOF_CHAR 1 diff --git a/lib/hcl-msw.h b/lib/hcl-msw.h index 7612dd0..9cecfd8 100644 --- a/lib/hcl-msw.h +++ b/lib/hcl-msw.h @@ -25,23 +25,23 @@ */ /* -Macro Meaning -_WIN64 A 64-bit platform. -_WIN32 A 32-bit platform. This value is also defined by the 64-bit - compiler for backward compatibility. -_WIN16 A 16-bit platform +Macro Meaning +_WIN64 A 64-bit platform. +_WIN32 A 32-bit platform. This value is also defined by the 64-bit + compiler for backward compatibility. +_WIN16 A 16-bit platform The following macros are specific to the architecture. -Macro Meaning -_M_IA64 Intel Itanium Processor Family -_M_IX86 x86 platform -_M_X64 x64 platform +Macro Meaning +_M_IA64 Intel Itanium Processor Family +_M_IX86 x86 platform +_M_X64 x64 platform */ -/* windows for most of non-x86 platforms dropped. +/* windows for most of non-x86 platforms dropped. * make it selective to support old non-x86 windows platforms. */ -#define HCL_ENDIAN_LITTLE +#define HCL_ENDIAN_LITTLE #if defined(__WATCOMC__) # define HCL_SIZEOF_CHAR 1 diff --git a/lib/hcl-opt.h b/lib/hcl-opt.h index 2e92695..f6842f9 100644 --- a/lib/hcl-opt.h +++ b/lib/hcl-opt.h @@ -30,8 +30,8 @@ #include "hcl-cmn.h" /** \file - * This file defines functions and data structures to process - * command-line arguments. + * This file defines functions and data structures to process + * command-line arguments. */ typedef struct hcl_uopt_t hcl_uopt_t; @@ -54,7 +54,7 @@ struct hcl_uopt_t hcl_uch_t* arg; /* argument associated with an option */ /* output */ - const hcl_uch_t* lngopt; + const hcl_uch_t* lngopt; /* input + output */ int ind; /* index into parent argv vector */ @@ -83,7 +83,7 @@ struct hcl_bopt_t hcl_bch_t* arg; /* argument associated with an option */ /* output */ - const hcl_bch_t* lngopt; + const hcl_bch_t* lngopt; /* input + output */ int ind; /* index into parent argv vector */ @@ -98,27 +98,27 @@ extern "C" { /** * The hcl_getopt() function processes the \a argc command-line arguments - * pointed to by \a argv as configured in \a opt. It can process two - * different option styles: a single character starting with '-', and a - * long name starting with '--'. + * pointed to by \a argv as configured in \a opt. It can process two + * different option styles: a single character starting with '-', and a + * long name starting with '--'. * * A character in \a opt.str is treated as a single character option. Should * it require a parameter, specify ':' after it. * - * Two special returning option characters indicate special error conditions. + * Two special returning option characters indicate special error conditions. * - \b ? indicates a bad option stored in the \a opt->opt field. * - \b : indicates a bad parameter for an option stored in the \a opt->opt field. * * @return an option character on success, HCL_CHAR_EOF on no more options. */ HCL_EXPORT hcl_uci_t hcl_getuopt ( - int argc, /* argument count */ + int argc, /* argument count */ hcl_uch_t* const* argv, /* argument array */ hcl_uopt_t* opt /* option configuration */ ); HCL_EXPORT hcl_bci_t hcl_getbopt ( - int argc, /* argument count */ + int argc, /* argument count */ hcl_bch_t* const* argv, /* argument array */ hcl_bopt_t* opt /* option configuration */ ); diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 775df1c..1ad7e68 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -641,6 +641,9 @@ struct hcl_frd_t struct hcl_compiler_t { + /* flags passed in via hcl_compile() */ + int flags; + /* callback pointer registerd upon compiler creation */ hcl_cb_t* cbp; @@ -758,13 +761,13 @@ struct hcl_compiler_t -/* hcl_context_t, hcl_block_t, hcl_function_t stores the local variable information +/* hcl_context_t, hcl_lambda_t, hcl_function_t stores the local variable information * * Use up to 29 bits in a 32-bit hcl_ooi_t. Exclude the tag bit and the sign bit. * | SIGN | INSTA | VA | NARGS | NRVARS | NLVARS | TAG | * 1 1 8 8 11 2 <= 32 * ----------------------------------------------------------- - * Parameters to the MAKE_BLOCK or MAKE_FUNCTION instructions + * Parameters to the MAKE_LAMBDA or MAKE_FUNCTION instructions * | INSTA | VA | NARGS | NRVARS | NLVARS * 1 1 4 4 6 <= 16 (HCL_CODE_LONG_PARAM_SIZE 1, two params) * 1 1 8 8 11 <= 32 (HCL_CODE_LONG_PARAM_SIZE 2, two params, use 29 bits to avoid collection when converted to a smooi) @@ -1158,7 +1161,7 @@ enum hcl_bcode_t HCL_CODE_RETURN_FROM_BLOCK = 0xFC, /* 252, return the stack top from a block */ HCL_CODE_MAKE_FUNCTION = 0xFD, /* 253 */ - HCL_CODE_MAKE_BLOCK = 0xFE, /* 254 */ + HCL_CODE_MAKE_LAMBDA = 0xFE, /* 254 */ HCL_CODE_NOOP = 0xFF /* 255 */ }; diff --git a/lib/hcl-rbt.h b/lib/hcl-rbt.h index 51f32a5..0619589 100644 --- a/lib/hcl-rbt.h +++ b/lib/hcl-rbt.h @@ -31,37 +31,37 @@ /** \file * This file provides a red-black tree encapsulated in the #hcl_rbt_t type that - * implements a self-balancing binary search tree.Its interface is very close + * implements a self-balancing binary search tree.Its interface is very close * to #hcl_htb_t. * * This sample code adds a series of keys and values and print them * in descending key order. * \code * #include - * + * * static hcl_rbt_walk_t walk (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, void* ctx) * { * hcl_printf (HCL_T("key = %d, value = %d\n"), * *(int*)HCL_RBT_KPTR(pair), *(int*)HCL_RBT_VPTR(pair)); * return HCL_RBT_WALK_FORWARD; * } - * + * * int main () * { * hcl_rbt_t* s1; * int i; - * + * * s1 = hcl_rbt_open(HCL_MMGR_GETDFL(), 0, 1, 1); // error handling skipped * hcl_rbt_setstyle(s1, hcl_get_rbt_style(HCL_RBT_STYLE_INLINE_COPIERS)); - * + * * for (i = 0; i < 20; i++) * { * int x = i * 20; * hcl_rbt_insert (s1, &i, HCL_SIZEOF(i), &x, HCL_SIZEOF(x)); // eror handling skipped * } - * + * * hcl_rbt_rwalk (s1, walk, HCL_NULL); - * + * * hcl_rbt_close (s1); * return 0; * } @@ -71,7 +71,7 @@ typedef struct hcl_rbt_t hcl_rbt_t; typedef struct hcl_rbt_pair_t hcl_rbt_pair_t; -/** +/** * The hcl_rbt_walk_t type defines values that the callback function can * return to control hcl_rbt_walk() and hcl_rbt_rwalk(). */ @@ -98,7 +98,7 @@ typedef enum hcl_rbt_id_t hcl_rbt_id_t; */ typedef void* (*hcl_rbt_copier_t) ( hcl_rbt_t* rbt /**< red-black tree */, - void* dptr /**< pointer to a key or a value */, + void* dptr /**< pointer to a key or a value */, hcl_oow_t dlen /**< length of a key or a value */ ); @@ -119,17 +119,17 @@ typedef void (*hcl_rbt_freeer_t) ( * key is greater than the second key, -1 otherwise. */ typedef int (*hcl_rbt_comper_t) ( - const hcl_rbt_t* rbt, /**< red-black tree */ + const hcl_rbt_t* rbt, /**< red-black tree */ const void* kptr1, /**< key pointer */ - hcl_oow_t klen1, /**< key length */ + hcl_oow_t klen1, /**< key length */ const void* kptr2, /**< key pointer */ hcl_oow_t klen2 /**< key length */ ); /** - * The hcl_rbt_keeper_t type defines a value keeper that is called when + * The hcl_rbt_keeper_t type defines a value keeper that is called when * a value is retained in the context that it should be destroyed because - * it is identical to a new value. Two values are identical if their + * it is identical to a new value. Two values are identical if their * pointers and lengths are equal. */ typedef void (*hcl_rbt_keeper_t) ( @@ -149,12 +149,12 @@ typedef hcl_rbt_walk_t (*hcl_rbt_walker_t) ( /** * The hcl_rbt_cbserter_t type defines a callback function for hcl_rbt_cbsert(). - * The hcl_rbt_cbserter() function calls it to allocate a new pair for the + * The hcl_rbt_cbserter() function calls it to allocate a new pair for the * key pointed to by \a kptr of the length \a klen and the callback context * \a ctx. The second parameter \a pair is passed the pointer to the existing * pair for the key or #HCL_NULL in case of no existing key. The callback * must return a pointer to a new or a reallocated pair. When reallocating the - * existing pair, this callback must destroy the existing pair and return the + * existing pair, this callback must destroy the existing pair and return the * newly reallocated pair. It must return #HCL_NULL for failure. */ typedef hcl_rbt_pair_t* (*hcl_rbt_cbserter_t) ( @@ -174,10 +174,10 @@ enum hcl_rbt_pair_color_t typedef enum hcl_rbt_pair_color_t hcl_rbt_pair_color_t; /** - * The hcl_rbt_pair_t type defines red-black tree pair. A pair is composed - * of a key and a value. It maintains pointers to the beginning of a key and - * a value plus their length. The length is scaled down with the scale factor - * specified in an owning tree. Use macros defined in the + * The hcl_rbt_pair_t type defines red-black tree pair. A pair is composed + * of a key and a value. It maintains pointers to the beginning of a key and + * a value plus their length. The length is scaled down with the scale factor + * specified in an owning tree. Use macros defined in the */ struct hcl_rbt_pair_t { @@ -202,8 +202,8 @@ struct hcl_rbt_pair_t typedef struct hcl_rbt_style_t hcl_rbt_style_t; /** - * The hcl_rbt_style_t type defines callback function sets for key/value - * pair manipulation. + * The hcl_rbt_style_t type defines callback function sets for key/value + * pair manipulation. */ struct hcl_rbt_style_t { @@ -337,10 +337,10 @@ HCL_EXPORT const hcl_rbt_style_t* hcl_rbt_getstyle ( ); /** - * The hcl_rbt_setstyle() function sets internal manipulation callback + * The hcl_rbt_setstyle() function sets internal manipulation callback * functions for data construction, destruction, comparison, etc. * The callback structure pointed to by \a style must outlive the tree - * pointed to by \a htb as the tree doesn't copy the contents of the + * pointed to by \a htb as the tree doesn't copy the contents of the * structure. */ HCL_EXPORT void hcl_rbt_setstyle ( @@ -356,10 +356,10 @@ HCL_EXPORT hcl_oow_t hcl_rbt_getsize ( ); /** - * The hcl_rbt_search() function searches red-black tree to find a pair with a + * The hcl_rbt_search() function searches red-black tree to find a pair with a * matching key. It returns the pointer to the pair found. If it fails * to find one, it returns HCL_NULL. - * \return pointer to the pair with a maching key, + * \return pointer to the pair with a maching key, * or HCL_NULL if no match is found. */ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_search ( @@ -369,12 +369,12 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_search ( ); /** - * The hcl_rbt_upsert() function searches red-black tree for the pair with a + * The hcl_rbt_upsert() function searches red-black tree for the pair with a * matching key. If one is found, it updates the pair. Otherwise, it inserts - * a new pair with the key and the value given. It returns the pointer to the + * a new pair with the key and the value given. It returns the pointer to the * pair updated or inserted. - * \return a pointer to the updated or inserted pair on success, - * HCL_NULL on failure. + * \return a pointer to the updated or inserted pair on success, + * HCL_NULL on failure. */ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_upsert ( hcl_rbt_t* rbt, /**< red-black tree */ @@ -386,9 +386,9 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_upsert ( /** * The hcl_rbt_ensert() function inserts a new pair with the key and the value - * given. If there exists a pair with the key given, the function returns + * given. If there exists a pair with the key given, the function returns * the pair containing the key. - * \return pointer to a pair on success, HCL_NULL on failure. + * \return pointer to a pair on success, HCL_NULL on failure. */ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_ensert ( hcl_rbt_t* rbt, /**< red-black tree */ @@ -400,9 +400,9 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_ensert ( /** * The hcl_rbt_insert() function inserts a new pair with the key and the value - * given. If there exists a pair with the key given, the function returns + * given. If there exists a pair with the key given, the function returns * HCL_NULL without channging the value. - * \return pointer to the pair created on success, HCL_NULL on failure. + * \return pointer to the pair created on success, HCL_NULL on failure. */ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_insert ( hcl_rbt_t* rbt, /**< red-black tree */ @@ -426,7 +426,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update ( ); /** - * The hcl_rbt_cbsert() function inserts a key/value pair by delegating pair + * The hcl_rbt_cbsert() function inserts a key/value pair by delegating pair * allocation to a callback function. Depending on the callback function, * it may behave like hcl_rbt_insert(), hcl_rbt_upsert(), hcl_rbt_update(), * hcl_rbt_ensert(), or totally differently. The sample code below inserts @@ -441,7 +441,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update ( * (int)HCL_RBT_VLEN(pair), HCL_RBT_VPTR(pair), (int)HCL_RBT_VLEN(pair)); * return HCL_RBT_WALK_FORWARD; * } - * + * * hcl_rbt_pair_t* cbserter ( * hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, * void* kptr, hcl_oow_t klen, void* ctx) @@ -449,53 +449,53 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update ( * hcl_cstr_t* v = (hcl_cstr_t*)ctx; * if (pair == HCL_NULL) * { - * // no existing key for the key + * // no existing key for the key * return hcl_rbt_allocpair (rbt, kptr, klen, v->ptr, v->len); * } * else * { - * // a pair with the key exists. - * // in this sample, i will append the new value to the old value + * // a pair with the key exists. + * // in this sample, i will append the new value to the old value * // separated by a comma * hcl_rbt_pair_t* new_pair; * hcl_ooch_t comma = HCL_T(','); * hcl_oob_t* vptr; - * - * // allocate a new pair, but without filling the actual value. - * // note vptr is given HCL_NULL for that purpose + * + * // allocate a new pair, but without filling the actual value. + * // note vptr is given HCL_NULL for that purpose * new_pair = hcl_rbt_allocpair ( - * rbt, kptr, klen, HCL_NULL, pair->vlen + 1 + v->len); + * rbt, kptr, klen, HCL_NULL, pair->vlen + 1 + v->len); * if (new_pair == HCL_NULL) return HCL_NULL; - * - * // fill in the value space + * + * // fill in the value space * vptr = new_pair->vptr; * hcl_memcpy (vptr, pair->vptr, pair->vlen*HCL_SIZEOF(hcl_ooch_t)); * vptr += pair->vlen*HCL_SIZEOF(hcl_ooch_t); * hcl_memcpy (vptr, &comma, HCL_SIZEOF(hcl_ooch_t)); * vptr += HCL_SIZEOF(hcl_ooch_t); * hcl_memcpy (vptr, v->ptr, v->len*HCL_SIZEOF(hcl_ooch_t)); - * - * // this callback requires the old pair to be destroyed + * + * // this callback requires the old pair to be destroyed * hcl_rbt_freepair (rbt, pair); - * - * // return the new pair + * + * // return the new pair * return new_pair; * } * } - * + * * int main () * { * hcl_rbt_t* s1; * int i; * hcl_ooch_t* keys[] = { HCL_T("one"), HCL_T("two"), HCL_T("three") }; * hcl_ooch_t* vals[] = { HCL_T("1"), HCL_T("2"), HCL_T("3"), HCL_T("4"), HCL_T("5") }; - * + * * s1 = hcl_rbt_open ( * HCL_MMGR_GETDFL(), 0, * HCL_SIZEOF(hcl_ooch_t), HCL_SIZEOF(hcl_ooch_t) - * ); // note error check is skipped + * ); // note error check is skipped * hcl_rbt_setstyle (s1, &style1); - * + * * for (i = 0; i < HCL_COUNTOF(vals); i++) * { * hcl_cstr_t ctx; @@ -506,7 +506,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update ( * ); // note error check is skipped * } * hcl_rbt_walk (s1, print_map_pair, HCL_NULL); - * + * * hcl_rbt_close (s1); * return 0; * } @@ -521,7 +521,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_cbsert ( ); /** - * The hcl_rbt_delete() function deletes a pair with a matching key + * The hcl_rbt_delete() function deletes a pair with a matching key * \return 0 on success, -1 on failure */ HCL_EXPORT int hcl_rbt_delete ( @@ -538,7 +538,7 @@ HCL_EXPORT void hcl_rbt_clear ( ); /** - * The hcl_rbt_walk() function traverses a red-black tree in preorder + * The hcl_rbt_walk() function traverses a red-black tree in preorder * from the leftmost child. */ HCL_EXPORT void hcl_rbt_walk ( @@ -548,7 +548,7 @@ HCL_EXPORT void hcl_rbt_walk ( ); /** - * The hcl_rbt_walk() function traverses a red-black tree in preorder + * The hcl_rbt_walk() function traverses a red-black tree in preorder * from the rightmost child. */ HCL_EXPORT void hcl_rbt_rwalk ( @@ -558,11 +558,11 @@ HCL_EXPORT void hcl_rbt_rwalk ( ); /** - * The hcl_rbt_allocpair() function allocates a pair for a key and a value + * The hcl_rbt_allocpair() function allocates a pair for a key and a value * given. But it does not chain the pair allocated into the red-black tree \a rbt. - * Use this function at your own risk. + * Use this function at your own risk. * - * Take note of he following special behavior when the copier is + * Take note of he following special behavior when the copier is * #HCL_RBT_COPIER_INLINE. * - If \a kptr is #HCL_NULL, the key space of the size \a klen is reserved but * not propagated with any data. @@ -571,7 +571,7 @@ HCL_EXPORT void hcl_rbt_rwalk ( */ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_allocpair ( hcl_rbt_t* rbt, - void* kptr, + void* kptr, hcl_oow_t klen, void* vptr, hcl_oow_t vlen @@ -595,7 +595,7 @@ HCL_EXPORT int hcl_rbt_dflcomp ( const void* kptr1, hcl_oow_t klen1, const void* kptr2, - hcl_oow_t klen2 + hcl_oow_t klen2 ); #if defined(__cplusplus) diff --git a/lib/hcl-tmr.h b/lib/hcl-tmr.h index 3379412..86c5d56 100644 --- a/lib/hcl-tmr.h +++ b/lib/hcl-tmr.h @@ -35,7 +35,7 @@ typedef hcl_oow_t hcl_tmr_index_t; typedef void (*hcl_tmr_handler_t) ( hcl_tmr_t* tmr, - const hcl_ntime_t* now, + const hcl_ntime_t* now, hcl_tmr_event_t* evt ); @@ -72,7 +72,7 @@ extern "C" { #endif HCL_EXPORT hcl_tmr_t* hcl_tmr_open ( - hcl_t* mmgr, + hcl_t* mmgr, hcl_oow_t xtnsize, hcl_oow_t capa ); @@ -82,7 +82,7 @@ HCL_EXPORT void hcl_tmr_close ( ); HCL_EXPORT int hcl_tmr_init ( - hcl_tmr_t* tmr, + hcl_tmr_t* tmr, hcl_t* mmgr, hcl_oow_t capa ); diff --git a/lib/hcl-xma.h b/lib/hcl-xma.h index 804c8fc..d1e667b 100644 --- a/lib/hcl-xma.h +++ b/lib/hcl-xma.h @@ -52,15 +52,15 @@ * hcl_xma_t* xma; * void* ptr1, * ptr2; * - * // create a new memory allocator obtaining a 100K byte zone + * // create a new memory allocator obtaining a 100K byte zone * // with the default memory allocator - * xma = hcl_xma_open(HCL_NULL, 0, 100000L); + * xma = hcl_xma_open(HCL_NULL, 0, 100000L); * * ptr1 = hcl_xma_alloc(xma, 5000); // allocate a 5K block from the zone * ptr2 = hcl_xma_alloc(xma, 1000); // allocate a 1K block from the zone * ptr1 = hcl_xma_realloc(xma, ptr1, 6000); // resize the 5K block to 6K. * - * hcl_xma_dump (xma, dumper, HCL_NULL); // dump memory blocks + * hcl_xma_dump (xma, dumper, HCL_NULL); // dump memory blocks * * // the following two lines are not actually needed as the allocator * // is closed after them. @@ -102,7 +102,7 @@ struct hcl_xma_t int internal; /** pointer array to free memory blocks */ - hcl_xma_fblk_t* xfree[HCL_XMA_FIXED + HCL_XMA_SIZE_BITS + 1]; + hcl_xma_fblk_t* xfree[HCL_XMA_FIXED + HCL_XMA_SIZE_BITS + 1]; /** pre-computed value for fast xfree index calculation */ hcl_oow_t bdec; @@ -150,7 +150,7 @@ HCL_EXPORT hcl_xma_t* hcl_xma_open ( /** * The hcl_xma_close() function destroys a memory allocator. It also frees - * the memory zone obtained, which invalidates the memory blocks within + * the memory zone obtained, which invalidates the memory blocks within * the zone. Call this function to destroy a memory allocator created with * hcl_xma_open(). */ @@ -186,7 +186,7 @@ HCL_EXPORT int hcl_xma_init ( ); /** - * The hcl_xma_fini() function finalizes a memory allocator. Call this + * The hcl_xma_fini() function finalizes a memory allocator. Call this * function to finalize a memory allocator initialized with hcl_xma_init(). */ HCL_EXPORT void hcl_xma_fini ( diff --git a/lib/hcl.c b/lib/hcl.c index cf4146e..e5641fc 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -136,7 +136,7 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, const hcl_vmprim_t* vmprim) * routine still function despite some side-effects when * reallocation fails */ /* +1 required for consistency with put_oocs and put_ooch in logfmt.c */ - hcl->log.ptr = (hcl_ooch_t*)hcl_allocmem(hcl, (hcl->log.capa + 1) * HCL_SIZEOF(*hcl->log.ptr)); + hcl->log.ptr = (hcl_ooch_t*)hcl_allocmem(hcl, (hcl->log.capa + 1) * HCL_SIZEOF(*hcl->log.ptr)); if (HCL_UNLIKELY(!hcl->log.ptr)) goto oops; hcl->gci.stack.capa = HCL_ALIGN_POW2(1, 1024); /* TODO: is this a good initial size? */ @@ -208,7 +208,7 @@ void hcl_fini (hcl_t* hcl) if (hcl->log.len > 0) { - /* flush pending log message that could be generated by the fini + /* flush pending log message that could be generated by the fini * callbacks. however, the actual logging might not be produced at * this point because one of the callbacks could arrange to stop * logging */ @@ -312,7 +312,7 @@ void hcl_fini (hcl_t* hcl) if (hcl->heap) hcl_killheap (hcl, hcl->heap); - if (hcl->log.ptr) + if (hcl->log.ptr) { hcl_freemem (hcl, hcl->log.ptr); hcl->log.capa = 0; @@ -362,7 +362,7 @@ void hcl_reset (hcl_t* hcl) hcl_oop_t v; hcl_oow_t i; - /* delete all literals shown in the literal frame from the system dictionary + /* delete all literals shown in the literal frame from the system dictionary * excluding special kernel symbols. */ for (i = 0; i < hcl->code.lit.len; i++) { @@ -519,7 +519,7 @@ int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value) hcl->option.dfl_procstk_size = *(hcl_oow_t*)value; break; } - + case HCL_MOD_INCTX: hcl->option.mod_inctx = *(void**)value; break; @@ -529,13 +529,13 @@ int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value) goto einval; } - for (cb = hcl->cblist; cb; cb = cb->next) + for (cb = hcl->cblist; cb; cb = cb->next) { if (cb->opt_set) cb->opt_set (hcl, id, value); } return 0; - + einval: hcl_seterrnum (hcl, HCL_EINVAL); return -1; @@ -608,7 +608,7 @@ hcl_cb_t* hcl_regcb (hcl_t* hcl, hcl_cb_t* tmpl) actual->next = hcl->cblist; actual->prev = HCL_NULL; hcl->cblist = actual; - + /* vm_checkbc is invoked very frequently. * and there might be multiple vm_checkbc callbacks registered. * keeping the count of vm_checkbc callbacks registered @@ -631,7 +631,7 @@ void hcl_deregcb (hcl_t* hcl, hcl_cb_t* cb) if (cb->prev) cb->prev->next = cb->next; } - if (cb->vm_checkbc) + if (cb->vm_checkbc) { HCL_ASSERT (hcl, hcl->vm_checkbc_cb_count > 0); hcl->vm_checkbc_cb_count--; @@ -688,7 +688,7 @@ static struct const hcl_bch_t* modname; int (*modload) (hcl_t* hcl, hcl_mod_t* mod); } -static_modtab[] = +static_modtab[] = { { "arr", hcl_mod_arr }, { "dic", hcl_mod_dic }, @@ -707,17 +707,17 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel int n; #endif - /* maximum module name length is HCL_MOD_NAME_LEN_MAX. + /* maximum module name length is HCL_MOD_NAME_LEN_MAX. * MOD_PREFIX_LEN for MOD_PREFIX * 1 for _ at the end when hcl_mod_xxx_ is attempted. * 1 for the terminating '\0'. */ - hcl_ooch_t buf[MOD_PREFIX_LEN + HCL_MOD_NAME_LEN_MAX + 1 + 1]; + hcl_ooch_t buf[MOD_PREFIX_LEN + HCL_MOD_NAME_LEN_MAX + 1 + 1]; /* copy instead of encoding conversion. MOD_PREFIX must not * include a character that requires encoding conversion. * note the terminating null isn't needed in buf here. */ - hcl_copy_bchars_to_oochars (buf, MOD_PREFIX, MOD_PREFIX_LEN); + hcl_copy_bchars_to_oochars (buf, MOD_PREFIX, MOD_PREFIX_LEN); if (namelen > HCL_COUNTOF(buf) - (MOD_PREFIX_LEN + 1 + 1)) { @@ -735,7 +735,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel /* TODO: binary search ... */ for (n = 0; n < HCL_COUNTOF(static_modtab); n++) { - if (hcl_comp_oochars_bcstr(name, namelen, static_modtab[n].modname) == 0) + if (hcl_comp_oochars_bcstr(name, namelen, static_modtab[n].modname) == 0) { load = static_modtab[n].modload; break; @@ -797,7 +797,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel md.handle = hcl->vmprim.dl_open(hcl, &buf[MOD_PREFIX_LEN], HCL_VMPRIM_DLOPEN_PFMOD); } - if (md.handle == HCL_NULL) + if (md.handle == HCL_NULL) { HCL_DEBUG2 (hcl, "Cannot open a module [%.*js]\n", namelen, name); hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to open a module [%.*js]", namelen, name); @@ -806,7 +806,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel /* attempt to get hcl_mod_xxx where xxx is the module name*/ load = (hcl_mod_load_t)hcl->vmprim.dl_getsym(hcl, md.handle, buf); - if (!load) + if (!load) { hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js]", buf, namelen, name); HCL_DEBUG3 (hcl, "Cannot get a module symbol [%js] in [%.*js]\n", buf, namelen, name); @@ -829,7 +829,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel if (load(hcl, &mdp->mod) <= -1) { const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl); - hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg); + hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg); HCL_DEBUG3 (hcl, "Module function [%js] returned failure in [%.*js]\n", buf, namelen, name); hcl_rbt_delete (&hcl->modtab, name, namelen); hcl->vmprim.dl_close (hcl, mdp->handle); @@ -850,7 +850,7 @@ void hcl_closemod (hcl_t* hcl, hcl_mod_data_t* mdp) { if (mdp->mod.unload) mdp->mod.unload (hcl, &mdp->mod); - if (mdp->handle) + if (mdp->handle) { hcl->vmprim.dl_close (hcl, mdp->handle); HCL_DEBUG2 (hcl, "Closed a module [%js] - %p\n", mdp->mod.name, mdp->handle); @@ -884,7 +884,7 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle sep = hcl_rfind_oochar(pfid, pfidlen, '.'); if (!sep) { - /* i'm writing a conservative code here. the compiler should + /* i'm writing a conservative code here. the compiler should * guarantee that a period is included in an primitive function identifer. * what if the compiler is broken? imagine a buggy compiler rewritten * in hcl itself? */ @@ -912,7 +912,7 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle if (!mdp) return HCL_NULL; } - if ((pfbase = mdp->mod.query(hcl, &mdp->mod, sep + 1, pfidlen - mod_name_len - 1)) == HCL_NULL) + if ((pfbase = mdp->mod.query(hcl, &mdp->mod, sep + 1, pfidlen - mod_name_len - 1)) == HCL_NULL) { /* the primitive function is not found. but keep the module open even if it's opened above */ HCL_DEBUG3 (hcl, "Cannot find a primitive function [%.*js] in a module [%js]\n", pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name); diff --git a/lib/hcl.h b/lib/hcl.h index e9b7a3c..d292df1 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -164,8 +164,11 @@ enum hcl_synerrnum_t HCL_SYNERR_CALLABLE, /* invalid callable */ HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */ HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */ + HCL_SYNERR_SEMICOLON, /* unexpected semicolon */ HCL_SYNERR_EMPTYXLIST, /* empty x-list */ - HCL_SYNERR_EMPTYMLIST /* empty m-list */ + HCL_SYNERR_EMPTYMLIST, /* empty m-list */ + HCL_SYNERR_BLOCK, /* block expression expected */ + HCL_SYNERR_BLOCKBANNED /* block expression disallowed */ }; typedef enum hcl_synerrnum_t hcl_synerrnum_t; @@ -575,8 +578,8 @@ typedef struct hcl_function_t hcl_function_t; typedef struct hcl_function_t* hcl_oop_function_t; #define HCL_BLOCK_NAMED_INSTVARS 3 -typedef struct hcl_block_t hcl_block_t; -typedef struct hcl_block_t* hcl_oop_block_t; +typedef struct hcl_lambda_t hcl_lambda_t; +typedef struct hcl_lambda_t* hcl_oop_lambda_t; #define HCL_CONTEXT_NAMED_INSTVARS 9 typedef struct hcl_context_t hcl_context_t; @@ -600,10 +603,10 @@ struct hcl_function_t }; /* hcl_function_t copies the byte codes and literal frames into itself - * hlc_block_t contains minimal information(ip) for referening byte codes + * hlc_lambda_t contains minimal information(ip) for referening byte codes * and literal frames available in home->origin. */ -struct hcl_block_t +struct hcl_lambda_t { HCL_OBJ_HEADER; @@ -692,10 +695,10 @@ struct hcl_process_t hcl_oop_t id; /* SmallInteger */ hcl_oop_t state; /* SmallInteger */ - hcl_oop_t sp; /* stack pointer. SmallInteger */ + hcl_oop_t sp; /* stack pointer. SmallInteger */ hcl_oop_t st; /* stack top */ - hcl_oop_t exsp; /* exception stack pointer. SmallInteger */ + hcl_oop_t exsp; /* exception stack pointer. SmallInteger */ hcl_oop_t exst; /* exception stack top */ hcl_oop_t clsp; /* class stack pointer */ @@ -1491,7 +1494,10 @@ enum hcl_compile_flag_t HCL_COMPILE_CLEAR_CODE = (1 << 0), /* clear the top-level function block at the end of hcl_compile() */ - HCL_COMPILE_CLEAR_FNBLK = (1 << 1) + HCL_COMPILE_CLEAR_FNBLK = (1 << 1), + + /* enable the block {} mode */ + HCL_COMPILE_ENABLE_BLOCK = (1 << 2) }; typedef enum hcl_compile_flag_t hcl_compile_flag_t; #endif @@ -1868,7 +1874,7 @@ enum hcl_brand_t HCL_BRAND_PRIM, HCL_BRAND_FUNCTION, - HCL_BRAND_BLOCK, + HCL_BRAND_LAMBDA, HCL_BRAND_CONTEXT, HCL_BRAND_PROCESS, HCL_BRAND_PROCESS_SCHEDULER, @@ -1934,7 +1940,7 @@ typedef enum hcl_concode_t hcl_concode_t; #define HCL_IS_SYMBOL_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL_ARRAY) #define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT) #define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION) -#define HCL_IS_BLOCK(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BLOCK) +#define HCL_IS_LAMBDA(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_LAMBDA) #define HCL_IS_CLASS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CLASS) #define HCL_IS_INSTANCE(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_INSTANCE) #define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS) diff --git a/lib/heap.c b/lib/heap.c index b577d64..7d04024 100644 --- a/lib/heap.c +++ b/lib/heap.c @@ -122,7 +122,7 @@ void* hcl_callocheapmem (hcl_t* hcl, hcl_heap_t* heap, hcl_oow_t size) void* ptr; ptr = HCL_MMGR_ALLOC(&heap->xmmgr, size); - if (HCL_UNLIKELY(!ptr)) + if (HCL_UNLIKELY(!ptr)) { HCL_DEBUG2 (hcl, "Cannot callocate %zd bytes from heap - ptr %p\n", size, heap); hcl_seterrnum (hcl, HCL_EOOMEM); diff --git a/lib/json.c b/lib/json.c index 15ad684..3bcc1c9 100644 --- a/lib/json.c +++ b/lib/json.c @@ -52,15 +52,15 @@ struct hcl_json_state_node_t struct { - /* 0: ready to get key (at the beginning or got comma), + /* 0: ready to get key (at the beginning or got comma), * 1: got key, 2: got colon, 3: got value */ - int state; + int state; } id; /* in dictionary */ struct { int escaped; int digit_count; - /* acc is always of unicode type to handle \u and \U. + /* acc is always of unicode type to handle \u and \U. * in the bch mode, it will get converted to a utf8 stream. */ hcl_uch_t acc; } sv; @@ -70,7 +70,7 @@ struct hcl_json_state_node_t int digit_count; /* for a character, no way to support the unicode character * in the bch mode */ - hcl_ooch_t acc; + hcl_ooch_t acc; } cv; struct { @@ -180,7 +180,7 @@ static int add_char_to_token (hcl_json_t* json, hcl_ooch_t ch) static int add_chars_to_token (hcl_json_t* json, const hcl_ooch_t* ptr, hcl_oow_t len) { hcl_oow_t i; - + if (json->tok_capa - json->tok.len > len) { hcl_ooch_t* tmp; @@ -194,7 +194,7 @@ static int add_chars_to_token (hcl_json_t* json, const hcl_ooch_t* ptr, hcl_oow_ json->tok.ptr = tmp; } - for (i = 0; i < len; i++) + for (i = 0; i < len; i++) json->tok.ptr[json->tok.len++] = ptr[i]; json->tok.ptr[json->tok.len] = '\0'; return 0; @@ -226,7 +226,7 @@ static int push_state (hcl_json_t* json, hcl_json_state_t state) ss->state = state; ss->next = json->state_stack; - + json->state_stack = ss; return 0; } @@ -261,7 +261,7 @@ static void pop_all_states (hcl_json_t* json) static int invoke_data_inst (hcl_json_t* json, hcl_json_inst_t inst) { - if (json->state_stack->state == HCL_JSON_STATE_IN_DIC && json->state_stack->u.id.state == 1) + if (json->state_stack->state == HCL_JSON_STATE_IN_DIC && json->state_stack->u.id.state == 1) { if (inst != HCL_JSON_INST_STRING) { @@ -342,7 +342,7 @@ static int handle_string_value_char (hcl_json_t* json, hcl_ooci_t c) } else if (json->state_stack->u.sv.escaped == 1) { - if (c >= '0' && c <= '8') + if (c >= '0' && c <= '8') { json->state_stack->u.sv.escaped = 3; json->state_stack->u.sv.digit_count = 0; @@ -438,7 +438,7 @@ static int handle_character_value_char (hcl_json_t* json, hcl_ooci_t c) } else if (json->state_stack->u.cv.escaped == 1) { - if (c >= '0' && c <= '8') + if (c >= '0' && c <= '8') { json->state_stack->u.cv.escaped = 3; json->state_stack->u.cv.digit_count = 0; @@ -475,7 +475,7 @@ static int handle_character_value_char (hcl_json_t* json, hcl_ooci_t c) else if (c == '\'') { pop_state (json); - + if (json->tok.len < 1) { hcl_json_seterrbfmt (json, HCL_EINVAL, "no character in a character literal"); @@ -488,7 +488,7 @@ static int handle_character_value_char (hcl_json_t* json, hcl_ooci_t c) if (add_char_to_token(json, c) <= -1) return -1; } - if (json->tok.len > 1) + if (json->tok.len > 1) { hcl_json_seterrbfmt (json, HCL_EINVAL, "too many characters in a character literal - %.*js", json->tok.len, json->tok.ptr); return -1; @@ -567,7 +567,7 @@ static int handle_start_char (hcl_json_t* json, hcl_ooci_t c) if (json->prim.instcb(json, HCL_JSON_INST_START_DIC, HCL_NULL) <= -1) return -1; return 1; } - else if (is_spacechar(c)) + else if (is_spacechar(c)) { /* do nothing */ return 1; @@ -796,7 +796,7 @@ start_over: case HCL_JSON_STATE_IN_STRING_VALUE: x = handle_string_value_char(json, c); break; - + case HCL_JSON_STATE_IN_CHARACTER_VALUE: x = handle_character_value_char(json, c); break; @@ -846,7 +846,7 @@ static int feed_json_data (hcl_json_t* json, const hcl_bch_t* data, hcl_oow_t le else if (n > bcslen) { /* incomplete sequence */ - *xlen = ptr - data; + *xlen = ptr - data; return 0; /* feed more for incomplete sequence */ } @@ -879,14 +879,14 @@ hcl_json_t* hcl_json_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, hcl_json_prim_t* json_hcl_xtn_t* xtn; json = (hcl_json_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*json) + xtnsize); - if (!json) + if (!json) { if (errnum) *errnum = HCL_ESYSMEM; return HCL_NULL; } hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum); - if (!hcl) + if (!hcl) { HCL_MMGR_FREE (mmgr, json); return HCL_NULL; @@ -906,7 +906,7 @@ hcl_json_t* hcl_json_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, hcl_json_prim_t* json->cfg.logmask = ~(hcl_bitmask_t)0; /* the dummy hcl is used for this json to perform primitive operations - * such as getting system time or logging. so the heap size doesn't + * such as getting system time or logging. so the heap size doesn't * need to be changed from the tiny value set above. */ hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, &json->cfg.logmask); hcl_setcmgr (json->dummy_hcl, json->cmgr); @@ -937,11 +937,11 @@ int hcl_json_setoption (hcl_json_t* json, hcl_json_option_t id, const void* valu case HCL_JSON_LOG_MASK: json->cfg.logmask = *(const hcl_bitmask_t*)value; - if (json->dummy_hcl) + if (json->dummy_hcl) { /* setting this affects the dummy hcl immediately. - * existing hcl instances inside worker threads won't get - * affected. new hcl instances to be created later + * existing hcl instances inside worker threads won't get + * affected. new hcl instances to be created later * is supposed to use the new value */ hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, value); } diff --git a/lib/number.c b/lib/number.c index 917d118..a05e7e3 100644 --- a/lib/number.c +++ b/lib/number.c @@ -46,7 +46,7 @@ static hcl_ooi_t equalize_scale (hcl_t* hcl, hcl_oop_t* x, hcl_oop_t* y) hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv); return -1; } - + ys = 0; yv = *y; if (HCL_IS_FPDEC(hcl, yv)) @@ -131,7 +131,7 @@ hcl_oop_t hcl_addnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) hcl_pushvolat (hcl, &y); scale = equalize_scale(hcl, &x, &y); - if (scale <= -1) + if (scale <= -1) { hcl_popvolats (hcl, 2); return HCL_NULL; @@ -160,7 +160,7 @@ hcl_oop_t hcl_subnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) hcl_pushvolat (hcl, &y); scale = equalize_scale(hcl, &x, &y); - if (scale <= -1) + if (scale <= -1) { hcl_popvolats (hcl, 2); return HCL_NULL; @@ -191,7 +191,7 @@ static hcl_oop_t mul_nums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int mult) hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv); return HCL_NULL; } - + ys = 0; yv = y; if (HCL_IS_FPDEC(hcl, y)) @@ -208,7 +208,7 @@ static hcl_oop_t mul_nums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, int mult) nv = hcl_mulints(hcl, xv, yv); if (!nv) return HCL_NULL; - cs = xs + ys; + cs = xs + ys; if (cs <= 0) return nv; /* the result must be an integer */ ns = (mult || xs > ys)? xs: ys; @@ -273,7 +273,7 @@ hcl_oop_t hcl_divnums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y) for (i = 0; i < ys; i++) { nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10)); - if (!nv) + if (!nv) { hcl_popvolat (hcl); return HCL_NULL; @@ -303,7 +303,7 @@ static hcl_oop_t comp_nums (hcl_t* hcl, hcl_oop_t x, hcl_oop_t y, hcl_oop_t (*co hcl_pushvolat (hcl, &y); scale = equalize_scale(hcl, &x, &y); - if (scale <= -1) + if (scale <= -1) { hcl_popvolats (hcl, 2); return HCL_NULL; @@ -387,10 +387,10 @@ hcl_oop_t hcl_absnum (hcl_t* hcl, hcl_oop_t x) scale = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)x)->scale); v = ((hcl_oop_fpdec_t)x)->value; - + v = hcl_absint(hcl, v); if (!v) return HCL_NULL; - + return hcl_makefpdec(hcl, v, scale); } } diff --git a/lib/obj.c b/lib/obj.c index 11bdc4e..9bcad26 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -474,7 +474,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, oop = HCL_NULL; break; } - + if (HCL_LIKELY(oop)) { #if 0 diff --git a/lib/opt-impl.h b/lib/opt-impl.h index b4a53dd..d462afa 100644 --- a/lib/opt-impl.h +++ b/lib/opt-impl.h @@ -31,7 +31,7 @@ #include "hcl-opt.h" #include "hcl-utl.h" -/* +/* * hcl_getopt is based on BSD getopt. * -------------------------------------------------------------------------- * @@ -75,18 +75,18 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt) opt->arg = HCL_NULL; opt->lngopt = HCL_NULL; - if (opt->cur == HCL_NULL) + if (opt->cur == HCL_NULL) { opt->cur = XEMSG; opt->ind = 1; } - if (*opt->cur == '\0') + if (*opt->cur == '\0') { /* update scanning pointer */ - if (opt->ind >= argc || *(opt->cur = argv[opt->ind]) != '-') + if (opt->ind >= argc || *(opt->cur = argv[opt->ind]) != '-') { - /* All arguments have been processed or the current + /* All arguments have been processed or the current * argument doesn't start with a dash */ opt->cur = XEMSG; return XCI_EOF; @@ -127,7 +127,7 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt) while (*end != '\0' && *end != '=') end++; - for (o = opt->lng; o->str; o++) + for (o = opt->lng; o->str; o++) { const xch_t* str = o->str; @@ -151,10 +151,10 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt) } else if (opt->arg == HCL_NULL) { - /* check if it has a remaining argument + /* check if it has a remaining argument * available */ - if (argc <= ++opt->ind) return BADARG; - /* If so, the next available argument is + if (argc <= ++opt->ind) return BADARG; + /* If so, the next available argument is * taken to be an option argument */ opt->arg = argv[opt->ind]; } @@ -164,12 +164,12 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt) } /*if (*end == HCL_T('=')) *end = HCL_T('\0');*/ - opt->lngopt = opt->cur; + opt->lngopt = opt->cur; return BADCH; } if ((opt->opt = *opt->cur++) == ':' || - (oli = xfindcharincstr(opt->str, opt->opt)) == HCL_NULL) + (oli = xfindcharincstr(opt->str, opt->opt)) == HCL_NULL) { /* * if the user didn't specify '-' as an option, @@ -180,21 +180,21 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt) return BADCH; } - if (*++oli != ':') + if (*++oli != ':') { /* don't need argument */ if (*opt->cur == '\0') opt->ind++; } - else + else { /* need an argument */ - if (*opt->cur != '\0') + if (*opt->cur != '\0') { /* no white space */ opt->arg = opt->cur; } - else if (argc <= ++opt->ind) + else if (argc <= ++opt->ind) { /* no arg */ opt->cur = XEMSG; diff --git a/lib/prim.c b/lib/prim.c index 97b8a68..9849d80 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -71,7 +71,7 @@ static void log_char_object (hcl_t* hcl, hcl_bitmask_t mask, hcl_oop_char_t msg) start_over: while (rem > 0) { - if (*ptr == '\0') + if (*ptr == '\0') { n = hcl_logbfmt (hcl, mask, "%jc", *ptr); HCL_ASSERT (hcl, n == 1); @@ -82,9 +82,9 @@ start_over: n = hcl_logbfmt (hcl, mask, "%.*js", rem, ptr); if (n <= -1) break; - if (n == 0) + if (n == 0) { - /* to skip the unprinted character. + /* to skip the unprinted character. * actually, this check is not needed because of '\0' skipping * at the beginning of the loop */ n = hcl_logbfmt (hcl, mask, "%jc", *ptr); @@ -103,7 +103,7 @@ static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) hcl_ooi_t k; /*level = HCL_STACK_GET(hcl, hcl->sp - nargs + 1); - if (!HCL_OOP_IS_SMOOI(level)) mask = HCL_LOG_APP | HCL_LOG_INFO; + if (!HCL_OOP_IS_SMOOI(level)) mask = HCL_LOG_APP | HCL_LOG_INFO; else mask = HCL_LOG_APP | HCL_OOP_TO_SMOOI(level);*/ mask = HCL_LOG_APP | HCL_LOG_FATAL; /* TODO: accept logging level .. */ @@ -111,7 +111,7 @@ static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { msg = HCL_STACK_GETARG (hcl, nargs, k); - if (msg == hcl->_nil || msg == hcl->_true || msg == hcl->_false) + if (msg == hcl->_nil || msg == hcl->_true || msg == hcl->_false) { goto dump_object; } @@ -442,7 +442,7 @@ static hcl_pfrc_t pf_and (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { /* do nothing */ } - else if (arg == hcl->_false) + else if (arg == hcl->_false) { rv = hcl->_false; break; @@ -472,7 +472,7 @@ static hcl_pfrc_t pf_or (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) rv = hcl->_true; break; } - else if (arg == hcl->_false) + else if (arg == hcl->_false) { /* do nothing */ } @@ -660,7 +660,7 @@ static hcl_pfrc_t pf_number_sqrt (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_number_abs (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t ret; - ret = hcl_absnum(hcl, HCL_STACK_GETARG(hcl, nargs, 0)); + ret = hcl_absnum(hcl, HCL_STACK_GETARG(hcl, nargs, 0)); if (!ret) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, ret); @@ -786,7 +786,7 @@ static hcl_pfrc_t pf_va_count (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) hcl_oop_context_t ctx; hcl_ooi_t attr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs; - if (nargs >= 1) + if (nargs >= 1) { ctx = (hcl_oop_context_t)HCL_STACK_GETARG(hcl, nargs, 0); if (!HCL_IS_CONTEXT(hcl, ctx)) @@ -806,7 +806,7 @@ static hcl_pfrc_t pf_va_count (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) fixed_nargs = GET_BLK_MASK_NARGS(attr_mask); nrvars = GET_BLK_MASK_NRVARS(attr_mask); nlvars = GET_BLK_MASK_NLVARS(attr_mask); - + /*if (!va) TODO: need this check? { }*/ @@ -822,7 +822,7 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) hcl_ooi_t attr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs; hcl_oow_t index; - if (nargs >= 2) + if (nargs >= 2) { ctx = (hcl_oop_context_t)HCL_STACK_GETARG(hcl, nargs, 1); if (!HCL_IS_CONTEXT(hcl, ctx)) @@ -842,7 +842,7 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) nrvars = GET_BLK_MASK_NRVARS(attr_mask); nlvars = GET_BLK_MASK_NLVARS(attr_mask); - if (hcl_inttooow(hcl, HCL_STACK_GETARG(hcl, nargs, 0), &index) == 0) + if (hcl_inttooow(hcl, HCL_STACK_GETARG(hcl, nargs, 0), &index) == 0) { return HCL_PF_FAILURE; } @@ -895,7 +895,7 @@ static pf_t builtin_prims[] = { 0, 0, pf_gc, 2, { 'g','c' } }, - { 1, 1, pf_not, 3, { 'n','o','t' } }, + { 1, 1, pf_not, 3, { 'n','o','t' } }, /* this is a long-circuit logical and the short-curcuit 'and' is treated as a special form */ { 2, HCL_TYPE_MAX(hcl_oow_t), pf_and, 4, { '_','a','n','d' } }, /* this is a long-cirtuit logical or. the short-circuit 'or' is treated as a special form */ @@ -943,7 +943,7 @@ static pf_t builtin_prims[] = { 2, 2, pf_integer_bxor, 7, { 'b','i','t','-','x','o','r' } }, { 1, 1, pf_integer_bnot, 7, { 'b','i','t','-','n','o','t' } }, { 2, 2, pf_integer_bshift, 9, { 'b','i','t','-','s','h','i','f','t' } }, - + { 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_quo, 3, { 'd','i','v' } }, { 2, HCL_TYPE_MAX(hcl_oow_t), pf_integer_rem, 3, { 'r','e','m' } }, { 1, HCL_TYPE_MAX(hcl_oow_t), pf_integer_mquo, 4, { 'm','d','i','v' } }, @@ -998,9 +998,9 @@ int hcl_addbuiltinprims (hcl_t* hcl) hcl_popvolat (hcl); if (HCL_UNLIKELY(!cons)) return -1; - /* turn on the kernel bit in the symbol associated with a primitive + /* turn on the kernel bit in the symbol associated with a primitive * function. 'set' prevents this symbol from being used as a variable - * name */ + * name */ HCL_OBJ_SET_FLAGS_KERNEL (name, 2); } diff --git a/lib/print.c b/lib/print.c index b86026c..5d8bbe9 100644 --- a/lib/print.c +++ b/lib/print.c @@ -88,7 +88,7 @@ enum WORD_PRIM, WORD_FUNCTION, - WORD_BLOCK, + WORD_LAMBDA, WORD_CONTEXT, WORD_PROCESS, WORD_PROCESS_SCHEDULER, @@ -98,7 +98,7 @@ enum WORD_INSTANCE }; -static struct +static struct { hcl_oow_t len; hcl_ooch_t ptr[20]; @@ -113,7 +113,7 @@ static struct { 7, { '#','<','P','R','I','M','>' } }, { 11, { '#','<','F','U','N','C','T','I','O','N','>' } }, - { 11, { '#','<','B','L','O','C','K','>' } }, + { 9, { '#','<','L','A','M','B','D','A','>' } }, { 10, { '#','<','C','O','N','T','E','X','T','>' } }, { 10, { '#','<','P','R','O','C','E','S','S','>' } }, { 20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } }, @@ -132,9 +132,9 @@ static HCL_INLINE int print_single_char (hcl_fmtout_t* fmtout, hcl_ooch_t ch) if (hcl_bfmt_out(fmtout, "\\%jc", chu) <= -1) return -1; } #if defined(HCL_OOCH_IS_UCH) - else if (chu < ' ') + else if (chu < ' ') #else - else if (chu < ' ' || chu >= 0x80) + else if (chu < ' ' || chu >= 0x80) #endif { hcl_oochu_t escaped; @@ -177,7 +177,7 @@ static HCL_INLINE int print_single_char (hcl_fmtout_t* fmtout, hcl_ooch_t ch) { if (hcl_bfmt_out(fmtout, "\\U%08X", chu) <= -1) return -1; } - else + else #endif { #if (HCL_SIZEOF_OOCH_T >= 2) @@ -221,7 +221,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj) { "(:", "(" }, /*HCL_CONCODE_MLIST */ { "{", "{" }, /*HCL_CONCODE_BLOCK */ { "[", "[" }, /*HCL_CONCODE_ARRAY */ - { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ + { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ { "#{", "{" }, /*HCL_CONCODE_DIC */ { "#(", "[" } /*HCL_CONCODE_QLIST */ }; @@ -237,7 +237,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj) { ")", "]" }, /*HCL_CONCODE_QLIST */ }; - static const hcl_bch_t* breakers[][2] = + static const hcl_bch_t* breakers[][2] = { { " ", "," }, /* item breaker */ { " ", ":" } /* key value breaker */ @@ -246,7 +246,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj) json = !!(fmtout->mask & HCL_LOG_PREFER_JSON); next: - switch ((brand = HCL_BRANDOF(hcl, obj))) + switch ((brand = HCL_BRANDOF(hcl, obj))) { case HCL_BRAND_SMOOI: if (hcl_bfmt_out(fmtout, "%zd", HCL_OOP_TO_SMOOI(obj)) <= -1) return -1; @@ -293,10 +293,10 @@ next: /* -1 to drive hcl_inttostr() to not create a new string object. * not using the object memory. the result stays in the temporary * buffer */ - tmp = hcl_inttostr(hcl, obj, 10 | HCL_INTTOSTR_NONEWOBJ); + tmp = hcl_inttostr(hcl, obj, 10 | HCL_INTTOSTR_NONEWOBJ); if (!tmp) return -1; - HCL_ASSERT (hcl, (hcl_oop_t)tmp == hcl->_nil); + HCL_ASSERT (hcl, (hcl_oop_t)tmp == hcl->_nil); if (hcl_bfmt_out(fmtout, "%.*js", hcl->inttostr.xbuf.len, hcl->inttostr.xbuf.ptr) <= -1) return -1; break; } @@ -319,7 +319,7 @@ next: if (hcl_bfmt_out(fmtout, "0.%0*d", scale, 0) <= -1) return -1; } } - else + else { hcl_oop_t tmp; hcl_oow_t len, adj; @@ -334,13 +334,13 @@ next: { if (scale == len) { - if (hcl_bfmt_out(fmtout, "%.*js0.%.*js", + if (hcl_bfmt_out(fmtout, "%.*js0.%.*js", adj, hcl->inttostr.xbuf.ptr, len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1; } else { - if (hcl_bfmt_out(fmtout, "%.*js0.%0*d%.*js", + if (hcl_bfmt_out(fmtout, "%.*js0.%0*d%.*js", adj, hcl->inttostr.xbuf.ptr, scale - len, 0, len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1; @@ -362,8 +362,8 @@ next: qse_char_t buf[256]; hcl->prm.sprintf ( hcl->prm.ctx, - buf, HCL_COUNTOF(buf), - HCL_T("%Lf"), + buf, HCL_COUNTOF(buf), + HCL_T("%Lf"), #ifdef __MINGW32__ (double)HCL_RVAL(obj) #else @@ -392,7 +392,7 @@ next: for (i = 0; i < HCL_OBJ_GET_SIZE(obj); i++) { ch = ((hcl_oop_char_t)obj)->slot[i]; - if (ch < ' ' || ch == '\"' || ch == '\\') + if (ch < ' ' || ch == '\"' || ch == '\\') { escape = 1; break; @@ -431,7 +431,7 @@ next: { int x; - /* Push what to print next on to the stack + /* Push what to print next on to the stack * the variable p is */ ps.type = PRINT_STACK_CONS; ps.obj = HCL_CONS_CDR(cur); @@ -440,30 +440,30 @@ next: if (x <= -1) return -1; obj = HCL_CONS_CAR(cur); - /* Jump to the 'next' label so that the object - * pointed to by 'obj' is printed. Once it + /* Jump to the 'next' label so that the object + * pointed to by 'obj' is printed. Once it * ends, a jump back to the 'resume' label * is made at the at of this function. */ - goto next; + goto next; resume_cons: HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS); cur = ps.obj; /* Get back the CDR pushed */ concode = ps.idx; /* restore the concode */ - if (HCL_IS_NIL(hcl,cur)) + if (HCL_IS_NIL(hcl,cur)) { /* The CDR part points to a NIL object, which * indicates the end of a list. break the loop */ break; } - if (!HCL_OOP_IS_POINTER(cur) || HCL_OBJ_GET_FLAGS_BRAND(cur) != HCL_BRAND_CONS) + if (!HCL_OOP_IS_POINTER(cur) || HCL_OBJ_GET_FLAGS_BRAND(cur) != HCL_BRAND_CONS) { /* The CDR part does not point to a pair. */ if (hcl_bfmt_out(fmtout, " . ") <= -1) return -1; - /* Push NIL so that the HCL_IS_NIL(hcl,p) test in + /* Push NIL so that the HCL_IS_NIL(hcl,p) test in * the 'if' statement above breaks the loop - * after the jump is maded back to the 'resume' + * after the jump is maded back to the 'resume' * label. */ ps.type = PRINT_STACK_CONS; ps.obj = hcl->_nil; @@ -490,7 +490,7 @@ next: if (hcl_bfmt_out(fmtout, opening_parens[HCL_CONCODE_ARRAY][json]) <= -1) return -1; - if (HCL_OBJ_GET_SIZE(obj) <= 0) + if (HCL_OBJ_GET_SIZE(obj) <= 0) { if (hcl_bfmt_out(fmtout, closing_parens[HCL_CONCODE_ARRAY][json]) <= -1) return -1; break; @@ -504,7 +504,7 @@ next: /* Push what to print next on to the stack */ ps.idx = arridx + 1; - if (ps.idx >= HCL_OBJ_GET_SIZE(obj)) + if (ps.idx >= HCL_OBJ_GET_SIZE(obj)) { ps.type = PRINT_STACK_ARRAY_END; } @@ -513,26 +513,26 @@ next: HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY); ps.obj = obj; } - + x = push (hcl, &ps); if (x <= -1) return -1; obj = ((hcl_oop_oop_t)obj)->slot[arridx]; - if (arridx > 0) + if (arridx > 0) { if (hcl_bfmt_out(fmtout, breakers[0][json]) <= -1) return -1; } - /* Jump to the 'next' label so that the object - * pointed to by 'obj' is printed. Once it + /* Jump to the 'next' label so that the object + * pointed to by 'obj' is printed. Once it * ends, a jump back to the 'resume' label * is made at the end of this function. */ - goto next; + goto next; resume_array: HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY); arridx = ps.idx; obj = ps.obj; - } + } while (1); break; } @@ -562,7 +562,7 @@ next: dic = (hcl_oop_dic_t)obj; HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally)); - if (HCL_OOP_TO_SMOOI(dic->tally) <= 0) + if (HCL_OOP_TO_SMOOI(dic->tally) <= 0) { if (hcl_bfmt_out(fmtout, closing_parens[HCL_CONCODE_DIC][json]) <= -1) return -1; break; @@ -611,7 +611,7 @@ next: { /* Push what to print next on to the stack */ ps.idx = bucidx + 1; - if (ps.idx >= bucsize) + if (ps.idx >= bucsize) { ps.type = PRINT_STACK_DIC_END; } @@ -629,16 +629,16 @@ next: obj = HCL_CONS_CDR(obj); } - if (buctally > 0) + if (buctally > 0) { if (hcl_bfmt_out(fmtout, breakers[buctally & 1][json]) <= -1) return -1; } - - /* Jump to the 'next' label so that the object - * pointed to by 'obj' is printed. Once it + + /* Jump to the 'next' label so that the object + * pointed to by 'obj' is printed. Once it * ends, a jump back to the 'resume' label * is made at the end of this function. */ - goto next; + goto next; resume_dic: HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC); @@ -647,7 +647,7 @@ next: obj = ps.obj; dic = (hcl_oop_dic_t)ps.obj2; bucsize = HCL_OBJ_GET_SIZE(dic->bucket); - } + } while (1); break; @@ -677,8 +677,8 @@ next: word_index = WORD_FUNCTION; goto print_word; - case HCL_BRAND_BLOCK: - word_index = WORD_BLOCK; + case HCL_BRAND_LAMBDA: + word_index = WORD_LAMBDA; goto print_word; case HCL_BRAND_CONTEXT: @@ -761,7 +761,7 @@ int hcl_outfmtobj (hcl_t* hcl, hcl_bitmask_t mask, hcl_oop_t obj, hcl_outbfmt_t int n; /* the printer stack must be empty. buggy if not. */ - HCL_ASSERT (hcl, hcl->p.s.size == 0); + HCL_ASSERT (hcl, hcl->p.s.size == 0); hcl->p.e = obj; /* remember the head of the object to print */ n = hcl_proutbfmt(hcl, mask, obj); @@ -772,7 +772,7 @@ int hcl_outfmtobj (hcl_t* hcl, hcl_bitmask_t mask, hcl_oop_t obj, hcl_outbfmt_t if (n <= -1) hcl->p.s.size = 0; /* the printer stack must get empty when done. buggy if not */ - HCL_ASSERT (hcl, hcl->p.s.size == 0); + HCL_ASSERT (hcl, hcl->p.s.size == 0); return n; } diff --git a/lib/read.c b/lib/read.c index 977d161..68830d8 100644 --- a/lib/read.c +++ b/lib/read.c @@ -673,10 +673,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv static HCL_INLINE int is_at_block_beginning (hcl_t* hcl) { hcl_rstl_t* rstl; - - //HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL); rstl = hcl->c->r.st; - return !rstl || LIST_FLAG_GET_CONCODE(rstl->flagv) == HCL_CONCODE_BLOCK && rstl->count <= 0; } @@ -876,12 +873,10 @@ static int on_fed_cnode (hcl_t* hcl, hcl_cnode_t* obj) static void init_feed (hcl_t* hcl) { HCL_MEMSET (&hcl->c->feed, 0, HCL_SIZEOF(hcl->c->feed)); - hcl->c->feed.lx.state = HCL_FLX_START; hcl->c->feed.lx.loc.line = 1; hcl->c->feed.lx.loc.colm = 1; hcl->c->feed.lx.loc.file = HCL_NULL; - hcl->c->feed.on_cnode = on_fed_cnode; } @@ -1101,6 +1096,7 @@ static int feed_process_token (hcl_t* hcl) case HCL_TOK_LBRACE: /* { */ frd->flagv = 0; LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_BLOCK); +hcl_logbfmt (hcl, HCL_LOG_FATAL, "XXXX [%d,%d]\n", TOKEN_LOC(hcl)->line, TOKEN_LOC(hcl)->colm); goto start_list; case HCL_TOK_DLPAREN: /* #{ */ @@ -1176,14 +1172,15 @@ static int feed_process_token (hcl_t* hcl) if (frd->level <= 0) { /* redundant semicolons */ - hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL); + /* TOD: change error info or code */ + hcl_setsynerr (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), HCL_NULL); goto oops; } if (!(frd->flagv & AUTO_FORGED)) { - /* TODO: change error info */ - hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL); + /* TODO: change error info or code */ + hcl_setsynerr (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), HCL_NULL); goto oops; } @@ -1194,6 +1191,7 @@ static int feed_process_token (hcl_t* hcl) hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL); goto oops; } +hcl_logbfmt(hcl, HCL_LOG_FATAL, "forged xlist...exiting..OK\n"); frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); frd->level--; @@ -1388,6 +1386,7 @@ static int feed_process_token (hcl_t* hcl) { hcl_oop_t obj = frd->obj; +hcl_logbfmt(hcl, HCL_LOG_FATAL, "QQQQQQQQQQQQ forged xlist...\n"); frd->flagv = AUTO_FORGED; LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_XLIST); diff --git a/lib/sym.c b/lib/sym.c index 0066961..e91175e 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -42,13 +42,13 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) else if (oldsz < 400000) newsz = oldsz + (oldsz / 16); else if (oldsz < 800000) newsz = oldsz + (oldsz / 32); else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64); - else + else { hcl_oow_t inc, inc_max; inc = oldsz / 128; inc_max = HCL_OBJ_SIZE_MAX - oldsz; - if (inc > inc_max) + if (inc > inc_max) { if (inc_max > 0) inc = inc_max; else @@ -89,7 +89,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow hcl_oop_char_t symbol; HCL_ASSERT (hcl, len > 0); - if (len <= 0) + if (len <= 0) { /* i don't allow an empty symbol name */ hcl_seterrnum (hcl, HCL_EINVAL); @@ -100,7 +100,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow index = hcl_hash_oochars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket); /* find a matching symbol in the open-addressed symbol table */ - while (hcl->symtab->bucket->slot[index] != hcl->_nil) + while (hcl->symtab->bucket->slot[index] != hcl->_nil) { symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[index]; HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, symbol)); @@ -114,7 +114,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow index = (index + 1) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket); } - if (!create) + if (!create) { hcl_seterrnum (hcl, HCL_ENOENT); return HCL_NULL; @@ -125,7 +125,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow tally = HCL_OOP_TO_SMOOI(hcl->symtab->tally); if (tally >= HCL_SMOOI_MAX) { - /* this built-in table is not allowed to hold more than + /* this built-in table is not allowed to hold more than * HCL_SMOOI_MAX items for efficiency sake */ hcl_seterrnum (hcl, HCL_EDFULL); return HCL_NULL; @@ -133,7 +133,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow /* no conversion to hcl_oow_t is necessary for tally + 1. * the maximum value of tally is checked to be HCL_SMOOI_MAX - 1. - * tally + 1 can produce at most HCL_SMOOI_MAX. above all, + * tally + 1 can produce at most HCL_SMOOI_MAX. above all, * HCL_SMOOI_MAX is way smaller than HCL_TYPE_MAX(hcl_ooi_t). */ if (tally + 1 >= HCL_OBJ_GET_SIZE(hcl->symtab->bucket)) { @@ -155,7 +155,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow /* recalculate the index for the expanded bucket */ index = hcl_hash_oochars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket); - while (hcl->symtab->bucket->slot[index] != hcl->_nil) + while (hcl->symtab->bucket->slot[index] != hcl->_nil) index = (index + 1) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket); } diff --git a/lib/tmr.c b/lib/tmr.c index 00c4430..f5e358b 100644 --- a/lib/tmr.c +++ b/lib/tmr.c @@ -78,7 +78,7 @@ int hcl_tmr_init (hcl_tmr_t* tmr, hcl_t* hcl, hcl_oow_t capa) void hcl_tmr_fini (hcl_tmr_t* tmr) { hcl_tmr_clear (tmr); - if (tmr->event) + if (tmr->event) { hcl_freemem (tmr->hcl, tmr->event); tmr->event = HCL_NULL; @@ -111,7 +111,7 @@ static hcl_tmr_index_t sift_up (hcl_tmr_t* tmr, hcl_tmr_index_t index, int notif hcl_tmr_event_t item; hcl_oow_t old_index; - item = tmr->event[index]; + item = tmr->event[index]; old_index = index; do @@ -173,7 +173,7 @@ static hcl_tmr_index_t sift_down (hcl_tmr_t* tmr, hcl_tmr_index_t index, int not index = younger; } while (index < base); - + tmr->event[index] = item; if (notify && index != old_index) tmr->event[index].updater (tmr, old_index, index, &tmr->event[index]); diff --git a/lib/utf8.c b/lib/utf8.c index b9666d8..863473f 100644 --- a/lib/utf8.c +++ b/lib/utf8.c @@ -58,7 +58,7 @@ struct __utf8_t typedef struct __utf8_t __utf8_t; -static __utf8_t utf8_table[] = +static __utf8_t utf8_table[] = { {0x00000000ul, 0x0000007Ful, 0x00, 0x80, 0x7F, 1}, {0x00000080ul, 0x000007FFul, 0xC0, 0xE0, 0x1F, 2}, @@ -82,7 +82,7 @@ static HCL_INLINE __utf8_t* get_utf8_slot (hcl_uch_t uc) end = utf8_table + HCL_COUNTOF(utf8_table); cur = utf8_table; - while (cur < end) + while (cur < end) { if (uc >= cur->lower && uc <= cur->upper) return cur; cur++; @@ -100,7 +100,7 @@ hcl_oow_t hcl_uc_to_utf8 (hcl_uch_t uc, hcl_bch_t* utf8, hcl_oow_t size) if (utf8 && cur->length <= size) { int index = cur->length; - while (index > 1) + while (index > 1) { /* * 0x3F: 00111111 @@ -130,16 +130,16 @@ hcl_oow_t hcl_utf8_to_uc (const hcl_bch_t* utf8, hcl_oow_t size, hcl_uch_t* uc) end = utf8_table + HCL_COUNTOF(utf8_table); cur = utf8_table; - while (cur < end) + while (cur < end) { - if ((utf8[0] & cur->mask) == cur->fbyte) + if ((utf8[0] & cur->mask) == cur->fbyte) { - /* if size is less that cur->length, the incomplete-seqeunce + /* if size is less that cur->length, the incomplete-seqeunce * error is naturally indicated. so validate the string * only if size is as large as cur->length. */ - if (size >= cur->length) + if (size >= cur->length) { int i; @@ -151,12 +151,12 @@ hcl_oow_t hcl_utf8_to_uc (const hcl_bch_t* utf8, hcl_oow_t size, hcl_uch_t* uc) for (i = 1; i < cur->length; i++) { /* in utf8, trailing bytes are all - * set with 0x80. + * set with 0x80. * * 10XXXXXX & 11000000 => 10000000 * * if not, invalid. */ - if ((utf8[i] & 0xC0) != 0x80) return 0; + if ((utf8[i] & 0xC0) != 0x80) return 0; w = (w << 6) | (utf8[i] & 0x3F); } *uc = w; @@ -166,19 +166,19 @@ hcl_oow_t hcl_utf8_to_uc (const hcl_bch_t* utf8, hcl_oow_t size, hcl_uch_t* uc) for (i = 1; i < cur->length; i++) { /* in utf8, trailing bytes are all - * set with 0x80. + * set with 0x80. * * 10XXXXXX & 11000000 => 10000000 * * if not, invalid. */ - if ((utf8[i] & 0xC0) != 0x80) return 0; + if ((utf8[i] & 0xC0) != 0x80) return 0; } } } - /* this return value can indicate both - * the correct length (size >= cur->length) - * and + /* this return value can indicate both + * the correct length (size >= cur->length) + * and * the incomplete seqeunce error (size < cur->length). */ return (hcl_oow_t)cur->length; @@ -191,16 +191,16 @@ hcl_oow_t hcl_utf8_to_uc (const hcl_bch_t* utf8, hcl_oow_t size, hcl_uch_t* uc) /* - * See http://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c + * See http://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c */ -struct interval +struct interval { int first; int last; }; /* auxiliary function for binary search in interval table */ -static int bisearch(hcl_uch_t ucs, const struct interval *table, int max) +static int bisearch(hcl_uch_t ucs, const struct interval *table, int max) { int min = 0; int mid; @@ -335,5 +335,5 @@ int hcl_ucwidth (hcl_uch_t uc) } } - return 1; + return 1; } diff --git a/lib/xma.c b/lib/xma.c index 0a22212..e0d5e99 100644 --- a/lib/xma.c +++ b/lib/xma.c @@ -29,9 +29,9 @@ #include /* TODO: replace assert() with HCL_ASSERT() or something */ -/* +/* * in the following run, movaps tries to write to the address 0x7fffea722f78. - * since the instruction deals with 16-byte aligned data only, it triggered + * since the instruction deals with 16-byte aligned data only, it triggered * the general protection error. * $ gdb ~/xxx/bin/xxx @@ -79,16 +79,16 @@ struct hcl_xma_mblk_t /* the block size is shifted by 1 bit and the maximum value is * offset by 1 bit because of the 'free' bit-field. - * i could keep 'size' without shifting with bit manipulation - * because the actual size is aligned and the last bit will + * i could keep 'size' without shifting with bit manipulation + * because the actual size is aligned and the last bit will * never be 1. i don't think there is a practical use case where - * you need to allocate a huge chunk covering the entire + * you need to allocate a huge chunk covering the entire * address space of your machine. */ hcl_oow_t free: 1; hcl_oow_t size: HCL_XMA_SIZE_BITS; /**< block size */ }; -struct hcl_xma_fblk_t +struct hcl_xma_fblk_t { hcl_oow_t prev_size; hcl_oow_t free: 1; @@ -105,7 +105,7 @@ static void DBG_VERIFY (hcl_xma_t* xma, const char* desc) { hcl_xma_mblk_t* tmp, * next; hcl_oow_t cnt; - hcl_oow_t fsum, asum; + hcl_oow_t fsum, asum; #if defined(HCL_XMA_ENABLE_STAT) hcl_oow_t isum; #endif @@ -139,7 +139,7 @@ static void DBG_VERIFY (hcl_xma_t* xma, const char* desc) #define DBG_VERIFY(xma, desc) #endif -static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n) +static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n) { /* * 2**x = n; @@ -169,7 +169,7 @@ static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n) #if HCL_SIZEOF_OOW_T >= 8 if ((n & (~(hcl_oow_t)0 << (BITS-32))) == 0) { x -= 32; n <<= 32; } #endif -#if HCL_SIZEOF_OOW_T >= 4 +#if HCL_SIZEOF_OOW_T >= 4 if ((n & (~(hcl_oow_t)0 << (BITS-16))) == 0) { x -= 16; n <<= 16; } #endif #if HCL_SIZEOF_OOW_T >= 2 @@ -185,7 +185,7 @@ static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n) #undef BITS } -static HCL_INLINE hcl_oow_t getxfi (hcl_xma_t* xma, hcl_oow_t size) +static HCL_INLINE hcl_oow_t getxfi (hcl_xma_t* xma, hcl_oow_t size) { hcl_oow_t xfi = ((size) / ALIGN) - 1; if (xfi >= FIXED) xfi = szlog2(size) - (xma)->bdec + FIXED; @@ -236,7 +236,7 @@ int hcl_xma_init (hcl_xma_t* xma, hcl_mmgr_t* mmgr, void* zoneptr, hcl_oow_t zon internal = 1; /* internally created. must be freed upon hcl_xma_fini() */ } - else if (zonesize < FBLKMINSIZE) + else if (zonesize < FBLKMINSIZE) { /* the zone size is too small for an externally allocated zone. */ /* TODO: difference error code from memory allocation failure.. this is not really memory shortage */ @@ -261,7 +261,7 @@ int hcl_xma_init (hcl_xma_t* xma, hcl_mmgr_t* mmgr, void* zoneptr, hcl_oow_t zon /* get the free block index */ xfi = getxfi(xma, first->size); /* locate it into an apporopriate slot */ - xma->xfree[xfi] = first; + xma->xfree[xfi] = first; /* let it be the head, which is natural with only a block */ xma->start = (hcl_uint8_t*)first; xma->end = xma->start + zonesize; @@ -275,7 +275,7 @@ int hcl_xma_init (hcl_xma_t* xma, hcl_mmgr_t* mmgr, void* zoneptr, hcl_oow_t zon xma->stat.nfree = 1; xma->stat.nused = 0; #endif - + return 0; } @@ -290,15 +290,15 @@ void hcl_xma_fini (hcl_xma_t* xma) static HCL_INLINE void attach_to_freelist (hcl_xma_t* xma, hcl_xma_fblk_t* b) { - /* - * attach a block to a free list + /* + * attach a block to a free list */ /* get the free list index for the block size */ - hcl_oow_t xfi = getxfi(xma, b->size); + hcl_oow_t xfi = getxfi(xma, b->size); /* let it be the head of the free list doubly-linked */ - b->free_prev = HCL_NULL; + b->free_prev = HCL_NULL; b->free_next = xma->xfree[xfi]; if (xma->xfree[xfi]) xma->xfree[xfi]->free_prev = b; xma->xfree[xfi] = b; @@ -315,11 +315,11 @@ static HCL_INLINE void detach_from_freelist (hcl_xma_t* xma, hcl_xma_fblk_t* b) if (p) { - /* the previous item exists. let its 'next' pointer point to + /* the previous item exists. let its 'next' pointer point to * the block's next item. */ p->free_next = n; } - else + else { /* the previous item does not exist. the block is the first * item in the free list. */ @@ -330,7 +330,7 @@ static HCL_INLINE void detach_from_freelist (hcl_xma_t* xma, hcl_xma_fblk_t* b) xma->xfree[xfi] = n; } - /* let the 'prev' pointer of the block's next item point to the + /* let the 'prev' pointer of the block's next item point to the * block's previous item */ if (n) n->free_prev = p; } @@ -352,8 +352,8 @@ static hcl_xma_fblk_t* alloc_from_freelist (hcl_xma_t* xma, hcl_oow_t xfi, hcl_o { hcl_xma_mblk_t* y, * z; - /* the remaining part is large enough to hold - * another block. let's split it + /* the remaining part is large enough to hold + * another block. let's split it */ /* shrink the size of the 'cand' block */ @@ -484,7 +484,7 @@ static void* _realloc_merge (hcl_xma_t* xma, void* b, hcl_oow_t size) hcl_xma_mblk_t* blk = (hcl_xma_mblk_t*)USR_TO_SYS(b); DBG_VERIFY (xma, "realloc merge start"); - /* rounds up 'size' to be multiples of ALIGN */ + /* rounds up 'size' to be multiples of ALIGN */ if (size < MINALLOCSIZE) size = MINALLOCSIZE; size = HCL_ALIGN_POW2(size, ALIGN); @@ -511,8 +511,8 @@ static void* _realloc_merge (hcl_xma_t* xma, void* b, hcl_oow_t size) rem = (MBLKHDRSIZE + n->size) - req; if (rem >= FBLKMINSIZE) { - /* - * the remaining part of the next block is large enough + /* + * the remaining part of the next block is large enough * to hold a block. break the next block. */ @@ -555,7 +555,7 @@ static void* _realloc_merge (hcl_xma_t* xma, void* b, hcl_oow_t size) { /* shrink the block */ hcl_oow_t rem = blk->size - size; - if (rem >= FBLKMINSIZE) + if (rem >= FBLKMINSIZE) { hcl_xma_mblk_t* n; @@ -628,7 +628,7 @@ void* hcl_xma_realloc (hcl_xma_t* xma, void* b, hcl_oow_t size) { void* n; - if (b == HCL_NULL) + if (b == HCL_NULL) { /* 'realloc' with NULL is the same as 'alloc' */ n = hcl_xma_alloc(xma, size); @@ -676,20 +676,20 @@ void hcl_xma_free (hcl_xma_t* xma, void* b) /* * Merge the block with surrounding blocks * - * blk + * blk * | * v * +------------+------------+------------+------------+ * | X | | Y | Z | * +------------+------------+------------+------------+ - * - * + * + * * +--------------------------------------+------------+ * | X | Z | * +--------------------------------------+------------+ * */ - + hcl_xma_mblk_t* z = next_mblk(y); hcl_oow_t ns = MBLKHDRSIZE + org_blk_size + MBLKHDRSIZE; hcl_oow_t bs = ns + y->size; @@ -719,8 +719,8 @@ void hcl_xma_free (hcl_xma_t* xma, void* b) * +------------+------------+------------+ * | | Y | Z | * +------------+------------+------------+ - * - * + * + * * * blk * | @@ -728,8 +728,8 @@ void hcl_xma_free (hcl_xma_t* xma, void* b) * +-------------------------+------------+ * | | Z | * +-------------------------+------------+ - * - * + * + * */ hcl_xma_mblk_t* z = next_mblk(y); @@ -754,7 +754,7 @@ void hcl_xma_free (hcl_xma_t* xma, void* b) else if ((hcl_uint8_t*)x >= xma->start && x->free) { /* - * Merge the block with the previous block + * Merge the block with the previous block * * blk * | @@ -797,7 +797,7 @@ void hcl_xma_free (hcl_xma_t* xma, void* b) void hcl_xma_dump (hcl_xma_t* xma, hcl_xma_dumper_t dumper, void* ctx) { hcl_xma_mblk_t* tmp; - hcl_oow_t fsum, asum; + hcl_oow_t fsum, asum; #if defined(HCL_XMA_ENABLE_STAT) hcl_oow_t isum; #endif diff --git a/lib/xutl-sa.h b/lib/xutl-sa.h index c30137c..2e4a03c 100644 --- a/lib/xutl-sa.h +++ b/lib/xutl-sa.h @@ -18,14 +18,14 @@ static int str_to_ipv4 (const ooch_t* str, hcl_oow_t len, struct in_addr* inaddr c = *str++; - if (c >= '0' && c <= '9') + if (c >= '0' && c <= '9') { if (digits > 0 && acc == 0) return -1; acc = acc * 10 + (c - '0'); if (acc > 255) return -1; digits++; } - else if (c == '.') + else if (c == '.') { if (dots >= 3 || digits == 0) return -1; addr = (addr << 8) | acc; @@ -90,10 +90,10 @@ static int str_to_ipv6 (const ooch_t* src, hcl_oow_t len, struct in6_addr* inadd continue; } - if (ch == ':') + if (ch == ':') { curtok = src; - if (!saw_xdigit) + if (!saw_xdigit) { if (colonp) return -1; colonp = tp; @@ -113,23 +113,23 @@ static int str_to_ipv6 (const ooch_t* src, hcl_oow_t len, struct in6_addr* inadd } if (ch == '.' && ((tp + HCL_SIZEOF(struct in_addr)) <= endp) && - str_to_ipv4(curtok, src_end - curtok, (struct in_addr*)tp) == 0) + str_to_ipv4(curtok, src_end - curtok, (struct in_addr*)tp) == 0) { tp += HCL_SIZEOF(struct in_addr*); saw_xdigit = 0; - break; + break; } return -1; } - if (saw_xdigit) + if (saw_xdigit) { if (tp + HCL_SIZEOF(hcl_uint16_t) > endp) return -1; *tp++ = (hcl_uint8_t)(val >> 8) & 0xff; *tp++ = (hcl_uint8_t)val & 0xff; } - if (colonp != HCL_NULL) + if (colonp != HCL_NULL) { /* * Since some memmove()'s erroneously fail to handle @@ -137,8 +137,8 @@ static int str_to_ipv6 (const ooch_t* src, hcl_oow_t len, struct in6_addr* inadd */ hcl_oow_t n = tp - colonp; hcl_oow_t i; - - for (i = 1; i <= n; i++) + + for (i = 1; i <= n; i++) { endp[-i] = colonp[n - i]; colonp[n - i] = 0; @@ -163,7 +163,7 @@ int str_to_sockaddr (hcl_t* hcl, const ooch_t* str, hcl_oow_t len, hcl_sckaddr_t p = str; end = str + len; - if (p >= end) + if (p >= end) { if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "blank address"); return -1; @@ -195,7 +195,7 @@ int str_to_sockaddr (hcl_t* hcl, const ooch_t* str, hcl_oow_t len, hcl_sckaddr_t return -1; } - if (*p >= '0' && *p <= '9') + if (*p >= '0' && *p <= '9') { /* numeric scope id */ y = 0; @@ -244,9 +244,9 @@ TODO: if (str_to_ipv4(tmp.ptr, tmp.len, &nwad->in4.sin_addr) <= -1) { #if (HCL_SIZEOF_STRUCT_SOCKADDR_IN6 > 0) - /* check if it is an IPv6 address not enclosed in []. + /* check if it is an IPv6 address not enclosed in []. * the port number can't be specified in this format. */ - if (p >= end || *p != ':') + if (p >= end || *p != ':') { /* without :, it can't be an ipv6 address */ goto unrecog; @@ -271,7 +271,7 @@ TODO: return -1; } - if (*p >= '0' && *p <= '9') + if (*p >= '0' && *p <= '9') { /* numeric scope id */ y = 0; @@ -310,7 +310,7 @@ TODO return nwad->in6.sin6_family; #else goto unrecog; - #endif + #endif } nwad->in4.sin_family = AF_INET; @@ -318,7 +318,7 @@ TODO } #endif - if (p < end && *p == ':') + if (p < end && *p == ':') { /* port number */ hcl_uint32_t port = 0; @@ -333,8 +333,8 @@ TODO } tmp.len = p - tmp.ptr; - if (tmp.len <= 0 || tmp.len >= 6 || - port > HCL_TYPE_MAX(hcl_uint16_t)) + if (tmp.len <= 0 || tmp.len >= 6 || + port > HCL_TYPE_MAX(hcl_uint16_t)) { if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "port number blank or too large"); return -1; @@ -356,7 +356,7 @@ TODO unrecog: if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "unrecognized address"); return -1; - + no_rbrack: if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "missing right bracket"); return -1;