trying to revive this project

This commit is contained in:
2018-02-05 10:43:25 +00:00
parent a84cd9da09
commit 293222d5c5
47 changed files with 16035 additions and 6174 deletions

View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2016 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
@ -27,7 +27,6 @@
#include "hcl-prv.h"
/*#include <stdio.h>*/ /* for snrintf(). used for floating-point number formatting */
#include <stdarg.h>
#if defined(_MSC_VER) || defined(__BORLANDC__) || (defined(__WATCOMC__) && (__WATCOMC__ < 1200))
# define snprintf _snprintf
@ -126,12 +125,12 @@ static const hcl_bch_t hex2ascii_upper[] =
'N','O','P','Q','R','S','T','U','V','W','X','H','Z'
};
static hcl_ooch_t ooch_nullstr[] = { '(','n','u','l','l', ')','\0' };
static hcl_uch_t uch_nullstr[] = { '(','n','u','l','l', ')','\0' };
static hcl_bch_t bch_nullstr[] = { '(','n','u','l','l', ')','\0' };
typedef int (*hcl_fmtout_putch_t) (
hcl_t* hcl,
hcl_oow_t mask,
hcl_oow_t mask,
hcl_ooch_t c,
hcl_oow_t len
);
@ -160,7 +159,7 @@ struct hcl_fmtout_t
* The buffer pointed to by `nbuf' must have length >= MAXNBUF.
*/
static hcl_bch_t* sprintn_lower (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t *lenp)
static hcl_bch_t* sprintn_lower (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t* lenp)
{
hcl_bch_t* p;
@ -172,7 +171,7 @@ static hcl_bch_t* sprintn_lower (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, h
return p; /* returns the end */
}
static hcl_bch_t* sprintn_upper (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t *lenp)
static hcl_bch_t* sprintn_upper (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t* lenp)
{
hcl_bch_t* p;
@ -187,6 +186,103 @@ static hcl_bch_t* sprintn_upper (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, h
/* ------------------------------------------------------------------------- */
static int put_ooch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
{
/* this is not equivalent to put_oocs(hcl,mask,&ch, 1);
* this function is to emit a single character multiple times */
hcl_oow_t rem;
if (len <= 0) return 1;
if (hcl->log.len > 0 && hcl->log.last_mask != mask)
{
/* the mask has changed. commit the buffered text */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
}
redo:
rem = 0;
if (len > hcl->log.capa - hcl->log.len)
{
hcl_oow_t newcapa, max;
hcl_ooch_t* tmp;
max = HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len;
if (len > max)
{
/* data too big. */
rem += len - max;
len = max;
}
newcapa = HCL_ALIGN_POW2(hcl->log.len + len, HCL_LOG_CAPA_ALIGN); /* TODO: adjust this capacity */
if (newcapa > hcl->option.log_maxcapa)
{
/* [NOTE]
* it doesn't adjust newcapa to hcl->option.log_maxcapa.
* nor does it cut the input to fit it into the adjusted capacity.
* if maxcapa set is not aligned to HCL_LOG_CAPA_ALIGN,
* the largest buffer capacity may be suboptimal */
goto make_do;
}
/* +1 to handle line ending injection more easily */
tmp = hcl_reallocmem (hcl, hcl->log.ptr, (newcapa + 1) * HCL_SIZEOF(*tmp));
if (!tmp)
{
make_do:
if (hcl->log.len > 0)
{
/* can't expand the buffer. just flush the existing contents */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
}
if (len > hcl->log.capa)
{
rem += len - hcl->log.capa;
len = hcl->log.capa;
}
}
else
{
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
}
while (len > 0)
{
hcl->log.ptr[hcl->log.len++] = ch;
len--;
}
hcl->log.last_mask = mask;
if (rem > 0)
{
len = rem;
goto redo;
}
return 1; /* success */
}
static int put_oocs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
{
hcl_oow_t rem;
if (len <= 0) return 1;
if (hcl->log.len > 0 && hcl->log.last_mask != mask)
@ -204,96 +300,81 @@ static int put_ooch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
}
redo:
rem = 0;
if (len > hcl->log.capa - hcl->log.len)
{
hcl_oow_t newcapa;
hcl_oow_t newcapa, max;
hcl_ooch_t* tmp;
if (len > HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len)
max = HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len;
if (len > max)
{
/* data too big */
hcl->errnum = HCL_ETOOBIG;
return -1;
/* data too big. */
rem += len - max;
len = max;
}
newcapa = HCL_ALIGN_POW2(hcl->log.len + len, 512); /* TODO: adjust this capacity */
if (newcapa > hcl->option.log_maxcapa)
{
/* [NOTE]
* it doesn't adjust newcapa to hcl->option.log_maxcapa.
* nor does it cut the input to fit it into the adjusted capacity.
* if maxcapa set is not aligned to HCL_LOG_CAPA_ALIGN,
* the largest buffer capacity may be suboptimal */
goto make_do;
}
newcapa = HCL_ALIGN(hcl->log.len + len, 512); /* TODO: adjust this capacity */
/* +1 to handle line ending injection more easily */
tmp = hcl_reallocmem (hcl, hcl->log.ptr, (newcapa + 1) * HCL_SIZEOF(*tmp));
if (!tmp)
{
make_do:
if (hcl->log.len > 0)
{
/* can't expand the buffer. just flush the existing contents */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
goto redo;
}
return -1;
if (len > hcl->log.capa)
{
rem += len - hcl->log.capa;
len = hcl->log.capa;
}
}
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
while (len > 0)
{
hcl->log.ptr[hcl->log.len++] = ch;
len--;
}
hcl->log.last_mask = mask;
return 1; /* success */
}
static int put_oocs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
{
if (len <= 0) return 1;
if (hcl->log.len > 0 && hcl->log.last_mask != mask)
{
/* the mask has changed. commit the buffered text */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
else
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
}
if (len > hcl->log.capa - hcl->log.len)
{
hcl_oow_t newcapa;
hcl_ooch_t* tmp;
if (len > HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len)
{
/* data too big */
hcl->errnum = HCL_ETOOBIG;
return -1;
}
newcapa = HCL_ALIGN(hcl->log.len + len, 512); /* TODO: adjust this capacity */
/* +1 to handle line ending injection more easily */
tmp = hcl_reallocmem (hcl, hcl->log.ptr, (newcapa + 1) * HCL_SIZEOF(*tmp));
if (!tmp) return -1;
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
HCL_MEMCPY (&hcl->log.ptr[hcl->log.len], ptr, len * HCL_SIZEOF(*ptr));
hcl->log.len += len;
hcl->log.last_mask = mask;
if (rem > 0)
{
ptr += len;
len = rem;
goto redo;
}
return 1; /* success */
}
/* ------------------------------------------------------------------------- */
typedef hcl_ooi_t (*outbfmt_t) (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...);
static hcl_ooi_t log_object (hcl_t* hcl, hcl_iocmd_t cmd, void* arg)
{
hcl_iooutarg_t* outarg = (hcl_iooutarg_t*)arg;
@ -308,21 +389,239 @@ static int print_object (hcl_t* hcl, hcl_oow_t mask, hcl_oop_t obj)
return hcl_printobj (hcl, obj, log_object, &outarg);
}
#if 0
static void print_object (hcl_t* hcl, hcl_oow_t mask, hcl_oop_t oop, outbfmt_t outbfmt)
{
if (oop == hcl->_nil)
{
outbfmt (hcl, mask, "nil");
}
else if (oop == hcl->_true)
{
outbfmt (hcl, mask, "true");
}
else if (oop == hcl->_false)
{
outbfmt (hcl, mask, "false");
}
else if (HCL_OOP_IS_SMOOI(oop))
{
outbfmt (hcl, mask, "%zd", HCL_OOP_TO_SMOOI(oop));
}
else if (HCL_OOP_IS_SMPTR(oop))
{
outbfmt (hcl, mask, "%p", HCL_OOP_TO_SMPTR(oop));
}
else if (HCL_OOP_IS_CHAR(oop))
{
outbfmt (hcl, mask, "$%.1C", HCL_OOP_TO_CHAR(oop));
}
else if (HCL_OOP_IS_ERROR(oop))
{
outbfmt (hcl, mask, "error(%zd)", HCL_OOP_TO_ERROR(oop));
}
else
{
hcl_oop_class_t c;
hcl_oow_t i;
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(oop));
c = (hcl_oop_class_t)HCL_OBJ_GET_CLASS(oop); /*HCL_CLASSOF(hcl, oop);*/
if (c == hcl->_large_negative_integer)
{
hcl_oow_t i;
outbfmt (hcl, mask, "-16r");
for (i = HCL_OBJ_GET_SIZE(oop); i > 0;)
{
outbfmt (hcl, mask, "%0*lX", (int)(HCL_SIZEOF(hcl_liw_t) * 2), (unsigned long)((hcl_oop_liword_t)oop)->slot[--i]);
}
}
else if (c == hcl->_large_positive_integer)
{
hcl_oow_t i;
outbfmt (hcl, mask, "16r");
for (i = HCL_OBJ_GET_SIZE(oop); i > 0;)
{
outbfmt (hcl, mask, "%0*lX", (int)(HCL_SIZEOF(hcl_liw_t) * 2), (unsigned long)((hcl_oop_liword_t)oop)->slot[--i]);
}
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_CHAR)
{
if (c == hcl->_symbol)
{
outbfmt (hcl, mask, "#%.*js", HCL_OBJ_GET_SIZE(oop), ((hcl_oop_char_t)oop)->slot);
}
else /*if ((hcl_oop_t)c == hcl->_string)*/
{
hcl_ooch_t ch;
int escape = 0;
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
ch = ((hcl_oop_char_t)oop)->slot[i];
if (ch < ' ')
{
escape = 1;
break;
}
}
if (escape)
{
hcl_ooch_t escaped;
outbfmt (hcl, mask, "S'");
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
ch = ((hcl_oop_char_t)oop)->slot[i];
if (ch < ' ')
{
switch (ch)
{
case '\0':
escaped = '0';
break;
case '\n':
escaped = 'n';
break;
case '\r':
escaped = 'r';
break;
case '\t':
escaped = 't';
break;
case '\f':
escaped = 'f';
break;
case '\b':
escaped = 'b';
break;
case '\v':
escaped = 'v';
break;
case '\a':
escaped = 'a';
break;
default:
escaped = ch;
break;
}
if (escaped == ch)
outbfmt (hcl, mask, "\\x%X", ch);
else
outbfmt (hcl, mask, "\\%jc", escaped);
}
else
{
outbfmt (hcl, mask, "%jc", ch);
}
}
outbfmt (hcl, mask, "'");
}
else
{
outbfmt (hcl, mask, "'%.*js'", HCL_OBJ_GET_SIZE(oop), ((hcl_oop_char_t)oop)->slot);
}
}
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_BYTE)
{
outbfmt (hcl, mask, "#[");
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " %d", ((hcl_oop_byte_t)oop)->slot[i]);
}
outbfmt (hcl, mask, "]");
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_HALFWORD)
{
outbfmt (hcl, mask, "#[["); /* TODO: fix this symbol/notation */
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " %zX", (hcl_oow_t)((hcl_oop_halfword_t)oop)->slot[i]);
}
outbfmt (hcl, mask, "]]");
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_WORD)
{
outbfmt (hcl, mask, "#[[["); /* TODO: fix this symbol/notation */
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " %zX", ((hcl_oop_word_t)oop)->slot[i]);
}
outbfmt (hcl, mask, "]]]");
}
else if (c == hcl->_array)
{
outbfmt (hcl, mask, "#(");
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " ");
print_object (hcl, mask, ((hcl_oop_oop_t)oop)->slot[i], outbfmt);
}
outbfmt (hcl, mask, ")");
}
else if (c == hcl->_class)
{
/* print the class name */
outbfmt (hcl, mask, "%.*js", HCL_OBJ_GET_SIZE(((hcl_oop_class_t)oop)->name), ((hcl_oop_class_t)oop)->name->slot);
}
else if (c == hcl->_association)
{
outbfmt (hcl, mask, "%O -> %O", ((hcl_oop_association_t)oop)->key, ((hcl_oop_association_t)oop)->value);
}
else
{
outbfmt (hcl, mask, "<<%.*js>>", HCL_OBJ_GET_SIZE(c->name), ((hcl_oop_char_t)c->name)->slot);
}
}
}
#endif
/* ------------------------------------------------------------------------- */
#undef FMTCHAR_IS_BCH
#undef FMTCHAR_IS_UCH
#undef FMTCHAR_IS_OOCH
#undef fmtchar_t
#undef logfmtv
#define fmtchar_t hcl_bch_t
#define logfmtv __logbfmtv
#define FMTCHAR_IS_BCH
#define logfmtv hcl_logbfmtv
#if defined(HCL_OOCH_IS_BCH)
# define FMTCHAR_IS_OOCH
#endif
#include "logfmtv.h"
#undef FMTCHAR_IS_BCH
#undef FMTCHAR_IS_UCH
#undef FMTCHAR_IS_OOCH
#undef fmtchar_t
#undef logfmtv
#define fmtchar_t hcl_ooch_t
#define logfmtv hcl_logoofmtv
#define FMTCHAR_IS_OOCH
#include "logfmtv.h"
#define fmtchar_t hcl_uch_t
#define logfmtv __logufmtv
#define FMTCHAR_IS_UCH
#if defined(HCL_OOCH_IS_UCH)
# define FMTCHAR_IS_OOCH
#endif
#include "logfmtv.h"
static int _logbfmtv (hcl_t* hcl, const hcl_bch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logbfmtv (hcl, fmt, data, ap, hcl_logbfmt);
}
static int _logufmtv (hcl_t* hcl, const hcl_uch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logufmtv (hcl, fmt, data, ap, hcl_logbfmt);
}
hcl_ooi_t hcl_logbfmt (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
{
@ -330,12 +629,23 @@ hcl_ooi_t hcl_logbfmt (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
va_list ap;
hcl_fmtout_t fo;
if (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES)
{
/* if a type is given, it's not untyped any more.
* mask off the UNTYPED bit */
mask &= ~HCL_LOG_UNTYPED;
/* if the default_type_mask has the UNTYPED bit on,
* it'll get turned back on */
mask |= (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES);
}
fo.mask = mask;
fo.putch = put_ooch;
fo.putcs = put_oocs;
va_start (ap, fmt);
x = hcl_logbfmtv (hcl, fmt, &fo, ap);
x = _logbfmtv (hcl, fmt, &fo, ap);
va_end (ap);
if (hcl->log.len > 0 && hcl->log.ptr[hcl->log.len - 1] == '\n')
@ -346,18 +656,24 @@ hcl_ooi_t hcl_logbfmt (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
return (x <= -1)? -1: fo.count;
}
hcl_ooi_t hcl_logoofmt (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* fmt, ...)
hcl_ooi_t hcl_logufmt (hcl_t* hcl, hcl_oow_t mask, const hcl_uch_t* fmt, ...)
{
int x;
va_list ap;
hcl_fmtout_t fo;
if (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES)
{
mask &= ~HCL_LOG_UNTYPED;
mask |= (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES);
}
fo.mask = mask;
fo.putch = put_ooch;
fo.putcs = put_oocs;
va_start (ap, fmt);
x = hcl_logoofmtv (hcl, fmt, &fo, ap);
x = _logufmtv (hcl, fmt, &fo, ap);
va_end (ap);
if (hcl->log.len > 0 && hcl->log.ptr[hcl->log.len - 1] == '\n')
@ -368,3 +684,135 @@ hcl_ooi_t hcl_logoofmt (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* fmt, ...)
return (x <= -1)? -1: fo.count;
}
/* --------------------------------------------------------------------------
* ERROR MESSAGE FORMATTING
* -------------------------------------------------------------------------- */
static int put_errch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
{
hcl_oow_t max;
max = HCL_COUNTOF(hcl->errmsg.buf) - hcl->errmsg.len - 1;
if (len > max) len = max;
if (len <= 0) return 1;
while (len > 0)
{
hcl->errmsg.buf[hcl->errmsg.len++] = ch;
len--;
}
hcl->errmsg.buf[hcl->errmsg.len] = '\0';
return 1; /* success */
}
static int put_errcs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
{
hcl_oow_t max;
max = HCL_COUNTOF(hcl->errmsg.buf) - hcl->errmsg.len - 1;
if (len > max) len = max;
if (len <= 0) return 1;
HCL_MEMCPY (&hcl->errmsg.buf[hcl->errmsg.len], ptr, len * HCL_SIZEOF(*ptr));
hcl->errmsg.len += len;
hcl->errmsg.buf[hcl->errmsg.len] = '\0';
return 1; /* success */
}
static hcl_ooi_t __errbfmtv (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...);
static int _errbfmtv (hcl_t* hcl, const hcl_bch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logbfmtv (hcl, fmt, data, ap, __errbfmtv);
}
static int _errufmtv (hcl_t* hcl, const hcl_uch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logufmtv (hcl, fmt, data, ap, __errbfmtv);
}
static hcl_ooi_t __errbfmtv (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
{
va_list ap;
hcl_fmtout_t fo;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
va_start (ap, fmt);
_errbfmtv (hcl, fmt, &fo, ap);
va_end (ap);
return fo.count;
}
void hcl_seterrbfmt (hcl_t* hcl, hcl_errnum_t errnum, const hcl_bch_t* fmt, ...)
{
va_list ap;
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
va_start (ap, fmt);
_errbfmtv (hcl, fmt, &fo, ap);
va_end (ap);
}
void hcl_seterrufmt (hcl_t* hcl, hcl_errnum_t errnum, const hcl_uch_t* fmt, ...)
{
va_list ap;
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
va_start (ap, fmt);
_errufmtv (hcl, fmt, &fo, ap);
va_end (ap);
}
void hcl_seterrbfmtv (hcl_t* hcl, hcl_errnum_t errnum, const hcl_bch_t* fmt, va_list ap)
{
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
_errbfmtv (hcl, fmt, &fo, ap);
}
void hcl_seterrufmtv (hcl_t* hcl, hcl_errnum_t errnum, const hcl_uch_t* fmt, va_list ap)
{
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
_errufmtv (hcl, fmt, &fo, ap);
}