home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1991
/
09
/
bob.lst
< prev
next >
Wrap
File List
|
1991-08-21
|
16KB
|
668 lines
_YOUR OWN TINY OBJECT-ORIENTED LANGUAGE_
by David Betz
[LISTING ONE]
/* bobint.c - bytecode interpreter */
/*
Copyright (c) 1991, by David Michael Betz
All rights reserved
*/
#include <setjmp.h>
#include "bob.h"
#define iszero(x) ((x)->v_type == DT_INTEGER && (x)->v.v_integer == 0)
#define istrue(x) ((x)->v_type != DT_NIL && !iszero(x))
/* global variables */
VALUE *stkbase; /* the runtime stack */
VALUE *stktop; /* the top of the stack */
VALUE *sp; /* the stack pointer */
VALUE *fp; /* the frame pointer */
int trace=0; /* variable to control tracing */
/* external variables */
extern DICTIONARY *symbols;
extern jmp_buf error_trap;
/* local variables */
static unsigned char *cbase; /* the base code address */
static unsigned char *pc; /* the program counter */
static VALUE *code; /* the current code vector */
/* forward declarations */
char *typename();
/* execute - execute a bytecode function */
int execute(name)
char *name;
{
DICT_ENTRY *sym;
/* setup an error trap handler */
if (setjmp(error_trap) != 0)
return (FALSE);
/* lookup the symbol */
if ((sym = findentry(symbols,name)) == NULL)
return (FALSE);
/* dispatch on its data type */
switch (sym->de_value.v_type) {
case DT_CODE:
(*sym->de_value.v.v_code)(0);
break;è case DT_BYTECODE:
interpret(sym->de_value.v.v_bytecode);
break;
}
return (TRUE);
}
/* interpret - interpret bytecode instructions */
int interpret(fcn)
VALUE *fcn;
{
register int pcoff,n;
register VALUE *obj;
VALUE *topframe,val;
STRING *s1,*s2,*sn;
/* initialize */
sp = fp = stktop;
cbase = pc = fcn[1].v.v_string->s_data;
code = fcn;
/* make a dummy call frame */
check(4);
push_bytecode(code);
push_integer(0);
push_integer(0);
push_integer(0);
fp = topframe = sp;
/* execute each instruction */
for (;;) {
if (trace)
decode_instruction(code,pc-code[1].v.v_string->s_data);
switch (*pc++) {
case OP_CALL:
n = *pc++;
switch (sp[n].v_type) {
case DT_CODE:
(*sp[n].v.v_code)(n);
break;
case DT_BYTECODE:
check(3);
code = sp[n].v.v_bytecode;
push_integer(n);
push_integer(stktop - fp);
push_integer(pc - cbase);
cbase = pc = code[1].v.v_string->s_data;
fp = sp;
break;
default:
error("Call to non-procedure, Type %s",
typename(sp[n].v_type));
return;
}
break;è case OP_RETURN:
if (fp == topframe) return;
val = *sp;
sp = fp;
pcoff = fp[0].v.v_integer;
n = fp[2].v.v_integer;
fp = stktop - fp[1].v.v_integer;
code = fp[fp[2].v.v_integer+3].v.v_bytecode;
cbase = code[1].v.v_string->s_data;
pc = cbase + pcoff;
sp += n + 3;
*sp = val;
break;
case OP_REF:
*sp = code[*pc++].v.v_var->de_value;
break;
case OP_SET:
code[*pc++].v.v_var->de_value = *sp;
break;
case OP_VREF:
chktype(0,DT_INTEGER);
switch (sp[1].v_type) {
case DT_VECTOR: vectorref(); break;
case DT_STRING: stringref(); break;
default: badtype(1,DT_VECTOR); break;
}
break;
case OP_VSET:
chktype(1,DT_INTEGER);
switch (sp[2].v_type) {
case DT_VECTOR: vectorset(); break;
case DT_STRING: stringset(); break;
default: badtype(1,DT_VECTOR); break;
}
break;
case OP_MREF:
obj = fp[fp[2].v.v_integer+2].v.v_object;
*sp = obj[*pc++];
break;
case OP_MSET:
obj = fp[fp[2].v.v_integer+2].v.v_object;
obj[*pc++] = *sp;
break;
case OP_AREF:
n = *pc++;
if (n >= fp[2].v.v_integer)
error("Too few arguments");
*sp = fp[n+3];
break;
case OP_ASET:
n = *pc++;
if (n >= fp[2].v.v_integer)
error("Too few arguments");
fp[n+3] = *sp;
break;è case OP_TREF:
n = *pc++;
*sp = fp[-n-1];
break;
case OP_TSET:
n = *pc++;
fp[-n-1] = *sp;
break;
case OP_TSPACE:
n = *pc++;
check(n);
while (--n >= 0) {
--sp;
set_nil(sp);
}
break;
case OP_BRT:
if (istrue(sp))
pc = cbase + getwoperand();
else
pc += 2;
break;
case OP_BRF:
if (istrue(sp))
pc += 2;
else
pc = cbase + getwoperand();
break;
case OP_BR:
pc = cbase + getwoperand();
break;
case OP_NIL:
set_nil(sp);
break;
case OP_PUSH:
check(1);
push_integer(FALSE);
break;
case OP_NOT:
if (istrue(sp))
set_integer(sp,FALSE);
else
set_integer(sp,TRUE);
break;
case OP_NEG:
chktype(0,DT_INTEGER);
sp->v.v_integer = -sp->v.v_integer;
break;
case OP_ADD:
switch (sp[1].v_type) {
case DT_INTEGER:
switch (sp[0].v_type) {
case DT_INTEGER:
sp[1].v.v_integer += sp->v.v_integer;
break;è case DT_STRING:
s2 = sp[0].v.v_string;
sn = newstring(1 + s2->s_length);
sn->s_data[0] = sp[1].v.v_integer;
memcpy(&sn->s_data[1],
s2->s_data,
s2->s_length);
set_string(&sp[1],sn);
break;
default:
break;
}
break;
case DT_STRING:
s1 = sp[1].v.v_string;
switch (sp[0].v_type) {
case DT_INTEGER:
sn = newstring(s1->s_length + 1);
memcpy(sn->s_data,
s1->s_data,
s1->s_length);
sn->s_data[s1->s_length] = sp[0].v.v_integer;
set_string(&sp[1],sn);
break;
case DT_STRING:
s2 = sp[0].v.v_string;
sn = newstring(s1->s_length + s2->s_length);
memcpy(sn->s_data,
s1->s_data,s1->s_length);
memcpy(&sn->s_data[s1->s_length],
s2->s_data,s2->s_length);
set_string(&sp[1],sn);
break;
default:
break;
}
break;
default:
badtype(1,DT_VECTOR);
break;
}
++sp;
break;
case OP_SUB:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
sp[1].v.v_integer -= sp->v.v_integer;
++sp;
break;
case OP_MUL:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
sp[1].v.v_integer *= sp->v.v_integer;
++sp;
break;è case OP_DIV:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
if (sp->v.v_integer != 0) {
int x=sp->v.v_integer;
sp[1].v.v_integer /= x;
}
else
sp[1].v.v_integer = 0;
++sp;
break;
case OP_REM:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
if (sp->v.v_integer != 0) {
int x=sp->v.v_integer;
sp[1].v.v_integer %= x;
}
else
sp[1].v.v_integer = 0;
++sp;
break;
case OP_INC:
chktype(0,DT_INTEGER);
++sp->v.v_integer;
break;
case OP_DEC:
chktype(0,DT_INTEGER);
--sp->v.v_integer;
break;
case OP_BAND:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
sp[1].v.v_integer &= sp->v.v_integer;
++sp;
break;
case OP_BOR:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
sp[1].v.v_integer |= sp->v.v_integer;
++sp;
break;
case OP_XOR:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
sp[1].v.v_integer ^= sp->v.v_integer;
++sp;
break;
case OP_BNOT:
chktype(0,DT_INTEGER);
sp->v.v_integer = ~sp->v.v_integer;
break;
case OP_SHL:
switch (sp[1].v_type) {
case DT_INTEGER:è chktype(0,DT_INTEGER);
sp[1].v.v_integer <<= sp->v.v_integer;
break;
case DT_FILE:
print1(sp[1].v.v_fp,FALSE,&sp[0]);
break;
default:
break;
}
++sp;
break;
case OP_SHR:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
sp[1].v.v_integer >>= sp->v.v_integer;
++sp;
break;
case OP_LT:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
n = sp[1].v.v_integer < sp->v.v_integer;
++sp;
set_integer(sp,n ? TRUE : FALSE);
break;
case OP_LE:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
n = sp[1].v.v_integer <= sp->v.v_integer;
++sp;
set_integer(sp,n ? TRUE : FALSE);
break;
case OP_EQ:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
n = sp[1].v.v_integer == sp->v.v_integer;
++sp;
set_integer(sp,n ? TRUE : FALSE);
break;
case OP_NE:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
n = sp[1].v.v_integer != sp->v.v_integer;
++sp;
set_integer(sp,n ? TRUE : FALSE);
break;
case OP_GE:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);
n = sp[1].v.v_integer >= sp->v.v_integer;
++sp;
set_integer(sp,n ? TRUE : FALSE);
break;
case OP_GT:
chktype(0,DT_INTEGER);
chktype(1,DT_INTEGER);è n = sp[1].v.v_integer > sp->v.v_integer;
++sp;
set_integer(sp,n ? TRUE : FALSE);
break;
case OP_LIT:
*sp = code[*pc++];
break;
case OP_SEND:
n = *pc++;
chktype(n,DT_OBJECT);
send(n);
break;
case OP_DUP2:
check(2);
sp -= 2;
*sp = sp[2];
sp[1] = sp[3];
break;
case OP_NEW:
chktype(0,DT_CLASS);
set_object(sp,newobject(sp->v.v_class));
break;
default:
info("Bad opcode %02x",pc[-1]);
break;
}
}
}
/* send - send a message to an object */
static send(n)
int n;
{
char selector[TKNSIZE+1];
DICT_ENTRY *de;
CLASS *class;
class = sp[n].v.v_object[OB_CLASS].v.v_class;
getcstring(selector,sizeof(selector),sp[n-1].v.v_string);
sp[n-1] = sp[n];
do {
if ((de = findentry(class->cl_functions,selector)) != NULL) {
switch (de->de_value.v_type) {
case DT_CODE:
(*de->de_value.v.v_code)(n);
return;
case DT_BYTECODE:
check(3);
code = de->de_value.v.v_bytecode;
set_bytecode(&sp[n],code);
push_integer(n);
push_integer(stktop - fp);
push_integer(pc - cbase);
cbase = pc = code[1].v.v_string->s_data;
fp = sp;
return;è default:
error("Bad method, Selector '%s', Type %d",
selector,
de->de_value.v_type);
}
}
} while ((class = class->cl_base) != NULL);
nomethod(selector);
}
/* vectorref - load a vector element */
static vectorref()
{
VALUE *vect;
int i;
vect = sp[1].v.v_vector;
i = sp[0].v.v_integer;
if (i < 0 || i >= vect[0].v.v_integer)
error("subscript out of bounds");
sp[1] = vect[i+1];
++sp;
}
/* vectorset - set a vector element */
static vectorset()
{
VALUE *vect;
int i;
vect = sp[2].v.v_vector;
i = sp[1].v.v_integer;
if (i < 0 || i >= vect[0].v.v_integer)
error("subscript out of bounds");
vect[i+1] = sp[2] = *sp;
sp += 2;
}
/* stringref - load a string element */
static stringref()
{
STRING *str;
int i;
str = sp[1].v.v_string;
i = sp[0].v.v_integer;
if (i < 0 || i >= str->s_length)
error("subscript out of bounds");
set_integer(&sp[1],str->s_data[i]);
++sp;
}
/* stringset - set a string element */
static stringset()
{
STRING *str;
int i;
chktype(0,DT_INTEGER);è str = sp[2].v.v_string;
i = sp[1].v.v_integer;
if (i < 0 || i >= str->s_length)
error("subscript out of bounds");
str->s_data[i] = sp[0].v.v_integer;
set_integer(&sp[2],str->s_data[i]);
sp += 2;
}
/* getwoperand - get data word */
static int getwoperand()
{
int b;
b = *pc++;
return ((*pc++ << 8) | b);
}
/* type names */
static char *tnames[] = {
"NIL","CLASS","OBJECT","VECTOR","INTEGER","STRING","BYTECODE",
"CODE","VAR","FILE"
};
/* typename - get the name of a type */
static char *typename(type)
int type;
{
static char buf[20];
if (type >= _DTMIN && type <= _DTMAX)
return (tnames[type]);
sprintf(buf,"(%d)",type);
return (buf);
}
/* badtype - report a bad operand type */
badtype(off,type)
int off,type;
{
char tn1[20];
strcpy(tn1,typename(sp[off].v_type));
info("PC: %04x, Offset %d, Type %s, Expected %s",
pc-cbase,off,tn1,typename(type));
error("Bad argument type");
}
/* nomethod - report a failure to find a method for a selector */
static nomethod(selector)
char *selector;
{
error("No method for selector '%s'",selector);
}
/* stackover - report a stack overflow error */
stackover()
{è error("Stack overflow");
}
Examplσ 1║
(a⌐
factorial(n)
{
return n == 1 ? 1 : n * factorial(n-1);
}
(b⌐
main(; i)
{
for (i = 1; i <= 10; ++i)
print(i," factorial is ",factorial(i),"\n");
}
Examplσ 2:
(a⌐ ┴ BoΓ clas≤ definition
clas≤ foo
{
a,b;
statiπ last;
statiπ get_last();
}
(b⌐
foo::foo(aa,bb)
{
a == aa; b = bb;
last = this;
return this;
}
Examplσ 3:è
(a)
foo::get_a()
{
return a;
}
(b)
foo::set_a(aa)
{
a = aa;
}
(c)
foo::count(; i)
{
for (i = a; i <= b; ++i)
print(i,"\n");
}
main(; foo1,foo2)
{
foo1 = new foo(1,2); // create a object of class foo
foo2 = new foo(11,22); // and another
print("foo1 counting\n"); // ask the first to count
foo1->count();
print("foo2 counting\n"); // ask the second to count
foo2->count();
}
Examplσ 4:
(a)
class bar : foo // a class derived from foo
{
c;
}
(b)
bar::bar(aa,bb,cc)
{
this->foo(aa,bb);
return this;
}è
Examplσ 5
typedef struct value {
int v_type; /* data type */
union { /* value */
struct class *v_class;
struct value *v_object;
struct value *v_vector;
struct string *v_string;
struct value *v_bytecode;
struct dict_entry *v_var;
int (*v_code)();
long v_integer;
} v;
} VALUE;