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