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;
int vm_running;
int extra_cflags;
/*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)
{
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);
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)
{
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
* 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));
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() */
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 (xlen > 0 && hcl_feedbchars(hcl, buf, xlen) <= -1) goto feed_error;
if (xlen < HCL_COUNTOF(buf))
if (is_tty)
{
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));
goto oops;
if (ferror(fp))
{
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;
if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error;
#endif
bch = ch;
if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error;
}
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)
@ -549,7 +562,7 @@ int main (int argc, char* argv[])
};
static hcl_bopt_t opt =
{
"l:v",
"l:xv",
lopt
};
@ -557,7 +570,7 @@ int main (int argc, char* argv[])
hcl_oow_t heapsize = DEFAULT_HEAPSIZE;
int verbose = 0;
int show_info = 0;
/*int experimental = 0;*/
int experimental = 0;
#if defined(HCL_BUILD_DEBUG)
const char* dbgopt = HCL_NULL;
@ -581,9 +594,9 @@ int main (int argc, char* argv[])
logopt = opt.arg;
break;
/*case 'x':
case 'x':
experimental = 1;
break;*/
break;
case 'v':
verbose = 1;
@ -695,6 +708,7 @@ int main (int argc, char* argv[])
goto oops;
}
if (experimental) xtn->extra_cflags |= HCL_COMPILE_ENABLE_BLOCK;
xtn->cci_path = argv[opt.ind++]; /* input source code file */
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_ooch_t dummy;
if (!tok)
if (!tok)
{
empty.ptr = &dummy;
empty.len = 0;
@ -193,9 +193,7 @@ redo:
HCL_ASSERT (hcl, tmp1 != HCL_NULL);
hcl_freemem (hcl, c);
hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */
if (tmp2)
{
c = tmp2;
@ -210,9 +208,7 @@ redo:
hcl_cnode_t* tmp;
tmp = c->u.shell.obj;
hcl_freemem (hcl, c);
if (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:
{
hcl_oow_t b3;
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
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);
LOG_INST_1 (hcl, "pop_into_cvar_i %zu", b1);
break;
/* -------------------------------------------------------- */
/* -------------------------------------------------------- */
case HCL_CODE_PUSH_CVAR_M_X:
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:
{
hcl_oow_t b3, b4;
/* b1 - block mask
/* b1 - block mask
* b2 - block mask
* b3 - base literal frame start
* 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);
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_VA(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;
}
case HCL_CODE_MAKE_BLOCK:
case HCL_CODE_MAKE_LAMBDA:
/* b1 - block mask
* b2 - block mask */
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, 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_VA(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 < 800000) newsz = oldsz + (oldsz / 32);
else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64);
else
else
{
hcl_oow_t inc, inc_max;
inc = oldsz / 128;
inc_max = HCL_OBJ_SIZE_MAX - oldsz;
if (inc > inc_max)
if (inc > inc_max)
{
if (inc_max > 0) inc = inc_max;
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);
newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0);
newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0);
hcl_popvolat (hcl);
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
/* find */
while (dic->bucket->slot[index] != hcl->_nil)
while (dic->bucket->slot[index] != hcl->_nil)
{
#if defined(SYMBOL_ONLY_KEY)
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));
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. */
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);
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_seterrnum (hcl, HCL_EDFULL);
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.
* 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). */
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);
#endif
while (dic->bucket->slot[index] != hcl->_nil)
while (dic->bucket->slot[index] != hcl->_nil)
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 */
ass = (hcl_oop_cons_t)hcl_makecons(hcl, (hcl_oop_t)key, value);
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);
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));
if (HCL_IS_SYMBOL(hcl, 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;
}
@ -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 */
/* hcl_seterrXXX() is not called here. the dictionary lookup is very frequent
* and so is lookup failure. for instance, hcl_findmethod() calls this over
/* hcl_seterrXXX() is not called here. the dictionary lookup is very frequent
* 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
* set the error information whenever the failure occurs.
* 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
/* find */
while (dic->bucket->slot[index] != hcl->_nil)
while (dic->bucket->slot[index] != hcl->_nil)
{
#if defined(SYMBOL_ONLY_KEY)
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));
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. */
goto found;

4
lib/err.c
View File

