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

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan 2005-10-02 10:44:49 +00:00
parent b48829f1af
commit 281207ab33
5 changed files with 47 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ase/stx/bytecode.c
View File

@ -1,5 +1,5 @@
/*
* $Id: bytecode.c,v 1.14 2005-09-30 12:19:00 bacon Exp $
* $Id: bytecode.c,v 1.15 2005-10-02 10:44:49 bacon Exp $
*/
#include <xp/stx/bytecode.h>
#include <xp/stx/class.h>
@ -159,13 +159,13 @@ static int __decode2 (xp_stx_t* stx,
}
else if (code >= 0x70 && code <= 0x71 ) {
/* send */
/* send message */
next = bytecodes->data[pc++];
xp_printf (XP_TEXT("%s nargs(%d) selector(%d)\n"),
send_opcode_names[code - 0x70], next >> 5, next & 0x1F);
}
else if (code >= 0x72 && code <= 0x73 ) {
/* send extended */
/* send message extended */
next = bytecodes->data[pc++];
next2 = bytecodes->data[pc++];
xp_printf (XP_TEXT("%s %d %d\n"),

27
ase/stx/class.c
View File

@ -1,5 +1,5 @@
/*
* $Id: class.c,v 1.25 2005-09-11 15:43:14 bacon Exp $
* $Id: class.c,v 1.26 2005-10-02 10:44:49 bacon Exp $
*/
#include <xp/stx/class.h>
@ -121,11 +121,12 @@ xp_word_t xp_stx_lookup_method (
class_obj = (xp_stx_class_t*)XP_STX_OBJECT(stx, class_index);
xp_assert (class_obj != XP_NULL);
/* TODO: can a metaclas have class variables? */
/* TODO: can a metaclass have class variables? */
#if 0
if (class_obj->header.class != stx->class_metaclass &&
class_obj->methods != stx->nil) {
xp_word_t assoc;
assoc = xp_stx_dict_lookup(stx, class_obj->methods,name);
assoc = xp_stx_dict_lookup(stx, class_obj->methods, name);
if (assoc != stx->nil) {
xp_assert (XP_STX_CLASS(stx,assoc) == stx->class_association);
return XP_STX_WORD_AT(stx, assoc, XP_STX_ASSOCIATION_VALUE);
@ -138,6 +139,26 @@ xp_word_t xp_stx_lookup_method (
stx, class_obj->superclass, name);
if (tmp != stx->nil) return tmp;
}
#endif
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_word_t assoc;
assoc = xp_stx_dict_lookup(stx, class_obj->methods, name);
if (assoc != stx->nil) {
xp_assert (XP_STX_CLASS(stx,assoc) == stx->class_association);
return XP_STX_WORD_AT(stx, assoc, XP_STX_ASSOCIATION_VALUE);
}
}
class_index = class_obj->superclass;
}
return stx->nil;
}

35
ase/stx/interp.c
View File

@ -1,5 +1,5 @@
/*
* $Id: interp.c,v 1.17 2005-10-01 05:33:06 bacon Exp $
* $Id: interp.c,v 1.18 2005-10-02 10:44:49 bacon Exp $
*/
#include <xp/stx/interp.h>
@ -61,8 +61,8 @@ static int __push_to_stack (xp_stx_t* stx,
process_t* proc, xp_word_t what, xp_word_t index);
static int __store_from_stack (xp_stx_t* stx,
process_t* proc, xp_word_t what, xp_word_t index);
static int __send_to_self (xp_stx_t* stx,
process_t* proc, xp_word_t nargs, xp_word_t selector);
static int __send_message (xp_stx_t* stx, process_t* proc,
xp_word_t nargs, xp_word_t selector, xp_bool_t to_super);
static int __return_from_message (xp_stx_t* stx, process_t* proc);
static int __dispatch_primitive (xp_stx_t* stx, process_t* proc, xp_word_t no);
@ -166,31 +166,30 @@ static int __run_process (xp_stx_t* stx, process_t* proc)
/* TODO: more here .... */
else if (code == 0x70) {
/* send message to self */
next = proc->bytecodes[proc->pc++];
//xp_printf (XP_TEXT("%d, %d\n"), next >> 5, next & 0x1F);
if (__send_to_self (stx, proc,
next >> 5, proc->literals[next & 0x1F]) == -1) break;
//xp_printf (XP_TEXT("done %d, %d\n"), next >> 5, next & 0x1F);
if (__send_message (stx, proc, next >> 5,
proc->literals[next & 0x1F], xp_false) == -1) break;
}
else if (code == 0x71) {
/* send to super */
/* send message to super */
next = proc->bytecodes[proc->pc++];
//if (__send_to_super (stx, proc,
// next >> 5, proc->literals[next & 0x1F]) == -1) break;
if (__send_message (stx, proc, next >> 5,
proc->literals[next & 0x1F], xp_true) == -1) break;
}
else if (code == 0x72) {
/* send to self extended */
/* send message to self extended */
next = proc->bytecodes[proc->pc++];
next2 = proc->bytecodes[proc->pc++];
if (__send_to_self (stx, proc,
next >> 5, proc->literals[next2]) == -1) break;
if (__send_message (stx, proc, next >> 5,
proc->literals[next2], xp_false) == -1) break;
}
else if (code == 0x73) {
/* send to super extended */
/* send message to super extended */
next = proc->bytecodes[proc->pc++];
next2 = proc->bytecodes[proc->pc++];
//__send_to_super (stx,
// proc, next >> 5, proc->literals[next2]);
if (__send_message (stx, proc, next >> 5,
proc->literals[next2], xp_true) == -1) break;
}
/* more code .... */
@ -257,8 +256,8 @@ static int __store_from_stack (xp_stx_t* stx,
return 0;
}
static int __send_to_self (xp_stx_t* stx,
process_t* proc, xp_word_t nargs, xp_word_t selector)
static int __send_message (xp_stx_t* stx, process_t* proc,
xp_word_t nargs, xp_word_t selector, xp_bool_t to_super)
{
xp_word_t receiver, method;
xp_word_t i, tmpcount, argcount;

4
ase/stx/parser.c
View File

@ -1,5 +1,5 @@
/*
* $Id: parser.c,v 1.76 2005-10-01 16:48:44 bacon Exp $
* $Id: parser.c,v 1.77 2005-10-02 10:44:49 bacon Exp $
*/
#include <xp/stx/parser.h>
@ -356,7 +356,7 @@ static INLINE int __emit_send_to_self (
}
static INLINE int __emit_send_to_super (
xp_stx_parser_t* parser, int selector, int nargs)
xp_stx_parser_t* parser, int nargs, int selector)
{
xp_assert (nargs >= 0x00 && nargs <= 0xFF);
xp_assert (selector >= 0x00 && selector <= 0xFF);

2
ase/test/stx/test.st
View File

@ -9,6 +9,6 @@ main
a := #abc print: 123 and: 2345.
#abc print: a and: a.
"super print: a and: a."
super print: a and: a.
1234567.
^nil.