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

working on the block expression compilation
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2023-11-10 00:03:03 +09:00
parent 9110a083eb
commit 5a28ab3749
36 changed files with 1108 additions and 1044 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
bin/main.c
View File

@ -97,6 +97,7 @@ struct xtn_t
const char* udo_path; const char* udo_path;
int vm_running; int vm_running;
int extra_cflags;
/*hcl_oop_t sym_errstr;*/ /*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) 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); execute_in_interactive_mode (hcl);
return 0; 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) static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
{ {
FILE* fp = HCL_NULL; 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 /* override the default cnode handler. the default one simply
* compiles the expression node without execution */ * 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)); hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot begin feed - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl));
goto oops; 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() */ /* [NOTE] it isn't a very nice idea to get this internal data and use it with read_input() */
while (1) 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 (is_tty)
if (xlen > 0 && hcl_feedbchars(hcl, buf, xlen) <= -1) goto feed_error;
if (xlen < HCL_COUNTOF(buf))
{ {
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)); if (ferror(fp))
goto oops; {
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; bch = ch;
if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error; if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error;
#endif }
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) if (hcl_endfeed(hcl) <= -1)
@ -549,7 +562,7 @@ int main (int argc, char* argv[])
}; };
static hcl_bopt_t opt = static hcl_bopt_t opt =
{ {
"l:v", "l:xv",
lopt lopt
}; };
@ -557,7 +570,7 @@ int main (int argc, char* argv[])
hcl_oow_t heapsize = DEFAULT_HEAPSIZE; hcl_oow_t heapsize = DEFAULT_HEAPSIZE;
int verbose = 0; int verbose = 0;
int show_info = 0; int show_info = 0;
/*int experimental = 0;*/ int experimental = 0;
#if defined(HCL_BUILD_DEBUG) #if defined(HCL_BUILD_DEBUG)
const char* dbgopt = HCL_NULL; const char* dbgopt = HCL_NULL;
@ -581,9 +594,9 @@ int main (int argc, char* argv[])
logopt = opt.arg; logopt = opt.arg;
break; break;
/*case 'x': case 'x':
experimental = 1; experimental = 1;
break;*/ break;
case 'v': case 'v':
verbose = 1; verbose = 1;
@ -695,6 +708,7 @@ int main (int argc, char* argv[])
goto oops; goto oops;
} }
if (experimental) xtn->extra_cflags |= HCL_COMPILE_ENABLE_BLOCK;
xtn->cci_path = argv[opt.ind++]; /* input source code file */ xtn->cci_path = argv[opt.ind++]; /* input source code file */
if (opt.ind < argc) xtn->udo_path = argv[opt.ind++]; if (opt.ind < argc) xtn->udo_path = argv[opt.ind++];

432
lib/bigint.c
View File

File diff suppressed because it is too large Load Diff

6
lib/cnode.c
View File

