diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 9798e2c..94cfb20 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -148,6 +148,7 @@ enum hcl_iotok_type_t HCL_IOTOK_STRLIT, HCL_IOTOK_NUMLIT, HCL_IOTOK_RADNUMLIT, + HCL_IOTOK_FPDECLIT, HCL_IOTOK_SMPTRLIT, HCL_IOTOK_ERRORLIT, HCL_IOTOK_NIL, diff --git a/lib/hcl.h b/lib/hcl.h index 0c9a155..abca4d4 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -101,7 +101,7 @@ enum hcl_synerrnum_t HCL_SYNERR_HASHLIT, /* wrong hashed literal */ HCL_SYNERR_CHARLIT, /* wrong character literal */ HCL_SYNERR_RADNUMLIT , /* invalid numeric literal with radix */ - HCL_SYNERR_INTRANGE, /* integer range error */ + HCL_SYNERR_NUMRANGE, /* number range error */ HCL_SYNERR_ERRORLIT, /* wrong error literal */ HCL_SYNERR_SMPTRLIT, /* wrong smptr literal */ @@ -551,6 +551,16 @@ struct hcl_dic_t hcl_oop_oop_t bucket; /* Array */ }; +#define HCL_FPDEC_NAMED_INSTVARS 2 +typedef struct hcl_fpdec_t hcl_fpdec_t; +typedef struct hcl_fpdec_t* hcl_oop_fpdec_t; +struct hcl_fpdec_t +{ + HCL_OBJ_HEADER; + hcl_oop_t value; /* smooi or bigint */ + hcl_oop_t scale; /* smooi, positive */ +}; + #define HCL_CONTEXT_NAMED_INSTVARS 8 typedef struct hcl_context_t hcl_context_t; typedef struct hcl_context_t* hcl_oop_context_t; @@ -693,12 +703,36 @@ struct hcl_heap_t * VIRTUAL MACHINE PRIMITIVES * ========================================================================= */ -typedef void* (*hcl_alloc_heap_t) (hcl_t* hcl, hcl_oow_t size); -typedef void (*hcl_free_heap_t) (hcl_t* hcl, void* ptr); +typedef void* (*hcl_alloc_heap_t) ( + hcl_t* hcl, + hcl_oow_t size +); -typedef void (*hcl_log_write_t) (hcl_t* hcl, unsigned int mask, const hcl_ooch_t* msg, hcl_oow_t len); -typedef void (*hcl_syserrstrb_t) (hcl_t* hcl, int syserr, hcl_bch_t* buf, hcl_oow_t len); -typedef void (*hcl_syserrstru_t) (hcl_t* hcl, int syserr, hcl_uch_t* buf, hcl_oow_t len); +typedef void (*hcl_free_heap_t) ( + hcl_t* hcl, + void* ptr +); + +typedef void (*hcl_log_write_t) ( + hcl_t* hcl, + unsigned int mask, + const hcl_ooch_t* msg, + hcl_oow_t len +); + +typedef void (*hcl_syserrstrb_t) ( + hcl_t* hcl, + int syserr, + hcl_bch_t* buf, + hcl_oow_t len +); + +typedef void (*hcl_syserrstru_t) ( + hcl_t* hcl, + int syserr, + hcl_uch_t* buf, + hcl_oow_t len +); enum hcl_vmprim_opendl_flag_t { @@ -706,12 +740,31 @@ enum hcl_vmprim_opendl_flag_t }; typedef enum hcl_vmprim_opendl_flag_t hcl_vmprim_opendl_flag_t; -typedef void* (*hcl_vmprim_dlopen_t) (hcl_t* hcl, const hcl_ooch_t* name, int flags); -typedef void (*hcl_vmprim_dlclose_t) (hcl_t* hcl, void* handle); -typedef void* (*hcl_vmprim_dlgetsym_t) (hcl_t* hcl, void* handle, const hcl_ooch_t* name); +typedef void* (*hcl_vmprim_dlopen_t) ( + hcl_t* hcl, + const hcl_ooch_t* name, + int flags +); -typedef void (*hcl_vmprim_gettime_t) (hcl_t* hcl, hcl_ntime_t* now); -typedef void (*hcl_vmprim_sleep_t) (hcl_t* hcl, const hcl_ntime_t* duration); +typedef void (*hcl_vmprim_dlclose_t) ( + hcl_t* hcl, + void* handle +); + +typedef void* (*hcl_vmprim_dlgetsym_t) ( + hcl_t* hcl, + void* handle, + const hcl_ooch_t* name +); + +typedef void (*hcl_vmprim_gettime_t) ( + hcl_t* hcl, + hcl_ntime_t* now +); + +typedef void (*hcl_vmprim_sleep_t) ( + hcl_t* hcl, + const hcl_ntime_t* duration); struct hcl_vmprim_t { @@ -1324,6 +1377,7 @@ enum hcl_brand_t HCL_BRAND_SYMBOL, HCL_BRAND_STRING, HCL_BRAND_DIC, + HCL_BRAND_FPDEC, /* fixed-point decimal */ HCL_BRAND_CFRAME,/* compiler frame */ HCL_BRAND_PRIM, diff --git a/lib/obj.c b/lib/obj.c index b18b5d8..7b10758 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -268,6 +268,7 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int return alloc_numeric_array(hcl, HCL_BRAND_STRING, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, ngc); } + /* ------------------------------------------------------------------------ * * NGC HANDLING * ------------------------------------------------------------------------ */ diff --git a/lib/print.c b/lib/print.c index cb7b20d..4356ba7 100644 --- a/lib/print.c +++ b/lib/print.c @@ -284,6 +284,22 @@ next: break; } + case HCL_BRAND_FPDEC: + { + hcl_oop_t tmp; + hcl_oop_fpdec_t f = (hcl_oop_fpdec_t)obj; + hcl_ooi_t scale; + + scale = HCL_OOP_TO_SMOOI(f->scale); + + tmp = hcl_inttostr(hcl, f->value, 10, -1); + if (!tmp) return -1; + + HCL_ASSERT (hcl, (hcl_oop_t)tmp == hcl->_nil); + if (outbfmt(hcl, mask, "%.*js.%.*js", hcl->inttostr.xbuf.len - scale, hcl->inttostr.xbuf.ptr, scale, &hcl->inttostr.xbuf.ptr[hcl->inttostr.xbuf.len - scale]) <= -1) return -1; + break; + } + #if 0 case HCL_BRAND_REAL: { diff --git a/lib/read.c b/lib/read.c index 293bb91..8e86a02 100644 --- a/lib/read.c +++ b/lib/read.c @@ -126,7 +126,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n if (*ptr != '#') { - hcl_seterrnum (hcl, HCL_EINVAL); + hcl_seterrbfmt (hcl, HCL_EINVAL, "radixed number not starting with # - %*.js", str->len, str->ptr); return -1; } ptr++; /* skip '#' */ @@ -136,7 +136,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n else if (*ptr == 'b') base = 2; else { - hcl_seterrnum (hcl, HCL_EINVAL); + hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); return -1; } ptr++; @@ -152,7 +152,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n if (value < old_value) { /* overflow must have occurred */ - hcl_seterrnum (hcl, HCL_ERANGE); + hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); return -1; } old_value = value; @@ -162,13 +162,13 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n if (ptr < end) { /* trailing garbage? */ - hcl_seterrnum (hcl, HCL_EINVAL); + 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_seterrnum (hcl, HCL_ERANGE); + hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); return -1; } @@ -218,7 +218,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) if (*ptr != '#') { - hcl_seterrnum (hcl, HCL_EINVAL); + hcl_seterrbfmt(hcl, HCL_EINVAL, "radixed number not starting with # - %.*js", str->len, str->ptr); return HCL_NULL; } ptr++; /* skip '#' */ @@ -228,7 +228,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) else if (*ptr == 'b') base = 2; else { - hcl_seterrnum (hcl, HCL_EINVAL); + hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); return HCL_NULL; } ptr++; @@ -241,6 +241,47 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) return hcl_strtoint(hcl, ptr, end - ptr, base); } +static hcl_oop_t string_to_fpdec (hcl_t* hcl, hcl_oocs_t* str, const hcl_ioloc_t* loc) +{ + hcl_oow_t pos; + hcl_oow_t scale = 0; + hcl_oop_t v; + hcl_oop_fpdec_t f; + + 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; + } + + if (scale > 0) HCL_MEMMOVE (&str->ptr[pos], &str->ptr[pos + 1], scale * HCL_SIZEOF(str->ptr[0])); + } + } + + v = hcl_strtoint(hcl, str->ptr, str->len - 1, 10); + if (scale > 0) HCL_MEMMOVE (&str->ptr[pos + 1], &str->ptr[pos], scale * HCL_SIZEOF(str->ptr[0])); + if (!v) return HCL_NULL; + + hcl_pushtmp (hcl, &v); + f = (hcl_oop_fpdec_t)hcl_makearray (hcl, HCL_FPDEC_NAMED_INSTVARS, 0); + hcl_poptmp (hcl); + + if (!f) return HCL_NULL; + + HCL_OBJ_SET_FLAGS_BRAND(f, HCL_BRAND_FPDEC); + f->value = v; + f->scale = HCL_SMOOI_TO_OOP(scale); + + return f; +} + static HCL_INLINE int is_spacechar (hcl_ooci_t c) { /* TODO: handle other space unicode characters */ @@ -352,7 +393,7 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, h #define CLEAR_TOKEN_NAME(hcl) ((hcl)->c->tok.name.len = 0) #define SET_TOKEN_TYPE(hcl,tv) ((hcl)->c->tok.type = (tv)) -#define TOKEN_TYPE(hc) ((hcl)->c->tok.type) +#define TOKEN_TYPE(hcl) ((hcl)->c->tok.type) #define TOKEN_NAME(hcl) (&(hcl)->c->tok.name) #define TOKEN_NAME_CAPA(hcl) ((hcl)->c->tok.name_capa) #define TOKEN_NAME_LEN(hcl) ((hcl)->c->tok.name.len) @@ -1114,18 +1155,25 @@ retry: case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': numlit: - /* TODO: floating-pointer number */ SET_TOKEN_TYPE (hcl, HCL_IOTOK_NUMLIT); while (1) { ADD_TOKEN_CHAR (hcl, c); GET_CHAR_TO (hcl, c); + if (TOKEN_TYPE(hcl) == HCL_IOTOK_NUMLIT && c == '.') + { + SET_TOKEN_TYPE (hcl, HCL_IOTOK_FPDECLIT); + ADD_TOKEN_CHAR (hcl, c); + GET_CHAR_TO (hcl, c); + } + if (!is_digitchar(c)) { unget_char (hcl, &hcl->c->lxc); break; } } + break; default: @@ -1999,7 +2047,6 @@ static int read_object (hcl_t* hcl) case HCL_IOTOK_VBAR: /* TODO: think wheter to allow | | inside a quoted list... */ - /* TODO: revise this part ... */ if (array_level > 0) { @@ -2074,6 +2121,10 @@ static int read_object (hcl_t* hcl) obj = string_to_num(hcl, TOKEN_NAME(hcl), TOKEN_TYPE(hcl) == HCL_IOTOK_RADNUMLIT); break; + case HCL_IOTOK_FPDECLIT: + obj = string_to_fpdec(hcl, TOKEN_NAME(hcl), TOKEN_LOC(hcl)); + break; + /* case HCL_IOTOK_REAL: obj = hcl_makerealnum(hcl, HCL_IOTOK_RVAL(hcl)); @@ -2299,7 +2350,7 @@ int hcl_attachio (hcl_t* hcl, hcl_ioimpl_t reader, hcl_ioimpl_t printer) if (!reader || !printer) { - hcl_seterrnum (hcl, HCL_EINVAL); + hcl_seterrbfmt (hcl, HCL_EINVAL, "reader and/or printer not supplied"); return -1; }