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

work in progress to support the named primitive via shared object loading

Browse Source
This commit is contained in:
hyunghwan.chung
2015-10-08 14:26:04 +00:00
parent 5c69f6c3b4
commit 8c963d919c
17 changed files with 1032 additions and 317 deletions
Download Patch File Download Diff File Expand all files Collapse all files

462
stix/lib/Stix.st
View File

@ -1,462 +0,0 @@
#class Apex(nil)
{
#dcl(#class) sysdic.
#method(#class) yourself
{
^self.
}
#method yourself
{
^self.
}
#method(#class) dump
{
<primitive: #dump>
}
#method dump
{
<primitive: #dump>
}
#method(#class) new
{
## <primitive: 1>
<primitive: #new>
}
#method(#class) new: anInteger
{
## <primitive: 2>
<primitive: #newWithSize>
}
#method basicSize
{
## <primitive: 3>
<primitive: #basicSize>
^0
}
#method basicAt: anInteger
{
## <primitive: 4>
<primitive: #basicAt>
## self error: 'out of range'.
}
#method basicAt: anInteger put: anObject
{
## <primitive: 5>
<primitive: #basicAtPut>
## self error: 'out of range'.
}
#method badReturnError
{
## TODO: implement this
}
#method mustBeBoolean
{
## TODO: implement this
}
#method doesNotUnderstand: aMessageSymbol
{
## TODO: implement this
}
#method error: anErrorString
{
anErrorString dump.
}
}
#class Object(Apex)
{
}
#class UndefinedObject(Apex)
{
}
#class(#pointer) Class(Apex)
{
#dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic.
}
#class Magnitude(Object)
{
}
#class Association(Magnitude)
{
#dcl key value.
}
#class Character(Magnitude)
{
}
#class Number(Magnitude)
{
#method add: aNumber
{
<primitive: #integerAdd>
}
#method + aNumber
{
<primitive: #integerAdd>
}
#method - aNumber
{
<primitive: #integerSub>
}
#method * aNumber
{
<primitive: #integerMul>
}
#method = aNumber
{
<primitive: #integerEQ>
}
#method < aNumber
{
<primitive: #integerLT>
}
#method > aNumber
{
<primitive: #integerGT>
}
}
#class SmallInteger(Number)
{
}
#class Boolean(Object)
{
}
#class True(Boolean)
{
#method ifTrue: trueBlock ifFalse: falseBlock
{
^trueBlock value.
}
#method ifTrue: trueBlock
{
^trueBlock value.
}
#method ifFalse: falseBlock
{
^nil.
}
}
#class False(Boolean)
{
#method ifTrue: trueBlock ifFalse: falseBlock
{
^falseBlock value.
}
#method ifTrue: trueBlock
{
^nil.
}
#method ifFalse: falseBlock
{
^falseBlock value.
}
}
#class Collection(Object)
{
}
#class(#byte) ByteArray(Collection)
{
#method at: anInteger
{
^self basicAt: anInteger.
}
#method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
}
#class(#pointer) Array(Collection)
{
#method at: anInteger
{
^self basicAt: anInteger.
}
#method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
}
#class(#character) String(Array)
{
}
#class(#character) Symbol(Array)
{
}
#class Set(Collection)
{
#dcl tally bucket.
}
#class SymbolSet(Set)
{
}
#class Dictionary(Set)
{
}
#class SystemDictionary(Dictionary)
{
}
#class Namespace(Set)
{
}
#class PoolDictionary(Set)
{
}
#class MethodDictionary(Dictionary)
{
}
#class(#pointer) Context(Apex)
{
}
#class(#pointer) MethodContext(Context)
{
#dcl sender ip sp ntmprs method receiver home origin.
#method pc
{
^ip
}
#method pc: anInteger
{
ip := anInteger.
"sp := sp - 1." "whould this always work??? "
}
#method sp
{
^sp.
}
#method sp: anInteger
{
sp := anInteger.
}
#method pc: aPC sp: aSP
{
ip := aPC.
sp := aSP.
##sp := sp - 1.
}
}
#class(#pointer) BlockContext(Context)
{
#dcl caller ip sp ntmprs nargs source home origin.
#method value
{
<primitive: #blockValue>
}
#method value: a
{
<primitive: #blockValue>
}
#method value: a value: b
{
<primitive: #blockValue>
}
#method value: a value: b value: c
{
<primitive: #blockValue>
}
#method whileTrue: aBlock
{
## http://stackoverflow.com/questions/2500483/is-there-a-way-in-a-message-only-language-to-define-a-whiletrue-message-without
## ----------------------------------------------------------------------------
## ^(self value) ifTrue: [aBlock value. self whileTrue: aBlock].
## ----------------------------------------------------------------------------
## less block context before whileTrue: is recursively sent.
## whileTrue: is sent in a method context.
## (self value) ifFalse: [^nil].
## aBlock value.
## self whileTrue: aBlock.
## ----------------------------------------------------------------------------
## ----------------------------------------------------------------------------
| pc sp xsp |
sp := thisContext sp.
sp := sp - 1. "decrement sp by 1 becuase thisContext pushed above affects the sp method"
pc := thisContext pc.
self value ifFalse: [ ^nil "^self" ].
aBlock value.
##thisContext pc: pc - 3 sp: sp.
##thisContext pc: pc + 2 sp: sp.
thisContext pc: pc + 1 sp: sp.
## this +2 or - 3 above is dependent on the byte code instruction size used for 'store'
## +2 to skip STORE_INTO_TEMP(pc) and POP_STACKTOP.
## TODO: make it independent of the byte code size
## ----------------------------------------------------------------------------
## #<label>:
## thisContext pc: #<label> sp: sp.
##
## | pc |
## pc := thisContext pc.
## ^self value ifTrue: [aBlock value. thisContext pc: pc]
## ----------------------------------------------------------------------------
## self value ifTrue: [ aBlock value. thisContext restart. ].
}
#method pc
{
^ip
}
#method pc: anInteger
{
ip := anInteger.
}
#method sp
{
^sp
}
#method sp: anInteger
{
sp := anInteger.
}
#method restart
{
ip := source pc.
}
}
#class(#pointer) CompiledMethod(Object)
{
#dcl owner preamble ntmprs nargs code source.
}
#class FFI(Object)
{
#dcl name handle funcs.
#method(#class) new: aString
{
^self new open: aString.
}
#method open: aString
{
self.funcs := Dictionary new.
self.name := aString.
self.handle := self privateOpen: self.name.
}
#method close
{
self privateClose: self.handle.
self.handle := nil.
}
#method call: aFunctionName withSig: aString withArgs: anArray
{
| f |
## f := self.funcs at: aFunctionName.
## f isNil ifTrue: [
## f := self privateGetSymbol: aFunctionName in: self.handle.
## f isNil ifTrue: [ self error: 'No such function' ].
## self.funcs at: aFunctionName put: f.
## ].
f := self privateGetSymbol: aFunctionName in: self.handle.
## f isNil ifTrue: [ self error: 'No such function' ].
^self privateCall: f withSig: aString withArgs: anArray
}
#method privateOpen: aString
{
<primitive: #ffiOpen>
## throw an exception here.
}
#method privateClose: aHandle
{
<primitive: #ffiClose>
}
#method privateCall: aSymbol withSig: aString withArgs: anArray
{
<primitive: #ffiCall>
}
#method privateGetSymbol: aString in: aHandle
{
<primitive: #ffiGetSym>
}
}

49
stix/lib/comp.c
View File

