diff --git a/lang.txt b/lang.txt index d597d12..b32ca79 100644 --- a/lang.txt +++ b/lang.txt @@ -1,5 +1,5 @@ ## TODO: - can we allow commans in xlist to make it more like conventional programming langauges? + can we allow commas between arguments in xlist/mlist to make it more like conventional programming langauges? make literal frame in the compiler not use object momory. ask VM to take the byte codes and create literal frame using object memory -> hcl->code.lit.arr must be composed of plain data. not using object memory -> it must ask VM(locally via a function call, remotely via some communication) to create objects in the object memory diff --git a/lib/comp.c b/lib/comp.c index 381ed57..0daba80 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -2008,7 +2008,7 @@ inside_loop: static int compile_expression_block (hcl_t* hcl, hcl_cnode_t* src, const hcl_bch_t* ctxname, int flags) { - hcl_cnode_t* cmd, * obj, * tmp; + hcl_cnode_t* cmd, * obj; hcl_oow_t nlvars, tvslen; hcl_fnblk_info_t* fbi; hcl_cframe_t* cf; @@ -4227,6 +4227,86 @@ HCL_DEBUG1 (hcl, ">>>> instance variable or method %js\n", sep + 1); return 0; } +HCL_UNUSED static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* num) +{ + /* it is not a generic conversion function. + * it assumes a certain pre-sanity check on the string + * done by the lexical analyzer */ + + int v, negsign, base; + const hcl_ooch_t* ptr, * end; + hcl_oow_t value, old_value; + + negsign = 0; + ptr = str->ptr, + end = str->ptr + str->len; + + HCL_ASSERT (hcl, ptr < end); + + if (*ptr == '+' || *ptr == '-') + { + negsign = *ptr - '+'; + ptr++; + } + + if (radixed) + { + HCL_ASSERT (hcl, ptr < end); + + if (*ptr != '#') + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "radixed number not starting with # - %*.js", str->len, str->ptr); + return -1; + } + ptr++; /* skip '#' */ + + if (*ptr == 'x') base = 16; + else if (*ptr == 'o') base = 8; + else if (*ptr == 'b') base = 2; + else + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); + return -1; + } + ptr++; + } + else base = 10; + + HCL_ASSERT (hcl, ptr < end); + + value = old_value = 0; + while (ptr < end && (v = HCL_CHAR_TO_NUM(*ptr, base)) < base) + { + value = value * base + v; + if (value < old_value) + { + /* overflow must have occurred */ + hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); + return -1; + } + old_value = value; + ptr++; + } + + if (ptr < end) + { + /* trailing garbage? */ + hcl_seterrbfmt (hcl, HCL_EINVAL, "trailing garbage after numeric literal - %.*js", str->len, str->ptr); + return -1; + } + + if (value > HCL_TYPE_MAX(hcl_ooi_t) + (negsign? 1: 0)) /* assume 2's complement */ + { + hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); + return -1; + } + + *num = value; + if (negsign) *num *= -1; + + return 0; +} + static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, const hcl_loc_t* loc, int radixed) { int negsign, base; @@ -4253,7 +4333,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, const hcl_loc_t* lo base = 0; do { - base = base * 10 + CHAR_TO_NUM(*ptr, 10); + base = base * 10 + HCL_CHAR_TO_NUM(*ptr, 10); ptr++; } while (*ptr != 'r'); @@ -4951,7 +5031,6 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl) hcl_ooi_t jump_inst_pos; hcl_ooi_t cond_pos, body_pos; hcl_loc_t start_loc; - hcl_cnode_t* cmd_cnode; int jump_inst, next_cop; hcl_cnode_t* cond, * body; diff --git a/lib/fmt.c b/lib/fmt.c index 7d36172..676974f 100644 --- a/lib/fmt.c +++ b/lib/fmt.c @@ -1550,7 +1550,7 @@ static int log_oocs (hcl_fmtout_t* fmtout, const hcl_ooch_t* ptr, hcl_oow_t len) hcl->log.ptr[hcl->log.len++] = '\n'; } - vmprim_log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); + HCL_VMPRIM_LOG_WRITE (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); hcl->log.len = 0; } @@ -1594,7 +1594,7 @@ redo: /* no line ending - append a line terminator */ hcl->log.ptr[hcl->log.len++] = '\n'; } - vmprim_log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); + HCL_VMPRIM_LOG_WRITE (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); hcl->log.len = 0; } @@ -1710,7 +1710,7 @@ hcl_ooi_t hcl_logbfmtv (hcl_t* hcl, hcl_bitmask_t mask, const hcl_bch_t* fmt, va if (hcl->log.len > 0 && hcl->log.ptr[hcl->log.len - 1] == '\n') { - vmprim_log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); + HCL_VMPRIM_LOG_WRITE (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); hcl->log.len = 0; } @@ -1765,7 +1765,7 @@ hcl_ooi_t hcl_logufmtv (hcl_t* hcl, hcl_bitmask_t mask, const hcl_uch_t* fmt, va if (hcl->log.len > 0 && hcl->log.ptr[hcl->log.len - 1] == '\n') { - vmprim_log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); + HCL_VMPRIM_LOG_WRITE (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); hcl->log.len = 0; } return (x <= -1)? -1: fo.count; diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 9f203fe..80fb926 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -1198,13 +1198,19 @@ typedef hcl_ooi_t (*hcl_outbfmt_t) ( /* i don't want an error raised inside the callback to override * the existing error number and message. */ -#define vmprim_log_write(hcl,mask,ptr,len) do { \ +#define HCL_VMPRIM_LOG_WRITE(hcl,mask,ptr,len) do { \ int shuterr = (hcl)->shuterr; \ (hcl)->shuterr = 1; \ (hcl)->vmprim.log_write (hcl, mask, ptr, len); \ (hcl)->shuterr = shuterr; \ } while(0) + +#define HCL_CHAR_TO_NUM(c,base) \ + ((c >= '0' && c <= '9')? ((c - '0' < base)? (c - '0'): base): \ + (c >= 'A' && c <= 'Z')? ((c - 'A' + 10 < base)? (c - 'A' + 10): base): \ + (c >= 'a' && c <= 'z')? ((c - 'a' + 10 < base)? (c - 'a' + 10): base): base) + #if defined(__cplusplus) extern "C" { #endif diff --git a/lib/hcl.c b/lib/hcl.c index 97e3022..99eb4bf 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -196,7 +196,7 @@ void hcl_fini (hcl_t* hcl) { /* flush pending log messages just in case. */ HCL_ASSERT (hcl, hcl->log.ptr != HCL_NULL); - vmprim_log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); + HCL_VMPRIM_LOG_WRITE (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); } for (cb = hcl->cblist; cb; cb = cb->next) @@ -211,7 +211,7 @@ void hcl_fini (hcl_t* hcl) * this point because one of the callbacks could arrange to stop * logging */ HCL_ASSERT (hcl, hcl->log.ptr != HCL_NULL); - vmprim_log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); + HCL_VMPRIM_LOG_WRITE (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len); } /* deregister all callbacks */ diff --git a/lib/prim.c b/lib/prim.c index 09b488d..e5d8a1d 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -204,7 +204,7 @@ static hcl_pfrc_t pf_sprintf (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) else { hcl_oop_t str; - str = hcl_makestring (hcl, hcl->sprintf.xbuf.ptr, hcl->sprintf.xbuf.len, 0); + str = hcl_makestring(hcl, hcl->sprintf.xbuf.ptr, hcl->sprintf.xbuf.len, 0); if (!str) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, str); diff --git a/lib/read.c b/lib/read.c index f7b2528..5246ba8 100644 --- a/lib/read.c +++ b/lib/read.c @@ -29,11 +29,6 @@ #define SALIT_BUFFER_ALIGN 128 #define ARLIT_BUFFER_ALIGN 128 -#define CHAR_TO_NUM(c,base) \ - ((c >= '0' && c <= '9')? ((c - '0' < base)? (c - '0'): base): \ - (c >= 'A' && c <= 'Z')? ((c - 'A' + 10 < base)? (c - 'A' + 10): base): \ - (c >= 'a' && c <= 'z')? ((c - 'a' + 10 < base)? (c - 'a' + 10): base): base) - static struct voca_t { hcl_oow_t len; @@ -149,183 +144,6 @@ static struct static int init_compiler (hcl_t* hcl); -static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* num) -{ - /* it is not a generic conversion function. - * it assumes a certain pre-sanity check on the string - * done by the lexical analyzer */ - - int v, negsign, base; - const hcl_ooch_t* ptr, * end; - hcl_oow_t value, old_value; - - negsign = 0; - ptr = str->ptr, - end = str->ptr + str->len; - - HCL_ASSERT (hcl, ptr < end); - - if (*ptr == '+' || *ptr == '-') - { - negsign = *ptr - '+'; - ptr++; - } - - if (radixed) - { - HCL_ASSERT (hcl, ptr < end); - - if (*ptr != '#') - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "radixed number not starting with # - %*.js", str->len, str->ptr); - return -1; - } - ptr++; /* skip '#' */ - - if (*ptr == 'x') base = 16; - else if (*ptr == 'o') base = 8; - else if (*ptr == 'b') base = 2; - else - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); - return -1; - } - ptr++; - } - else base = 10; - - HCL_ASSERT (hcl, ptr < end); - - value = old_value = 0; - while (ptr < end && (v = CHAR_TO_NUM(*ptr, base)) < base) - { - value = value * base + v; - if (value < old_value) - { - /* overflow must have occurred */ - hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); - return -1; - } - old_value = value; - ptr++; - } - - if (ptr < end) - { - /* trailing garbage? */ - hcl_seterrbfmt (hcl, HCL_EINVAL, "trailing garbage after numeric literal - %.*js", str->len, str->ptr); - return -1; - } - - if (value > HCL_TYPE_MAX(hcl_ooi_t) + (negsign? 1: 0)) /* assume 2's complement */ - { - hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); - return -1; - } - - *num = value; - if (negsign) *num *= -1; - - return 0; -} - -static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) -{ - int negsign, base; - const hcl_ooch_t* ptr, * end; - - negsign = 0; - ptr = str->ptr, - end = str->ptr + str->len; - - HCL_ASSERT (hcl, ptr < end); - - if (*ptr == '+' || *ptr == '-') - { - negsign = *ptr - '+'; - ptr++; - } - -#if 0 - if (radixed) - { - HCL_ASSERT (hcl, ptr < end); - - base = 0; - do - { - base = base * 10 + CHAR_TO_NUM(*ptr, 10); - ptr++; - } - while (*ptr != 'r'); - - ptr++; - } - else base = 10; -#else - if (radixed) - { - HCL_ASSERT (hcl, ptr < end); - - if (*ptr != '#') - { - hcl_seterrbfmt(hcl, HCL_EINVAL, "radixed number not starting with # - %.*js", str->len, str->ptr); - return HCL_NULL; - } - ptr++; /* skip '#' */ - - if (*ptr == 'x') base = 16; - else if (*ptr == 'o') base = 8; - else if (*ptr == 'b') base = 2; - else - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); - return HCL_NULL; - } - ptr++; - } - else base = 10; -#endif - -/* TODO: handle floating point numbers ... etc */ - if (negsign) base = -base; - return hcl_strtoint(hcl, ptr, end - ptr, base); -} - -static hcl_oop_t string_to_fpdec (hcl_t* hcl, hcl_oocs_t* str, const hcl_loc_t* loc) -{ - hcl_oow_t pos; - hcl_oow_t scale = 0; - hcl_oop_t v; - - pos = str->len; - while (pos > 0) - { - pos--; - if (str->ptr[pos] == '.') - { - scale = str->len - pos - 1; - if (scale > HCL_SMOOI_MAX) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_NUMRANGE, loc, str, "too many digits after decimal point"); - return HCL_NULL; - } - - HCL_ASSERT (hcl, scale > 0); - /*if (scale > 0)*/ HCL_MEMMOVE (&str->ptr[pos], &str->ptr[pos + 1], scale * HCL_SIZEOF(str->ptr[0])); /* remove the decimal point */ - break; - } - } - - /* if no decimal point is included or no digit after the point , you must not call this function */ - HCL_ASSERT (hcl, scale > 0); - - v = hcl_strtoint(hcl, str->ptr, str->len - 1, 10); - if (!v) return HCL_NULL; - - return hcl_makefpdec(hcl, v, scale); -} - static HCL_INLINE int is_spacechar (hcl_ooci_t c) { /* TODO: handle other space unicode characters */ @@ -1390,7 +1208,7 @@ static int feed_process_token (hcl_t* hcl) for (i = 2; i < TOKEN_NAME_LEN(hcl); i++) { HCL_ASSERT (hcl, is_xdigitchar(TOKEN_NAME_CHAR(hcl, i))); - v = v * 16 + CHAR_TO_NUM(TOKEN_NAME_CHAR(hcl, i), 16); + v = v * 16 + HCL_CHAR_TO_NUM(TOKEN_NAME_CHAR(hcl, i), 16); } if (!HCL_IN_SMPTR_RANGE(v)) @@ -1412,7 +1230,7 @@ static int feed_process_token (hcl_t* hcl) for (i = 2; i < TOKEN_NAME_LEN(hcl); i++) { HCL_ASSERT (hcl, is_digitchar(TOKEN_NAME_CHAR(hcl, i))); - v = v * 10 + CHAR_TO_NUM(TOKEN_NAME_CHAR(hcl, i), 10); + v = v * 10 + HCL_CHAR_TO_NUM(TOKEN_NAME_CHAR(hcl, i), 10); if (v > HCL_ERROR_MAX) { @@ -1443,7 +1261,7 @@ static int feed_process_token (hcl_t* hcl) /* case HCL_TOK_REAL: - frd->obj = hcl_makerealnum(hcl, HCL_TOK_RVAL(hcl)); + frd->obj = hcl_makecnoderealnum(hcl, HCL_TOK_RVAL(hcl)); break; */ @@ -1989,7 +1807,7 @@ static int flx_hmarked_char (hcl_t* hcl, hcl_ooci_t c) "invalid hexadecimal character character literal %.*js", TOKEN_NAME_LEN(hcl), TOKEN_NAME_PTR(hcl)); return -1; } - c = c * 16 + CHAR_TO_NUM(TOKEN_NAME_CHAR(hcl, i), 16); /* don't care if it is for 'p' */ + c = c * 16 + HCL_CHAR_TO_NUM(TOKEN_NAME_CHAR(hcl, i), 16); /* don't care if it is for 'p' */ } } #if (HCL_SIZEOF_OOCH_T >= 2) @@ -2094,7 +1912,7 @@ static int flx_hmarked_number (hcl_t* hcl, hcl_ooci_t c) { hcl_flx_hn_t* rn = FLX_HN(hcl); - if (CHAR_TO_NUM(c, rn->radix) >= rn->radix) + if (HCL_CHAR_TO_NUM(c, rn->radix) >= rn->radix) { if (is_delimchar(c)) {