@ -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_oocs_t empty;
hcl_ooch_t dummy; hcl_ooch_t dummy;
if (!tok) if (!tok)
{ {
empty.ptr = &dummy; empty.ptr = &dummy;
empty.len = 0; empty.len = 0;
@ -193,9 +193,7 @@ redo:
HCL_ASSERT (hcl, tmp1 != HCL_NULL); HCL_ASSERT (hcl, tmp1 != HCL_NULL);
hcl_freemem (hcl, c); hcl_freemem (hcl, c);
hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */ hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */
if (tmp2) if (tmp2)
{ {
c = tmp2; c = tmp2;
@ -210,9 +208,7 @@ redo:
hcl_cnode_t* tmp; hcl_cnode_t* tmp;
tmp = c->u.shell.obj; tmp = c->u.shell.obj;
hcl_freemem (hcl, c); hcl_freemem (hcl, c);
if (tmp) if (tmp)
{ {
c = tmp; c = tmp;

388
lib/comp.c
View File

File diff suppressed because it is too large Load Diff

14
lib/decode.c
View File

@ -376,7 +376,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
case HCL_CODE_CLASS_ENTER: case HCL_CODE_CLASS_ENTER:
{ {
hcl_oow_t b3; hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2); FETCH_PARAM_CODE_TO (hcl, b2);
FETCH_PARAM_CODE_TO (hcl, b3); 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); FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "pop_into_cvar_i %zu", b1); LOG_INST_1 (hcl, "pop_into_cvar_i %zu", b1);
break; break;
/* -------------------------------------------------------- */ /* -------------------------------------------------------- */
case HCL_CODE_PUSH_CVAR_M_X: case HCL_CODE_PUSH_CVAR_M_X:
FETCH_PARAM_CODE_TO (hcl, b1); 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: case HCL_CODE_MAKE_FUNCTION:
{ {
hcl_oow_t b3, b4; hcl_oow_t b3, b4;
/* b1 - block mask /* b1 - block mask
* b2 - block mask * b2 - block mask
* b3 - base literal frame start * b3 - base literal frame start
* b4 - base literal frame end */ * 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); FETCH_PARAM_CODE_TO (hcl, b4);
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2; 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_INSTA(b1),
GET_BLK_MASK_VA(b1), GET_BLK_MASK_VA(b1),
GET_BLK_MASK_NARGS(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; break;
} }
case HCL_CODE_MAKE_BLOCK: case HCL_CODE_MAKE_LAMBDA:
/* b1 - block mask /* b1 - block mask
* b2 - block mask */ * b2 - block mask */
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2); FETCH_PARAM_CODE_TO (hcl, b2);
b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | 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_INSTA(b1),
GET_BLK_MASK_VA(b1), GET_BLK_MASK_VA(b1),
GET_BLK_MASK_NARGS(b1), GET_BLK_MASK_NARGS(b1),

30
lib/dic.c
View File

@ -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 < 400000) newsz = oldsz + (oldsz / 16);
else if (oldsz < 800000) newsz = oldsz + (oldsz / 32); else if (oldsz < 800000) newsz = oldsz + (oldsz / 32);
else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64); else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64);
else else
{ {
hcl_oow_t inc, inc_max; hcl_oow_t inc, inc_max;
inc = oldsz / 128; inc = oldsz / 128;
inc_max = HCL_OBJ_SIZE_MAX - oldsz; inc_max = HCL_OBJ_SIZE_MAX - oldsz;
if (inc > inc_max) if (inc > inc_max)
{ {
if (inc_max > 0) inc = inc_max; if (inc_max > 0) inc = inc_max;
else 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); 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); hcl_popvolat (hcl);
if (!newbuc) return HCL_NULL; 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 #endif
/* find */ /* find */
while (dic->bucket->slot[index] != hcl->_nil) while (dic->bucket->slot[index] != hcl->_nil)
{ {
#if defined(SYMBOL_ONLY_KEY) #if defined(SYMBOL_ONLY_KEY)
ass = (hcl_oop_cons_t)dic->bucket->slot[index]; 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)); HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car));
if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(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. */ /* the value of HCL_NULL indicates no insertion or update. */
if (value) ass->cdr = value; /* 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); tally = HCL_OOP_TO_SMOOI(dic->tally);
if (tally >= HCL_SMOOI_MAX) 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_SMOOI_MAX items for efficiency sake */
hcl_seterrnum (hcl, HCL_EDFULL); hcl_seterrnum (hcl, HCL_EDFULL);
return HCL_NULL; 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. /* no conversion to hcl_oow_t is necessary for tally + 1.
* the maximum value of tally is checked to be HCL_SMOOI_MAX - 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). */ * HCL_SMOOI_MAX is way smaller than HCL_TYPE_MAX(hcl_ooi_t). */
if (tally + 1 >= HCL_OBJ_GET_SIZE(dic->bucket)) 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); index %= HCL_OBJ_GET_SIZE(dic->bucket);
#endif #endif
while (dic->bucket->slot[index] != hcl->_nil) while (dic->bucket->slot[index] != hcl->_nil)
index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket); 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 */ * the key isn't found in the root dictionary */
ass = (hcl_oop_cons_t)hcl_makecons(hcl, (hcl_oop_t)key, value); ass = (hcl_oop_cons_t)hcl_makecons(hcl, (hcl_oop_t)key, value);
if (!ass) goto oops; 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); 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)); HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass));
if (HCL_IS_SYMBOL(hcl, ass->car)) if (HCL_IS_SYMBOL(hcl, ass->car))
{ {
if (name->len == HCL_OBJ_GET_SIZE(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; 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 */ /* when value is HCL_NULL, perform no insertion */
/* hcl_seterrXXX() is not called here. the dictionary lookup is very frequent /* hcl_seterrXXX() is not called here. the dictionary lookup is very frequent
* and so is lookup failure. for instance, hcl_findmethod() calls this over * 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 * a class chain. there might be a failure at each class level. it's waste to
* set the error information whenever the failure occurs. * set the error information whenever the failure occurs.
* the caller of this function must set the error information upon failure */ * 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 #endif
/* find */ /* find */
while (dic->bucket->slot[index] != hcl->_nil) while (dic->bucket->slot[index] != hcl->_nil)
{ {
#if defined(SYMBOL_ONLY_KEY) #if defined(SYMBOL_ONLY_KEY)
ass = (hcl_oop_cons_t)dic->bucket->slot[index]; 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)); HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car));
if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(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. */ /* the value of HCL_NULL indicates no insertion or update. */
goto found; goto found;

4
lib/err.c
View File

@ -160,7 +160,9 @@ static char* synerrstr[] =
"unbalanced key/value pair", "unbalanced key/value pair",
"unbalanced parenthesis/brace/bracket", "unbalanced parenthesis/brace/bracket",
"empty x-list", "empty x-list",
"empty m-list" "empty m-list",
"block expression expected"
"block expression disallowed"
}; };
/* -------------------------------------------------------------------------- /* --------------------------------------------------------------------------

382
lib/exec.c
View File

File diff suppressed because it is too large Load Diff

46
lib/fmt-imp.h
View File

@ -25,7 +25,7 @@
*/ */
static int fmt_uintmax ( static int fmt_uintmax (
char_t* buf, int size, char_t* buf, int size,
hcl_uintmax_t value, int base_and_flags, int prec, hcl_uintmax_t value, int base_and_flags, int prec,
char_t fillchar, char_t signchar, const char_t* prefix) char_t fillchar, char_t signchar, const char_t* prefix)
{ {
@ -41,10 +41,10 @@ static int fmt_uintmax (
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ": "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ":
"0123456789abcdefghijklmnopqrstuvwxyz"; "0123456789abcdefghijklmnopqrstuvwxyz";
if ((base_and_flags & HCL_FMT_INTMAX_NOZERO) && value == 0) if ((base_and_flags & HCL_FMT_INTMAX_NOZERO) && value == 0)
{ {
p = tmp; p = tmp;
if (base_and_flags & HCL_FMT_INTMAX_ZEROLEAD) if (base_and_flags & HCL_FMT_INTMAX_ZEROLEAD)
{ {
/* NOZERO emits no digit, ZEROLEAD emits 1 digit. /* NOZERO emits no digit, ZEROLEAD emits 1 digit.
* so it emits '0' */ * so it emits '0' */
@ -63,7 +63,7 @@ static int fmt_uintmax (
hcl_uintmax_t v = value; hcl_uintmax_t v = value;
/* store the resulting numeric string into 'tmp' first */ /* store the resulting numeric string into 'tmp' first */
p = tmp; p = tmp;
do do
{ {
*p++ = xbasestr[v % base]; *p++ = xbasestr[v % base];
@ -73,11 +73,11 @@ static int fmt_uintmax (
/* reslen is the length of the resulting string without padding. */ /* reslen is the length of the resulting string without padding. */
reslen = (int)(p - tmp); reslen = (int)(p - tmp);
/* precision specified the minum number of digits to produce. /* 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 */ * reslen should be adjusted to precision */
if (prec > reslen) if (prec > reslen)
{ {
/* if the precision is greater than the actual digits /* if the precision is greater than the actual digits
* made from the value, 0 is inserted in front. * made from the value, 0 is inserted in front.
@ -86,12 +86,12 @@ static int fmt_uintmax (
preczero = prec - reslen; preczero = prec - reslen;
reslen = prec; reslen = prec;
} }
else else
{ {
preczero = 0; 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. */ * so ZEROLEAD don't need to add another 0. */
preczero++; preczero++;
reslen++; reslen++;
@ -137,10 +137,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */ /* add 0s for precision */
while (preczero > 0 && bp < be) while (preczero > 0 && bp < be)
{ {
*bp++ = '0'; *bp++ = '0';
preczero--; preczero--;
} }
/* copy the numeric string to the destination buffer */ /* copy the numeric string to the destination buffer */
@ -169,10 +169,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */ /* add 0s for precision */
while (preczero > 0 && bp < be) while (preczero > 0 && bp < be)
{ {
*bp++ = '0'; *bp++ = '0';
preczero--; preczero--;
} }
/* copy the numeric string to the destination buffer */ /* copy the numeric string to the destination buffer */
@ -194,10 +194,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */ /* add 0s for precision */
while (preczero > 0 && bp < be) while (preczero > 0 && bp < be)
{ {
*bp++ = '0'; *bp++ = '0';
preczero--; preczero--;
} }
/* copy the numeric string to the destination buffer */ /* copy the numeric string to the destination buffer */
@ -213,10 +213,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++; if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */ /* add 0s for precision */
while (preczero > 0 && bp < be) while (preczero > 0 && bp < be)
{ {
*bp++ = '0'; *bp++ = '0';
preczero--; preczero--;
} }
/* copy the numeric string to the destination buffer */ /* copy the numeric string to the destination buffer */

4
lib/fmt.c
View File

@ -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; ucslen = b->capa - b->len;
n = hcl_conv_bchars_to_uchars_with_cmgr(ptr, &bcslen, &b->ptr[b->len], &ucslen, b->hcl->_cmgr, 1); n = hcl_conv_bchars_to_uchars_with_cmgr(ptr, &bcslen, &b->ptr[b->len], &ucslen, b->hcl->_cmgr, 1);
b->len += ucslen; b->len += ucslen;
if (n <= -1) if (n <= -1)
{ {
if (n == -2) if (n == -2)
{ {
return 0; /* buffer full. stop */ return 0; /* buffer full. stop */
} }

56
lib/gc.c
View File

@ -31,7 +31,7 @@
#include <sys/resource.h> /* getrusage */ #include <sys/resource.h> /* getrusage */
#endif #endif
static struct static struct
{ {
hcl_oow_t len; hcl_oow_t len;
hcl_ooch_t ptr[20]; 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); HCL_ASSERT (hcl, hcl->symtab->bucket->slot[index] != _nil);
for (i = 0, x = index, y = index; i < bucket_size; i++) for (i = 0, x = index, y = index; i < bucket_size; i++)
{ {
y = (y + 1) % bucket_size; 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 */ /* done if the slot at the current hash index is _nil */
if (hcl->symtab->bucket->slot[y] == _nil) break; 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 */ * at the current hash index */
symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[y]; 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; hcl_oow_t nbytes;
/* only an OOP object can have the trailer. /* only an OOP object can have the trailer.
* *
* | _flags | * | _flags |
* | _size | <-- if it's 3 * | _size | <-- if it's 3
@ -149,7 +149,7 @@ hcl_oow_t hcl_getobjpayloadbytes (hcl_t* hcl, hcl_oop_t oop)
* | X | * | X |
* | Y | <-- it may exist if EXTRA is set in _flags. * | Y | <-- it may exist if EXTRA is set in _flags.
* | Z | <-- if TRAILER is set, it is the number of bytes in the trailer * | 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_TYPE(oop) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t)); 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? */ * determine that it is an instance of process? */
if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop)))
{ {
/* the stack in a process object doesn't need to be /* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer * scanned in full. the slots above the stack pointer
* are garbages. */ * are garbages. */
size = HCL_PROCESS_NAMED_INSTVARS + HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1; 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)); 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) if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS)
{ {
hcl_oop_process_t proc; hcl_oop_process_t proc;
/* the stack in a process object doesn't need to be /* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer * scanned in full. the slots above the stack pointer
* are garbages. */ * are garbages. */
proc = (hcl_oop_process_t)oop; 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; hcl_oow_t gcfin_count;
#endif #endif
hcl_cb_t* cb; hcl_cb_t* cb;
#if defined(HCL_PROFILE_VM) #if defined(HCL_PROFILE_VM)
struct rusage ru; struct rusage ru;
hcl_ntime_t rut; 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++) 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. */ * 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]); 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 #if 0
void hcl_gc (hcl_t* hcl) void hcl_gc (hcl_t* hcl)
{ {
/* /*
* move a referenced object to the new heap. * move a referenced object to the new heap.
* inspect the fields of the moved object in 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. * 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->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", "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 */ * in the permanant heap. minimize moving around */
old_nil = hcl->_nil; old_nil = hcl->_nil;
@ -603,7 +603,7 @@ void hcl_gc (hcl_t* hcl)
for (i = 0; i < hcl->code.lit.len; i++) 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. */ * pointed by the elements of this array must be gabage-collected. */
((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i] = ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i] =
hcl_moveoop(hcl, ((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. /* traverse the symbol table for unreferenced symbols.
* if the symbol has not moved to the new heap, the symbol * 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 */ * table itself */
compact_symbol_table (hcl, old_nil); 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); hcl->symtab = (hcl_oop_dic_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->symtab);
/* scan the new heap again from the end position of /* 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. */ * the symbol table. */
ptr = scan_new_heap (hcl, ptr); ptr = scan_new_heap (hcl, ptr);
@ -696,7 +696,7 @@ void hcl_gc (hcl_t* hcl)
buc = (hcl_oop_oop_t) hcl->symtab->bucket; buc = (hcl_oop_oop_t) hcl->symtab->bucket;
for (index = 0; index < HCL_OBJ_GET_SIZE(buc); index++) 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]); 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 */ 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 */ /* 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", "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 #endif
@ -774,13 +774,13 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
if (HCL_UNLIKELY(!hcl->_undef)) return -1; if (HCL_UNLIKELY(!hcl->_undef)) return -1;
} }
if (!hcl->_nil) if (!hcl->_nil)
{ {
hcl->_nil = hcl_makenil(hcl); hcl->_nil = hcl_makenil(hcl);
if (HCL_UNLIKELY(!hcl->_nil)) return -1; if (HCL_UNLIKELY(!hcl->_nil)) return -1;
} }
if (!hcl->_true) if (!hcl->_true)
{ {
hcl->_true = hcl_maketrue(hcl); hcl->_true = hcl_maketrue(hcl);
if (HCL_UNLIKELY(!hcl->_true)) return -1; 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); hcl->symtab = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_symtab_size);
if (HCL_UNLIKELY(!hcl->symtab)) return -1; 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) if (!hcl->code.dbgi)
{ {
hcl->code.dbgi = (hcl_dbgi_t*)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.dbgi) * HCL_BC_BUFFER_INIT); 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 */ /* bc.ptr and dbgi go together. so free bc.ptr if dbgi allocation fails */
hcl_freemem (hcl, hcl->code.bc.ptr); 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; hcl_oow_t i;
for (i = 0; i < HCL_COUNTOF(syminfo); 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 syminfo[i].syncode;
} }
return 0; /* 0 indicates no syntax code found */ 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; hcl_oow_t i;
for (i = 0; i < HCL_COUNTOF(syminfo); 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 syminfo[i].syncode;
} }
return 0; /* 0 indicates no syntax code found */ return 0; /* 0 indicates no syntax code found */

44
lib/hcl-c.c
View File

@ -119,9 +119,9 @@ struct hcl_client_t
int in_data_part; int in_data_part;
int negated; int negated;
hcl_oow_t max; /* chunk length */ hcl_oow_t max; /* chunk length */
hcl_oow_t tally; hcl_oow_t tally;
hcl_oow_t total; hcl_oow_t total;
hcl_oow_t clcount; hcl_oow_t clcount;
} chunked_data; } chunked_data;
} u; } u;
} rep; } 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) 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; 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) 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; *value = v;
return 1; return 1;
} }
static HCL_INLINE hcl_ooch_t unescape (hcl_ooch_t c) 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; if (add_to_reply_token(client, c) <= -1) goto oops;
break; break;
} }
else if (is_spacechar(c)) else if (is_spacechar(c))
{ {
/* skip whitespaces at the beginning of the start line before the reply name */ /* skip whitespaces at the beginning of the start line before the reply name */
break; 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; client->rep.u.reply_value_quoted.escaped = 0;
break; break;
} }
else else
{ {
/* the first value character has been encountered */ /* the first value character has been encountered */
client->state = HCL_CLIENT_STATE_IN_REPLY_VALUE_UNQUOTED; 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"); hcl_client_seterrbfmt (client, HCL_EFINIS, "sudden end of reply line without closing quote");
goto oops; goto oops;
} }
else else
{ {
if (client->rep.u.reply_value_quoted.escaped) 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') else if (c == '\n')
{ {
reply_value_end: 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 * 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 * to be in UTF-8 encoding. this is different from the data in the
* long-format reply which is treated as octet stream */ * 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) if (client->rep.tok.len > client->rep.last_attr_key.capa)
{ {
hcl_ooch_t* tmp; 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)); 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; 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; client->rep.u.attr_value_quoted.escaped = 0;
break; break;
} }
else else
{ {
/* the first value character has been encountered */ /* the first value character has been encountered */
client->state = HCL_CLIENT_STATE_IN_ATTR_VALUE_UNQUOTED; 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"); hcl_client_seterrbfmt (client, HCL_EFINIS, "sudden end of attribute value without closing quote");
goto oops; goto oops;
} }
else else
{ {
if (client->rep.u.attr_value_quoted.escaped) 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; client->state = HCL_CLIENT_STATE_IN_LENGTH_BOUNDED_DATA;
/* [NOTE] the max length for the length-bounded transfer scheme is limited /* [NOTE] the max length for the length-bounded transfer scheme is limited
* by the system word size as of this implementation */ * 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; client->rep.u.length_bounded_data.tally = 0;
} }
else else
@ -630,8 +630,8 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes)
} }
return 0; return 0;
oops: oops:
return -1; 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; client->rep.u.chunked_data.negated = 1;
} }
else if (bc == ':') else if (bc == ':')
{ {
if (client->rep.u.chunked_data.clcount == 0) 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; 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.max = client->rep.u.chunked_data.max * 10 + (bc - '0');
client->rep.u.chunked_data.clcount++; 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_xtn_t* xtn;
client = (hcl_client_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*client) + xtnsize); client = (hcl_client_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*client) + xtnsize);
if (!client) if (!client)
{ {
if (errnum) *errnum = HCL_ESYSMEM; if (errnum) *errnum = HCL_ESYSMEM;
return HCL_NULL; return HCL_NULL;
} }
hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum); hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum);
if (!hcl) if (!hcl)
{ {
HCL_MMGR_FREE (mmgr, client); HCL_MMGR_FREE (mmgr, client);
return HCL_NULL; 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; client->cfg.logmask = ~(hcl_bitmask_t)0;
/* the dummy hcl is used for this client to perform primitive operations /* 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. */ * need to be changed from the tiny value set above. */
hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, &client->cfg.logmask); hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, &client->cfg.logmask);
hcl_setcmgr (client->dummy_hcl, client->_cmgr); 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: case HCL_CLIENT_LOG_MASK:
client->cfg.logmask = *(const hcl_bitmask_t*)value; client->cfg.logmask = *(const hcl_bitmask_t*)value;
if (client->dummy_hcl) if (client->dummy_hcl)
{ {
/* setting this affects the dummy hcl immediately. /* setting this affects the dummy hcl immediately.
* existing hcl instances inside worker threads won't get * existing hcl instances inside worker threads won't get
* affected. new hcl instances to be created later * affected. new hcl instances to be created later
* is supposed to use the new value */ * is supposed to use the new value */
hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, value); hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, value);
} }

4
lib/hcl-dos.h
View File

