diff --git a/ase/stx/bytecode.c b/ase/stx/bytecode.c index 47f9d603..9ad30d06 100644 --- a/ase/stx/bytecode.c +++ b/ase/stx/bytecode.c @@ -1,5 +1,5 @@ /* - * $Id: bytecode.c,v 1.15 2005-10-02 10:44:49 bacon Exp $ + * $Id: bytecode.c,v 1.16 2005-10-02 15:45:09 bacon Exp $ */ #include #include @@ -17,7 +17,6 @@ int xp_stx_decode (xp_stx_t* stx, xp_word_t class) class_obj = (xp_stx_class_t*)XP_STX_OBJECT(stx, class); if (class_obj->methods == stx->nil) return 0; - /* TODO */ xp_stx_dict_traverse (stx, class_obj->methods, __decode1, class_obj); return 0; @@ -116,7 +115,7 @@ static int __decode2 (xp_stx_t* stx, static const xp_char_t* stack_special_opcode_names[] = { - XP_TEXT("store_pop_stack_top"), + XP_TEXT("pop_stack_top"), XP_TEXT("duplicate_pop_stack_top"), XP_TEXT("push_active_context"), XP_TEXT("push_nil"), diff --git a/ase/stx/bytecode.h b/ase/stx/bytecode.h index 0559ba12..17be65d2 100644 --- a/ase/stx/bytecode.h +++ b/ase/stx/bytecode.h @@ -1,5 +1,5 @@ /* - * $Id: bytecode.h,v 1.11 2005-09-30 12:19:00 bacon Exp $ + * $Id: bytecode.h,v 1.12 2005-10-02 15:45:09 bacon Exp $ */ #ifndef _XP_STX_BYTECODE_H_ @@ -21,7 +21,7 @@ #define STORE_RECEIVER_VARIABLE_EXTENDED 0x64 #define STORE_TEMPORARY_LOCATION_EXTENDED 0x65 -#define STORE_POP_STACK_TOP 0x67 +#define POP_STACK_TOP 0x67 #define DUPLICATE_POP_STACK_TOP 0x68 #define PUSH_ACTIVE_CONTEXT 0x69 #define PUSH_NIL 0x6A diff --git a/ase/stx/class.c b/ase/stx/class.c index 6544eec7..cbb47ccf 100644 --- a/ase/stx/class.c +++ b/ase/stx/class.c @@ -1,5 +1,5 @@ /* - * $Id: class.c,v 1.26 2005-10-02 10:44:49 bacon Exp $ + * $Id: class.c,v 1.27 2005-10-02 15:45:09 bacon Exp $ */ #include @@ -113,15 +113,14 @@ xp_word_t xp_stx_lookup_class_variable ( return stx->nil; } -xp_word_t xp_stx_lookup_method ( - xp_stx_t* stx, xp_word_t class_index, const xp_char_t* name) +xp_word_t xp_stx_lookup_method (xp_stx_t* stx, + xp_word_t class_index, const xp_char_t* name, xp_bool_t from_super) { xp_stx_class_t* class_obj; class_obj = (xp_stx_class_t*)XP_STX_OBJECT(stx, class_index); xp_assert (class_obj != XP_NULL); - /* TODO: can a metaclass have class variables? */ #if 0 if (class_obj->header.class != stx->class_metaclass && class_obj->methods != stx->nil) { @@ -143,11 +142,16 @@ xp_word_t xp_stx_lookup_method ( while (class_index != stx->nil) { class_obj = (xp_stx_class_t*)XP_STX_OBJECT(stx, class_index); - xp_assert (class_obj != XP_NULL); - /* TODO: check if this condition is ok */ - if (class_obj->header.class != stx->class_metaclass && - class_obj->methods != stx->nil) { + xp_assert (class_obj != XP_NULL); + xp_assert ( + class_obj->header.class == stx->class_metaclass || + XP_STX_CLASS(stx,class_obj->header.class) == stx->class_metaclass); + + if (from_super) { + from_super = xp_false; + } + else if (class_obj->methods != stx->nil) { xp_word_t assoc; assoc = xp_stx_dict_lookup(stx, class_obj->methods, name); if (assoc != stx->nil) { diff --git a/ase/stx/class.h b/ase/stx/class.h index 5d814305..7fa6f008 100644 --- a/ase/stx/class.h +++ b/ase/stx/class.h @@ -1,5 +1,5 @@ /* - * $Id: class.h,v 1.14 2005-09-11 15:15:35 bacon Exp $ + * $Id: class.h,v 1.15 2005-10-02 15:45:09 bacon Exp $ */ #ifndef _XP_STX_CLASS_H_ @@ -71,8 +71,8 @@ int xp_stx_get_instance_variable_index ( xp_word_t xp_stx_lookup_class_variable ( xp_stx_t* stx, xp_word_t class_index, const xp_char_t* name); -xp_word_t xp_stx_lookup_method ( - xp_stx_t* stx, xp_word_t class_index, const xp_char_t* name); +xp_word_t xp_stx_lookup_method (xp_stx_t* stx, + xp_word_t class_index, const xp_char_t* name, xp_bool_t from_super); #ifdef __cplusplus } diff --git a/ase/stx/interp.c b/ase/stx/interp.c index 4706ca31..d6cba902 100644 --- a/ase/stx/interp.c +++ b/ase/stx/interp.c @@ -1,5 +1,5 @@ /* - * $Id: interp.c,v 1.18 2005-10-02 10:44:49 bacon Exp $ + * $Id: interp.c,v 1.19 2005-10-02 15:45:09 bacon Exp $ */ #include @@ -149,6 +149,13 @@ static int __run_process (xp_stx_t* stx, process_t* proc) /* TODO: more here .... */ + else if (code == 0x67) { + /* pop stack top */ + proc->stack_top--; + } + + /* TODO: more here .... */ + else if (code == 0x6A) { proc->stack[proc->stack_top++] = stx->nil; } @@ -266,8 +273,9 @@ static int __send_message (xp_stx_t* stx, process_t* proc, xp_assert (XP_STX_CLASS(stx,selector) == stx->class_symbol); receiver = proc->stack[proc->stack_top - nargs - 1]; - method = xp_stx_lookup_method (stx, - XP_STX_CLASS(stx,receiver), XP_STX_DATA(stx,selector)); + method = xp_stx_lookup_method ( + stx, XP_STX_CLASS(stx,receiver), + XP_STX_DATA(stx,selector), to_super); if (method == stx->nil) { xp_printf (XP_TEXT("cannot find the method....\n")); return -1; @@ -363,6 +371,9 @@ static int __dispatch_primitive (xp_stx_t* stx, process_t* proc, xp_word_t no) XP_STX_FROM_SMALLINT(proc->stack[proc->stack_base + 1]), XP_STX_FROM_SMALLINT(proc->stack[proc->stack_base + 2])); break; + case 20: + xp_printf (XP_TEXT("<< PRIMITIVE 20 >>\n")); + break; } return 0; diff --git a/ase/stx/parser.c b/ase/stx/parser.c index 26569f39..ce125cba 100644 --- a/ase/stx/parser.c +++ b/ase/stx/parser.c @@ -1,5 +1,5 @@ /* - * $Id: parser.c,v 1.77 2005-10-02 10:44:49 bacon Exp $ + * $Id: parser.c,v 1.78 2005-10-02 15:45:09 bacon Exp $ */ #include @@ -826,6 +826,7 @@ static int __parse_expression (xp_stx_parser_t* parser) * ::= identifier * assignmentOperator ::= ':=' */ + xp_stx_t* stx = parser->stx; if (parser->token.type == XP_STX_TOKEN_IDENT) { xp_char_t* ident = xp_stx_token_yield (&parser->token, 0); diff --git a/ase/test/stx/parser.c b/ase/test/stx/parser.c index 0dc4dc2d..b142c4bc 100644 --- a/ase/test/stx/parser.c +++ b/ase/test/stx/parser.c @@ -153,7 +153,8 @@ int xp_main (int argc, xp_char_t* argv[]) goto exit_program; } - if (xp_stx_parser_parse_method (&parser, n, + /* compile the method to n's class */ + if (xp_stx_parser_parse_method (&parser, XP_STX_CLASS(&stx,n), (void*)XP_TEXT("test.st")) == -1) { xp_printf (XP_TEXT("parser error <%s>\n"), xp_stx_parser_error_string (&parser)); @@ -171,8 +172,14 @@ int xp_main (int argc, xp_char_t* argv[]) xp_stx_parser_error_string (&parser)); } + if (xp_stx_parser_parse_method (&parser, stx.class_string, + (void*)XP_TEXT("test3.st")) == -1) { + xp_printf (XP_TEXT("parser error <%s>\n"), + xp_stx_parser_error_string (&parser)); + } + xp_printf (XP_TEXT("\n== Decoded Methods ==\n")); - if (xp_stx_decode(&stx, n) == -1) { + if (xp_stx_decode(&stx, XP_STX_CLASS(&stx,n)) == -1) { xp_printf (XP_TEXT("parser error <%s>\n"), xp_stx_parser_error_string (&parser)); } @@ -183,8 +190,15 @@ int xp_main (int argc, xp_char_t* argv[]) xp_stx_parser_error_string (&parser)); } + xp_printf (XP_TEXT("\n== Decoded Methods for String ==\n")); + if (xp_stx_decode(&stx, stx.class_string) == -1) { + xp_printf (XP_TEXT("parser error <%s>\n"), + xp_stx_parser_error_string (&parser)); + } + xp_printf (XP_TEXT("== Running the main method ==\n")); - m = xp_stx_lookup_method (&stx, n, XP_TEXT("main")); + m = xp_stx_lookup_method ( + &stx, XP_STX_CLASS(&stx,n), XP_TEXT("main"), xp_false); if (m == stx.nil) { xp_printf (XP_TEXT("cannot lookup method main\n")); } diff --git a/ase/test/stx/test.st b/ase/test/stx/test.st index 6b8f670e..d3dbeb00 100644 --- a/ase/test/stx/test.st +++ b/ase/test/stx/test.st @@ -9,6 +9,5 @@ main a := #abc print: 123 and: 2345. #abc print: a and: a. - super print: a and: a. 1234567. ^nil. diff --git a/ase/test/stx/test1.st b/ase/test/stx/test1.st index c3974a73..d2e24b72 100644 --- a/ase/test/stx/test1.st +++ b/ase/test/stx/test1.st @@ -4,5 +4,6 @@ print: a1 and: a2 t1 := #abcdefg. "a1 := 2341 arguments are not assignable" t1 prim2: a2. - self prim2: 2189. + super prim2: 999999. + self prim2: 999999. ^67891. diff --git a/ase/test/stx/test3.st b/ase/test/stx/test3.st new file mode 100644 index 00000000..4f9eb9b0 --- /dev/null +++ b/ase/test/stx/test3.st @@ -0,0 +1,2 @@ +prim2: n +