home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1991 / 09 / bob / bobint.c < prev    next >
Text File  |  1991-07-11  |  12KB  |  540 lines
  1. /* bobint.c - bytecode interpreter */
  2. /*
  3.     Copyright (c) 1991, by David Michael Betz
  4.     All rights reserved
  5. */
  6.  
  7. #include <setjmp.h>
  8. #include "bob.h"
  9.  
  10. #define iszero(x)    ((x)->v_type == DT_INTEGER && (x)->v.v_integer == 0)
  11. #define istrue(x)    ((x)->v_type != DT_NIL && !iszero(x))
  12.  
  13. /* global variables */
  14. VALUE *stkbase;        /* the runtime stack */
  15. VALUE *stktop;        /* the top of the stack */
  16. VALUE *sp;        /* the stack pointer */
  17. VALUE *fp;        /* the frame pointer */
  18. int trace=0;        /* variable to control tracing */
  19.  
  20. /* external variables */
  21. extern DICTIONARY *symbols;
  22. extern jmp_buf error_trap;
  23.  
  24. /* local variables */
  25. static unsigned char *cbase;    /* the base code address */
  26. static unsigned char *pc;    /* the program counter */
  27. static VALUE *code;        /* the current code vector */
  28.  
  29. /* forward declarations */
  30. char *typename();
  31.  
  32. /* execute - execute a bytecode function */
  33. int execute(name)
  34.   char *name;
  35. {
  36.     DICT_ENTRY *sym;
  37.     
  38.     /* setup an error trap handler */
  39.     if (setjmp(error_trap) != 0)
  40.     return (FALSE);
  41.  
  42.     /* lookup the symbol */
  43.     if ((sym = findentry(symbols,name)) == NULL)
  44.     return (FALSE);
  45.  
  46.     /* dispatch on its data type */
  47.     switch (sym->de_value.v_type) {
  48.     case DT_CODE:
  49.     (*sym->de_value.v.v_code)(0);
  50.     break;
  51.     case DT_BYTECODE:
  52.     interpret(sym->de_value.v.v_bytecode);
  53.     break;
  54.     }
  55.     return (TRUE);
  56. }
  57.  
  58. /* interpret - interpret bytecode instructions */
  59. int interpret(fcn)
  60.   VALUE *fcn;
  61. {
  62.     register int pcoff,n;
  63.     register VALUE *obj;
  64.     VALUE *topframe,val;
  65.     STRING *s1,*s2,*sn;
  66.     
  67.     /* initialize */
  68.     sp = fp = stktop;
  69.     cbase = pc = fcn[1].v.v_string->s_data;
  70.     code = fcn;
  71.  
  72.     /* make a dummy call frame */
  73.     check(4);
  74.     push_bytecode(code);
  75.     push_integer(0);
  76.     push_integer(0);
  77.     push_integer(0);
  78.     fp = topframe = sp;
  79.     
  80.     /* execute each instruction */
  81.     for (;;) {
  82.     if (trace)
  83.         decode_instruction(code,pc-code[1].v.v_string->s_data);
  84.     switch (*pc++) {
  85.     case OP_CALL:
  86.         n = *pc++;
  87.         switch (sp[n].v_type) {
  88.         case DT_CODE:
  89.             (*sp[n].v.v_code)(n);
  90.             break;
  91.         case DT_BYTECODE:
  92.             check(3);
  93.             code = sp[n].v.v_bytecode;
  94.             push_integer(n);
  95.             push_integer(stktop - fp);
  96.             push_integer(pc - cbase);
  97.             cbase = pc = code[1].v.v_string->s_data;
  98.             fp = sp;
  99.             break;
  100.         default:
  101.             error("Call to non-procedure, Type %s",
  102.               typename(sp[n].v_type));
  103.             return;
  104.         }
  105.         break;
  106.     case OP_RETURN:
  107.         if (fp == topframe) return;
  108.         val = *sp;
  109.         sp = fp;
  110.         pcoff = fp[0].v.v_integer;
  111.         n = fp[2].v.v_integer;
  112.         fp = stktop - fp[1].v.v_integer;
  113.         code = fp[fp[2].v.v_integer+3].v.v_bytecode;
  114.         cbase = code[1].v.v_string->s_data;
  115.         pc = cbase + pcoff;
  116.         sp += n + 3;
  117.         *sp = val;
  118.         break;
  119.     case OP_REF:
  120.         *sp = code[*pc++].v.v_var->de_value;
  121.         break;
  122.     case OP_SET:
  123.         code[*pc++].v.v_var->de_value = *sp;
  124.         break;
  125.     case OP_VREF:
  126.         chktype(0,DT_INTEGER);
  127.         switch (sp[1].v_type) {
  128.         case DT_VECTOR: vectorref(); break;
  129.         case DT_STRING: stringref(); break;
  130.         default:    badtype(1,DT_VECTOR); break;
  131.         }
  132.         break;
  133.     case OP_VSET:
  134.         chktype(1,DT_INTEGER);
  135.         switch (sp[2].v_type) {
  136.         case DT_VECTOR: vectorset(); break;
  137.         case DT_STRING: stringset(); break;
  138.         default:    badtype(1,DT_VECTOR); break;
  139.         }
  140.         break;
  141.     case OP_MREF:
  142.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  143.         *sp = obj[*pc++];
  144.         break;
  145.     case OP_MSET:
  146.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  147.         obj[*pc++] = *sp;
  148.         break;
  149.     case OP_AREF:
  150.         n = *pc++;
  151.         if (n >= fp[2].v.v_integer)
  152.             error("Too few arguments");
  153.         *sp = fp[n+3];
  154.         break;
  155.     case OP_ASET:
  156.         n = *pc++;
  157.         if (n >= fp[2].v.v_integer)
  158.             error("Too few arguments");
  159.         fp[n+3] = *sp;
  160.         break;
  161.     case OP_TREF:
  162.         n = *pc++;
  163.         *sp = fp[-n-1];
  164.         break;
  165.     case OP_TSET:
  166.         n = *pc++;
  167.         fp[-n-1] = *sp;
  168.         break;
  169.     case OP_TSPACE:
  170.         n = *pc++;
  171.         check(n);
  172.         while (--n >= 0) {
  173.             --sp;
  174.             set_nil(sp);
  175.         }
  176.         break;
  177.     case OP_BRT:
  178.         if (istrue(sp))
  179.             pc = cbase + getwoperand();
  180.         else
  181.             pc += 2;
  182.         break;
  183.     case OP_BRF:
  184.         if (istrue(sp))
  185.             pc += 2;
  186.         else
  187.             pc = cbase + getwoperand();
  188.         break;
  189.     case OP_BR:
  190.         pc = cbase + getwoperand();
  191.         break;
  192.     case OP_NIL:
  193.         set_nil(sp);
  194.         break;
  195.     case OP_PUSH:
  196.         check(1);
  197.         push_integer(FALSE);
  198.         break;
  199.     case OP_NOT:
  200.         if (istrue(sp))
  201.             set_integer(sp,FALSE);
  202.         else
  203.             set_integer(sp,TRUE);
  204.         break;
  205.     case OP_NEG:
  206.         chktype(0,DT_INTEGER);
  207.         sp->v.v_integer = -sp->v.v_integer;
  208.         break;
  209.     case OP_ADD:
  210.         switch (sp[1].v_type) {
  211.         case DT_INTEGER:
  212.             switch (sp[0].v_type) {
  213.             case DT_INTEGER:
  214.             sp[1].v.v_integer += sp->v.v_integer;
  215.             break;
  216.             case DT_STRING:
  217.             s2 = sp[0].v.v_string;
  218.             sn = newstring(1 + s2->s_length);
  219.             sn->s_data[0] = sp[1].v.v_integer;
  220.             memcpy(&sn->s_data[1],
  221.                    s2->s_data,
  222.                    s2->s_length);
  223.             set_string(&sp[1],sn);
  224.             break;
  225.             default:
  226.             break;
  227.             }
  228.             break;
  229.         case DT_STRING:
  230.             s1 = sp[1].v.v_string;
  231.             switch (sp[0].v_type) {
  232.             case DT_INTEGER:
  233.             sn = newstring(s1->s_length + 1);
  234.             memcpy(sn->s_data,
  235.                    s1->s_data,
  236.                    s1->s_length);
  237.             sn->s_data[s1->s_length] = sp[0].v.v_integer;
  238.             set_string(&sp[1],sn);
  239.             break;
  240.             case DT_STRING:
  241.             s2 = sp[0].v.v_string;
  242.             sn = newstring(s1->s_length + s2->s_length);
  243.             memcpy(sn->s_data,
  244.                    s1->s_data,s1->s_length);
  245.             memcpy(&sn->s_data[s1->s_length],
  246.                    s2->s_data,s2->s_length);
  247.             set_string(&sp[1],sn);
  248.             break;
  249.             default:
  250.             break;
  251.             }
  252.             break;
  253.         default:
  254.             badtype(1,DT_VECTOR);
  255.             break;
  256.         }
  257.         ++sp;
  258.         break;
  259.     case OP_SUB:
  260.         chktype(0,DT_INTEGER);
  261.         chktype(1,DT_INTEGER);
  262.         sp[1].v.v_integer -= sp->v.v_integer;
  263.         ++sp;
  264.         break;
  265.     case OP_MUL:
  266.         chktype(0,DT_INTEGER);
  267.         chktype(1,DT_INTEGER);
  268.         sp[1].v.v_integer *= sp->v.v_integer;
  269.         ++sp;
  270.         break;
  271.     case OP_DIV:
  272.         chktype(0,DT_INTEGER);
  273.         chktype(1,DT_INTEGER);
  274.         if (sp->v.v_integer != 0) {
  275.             int x=sp->v.v_integer;
  276.             sp[1].v.v_integer /= x;
  277.         }
  278.         else
  279.             sp[1].v.v_integer = 0;
  280.         ++sp;
  281.         break;
  282.     case OP_REM:
  283.         chktype(0,DT_INTEGER);
  284.         chktype(1,DT_INTEGER);
  285.         if (sp->v.v_integer != 0) {
  286.             int x=sp->v.v_integer;
  287.             sp[1].v.v_integer %= x;
  288.         }
  289.         else
  290.             sp[1].v.v_integer = 0;
  291.         ++sp;
  292.         break;
  293.     case OP_INC:
  294.         chktype(0,DT_INTEGER);
  295.         ++sp->v.v_integer;
  296.         break;
  297.     case OP_DEC:
  298.         chktype(0,DT_INTEGER);
  299.         --sp->v.v_integer;
  300.         break;
  301.     case OP_BAND:
  302.         chktype(0,DT_INTEGER);
  303.         chktype(1,DT_INTEGER);
  304.         sp[1].v.v_integer &= sp->v.v_integer;
  305.         ++sp;
  306.         break;
  307.     case OP_BOR:
  308.         chktype(0,DT_INTEGER);
  309.         chktype(1,DT_INTEGER);
  310.         sp[1].v.v_integer |= sp->v.v_integer;
  311.         ++sp;
  312.         break;
  313.     case OP_XOR:
  314.         chktype(0,DT_INTEGER);
  315.         chktype(1,DT_INTEGER);
  316.         sp[1].v.v_integer ^= sp->v.v_integer;
  317.         ++sp;
  318.         break;
  319.     case OP_BNOT:
  320.         chktype(0,DT_INTEGER);
  321.         sp->v.v_integer = ~sp->v.v_integer;
  322.         break;
  323.     case OP_SHL:
  324.         chktype(0,DT_INTEGER);
  325.         chktype(1,DT_INTEGER);
  326.         sp[1].v.v_integer <<= sp->v.v_integer;
  327.         ++sp;
  328.         break;
  329.     case OP_SHR:
  330.         chktype(0,DT_INTEGER);
  331.         chktype(1,DT_INTEGER);
  332.         sp[1].v.v_integer >>= sp->v.v_integer;
  333.         ++sp;
  334.         break;
  335.     case OP_LT:
  336.         chktype(0,DT_INTEGER);
  337.         chktype(1,DT_INTEGER);
  338.         n = sp[1].v.v_integer < sp->v.v_integer;
  339.         ++sp;
  340.         set_integer(sp,n ? TRUE : FALSE);
  341.         break;
  342.     case OP_LE:
  343.         chktype(0,DT_INTEGER);
  344.         chktype(1,DT_INTEGER);
  345.         n = sp[1].v.v_integer <= sp->v.v_integer;
  346.         ++sp;
  347.         set_integer(sp,n ? TRUE : FALSE);
  348.         break;
  349.     case OP_EQ:
  350.         chktype(0,DT_INTEGER);
  351.         chktype(1,DT_INTEGER);
  352.         n = sp[1].v.v_integer == sp->v.v_integer;
  353.         ++sp;
  354.         set_integer(sp,n ? TRUE : FALSE);
  355.         break;
  356.     case OP_NE:
  357.         chktype(0,DT_INTEGER);
  358.         chktype(1,DT_INTEGER);
  359.         n = sp[1].v.v_integer != sp->v.v_integer;
  360.         ++sp;
  361.         set_integer(sp,n ? TRUE : FALSE);
  362.         break;
  363.     case OP_GE:
  364.         chktype(0,DT_INTEGER);
  365.         chktype(1,DT_INTEGER);
  366.         n = sp[1].v.v_integer >= sp->v.v_integer;
  367.         ++sp;
  368.         set_integer(sp,n ? TRUE : FALSE);
  369.         break;
  370.     case OP_GT:
  371.         chktype(0,DT_INTEGER);
  372.         chktype(1,DT_INTEGER);
  373.         n = sp[1].v.v_integer > sp->v.v_integer;
  374.         ++sp;
  375.         set_integer(sp,n ? TRUE : FALSE);
  376.         break;
  377.     case OP_LIT:
  378.         *sp = code[*pc++];
  379.         break;
  380.     case OP_SEND:
  381.         n = *pc++;
  382.         chktype(n,DT_OBJECT);
  383.         send(n);
  384.         break;
  385.     case OP_DUP2:
  386.         check(2);
  387.         sp -= 2;
  388.         *sp = sp[2];
  389.         sp[1] = sp[3];
  390.         break;
  391.     case OP_NEW:
  392.         chktype(0,DT_CLASS);
  393.         set_object(sp,newobject(sp->v.v_class));
  394.         break;
  395.     default:
  396.         info("Bad opcode %02x",pc[-1]);
  397.         break;
  398.     }
  399.     }
  400. }
  401.  
  402. /* send - send a message to an object */
  403. static send(n)
  404.   int n;
  405. {
  406.     char selector[TKNSIZE+1];
  407.     DICT_ENTRY *de;
  408.     CLASS *class;
  409.     class = sp[n].v.v_object[OB_CLASS].v.v_class;
  410.     getcstring(selector,sizeof(selector),sp[n-1].v.v_string);
  411.     sp[n-1] = sp[n];
  412.     do {
  413.     if ((de = findentry(class->cl_functions,selector)) != NULL) {
  414.         switch (de->de_value.v_type) {
  415.         case DT_CODE:
  416.         (*de->de_value.v.v_code)(n);
  417.         return;
  418.         case DT_BYTECODE:
  419.         check(3);
  420.         code = de->de_value.v.v_bytecode;
  421.         set_bytecode(&sp[n],code);
  422.         push_integer(n);
  423.         push_integer(stktop - fp);
  424.         push_integer(pc - cbase);
  425.         cbase = pc = code[1].v.v_string->s_data;
  426.         fp = sp;
  427.         return;
  428.         default:
  429.         error("Bad method, Selector '%s', Type %d",
  430.               selector,
  431.               de->de_value.v_type);
  432.         }
  433.     }
  434.     } while ((class = class->cl_base) != NULL);
  435.     nomethod(selector);
  436. }
  437.  
  438. /* vectorref - load a vector element */
  439. static vectorref()
  440. {
  441.     VALUE *vect;
  442.     int i;
  443.     vect = sp[1].v.v_vector;
  444.     i = sp[0].v.v_integer;
  445.     if (i < 0 || i >= vect[0].v.v_integer)
  446.     error("subscript out of bounds");
  447.     sp[1] = vect[i+1];
  448.     ++sp;
  449. }
  450.  
  451. /* vectorset - set a vector element */
  452. static vectorset()
  453. {
  454.     VALUE *vect;
  455.     int i;
  456.     vect = sp[2].v.v_vector;
  457.     i = sp[1].v.v_integer;
  458.     if (i < 0 || i >= vect[0].v.v_integer)
  459.     error("subscript out of bounds");
  460.     vect[i+1] = sp[2] = *sp;
  461.     sp += 2;
  462. }
  463.  
  464. /* stringref - load a string element */
  465. static stringref()
  466. {
  467.     STRING *str;
  468.     int i;
  469.     str = sp[1].v.v_string;
  470.     i = sp[0].v.v_integer;
  471.     if (i < 0 || i >= str->s_length)
  472.     error("subscript out of bounds");
  473.     set_integer(&sp[1],str->s_data[i]);
  474.     ++sp;
  475. }
  476.  
  477. /* stringset - set a string element */
  478. static stringset()
  479. {
  480.     STRING *str;
  481.     int i;
  482.     chktype(0,DT_INTEGER);
  483.     str = sp[2].v.v_string;
  484.     i = sp[1].v.v_integer;
  485.     if (i < 0 || i >= str->s_length)
  486.     error("subscript out of bounds");
  487.     str->s_data[i] = sp[0].v.v_integer;
  488.     set_integer(&sp[2],str->s_data[i]);
  489.     sp += 2;
  490. }
  491.  
  492. /* getwoperand - get data word */
  493. static int getwoperand()
  494. {
  495.     int b;
  496.     b = *pc++;
  497.     return ((*pc++ << 8) | b);
  498. }
  499.  
  500. /* type names */
  501. static char *tnames[] = {
  502. "NIL","CLASS","OBJECT","VECTOR","INTEGER","STRING","BYTECODE",
  503. "CODE","VAR","FILE"
  504. };
  505.  
  506. /* typename - get the name of a type */
  507. static char *typename(type)
  508.   int type;
  509. {
  510.     static char buf[20];
  511.     if (type >= _DTMIN && type <= _DTMAX)
  512.     return (tnames[type]);
  513.     sprintf(buf,"(%d)",type);
  514.     return (buf);
  515. }
  516.  
  517. /* badtype - report a bad operand type */
  518. badtype(off,type)
  519.   int off,type;
  520. {
  521.     char tn1[20];
  522.     strcpy(tn1,typename(sp[off].v_type));
  523.     info("PC: %04x, Offset %d, Type %s, Expected %s",
  524.      pc-cbase,off,tn1,typename(type));
  525.     error("Bad argument type");
  526. }
  527.  
  528. /* nomethod - report a failure to find a method for a selector */
  529. static nomethod(selector)
  530.   char *selector;
  531. {
  532.     error("No method for selector '%s'",selector);
  533. }
  534.  
  535. /* stackover - report a stack overflow error */
  536. stackover()
  537. {
  538.     error("Stack overflow");
  539. }
  540.