home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume2 / basic / part1 / newbs / act.c next >
Encoding:
C/C++ Source or Header  |  1986-11-30  |  14.0 KB  |  610 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();    vizd = pop();
  338.         step = pop();    to = pop();
  339.         from = pop();
  340. if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  341.     xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
  342.         if(vizd.ival == 0) { /* first visit to loop */
  343.         place = pop();
  344. if(dbg) printf("first time:var:%s:",place.vpval->name);
  345.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  346.         place.plval = getplace(place.vpval);
  347.         *(place.plval) = from;    /* since first time, set starting val */
  348. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  349.         if(vizd.ival==T_INT && step.ival==0)
  350.             if(to.ival < from.ival)
  351.                 step.ival = -1;
  352.             else
  353.                 step.ival = 1;
  354.         else if(vizd.ival==T_DBL && step.rval==0)
  355.             if(to.rval < from.rval)
  356.                 step.rval = -1;
  357.             else
  358.                 step.rval = 1;
  359.         }
  360.         else place = pop();
  361. if(dbg) printf("var.place:%o:",place.plval);
  362.  
  363.         /* The stack frame is now correctly popped off.
  364.          * Next, we check if the loop is finished.
  365.          */
  366.  
  367.         if(vizd.ival == T_INT)
  368.         if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
  369.         else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
  370.         else /* vizd.ival == T_DBL */
  371.         if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
  372.         else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
  373.  
  374.         /* Loop is not done yet, push back stack frame. */
  375.  
  376. if(dbg) printf("loop not done, push everything back\n");
  377.         push(place);    push(from);    push(to);
  378.         push(step);        push(vizd);    push(xitpt);
  379.         return(p);
  380.  
  381.     /* Come here when the loop is finished. */
  382. loop_done:
  383. if(dbg) printf("loop done, jump to xitpt\n");
  384.         Thisline = xitpt.lval.codelist;
  385.         Thisline--;
  386.         Thisp = xitpt.lval.place;
  387.         return(p);
  388.     default: STerror("for");
  389.     }
  390. }
  391.  
  392. /* M_COMPILE:
  393.  *    var name next rlabel FORx go@ dlabel FORx+1
  394.  *--to--
  395.  *    _var,vp,_next,_rlabel,lblp,_go_at,dlabel,lblp2
  396.  *
  397.  * M_EXECUTE:
  398.  *    stack: same as M_EXECUTE in _for.
  399.  *    other: adds step to (control var)->val.
  400.  */
  401. _next(l,p) int(*l[])(),p;
  402. {
  403.     union value vp,xitpt,vizd,step,to,from,place;
  404.  
  405.     switch(status&XMODE) {
  406.     case M_COMPILE:
  407.     case M_FIXUP: return(p);
  408.     case M_EXECUTE:
  409.         vp = pop();
  410. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  411.         vp.plval = getplace(vp.vpval);
  412. if(dbg) printf(":vp.pl:%o:",vp.plval);
  413.         xitpt = pop();    vizd = pop();    step = pop();
  414.         to = pop();        from = pop();    place = pop();
  415. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  416.     place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  417. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  418.     xitpt.lval.place,xitpt.lval.codelist->num);
  419.         if(place.plval != vp.plval) FNerror(l,p);
  420.         if(vizd.ival == T_INT)
  421.         place.plval->ival += step.ival;
  422.         else
  423.         place.plval->rval += step.rval;
  424.         push(place);    push(from);    push(to);    
  425.         push(step);        push(vizd);    push(xitpt);
  426.         return(p);
  427.     default: STerror("next");
  428.     }
  429. }
  430.  
  431. /* variables needed for M_READ. */
  432.  
  433. struct line *dlist[DLSIZ];
  434. int dlp = 0;
  435. int dlindx = 2;        /* skips <_data,0> */
  436. int dtype;        /* type of last operation. */
  437.  
  438.  
  439. /* M_COMPILE:
  440.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  441.  * M_FIXUP:
  442.  *    allocates a spot in dlist, stores pointer to llist entry for
  443.  *    this line at that spot.
  444.  * M_EXECUTE:
  445.  *    Returns, with p pointing at the zero, making interp() return.
  446.  */
  447. _data(l,p) int(*l[])(),p;
  448. {
  449.     switch(status&XMODE) {
  450. #ifdef INT
  451.     case M_COMPILE:
  452.         l[p++] = 0;
  453.         return(p);
  454. #endif
  455.     case M_FIXUP:
  456.         dlist[dlp++] = gllentry(l);
  457.         p++;
  458.     case M_EXECUTE: return(p);
  459.     default:
  460.         STerror("data");
  461.     }
  462. }
  463.  
  464. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  465.  */
  466. _dsep(l,p) int(*l[])(),p;
  467. {
  468.     switch(status&XMODE) {
  469. #ifdef INT
  470.     case M_COMPILE:
  471. #endif
  472.     case M_FIXUP:
  473.         l[p++] = 0;
  474.     case M_READ:
  475.     case M_EXECUTE: return(p);
  476.     default: STerror("dsep");
  477.     }
  478. }
  479.  
  480. /* routines for changing the interpretors state. */
  481.  
  482. struct statstk {    /* for saving old states */
  483.     int stkp;
  484.     int stat;
  485. } sstk[30];
  486. int sstktop = 0;
  487.  
  488. /* M_COMPILE:
  489.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  490.  * M_FIXUP:
  491.  *    skip <state>
  492.  * any other state:
  493.  *    save old state and stack pointer.
  494.  *    set state to <state>.
  495.  */
  496. _pushstate(l,p) int (*l[])(),p;
  497. {
  498.     switch(status&XMODE) {
  499. #ifdef INT
  500.     case M_COMPILE:
  501.         l[p++] = atoi(int_in());
  502.         return(p);
  503. #endif
  504.     case M_FIXUP: return(++p);
  505.     default:
  506.         sstk[sstktop].stkp = stackp;
  507.         sstk[sstktop].stat = status;
  508.         sstktop++;
  509.         status = l[p++];
  510.         return(p);
  511.     }
  512. }
  513. _popstate(l,p) int (*l[])(),p;
  514. {
  515.     switch(status&XMODE) {
  516. #ifdef INT
  517.     case M_COMPILE:
  518. #endif
  519.     case M_FIXUP: return(p);
  520.     default:
  521.         sstktop--;
  522.         stackp = sstk[sstktop].stkp;
  523.         status = sstk[sstktop].stat&XMODE;
  524.         return(p);
  525.     }
  526. }
  527.  
  528.  
  529. /* stack maintanence routines.
  530.  */
  531.  
  532.  
  533. /* M_COMPILE:
  534.  *    x spop x    --to--    x,_spop,x
  535.  * M_EXECUTE:
  536.  *    stack: string,x   --to--   x
  537.  *    other: frees storage used by string (if any).
  538.  */
  539. _spop(l,p) int(*l[])(),p;
  540. {
  541.     union value s;
  542.  
  543.     switch(status&XMODE) {
  544.     case M_EXECUTE:
  545.         s=pop();
  546.         if(s.sval != 0) free(s.sval);
  547. #ifdef INT
  548.     case M_COMPILE:
  549. #endif
  550.     case M_FIXUP: return(p);
  551.     default:
  552.         STerror("spop");
  553.     }
  554. }
  555.  
  556. /* M_COMPILE:
  557.  *    x pop x    --to--    x,_pop,x
  558.  * M_EXECUTE:
  559.  *    stack: int,x    --to--   x
  560.  */
  561. _pop(l,p) int(*l[])(),p;
  562. {
  563.     switch(status&XMODE) {
  564.     case M_FIXUP:
  565.     case M_COMPILE: return(p);
  566.     case M_EXECUTE: pop(); return(p);
  567.     default:
  568.         STerror("pop");
  569.     }
  570. }
  571.  
  572. _stop(l,p) int(*l[])(),p;
  573. {
  574.     switch(status&XMODE) {
  575.     case M_FIXUP:
  576.     case M_COMPILE: return(p);
  577.     case M_EXECUTE: exit(1);
  578.     default:
  579.         STerror("stop");
  580.     }
  581. }
  582. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  583.  
  584.  
  585. /* operator list for the intermediate language. */
  586. struct wlnode wlist[] = {
  587.     "itoa",_itoa,    "print",_print,    "goto",_goto,    "if",_if,  "rtoa",_rtoa,
  588.     "itor",_itor,    "rtoi",_rtoi,    "gosub",_gosub,  "return",_return,
  589.     "scon",_scon,    "icon",_icon,    "i+",_iadd,    "-",_isub,
  590.     "rcon",_rcon,    "r+",_radd,    "r-",_rsub,
  591.     "i*",_imult,    "i/",_idiv,    "i%",_imod,    ",",_comma,
  592.     "r*",_rmult,    "r/",_rdiv,    ";",_scolon,
  593.     "i==",_ieq,    "s==",_seq,    "r==",_req,
  594.     "i<>",_ineq,    "r<>",_rneq,    "s<>",_sneq,
  595.     "i<=",_ileq,    "s<=",_sleq,    "r<=",_rleq,
  596.     "i<",_ilt,    "s<",_slt,    "r<",_rlt,
  597.     "i>=",_igeq,    "s>=",_sgeq,    "r>=",_rgeq,
  598.     "i>",_igt,    "s>",_sgt,    "r>",_rgt,
  599.     "or",_or,    "and",_and,    "val",_val,    "not",_not,
  600.     "pop",_pop,    "spop",_spop,
  601.     "stop",_stop,    "end",_end,    "var",_var,    "store",_store,
  602.     "for",_for,    "next",_next,
  603.     "dlabel",_dlabel,    "rlabel",_rlabel,
  604.     "contin",_contin,  "leave",_leave,  "enter",_enter,  "exitlp",_exitlp,
  605.     "data",_data,    "dsep",_dsep,
  606.     "pushstate",_pushstate,        "popstate",_popstate,
  607.     0,0
  608. };
  609.  
  610.