@ -1493,13 +1493,13 @@ static const stix_uch_t* add_io_name (stix_t* stix, const stix_ucs_t* name)
static int begin_include (stix_t* stix)
{
stix_ioarg_t* arg;
stix_io_arg_t* arg;
const stix_uch_t* io_name;
io_name = add_io_name (stix, &stix->c->tok.name);
if (!io_name) return -1;
arg = (stix_ioarg_t*) stix_callocmem (stix, STIX_SIZEOF(*arg));
arg = (stix_io_arg_t*) stix_callocmem (stix, STIX_SIZEOF(*arg));
if (!arg) goto oops;
arg->name = io_name;
@ -1546,7 +1546,7 @@ oops:
static int end_include (stix_t* stix)
{
int x;
stix_ioarg_t* cur;
stix_io_arg_t* cur;
if (stix->c->curinp == &stix->c->arg) return 0; /* no include */
@ -2561,8 +2561,10 @@ static int compile_method_primitive (stix_t* stix)
set_syntax_error (stix, STIX_SYNERR_PRIMITIVE, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
/* TODO: other modifiers?
/* TODO: other modifiers than primitive: ?
* <primitive: 10>
* <primitive: #primitive_name>
* <some-other-modifier: xxxx>
*/
@ -2593,6 +2595,23 @@ static int compile_method_primitive (stix_t* stix)
prim_no = stix_getprimno (stix, &stix->c->tok.name);
if (prim_no <= -1)
{
const stix_uch_t* us;
/* the primitive is not found */
us = stix_findchar (stix->c->tok.name.ptr, stix->c->tok.name.len, '_');
if (us > stix->c->tok.name.ptr && us < stix->c->tok.name.ptr + stix->c->tok.name.len - 1)
{
stix_size_t lit_idx;
/* the symbol literal contains an underscore.
* and it is none of the first of the last character */
if (add_symbol_literal(stix, &stix->c->tok.name, &lit_idx) >= 0 &&
STIX_OOI_IN_PREAMBLE_INDEX_RANGE(lit_idx))
{
stix->c->mth.prim_type = 2; /* named primitive */
stix->c->mth.prim_no = lit_idx;
break;
}
}
set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
@ -2601,6 +2620,8 @@ static int compile_method_primitive (stix_t* stix)
set_syntax_error (stix, STIX_SYNERR_PRIMNO, &stix->c->tok.loc, &stix->c->tok.name);
return -1;
}
stix->c->mth.prim_type = 1;
stix->c->mth.prim_no = prim_no;
break;
@ -4086,8 +4107,9 @@ static int add_compiled_method (stix_t* stix)
preamble_code = STIX_METHOD_PREAMBLE_NONE;
preamble_index = 0;
if (stix->c->mth.prim_no < 0)
if (stix->c->mth.prim_type <= 0)
{
/* no primitive is set */
if (stix->c->mth.code.len <= 0)
{
preamble_code = STIX_METHOD_PREAMBLE_RETURN_RECEIVER;
@ -4186,13 +4208,19 @@ static int add_compiled_method (stix_t* stix)
}
}
}
else
else if (stix->c->mth.prim_type == 1)
{
preamble_code = STIX_METHOD_PREAMBLE_PRIMITIVE;
preamble_index = stix->c->mth.prim_no;
}
else
{
STIX_ASSERT (stix->c->mth.prim_type == 2);
preamble_code = STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE;
preamble_index = stix->c->mth.prim_no;
}
STIX_ASSERT (preamble_index >= 0 && preamble_index <= 0xFFFF); /* TODO: replace 0xFFFF by a proper macro name */
STIX_ASSERT (STIX_OOI_IN_PREAMBLE_INDEX_RANGE(preamble_index));
mth->owner = stix->c->cls.self_oop;
mth->preamble = STIX_OOP_FROM_SMINT(STIX_METHOD_MAKE_PREAMBLE(preamble_code, preamble_index));
@ -4236,7 +4264,8 @@ static int compile_method_definition (stix_t* stix)
stix->c->mth.literal_count = 0;
stix->c->mth.balit_count = 0;
stix->c->mth.arlit_count = 0;
stix->c->mth.prim_no = -1;
stix->c->mth.prim_type = 0;
stix->c->mth.prim_no = 0;
stix->c->mth.blk_depth = 0;
stix->c->mth.code.len = 0;
@ -5089,7 +5118,7 @@ static void fini_compiler (stix_t* stix)
}
}
int stix_compile (stix_t* stix, stix_ioimpl_t io)
int stix_compile (stix_t* stix, stix_io_impl_t io)
{
int n;
@ -5158,7 +5187,7 @@ oops:
* closed. close them */
while (stix->c->curinp != &stix->c->arg)
{
stix_ioarg_t* prev;
stix_io_arg_t* prev;
/* nothing much to do about a close error */
stix->c->impl (stix, STIX_IO_CLOSE, stix->c->curinp);

461
stix/lib/exec.c
View File

@ -91,6 +91,18 @@
#endif
#if defined(STIX_DEBUG_EXEC)
# define DBGOUT_EXEC_0(fmt) printf(fmt "\n")
# define DBGOUT_EXEC_1(fmt,a1) printf(fmt "\n",a1)
# define DBGOUT_EXEC_2(fmt,a1,a2) printf(fmt "\n", a1, a2)
# define DBGOUT_EXEC_3(fmt,a1,a2,a3) printf(fmt "\n", a1, a2, a3)
#else
# define DBGOUT_EXEC_0(fmt)
# define DBGOUT_EXEC_1(fmt,a1)
# define DBGOUT_EXEC_2(fmt,a1,a2)
# define DBGOUT_EXEC_3(fmt,a1,a2,a3)
#endif
static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth)
{
stix_oop_context_t ctx;
@ -199,7 +211,9 @@ static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth)
/* swtich the active context */
SWITCH_ACTIVE_CONTEXT (stix, ctx);
#if defined(STIX_DEBUG_EXEC)
printf ("<<ENTERING>> SP=%d\n", (int)stix->sp);
#endif
return 0;
#if 0
@ -208,16 +222,20 @@ reuse_context:
ctx->_class = stix->_method_context;
ctx->receiver_or_source = ACTIVE_STACK_GET(stix, stix->sp - nargs);
#if defined(STIX_DEBUG_EXEC)
printf ("####### REUSING CONTEXT INSTEAD OF <<ENTERING>> WITH RECEIVER ");
print_object (stix, ctx->receiver_or_source);
printf ("\n");
#endif
for (i = 0; i < nargs; i++)
{
ctx->slot[i] = ACTIVE_STACK_GET (stix, stix->sp - nargs + i + 1);
#if defined(STIX_DEBUG_EXEC)
printf ("REUSING ARGUMENT %d - ", (int)i);
print_object (stix, ctx->slot[i]);
printf ("\n");
#endif
}
for (; i <= stix->sp; i++) ctx->slot[i] = stix->_nil;
/* keep the sender
@ -248,9 +266,11 @@ static stix_oop_method_t find_method (stix_t* stix, stix_oop_t receiver, const s
int dic_no;
/* TODO: implement method lookup cache */
#if defined(STIX_DEBUG_EXEC)
printf ("==== FINDING METHOD FOR %p [", receiver);
print_ucs (message);
printf ("] in ");
#endif
cls = (stix_oop_class_t)STIX_CLASSOF(stix, receiver);
if ((stix_oop_t)cls == stix->_class)
@ -258,17 +278,21 @@ printf ("] in ");
/* receiver is a class object */
c = receiver;
dic_no = STIX_CLASS_MTHDIC_CLASS;
#if defined(STIX_DEBUG_EXEC)
printf ("class method dictioanry of ");
print_object(stix, (stix_oop_t)((stix_oop_class_t)c)->name);
printf ("\n");
#endif
}
else
{
c = (stix_oop_t)cls;
dic_no = STIX_CLASS_MTHDIC_INSTANCE;
#if defined(STIX_DEBUG_EXEC)
printf ("instance method dictioanry of ");
print_object(stix, (stix_oop_t)((stix_oop_class_t)c)->name);
printf ("\n");
#endif
}
@ -384,6 +408,49 @@ static int primitive_dump (stix_t* stix, stix_ooi_t nargs)
return 1; /* success */
}
static int primitive_identical (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, arg, b;
STIX_ASSERT (nargs == 1);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
arg = ACTIVE_STACK_GET(stix, stix->sp);
b = (rcv == arg)? stix->_true: stix->_false;
ACTIVE_STACK_POP (stix);
ACTIVE_STACK_SETTOP (stix, b);
return 1;
}
static int primitive_not_identical (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, arg, b;
STIX_ASSERT (nargs == 1);
rcv = ACTIVE_STACK_GET(stix, stix->sp - 1);
arg = ACTIVE_STACK_GET(stix, stix->sp);
b = (rcv != arg)? stix->_true: stix->_false;
ACTIVE_STACK_POP (stix);
ACTIVE_STACK_SETTOP (stix, b);
return 1;
}
static int primitive_class (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, c;
STIX_ASSERT (nargs == 0);
rcv = ACTIVE_STACK_GETTOP (stix);
c = STIX_CLASSOF(stix, rcv);
ACTIVE_STACK_SETTOP (stix, c);
return 1; /* success */
}
static int primitive_new (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv, obj;
@ -504,7 +571,7 @@ static int primitive_basic_at (stix_t* stix, stix_ooi_t nargs)
break;
case STIX_OBJ_TYPE_WORD:
/* TODO: largeINteger if the word is too large */
/* TODO: LargeInteger if the word is too large */
v = STIX_OOP_FROM_SMINT(((stix_oop_word_t)rcv)->slot[idx]);
break;
@ -623,7 +690,9 @@ static int primitive_block_value (stix_t* stix, stix_ooi_t nargs)
org_blkctx = (stix_oop_context_t)ACTIVE_STACK_GET(stix, stix->sp - nargs);
if (STIX_CLASSOF(stix, org_blkctx) != stix->_block_context)
{
#if defined(STIX_DEBUG_EXEC)
printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
#endif
return 0;
}
@ -635,7 +704,9 @@ printf ("PRIMITVE VALUE RECEIVER IS NOT A BLOCK CONTEXT\n");
* For example, [thisContext value] value.
*/
STIX_ASSERT (STIX_OBJ_GET_SIZE(org_blkctx) > STIX_CONTEXT_NAMED_INSTVARS);
#if defined(STIX_DEBUG_EXEC)
printf ("PRIM REVALUING AN BLOCKCONTEXT\n");
#endif
return 0;
}
STIX_ASSERT (STIX_OBJ_GET_SIZE(org_blkctx) == STIX_CONTEXT_NAMED_INSTVARS);
@ -643,8 +714,10 @@ printf ("PRIM REVALUING AN BLOCKCONTEXT\n");
if (STIX_OOP_TO_SMINT(org_blkctx->method_or_nargs) != nargs)
{
/* the number of argument doesn't match */
#if defined(STIX_DEBUG_EXEC)
/* TODO: better handling of primitive failure */
printf ("PRIM BlockContext value FAIL - NARGS MISMATCH\n");
#endif
return 0;
}
@ -669,8 +742,10 @@ printf ("PRIM BlockContext value FAIL - NARGS MISMATCH\n");
blkctx->receiver_or_source = (stix_oop_t)org_blkctx;
blkctx->home = org_blkctx->home;
blkctx->origin = org_blkctx->origin;
#if defined(STIX_DEBUG_EXEC)
printf ("~~~~~~~~~~ BLOCK VALUING %p TO NEW BLOCK %p\n", org_blkctx, blkctx);
#endif
#endif
/* TODO: check the stack size of a block context to see if it's large enough to hold arguments */
/* copy the arguments to the stack */
@ -692,7 +767,9 @@ printf ("~~~~~~~~~~ BLOCK VALUING %p TO NEW BLOCK %p\n", org_blkctx, blkctx);
blkctx->sp = STIX_OOP_FROM_SMINT(local_ntmprs);
blkctx->sender = (stix_oop_t)stix->active_context;
#if defined(STIX_DEBUG_EXEC)
printf ("<<ENTERING BLOCK>>\n");
#endif
SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)blkctx);
return 1;
}
@ -1242,6 +1319,10 @@ typedef struct primitive_t primitive_t;
static primitive_t primitives[] =
{
{ -1, primitive_dump, "dump" },
{ 1, primitive_identical, "identical" },
{ 1, primitive_not_identical, "notIdentical" },
{ 0, primitive_class, "class" },
{ 0, primitive_new, "new" },
{ 1, primitive_new_with_size, "newWithSize" },
{ 0, primitive_basic_size, "basicSize" },
@ -1282,6 +1363,171 @@ int stix_getprimno (stix_t* stix, const stix_ucs_t* name)
return -1;
}
static stix_mod_t* query_primitive_module (stix_t* stix, const stix_uch_t* name)
{
stix_rbt_pair_t* pair;
stix_mod_data_t* mdp;
stix_cstr_t ea;
int n;
STIX_ASSERT (nsegs == 2);
pair = stix_rbt_search (stix->modtab, segs[0].ptr, segs[0].len);
if (pair)
{
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
}
else
{
stix_mod_data_t md;
stix_mod_load_t load = STIX_NULL;
stix_mod_spec_t spec;
stix_size_t buflen;
/*stix_char_t buf[64 + 15] = STIX_T("_stix_mod_");*/
/* maximum module name length is 64. 15 is decomposed to 13 + 1 + 1.
* 13 for _stix_mod_t
* 1 for _ at the end when stix_mod_xxx_ is attempted.
* 1 for the terminating '\0'
*/
stix_char_t buf[64 + 15];
/* the terminating null isn't needed in buf here */
STIX_MEMCPY (buf, STIX_T("_stix_mod_"), STIX_SIZEOF(stix_char_t) * 13);
if (segs[0].len > STIX_COUNTOF(buf) - 15)
{
/* module name too long */
ea.ptr = segs[0].ptr;
ea.len = segs[0].len;
stix_seterror (stix, STIX_ESEGTL, &ea, STIX_NULL);
return STIX_NULL;
}
#if defined(STIX_ENABLE_STATIC_MODULE)
/* attempt to find a statically linked module */
/* TODO: binary search ... */
for (n = 0; n < STIX_COUNTOF(static_modtab); n++)
{
if (stix_strcmp (static_modtab[n].modname, segs[0].ptr) == 0)
{
load = static_modtab[n].modload;
break;
}
}
/*if (n >= STIX_COUNTOF(static_modtab))
{
ea.ptr = segs[0].ptr;
ea.len = segs[0].len;
stix_seterror (stix, STIX_ENOENT, &ea, STIX_NULL);
return STIX_NULL;
}*/
if (load)
{
/* found the module in the staic module table */
STIX_MEMSET (&md, 0, STIX_SIZEOF(md));
/* Note md.handle is STIX_NULL for a static module */
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = stix_rbt_insert (stix->modtab, segs[0].ptr, segs[0].len, &md, STIX_SIZEOF(md));
if (pair == STIX_NULL)
{
stix_seterrnum (stix, STIX_ENOMEM, STIX_NULL);
return STIX_NULL;
}
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
if (load (&mdp->mod, stix) <= -1)
{
stix_rbt_delete (stix->modtab, segs[0].ptr, segs[0].len);
return STIX_NULL;
}
goto done;
}
#endif
/* attempt to find an external module */
STIX_MEMSET (&spec, 0, STIX_SIZEOF(spec));
if (stix->opt.mod[0].len > 0)
spec.prefix = stix->opt.mod[0].ptr;
else spec.prefix = STIX_T(STIX_DEFAULT_MODPREFIX);
if (stix->opt.mod[1].len > 0)
spec.postfix = stix->opt.mod[1].ptr;
else spec.postfix = STIX_T(STIX_DEFAULT_MODPOSTFIX);
STIX_MEMSET (&md, 0, STIX_SIZEOF(md));
if (stix->prm.modopen && stix->prm.modsym && stix->prm.modclose)
{
spec.name = segs[0].ptr;
md.handle = stix->prm.modopen (stix, &spec);
}
else md.handle = STIX_NULL;
if (md.handle == STIX_NULL)
{
ea.ptr = segs[0].ptr;
ea.len = segs[0].len;
stix_seterror (stix, STIX_ENOENT, &ea, STIX_NULL);
return STIX_NULL;
}
buflen = stix_strcpy (&buf[13], segs[0].ptr);
/* attempt stix_mod_xxx */
load = stix->prm.modsym (stix, md.handle, &buf[1]);
if (!load)
{
/* attempt _stix_mod_xxx */
load = stix->prm.modsym (stix, md.handle, &buf[0]);
if (!load)
{
/* attempt stix_mod_xxx_ */
buf[13 + buflen] = STIX_T('_');
buf[13 + buflen + 1] = STIX_T('\0');
load = stix->prm.modsym (stix, md.handle, &buf[1]);
if (!load)
{
ea.ptr = &buf[1];
ea.len = 12 + buflen;
stix_seterror (stix, STIX_ENOENT, &ea, STIX_NULL);
stix->prm.modclose (stix, md.handle);
return STIX_NULL;
}
}
}
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = stix_rbt_insert (stix->modtab, segs[0].ptr, segs[0].len, &md, STIX_SIZEOF(md));
if (pair == STIX_NULL)
{
stix_seterrnum (stix, STIX_ENOMEM, STIX_NULL);
stix->prm.modclose (stix, md.handle);
return STIX_NULL;
}
mdp = (stix_mod_data_t*)STIX_RBT_VPTR(pair);
if (load (&mdp->mod, stix) <= -1)
{
stix_rbt_delete (stix->modtab, segs[0].ptr, segs[0].len);
stix->prm.modclose (stix, mdp->handle);
return STIX_NULL;
}
}
done:
n = mdp->mod.query (&mdp->mod, stix, segs[1].ptr, sym);
return (n <= -1)? STIX_NULL: &mdp->mod;
}
/* ------------------------------------------------------------------------- */
int stix_execute (stix_t* stix)
@ -1290,12 +1536,12 @@ int stix_execute (stix_t* stix)
stix_ooi_t b1, b2;
stix_oop_t return_value;
stix_size_t inst_counter;
#if defined(STIX_PROFILE_EXEC)
stix_size_t inst_counter = 0;
#endif
STIX_ASSERT (stix->active_context != STIX_NULL);
inst_counter = 0;
while (1)
{
@ -1308,7 +1554,10 @@ printf ("IP => %d ", (int)stix->ip);
#if 0
printf ("BCODE = %x\n", bcode);
#endif
inst_counter++;
#if defined(STIX_PROFILE_EXEC)
inst_counter++;
#endif
switch (bcode)
{
@ -1327,7 +1576,7 @@ inst_counter++;
case BCODE_PUSH_INSTVAR_7:
b1 = bcode & 0x7; /* low 3 bits */
push_instvar:
printf ("PUSH_INSTVAR %d\n", (int)b1);
DBGOUT_EXEC_1 ("PUSH_INSTVAR %d", (int)b1);
STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(stix->active_context->origin->receiver_or_source) == STIX_OBJ_TYPE_OOP);
ACTIVE_STACK_PUSH (stix, ((stix_oop_oop_t)stix->active_context->origin->receiver_or_source)->slot[b1]);
break;
@ -1347,7 +1596,7 @@ printf ("PUSH_INSTVAR %d\n", (int)b1);
case BCODE_STORE_INTO_INSTVAR_7:
b1 = bcode & 0x7; /* low 3 bits */
store_instvar:
printf ("STORE_INTO_INSTVAR %d\n", (int)b1);
DBGOUT_EXEC_1 ("STORE_INTO_INSTVAR %d", (int)b1);
STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(stix->active_context->receiver_or_source) == STIX_OBJ_TYPE_OOP);
((stix_oop_oop_t)stix->active_context->origin->receiver_or_source)->slot[b1] = ACTIVE_STACK_GETTOP(stix);
break;
@ -1366,7 +1615,7 @@ printf ("STORE_INTO_INSTVAR %d\n", (int)b1);
case BCODE_POP_INTO_INSTVAR_7:
b1 = bcode & 0x7; /* low 3 bits */
pop_into_instvar:
printf ("POP_INTO_INSTVAR %d\n", (int)b1);
DBGOUT_EXEC_1 ("POP_INTO_INSTVAR %d", (int)b1);
STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(stix->active_context->receiver_or_source) == STIX_OBJ_TYPE_OOP);
((stix_oop_oop_t)stix->active_context->origin->receiver_or_source)->slot[b1] = ACTIVE_STACK_GETTOP(stix);
ACTIVE_STACK_POP (stix);
@ -1452,8 +1701,7 @@ printf ("POP_INTO_INSTVAR %d\n", (int)b1);
if ((bcode >> 4) & 1)
{
/* push - bit 4 on*/
printf ("PUSH_TEMPVAR %d - ", (int)b1);
DBGOUT_EXEC_1 ("PUSH_TEMPVAR %d", (int)b1);
ACTIVE_STACK_PUSH (stix, ctx->slot[bx]);
}
else
@ -1464,18 +1712,18 @@ printf ("PUSH_TEMPVAR %d - ", (int)b1);
if ((bcode >> 3) & 1)
{
/* pop - bit 3 on */
DBGOUT_EXEC_1 ("POP_INTO_TEMPVAR %d", (int)b1);
ACTIVE_STACK_POP (stix);
printf ("POP_INTO_TEMPVAR %d - ", (int)b1);
}
else
{
printf ("STORE_INTO_TEMPVAR %d - ", (int)b1);
}
else
{
DBGOUT_EXEC_1 ("STORE_INTO_TEMPVAR %d", (int)b1);
}
}
print_object (stix, ctx->slot[bx]);
printf ("\n");
/*
print_object (stix, ctx->slot[bx]);
printf ("\n");
*/
break;
}
@ -1494,9 +1742,11 @@ printf ("\n");
case BCODE_PUSH_LITERAL_7:
b1 = bcode & 0x7; /* low 3 bits */
push_literal:
printf ("PUSH_LITERAL idx=%d - ", (int)b1);
print_object (stix, stix->active_method->slot[b1]);
printf ("\n");
DBGOUT_EXEC_1 ("PUSH_LITERAL %d", (int)b1);
/*
print_object (stix, stix->active_method->slot[b1]);
printf ("\n");
*/
ACTIVE_STACK_PUSH (stix, stix->active_method->slot[b1]);
break;
@ -1535,19 +1785,19 @@ printf ("\n");
if ((bcode >> 2) & 1)
{
/* pop */
DBGOUT_EXEC_1("POP_INTO_OBJECT %d", (int)b1);
ACTIVE_STACK_POP (stix);
printf ("POP_INTO_OBJECT %d - ", (int)b1);
}
else
{
printf ("STORE_INTO_OBJECT %d - ", (int)b1);
}
else
{
DBGOUT_EXEC_1("STORE_INTO_OBJECT %d", (int)b1);
}
}
else
{
/* push */
DBGOUT_EXEC_1("PUSH_OBJECT %d", (int)b1);
ACTIVE_STACK_PUSH (stix, ass->value);
printf ("PUSH_OBJECT %d - ", (int)b1);
}
break;
}
@ -1556,7 +1806,7 @@ printf ("PUSH_OBJECT %d - ", (int)b1);
case BCODE_JUMP_FORWARD_X:
FETCH_PARAM_CODE_TO (stix, b1);
printf ("JUMP_FORWARD %d\n", (int)b1);
DBGOUT_EXEC_1 ("JUMP_FORWARD %d", (int)b1);
stix->ip += b1;
break;
@ -1564,13 +1814,13 @@ printf ("JUMP_FORWARD %d\n", (int)b1);
case BCODE_JUMP_FORWARD_1:
case BCODE_JUMP_FORWARD_2:
case BCODE_JUMP_FORWARD_3:
printf ("JUMP_FORWARD %d\n", (int)(bcode & 0x3));
DBGOUT_EXEC_1 ("JUMP_FORWARD %d", (int)(bcode & 0x3));
stix->ip += (bcode & 0x3); /* low 2 bits */
break;
case BCODE_JUMP_BACKWARD_X:
FETCH_PARAM_CODE_TO (stix, b1);
printf ("JUMP_BACKWARD %d\n", (int)b1);
DBGOUT_EXEC_1 ("JUMP_BACKWARD %d", (int)b1);
stix->ip += b1;
break;
@ -1578,7 +1828,7 @@ printf ("JUMP_BACKWARD %d\n", (int)b1);
case BCODE_JUMP_BACKWARD_1:
case BCODE_JUMP_BACKWARD_2:
case BCODE_JUMP_BACKWARD_3:
printf ("JUMP_BACKWARD %d\n", (int)(bcode & 0x3));
DBGOUT_EXEC_1 ("JUMP_BACKWARD %d", (int)(bcode & 0x3));
stix->ip -= (bcode & 0x3); /* low 2 bits */
break;
@ -1598,14 +1848,14 @@ return -1;
case BCODE_JUMP2_FORWARD:
FETCH_PARAM_CODE_TO (stix, b1);
printf ("JUMP2_FORWARD %d\n", (int)b1);
DBGOUT_EXEC_1 ("JUMP2_FORWARD %d", (int)b1);
stix->ip += MAX_CODE_JUMP + b1;
break;
break;
case BCODE_JUMP2_BACKWARD:
FETCH_PARAM_CODE_TO (stix, b1);
printf ("JUMP2_BACKWARD %d\n", (int)b1);
DBGOUT_EXEC_1 ("JUMP2_BACKWARD %d", (int)b1);
stix->ip -= MAX_CODE_JUMP + b1;
break;
@ -1654,22 +1904,24 @@ printf ("JUMP2_BACKWARD %d\n", (int)b1);
{
/* pop */
ACTIVE_STACK_POP (stix);
printf ("POP_INTO_CTXTEMPVAR %d %d - ", (int)b1, (int)b2);
DBGOUT_EXEC_2 ("POP_INTO_CTXTEMPVAR %d %d", (int)b1, (int)b2);
}
else
{
DBGOUT_EXEC_2 ("STORE_INTO_CTXTEMPVAR %d %d", (int)b1, (int)b2);
}
else
{
printf ("STORE_INTO_CTXTEMPVAR %d %d - ", (int)b1, (int)b2);
}
}
else
{
/* push */
ACTIVE_STACK_PUSH (stix, ctx->slot[b2]);
printf ("PUSH_CTXTEMPVAR %d %d - ", (int)b1, (int)b2);
DBGOUT_EXEC_2 ("PUSH_CTXTEMPVAR %d %d", (int)b1, (int)b2);
}
/*
print_object (stix, ctx->slot[b2]);
printf ("\n");
*/
break;
}
/* -------------------------------------------------------- */
@ -1716,22 +1968,23 @@ printf ("\n");
{
/* pop */
ACTIVE_STACK_POP (stix);
printf ("POP_INTO_OBJVAR %d %d - ", (int)b1, (int)b2);
DBGOUT_EXEC_2 ("POP_INTO_OBJVAR %d %d", (int)b1, (int)b2);
}
else
{
DBGOUT_EXEC_2 ("STORE_INTO_OBJVAR %d %d", (int)b1, (int)b2);
}
else
{
printf ("STORE_INTO_OBJVAR %d %d - ", (int)b1, (int)b2);
}
}
else
{
/* push */
printf ("PUSH_OBJVAR %d %d - ", (int)b1, (int)b2);
DBGOUT_EXEC_2 ("PUSH_OBJVAR %d %d", (int)b1, (int)b2);
ACTIVE_STACK_PUSH (stix, t->slot[b1]);
}
/*
print_object (stix, t->slot[b1]);
printf ("\n");
*/
break;
}
@ -1769,15 +2022,19 @@ printf ("\n");
selector = (stix_oop_char_t)stix->active_method->slot[b2];
#if defined(STIX_DEBUG_EXEC)
printf ("SEND_MESSAGE%s TO RECEIVER AT STACKPOS=%d NARGS=%d SELECTOR=", (((bcode >> 2) & 1)? "_TO_SUPER": ""), (int)(stix->sp - b1), (int)b1);
print_object (stix, (stix_oop_t)selector);
fflush (stdout);
#endif
STIX_ASSERT (STIX_CLASSOF(stix, selector) == stix->_symbol);
newrcv = ACTIVE_STACK_GET(stix, stix->sp - b1);
#if defined(STIX_DEBUG_EXEC)
printf (" RECEIVER = ");
print_object(stix, newrcv);
printf ("\n");
#endif
mthname.ptr = selector->slot;
mthname.len = STIX_OBJ_GET_SIZE(selector);
newmth = find_method (stix, newrcv, &mthname, ((bcode >> 2) & 1));
@ -1797,36 +2054,36 @@ printf ("]\n");
switch (preamble_code)
{
case STIX_METHOD_PREAMBLE_RETURN_RECEIVER:
printf ("RETURN RECEIVER AT PREAMBLE\n");
DBGOUT_EXEC_0 ("METHOD_PREAMBLE_RETURN_RECEIVER");
ACTIVE_STACK_POPS (stix, b1); /* pop arguments only*/
break;
case STIX_METHOD_PREAMBLE_RETURN_NIL:
printf ("RETURN NIL AT PREAMBLE\n");
DBGOUT_EXEC_0 ("METHOD_PREAMBLE_RETURN_NIL");
ACTIVE_STACK_POPS (stix, b1);
ACTIVE_STACK_SETTOP (stix, stix->_nil);
break;
case STIX_METHOD_PREAMBLE_RETURN_TRUE:
printf ("RETURN TRUE AT PREAMBLE\n");
DBGOUT_EXEC_0 ("METHOD_PREAMBLE_RETURN_TRUE");
ACTIVE_STACK_POPS (stix, b1);
ACTIVE_STACK_SETTOP (stix, stix->_true);
break;
case STIX_METHOD_PREAMBLE_RETURN_FALSE:
printf ("RETURN FALSE AT PREAMBLE\n");
DBGOUT_EXEC_0 ("METHOD_PREAMBLE_RETURN_FALSE");
ACTIVE_STACK_POPS (stix, b1);
ACTIVE_STACK_SETTOP (stix, stix->_false);
break;
case STIX_METHOD_PREAMBLE_RETURN_INDEX:
printf ("RETURN %d AT PREAMBLE\n", (int)STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
DBGOUT_EXEC_1 ("METHOD_PREAMBLE_RETURN_INDEX %d", (int)STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
ACTIVE_STACK_POPS (stix, b1);
ACTIVE_STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(STIX_METHOD_GET_PREAMBLE_INDEX(preamble)));
break;
case STIX_METHOD_PREAMBLE_RETURN_NEGINDEX:
printf ("RETURN %d AT PREAMBLE\n", (int)-STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
DBGOUT_EXEC_1 ("METHOD_PREAMBLE_RETURN_NEGINDEX %d", (int)STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
ACTIVE_STACK_POPS (stix, b1);
ACTIVE_STACK_SETTOP (stix, STIX_OOP_FROM_SMINT(-STIX_METHOD_GET_PREAMBLE_INDEX(preamble)));
break;
@ -1837,7 +2094,8 @@ printf ("RETURN %d AT PREAMBLE\n", (int)-STIX_METHOD_GET_PREAMBLE_INDEX(preamble
ACTIVE_STACK_POPS (stix, b1); /* pop arguments only */
printf ("RETURN INSTVAR AT PREAMBLE index %d\n", (int)STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
DBGOUT_EXEC_1 ("METHOD_PREAMBLE_RETURN_INSTVAR %d", (int)STIX_METHOD_GET_PREAMBLE_INDEX(preamble));
/* replace the receiver by an instance variable of the receiver */
rcv = (stix_oop_oop_t)ACTIVE_STACK_GETTOP(stix);
STIX_ASSERT (STIX_OBJ_GET_FLAGS_TYPE(rcv) == STIX_OBJ_TYPE_OOP);
@ -1863,11 +2121,14 @@ printf ("RETURN INSTVAR AT PREAMBLE index %d\n", (int)STIX_METHOD_GET_PREAMBLE_I
break;
}
case STIX_METHOD_PREAMBLE_PRIMITIVE:
{
stix_ooi_t prim_no;
prim_no = STIX_METHOD_GET_PREAMBLE_INDEX(preamble);
DBGOUT_EXEC_1 ("METHOD_PREAMBLE_PRIMITIVE %d", (int)prim_no);
if (prim_no >= 0 && prim_no < STIX_COUNTOF(primitives) &&
(primitives[prim_no].nargs < 0 || primitives[prim_no].nargs == b1))
{
@ -1880,12 +2141,46 @@ printf ("RETURN INSTVAR AT PREAMBLE index %d\n", (int)STIX_METHOD_GET_PREAMBLE_I
if (n >= 1) break;
}
/* primitive failed. fall through */
/* primitive failed */
if (activate_new_method (stix, newmth) <= -1) goto oops;
break;
}
case STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE:
{
stix_ooi_t prim_name_index;
stix_oop_t name;
primitive_handler_t handler;
prim_name_index = STIX_METHOD_GET_PREAMBLE_INDEX(preamble);
DBGOUT_EXEC_1 ("METHOD_PREAMBLE_NAMED_PRIMITIVE %d", (int)prim_name_index);
name = newmth->slot[prim_name_index];
STIX_ASSERT (STIX_ISTYPEOF(stix,name,STIX_OBJ_TYPE_CHAR));
STIX_ASSERT (STIX_OBJ_GET_FLAGS_EXTRA(name));
STIX_ASSERT (STIX_CLASSOF(stix,name) == stix->_symbol);
handler = query_primitive_module (stix, ((stix_oop_char_t)name)->slot);
if (handler)
{
stix_pushtmp (stix, (stix_oop_t*)&newmth);
n = handler (stix, b1);
stix_poptmp (stix);
if (n <= -1) goto oops;
if (n >= 1) break;
}
/* primitive failed */
if (activate_new_method (stix, newmth) <= -1) goto oops;
break;
}
default:
if (activate_new_method (stix, newmth) <= -1) goto oops;
break;
/* this must not happen */
stix->errnum = STIX_EINTERN;
return -1;
}
break; /* CMD_SEND_MESSAGE */
@ -1894,60 +2189,60 @@ printf ("RETURN INSTVAR AT PREAMBLE index %d\n", (int)STIX_METHOD_GET_PREAMBLE_I
/* -------------------------------------------------------- */
case BCODE_PUSH_RECEIVER:
printf ("PUSH_RECEIVER %p TO STACK INDEX %d\n", stix->active_context->origin->receiver_or_source, (int)stix->sp);
DBGOUT_EXEC_0 ("PUSH_RECEIVER");
ACTIVE_STACK_PUSH (stix, stix->active_context->origin->receiver_or_source);
break;
case BCODE_PUSH_NIL:
printf ("PUSH_NIL\n");
DBGOUT_EXEC_0 ("PUSH_NIL");
ACTIVE_STACK_PUSH (stix, stix->_nil);
break;
case BCODE_PUSH_TRUE:
printf ("PUSH_TRUE\n");
DBGOUT_EXEC_0 ("PUSH_TRUE");
ACTIVE_STACK_PUSH (stix, stix->_true);
break;
case BCODE_PUSH_FALSE:
printf ("PUSH_FALSE\n");
DBGOUT_EXEC_0 ("PUSH_FALSE");
ACTIVE_STACK_PUSH (stix, stix->_false);
break;
case BCODE_PUSH_CONTEXT:
printf ("PUSH_CONTEXT\n");
DBGOUT_EXEC_0 ("PUSH_CONTEXT");
ACTIVE_STACK_PUSH (stix, (stix_oop_t)stix->active_context);
break;
case BCODE_PUSH_NEGONE:
printf ("PUSH_NEGONE\n");
DBGOUT_EXEC_0 ("PUSH_NEGONE");
ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(-1));
break;
case BCODE_PUSH_ZERO:
printf ("PUSH_ZERO\n");
DBGOUT_EXEC_0 ("PUSH_ZERO");
ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(0));
break;
case BCODE_PUSH_ONE:
printf ("PUSH_ONE\n");
DBGOUT_EXEC_0 ("PUSH_ONE");
ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(1));
break;
case BCODE_PUSH_TWO:
printf ("PUSH_TWO\n");
DBGOUT_EXEC_0 ("PUSH_TWO");
ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(2));
break;
case BCODE_PUSH_INTLIT:
FETCH_PARAM_CODE_TO (stix, b1);
DBGOUT_EXEC_1 ("PUSH_INTLIT %d", (int)b1);
ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(b1));
printf ("PUSH_INTLIT %d\n", (int)b1);
break;
case BCODE_PUSH_NEGINTLIT:
FETCH_PARAM_CODE_TO (stix, b1);
DBGOUT_EXEC_1 ("PUSH_NEGINTLIT %d", (int)-b1);
ACTIVE_STACK_PUSH (stix, STIX_OOP_FROM_SMINT(-b1));
printf ("PUSH_NEGINTLIT %d\n", (int)-b1);
break;
/* -------------------------------------------------------- */
@ -1955,7 +2250,7 @@ printf ("PUSH_NEGINTLIT %d\n", (int)-b1);
case BCODE_DUP_STACKTOP:
{
stix_oop_t t;
printf ("DUP_STACKTOP SP=%d\n", (int)stix->sp);
DBGOUT_EXEC_0 ("DUP_STACKTOP");
STIX_ASSERT (!ACTIVE_STACK_ISEMPTY(stix));
t = ACTIVE_STACK_GETTOP(stix);
ACTIVE_STACK_PUSH (stix, t);
@ -1963,22 +2258,25 @@ printf ("DUP_STACKTOP SP=%d\n", (int)stix->sp);
}
case BCODE_POP_STACKTOP:
printf ("POP_STACKTOP\n");
DBGOUT_EXEC_0 ("POP_STACKTOP");
STIX_ASSERT (!ACTIVE_STACK_ISEMPTY(stix));
ACTIVE_STACK_POP (stix);
break;
case BCODE_RETURN_STACKTOP:
printf ("RETURN_STACKTOP\n");
DBGOUT_EXEC_0 ("RETURN_STACKTOP");
return_value = ACTIVE_STACK_GETTOP(stix);
ACTIVE_STACK_POP (stix);
goto handle_return;
case BCODE_RETURN_RECEIVER:
printf ("RETURN_RECEIVER\n");
DBGOUT_EXEC_0 ("RETURN_RECEIVER");
return_value = stix->active_context->origin->receiver_or_source;
handle_return:
#if defined(STIX_DEBUG_EXEC)
printf ("<<LEAVING>> SP=%d\n", (int)stix->sp);
#endif
/* put the instruction pointer back to the return
* instruction (RETURN_RECEIVER or RETURN_RECEIVER)
@ -2032,8 +2330,9 @@ printf ("<<LEAVING>> SP=%d\n", (int)stix->sp);
/* the sending context of the intial context has been set to nil.
* use this fact to tell an initial context from a normal context. */
STIX_ASSERT (stix->active_context->receiver_or_source == stix->_nil);
#if defined(STIX_DEBUG_EXEC)
printf ("<<<RETURNIGN TO THE INITIAL CONTEXT>>>\n");
#endif
STIX_ASSERT (stix->sp == 0);
goto done;
}
@ -2041,7 +2340,8 @@ printf ("<<<RETURNIGN TO THE INITIAL CONTEXT>>>\n");
break;
case BCODE_RETURN_FROM_BLOCK:
printf ("LEAVING_BLOCK\n");
DBGOUT_EXEC_0 ("RETURN_FROM_BLOCK");
STIX_ASSERT(STIX_CLASSOF(stix, stix->active_context) == stix->_block_context);
return_value = ACTIVE_STACK_GETTOP(stix);
@ -2058,7 +2358,7 @@ printf ("LEAVING_BLOCK\n");
FETCH_PARAM_CODE_TO (stix, b1);
FETCH_PARAM_CODE_TO (stix, b2);
printf ("MAKE_BLOCK %d %d\n", (int)b1, (int)b2);
DBGOUT_EXEC_2 ("MAKE_BLOCK %d %d", (int)b1, (int)b2);
STIX_ASSERT (b1 >= 0);
STIX_ASSERT (b2 >= b1);
@ -2099,7 +2399,9 @@ printf ("MAKE_BLOCK %d %d\n", (int)b1, (int)b2);
stix_ooi_t nargs, ntmprs;
stix_oop_context_t rctx;
stix_oop_context_t blkctx;
printf ("SEND_BLOCK_COPY\n");
DBGOUT_EXEC_0 ("SEND_BLOCK_COPY");
/* it emulates thisContext blockCopy: nargs ofTmprCount: ntmprs */
STIX_ASSERT (stix->sp >= 2);
@ -2200,7 +2502,10 @@ printf ("UNKNOWN BYTE CODE ENCOUNTERED %x\n", (int)bcode);
}
done:
#if defined(STIX_PROFILE_EXEC)
printf ("TOTAL_INST_COUTNER = %lu\n", (unsigned long int)inst_counter);
#endif
return 0;
@ -2209,8 +2514,10 @@ oops:
return -1;
}
int stix_invoke (stix_t* stix, const stix_ucs_t* objname, const stix_ucs_t* mthname)
{
if (activate_initial_context (stix, objname, mthname) <= -1) return -1;
return stix_execute (stix);
}

