home *** CD-ROM | disk | FTP | other *** search
/ Computer Select (Limited Edition) / Computer Select.iso / dobbs / v16n09 / bob.asc < prev    next >
Encoding:
Text File  |  1991-08-21  |  15.5 KB  |  668 lines
  1. _YOUR OWN TINY OBJECT-ORIENTED LANGUAGE_
  2. by David Betz
  3.  
  4. [LISTING ONE]
  5.  
  6. /* bobint.c - bytecode interpreter */
  7. /*
  8.     Copyright (c) 1991, by David Michael Betz
  9.     All rights reserved
  10. */
  11.  
  12. #include <setjmp.h>
  13. #include "bob.h"
  14.  
  15. #define iszero(x)   ((x)->v_type == DT_INTEGER && (x)->v.v_integer == 0)
  16. #define istrue(x)   ((x)->v_type != DT_NIL && !iszero(x))
  17.  
  18. /* global variables */
  19. VALUE *stkbase;     /* the runtime stack */
  20. VALUE *stktop;      /* the top of the stack */
  21. VALUE *sp;      /* the stack pointer */
  22. VALUE *fp;      /* the frame pointer */
  23. int trace=0;        /* variable to control tracing */
  24.  
  25. /* external variables */
  26. extern DICTIONARY *symbols;
  27. extern jmp_buf error_trap;
  28.  
  29. /* local variables */
  30. static unsigned char *cbase;    /* the base code address */
  31. static unsigned char *pc;   /* the program counter */
  32. static VALUE *code;     /* the current code vector */
  33.  
  34. /* forward declarations */
  35. char *typename();
  36.  
  37. /* execute - execute a bytecode function */
  38. int execute(name)
  39.   char *name;
  40. {
  41.     DICT_ENTRY *sym;
  42.     
  43.     /* setup an error trap handler */
  44.     if (setjmp(error_trap) != 0)
  45.     return (FALSE);
  46.  
  47.     /* lookup the symbol */
  48.     if ((sym = findentry(symbols,name)) == NULL)
  49.     return (FALSE);
  50.  
  51.     /* dispatch on its data type */
  52.     switch (sym->de_value.v_type) {
  53.     case DT_CODE:
  54.     (*sym->de_value.v.v_code)(0);
  55.     break;è    case DT_BYTECODE:
  56.     interpret(sym->de_value.v.v_bytecode);
  57.     break;
  58.     }
  59.     return (TRUE);
  60. }
  61.  
  62. /* interpret - interpret bytecode instructions */
  63. int interpret(fcn)
  64.   VALUE *fcn;
  65. {
  66.     register int pcoff,n;
  67.     register VALUE *obj;
  68.     VALUE *topframe,val;
  69.     STRING *s1,*s2,*sn;
  70.     
  71.     /* initialize */
  72.     sp = fp = stktop;
  73.     cbase = pc = fcn[1].v.v_string->s_data;
  74.     code = fcn;
  75.  
  76.     /* make a dummy call frame */
  77.     check(4);
  78.     push_bytecode(code);
  79.     push_integer(0);
  80.     push_integer(0);
  81.     push_integer(0);
  82.     fp = topframe = sp;
  83.     
  84.     /* execute each instruction */
  85.     for (;;) {
  86.     if (trace)
  87.         decode_instruction(code,pc-code[1].v.v_string->s_data);
  88.     switch (*pc++) {
  89.     case OP_CALL:
  90.         n = *pc++;
  91.         switch (sp[n].v_type) {
  92.         case DT_CODE:
  93.             (*sp[n].v.v_code)(n);
  94.             break;
  95.         case DT_BYTECODE:
  96.             check(3);
  97.             code = sp[n].v.v_bytecode;
  98.             push_integer(n);
  99.             push_integer(stktop - fp);
  100.             push_integer(pc - cbase);
  101.             cbase = pc = code[1].v.v_string->s_data;
  102.             fp = sp;
  103.             break;
  104.         default:
  105.             error("Call to non-procedure, Type %s",
  106.               typename(sp[n].v_type));
  107.             return;
  108.         }
  109.         break;è    case OP_RETURN:
  110.         if (fp == topframe) return;
  111.         val = *sp;
  112.         sp = fp;
  113.         pcoff = fp[0].v.v_integer;
  114.         n = fp[2].v.v_integer;
  115.         fp = stktop - fp[1].v.v_integer;
  116.         code = fp[fp[2].v.v_integer+3].v.v_bytecode;
  117.         cbase = code[1].v.v_string->s_data;
  118.         pc = cbase + pcoff;
  119.         sp += n + 3;
  120.         *sp = val;
  121.         break;
  122.     case OP_REF:
  123.         *sp = code[*pc++].v.v_var->de_value;
  124.         break;
  125.     case OP_SET:
  126.         code[*pc++].v.v_var->de_value = *sp;
  127.         break;
  128.     case OP_VREF:
  129.         chktype(0,DT_INTEGER);
  130.         switch (sp[1].v_type) {
  131.         case DT_VECTOR: vectorref(); break;
  132.         case DT_STRING: stringref(); break;
  133.         default:    badtype(1,DT_VECTOR); break;
  134.         }
  135.         break;
  136.     case OP_VSET:
  137.         chktype(1,DT_INTEGER);
  138.         switch (sp[2].v_type) {
  139.         case DT_VECTOR: vectorset(); break;
  140.         case DT_STRING: stringset(); break;
  141.         default:    badtype(1,DT_VECTOR); break;
  142.         }
  143.         break;
  144.     case OP_MREF:
  145.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  146.         *sp = obj[*pc++];
  147.         break;
  148.     case OP_MSET:
  149.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  150.         obj[*pc++] = *sp;
  151.         break;
  152.     case OP_AREF:
  153.         n = *pc++;
  154.         if (n >= fp[2].v.v_integer)
  155.             error("Too few arguments");
  156.         *sp = fp[n+3];
  157.         break;
  158.     case OP_ASET:
  159.         n = *pc++;
  160.         if (n >= fp[2].v.v_integer)
  161.             error("Too few arguments");
  162.         fp[n+3] = *sp;
  163.         break;è    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;è            case DT_STRING:
  218.             s2 = sp[0].v.v_string;
  219.             sn = newstring(1 + s2->s_length);
  220.             sn->s_data[0] = sp[1].v.v_integer;
  221.             memcpy(&sn->s_data[1],
  222.                    s2->s_data,
  223.                    s2->s_length);
  224.             set_string(&sp[1],sn);
  225.             break;
  226.             default:
  227.             break;
  228.             }
  229.             break;
  230.         case DT_STRING:
  231.             s1 = sp[1].v.v_string;
  232.             switch (sp[0].v_type) {
  233.             case DT_INTEGER:
  234.             sn = newstring(s1->s_length + 1);
  235.             memcpy(sn->s_data,
  236.                    s1->s_data,
  237.                    s1->s_length);
  238.             sn->s_data[s1->s_length] = sp[0].v.v_integer;
  239.             set_string(&sp[1],sn);
  240.             break;
  241.             case DT_STRING:
  242.             s2 = sp[0].v.v_string;
  243.             sn = newstring(s1->s_length + s2->s_length);
  244.             memcpy(sn->s_data,
  245.                    s1->s_data,s1->s_length);
  246.             memcpy(&sn->s_data[s1->s_length],
  247.                    s2->s_data,s2->s_length);
  248.             set_string(&sp[1],sn);
  249.             break;
  250.             default:
  251.             break;
  252.             }
  253.             break;
  254.         default:
  255.             badtype(1,DT_VECTOR);
  256.             break;
  257.         }
  258.         ++sp;
  259.         break;
  260.     case OP_SUB:
  261.         chktype(0,DT_INTEGER);
  262.         chktype(1,DT_INTEGER);
  263.         sp[1].v.v_integer -= sp->v.v_integer;
  264.         ++sp;
  265.         break;
  266.     case OP_MUL:
  267.         chktype(0,DT_INTEGER);
  268.         chktype(1,DT_INTEGER);
  269.         sp[1].v.v_integer *= sp->v.v_integer;
  270.         ++sp;
  271.         break;è    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.         switch (sp[1].v_type) {
  325.         case DT_INTEGER:è            chktype(0,DT_INTEGER);
  326.             sp[1].v.v_integer <<= sp->v.v_integer;
  327.             break;
  328.         case DT_FILE:
  329.             print1(sp[1].v.v_fp,FALSE,&sp[0]);
  330.             break;
  331.         default:
  332.             break;
  333.         }
  334.         ++sp;
  335.         break;
  336.     case OP_SHR:
  337.         chktype(0,DT_INTEGER);
  338.         chktype(1,DT_INTEGER);
  339.         sp[1].v.v_integer >>= sp->v.v_integer;
  340.         ++sp;
  341.         break;
  342.     case OP_LT:
  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_LE:
  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_EQ:
  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_NE:
  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_GE:
  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_GT:
  378.         chktype(0,DT_INTEGER);
  379.         chktype(1,DT_INTEGER);è        n = sp[1].v.v_integer > sp->v.v_integer;
  380.         ++sp;
  381.         set_integer(sp,n ? TRUE : FALSE);
  382.         break;
  383.     case OP_LIT:
  384.         *sp = code[*pc++];
  385.         break;
  386.     case OP_SEND:
  387.         n = *pc++;
  388.         chktype(n,DT_OBJECT);
  389.         send(n);
  390.         break;
  391.     case OP_DUP2:
  392.         check(2);
  393.         sp -= 2;
  394.         *sp = sp[2];
  395.         sp[1] = sp[3];
  396.         break;
  397.     case OP_NEW:
  398.         chktype(0,DT_CLASS);
  399.         set_object(sp,newobject(sp->v.v_class));
  400.         break;
  401.     default:
  402.         info("Bad opcode %02x",pc[-1]);
  403.         break;
  404.     }
  405.     }
  406. }
  407.  
  408. /* send - send a message to an object */
  409. static send(n)
  410.   int n;
  411. {
  412.     char selector[TKNSIZE+1];
  413.     DICT_ENTRY *de;
  414.     CLASS *class;
  415.     class = sp[n].v.v_object[OB_CLASS].v.v_class;
  416.     getcstring(selector,sizeof(selector),sp[n-1].v.v_string);
  417.     sp[n-1] = sp[n];
  418.     do {
  419.     if ((de = findentry(class->cl_functions,selector)) != NULL) {
  420.         switch (de->de_value.v_type) {
  421.         case DT_CODE:
  422.         (*de->de_value.v.v_code)(n);
  423.         return;
  424.         case DT_BYTECODE:
  425.         check(3);
  426.         code = de->de_value.v.v_bytecode;
  427.         set_bytecode(&sp[n],code);
  428.         push_integer(n);
  429.         push_integer(stktop - fp);
  430.         push_integer(pc - cbase);
  431.         cbase = pc = code[1].v.v_string->s_data;
  432.         fp = sp;
  433.         return;è        default:
  434.         error("Bad method, Selector '%s', Type %d",
  435.               selector,
  436.               de->de_value.v_type);
  437.         }
  438.     }
  439.     } while ((class = class->cl_base) != NULL);
  440.     nomethod(selector);
  441. }
  442.  
  443. /* vectorref - load a vector element */
  444. static vectorref()
  445. {
  446.     VALUE *vect;
  447.     int i;
  448.     vect = sp[1].v.v_vector;
  449.     i = sp[0].v.v_integer;
  450.     if (i < 0 || i >= vect[0].v.v_integer)
  451.     error("subscript out of bounds");
  452.     sp[1] = vect[i+1];
  453.     ++sp;
  454. }
  455.  
  456. /* vectorset - set a vector element */
  457. static vectorset()
  458. {
  459.     VALUE *vect;
  460.     int i;
  461.     vect = sp[2].v.v_vector;
  462.     i = sp[1].v.v_integer;
  463.     if (i < 0 || i >= vect[0].v.v_integer)
  464.     error("subscript out of bounds");
  465.     vect[i+1] = sp[2] = *sp;
  466.     sp += 2;
  467. }
  468.  
  469. /* stringref - load a string element */
  470. static stringref()
  471. {
  472.     STRING *str;
  473.     int i;
  474.     str = sp[1].v.v_string;
  475.     i = sp[0].v.v_integer;
  476.     if (i < 0 || i >= str->s_length)
  477.     error("subscript out of bounds");
  478.     set_integer(&sp[1],str->s_data[i]);
  479.     ++sp;
  480. }
  481.  
  482. /* stringset - set a string element */
  483. static stringset()
  484. {
  485.     STRING *str;
  486.     int i;
  487.     chktype(0,DT_INTEGER);è    str = sp[2].v.v_string;
  488.     i = sp[1].v.v_integer;
  489.     if (i < 0 || i >= str->s_length)
  490.     error("subscript out of bounds");
  491.     str->s_data[i] = sp[0].v.v_integer;
  492.     set_integer(&sp[2],str->s_data[i]);
  493.     sp += 2;
  494. }
  495.  
  496. /* getwoperand - get data word */
  497. static int getwoperand()
  498. {
  499.     int b;
  500.     b = *pc++;
  501.     return ((*pc++ << 8) | b);
  502. }
  503.  
  504. /* type names */
  505. static char *tnames[] = {
  506. "NIL","CLASS","OBJECT","VECTOR","INTEGER","STRING","BYTECODE",
  507. "CODE","VAR","FILE"
  508. };
  509.  
  510. /* typename - get the name of a type */
  511. static char *typename(type)
  512.   int type;
  513. {
  514.     static char buf[20];
  515.     if (type >= _DTMIN && type <= _DTMAX)
  516.     return (tnames[type]);
  517.     sprintf(buf,"(%d)",type);
  518.     return (buf);
  519. }
  520.  
  521. /* badtype - report a bad operand type */
  522. badtype(off,type)
  523.   int off,type;
  524. {
  525.     char tn1[20];
  526.     strcpy(tn1,typename(sp[off].v_type));
  527.     info("PC: %04x, Offset %d, Type %s, Expected %s",
  528.      pc-cbase,off,tn1,typename(type));
  529.     error("Bad argument type");
  530. }
  531.  
  532. /* nomethod - report a failure to find a method for a selector */
  533. static nomethod(selector)
  534.   char *selector;
  535. {
  536.     error("No method for selector '%s'",selector);
  537. }
  538.  
  539. /* stackover - report a stack overflow error */
  540. stackover()
  541. {è    error("Stack overflow");
  542. }
  543.  
  544.  
  545.  
  546.  
  547. Examplσ 1║ 
  548.  
  549. (a⌐ 
  550.  
  551.     factorial(n)
  552.     {
  553.         return n == 1 ? 1 : n * factorial(n-1);
  554.  
  555.     }
  556.  
  557.  
  558.  
  559. (b⌐ 
  560.  
  561.  
  562.     main(; i)
  563.     {
  564.         for (i = 1; i <= 10; ++i)
  565.             print(i," factorial is ",factorial(i),"\n");
  566.     }
  567.  
  568.  
  569.  
  570. Examplσ 2:
  571.  
  572. (a⌐ ┴ BoΓ clas≤ definition
  573.  
  574.     clas≤ foo
  575.     {
  576.         a,b;
  577.         statiπ last;
  578.         statiπ get_last();
  579.     }
  580.  
  581.  
  582. (b⌐ 
  583.  
  584.     foo::foo(aa,bb)
  585.     {
  586.         a == aa; b = bb;
  587.         last = this;
  588.         return this;
  589.     }
  590.  
  591.  
  592.  
  593.  
  594.  
  595. Examplσ 3:è
  596. (a)
  597.     foo::get_a()
  598.     {
  599.         return a;
  600.     }
  601.  
  602.  
  603.  
  604. (b)
  605.  
  606.     foo::set_a(aa)
  607.     {
  608.         a = aa;
  609.     }
  610.  
  611.  
  612. (c)
  613.  
  614.  
  615.     foo::count(; i)
  616.     {
  617.         for (i = a; i <= b; ++i)
  618.             print(i,"\n");
  619.     }
  620.  
  621.     main(; foo1,foo2)
  622.     {
  623.  
  624.         foo1 = new foo(1,2);      // create a object of class foo
  625.         foo2 = new foo(11,22);    // and another
  626.         print("foo1 counting\n"); // ask the first to count
  627.         foo1->count();
  628.         print("foo2 counting\n"); // ask the second to count
  629.         foo2->count();
  630.     }
  631.  
  632.  
  633. Examplσ 4:
  634.  
  635. (a)
  636.  
  637.     class bar : foo // a class derived from foo
  638.     {
  639.         c;
  640.     }
  641.  
  642.  
  643. (b)
  644.  
  645.     bar::bar(aa,bb,cc)
  646.     {
  647.         this->foo(aa,bb);
  648.         return this;
  649.     }è
  650.  
  651.  
  652. Examplσ 5
  653.  
  654. typedef struct value {
  655.   int v_type;           /* data type */
  656.   union {           /* value */
  657.     struct class *v_class;
  658.     struct value *v_object;
  659.     struct value *v_vector;
  660.     struct string *v_string;
  661.  
  662.     struct value *v_bytecode;
  663.     struct dict_entry *v_var;
  664.     int (*v_code)();
  665.     long v_integer;
  666.   } v;
  667. } VALUE;
  668.