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