@ -81,7 +81,7 @@
# define HCL_SIZEOF_MBSTATE_T HCL_SIZEOF_LONG # define HCL_SIZEOF_MBSTATE_T HCL_SIZEOF_LONG
# define HCL_MBLEN_MAX 8 # define HCL_MBLEN_MAX 8
#elif defined(__TURBOC__) #elif defined(__TURBOC__)
/* TODO: be more version specific wchar_t may be available in newer BCC */ /* TODO: be more version specific wchar_t may be available in newer BCC */
# define HCL_SIZEOF_CHAR 1 # define HCL_SIZEOF_CHAR 1
# define HCL_SIZEOF_SHORT 2 # define HCL_SIZEOF_SHORT 2
@ -92,7 +92,7 @@
# define HCL_SIZEOF_VOID_P 4 # define HCL_SIZEOF_VOID_P 4
# define HCL_SIZEOF_FLOAT 4 # define HCL_SIZEOF_FLOAT 4
# define HCL_SIZEOF_DOUBLE 8 # 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_WCHAR_T 0
# define HCL_SIZEOF___INT8 0 # define HCL_SIZEOF___INT8 0

2
lib/hcl-json.h
View File

@ -29,7 +29,7 @@
#include <hcl.h> #include <hcl.h>
/** /**
* The hcl_json_t type defines a simple json parser. * The hcl_json_t type defines a simple json parser.
*/ */
typedef struct hcl_json_t hcl_json_t; typedef struct hcl_json_t hcl_json_t;

2
lib/hcl-mac.h
View File

@ -26,7 +26,7 @@
/* This file is for class Mac OS */ /* This file is for class Mac OS */
/* Mac OS on PPC and m68k uses the big endian mode */ /* Mac OS on PPC and m68k uses the big endian mode */
#define HCL_ENDIAN_BIG #define HCL_ENDIAN_BIG
#if defined(__MWERKS__) #if defined(__MWERKS__)
# define HCL_SIZEOF_CHAR 1 # define HCL_SIZEOF_CHAR 1

22
lib/hcl-msw.h
View File

@ -25,23 +25,23 @@
*/ */
/* /*
Macro Meaning Macro Meaning
_WIN64 A 64-bit platform. _WIN64 A 64-bit platform.
_WIN32 A 32-bit platform. This value is also defined by the 64-bit _WIN32 A 32-bit platform. This value is also defined by the 64-bit
compiler for backward compatibility. compiler for backward compatibility.
_WIN16 A 16-bit platform _WIN16 A 16-bit platform
The following macros are specific to the architecture. The following macros are specific to the architecture.
Macro Meaning Macro Meaning
_M_IA64 Intel Itanium Processor Family _M_IA64 Intel Itanium Processor Family
_M_IX86 x86 platform _M_IX86 x86 platform
_M_X64 x64 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. */ * make it selective to support old non-x86 windows platforms. */
#define HCL_ENDIAN_LITTLE #define HCL_ENDIAN_LITTLE
#if defined(__WATCOMC__) #if defined(__WATCOMC__)
# define HCL_SIZEOF_CHAR 1 # define HCL_SIZEOF_CHAR 1

20
lib/hcl-opt.h
View File

@ -30,8 +30,8 @@
#include "hcl-cmn.h" #include "hcl-cmn.h"
/** \file /** \file
* This file defines functions and data structures to process * This file defines functions and data structures to process
* command-line arguments. * command-line arguments.
*/ */
typedef struct hcl_uopt_t hcl_uopt_t; 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 */ hcl_uch_t* arg; /* argument associated with an option */
/* output */ /* output */
const hcl_uch_t* lngopt; const hcl_uch_t* lngopt;
/* input + output */ /* input + output */
int ind; /* index into parent argv vector */ int ind; /* index into parent argv vector */
@ -83,7 +83,7 @@ struct hcl_bopt_t
hcl_bch_t* arg; /* argument associated with an option */ hcl_bch_t* arg; /* argument associated with an option */
/* output */ /* output */
const hcl_bch_t* lngopt; const hcl_bch_t* lngopt;
/* input + output */ /* input + output */
int ind; /* index into parent argv vector */ int ind; /* index into parent argv vector */
@ -98,27 +98,27 @@ extern "C" {
/** /**
* The hcl_getopt() function processes the \a argc command-line arguments * 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 * pointed to by \a argv as configured in \a opt. It can process two
* different option styles: a single character starting with '-', and a * different option styles: a single character starting with '-', and a
* long name starting with '--'. * long name starting with '--'.
* *
* A character in \a opt.str is treated as a single character option. Should * A character in \a opt.str is treated as a single character option. Should
* it require a parameter, specify ':' after it. * 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 option stored in the \a opt->opt field.
* - \b : indicates a bad parameter for an 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. * @return an option character on success, HCL_CHAR_EOF on no more options.
*/ */
HCL_EXPORT hcl_uci_t hcl_getuopt ( HCL_EXPORT hcl_uci_t hcl_getuopt (
int argc, /* argument count */ int argc, /* argument count */
hcl_uch_t* const* argv, /* argument array */ hcl_uch_t* const* argv, /* argument array */
hcl_uopt_t* opt /* option configuration */ hcl_uopt_t* opt /* option configuration */
); );
HCL_EXPORT hcl_bci_t hcl_getbopt ( HCL_EXPORT hcl_bci_t hcl_getbopt (
int argc, /* argument count */ int argc, /* argument count */
hcl_bch_t* const* argv, /* argument array */ hcl_bch_t* const* argv, /* argument array */
hcl_bopt_t* opt /* option configuration */ hcl_bopt_t* opt /* option configuration */
); );

9
lib/hcl-prv.h
View File

@ -641,6 +641,9 @@ struct hcl_frd_t
struct hcl_compiler_t struct hcl_compiler_t
{ {
/* flags passed in via hcl_compile() */
int flags;
/* callback pointer registerd upon compiler creation */ /* callback pointer registerd upon compiler creation */
hcl_cb_t* cbp; 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. * 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 | * | SIGN | INSTA | VA | NARGS | NRVARS | NLVARS | TAG |
* 1 1 8 8 11 2 <= 32 * 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 * | INSTA | VA | NARGS | NRVARS | NLVARS
* 1 1 4 4 6 <= 16 (HCL_CODE_LONG_PARAM_SIZE 1, two params) * 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) * 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_RETURN_FROM_BLOCK = 0xFC, /* 252, return the stack top from a block */
HCL_CODE_MAKE_FUNCTION = 0xFD, /* 253 */ HCL_CODE_MAKE_FUNCTION = 0xFD, /* 253 */
HCL_CODE_MAKE_BLOCK = 0xFE, /* 254 */ HCL_CODE_MAKE_LAMBDA = 0xFE, /* 254 */
HCL_CODE_NOOP = 0xFF /* 255 */ HCL_CODE_NOOP = 0xFF /* 255 */
}; };

122
lib/hcl-rbt.h
View File

