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