]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/m2/mc/mcp3.bnf
Update copyright years.
[thirdparty/gcc.git] / gcc / m2 / mc / mcp3.bnf
CommitLineData
1eee94d3
GM
1--
2-- mc-3.bnf grammar and associated actions for mcp3.
3--
a945c346 4-- Copyright (C) 2015-2024 Free Software Foundation, Inc.
1eee94d3
GM
5-- Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6--
7-- This file is part of GNU Modula-2.
8--
9-- GNU Modula-2 is free software; you can redistribute it and/or modify
10-- it under the terms of the GNU General Public License as published by
11-- the Free Software Foundation; either version 3, or (at your option)
12-- any later version.
13--
14-- GNU Modula-2 is distributed in the hope that it will be useful, but
15-- WITHOUT ANY WARRANTY; without even the implied warranty of
16-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17-- General Public License for more details.
18--
19-- You should have received a copy of the GNU General Public License
20-- along with GNU Modula-2; see the file COPYING3. If not see
21-- <http://www.gnu.org/licenses/>.
22% module mcp3 begin
23(* output from mc-3.bnf, automatically generated do not edit.
24
a945c346 25Copyright (C) 2015-2024 Free Software Foundation, Inc.
1eee94d3
GM
26Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
27
28This file is part of GNU Modula-2.
29
30GNU Modula-2 is free software; you can redistribute it and/or modify
31it under the terms of the GNU General Public License as published by
32the Free Software Foundation; either version 3, or (at your option)
33any later version.
34
35GNU Modula-2 is distributed in the hope that it will be useful, but
36WITHOUT ANY WARRANTY; without even the implied warranty of
37MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
38General Public License for more details.
39
40You should have received a copy of the GNU General Public License
41along with GNU Modula-2; see the file COPYING. If not,
42see <https://www.gnu.org/licenses/>. *)
43
44IMPLEMENTATION MODULE mcp3 ;
45
46FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
47 ConCat, ConCatChar ;
48
49FROM mcError IMPORT errorStringAt ;
50FROM nameKey IMPORT NulName, Name, makekey, makeKey ;
51FROM mcPrintf IMPORT printf0, printf1 ;
52FROM mcDebug IMPORT assert ;
53FROM mcReserved IMPORT toktype ;
54FROM mcMetaError IMPORT metaError1, metaError2 ;
55FROM mcStack IMPORT stack ;
56
57IMPORT mcStack ;
58
59FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
60 insertTokenAndRewind, getTokenNo ;
61
62FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
63 putTypeHidden,
64 enterScope, leaveScope,
65 putType, lookupSym, isDef, makeSubrange,
66 makeSet, makePointer, makeProcType,
67 putReturnType, putOptReturn,
68 addParameter, paramEnter, paramLeave,
69 makeVarargs, makeVarParameter, makeNonVarParameter,
70 putSubrangeType, putConst,
71 makeArray, putUnbounded, getCardinal,
72 makeRecord, isRecord, isRecordField, isVarientField, makeVarient,
73 addFieldsToRecord, isVarient, buildVarientSelector,
74 buildVarientFieldRecord, makeVarDecl, addOptParameter,
75 makeIdentList, putIdent, addVarParameters, addNonVarParameters,
76 lookupInScope, import, lookupExported, isImp, isModule, isConst,
77 makeLiteralInt, makeLiteralReal, makeString, getBuiltinConst,
78 getNextEnum, resetEnumPos, makeConstExp, setConstExpComplete,
79 makeEnum, makeEnumField, setNoReturn ;
80
81
82CONST
83 Pass1 = FALSE ;
84 Debugging = FALSE ;
85
86VAR
87 WasNoError : BOOLEAN ;
88 curisused : BOOLEAN ;
89 curstring,
90 curident : Name ;
91 curproc,
92 frommodule,
93 typeDes,
94 typeExp,
95 curmodule : node ;
96 stk : stack ;
97
98
99(*
100 push -
101*)
102
103PROCEDURE push (n: node) : node ;
104BEGIN
105 RETURN mcStack.push (stk, n)
106END push ;
107
108
109(*
110 pop -
111*)
112
113PROCEDURE pop () : node ;
114BEGIN
115 RETURN mcStack.pop (stk)
116END pop ;
117
118
119(*
120 replace -
121*)
122
123PROCEDURE replace (n: node) : node ;
124BEGIN
125 RETURN mcStack.replace (stk, n)
126END replace ;
127
128
129(*
130 peep - returns the top node on the stack without removing it.
131*)
132
133PROCEDURE peep () : node ;
134BEGIN
135 RETURN push (pop ())
136END peep ;
137
138
139(*
140 depth - returns the depth of the stack.
141*)
142
143PROCEDURE depth () : CARDINAL ;
144BEGIN
145 RETURN mcStack.depth (stk)
146END depth ;
147
148
149(*
150 checkDuplicate -
151*)
152
153PROCEDURE checkDuplicate (b: BOOLEAN) ;
154BEGIN
155
156END checkDuplicate ;
157
158
159PROCEDURE ErrorString (s: String) ;
160BEGIN
161 errorStringAt (s, getTokenNo ()) ;
162 WasNoError := FALSE
163END ErrorString ;
164
165
166PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
167BEGIN
168 ErrorString (InitString (a))
169END ErrorArray ;
170
171
172(*
173 checkParameterAttribute -
174*)
175
176PROCEDURE checkParameterAttribute ;
177BEGIN
178 IF makeKey ("unused") # curident
179 THEN
180 metaError1 ('attribute {%1k} is not allowed in the formal parameter section, currently only unused is allowed', curident)
181 END
182END checkParameterAttribute ;
183
184
185(*
186 checkReturnAttribute -
187*)
188
189PROCEDURE checkReturnAttribute ;
190BEGIN
191 IF makeKey ("noreturn") # curident
192 THEN
193 metaError1 ('attribute {%1k} is not allowed in the procedure return type, only noreturn is allowed', curident)
194 END
195END checkReturnAttribute ;
196
197
198(*
199 pushNunbounded -
200*)
201
202PROCEDURE pushNunbounded (c: CARDINAL) ;
203VAR
204 type,
205 array,
206 subrange: node ;
207BEGIN
208 WHILE c#0 DO
209 type := pop () ;
210 subrange := makeSubrange (NIL, NIL) ;
211 putSubrangeType (subrange, getCardinal ()) ;
212
213 array := makeArray (subrange, type) ;
214 putUnbounded (array) ;
215 type := push (array) ;
216 DEC (c)
217 END
218END pushNunbounded ;
219
220
221(*
222 makeIndexedArray - builds and returns an array of type, t, with, c, indices.
223*)
224
225PROCEDURE makeIndexedArray (c: CARDINAL; t: node) : node ;
226VAR
227 i: node ;
228BEGIN
229 WHILE c>0 DO
230 t := makeArray (pop (), t) ;
231 DEC (c)
232 END ;
233 RETURN t
234END makeIndexedArray ;
235
236
237(*
238 importInto - from, m, import, name, into module, current.
239 It checks to see if curident is an enumeration type
240 and if so automatically includes all enumeration fields
241 as well.
242*)
243
244PROCEDURE importInto (m: node; name: Name; current: node) ;
245VAR
246 s, o: node ;
247BEGIN
248 assert (isDef (m)) ;
249 assert (isDef (current) OR isModule (current) OR isImp (current)) ;
250 s := lookupExported (m, name) ;
251 IF s=NIL
252 THEN
253 metaError2 ('{%1k} was not exported from definition module {%2a}', name, m)
254 ELSE
255 o := import (current, s) ;
256 IF s#o
257 THEN
258 metaError2 ('{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}',
259 s, o)
260 END
261 END
262END importInto ;
263
264
265(*
266 checkEndName - if module does not have, name, then issue an error containing, desc.
267*)
268
269PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
270VAR
271 s: String ;
272BEGIN
273 IF getSymName (module)#name
274 THEN
275 s := InitString ('inconsistent module name found with this ') ;
276 s := ConCat (s, Mark (InitString (desc))) ;
277 ErrorString (s)
278 END
279END checkEndName ;
280
281% declaration mcp3 begin
282
283
284(*
285 SyntaxError - after a syntax error we skip all tokens up until we reach
286 a stop symbol.
287*)
288
289PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
290BEGIN
291 DescribeError ;
292 IF Debugging
293 THEN
294 printf0('\nskipping token *** ')
295 END ;
296 (*
297 yes the ORD(currenttoken) looks ugly, but it is *much* safer than
298 using currenttoken<sometok as a change to the ordering of the
299 token declarations below would cause this to break. Using ORD() we are
300 immune from such changes
301 *)
302 WHILE NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR
303 ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
304 ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
305 DO
306 getToken
307 END ;
308 IF Debugging
309 THEN
310 printf0(' ***\n')
311 END
312END SyntaxError ;
313
314
315(*
316 SyntaxCheck -
317*)
318
319PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
320BEGIN
321 (* and again (see above re: ORD)
322 *)
323 IF NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR
324 ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
325 ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
326 THEN
327 SyntaxError (stopset0, stopset1, stopset2)
328 END
329END SyntaxCheck ;
330
331
332(*
333 WarnMissingToken - generates a warning message about a missing token, t.
334*)
335
336PROCEDURE WarnMissingToken (t: toktype) ;
337VAR
338 s0 : SetOfStop0 ;
339 s1 : SetOfStop1 ;
340 s2 : SetOfStop2 ;
341 str: String ;
342BEGIN
343 s0 := SetOfStop0{} ;
344 s1 := SetOfStop1{} ;
345 s2 := SetOfStop2{} ;
346 IF ORD(t)<32
347 THEN
348 s0 := SetOfStop0{t}
349 ELSIF ORD(t)<64
350 THEN
351 s1 := SetOfStop1{t}
352 ELSE
353 s2 := SetOfStop2{t}
354 END ;
355 str := DescribeStop (s0, s1, s2) ;
356
357 str := ConCat (InitString ('syntax error,'), Mark (str)) ;
358 errorStringAt (str, getTokenNo ())
359END WarnMissingToken ;
360
361
362(*
363 MissingToken - generates a warning message about a missing token, t.
364*)
365
366PROCEDURE MissingToken (t: toktype) ;
367BEGIN
368 WarnMissingToken (t) ;
369 IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
370 THEN
371 IF Debugging
372 THEN
373 printf0 ('inserting token\n')
374 END ;
375 insertToken (t)
376 END
377END MissingToken ;
378
379
380(*
381 CheckAndInsert -
382*)
383
384PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
385BEGIN
386 IF ((ORD(t)<32) AND (t IN stopset0)) OR
387 ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
388 ((ORD(t)>=64) AND (t IN stopset2))
389 THEN
390 WarnMissingToken (t) ;
391 insertTokenAndRewind (t) ;
392 RETURN( TRUE )
393 ELSE
394 RETURN( FALSE )
395 END
396END CheckAndInsert ;
397
398
399(*
400 InStopSet
401*)
402
403PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
404BEGIN
405 IF ((ORD(t)<32) AND (t IN stopset0)) OR
406 ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
407 ((ORD(t)>=64) AND (t IN stopset2))
408 THEN
409 RETURN( TRUE )
410 ELSE
411 RETURN( FALSE )
412 END
413END InStopSet ;
414
415
416(*
417 PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
418 If it is not then it will insert a token providing the token
419 is one of ; ] ) } . OF END ,
420
421 if the stopset contains <identtok> then we do not insert a token
422*)
423
424PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
425BEGIN
426 (* and again (see above re: ORD)
427 *)
428 IF (NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR
429 ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
430 ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
431 (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
432 THEN
433 (* SyntaxCheck would fail since currentoken is not part of the stopset
434 we check to see whether any of currenttoken might be a commonly omitted token *)
435 IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR
436 CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
437 CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
438 CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
439 CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
440 CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
441 CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
442 CheckAndInsert(commatok, stopset0, stopset1, stopset2)
443 THEN
444 END
445 END
446END PeepToken ;
447
448
449(*
450 Expect -
451*)
452
453PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
454BEGIN
455 IF currenttoken=t
456 THEN
457 getToken ;
458 IF Pass1
459 THEN
460 PeepToken(stopset0, stopset1, stopset2)
461 END
462 ELSE
463 MissingToken(t)
464 END ;
465 SyntaxCheck(stopset0, stopset1, stopset2)
466END Expect ;
467
468
469(*
470 CompilationUnit - returns TRUE if the input was correct enough to parse
471 in future passes.
472*)
473
474PROCEDURE CompilationUnit () : BOOLEAN ;
475BEGIN
476 stk := mcStack.init () ;
477 WasNoError := TRUE ;
478 FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
479 mcStack.kill (stk) ;
480 RETURN WasNoError
481END CompilationUnit ;
482
483
484(*
485 Ident - error checking varient of Ident
486*)
487
488PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
489BEGIN
490 curident := makekey (currentstring) ;
491 Expect(identtok, stopset0, stopset1, stopset2)
492END Ident ;
493
494
495(*
496 string -
497*)
498
499PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
500BEGIN
501 curstring := makekey (currentstring) ;
502 Expect(stringtok, stopset0, stopset1, stopset2)
503END string ;
504
505
506(*
507 Integer -
508*)
509
510PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
511BEGIN
512 Expect(integertok, stopset0, stopset1, stopset2)
513END Integer ;
514
515
516(*
517 Real -
518*)
519
520PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
521BEGIN
522 Expect(realtok, stopset0, stopset1, stopset2)
523END Real ;
524
525% module mcp3 end
526END mcp3.
527% rules
528error 'ErrorArray' 'ErrorString'
529tokenfunc 'currenttoken'
530
531token '' eoftok -- internal token
532token '+' plustok
533token '-' minustok
534token '*' timestok
535token '/' dividetok
536token ':=' becomestok
537token '&' ambersandtok
538token "." periodtok
539token "," commatok
540token ";" semicolontok
541token '(' lparatok
542token ')' rparatok
543token '[' lsbratok -- left square brackets
544token ']' rsbratok -- right square brackets
545token '{' lcbratok -- left curly brackets
546token '}' rcbratok -- right curly brackets
547token '^' uparrowtok
548token "'" singlequotetok
549token '=' equaltok
550token '#' hashtok
551token '<' lesstok
552token '>' greatertok
553token '<>' lessgreatertok
554token '<=' lessequaltok
555token '>=' greaterequaltok
556token '<*' ldirectivetok
557token '*>' rdirectivetok
558token '..' periodperiodtok
559token ':' colontok
560token '"' doublequotestok
561token '|' bartok
562token 'AND' andtok
563token 'ARRAY' arraytok
564token 'BEGIN' begintok
565token 'BY' bytok
566token 'CASE' casetok
567token 'CONST' consttok
568token 'DEFINITION' definitiontok
569token 'DIV' divtok
570token 'DO' dotok
571token 'ELSE' elsetok
572token 'ELSIF' elsiftok
573token 'END' endtok
574token 'EXCEPT' excepttok
575token 'EXIT' exittok
576token 'EXPORT' exporttok
577token 'FINALLY' finallytok
578token 'FOR' fortok
579token 'FROM' fromtok
580token 'IF' iftok
581token 'IMPLEMENTATION' implementationtok
582token 'IMPORT' importtok
583token 'IN' intok
584token 'LOOP' looptok
585token 'MOD' modtok
586token 'MODULE' moduletok
587token 'NOT' nottok
588token 'OF' oftok
589token 'OR' ortok
590token 'PACKEDSET' packedsettok
591token 'POINTER' pointertok
592token 'PROCEDURE' proceduretok
593token 'QUALIFIED' qualifiedtok
594token 'UNQUALIFIED' unqualifiedtok
595token 'RECORD' recordtok
596token 'REM' remtok
597token 'REPEAT' repeattok
598token 'RETRY' retrytok
599token 'RETURN' returntok
600token 'SET' settok
601token 'THEN' thentok
602token 'TO' totok
603token 'TYPE' typetok
604token 'UNTIL' untiltok
605token 'VAR' vartok
606token 'WHILE' whiletok
607token 'WITH' withtok
608token 'ASM' asmtok
609token 'VOLATILE' volatiletok
610token '...' periodperiodperiodtok
611token '__DATE__' datetok
612token '__LINE__' linetok
613token '__FILE__' filetok
614token '__ATTRIBUTE__' attributetok
615token '__BUILTIN__' builtintok
616token '__INLINE__' inlinetok
617token 'integer number' integertok
618token 'identifier' identtok
619token 'real number' realtok
620token 'string' stringtok
621
622special Ident first { < identtok > } follow { }
623special Integer first { < integertok > } follow { }
624special Real first { < realtok > } follow { }
625special string first { < stringtok > } follow { }
626
627BNF
628
629-- the following are provided by the module m2flex and also handbuild procedures below
630-- Ident := Letter { ( Letter | Digit ) } =:
631-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
632-- Digit { HexDigit } " H " =:
633-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
634-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
635-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
636-- Digit := OctalDigit | " 8 " | " 9 " =:
637-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
638-- String
639
640FileUnit := DefinitionModule | ImplementationOrProgramModule
641 =:
642
643ProgramModule := "MODULE"
644 Ident % curmodule := lookupModule (curident) %
645 % enterScope (curmodule) %
646 % resetEnumPos (curmodule) %
647 [ Priority
648 ]
649 ";"
650 { Import }
651 Block
652 Ident % checkEndName (curmodule, curident, 'program module') %
653 % setConstExpComplete (curmodule) %
654 % leaveScope %
655
656 "."
657 =:
658
659ImplementationModule := "IMPLEMENTATION" "MODULE"
660 Ident % curmodule := lookupImp (curident) %
661 % enterScope (lookupDef (curident)) %
662 % enterScope (curmodule) %
663 % resetEnumPos (curmodule) %
664 [ Priority
665 ] ";"
666 { Import }
667 Block
668 Ident % checkEndName (curmodule, curident, 'implementation module') %
669 % setConstExpComplete (curmodule) %
670 % leaveScope ; leaveScope %
671 "."
672 =:
673
674ImplementationOrProgramModule := ImplementationModule | ProgramModule
675 =:
676
677Number := Integer | Real =:
678
679Qualident :=
680 Ident { "." Ident }
681 =:
682
683ConstantDeclaration := % VAR d, e: node ; %
684 Ident % d := lookupSym (curident) %
685 "=" ConstExpression % e := pop () %
686 % assert (isConst (d)) %
687 % putConst (d, e) %
688 =:
689
690ConstExpressionNop := SimpleConstExpr % VAR n: node ; %
691 [ Relation SimpleConstExpr ]
692 % n := makeConstExp () %
693 =:
694
695ConstExpression := % VAR n: node ; %
696 % n := push (makeConstExp ()) %
697 SimpleConstExpr
698 [ Relation SimpleConstExpr ]
699 =:
700
701Relation := "="
702 | "#"
703 | "<>"
704 | "<"
705 | "<="
706 | ">"
707 | ">="
708 | "IN"
709 =:
710
711SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
712
713UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =:
714
715AddOperator := "+" | "-" | "OR" =:
716
717ConstTerm := ConstFactor { MulOperator ConstFactor } =:
718
719MulOperator := "*"
720 | "/"
721 | "DIV"
722 | "MOD"
723 | "REM"
724 | "AND"
725 | "&"
726 =:
727
728ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
729 "(" ConstExpressionNop ")" | "NOT" ConstFactor
730 | ConstAttribute =:
731
732-- to help satisfy LL1
733
734ConstString := string =:
735
736ComponentElement := ConstExpressionNop [ ".." ConstExpressionNop ] =:
737
738ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ] =:
739
740ArraySetRecordValue := ComponentValue { ',' ComponentValue } =:
741
742Constructor := '{'[ ArraySetRecordValue ] '}' =:
743
744ConstSetOrQualidentOrFunction := Qualident
745 [ Constructor |
746 ConstActualParameters
747 ] | Constructor =:
748
749ConstActualParameters := "(" [ ConstExpList ] ")" =:
750
751ConstExpList := ConstExpressionNop { "," ConstExpressionNop } =:
752
753ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
754 ConstAttributeExpression
755 ")" ")" =:
756
757ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
758
759ByteAlignment := '<*' AttributeExpression '*>' =:
760
761OptAlignmentExpression := [ AlignmentExpression ] =:
762
763AlignmentExpression := "(" ConstExpressionNop ")" =:
764
765Alignment := [ ByteAlignment ] =:
766
767IdentList := Ident { "," Ident }
768 =:
769
770PushIdentList := % VAR n: node ; %
771 % n := makeIdentList () %
772 Ident % checkDuplicate (putIdent (n, curident)) %
773 { "," Ident % checkDuplicate (putIdent (n, curident)) %
774 } % n := push (n) %
775 =:
776
777SubrangeType := % VAR low, high: node ; d: CARDINAL ; %
778 "[" % d := depth () %
779 ConstExpression % low := pop () %
780 % assert (d = depth ()) %
781 ".." ConstExpression % high := pop () %
782 % assert (d = depth ()) %
783 % typeExp := push (makeSubrange (low, high)) %
784 % assert (d = depth () - 1) %
785 "]"
786 =:
787
788ArrayType := "ARRAY" % VAR c: CARDINAL ; t, n: node ; %
789 % c := 0 %
790 SimpleType % INC (c) %
791 { ","
792 SimpleType % INC (c) %
793 } "OF"
794 Type % n := push (makeIndexedArray (c, pop ())) %
795 =:
796
797RecordType := "RECORD" % VAR n: node ; %
798 % n := push (makeRecord ()) %
799 % n := push (NIL) (* no varient *) %
800 [ DefaultRecordAttributes ]
801 FieldListSequence % assert (pop ()=NIL) %
802 "END" =:
803
804DefaultRecordAttributes := '<*'
805 AttributeExpression
806
807 '*>' =:
808
809RecordFieldPragma := [ '<*' FieldPragmaExpression
810 { ',' FieldPragmaExpression } '*>' ] =:
811
812FieldPragmaExpression := Ident PragmaConstExpression =:
813
814PragmaConstExpression := [ '(' ConstExpressionNop ')' ] =:
815
816AttributeExpression := Ident '(' ConstExpressionNop ')' =:
817
818FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
819
820FieldListStatement := [ FieldList ] =:
821
822FieldList := % VAR r, i, f, t, n, v, w: node ; d: CARDINAL ; %
823 % d := depth () %
824 % v := pop () ; assert ((v=NIL) OR isVarient (v)) %
825 % r := peep () ; assert (isRecord (r) OR isVarientField (r)) %
826 % v := push (v) %
827 % assert (d=depth ()) %
828 % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isVarientField (r))) %
829 PushIdentList ":" % assert (d=depth () - 1) %
830 % i := pop () %
831 Type % assert (d=depth () - 1) %
832 % t := pop () %
833 RecordFieldPragma % assert (d=depth ()) %
834 % r := addFieldsToRecord (r, v, i, t) %
835 % assert (d=depth ()) %
836 |
837 "CASE" % (* addRecordToList *) %
838 % d := depth () %
839 % v := pop () ; assert ((v=NIL) OR isVarient (v)) %
840 % r := peep () ; assert (isRecord (r) OR isVarientField (r)) %
841 % v := push (v) %
842 % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isRecordField (r))) %
843 % w := push (makeVarient (r)) %
844 % assert (d = depth () - 1) %
845 % (* addVarientToList *) %
846 CaseTag "OF"
847 % assert (d = depth () - 1) %
848 Varient % assert (d = depth () - 1) %
849 { "|" Varient % assert (d = depth () - 1) %
850 }
851 % w := peep () ; assert (isVarient (w)) %
852 % assert (d = depth () - 1) %
853 [ "ELSE"
854 FieldListSequence
855 ] "END" % w := pop () ; assert (isVarient (w)) %
856 % assert (d=depth ()) %
857 =:
858
859TagIdent := Ident | % curident := NulName %
860 =:
861
862CaseTag := % VAR tagident: Name ; q, v, w, r: node ; %
863 % w := pop () ; v := pop () ; r := peep () ; v := push (v) ; w := push (w) %
864 % assert (isVarient (w)) %
865 % assert ((v=NIL) OR isVarient (v)) %
866 % assert (isRecord (r) OR isVarientField (r)) %
867 % assert (isVarient (push (pop ()))) %
868 TagIdent % tagident := curident %
869 ( ":" PushQualident % q := pop () %
870 % assert (isVarient (push (pop ()))) %
871 | % q := NIL %
872 ) % buildVarientSelector (r, w, tagident, q) %
873 =:
874
875Varient := % VAR p, r, v, f: node ; d: CARDINAL ; %
876 % d := depth () %
877 % assert (isVarient (peep ())) %
878 [ % v := pop () ; assert (isVarient (v)) %
879 % r := pop () %
880 % p := peep () %
881 % r := push (r) %
882 % f := push (buildVarientFieldRecord (v, p)) %
883 % v := push (v) %
884 VarientCaseLabelList ":" FieldListSequence % v := pop () %
885 % f := pop () %
886 % assert (isVarientField (f)) %
887 % assert (isVarient (v)) %
888 % v := push (v) %
889 ] % assert (isVarient (peep ())) %
890 % assert (d=depth ()) %
891 =:
892
893VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
894
895VarientCaseLabels := % VAR l, h: node ; %
896 % h := NIL %
897 ConstExpression % l := pop () %
898 [ ".." ConstExpression % h := pop () %
899 ] % (* l, h could be saved if necessary. *) %
900 =:
901
902SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType % VAR n: node ; %
903 % n := push (makeSet (pop ())) %
904 =:
905
906PointerType := "POINTER" "TO" Type % VAR n: node ; %
907 % n := push (makePointer (pop ())) %
908 =:
909
910ProcedureType := "PROCEDURE" % curproc := push (makeProcType ()) %
911 [ FormalTypeList ] =:
912
913FormalTypeList := "(" ( ")" FormalReturn |
914 ProcedureParameters ")" FormalReturn ) =:
915
916FormalReturn := [ ":" OptReturnType ] =:
917
918OptReturnType := "[" PushQualident % putReturnType (curproc, pop ()) %
919 % putOptReturn (curproc) %
920 "]" | PushQualident % putReturnType (curproc, pop ()) %
921 =:
922
923ProcedureParameters := ProcedureParameter % addParameter (curproc, pop ()) %
924 { "," ProcedureParameter % addParameter (curproc, pop ()) %
925 } =:
926
927ProcedureParameter := "..." % VAR n: node ; %
928 % n := push (makeVarargs ()) %
929 | "VAR" FormalType % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) %
930 | FormalType % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) %
931 =:
932
933
934VarIdent := % VAR n, a: node ; %
935 % n := pop () %
936 Ident % checkDuplicate (putIdent (n, curident)) %
937 % n := push (n) %
938 [ "[" ConstExpression % a := pop () (* could store, a, into, n. *) %
939 "]" ]
940 =:
941
942VarIdentList := % VAR n: node ; %
943 % n := makeIdentList () %
944 % n := push (n) %
945 VarIdent { "," VarIdent }
946 =:
947
948VariableDeclaration := % VAR v, d: node ; %
949 VarIdentList % v := pop () %
950 ":" Type % d := makeVarDecl (v, pop ()) %
951 Alignment
952 =:
953
954Designator := Qualident
955 { SubDesignator } =:
956
957SubDesignator := "."
958 Ident
959 | "[" ArrayExpList
960 "]"
961 | "^"
962 =:
963
964ArrayExpList :=
965 Expression
966 { ","
967 Expression
968 }
969 =:
970
971ExpList := Expression { "," Expression }
972 =:
973
974Expression := SimpleExpression [ Relation SimpleExpression ]
975 =:
976
977SimpleExpression := UnaryOrTerm { AddOperator Term } =:
978
979UnaryOrTerm := "+" Term
980 | "-" Term
981 | Term
982 =:
983
984Term := Factor { MulOperator Factor
985 } =:
986
987Factor := Number | string | SetOrDesignatorOrFunction |
988 "(" Expression ")" | "NOT" ( Factor
989 | ConstAttribute
990 ) =:
991
992SetOrDesignatorOrFunction := Qualident
993 [ Constructor |
994 SimpleDes [ ActualParameters ]
995 ] |
996 Constructor =:
997
998-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
999SimpleDes := { SubDesignator } =:
1000
1001ActualParameters := "(" [ ExpList ] ")" =:
1002
1003ExitStatement := "EXIT"
1004 =:
1005
1006ReturnStatement := "RETURN" [ Expression ]
1007 =:
1008
1009Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
1010 WhileStatement | RepeatStatement | LoopStatement |
1011 ForStatement | WithStatement | AsmStatement |
1012 ExitStatement | ReturnStatement | RetryStatement
1013 ]
1014 =:
1015
1016RetryStatement := "RETRY"
1017 =:
1018
1019AssignmentOrProcedureCall := Designator
1020 ( ":=" Expression
1021 |
1022 ActualParameters | % (* epsilon *) %
1023 )
1024 =:
1025
1026StatementSequence := Statement { ";" Statement }
1027 =:
1028
1029IfStatement := "IF"
1030 Expression "THEN"
1031 StatementSequence
1032 { "ELSIF"
1033
1034 Expression "THEN"
1035 StatementSequence
1036 }
1037 [ "ELSE"
1038 StatementSequence ] "END"
1039 =:
1040
1041CaseStatement := "CASE"
1042 Expression
1043 "OF" Case { "|" Case }
1044 CaseEndStatement
1045 =:
1046
1047CaseEndStatement := "END"
1048 | "ELSE"
1049 StatementSequence "END"
1050 =:
1051
1052Case := [ CaseLabelList ":" StatementSequence ]
1053 =:
1054
1055CaseLabelList := CaseLabels { "," CaseLabels } =:
1056
1057CaseLabels := ConstExpressionNop [ ".." ConstExpressionNop ]
1058 =:
1059
1060WhileStatement := "WHILE" Expression "DO"
1061 StatementSequence
1062 "END"
1063 =:
1064
1065RepeatStatement := "REPEAT"
1066 StatementSequence
1067 "UNTIL" Expression
1068 =:
1069
1070ForStatement := "FOR" Ident ":=" Expression "TO" Expression
1071 [ "BY" ConstExpressionNop ] "DO"
1072 StatementSequence
1073 "END"
1074 =:
1075
1076LoopStatement := "LOOP"
1077 StatementSequence
1078 "END"
1079 =:
1080
1081WithStatement := "WITH" Designator "DO"
1082 StatementSequence
1083 "END"
1084 =:
1085
1086ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
1087 Ident % leaveScope %
1088 =:
1089
1090ProcedureIdent := Ident % curproc := lookupSym (curident) %
1091 % enterScope (curproc) %
1092 =:
1093
1094DefProcedureIdent := Ident % curproc := lookupSym (curident) %
1095 =:
1096
1097DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
1098 =:
1099
1100ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent [ FormalParameters ] AttributeNoReturn )
1101 =:
1102
1103Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
1104
1105DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent [ DefFormalParameters ] AttributeNoReturn )
1106 =:
1107
1108-- introduced procedure block so we can produce more informative
1109-- error messages
1110
1111ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"
1112 =:
1113
1114Block := { Declaration } InitialBlock FinalBlock "END"
1115 =:
1116
1117InitialBlock := [ "BEGIN" InitialBlockBody ] =:
1118
1119FinalBlock := [ "FINALLY" FinalBlockBody ] =:
1120
1121InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
1122
1123FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
1124
1125ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
1126
1127NormalPart := StatementSequence =:
1128
1129ExceptionalPart := StatementSequence
1130 =:
1131
1132Declaration := "CONST" { ConstantDeclaration ";" } |
1133 "TYPE" { TypeDeclaration } |
1134 "VAR" { VariableDeclaration ";" } |
1135 ProcedureDeclaration ";" |
1136 ModuleDeclaration ";" =:
1137
1138DefFormalParameters := "(" % paramEnter (curproc) %
1139 [ DefMultiFPSection ] ")" % paramLeave (curproc) %
1140 FormalReturn =:
1141
1142DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
1143
1144FormalParameters := "(" % paramEnter (curproc) %
1145 [ MultiFPSection ] ")" % paramLeave (curproc) %
1146 FormalReturn =:
1147
1148AttributeNoReturn := [ NoReturn | % setNoReturn (curproc, FALSE) %
1149 ] =:
1150
1151NoReturn := "<*" Ident % setNoReturn (curproc, TRUE) %
1152 % checkReturnAttribute %
1153 "*>" =:
1154
1155AttributeUnused := [ Unused ] =:
1156
1157Unused := "<*" Ident % curisused := FALSE %
1158 % checkParameterAttribute %
1159 "*>" =:
1160
1161MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
1162
1163FPSection := NonVarFPSection | VarFPSection =:
1164
1165DefExtendedFP := DefOptArg | "..." % addParameter (curproc, makeVarargs ()) %
1166 =:
1167
1168ExtendedFP := OptArg | "..."
1169 =:
1170
1171VarFPSection := "VAR" PushIdentList % VAR l, t: node ; %
1172 ":" FormalType % t := pop () %
1173 % l := pop () %
1174 % curisused := TRUE %
1175 [ AttributeUnused ]
1176 % addVarParameters (curproc, l, t, curisused) %
1177 =:
1178
1179NonVarFPSection := PushIdentList % VAR l, t: node ; %
1180 ":" FormalType % t := pop () %
1181 % l := pop () %
1182 % curisused := TRUE %
1183 [ AttributeUnused ]
1184 % addNonVarParameters (curproc, l, t, curisused) %
1185 =:
1186
1187OptArg := % VAR p, init, type: node ; id: Name ; %
1188 "[" Ident % id := curident %
1189 ":" FormalType % type := pop () %
1190 % init := NIL %
1191 [ "=" ConstExpression % init := pop () %
1192 ] "]" % p := addOptParameter (curproc, id, type, init) %
1193 =:
1194
1195
1196DefOptArg := % VAR p, init, type: node ; id: Name ; %
1197 "[" Ident % id := curident %
1198 ":" FormalType % type := pop () %
1199 "=" ConstExpression % init := pop () %
1200 "]" % p := addOptParameter (curproc, id, type, init) %
1201 =:
1202
1203
1204FormalType := % VAR c: CARDINAL ; %
1205 % VAR n, a, s: node ; %
1206 % c := 0 %
1207 { "ARRAY" "OF" % INC (c) %
1208 } PushQualident % pushNunbounded (c) %
1209 =:
1210
1211ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
1212 { Import } [ Export ]
1213 Block Ident
1214 =:
1215
1216Priority := "[" ConstExpressionNop "]" =:
1217
1218Export := "EXPORT" ( "QUALIFIED"
1219 IdentList |
1220 "UNQUALIFIED"
1221 IdentList |
1222 IdentList ) ";" =:
1223
1224FromIdentList := Ident % importInto (frommodule, curident, curmodule) %
1225 { "," Ident % importInto (frommodule, curident, curmodule) %
1226 }
1227 =:
1228
1229FromImport := "FROM" Ident % frommodule := lookupDef (curident) %
1230 "IMPORT" FromIdentList ";"
1231 =:
1232
1233ImportModuleList := Ident { "," Ident } =:
1234
1235WithoutFromImport := "IMPORT" ImportModuleList ";"
1236 =:
1237
1238Import := FromImport | WithoutFromImport =:
1239
1240DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] Ident ";" % curmodule := lookupDef (curident) %
1241 % enterScope (curmodule) %
1242 % resetEnumPos (curmodule) %
1243 { Import } [ Export ]
1244 { Definition }
1245 "END" Ident "." % checkEndName (curmodule, curident, 'definition module') %
1246 % setConstExpComplete (curmodule) %
1247 % leaveScope %
1248 =:
1249
1250PushQualident :=
1251 Ident % typeExp := push (lookupSym (curident)) %
1252 % IF typeExp = NIL
1253 THEN
1254 metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
1255 END %
1256 [ "."
1257 % IF NOT isDef (typeExp)
1258 THEN
1259 ErrorArray ('the first component of this qualident must be a definition module')
1260 END %
1261 Ident % typeExp := replace (lookupInScope (typeExp, curident)) ;
1262 IF typeExp=NIL
1263 THEN
1264 ErrorArray ('identifier not found in definition module')
1265 END %
1266 ]
1267 =:
1268
1269OptSubrange := [ SubrangeType
1270 % VAR q, s: node ; %
1271 % s := pop () %
1272 % q := pop () %
1273 % putSubrangeType (s, q) %
1274 % typeExp := push (s) %
1275 ]
1276 =:
1277
1278TypeEquiv := PushQualident OptSubrange =:
1279
1280EnumIdentList := % VAR f: node ; %
1281 % typeExp := push (makeEnum ()) %
1282 Ident % f := makeEnumField (typeExp, curident) %
1283 { "," Ident % f := makeEnumField (typeExp, curident) %
1284 }
1285 =:
1286
1287Enumeration := "(" EnumIdentList ")" =:
1288
1289SimpleType := % VAR d: CARDINAL ; %
1290 % d := depth () %
1291 ( TypeEquiv | Enumeration | SubrangeType ) % assert (d = depth () - 1) %
1292 =:
1293
1294Type := SimpleType | ArrayType | RecordType | SetType |
1295 PointerType | ProcedureType
1296 =:
1297
1298TypeDeclaration := { Ident % typeDes := lookupSym (curident) %
1299 ( ";" | "=" Type % putType (typeDes, pop ()) %
1300 Alignment ";" ) }
1301 =:
1302
1303Definition := "CONST" { ConstantDeclaration ";" } |
1304 "TYPE" { TypeDeclaration } |
1305 "VAR" { VariableDeclaration ";" } |
1306 DefProcedureHeading ";" =:
1307
1308AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
1309
1310AsmOperands := string [ AsmOperandSpec ]
1311 =:
1312
1313AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
1314 =:
1315
1316AsmList := [ AsmElement ] { ',' AsmElement } =:
1317
1318NamedOperand := '[' Ident ']' =:
1319
1320AsmOperandName := [ NamedOperand ]
1321 =:
1322
1323AsmElement := AsmOperandName string '(' Expression ')'
1324 =:
1325
1326TrashList := [ string ] { ',' string } =:
1327
1328FNB