1 /* lex.c
2 
3    Written by Don Maszle
4    10 October 1991
5 
6    Copyright (c) 1991-2017 Free Software Foundation, Inc.
7 
8    This file is part of GNU MCSim.
9 
10    GNU MCSim is free software; you can redistribute it and/or
11    modify it under the terms of the GNU General Public License
12    as published by the Free Software Foundation; either version 3
13    of the License, or (at your option) any later version.
14 
15    GNU MCSim is distributed in the hope that it will be useful,
16    but WITHOUT ANY WARRANTY; without even the implied warranty of
17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18    GNU General Public License for more details.
19 
20    You should have received a copy of the GNU General Public License
21    along with GNU MCSim; if not, see <http://www.gnu.org/licenses/>
22 
23    Contains routines for lexical parsing of input.  Provides types
24    INPUTBUF and *PINPUTBUF for maintaining information about an input
25    buffer.  The buffer must be initialized with the name of a file.
26 
27    All Lex routines take the input buffer as an argument.  Input is
28    read from the buffer and the buffer position is updated.  A
29    routine MakeStringBuffer() creates a temporary buffer from a
30    string, copying information about the original buffer if it is
31    provided.
32 
33    A pointer is provided in the INPUTBUF structure to hold user information.
34 */
35 
36 #include <stdio.h>
37 #include <stdlib.h>
38 #include <string.h>
39 #include <ctype.h>
40 
41 #include "lex.h"
42 #include "lexerr.h"
43 
44 #ifndef SEEK_CUR
45 #define SEEK_CUR 1
46 #endif
47 
48 PSTR vrgszLexTypes[] = {
49   "null-type??",             /* 00 */
50   "identifier",              /* 01 */
51   "integer",                 /* 02 */
52   "integer-or-id",           /* 03 */
53   "floating-point",          /* 04 */
54   "float-or-id",             /* 05 */
55   "number",                  /* 06 */
56   "number-or-id",            /* 07 */
57   "punctuation",             /* 08 */
58   "invalid lexical type",    /* 09 */
59   "invalid lexical type",    /* 0a */
60   "invalid lexical type",    /* 0b */
61   "invalid lexical type",    /* 0c */
62   "invalid lexical type",    /* 0d */
63   "invalid lexical type",    /* 0e */
64   "invalid lexical type",    /* 0f */
65   "quoted-string",           /* 10 */
66 
67   "" /* End flag */
68 }; /* vrgszLexTypes[] = */
69 
70 
71 /* routines */
72 
73 /* -----------------------------------------------------------------------------
74    PreventLexSplit
75 
76    Prevents the buffer from splitting a lexical element by
77    "backing up" the EOB pointer and adjusting the file pointer
78    to just after a carriage return.
79 */
PreventLexSplit(PINPUTBUF pibIn,int iOffset)80 void PreventLexSplit (PINPUTBUF pibIn, int iOffset)
81 {
82   long lDelta;
83   PBUF pbufEOB = pibIn->pbufOrg + iOffset;
84   PBUF pbufEOBOld;
85 
86   if (!EOB(pibIn)        /* If not EOB, use all of input, otherwise... */
87       || (iOffset == BUFFER_SIZE)) {    /* No room for NULL */
88 
89     pbufEOBOld = pbufEOB;        /* Save EOB */
90     while (*(--pbufEOB) != CH_EOLN)
91       ;                /* Move EOB to last EOLN */
92     *pbufEOB = '\0';        /* Overwrite EOLN with NULL */
93 
94     if ((lDelta = (long) (pbufEOB - pbufEOBOld)))
95       fseek (pibIn->pfileIn, lDelta, SEEK_CUR);    /* Backup file ptr */
96   } /* if */
97 
98   else *pbufEOB = '\0'; /* Append NULL */
99 
100 } /* PreventLexSplit */
101 
102 
103 /* -----------------------------------------------------------------------------
104    FillBuffer
105 
106    Fills the initialized input buffer and sets all buffer pointers.
107 
108    Return 0 on error, non-zero on success or EOF if at end of file.
109 */
FillBuffer(PINPUTBUF pibIn)110 int FillBuffer (PINPUTBUF pibIn)
111 {
112   int iReturn = 0;
113   int iOffset;
114 
115   if (pibIn && pibIn->pfileIn && pibIn->pbufOrg) {
116 
117     if ((iOffset = fread (pibIn->pbufOrg, 1, BUFFER_SIZE, pibIn->pfileIn))) {
118       iReturn = (int) iOffset;
119       PreventLexSplit (pibIn, iOffset);
120       pibIn->pbufCur = pibIn->pbufOrg;
121     } /* if */
122 
123     else
124       if (feof(pibIn->pfileIn))
125     iReturn = EOF;
126       else
127     ReportError (pibIn, RE_FATAL, "Unexpected end of file.", NULL);
128   } /* if */
129 
130   return (iReturn);
131 
132 } /* FillBuffer */
133 
134 
135 /* -----------------------------------------------------------------------------
136    InitBuffer
137 
138    Initializes the input buffer whose address is pibIn with the
139    file given by szFullPathname, and fills the buffer array with the
140    first data to be processed.
141 
142    Returns 0 on error, non-zero on success.
143 */
InitBuffer(PINPUTBUF pibIn,PSTR szFullPathname)144 BOOL InitBuffer (PINPUTBUF pibIn, PSTR szFullPathname)
145 {
146   BOOL bReturn = 0;
147 
148   if (!pibIn)
149     return FALSE;
150 
151   pibIn->iLineNum = 1;
152   pibIn->iLNPrev = 0;
153   pibIn->cErrors = 0;
154   pibIn->pInfo = NULL;
155   pibIn->pbufCur = NULL;
156 
157   if ((pibIn->pfileIn = fopen (szFullPathname, "r"))) {
158     if ((pibIn->pbufOrg = (PBUF) malloc (BUFFER_SIZE)))
159       bReturn = FillBuffer (pibIn);
160     else
161       ReportError (pibIn, RE_OUTOFMEM | RE_FATAL, "InitBuffer", NULL);
162   }
163   else
164     ReportError (pibIn, RE_FILENOTFOUND | RE_FATAL, szFullPathname, NULL);
165 
166   return (bReturn);
167 
168 } /* InitBuffer */
169 
170 
171 /* -----------------------------------------------------------------------------
172    MakeStringBuffer
173 
174    Makes a string buffer from a string.
175 */
MakeStringBuffer(PINPUTBUF pBuf,PINPUTBUF pbufStr,PSTR sz)176 void MakeStringBuffer (PINPUTBUF pBuf, PINPUTBUF pbufStr, PSTR sz)
177 {
178   pbufStr->pfileIn = NULL;        /* Flags that is not file buffer */
179   pbufStr->pbufCur = pbufStr->pbufOrg = sz;
180   pbufStr->iLineNum = 0;        /* Multiline eqn formatting in modo */
181   pbufStr->iLNPrev  = 0;
182   pbufStr->pInfo = (pBuf ? pBuf->pInfo : NULL);
183 
184   if (pBuf) {
185     pbufStr->iLineNum = pBuf->iLineNum;    /* For error reporting  */
186     pbufStr->iLNPrev = TRUE;        /* Flag: Use iLineNum in ReportError */
187   } /* if */
188 
189 } /* MakeStringBuffer */
190 
191 
FlushBuffer(PINPUTBUF pibIn)192 void FlushBuffer (PINPUTBUF pibIn)
193 {
194   PBUF pbuf = pibIn->pbufOrg;
195 
196   while (*pbuf)
197     printf ("%c", *pbuf++);
198   printf ("");
199 } /* FlushBuffer */
200 
201 
202 /* -----------------------------------------------------------------------------
203    SkipWhitespace
204 
205    Skips over whitespace of input buffer.  Returns non-zero if something
206    has been skipped.
207 */
SkipWhitespace(PINPUTBUF pibIn)208 int SkipWhitespace (PINPUTBUF pibIn)
209 {
210   char c;
211   int fSkipped = 0;
212 
213   if (!pibIn)
214     return 0;
215 
216   if (!*pibIn->pbufCur && pibIn->pfileIn)
217     FillBuffer (pibIn);
218 
219   /* Skip Spaces, Tabs and Newlines */
220 
221   while (isspace(c = *pibIn->pbufCur) || c == CH_COMMENT) {
222     fSkipped = 1;
223     if (c == CH_COMMENT)
224       SkipComment (pibIn);
225 
226     else {
227       if (c == '\n')
228     pibIn->iLineNum++;
229 
230       if (!*(++pibIn->pbufCur) && pibIn->pfileIn)
231     if (FillBuffer (pibIn) == EOF)
232       break;
233     } /* else */
234   } /* while */
235 
236   return (fSkipped);
237 
238 } /* SkipWhitespace */
239 
240 
241 /* ---------------------------------------------------------------------------
242    GetArrayBounds
243    return the lower (LB) upper (UB) bounds of an array given between [].
244    GetArrayBounds must be called after finding [. It reads up to ], included.
245    Errors are generated if LB < 0 or UB < LB.
246    Syntax for bounds:
247    [i]:   bounds returned are i to i+1
248    [i-j]: bounds returned are i to j+1
249    where i and j are long integers
250 */
GetArrayBounds(PINPUTBUF pibIn,PLONG piLB,PLONG piUB)251 void GetArrayBounds (PINPUTBUF pibIn, PLONG piLB, PLONG piUB)
252 {
253   PSTRLEX szTmp;
254 
255   if (ENextLex (pibIn, szTmp, LX_INTEGER)) {
256     ReportError (pibIn, RE_INIT | RE_FATAL, NULL, NULL);
257   }
258   else {
259     *piLB = atol(szTmp);
260     if (*piLB < 0)
261       ReportError (pibIn, RE_POSITIVE | RE_FATAL, szTmp, NULL);
262 
263     if (NextChar (pibIn) == '-') { /* get eventual hyphen */
264       pibIn->pbufCur++; /* advance */
265       if (ENextLex (pibIn, szTmp, LX_INTEGER)) {
266         ReportError (pibIn, RE_INIT | RE_FATAL, NULL, NULL);
267       }
268       else {
269       *piUB = atol(szTmp) + 1;
270         if (*piUB <= *piLB)
271          ReportError (pibIn, RE_UNKNOWN | RE_FATAL, "",
272                       "Upper bound must be higher than lower bound");
273       }
274       if (!GetPunct (pibIn, szTmp, ']')) { /* get closing bracket */
275         ReportError (pibIn, RE_LEXEXPECTED | RE_FATAL, "]", NULL);
276       }
277     }
278     else {
279       if (!GetPunct (pibIn, szTmp, ']')) { /* get closing bracket */
280         ReportError (pibIn, RE_LEXEXPECTED | RE_FATAL, "]", NULL);
281       }
282       else { /* a number is an index, the upper bound is set at LB+1 */
283         *piUB = *piLB + 1;
284       }
285     }
286   }
287 } /* GetArrayBounds */
288 
289 
290 /* -----------------------------------------------------------------------------
291    GetaString
292 
293    Copies the quoted string from buffer to szLex.
294 */
GetaString(PINPUTBUF pibIn,PSTR szLex)295 void GetaString (PINPUTBUF pibIn, PSTR szLex)
296 {
297   int i = 0;
298 
299   if (!pibIn || !szLex)
300     return;
301 
302   if (IsString ((PSTR) pibIn->pbufCur)) {
303     do
304       szLex[i++] = *++pibIn->pbufCur; /* Copy string */
305 
306     while ((*pibIn->pbufCur)
307            && (*pibIn->pbufCur != CH_STRDELIM)
308            && (i < MAX_LEX-1));
309   } /* if */
310 
311   if (*pibIn->pbufCur == CH_STRDELIM) {
312     pibIn->pbufCur++; /* Increment past closing delim */
313     i--;
314   }
315 
316   szLex[i] = '\0'; /* Overwrite closing delim with '\0' */
317 
318 } /* GetaString */
319 
320 
321 /* -----------------------------------------------------------------------------
322    GetIdentifier
323 
324    Copies identifier from buffer to szLex.  A valid id begins with a
325    letter or '_' and is followed by alphanumerics or '_'.  MAX_LEX is
326    the length of the longest permitable id.
327 */
GetIdentifier(PINPUTBUF pibIn,PSTR szLex)328 void GetIdentifier (PINPUTBUF pibIn, PSTR szLex)
329 {
330   int i = 0;
331 
332   if (!pibIn || !szLex)
333     return;
334 
335   if (isalpha(*pibIn->pbufCur) || IsUnderscore(*pibIn->pbufCur)) {
336     do
337     szLex[i++] = *pibIn->pbufCur++; /* Copy identifier */
338 
339     while ((*pibIn->pbufCur)
340            && (isalnum(*pibIn->pbufCur) || IsUnderscore(*pibIn->pbufCur))
341            && (i < MAX_LEX-1));
342   } /* if */
343 
344   szLex[i] = '\0';
345 
346 } /* GetIdentifier */
347 
348 
349 /* -----------------------------------------------------------------------------
350    GetNumber
351 
352    Gets the next lexical element as either a floating-point or
353    integer number from the input buffer.  piLexType is set accordingly.
354 
355    An integer is defined as a sequence of digits.
356 
357    A floating-point ::= (digits | dotted-digits) {exponent}?
358    where
359        dotted-digits ::= (ddd. | ddd.ddd | .ddd)
360        {exponent}    ::= ('e' | 'E') {'+' | '-'}? digits
361 
362    Leading signs to the numbers are handled separately as unary
363    or binary operators.
364 
365    The routine processes by using a state transition definition of
366    parsing the number:
367            ddd1 [[.[ddd2]] [E[+]ddd3]]
368 */
GetNumber(PINPUTBUF pibIn,PSTR szLex,PINT piLexType)369 void GetNumber (PINPUTBUF pibIn, PSTR szLex, PINT piLexType)
370 {
371   int i = 0;
372   char c;
373   BOOL bHasSign = FALSE;
374   BOOL bLeadingDigits = FALSE;
375   enum States
376    {Start, Digits1, Point, Digits2, Exp, ExpSign, Digits3, End} eState;
377 
378   if (!pibIn || !szLex || !piLexType)
379     return;
380 
381   eState = Start;
382   *piLexType = LX_NULL;
383   while ((c = *pibIn->pbufCur)
384          && i < MAX_LEX-1
385      && eState != End) {
386 
387     switch (eState) {
388       case Start:
389     if (c == '.')
390       eState = Point;
391     else if (!bHasSign && IsSign(c))
392       bHasSign = TRUE;
393     else if (isdigit(*pibIn->pbufCur)) {
394       bLeadingDigits = *piLexType = LX_INTEGER;
395       eState = Digits1;
396     } /* else */
397     else
398       eState = End;
399     break;
400 
401       case Digits1:
402     if (c == '.')
403       eState = Point;
404     else if (c == 'e' || c == 'E')
405       eState = Exp;
406     else if (!isdigit(c))
407       eState = End;
408     break;
409 
410       case Point:
411     *piLexType = LX_FLOAT;
412     if (bLeadingDigits && (c == 'e' || c == 'E'))
413       eState = Exp;
414     else if (isdigit(c))
415       eState = Digits2;
416     else {
417       if (!bLeadingDigits)        /* Error, point only */
418         *piLexType = LX_NULL;
419       eState = End;
420     } /* else */
421     break;
422 
423       case Digits2:
424     if (c == 'e' || c == 'E')
425       eState = Exp;
426     else if (!isdigit(c))
427       eState = End;
428     break;
429 
430       case Exp:
431     *piLexType = LX_FLOAT;
432     if (IsSign(c)) {
433       eState = ExpSign;
434       break;
435     } /* if */
436         /* Fall through! */
437 
438       case ExpSign:
439     if (isdigit(c))
440       eState = Digits3;
441     else {
442       *piLexType = LX_NULL;
443       eState = End;
444     }
445     break;
446 
447       case Digits3:
448     if (!isdigit(c))
449       eState = End;
450         break;
451 
452       case End:
453     break;
454     } /* switch */
455 
456     if (eState != End)
457       szLex[i++] = *pibIn->pbufCur++;
458   } /* while */
459   szLex[i] = '\0';
460 
461 } /* GetNumber */
462 
463 
464 /* -----------------------------------------------------------------------------
465    NextLex
466 
467    Skips over leading whitespace and copies the next lexical element
468    into szLex.
469 */
NextLex(PINPUTBUF pibIn,PSTRLEX szLex,PINT piLexType)470 void NextLex (PINPUTBUF pibIn, PSTRLEX szLex, PINT piLexType)
471 {
472   char c;
473   BOOL fDone = FALSE;
474 
475   *piLexType = LX_NULL;
476   if (!pibIn || !szLex || !piLexType || !pibIn->pbufCur)
477     return;
478 
479   while (!fDone) {
480     fDone = TRUE;
481     SkipWhitespace (pibIn);
482 
483     if (!EOB(pibIn)) {
484       c = *pibIn->pbufCur;
485 
486       if (c == CH_COMMENT) { /* Comments can appear anywhere */
487         fDone = FALSE; /* Continue until you get a lex */
488         SkipComment (pibIn);
489       } /* if */
490 
491       else
492       if (isalpha(c) || IsUnderscore(c)) { /* Take one identifier */
493         *piLexType = LX_IDENTIFIER;
494         GetIdentifier (pibIn, szLex);
495       } /* if */
496 
497       else
498       if (isdigit(c) || c == '.' || IsSign(c)) { /* Take one number */
499         GetNumber (pibIn, szLex, piLexType);
500         if (IsSign(c) && !*piLexType) { /* Unary +/- for identifier */
501           szLex[0] = c;
502           szLex[1] = '\0';
503           *piLexType = LX_PUNCT;
504         } /* if */
505       } /* if */
506 
507       else
508       if (c == CH_STRDELIM) {
509         *piLexType = LX_STRING;
510         GetaString (pibIn, szLex);
511       } /* if */
512 
513       else { /* Is other punctuation -- Take one char */
514         *piLexType = LX_PUNCT;
515         szLex[0] = *pibIn->pbufCur++;
516         szLex[1] = '\0';
517       } /* else */
518     } /* if */
519   } /* while */
520 
521 } /* NextLex */
522 
523 
524 /* -----------------------------------------------------------------------------
525    ENextLex
526 
527    Sames as NextLex but looks for iType.  Reports errors.  Returns
528    0 if ok, non-zero if error.
529 */
ENextLex(PINPUTBUF pibIn,PSTRLEX szLex,int iType)530 BOOL ENextLex (PINPUTBUF pibIn, PSTRLEX szLex, int iType)
531 {
532   int iLex, iErr;
533 
534   NextLex (pibIn, szLex, &iLex);
535 
536   if ((iErr = !(iType & iLex)))
537     ReportError (pibIn, RE_LEXEXPECTED, vrgszLexTypes[iType], szLex);
538 
539   return (iErr);
540 
541 } /* ENextLex */
542 
543 
544 /* -----------------------------------------------------------------------------
545    SkipComment
546 
547    Skips over the comment in the input buffer, the leading delimiter
548    of which has already been stripped.
549 */
SkipComment(PINPUTBUF pibIn)550 void SkipComment (PINPUTBUF pibIn)
551 {
552   if (!pibIn)
553     return;
554 
555   if (!*pibIn->pbufCur)
556     FillBuffer (pibIn);
557 
558   while (*pibIn->pbufCur++ != CH_EOLN) /* Eat 1 line comment */
559     if (!*pibIn->pbufCur)
560       if (FillBuffer (pibIn) == EOF)
561     break;
562 
563   pibIn->iLineNum++;
564 
565   if (!*pibIn->pbufCur)
566     FillBuffer (pibIn);
567 
568 } /* SkipComment */
569 
570 
571 /* -----------------------------------------------------------------------------
572    NextChar
573 
574    Returns the next character in the input buffer without advancing
575    over it.
576 */
NextChar(PINPUTBUF pibIn)577 char NextChar (PINPUTBUF pibIn)
578 {
579   if (!pibIn
580      || (!*pibIn->pbufCur
581          && FillBuffer (pibIn) == EOF))
582     return (0);
583 
584   else
585     return (*pibIn->pbufCur);
586 
587 } /* NextChar */
588 
589 
590 /* -----------------------------------------------------------------------------
591    GetOptPunct
592 
593    Advances over the optional punctuation chPunct.  Allows syntax where either
594    the punctuation or whitespace is valid.
595 
596    e.g. 'x 5;'  -or-  'x = 5;'
597 */
GetOptPunct(PINPUTBUF pibIn,PSTR szLex,char chPunct)598 int GetOptPunct (PINPUTBUF pibIn, PSTR szLex, char chPunct)
599 {
600   int iReturn, iType;
601 
602   iReturn = SkipWhitespace (pibIn);
603   if (NextChar (pibIn) == chPunct) {
604     iReturn = TRUE;
605     NextLex (pibIn, szLex, &iType);
606   }
607   return (iReturn);
608 
609 } /* GetOptPunct */
610 
611 
612 /* -----------------------------------------------------------------------------
613    GetPunct
614 
615    Tries to get the given punctuation from the input buffer.
616    Returns TRUE if the next lexical item was the chPunct, else FALSE .
617 */
GetPunct(PINPUTBUF pibIn,PSTR szLex,char chPunct)618 int GetPunct (PINPUTBUF pibIn, PSTR szLex, char chPunct)
619 {
620   int iType;
621 
622   NextLex (pibIn, szLex, &iType);
623   return ((iType == LX_PUNCT) && szLex[0] == chPunct);
624 
625 } /* GetPunct */
626 
627 
628 /* -----------------------------------------------------------------------------
629    EGetPunct
630 
631    Tries to get the given punctuation from the input buffer.
632    Returns 0 if next lexical item was the chPunct, non-zero if error.
633    Reports Errors.
634 */
EGetPunct(PINPUTBUF pibIn,PSTR szLex,char chPunct)635 int EGetPunct (PINPUTBUF pibIn, PSTR szLex, char chPunct)
636 {
637   int iReturn;
638 
639   iReturn = !GetPunct (pibIn, szLex, chPunct);
640   if (iReturn) {
641     szLex[1] = chPunct;
642     ReportError (pibIn, RE_EXPECTED, szLex, NULL);
643   }
644 
645   return (iReturn);
646 
647 } /* EGetPunct */
648 
649 
650 /* -----------------------------------------------------------------------------
651    EatStatement
652 
653    Eats buffer to the statement terminator.
654 */
EatStatement(PINPUTBUF pib)655 void EatStatement (PINPUTBUF pib)
656 {
657   char c;
658 
659   if (!pib)
660     return;
661 
662   while ((c = NextChar (pib)) && (c != CH_STMTTERM)) {
663     if (c == CH_EOLN)
664       pib->iLineNum++;
665     pib->pbufCur++;    /* Eat to ... */
666   } /* while */
667 
668   if (c)
669     pib->pbufCur++; /* ... and including statement terminator */
670 } /* EatStatement */
671 
672 
673 /* -----------------------------------------------------------------------------
674    GetStatement
675 
676    Gets the next statement from the input buffer.  The buffer is
677    read until a statement terminator ';' is found.  The statement is
678    unprocessed.  Syntactical validity will be checked later.
679 
680    The buffer szStmt is assumed to be of type PSTREQN of size MAX_EQN.
681 */
GetStatement(PINPUTBUF pibIn,PSTR szStmt)682 void GetStatement (PINPUTBUF pibIn, PSTR szStmt)
683 {
684   int i, fDone = 0;
685 
686   if (!pibIn || !szStmt)
687     return;
688 
689   SkipWhitespace (pibIn);
690 
691   i = 0;
692   if (!EOB(pibIn)) {
693     while (!fDone) {
694       if (*pibIn->pbufCur) {
695         if (!(fDone = (NextChar (pibIn) == CH_STMTTERM))) {
696           if (i < MAX_EQN-2) {
697             if ((szStmt[i++] = *pibIn->pbufCur++) == CH_EOLN)
698               pibIn->iLineNum++;
699           } /* if */
700           else {
701             ReportError (pibIn, RE_EQNTOOLONG | RE_FATAL, NULL, NULL);
702           }
703         } /* if !fDone... */
704       } /* if pibIn->pbufCur */
705       else {
706         fDone = (FillBuffer (pibIn) == EOF);
707       }
708     } /* while */
709 
710     szStmt[i] = '\0';
711 
712   } /* if */
713 
714   if (!i)
715     ReportError (pibIn,
716                  RE_LEXEXPECTED | RE_FATAL, "rvalue to assignment", NULL);
717 
718 } /* GetStatement */
719 
720 
721 /* -----------------------------------------------------------------------------
722    NextListItem
723 
724    Copies the next list item to szLex if it is a lexical element
725    indicated in the bit flags bIdTypes.  If the fItemNum flag is
726    non-zero, a separator must appear in the list.
727 
728    Returns positive if a valid item is found.
729    Returns negative if szLex is an invalid item.
730 
731    Will not eat list terminator.
732 */
NextListItem(PINPUTBUF pibIn,PSTR szLex,int bIdTypes,int fItemNum,char cListTerm)733 int NextListItem (PINPUTBUF pibIn, PSTR szLex,
734                   int bIdTypes, int fItemNum, char cListTerm)
735 {
736   int iType, iReturn = 0;
737 
738   if (!fItemNum
739       || GetOptPunct (pibIn, szLex, ',')) {
740     if (NextChar (pibIn) != cListTerm) {
741       NextLex (pibIn, szLex, &iType);
742       if (iType & bIdTypes)
743     iReturn = 1;
744       else
745     iReturn = -1;
746     } /* if */
747   } /* if */
748 
749   return (iReturn);
750 
751 } /* NextListItem */
752 
753 
754 /* -----------------------------------------------------------------------------
755    GetFuncArgs
756 
757    Gets nArgs arguments to a "function" from pibIn. The argument
758    list must be in parentheses.
759 
760    rgiArgTypes[] is a profile specifying which type each argument must be.
761    rgszArgs[] is an array of PSTRLEX buffers to hold the arguments.
762 
763    Returns TRUE on success, FALSE on an error. Errors are reported,
764    but the statement is not flushed.
765 */
GetFuncArgs(PINPUTBUF pibIn,int nArgs,int rgiArgTypes[],PSTR szArgs)766 BOOL GetFuncArgs (PINPUTBUF pibIn,
767                   int nArgs, int rgiArgTypes[], PSTR szArgs)
768 {
769   BOOL bOK = TRUE;
770   int i, iType;
771   PSTRLEX szPunct;
772 
773   if (!(bOK = GetPunct(pibIn, szPunct, CH_LPAREN))) {
774     szPunct[1] = CH_LPAREN;
775     ReportError(pibIn, RE_EXPECTED, szPunct, NULL);
776   } /* if */
777 
778   for (i = 0; i < nArgs && bOK; i++, szArgs += MAX_LEX) {
779     if (i)
780       if (!(bOK = GetOptPunct(pibIn, szArgs, ','))) {
781         *(szArgs+1) = ',';
782         ReportError(pibIn, RE_EXPECTED, szArgs, NULL);
783         return(bOK); /* Error: Stop getting args */
784       }
785 
786     NextLex (pibIn, szArgs, &iType);
787     if (!(bOK &= (iType & rgiArgTypes[i]) > 0)) {
788       ReportError(pibIn, RE_LEXEXPECTED,
789                   vrgszLexTypes[rgiArgTypes[i]], szArgs);
790       return(bOK); /* Error: Stop getting args */
791     }
792   } /* for */
793 
794   if (!(bOK = GetPunct (pibIn, szPunct, CH_RPAREN))) {
795     szPunct[1] = CH_RPAREN;
796     ReportError(pibIn, RE_EXPECTED, szPunct, NULL);
797   } /* if */
798 
799   return(bOK);
800 
801 } /* GetFuncArgs */
802 
803 
804 /* ---------------------------------------------------------------------------
805    UnrollEquation
806 
807    Copy szEqn in szEqnU, replacing bracketed expressions evaluating in
808    <number> by _number. Expressions can be composed of integers, the
809    4 basic arithmetic operators, parentheses and 'i' which stands for the
810    argument index passed to the routine.
811    Examples:
812    y[0] -> y_0
813    y[1 + 1] -> y_2
814    y[i * 2] -> y_4 if index = 2
815 */
UnrollEquation(PINPUTBUF pibIn,long index,PSTR szEqn,PSTR szEqnU)816 void UnrollEquation (PINPUTBUF pibIn, long index, PSTR szEqn, PSTR szEqnU)
817 {
818   int j = 0, k = 0, m;
819   BOOL bExpress = FALSE;
820   PSTRLEX szExpression;
821 
822   while ((szEqn[j] != '\0') && (k < MAX_EQN - 1)) {
823     if (bExpress) { /* bracketed expressions found: scan it up to ] included */
824       /* copy the expression to a temporary string */
825       m = 0;
826       while ((szEqn[j] != '\0') && (szEqn[j] != ']') && (m < MAX_EQN - 1)) {
827         szExpression[m] = szEqn[j];
828         j++;
829         m++;
830       }
831       if (szEqn[j] == ']') { /* skip and exit expression parsing mode */
832         j++;
833         bExpress = FALSE;
834       }
835       if ((szEqn[j] != '\0') && (m == MAX_EQN - 1))
836         ReportError (pibIn, RE_EQNTOOLONG | RE_FATAL, NULL,
837                      "(Occured while unrolling a loop)");
838       szExpression[m] = '\0'; /* terminate szExpression */
839 
840       /* compute expression and put back the result in szExpression
841       sprintf (szExpression, "%ld",
842                EvaluateExpression (pibIn, index, szExpression)); */
843 
844       /* copy szExpression into szEqnU */
845       m = 0;
846       while ((szExpression[m] != '\0') && (m < MAX_EQN - 1)) {
847         szEqnU[k] = szExpression[m];
848         k++;
849         m++;
850       }
851     } /* end if bExpress */
852     else switch (szEqn[j]) {
853       case '[': /* replace by _ and enter expression parsing mode */
854         szEqnU[k] = '_';
855         j++;
856         k++;
857         bExpress = TRUE;
858         break;
859 
860       case ']': /* should have been eaten in expression parsing mode */
861         ReportError (pibIn, RE_UNEXPECTED | RE_FATAL, "]",
862                      "(Could be nested brackets)");
863 
864       default: /* copy and advance */
865         szEqnU[k] = szEqn[j];
866         j++;
867         k++;
868         break;
869     }
870   } /* while */
871   if ((szEqn[j] != '\0') && (k == MAX_EQN - 1))
872     ReportError (pibIn, RE_EQNTOOLONG | RE_FATAL, NULL,
873                  "(Occured in UnrollEquation)");
874 
875   /* terminate szEqnU */
876   szEqnU[k] = '\0';
877 
878 } /* UnrollEquation */
879 
880 
881 /* End */
882 
883