added some logging methods to SystemDictioanry

added Resource handling functions for use by primitive modules
This commit is contained in:
hyunghwan.chung 2016-06-30 13:44:37 +00:00
parent de965baab7
commit 1445d0deb0
9 changed files with 298 additions and 21 deletions

View File

@ -105,10 +105,51 @@
{
}
#class SystemDictionary(Dictionary)
#pooldic Log
{
## -----------------------------------------------------------
## these items must follow defintions in stix.h
## -----------------------------------------------------------
#DEBUG := 1.
#INFO := 2.
#WARN := 4.
#ERROR := 8.
#FATAL := 16.
}
#class SystemDictionary(Dictionary)
{
## the following methods may not look suitable to be placed
## inside a system dictionary. but they are here for quick and dirty
## output production from the stix code.
## System logNl: 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'.
##
#dcl(#pooldic) Log.
#method log: message level: level
{
<primitive: #_log>
## do nothing upon logging failure
}
#method logNl: message level: level
{
self log: message level: level.
self log: S'\n' level: level.
^self.
}
#method log: message
{
^self log: message level: Log.INFO.
}
#method logNl: message
{
^self logNl: message level: Log.INFO.
}
}
#class Namespace(Set)
{

View File

@ -286,6 +286,10 @@
#include 'Except.st'.
#include 'Process.st'.
#class Resource(Object)
{
}
#class FFI(Object)
{
#dcl name handle funcs.

View File

@ -5005,6 +5005,7 @@ static int compile_stream (stix_t* stix)
}
else if (is_token_symbol(stix, VOCA_POOLDIC))
{
/* TODO: allow #pooldic within #class */
/* #pooldic SharedPoolDic { #abc := 20. #defg := 'ayz' } */
GET_TOKEN (stix);
if (compile_pooldic_definition(stix) <= -1) return -1;

View File

@ -128,7 +128,7 @@
#endif
#define __PRIMITIVE_NAME__ (&__FUNCTION__[5])
#define __PRIMITIVE_NAME__ (&__FUNCTION__[4])
/* ------------------------------------------------------------------------- */
static STIX_INLINE void vm_gettime (stix_t* stix, stix_ntime_t* now)
@ -1167,6 +1167,62 @@ static int prim_dump (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */
}
static int prim_log (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t msg, level;
STIX_ASSERT (nargs >= 2);
level = STIX_STACK_GET(stix, stix->sp);
msg = STIX_STACK_GET(stix, stix->sp - 1);
/* TODO: SUPPORT ARBITRARY NUMBERS OF MESSAGES */
if (!STIX_OOP_IS_SMOOI(level)) level = STIX_SMOOI_TO_OOP(STIX_LOG_INFO);
if (STIX_OOP_IS_POINTER(msg) && STIX_OBJ_GET_FLAGS_TYPE(msg))
{
stix_ooi_t n;
stix_oow_t rem;
const stix_ooch_t* ptr;
rem = STIX_OBJ_GET_SIZE(msg);
ptr = ((stix_oop_char_t)msg)->slot;
start_over:
while (rem > 0)
{
if (*ptr == '\0')
{
n = stix_logbfmt (stix, STIX_LOG_APP | STIX_OOP_TO_SMOOI(level), "%C", *ptr);
STIX_ASSERT (n == 1);
rem -= n;
ptr += n;
goto start_over;
}
n = stix_logbfmt (stix, STIX_LOG_APP | STIX_OOP_TO_SMOOI(level), "%.*S", rem, ptr);
if (n <= -1) break;
if (n == 0)
{
/* to skip the unprinted character.
* actually, this check is not needed because of '\0' skipping
* at the beginning of the loop */
n = stix_logbfmt (stix, STIX_LOG_APP | STIX_OOP_TO_SMOOI(level), "%C", *ptr);
STIX_ASSERT (n == 1);
}
rem -= n;
ptr += n;
}
}
else
{
stix_logbfmt (stix, STIX_LOG_APP | STIX_OOP_TO_SMOOI(level), "%O", msg);
}
STIX_STACK_POPS (stix, nargs); /* delete arguments, keep self */
return 1;
}
static int prim_identical (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, arg, b;
@ -1745,6 +1801,8 @@ static int prim_process_terminate (stix_t* stix, stix_ooi_t nargs)
stix_oop_t rcv;
STIX_ASSERT (nargs == 0);
/* TODO: need to run ensure blocks here..
* when it's executed here. it does't have to be in Exception>>handleException when there is no exception handler */
rcv = STIX_STACK_GET(stix, stix->sp);
if (STIX_CLASSOF(stix,rcv) != stix->_process) return 0;
@ -2598,6 +2656,7 @@ typedef struct prim_t prim_t;
static prim_t primitives[] =
{
{ 0, MAX_NARGS, prim_dump, "_dump" },
{ 2, 2, prim_log, "_log" },
{ 1, 1, prim_identical, "_identical" },
{ 1, 1, prim_not_identical, "_not_identical" },

View File

@ -149,6 +149,7 @@ static int ignite_1 (stix_t* stix)
stix->_small_integer = alloc_kernel_class (stix, 0, STIX_CLASS_SPEC_MAKE(0, 0, STIX_OBJ_TYPE_OOP));
stix->_large_positive_integer = alloc_kernel_class (stix, 0, STIX_CLASS_SPEC_MAKE(0, 1, STIX_OBJ_TYPE_LIWORD));
stix->_large_negative_integer = alloc_kernel_class (stix, 0, STIX_CLASS_SPEC_MAKE(0, 1, STIX_OBJ_TYPE_LIWORD));
stix->_resource = alloc_kernel_class (stix, 0, STIX_CLASS_SPEC_MAKE(0, 0, STIX_OBJ_TYPE_OOP));
if (!stix->_apex || !stix->_undefined_object ||
!stix->_object || !stix->_string ||
@ -164,7 +165,7 @@ static int ignite_1 (stix_t* stix)
!stix->_true_class || !stix->_false_class ||
!stix->_character || !stix->_small_integer ||
!stix->_large_positive_integer || !stix->_large_negative_integer) return -1;
!stix->_large_positive_integer || !stix->_large_negative_integer || !stix->_resource) return -1;
STIX_OBJ_SET_CLASS (stix->_nil, stix->_undefined_object);
return 0;

View File

@ -299,6 +299,10 @@ static void print_object (stix_t* stix, unsigned int mask, stix_oop_t oop)
{
stix_logbfmt (stix, mask, "$%.1C", STIX_OOP_TO_CHAR(oop));
}
else if (STIX_OOP_IS_RSRC(oop))
{
stix_logbfmt (stix, mask, "%zX", stix->rsrc.ptr[STIX_OOP_TO_RSRC(oop)]);
}
else
{
stix_oop_class_t c;
@ -327,11 +331,81 @@ static void print_object (stix_t* stix, unsigned int mask, stix_oop_t oop)
}
else if (STIX_OBJ_GET_FLAGS_TYPE(oop) == STIX_OBJ_TYPE_CHAR)
{
if ((stix_oop_t)c == stix->_symbol) stix_logbfmt (stix, mask, "#");
else if ((stix_oop_t)c == stix->_string) stix_logbfmt (stix, mask, "'");
if ((stix_oop_t)c == stix->_symbol)
{
stix_logbfmt (stix, mask, "#%.*S", STIX_OBJ_GET_SIZE(oop), ((stix_oop_char_t)oop)->slot);
}
else /*if ((stix_oop_t)c == stix->_string)*/
{
stix_ooch_t ch;
int escape = 0;
stix_logbfmt (stix, mask, "%.*S", STIX_OBJ_GET_SIZE(oop), ((stix_oop_char_t)oop)->slot);
if ((stix_oop_t)c == stix->_string) stix_logbfmt (stix, mask, "'");
for (i = 0; i < STIX_OBJ_GET_SIZE(oop); i++)
{
ch = ((stix_oop_char_t)oop)->slot[i];
if (ch < ' ')
{
escape = 1;
break;
}
}
if (escape)
{
stix_ooch_t escaped;
stix_logbfmt (stix, mask, "S'");
for (i = 0; i < STIX_OBJ_GET_SIZE(oop); i++)
{
ch = ((stix_oop_char_t)oop)->slot[i];
if (ch < ' ')
{
switch (ch)
{
case '\0':
escaped = '0';
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)
stix_logbfmt (stix, mask, "\\x%X", ch);
else
stix_logbfmt (stix, mask, "\\%C", escaped);
}
else
{
stix_logbfmt (stix, mask, "%C", ch);
}
}
stix_logbfmt (stix, mask, "'");
}
else
{
stix_logbfmt (stix, mask, "'%.*S'", STIX_OBJ_GET_SIZE(oop), ((stix_oop_char_t)oop)->slot);
}
}
}
else if (STIX_OBJ_GET_FLAGS_TYPE(oop) == STIX_OBJ_TYPE_BYTE)
{

View File

@ -94,8 +94,9 @@ int stix_init (stix_t* stix, stix_mmgr_t* mmgr, stix_oow_t heapsz, const stix_vm
stix->option.dfl_sysdic_size = STIX_DFL_SYSDIC_SIZE;
stix->option.dfl_procstk_size = STIX_DFL_PROCSTK_SIZE;
/* TODO: intoduct a permanent heap */
/*stix->permheap = stix_makeheap (stix, what is the best size???);
if (!stix->curheap) goto oops; */
if (!stix->permheap) goto oops; */
stix->curheap = stix_makeheap (stix, heapsz);
if (!stix->curheap) goto oops;
stix->newheap = stix_makeheap (stix, heapsz);
@ -105,6 +106,11 @@ int stix_init (stix_t* stix, stix_mmgr_t* mmgr, stix_oow_t heapsz, const stix_vm
stix_rbt_setstyle (&stix->pmtable, stix_getrbtstyle(STIX_RBT_STYLE_INLINE_COPIERS));
fill_bigint_tables (stix);
stix->tagged_classes[STIX_OOP_TAG_SMINT] = &stix->_small_integer;
stix->tagged_classes[STIX_OOP_TAG_CHAR] = &stix->_character;
stix->tagged_classes[STIX_OOP_TAG_RSRC] = &stix->_resource;
return 0;
oops:
@ -152,10 +158,19 @@ void stix_fini (stix_t* stix)
stix_rbt_walk (&stix->pmtable, unload_primitive_module, stix);
stix_rbt_fini (&stix->pmtable);
/* TOOD: persistency? storing objects to image file? */
stix_killheap (stix, stix->newheap);
stix_killheap (stix, stix->curheap);
stix_killheap (stix, stix->permheap);
if (stix->rsrc.ptr)
{
stix_freemem (stix, stix->rsrc.ptr);
stix->rsrc.free = 0;
stix->rsrc.capa = 0;
stix->rsrc.ptr = STIX_NULL;
}
/* deregister all callbacks */
while (stix->cblist) stix_deregcb (stix, stix->cblist);
@ -332,3 +347,61 @@ void stix_freemem (stix_t* stix, void* ptr)
{
STIX_MMGR_FREE (stix->mmgr, ptr);
}
stix_oop_t stix_makersrc (stix_t* stix, stix_oow_t v)
{
stix_oop_t imm;
stix_oow_t avail;
if (stix->rsrc.free >= stix->rsrc.capa)
{
stix_oow_t* tmp;
stix_ooi_t newcapa, i;
newcapa = stix->rsrc.capa + 256;
tmp = stix_reallocmem (stix, stix->rsrc.ptr, STIX_SIZEOF(*tmp) * newcapa);
if (!tmp) return STIX_NULL;
for (i = stix->rsrc.capa; i < newcapa; i++) tmp[i] = i + 1;
stix->rsrc.free = i;
stix->rsrc.ptr = tmp;
stix->rsrc.capa = newcapa;
}
avail = stix->rsrc.free;
stix->rsrc.free = stix->rsrc.ptr[stix->rsrc.free];
stix->rsrc.ptr[avail] = v;
/* there must not be too many immedates in the whole system. */
STIX_ASSERT (STIX_IN_SMOOI_RANGE(avail));
return STIX_RSRC_TO_OOP(avail);
return imm;
}
void stix_killrsrc (stix_t* stix, stix_oop_t imm)
{
if (STIX_OOP_IS_RSRC(stix))
{
stix_ooi_t v;
v = STIX_OOP_TO_RSRC(stix);
/* the value of v, if properly created by stix_makeimm(), must
* fall in the following range. when storing and loading the values
* from an image file, you must take extra care not to break this
* assertion */
STIX_ASSERT (v >= 0 && v < stix->rsrc.capa);
stix->rsrc.ptr[v] = stix->rsrc.free;
stix->rsrc.free = v;
}
}
stix_oow_t stix_getrsrcval (stix_t* stix, stix_oop_t imm)
{
STIX_ASSERT (STIX_OOP_IS_RSRC(imm));
return stix->rsrc.ptr[STIX_OOP_TO_RSRC(imm)];
}

View File

@ -172,19 +172,26 @@ typedef struct stix_obj_word_t* stix_oop_word_t;
#define STIX_OOP_TAG_BITS 2
#define STIX_OOP_TAG_SMINT 1
#define STIX_OOP_TAG_CHAR 2
#define STIX_OOP_TAG_RSRC 3
#define STIX_OOP_IS_NUMERIC(oop) (((stix_oow_t)oop) & (STIX_OOP_TAG_SMINT | STIX_OOP_TAG_CHAR))
#define STIX_OOP_IS_POINTER(oop) (!STIX_OOP_IS_NUMERIC(oop))
#define STIX_OOP_GET_TAG(oop) (((stix_oow_t)oop) & STIX_LBMASK(stix_oow_t, STIX_OOP_TAG_BITS))
#define STIX_OOP_IS_NUMERIC(oop) (STIX_OOP_GET_TAG(oop) != 0)
#define STIX_OOP_IS_POINTER(oop) (STIX_OOP_GET_TAG(oop) == 0)
#define STIX_OOP_IS_SMOOI(oop) (STIX_OOP_GET_TAG(oop) == STIX_OOP_TAG_SMINT)
#define STIX_OOP_IS_CHAR(oop) (STIX_OOP_GET_TAG(oop) == STIX_OOP_TAG_CHAR)
#define STIX_OOP_IS_RSRC(oop) (STIX_OOP_GET_TAG(oop) == STIX_OOP_TAG_RSRC)
#define STIX_OOP_IS_SMOOI(oop) (((stix_ooi_t)oop) & STIX_OOP_TAG_SMINT)
#define STIX_OOP_IS_CHAR(oop) (((stix_oow_t)oop) & STIX_OOP_TAG_CHAR)
#define STIX_SMOOI_TO_OOP(num) ((stix_oop_t)((((stix_ooi_t)(num)) << STIX_OOP_TAG_BITS) | STIX_OOP_TAG_SMINT))
#define STIX_OOP_TO_SMOOI(oop) (((stix_ooi_t)oop) >> STIX_OOP_TAG_BITS)
#define STIX_CHAR_TO_OOP(num) ((stix_oop_t)((((stix_oow_t)(num)) << STIX_OOP_TAG_BITS) | STIX_OOP_TAG_CHAR))
#define STIX_OOP_TO_CHAR(oop) (((stix_oow_t)oop) >> STIX_OOP_TAG_BITS)
/* SMOOI takes up 62 bit on a 64-bit architecture and 30 bits
/* RSRC(resurce) is a index to the VM's resource table(stix->rsrc.ptr) */
#define STIX_RSRC_TO_OOP(num) ((stix_oop_t)((((stix_oow_t)(num)) << STIX_OOP_TAG_BITS) | STIX_OOP_TAG_RSRC))
#define STIX_OOP_TO_RSRC(oop) (((stix_oow_t)oop) >> STIX_OOP_TAG_BITS)
/* SMOOI takes up 62 bits on a 64-bit architecture and 30 bits
* on a 32-bit architecture. The absolute value takes up 61 bits and 29 bits
* respectively for the 1 sign bit. */
#define STIX_SMOOI_BITS (STIX_OOI_BITS - STIX_OOP_TAG_BITS)
@ -628,10 +635,14 @@ struct stix_process_scheduler_t
* The STIX_CLASSOF() macro return the class of an object including a numeric
* object encoded into a pointer.
*/
/*
#define STIX_CLASSOF(stix,oop) ( \
STIX_OOP_IS_SMOOI(oop)? (stix)->_small_integer: \
STIX_OOP_IS_CHAR(oop)? (stix)->_character: STIX_OBJ_GET_CLASS(oop) \
)
* */
#define STIX_CLASSOF(stix,oop) \
(STIX_OOP_GET_TAG(oop)? *stix->tagged_classes[STIX_OOP_GET_TAG(oop)]: STIX_OBJ_GET_CLASS(oop))
/**
* The STIX_BYTESOF() macro returns the size of the payload of
@ -816,8 +827,11 @@ struct stix_t
stix_oop_t _small_integer; /* SmallInteger */
stix_oop_t _large_positive_integer; /* LargePositiveInteger */
stix_oop_t _large_negative_integer; /* LargeNegativeInteger */
stix_oop_t _resource;
/* == NEVER CHANGE THE ORDER OF FIELDS ABOVE == */
stix_oop_t* tagged_classes[4];
stix_oop_set_t symtab; /* system-wide symbol table. instance of SymbolSet */
stix_oop_set_t sysdic; /* system dictionary. instance of SystemDictionary */
stix_oop_process_scheduler_t processor; /* instance of ProcessScheduler */
@ -856,6 +870,15 @@ struct stix_t
} bigint[37];
/* == END BIGINT CONVERSION == */
/* == RSRC MANAGEMENT == */
struct
{
stix_oow_t* ptr;
stix_oow_t free;
stix_oow_t capa;
} rsrc;
/* == END RSRC MANAGEMENT == */
#if defined(STIX_INCLUDE_COMPILER)
stix_compiler_t* c;
#endif
@ -894,7 +917,8 @@ enum stix_log_mask_t
STIX_LOG_MNEMONIC = (1 << 8), /* bytecode mnemonic */
STIX_LOG_GC = (1 << 9),
STIX_LOG_IC = (1 << 10), /* instruction cycle, fetch-decode-execute */
STIX_LOG_PRIMITIVE = (1 << 11)
STIX_LOG_PRIMITIVE = (1 << 11),
STIX_LOG_APP = (1 << 12) /* stix applications, set by stix logging primitive */
};
typedef enum stix_log_mask_t stix_log_mask_t;