home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume18 / spin / part02 / exec.c
Encoding:
C/C++ Source or Header  |  1989-03-08  |  13.0 KB  |  616 lines
  1. /* exec.c - execution for spin
  2.  *
  3.  * 16.Oct.87  jimmc  Initial definition
  4.  * 21.Oct.87  jimmc  Add xexec stuff
  5.  * 22.Oct.87  jimmc  Add I and S arg types
  6.  *  4.Nov.87  jimmc  Add longjmp stuff, use SPescape
  7.  *  5.Nov.87  jimmc  Add SPbool
  8.  * 30.Nov.87  jimmc  Lint cleanup
  9.  * 18.Jan.88  jimmc  Allow negative default values for I arg format
  10.  */
  11. /* LINTLIBRARY */
  12.  
  13. #include <stdio.h>
  14. #include <ctype.h>
  15. #include <strings.h>
  16. #include "goto.h"
  17. #include "xalloc.h"
  18. #include "spin.h"
  19. #include "spinparse.h"
  20. #include "exec.h"
  21.  
  22. typedef char *string;
  23. typedef int (*intfuncp)();
  24. typedef double (*dblfuncp)();
  25. typedef string (*strfuncp)();
  26. typedef SPtoken * (*listfuncp)();
  27.  
  28. int (*SPxexecp)();
  29.  
  30. SPsetxexecp(funcp)
  31. int (*funcp)();
  32. {
  33.     SPxexecp = funcp;
  34. }
  35.  
  36. SPtoken *
  37. SPnewnil()
  38. {
  39. SPtoken *rval;
  40.  
  41.     ALLOCTOKEN(rval)
  42.     rval->type = SPTokNil;
  43.     return rval;
  44. }
  45.  
  46. SPtoken *
  47. SPcopytoken(tk)
  48. SPtoken *tk;
  49. {
  50. SPtoken *newtk, *ltk, *newltk, *prevltk;
  51.  
  52.     if (!tk) return NIL;
  53.     if (tk->type==SPTokList) {
  54.         ALLOCTOKEN(newtk)
  55.         *newtk = *tk;
  56.         newtk->value.l = NIL;
  57.         prevltk = NIL;
  58.         for (ltk=tk->value.l; ltk; ltk=ltk->next) {
  59.             newltk = SPcopytoken(ltk);
  60.             newltk->next = NIL;
  61.             if (!newtk->value.l) newtk->value.l = newltk;
  62.             else prevltk->next = newltk;
  63.             prevltk = newltk;
  64.         }
  65.         return newtk;
  66.     }
  67.     ALLOCTOKEN(newtk)
  68.     *newtk = *tk;    /* structure copy */
  69.     if (tk->type==SPTokStr || tk->type==SPTokName) {
  70.         newtk->value.s = XALLOCM(char,strlen(tk->value.s)+1,
  71.                     "copy token");
  72.         strcpy(newtk->value.s,tk->value.s);
  73.     }
  74.     return newtk;
  75. }
  76.  
  77. SPtoken *
  78. SPexec(tk)
  79. SPtoken *tk;
  80. {
  81. SPtoken *SPexeclist(), *SPexecname();
  82.  
  83. #if 0    /* sometimes useful for debugging */
  84. printf("exec\n");
  85. SPdumptoken(tk);
  86. #endif
  87.     if (!tk) return NIL;
  88.     if (tk->type!=SPTokList) {    /* treat as constant */
  89.         return SPcopytoken(tk);
  90.     }
  91. /* It is a list, so we need to examine the first item in the list
  92.  * and base our mode of execution on that item.
  93.  */
  94.     tk = tk->value.l;
  95.     if (!tk) return SPnewnil();
  96.     switch (tk->type) {
  97.     case SPTokList:
  98.         return SPexeclist(tk);
  99.     case SPTokName:
  100.         return SPexecname(tk);
  101.     default:
  102.         SPescape("BadExecList",
  103.             "bad node type %c in list execution",tk->type);
  104.         /* NOTREACHED */
  105.     }
  106. }
  107.  
  108. SPtoken *
  109. SPqexec(tk)
  110. SPtoken *tk;
  111. {
  112.     if (!tk) return NIL;
  113.     if (tk->type==SPTokList) return SPexec(tk);
  114.     return tk;
  115. }
  116.  
  117. int
  118. SPbool(tk)    /* returns boolean value for token */
  119. SPtoken *tk;
  120. {
  121.     if (!tk) return 0;
  122.     switch (tk->type) {
  123.     case SPTokInt:
  124.         return (tk->value.n!=0);
  125.     case SPTokFloat:
  126.         return (tk->value.f!=0.0);
  127.     case SPTokNil:
  128.         return 0;
  129.     case SPTokStr:
  130.     case SPTokName:
  131.         return (tk->value.s!=0 && tk->value.s[0]!=0);
  132.     case SPTokList:
  133.         return (tk->value.l!=0);
  134.     default:
  135.         SPescape("UnknownType","unknown node type %c",tk->type);
  136.         /* NOTREACHED */
  137.     }
  138. }
  139.  
  140. int
  141. SPbooleval(tk)
  142. SPtoken *tk;
  143. {
  144.     return SPbool(SPqexec(tk));
  145. }
  146.  
  147. SPtoken *
  148. SPexecname(tk)
  149. SPtoken *tk;
  150. {
  151. char *name;
  152. SPfuncinfo *finfo, *SPfindfunc();
  153. SPtoken *tkval;
  154. int argc;
  155. int argv[100];
  156. char *argstr;
  157. int argtype;
  158. SPtoken *rval;
  159. int rtype;
  160. int t;
  161. int n;
  162. float f;
  163. char *s;
  164. SPtoken *l;
  165. int dflti;
  166. char *dflts, *dflts0;
  167. double *dptr;
  168. int (*ifp)();
  169. double (*ffp)();
  170. char * (*sfp)();
  171. SPtoken * (*lfp)();
  172. static char *badargs="BadArgument";
  173. static char *toomanyargsdef="TooManyArgsDef";
  174. static char *badargstr="BadArgstrFormat";
  175.  
  176.     if (!tk || tk->type!=SPTokName) return NIL;
  177.     name = tk->value.s;
  178. #if 0
  179. printf("execname %s\n", name);
  180. #endif
  181.     finfo = SPfindfunc(name);
  182.     if (!finfo) {
  183.         /* maybe it's a user-defined function */
  184.         if (SPxexecp) {
  185.             ALLOCTOKEN(rval)
  186.             t = (*SPxexecp)(name,tk->next,rval);
  187.             if (t) return rval;    /* he did it! */
  188.             FREETOKEN(rval)
  189.         }
  190.         SPescape("NoSuchFunction","can't fund function %s",name);
  191.         /* NOTREACHED */
  192.     }
  193.     argc = 0;
  194.     argstr = finfo->args+1;
  195.     tk = tk->next;
  196.     while (*argstr && *argstr!=';') {
  197.         argtype = *argstr;
  198.         switch (argtype) {
  199.         case 'b':        /* any type, converted to bool int */
  200.             tkval = SPqexec(tk);
  201.             if (!tkval) {
  202.                 SPescape(badargs,"needed arg for %s",name);
  203.                 /* NOTREACHED */
  204.             }
  205.             argv[argc++] = SPbool(tkval);
  206.             break;
  207.         case 'i':        /* int */
  208.             tkval = SPqexec(tk);
  209.             if (tkval && tkval->type==SPTokInt) {
  210.                 argv[argc++] = tkval->value.n;
  211.             }
  212.             else {
  213.                 SPescape(badargs,"needed int for %s",name);
  214.                 /* NOTREACHED */
  215.             }
  216.             break;
  217.         case 'I':    /* optional int */
  218.             if (argstr[1]=='-') {
  219.                 argstr++;
  220.                 dflti = -atoi(argstr+1);
  221.             } else {
  222.                 dflti = atoi(argstr+1);
  223.             }
  224.             while (isdigit(argstr[1])) argstr++;
  225.             tkval = SPqexec(tk);
  226.             if (tkval)
  227.                 if (tkval->type==SPTokInt) {
  228.                     argv[argc++] = tkval->value.n;
  229.                 }
  230.                 else {
  231.                     SPescape(badargs,"needed int for %s",
  232.                         name);
  233.                     /* NOTREACHED */
  234.                 }
  235.             else {
  236.                 argv[argc++] = dflti;
  237.             }
  238.             break;
  239.         case 'f':        /* float */
  240.             tkval = SPqexec(tk);
  241.             if (tkval && tkval->type==SPTokFloat) {
  242.                 dptr = (double *)(argv+argc);
  243.                 *dptr = (double)(tkval->value.f);
  244.                 argc = ((int *)dptr)-argv;
  245.             }
  246.             else {
  247.                 SPescape(badargs,"needed float for %s",name);
  248.                 /* NOTREACHED */
  249.             }
  250.             break;
  251.         case 'n':        /* name */
  252.         case 's':        /* string */
  253.             tkval = SPqexec(tk);
  254.             if (tkval && (tkval->type==SPTokName ||
  255.                 (argtype=='s'&&tkval->type==SPTokStr))) {
  256.                 ((char **)argv)[argc++] = tkval->value.s;
  257.             }
  258.             else {
  259.                 SPescape(badargs,"needed %s for %s",
  260.                     argtype=='n'?"name":"string",name);
  261.                 /* NOTREACHED */
  262.             }
  263.             break;
  264.         case 'S':        /* optional string */
  265.             if (argstr[1]=='N') {
  266.                 dflts = NIL;
  267.                 ++argstr;
  268.             }
  269.             else if (argstr[1]=='"') {    /* read str */
  270.                 argstr += 2;    /* point past quote */
  271.                 dflts0 = argstr;
  272.                 while (*argstr!=0 && *argstr!='"') {
  273.                     argstr++;
  274.                 }
  275.                 dflts = XALLOC(char,argstr-dflts0+1);
  276.                 strncpy(dflts,dflts0,argstr-dflts0);
  277.                 dflts[argstr-dflts0]=0;
  278.             }
  279.             else {
  280.                 SPescape("BadArgstrFormat",
  281.                     "bad format in arg string for %s",
  282.                     name);
  283.                 /* NOTREACHED */
  284.             }
  285.             tkval = SPqexec(tk);
  286.             if (tkval) {
  287.                 if ((tkval->type==SPTokName ||
  288.                     (argtype=='S'&&tkval->type==SPTokStr))) {
  289.                     ((char **)argv)[argc++] =
  290.                         tkval->value.s;
  291.                     XFREE(dflts);
  292.                 }
  293.                 else {
  294.                     SPescape(badargs,"needed %s for %s",
  295.                         argtype=='n'?"name":"string",name);
  296.                     /* NOTREACHED */
  297.                 }
  298.             }
  299.             else {
  300.                 ((char **)argv)[argc++] = dflts;
  301.             }
  302.             break;
  303.         case 'V':        /* single evaluated variable */
  304.             tkval = SPqexec(tk);
  305.             if (!tkval) tkval=SPnewnil();
  306.             ((SPtoken **)argv)[argc++] = tkval;
  307.             break;
  308.         case 'L':        /* unevaluated list */
  309.             ((SPtoken **)argv)[argc++] = tk;
  310.             break;
  311.         case 'R':    /* remainder of list as one arg, uneval. */
  312.             ALLOCTOKEN(tkval)
  313.             tkval->type = SPTokList;
  314.             tkval->next = 0;
  315.             tkval->value.l = tk;
  316.             tk = 0;
  317.             ((SPtoken **)argv)[argc++] = tkval;
  318.             break;
  319.         default:
  320.             SPescape(badargstr,
  321.                 "bad arg type %c in func %s",argtype,name);
  322.             /* NOTREACHED */
  323.         }
  324.         if (*argstr) argstr++;
  325.         if (tk) tk = tk->next;
  326.     }
  327.     if (tk) {
  328.         SPescape("TooManyArgs","too many arguments for %s",name);
  329.         /* NOTREACHED */
  330.     }
  331.     if (*argstr && *argstr!=';') {
  332.         SPescape("NotEnoughArgs","not enough arguments for %s", name);
  333.         /* NOTREACHED */
  334.     }
  335.     ALLOCTOKEN(rval)
  336.     rtype = finfo->args[0];
  337.     switch (rtype) {    /* return value type */
  338.     case 'i':    /* int */
  339.     case 'v':    /* no return value */
  340.         ifp = finfo->funcp;
  341.         switch (argc) {
  342.         case 0: n = (*ifp)(); break;
  343.         case 1: n = (*ifp)(argv[0]); break;
  344.         case 2: n = (*ifp)(argv[0],argv[1]); break;
  345.         case 3: n = (*ifp)(argv[0],argv[1],argv[2]); break;
  346.         case 4: n = (*ifp)(argv[0],argv[1],argv[2],argv[3]); break;
  347.         default:
  348.             SPescape(toomanyargsdef,
  349.                 "too many args in definition of %s",name);
  350.             /* NOTREACHED */
  351.         }
  352.         if (rtype=='v') {
  353.             rval->type = SPTokNil;
  354.         } else {
  355.             rval->type = SPTokInt;
  356.             rval->value.n = n;
  357.         }
  358.         break;
  359.     case 'f':    /* float (double) */
  360.         ffp = (dblfuncp)(finfo->funcp);
  361.         switch (argc) {
  362.         case 0: f = (*ffp)(); break;
  363.         case 1: f = (*ffp)(argv[0]); break;
  364.         case 2: f = (*ffp)(argv[0],argv[1]); break;
  365.         case 3: f = (*ffp)(argv[0],argv[1],argv[2]); break;
  366.         case 4: f = (*ffp)(argv[0],argv[1],argv[2],argv[3]); break;
  367.         default:
  368.             SPescape(toomanyargsdef,
  369.                 "too many args in definition of %s",name);
  370.             /* NOTREACHED */
  371.         }
  372.         rval->type = SPTokFloat;
  373.         rval->value.f = f;
  374.         break;
  375.     case 'n':    /* name */
  376.     case 's':    /* string */
  377.     case 'S':    /* allocated string */
  378.         sfp = (strfuncp)(finfo->funcp);
  379.         switch (argc) {
  380.         case 0: s = (*sfp)(); break;
  381.         case 1: s = (*sfp)(argv[0]); break;
  382.         case 2: s = (*sfp)(argv[0],argv[1]); break;
  383.         case 3: s = (*sfp)(argv[0],argv[1],argv[2]); break;
  384.         case 4: s = (*sfp)(argv[0],argv[1],argv[2],argv[3]); break;
  385.         default:
  386.             SPescape(toomanyargsdef,
  387.                 "too many args in definition of %s",name);
  388.             /* NOTREACHED */
  389.         }
  390.         if (rtype=='n')
  391.             rval->type = SPTokName;
  392.         else
  393.             rval->type = SPTokStr;
  394.         if (islower(rtype) || !s) {
  395.             if (!s) s="";
  396.             rval->value.s =
  397.                 XALLOCM(char,strlen(s)+1,"eval str func");
  398.         }
  399.         else {
  400.             rval->value.s = s;    /* allocated for us */
  401.         }
  402.         strcpy(rval->value.s,s);
  403.         break;
  404.     case 'V':    /* returns an already allocated var token */
  405.     case 'l':    /* returns a static list */
  406.     case 'L':    /* returns an already-allocated list */
  407.         lfp = (listfuncp)finfo->funcp;
  408.         switch (argc) {
  409.         case 0: l = (*lfp)(); break;
  410.         case 1: l = (*lfp)(argv[0]); break;
  411.         case 2: l = (*lfp)(argv[0],argv[1]); break;
  412.         case 3: l = (*lfp)(argv[0],argv[1],argv[2]); break;
  413.         case 4: l = (*lfp)(argv[0],argv[1],argv[2],argv[3]); break;
  414.         default:
  415.             SPescape(toomanyargsdef,
  416.                 "too many args in definition of %s",name);
  417.             /* NOTREACHED */
  418.         }
  419.         FREETOKEN(rval)
  420.         if (islower(rtype))
  421.             rval = SPcopytoken(l);
  422.         else
  423.             rval = l;
  424.         break;
  425.     default:
  426.         SPescape(badargstr,"bad return code type %c for %s",rtype,name);
  427.         rval->type = SPTokNil;
  428.         break;
  429.     }
  430.     return rval;
  431. }
  432.  
  433. /* execute all of the nodes in a list of nodes */
  434. SPtoken *
  435. SPexeclist(tklist)
  436. SPtoken *tklist;
  437. {
  438. SPtoken *rval;
  439. jmp_bufp savejbufp;
  440. jmp_buf ourjbuf;
  441. SPtoken *tk, *jtk;
  442.  
  443.     rval = NIL;
  444.     savejbufp = SPjbufp;
  445.     SPjbufp = jmpbuf_addr(ourjbuf);
  446.     for (tk=tklist; tk; tk=tk->next) {
  447.         if (rval) FREETOKEN(rval)
  448.         if (setjmp(jmpbuf_ref(SPjbufp))) {    /* process goto */
  449.             for (jtk=tklist; jtk; jtk=jtk->next) {
  450.                 if (SPisgotolabel(jtk)) {
  451.                     tk = jtk;    /* go there */
  452.                     goto foundlabel; /* resume execution */
  453.                 }
  454.             }
  455.             /* didn't find the label, keep going up */
  456.             SPjbufp = savejbufp;
  457.             longjmp(jmpbuf_ref(SPjbufp),1);
  458.         }
  459. foundlabel:
  460.         rval = SPexec(tk);    /* execute one node */
  461.     }
  462.     SPjbufp = savejbufp;
  463.     return rval;
  464. }
  465.  
  466. int    /* returns 1 if the node is a label list and matches SPgotolabel */
  467. SPisgotolabel(tk)
  468. SPtoken *tk;
  469. {
  470. SPtoken *tkl, *tkln;
  471.  
  472.     if (tk &&
  473.         tk->type==SPTokList &&
  474.         ((tkl=tk->value.l)) &&
  475.         tkl->type==SPTokName &&
  476.         tkl->value.s &&
  477.         strcmp(tkl->value.s,"label")==0 &&
  478.         ((tkln=tkl->next)) &&
  479.         tkln->type==SPTokName &&
  480.         tkln->value.s &&
  481.         strcmp(tkln->value.s,SPgotolabel)==0
  482.        ) {
  483.         return 1;    /* found it */
  484.     }
  485.     return 0;    /* not this one */
  486. }
  487.  
  488. /*..........*/
  489.  
  490. SPfuncinfo *SPfuncbase;
  491.  
  492. SPfuncinfo *
  493. SPfindfunc(name)
  494. char *name;        /* name of the func to find */
  495. {
  496. SPfuncinfo *finfo;
  497.  
  498.     for (finfo=SPfuncbase; finfo; finfo=finfo->next)
  499.         if (strcmp(finfo->name,name)==0) return finfo;
  500.     return NIL;
  501. }
  502.  
  503. SPfuncinfo *
  504. SPnewfunc(name)        /* make a new entry for the name */
  505. char *name;
  506. {
  507. SPfuncinfo *finfo;
  508.  
  509.     finfo = XALLOCM(SPfuncinfo,1,"newfunc");
  510.     finfo->name = name;
  511.     finfo->next = SPfuncbase;
  512.     SPfuncbase = finfo;
  513.     return finfo;
  514. }
  515.  
  516. /* VARARGS2 */ /* not really - but third arg is of variable type */
  517. void
  518. SPdeffunc(name,args,funcp)
  519. char *name;        /* the name of the function */
  520. char *args;        /* type of args encoded as string */
  521. void (*funcp)();    /* pointer to the function */
  522. {
  523. SPfuncinfo *finfo;
  524.  
  525.     if (strlen(args)<1) {
  526.         SPwerror("args string for %s is too short", name);
  527.         return;
  528.     }
  529.     finfo = SPfindfunc(name);    /* find the function */
  530.     if (finfo) {        /* redefinition */
  531.         SPwerror("%s redefined",name);
  532.     }
  533.     else {            /* new */
  534.         finfo = SPnewfunc(name);
  535.     }
  536.     finfo->args = args;
  537.     finfo->funcp = funcp;
  538. }
  539.  
  540. /*..........*/
  541.  
  542. SPprintval(stream,tk,indent)
  543. FILE *stream;
  544. SPtoken *tk;
  545. int indent;
  546. {
  547. int i;
  548. SPtoken *ltk;
  549.  
  550.     for (i=0;i<indent;i++)
  551.         fputs("  ",stream);
  552.     if (!tk) fprintf(stream,"<NIL>\n");
  553.     else switch (tk->type) {
  554.     case SPTokNil: fprintf(stream,"NIL\n"); break;
  555.     case SPTokInt: fprintf(stream,"INT %d\n",tk->value.n); break;
  556.     case SPTokFloat: fprintf(stream,"FLOAT %g\n",tk->value.f); break;
  557.     case SPTokStr: fprintf(stream,"STRING %s\n",tk->value.s); break;
  558.     case SPTokName: fprintf(stream,"NAME %s\n",tk->value.s); break;
  559.     case SPTokList:
  560.         fprintf(stream,"LIST:\n");
  561.         for (ltk=tk->value.l; ltk; ltk=ltk->next)
  562.             SPprintval(stream,ltk,indent+1);
  563.         break;
  564.     default:
  565.         fprintf(stream,"Type %03o (%c)\n",tk->type,tk->type);
  566.         break;
  567.     }
  568. }
  569.  
  570. /*..........*/
  571.  
  572. /* some debug routines which print out tokens */
  573. void
  574. SPdumptoken(tk)
  575. SPtoken *tk;
  576. {
  577.     if (!tk) {
  578.         printf("NIL pointer\n");
  579.         return;
  580.     }
  581.     if (!isprint(tk->type)) {
  582.         printf("bad type: %03o\n", tk->type);
  583.         return;
  584.     }
  585.     printf("type=%c",tk->type);
  586.     switch (tk->type) {
  587.     case SPTokInt:
  588.         printf(" %d", tk->value.n);
  589.         break;
  590.     case SPTokFloat:
  591.         printf(" %f", tk->value.f);
  592.         break;
  593.     case SPTokStr:
  594.     case SPTokName:
  595.         printf(" %s", tk->value.s);
  596.         break;
  597.     case SPTokList:
  598.         printf("\n");
  599.         SPdumptokenlist(tk->value.l);
  600.         break;
  601.     }
  602.     printf("\n");
  603. }
  604.  
  605. void
  606. SPdumptokenlist(tk)
  607. SPtoken *tk;
  608. {
  609.     while (tk) {
  610.         SPdumptoken(tk);
  611.         tk = tk->next;
  612.     }
  613. }
  614.  
  615. /* end */
  616.