hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implemented reading and printing of fixed-point decimal number. primitives yet to be written

Browse Source
This commit is contained in:
hyung-hwan 2018-03-28 08:57:49 +00:00
parent 25253fc0e1
commit 3a30ffda7b
5 changed files with 145 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lib/hcl-prv.h
View File

@ -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,

76
lib/hcl.h
View File

@ -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,

1
lib/obj.c
View File

@ -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
* ------------------------------------------------------------------------ */

16
lib/print.c
View File

@ -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:
{

73
lib/read.c
View File

@ -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;
}