@ -31,37 +31,37 @@
/** \file /** \file
* This file provides a red-black tree encapsulated in the #hcl_rbt_t type that * 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. * to #hcl_htb_t.
* *
* This sample code adds a series of keys and values and print them * This sample code adds a series of keys and values and print them
* in descending key order. * in descending key order.
* \code * \code
* #include <hcl-rbt.h> * #include <hcl-rbt.h>
* *
* static hcl_rbt_walk_t walk (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, void* ctx) * 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"), * hcl_printf (HCL_T("key = %d, value = %d\n"),
* *(int*)HCL_RBT_KPTR(pair), *(int*)HCL_RBT_VPTR(pair)); * *(int*)HCL_RBT_KPTR(pair), *(int*)HCL_RBT_VPTR(pair));
* return HCL_RBT_WALK_FORWARD; * return HCL_RBT_WALK_FORWARD;
* } * }
* *
* int main () * int main ()
* { * {
* hcl_rbt_t* s1; * hcl_rbt_t* s1;
* int i; * int i;
* *
* s1 = hcl_rbt_open(HCL_MMGR_GETDFL(), 0, 1, 1); // error handling skipped * 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)); * hcl_rbt_setstyle(s1, hcl_get_rbt_style(HCL_RBT_STYLE_INLINE_COPIERS));
* *
* for (i = 0; i < 20; i++) * for (i = 0; i < 20; i++)
* { * {
* int x = i * 20; * int x = i * 20;
* hcl_rbt_insert (s1, &i, HCL_SIZEOF(i), &x, HCL_SIZEOF(x)); // eror handling skipped * hcl_rbt_insert (s1, &i, HCL_SIZEOF(i), &x, HCL_SIZEOF(x)); // eror handling skipped
* } * }
* *
* hcl_rbt_rwalk (s1, walk, HCL_NULL); * hcl_rbt_rwalk (s1, walk, HCL_NULL);
* *
* hcl_rbt_close (s1); * hcl_rbt_close (s1);
* return 0; * return 0;
* } * }
@ -71,7 +71,7 @@
typedef struct hcl_rbt_t hcl_rbt_t; typedef struct hcl_rbt_t hcl_rbt_t;
typedef struct hcl_rbt_pair_t hcl_rbt_pair_t; typedef struct hcl_rbt_pair_t hcl_rbt_pair_t;
/** /**
* The hcl_rbt_walk_t type defines values that the callback function can * The hcl_rbt_walk_t type defines values that the callback function can
* return to control hcl_rbt_walk() and hcl_rbt_rwalk(). * 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) ( typedef void* (*hcl_rbt_copier_t) (
hcl_rbt_t* rbt /**< red-black tree */, 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 */ 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. * key is greater than the second key, -1 otherwise.
*/ */
typedef int (*hcl_rbt_comper_t) ( 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 */ const void* kptr1, /**< key pointer */
hcl_oow_t klen1, /**< key length */ hcl_oow_t klen1, /**< key length */
const void* kptr2, /**< key pointer */ const void* kptr2, /**< key pointer */
hcl_oow_t klen2 /**< key length */ 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 * 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. * pointers and lengths are equal.
*/ */
typedef void (*hcl_rbt_keeper_t) ( 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_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 * 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 * \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 * 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 * 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. * newly reallocated pair. It must return #HCL_NULL for failure.
*/ */
typedef hcl_rbt_pair_t* (*hcl_rbt_cbserter_t) ( 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; 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 * 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 * 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 * a value plus their length. The length is scaled down with the scale factor
* specified in an owning tree. Use macros defined in the * specified in an owning tree. Use macros defined in the
*/ */
struct hcl_rbt_pair_t struct hcl_rbt_pair_t
{ {
@ -202,8 +202,8 @@ struct hcl_rbt_pair_t
typedef struct hcl_rbt_style_t hcl_rbt_style_t; typedef struct hcl_rbt_style_t hcl_rbt_style_t;
/** /**
* The hcl_rbt_style_t type defines callback function sets for key/value * The hcl_rbt_style_t type defines callback function sets for key/value
* pair manipulation. * pair manipulation.
*/ */
struct hcl_rbt_style_t 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. * functions for data construction, destruction, comparison, etc.
* The callback structure pointed to by \a style must outlive the tree * 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. * structure.
*/ */
HCL_EXPORT void hcl_rbt_setstyle ( 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 * matching key. It returns the pointer to the pair found. If it fails
* to find one, it returns HCL_NULL. * 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. * or HCL_NULL if no match is found.
*/ */
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_search ( 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 * 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. * pair updated or inserted.
* \return a pointer to the updated or inserted pair on success, * \return a pointer to the updated or inserted pair on success,
* HCL_NULL on failure. * HCL_NULL on failure.
*/ */
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_upsert ( HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_upsert (
hcl_rbt_t* rbt, /**< red-black tree */ 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 * 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. * 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_EXPORT hcl_rbt_pair_t* hcl_rbt_ensert (
hcl_rbt_t* rbt, /**< red-black tree */ 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 * 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. * 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_EXPORT hcl_rbt_pair_t* hcl_rbt_insert (
hcl_rbt_t* rbt, /**< red-black tree */ 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, * allocation to a callback function. Depending on the callback function,
* it may behave like hcl_rbt_insert(), hcl_rbt_upsert(), hcl_rbt_update(), * it may behave like hcl_rbt_insert(), hcl_rbt_upsert(), hcl_rbt_update(),
* hcl_rbt_ensert(), or totally differently. The sample code below inserts * 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)); * (int)HCL_RBT_VLEN(pair), HCL_RBT_VPTR(pair), (int)HCL_RBT_VLEN(pair));
* return HCL_RBT_WALK_FORWARD; * return HCL_RBT_WALK_FORWARD;
* } * }
* *
* hcl_rbt_pair_t* cbserter ( * hcl_rbt_pair_t* cbserter (
* hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, * hcl_rbt_t* rbt, hcl_rbt_pair_t* pair,
* void* kptr, hcl_oow_t klen, void* ctx) * 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; * hcl_cstr_t* v = (hcl_cstr_t*)ctx;
* if (pair == HCL_NULL) * 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); * return hcl_rbt_allocpair (rbt, kptr, klen, v->ptr, v->len);
* } * }
* else * else
* { * {
* // a pair with the key exists. * // a pair with the key exists.
* // in this sample, i will append the new value to the old value * // in this sample, i will append the new value to the old value
* // separated by a comma * // separated by a comma
* hcl_rbt_pair_t* new_pair; * hcl_rbt_pair_t* new_pair;
* hcl_ooch_t comma = HCL_T(','); * hcl_ooch_t comma = HCL_T(',');
* hcl_oob_t* vptr; * hcl_oob_t* vptr;
* *
* // allocate a new pair, but without filling the actual value. * // allocate a new pair, but without filling the actual value.
* // note vptr is given HCL_NULL for that purpose * // note vptr is given HCL_NULL for that purpose
* new_pair = hcl_rbt_allocpair ( * 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; * if (new_pair == HCL_NULL) return HCL_NULL;
* *
* // fill in the value space * // fill in the value space
* vptr = new_pair->vptr; * vptr = new_pair->vptr;
* hcl_memcpy (vptr, pair->vptr, pair->vlen*HCL_SIZEOF(hcl_ooch_t)); * hcl_memcpy (vptr, pair->vptr, pair->vlen*HCL_SIZEOF(hcl_ooch_t));
* 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)); * hcl_memcpy (vptr, &comma, HCL_SIZEOF(hcl_ooch_t));
* vptr += HCL_SIZEOF(hcl_ooch_t); * vptr += HCL_SIZEOF(hcl_ooch_t);
* hcl_memcpy (vptr, v->ptr, v->len*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); * hcl_rbt_freepair (rbt, pair);
* *
* // return the new pair * // return the new pair
* return new_pair; * return new_pair;
* } * }
* } * }
* *
* int main () * int main ()
* { * {
* hcl_rbt_t* s1; * hcl_rbt_t* s1;
* int i; * int i;
* hcl_ooch_t* keys[] = { HCL_T("one"), HCL_T("two"), HCL_T("three") }; * 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") }; * hcl_ooch_t* vals[] = { HCL_T("1"), HCL_T("2"), HCL_T("3"), HCL_T("4"), HCL_T("5") };
* *
* s1 = hcl_rbt_open ( * s1 = hcl_rbt_open (
* HCL_MMGR_GETDFL(), 0, * HCL_MMGR_GETDFL(), 0,
* HCL_SIZEOF(hcl_ooch_t), HCL_SIZEOF(hcl_ooch_t) * 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); * hcl_rbt_setstyle (s1, &style1);
* *
* for (i = 0; i < HCL_COUNTOF(vals); i++) * for (i = 0; i < HCL_COUNTOF(vals); i++)
* { * {
* hcl_cstr_t ctx; * hcl_cstr_t ctx;
@ -506,7 +506,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
* ); // note error check is skipped * ); // note error check is skipped
* } * }
* hcl_rbt_walk (s1, print_map_pair, HCL_NULL); * hcl_rbt_walk (s1, print_map_pair, HCL_NULL);
* *
* hcl_rbt_close (s1); * hcl_rbt_close (s1);
* return 0; * 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 * \return 0 on success, -1 on failure
*/ */
HCL_EXPORT int hcl_rbt_delete ( 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. * from the leftmost child.
*/ */
HCL_EXPORT void hcl_rbt_walk ( 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. * from the rightmost child.
*/ */
HCL_EXPORT void hcl_rbt_rwalk ( 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. * 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. * #HCL_RBT_COPIER_INLINE.
* - If \a kptr is #HCL_NULL, the key space of the size \a klen is reserved but * - If \a kptr is #HCL_NULL, the key space of the size \a klen is reserved but
* not propagated with any data. * 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_EXPORT hcl_rbt_pair_t* hcl_rbt_allocpair (
hcl_rbt_t* rbt, hcl_rbt_t* rbt,
void* kptr, void* kptr,
hcl_oow_t klen, hcl_oow_t klen,
void* vptr, void* vptr,
hcl_oow_t vlen hcl_oow_t vlen
@ -595,7 +595,7 @@ HCL_EXPORT int hcl_rbt_dflcomp (
const void* kptr1, const void* kptr1,
hcl_oow_t klen1, hcl_oow_t klen1,
const void* kptr2, const void* kptr2,
hcl_oow_t klen2 hcl_oow_t klen2
); );
#if defined(__cplusplus) #if defined(__cplusplus)

6
lib/hcl-tmr.h
View File

@ -35,7 +35,7 @@ typedef hcl_oow_t hcl_tmr_index_t;
typedef void (*hcl_tmr_handler_t) ( typedef void (*hcl_tmr_handler_t) (
hcl_tmr_t* tmr, hcl_tmr_t* tmr,
const hcl_ntime_t* now, const hcl_ntime_t* now,
hcl_tmr_event_t* evt hcl_tmr_event_t* evt
); );
@ -72,7 +72,7 @@ extern "C" {
#endif #endif
HCL_EXPORT hcl_tmr_t* hcl_tmr_open ( HCL_EXPORT hcl_tmr_t* hcl_tmr_open (
hcl_t* mmgr, hcl_t* mmgr,
hcl_oow_t xtnsize, hcl_oow_t xtnsize,
hcl_oow_t capa hcl_oow_t capa
); );
@ -82,7 +82,7 @@ HCL_EXPORT void hcl_tmr_close (
); );
HCL_EXPORT int hcl_tmr_init ( HCL_EXPORT int hcl_tmr_init (
hcl_tmr_t* tmr, hcl_tmr_t* tmr,
hcl_t* mmgr, hcl_t* mmgr,
hcl_oow_t capa hcl_oow_t capa
); );

12
lib/hcl-xma.h
View File

@ -52,15 +52,15 @@
* hcl_xma_t* xma; * hcl_xma_t* xma;
* void* ptr1, * ptr2; * 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 * // 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 * 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 * 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. * 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 * // the following two lines are not actually needed as the allocator
* // is closed after them. * // is closed after them.
@ -102,7 +102,7 @@ struct hcl_xma_t
int internal; int internal;
/** pointer array to free memory blocks */ /** 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 */ /** pre-computed value for fast xfree index calculation */
hcl_oow_t bdec; 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 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 * the zone. Call this function to destroy a memory allocator created with
* hcl_xma_open(). * 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(). * function to finalize a memory allocator initialized with hcl_xma_init().
*/ */
HCL_EXPORT void hcl_xma_fini ( HCL_EXPORT void hcl_xma_fini (

40
lib/hcl.c
View File

@ -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 * routine still function despite some side-effects when
* reallocation fails */ * reallocation fails */
/* +1 required for consistency with put_oocs and put_ooch in logfmt.c */ /* +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; if (HCL_UNLIKELY(!hcl->log.ptr)) goto oops;
hcl->gci.stack.capa = HCL_ALIGN_POW2(1, 1024); /* TODO: is this a good initial size? */ 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) 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 * callbacks. however, the actual logging might not be produced at
* this point because one of the callbacks could arrange to stop * this point because one of the callbacks could arrange to stop
* logging */ * logging */
@ -312,7 +312,7 @@ void hcl_fini (hcl_t* hcl)
if (hcl->heap) hcl_killheap (hcl, hcl->heap); if (hcl->heap) hcl_killheap (hcl, hcl->heap);
if (hcl->log.ptr) if (hcl->log.ptr)
{ {
hcl_freemem (hcl, hcl->log.ptr); hcl_freemem (hcl, hcl->log.ptr);
hcl->log.capa = 0; hcl->log.capa = 0;
@ -362,7 +362,7 @@ void hcl_reset (hcl_t* hcl)
hcl_oop_t v; hcl_oop_t v;
hcl_oow_t i; 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. */ * excluding special kernel symbols. */
for (i = 0; i < hcl->code.lit.len; i++) 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; hcl->option.dfl_procstk_size = *(hcl_oow_t*)value;
break; break;
} }
case HCL_MOD_INCTX: case HCL_MOD_INCTX:
hcl->option.mod_inctx = *(void**)value; hcl->option.mod_inctx = *(void**)value;
break; break;
@ -529,13 +529,13 @@ int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)
goto einval; 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); if (cb->opt_set) cb->opt_set (hcl, id, value);
} }
return 0; return 0;
einval: einval:
hcl_seterrnum (hcl, HCL_EINVAL); hcl_seterrnum (hcl, HCL_EINVAL);
return -1; return -1;
@ -608,7 +608,7 @@ hcl_cb_t* hcl_regcb (hcl_t* hcl, hcl_cb_t* tmpl)
actual->next = hcl->cblist; actual->next = hcl->cblist;
actual->prev = HCL_NULL; actual->prev = HCL_NULL;
hcl->cblist = actual; hcl->cblist = actual;
/* vm_checkbc is invoked very frequently. /* vm_checkbc is invoked very frequently.
* and there might be multiple vm_checkbc callbacks registered. * and there might be multiple vm_checkbc callbacks registered.
* keeping the count of 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->prev) cb->prev->next = cb->next;
} }
if (cb->vm_checkbc) if (cb->vm_checkbc)
{ {
HCL_ASSERT (hcl, hcl->vm_checkbc_cb_count > 0); HCL_ASSERT (hcl, hcl->vm_checkbc_cb_count > 0);
hcl->vm_checkbc_cb_count--; hcl->vm_checkbc_cb_count--;
@ -688,7 +688,7 @@ static struct
const hcl_bch_t* modname; const hcl_bch_t* modname;
int (*modload) (hcl_t* hcl, hcl_mod_t* mod); int (*modload) (hcl_t* hcl, hcl_mod_t* mod);
} }
static_modtab[] = static_modtab[] =
{ {
{ "arr", hcl_mod_arr }, { "arr", hcl_mod_arr },
{ "dic", hcl_mod_dic }, { "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; int n;
#endif #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 * MOD_PREFIX_LEN for MOD_PREFIX
* 1 for _ at the end when hcl_mod_xxx_ is attempted. * 1 for _ at the end when hcl_mod_xxx_ is attempted.
* 1 for the terminating '\0'. * 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 /* copy instead of encoding conversion. MOD_PREFIX must not
* include a character that requires encoding conversion. * include a character that requires encoding conversion.
* note the terminating null isn't needed in buf here. */ * 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)) 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 ... */ /* TODO: binary search ... */
for (n = 0; n < HCL_COUNTOF(static_modtab); n++) 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; load = static_modtab[n].modload;
break; 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); 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_DEBUG2 (hcl, "Cannot open a module [%.*js]\n", namelen, name);
hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to open a module [%.*js]", 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*/ /* 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); 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_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); 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) if (load(hcl, &mdp->mod) <= -1)
{ {
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl); 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_DEBUG3 (hcl, "Module function [%js] returned failure in [%.*js]\n", buf, namelen, name);
hcl_rbt_delete (&hcl->modtab, name, namelen); hcl_rbt_delete (&hcl->modtab, name, namelen);
hcl->vmprim.dl_close (hcl, mdp->handle); 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->mod.unload) mdp->mod.unload (hcl, &mdp->mod);
if (mdp->handle) if (mdp->handle)
{ {
hcl->vmprim.dl_close (hcl, mdp->handle); hcl->vmprim.dl_close (hcl, mdp->handle);
HCL_DEBUG2 (hcl, "Closed a module [%js] - %p\n", mdp->mod.name, 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, '.'); sep = hcl_rfind_oochar(pfid, pfidlen, '.');
if (!sep) 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. * guarantee that a period is included in an primitive function identifer.
* what if the compiler is broken? imagine a buggy compiler rewritten * what if the compiler is broken? imagine a buggy compiler rewritten
* in hcl itself? */ * 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 (!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 */ /* 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); HCL_DEBUG3 (hcl, "Cannot find a primitive function [%.*js] in a module [%js]\n", pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name);

26
lib/hcl.h
View File

@ -164,8 +164,11 @@ enum hcl_synerrnum_t
HCL_SYNERR_CALLABLE, /* invalid callable */ HCL_SYNERR_CALLABLE, /* invalid callable */
HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */ HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */
HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */ HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */
HCL_SYNERR_SEMICOLON, /* unexpected semicolon */
HCL_SYNERR_EMPTYXLIST, /* empty x-list */ 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; 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; typedef struct hcl_function_t* hcl_oop_function_t;
#define HCL_BLOCK_NAMED_INSTVARS 3 #define HCL_BLOCK_NAMED_INSTVARS 3
typedef struct hcl_block_t hcl_block_t; typedef struct hcl_lambda_t hcl_lambda_t;
typedef struct hcl_block_t* hcl_oop_block_t; typedef struct hcl_lambda_t* hcl_oop_lambda_t;
#define HCL_CONTEXT_NAMED_INSTVARS 9 #define HCL_CONTEXT_NAMED_INSTVARS 9
typedef struct hcl_context_t hcl_context_t; 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 /* 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. * and literal frames available in home->origin.
*/ */
struct hcl_block_t struct hcl_lambda_t
{ {
HCL_OBJ_HEADER; HCL_OBJ_HEADER;
@ -692,10 +695,10 @@ struct hcl_process_t
hcl_oop_t id; /* SmallInteger */ hcl_oop_t id; /* SmallInteger */
hcl_oop_t state; /* 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 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 exst; /* exception stack top */
hcl_oop_t clsp; /* class stack pointer */ hcl_oop_t clsp; /* class stack pointer */
@ -1491,7 +1494,10 @@ enum hcl_compile_flag_t
HCL_COMPILE_CLEAR_CODE = (1 << 0), HCL_COMPILE_CLEAR_CODE = (1 << 0),
/* clear the top-level function block at the end of hcl_compile() */ /* 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; typedef enum hcl_compile_flag_t hcl_compile_flag_t;
#endif #endif
@ -1868,7 +1874,7 @@ enum hcl_brand_t
HCL_BRAND_PRIM, HCL_BRAND_PRIM,
HCL_BRAND_FUNCTION, HCL_BRAND_FUNCTION,
HCL_BRAND_BLOCK, HCL_BRAND_LAMBDA,
HCL_BRAND_CONTEXT, HCL_BRAND_CONTEXT,
HCL_BRAND_PROCESS, HCL_BRAND_PROCESS,
HCL_BRAND_PROCESS_SCHEDULER, 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_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_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_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_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_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) #define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS)

2
lib/heap.c
View File

@ -122,7 +122,7 @@ void* hcl_callocheapmem (hcl_t* hcl, hcl_heap_t* heap, hcl_oow_t size)
void* ptr; void* ptr;
ptr = HCL_MMGR_ALLOC(&heap->xmmgr, size); 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_DEBUG2 (hcl, "Cannot callocate %zd bytes from heap - ptr %p\n", size, heap);
hcl_seterrnum (hcl, HCL_EOOMEM); hcl_seterrnum (hcl, HCL_EOOMEM);

42
lib/json.c
View File

@ -52,15 +52,15 @@ struct hcl_json_state_node_t
struct 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 */ * 1: got key, 2: got colon, 3: got value */
int state; int state;
} id; /* in dictionary */ } id; /* in dictionary */
struct struct
{ {
int escaped; int escaped;
int digit_count; 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. */ * in the bch mode, it will get converted to a utf8 stream. */
hcl_uch_t acc; hcl_uch_t acc;
} sv; } sv;
@ -70,7 +70,7 @@ struct hcl_json_state_node_t
int digit_count; int digit_count;
/* for a character, no way to support the unicode character /* for a character, no way to support the unicode character
* in the bch mode */ * in the bch mode */
hcl_ooch_t acc; hcl_ooch_t acc;
} cv; } cv;
struct 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) static int add_chars_to_token (hcl_json_t* json, const hcl_ooch_t* ptr, hcl_oow_t len)
{ {
hcl_oow_t i; hcl_oow_t i;
if (json->tok_capa - json->tok.len > len) if (json->tok_capa - json->tok.len > len)
{ {
hcl_ooch_t* tmp; 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; 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++] = ptr[i];
json->tok.ptr[json->tok.len] = '\0'; json->tok.ptr[json->tok.len] = '\0';
return 0; return 0;
@ -226,7 +226,7 @@ static int push_state (hcl_json_t* json, hcl_json_state_t state)
ss->state = state; ss->state = state;
ss->next = json->state_stack; ss->next = json->state_stack;
json->state_stack = ss; json->state_stack = ss;
return 0; 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) 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) 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) 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.escaped = 3;
json->state_stack->u.sv.digit_count = 0; 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) 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.escaped = 3;
json->state_stack->u.cv.digit_count = 0; 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 == '\'') else if (c == '\'')
{ {
pop_state (json); pop_state (json);
if (json->tok.len < 1) if (json->tok.len < 1)
{ {
hcl_json_seterrbfmt (json, HCL_EINVAL, "no character in a character literal"); 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 (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); hcl_json_seterrbfmt (json, HCL_EINVAL, "too many characters in a character literal - %.*js", json->tok.len, json->tok.ptr);
return -1; 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; if (json->prim.instcb(json, HCL_JSON_INST_START_DIC, HCL_NULL) <= -1) return -1;
return 1; return 1;
} }
else if (is_spacechar(c)) else if (is_spacechar(c))
{ {
/* do nothing */ /* do nothing */
return 1; return 1;
@ -796,7 +796,7 @@ start_over:
case HCL_JSON_STATE_IN_STRING_VALUE: case HCL_JSON_STATE_IN_STRING_VALUE:
x = handle_string_value_char(json, c); x = handle_string_value_char(json, c);
break; break;
case HCL_JSON_STATE_IN_CHARACTER_VALUE: case HCL_JSON_STATE_IN_CHARACTER_VALUE:
x = handle_character_value_char(json, c); x = handle_character_value_char(json, c);
break; 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) else if (n > bcslen)
{ {
/* incomplete sequence */ /* incomplete sequence */
*xlen = ptr - data; *xlen = ptr - data;
return 0; /* feed more for incomplete sequence */ 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_xtn_t* xtn;
json = (hcl_json_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*json) + xtnsize); json = (hcl_json_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*json) + xtnsize);
if (!json) if (!json)
{ {
if (errnum) *errnum = HCL_ESYSMEM; if (errnum) *errnum = HCL_ESYSMEM;
return HCL_NULL; return HCL_NULL;
} }
hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum); hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum);
if (!hcl) if (!hcl)
{ {
HCL_MMGR_FREE (mmgr, json); HCL_MMGR_FREE (mmgr, json);
return HCL_NULL; 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; json->cfg.logmask = ~(hcl_bitmask_t)0;
/* the dummy hcl is used for this json to perform primitive operations /* 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. */ * need to be changed from the tiny value set above. */
hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, &json->cfg.logmask); hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, &json->cfg.logmask);
hcl_setcmgr (json->dummy_hcl, json->cmgr); 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: case HCL_JSON_LOG_MASK:
json->cfg.logmask = *(const hcl_bitmask_t*)value; json->cfg.logmask = *(const hcl_bitmask_t*)value;
if (json->dummy_hcl) if (json->dummy_hcl)
{ {
/* setting this affects the dummy hcl immediately. /* setting this affects the dummy hcl immediately.
* existing hcl instances inside worker threads won't get * existing hcl instances inside worker threads won't get
* affected. new hcl instances to be created later * affected. new hcl instances to be created later
* is supposed to use the new value */ * is supposed to use the new value */
hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, value); hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, value);
} }