8
stix/lib/main.c
View File

@ -65,7 +65,7 @@ static stix_mmgr_t sys_mmgr =
};
static STIX_INLINE stix_ssize_t open_input (stix_t* stix, stix_ioarg_t* arg)
static STIX_INLINE stix_ssize_t open_input (stix_t* stix, stix_io_arg_t* arg)
{
if (arg->includer)
{
@ -108,7 +108,7 @@ static STIX_INLINE stix_ssize_t open_input (stix_t* stix, stix_ioarg_t* arg)
return 0;
}
static STIX_INLINE stix_ssize_t read_input (stix_t* stix, stix_ioarg_t* arg)
static STIX_INLINE stix_ssize_t read_input (stix_t* stix, stix_io_arg_t* arg)
{
xtn_t* xtn = stix_getxtn(stix);
stix_size_t n, bcslen, ucslen, remlen;
@ -141,14 +141,14 @@ static STIX_INLINE stix_ssize_t read_input (stix_t* stix, stix_ioarg_t* arg)
return ucslen;
}
static STIX_INLINE stix_ssize_t close_input (stix_t* stix, stix_ioarg_t* arg)
static STIX_INLINE stix_ssize_t close_input (stix_t* stix, stix_io_arg_t* arg)
{
STIX_ASSERT (arg->handle != STIX_NULL);
fclose ((FILE*)arg->handle);
return 0;
}
static stix_ssize_t input_handler (stix_t* stix, stix_iocmd_t cmd, stix_ioarg_t* arg)
static stix_ssize_t input_handler (stix_t* stix, stix_io_cmd_t cmd, stix_io_arg_t* arg)
{
switch (cmd)
{

32
stix/lib/stix-prv.h
View File

@ -50,6 +50,8 @@
/* this is for gc debugging */
#define STIX_DEBUG_GC_001
/*#define STIX_DEBUG_EXEC*/
#define STIX_PROFILE_EXEC
#include <stdio.h> /* TODO: delete these header inclusion lines */
#include <string.h>
@ -159,13 +161,13 @@
/* SOURCE CODE I/O FOR COMPILER */
/* ========================================================================= */
enum stix_iocmd_t
enum stix_io_cmd_t
{
STIX_IO_OPEN,
STIX_IO_CLOSE,
STIX_IO_READ
};
typedef enum stix_iocmd_t stix_iocmd_t;
typedef enum stix_io_cmd_t stix_io_cmd_t;
struct stix_ioloc_t
{
@ -183,14 +185,14 @@ struct stix_iolxc_t
typedef struct stix_iolxc_t stix_iolxc_t;
/*
enum stix_ioarg_flag_t
enum stix_io_arg_flag_t
{
STIX_IO_INCLUDED = (1 << 0)
};
typedef enum stix_ioarg_flag_t stix_ioarg_flag_t; */
typedef enum stix_io_arg_flag_t stix_io_arg_flag_t; */
typedef struct stix_ioarg_t stix_ioarg_t;
struct stix_ioarg_t
typedef struct stix_io_arg_t stix_io_arg_t;
struct stix_io_arg_t
{
/**
* [IN] I/O object name.
@ -216,7 +218,7 @@ struct stix_ioarg_t
* [IN] points to the data of the includer. It is #STIX_NULL for the
* main stream.
*/
stix_ioarg_t* includer;
stix_io_arg_t* includer;
/*-----------------------------------------------------------------*/
/*----------- from here down, internal use only -------------------*/
@ -232,10 +234,10 @@ struct stix_ioarg_t
/*-----------------------------------------------------------------*/
};
typedef stix_ssize_t (*stix_ioimpl_t) (
typedef stix_ssize_t (*stix_io_impl_t) (
stix_t* stix,
stix_iocmd_t cmd,
stix_ioarg_t* arg
stix_io_cmd_t cmd,
stix_io_arg_t* arg
);
struct stix_iotok_t
@ -363,7 +365,7 @@ typedef struct stix_code_t stix_code_t;
struct stix_compiler_t
{
/* input handler */
stix_ioimpl_t impl;
stix_io_impl_t impl;
/* information about the last meaningful character read.
* this is a copy of curinp->lxc if no ungetting is performed.
@ -377,10 +379,10 @@ struct stix_compiler_t
int nungots;
/* static input data buffer */
stix_ioarg_t arg;
stix_io_arg_t arg;
/* pointer to the current input data. initially, it points to &arg */
stix_ioarg_t* curinp;
stix_io_arg_t* curinp;
/* the last token read */
stix_iotok_t tok;
@ -480,6 +482,8 @@ struct stix_compiler_t
stix_size_t arlit_count;
stix_size_t arlit_capa;
/* 0 for no primitive, 1 for a normal primitive, 2 for a named primitive */
int prim_type;
/* primitive number */
stix_ooi_t prim_no;
@ -1062,7 +1066,7 @@ int stix_utf8toucs (
/* ========================================================================= */
int stix_compile (
stix_t* stix,
stix_ioimpl_t io
stix_io_impl_t io
);
void stix_getsynerr (

62
stix/lib/stix.h
View File

@ -73,6 +73,8 @@ struct stix_ucs_t
};
typedef struct stix_ucs_t stix_ucs_t;
/* =========================================================================
* PRIMITIVE MACROS
* ========================================================================= */
@ -584,9 +586,9 @@ struct stix_association_t
};
#if defined(STIX_USE_OBJECT_TRAILER)
# define STIX_METHOD_NAMED_INSTVARS 5
# define STIX_METHOD_NAMED_INSTVARS 7
#else
# define STIX_METHOD_NAMED_INSTVARS 6
# define STIX_METHOD_NAMED_INSTVARS 8
#endif
typedef struct stix_method_t stix_method_t;
typedef struct stix_method_t* stix_oop_method_t;
@ -599,6 +601,8 @@ struct stix_method_t
/* primitive number */
stix_oop_t preamble; /* SmallInteger */
stix_oop_t preamble_data[2]; /* SmallInteger */
/* number of temporaries including arguments */
stix_oop_t tmpr_count; /* SmallInteger */
@ -644,9 +648,12 @@ struct stix_method_t
#define STIX_METHOD_PREAMBLE_RETURN_NEGINDEX 6
#define STIX_METHOD_PREAMBLE_RETURN_INSTVAR 7
#define STIX_METHOD_PREAMBLE_PRIMITIVE 8
#define STIX_METHOD_PREAMBLE_NAMED_PRIMITIVE 9 /* index is an index to the symbol table */
/* the index is an 16-bit unsigned integer. */
#define STIX_OOI_IN_PREAMBLE_INDEX_RANGE(ooi) ((ooi) >= 0 && (ooi) <= 0xFFFF)
#define STIX_METHOD_PREAMBLE_INDEX_MIN 0x0000
#define STIX_METHOD_PREAMBLE_INDEX_MAX 0xFFFF
#define STIX_OOI_IN_PREAMBLE_INDEX_RANGE(num) ((num) >= STIX_METHOD_PREAMBLE_INDEX_MIN && (num) <= STIX_METHOD_PREAMBLE_INDEX_MAX)
#define STIX_CONTEXT_NAMED_INSTVARS 8
typedef struct stix_context_t stix_context_t;
@ -733,19 +740,58 @@ struct stix_heap_t
typedef struct stix_t stix_t;
typedef void (*stix_cbimpl_t) (stix_t* stix);
/* =========================================================================
* MODULE MANIPULATION
* ========================================================================= */
enum stix_mod_cmd_t
{
STIX_MOD_OPEN,
STIX_MOD_CLOSE,
STIX_MOD_READ
};
typedef enum stix_mod_cmd_t stix_mod_cmd_t;
struct stix_mod_arg_t
{
/* [INPUT] */
const stix_uch_t* prefix;
const stix_uch_t* postfix;
const stix_uch_t* name;
/* [OUTPUT] */
void* handle;
};
typedef struct stix_mod_arg_t stix_mod_arg_t;
typedef int (*stix_mod_impl_t) (
stix_t* stix,
stix_mod_cmd_t cmd,
stix_mod_arg_t* arg
);
/* =========================================================================
* IO MANIPULATION
* ========================================================================= */
/* TODO: MOVE stix_io_impl_t HERE */
/* =========================================================================
* CALLBACK MANIPULATION
* ========================================================================= */
typedef void (*stix_cb_impl_t) (stix_t* stix);
typedef struct stix_cb_t stix_cb_t;
struct stix_cb_t
{
stix_cbimpl_t gc;
stix_cbimpl_t fini;
stix_cb_impl_t gc;
stix_cb_impl_t fini;
/* private below */
stix_cb_t* prev;
stix_cb_t* next;
stix_cb_t* prev;
stix_cb_t* next;
};
#if defined(STIX_INCLUDE_COMPILER)
typedef struct stix_compiler_t stix_compiler_t;
#endif

299
stix/lib/test-005.st
View File

@ -1,299 +0,0 @@
#include 'Stix.st'.
#################################################################
## MAIN
#################################################################
## TODO: use #define to define a class or use #class to define a class.
## use #extend to extend a class
## using #class for both feels confusing.
#extend Apex
{
}
#extend SmallInteger
{
#method getTrue: anInteger
{
^anInteger + 9999.
}
#method inc
{
^self + 1.
}
}
#class TestObject(Object)
{
#dcl(#class) Q R.
#dcl(#classinst) t1 t2.
}
#class MyObject(TestObject)
{
#dcl(#class) C B A.
#method getTrue
{
^true.
}
#method getTrue: anInteger
{
^ anInteger
}
#method getFalse
{
^false
}
#method yyy: aBlock
{
| a |
a := aBlock value.
^a + 99.
##a := Stix.MyCOM.HashTable new.
}
#method xxx: aBlock
{
| a |
a := self yyy: aBlock.
'KKKKKKKKKKKKKKKKKKKKKKKKKKKKK' dump.
^a.
}
#method(#class) main2
{
| a b c sum |
## ##(10 add: 20) dump.
## (10 + 20) dump.
##
## a := 10 + 20 + 30.
## b := [:x :y | | t z | x := 20. b := 9. x := 10 + 20 ].
##
## (b value: 10 value: 20) dump.
##
## thisContext basicSize dump.
##
## (thisContext basicAt: (8 + 5)) dump.
##
## ^self.
a := self new.
##a yourself.
##b := a getTrue; getFalse.
##b := a getTrue; getFalse; getTrue: 20 + 10.
##b := a getTrue; getFalse; getTrue: 20 + 10; getTrue: 90 + 20.
##b := 3 + 5 getTrue: 20; getTrue: 8 + 1; getTrue: 20; yourself.
b := 3 + 5 inc getTrue: 20 + (30 getTrue: 20; yourself); yourself.
##b := [:q | q ] value: a getTrue.
b dump.
##^self.
## ############################################################
## A := 99.
[:x :y | R := y. ] value: 10 value: 6.
R := R + 1.
R dump.
sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ].
##sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1)) + (sum value: (n - 2))] ].
(sum value: R; value: 5) dump.
##sum := [ :n | sum value: 5 ].
##sum value: 5.
#[ 1 2 3] dump.
#[ 4 5 6] dump.
#(abc:def: 2 'string is good' 3 4 (5 6) (7 (8 9)) 10) dump.
#([] #[]) dump.
a := #(abc:def: -2 'string is good' 3 #[2 3 4] 4 (5 6) (7 (8 [4 56] 'hello' 9)) 10 -93952 self true false nil thisContext super).
a at: 3 put: 'hello world'; dump.
a := self new.
(a xxx: [888]) dump.
20 dump.
b := 0.
[ b < 9 ] whileTrue: [ b dump. b := b + 1 ].
S'hello \t\u78966\u8765\u3456\u2723\x20\123world\uD57C\uB85C\uC6B0' dump.
C'\n' dump.
#abc:def: dump.
##a := (11 < 10) ifTrue: [5] ifFalse: [20].
##a dump.
}
#method(#class) main55
{
|a b c|
self main2.
## b := 0.
## [ b < 5 ] whileTrue: [ b dump. b := b + 1 ].
}
#method(#class) getTen
{
^10
}
## ---------------------------------------------------------------------------
" this sample demonstrates what happens when a block context returns to the origin's caller
after the caller has already returned. "
#method(#class) xxxx
{
| g1 g2 |
t1 dump.
t2 := [ |tmp| g1 := 50. g2 := 100. tmp := g1 + g2. tmp dump. ^tmp ].
(t1 < 100) ifFalse: [ ^self ].
t1 := t1 + 1.
self xxxx
}
#method(#class) yyyy
{
|c1|
t1 := 1.
c1 :=self xxxx.
888 dump.
999 dump.
^c1.
}
#method(#class) main66
{
self yyyy.
t2 := t2 value. "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
t2 dump.
}
#method(#class) mainj
{
|k1|
t1 := 1.
self xxxx.
t2 := t2 value. "can t2 return? it should return somewhere into the method context of yyy. but it has already terminated"
t2 dump.
}
## ----------------------------------------------------------------------
#method(#class) main22
{
|a b c d e f g h i j k sum |
sum := [ :n | (n < 2) ifTrue: [1] ifFalse: [ n + (sum value: (n - 1))] ].
(sum value: 5) dump.
'-------------------------' dump.
b := 0.
[ b < 2000 ] whileTrue: [ b dump. b := b + 1 ].
'-------------------------' dump.
b := 0.
[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
'-------------------------' dump.
a := #[4 5 6 7] at: 3.
(#[3 2 1] at: 3) dump.
## thisContext value. "the message value must be unresolvable as thisContext is a method context"
## [thisContext value] value.
'-------------------------' dump.
b := 0.
[ b := b + 1. b dump. thisContext value] value.
[self getTen] value dump.
}
#method(#class) main
{
| ffi |
ffi := FFI new: 'libc.so.6'.
## ffi call: #printf with: #((str '%d') (int 10) (long 20)).
ffi call: #printf withSig: 'i|sii' withArgs: #(S'hello world %d %d\n' 11123 9876543).
## ffi call: #puts withSig: 'i|s' withArgs: #('hello world').
ffi close.
}
}
"
[ a := 20. b := [ a + 20 ]. b value. ] value
^ ^ ^ ^
p1 p3 p4 p2
--------------------------------------------------------------------------------
AC
--------------------------------------------------------------------------------
mc1<active>
mc1->sender := fake_initial_context.
mc1->home := nil.
mc1->origin := mc1.
mc1 p1 -> bc1 is created based on mc1 (mc1 blockCopy:)
bc1->caller := nil
bc1->origin := mc1.
bc1->home := mc1. (the active context is a method context. so just use it as a home).
bc1->source := nil.
mc1 p2 -> bc2 is shallow-copied of bc1. (bc1 value)
bc2->caller := mc1. (mc1 is the active context at p2 time)
bc2->origin := bc1->origin.
bc2->home := bc1->home.
bc2->source := bc1.
bc2 bc3 is created based on bc2. (bc2 blockCopy:)
bc3->caller := nil
bc3->origin := bc2->origin
//bc3->home := bc2.
bc3->home := bc2->source. (the active context is a block context. take from the block context's source */
bc3->source := nil.
bc2 bc4 is shallow-copied of bc3. (bc3 value)
bc4->caller := bc2. (bc2 is the active context at p2 time)
bc4->origin := bc3->origin
bc4->home := bc3->home
bc4->source = bc3.
bc4.
--------------------------------------------------------------------------------
'home' is set when the context is created by blockCopy.
'caller' is set when the context is activated.
all 'origin' fields point to mc1 as a result.
self represents the receiver. that is bc->origin->receiver which is mc1->receiver.
--------------------------------------------------------------------------------
#method ifTrue: trueBlock
{
^trueBlock value.
}
#method whileTrue: aBlock
{
(self value) ifTrue: [aBlock value. self whileTrue: aBlock].
}
[ b < 10 ] whileTrue: [ b dump. b := b + 1 ].
"