home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / logo / part03 / logoproc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-23  |  11.2 KB  |  598 lines
  1.  
  2. #include <stdio.h>
  3. #include "logo.h"
  4.  
  5. int errrec();
  6. int ehand2();
  7. int ehand3();
  8. int leave();
  9.  
  10. extern char popname[];
  11. extern int letflag, pflag, argno, yyline, rendflag, currtest;
  12. extern int traceflag, *stkbase, stkbi, yychar, endflag, topf;
  13. #ifdef PAUSE
  14. extern int pauselev, errpause, catching, flagquit;
  15. #endif
  16. #ifndef NOTURTLE
  17. extern int turtdes;
  18. #endif
  19. extern char charib, *getbpt, *ibufptr;
  20. extern char titlebuf[];
  21. extern struct lexstruct keywords[];
  22. extern struct stkframe *fbr;
  23. extern struct plist *proclist;
  24. extern struct object *multarg;
  25. extern struct runblock *thisrun;
  26. #ifndef YYSTYPE
  27. #define YYSTYPE int
  28. #endif
  29. extern YYSTYPE yylval;
  30.  
  31. int doprep = 0;
  32. int *newstk =NULL;
  33. int newsti =0;
  34. FILE *pbuf =0;
  35. struct plist *pcell =NULL;
  36. struct alist *locptr =NULL, *newloc =NULL;
  37. struct object *allocstk[MAXALLOC] ={0};
  38.  
  39. int memb(ch,str)
  40. register char ch,*str;
  41. {
  42.     register char ch1;
  43.  
  44.     while (ch1 = *str++)
  45.         if (ch == ch1) return(1);
  46.     return(0);
  47. }
  48.  
  49. char *token(str)
  50. register char *str;
  51. {
  52.     static char output[NAMELEN+5];
  53.     register char ch,*op;
  54.  
  55.     op = output;
  56.     while((op < &output[19]) && (ch = *str++) && !memb(ch," \t\"[\r\n:")){
  57.         if (ch >= 'A' && ch <= 'Z') ch += 'a'-'A';
  58.         *op++ = ch;
  59.     }
  60.     *op = '\0';
  61.     return(output);
  62. }
  63.  
  64. #ifdef DEBUG
  65. jfree(block)
  66. char *block;
  67. {
  68.     if (memtrace)
  69.         printf("Jfree loc=0%o\n",block);
  70.     if (block==0) printf("Trying to jfree zero.\n");
  71.     else free(block);
  72. }
  73. #endif
  74.  
  75. newproc(nameob)
  76. struct object *nameob;
  77. {
  78.     register char *name;
  79.     register struct stkframe *stemp;
  80.     register struct lincell *ltemp;
  81.     struct plist *pptr;
  82.     int linlab;
  83.     int itemp;
  84.     char *temp,*tstr;
  85.     struct object *title;
  86.     char s[100];
  87.     int olp;
  88.     int oldlet;
  89.     int olc,c;
  90.     int pc;
  91.     extern struct plist *proclook();
  92.  
  93.     name = nameob->obstr;
  94.     stemp=(struct stkframe *)ckzmalloc(sizeof(*stemp));
  95.     stemp->prevframe=fbr;
  96.     stemp->oldyyc= -2;
  97.     stemp->oldline= -1;
  98.     stemp->oldnewstk=newstk;
  99.     newstk = NULL;
  100.     stemp->oldnloc=newloc;
  101.     newloc=NULL;
  102.     stemp->argtord=argno;
  103.     stemp->prevpcell=pcell;
  104.     pcell = NULL;
  105.     stemp->loclist = NULL;
  106.     fbr=stemp;
  107.     doprep++;
  108.     argno=0;
  109.     if (pptr=proclook(name)) {
  110.         mfree(nameob);
  111.         newstk=pptr->realbase;
  112.         (pptr->recdepth)++;
  113.         title=pptr->ptitle;
  114.         pcell=pptr;
  115.     } else {
  116.         onintr(ehand2,&pbuf);
  117.         cpystr (s,name,EXTEN,NULL);
  118.         if (!(pbuf=fopen(s,"r"))) {
  119.             extern int errno;
  120.  
  121.             if (errno != 2) /* ENOENT */ {
  122.                 onintr(errrec,1);
  123. #ifdef SMALL
  124.                 printf("%s: error %d\n",s,errno);
  125. #else
  126.                 perror(s);
  127. #endif
  128.                 errhand();
  129.             }
  130.             cpystr(s,LIBLOGO,name,EXTEN,NULL);
  131.             if (!(pbuf = fopen(s,"r"))) {
  132.                 onintr(errrec,1);
  133.                 printf("You haven't told me how to %s.\n",name);
  134.                 errhand();
  135.             }
  136.         }
  137.         pptr=(struct plist *)ckzmalloc(sizeof(*pptr));
  138.         pptr->plines=NULL;
  139.         pptr->procname=globcopy(nameob);
  140.         mfree(nameob);
  141.         temp=s;
  142.         while ( ((c=getc(pbuf)) != EOF) && (c!='\n') ) *temp++=c;
  143.         if (c==EOF) {
  144.             printf("Bad format in %s title line.\n",
  145.                 pptr->procname->obstr);
  146.             errhand();
  147.         }
  148.         *temp++='\n';
  149.         *temp='\0';
  150.         title=globcopy(objcpstr(s));
  151.         pptr->after=proclist;
  152.         pptr->recdepth=1;
  153.         pptr->ptitle=title;
  154.         pptr->before=NULL;
  155.         if (proclist) proclist->before = pptr;
  156.         proclist=pptr;
  157.         pcell=pptr;
  158.     }
  159.     tstr = title->obstr;
  160. nextarg: while((c= *tstr++)!=':' && c!='\n')
  161.         ;
  162.     if (c==':') {
  163.         temp=s;
  164.         while ((c= *tstr++)!=' ' && c!='\n') *temp++=c;
  165.         *temp='\0';
  166.         tstr--;
  167.         loccreate(globcopy(objcpstr(s)),&newloc);
  168.         argno++;
  169.         goto nextarg;
  170.     }
  171.     if (pptr->recdepth!=1) return;
  172.     olp=pflag;
  173.     pflag=1;
  174.     oldlet=letflag;
  175.     letflag=0;
  176.     olc=charib;
  177.     charib=0;
  178.     newstk=(int *)ckmalloc(PSTKSIZ*sizeof(int));
  179.     *newstk=0;
  180.     newsti=1;
  181.     *(newstk+newsti) = -1;    /* BH 6/25/82 in case yylex blows up */
  182.     itemp = '\n';
  183.     while ((pc = yylex()) != -1) {
  184.         if (pc==1) return;
  185.         if ((itemp == '\n') && isuint(pc)) {
  186.             linlab=((struct object *)yylval)->obint;
  187.             ltemp=(struct lincell *)ckmalloc(sizeof(*ltemp));
  188.             ltemp->linenum=linlab;
  189.             ltemp->base=newstk;
  190.             ltemp->index=newsti;
  191.             ltemp->nextline=pptr->plines;
  192.             pptr->plines=ltemp;
  193.         }
  194.         *(newstk+newsti++)=pc;
  195.         if (newsti==PSTKSIZ-1) newfr();
  196.         *(newstk+newsti++)=yylval;
  197.         if (isstored(pc)) {
  198.             yylval = (YYSTYPE)globcopy(yylval);
  199.             mfree(yylval);
  200.         }
  201.         if (newsti==PSTKSIZ-1) newfr();
  202.         *(newstk+newsti) = -1;
  203.         itemp = pc;
  204.     }
  205.     *(newstk+newsti)= -1;
  206.     *(newstk+PSTKSIZ-1)=0;
  207.     pflag=olp;
  208.     letflag=oldlet;
  209.     charib=olc;
  210.     fclose(pbuf);
  211.     onintr(errrec,1);
  212.     while (*newstk!=0) newstk= (int *)*newstk;
  213.     pptr->realbase=newstk;
  214. }
  215.  
  216. procprep()
  217. {
  218.     doprep=0;
  219.     fbr->oldline=yyline;
  220.     fbr->oldbpt=getbpt;
  221.     getbpt=0;
  222.     fbr->loclist=locptr;
  223.     locptr=newloc;
  224.     newloc=NULL;
  225.     fbr->stk=stkbase;
  226.     stkbase=newstk;
  227.     newstk=NULL;
  228.     fbr->ind=stkbi;
  229.     stkbi=1;
  230.     newsti=0;
  231.     argno= -1;
  232.     fbr->oldpfg = pflag;
  233.     pflag=2;
  234.     fbr->iftest = currtest;
  235.     if (traceflag) intrace();
  236. }
  237.  
  238. frmpop(val)
  239. register struct object *val;
  240. {
  241.     struct alist *atemp0,*atemp1,*atemp2;
  242.     register struct stkframe *ftemp;
  243.     struct lincell *ltemp,*ltemp2;
  244.     register i;
  245.     int *stemp;
  246.     int stval;
  247.  
  248.     if (traceflag) outtrace(val);
  249.     if (!pcell) goto nopcell;
  250.     strcpy(popname,pcell->procname->obstr);
  251.     (pcell->recdepth)--;
  252.     if (pcell->recdepth==0) {
  253.         lfree(pcell->procname);
  254.         lfree(pcell->ptitle);
  255.         if (pcell->before) (pcell->before)->after=pcell->after;
  256.         else proclist=pcell->after;
  257.         if (pcell->after) (pcell->after)->before=pcell->before;
  258.         for(ltemp=pcell->plines;ltemp;ltemp=ltemp2) {
  259.             ltemp2=ltemp->nextline;
  260.             JFREE(ltemp);
  261.         }
  262.         if ((stemp=stkbase) == 0) goto nostack;
  263.         while (*stemp!=0) stemp= (int *)*stemp;
  264.         for (i=1;;i++) {
  265.             stval= *(stemp+i);
  266.             if (isstored(stval))
  267.             {
  268.                 if (i==PSTKSIZ-2) {
  269.                     stkbase= (int *)*(stemp+PSTKSIZ-1);
  270.                     JFREE(stemp);
  271.                     stemp=stkbase;
  272.                     i=0;
  273.                 }
  274.                 lfree(*(stemp+ (++i)));
  275.             } else if (stval== -1) {
  276.                 JFREE(stemp);
  277.                 break;
  278.             } else {
  279.                 if (i==PSTKSIZ-2) {
  280.                     stkbase= (int *)*(stemp+PSTKSIZ-1);
  281.                     JFREE(stemp);
  282.                     stemp=stkbase;
  283.                     i=1;
  284.                 } else i++;
  285.             }
  286.             if (i==PSTKSIZ-2) {
  287.                 stkbase= (int *)*(stemp+PSTKSIZ-1);
  288.                 JFREE(stemp);
  289.                 stemp=stkbase;
  290.                 i=0;
  291.             }
  292.         }
  293.     nostack:
  294.         JFREE(pcell);
  295.     }
  296. nopcell:
  297.     ftemp=fbr;
  298.     stkbase=ftemp->stk;
  299.     stkbi=ftemp->ind;
  300.     newstk=ftemp->oldnewstk;
  301.     atemp0=newloc;    /* BH 6/20/82 maybe never did procprep */
  302.     newloc=ftemp->oldnloc;
  303.     pflag = fbr->oldpfg;
  304.     atemp1=locptr;
  305.     locptr=ftemp->loclist;
  306.     argno=ftemp->argtord;
  307.     pcell=ftemp->prevpcell;
  308.     yychar=ftemp->oldyyc;
  309.     yylval=ftemp->oldyyl;
  310.     yyline=ftemp->oldline;
  311.     getbpt=ftemp->oldbpt;
  312.     currtest=ftemp->iftest;
  313.     fbr=ftemp->prevframe;
  314.     JFREE(ftemp);
  315.     while (atemp1) {
  316.         atemp2=atemp1->next;
  317.         if (atemp1->name) lfree(atemp1->name);
  318.         if (atemp1->val!=(struct object *)-1)    /* BH 2/28/80 was NULL instead of -1 */
  319.             lfree(atemp1->val);
  320.         JFREE(atemp1);
  321.         atemp1=atemp2;
  322.     }
  323.     while (atemp0) {
  324.         atemp2=atemp0->next;
  325.         if (atemp0->name) lfree(atemp0->name);
  326.         if (atemp0->val!=(struct object *)-1)
  327.             lfree(atemp0->val);
  328.         JFREE(atemp0);
  329.         atemp0=atemp2;
  330.     }
  331. }
  332.  
  333. proccreate(nameob)
  334. register struct object *nameob;
  335. {
  336.     register char *name;
  337.     char temp[16];
  338.     register FILDES edfd;
  339.     int pid;
  340.  
  341. #ifndef NOTURTLE
  342.     if (turtdes<0) textscreen();
  343. #endif
  344.     name = token(nameob->obstr);
  345.     if (strlen(name)>NAMELEN) {
  346.         pf1("Procedure name must be no more than %d letters.",NAMELEN);
  347.         errhand();
  348.     }
  349.     cpystr(temp,name,EXTEN,NULL);
  350.     if ((edfd=open(temp,READ,0))>=0) {
  351.         close(edfd);
  352.         nputs(name);
  353.         puts(" is already defined.");
  354.         errhand();
  355.     }
  356.     if ((edfd = creat(temp,0666)) < 0) {
  357.         printf("Can't write %s.\n",name);
  358.         errhand();
  359.     }
  360.     onintr(ehand3,edfd);
  361.     mfree(nameob);
  362.     write(edfd,titlebuf,strlen(titlebuf));
  363.     addlines(edfd);
  364.     onintr(errrec,1);
  365. }
  366.  
  367. help()
  368. {
  369.     FILE *sbuf;
  370.  
  371.     sbuf=fopen(HELPFILE,"r");
  372.     if (sbuf == NULL) {
  373.         printf("? Help file missing, sorry.\n");
  374.         return;
  375.     }
  376.     onintr(ehand2,sbuf);
  377.     while(putch(getc(sbuf))!=EOF)
  378.         ;
  379.     fclose(sbuf);
  380.     onintr(errrec,1);
  381. }
  382.  
  383. struct object *describe(arg)
  384. struct object *arg;
  385. {
  386.     register char *argstr;
  387.     register struct lexstruct *lexp;
  388.     FILE *sbuf;
  389.     char fname[30];
  390.  
  391.     if (!stringp(arg)) ungood("Describe",arg);
  392.     argstr = token(arg->obstr);
  393.     for (lexp = keywords; lexp->word; lexp++)
  394.          if (!strcmp(argstr,lexp->word) || 
  395.              (lexp->abbr && !strcmp(argstr,lexp->abbr)))
  396.             break;
  397.     if (!lexp->word) {
  398.         pf1("%p isn't a primitive.\n",arg);
  399.         errhand();
  400.     }
  401.     if (strlen(lexp->word) > 9)    /* kludge for Eunice */
  402.         cpystr(fname,DOCLOGO,lexp->abbr,NULL);
  403.     else
  404.         cpystr(fname,DOCLOGO,lexp->word,NULL);
  405.     if (!(sbuf=fopen(fname,"r"))) {
  406.         printf("Sorry, I have no information about %s\n",lexp->word);
  407.         errhand();
  408.     } else {
  409.         onintr(ehand2,sbuf);
  410.         while (putch(getc(sbuf))!=EOF)
  411.             ;
  412.         fclose(sbuf);
  413.     }
  414.     onintr(errrec,1);
  415.     mfree(arg);
  416.     return ((struct object *)(-1));
  417. }
  418.  
  419. errwhere()
  420. {
  421.     register i =0;
  422.     register struct object **astk;
  423.     register struct plist *opc;
  424.  
  425.     cboff();    /* BH 12/13/81 */
  426.     ibufptr=NULL;
  427.     if (doprep) {
  428.         procprep();
  429.         frmpop(-1);
  430.     }
  431.  
  432.     for (astk=allocstk;i<MAXALLOC;i++)
  433.         if (astk[i]!=0)
  434.             mfree(astk[i]);
  435.  
  436.     if (multarg) {
  437.         lfree(multarg);
  438.         multarg = 0;
  439.     }    /* BH 10/31/81 multarg isn't on astk, isn't mfreed. */
  440.  
  441. #ifdef PAUSE
  442.     if ((errpause||pauselev) && fbr && !topf) {
  443.         /* I hope this pauses on error */
  444.         if (!pflag && !getbpt) charib=0;
  445.         dopause();
  446.     }
  447.     else
  448. #endif
  449.     {
  450.         opc = pcell;
  451.         if (fbr && fbr->oldline==-1) {
  452.             opc=fbr->prevpcell;
  453.         }
  454.         if (opc&&!topf)
  455.             printf("You were at line %d in procedure %s\n",
  456.                 yyline,opc->procname->obstr);
  457.     }
  458. }
  459.  
  460. errzap() {
  461.     while (thisrun)
  462.         unrun();
  463.  
  464.     while (fbr)
  465.         frmpop(-1);
  466.  
  467.     charib=0;
  468.     if(traceflag)traceflag=1;
  469.     topf=0;
  470.     yyline=0;
  471.     letflag=0;
  472.     pflag=0;
  473.     endflag=0;
  474.     rendflag=0;
  475.     argno= -1;
  476.     newstk=NULL;
  477.     newsti=0;
  478.     stkbase=NULL;
  479.     stkbi=0;
  480.     fbr=NULL;
  481.     locptr=NULL;
  482.     newloc=NULL;
  483.     proclist=NULL;
  484.     pcell=NULL;
  485. #ifdef PAUSE
  486.     pauselev = 0;
  487. #endif
  488. }
  489.  
  490. errrec()
  491. {
  492.     /* Here on SIGQUIT */
  493. #ifdef PAUSE
  494.     if (catching)
  495. #endif
  496.         errhand();
  497. #ifdef PAUSE
  498.     flagquit++;    /* We'll catch this later */
  499. #endif
  500. }
  501.  
  502. ehand2(fle)
  503. register FILE *fle;
  504. {
  505.     fclose(fle);
  506.     errhand();
  507. }
  508.  
  509. ehand3(fle)
  510. register FILDES fle;
  511. {
  512.     close(fle);
  513.     errhand();
  514. }
  515.  
  516. struct object *tracefuns = 0;
  517.  
  518. ltrace() {    /* trace everything */
  519.     lfree(tracefuns);
  520.     tracefuns = (struct object *)0;
  521.     traceflag = 1;
  522. }
  523.  
  524. luntrace() {    /* trace nothing */
  525.     lfree(tracefuns);
  526.     tracefuns = (struct object *)0;
  527.     traceflag = 0;
  528. }
  529.  
  530. struct object *sometrace(funs)
  531. struct object *funs;
  532. {
  533.     if (funs==0) {
  534.         luntrace();
  535.     } else if (!listp(funs)) {
  536.         ungood("Trace",funs);
  537.     } else {
  538.         tracefuns = globcopy(funs);
  539.         mfree(funs);
  540.         traceflag = 1;
  541.     }
  542.     return ((struct object *)(-1));
  543. }
  544.  
  545. int chktrace(procname)
  546. char *procname;
  547. {
  548.     struct object *rest;
  549.  
  550.     if (tracefuns == 0) return(1);
  551.     for (rest=tracefuns; rest; rest=rest->obcdr) {
  552.         if (!stringp(rest->obcar)) continue;
  553.         if (!strcmp(token(rest->obcar->obstr),procname)) return(1);
  554.     }
  555.     return(0);
  556. }
  557.  
  558. intrace()
  559. {
  560.     register struct alist *aptr;
  561.  
  562.     if (!pcell) return;
  563.     if (!chktrace(pcell->procname->obstr)) return;
  564.     indent(traceflag-1);
  565.     nputs(pcell->procname->obstr);
  566.     if (locptr && (locptr->val != (struct object *)-1)) {
  567.         pf1(" of %l",locptr->val);    /* BH locptr->val was inval */
  568.         for (aptr=locptr->next;aptr;aptr=aptr->next) {
  569.             if (aptr->val == (struct object *)-1) break;
  570.             pf1(" and %l",aptr->val);    /* was inval */
  571.         }
  572.         putchar('\n');
  573.     }
  574.     else puts(" called.");
  575.     fflush(stdout);
  576.     traceflag++;
  577. }
  578.  
  579. outtrace(retval)
  580. register struct object *retval;
  581. {
  582.     if (!pcell) return;
  583.     if (!chktrace(pcell->procname->obstr)) return;
  584.     if (traceflag>1) traceflag--;
  585.     indent(traceflag-1);
  586.     nputs(pcell->procname->obstr);
  587.     if (retval != (struct object *)-1) pf1(" outputs %l\n",retval);
  588.     else puts(" stops.");
  589.     fflush(stdout);
  590. }
  591.  
  592. indent(no)
  593. register int no;
  594. {
  595.     while (no--)putchar(' ');
  596. }
  597.  
  598.