18
lib/number.c
View File

@ -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); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv);
return -1; return -1;
} }
ys = 0; ys = 0;
yv = *y; yv = *y;
if (HCL_IS_FPDEC(hcl, yv)) 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); hcl_pushvolat (hcl, &y);
scale = equalize_scale(hcl, &x, &y); scale = equalize_scale(hcl, &x, &y);
if (scale <= -1) if (scale <= -1)
{ {
hcl_popvolats (hcl, 2); hcl_popvolats (hcl, 2);
return HCL_NULL; 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); hcl_pushvolat (hcl, &y);
scale = equalize_scale(hcl, &x, &y); scale = equalize_scale(hcl, &x, &y);
if (scale <= -1) if (scale <= -1)
{ {
hcl_popvolats (hcl, 2); hcl_popvolats (hcl, 2);
return HCL_NULL; 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); hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not numeric - %O", xv);
return HCL_NULL; return HCL_NULL;
} }
ys = 0; ys = 0;
yv = y; yv = y;
if (HCL_IS_FPDEC(hcl, 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); nv = hcl_mulints(hcl, xv, yv);
if (!nv) return HCL_NULL; if (!nv) return HCL_NULL;
cs = xs + ys; cs = xs + ys;
if (cs <= 0) return nv; /* the result must be an integer */ if (cs <= 0) return nv; /* the result must be an integer */
ns = (mult || xs > ys)? xs: ys; 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++) for (i = 0; i < ys; i++)
{ {
nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10)); nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10));
if (!nv) if (!nv)
{ {
hcl_popvolat (hcl); hcl_popvolat (hcl);
return HCL_NULL; 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); hcl_pushvolat (hcl, &y);
scale = equalize_scale(hcl, &x, &y); scale = equalize_scale(hcl, &x, &y);
if (scale <= -1) if (scale <= -1)
{ {
hcl_popvolats (hcl, 2); hcl_popvolats (hcl, 2);
return HCL_NULL; 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); scale = HCL_OOP_TO_SMOOI(((hcl_oop_fpdec_t)x)->scale);
v = ((hcl_oop_fpdec_t)x)->value; v = ((hcl_oop_fpdec_t)x)->value;
v = hcl_absint(hcl, v); v = hcl_absint(hcl, v);
if (!v) return HCL_NULL; if (!v) return HCL_NULL;
return hcl_makefpdec(hcl, v, scale); return hcl_makefpdec(hcl, v, scale);
} }
} }

2
lib/obj.c
View File

