home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / xlisp / xlisp12.ark / XLREAD.C < prev    next >
Encoding:
C/C++ Source or Header  |  1985-02-20  |  8.1 KB  |  382 lines
  1. /* xlread - xlisp expression input routine */
  2.  
  3. #ifdef AZTEC
  4. #include "stdio.h"
  5. #include "setjmp.h"
  6. #else
  7. #include <stdio.h>
  8. #include <setjmp.h>
  9. #include <ctype.h>
  10. #endif
  11.  
  12. #include "xlisp.h"
  13.  
  14. /* external variables */
  15. extern jmp_buf *xljmpbuf;
  16. extern struct node *s_quote;
  17. extern struct node *xlstack;
  18. extern int xlplevel;
  19.  
  20. /* external routines */
  21. extern FILE *fopen();
  22.  
  23. /* forward declarations */
  24. FORWARD struct node *plist();
  25. FORWARD struct node *pstring();
  26. FORWARD struct node *pquote();
  27. FORWARD struct node *pname();
  28.  
  29. /* xlload - load a file of xlisp expressions */
  30. int xlload(name)
  31.   char *name;
  32. {
  33.     jmp_buf loadjmpbuf,*oldjmpbuf;
  34.     struct node *oldstk,fptr,val;
  35.     char fname[50];
  36.     FILE *fp;
  37.  
  38.     /* create a new stack frame */
  39.     oldstk = xlsave(&fptr,&val,NULL);
  40.  
  41.     /* add the default extension */
  42.     strcpy(fname,name); strcat(fname,".lsp");
  43.  
  44.     /* open the file */
  45.     if ((fp = fopen(fname,"r")) == NULL)
  46.     return (FALSE);
  47.  
  48.     /* allocate a file node */
  49.     fptr.n_ptr = newnode(FPTR);
  50.     fptr.n_ptr->n_fp = fp;
  51.     fptr.n_ptr->n_savech = 0;
  52.  
  53.     /* setup to trap errors */
  54.     oldjmpbuf = xljmpbuf;
  55.     if (setjmp(xljmpbuf = loadjmpbuf)) {
  56.     fclose(fp);
  57.     longjmp(xljmpbuf = oldjmpbuf,1);
  58.     }
  59.  
  60.     /* read and evaluate each expression in the file */
  61.     while (xlread(fptr.n_ptr,&val.n_ptr))
  62.     xleval(val.n_ptr);
  63.  
  64.     /* restore error trapping context and previous stack frame */
  65.     xljmpbuf = oldjmpbuf;
  66.     xlstack = oldstk;
  67.  
  68.     /* close the file */
  69.     fclose(fp);
  70.  
  71.     /* return successfully */
  72.     return (TRUE);
  73. }
  74.  
  75. /* xlread - read an xlisp expression */
  76. int xlread(fptr,pval)
  77.   struct node *fptr,**pval;
  78. {
  79.     /* initialize */
  80.     xlplevel = 0;
  81.  
  82.     /* parse an expression */
  83.     return (parse(fptr,pval));
  84. }
  85.  
  86. /* parse - parse an xlisp expression */
  87. LOCAL int parse(fptr,pval)
  88.   struct node *fptr,**pval;
  89. {
  90.     int ch;
  91.  
  92.     /* keep looking for a node skipping comments */
  93.     while (TRUE)
  94.  
  95.     /* check next character for type of node */
  96.     switch (ch = nextch(fptr)) {
  97.     case EOF:
  98.         return (FALSE);
  99.     case '\'':            /* a quoted expression */
  100.         *pval = pquote(fptr);
  101.         return (TRUE);
  102.     case '(':            /* a sublist */
  103.         *pval = plist(fptr);
  104.         return (TRUE);
  105.     case ')':            /* closing paren - shouldn't happen */
  106.         xlfail("extra right paren");
  107.     case '.':            /* dot - shouldn't happen */
  108.         xlfail("misplaced dot");
  109.     case ';':            /* a comment */
  110.         pcomment(fptr);
  111.         break;
  112.     case '"':            /* a string */
  113.         *pval = pstring(fptr);
  114.         return (TRUE);
  115.     default:
  116.         if (issym(ch))        /* a name */
  117.             *pval = pname(fptr);
  118.         else
  119.             xlfail("invalid character");
  120.         return (TRUE);
  121.     }
  122. }
  123.  
  124. /* pcomment - parse a comment */
  125. LOCAL pcomment(fptr)
  126.   struct node *fptr;
  127. {
  128.     int ch;
  129.  
  130.     /* skip to end of line */
  131.     while ((ch = checkeof(fptr)) != EOF && ch != '\n')
  132.     ;
  133. }
  134.  
  135. /* plist - parse a list */
  136. LOCAL struct node *plist(fptr)
  137.   struct node *fptr;
  138. {
  139.     struct node *oldstk,val,*lastnptr,*nptr;
  140.     int ch;
  141.  
  142.     /* increment the nesting level */
  143.     xlplevel += 1;
  144.  
  145.     /* create a new stack frame */
  146.     oldstk = xlsave(&val,NULL);
  147.  
  148.     /* skip the opening paren */
  149.     xlgetc(fptr);
  150.  
  151.     /* keep appending nodes until a closing paren is found */
  152.     lastnptr = NULL;
  153.     for (lastnptr = NULL; (ch = nextch(fptr)) != ')'; lastnptr = nptr) {
  154.  
  155.     /* check for end of file */
  156.     if (ch == EOF)
  157.         badeof();
  158.  
  159.     /* check for a dotted pair */
  160.     if (ch == '.') {
  161.  
  162.         /* skip the dot */
  163.         xlgetc(fptr);
  164.  
  165.         /* make sure there's a node */
  166.         if (lastnptr == NULL)
  167.         xlfail("invalid dotted pair");
  168.  
  169.         /* parse the expression after the dot */
  170.         if (!parse(fptr,&lastnptr->n_listnext))
  171.         badeof();
  172.  
  173.         /* make sure its followed by a close paren */
  174.         if (nextch(fptr) != ')')
  175.         xlfail("invalid dotted pair");
  176.  
  177.         /* done with this list */
  178.         break;
  179.     }
  180.  
  181.     /* allocate a new node and link it into the list */
  182.     nptr = newnode(LIST);
  183.     if (lastnptr == NULL)
  184.         val.n_ptr = nptr;
  185.     else
  186.         lastnptr->n_listnext = nptr;
  187.  
  188.     /* initialize the new node */
  189.     if (!parse(fptr,&nptr->n_listvalue))
  190.         badeof();
  191.     }
  192.  
  193.     /* skip the closing paren */
  194.     xlgetc(fptr);
  195.  
  196.     /* restore the previous stack frame */
  197.     xlstack = oldstk;
  198.  
  199.     /* decrement the nesting level */
  200.     xlplevel -= 1;
  201.  
  202.     /* return successfully */
  203.     return (val.n_ptr);
  204. }
  205.  
  206. /* pstring - parse a string */
  207. LOCAL struct node *pstring(fptr)
  208.   struct node *fptr;
  209. {
  210.     struct node *oldstk,val;
  211.     char sbuf[STRMAX+1];
  212.     int ch,i,d1,d2,d3;
  213.  
  214.     /* create a new stack frame */
  215.     oldstk = xlsave(&val,NULL);
  216.  
  217.     /* skip the opening quote */
  218.     xlgetc(fptr);
  219.  
  220.     /* loop looking for a closing quote */
  221.     for (i = 0; i < STRMAX && (ch = checkeof(fptr)) != '"'; i++) {
  222.     switch (ch) {
  223.     case EOF:
  224.         badeof();
  225.     case '\\':
  226.         switch (ch = checkeof(fptr)) {
  227.         case 'e':
  228.             ch = '\033';
  229.             break;
  230.         case 'n':
  231.             ch = '\n';
  232.             break;
  233.         case 'r':
  234.             ch = '\r';
  235.             break;
  236.         case 't':
  237.             ch = '\t';
  238.             break;
  239.         default:
  240.             if (ch >= '0' && ch <= '7') {
  241.                 d1 = ch - '0';
  242.                 d2 = checkeof(fptr) - '0';
  243.                 d3 = checkeof(fptr) - '0';
  244.                 ch = (d1 << 6) + (d2 << 3) + d3;
  245.             }
  246.             break;
  247.         }
  248.     }
  249.     sbuf[i] = ch;
  250.     }
  251.     sbuf[i] = 0;
  252.  
  253.     /* initialize the node */
  254.     val.n_ptr = newnode(STR);
  255.     val.n_ptr->n_str = strsave(sbuf);
  256.     val.n_ptr->n_strtype = DYNAMIC;
  257.  
  258.     /* restore the previous stack frame */
  259.     xlstack = oldstk;
  260.  
  261.     /* return the new string */
  262.     return (val.n_ptr);
  263. }
  264.  
  265. /* pquote - parse a quoted expression */
  266. LOCAL struct node *pquote(fptr)
  267.   struct node *fptr;
  268. {
  269.     struct node *oldstk,val;
  270.  
  271.     /* create a new stack frame */
  272.     oldstk = xlsave(&val,NULL);
  273.  
  274.     /* skip the quote character */
  275.     xlgetc(fptr);
  276.  
  277.     /* allocate two nodes */
  278.     val.n_ptr = newnode(LIST);
  279.     val.n_ptr->n_listvalue = s_quote;
  280.     val.n_ptr->n_listnext = newnode(LIST);
  281.  
  282.     /* initialize the second to point to the quoted expression */
  283.     if (!parse(fptr,&val.n_ptr->n_listnext->n_listvalue))
  284.     badeof();
  285.  
  286.     /* restore the previous stack frame */
  287.     xlstack = oldstk;
  288.  
  289.     /* return the quoted expression */
  290.     return (val.n_ptr);
  291. }
  292.  
  293. /* pname - parse a symbol name */
  294. LOCAL struct node *pname(fptr)
  295.   struct node *fptr;
  296. {
  297.     char sname[STRMAX+1];
  298.     struct node *val;
  299.     int ch,i;
  300.  
  301.     /* get symbol name */
  302.     for (i = 0; i < STRMAX && issym(xlpeek(fptr)); )
  303.     sname[i++] = xlgetc(fptr);
  304.     sname[i] = 0;
  305.  
  306.     /* check for a number or enter the symbol into the oblist */
  307.     return (isnumber(sname,&val) ? val : xlenter(sname,DYNAMIC));
  308. }
  309.  
  310. /* nextch - look at the next non-blank character */
  311. LOCAL int nextch(fptr)
  312.   struct node *fptr;
  313. {
  314.     int ch;
  315.  
  316.     /* return and save the next non-blank character */
  317.     while ((ch = xlpeek(fptr)) != EOF && isspace(ch))
  318.     xlgetc(fptr);
  319.     return (ch);
  320. }
  321.  
  322. /* checkeof - get a character and check for end of file */
  323. LOCAL int checkeof(fptr)
  324.   struct node *fptr;
  325. {
  326.     int ch;
  327.  
  328.     if ((ch = xlgetc(fptr)) == EOF)
  329.     badeof();
  330.     return (ch);
  331. }
  332.  
  333. /* badeof - unexpected eof */
  334. LOCAL badeof()
  335. {
  336.     xlfail("unexpected EOF");
  337. }
  338.  
  339. /* isnumber - check if this string is a number */
  340. int isnumber(str,pval)
  341.   char *str; struct node **pval;
  342. {
  343.     char *p;
  344.     int d;
  345.  
  346.     /* initialize */
  347.     p = str; d = 0;
  348.  
  349.     /* check for a sign */
  350.     if (*p == '+' || *p == '-')
  351.     p++;
  352.  
  353.     /* check for a string of digits */
  354.     while (isdigit(*p))
  355.     p++, d++;
  356.  
  357.     /* make sure there was at least one digit and this is the end */
  358.     if (d == 0 || *p)
  359.     return (FALSE);
  360.  
  361.     /* convert the string to an integer and return successfully */
  362.     *pval = newnode(INT);
  363.     (*pval)->n_int = atoi(*str == '+' ? ++str : str);
  364.     return (TRUE);
  365. }
  366.  
  367. /* issym - check whether a character if valid in a symbol name */
  368. LOCAL int issym(ch)
  369.   int ch;
  370. {
  371.     if (ch <= ' ' ||
  372.         ch == '(' ||
  373.         ch == ')' ||
  374.         ch == ';' || 
  375.         ch == '.' ||
  376.         ch == '"' ||
  377.         ch == '\'')
  378.     return (FALSE);
  379.     else
  380.     return (TRUE);
  381. }
  382.