home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / logo / part03 / logoaux.c next >
Encoding:
C/C++ Source or Header  |  1987-06-23  |  10.9 KB  |  676 lines
  1.  
  2. /*    This file contains a miscellany of functions for LOGO, both
  3.  * primary implementation of LOGO operations and commands, and also various
  4.  * other functions for maintaining the overhead of the interpreter (variable
  5.  * storage, function calls, etc.)
  6.  *
  7.  *    Copyright (C) 1979, The Children's Museum, Boston, Mass.
  8.  *    Written by Douglas B. Klunder
  9.  */
  10.  
  11. #include "logo.h"
  12. #include <sgtty.h>
  13. #include <setjmp.h>
  14. extern jmp_buf yerrbuf;
  15. int tvec[2] ={0,0};
  16. extern int yychar,yylval,yyline;
  17. extern int topf,errtold,flagquit;
  18. extern FILE *ofile;
  19. extern char *ostring;
  20. extern char *getbpt;
  21. extern char charib;
  22. extern int pflag,letflag;
  23. extern int currtest;
  24. struct runblock *thisrun = NULL;
  25. extern struct plist *pcell;    /* for PAUSE */
  26. extern struct stkframe *fbr;
  27. #ifdef PAUSE
  28. extern int pauselev,psigflag;
  29. #endif
  30.  
  31. tyobj(text)
  32. register struct object *text;
  33. {
  34.     register struct object *temp;
  35.     char str[30];
  36.  
  37.     if (text==0) return;
  38.     switch (text->obtype) {
  39.         case CONS:
  40.             for (temp = text; temp; temp = temp->obcdr) {
  41.                 fty1(temp->obcar);
  42.                 if(temp->obcdr) putc1(' ');
  43.             }
  44.             break;
  45.         case STRING:
  46.             sputs(text->obstr);
  47.             break;
  48.         case INT:
  49.             sprintf(str,FIXFMT,text->obint);
  50.             sputs(str);
  51.             break;
  52.         case DUB:
  53.             sprintf(str,"%g",text->obdub);
  54.             if (!index(str,'.')) strcat(str,".0");
  55.             sputs(str);
  56.             break;
  57.     }
  58. }
  59.  
  60. fty1(text)
  61. register struct object *text;
  62. {
  63.     if (listp(text)) {
  64.         putc1('[');
  65.         tyobj(text);
  66.         putc1(']');
  67.     } else tyobj(text);
  68. }
  69.  
  70. fillbuf(text)    /* Logo TYPE */
  71. register struct object *text;
  72. {
  73.     tyobj(text);
  74.     mfree(text);
  75. }
  76.  
  77. struct object *cmprint(arg)
  78. struct object *arg;
  79. {
  80.     fillbuf(arg);
  81.     putchar('\n');
  82.     return ((struct object *)(-1));
  83. }
  84.  
  85. struct object *cmtype(arg)
  86. struct object *arg;
  87. {
  88.     fillbuf(arg);
  89.     return ((struct object *)(-1));
  90. }
  91.  
  92. struct object *cmfprint(arg)
  93. struct object *arg;
  94. {
  95.     fty1(arg);
  96.     putchar('\n');
  97.     mfree(arg);
  98.     return ((struct object *)(-1));
  99. }
  100.  
  101. struct object *cmftype(arg)
  102. struct object *arg;
  103. {
  104.     fty1(arg);
  105.     mfree(arg);
  106.     return ((struct object *)(-1));
  107. }
  108.  
  109. setfile(file)
  110. register struct object *file;
  111. {
  112.     file = numconv(file,"File command");
  113.     if (!intp(file)) ungood("File command",file);
  114.     ofile = (FILE *)((int)(file->obint));
  115.     mfree(file);
  116. }
  117.  
  118. fileprint(file,text)
  119. register struct object *file,*text;
  120. {
  121.     setfile(file);
  122.     fillbuf(text);
  123.     fputc('\n',ofile);
  124.     ofile = NULL;
  125. }
  126.  
  127. filefprint(file,text)
  128. register struct object *file,*text;
  129. {
  130.     setfile(file);
  131.     fty1(text);
  132.     mfree(text);
  133.     fputc('\n',ofile);
  134.     ofile = NULL;
  135. }
  136.  
  137. filetype(file,text)
  138. register struct object *file,*text;
  139. {
  140.     setfile(file);
  141.     fillbuf(text);
  142.     ofile = NULL;
  143. }
  144.  
  145. fileftype(file,text)
  146. struct object *file,*text;
  147. {
  148.     setfile(file);
  149.     fty1(text);
  150.     mfree(text);
  151.     ofile = NULL;
  152. }
  153.  
  154. struct object *openfile(name,type)
  155. register struct object *name;
  156. register char *type;
  157. {
  158.     FILE *fildes;
  159.  
  160.     if (!stringp(name)) ungood("Open file",name);
  161.     fildes = fopen(name->obstr,type);
  162.     if (!fildes) {
  163.         pf1("Can't open file %l.\n",name);
  164.         errhand();
  165.     }
  166.     mfree(name);
  167.     return(localize(objint((FIXNUM)((int)fildes))));
  168. }
  169.  
  170. struct object *loread(arg)
  171. struct object *arg;
  172. {
  173.     return(openfile(arg,"r"));
  174. }
  175.  
  176. struct object *lowrite(arg)
  177. struct object *arg;
  178. {
  179.     return(openfile(arg,"w"));
  180. }
  181.  
  182. struct object *callunix(cmd)
  183. register struct object *cmd;
  184. {
  185.     register struct object *str;
  186.  
  187.     str = stringform(cmd);
  188.     system(str->obstr);
  189.     mfree(str);
  190.     mfree(cmd);
  191.     return ((struct object *)(-1));
  192. }
  193.  
  194. struct object *fileclose(file)
  195. register struct object *file;
  196. {
  197.     setfile(file);
  198.     fclose(ofile);
  199.     ofile = NULL;
  200.     return ((struct object *)(-1));
  201. }
  202.  
  203. struct object *fileread(file,how)
  204. register struct object *file;
  205. int how; /* 0 for fileread (returns list), 1 for fileword (returns str) */
  206. {
  207.     char str[200];
  208.     register struct object *x;
  209.     char *svgbpt;
  210.     char c;
  211.  
  212.     setfile(file);
  213.     fgets(str,200,ofile);
  214.     if (feof(ofile)) {
  215.         ofile = NULL;
  216.         if (how) return((struct object *)0);
  217.         return(localize(objcpstr("")));
  218.     }
  219.     ofile = NULL;
  220.     if (how) {
  221.         str[strlen(str)-1] = '\0';
  222.         return(localize(objcpstr(str)));
  223.     }
  224.     str[strlen(str)-1] = ']';
  225.     c = charib;
  226.     charib = 0;
  227.     svgbpt = getbpt;
  228.     getbpt = str;
  229.     x = makelist();
  230.     getbpt = svgbpt;
  231.     charib = c;
  232.     return(x);
  233. }
  234.  
  235. struct object *lfread(arg)
  236. struct object *arg;
  237. {
  238.     return(fileread(arg,0));
  239. }
  240.  
  241. struct object *lfword(arg)
  242. struct object *arg;
  243. {
  244.     return(fileread(arg,1));
  245. }
  246.  
  247. struct object *lsleep(tim)    /* wait */
  248. register struct object *tim;
  249. {
  250.     int itim;
  251.  
  252.     tim = numconv(tim,"Wait");
  253.     if (intp(tim)) itim = tim->obint;
  254.     else itim = tim->obdub;
  255.     mfree(tim);
  256.     sleep(itim);
  257.     return ((struct object *)(-1));
  258. }
  259.  
  260. struct object *input(flag)
  261. int flag;    /* 0 for readlist, 1 for request */
  262. {
  263.     int len;
  264.     char s[512];
  265.     register struct object *x;
  266.     char *svgbpt;
  267.     char c;
  268.  
  269.     if (flag) putchar('?');
  270.     fflush(stdout);
  271.     len = read(0,s,512);
  272.     if (len <= 0) len = 1;
  273.     s[len-1]=']';
  274.     c = charib;
  275.     charib = 0;
  276.     svgbpt = getbpt;
  277.     getbpt = s;
  278.     x = makelist();
  279.     getbpt = svgbpt;
  280.     charib = c;
  281.     return (x);
  282. }
  283.  
  284. struct object *readlist() {
  285.     return(input(0));
  286. }
  287.  
  288. struct object *request() {
  289.     return(input(1));
  290. }
  291.  
  292. struct object *ltime()        /* LOGO time */
  293. {
  294.     char ctim[50];
  295.     register struct object *x;
  296.     char *svgbpt;
  297.     char c;
  298.  
  299.     time(tvec);
  300.     strcpy(ctim,ctime(tvec));
  301.     ctim[strlen(ctim)-1]=']';
  302.     c = charib;
  303.     charib = 0;
  304.     svgbpt = getbpt;
  305.     getbpt = ctim;
  306.     x = makelist();
  307.     getbpt = svgbpt;
  308.     charib = c;
  309.     return(x);
  310. }
  311.  
  312. dorun(arg,num)
  313. struct object *arg;
  314. FIXNUM num;
  315. {
  316.     register struct object *str;
  317.     register struct runblock *rtemp;
  318.  
  319.     rtemp = (struct runblock *)ckmalloc(sizeof(struct runblock));
  320.     if (num != 0) {
  321.         rtemp->rcount = num;
  322.         rtemp->rupcount = 0;
  323.     } else {
  324.         rtemp->rcount = 1;    /* run or if, not repeat */
  325.          if (thisrun)
  326.              rtemp->rupcount = thisrun->rupcount - 1;
  327.          else
  328.              rtemp->rupcount = 0;
  329.     }
  330.     rtemp->roldyyc = yychar;
  331.     rtemp->roldyyl = yylval;
  332.     rtemp->roldline = yyline;
  333.     rtemp->svbpt = getbpt;
  334.     rtemp->svpflag = pflag;
  335.     rtemp->svletflag = letflag;
  336.     rtemp->svch = charib;
  337.     if (arg == (struct object *)(-1)) {    /* PAUSE */
  338.         rtemp->str = (struct object *)(-1);
  339.     } else {
  340.         str = stringform(arg);
  341.         mfree(arg);
  342.         strcat(str->obstr,"\n");
  343.         rtemp->str = globcopy(str);
  344.         mfree(str);
  345.     }
  346.     rtemp->rprev = thisrun;
  347.     thisrun = rtemp;
  348.     rerun();
  349. }
  350.  
  351. rerun() {
  352.     yychar = -1;
  353.     pflag = 0;
  354.     letflag = 0;
  355.     charib = '\0';
  356.     thisrun->rupcount++;
  357.     if (thisrun->str == (struct object *)(-1))    /* PAUSE */
  358.         getbpt = 0;
  359.     else
  360.         getbpt = thisrun->str->obstr;
  361. }
  362.  
  363. unrun() {
  364.     register struct runblock *rtemp;
  365.  
  366.     yychar = thisrun->roldyyc;
  367.     yylval = thisrun->roldyyl;
  368.     yyline = thisrun->roldline;
  369.     getbpt = thisrun->svbpt;
  370.     pflag = thisrun->svpflag;
  371.     letflag = thisrun->svletflag;
  372.     charib = thisrun->svch;
  373.     if (thisrun->str != (struct object *)(-1))    /* PAUSE */
  374.         lfree(thisrun->str);
  375.     rtemp = thisrun;
  376.     thisrun = thisrun->rprev;
  377.     JFREE(rtemp);
  378. }
  379.  
  380. dorep(count,cmd)
  381. struct object *count,*cmd;
  382. {
  383.     FIXNUM icount;
  384.  
  385.     count = numconv(count,"Repeat");
  386.     if (intp(count)) icount = count->obint;
  387.     else icount = count->obdub;
  388.     if (icount < (FIXNUM)0) ungood("Repeat",count);
  389.     if (icount == (FIXNUM)0) {
  390.         mfree(cmd);
  391.         cmd = 0;
  392.         icount++;
  393.     }
  394.     dorun(cmd,icount);
  395.     mfree(count);
  396. }
  397.  
  398. struct object *repcount() {
  399.     if (!thisrun) {
  400.         puts("Repcount outside repeat.");
  401.         errhand();
  402.     }
  403.     return(localize(objint(thisrun->rupcount)));
  404. }
  405.  
  406. #ifdef PAUSE
  407. dopause() {
  408.     register struct plist *opc;
  409.  
  410.     if (pflag || getbpt) {
  411.         printf("Pausing");
  412.         opc = pcell;
  413.         if (fbr && fbr->oldline==-1) {
  414.             opc=fbr->prevpcell;
  415.         }
  416.         if (opc&&!topf) printf(" at line %d in procedure %s",yyline,
  417.                 opc->procname->obstr);
  418.         printf("\n");
  419.         pauselev++;
  420.     }
  421.     if (psigflag) {
  422.         psigflag = 0;
  423. #ifdef EUNICE
  424.         yyprompt();
  425. #endif
  426.     }
  427.     if (pflag || getbpt)
  428.         dorun((struct object *)(-1),(FIXNUM)0);
  429. }
  430.  
  431. unpause() {
  432.     if (pauselev > 0) {
  433.         pauselev--;
  434.         unrun();
  435.     }
  436. }
  437. #endif
  438.  
  439. errhand()    /* do error recovery, then pop out to outer level */
  440. {
  441.     errtold++;
  442.     flagquit = 0;
  443.     onintr(errrec,1);
  444. #ifdef PAUSE
  445.     longjmp(yerrbuf,9);
  446. #else
  447.     ltopl();
  448. #endif
  449. }
  450.  
  451. nullfn()
  452. {
  453. }
  454.  
  455. readlin(fd,buf)        /* read a line from file */
  456. register FILDES fd;
  457. register char *buf;
  458. {
  459.     register char *i;
  460.  
  461.     for (i = buf; *(i-1) != '\n'; i++) read(fd,i,1);
  462. }
  463.  
  464. makeup(str)
  465. register char *str;
  466. {
  467.     register char ch;
  468.  
  469.     while (ch = *str) {
  470.         if (ch >= 'a' && ch <= 'z') *str = ch-040;
  471.         str++;
  472.     }
  473. }
  474.  
  475. struct object *cbreak(ostr)
  476. register struct object *ostr;
  477. {
  478.     struct sgttyb sgt;
  479.     register char *str;
  480.  
  481. #ifdef CBREAK
  482.     if (!stringp(ostr)) ungood("Cbreak",ostr);
  483.     str = ostr->obstr;
  484.     makeup(str);
  485.     if (strcmp(str,"ON") && strcmp(str,"OFF")) {
  486.         puts("cbreak input must be \"on or \"off");
  487.         errhand();
  488.     }
  489.     gtty(0,&sgt);
  490.     if (!strcmp(str,"ON")) {
  491.         sgt.sg_flags |= CBREAK;
  492.         sgt.sg_flags &= ~ECHO;
  493.     } else {
  494.         sgt.sg_flags &= ~CBREAK;
  495.         sgt.sg_flags |= ECHO;
  496.     }
  497.     stty(0,&sgt);
  498.     mfree(ostr);
  499.     return ((struct object *)(-1));
  500. #else
  501.     printf("No CBREAK on this system.\n");
  502.     errhand();    /* Such as V6 or Idris */
  503. #endif
  504. }
  505.  
  506. cboff()
  507. {
  508.     struct sgttyb sgt;
  509.  
  510. #ifdef CBREAK
  511.     gtty(0,&sgt);
  512.     sgt.sg_flags &= ~CBREAK;
  513.     sgt.sg_flags |= ECHO;
  514.     stty(0,&sgt);
  515. #endif
  516. }
  517.  
  518. struct object *readchar()
  519. {
  520.     char s[2];
  521.  
  522.     fflush(stdout);
  523.     read(0,s,1);
  524.     s[1] = '\0';
  525.     return(localize(objcpstr(s)));
  526. }
  527.  
  528. struct object *keyp()
  529. {
  530. #ifdef TIOCEMPTY
  531.     int i;
  532.  
  533.     fflush(stdout);
  534.     ioctl(0,TIOCEMPTY,&i);
  535.     if (i)
  536.         return(true());
  537.     else
  538. #else 
  539. #ifdef FIONREAD
  540.     long i;
  541.  
  542.     fflush(stdout);
  543.     ioctl(0,FIONREAD,&i);
  544.     if (i)
  545.         return(true());
  546.     else
  547. #endif
  548. #endif
  549.         return(false());
  550. }
  551.  
  552. struct object *settest(val)
  553. struct object *val;
  554. {
  555.     if (obstrcmp(val,"true") && obstrcmp(val,"false")) ungood("Test",val);
  556.     currtest = !obstrcmp(val,"true");
  557.     mfree(val);
  558.     return ((struct object *)(-1));
  559. }
  560.  
  561. loflush() {
  562.     fflush(stdout);
  563. }
  564.  
  565. struct object *cmoutput(arg)
  566. struct object *arg;
  567. {
  568.     extern int endflag;
  569.  
  570. #ifdef PAUSE
  571.     if (!pflag && thisrun && thisrun->str==(struct object *)(-1))
  572.         unpause();
  573. #endif
  574.     endflag = 1;
  575.     return(arg);
  576. }
  577.  
  578. #ifdef SETCURSOR
  579.  
  580. int gotterm = 0;
  581.  
  582. /* Termcap definitions */
  583.  
  584. char    *UP,
  585.     *CS,
  586.     *CM,
  587.     *CL,
  588.     *BC,
  589.     *padchar;
  590.  
  591. char    PC = '\0';
  592.  
  593. short ospeed;
  594.  
  595. char    tspace[128];
  596.  
  597. char **meas[] = {
  598.     &CS, &CM, &CL, &UP, &BC, &padchar, 0
  599. };
  600.  
  601. char    tbuff[1024];
  602.  
  603. getTERM()
  604. {
  605.     char    *getenv();
  606.     struct sgttyb tty;
  607.     char    *ts="cscmclupbcpc";
  608.     char    *termname = 0,
  609.         *termp = tspace;
  610.     int    i;
  611.  
  612.     if (gotterm) return(gotterm);
  613.  
  614.     if (gtty(1, &tty)) {
  615.         ospeed = B1200;
  616.     } else {
  617.         tty.sg_flags &= ~ XTABS;
  618.         ospeed = tty.sg_ospeed;
  619.         stty(1,&tty);
  620.     }
  621.  
  622.     termname = getenv("TERM");
  623.     if (termname == 0) {
  624.         puts("No terminal in environment.");
  625.         gotterm = -1;
  626.         return(gotterm);
  627.     }
  628.  
  629.     if (tgetent(tbuff, termname) < 1) {
  630.         pf1("No termcap entry for %s\n",termname);
  631.         gotterm = -1;
  632.         return(gotterm);
  633.     }
  634.  
  635.     for (i = 0; meas[i]; i++) {
  636.         *(meas[i]) = (char *) tgetstr(ts, &termp);
  637.         ts += 2;
  638.     }
  639.  
  640.     if (padchar) PC = *padchar;
  641.  
  642.     gotterm = 1;
  643.     return(gotterm);
  644. }
  645.  
  646. extern int putch();
  647.  
  648. struct object *clrtxt()
  649. {
  650.     if (getTERM() < 0) return;
  651.     tputs(CL,24,putch);
  652.     return ((struct object *)(-1));
  653. }
  654.  
  655. struct object *setcur(x,y)
  656. struct object *x,*y;
  657. {
  658.     int ix,iy;
  659.  
  660.     x=numconv(x,"Setcursorxy");
  661.     y=numconv(y,"Setcursorxy");
  662.     if (!intp(x)) ungood("Setcursorxy",x);
  663.     if (!intp(y)) ungood("Setcursorxy",y);
  664.     if (getTERM() > 0) {
  665.         ix = x->obint;
  666.         iy = y->obint;
  667.         tputs(tgoto(CM,ix,iy),1,putch);
  668.     }
  669.     mfree(x);
  670.     mfree(y);
  671.     return ((struct object *)(-1));
  672. }
  673.  
  674. #endif SETCURSOR
  675.  
  676.