@ -474,7 +474,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
oop = HCL_NULL; oop = HCL_NULL;
break; break;
} }
if (HCL_LIKELY(oop)) if (HCL_LIKELY(oop))
{ {
#if 0 #if 0

30
lib/opt-impl.h
View File

@ -31,7 +31,7 @@
#include "hcl-opt.h" #include "hcl-opt.h"
#include "hcl-utl.h" #include "hcl-utl.h"
/* /*
* hcl_getopt is based on BSD getopt. * 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->arg = HCL_NULL;
opt->lngopt = HCL_NULL; opt->lngopt = HCL_NULL;
if (opt->cur == HCL_NULL) if (opt->cur == HCL_NULL)
{ {
opt->cur = XEMSG; opt->cur = XEMSG;
opt->ind = 1; opt->ind = 1;
} }
if (*opt->cur == '\0') if (*opt->cur == '\0')
{ {
/* update scanning pointer */ /* 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 */ * argument doesn't start with a dash */
opt->cur = XEMSG; opt->cur = XEMSG;
return XCI_EOF; return XCI_EOF;
@ -127,7 +127,7 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt)
while (*end != '\0' && *end != '=') end++; 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; 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) else if (opt->arg == HCL_NULL)
{ {
/* check if it has a remaining argument /* check if it has a remaining argument
* available */ * available */
if (argc <= ++opt->ind) return BADARG; if (argc <= ++opt->ind) return BADARG;
/* If so, the next available argument is /* If so, the next available argument is
* taken to be an option argument */ * taken to be an option argument */
opt->arg = argv[opt->ind]; 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');*/ /*if (*end == HCL_T('=')) *end = HCL_T('\0');*/
opt->lngopt = opt->cur; opt->lngopt = opt->cur;
return BADCH; return BADCH;
} }
if ((opt->opt = *opt->cur++) == ':' || 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, * 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; return BADCH;
} }
if (*++oli != ':') if (*++oli != ':')
{ {
/* don't need argument */ /* don't need argument */
if (*opt->cur == '\0') opt->ind++; if (*opt->cur == '\0') opt->ind++;
} }
else else
{ {
/* need an argument */ /* need an argument */
if (*opt->cur != '\0') if (*opt->cur != '\0')
{ {
/* no white space */ /* no white space */
opt->arg = opt->cur; opt->arg = opt->cur;
} }
else if (argc <= ++opt->ind) else if (argc <= ++opt->ind)
{ {
/* no arg */ /* no arg */
opt->cur = XEMSG; opt->cur = XEMSG;

32
lib/prim.c
View File

@ -71,7 +71,7 @@ static void log_char_object (hcl_t* hcl, hcl_bitmask_t mask, hcl_oop_char_t msg)
start_over: start_over:
while (rem > 0) while (rem > 0)
{ {
if (*ptr == '\0') if (*ptr == '\0')
{ {
n = hcl_logbfmt (hcl, mask, "%jc", *ptr); n = hcl_logbfmt (hcl, mask, "%jc", *ptr);
HCL_ASSERT (hcl, n == 1); HCL_ASSERT (hcl, n == 1);
@ -82,9 +82,9 @@ start_over:
n = hcl_logbfmt (hcl, mask, "%.*js", rem, ptr); n = hcl_logbfmt (hcl, mask, "%.*js", rem, ptr);
if (n <= -1) break; 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 * actually, this check is not needed because of '\0' skipping
* at the beginning of the loop */ * at the beginning of the loop */
n = hcl_logbfmt (hcl, mask, "%jc", *ptr); 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; hcl_ooi_t k;
/*level = HCL_STACK_GET(hcl, hcl->sp - nargs + 1); /*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);*/ else mask = HCL_LOG_APP | HCL_OOP_TO_SMOOI(level);*/
mask = HCL_LOG_APP | HCL_LOG_FATAL; /* TODO: accept logging 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); 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; 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 */ /* do nothing */
} }
else if (arg == hcl->_false) else if (arg == hcl->_false)
{ {
rv = hcl->_false; rv = hcl->_false;
break; 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; rv = hcl->_true;
break; break;
} }
else if (arg == hcl->_false) else if (arg == hcl->_false)
{ {
/* do nothing */ /* 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) static hcl_pfrc_t pf_number_abs (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{ {
hcl_oop_t ret; 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; if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret); 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_oop_context_t ctx;
hcl_ooi_t attr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs; 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); ctx = (hcl_oop_context_t)HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_CONTEXT(hcl, ctx)) 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); fixed_nargs = GET_BLK_MASK_NARGS(attr_mask);
nrvars = GET_BLK_MASK_NRVARS(attr_mask); nrvars = GET_BLK_MASK_NRVARS(attr_mask);
nlvars = GET_BLK_MASK_NLVARS(attr_mask); nlvars = GET_BLK_MASK_NLVARS(attr_mask);
/*if (!va) TODO: need this check? /*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_ooi_t attr_mask, va, fixed_nargs, nrvars, nlvars, nvaargs;
hcl_oow_t index; hcl_oow_t index;
if (nargs >= 2) if (nargs >= 2)
{ {
ctx = (hcl_oop_context_t)HCL_STACK_GETARG(hcl, nargs, 1); ctx = (hcl_oop_context_t)HCL_STACK_GETARG(hcl, nargs, 1);
if (!HCL_IS_CONTEXT(hcl, ctx)) 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); nrvars = GET_BLK_MASK_NRVARS(attr_mask);
nlvars = GET_BLK_MASK_NLVARS(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; return HCL_PF_FAILURE;
} }
@ -895,7 +895,7 @@ static pf_t builtin_prims[] =
{ 0, 0, pf_gc, 2, { 'g','c' } }, { 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 */ /* 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' } }, { 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 */ /* 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' } }, { 2, 2, pf_integer_bxor, 7, { 'b','i','t','-','x','o','r' } },
{ 1, 1, pf_integer_bnot, 7, { 'b','i','t','-','n','o','t' } }, { 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' } }, { 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' } }, { 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' } }, { 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' } }, { 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); hcl_popvolat (hcl);
if (HCL_UNLIKELY(!cons)) return -1; 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 * function. 'set' prevents this symbol from being used as a variable
* name */ * name */
HCL_OBJ_SET_FLAGS_KERNEL (name, 2); HCL_OBJ_SET_FLAGS_KERNEL (name, 2);
} }

90
lib/print.c
View File

@ -88,7 +88,7 @@ enum
WORD_PRIM, WORD_PRIM,
WORD_FUNCTION, WORD_FUNCTION,
WORD_BLOCK, WORD_LAMBDA,
WORD_CONTEXT, WORD_CONTEXT,
WORD_PROCESS, WORD_PROCESS,
WORD_PROCESS_SCHEDULER, WORD_PROCESS_SCHEDULER,
@ -98,7 +98,7 @@ enum
WORD_INSTANCE WORD_INSTANCE
}; };
static struct static struct
{ {
hcl_oow_t len; hcl_oow_t len;
hcl_ooch_t ptr[20]; hcl_ooch_t ptr[20];
@ -113,7 +113,7 @@ static struct
{ 7, { '#','<','P','R','I','M','>' } }, { 7, { '#','<','P','R','I','M','>' } },
{ 11, { '#','<','F','U','N','C','T','I','O','N','>' } }, { 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, { '#','<','C','O','N','T','E','X','T','>' } },
{ 10, { '#','<','P','R','O','C','E','S','S','>' } }, { 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','>' } }, { 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 (hcl_bfmt_out(fmtout, "\\%jc", chu) <= -1) return -1;
} }
#if defined(HCL_OOCH_IS_UCH) #if defined(HCL_OOCH_IS_UCH)
else if (chu < ' ') else if (chu < ' ')
#else #else
else if (chu < ' ' || chu >= 0x80) else if (chu < ' ' || chu >= 0x80)
#endif #endif
{ {
hcl_oochu_t escaped; 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; if (hcl_bfmt_out(fmtout, "\\U%08X", chu) <= -1) return -1;
} }
else else
#endif #endif
{ {
#if (HCL_SIZEOF_OOCH_T >= 2) #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_MLIST */
{ "{", "{" }, /*HCL_CONCODE_BLOCK */ { "{", "{" }, /*HCL_CONCODE_BLOCK */
{ "[", "[" }, /*HCL_CONCODE_ARRAY */ { "[", "[" }, /*HCL_CONCODE_ARRAY */
{ "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */
{ "#{", "{" }, /*HCL_CONCODE_DIC */ { "#{", "{" }, /*HCL_CONCODE_DIC */
{ "#(", "[" } /*HCL_CONCODE_QLIST */ { "#(", "[" } /*HCL_CONCODE_QLIST */
}; };
@ -237,7 +237,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj)
{ ")", "]" }, /*HCL_CONCODE_QLIST */ { ")", "]" }, /*HCL_CONCODE_QLIST */
}; };
static const hcl_bch_t* breakers[][2] = static const hcl_bch_t* breakers[][2] =
{ {
{ " ", "," }, /* item breaker */ { " ", "," }, /* item breaker */
{ " ", ":" } /* key value 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); json = !!(fmtout->mask & HCL_LOG_PREFER_JSON);
next: next:
switch ((brand = HCL_BRANDOF(hcl, obj))) switch ((brand = HCL_BRANDOF(hcl, obj)))
{ {
case HCL_BRAND_SMOOI: case HCL_BRAND_SMOOI:
if (hcl_bfmt_out(fmtout, "%zd", HCL_OOP_TO_SMOOI(obj)) <= -1) return -1; 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. /* -1 to drive hcl_inttostr() to not create a new string object.
* not using the object memory. the result stays in the temporary * not using the object memory. the result stays in the temporary
* buffer */ * buffer */
tmp = hcl_inttostr(hcl, obj, 10 | HCL_INTTOSTR_NONEWOBJ); tmp = hcl_inttostr(hcl, obj, 10 | HCL_INTTOSTR_NONEWOBJ);
if (!tmp) return -1; 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; if (hcl_bfmt_out(fmtout, "%.*js", hcl->inttostr.xbuf.len, hcl->inttostr.xbuf.ptr) <= -1) return -1;
break; break;
} }
@ -319,7 +319,7 @@ next:
if (hcl_bfmt_out(fmtout, "0.%0*d", scale, 0) <= -1) return -1; if (hcl_bfmt_out(fmtout, "0.%0*d", scale, 0) <= -1) return -1;
} }
} }
else else
{ {
hcl_oop_t tmp; hcl_oop_t tmp;
hcl_oow_t len, adj; hcl_oow_t len, adj;
@ -334,13 +334,13 @@ next:
{ {
if (scale == len) if (scale == len)
{ {
if (hcl_bfmt_out(fmtout, "%.*js0.%.*js", if (hcl_bfmt_out(fmtout, "%.*js0.%.*js",
adj, hcl->inttostr.xbuf.ptr, adj, hcl->inttostr.xbuf.ptr,
len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1; len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1;
} }
else else
{ {
if (hcl_bfmt_out(fmtout, "%.*js0.%0*d%.*js", if (hcl_bfmt_out(fmtout, "%.*js0.%0*d%.*js",
adj, hcl->inttostr.xbuf.ptr, adj, hcl->inttostr.xbuf.ptr,
scale - len, 0, scale - len, 0,
len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1; len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1;
@ -362,8 +362,8 @@ next:
qse_char_t buf[256]; qse_char_t buf[256];
hcl->prm.sprintf ( hcl->prm.sprintf (
hcl->prm.ctx, hcl->prm.ctx,
buf, HCL_COUNTOF(buf), buf, HCL_COUNTOF(buf),
HCL_T("%Lf"), HCL_T("%Lf"),
#ifdef __MINGW32__ #ifdef __MINGW32__
(double)HCL_RVAL(obj) (double)HCL_RVAL(obj)
#else #else
@ -392,7 +392,7 @@ next:
for (i = 0; i < HCL_OBJ_GET_SIZE(obj); i++) for (i = 0; i < HCL_OBJ_GET_SIZE(obj); i++)
{ {
ch = ((hcl_oop_char_t)obj)->slot[i]; ch = ((hcl_oop_char_t)obj)->slot[i];
if (ch < ' ' || ch == '\"' || ch == '\\') if (ch < ' ' || ch == '\"' || ch == '\\')
{ {
escape = 1; escape = 1;
break; break;
@ -431,7 +431,7 @@ next:
{ {
int x; int x;
/* Push what to print next on to the stack /* Push what to print next on to the stack
* the variable p is */ * the variable p is */
ps.type = PRINT_STACK_CONS; ps.type = PRINT_STACK_CONS;
ps.obj = HCL_CONS_CDR(cur); ps.obj = HCL_CONS_CDR(cur);
@ -440,30 +440,30 @@ next:
if (x <= -1) return -1; if (x <= -1) return -1;
obj = HCL_CONS_CAR(cur); obj = HCL_CONS_CAR(cur);
/* Jump to the 'next' label so that the object /* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it * pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label * ends, a jump back to the 'resume' label
* is made at the at of this function. */ * is made at the at of this function. */
goto next; goto next;
resume_cons: resume_cons:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS); HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS);
cur = ps.obj; /* Get back the CDR pushed */ cur = ps.obj; /* Get back the CDR pushed */
concode = ps.idx; /* restore the concode */ 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 /* The CDR part points to a NIL object, which
* indicates the end of a list. break the loop */ * indicates the end of a list. break the loop */
break; 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. */ /* The CDR part does not point to a pair. */
if (hcl_bfmt_out(fmtout, " . ") <= -1) return -1; 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 * 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. */ * label. */
ps.type = PRINT_STACK_CONS; ps.type = PRINT_STACK_CONS;
ps.obj = hcl->_nil; 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_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; if (hcl_bfmt_out(fmtout, closing_parens[HCL_CONCODE_ARRAY][json]) <= -1) return -1;
break; break;
@ -504,7 +504,7 @@ next:
/* Push what to print next on to the stack */ /* Push what to print next on to the stack */
ps.idx = arridx + 1; 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; ps.type = PRINT_STACK_ARRAY_END;
} }
@ -513,26 +513,26 @@ next:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY); HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY);
ps.obj = obj; ps.obj = obj;
} }
x = push (hcl, &ps); x = push (hcl, &ps);
if (x <= -1) return -1; if (x <= -1) return -1;
obj = ((hcl_oop_oop_t)obj)->slot[arridx]; 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; if (hcl_bfmt_out(fmtout, breakers[0][json]) <= -1) return -1;
} }
/* Jump to the 'next' label so that the object /* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it * pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label * ends, a jump back to the 'resume' label
* is made at the end of this function. */ * is made at the end of this function. */
goto next; goto next;
resume_array: resume_array:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY); HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY);
arridx = ps.idx; arridx = ps.idx;
obj = ps.obj; obj = ps.obj;
} }
while (1); while (1);
break; break;
} }
@ -562,7 +562,7 @@ next:
dic = (hcl_oop_dic_t)obj; dic = (hcl_oop_dic_t)obj;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally)); 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; if (hcl_bfmt_out(fmtout, closing_parens[HCL_CONCODE_DIC][json]) <= -1) return -1;
break; break;
@ -611,7 +611,7 @@ next:
{ {
/* Push what to print next on to the stack */ /* Push what to print next on to the stack */
ps.idx = bucidx + 1; ps.idx = bucidx + 1;
if (ps.idx >= bucsize) if (ps.idx >= bucsize)
{ {
ps.type = PRINT_STACK_DIC_END; ps.type = PRINT_STACK_DIC_END;
} }
@ -629,16 +629,16 @@ next:
obj = HCL_CONS_CDR(obj); obj = HCL_CONS_CDR(obj);
} }
if (buctally > 0) if (buctally > 0)
{ {
if (hcl_bfmt_out(fmtout, breakers[buctally & 1][json]) <= -1) return -1; if (hcl_bfmt_out(fmtout, breakers[buctally & 1][json]) <= -1) return -1;
} }
/* Jump to the 'next' label so that the object /* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it * pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label * ends, a jump back to the 'resume' label
* is made at the end of this function. */ * is made at the end of this function. */
goto next; goto next;
resume_dic: resume_dic:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC); HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC);
@ -647,7 +647,7 @@ next:
obj = ps.obj; obj = ps.obj;
dic = (hcl_oop_dic_t)ps.obj2; dic = (hcl_oop_dic_t)ps.obj2;
bucsize = HCL_OBJ_GET_SIZE(dic->bucket); bucsize = HCL_OBJ_GET_SIZE(dic->bucket);
} }
while (1); while (1);
break; break;
@ -677,8 +677,8 @@ next:
word_index = WORD_FUNCTION; word_index = WORD_FUNCTION;
goto print_word; goto print_word;
case HCL_BRAND_BLOCK: case HCL_BRAND_LAMBDA:
word_index = WORD_BLOCK; word_index = WORD_LAMBDA;
goto print_word; goto print_word;
case HCL_BRAND_CONTEXT: 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; int n;
/* the printer stack must be empty. buggy if not. */ /* 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 */ hcl->p.e = obj; /* remember the head of the object to print */
n = hcl_proutbfmt(hcl, mask, obj); 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; if (n <= -1) hcl->p.s.size = 0;
/* the printer stack must get empty when done. buggy if not */ /* 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; return n;
} }

15
lib/read.c
View File

@ -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) static HCL_INLINE int is_at_block_beginning (hcl_t* hcl)
{ {
hcl_rstl_t* rstl; hcl_rstl_t* rstl;
//HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st; rstl = hcl->c->r.st;
return !rstl || LIST_FLAG_GET_CONCODE(rstl->flagv) == HCL_CONCODE_BLOCK && rstl->count <= 0; 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) static void init_feed (hcl_t* hcl)
{ {
HCL_MEMSET (&hcl->c->feed, 0, HCL_SIZEOF(hcl->c->feed)); HCL_MEMSET (&hcl->c->feed, 0, HCL_SIZEOF(hcl->c->feed));
hcl->c->feed.lx.state = HCL_FLX_START; hcl->c->feed.lx.state = HCL_FLX_START;
hcl->c->feed.lx.loc.line = 1; hcl->c->feed.lx.loc.line = 1;
hcl->c->feed.lx.loc.colm = 1; hcl->c->feed.lx.loc.colm = 1;
hcl->c->feed.lx.loc.file = HCL_NULL; hcl->c->feed.lx.loc.file = HCL_NULL;
hcl->c->feed.on_cnode = on_fed_cnode; hcl->c->feed.on_cnode = on_fed_cnode;
} }
@ -1101,6 +1096,7 @@ static int feed_process_token (hcl_t* hcl)
case HCL_TOK_LBRACE: /* { */ case HCL_TOK_LBRACE: /* { */
frd->flagv = 0; frd->flagv = 0;
LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_BLOCK); 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; goto start_list;
case HCL_TOK_DLPAREN: /* #{ */ case HCL_TOK_DLPAREN: /* #{ */
@ -1176,14 +1172,15 @@ static int feed_process_token (hcl_t* hcl)
if (frd->level <= 0) if (frd->level <= 0)
{ {
/* redundant semicolons */ /* 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; goto oops;
} }
if (!(frd->flagv & AUTO_FORGED)) if (!(frd->flagv & AUTO_FORGED))
{ {
/* TODO: change error info */ /* TODO: change error info or code */
hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL); hcl_setsynerr (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), HCL_NULL);
goto oops; 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); hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
goto oops; goto oops;
} }
hcl_logbfmt(hcl, HCL_LOG_FATAL, "forged xlist...exiting..OK\n");
frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); frd->obj = leave_list(hcl, &frd->flagv, &oldflagv);
frd->level--; frd->level--;
@ -1388,6 +1386,7 @@ static int feed_process_token (hcl_t* hcl)
{ {
hcl_oop_t obj = frd->obj; hcl_oop_t obj = frd->obj;
hcl_logbfmt(hcl, HCL_LOG_FATAL, "QQQQQQQQQQQQ forged xlist...\n");
frd->flagv = AUTO_FORGED; frd->flagv = AUTO_FORGED;
LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_XLIST); LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_XLIST);

