gcc/m2/bnf/m2-3.bnf

   1 --
   2 -- m2-3.bnf grammar and associated actions for pass 3.
   3 --
   4 -- Copyright (C) 2001-2021 Free Software Foundation, Inc.
   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 P3Build begin
  23 (* output from m2-3.bnf, automatically generated do not edit if these
  24    are the top two lines in the file.
  25
  26 Copyright (C) 2001-2021 Free Software Foundation, Inc.
  27 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
  28
  29 This file is part of GNU Modula-2.
  30
  31 GNU Modula-2 is free software; you can redistribute it and/or modify
  32 it under the terms of the GNU General Public License as published by
  33 the Free Software Foundation; either version 3, or (at your option)
  34 any later version.
  35
  36 GNU Modula-2 is distributed in the hope that it will be useful, but
  37 WITHOUT ANY WARRANTY; without even the implied warranty of
  38 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  39 General Public License for more details.
  40
  41 You should have received a copy of the GNU General Public License
  42 along with GNU Modula-2; see the file COPYING.  If not,
  43 see <https://www.gnu.org/licenses/>.  *)
  44
  45 IMPLEMENTATION MODULE P3Build ;
  46
  47 FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
  48                      InsertTokenAndRewind, GetTokenNo, PrintTokenNo, MakeVirtualTok,
  49                      UnknownTokenNo ;
  50
  51 FROM M2Error IMPORT ErrorStringAt, WriteFormat1, WriteFormat2 ;
  52 FROM NameKey IMPORT NulName, Name, makekey ;
  53 FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
  54 FROM M2Printf IMPORT printf0, printf1 ;
  55 FROM M2Debug IMPORT Assert ;
  56 FROM P2SymBuild IMPORT BuildString, BuildNumber ;
  57 FROM M2MetaError IMPORT MetaErrorT0 ;
  58
  59 FROM M2Reserved IMPORT tokToTok, toktype,
  60                        NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
  61                        EqualTok, HashTok, LessGreaterTok, LessTok, LessEqualTok,
  62                        GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
  63                        OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok,
  64                        AndTok, AmbersandTok, PeriodPeriodTok, ByTok ;
  65
  66 FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
  67                     PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
  68                     BuildModuleStart,
  69                     StartBuildDefFile, StartBuildModFile,
  70                     EndBuildFile,
  71                     StartBuildInit,
  72                     EndBuildInit,
  73                     StartBuildFinally,
  74                     EndBuildFinally,
  75                     BuildExceptInitial,
  76                     BuildExceptFinally,
  77                     BuildExceptProcedure,
  78                     BuildReThrow,
  79                     BuildProcedureStart,
  80                     BuildProcedureBegin,
  81                     BuildProcedureEnd,
  82                     BuildStmtNote,
  83                     BuildFunctionCall, BuildConstFunctionCall,
  84                     BuildBinaryOp, BuildUnaryOp, BuildRelOp, BuildNot,
  85                     BuildEmptySet, BuildInclRange, BuildInclBit,
  86                     BuildSetStart, BuildSetEnd,
  87                     PushLineNo, BuildSizeCheckStart,
  88                     BuildBuiltinConst, BuildBuiltinTypeInfo,
  89                     BuildAssignment, BuildAlignment,
  90                     BuildRepeat, BuildUntil,
  91                     BuildWhile, BuildDoWhile, BuildEndWhile,
  92                     BuildLoop, BuildExit, BuildEndLoop,
  93                     BuildThenIf, BuildElse, BuildEndIf,
  94                     BuildForToByDo, BuildPseudoBy, BuildEndFor,
  95                     BuildElsif1, BuildElsif2,
  96                     BuildProcedureCall, BuildReturn, BuildNulExpression,
  97                     CheckBuildFunction,
  98                     StartBuildWith, EndBuildWith,
  99                     BuildInline,
 100                     BuildCaseStart,
 101                     BuildCaseOr,
 102                     BuildCaseElse,
 103                     BuildCaseEnd,
 104                     BuildCaseCheck,
 105                     BuildCaseStartStatementSequence,
 106                     BuildCaseEndStatementSequence,
 107                     BuildCaseList,
 108                     BuildCaseRange, BuildCaseEquality,
 109                     BuildConstructorStart,
 110                     BuildConstructorEnd,
 111                     SilentBuildConstructorStart,
 112                     NextConstructorField, BuildTypeForConstructor,
 113                     BuildComponentValue,
 114                     BeginVarient, EndVarient, ElseVarient,
 115                     BeginVarientList, EndVarientList,
 116                     RecordOp,
 117                     BuildNulParam,
 118                     BuildDesignatorRecord,
 119                     BuildDesignatorArray,
 120                     BuildDesignatorPointer,
 121                     BuildBooleanVariable,
 122                     CheckWithReference,
 123                     BuildModulePriority,
 124                     BuildRetry,
 125                     DisplayStack,
 126                     AddVarientRange, AddVarientEquality,
 127                     BeginVarient, EndVarient, BeginVarientList, EndVarientList,
 128                     PushInConstExpression, PopInConstExpression, IsInConstExpression,
 129                     BuildDefaultFieldAlignment, BuildPragmaField,
 130                     IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
 131
 132 FROM P3SymBuild IMPORT P3StartBuildProgModule,
 133                        P3EndBuildProgModule,
 134
 135                        P3StartBuildDefModule,
 136                        P3EndBuildDefModule,
 137
 138                        P3StartBuildImpModule,
 139                        P3EndBuildImpModule,
 140
 141                        StartBuildInnerModule,
 142                        EndBuildInnerModule,
 143
 144                        CheckImportListOuterModule,
 145                        CheckCanBeImported,
 146                        StartBuildProcedure,
 147                        BuildProcedureHeading,
 148                        EndBuildProcedure,
 149                        BuildVarAtAddress,
 150                        BuildConst,
 151                        BuildSubrange,
 152                        BuildNulName,
 153                        BuildOptArgInitializer ;
 154
 155 FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
 156                         PutGnuAsmOutput, PutGnuAsmTrash,
 157                         PutGnuAsmVolatile, PutGnuAsmSimple,
 158                         MakeRegInterface,
 159                         PutRegInterface,
 160                         IsRegInterface, IsGnuAsmVolatile, IsGnuAsm,
 161                         GetSymName, GetType, SkipType,
 162                         NulSym,
 163                         StartScope, EndScope,
 164                         PutIncluded,
 165                         IsVarParam, IsProcedure, IsDefImp, IsModule, IsProcType,
 166                         IsRecord,
 167                         RequestSym, IsExported,
 168                         GetSym, GetLocalSym ;
 169
 170 FROM M2Batch IMPORT IsModuleKnown ;
 171
 172 FROM M2CaseList IMPORT BeginCaseList, EndCaseList ;
 173
 174 IMPORT M2Error ;
 175
 176 CONST
 177    Debugging = FALSE ;
 178    Pass1     = FALSE ;          (* permanently disabled for the time being *)
 179    Pass2     = FALSE ;
 180    Pass3     =  TRUE ;          (* permanently disabled for the time being *)
 181    DebugAsm  = FALSE ;
 182
 183 VAR
 184    WasNoError: BOOLEAN ;
 185
 186
 187 PROCEDURE ErrorString (s: String) ;
 188 BEGIN
 189    ErrorStringAt(s, GetTokenNo ()) ;
 190    WasNoError := FALSE
 191 END ErrorString ;
 192
 193
 194 PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
 195 BEGIN
 196    ErrorString(InitString(a))
 197 END ErrorArray ;
 198
 199
 200 % declaration P3Build begin
 201
 202
 203 (*
 204    SyntaxError - after a syntax error we skip all tokens up until we reach
 205                  a stop symbol.
 206 *)
 207
 208 PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 209 BEGIN
 210    DescribeError ;
 211    IF Debugging
 212    THEN
 213       printf0('\nskipping token *** ')
 214    END ;
 215    (* --fixme-- this assumes a 32 bit word size.  *)
 216    WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
 217               ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
 218               ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
 219    DO
 220       GetToken
 221    END ;
 222    IF Debugging
 223    THEN
 224       printf0(' ***\n')
 225    END
 226 END SyntaxError ;
 227
 228
 229 (*
 230    SyntaxCheck -
 231 *)
 232
 233 PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 234 BEGIN
 235    (* --fixme-- this assumes a 32 bit word size.  *)
 236    IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
 237            ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
 238            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
 239    THEN
 240       SyntaxError(stopset0, stopset1, stopset2)
 241    END
 242 END SyntaxCheck ;
 243
 244
 245 (*
 246    WarnMissingToken - generates a warning message about a missing token, t.
 247 *)
 248
 249 PROCEDURE WarnMissingToken (t: toktype) ;
 250 VAR
 251    s0 : SetOfStop0 ;
 252    s1 : SetOfStop1 ;
 253    s2 : SetOfStop2 ;
 254    str: String ;
 255 BEGIN
 256    s0 := SetOfStop0{} ;
 257    s1 := SetOfStop1{} ;
 258    s2 := SetOfStop2{} ;
 259    IF ORD(t)<32
 260    THEN
 261       s0 := SetOfStop0{t}
 262    ELSIF ORD(t)<64
 263    THEN
 264       s1 := SetOfStop1{t}
 265    ELSE
 266       s2 := SetOfStop2{t}
 267    END ;
 268    str := DescribeStop(s0, s1, s2) ;
 269
 270    str := ConCat(InitString('syntax error,'), Mark(str)) ;
 271    ErrorStringAt (str, GetTokenNo ())
 272 END WarnMissingToken ;
 273
 274
 275 (*
 276    MissingToken - generates a warning message about a missing token, t.
 277 *)
 278
 279 PROCEDURE MissingToken (t: toktype) ;
 280 BEGIN
 281    WarnMissingToken(t) ;
 282    IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
 283    THEN
 284       IF Debugging
 285       THEN
 286          printf0('inserting token\n')
 287       END ;
 288       InsertToken(t)
 289    END
 290 END MissingToken ;
 291
 292
 293 (*
 294    CheckAndInsert -
 295 *)
 296
 297 PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
 298 BEGIN
 299    IF ((ORD(t)<32) AND (t IN stopset0)) OR
 300       ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
 301       ((ORD(t)>=64) AND (t IN stopset2))
 302    THEN
 303       WarnMissingToken(t) ;
 304       InsertTokenAndRewind(t) ;
 305       RETURN( TRUE )
 306    ELSE
 307       RETURN( FALSE )
 308    END
 309 END CheckAndInsert ;
 310
 311
 312 (*
 313    InStopSet
 314 *)
 315
 316 PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
 317 BEGIN
 318    IF ((ORD(t)<32) AND (t IN stopset0)) OR
 319       ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
 320       ((ORD(t)>=64) AND (t IN stopset2))
 321    THEN
 322       RETURN( TRUE )
 323    ELSE
 324       RETURN( FALSE )
 325    END
 326 END InStopSet ;
 327
 328
 329 (*
 330    PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
 331                If it is not then it will insert a token providing the token
 332                is one of ; ] ) } . OF END ,
 333
 334                if the stopset contains <identtok> then we do not insert a token
 335 *)
 336
 337 PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 338 BEGIN
 339    (* and again (see above re: ORD)
 340     *)
 341    IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
 342             ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
 343             ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
 344       (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
 345    THEN
 346       (* SyntaxCheck would fail since currentoken is not part of the stopset
 347          we check to see whether any of currenttoken might be a commonly omitted token *)
 348       IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR
 349          CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
 350          CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
 351          CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
 352          CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
 353          CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
 354          CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
 355          CheckAndInsert(commatok, stopset0, stopset1, stopset2)
 356       THEN
 357       END
 358    END
 359 END PeepToken ;
 360
 361
 362 (*
 363    Expect -
 364 *)
 365
 366 PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 367 BEGIN
 368    IF currenttoken=t
 369    THEN
 370       GetToken ;
 371       IF Pass1
 372       THEN
 373          PeepToken(stopset0, stopset1, stopset2)
 374       END
 375    ELSE
 376       MissingToken(t)
 377    END ;
 378    SyntaxCheck(stopset0, stopset1, stopset2)
 379 END Expect ;
 380
 381
 382 (*
 383    CompilationUnit - returns TRUE if the input was correct enough to parse
 384                      in future passes.
 385 *)
 386
 387 PROCEDURE CompilationUnit () : BOOLEAN ;
 388 BEGIN
 389    WasNoError := TRUE ;
 390    FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
 391    RETURN( WasNoError )
 392 END CompilationUnit ;
 393
 394
 395 (*
 396    Ident - error checking varient of Ident
 397 *)
 398
 399 PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 400 BEGIN
 401    IF IsAutoPushOn()
 402    THEN
 403       PushTFtok (makekey (currentstring), identtok, GetTokenNo ())
 404       (*  ; MetaErrorT0 (GetTokenNo(), "{%W}an ident")  *)
 405    END ;
 406    Expect(identtok, stopset0, stopset1, stopset2)
 407 END Ident ;
 408
 409
 410 (*
 411    string -
 412 *)
 413
 414 PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 415 BEGIN
 416    IF IsAutoPushOn()
 417    THEN
 418       PushTFtok(makekey(currentstring), stringtok, GetTokenNo ()) ;
 419       BuildString
 420    END ;
 421    Expect(stringtok, stopset0, stopset1, stopset2)
 422 END string ;
 423
 424
 425 (*
 426    Integer -
 427 *)
 428
 429 PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 430 BEGIN
 431    IF IsAutoPushOn()
 432    THEN
 433       PushTFtok (makekey(currentstring), integertok, GetTokenNo ()) ;
 434       BuildNumber
 435    END ;
 436    Expect(integertok, stopset0, stopset1, stopset2)
 437 END Integer ;
 438
 439
 440 (*
 441    Real -
 442 *)
 443
 444 PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 445 BEGIN
 446    IF IsAutoPushOn()
 447    THEN
 448       PushTFtok (makekey(currentstring), realtok, GetTokenNo ()) ;
 449       BuildNumber
 450    END ;
 451    Expect(realtok, stopset0, stopset1, stopset2)
 452 END Real ;
 453
 454 % module P3Build end
 455 END P3Build.
 456 % rules
 457 error       'ErrorArray' 'ErrorString'
 458 tokenfunc   'currenttoken'
 459
 460 token   ''                eoftok      -- internal token
 461 token   '+'               plustok
 462 token   '-'               minustok
 463 token   '*'               timestok
 464 token   '/'               dividetok
 465 token   ':='              becomestok
 466 token   '&'               ambersandtok
 467 token   "."               periodtok
 468 token   ","               commatok
 469 token   ";"               semicolontok
 470 token   '('               lparatok
 471 token   ')'               rparatok
 472 token   '['               lsbratok   -- left  square brackets
 473 token   ']'               rsbratok   -- right square brackets
 474 token   '{'               lcbratok   -- left  curly brackets
 475 token   '}'               rcbratok   -- right curly brackets
 476 token   '^'               uparrowtok
 477 token   "'"               singlequotetok
 478 token   '='               equaltok
 479 token   '#'               hashtok
 480 token   '<'               lesstok
 481 token   '>'               greatertok
 482 token   '<>'              lessgreatertok
 483 token   '<='              lessequaltok
 484 token   '>='              greaterequaltok
 485 token   '<*'              ldirectivetok
 486 token   '*>'              rdirectivetok
 487 token   '..'              periodperiodtok
 488 token   ':'               colontok
 489 token   '"'               doublequotestok
 490 token   '|'               bartok
 491 token   'AND'             andtok
 492 token   'ARRAY'           arraytok
 493 token   'BEGIN'           begintok
 494 token   'BY'              bytok
 495 token   'CASE'            casetok
 496 token   'CONST'           consttok
 497 token   'DEFINITION'      definitiontok
 498 token   'DIV'             divtok
 499 token   'DO'              dotok
 500 token   'ELSE'            elsetok
 501 token   'ELSIF'           elsiftok
 502 token   'END'             endtok
 503 token   'EXCEPT'          excepttok
 504 token   'EXIT'            exittok
 505 token   'EXPORT'          exporttok
 506 token   'FINALLY'         finallytok
 507 token   'FOR'             fortok
 508 token   'FROM'            fromtok
 509 token   'IF'              iftok
 510 token   'IMPLEMENTATION'  implementationtok
 511 token   'IMPORT'          importtok
 512 token   'IN'              intok
 513 token   'LOOP'            looptok
 514 token   'MOD'             modtok
 515 token   'MODULE'          moduletok
 516 token   'NOT'             nottok
 517 token   'OF'              oftok
 518 token   'OR'              ortok
 519 token   'PACKEDSET'       packedsettok
 520 token   'POINTER'         pointertok
 521 token   'PROCEDURE'       proceduretok
 522 token   'QUALIFIED'       qualifiedtok
 523 token   'UNQUALIFIED'     unqualifiedtok
 524 token   'RECORD'          recordtok
 525 token   'REM'             remtok
 526 token   'REPEAT'          repeattok
 527 token   'RETRY'           retrytok
 528 token   'RETURN'          returntok
 529 token   'SET'             settok
 530 token   'THEN'            thentok
 531 token   'TO'              totok
 532 token   'TYPE'            typetok
 533 token   'UNTIL'           untiltok
 534 token   'VAR'             vartok
 535 token   'WHILE'           whiletok
 536 token   'WITH'            withtok
 537 token   'ASM'             asmtok
 538 token   'VOLATILE'        volatiletok
 539 token   '...'             periodperiodperiodtok
 540 token   '__DATE__'        datetok
 541 token   '__LINE__'        linetok
 542 token   '__FILE__'        filetok
 543 token   '__ATTRIBUTE__'   attributetok
 544 token   '__BUILTIN__'     builtintok
 545 token   '__INLINE__'      inlinetok
 546 token   'integer number'  integertok
 547 token   'identifier'      identtok
 548 token   'real number'     realtok
 549 token   'string'          stringtok
 550
 551 special Ident             first { < identtok > } follow { }
 552 special Integer           first { < integertok > } follow { }
 553 special Real              first { < realtok > } follow { }
 554 special string            first { < stringtok > } follow { }
 555
 556 BNF
 557
 558 -- the following are provided by the module m2flex and also handbuild procedures below
 559 -- Ident := Letter { ( Letter | Digit ) } =:
 560 -- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
 561 --           Digit { HexDigit } " H " =:
 562 -- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
 563 -- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
 564 -- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
 565 -- Digit := OctalDigit | " 8 " | " 9 " =:
 566 -- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
 567 -- String
 568
 569 FileUnit :=                                                                % PushAutoOff %
 570             ( DefinitionModule |
 571               ImplementationOrProgramModule )                              % PopAuto %
 572          =:
 573
 574 ProgramModule := "MODULE"                                                  % M2Error.DefaultProgramModule %
 575                                                                            % PushAutoOn %
 576                   Ident                                                    % P3StartBuildProgModule %
 577                                                                            % StartBuildModFile %
 578                                                                            % BuildModuleStart %
 579                                                                            % PushAutoOff %
 580                   [ Priority
 581                   ]
 582                   ";"
 583                   { Import }
 584                   Block                                                    % PushAutoOn %
 585                   Ident                                                    % EndBuildFile %
 586                                                                            % P3EndBuildProgModule %
 587                   "."                                                      % PopAuto ; PopAuto %
 588                   =:
 589
 590 ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
 591                                          "MODULE"                          % PushAutoOn %
 592                          Ident                                             % StartBuildModFile %
 593                                                                            % P3StartBuildImpModule %
 594                                                                            % BuildModuleStart %
 595                                                                            % PushAutoOff %
 596                          [ Priority
 597                          ] ";"
 598                          { Import }
 599                          Block                                             % PushAutoOn %
 600
 601                          Ident                                             % EndBuildFile %
 602                                                                            % P3EndBuildImpModule %
 603                          "."                                               % PopAuto ; PopAuto ; PopAuto %
 604                       =:
 605
 606 ImplementationOrProgramModule :=                                           % PushAutoOff %
 607                                  ( ImplementationModule | ProgramModule )  % PopAuto %
 608                               =:
 609
 610 Number := Integer | Real =:
 611
 612 --
 613 --  In pass 3 Qualident needs some care as we must only parse module.module.ident
 614 --  and not ident.recordfield.  We leave the ident.recordfield to be parsed by
 615 --  SubDesignator.  Note that Qualident is called by SubDesignator so if
 616 --  IsAutoPushOff then we just consume tokens.
 617 --
 618
 619 Qualident :=                                                               % VAR name          : Name ;
 620                                                                                  init, ip1,
 621                                                                                  tokstart, tok : CARDINAL ; %
 622              Ident
 623                                                                            % IF IsAutoPushOn()
 624                                                                              THEN
 625                                                                                 PopTtok(name, tokstart) ;
 626                                                                                 tok := tokstart ;
 627                                                                                 init := RequestSym (tok, name) ;
 628                                                                                 WHILE IsDefImp (init) OR IsModule (init) DO
 629                                                                                    Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
 630                                                                                    StartScope (init) ;
 631                                                                                    Ident (stopset0, stopset1, stopset2) ;
 632                                                                                    PopTtok (name, tok) ;
 633                                                                                    ip1 := RequestSym (tok, name) ;
 634                                                                                    PutIncluded(ip1) ;
 635                                                                                    EndScope ;
 636                                                                                    CheckCanBeImported(init, ip1) ;
 637                                                                                    init := ip1
 638                                                                                 END ;
 639                                                                                 IF tok#tokstart
 640                                                                                 THEN
 641                                                                                    tok := MakeVirtualTok (tokstart, tokstart, tok)
 642                                                                                 END ;
 643                                                                                 IF IsProcedure(init) OR IsProcType(init)
 644                                                                                 THEN
 645                                                                                    PushTtok(init, tok)
 646                                                                                 ELSE
 647                                                                                    PushTFtok(init, GetType(init), tok) ;
 648                                                                                 END
 649                                                                              ELSE %
 650              { "." Ident }                                                 % END %
 651            =:
 652
 653 ConstantDeclaration :=                                                     % VAR tokno: CARDINAL ; %
 654                                                                            % PushAutoOn %
 655                        ( Ident "="                                         % tokno := GetTokenNo () -1 %
 656                                                                            % BuildConst %
 657                          ConstExpression )                                 % BuildAssignment (tokno) %
 658                                                                            % PopAuto %
 659                      =:
 660
 661 ConstExpression :=                                                         % VAR tokpos: CARDINAL ; %
 662                                                                            % PushAutoOn %
 663                    SimpleConstExpr [ Relation                              % tokpos := GetTokenNo ()-1 %
 664                                               SimpleConstExpr              % BuildRelOp (tokpos) %
 665                                    ]                                       % PopAuto %
 666                 =:
 667
 668 Relation := "="                                                            % PushTtok(EqualTok, GetTokenNo() -1) %
 669             | "#"                                                          % PushTtok(HashTok, GetTokenNo() -1) %
 670             | "<>"                                                         % PushTtok(LessGreaterTok, GetTokenNo() -1) %
 671             | "<"                                                          % PushTtok(LessTok, GetTokenNo() -1) %
 672             | "<="                                                         % PushTtok(LessEqualTok, GetTokenNo() -1) %
 673             | ">"                                                          % PushTtok(GreaterTok, GetTokenNo() -1) %
 674             | ">="                                                         % PushTtok(GreaterEqualTok, GetTokenNo() -1) %
 675             | "IN"                                                         % PushTtok(InTok, GetTokenNo() -1) %
 676          =:
 677
 678 SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm                % BuildBinaryOp %
 679                                     } =:
 680
 681 UnaryOrConstTerm := "+"                                                    % PushTtok(PlusTok, GetTokenNo() -1) %
 682                     ConstTerm                                              % BuildUnaryOp %
 683                     |
 684                     "-"                                                    % PushTtok(MinusTok, GetTokenNo() -1) %
 685                     ConstTerm                                              % BuildUnaryOp %
 686                     |
 687                     ConstTerm =:
 688
 689 AddOperator :=   "+"                                                       % PushTtok(PlusTok, GetTokenNo() -1) ;
 690                                                                              RecordOp %
 691                | "-"                                                       % PushTtok(MinusTok, GetTokenNo() -1) ;
 692                                                                              RecordOp %
 693                | "OR"                                                      % PushTtok(OrTok, GetTokenNo() -1) ;
 694                                                                              RecordOp %
 695             =:
 696
 697 ConstTerm := ConstFactor { MulOperator ConstFactor                         % BuildBinaryOp %
 698                          } =:
 699
 700 MulOperator := "*"                                                         % PushTtok(TimesTok, GetTokenNo() -1) ;
 701                                                                              RecordOp %
 702                | "/"                                                       % PushTtok(DivideTok, GetTokenNo() -1) ;
 703                                                                              RecordOp %
 704                | "DIV"                                                     % PushTtok(DivTok, GetTokenNo() -1) ;
 705                                                                              RecordOp %
 706                | "MOD"                                                     % PushTtok(ModTok, GetTokenNo() -1) ;
 707                                                                              RecordOp %
 708                | "REM"                                                     % PushTtok(RemTok, GetTokenNo() -1) ;
 709                                                                              RecordOp %
 710                | "AND"                                                     % PushTtok(AndTok, GetTokenNo() -1) ;
 711                                                                              RecordOp %
 712                | "&"                                                       % PushTtok(AmbersandTok, GetTokenNo() -1) ;
 713                                                                              RecordOp %
 714             =:
 715
 716 ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
 717                "(" ConstExpression ")" | "NOT" ConstFactor                 % BuildNot %
 718                | ConstAttribute =:
 719
 720 -- to help satisfy LL1
 721
 722 ConstString := string =:
 723
 724 ComponentElement := ConstExpression ( ".." ConstExpression                 % PushT(PeriodPeriodTok) %
 725                                       |                                    % PushT(NulTok) %
 726                                     )
 727                   =:
 728
 729 ComponentValue := ComponentElement ( 'BY' ConstExpression                  % PushT(ByTok) %
 730
 731                                      |                                     % PushT(NulTok) %
 732                                    )
 733                 =:
 734
 735 ArraySetRecordValue := ComponentValue                                      % BuildComponentValue %
 736                                       { ','                                % NextConstructorField %
 737                                             ComponentValue                 % BuildComponentValue %
 738                                                            }
 739                      =:
 740
 741 Constructor := '{'                                                         % BuildConstructorStart %
 742                   [ ArraySetRecordValue ]                                  % BuildConstructorEnd   %
 743                '}' =:
 744
 745 ConstSetOrQualidentOrFunction := Qualident
 746                                  [ Constructor | ConstActualParameters     % BuildConstFunctionCall %
 747                                                                        ]
 748                                    |                                       % BuildTypeForConstructor %
 749                                      Constructor =:
 750
 751 ConstActualParameters :=                                                   % PushInConstExpression %
 752                          ActualParameters                                  % PopInConstExpression %
 753                        =:
 754
 755 ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("                    % PushAutoOn %
 756                   ConstAttributeExpression                                 % PopAuto %
 757                   ")" ")" =:
 758
 759 ConstAttributeExpression :=
 760                             Ident                                          % BuildBuiltinConst %
 761                                   | "<" Qualident ',' Ident                % BuildBuiltinTypeInfo %
 762                                                               ">"
 763                           =:
 764
 765 ByteAlignment := '<*'                                                      % PushAutoOn %
 766                       AttributeExpression                                  % BuildAlignment %
 767                                           '*>'                             % PopAuto %
 768                =:
 769
 770 Alignment := [ ByteAlignment ] =:
 771
 772 TypeDeclaration := Ident "=" Type Alignment
 773                 =:
 774
 775 Type :=
 776                                                                            % PushAutoOff %
 777         ( SimpleType | ArrayType
 778           | RecordType
 779           | SetType
 780           | PointerType
 781           | ProcedureType )                                                % PopAuto %
 782       =:
 783
 784 SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
 785
 786 Enumeration := "("
 787                    ( IdentList
 788                                )
 789                ")"
 790             =:
 791
 792 IdentList := Ident                                                         % VAR
 793                                                                                 on: BOOLEAN ;
 794                                                                                 n : CARDINAL ; %
 795                                                                            % on := IsAutoPushOn() ;
 796                                                                              IF on
 797                                                                              THEN
 798                                                                                 n := 1
 799                                                                              END %
 800              { "," Ident                                                   % IF on
 801                                                                              THEN
 802                                                                                 INC(n)
 803                                                                              END %
 804              }                                                             % IF on
 805                                                                              THEN
 806                                                                                 PushT(n)
 807                                                                              END %
 808              =:
 809
 810 SubrangeType := "[" ConstExpression  ".." ConstExpression "]"              % BuildSubrange ; %
 811               =:
 812
 813 ArrayType := "ARRAY"
 814
 815               SimpleType
 816               { ","
 817                 SimpleType
 818               } "OF"
 819              Type
 820            =:
 821
 822 RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
 823
 824 DefaultRecordAttributes := '<*'                                           % PushAutoOn %
 825                                 AttributeExpression                       % BuildDefaultFieldAlignment %
 826                                                                           % PopAuto %
 827                                                     '*>' =:
 828
 829 RecordFieldPragma := [ '<*' FieldPragmaExpression
 830                             { ',' FieldPragmaExpression } '*>' ] =:
 831
 832 FieldPragmaExpression :=                                                   % PushAutoOn %
 833                          Ident PragmaConstExpression                       % BuildPragmaField %
 834                                                                            % PopAuto %
 835                                                            =:
 836
 837 PragmaConstExpression := ( '(' ConstExpression ')' |                       % PushT(NulSym) %
 838                                                                            % Annotate('NulSym||no pragma const') %
 839                                                      )     =:
 840
 841 AttributeExpression := Ident '(' ConstExpression ')' =:
 842
 843 FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
 844
 845 -- at present FieldListStatement is as follows:
 846 FieldListStatement := [ FieldList ] =:
 847 -- later replace it with FieldList to comply with PIM2
 848
 849 -- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
 850 -- symbols. We rewrite FieldList to inline qualident
 851 -- was
 852 -- FieldList := IdentList ":"                                              % BuildNulName %
 853 --                           Type |
 854 --             "CASE" [ Ident ":" ] Qualident "OF" Varient { "|" Varient }
 855 --                    [ "ELSE" FieldListSequence ] "END" =:
 856
 857 FieldList := IdentList ":"
 858                            Type RecordFieldPragma
 859              |
 860              "CASE"                                                        % BeginVarient %
 861                     CaseTag "OF"
 862                                  Varient { "|" Varient }
 863               [ "ELSE"                                                     % ElseVarient %
 864                 FieldListSequence
 865               ] "END"                                                      % EndVarient %
 866            =:
 867
 868 TagIdent := [ Ident ] =:
 869
 870 CaseTag :=  TagIdent [":" Qualident ] =:
 871
 872 Varient := [                                                               % BeginVarientList %
 873              VarientCaseLabelList ":" FieldListSequence                    % EndVarientList %
 874                                                         ] =:
 875
 876 VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
 877
 878 VarientCaseLabels := ConstExpression ( ".." ConstExpression                % AddVarientRange %
 879                                        |                                   % AddVarientEquality ; (* epsilon *) %
 880                                      )
 881                    =:
 882
 883 --
 884 --  the following rules are a copy of the ConstExpression ebnf rules but without
 885 --  any actions all prefixed with Silent.
 886 --  At present they are only used by CaseLabels, if this continues to be true we
 887 --  might consider restricting the SilentConstExpression. Eg it makes no sence to allow
 888 --  String in these circumstances!
 889 --
 890
 891 SilentConstExpression :=                                                   % PushAutoOff %
 892                          SilentSimpleConstExpr
 893                          [ SilentRelation SilentSimpleConstExpr ]          % PopAuto %
 894                       =:
 895
 896 SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
 897
 898 SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
 899
 900 SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
 901
 902 SilentAddOperator := "+" | "-" | "OR" =:
 903
 904 SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
 905
 906 SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
 907
 908 SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
 909                      "(" SilentConstExpression ")" | "NOT" SilentConstFactor
 910                      | SilentConstAttribute =:
 911
 912 SilentConstString := string =:
 913
 914 SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
 915
 916 SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
 917
 918 SilentComponentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
 919
 920 SilentComponentValue := SilentComponentElement [ 'BY' SilentConstExpression ] =:
 921
 922 SilentArraySetRecordValue := SilentComponentValue { ',' SilentComponentValue } =:
 923
 924 SilentConstructor := '{'                                                   % SilentBuildConstructorStart %
 925                          [ SilentArraySetRecordValue ] '}' =:
 926
 927 SilentConstSetOrQualidentOrFunction := SilentConstructor | Qualident
 928                                        [ SilentConstructor | SilentActualParameters ] =:
 929
 930 SilentActualParameters := "(" [ SilentExpList ] ")" =:
 931
 932 SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
 933
 934 -- end of the Silent constant rules
 935
 936 SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
 937
 938 PointerType := "POINTER" "TO"
 939                               Type
 940              =:
 941
 942 ProcedureType := "PROCEDURE"
 943                  [ FormalTypeList ] =:
 944
 945 FormalTypeList := "(" ( ")" FormalReturn |
 946                         ProcedureParameters ")" FormalReturn ) =:
 947
 948 FormalReturn := [ ":" OptReturnType ] =:
 949
 950 OptReturnType := "[" Qualident "]" | Qualident =:
 951
 952 ProcedureParameters := ProcedureParameter
 953                        { "," ProcedureParameter } =:
 954
 955 ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
 956
 957
 958 VarIdent :=                                                                % VAR
 959                                                                                 Sym, Type: CARDINAL ;
 960                                                                                 on: BOOLEAN ; %
 961                                                                            % on := IsAutoPushOn() %
 962                                                                            % IF NOT on
 963                                                                              THEN
 964                                                                                 PushAutoOn
 965                                                                              END %
 966             Ident                                                          % IF on
 967                                                                              THEN
 968                                                                                 PopTF(Sym, Type) ;
 969                                                                                 PushTF(Sym, Type) ;
 970                                                                                 PushTF(Sym, Type)
 971                                                                              END %
 972                   [ "[" ConstExpression                                    % BuildVarAtAddress %
 973                                         "]" ]
 974                                                                            % PopNothing ;
 975                                                                              PopAuto %
 976          =:
 977
 978 VarIdentList := VarIdent                                                   % VAR
 979                                                                                 on: BOOLEAN ;
 980                                                                                 n : CARDINAL ; %
 981                                                                            % on := IsAutoPushOn() ;
 982                                                                              IF on
 983                                                                              THEN
 984                                                                                 n := 1
 985                                                                              END %
 986              { "," VarIdent                                                % IF on
 987                                                                              THEN
 988                                                                                 INC(n)
 989                                                                              END %
 990              }                                                             % IF on
 991                                                                              THEN
 992                                                                                 PushT(n)
 993                                                                              END %
 994              =:
 995
 996 VariableDeclaration := VarIdentList ":"
 997                        Type Alignment
 998                     =:
 999
1000 Designator := Qualident                                                    % CheckWithReference %
1001               { SubDesignator } =:
1002
1003 SubDesignator := "."                                                       % VAR Sym, Type, tok,
1004                                                                                  dotpostok     : CARDINAL ;
1005                                                                                  name, n1      : Name ; %
1006                                                                            % dotpostok := GetTokenNo () -1 ;
1007                                                                              PopTFtok (Sym, Type, tok) ;
1008                                                                              Type := SkipType(Type) ;
1009                                                                              PushTFtok(Sym, Type, tok) ;
1010                                                                              IF Type=NulSym
1011                                                                              THEN
1012                                                                                 n1 := GetSymName(Sym) ;
1013                                                                                 IF IsModuleKnown(GetSymName(Sym))
1014                                                                                 THEN
1015                                                                                    WriteFormat2('%a looks like a module which has not been globally imported (eg. suggest that you IMPORT %a ;)',
1016                                                                                    n1, n1)
1017                                                                                 ELSE
1018                                                                                    WriteFormat1('%a is not a record variable', n1)
1019                                                                                 END
1020                                                                              ELSIF NOT IsRecord(Type)
1021                                                                              THEN
1022                                                                                 n1 := GetSymName(Type) ;
1023                                                                                 WriteFormat1('%a is not a record type', n1)
1024                                                                              END ;
1025                                                                              StartScope(Type) %
1026                  Ident
1027                                                                            % PopTtok (name, tok) ;
1028                                                                              Sym := GetLocalSym(Type, name) ;
1029                                                                              IF Sym=NulSym
1030                                                                              THEN
1031                                                                                 n1 := GetSymName(Type) ;
1032                                                                                 WriteFormat2('field %a does not exist within record %a', name, n1)
1033                                                                              END ;
1034                                                                              Type := GetType(Sym) ;
1035                                                                              PushTFtok (Sym, Type, tok) ;
1036                                                                              EndScope ;
1037                                                                              PushT(1) ;
1038                                                                              BuildDesignatorRecord (dotpostok) %
1039                  | "[" ArrayExpList
1040                    "]"
1041                  | "^"                                                     % BuildDesignatorPointer (GetTokenNo () -1) %
1042             =:
1043
1044 ArrayExpList :=
1045            Expression                                                      % BuildBooleanVariable %
1046                                                                            % BuildDesignatorArray %
1047              { ","
1048                Expression                                                  % BuildBooleanVariable %
1049                                                                            % BuildDesignatorArray %
1050              }
1051         =:
1052
1053 ExpList :=                                                                 % VAR n: CARDINAL ; %
1054            Expression                                                      % BuildBooleanVariable %
1055                                                                            % n := 1 %
1056              { ","
1057                Expression                                                  % BuildBooleanVariable %
1058                                                                            % INC(n) %
1059              }
1060                                                                            % PushT(n) %
1061         =:
1062
1063 Expression :=                                                              % VAR tokpos: CARDINAL ; %
1064                                                                            % PushAutoOn %
1065               SimpleExpression [ Relation                                  % tokpos := GetTokenNo ()-1 %
1066                                           SimpleExpression                 % BuildRelOp (tokpos) %
1067                                ]                                           % PopAuto %
1068            =:
1069
1070 SimpleExpression := UnaryOrTerm { AddOperator Term                         % BuildBinaryOp %
1071                                 } =:
1072
1073 UnaryOrTerm := "+"                                                         % PushTtok(PlusTok, GetTokenNo() -1) %
1074                  Term                                                      % BuildUnaryOp %
1075                | "-"                                                       % PushTtok(MinusTok, GetTokenNo() -1) %
1076                  Term                                                      % BuildUnaryOp %
1077                | Term =:
1078
1079 Term := Factor { MulOperator Factor                                        % BuildBinaryOp %
1080                } =:
1081
1082 Factor := Number | string | SetOrDesignatorOrFunction |
1083           "(" Expression ")" | "NOT" ( Factor                              % BuildNot %
1084           | ConstAttribute
1085                                 ) =:
1086
1087 SetOrDesignatorOrFunction := Qualident
1088                                                                            % Assert (OperandTok(1) # UnknownTokenNo) %
1089                                                                            % CheckWithReference %
1090                                                                            % Assert (OperandTok(1) # UnknownTokenNo) %
1091                               [ Constructor |
1092                                 SimpleDes                                  % (* Assert (OperandTok(1) # UnknownTokenNo) *) %
1093                                           [ ActualParameters               % IF IsInConstExpression()
1094                                                                              THEN
1095                                                                                 BuildConstFunctionCall
1096                                                                              ELSE
1097                                                                                 BuildFunctionCall
1098                                                                              END %
1099                                                              ]
1100                               ]                                |
1101                                                                            % BuildTypeForConstructor %
1102                               Constructor =:
1103
1104 -- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
1105 SimpleDes := { SubDesignator } =:
1106
1107 ActualParameters := "("                                                    % BuildSizeCheckStart %
1108                         ( ExpList |                                        % BuildNulParam %
1109                         ) ")" =:
1110
1111 ExitStatement := "EXIT"                                                    % BuildExit %
1112               =:
1113
1114 ReturnStatement := "RETURN"                                                % VAR tokno: CARDINAL ; %
1115                                                                            % tokno := GetTokenNo () -1 %
1116                             ( Expression |                                 % BuildNulExpression (* in epsilon *) %
1117                                            )                               % BuildReturn (tokno) %
1118                 =:
1119
1120 Statement :=                                                               % BuildStmtNote (0) %
1121                                                                            % PushAutoOn ; DisplayStack %
1122              [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
1123                WhileStatement | RepeatStatement | LoopStatement |
1124                ForStatement | WithStatement | AsmStatement |
1125                ExitStatement | ReturnStatement | RetryStatement
1126              ]                                                             % PopAuto ; %
1127           =:
1128
1129 RetryStatement := "RETRY"                                                  % BuildRetry %
1130                 =:
1131
1132 AssignmentOrProcedureCall :=                                               % VAR isFunc: BOOLEAN ;
1133                                                                                  tokno : CARDINAL ; %
1134                                                                            % DisplayStack %
1135                              Designator
1136                                                                            % tokno := GetTokenNo () %
1137                              ( ":="
1138                                                                            % (* PrintTokenNo (tokno) *) %
1139                                     Expression                             % BuildAssignment (tokno) %
1140                                 |                                          % isFunc := CheckBuildFunction() %
1141                                   ( ActualParameters |                     % BuildNulParam (* in epsilon *) %
1142                                   )                                        % IF isFunc
1143                                                                              THEN
1144                                                                                 BuildFunctionCall ;
1145                                                                                 BuildAssignment (tokno)
1146                                                                              ELSE
1147                                                                                 BuildProcedureCall (tokno - 1)
1148                                                                              END %
1149                              )                                             % DisplayStack %
1150                            =:
1151
1152 -- these two break LL1 as both start with a Designator
1153 -- ProcedureCall := Designator [ ActualParameters ] =:
1154 -- Assignment := Designator ":=" Expression =:
1155
1156 StatementSequence :=
1157                      Statement
1158                                { ";"
1159                                      Statement }
1160                   =:
1161
1162 IfStatement := "IF"
1163                     Expression
1164                                "THEN"                                      % BuildThenIf %
1165                                                                            % BuildStmtNote (-1) %
1166                                       StatementSequence
1167               { "ELSIF"
1168                                                                            % BuildElsif1 %
1169                                                                            % BuildStmtNote (-1) %
1170                         Expression
1171                                    "THEN"                                  % BuildThenIf %
1172                                                                            % BuildStmtNote (-1) %
1173                                           StatementSequence                % BuildElsif2 %
1174               }
1175               [
1176                 "ELSE"                                                     % BuildElse %
1177                                                                            % BuildStmtNote (-1) %
1178                       StatementSequence ] "END"                            % BuildEndIf %
1179                                                                            % BuildStmtNote (-1) %
1180             =:
1181
1182 CaseStatement := "CASE"
1183                         Expression                                         % BuildCaseStart %
1184                                    "OF" Case { "|" Case }
1185                  CaseEndStatement
1186                =:
1187
1188 CaseEndStatement := "END"                                                  % BuildStmtNote (-1) %
1189                                                                            % BuildCaseElse %
1190                                                                            % BuildCaseCheck %
1191                                                                            % BuildCaseEnd %
1192                     | "ELSE"                                               % BuildStmtNote (-1) %
1193                                                                            % BuildCaseElse %
1194                            StatementSequence                               % BuildStmtNote (0) %
1195                                              "END"
1196                                                                            % BuildCaseEnd %
1197                  =:
1198
1199 Case := [                                                                  % BuildStmtNote (-1) %
1200           CaseLabelList                                                    % BuildCaseStartStatementSequence %
1201                         ":"
1202                           StatementSequence                                % BuildCaseEndStatementSequence %
1203                                                                            % EndCaseList %
1204         ]
1205       =:
1206
1207 CaseLabelList :=                                                           % BeginCaseList(NulSym) %
1208                  CaseLabels { ","                                          % BuildCaseOr %
1209                                   CaseLabels } =:
1210
1211 CaseLabels := ConstExpression ( ".." ConstExpression                       % BuildCaseRange ;
1212                                                                              BuildCaseList %
1213                                 |                                          % BuildCaseEquality ;  (* epsilon *)
1214                                                                              BuildCaseList %
1215                               ) =:
1216
1217 WhileStatement := "WHILE"                                                  % BuildWhile %
1218                                                                            % BuildStmtNote (0) %
1219                   Expression
1220                                                                            % BuildStmtNote (0) %
1221                              "DO"                                          % BuildDoWhile %
1222                                   StatementSequence                        % BuildStmtNote (0) %
1223                                                     "END"                  % DisplayStack ; BuildEndWhile %
1224                 =:
1225
1226 RepeatStatement := "REPEAT"
1227                                                                            % BuildRepeat %
1228                             StatementSequence                              % BuildStmtNote (0) %
1229                                               "UNTIL"
1230                     Expression                                             % BuildUntil %
1231                  =:
1232
1233 ForStatement :=                                                            % VAR endpostok: CARDINAL ; %
1234                                                                            % PushLineNo %
1235                 "FOR" Ident ":=" Expression "TO" Expression
1236                 ( "BY" ConstExpression |                                   % BuildPseudoBy (* epsilon *) %
1237                 )                                                          % PushLineNo %
1238                                                                            % BuildStmtNote (0) %
1239                   "DO"                                                     % BuildForToByDo %
1240                 StatementSequence                                          % BuildStmtNote (0) %
1241                                                                            % endpostok := GetTokenNo () %
1242                                   "END"                                    % BuildEndFor (endpostok) %
1243               =:
1244
1245 LoopStatement := "LOOP"
1246                                                                            % BuildLoop %
1247                         StatementSequence                                  % BuildStmtNote (0) %
1248                                           "END"                            % BuildEndLoop %
1249                =:
1250
1251 WithStatement := "WITH"
1252                         Designator                                         % StartBuildWith %
1253                                    "DO"
1254                         StatementSequence
1255                                                                            % BuildStmtNote (0) %
1256                  "END"                                                     % EndBuildWith %
1257                =:
1258
1259 ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock                % BuildProcedureEnd ;
1260                                                                              PushAutoOn %
1261
1262                         Ident                                              % EndBuildProcedure ;
1263                                                                              PopAuto %
1264                       =:
1265
1266 DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
1267                             "(" "("                                        % PushAutoOff %
1268                                     Ident                                  % PopAuto %
1269                                           ")" ")" | "__INLINE__" ]
1270                       =:
1271
1272 ProcedureHeading := "PROCEDURE"                                            % M2Error.DefaultProcedure %
1273                                                                            % PushAutoOn %
1274                      DefineBuiltinProcedure
1275                      ( Ident
1276                                                                            % StartBuildProcedure ;
1277                                                                              PushAutoOff %
1278                        [ FormalParameters ] AttributeNoReturn
1279                                                                            % BuildProcedureHeading ;
1280                                                                              PopAuto %
1281                      )                                                     % PopAuto %
1282                      =:
1283
1284 Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
1285
1286 DefProcedureHeading := "PROCEDURE"                                         % M2Error.DefaultProcedure %
1287                                                                            % PushAutoOn %
1288                         Builtin
1289                         ( Ident
1290                                                                            % StartBuildProcedure ;
1291                                                                              PushAutoOff %
1292                           [ DefFormalParameters ] AttributeNoReturn
1293                                                                            % BuildProcedureHeading ;
1294                                                                              PopAuto %
1295                         )                                                  % PopAuto %
1296                                                                            % M2Error.LeaveErrorScope %
1297                      =:
1298
1299 AttributeNoReturn := [ "<*" Ident "*>" ] =:
1300
1301 -- introduced procedure block so we can produce more informative
1302 -- error messages
1303
1304 ProcedureBlock :=                                                          % BuildProcedureStart %
1305                   { Declaration }                                          % BuildProcedureBegin %
1306                                   [ "BEGIN"                                % BuildStmtNote (-1) %
1307                                             ProcedureBlockBody ]           % BuildStmtNote (0) %
1308                                                                  "END"
1309                 =:
1310
1311 Block := { Declaration }                                                   % StartBuildInit %
1312                          InitialBlock                                      % EndBuildInit ;
1313                                                                              StartBuildFinally %
1314                                       FinalBlock                           % EndBuildFinally %
1315                                                  "END"
1316        =:
1317
1318 InitialBlock := [ "BEGIN"                                                  % BuildStmtNote (-1) %
1319                           InitialBlockBody ] =:
1320
1321 FinalBlock := [ "FINALLY"                                                  % BuildStmtNote (-1) %
1322                           FinalBlockBody ] =:
1323
1324 InitialBlockBody := NormalPart [
1325                                  "EXCEPT"                                  % BuildStmtNote (-1) %
1326                                                                            % BuildExceptInitial %
1327                                           ExceptionalPart ] =:
1328
1329 FinalBlockBody := NormalPart [
1330                                "EXCEPT"                                    % BuildStmtNote (-1) %
1331                                                                            % BuildExceptFinally %
1332                                         ExceptionalPart ] =:
1333
1334 ProcedureBlockBody := NormalPart [
1335                                    "EXCEPT"                                % BuildStmtNote (-1) %
1336                                                                            % BuildExceptProcedure %
1337                                             ExceptionalPart ] =:
1338
1339 NormalPart := StatementSequence =:
1340
1341 ExceptionalPart := StatementSequence                                       % BuildReThrow (GetTokenNo()) %
1342                  =:
1343
1344 Declaration := "CONST" { ConstantDeclaration ";" } |
1345                "TYPE" { TypeDeclaration ";" } |
1346                "VAR" { VariableDeclaration ";" } |
1347                ProcedureDeclaration ";" |
1348                ModuleDeclaration ";" =:
1349
1350 DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
1351
1352 DefMultiFPSection := DefExtendedFP |
1353                      FPSection [ ";" DefMultiFPSection ] =:
1354
1355 FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
1356
1357 MultiFPSection := ExtendedFP |
1358                   FPSection [ ";" MultiFPSection ] =:
1359
1360 FPSection := NonVarFPSection | VarFPSection =:
1361
1362 DefExtendedFP := DefOptArg | "..." =:
1363
1364 ExtendedFP := OptArg | "..." =:
1365
1366 VarFPSection := "VAR" IdentList ":" FormalType =:
1367
1368 NonVarFPSection := IdentList ":" FormalType =:
1369
1370 OptArg := "[" Ident ":" FormalType [ "=" ConstExpression                   % BuildOptArgInitializer %
1371                                                          ] "]" =:
1372
1373 DefOptArg := "[" Ident ":" FormalType "=" ConstExpression                  % BuildOptArgInitializer %
1374                                                           "]" =:
1375
1376 FormalType := { "ARRAY" "OF" } Qualident =:
1377
1378 ModuleDeclaration := "MODULE"                                              % M2Error.DefaultInnerModule %
1379                                                                            % PushAutoOn %
1380                      Ident                                                 % StartBuildInnerModule %
1381                                                                            % BuildModuleStart ;
1382                                                                              PushAutoOff %
1383                      [ Priority ] ";"
1384                      { Import } [ Export ]
1385                        Block                                               % PushAutoOn %
1386                        Ident                                               % EndBuildInnerModule %
1387                                                                            % PopAuto ; PopAuto ; PopAuto %
1388                      =:
1389
1390 Priority := "["                                                            % PushAutoOn %
1391                 ConstExpression                                            % BuildModulePriority ;
1392                                                                              PopAuto %
1393                                 "]" =:
1394
1395 Export := "EXPORT" ( "QUALIFIED"
1396                                  IdentList |
1397                      "UNQUALIFIED"
1398                                  IdentList |
1399                      IdentList ) ";" =:
1400
1401 FromImport :=                                                              % PushAutoOn %
1402                "FROM" Ident "IMPORT" IdentList ";"                         % CheckImportListOuterModule %
1403                                                                            % PopAuto %
1404             =:
1405
1406 WithoutFromImport :=                                                       % PushAutoOff %
1407                       "IMPORT" IdentList ";"
1408                                                                            % PopAuto %
1409                    =:
1410
1411 Import :=  FromImport | WithoutFromImport =:
1412
1413 DefinitionModule := "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
1414                                  "MODULE"                                  % PushAutoOn %
1415                     [ "FOR" string ]
1416                     Ident                                                  % StartBuildDefFile ;
1417                                                                              P3StartBuildDefModule ;
1418                                                                              PushAutoOff %
1419                     ";"
1420                     { Import } [ Export
1421                                         ]
1422                     { Definition }
1423                                    "END"                                   % PushAutoOn %
1424                                          Ident                             % EndBuildFile ;
1425                                                                              P3EndBuildDefModule %
1426                                                "."                         % PopAuto ; PopAuto ; PopAuto %
1427                   =:
1428
1429 Definition := "CONST" { ConstantDeclaration ";" } |
1430               "TYPE"
1431                     { Ident ( ";"
1432                                   | "=" Type Alignment ";" )
1433                     }
1434               |
1435               "VAR" { VariableDeclaration ";" } |
1436               DefProcedureHeading ";" =:
1437
1438 AsmStatement :=                                                            % VAR CurrentAsm: CARDINAL ; %
1439                 'ASM'                                                      % IF Pass3
1440                                                                              THEN
1441                                                                                 PushAutoOn ;
1442                                                                                 PushT(0) ;  (* operand count *)
1443                                                                                 PushT(MakeGnuAsm())
1444                                                                              END
1445                                                                            %
1446                 [ 'VOLATILE'                                               % IF Pass3
1447                                                                              THEN
1448                                                                                 PopT(CurrentAsm) ;
1449                                                                                 PutGnuAsmVolatile(CurrentAsm) ;
1450                                                                                 PushT(CurrentAsm)
1451                                                                              END
1452                                                                            %
1453                 ] '(' AsmOperands                                          % IF Pass3
1454                                                                              THEN
1455                                                                                 PopNothing ;  (* throw away interface sym *)
1456                                                                                 BuildInline ;
1457                                                                                 PopNothing ;  (* throw away count *)
1458                                                                                 PopAuto
1459                                                                              END
1460                                                                            %
1461                   ')' =:
1462
1463 AsmOperands :=                                                             % VAR CurrentAsm, count: CARDINAL ;
1464                                                                                  str: CARDINAL ;
1465                                                                            %
1466                string                                                      % IF Pass3
1467                                                                              THEN
1468                                                                                 PopT(str) ;
1469                                                                                 PopT(CurrentAsm) ;
1470                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1471                                                                                 PopT(count) ;
1472                                                                                 IF DebugAsm
1473                                                                                 THEN
1474                                                                                    printf1('1: count of asm operands: %d\n', count)
1475                                                                                 END ;
1476                                                                                 PushT(count) ;
1477                                                                                 (* adds the name/instruction for this asm *)
1478                                                                                 PutGnuAsm(CurrentAsm, str) ;
1479                                                                                 PushT(CurrentAsm) ;
1480                                                                                 PushT(NulSym)    (* the InterfaceSym *)
1481                                                                              END
1482                                                                            %
1483                        ( AsmOperandSpec |                                  % (* epsilon *)
1484                                                                              IF Pass3
1485                                                                              THEN
1486                                                                                 PutGnuAsmSimple(CurrentAsm)
1487                                                                              END
1488                                                                            %
1489                                                         )
1490                =:
1491
1492 AsmOperandSpec :=                                                          % VAR CurrentAsm, outputs, inputs, trash, count: CARDINAL ;
1493                                                                            %
1494                   [ ':' AsmList                                            % IF Pass3
1495                                                                              THEN
1496                                                                                 PopT(outputs) ;
1497                                                                                 PopT(CurrentAsm) ;
1498                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1499                                                                                 PopT(count) ;
1500                                                                                 IF DebugAsm
1501                                                                                 THEN
1502                                                                                    printf1('2: output count of asm operands: %d\n', count)
1503                                                                                 END ;
1504                                                                                 PutGnuAsmOutput(CurrentAsm, outputs) ;
1505                                                                                 PushT(0) ;  (* reset count *)
1506                                                                                 PushT(CurrentAsm) ;
1507                                                                                 PushT(NulSym)    (* the InterfaceSym *)
1508                                                                              END
1509                                                                            %
1510                      [ ':' AsmList                                         % IF Pass3
1511                                                                              THEN
1512                                                                                 PopT(inputs) ;
1513                                                                                 PopT(CurrentAsm) ;
1514                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1515                                                                                 PopT(count) ;
1516                                                                                 IF DebugAsm
1517                                                                                 THEN
1518                                                                                    printf1('3: input count of asm operands: %d\n', count)
1519                                                                                 END ;
1520                                                                                 PutGnuAsmInput(CurrentAsm, inputs) ;
1521                                                                                 PushT(0) ;  (* reset count *)
1522                                                                                 PushT(CurrentAsm) ;
1523                                                                                 PushT(NulSym)    (* the InterfaceSym *)
1524                                                                              END
1525                                                                            %
1526                         [ ':' TrashList                                    % IF Pass3
1527                                                                              THEN
1528                                                                                 PopT(trash) ;
1529                                                                                 PopT(CurrentAsm) ;
1530                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1531                                                                                 PopT(count) ;
1532                                                                                 IF DebugAsm
1533                                                                                 THEN
1534                                                                                    printf1('4: trash count of asm operands: %d\n', count)
1535                                                                                 END ;
1536                                                                                 PutGnuAsmTrash(CurrentAsm, trash) ;
1537                                                                                 PushT(0) ;  (* reset count *)
1538                                                                                 PushT(CurrentAsm) ;
1539                                                                                 PushT(NulSym)    (* the InterfaceSym *)
1540                                                                              END
1541                                                                            %
1542                            ] ] ]
1543             =:
1544
1545 AsmList     :=                                                             % VAR count, CurrentAsm, CurrentInterface: CARDINAL ; %
1546                                                                            % IF Pass3
1547                                                                              THEN
1548                                                                                 PopT(CurrentInterface) ;
1549                                                                                 PopT(CurrentAsm) ;
1550                                                                                 PopT(count) ;
1551                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1552                                                                                 PushT(count) ;
1553                                                                                 PushT(CurrentAsm) ;
1554                                                                                 PushT(CurrentInterface) ;
1555                                                                                 IF DebugAsm
1556                                                                                 THEN
1557                                                                                    printf1('8: AsmList has a count of asm operands: %d\n', count)
1558                                                                                 END
1559                                                                              END
1560                                                                            %
1561                [ AsmElement ] { ',' AsmElement } =:
1562
1563 NamedOperand := '[' Ident ']' =:
1564
1565 AsmOperandName :=  ( NamedOperand
1566                                   |                                        % IF IsAutoPushOn()
1567                                                                              THEN
1568                                                                                 PushTF(NulName, identtok)
1569                                                                              END
1570                                                                            %
1571                                     )
1572                 =:
1573
1574 AsmElement :=                                                              % VAR n, str, expr,
1575                                                                                  CurrentInterface,
1576                                                                                  CurrentAsm, name: CARDINAL ; %
1577               AsmOperandName
1578
1579               string '(' Expression                                        % IF Pass3
1580                                                                              THEN
1581                                                                                 PopT(expr) ;
1582                                                                                 PopT(str) ;
1583                                                                                 PopT(name) ;
1584                                                                                 PopT(CurrentInterface) ;
1585                                                                                 PopT(CurrentAsm) ;
1586                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1587                                                                                 PopT(n) ;
1588                                                                                 INC(n) ;
1589                                                                                 IF CurrentInterface=NulSym
1590                                                                                 THEN
1591                                                                                    CurrentInterface := MakeRegInterface()
1592                                                                                 END ;
1593                                                                                 IF DebugAsm
1594                                                                                 THEN
1595                                                                                    printf1('5: count of asm operands: %d\n', n)
1596                                                                                 END ;
1597                                                                                 PutRegInterface(CurrentInterface, n, name, str, expr) ;
1598                                                                                 PushT(n) ;
1599                                                                                 PushT(CurrentAsm) ;
1600                                                                                 PushT(CurrentInterface)
1601                                                                              END
1602                                                                            %
1603                       ')'
1604            =:
1605
1606 TrashList :=                                                               % VAR CurrentInterface,
1607                                                                                  CurrentAsm,
1608                                                                                  n, str          : CARDINAL ; %
1609              [ string                                                      % IF Pass3
1610                                                                              THEN
1611                                                                                 PopT(str) ;
1612                                                                                 PopT(CurrentInterface) ;
1613                                                                                 PopT(CurrentAsm) ;
1614                                                                                 PopT(n) ;
1615                                                                                 INC(n) ;
1616                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1617                                                                                 IF DebugAsm
1618                                                                                 THEN
1619                                                                                    printf1('6: count of asm trash operands: %d\n', n)
1620                                                                                 END ;
1621                                                                                 IF CurrentInterface=NulSym
1622                                                                                 THEN
1623                                                                                    CurrentInterface := MakeRegInterface()
1624                                                                                 END ;
1625                                                                                 PutRegInterface(CurrentInterface, n, NulName, str, NulSym) ;
1626                                                                                 PushT(n) ;
1627                                                                                 PushT(CurrentAsm) ;
1628                                                                                 PushT(CurrentInterface)
1629                                                                              END
1630                                                                            %
1631              ] { ',' string                                                % IF Pass3
1632                                                                              THEN
1633                                                                                 PopT(str) ;
1634                                                                                 PopT(CurrentInterface) ;
1635                                                                                 PopT(CurrentAsm) ;
1636                                                                                 PopT(n) ;
1637                                                                                 INC(n) ;
1638                                                                                 Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
1639                                                                                 IF DebugAsm
1640                                                                                 THEN
1641                                                                                    printf1('7: count of asm trash operands: %d\n', n)
1642                                                                                 END ;
1643                                                                                 IF CurrentInterface=NulSym
1644                                                                                 THEN
1645                                                                                    CurrentInterface := MakeRegInterface()
1646                                                                                 END ;
1647                                                                                 PutRegInterface(CurrentInterface, n, NulName, str, NulSym) ;
1648                                                                                 PushT(n) ;
1649                                                                                 PushT(CurrentAsm) ;
1650                                                                                 PushT(CurrentInterface)
1651                                                                              END
1652                                                                            %
1653                 } =:
1654
1655 FNB