@ -160,7 +160,9 @@ static char* synerrstr[] =
"unbalanced key/value pair",
"unbalanced parenthesis/brace/bracket",
"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 (
char_t* buf, int size,
char_t* buf, int size,
hcl_uintmax_t value, int base_and_flags, int prec,
char_t fillchar, char_t signchar, const char_t* prefix)
{
@ -41,10 +41,10 @@ static int fmt_uintmax (
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ":
"0123456789abcdefghijklmnopqrstuvwxyz";
if ((base_and_flags & HCL_FMT_INTMAX_NOZERO) && value == 0)
if ((base_and_flags & HCL_FMT_INTMAX_NOZERO) && value == 0)
{
p = tmp;
if (base_and_flags & HCL_FMT_INTMAX_ZEROLEAD)
p = tmp;
if (base_and_flags & HCL_FMT_INTMAX_ZEROLEAD)
{
/* NOZERO emits no digit, ZEROLEAD emits 1 digit.
* so it emits '0' */
@ -63,7 +63,7 @@ static int fmt_uintmax (
hcl_uintmax_t v = value;
/* store the resulting numeric string into 'tmp' first */
p = tmp;
p = tmp;
do
{
*p++ = xbasestr[v % base];
@ -73,11 +73,11 @@ static int fmt_uintmax (
/* reslen is the length of the resulting string without padding. */
reslen = (int)(p - tmp);
/* 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 */
if (prec > reslen)
if (prec > reslen)
{
/* if the precision is greater than the actual digits
* made from the value, 0 is inserted in front.
@ -86,12 +86,12 @@ static int fmt_uintmax (
preczero = prec - reslen;
reslen = prec;
}
else
else
{
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. */
preczero++;
reslen++;
@ -137,10 +137,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */
while (preczero > 0 && bp < be)
{
while (preczero > 0 && bp < be)
{
*bp++ = '0';
preczero--;
preczero--;
}
/* copy the numeric string to the destination buffer */
@ -169,10 +169,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */
while (preczero > 0 && bp < be)
{
while (preczero > 0 && bp < be)
{
*bp++ = '0';
preczero--;
preczero--;
}
/* copy the numeric string to the destination buffer */
@ -194,10 +194,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */
while (preczero > 0 && bp < be)
{
while (preczero > 0 && bp < be)
{
*bp++ = '0';
preczero--;
preczero--;
}
/* copy the numeric string to the destination buffer */
@ -213,10 +213,10 @@ static int fmt_uintmax (
if (prefix) while (*prefix && bp < be) *bp++ = *prefix++;
/* add 0s for precision */
while (preczero > 0 && bp < be)
{
while (preczero > 0 && bp < be)
{
*bp++ = '0';
preczero--;
preczero--;
}
/* 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;
n = hcl_conv_bchars_to_uchars_with_cmgr(ptr, &bcslen, &b->ptr[b->len], &ucslen, b->hcl->_cmgr, 1);
b->len += ucslen;
if (n <= -1)
if (n <= -1)
{
if (n == -2)
if (n == -2)
{
return 0; /* buffer full. stop */
}

56
lib/gc.c
View File

@ -31,7 +31,7 @@
#include <sys/resource.h> /* getrusage */
#endif
static struct
static struct
{
hcl_oow_t len;
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);
for (i = 0, x = index, y = index; i < bucket_size; i++)
{
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 */
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 */
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;
/* only an OOP object can have the trailer.
/* only an OOP object can have the trailer.
*
* | _flags |
* | _size | <-- if it's 3
@ -149,7 +149,7 @@ hcl_oow_t hcl_getobjpayloadbytes (hcl_t* hcl, hcl_oop_t oop)
* | X |
* | Y | <-- it may exist if EXTRA is set in _flags.
* | 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_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? */
if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop)))
{
/* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer
/* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer
* are garbages. */
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));
@ -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)
{
hcl_oop_process_t proc;
/* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer
/* the stack in a process object doesn't need to be
* scanned in full. the slots above the stack pointer
* are garbages. */
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;
#endif
hcl_cb_t* cb;
#if defined(HCL_PROFILE_VM)
struct rusage ru;
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++)
{
/* 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. */
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
void hcl_gc (hcl_t* hcl)
{
/*
/*
* move a referenced object to 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.
@ -575,11 +575,11 @@ void hcl_gc (hcl_t* hcl)
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",
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 */
old_nil = hcl->_nil;
@ -603,7 +603,7 @@ void hcl_gc (hcl_t* hcl)
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. */
((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.
* 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 */
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);
/* 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. */
ptr = scan_new_heap (hcl, ptr);
@ -696,7 +696,7 @@ void hcl_gc (hcl_t* hcl)
buc = (hcl_oop_oop_t) hcl->symtab->bucket;
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]);
}
@ -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 */
/* 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",
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
@ -774,13 +774,13 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
if (HCL_UNLIKELY(!hcl->_undef)) return -1;
}
if (!hcl->_nil)
if (!hcl->_nil)
{
hcl->_nil = hcl_makenil(hcl);
if (HCL_UNLIKELY(!hcl->_nil)) return -1;
}
if (!hcl->_true)
if (!hcl->_true)
{
hcl->_true = hcl_maketrue(hcl);
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);
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)
{
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 */
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;
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 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;
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 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 negated;
hcl_oow_t max; /* chunk length */
hcl_oow_t tally;
hcl_oow_t tally;
hcl_oow_t total;
hcl_oow_t clcount;
hcl_oow_t clcount;
} chunked_data;
} u;
} 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)
{
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)
{
@ -216,7 +216,7 @@ static HCL_INLINE int is_token_integer (hcl_client_t* client, hcl_oow_t* value)
*value = v;
return 1;
}
}
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;
break;
}
else if (is_spacechar(c))
else if (is_spacechar(c))
{
/* skip whitespaces at the beginning of the start line before the reply name */
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;
break;
}
else
else
{
/* the first value character has been encountered */
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");
goto oops;
}
else
else
{
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')
{
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
* to be in UTF-8 encoding. this is different from the data in the
* 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)
{
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));
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;
break;
}
else
else
{
/* the first value character has been encountered */
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");
goto oops;
}
else
else
{
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;
/* [NOTE] the max length for the length-bounded transfer scheme is limited
* 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;
}
else
@ -630,8 +630,8 @@ static int handle_char (hcl_client_t* client, hcl_ooci_t c, hcl_oow_t nbytes)
}
return 0;
oops:
oops:
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;
}
else if (bc == ':')
else if (bc == ':')
{
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;
}
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.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_client_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*client) + xtnsize);
if (!client)
if (!client)
{
if (errnum) *errnum = HCL_ESYSMEM;
return HCL_NULL;
}
hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum);
if (!hcl)
if (!hcl)
{
HCL_MMGR_FREE (mmgr, client);
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;
/* 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. */
hcl_setoption (client->dummy_hcl, HCL_LOG_MASK, &client->cfg.logmask);
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:
client->cfg.logmask = *(const hcl_bitmask_t*)value;
if (client->dummy_hcl)
if (client->dummy_hcl)
{
/* setting this affects the dummy hcl immediately.
* existing hcl instances inside worker threads won't get
* affected. new hcl instances to be created later
* existing hcl instances inside worker threads won't get
* affected. new hcl instances to be created later
* is supposed to use the new 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_MBLEN_MAX 8
#elif defined(__TURBOC__)
#elif defined(__TURBOC__)
/* TODO: be more version specific wchar_t may be available in newer BCC */
# define HCL_SIZEOF_CHAR 1
# define HCL_SIZEOF_SHORT 2
@ -92,7 +92,7 @@
# define HCL_SIZEOF_VOID_P 4
# define HCL_SIZEOF_FLOAT 4
# 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___INT8 0

2
lib/hcl-json.h
View File

@ -29,7 +29,7 @@
#include <hcl.h>
/**
/**
* The hcl_json_t type defines a simple json parser.
*/
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 */
/* Mac OS on PPC and m68k uses the big endian mode */
#define HCL_ENDIAN_BIG
#define HCL_ENDIAN_BIG
#if defined(__MWERKS__)
# define HCL_SIZEOF_CHAR 1

22
lib/hcl-msw.h
View File

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

20
lib/hcl-opt.h
View File

@ -30,8 +30,8 @@
#include "hcl-cmn.h"
/** \file
* This file defines functions and data structures to process
* command-line arguments.
* This file defines functions and data structures to process
* command-line arguments.
*/
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 */
/* output */
const hcl_uch_t* lngopt;
const hcl_uch_t* lngopt;
/* input + output */
int ind; /* index into parent argv vector */
@ -83,7 +83,7 @@ struct hcl_bopt_t
hcl_bch_t* arg; /* argument associated with an option */
/* output */
const hcl_bch_t* lngopt;
const hcl_bch_t* lngopt;
/* input + output */
int ind; /* index into parent argv vector */
@ -98,27 +98,27 @@ extern "C" {
/**
* 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
* different option styles: a single character starting with '-', and a
* long name starting with '--'.
* pointed to by \a argv as configured in \a opt. It can process two
* different option styles: a single character starting with '-', and a
* long name starting with '--'.
*
* A character in \a opt.str is treated as a single character option. Should
* 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 parameter for an option stored in the \a opt->opt field.
*
* @return an option character on success, HCL_CHAR_EOF on no more options.
*/
HCL_EXPORT hcl_uci_t hcl_getuopt (
int argc, /* argument count */
int argc, /* argument count */
hcl_uch_t* const* argv, /* argument array */
hcl_uopt_t* opt /* option configuration */
);
HCL_EXPORT hcl_bci_t hcl_getbopt (
int argc, /* argument count */
int argc, /* argument count */
hcl_bch_t* const* argv, /* argument array */
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
{
/* flags passed in via hcl_compile() */
int flags;
/* callback pointer registerd upon compiler creation */
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.
* | SIGN | INSTA | VA | NARGS | NRVARS | NLVARS | TAG |
* 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
* 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)
@ -1158,7 +1161,7 @@ enum hcl_bcode_t
HCL_CODE_RETURN_FROM_BLOCK = 0xFC, /* 252, return the stack top from a block */
HCL_CODE_MAKE_FUNCTION = 0xFD, /* 253 */
HCL_CODE_MAKE_BLOCK = 0xFE, /* 254 */
HCL_CODE_MAKE_LAMBDA = 0xFE, /* 254 */
HCL_CODE_NOOP = 0xFF /* 255 */
};

122
lib/hcl-rbt.h
View File

@ -31,37 +31,37 @@
/** \file
* 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.
*
* This sample code adds a series of keys and values and print them
* in descending key order.
* \code
* #include <hcl-rbt.h>
*
*
* 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"),
* *(int*)HCL_RBT_KPTR(pair), *(int*)HCL_RBT_VPTR(pair));
* return HCL_RBT_WALK_FORWARD;
* }
*
*
* int main ()
* {
* hcl_rbt_t* s1;
* int i;
*
*
* 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));
*
*
* for (i = 0; i < 20; i++)
* {
* int x = i * 20;
* hcl_rbt_insert (s1, &i, HCL_SIZEOF(i), &x, HCL_SIZEOF(x)); // eror handling skipped
* }
*
*
* hcl_rbt_rwalk (s1, walk, HCL_NULL);
*
*
* hcl_rbt_close (s1);
* return 0;
* }
@ -71,7 +71,7 @@
typedef struct hcl_rbt_t hcl_rbt_t;
typedef struct hcl_rbt_pair_t hcl_rbt_pair_t;
/**
/**
* The hcl_rbt_walk_t type defines values that the callback function can
* 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) (
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 */
);
@ -119,17 +119,17 @@ typedef void (*hcl_rbt_freeer_t) (
* key is greater than the second key, -1 otherwise.
*/
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 */
hcl_oow_t klen1, /**< key length */
hcl_oow_t klen1, /**< key length */
const void* kptr2, /**< key pointer */
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
* 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.
*/
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() 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
* \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
* 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.
*/
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;
/**
* 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
* a value plus their length. The length is scaled down with the scale factor
* specified in an owning tree. Use macros defined in the
* 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
* a value plus their length. The length is scaled down with the scale factor
* specified in an owning tree. Use macros defined in the
*/
struct hcl_rbt_pair_t
{
@ -202,8 +202,8 @@ struct hcl_rbt_pair_t
typedef struct hcl_rbt_style_t hcl_rbt_style_t;
/**
* The hcl_rbt_style_t type defines callback function sets for key/value
* pair manipulation.
* The hcl_rbt_style_t type defines callback function sets for key/value
* pair manipulation.
*/
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.
* 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.
*/
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
* 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.
*/
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
* 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.
* \return a pointer to the updated or inserted pair on success,
* HCL_NULL on failure.
* \return a pointer to the updated or inserted pair on success,
* HCL_NULL on failure.
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_upsert (
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
* 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.
* \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_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
* 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.
* \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_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,
* it may behave like hcl_rbt_insert(), hcl_rbt_upsert(), hcl_rbt_update(),
* 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));
* return HCL_RBT_WALK_FORWARD;
* }
*
*
* hcl_rbt_pair_t* cbserter (
* hcl_rbt_t* rbt, hcl_rbt_pair_t* pair,
* 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;
* 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);
* }
* else
* {
* // a pair with the key exists.
* // in this sample, i will append the new value to the old value
* // a pair with the key exists.
* // in this sample, i will append the new value to the old value
* // separated by a comma
* hcl_rbt_pair_t* new_pair;
* hcl_ooch_t comma = HCL_T(',');
* hcl_oob_t* vptr;
*
* // allocate a new pair, but without filling the actual value.
* // note vptr is given HCL_NULL for that purpose
*
* // allocate a new pair, but without filling the actual value.
* // note vptr is given HCL_NULL for that purpose
* 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;
*
* // fill in the value space
*
* // fill in the value space
* vptr = new_pair->vptr;
* hcl_memcpy (vptr, pair->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));
* vptr += 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);
*
* // return the new pair
*
* // return the new pair
* return new_pair;
* }
* }
*
*
* int main ()
* {
* hcl_rbt_t* s1;
* int i;
* 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") };
*
*
* s1 = hcl_rbt_open (
* HCL_MMGR_GETDFL(), 0,
* 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);
*
*
* for (i = 0; i < HCL_COUNTOF(vals); i++)
* {
* hcl_cstr_t ctx;
@ -506,7 +506,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
* ); // note error check is skipped
* }
* hcl_rbt_walk (s1, print_map_pair, HCL_NULL);
*
*
* hcl_rbt_close (s1);
* 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
*/
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.
*/
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.
*/
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.
* 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.
* - If \a kptr is #HCL_NULL, the key space of the size \a klen is reserved but
* 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_rbt_t* rbt,
void* kptr,
void* kptr,
hcl_oow_t klen,
void* vptr,
hcl_oow_t vlen
@ -595,7 +595,7 @@ HCL_EXPORT int hcl_rbt_dflcomp (
const void* kptr1,
hcl_oow_t klen1,
const void* kptr2,
hcl_oow_t klen2
hcl_oow_t klen2
);
#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) (
hcl_tmr_t* tmr,
const hcl_ntime_t* now,
const hcl_ntime_t* now,
hcl_tmr_event_t* evt
);
@ -72,7 +72,7 @@ extern "C" {
#endif
HCL_EXPORT hcl_tmr_t* hcl_tmr_open (
hcl_t* mmgr,
hcl_t* mmgr,
hcl_oow_t xtnsize,
hcl_oow_t capa
);
@ -82,7 +82,7 @@ HCL_EXPORT void hcl_tmr_close (
);
HCL_EXPORT int hcl_tmr_init (
hcl_tmr_t* tmr,
hcl_tmr_t* tmr,
hcl_t* mmgr,
hcl_oow_t capa
);

12
lib/hcl-xma.h
View File

@ -52,15 +52,15 @@
* hcl_xma_t* xma;
* 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
* 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
* 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.
*
* 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
* // is closed after them.
@ -102,7 +102,7 @@ struct hcl_xma_t
int internal;
/** 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 */
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 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
* 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().
*/
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
* reallocation fails */
/* +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;
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)
{
/* 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
* this point because one of the callbacks could arrange to stop
* logging */
@ -312,7 +312,7 @@ void hcl_fini (hcl_t* hcl)
if (hcl->heap) hcl_killheap (hcl, hcl->heap);
if (hcl->log.ptr)
if (hcl->log.ptr)
{
hcl_freemem (hcl, hcl->log.ptr);
hcl->log.capa = 0;
@ -362,7 +362,7 @@ void hcl_reset (hcl_t* hcl)
hcl_oop_t v;
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. */
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;
break;
}
case HCL_MOD_INCTX:
hcl->option.mod_inctx = *(void**)value;
break;
@ -529,13 +529,13 @@ int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)
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);
}
return 0;
einval:
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
@ -608,7 +608,7 @@ hcl_cb_t* hcl_regcb (hcl_t* hcl, hcl_cb_t* tmpl)
actual->next = hcl->cblist;
actual->prev = HCL_NULL;
hcl->cblist = actual;
/* vm_checkbc is invoked very frequently.
* and there might be multiple 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->vm_checkbc)
if (cb->vm_checkbc)
{
HCL_ASSERT (hcl, hcl->vm_checkbc_cb_count > 0);
hcl->vm_checkbc_cb_count--;
@ -688,7 +688,7 @@ static struct
const hcl_bch_t* modname;
int (*modload) (hcl_t* hcl, hcl_mod_t* mod);
}
static_modtab[] =
static_modtab[] =
{
{ "arr", hcl_mod_arr },
{ "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;
#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
* 1 for _ at the end when hcl_mod_xxx_ is attempted.
* 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
* include a character that requires encoding conversion.
* 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))
{
@ -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 ... */
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;
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);
}
if (md.handle == HCL_NULL)
if (md.handle == HCL_NULL)
{
HCL_DEBUG2 (hcl, "Cannot open a module [%.*js]\n", 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*/
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_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)
{
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_rbt_delete (&hcl->modtab, name, namelen);
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->handle)
if (mdp->handle)
{
hcl->vmprim.dl_close (hcl, 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, '.');
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.
* what if the compiler is broken? imagine a buggy compiler rewritten
* 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 ((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 */
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_UNBALKV, /* unbalanced key/value pair */
HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */
HCL_SYNERR_SEMICOLON, /* unexpected semicolon */
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;
@ -575,8 +578,8 @@ typedef struct hcl_function_t hcl_function_t;
typedef struct hcl_function_t* hcl_oop_function_t;
#define HCL_BLOCK_NAMED_INSTVARS 3
typedef struct hcl_block_t hcl_block_t;
typedef struct hcl_block_t* hcl_oop_block_t;
typedef struct hcl_lambda_t hcl_lambda_t;
typedef struct hcl_lambda_t* hcl_oop_lambda_t;
#define HCL_CONTEXT_NAMED_INSTVARS 9
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
* 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.
*/
struct hcl_block_t
struct hcl_lambda_t
{
HCL_OBJ_HEADER;
@ -692,10 +695,10 @@ struct hcl_process_t
hcl_oop_t id; /* 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 exsp; /* exception stack pointer. SmallInteger */
hcl_oop_t exsp; /* exception stack pointer. SmallInteger */
hcl_oop_t exst; /* exception stack top */
hcl_oop_t clsp; /* class stack pointer */
@ -1491,7 +1494,10 @@ enum hcl_compile_flag_t
HCL_COMPILE_CLEAR_CODE = (1 << 0),
/* 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;
#endif
@ -1868,7 +1874,7 @@ enum hcl_brand_t
HCL_BRAND_PRIM,
HCL_BRAND_FUNCTION,
HCL_BRAND_BLOCK,
HCL_BRAND_LAMBDA,
HCL_BRAND_CONTEXT,
HCL_BRAND_PROCESS,
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_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_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_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)

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;
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_seterrnum (hcl, HCL_EOOMEM);

42
lib/json.c
View File

@ -52,15 +52,15 @@ struct hcl_json_state_node_t
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 */
int state;
int state;
} id; /* in dictionary */
struct
{
int escaped;
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. */
hcl_uch_t acc;
} sv;
@ -70,7 +70,7 @@ struct hcl_json_state_node_t
int digit_count;
/* for a character, no way to support the unicode character
* in the bch mode */
hcl_ooch_t acc;
hcl_ooch_t acc;
} cv;
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)
{
hcl_oow_t i;
if (json->tok_capa - json->tok.len > len)
{
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;
}
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] = '\0';
return 0;
@ -226,7 +226,7 @@ static int push_state (hcl_json_t* json, hcl_json_state_t state)
ss->state = state;
ss->next = json->state_stack;
json->state_stack = ss;
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)
{
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)
{
@ -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)
{
if (c >= '0' && c <= '8')
if (c >= '0' && c <= '8')
{
json->state_stack->u.sv.escaped = 3;
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)
{
if (c >= '0' && c <= '8')
if (c >= '0' && c <= '8')
{
json->state_stack->u.cv.escaped = 3;
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 == '\'')
{
pop_state (json);
if (json->tok.len < 1)
{
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 (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);
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;
return 1;
}
else if (is_spacechar(c))
else if (is_spacechar(c))
{
/* do nothing */
return 1;
@ -796,7 +796,7 @@ start_over:
case HCL_JSON_STATE_IN_STRING_VALUE:
x = handle_string_value_char(json, c);
break;
case HCL_JSON_STATE_IN_CHARACTER_VALUE:
x = handle_character_value_char(json, c);
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)
{
/* incomplete sequence */
*xlen = ptr - data;
*xlen = ptr - data;
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_json_t*)HCL_MMGR_ALLOC(mmgr, HCL_SIZEOF(*json) + xtnsize);
if (!json)
if (!json)
{
if (errnum) *errnum = HCL_ESYSMEM;
return HCL_NULL;
}
hcl = hcl_openstdwithmmgr(mmgr, HCL_SIZEOF(*xtn), errnum);
if (!hcl)
if (!hcl)
{
HCL_MMGR_FREE (mmgr, json);
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;
/* 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. */
hcl_setoption (json->dummy_hcl, HCL_LOG_MASK, &json->cfg.logmask);
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:
json->cfg.logmask = *(const hcl_bitmask_t*)value;
if (json->dummy_hcl)
if (json->dummy_hcl)
{
/* setting this affects the dummy hcl immediately.
* existing hcl instances inside worker threads won't get
* affected. new hcl instances to be created later
* existing hcl instances inside worker threads won't get
* affected. new hcl instances to be created later
* is supposed to use the new 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);
return -1;
}
ys = 0;
yv = *y;
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);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
if (scale <= -1)
{
hcl_popvolats (hcl, 2);
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);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
if (scale <= -1)
{
hcl_popvolats (hcl, 2);
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);
return HCL_NULL;
}
ys = 0;
yv = 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);
if (!nv) return HCL_NULL;
cs = xs + ys;
cs = xs + ys;
if (cs <= 0) return nv; /* the result must be an integer */
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++)
{
nv = hcl_mulints(hcl, nv, HCL_SMOOI_TO_OOP(10));
if (!nv)
if (!nv)
{
hcl_popvolat (hcl);
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);
scale = equalize_scale(hcl, &x, &y);
if (scale <= -1)
if (scale <= -1)
{
hcl_popvolats (hcl, 2);
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);
v = ((hcl_oop_fpdec_t)x)->value;
v = hcl_absint(hcl, v);
if (!v) return HCL_NULL;
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;
break;
}
if (HCL_LIKELY(oop))
{
#if 0

30
lib/opt-impl.h
View File

@ -31,7 +31,7 @@
#include "hcl-opt.h"
#include "hcl-utl.h"
/*
/*
* 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->lngopt = HCL_NULL;
if (opt->cur == HCL_NULL)
if (opt->cur == HCL_NULL)
{
opt->cur = XEMSG;
opt->ind = 1;
}
if (*opt->cur == '\0')
if (*opt->cur == '\0')
{
/* 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 */
opt->cur = XEMSG;
return XCI_EOF;
@ -127,7 +127,7 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt)
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;
@ -151,10 +151,10 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt)
}
else if (opt->arg == HCL_NULL)
{
/* check if it has a remaining argument
/* check if it has a remaining argument
* available */
if (argc <= ++opt->ind) return BADARG;
/* If so, the next available argument is
if (argc <= ++opt->ind) return BADARG;
/* If so, the next available argument is
* taken to be an option argument */
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');*/
opt->lngopt = opt->cur;
opt->lngopt = opt->cur;
return BADCH;
}
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,
@ -180,21 +180,21 @@ xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt)
return BADCH;
}
if (*++oli != ':')
if (*++oli != ':')
{
/* don't need argument */
if (*opt->cur == '\0') opt->ind++;
}
else
else
{
/* need an argument */
if (*opt->cur != '\0')
if (*opt->cur != '\0')
{
/* no white space */
opt->arg = opt->cur;
}
else if (argc <= ++opt->ind)
else if (argc <= ++opt->ind)
{
/* no arg */
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:
while (rem > 0)
{
if (*ptr == '\0')
if (*ptr == '\0')
{
n = hcl_logbfmt (hcl, mask, "%jc", *ptr);
HCL_ASSERT (hcl, n == 1);
@ -82,9 +82,9 @@ start_over:
n = hcl_logbfmt (hcl, mask, "%.*js", rem, ptr);
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
* at the beginning of the loop */
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;
/*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);*/
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);
if (msg == hcl->_nil || msg == hcl->_true || msg == hcl->_false)
if (msg == hcl->_nil || msg == hcl->_true || msg == hcl->_false)
{
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 */
}
else if (arg == hcl->_false)
else if (arg == hcl->_false)
{
rv = hcl->_false;
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;
break;
}
else if (arg == hcl->_false)
else if (arg == hcl->_false)
{
/* 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)
{
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;
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_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);
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);
nrvars = GET_BLK_MASK_NRVARS(attr_mask);
nlvars = GET_BLK_MASK_NLVARS(attr_mask);
/*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_oow_t index;
if (nargs >= 2)
if (nargs >= 2)
{
ctx = (hcl_oop_context_t)HCL_STACK_GETARG(hcl, nargs, 1);
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);
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;
}
@ -895,7 +895,7 @@ static pf_t builtin_prims[] =
{ 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 */
{ 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 */
@ -943,7 +943,7 @@ static pf_t builtin_prims[] =
{ 2, 2, pf_integer_bxor, 7, { 'b','i','t','-','x','o','r' } },
{ 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' } },
{ 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' } },
{ 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);
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
* name */
* name */
HCL_OBJ_SET_FLAGS_KERNEL (name, 2);
}

90
lib/print.c
View File

@ -88,7 +88,7 @@ enum
WORD_PRIM,
WORD_FUNCTION,
WORD_BLOCK,
WORD_LAMBDA,
WORD_CONTEXT,
WORD_PROCESS,
WORD_PROCESS_SCHEDULER,
@ -98,7 +98,7 @@ enum
WORD_INSTANCE
};
static struct
static struct
{
hcl_oow_t len;
hcl_ooch_t ptr[20];
@ -113,7 +113,7 @@ static struct
{ 7, { '#','<','P','R','I','M','>' } },
{ 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, { '#','<','P','R','O','C','E','S','S','>' } },
{ 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 defined(HCL_OOCH_IS_UCH)
else if (chu < ' ')
else if (chu < ' ')
#else
else if (chu < ' ' || chu >= 0x80)
else if (chu < ' ' || chu >= 0x80)
#endif
{
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;
}
else
else
#endif
{
#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_BLOCK */
{ "[", "[" }, /*HCL_CONCODE_ARRAY */
{ "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */
{ "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */
{ "#{", "{" }, /*HCL_CONCODE_DIC */
{ "#(", "[" } /*HCL_CONCODE_QLIST */
};
@ -237,7 +237,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj)
{ ")", "]" }, /*HCL_CONCODE_QLIST */
};
static const hcl_bch_t* breakers[][2] =
static const hcl_bch_t* breakers[][2] =
{
{ " ", "," }, /* item 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);
next:
switch ((brand = HCL_BRANDOF(hcl, obj)))
switch ((brand = HCL_BRANDOF(hcl, obj)))
{
case HCL_BRAND_SMOOI:
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.
* not using the object memory. the result stays in the temporary
* buffer */
tmp = hcl_inttostr(hcl, obj, 10 | HCL_INTTOSTR_NONEWOBJ);
tmp = hcl_inttostr(hcl, obj, 10 | HCL_INTTOSTR_NONEWOBJ);
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;
break;
}
@ -319,7 +319,7 @@ next:
if (hcl_bfmt_out(fmtout, "0.%0*d", scale, 0) <= -1) return -1;
}
}
else
else
{
hcl_oop_t tmp;
hcl_oow_t len, adj;
@ -334,13 +334,13 @@ next:
{
if (scale == len)
{
if (hcl_bfmt_out(fmtout, "%.*js0.%.*js",
if (hcl_bfmt_out(fmtout, "%.*js0.%.*js",
adj, hcl->inttostr.xbuf.ptr,
len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1;
}
else
{
if (hcl_bfmt_out(fmtout, "%.*js0.%0*d%.*js",
if (hcl_bfmt_out(fmtout, "%.*js0.%0*d%.*js",
adj, hcl->inttostr.xbuf.ptr,
scale - len, 0,
len, &hcl->inttostr.xbuf.ptr[adj]) <= -1) return -1;
@ -362,8 +362,8 @@ next:
qse_char_t buf[256];
hcl->prm.sprintf (
hcl->prm.ctx,
buf, HCL_COUNTOF(buf),
HCL_T("%Lf"),
buf, HCL_COUNTOF(buf),
HCL_T("%Lf"),
#ifdef __MINGW32__
(double)HCL_RVAL(obj)
#else
@ -392,7 +392,7 @@ next:
for (i = 0; i < HCL_OBJ_GET_SIZE(obj); i++)
{
ch = ((hcl_oop_char_t)obj)->slot[i];
if (ch < ' ' || ch == '\"' || ch == '\\')
if (ch < ' ' || ch == '\"' || ch == '\\')
{
escape = 1;
break;
@ -431,7 +431,7 @@ next:
{
int x;
/* Push what to print next on to the stack
/* Push what to print next on to the stack
* the variable p is */
ps.type = PRINT_STACK_CONS;
ps.obj = HCL_CONS_CDR(cur);
@ -440,30 +440,30 @@ next:
if (x <= -1) return -1;
obj = HCL_CONS_CAR(cur);
/* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it
/* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label
* is made at the at of this function. */
goto next;
goto next;
resume_cons:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS);
cur = ps.obj; /* Get back the CDR pushed */
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
* indicates the end of a list. break the loop */
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. */
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
* after the jump is maded back to the 'resume'
* after the jump is maded back to the 'resume'
* label. */
ps.type = PRINT_STACK_CONS;
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_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;
break;
@ -504,7 +504,7 @@ next:
/* Push what to print next on to the stack */
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;
}
@ -513,26 +513,26 @@ next:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY);
ps.obj = obj;
}
x = push (hcl, &ps);
if (x <= -1) return -1;
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;
}
/* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it
/* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label
* is made at the end of this function. */
goto next;
goto next;
resume_array:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY);
arridx = ps.idx;
obj = ps.obj;
}
}
while (1);
break;
}
@ -562,7 +562,7 @@ next:
dic = (hcl_oop_dic_t)obj;
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;
break;
@ -611,7 +611,7 @@ next:
{
/* Push what to print next on to the stack */
ps.idx = bucidx + 1;
if (ps.idx >= bucsize)
if (ps.idx >= bucsize)
{
ps.type = PRINT_STACK_DIC_END;
}
@ -629,16 +629,16 @@ next:
obj = HCL_CONS_CDR(obj);
}
if (buctally > 0)
if (buctally > 0)
{
if (hcl_bfmt_out(fmtout, breakers[buctally & 1][json]) <= -1) return -1;
}
/* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it
/* Jump to the 'next' label so that the object
* pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label
* is made at the end of this function. */
goto next;
goto next;
resume_dic:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_DIC);
@ -647,7 +647,7 @@ next:
obj = ps.obj;
dic = (hcl_oop_dic_t)ps.obj2;
bucsize = HCL_OBJ_GET_SIZE(dic->bucket);
}
}
while (1);
break;
@ -677,8 +677,8 @@ next:
word_index = WORD_FUNCTION;
goto print_word;
case HCL_BRAND_BLOCK:
word_index = WORD_BLOCK;
case HCL_BRAND_LAMBDA:
word_index = WORD_LAMBDA;
goto print_word;
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;
/* 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 */
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;
/* 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;
}

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)
{
hcl_rstl_t* rstl;
//HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st;
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)
{
HCL_MEMSET (&hcl->c->feed, 0, HCL_SIZEOF(hcl->c->feed));
hcl->c->feed.lx.state = HCL_FLX_START;
hcl->c->feed.lx.loc.line = 1;
hcl->c->feed.lx.loc.colm = 1;
hcl->c->feed.lx.loc.file = HCL_NULL;
hcl->c->feed.on_cnode = on_fed_cnode;
}
@ -1101,6 +1096,7 @@ static int feed_process_token (hcl_t* hcl)
case HCL_TOK_LBRACE: /* { */
frd->flagv = 0;
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;
case HCL_TOK_DLPAREN: /* #{ */
@ -1176,14 +1172,15 @@ static int feed_process_token (hcl_t* hcl)
if (frd->level <= 0)
{
/* 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;
}
if (!(frd->flagv & AUTO_FORGED))
{
/* TODO: change error info */
hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
/* TODO: change error info or code */
hcl_setsynerr (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), HCL_NULL);
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);
goto oops;
}
hcl_logbfmt(hcl, HCL_LOG_FATAL, "forged xlist...exiting..OK\n");
frd->obj = leave_list(hcl, &frd->flagv, &oldflagv);
frd->level--;
@ -1388,6 +1386,7 @@ static int feed_process_token (hcl_t* hcl)
{
hcl_oop_t obj = frd->obj;
hcl_logbfmt(hcl, HCL_LOG_FATAL, "QQQQQQQQQQQQ forged xlist...\n");
frd->flagv = AUTO_FORGED;
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 < 800000) newsz = oldsz + (oldsz / 32);
else if (oldsz < 1600000) newsz = oldsz + (oldsz / 64);
else
else
{
hcl_oow_t inc, inc_max;
inc = oldsz / 128;
inc_max = HCL_OBJ_SIZE_MAX - oldsz;
if (inc > inc_max)
if (inc > inc_max)
{
if (inc_max > 0) inc = inc_max;
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_ASSERT (hcl, len > 0);
if (len <= 0)
if (len <= 0)
{
/* i don't allow an empty symbol name */
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);
/* 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];
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);
}
if (!create)
if (!create)
{
hcl_seterrnum (hcl, HCL_ENOENT);
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);
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_seterrnum (hcl, HCL_EDFULL);
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.
* 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). */
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 */
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);
}

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)
{
hcl_tmr_clear (tmr);
if (tmr->event)
if (tmr->event)
{
hcl_freemem (tmr->hcl, tmr->event);
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_oow_t old_index;
item = tmr->event[index];
item = tmr->event[index];
old_index = index;
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;
}
while (index < base);
tmr->event[index] = item;
if (notify && index != old_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;
static __utf8_t utf8_table[] =
static __utf8_t utf8_table[] =
{
{0x00000000ul, 0x0000007Ful, 0x00, 0x80, 0x7F, 1},
{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);
cur = utf8_table;
while (cur < end)
while (cur < end)
{
if (uc >= cur->lower && uc <= cur->upper) return 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)
{
int index = cur->length;
while (index > 1)
while (index > 1)
{
/*
* 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);
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
* only if size is as large as cur->length. */
if (size >= cur->length)
if (size >= cur->length)
{
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++)
{
/* in utf8, trailing bytes are all
* set with 0x80.
* set with 0x80.
*
* 10XXXXXX & 11000000 => 10000000
*
* if not, invalid. */
if ((utf8[i] & 0xC0) != 0x80) return 0;
if ((utf8[i] & 0xC0) != 0x80) return 0;
w = (w << 6) | (utf8[i] & 0x3F);
}
*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++)
{
/* in utf8, trailing bytes are all
* set with 0x80.
* set with 0x80.
*
* 10XXXXXX & 11000000 => 10000000
*
* if not, invalid. */
if ((utf8[i] & 0xC0) != 0x80) return 0;
if ((utf8[i] & 0xC0) != 0x80) return 0;
}
}
}
/* this return value can indicate both
* the correct length (size >= cur->length)
* and
/* this return value can indicate both
* the correct length (size >= cur->length)
* and
* the incomplete seqeunce error (size < 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 last;
};
/* 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 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 */
/*
/*
* 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.
*
$ 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
* offset by 1 bit because of the 'free' bit-field.
* i could keep 'size' without shifting with bit manipulation
* because the actual size is aligned and the last bit will
* i could keep 'size' without shifting with bit manipulation
* 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
* 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. */
hcl_oow_t free: 1;
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 free: 1;
@ -105,7 +105,7 @@ static void DBG_VERIFY (hcl_xma_t* xma, const char* desc)
{
hcl_xma_mblk_t* tmp, * next;
hcl_oow_t cnt;
hcl_oow_t fsum, asum;
hcl_oow_t fsum, asum;
#if defined(HCL_XMA_ENABLE_STAT)
hcl_oow_t isum;
#endif
@ -139,7 +139,7 @@ static void DBG_VERIFY (hcl_xma_t* xma, const char* desc)
#define DBG_VERIFY(xma, desc)
#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;
@ -169,7 +169,7 @@ static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n)
#if HCL_SIZEOF_OOW_T >= 8
if ((n & (~(hcl_oow_t)0 << (BITS-32))) == 0) { x -= 32; n <<= 32; }
#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; }
#endif
#if HCL_SIZEOF_OOW_T >= 2
@ -185,7 +185,7 @@ static HCL_INLINE hcl_oow_t szlog2 (hcl_oow_t n)
#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;
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() */
}
else if (zonesize < FBLKMINSIZE)
else if (zonesize < FBLKMINSIZE)
{
/* 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 */
@ -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 */
xfi = getxfi(xma, first->size);
/* 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 */
xma->start = (hcl_uint8_t*)first;
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.nused = 0;
#endif
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)
{
/*
* attach a block to a free list
/*
* attach a block to a free list
*/
/* 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 */
b->free_prev = HCL_NULL;
b->free_prev = HCL_NULL;
b->free_next = xma->xfree[xfi];
if (xma->xfree[xfi]) xma->xfree[xfi]->free_prev = 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)
{
/* 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. */
p->free_next = n;
}
else
else
{
/* the previous item does not exist. the block is the first
* 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;
}
/* 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 */
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;
/* the remaining part is large enough to hold
* another block. let's split it
/* the remaining part is large enough to hold
* another block. let's split it
*/
/* 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);
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;
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;
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.
*/
@ -555,7 +555,7 @@ static void* _realloc_merge (hcl_xma_t* xma, void* b, hcl_oow_t size)
{
/* shrink the block */
hcl_oow_t rem = blk->size - size;
if (rem >= FBLKMINSIZE)
if (rem >= FBLKMINSIZE)
{
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;
if (b == HCL_NULL)
if (b == HCL_NULL)
{
/* 'realloc' with NULL is the same as 'alloc' */
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
*
* blk
* blk
* |
* v
* +------------+------------+------------+------------+
* | X | | Y | Z |
* +------------+------------+------------+------------+
*
*
*
*
* +--------------------------------------+------------+
* | X | Z |
* +--------------------------------------+------------+
*
*/
hcl_xma_mblk_t* z = next_mblk(y);
hcl_oow_t ns = MBLKHDRSIZE + org_blk_size + MBLKHDRSIZE;
hcl_oow_t bs = ns + y->size;
@ -719,8 +719,8 @@ void hcl_xma_free (hcl_xma_t* xma, void* b)
* +------------+------------+------------+
* | | Y | Z |
* +------------+------------+------------+
*
*
*
*
*
* blk
* |
@ -728,8 +728,8 @@ void hcl_xma_free (hcl_xma_t* xma, void* b)
* +-------------------------+------------+
* | | Z |
* +-------------------------+------------+
*
*
*
*
*/
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)
{
/*
* Merge the block with the previous block
* Merge the block with the previous block
*
* 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)
{
hcl_xma_mblk_t* tmp;
hcl_oow_t fsum, asum;
hcl_oow_t fsum, asum;
#if defined(HCL_XMA_ENABLE_STAT)
hcl_oow_t isum;
#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++;
if (c >= '0' && c <= '9')
if (c >= '0' && c <= '9')
{
if (digits > 0 && acc == 0) return -1;
acc = acc * 10 + (c - '0');
if (acc > 255) return -1;
digits++;
}
else if (c == '.')
else if (c == '.')
{
if (dots >= 3 || digits == 0) return -1;
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;
}
if (ch == ':')
if (ch == ':')
{
curtok = src;
if (!saw_xdigit)
if (!saw_xdigit)
{
if (colonp) return -1;
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) &&
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*);
saw_xdigit = 0;
break;
break;
}
return -1;
}
if (saw_xdigit)
if (saw_xdigit)
{
if (tp + HCL_SIZEOF(hcl_uint16_t) > endp) return -1;
*tp++ = (hcl_uint8_t)(val >> 8) & 0xff;
*tp++ = (hcl_uint8_t)val & 0xff;
}
if (colonp != HCL_NULL)
if (colonp != HCL_NULL)
{
/*
* 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 i;
for (i = 1; i <= n; i++)
for (i = 1; i <= n; i++)
{
endp[-i] = colonp[n - i];
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;
end = str + len;
if (p >= end)
if (p >= end)
{
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "blank address");
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;
}
if (*p >= '0' && *p <= '9')
if (*p >= '0' && *p <= '9')
{
/* numeric scope id */
y = 0;
@ -244,9 +244,9 @@ TODO:
if (str_to_ipv4(tmp.ptr, tmp.len, &nwad->in4.sin_addr) <= -1)
{
#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. */
if (p >= end || *p != ':')
if (p >= end || *p != ':')
{
/* without :, it can't be an ipv6 address */
goto unrecog;
@ -271,7 +271,7 @@ TODO:
return -1;
}
if (*p >= '0' && *p <= '9')
if (*p >= '0' && *p <= '9')
{
/* numeric scope id */
y = 0;
@ -310,7 +310,7 @@ TODO
return nwad->in6.sin6_family;
#else
goto unrecog;
#endif
#endif
}
nwad->in4.sin_family = AF_INET;
@ -318,7 +318,7 @@ TODO
}
#endif
if (p < end && *p == ':')
if (p < end && *p == ':')
{
/* port number */
hcl_uint32_t port = 0;
@ -333,8 +333,8 @@ TODO
}
tmp.len = p - tmp.ptr;
if (tmp.len <= 0 || tmp.len >= 6 ||
port > HCL_TYPE_MAX(hcl_uint16_t))
if (tmp.len <= 0 || tmp.len >= 6 ||
port > HCL_TYPE_MAX(hcl_uint16_t))
{
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "port number blank or too large");
return -1;
@ -356,7 +356,7 @@ TODO
unrecog:
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "unrecognized address");
return -1;
no_rbrack:
if (hcl) hcl_seterrbfmt (hcl, HCL_EINVAL, "missing right bracket");
return -1;