16
lib/sym.c
View File

@ -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 < 400000) newsz = oldsz + (oldsz / 16);
else if (oldsz < 800000) newsz = oldsz + (oldsz / 32); else if (oldsz < 800000) newsz = oldsz + (oldsz / 32);
else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64); else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64);
else else
{ {
hcl_oow_t inc, inc_max; hcl_oow_t inc, inc_max;
inc = oldsz / 128; inc = oldsz / 128;
inc_max = HCL_OBJ_SIZE_MAX - oldsz; inc_max = HCL_OBJ_SIZE_MAX - oldsz;
if (inc > inc_max) if (inc > inc_max)
{ {
if (inc_max > 0) inc = inc_max; if (inc_max > 0) inc = inc_max;
else 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_oop_char_t symbol;
HCL_ASSERT (hcl, len > 0); HCL_ASSERT (hcl, len > 0);
if (len <= 0) if (len <= 0)
{ {
/* i don't allow an empty symbol name */ /* i don't allow an empty symbol name */
hcl_seterrnum (hcl, HCL_EINVAL); 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); index = hcl_hash_oochars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
/* find a matching symbol in the open-addressed symbol table */ /* 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]; symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[index];
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, symbol)); 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); index = (index + 1) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
} }
if (!create) if (!create)
{ {
hcl_seterrnum (hcl, HCL_ENOENT); hcl_seterrnum (hcl, HCL_ENOENT);
return HCL_NULL; 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); tally = HCL_OOP_TO_SMOOI(hcl->symtab->tally);
if (tally >= HCL_SMOOI_MAX) 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_SMOOI_MAX items for efficiency sake */
hcl_seterrnum (hcl, HCL_EDFULL); hcl_seterrnum (hcl, HCL_EDFULL);
return HCL_NULL; 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. /* no conversion to hcl_oow_t is necessary for tally + 1.
* the maximum value of tally is checked to be HCL_SMOOI_MAX - 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). */ * HCL_SMOOI_MAX is way smaller than HCL_TYPE_MAX(hcl_ooi_t). */
if (tally + 1 >= HCL_OBJ_GET_SIZE(hcl->symtab->bucket)) 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 */ /* recalculate the index for the expanded bucket */
index = hcl_hash_oochars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->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); index = (index + 1) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
} }

6
lib/tmr.c
View File

@ -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) void hcl_tmr_fini (hcl_tmr_t* tmr)
{ {
hcl_tmr_clear (tmr); hcl_tmr_clear (tmr);
if (tmr->event) if (tmr->event)
{ {
hcl_freemem (tmr->hcl, tmr->event); hcl_freemem (tmr->hcl, tmr->event);
tmr->event = HCL_NULL; 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_tmr_event_t item;
hcl_oow_t old_index; hcl_oow_t old_index;
item = tmr->event[index]; item = tmr->event[index];
old_index = index; old_index = index;
do 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; index = younger;
} }
while (index < base); while (index < base);
tmr->event[index] = item; tmr->event[index] = item;
if (notify && index != old_index) if (notify && index != old_index)
tmr->event[index].updater (tmr, old_index, index, &tmr->event[index]); tmr->event[index].updater (tmr, old_index, index, &tmr->event[index]);

36
lib/utf8.c
View File

@ -58,7 +58,7 @@ struct __utf8_t
typedef struct __utf8_t __utf8_t; typedef struct __utf8_t __utf8_t;
static __utf8_t utf8_table[] = static __utf8_t utf8_table[] =
{ {
{0x00000000ul, 0x0000007Ful, 0x00, 0x80, 0x7F, 1}, {0x00000000ul, 0x0000007Ful, 0x00, 0x80, 0x7F, 1},
{0x00000080ul, 0x000007FFul, 0xC0, 0xE0, 0x1F, 2}, {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); end = utf8_table + HCL_COUNTOF(utf8_table);
cur = utf8_table; cur = utf8_table;
while (cur < end) while (cur < end)
{ {
if (uc >= cur->lower && uc <= cur->upper) return cur; if (uc >= cur->lower && uc <= cur->upper) return cur;
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) if (utf8 && cur->length <= size)
{ {
int index = cur->length; int index = cur->length;
while (index > 1) while (index > 1)
{ {
/* /*
* 0x3F: 00111111 * 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); end = utf8_table + HCL_COUNTOF(utf8_table);
cur = 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 * error is naturally indicated. so validate the string
* only if size is as large as cur->length. */ * only if size is as large as cur->length. */
if (size >= cur->length) if (size >= cur->length)
{ {
int i; 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++) for (i = 1; i < cur->length; i++)
{ {
/* in utf8, trailing bytes are all /* in utf8, trailing bytes are all
* set with 0x80. * set with 0x80.
* *
* 10XXXXXX & 11000000 => 10000000 * 10XXXXXX & 11000000 => 10000000
* *
* if not, invalid. */ * if not, invalid. */
if ((utf8[i] & 0xC0) != 0x80) return 0; if ((utf8[i] & 0xC0) != 0x80) return 0;
w = (w << 6) | (utf8[i] & 0x3F); w = (w << 6) | (utf8[i] & 0x3F);
} }
*uc = w; *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++) for (i = 1; i < cur->length; i++)
{ {
/* in utf8, trailing bytes are all /* in utf8, trailing bytes are all
* set with 0x80. * set with 0x80.
* *
* 10XXXXXX & 11000000 => 10000000 * 10XXXXXX & 11000000 => 10000000
* *
* if not, invalid. */ * if not, invalid. */
if ((utf8[i] & 0xC0) != 0x80) return 0; if ((utf8[i] & 0xC0) != 0x80) return 0;
} }
} }
} }
/* this return value can indicate both /* this return value can indicate both
* the correct length (size >= cur->length) * the correct length (size >= cur->length)
* and * and
* the incomplete seqeunce error (size < cur->length). * the incomplete seqeunce error (size < cur->length).
*/ */
return (hcl_oow_t)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 first;
int last; int last;
}; };
/* auxiliary function for binary search in interval table */ /* 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 min = 0;
int mid; int mid;
@ -335,5 +335,5 @@ int hcl_ucwidth (hcl_uch_t uc)
} }
} }
return 1; return 1;
} }

74
lib/xma.c
View File

@ -29,9 +29,9 @@
#include <assert.h> /* TODO: replace assert() with HCL_ASSERT() or something */ #include <assert.h> /* TODO: replace assert() with HCL_ASSERT() or something */
/* /*
* in the following run, movaps tries to write to the address 0x7fffea722f78. * 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. * the general protection error.
* *
$ gdb ~/xxx/bin/xxx $ 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 /* the block size is shifted by 1 bit and the maximum value is
* offset by 1 bit because of the 'free' bit-field. * offset by 1 bit because of the 'free' bit-field.
* i could keep 'size' without shifting with bit manipulation * i could keep 'size' without shifting with bit manipulation
* because the actual size is aligned and the last bit will * 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 * 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. */ * address space of your machine. */
hcl_oow_t free: 1; hcl_oow_t free: 1;
hcl_oow_t size: HCL_XMA_SIZE_BITS; /**< block size */ 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 prev_size;
hcl_oow_t free: 1; 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_xma_mblk_t* tmp, * next;
hcl_oow_t cnt; hcl_oow_t cnt;
hcl_oow_t fsum, asum; hcl_oow_t fsum, asum;
#if defined(HCL_XMA_ENABLE_STAT) #if defined(HCL_XMA_ENABLE_STAT)
hcl_oow_t isum; hcl_oow_t isum;
#endif #endif
@ -139,7 +139,7 @@ static void DBG_VERIFY (hcl_xma_t* xma, const char* desc)
#define DBG_VERIFY(xma, desc) #define DBG_VERIFY(xma, desc)
#endif #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; * 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 HCL_SIZEOF_OOW_T >= 8
if ((n & (~(hcl_oow_t)0 << (BITS-32))) == 0) { x -= 32; n <<= 32; } if ((n & (~(hcl_oow_t)0 << (BITS-32))) == 0) { x -= 32; n <<= 32; }
#endif #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; } if ((n & (~(hcl_oow_t)0 << (BITS-16))) == 0) { x -= 16; n <<= 16; }
#endif #endif
#if HCL_SIZEOF_OOW_T >= 2 #if HCL_SIZEOF_OOW_T >= 2
@ -185,7 +185,7 @@ static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n)
#undef BITS #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; hcl_oow_t xfi = ((size) / ALIGN) - 1;
if (xfi >= FIXED) xfi = szlog2(size) - (xma)->bdec + FIXED; 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() */ 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. */ /* 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 */ /* 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 */ /* get the free block index */
xfi = getxfi(xma, first->size); xfi = getxfi(xma, first->size);
/* locate it into an apporopriate slot */ /* 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 */ /* let it be the head, which is natural with only a block */
xma->start = (hcl_uint8_t*)first; xma->start = (hcl_uint8_t*)first;
xma->end = xma->start + zonesize; 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.nfree = 1;
xma->stat.nused = 0; xma->stat.nused = 0;
#endif #endif
return 0; 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) 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 */ /* 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 */ /* 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]; b->free_next = xma->xfree[xfi];
if (xma->xfree[xfi]) xma->xfree[xfi]->free_prev = b; if (xma->xfree[xfi]) xma->xfree[xfi]->free_prev = b;
xma->xfree[xfi] = 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) 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. */ * the block's next item. */
p->free_next = n; p->free_next = n;
} }
else else
{ {
/* the previous item does not exist. the block is the first /* the previous item does not exist. the block is the first
* item in the free list. */ * 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; 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 */ * block's previous item */
if (n) n->free_prev = p; 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; hcl_xma_mblk_t* y, * z;
/* the remaining part is large enough to hold /* the remaining part is large enough to hold
* another block. let's split it * another block. let's split it
*/ */
/* shrink the size of the 'cand' block */ /* 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); hcl_xma_mblk_t* blk = (hcl_xma_mblk_t*)USR_TO_SYS(b);
DBG_VERIFY (xma, "realloc merge start"); 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; if (size < MINALLOCSIZE) size = MINALLOCSIZE;
size = HCL_ALIGN_POW2(size, ALIGN); 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; rem = (MBLKHDRSIZE + n->size) - req;
if (rem >= FBLKMINSIZE) 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. * 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 */ /* shrink the block */
hcl_oow_t rem = blk->size - size; hcl_oow_t rem = blk->size - size;
if (rem >= FBLKMINSIZE) if (rem >= FBLKMINSIZE)
{ {
hcl_xma_mblk_t* n; 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; void* n;
if (b == HCL_NULL) if (b == HCL_NULL)
{ {
/* 'realloc' with NULL is the same as 'alloc' */ /* 'realloc' with NULL is the same as 'alloc' */
n = hcl_xma_alloc(xma, size); 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 * Merge the block with surrounding blocks
* *
* blk * blk
* | * |
* v * v
* +------------+------------+------------+------------+ * +------------+------------+------------+------------+
* | X | | Y | Z | * | X | | Y | Z |
* +------------+------------+------------+------------+ * +------------+------------+------------+------------+
* *
* *
* +--------------------------------------+------------+ * +--------------------------------------+------------+
* | X | Z | * | X | Z |
* +--------------------------------------+------------+ * +--------------------------------------+------------+
* *
*/ */
hcl_xma_mblk_t* z = next_mblk(y); hcl_xma_mblk_t* z = next_mblk(y);
hcl_oow_t ns = MBLKHDRSIZE + org_blk_size + MBLKHDRSIZE; hcl_oow_t ns = MBLKHDRSIZE + org_blk_size + MBLKHDRSIZE;
hcl_oow_t bs = ns + y->size; hcl_oow_t bs = ns + y->size;
@ -719,8 +719,8 @@ void hcl_xma_free (hcl_xma_t* xma, void* b)
* +------------+------------+------------+ * +------------+------------+------------+
* | | Y | Z | * | | Y | Z |
* +------------+------------+------------+ * +------------+------------+------------+
* *
* *
* *
* blk * blk
* | * |
@ -728,8 +728,8 @@ void hcl_xma_free (hcl_xma_t* xma, void* b)
* +-------------------------+------------+ * +-------------------------+------------+
* | | Z | * | | Z |
* +-------------------------+------------+ * +-------------------------+------------+
* *
* *
*/ */
hcl_xma_mblk_t* z = next_mblk(y); 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) 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 * 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) void hcl_xma_dump (hcl_xma_t* xma, hcl_xma_dumper_t dumper, void* ctx)
{ {
hcl_xma_mblk_t* tmp; hcl_xma_mblk_t* tmp;
hcl_oow_t fsum, asum; hcl_oow_t fsum, asum;
#if defined(HCL_XMA_ENABLE_STAT) #if defined(HCL_XMA_ENABLE_STAT)
hcl_oow_t isum; hcl_oow_t isum;
#endif #endif

40
lib/xutl-sa.h
View File

@ -18,14 +18,14 @@ static int str_to_ipv4 (const ooch_t* str, hcl_oow_t len, struct in_addr* inaddr
c = *str++; c = *str++;
if (c >= '0' && c <= '9') if (c >= '0' && c <= '9')
{ {
if (digits > 0 && acc == 0) return -1; if (digits > 0 && acc == 0) return -1;
acc = acc * 10 + (c - '0'); acc = acc * 10 + (c - '0');
if (acc > 255) return -1; if (acc > 255) return -1;
digits++; digits++;
} }
else if (c == '.') else if (c == '.')
{ {
if (dots >= 3 || digits == 0) return -1; if (dots >= 3 || digits == 0) return -1;
addr = (addr << 8) | acc; 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; continue;
} }
if (ch == ':') if (ch == ':')
{ {
curtok = src; curtok = src;
if (!saw_xdigit) if (!saw_xdigit)
{ {
if (colonp) return -1; if (colonp) return -1;
colonp = tp; 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) && 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*); tp += HCL_SIZEOF(struct in_addr*);
saw_xdigit = 0; saw_xdigit = 0;
break; break;
} }
return -1; return -1;
} }
if (saw_xdigit) if (saw_xdigit)
{ {
if (tp + HCL_SIZEOF(hcl_uint16_t) > endp) return -1; if (tp + HCL_SIZEOF(hcl_uint16_t) > endp) return -1;
*tp++ = (hcl_uint8_t)(val >> 8) & 0xff; *tp++ = (hcl_uint8_t)(val >> 8) & 0xff;
*tp++ = (hcl_uint8_t)val & 0xff; *tp++ = (hcl_uint8_t)val & 0xff;
} }
if (colonp != HCL_NULL) if (colonp != HCL_NULL)
{ {
/* /*
* Since some memmove()'s erroneously fail to handle * 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 n = tp - colonp;
hcl_oow_t i; hcl_oow_t i;
for (i = 1; i <= n; i++) for (i = 1; i <= n; i++)
{ {
endp[-i] = colonp[n - i]; endp[-i] = colonp[n - i];
colonp[n - i] = 0; 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; p = str;
end = str + len; end = str + len;
if (p >= end) if (p >= end)
{ {
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "blank address"); if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "blank address");
return -1; 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; return -1;
} }
if (*p >= '0' && *p <= '9') if (*p >= '0' && *p <= '9')
{ {
/* numeric scope id */ /* numeric scope id */
y = 0; y = 0;
@ -244,9 +244,9 @@ TODO:
if (str_to_ipv4(tmp.ptr, tmp.len, &nwad->in4.sin_addr) <= -1) if (str_to_ipv4(tmp.ptr, tmp.len, &nwad->in4.sin_addr) <= -1)
{ {
#if (HCL_SIZEOF_STRUCT_SOCKADDR_IN6 > 0) #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. */ * 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 */ /* without :, it can't be an ipv6 address */
goto unrecog; goto unrecog;
@ -271,7 +271,7 @@ TODO:
return -1; return -1;
} }
if (*p >= '0' && *p <= '9') if (*p >= '0' && *p <= '9')
{ {
/* numeric scope id */ /* numeric scope id */
y = 0; y = 0;
@ -310,7 +310,7 @@ TODO
return nwad->in6.sin6_family; return nwad->in6.sin6_family;
#else #else
goto unrecog; goto unrecog;
#endif #endif
} }
nwad->in4.sin_family = AF_INET; nwad->in4.sin_family = AF_INET;
@ -318,7 +318,7 @@ TODO
} }
#endif #endif
if (p < end && *p == ':') if (p < end && *p == ':')
{ {
/* port number */ /* port number */
hcl_uint32_t port = 0; hcl_uint32_t port = 0;
@ -333,8 +333,8 @@ TODO
} }
tmp.len = p - tmp.ptr; tmp.len = p - tmp.ptr;
if (tmp.len <= 0 || tmp.len >= 6 || if (tmp.len <= 0 || tmp.len >= 6 ||
port > HCL_TYPE_MAX(hcl_uint16_t)) port > HCL_TYPE_MAX(hcl_uint16_t))
{ {
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "port number blank or too large"); if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "port number blank or too large");
return -1; return -1;
@ -356,7 +356,7 @@ TODO
unrecog: unrecog:
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "unrecognized address"); if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "unrecognized address");
return -1; return -1;
no_rbrack: no_rbrack:
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "missing right bracket"); if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "missing right bracket");
return -1; return -1;