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

cleaned up code by removing migrating unused functions
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2023-12-06 11:09:15 +09:00
parent 71abc60ef7
commit 291a999c2a
7 changed files with 102 additions and 199 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lang.txt
View File

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

85
lib/comp.c
View File

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

8
lib/fmt.c
View File

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

8
lib/hcl-prv.h
View File

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

4
lib/hcl.c
View File

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

2
lib/prim.c
View File

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

192
lib/read.c
View File

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