home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / READER.C < prev    next >
C/C++ Source or Header  |  1990-08-13  |  17KB  |  837 lines
  1. /*
  2.  *        X PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <at@unido.uucp>
  9.  *            <....!seismo!unido!at>
  10.  *            <at@unido.bitnet>
  11.  *
  12.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  13.  *            Permission is granted hereby to copy the entire
  14.  *            package including this copyright notice without fee.
  15.  *
  16.  */
  17.  
  18. #include <stdio.h>
  19. #include <setjmp.h>
  20. #include "prolog.h"
  21. #include "extern.h"
  22. #include "error.h"
  23. #include "charset.h"
  24.  
  25.  
  26. extern functor *find_operator();    /* functor */
  27. extern functor *get_functor();        /* fucntor */
  28. extern term *argument();        /* terms */
  29. extern term *term_copy();        /* terms */
  30. extern term *int_copy();        /* terms */
  31. extern term *var_copy();        /* terms */
  32.  
  33. term    *rd_term();            /* forward */
  34.  
  35. jmp_buf    hop;                /* for syntax errors in reader */
  36.  
  37. /*    Test a given term for an operator definition    */
  38.  
  39. short isinfix(name, prio, lprio, rprio)
  40. char *name;
  41. short *lprio, *rprio, *prio;
  42. {
  43.     short foo;
  44.     short flags;
  45.     short inf;
  46.     
  47.     if (!find_operator(name, &flags, &inf, &foo, &foo) || !inf)
  48.         return(FALSE);
  49.         
  50.     *lprio = (flags & LOWER_LEFT ? inf-1 : inf);
  51.     *rprio = (flags & LOWER_RIGHT ? inf-1 : inf);
  52.     *prio = inf;
  53.     return(TRUE);
  54. }
  55.  
  56. short ispostfix(name, prio, lprio)
  57. char *name;
  58. short *prio, *lprio;
  59. {
  60.     short foo;
  61.     short post;
  62.     short flags;
  63.     
  64.     if (!find_operator(name, &flags, &foo, &foo, &post) || !post)
  65.         return(FALSE);
  66.         
  67.     *lprio = (flags & LOWER_LEFT ? post-1 : post);
  68.     *prio = post;
  69.     return(TRUE);
  70. }
  71.  
  72. short isprefix(name, prio, rprio)
  73. char *name;
  74. short *prio, *rprio;
  75. {
  76.     short foo;
  77.     short pre;
  78.     short flags;
  79.     
  80.     if (!find_operator(name, &flags, &foo, &pre, &foo) || !pre)
  81.         return(FALSE);
  82.         
  83.     *rprio = (flags & LOWER_RIGHT ? pre-1 : pre);
  84.     *prio = pre;
  85.     return(TRUE);
  86. }
  87.  
  88. short isoperator(name, prio)
  89. char *name;
  90. short *prio;
  91. {
  92.     short inf, post, pre;
  93.     short flags;
  94.     
  95.     if (!find_operator(name, &flags, &inf, &pre, &post))
  96.         return(FALSE);
  97.     *prio = MAX(inf, pre);
  98.     *prio = MAX(*prio, post);
  99.     if (*prio)
  100.         return(TRUE);
  101.     else
  102.         return(FALSE);
  103. }
  104.  
  105. /*    write a term's name to the output stream */
  106. /*    quote it, if it's not a proper name */
  107.  
  108. static put_name(t, quote)
  109. term *t;
  110. short quote;
  111. {
  112.     char *p;
  113.     short ok = TRUE;
  114.     
  115.     p = NAME(t);
  116.     switch(ctype[*p])
  117.     {
  118.         case LOWER:    while (*p)
  119.                     if (ctype[*p++] > DIGIT)
  120.                     {
  121.                         ok = FALSE;
  122.                         break;
  123.                     }
  124.                 p = NAME(t);
  125.                 break;
  126.         case SINGLE:    ok = (*(p+1) == '\0');
  127.                 break;
  128.         case BRACKET:    ok = (!strcmp(p, ",") || !strcmp(p, "[]"));
  129.                 break;
  130.         case SYMBOL:    if (!strcmp(p, "/*") || !strcmp(p, "."))
  131.                     ok = FALSE;
  132.                 else
  133.                 {
  134.                     while (*p)
  135.                         if (ctype[*p++] != SYMBOL)
  136.                         {
  137.                             ok = FALSE;
  138.                             break;
  139.                         }
  140.                     p = NAME(t);
  141.                 }
  142.                 break;
  143.         default:    ok = FALSE;
  144.     }
  145.     if (!ok && quote)
  146.         putc('\'', out->fp);
  147.     while (*p)
  148.     {
  149.         if (*p == '\'')
  150.             putc('\'', out->fp);
  151.         putc(*p++, out->fp);
  152.     }
  153.     if (!ok && quote)
  154.         putc('\'', out->fp);
  155. }
  156.  
  157. /*    display a term t in enviroment e with local prio. */
  158. /*    display in standart prefix notation, if !doop */
  159.  
  160. void display(t, e, prio, doop, doquote)
  161. term *t;
  162. env *e;
  163. short prio;
  164. short doop;
  165. short doquote;
  166. {
  167.     short i,j,k;
  168.     
  169.     if (ISINT(t))            /* an integer */
  170.     {
  171.         fprintf(out->fp, "%ld", VALUE(t));
  172.         return;
  173.     }
  174.     if (ISVAR(t))            /* a variable */
  175.     {
  176.         putc('_', out->fp);
  177.         if (ISANONYMOUS(t) || ISANOPROTO(t))
  178.             return;
  179.         if (ISFRAME(t))        /* frame variable */
  180.             fprintf(out->fp,"%ld",
  181.              -1*(((long)t-(long)stack)/sizeof(term)));
  182.         else            /* copy or proto */
  183.             if (ISCOPY(t))
  184.                 fprintf(out->fp,"%ld",
  185.                 ((long)t-(long)copystack)/sizeof(term));
  186.             else
  187.                 fprintf(out->fp,"%ld", REF(t));
  188.         return;
  189.     }
  190.     if (FUNC(t) == ASSERTFUNCTOR)
  191.     {
  192.         putc('{', out->fp);
  193.         display(argument(t,e,1),e,255,doop,doquote);
  194.         putc('}', out->fp);
  195.         return;
  196.     }
  197.     if (ISATOM(t))            /* an atom */
  198.     {
  199.         if (doop && isoperator(NAME(t), &j))/* this is an operator */
  200.         {
  201.             putc('(', out->fp);
  202.             put_name(t, doquote);
  203.             putc(')', out->fp);
  204.         }
  205.         else
  206.             put_name(t, doquote);
  207.         return;
  208.     }
  209.     if (FUNC(t) == DOTFUNCTOR)    /* a list */
  210.     {
  211.         putc('[', out->fp);
  212.         do
  213.         {
  214.             display(argument(t, e, 1), e, 252, doop, doquote);
  215.             t = argument(t, e, 2);
  216.             if (FUNC(t) == DOTFUNCTOR)
  217.                 putc(',', out->fp);
  218.         } while (FUNC(t) == DOTFUNCTOR);
  219.         if (FUNC(t) != NILFUNCTOR)
  220.         {
  221.             putc('|', out->fp);
  222.             display(t, e, 252, doop, doquote);
  223.         }
  224.         putc(']', out->fp);
  225.         return;
  226.     }
  227.     /* if we reach this, t must be a structure */
  228.     if (! ISSTRUCT(t))            /* oops */
  229.     {
  230.         fprintf(out->fp, "?Invalid term at %ld?", (long)t);
  231.         return;
  232.     }
  233.     
  234.     i = ARITY(t);
  235.     if (i == 1)            /* maybe a prefix or postfix operator?*/
  236.     {
  237.         if (doop && isprefix(NAME(t), &j, &k))
  238.         {
  239.             if (j > prio)
  240.                 putc('(', out->fp);
  241.             put_name(t, doquote);
  242.             putc(' ', out->fp);
  243.             display(argument(t, e, 1), e, k, doop, doquote);
  244.             if (j > prio)
  245.                 putc(')', out->fp);
  246.             return;
  247.         }
  248.         if (doop && ispostfix(NAME(t), &j, &k))
  249.         {
  250.             if (j > prio)
  251.                 putc('(', out->fp);
  252.             display(argument(t, e, 1), e, k, doop, doquote);
  253.             putc(' ', out->fp);
  254.             put_name(t, doquote);
  255.             if (j > prio)
  256.                 putc(')', out->fp);
  257.             return;
  258.         }
  259.     }
  260.     if (i==2 && doop && isinfix(NAME(t), &i, &j, &k))
  261.     {
  262.         if (i > prio)
  263.             putc('(', out->fp);
  264.         display(argument(t, e, 1), e, j, doop, doquote);
  265.         putc(' ', out->fp);
  266.         put_name(t, doquote);
  267.         putc(' ', out->fp);
  268.         display(argument(t, e, 2), e, k, doop, doquote);
  269.         if (i > prio)
  270.             putc(')', out->fp);
  271.         return;
  272.     }
  273.     /* sorry pal, this is no operator. */
  274.     put_name(t, doquote);
  275.     putc('(', out->fp);
  276.     for (j=1; j<=i; j++)
  277.     {
  278.         display(argument(t, e, j), e, 252, doop, doquote);
  279.         if (j < i)
  280.             putc(',', out->fp);
  281.     }
  282.     putc(')', out->fp);
  283.     return;
  284. }
  285.  
  286. /*    The Prolog Reader    */
  287.  
  288. /*    Read a character from the current file */
  289.  
  290. char    rd_it()
  291. {
  292.     if (lastc == '\n' && FUNC(in->atom) == USERFUNCTOR)
  293.         fputs(NAME(prompt), out->fp);
  294.     lastc = getc(in->fp);
  295.     if (lastc == EOF)        /* stop reading immediately */
  296.     {
  297.         c_errno = EEOF;        /* signal error */
  298.         longjmp(hop, 2);
  299.     }
  300.     return(lastc);
  301. }
  302.  
  303. /*    Read a term in the line buffer    */
  304.  
  305. short rd_line()
  306. {
  307.     short i;
  308.     
  309.     i = 0;                    /* start a new line */
  310.     do
  311.     {
  312.         c = rd_it();
  313.         c_type = ctype[c];
  314.        DOTTEST:
  315.         if (c == '.' && i > 0 && ctype[line[i-1]] != SYMBOL)
  316.         {
  317.             line[i++] = '.';
  318.             c = rd_it();
  319.             if (ctype[c] == BLANK)    /* end of term */
  320.             {
  321.                 line[i++] = ' ';
  322.                 line[i] = '\0';    /* terminate line */
  323.                 p = line;
  324.                 return(TRUE);    /* all is well */
  325.             }
  326.             c_type = ctype[c];
  327.         }
  328.         if (c_type == BLANK)        /* skip blanks */
  329.         {
  330.             do
  331.                 c = rd_it();
  332.             while (ctype[c] == BLANK);
  333.             line[i++] = ' ';    /* leave just one blank */
  334.             c_type = ctype[c];
  335.             goto DOTTEST;
  336.         }
  337.         if (c == '%')
  338.         {
  339.             while(rd_it() != '\n');
  340.             continue;
  341.         }
  342.         line[i++] = c;            /* enter the character */
  343.         if (c == '*' && i > 1 && line[i-2] == '/') /* comment */
  344.         {
  345.             i -= 2;            /* remove / and * */
  346.             do
  347.             {
  348.                 while ((c = rd_it()) != '*');
  349.                 while ((c = rd_it()) == '*');
  350.             } while (c != '/');
  351.             continue;        /* with the loop */
  352.         }
  353.         if (i > MAXLINE)
  354.         {
  355.             fprintf(stderr, "Term too long\n");
  356.             BIERROR(EIO);
  357.         }
  358.         if (feof(in->fp) || ferror(in->fp))
  359.             FILEERROR(EEOF);
  360.         if (c_type == QUOTE)        /* sweep fuzzy name */
  361.         {
  362.             do
  363.             {
  364.                 line[i++] = c = rd_it();
  365.             } while (ctype[c] != QUOTE);
  366.             continue;        /* with the loop */
  367.         }
  368.         if (c_type == STRING)        /* sweep string */
  369.         {
  370.             do
  371.             {
  372.                 line[i++] = c = rd_it();
  373.             } while (ctype[c] != STRING);
  374.             continue;        /* with the loop */
  375.         }
  376.     } while (TRUE);
  377. }
  378.  
  379. /*    fetch the next character from the current line */
  380.  
  381. short rd_char()
  382. {
  383.     if (!*p)            /* current line is empty */
  384.         if (!rd_line())        /* eof on input */
  385.             return(FALSE);    /* signal an error */
  386.     c = *p++;
  387.     c_type = ctype[c];
  388.     return(TRUE);
  389. }
  390.  
  391. /*    Show a syntax error */
  392.  
  393. short syntax_error(t)
  394. char *t;
  395. {
  396.     char *q;
  397.     
  398.     fprintf(stderr, "\n [Syntax Error %s] \n", t);
  399.     for (q=line; *q && q<p; putc(*q++, stderr));
  400.     fprintf(stderr, "\n [Here] \n");
  401.     for (; *q; putc(*q++, stderr));
  402.     *p = '\0';
  403.     c_errno = ESYNTAX;
  404.     putc('\n', stderr);
  405.     longjmp(hop, 1);
  406. }
  407.  
  408. /*    search/enter a variable in the local variable space */
  409. /*    if the variable is not given, create and return it. */
  410.  
  411. term *getvar(name)
  412. char *name;
  413. {
  414.     term *t;
  415.     short i;
  416.     
  417.     if (!strcmp(name, "_"))        /* a anonymous variable */
  418.         return(ANONYMOUSATOM);
  419.         
  420.     for (i=0; i<tide; i++)        /* search in the table */
  421.         if (!strcmp(l_table[i].name, name))
  422.             return(l_table[i].t);
  423.     
  424.     if (tide == MAXVARS)        /* table overflow */
  425.         BIERROR(ETOOMANY);
  426.         
  427.     t = var_copy();            /* create new variable */
  428.     l_table[i].t = t;
  429.     strcpy(l_table[i].name, name);
  430.     tide++;
  431.     return(t);
  432. }
  433.  
  434. /*    parse the term and split it into token */
  435.  
  436. short rd_token()
  437. {
  438.     short i, k;
  439.     long l;
  440.     
  441.     k = 0;
  442.     if (valid_token)
  443.     {
  444.         valid_token = FALSE;
  445.         return(token_type);
  446.     }
  447.  
  448.     do
  449.     switch(c_type)
  450.     {
  451.         case BLANK:
  452.             while (rd_char() && c_type == BLANK);
  453.             continue;
  454.         case UPPER:
  455.             k++;
  456.         case LOWER:
  457.             i = 0;
  458.             do
  459.             {
  460.                 name[i++] = c;
  461.             } while (rd_char() && c_type <= DIGIT && i < MAXNAME);
  462.             if (i == MAXNAME)
  463.                 syntax_error("Name too long");
  464.             name[i] = '\0';
  465.             if (k)
  466.             {
  467.                 token_type = TVARIABLE;
  468.                 token = (char *)getvar(name);
  469.                 return(TVARIABLE);
  470.             }
  471.             else
  472.             {
  473.                 token_type = TSYMBOL;
  474.                 token = name;
  475.                 return(TSYMBOL);
  476.             }
  477.         case DIGIT:
  478.             l = 0;
  479.             do
  480.             {
  481.                 l = 10*l + c-'0';
  482.             } while (rd_char() && c_type == DIGIT);
  483.             token_type = TINTEGER;
  484.             token = (char *)int_copy(l);
  485.             return(TINTEGER);
  486.         case QUOTE:
  487.         case STRING:
  488.             k = c_type;
  489.             i = 0;
  490.             rd_char();        /* skip ' or " */
  491.             do
  492.             {
  493.                 if (c_type==k && *p == c)
  494.                     rd_char();
  495.                 name[i++] = c;
  496.             } while (rd_char() && (c_type != k || *p==c) && 
  497.                     i < MAXNAME);
  498.             if (i == MAXNAME)
  499.                 syntax_error("Name too long");
  500.             name[i] = '\0';
  501.             rd_char();        /* skip ' or " */
  502.             if (k == QUOTE)
  503.             {
  504.                 token_type = TSYMBOL;
  505.                 token = name;
  506.                 return(TSYMBOL);
  507.             }
  508.             else
  509.             {
  510.                 token_type = TSTRING;
  511.                 token = name;
  512.                 return(TSTRING);
  513.             }
  514.         case SYMBOL:
  515.             if (c == '/' && *p == '*')
  516.             {
  517.                 while(rd_char() && c != '*' && *p != '/');
  518.                 rd_char();
  519.                 rd_char();
  520.                 continue;
  521.             }
  522.             i = 1;
  523.             name[0] = c;
  524.             if (c == '.')
  525.             {
  526.                 if (rd_char() && c_type == BLANK)
  527.                 {
  528.                     token_type = TDOT;
  529.                     p--;
  530.                     return(TDOT);
  531.                 }
  532.             }
  533.             else
  534.                 rd_char();
  535.             while (c_type == SYMBOL && i < MAXNAME)
  536.             {
  537.                 name[i++] = c;
  538.                 rd_char();
  539.             }
  540.             if (i == MAXNAME)
  541.                 syntax_error("Name too long");
  542.             name[i] = '\0';
  543.             token_type = TSYMBOL;
  544.             token = name;
  545.             return(TSYMBOL);
  546.         case SINGLE:
  547.             name[0] = c;
  548.             name[1] = '\0';
  549.             rd_char();
  550.             token_type = TSYMBOL;
  551.             token = name;
  552.             return(TSYMBOL);
  553.         case BRACKET:
  554.             if (c == '[' && *p == ']')
  555.             {
  556.                 rd_char();
  557.                 rd_char();    /* skip ] */
  558.                 token_type = TINTEGER;
  559.                 token = (char *)NILATOM;
  560.                 return(TINTEGER);
  561.             }
  562.             token_type = TSPECIAL;
  563.             token = (char *)c;
  564.             rd_char();
  565.             return(TSPECIAL);
  566.     }
  567.     while (TRUE);
  568. }
  569.  
  570. /*    read the arguments of a standart term */
  571. /*    as we need a relative large local vector, we put this in it's */
  572. /*    own function to decrease stack usage as recursion takes place */
  573.  
  574. term *rd_args(name)
  575. term *name;
  576. {
  577.     short i = 0;
  578.     term *v[MAXARGS];
  579.     term *t;
  580.     char sname[MAXNAME];        /* the global name will be used again */
  581.     
  582.     strcpy(sname, name);        /* save the name for later use */
  583.     rd_char();            /* skip the ( */
  584.     do
  585.     {
  586.         v[i++] = rd_term(252);
  587.     } while (rd_token()==TSPECIAL && (char)token == ',' && i < MAXARGS);
  588.     if (token_type != TSPECIAL || (char)token != ')' || i == MAXARGS)
  589.         syntax_error("Wrong arguments list");
  590.         
  591.     t = term_copy(get_functor(sname, i));
  592.     while (i > 0)
  593.     {
  594.         ARG(t,i) = v[i-1];
  595.         i--;
  596.     }
  597.     return(t);
  598. }
  599.  
  600. /*    convert a string into a dotted list */
  601.  
  602. term *rd_string(name)
  603. char *name;
  604. {
  605.     term *t, *p;
  606.  
  607.     if (!*name)
  608.         return(NILATOM);
  609.     t = p = term_copy(DOTFUNCTOR);
  610.     do
  611.     {
  612.         ARG(p,1) = int_copy((long)*name++);
  613.         if (*name)
  614.         {
  615.             ARG(p,2) = term_copy(DOTFUNCTOR);
  616.             p = ARG(p,2);
  617.         }
  618.     } while (*name);
  619.     ARG(p,2) = NILATOM;
  620.     return(t);
  621. }
  622.  
  623. /*    parse a list */
  624.  
  625. term *rd_list()
  626. {
  627.     term *t, *p;
  628.     
  629.     p = t = term_copy(DOTFUNCTOR);
  630.     while (TRUE)
  631.     {
  632.         ARG(p,1) = rd_term(252);
  633.         if (rd_token() == TSPECIAL && (char)token == ',')
  634.         {
  635.             ARG(p,2) = term_copy(DOTFUNCTOR);
  636.             p = ARG(p,2);
  637.         }
  638.         else
  639.         {
  640.             if (token_type == TSPECIAL && (char)token == '|')
  641.                 ARG(p,2) = rd_term(252);
  642.             else
  643.             {
  644.                 ARG(p,2) = NILATOM;
  645.                 valid_token = TRUE;
  646.             }
  647.             break;
  648.         }
  649.     }
  650.     return(t);
  651. }
  652.  
  653. /*    read a whole prolog term */
  654.  
  655. term *rd_term(prio)
  656. short prio;
  657. {
  658.     short i,j,k;
  659.     short lp;            /* local prio */
  660.     term *t, *p;
  661.     
  662.     if (c_errno)            /* bad */
  663.         return(NULL);
  664.  
  665.     lp = 0;                /* local prio */
  666.     switch(rd_token())
  667.     {
  668.         case TSYMBOL:
  669.             if (c == '(')    /* standart syntax */
  670.             {
  671.                 t = rd_args(token);
  672.                 break;
  673.             }
  674.             if (isprefix(token, &lp, &k))
  675.             {
  676.                 t = term_copy(get_functor(token, 1));
  677.                 if (rd_token() == TSPECIAL &&
  678.                    ((char)token != '(' &&
  679.                     (char)token != '{' &&
  680.                     (char)token != '[')
  681.                     || token_type == TDOT) /* missing arg */
  682.                 {
  683.                     if (lp > prio)
  684.                         syntax_error("Priority conflict");
  685.                     valid_token = TRUE;
  686.                     ARG(t,0)=(term *)get_functor(NAME(t),0);
  687.                     break;
  688.                 }
  689.                 valid_token = TRUE;
  690.                 p = rd_term(k);
  691.                 if (FUNC(t) == MINUSFUNCTOR && ISINT(p))
  692.                 {
  693.                    VALUE(p) = VALUE(p)*-1;
  694.                    t = p;
  695.                 }
  696.                 else
  697.                    ARG(t,1) = p;
  698.                 break;
  699.             }
  700.             t = term_copy(get_functor(token, 0));
  701.             break;
  702.         case TINTEGER:
  703.             t = (term *)token;
  704.             break;
  705.         case TVARIABLE:
  706.             t = (term *)token;
  707.             break;
  708.         case TSTRING:
  709.             t = rd_string(token);
  710.             break;
  711.         case TSPECIAL:
  712.             if ((char)token == '(')
  713.             {
  714.                 t = rd_term(255);
  715.                 if (rd_token() != TSPECIAL||(char)token != ')')
  716.                     syntax_error("Missing bracket");
  717.                 break;
  718.             }
  719.             if ((char)token == '[')
  720.             {
  721.                 t = rd_list();
  722.                 if (rd_token() != TSPECIAL ||
  723.                     (char)token != ']')
  724.                     syntax_error("Missing bracket");
  725.                 break;
  726.             }
  727.             if ((char)token == '{')
  728.             {
  729.                 p = rd_term(255);
  730.                 if (rd_token() != TSPECIAL || (char)token!='}')
  731.                     syntax_error("Missing bracket");
  732.                 t = term_copy(ASSERTFUNCTOR);
  733.                 ARG(t,1) = p;
  734.                 break;
  735.             }
  736.         case TDOT:
  737.             syntax_error("Unexpected end of term");
  738.             return(NULL);
  739.     }
  740.     while (TRUE)
  741.     {
  742.         if (c_errno)
  743.             return(NULL);
  744.             
  745.         if (rd_token() == TSYMBOL)
  746.         {
  747.             if (isinfix(token, &i, &j, &k))
  748.             {
  749.                 if (i <= prio && j >= lp)
  750.                 {
  751.                     p = term_copy(get_functor(token, 2));
  752.                     ARG(p,1) = t;
  753.                     t = p;
  754.                     ARG(t,2) = rd_term(k);
  755.                     lp = i;
  756.                     continue;
  757.                 }
  758.             }
  759.             if (ispostfix(token, &j, &k))
  760.             {
  761.                 if (j <= prio && k >= lp)
  762.                 {
  763.                     p = term_copy(get_functor(token, 1));
  764.                     ARG(p,1) = t;
  765.                     t = p;
  766.                     lp = j;
  767.                     continue;
  768.                 }
  769.             }
  770.             valid_token = TRUE;
  771.             return(t);
  772.         }
  773.         
  774.         if (token_type == TDOT)
  775.         {
  776.             valid_token = TRUE;
  777.             return(t);
  778.         }
  779.         if (token_type != TSPECIAL || (char)token == '('
  780.             || (char)token == '[')
  781.         {
  782.             syntax_error("Misplaced bracket");
  783.             return(NULL);
  784.         }
  785.         if ((char)token == ',' && prio >= 253 && lp <=252)
  786.         {
  787.             p = term_copy(COMMAFUNCTOR);
  788.             ARG(p,1) = t;
  789.             t = p;
  790.             ARG(t,2) = rd_term(253);
  791.             lp = 253;
  792.             if (lp < prio)
  793.                 continue;
  794.             return(t);
  795.         }
  796.         valid_token = TRUE;
  797.         return(t);
  798.     }
  799. }
  800.  
  801. /*    The primitive for the BI read */
  802.  
  803. term *read_term()
  804. {
  805.     term *t;
  806.     term *oldtop, *oldnext;        /* old proto heigth */
  807.     
  808.     oldtop = copytop;
  809.     oldnext = copynext;
  810.     tide = 0;            /* no variables read */
  811.     p = line;
  812.     *p = '\0';            /* no input term */
  813.     valid_token = FALSE;        /* no token read so far */
  814.     if (setjmp(hop))        /* we returned from a longjmp */
  815.     {
  816.         copynext = oldnext;
  817.         copytop = oldtop;
  818.         if (!c_errno)
  819.             c_errno = EIO;
  820.         return(NULL);
  821.     }        
  822.     if (!rd_line())            /* error while reading */
  823.         return(NULL);
  824.     rd_char();
  825.     t = rd_term(255);
  826.     if (rd_token() != TDOT)
  827.         syntax_error("Missing end of term");
  828.     if (c_errno)
  829.     {
  830.         copynext = oldnext;
  831.         copytop = oldtop;
  832.         return(NULL);
  833.     }
  834.     else
  835.         return(t);
  836. }
  837.