diff --git a/stix/kernel/Apex.st b/stix/kernel/Apex.st new file mode 100644 index 0000000..f63723f --- /dev/null +++ b/stix/kernel/Apex.st @@ -0,0 +1,209 @@ +#class Apex(nil) +{ + #dcl(#class) sysdic. + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method(#class) dump + { + + } + + #method dump + { + + } + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method(#class) yourself + { + ^self. + } + + #method yourself + { + ^self. + } + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method(#class) new + { + + self primitiveFailed. + } + + #method(#class) new: anInteger + { + + self primitiveFailed. + } + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method class + { + + } + + #method(#class) class + { + + ^Class + } + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method basicSize + { + + ^0 + } + + #method basicAt: anInteger + { + + self error: 'out of range'. + } + + #method basicAt: anInteger put: anObject + { + + self error: 'out of range'. + } + + #method(#class) basicSize + { + + ^0 + } + + #method(#class) basicAt: anInteger + { + + self error: 'out of range'. + } + + #method(#class) basicAt: anInteger put: anObject + { + + self error: 'out of range'. + } + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method == anObject + { + "check if the receiver is identical to anObject. + this doesn't compare the contents" + + } + + #method ~~ anObject + { + + ^(self == anObject) not. + } + + #method(#class) == anObject + { + "check if the receiver is identical to anObject. + this doesn't compare the contents" + + } + + #method(#class) ~~ anObject + { + + ^(self == anObject) not. + } + + ## TODO: add = and ~= for equality check. + + #method isNil + { + "^self == nil." + ^false + } + + #method notNil + { + "^(self == nil) not" + "^self ~= nil." + ^true. + } + + #method(#class) isNil + { + "^self == nil." + ^false + } + + #method(#class) notNil + { + "^(self == nil) not" + "^self ~= nil." + ^true. + } + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + " + #method(#class) respondsTo: selectorSymbol + { + TODO: find selectorSymbol in the class method dictionary... + } + + #method respondsTo: selectorSymbol + { + TODO: find selectorSymbol in the method dictionary... + } + " + + ## ------------------------------------------------------- + ## ------------------------------------------------------- + + #method(#class) primitiveFailed + { + ## TODO: implement this + ## PrimitiveFailureError signal. + 'primitive failed' dump. + } + + #method primitiveFailed + { + self class primitiveFailed. + } + + #method(#class) doesNotUnderstand: messageSymbol + { + ## TODO: implement this + ## UnrecognizedMessage signal. + 'does not understand' dump. + } + + #method doesNotUnderstand: messageSymbol + { + self class doesNotUnderstand: messageSymbol + } + + #method(#class) error: msgText + { + ## TODO: implement this + ## Error signal: msgText. + msgText dump. + } + + #method error: aString + { + self class error: aString. + } + +} diff --git a/stix/kernel/Boolean.st b/stix/kernel/Boolean.st new file mode 100644 index 0000000..aee3298 --- /dev/null +++ b/stix/kernel/Boolean.st @@ -0,0 +1,93 @@ +#class Boolean(Object) +{ + + "TODO: do i need to really define methods defined in True and False here? + and call subclassResponsibiltiy?" +} + +#class True(Boolean) +{ + #method not + { + ^false + } + + #method & aBoolean + { + ^aBoolean + } + + #method | aBoolean + { + ^true + } + + #method and: aBlock + { + ^aBlock value + } + + #method or: aBlock + { + ^true + } + + #method ifTrue: trueBlock ifFalse: falseBlock + { + ^trueBlock value. + } + + #method ifTrue: trueBlock + { + ^trueBlock value. + } + + #method ifFalse: falseBlock + { + ^nil. + } +} + +#class False(Boolean) +{ + #method not + { + ^true + } + + #method & aBoolean + { + ^false + } + + #method | aBoolean + { + ^aBoolean + } + + #method and: aBlock + { + ^false + } + + #method or: aBlock + { + ^aBlock value + } + + + #method ifTrue: trueBlock ifFalse: falseBlock + { + ^falseBlock value. + } + + #method ifTrue: trueBlock + { + ^nil. + } + + #method ifFalse: falseBlock + { + ^falseBlock value. + } +} diff --git a/stix/kernel/Class.st b/stix/kernel/Class.st new file mode 100644 index 0000000..9f4ee98 --- /dev/null +++ b/stix/kernel/Class.st @@ -0,0 +1,5 @@ + +#class(#pointer) Class(Apex) +{ + #dcl spec selfspec superclass subclasses name instvars classvars classinstvars pooldics instmthdic classmthdic. +} diff --git a/stix/kernel/Collection-Array.st b/stix/kernel/Collection-Array.st new file mode 100644 index 0000000..a7cc988 --- /dev/null +++ b/stix/kernel/Collection-Array.st @@ -0,0 +1,40 @@ +#class(#pointer) Array(Collection) +{ + #method size + { + ^self basicSize. + } + + #method at: anInteger + { + ^self basicAt: anInteger. + } + + #method at: anInteger put: aValue + { + ^self basicAt: anInteger put: aValue. + } + + #method first + { + ^self at: 1. + } + + #method last + { + ^self at: self size. + } + + #method do: aBlock + { + 1 to: self size do: [:i | aBlock value: (self at: i)]. + } +} + +#class(#character) String(Array) +{ +} + +#class(#character) Symbol(Array) +{ +} diff --git a/stix/kernel/Collection-ByteArray.st b/stix/kernel/Collection-ByteArray.st new file mode 100644 index 0000000..11647a1 --- /dev/null +++ b/stix/kernel/Collection-ByteArray.st @@ -0,0 +1,13 @@ +#class(#byte) ByteArray(Collection) +{ + #method at: anInteger + { + ^self basicAt: anInteger. + } + + #method at: anInteger put: aValue + { + ^self basicAt: anInteger put: aValue. + } + +} diff --git a/stix/kernel/Collection-Set.st b/stix/kernel/Collection-Set.st new file mode 100644 index 0000000..2af6663 --- /dev/null +++ b/stix/kernel/Collection-Set.st @@ -0,0 +1,31 @@ +#class Set(Collection) +{ + #dcl tally bucket. +} + +#class SymbolSet(Set) +{ +} + +#class Dictionary(Set) +{ +} + +#class SystemDictionary(Dictionary) +{ +} + + +#class Namespace(Set) +{ +} + +#class PoolDictionary(Set) +{ +} + +#class MethodDictionary(Dictionary) +{ + +} + diff --git a/stix/kernel/Collection.st b/stix/kernel/Collection.st new file mode 100644 index 0000000..21b94b4 --- /dev/null +++ b/stix/kernel/Collection.st @@ -0,0 +1,3 @@ +#class Collection(Object) +{ +} diff --git a/stix/kernel/Number.st b/stix/kernel/Number.st new file mode 100644 index 0000000..5c1978a --- /dev/null +++ b/stix/kernel/Number.st @@ -0,0 +1,37 @@ +#class Number(Magnitude) +{ + #method add: aNumber + { + + } + + #method + aNumber + { + + } + + #method - aNumber + { + + } + + #method * aNumber + { + + } + + #method = aNumber + { + + } + + #method < aNumber + { + + } + + #method > aNumber + { + + } +} diff --git a/stix/kernel/Object.st b/stix/kernel/Object.st new file mode 100644 index 0000000..f255d48 --- /dev/null +++ b/stix/kernel/Object.st @@ -0,0 +1,4 @@ +#class Object(Apex) +{ + +} diff --git a/stix/lib/Stix.st b/stix/kernel/Stix.st similarity index 64% rename from stix/lib/Stix.st rename to stix/kernel/Stix.st index 5ac8949..ce917ef 100644 --- a/stix/lib/Stix.st +++ b/stix/kernel/Stix.st @@ -1,98 +1,19 @@ -#class Apex(nil) +#include 'Apex.st'. +#include 'Object.st'. +#include 'UndefinedObject.st'. +#include 'Class.st'. +#include 'Boolean.st'. + + +#class Error(Object) { - #dcl(#class) sysdic. - - #method(#class) yourself + #method(#class) signal: aString { - ^self. - } - - #method yourself - { - ^self. - } - - #method(#class) dump - { - - } - - #method dump - { - - } - - #method(#class) new - { - ## - - } - - #method(#class) new: anInteger - { - ## - - } - - #method basicSize - { - ## - - ^0 - } - - - #method basicAt: anInteger - { - ## - - ## self error: 'out of range'. - } - - #method basicAt: anInteger put: anObject - { - ## - - ## 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. + "accept an arbitary object instead of a string. + the object can be sent displayString for string conversion" } } -#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) { } @@ -142,122 +63,43 @@ { } + + + #method to: end by: step do: aBlock + { + | i | + + i := self. + (step > 0) + ifTrue: [ + [ i <= end ] whileTrue: [ + aBlock value: i. + i := i + step. + ] + ] + ifFalse: [ + [ i >= end ] whileTrue: [ + aBlock value: i. + i := i - step. + ] + ]. + } + + #method to: end do: aBlock + { + ^self to: end by: 1 do: aBlock. + } } #class SmallInteger(Number) { } -#class Boolean(Object) -{ +#include 'Collection.st'. +#include 'Collection-ByteArray.st'. +#include 'Collection-Array.st'. +#include 'Collection-Set.st'. -} - -#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) { @@ -391,11 +233,29 @@ { ip := source pc. } + + + + "------ TODO: -------------------------------------" + #method on: anError do: anExceptionBlock + { + "TODO: handle if anError is an ErrorSet .." + } + + #method ensure: aBlock + { + } + + #method ifCurtailed: aBlock + { + } + + "------ TODO: -------------------------------------" } #class(#pointer) CompiledMethod(Object) { - #dcl owner preamble ntmprs nargs code source. + #dcl owner preamble preamble_data_1 preamble_data_2 ntmprs nargs code source. } @@ -413,6 +273,14 @@ self.funcs := Dictionary new. self.name := aString. self.handle := self privateOpen: self.name. + + "[ self.handle := self privateOpen: self.name ] + on: Error do: [ + ] + on: XError do: [ + ]." + + ^self. } #method close @@ -432,7 +300,7 @@ ## self.funcs at: aFunctionName put: f. ## ]. f := self privateGetSymbol: aFunctionName in: self.handle. -## f isNil ifTrue: [ self error: 'No such function' ]. +f isNil ifTrue: [ self error: 'No such function' ]. ^self privateCall: f withSig: aString withArgs: anArray } @@ -440,7 +308,7 @@ f := self privateGetSymbol: aFunctionName in: self.handle. #method privateOpen: aString { - ## throw an exception here. + ^nil. ## TODO: Error signal: 'can not open' } #method privateClose: aHandle @@ -456,6 +324,7 @@ f := self privateGetSymbol: aFunctionName in: self.handle. #method privateGetSymbol: aString in: aHandle { + ^nil. } } diff --git a/stix/kernel/UndefinedObject.st b/stix/kernel/UndefinedObject.st new file mode 100644 index 0000000..06be4d5 --- /dev/null +++ b/stix/kernel/UndefinedObject.st @@ -0,0 +1,12 @@ +#class UndefinedObject(Apex) +{ + #method isNil + { + ^true + } + + #method notNil + { + ^false. + } +} diff --git a/stix/lib/test-005.st b/stix/kernel/test-005.st similarity index 96% rename from stix/lib/test-005.st rename to stix/kernel/test-005.st index 1024f8b..a145065 100644 --- a/stix/lib/test-005.st +++ b/stix/kernel/test-005.st @@ -224,14 +224,27 @@ [self getTen] value dump. } + #method(#class) abc + { + + } + #method(#class) main { - | ffi | + "| 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. + ffi close." + self abc. + + FFI isNil dump. + FFI notNil dump. + nil isNil dump. + nil notNil dump. + nil class dump. + nil class class class dump. } } diff --git a/stix/lib/comp.c b/stix/lib/comp.c index 27717e9..4262a5e 100644 --- a/stix/lib/comp.c +++ b/stix/lib/comp.c @@ -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: ? * + * * */ @@ -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); diff --git a/stix/lib/exec.c b/stix/lib/exec.c index 5eaa9c8..c98ff71 100644 --- a/stix/lib/exec.c +++ b/stix/lib/exec.c @@ -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 ("<> 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 <> 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 ("<>\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 ("<> 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 ("<> 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 ("<<>>\n"); +#endif STIX_ASSERT (stix->sp == 0); goto done; } @@ -2041,7 +2340,8 @@ printf ("<<>>\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); } + diff --git a/stix/lib/main.c b/stix/lib/main.c index 80579ea..a55b479 100644 --- a/stix/lib/main.c +++ b/stix/lib/main.c @@ -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) { diff --git a/stix/lib/stix-prv.h b/stix/lib/stix-prv.h index f2c2165..90dd457 100644 --- a/stix/lib/stix-prv.h +++ b/stix/lib/stix-prv.h @@ -50,6 +50,8 @@ /* this is for gc debugging */ #define STIX_DEBUG_GC_001 +/*#define STIX_DEBUG_EXEC*/ +#define STIX_PROFILE_EXEC #include /* TODO: delete these header inclusion lines */ #include @@ -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 ( diff --git a/stix/lib/stix.h b/stix/lib/stix.h index 189c269..e325b7c 100644 --- a/stix/lib/stix.h +++ b/stix/lib/stix.h @@ -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