home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume2 / basic / part3 / bs2 / action.c next >
Encoding:
C/C++ Source or Header  |  1986-11-30  |  13.7 KB  |  584 lines
  1. /* action.c -- "action" routines for interpretor.  These are the base-level
  2.  *    routines, pointed to by the code-list.
  3.  */
  4.  
  5. #include "bsdefs.h"
  6.  
  7. int status = 0;
  8.  
  9. /* M_COMPILE:
  10.  *    x print x   --to--   x,_print,x
  11.  * M_EXECUTE:
  12.  *    stack: string,x   --to--   x
  13.  *    output: "string\n"
  14.  */
  15. _print(l,p)
  16. int (*l[])(),p;
  17. {
  18.     union value s1;
  19.     switch(status&XMODE) {
  20.     case M_EXECUTE:
  21.         s1 = pop();
  22.         printf("%s",s1.sval);
  23.         if(s1.sval != 0) free(s1.sval);
  24.     case M_FIXUP:
  25.     case M_COMPILE: return(p);
  26.     default:
  27.         STerror("print");
  28.     }
  29. }
  30.  
  31. /* M_COMPILE:
  32.  *    x rlabel name goto x     --to--    x,rlabel,lval,_goto,0,x
  33.  *    (the 0 is for the benefit of interp())
  34.  * M_FIXUP: nothing.
  35.  * any other mode:
  36.  *    stack: lval,x    --to--    x
  37.  *    other: Thisline = lval.lval.codelist;
  38.  *           Thisp = lval.lval.place;
  39.  */
  40. _goto(l,p) int (*l[])(),p;
  41. {
  42.     union value lval;
  43.  
  44.     switch(status&XMODE) {
  45.     case M_COMPILE: l[p] = 0;
  46.     case M_FIXUP: return(++p);
  47.     default:
  48.         lval = pop();
  49.         if(lval.lval.codelist == 0) ULerror(l,p);
  50.         Thisline = lval.lval.codelist;
  51.         Thisline--;
  52.         Thisp = lval.lval.place;
  53. if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
  54.     lval.lval.place,lval.lval.codelist->num);
  55.         return(p);
  56.     }
  57. }
  58.  
  59. /* M_COMPILE:
  60.  *    x dlabel name x    --to--    x,_dlabel,&vlist entry,x
  61.  * M_FIXUP:
  62.  *    Make vlist entry for "name" point to current place.
  63.  */
  64. _dlabel(l,p) int (*l[])(),p;
  65. {
  66.     struct dictnode *vp;
  67.     char *s;
  68.  
  69.     switch(status&XMODE) {
  70.     case M_COMPILE:
  71.         s=gtok();
  72.         vp=gvadr(s,T_LBL);
  73.         l[p++] = vp;
  74.         return(p);
  75.     case M_FIXUP:
  76.         vp=l[p++];
  77.         vp->val.lval.codelist = (int **)gllentry(l);
  78.         vp->val.lval.place = p;
  79.         return(p);
  80.     default: return(++p);
  81.     }
  82. }
  83.  
  84. /* M_COMPILE:
  85.  *    x rlabel name x    --to--     x,rlabel,&vlist entry,x
  86.  * any other mode:
  87.  *    push(vp->val)    (i.e.  pointer to location of label)
  88.  */
  89. _rlabel(l,p) int (*l[])(),p;
  90. {
  91.     struct dictnode *vp;
  92.     char *s;
  93.  
  94.     switch(status&XMODE) {
  95.     case M_COMPILE:
  96.         s=gtok();
  97.         vp=gvadr(s,T_LBL);
  98.         l[p++] = vp;
  99.         return(p);
  100.     case M_FIXUP: return(++p);
  101.     default:
  102.         vp = l[p++];
  103. if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
  104.     vp->val.lval.codelist,vp->val.lval.place);
  105.         push(vp->val);
  106.         return(p);
  107.     }
  108. }
  109.  
  110. /* M_COMPILE:
  111.  *    x rlabel name goto x    --to--    x,_rlabel,lval,_gosub,0,x
  112.  *
  113.  * M_EXECUTE:
  114.  *    stack: lval,x   --to--   x
  115.  *    other: saves current place (on stack) and jumps to lval.
  116.  */
  117. _gosub(l,p) int(*l[])(),p;
  118. {
  119.     union value here,there;
  120.     switch(status&XMODE) {
  121.     case M_COMPILE:
  122.     case M_FIXUP:
  123.         l[p++] = 0;
  124.         return(p);
  125.     case M_EXECUTE:
  126.         there = pop();
  127.         here.lval.codelist = gllentry(l);
  128.         here.lval.place = p+1;
  129. if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
  130.     here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
  131.         push(here);
  132.         Thisline = there.lval.codelist;
  133.         Thisline--;
  134.         Thisp = there.lval.place;
  135.         return(p);
  136.     default: STerror("gosub");
  137.     }
  138. }
  139.  
  140. _return(l,p) int(*l[])(),p;
  141. {
  142.     union value loc;
  143.     switch(status&XMODE) {
  144.     case M_COMPILE:
  145.     case M_FIXUP:
  146.         l[p++] = 0;
  147.         return(p);
  148.     case M_EXECUTE:
  149.         loc = pop();
  150.         Thisp = loc.lval.place;
  151.         Thisline = loc.lval.codelist;
  152.         Thisline--;
  153.         return(p);
  154.     default:
  155.         STerror("return");
  156.     }
  157. }
  158.  
  159. /* Routines control entering and leaving of loops.
  160.  *
  161.  *    enter -- makes a mark that we have entered a loop, and also records
  162.  *         branch points for "continue" and "leave".
  163.  *    exitlp -- undoes the mark made by enter.
  164.  *    contin -- branches to "continue" point.
  165.  *    leave -- branches to "leave" point.
  166.  *
  167.  * The following stack structure is used to record these loop markers.
  168.  */
  169.  
  170. struct loopstack {
  171.     struct label contlb,leavlb;
  172. };
  173.  
  174. struct loopstack lpstk[20];
  175. int lpstkp = -1;    /* -1 when stack is empty.
  176.              * always points to CURRENT loop marker.
  177.              */
  178.  
  179. /* M_COMPILE:
  180.  *    x rlabel contlb rlabel leavlb enter x
  181.  *--to--
  182.  *    x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
  183.  *
  184.  * M_EXECUTE:
  185.  *    loopstack: x    --to--   <contlb,leavlb>,x
  186.  */
  187. _enter(l,p) int (*l[])(),p;
  188. {
  189.     union value loc;
  190.  
  191.     if((status&XMODE) == M_EXECUTE) {
  192.     lpstkp++;
  193.     loc = pop();
  194. if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
  195.     loc.lval.codelist,loc.lval.place);
  196.     lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
  197.     lpstk[lpstkp].leavlb.place = loc.lval.place;
  198.     loc = pop();
  199. if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
  200.     lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
  201.     lpstk[lpstkp].contlb.place = loc.lval.place;
  202.     }
  203.     return(p);
  204. }
  205.  
  206. /* M_EXECUTE:
  207.  *    loopstack: <contlb,leavlb>,x    --to--   x
  208.  *    other: ensures that lpstkp doesnt get less that -1;
  209.  */
  210. _exitlp(l,p) int (*l[])(),p;
  211. {
  212.     if((status&XMODE) == M_EXECUTE)
  213.     if(lpstkp >= 0)
  214.         lpstkp--;
  215.     else
  216.         lpstkp = -1;
  217. if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
  218.     return(p);
  219. }
  220.  
  221. /* M_COMPILE:
  222.  *    x leave x   --to--   x,_leave,0,x
  223.  *    (the 0 is for the benefit of interp())
  224.  *
  225.  * M_EXECUTE:
  226.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  227.  *    other: branches to leavlb.  exitlp takes care of cleaning up stack.
  228.  */
  229. _leave(l,p) int(*l[])(),p;
  230. {
  231.     switch(status&XMODE) {
  232.     case M_COMPILE:
  233.     case M_FIXUP: l[p++] = 0; return(p);
  234.     case M_EXECUTE:
  235.         if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
  236.         LVerror(l,p);
  237.         Thisline = lpstk[lpstkp].leavlb.codelist;
  238.         Thisline--;
  239.         Thisp = lpstk[lpstkp].leavlb.place;
  240.         return(p);
  241.     default: STerror("leave");
  242.     }
  243. }
  244.  
  245. /* M_COMPILE:
  246.  *    x contin x    --to--    x,_contin,0,x
  247.  *
  248.  * M_EXECUTE:
  249.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  250.  *    other: jumps to contlb.
  251.  */
  252. _contin(l,p) int (*l[])(),p;
  253. {
  254.     switch(status&XMODE) {
  255.     case M_COMPILE:
  256.     case M_FIXUP: l[p++] = 0; return(p);
  257.     case M_EXECUTE:
  258.         if(lpstkp == -1) /* cannot continue a loop we're not in */
  259.         CNerror(l,p);
  260.         Thisline = lpstk[lpstkp].contlb.codelist;
  261.         Thisline--;
  262.         Thisp = lpstk[lpstkp].contlb.place;
  263.         return(p);
  264.     default: STerror("contin");
  265.     }
  266. }
  267.  
  268.  
  269.  
  270. /* M_COMPILE:
  271.  *    x rlabel name if x    --to--   x,_rlabel,vp,if,0,x
  272.  *    (the 0 is for the benefit for interp()).
  273.  * M_EXECUTE:
  274.  *    stack: loc,bool,x     --to--   x
  275.  *    p: if bool, p=p else p=loc->place
  276.  */
  277. _if(l,p)
  278. int (*l[])(),p;
  279. {
  280.     union value bv,lv;
  281.  
  282.     switch(status&XMODE) {
  283.     case M_EXECUTE:
  284.         lv = pop();
  285.         bv = pop();
  286. if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
  287.     p,bv.ival);
  288.         if(bv.ival == (long)0) { /* jump to else part. */
  289.         Thisline = lv.lval.codelist;
  290.         Thisline--;
  291.         Thisp = lv.lval.place;
  292.         }
  293.         else p++;    /* skip the 0 so we get to the then part */
  294.         return(p);
  295.     case M_FIXUP:
  296.     case M_COMPILE: l[p++] = 0; return(p);
  297.     default: STerror("if");
  298.     }
  299. }
  300.  
  301. /* M_COMPILE:
  302.  *    var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
  303.  *--to--
  304.  *    _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
  305.  *
  306.  * M_EXECUTE:
  307.  *    stack: xitpt,vizd,step,to,from,vp,x
  308.  *    other: if exit conditions are correct, jump to exit point.
  309.  *        vizd is used to hold the data type for vp.  Data types
  310.  *        are always non-zero so the test for the first visit to
  311.  *        the loop is to see if vizd is 0.
  312.  */
  313. _for(l,p) int(*l[])(),p;
  314. {
  315.     union value xitpt,vizd,from,to,step,place;
  316.  
  317.     switch(status&XMODE) {
  318.     case M_COMPILE:
  319.     case M_FIXUP: l[p++] = 0; return(p);
  320.     case M_EXECUTE:
  321.         xitpt = pop();    vizd = pop();
  322.         step = pop();    to = pop();
  323.         from = pop();
  324. if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  325.     xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
  326.         if(vizd.ival == 0) { /* first visit to loop */
  327.         place = pop();
  328. if(dbg) printf("first time:var:%s:",place.vpval->name);
  329.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  330.         place.plval = getplace(place.vpval);
  331.         *(place.plval) = from;    /* since first time, set starting val */
  332. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  333.         if(vizd.ival==T_INT && step.ival==0)
  334.             if(to.ival < from.ival)
  335.                 step.ival = -1;
  336.             else
  337.                 step.ival = 1;
  338.         else if(vizd.ival==T_DBL && step.rval==0)
  339.             if(to.rval < from.rval)
  340.                 step.rval = -1;
  341.             else
  342.                 step.rval = 1;
  343.         }
  344.         else place = pop();
  345. if(dbg) printf("var.place:%o:",place.plval);
  346.  
  347.         /* The stack frame is now correctly popped off.
  348.          * Next, we check if the loop is finished.
  349.          */
  350.  
  351.         if(vizd.ival == T_INT)
  352.         if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
  353.         else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
  354.         else /* vizd.ival == T_DBL */
  355.         if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
  356.         else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
  357.  
  358.         /* Loop is not done yet, push back stack frame. */
  359.  
  360. if(dbg) printf("loop not done, push everything back\n");
  361.         push(place);    push(from);    push(to);
  362.         push(step);        push(vizd);    push(xitpt);
  363.         return(p);
  364.  
  365.     /* Come here when the loop is finished. */
  366. loop_done:
  367. if(dbg) printf("loop done, jump to xitpt\n");
  368.         Thisline = xitpt.lval.codelist;
  369.         Thisline--;
  370.         Thisp = xitpt.lval.place;
  371.         return(p);
  372.     default: STerror("for");
  373.     }
  374. }
  375.  
  376. /* M_COMPILE:
  377.  *    var name next rlabel FORx go@ dlabel FORx+1
  378.  *--to--
  379.  *    _var,vp,_next,_rlabel,lblp,_go_at,dlabel,lblp2
  380.  *
  381.  * M_EXECUTE:
  382.  *    stack: same as M_EXECUTE in _for.
  383.  *    other: adds step to (control var)->val.
  384.  */
  385. _next(l,p) int(*l[])(),p;
  386. {
  387.     union value vp,xitpt,vizd,step,to,from,place;
  388.  
  389.     switch(status&XMODE) {
  390.     case M_COMPILE:
  391.     case M_FIXUP: return(p);
  392.     case M_EXECUTE:
  393.         vp = pop();
  394. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  395.         vp.plval = getplace(vp.vpval);
  396. if(dbg) printf(":vp.pl:%o:",vp.plval);
  397.         xitpt = pop();    vizd = pop();    step = pop();
  398.         to = pop();        from = pop();    place = pop();
  399. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  400.     place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  401. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  402.     xitpt.lval.place,xitpt.lval.codelist->num);
  403.         if(place.plval != vp.plval) FNerror(l,p);
  404.         if(vizd.ival == T_INT)
  405.         place.plval->ival += step.ival;
  406.         else
  407.         place.plval->rval += step.rval;
  408.         push(place);    push(from);    push(to);    
  409.         push(step);        push(vizd);    push(xitpt);
  410.         return(p);
  411.     default: STerror("next");
  412.     }
  413. }
  414.  
  415. /* variables needed for M_READ. */
  416.  
  417. struct line *dlist[DLSIZ];
  418. int dlp = 0;
  419. int dlindx = 2;        /* skips <_data,0> */
  420. int dtype;        /* type of last operation. */
  421.  
  422.  
  423. /* M_COMPILE:
  424.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  425.  * M_FIXUP:
  426.  *    allocates a spot in dlist, stores pointer to llist entry for
  427.  *    this line at that spot.
  428.  * M_EXECUTE:
  429.  *    Returns, with p pointing at the zero, making interp() return.
  430.  */
  431. _data(l,p) int(*l[])(),p;
  432. {
  433.     switch(status&XMODE) {
  434.     case M_COMPILE:
  435.         l[p++] = 0;
  436.         return(p);
  437.     case M_FIXUP:
  438.         dlist[dlp++] = gllentry(l);
  439.         p++;
  440.     case M_EXECUTE: return(p);
  441.     default:
  442.         STerror("data");
  443.     }
  444. }
  445.  
  446. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  447.  */
  448. _dsep(l,p) int(*l[])(),p;
  449. {
  450.     switch(status&XMODE) {
  451.     case M_COMPILE:
  452.     case M_FIXUP:
  453.         l[p++] = 0;
  454.     case M_READ:
  455.     case M_EXECUTE: return(p);
  456.     default: STerror("dsep");
  457.     }
  458. }
  459.  
  460. /* routines for changing the interpretors state. */
  461.  
  462. struct statstk {    /* for saving old states */
  463.     int stkp;
  464.     int stat;
  465. } sstk[30];
  466. int sstktop = 0;
  467.  
  468. /* M_COMPILE:
  469.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  470.  * M_FIXUP:
  471.  *    skip <state>
  472.  * any other state:
  473.  *    save old state and stack pointer.
  474.  *    set state to <state>.
  475.  */
  476. _pushstate(l,p) int (*l[])(),p;
  477. {
  478.     switch(status&XMODE) {
  479.     case M_COMPILE:
  480.         l[p++] = atoi(int_in());
  481.         return(p);
  482.     case M_FIXUP: return(++p);
  483.     default:
  484.         sstk[sstktop].stkp = stackp;
  485.         sstk[sstktop].stat = status;
  486.         sstktop++;
  487.         status = l[p++];
  488.         return(p);
  489.     }
  490. }
  491. _popstate(l,p) int (*l[])(),p;
  492. {
  493.     switch(status&XMODE) {
  494.     case M_COMPILE:
  495.     case M_FIXUP: return(p);
  496.     default:
  497.         sstktop--;
  498.         stackp = sstk[sstktop].stkp;
  499.         status = sstk[sstktop].stat&XMODE;
  500.         return(p);
  501.     }
  502. }
  503.  
  504.  
  505. /* stack maintanence routines.
  506.  */
  507.  
  508.  
  509. /* M_COMPILE:
  510.  *    x spop x    --to--    x,_spop,x
  511.  * M_EXECUTE:
  512.  *    stack: string,x   --to--   x
  513.  *    other: frees storage used by string (if any).
  514.  */
  515. _spop(l,p) int(*l[])(),p;
  516. {
  517.     union value s;
  518.  
  519.     switch(status&XMODE) {
  520.     case M_EXECUTE:
  521.         s=pop();
  522.         if(s.sval != 0) free(s.sval);
  523.     case M_COMPILE: return(p);
  524.     case M_FIXUP: return(p);
  525.     default:
  526.         STerror("spop");
  527.     }
  528. }
  529.  
  530. /* M_COMPILE:
  531.  *    x pop x    --to--    x,_pop,x
  532.  * M_EXECUTE:
  533.  *    stack: int,x    --to--   x
  534.  */
  535. _pop(l,p) int(*l[])(),p;
  536. {
  537.     switch(status&XMODE) {
  538.     case M_FIXUP:
  539.     case M_COMPILE: return(p);
  540.     case M_EXECUTE: pop(); return(p);
  541.     default:
  542.         STerror("pop");
  543.     }
  544. }
  545.  
  546. _stop(l,p) int(*l[])(),p;
  547. {
  548.     switch(status&XMODE) {
  549.     case M_FIXUP:
  550.     case M_COMPILE: return(p);
  551.     case M_EXECUTE: exit(1);
  552.     default:
  553.         STerror("stop");
  554.     }
  555. }
  556. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  557.  
  558.  
  559. /* operator list for the intermediate language. */
  560. struct wlnode wlist[] = {
  561.     "itoa",_itoa,    "print",_print,    "goto",_goto,    "if",_if,  "rtoa",_rtoa,
  562.     "itor",_itor,    "rtoi",_rtoi,    "gosub",_gosub,  "return",_return,
  563.     "scon",_scon,    "icon",_icon,    "i+",_iadd,    "-",_isub,
  564.     "rcon",_rcon,    "r+",_radd,    "r-",_rsub,
  565.     "i*",_imult,    "i/",_idiv,    "i%",_imod,    ",",_comma,
  566.     "r*",_rmult,    "r/",_rdiv,    ";",_scolon,
  567.     "i==",_ieq,    "s==",_seq,    "r==",_req,
  568.     "i<>",_ineq,    "r<>",_rneq,    "s<>",_sneq,
  569.     "i<=",_ileq,    "s<=",_sleq,    "r<=",_rleq,
  570.     "i<",_ilt,    "s<",_slt,    "r<",_rlt,
  571.     "i>=",_igeq,    "s>=",_sgeq,    "r>=",_rgeq,
  572.     "i>",_igt,    "s>",_sgt,    "r>",_rgt,
  573.     "or",_or,    "and",_and,    "val",_val,    "not",_not,
  574.     "pop",_pop,    "spop",_spop,
  575.     "stop",_stop,    "end",_end,    "var",_var,    "store",_store,
  576.     "for",_for,    "next",_next,
  577.     "dlabel",_dlabel,    "rlabel",_rlabel,
  578.     "contin",_contin,  "leave",_leave,  "enter",_enter,  "exitlp",_exitlp,
  579.     "data",_data,    "dsep",_dsep,
  580.     "pushstate",_pushstate,        "popstate",_popstate,
  581.     0,0
  582. };
  583.  
  584.