home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / logo / part04 / logo.y
Encoding:
Text File  |  1987-06-23  |  19.1 KB  |  852 lines

  1.  
  2. %nonassoc LOWPREC
  3. %nonassoc '<' '>' '='
  4. %left '+' '-'
  5. %left '*' '/' '\\'
  6. %left '^'
  7. %left UNARY
  8. %token TWOOP ONEOP NOOP ONECOM
  9. %token CSTRING UINT
  10. %token LTO IFCOM LEDIT LIFTF LTRACE
  11. %token LPROC LPEND LAEND LGO
  12. %token CLIST TWOCOM NOCOM
  13. %token RUNCOM RNEND REPCOM THREECOM
  14. %{ 
  15. #include "logo.h"
  16.  
  17. char popname[NAMELEN+1];
  18. int multnum;
  19. struct object *multarg = 0;
  20. #include <setjmp.h>
  21. extern jmp_buf runret;
  22. jmp_buf yerrbuf;
  23. int catching = 0;
  24. int flagquit = 0;
  25. extern struct runblock *thisrun;
  26. #ifndef NOTURTLE
  27. extern int turtdes;
  28. extern struct display *mydpy;
  29. #endif
  30. int errtold = 0;
  31. int yyline =0;
  32. char ibuf[IBUFSIZ] ={0};
  33. char *ibufptr =NULL;
  34. char *getbpt =0;
  35. char titlebuf[100] ={0};
  36. char *titleptr =NULL;
  37. extern char *cpystr();
  38. int letflag =0;
  39. int topf =0;
  40. int pflag =0;
  41. char charib =0;
  42. int endflag =0, rendflag = 0;
  43. int traceflag =0;
  44. int currtest = 0;
  45. int argno =(-1);
  46. int *stkbase =NULL;
  47. int stkbi =0;
  48. struct stkframe *fbr =NULL;
  49. struct plist *proclist =NULL;
  50. #ifdef PAUSE
  51. int pauselev = 0;
  52. extern int psigflag,errpause;
  53. #endif
  54.  
  55. struct object *add(), *sub(), *mult(), *div(), *rem(), *and(), *or();
  56. struct object *greatp(), *lessp(), *lmax(), *lmin(), *lis();
  57. struct object *worcat(), *sencat(), *equal(), *lemp(), *comp();
  58. struct object *lnump(), *lsentp(), *lwordp(), *length(), *zerop();
  59. struct object *first(), *butfir(), *last(), *butlas(), *alllk();
  60. struct object *lnamep(), *lrandd(), *rnd(), *sq(), *lpow(), *lsin();
  61. struct object *lcos(), *latan(), *ltime(), *request(), *readlist();
  62. struct object *cmprint(), *cmtype(), *cmoutput(), *lsleep(), *lbreak();
  63. struct object *cmlocal(), *assign(), *cmedit(), *lstop(), *show(), *erase();
  64. struct object *help(), *describe(), *ltrace(), *luntrace(), *lbyecom();
  65. struct object *sometrace();
  66. #ifndef NOTURTLE
  67. struct object *getturtle(), *forward(), *back();
  68. struct object *left(), *right(), *penup(), *cmpendown(), *clearscreen();
  69. struct object *fullscreen(), *splitscreen(), *showturtle();
  70. struct object *hideturtle(), *textscreen(), *cmpenerase(), *pencolor();
  71. struct object *wipeclean(), *penmode(), *penreverse(), *shownp(), *towardsxy();
  72. struct object *setcolor(), *setxy(), *setheading();
  73. struct object *xcor(), *ycor(), *heading(), *getpen();
  74. struct object *scrunch(), *setscrunch();
  75. #endif
  76. struct object *ltopl(), *cmfprint(), *cmftype(), *pots(), *fput(), *lput();
  77. struct object *list(), *loread(), *lowrite(), *fileclose(), *cbreak();
  78. struct object *lfread(), *lfword(), *fileprint(), *filefprint();
  79. struct object *filetype(), *fileftype(), *callunix(), *repcount();
  80. #ifdef DEBUG
  81. struct object *setdebquit(), *setmemtrace(), *setyaccdebug();
  82. #endif
  83. struct object *readchar(), *keyp(), *intpart(), *round(), *toascii();
  84. struct object *tochar(), *loflush(), *settest(), *memberp(), *item();
  85. #ifdef PAUSE
  86. struct object *unpause(), *dopause(), *setipause(), *setqpause(); /* PAUSE */
  87. struct object *seterrpause(), *clrerrpause();
  88. #endif
  89. #ifdef FLOOR
  90. struct object *hitoot(), *lotoot(), *lampon(), *lampoff();
  91. struct object *ftouch(), *btouch(), *ltouch(), *rtouch();
  92. #endif
  93. #ifndef SMALL
  94. struct object *gprop(), *plist(), *pps(), *remprop();
  95. #endif
  96. #ifdef SETCURSOR
  97. struct object *clrtxt(), *setcur();
  98. #endif
  99.  
  100. struct lexstruct keywords[] =
  101. {
  102.     "sum",TWOOP,add,NULL,
  103.     "difference",TWOOP,sub,"diff",
  104.     "product",TWOOP,mult,NULL,
  105.     "quotient",TWOOP,div,NULL,
  106.     "remainder",TWOOP,rem,"mod",
  107.     "both",TWOOP,and,"and",
  108.     "either",TWOOP,or,"or",
  109.     "greaterp",TWOOP,greatp,NULL,
  110.     "lessp",TWOOP,lessp,NULL,
  111.     "maximum",TWOOP,lmax,"max",
  112.     "minimum",TWOOP,lmin,"min",
  113.     "is",TWOOP,lis,NULL,
  114.     "word",TWOOP,worcat,NULL,
  115.     "sentence",TWOOP,sencat,"se",
  116.     "equalp",TWOOP,equal,NULL,
  117.     "emptyp",ONEOP,lemp,NULL,
  118.     "not",ONEOP,comp,NULL,
  119.     "numberp",ONEOP,lnump,NULL,
  120.     "sentencep",ONEOP,lsentp,NULL,
  121.     "wordp",ONEOP,lwordp,NULL,
  122.     "count",ONEOP,length,NULL,
  123.     "zerop",ONEOP,zerop,NULL,
  124.     "first",ONEOP,first,NULL,
  125.     "butfirst",ONEOP,butfir,"bf",
  126.     "last",ONEOP,last,NULL,
  127.     "butlast",ONEOP,butlas,"bl",
  128.     "thing",ONEOP,alllk,NULL,
  129.     "namep",ONEOP,lnamep,NULL,
  130.     "random",ONEOP,rnd,"rnd",
  131.     "sqrt",ONEOP,sq,NULL,
  132.     "pow",TWOOP,lpow,NULL,
  133.     "sin",ONEOP,lsin,NULL,
  134.     "cos",ONEOP,lcos,NULL,
  135.     "arctan",ONEOP,latan,"atan",
  136.     "time",NOOP,ltime,NULL,
  137.     "request",NOOP,request,NULL,
  138.     "readlist",NOOP,readlist,"rl",
  139.     "print",ONECOM,cmprint,"pr",
  140.     "type",ONECOM,cmtype,NULL,
  141.     "output",ONECOM,cmoutput,"op",
  142.     "wait",ONECOM,lsleep,NULL,
  143.     "local",ONECOM,cmlocal,NULL,
  144.     "make",TWOCOM,assign,NULL,
  145.     "if",IFCOM,0,NULL,
  146.     "to",LTO,0,NULL,
  147.     "end",LPEND,0,NULL,
  148.     "stop",NOCOM,lstop,NULL,
  149.     "break",NOCOM,lbreak,NULL,
  150.     "edit",LEDIT,cmedit,"ed",
  151.     "go",LGO,0,NULL,
  152.     "show",ONECOM,show,"po",
  153.     "erase",ONECOM,erase,"er",
  154.     "help",NOCOM,help,NULL,
  155.     "describe",ONECOM,describe,NULL,
  156.     "trace",LTRACE,sometrace,NULL,
  157.     "untrace",NOCOM,luntrace,NULL,
  158.     "goodbye",NOCOM,lbyecom,"bye",
  159. #ifndef NOTURTLE
  160.     "turtle",ONECOM,getturtle,"tur",
  161.     "forward",ONECOM,forward,"fd",
  162.     "back",ONECOM,back,"bk",
  163.     "left",ONECOM,left,"lt",
  164.     "right",ONECOM,right,"rt",
  165. #ifdef FLOOR
  166.     "hitoot",ONECOM,hitoot,"hit",
  167.     "lotoot",ONECOM,lotoot,"lot",
  168.     "lampon",NOCOM,lampon,"lon",
  169.     "lampoff",NOCOM,lampoff,"loff",
  170. #endif
  171.     "penup",NOCOM,penup,"pu",
  172.     "pendown",NOCOM,cmpendown,"pd",
  173.     "clearscreen",NOCOM,clearscreen,"cs",
  174.     "fullscreen",NOCOM,fullscreen,"full",
  175.     "splitscreen",NOCOM,splitscreen,"split",
  176.     "showturtle",NOCOM,showturtle,"st",
  177.     "hideturtle",NOCOM,hideturtle,"ht",
  178.     "textscreen",NOCOM,textscreen,"text",
  179.     "penerase",NOCOM,cmpenerase,"pe",
  180.     "pencolor",ONECOM,pencolor,"penc",
  181.     "setcolor",TWOCOM,setcolor,"setc",
  182.     "setxy",TWOCOM,setxy,NULL,
  183.     "setheading",ONECOM,setheading,"seth",
  184.     "wipeclean",NOCOM,wipeclean,"clean",
  185.     "penmode",NOOP,penmode,NULL,
  186.     "penreverse",NOCOM,penreverse,"px",
  187.     "shownp",NOOP,shownp,NULL,
  188.     "towardsxy",TWOOP,towardsxy,NULL,
  189. #ifdef FLOOR
  190.     "ftouch",NOOP,ftouch,"fto",
  191.     "btouch",NOOP,btouch,"bto",
  192.     "ltouch",NOOP,ltouch,"lto",
  193.     "rtouch",NOOP,rtouch,"rto",
  194. #endif
  195.     "xcor",NOOP,xcor,NULL,
  196.     "ycor",NOOP,ycor,NULL,
  197.     "heading",NOOP,heading,NULL,
  198.     "getpen",NOOP,getpen,NULL,
  199.     "scrunch",NOOP,scrunch,NULL,
  200.     "setscrunch",ONECOM,setscrunch,"setscrun",
  201. #endif
  202.     "toplevel",NOCOM,ltopl,NULL,
  203.     "fprint",ONECOM,cmfprint,"fp",
  204.     "ftype",ONECOM,cmftype,"fty",
  205.     "pots",NOCOM,pots,NULL,
  206.     "fput",TWOOP,fput,NULL,
  207.     "lput",TWOOP,lput,NULL,
  208.     "list",TWOOP,list,NULL,
  209.     "openread",ONEOP,loread,"openr",
  210.     "openwrite",ONEOP,lowrite,"openw",
  211.     "close",ONECOM,fileclose,NULL,
  212.     "fileread",ONEOP,lfread,"fird",
  213.     "fileword",ONEOP,lfword,"fiwd",
  214.     "fileprint",TWOCOM,fileprint,"fip",
  215.     "filefprint",TWOCOM,filefprint,"fifp",
  216.     "filetype",TWOCOM,filetype,"fity",
  217.     "fileftype",TWOCOM,fileftype,"fifty",
  218.     "unix",ONECOM,callunix,NULL,
  219.     "run",RUNCOM,0,NULL,
  220.     "repeat",REPCOM,0,NULL,
  221.     "repcount",NOOP,repcount,NULL,
  222. #ifdef DEBUG
  223.     "debquit",NOCOM,setdebquit,NULL,
  224.     "memtrace",NOCOM,setmemtrace,NULL,
  225.     "yaccdebug",NOCOM,setyaccdebug,NULL,
  226. #endif
  227.     "cbreak",ONECOM,cbreak,NULL,
  228.     "readchar",NOOP,readchar,"rc",
  229.     "keyp",NOOP,keyp,NULL,
  230.     "int",ONEOP,intpart,NULL,
  231.     "round",ONEOP,round,NULL,
  232.     "ascii",ONEOP,toascii,NULL,
  233.     "char",ONEOP,tochar,NULL,
  234.     "oflush",NOCOM,loflush,NULL,
  235. #ifndef SMALL
  236.     "gprop",TWOOP,gprop,NULL,
  237.     "plist",ONEOP,plist,NULL,
  238.     "pprop",THREECOM,0,NULL,
  239.     "pps",NOCOM,pps,NULL,
  240.     "remprop",TWOCOM,remprop,NULL,
  241. #endif
  242.     "test",ONECOM,settest,NULL,
  243.     "iftrue",LIFTF,(struct object *(*)())1,"ift",
  244.     "iffalse",LIFTF,0,"iff",
  245.     "memberp",TWOOP,memberp,NULL,
  246.     "item",TWOOP,item,"nth",
  247. #ifdef PAUSE
  248.     "continue",NOCOM,unpause,"co",
  249.     "pause",NOCOM,dopause,NULL,
  250.     "setipause",NOCOM,setipause,NULL,
  251.     "setqpause",NOCOM,setqpause,NULL,
  252.     "errpause",NOCOM,seterrpause,NULL,
  253.     "errquit",NOCOM,clrerrpause,NULL,
  254. #endif
  255. #ifdef SETCURSOR
  256.     "cleartext",NOCOM,clrtxt,"ct",
  257.     "setcursorxy",TWOCOM,setcur,"setcxy",
  258. #endif
  259.     NULL,NULL,NULL,NULL,
  260. };
  261.  
  262. #define uperror {errtold++;YYERROR;}
  263.  
  264. #ifdef PAUSE
  265. #define catch(X) {if(!setjmp(yerrbuf)){if(flagquit)errhand();catching++;X;catching=0;}else{catching=0;uperror}}
  266. #else
  267. #define catch(X) {X;}
  268. #endif
  269. %}
  270. %%
  271. start_sym :  |
  272.      start_sym command  ={
  273.         popname[0] = '\0';
  274. #ifdef PAUSE
  275.         if (psigflag) dopause();
  276. #endif
  277.         yyprompt(1);
  278.     } |
  279.     start_sym error ={
  280.         popname[0] = '\0';
  281.         if (!errtold) {
  282.             logoyerror();
  283.         }
  284.         errtold = 0;
  285.         errwhere();
  286. #ifdef PAUSE
  287.         if ((!errpause&&!pauselev) || !fbr)
  288. #endif
  289.             errzap();
  290.         yyerrok;yyclearin;
  291.         yyprompt(0);
  292.     };
  293. command :
  294.     LEDIT rnewline ={
  295.         catch(doedit(););
  296.         $$ = -1;
  297.     } |
  298.     LTRACE rnewline ={
  299.         catch(ltrace(););
  300.         $$ = -1;
  301.     } |
  302.     onecom valuearg newline ={
  303.         catch($$=(int)(*keywords[$1].lexval)($2););} |
  304.     onecom error ={notenf($1);uperror;} |
  305.     TWOCOM valuearg valuearg newline ={
  306.         catch((*keywords[$1].lexval)($2,$3);); $$ = -1;} |
  307.     TWOCOM error ={notenf($1);uperror;} |
  308.     THREECOM valuearg valuearg valuearg newline ={
  309. #ifndef SMALL
  310.         catch(pprop($2,$3,$4););
  311. #endif
  312.         $$ = -1;
  313.     } |
  314.     THREECOM error ={
  315.         if (!errtold) {
  316.             puts("Not enough inputs to pprop.");
  317.         }
  318.         uperror;
  319.     } |
  320.     rnewline ={ $$= -1; } |
  321.     NOCOM newline ={
  322.         catch((*keywords[$1].lexval)();); $$= -1;} |
  323.     LGO white3 valuearg newline ={
  324.         catch(go($3););
  325.         $$= -1;
  326.         } |
  327.     LGO error ={notenf($1);uperror;} |
  328.     ifcall ={
  329.         if (($1 != -1) && !endflag) {
  330.             if (!errtold)
  331.                 pf1("You don't say what to do with %l.\n",$1);
  332.             uperror;
  333.         }
  334.         $$ = $1;
  335.     } |
  336.     title ={
  337.         if ($1== -1)
  338.             uperror
  339.         else
  340.             catch(proccreate($1););
  341.             $$ = -1;
  342.     } |
  343.     arg newline {
  344.         if (thisrun && !pflag) {
  345.             $$ = $1;
  346.         } else {
  347.             if(($1 != -1) && !endflag) {
  348.                 if (!errtold)
  349.                     pf1("You don't say what to do with %l\n",$1);
  350.                 uperror;
  351.             }
  352.         }
  353.     } ;
  354.  
  355. onecom : ONECOM | LEDIT | LTRACE ;
  356.  
  357. valuearg:    userarg ={
  358.             if ($1 == -1) {
  359.                 if (!errtold) {
  360.                     printf("%s didn't output.\n",
  361.                         popname);
  362.                 }
  363.                 uperror;
  364.             }
  365.         } |
  366.         sysarg ;
  367.  
  368. labint : UINT %prec UNARY ={ yyline=((struct object *)$1)->obint; mfree($1); $$ = 0;};
  369.  
  370. arg :    userarg | sysarg ;
  371.  
  372. userarg : proccall %prec UNARY |
  373.     runcall %prec LOWPREC ;
  374.  
  375. sysarg : TWOOP valuearg valuearg %prec LOWPREC ={
  376.         catch($$=(int)(*keywords[$1].lexval)($2,$3););
  377.     } |
  378.     TWOOP valuearg error %prec LOWPREC ={op2er1($1,$2);uperror;} |
  379.     TWOOP error %prec LOWPREC ={notenf($1);uperror;} |
  380.     ONEOP valuearg %prec LOWPREC ={
  381.         catch($$=(int)(*keywords[$1].lexval)($2););
  382.     } |
  383.     ONEOP error %prec LOWPREC ={notenf($1);uperror;} |
  384.     NOOP %prec LOWPREC ={
  385.         catch($$=(int)(*keywords[$1].lexval)(););
  386.     } |
  387.     UINT %prec LOWPREC |
  388.     '\"' CSTRING { $$=$2; } |
  389.     '[' CLIST ']' { $$=$2; } |
  390.     ':' CSTRING {
  391.         catch($$=(int)alllk($2););
  392.         } |
  393.     valuearg '+' valuearg ={
  394.         catch($$=(int)add($1,$3););
  395.     } |
  396.     valuearg '+' error ={inferr($1,$2);uperror;} |
  397.     valuearg '-' valuearg ={
  398.         catch($$=(int)sub($1,$3););
  399.     } |
  400.     valuearg '-' error ={inferr($1,$2);uperror;} |
  401.     '-' valuearg %prec UNARY ={
  402.         catch($$=(int)opp($2););
  403.     } |
  404.     '-' error %prec UNARY ={unerr('-');uperror;} |
  405.     valuearg '^' valuearg {
  406.         catch($$=(int)lpow($1,$3););
  407.     } |
  408.     valuearg '^' error { inferr($1,$2);uperror; } |
  409.     valuearg '*' valuearg ={
  410.         catch($$=(int)mult($1,$3););
  411.     } |
  412.     valuearg '*' error ={inferr($1,$2);uperror;} |
  413.     valuearg '/' valuearg ={
  414.         catch($$=(int)div($1,$3););
  415.     } |
  416.     valuearg '/' error ={inferr($1,$2);uperror;} |
  417.     valuearg '\\' valuearg ={
  418.         catch($$=(int)rem($1,$3););
  419.     } |
  420.     valuearg '\\' error ={inferr($1,$2);uperror;} |
  421.     valuearg '=' valuearg ={
  422.         catch($$=(int)equal($1,$3);)
  423.     } |
  424.     valuearg '=' error ={inferr($1,$2);uperror;} |
  425.     valuearg '<' valuearg ={
  426.         catch($$=(int)lessp($1,$3););
  427.     } |
  428.     valuearg '<' error ={inferr($1,$2);uperror;} |
  429.     valuearg '>' valuearg ={
  430.         catch($$=(int)greatp($1,$3););
  431.     } |
  432.     valuearg '>' error ={inferr($1,$2);uperror;} |
  433.     '{' TWOOP oparglist rbrak {
  434.         catch($$=multiop($2,globcopy(multarg)););
  435.         lfree(multarg);
  436.         multarg = 0;
  437.     }|
  438.     '(' TWOOP oparglist rbrak {
  439.         catch($$=multiop($2,globcopy(multarg)););
  440.         lfree(multarg);
  441.         multarg = 0;
  442.     }|
  443.     '(' valuearg rbrak ={$$=$2;} ;
  444.  
  445. oparglist : valuearg ={
  446.         catch(multarg = globcons($1,0););
  447.         mfree($1);
  448.         multnum = 1;
  449.     } |
  450.     valuearg oparglist ={
  451.         catch(multarg = globcons($1,multarg););
  452.         mfree($1);
  453.         multnum++;
  454.     };
  455. title : tbegin varlist '\n' ={
  456.         strcpy(titleptr,"\n");
  457.         $$=$1;
  458.     } |
  459.     tbegin '\n' ={
  460.         strcpy(titleptr,"\n");
  461.         $$=$1;
  462.     } |
  463.     tbegin varlist error ={
  464.         mfree($1);
  465.         terr();
  466.         $$= -1;
  467.     } |
  468.     tbegin error ={
  469.         mfree($1);
  470.         terr();
  471.         $$= -1;
  472.     };
  473. tbegin : LTO LPROC ={
  474.         titleptr=cpystr(titlebuf,"to ",
  475.             ((struct object *)($2))->obstr,NULL);
  476.         $$=$2;
  477.     } | 
  478.     LTO primitive ={
  479.         if (!errtold) printf("Can't redefine primitive %s\n",
  480.             keywords[$2].word);
  481.         uperror;
  482.     };
  483. primitive : NOOP | ONEOP | TWOOP | NOCOM | ONECOM | TWOCOM | THREECOM
  484.         | IFCOM | LTO | LEDIT | LIFTF | LGO
  485.         | RUNCOM | REPCOM | LPEND ;
  486. varlist : varsyn ={titleptr=cpystr(titleptr," :",
  487.             ((struct object *)($1))->obstr,NULL);
  488.         mfree($1);
  489.     } |
  490.     varlist varsyn {titleptr=cpystr(titleptr," :",
  491.             ((struct object *)($2))->obstr,NULL);
  492.         mfree($2);
  493.     } ;
  494. varsyn : ':' CSTRING {$$=$2;};
  495. proccall : procname args argend commlist procend ={
  496.         $$=$4;
  497.         frmpop($4);
  498.     } |
  499.     procname error ={
  500.         if (!errtold) printf("Not enough inputs to %s\n",
  501.             proclist->procname->obstr);
  502.         uperror;
  503.     };
  504. args: |    arglist;
  505. arglist : valuearg %prec LOWPREC ={
  506.         catch(argassign($1););
  507.     } |
  508.     arglist valuearg %prec LOWPREC ={
  509.         catch(argassign($2););
  510.     } ;
  511. argend : LAEND ={procprep();};
  512. commlist : ={yyline=1; $$ = -1;} |
  513.     commlist labint command ={
  514.         popname[0] = '\0';
  515. #ifdef PAUSE
  516.         if (psigflag) dopause();
  517.         if (thisrun && thisrun->str == (struct object *)(-1))
  518.             yyprompt(1);
  519. #endif
  520.         $$=$3;
  521.     } |
  522.     commlist command ={
  523.         popname[0] = '\0';
  524.         if (pflag) yyline++;
  525. #ifdef PAUSE
  526.         if (psigflag) dopause();
  527.         if (thisrun && thisrun->str == (struct object *)(-1))
  528.             yyprompt(1);
  529. #endif
  530.         $$=$2;
  531.     } |
  532.     commlist error ={
  533.         popname[0] = '\0';
  534. #ifdef PAUSE
  535.         if ((!errpause&&!pauselev) || !fbr)
  536. #endif
  537.             uperror;
  538. #ifdef PAUSE
  539.         if (!errtold) {
  540.             logoyerror();
  541.         }
  542.         errtold = 0;
  543.         errwhere();
  544.         yyerrok;yyclearin;
  545.         if (thisrun && thisrun->str == (struct object *)(-1))
  546.             yyprompt(0);
  547. #endif
  548.     };
  549. procend : LPEND |
  550.     labint LPEND ;
  551. procname : LPROC ={
  552.         catch(newproc($1););
  553.     };
  554. rcommlist : ={$$ = -1;} |
  555.     rcommlist command ={
  556.         popname[0] = '\0';
  557. #ifdef PAUSE
  558.         if (psigflag) dopause();
  559.         if (thisrun && thisrun->str == (struct object *)(-1))
  560.             yyprompt(1);
  561. #endif
  562.         $$=$2;
  563.     } |
  564.     rcommlist error ={
  565.         popname[0] = '\0';
  566. #ifdef PAUSE
  567.         if ((!errpause&&!pauselev) || !fbr)
  568. #endif
  569.             uperror;
  570. #ifdef PAUSE
  571.         if (!errtold) {
  572.             logoyerror();
  573.         }
  574.         errtold = 0;
  575.         errwhere();
  576.         yyerrok;yyclearin;
  577.         if (thisrun && thisrun->str == (struct object *)(-1))
  578.             yyprompt(0);
  579. #endif
  580.     };
  581. runcall : realrun | reprun | ifrun ;
  582. realrun : runstart rcommlist runend ={
  583.         unrun();
  584.         $$ = $2;
  585.         strcpy(popname,"run");
  586.     };
  587. reprun : reprstart rcommlist runend ={
  588.         unrun();
  589.         $$ = $2;
  590.         strcpy(popname,"repeat");
  591.     };
  592. ifrun : ifrstart rcommlist runend ={
  593.         unrun();
  594.         $$ = $2;
  595.         strcpy(popname,"if");
  596.     };
  597. runstart : RUNCOM valuearg %prec LOWPREC ={
  598.         catch(dorun($2,(FIXNUM)0););
  599.     } ;
  600. reprstart : REPCOM valuearg valuearg %prec LOWPREC ={
  601.         catch(dorep($2,$3););
  602.     } ;
  603. ifrstart : IFCOM valuearg valuearg valuearg %prec LOWPREC ={
  604.         {
  605.             int i;
  606.  
  607.             catch(i = truth($2););
  608.             if (i) {
  609.                 catch(dorun($3,(FIXNUM)0););
  610.                 mfree($4);
  611.             } else {
  612.                 catch(dorun($4,(FIXNUM)0););
  613.                 mfree($3);
  614.             }
  615.         }
  616.     } |
  617.     IFCOM error ={
  618.         if (!errtold) printf("Not enough inputs to if.\n");
  619.         uperror;
  620.     } ;
  621. runend : RNEND;
  622. ifcall : ifstart rcommlist runend ={
  623.         unrun();
  624.         $$ = $2;
  625.     };
  626. ifstart : IFCOM valuearg valuearg rnewline ={
  627.         {
  628.             int i;
  629.  
  630.             catch(i = truth($2););
  631.             if (i) {catch(dorun($3,(FIXNUM)0););}
  632.             else {
  633.                 catch(dorun(0,(FIXNUM)0););
  634.                 mfree($3);
  635.             }
  636.         }
  637.     } |
  638.     LIFTF valuearg newline ={
  639.         if ((int)keywords[$1].lexval==currtest) {
  640.             catch(dorun($2,(FIXNUM)0););
  641.         } else {
  642.             catch(dorun(0,(FIXNUM)0););
  643.             mfree($2);
  644.         }
  645.     } ;
  646. white3 : | LTO ;
  647. rbrak : '}' | ')' ;
  648. newline    : '\n' | ';' | ;
  649. rnewline : '\n' | ';' ;
  650. %%
  651.  
  652. extern struct object *makelist();
  653.  
  654. #ifdef PAUSE
  655. yylex1()
  656. #else
  657. yylex()
  658. #endif
  659. {
  660.     register char *str;
  661.     char s[100];
  662.     char c;
  663.     register pc;
  664.     register i;
  665.     NUMBER dubl;
  666.     int floatflag;
  667.     FIXNUM fixn;
  668.  
  669.     if (yyerrflag) return(1);
  670.     else if (argno==0 && pflag!=1) {
  671.         if (fbr->oldyyc==-2) fbr->oldyyc= -1;
  672.         return(LAEND);
  673.     } else if (endflag==1 && pflag>1) {
  674.         endflag=0;
  675.         return(LPEND);
  676.     }
  677.     else if (pflag==2) {
  678.         pc= *(stkbase+stkbi++);
  679.         if (stkbi==PSTKSIZ-1) {
  680.             stkbase= (int *)(*(stkbase+PSTKSIZ-1));
  681.             stkbi=1;
  682.         }
  683.         yylval= *(stkbase+stkbi++);
  684.         if (pc==LPROC || pc==CSTRING || pc==UINT || pc==CLIST) {
  685.             yylval=(int)localize((struct object *)yylval);
  686.         }
  687.         if (stkbi==PSTKSIZ-1) {
  688.             stkbase= (int *)(*(stkbase+PSTKSIZ-1));
  689.             stkbi=1;
  690.         }
  691.         if (pc== -1) return(0);
  692.         else return(pc);
  693.     } else if (letflag==1) {
  694.         str=s;
  695.         while (!index(" \t\n[](){}\";",(c = getchar()))) {
  696.             if (c == '\\') c = getchar() /* |0200 */ ;
  697.             else if (c == '%') c = ' ' /* |0200 */ ;
  698.             *str++ = c;
  699.         }
  700.         charib=c;
  701.         *str='\0';
  702.         yylval=(int)localize(objcpstr(s));
  703.         letflag=0;
  704.         return(CSTRING);
  705.     } else if (letflag==2) {
  706.         str = s;
  707.         while (( (c=getchar())>='a' && c<='z' )
  708.                 || (c>='A' && c<='Z') || (c>='0' && c<='9')
  709.                 || (c=='.') || (c=='_') ) {
  710.             if (c>='A' && c<='Z') c += 040;
  711.             *str++ = c;
  712.         }
  713.         charib = c;
  714.         *str = '\0';
  715.         letflag = 0;
  716.         yylval = (int)localize(objcpstr(s));
  717.         return(CSTRING);
  718.     }
  719.     else if (letflag==3) {
  720.         yylval = (int)makelist();
  721.         letflag = 4;
  722.         return(CLIST);
  723.     }
  724.     else if (letflag==4) {
  725.         letflag = 0;
  726.         return(yylval = getchar());
  727.     }
  728.     while ((c=getchar())==' ' || c=='\t')
  729.         ;
  730.     if (rendflag) {
  731.         getbpt = 0;
  732.         if (rendflag < 3)
  733.             --rendflag;
  734.         else if (!thisrun || thisrun->svpflag)
  735.             rendflag = 0;
  736.         return(RNEND);
  737.     }
  738.  
  739.     if (c == '!')    /* comment feature */
  740.         while ((c=getchar()) && (c != '\n')) ;
  741.  
  742.     if ((c<'a' || c>'z') && (c<'A' || c>'Z')
  743.             && (c<'0' || c>'9') && c!='.') {
  744.         yylval=c;
  745.         if (c=='\"') letflag=1;
  746.         if (c==':') letflag=2;
  747.         if (c=='[') letflag=3;
  748.         return(c);
  749.     }
  750.     else if ((c>='0' && c<='9')|| c=='.') {
  751.         floatflag = (c=='.');
  752.         str=s;
  753.         while ((c>='0' && c<='9')||(c=='E')||(c=='e')||(c=='.')) {
  754.             *str++=c;
  755.             if (c=='.') floatflag++;
  756.             if ((c=='e')||(c=='E')) {
  757.                 floatflag++;
  758.                 c = getchar();
  759.                 if ((c=='+')||(c=='-')) {
  760.                     *str++ = c;
  761.                     c = getchar();
  762.                 }
  763.             } else c=getchar();
  764.         }
  765.         charib=c;
  766.         *str='\0';
  767.         if (floatflag) {
  768.             sscanf(s,EFMT,&dubl);
  769.             yylval=(int)localize(objdub(dubl));
  770.         } else {
  771.             sscanf(s,FIXFMT,&fixn);
  772.             yylval=(int)localize(objint(fixn));
  773.         }
  774.         return(UINT);
  775.     } else {
  776.         if (c < 'a') c += 040;
  777.         yylval=(int)(str=s);
  778.         *str++=c;
  779.         c=getchar();
  780.         if (c >= 'A' && c <= 'Z') c += 040;
  781.         while ((c>='a' && c<='z') || (c>='0' && c<='9')
  782.                 || (c=='.') || (c=='_')) {
  783.             *str++=c;
  784.             c=getchar();
  785.             if (c >= 'A' && c <= 'Z') c += 040;
  786.         }
  787.         charib=c;
  788.         *str='\0';
  789.         for (i=0; keywords[i].word; i++) {
  790.             if (!strcmp(yylval,keywords[i].word) ||
  791.                  (keywords[i].abbr && 
  792.                   !strcmp(yylval,keywords[i].abbr))) {
  793.                 yylval=i;
  794.                 return(keywords[i].lexret);
  795.             }
  796.         }
  797.         yylval=(int)localize(objcpstr(s));
  798.         return(LPROC);
  799.     }
  800. }
  801.  
  802. #ifdef PAUSE
  803. yylex() {
  804.     int x;
  805.  
  806.     if (catching) return(yylex1());
  807.     if (!setjmp(yerrbuf)) {
  808.         if (flagquit) errhand();
  809.         catching++;
  810.         x = yylex1();
  811.         catching=0;
  812.         return(x);
  813.     } else {
  814.         catching=0;
  815.         return(12345);    /* This should cause an error up there */
  816.     }
  817. }
  818. #endif
  819.  
  820. int isuint(x)
  821. int x;
  822. {
  823.     return(x == UINT);
  824. }
  825.  
  826. int isstored(x)
  827. int x;
  828. {
  829.     return(x==UINT || x==LPROC || x==CSTRING || x==CLIST);
  830. }
  831.  
  832. yyprompt(clear) {
  833.     register int i;
  834.  
  835.     if (!ibufptr && !getbpt && !pflag) {
  836.         flagquit = 0;
  837. #ifdef PAUSE
  838.         if (pauselev > 0) {
  839.             for (i=pauselev; --i >=0; )
  840.                 putchar('-');
  841.         }
  842. #endif
  843.         putchar('?');
  844. #ifndef NOTURTLE
  845.         if ((turtdes<0) && clear)
  846.             (*mydpy->state)('*');
  847. #endif
  848.         fflush(stdout);
  849.     }
  850. }
  851.  
  852.