added some logging methods to SystemDictioanry
added Resource handling functions for use by primitive modules
This commit is contained in:
parent
de965baab7
commit
1445d0deb0
@ -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)
|
||||
{
|
||||
|
@ -286,6 +286,10 @@
|
||||
#include 'Except.st'.
|
||||
#include 'Process.st'.
|
||||
|
||||
#class Resource(Object)
|
||||
{
|
||||
}
|
||||
|
||||
#class FFI(Object)
|
||||
{
|
||||
#dcl name handle funcs.
|
||||
|
@ -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;
|
||||
|
@ -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" },
|
||||
|
@ -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;
|
||||
|
@ -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)
|
||||
{
|
||||
|
@ -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)];
|
||||
}
|
||||
|
@ -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;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user