home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume2 / basic / part1 / newbs / action.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-11-30  |  12.0 KB  |  484 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.     if((status&XMODE) == M_EXECUTE) {
  20.         s1 = pop();
  21.         printf("%s",s1.sval);
  22.         if(s1.sval != 0) free(s1.sval);
  23.     }
  24.     return(p);
  25. }
  26.  
  27. /* M_COMPILE:
  28.  *    x rlabel name goto x     --to--    x,rlabel,lval,_goto,0,x
  29.  *    (the 0 is for the benefit of interp())
  30.  * M_FIXUP: nothing.
  31.  * any other mode:
  32.  *    stack: lval,x    --to--    x
  33.  *    other: Thisline = lval.lval.codelist;
  34.  *           Thisp = lval.lval.place;
  35.  */
  36. _goto(l,p) int (*l[])(),p;
  37. {
  38.     union value lval;
  39.  
  40.     if((status&XMODE) == M_FIXUP) return(++p);
  41.     if((status&XMODE) == M_EXECUTE) {
  42.         lval = pop();
  43.         if(lval.lval.codelist == 0) ULerror(l,p);
  44.         Thisline = lval.lval.codelist;
  45.         Thisline--;
  46.         Thisp = lval.lval.place;
  47. if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
  48.     lval.lval.place,lval.lval.codelist->num);
  49.         return(p);
  50.     }
  51.     return(p);
  52. }
  53.  
  54. /* M_COMPILE:
  55.  *    x dlabel name x    --to--    x,_dlabel,&vlist entry,x
  56.  * M_FIXUP:
  57.  *    Make vlist entry for "name" point to current place.
  58.  */
  59. _dlabel(l,p) int (*l[])(),p;
  60. {
  61.     struct dictnode *vp;
  62.  
  63.     if((status&XMODE) == M_FIXUP) {
  64.         vp=l[p++];
  65.         vp->val.lval.codelist = (int **)gllentry(l);
  66.         vp->val.lval.place = p;
  67.         return(p);
  68.     }
  69.     p++; return(p);    /* skip over the vp in any other mode */
  70. }
  71.  
  72. /* M_COMPILE:
  73.  *    x rlabel name x    --to--     x,rlabel,&vlist entry,x
  74.  * any other mode:
  75.  *    push(vp->val)    (i.e.  pointer to location of label)
  76.  */
  77. _rlabel(l,p) int (*l[])(),p;
  78. {
  79.     struct dictnode *vp;
  80.  
  81.     if((status&XMODE) == M_FIXUP) return(++p);
  82.     if((status&XMODE) == M_EXECUTE) {
  83.         vp = l[p++];
  84. if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
  85.     vp->val.lval.codelist,vp->val.lval.place);
  86.         push(vp->val);
  87.     }
  88.         return(p);
  89. }
  90.  
  91. /* M_COMPILE:
  92.  *    x rlabel name gosub x    --to--    x,_rlabel,lval,_gosub,0,x
  93.  *
  94.  * M_EXECUTE:
  95.  *    stack: lval,x   --to--   x
  96.  *    other: saves current place (on stack) and jumps to lval.
  97.  */
  98. _gosub(l,p) int(*l[])(),p;
  99. {
  100.     union value here,there;
  101.     if((status&XMODE) == M_FIXUP) return(++p);
  102.     if((status&XMODE) == M_EXECUTE) {
  103.         there = pop();
  104.         here.lval.codelist = gllentry(l);
  105.         here.lval.place = p+1;
  106. if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
  107.     here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
  108.         push(here);
  109.         Thisline = there.lval.codelist;
  110.         Thisline--;
  111.         Thisp = there.lval.place;
  112.     }
  113.         return(p);
  114. }
  115.  
  116. _return(l,p) int(*l[])(),p;
  117. {
  118.     union value loc;
  119.     if((status&XMODE) == M_FIXUP) return(++p);
  120.     if((status&XMODE) == M_EXECUTE) {
  121.         loc = pop();
  122.         Thisp = loc.lval.place;
  123.         Thisline = loc.lval.codelist;
  124.         Thisline--;
  125.     }
  126.         return(p);
  127. }
  128.  
  129. /* Routines control entering and leaving of loops.
  130.  *
  131.  *    enter -- makes a mark that we have entered a loop, and also records
  132.  *         branch points for "continue" and "leave".
  133.  *    exitlp -- undoes the mark made by enter.
  134.  *    contin -- branches to "continue" point.
  135.  *    leave -- branches to "leave" point.
  136.  *
  137.  * The following stack structure is used to record these loop markers.
  138.  */
  139.  
  140. struct loopstack {
  141.     struct label contlb,leavlb;
  142. };
  143.  
  144. struct loopstack lpstk[20];
  145. int lpstkp = -1;    /* -1 when stack is empty.
  146.              * always points to CURRENT loop marker.
  147.              */
  148.  
  149. /* M_COMPILE:
  150.  *    x rlabel contlb rlabel leavlb enter x
  151.  *--to--
  152.  *    x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
  153.  *
  154.  * M_EXECUTE:
  155.  *    loopstack: x    --to--   <contlb,leavlb>,x
  156.  */
  157. _enter(l,p) int (*l[])(),p;
  158. {
  159.     union value loc;
  160.  
  161.     if((status&XMODE) == M_EXECUTE) {
  162.     lpstkp++;
  163.     loc = pop();
  164. if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
  165.     loc.lval.codelist,loc.lval.place);
  166.     lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
  167.     lpstk[lpstkp].leavlb.place = loc.lval.place;
  168.     loc = pop();
  169. if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
  170.     lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
  171.     lpstk[lpstkp].contlb.place = loc.lval.place;
  172.     }
  173.     return(p);
  174. }
  175.  
  176. /* M_EXECUTE:
  177.  *    loopstack: <contlb,leavlb>,x    --to--   x
  178.  *    other: ensures that lpstkp doesnt get less that -1;
  179.  */
  180. _exitlp(l,p) int (*l[])(),p;
  181. {
  182.     if((status&XMODE) == M_EXECUTE)
  183.     if(lpstkp >= 0)
  184.         lpstkp--;
  185.     else
  186.         lpstkp = -1;
  187. if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
  188.     return(p);
  189. }
  190.  
  191. /* M_COMPILE:
  192.  *    x leave x   --to--   x,_leave,0,x
  193.  *    (the 0 is for the benefit of interp())
  194.  *
  195.  * M_EXECUTE:
  196.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  197.  *    other: branches to leavlb.  exitlp takes care of cleaning up stack.
  198.  */
  199. _leave(l,p) int(*l[])(),p;
  200. {
  201.     if((status&XMODE) == M_FIXUP) return(++p);
  202.     if((status&XMODE) == M_EXECUTE) {
  203.         if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
  204.         LVerror(l,p);
  205.         Thisline = lpstk[lpstkp].leavlb.codelist;
  206.         Thisline--;
  207.         Thisp = lpstk[lpstkp].leavlb.place;
  208.     }
  209.         return(p);
  210. }
  211.  
  212. /* M_COMPILE:
  213.  *    x contin x    --to--    x,_contin,0,x
  214.  *
  215.  * M_EXECUTE:
  216.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  217.  *    other: jumps to contlb.
  218.  */
  219. _contin(l,p) int (*l[])(),p;
  220. {
  221.     if((status&XMODE) == M_FIXUP) return(++p);
  222.     if((status&XMODE) == M_EXECUTE) {
  223.         if(lpstkp == -1) /* cannot continue a loop we're not in */
  224.         CNerror(l,p);
  225.         Thisline = lpstk[lpstkp].contlb.codelist;
  226.         Thisline--;
  227.         Thisp = lpstk[lpstkp].contlb.place;
  228.     }
  229.         return(p);
  230. }
  231.  
  232.  
  233.  
  234. /* M_COMPILE:
  235.  *    x rlabel name if x    --to--   x,_rlabel,vp,if,0,x
  236.  *    (the 0 is for the benefit for interp()).
  237.  * M_EXECUTE:
  238.  *    stack: loc,bool,x     --to--   x
  239.  *    p: if bool, p=p else p=loc->place
  240.  */
  241. _if(l,p)
  242. int (*l[])(),p;
  243. {
  244.     union value bv,lv;
  245.  
  246.     if((status&XMODE) == M_FIXUP) return(++p);
  247.     if((status&XMODE) == M_EXECUTE) {
  248.         lv = pop();
  249.         bv = pop();
  250. if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
  251.     p,bv.ival);
  252.         if(bv.ival == (long)0) { /* jump to else part. */
  253.         Thisline = lv.lval.codelist;
  254.         Thisline--;
  255.         Thisp = lv.lval.place;
  256.         }
  257.         else p++;    /* skip the 0 so we get to the then part */
  258.     }
  259.         return(p);
  260. }
  261.  
  262. /* M_COMPILE:
  263.  *    var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
  264.  *--to--
  265.  *    _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
  266.  *
  267.  * M_EXECUTE:
  268.  *    stack: xitpt,vizd,step,to,from,vp,x
  269.  *    other: if exit conditions are correct, jump to exit point.
  270.  *        vizd is used to hold the data type for vp.  Data types
  271.  *        are always non-zero so the test for the first visit to
  272.  *        the loop is to see if vizd is 0.
  273.  */
  274. _for(l,p) int(*l[])(),p;
  275. {
  276.     union value xitpt,vizd,from,to,step,place;
  277.  
  278.     if((status&XMODE) == M_FIXUP) return(++p);
  279.     if((status&XMODE) == M_EXECUTE) {
  280.         xitpt = pop();    vizd = pop();
  281.         step = pop();    to = pop();
  282.         from = pop();
  283. if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  284.     xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
  285.         if(vizd.ival == 0) { /* first visit to loop */
  286.         place = pop();
  287. if(dbg) printf("first time:var:%s:",place.vpval->name);
  288.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  289.         place.plval = getplace(place.vpval);
  290.         *(place.plval) = from;    /* since first time, set starting val */
  291.         if(vizd.ival == T_INT) { /* if it is an INT, convert to/from/step to INT also */
  292.             to.ival = (long)to.rval;
  293.             from.ival = (long)from.rval;
  294.             step.ival = (long)step.rval;
  295.         }
  296. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  297.         if(vizd.ival==T_INT && step.ival==0)
  298.             if(to.ival < from.ival)
  299.                 step.ival = -1;
  300.             else
  301.                 step.ival = 1;
  302.         else if(vizd.ival==T_DBL && step.rval==0)
  303.             if(to.rval < from.rval)
  304.                 step.rval = -1;
  305.             else
  306.                 step.rval = 1;
  307.         }
  308.         else place = pop();
  309. if(dbg) printf("var.place:%o:",place.plval);
  310.  
  311.         /* The stack frame is now correctly popped off.
  312.          * Next, we check if the loop is finished.
  313.          */
  314.  
  315.         if(vizd.ival == T_INT)
  316.         if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
  317.         else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
  318.         else /* vizd.ival == T_DBL */
  319.         if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
  320.         else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
  321.  
  322.         /* Loop is not done yet, push back stack frame. */
  323.  
  324. if(dbg) printf("loop not done, push everything back\n");
  325.         push(place);    push(from);    push(to);
  326.         push(step);        push(vizd);    push(xitpt);
  327.         return(++p);    /* skip over the 0 */
  328.  
  329.     /* Come here when the loop is finished. */
  330. loop_done:
  331. if(dbg) printf("loop done, jump to xitpt\n");
  332.         Thisline = xitpt.lval.codelist;
  333.         Thisline--;
  334.         Thisp = xitpt.lval.place;
  335.         return(p);    /* hit the 0 */
  336.     }
  337. return(p);
  338. }
  339.  
  340. /* M_COMPILE:
  341.  *    var name next rlabel FORx goto dlabel FORx+1
  342.  *--to--
  343.  *    _var,vp,_next,_rlabel,lblp,_goto,dlabel,lblp2
  344.  *
  345.  * M_EXECUTE:
  346.  *    stack: same as M_EXECUTE in _for.
  347.  *    other: adds step to (control var)->val.
  348.  */
  349. _next(l,p) int(*l[])(),p;
  350. {
  351.     union value vp,xitpt,vizd,step,to,from,place;
  352.  
  353.     if((status&XMODE) == M_EXECUTE) {
  354.         vp = pop();
  355. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  356.         vp.plval = getplace(vp.vpval);
  357. if(dbg) printf(":vp.pl:%o:",vp.plval);
  358.         xitpt = pop();    vizd = pop();    step = pop();
  359.         to = pop();        from = pop();    place = pop();
  360. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  361.     place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  362. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  363.     xitpt.lval.place,xitpt.lval.codelist->num);
  364.         if(place.plval != vp.plval) FNerror(l,p);
  365.         if(vizd.ival == T_INT)
  366.         place.plval->ival += step.ival;
  367.         else
  368.         place.plval->rval += step.rval;
  369.         push(place);    push(from);    push(to);    
  370.         push(step);        push(vizd);    push(xitpt);
  371.         return(p);
  372.     }
  373. return(p);
  374. }
  375.  
  376. /* variables needed for M_READ. */
  377.  
  378. struct line *dlist[DLSIZ];
  379. int dlp = 0;
  380. int dlindx = 2;        /* skips <_data,0> */
  381. int dtype;        /* type of last operation. */
  382.  
  383.  
  384. /* M_COMPILE:
  385.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  386.  * M_FIXUP:
  387.  *    allocates a spot in dlist, stores pointer to llist entry for
  388.  *    this line at that spot.
  389.  * M_EXECUTE:
  390.  *    Returns, with p pointing at the zero, making interp() return.
  391.  */
  392. _data(l,p) int(*l[])(),p;
  393. {
  394.     if((status&XMODE) == M_FIXUP) {
  395.         dlist[dlp++] = gllentry(l);
  396.         p++;
  397.     }
  398.     return(p);
  399. }
  400.  
  401. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  402.  */
  403. _dsep(l,p) int(*l[])(),p;
  404. {
  405.     if((status&XMODE) == M_FIXUP) ++p;
  406.     return(p);
  407. }
  408.  
  409. /* routines for changing the interpretors state. */
  410.  
  411. struct statstk {    /* for saving old states */
  412.     int stkp;
  413.     int stat;
  414. } sstk[30];
  415. int sstktop = 0;
  416.  
  417. /* M_COMPILE:
  418.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  419.  * M_FIXUP:
  420.  *    skip <state>
  421.  * any other state:
  422.  *    save old state and stack pointer.
  423.  *    set state to <state>.
  424.  */
  425. _pushstate(l,p) int (*l[])(),p;
  426. {
  427.     if((status&XMODE) == M_FIXUP) return(++p);
  428.         sstk[sstktop].stkp = stackp;
  429.         sstk[sstktop].stat = status;
  430.         sstktop++;
  431.         status = l[p++];
  432.         return(p);
  433. }
  434. _popstate(l,p) int (*l[])(),p;
  435. {
  436.     if((status&XMODE) == M_FIXUP) return(p); /* want to stay in this mode */
  437.         sstktop--;
  438.         stackp = sstk[sstktop].stkp;
  439.         status = sstk[sstktop].stat&XMODE;
  440.         return(p);
  441. }
  442.  
  443.  
  444. /* stack maintanence routines.
  445.  */
  446.  
  447.  
  448. /* M_COMPILE:
  449.  *    x spop x    --to--    x,_spop,x
  450.  * M_EXECUTE:
  451.  *    stack: string,x   --to--   x
  452.  *    other: frees storage used by string (if any).
  453.  */
  454. _spop(l,p) int(*l[])(),p;
  455. {
  456.     union value s;
  457.  
  458.     if((status&XMODE) == M_EXECUTE) {
  459.         s=pop();
  460.         if(s.sval != 0) free(s.sval);
  461.     }
  462.     return(p);
  463. }
  464.  
  465. /* M_COMPILE:
  466.  *    x pop x    --to--    x,_pop,x
  467.  * M_EXECUTE:
  468.  *    stack: int,x    --to--   x
  469.  */
  470. _pop(l,p) int(*l[])(),p;
  471. {
  472.     if((status&XMODE) == M_EXECUTE) pop();
  473.     return(p);
  474. }
  475.  
  476. _stop(l,p) int(*l[])(),p;
  477. {
  478.     if((status&XMODE) == M_EXECUTE) exit(1);
  479.     return(p);
  480. }
  481. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  482.  
  483.  
  484.