M2compiler-V1/M2c.lst

Coco/R - Compiler-Compiler V1.53
Released by Pat Terry 17 September 2002
Source file: M2c.atg

Grammar Tests:

Deletable symbols:
     Case
     DesignTail
     Stat
     Field
     FieldSeq
     StatSeq
Undefined nonterminals:   -- none --
Unreachable nonterminals: -- none --
Circular derivations:     -- none --
Underivable nonterminals: -- none --
LL(1) conditions:
 LL(1) error in ArrayType: "OF" is the start & successor of a deletable structure

Listing:

    1  COMPILER M2c
    2  (* Modula-2 program modules with procedures and composites, MC64 backend
    3     (see MGen for details).
    4  
    5     - program module only, no DEFINITION / IMPLEMENTATION split
    6     - local MODULEs (single-file, no nesting, no bodies): EXPORT of
    7       VARs, CONSTs and procedures (value/VAR params, functions, open
    8       array formals with fixed actuals); use as M.x / M.P(args);
    9       no EXPORT of types, no PRIORITY
   10     - procedures: declarations (nested), value and VAR parameters,
   11       functions with RETURN, recursion, FORWARD headings;
   12       no procedure types/variables, no cones
   13     - composites (Phase 3): fixed ARRAYs (bounds, 1D/multi-D indexing,
   14       unchecked, byte-packed CHAR/BOOLEAN), RECORDs (field offsets,
   15       .field, WITH incl. nested), SETs (+ union, - difference,
   16       * intersection, inclusive .. ranges), POINTERs (NEW/DISPOSE via
   17       VM ALLOCATE, ^, NIL), strings (ARRAY OF CHAR literal assign).
   18       Open arrays deferred; whole array/record copy deferred except
   19       string literals; VAR actuals must be simple (no a[i]/p^/fields
   20       as VAR actuals, 233); value composite params rejected (230);
   21       composite function returns rejected (unchecked, avoid wrong LEAVE).
   22     - statements: assignment, procedure call, IF, CASE, WHILE,
   23       REPEAT, LOOP/EXIT, FOR, WITH, RETURN, NEW, DISPOSE
   24     - symbol table (SymTab) with static type checking: error codes
   25       200/201/202 and 210-224 (as before), plus 231 (procedure
   26       forward mismatch or missing body), 232 (bad RETURN), 233
   27       (invalid procedure call); same lenient rules (single pass,
   28       declare-before-use, except POINTER bases may be same-scope
   29       aliases with structural pointer compatibility in Assignable;
   30       INTEGER, CARDINAL and subranges form one
   31       integer family; no mixed INTEGER/REAL arithmetic; INTEGER
   32       assigns to REAL; 1-character literal is CHAR; InvalidType
   33       suppresses follow-on errors)
   34     - backend (MGen): single-module MC64 image <ModName>.MC4,
   35       runnable with mcint. Procedures take table entries 1..N
   36       (0 = module body), run with ENTER frames, called via ED
   37       (global), EC (directly nested) or EE (display walk); actuals
   38       evaluate left-to-right into temps, then push reversed.
   39       Lowered: scalar + composite globals/frame vars (multi-slot,
   40       byte sizes, field/element offsets), CONST literals,
   41       SET masks with literals/ranges/IN/=/#/+-/*; full scalar +
   42       composite expressions (scaled indexing via IdxScale, field
   43       via FieldAdd, deref via 41H/60H, byte ops 0DH/1DH for CHAR);
   44       control flow via E0/E1 jumps; composite assign via
   45       StoreIndir0/StoreByte (scalar elems) and copy_block (strings).
   46       The rest parses and type-checks
   47       but gets error 230: open arrays, whole array/record copy
   48       (except string literals), value composite params/returns,
   49       non-literal CONST expressions and BY steps,
   50       EXIT outside LOOP, imported names used as values.
   51     - test convention (the language has no I/O): a global
   52         VAR ExitCode : INTEGER;
   53       is printed as decimal + CRLF through an embedded helper;
   54       without it the program just ends.
   55     - known semantic edges: INTEGER DIV/MOD truncate toward zero;
   56       CARDINAL past MAXINT compares as signed; AND/OR are eager;
   57       REAL widens to binary64; unchecked ARRAY indexing (no DA/DB);
   58       NIL dereference reads 0 (no static check, no VM trap yet);
   59       CHAR/BOOLEAN arrays byte-packed (1 byte/elem, slots over-
   60       allocated 8x); at most 64 procedures, 64 actuals
   61       per call, 16 names per FP-section, 8-deep nested calls,
   62       8-deep WITH, 1024 slots max per type. *)
   63  
   64  IMPORT SymTab, MGen;
   65  
   66  CHARACTERS
   67    eol      = CHR(13) .
   68    letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
   69    digit    = "0123456789" .
   70    hexDigit = digit + "ABCDEF" .
   71    noQuote1 = ANY - "'" - eol .
   72    noQuote2 = ANY - '"' - eol .
   73  
   74  IGNORE CHR(9) .. CHR(13)
   75  
   76  COMMENTS
   77    FROM "(*" TO "*)" NESTED
   78  
   79  TOKENS
   80    ident   = letter { letter | digit } .
   81    integer = digit { digit }
   82            | digit { digit } CONTEXT("..")
   83            | digit { hexDigit } "H" .
   84    real    = digit { digit } "." { digit }
   85              [ "E" [ "+" | "-" ] digit { digit } ] .
   86    string  = "'" { noQuote1 } "'"
   87            | '"' { noQuote2 } '"' .
   88  
   89  PRODUCTIONS
   90    M2c                                   (. VAR m1, m2: SymTab.Name; .)
   91      = "MODULE"
   92        GetIdent<m1>                      (. SymTab.Init; MGen.OpenModule(m1);
   93                                             IF ~SymTab.Enter(m1, SymTab.KindModule)
   94                                             THEN SemError(200) END .)
   95        ";"
   96        { Import } Block<FALSE> GetIdent<m2>
   97                                          (. IF ~SymTab.Equal(m1, m2)
   98                                             THEN SemError(202) END .)
   99        "."                               (. IF SymTab.AnyForward() THEN
  100                                             SemError(231)
  101                                           END;
  102                                           MGen.EndModule;
  103                                           SymTab.PrintTable; .) .
  104    Import                                (. VAR n: SymTab.Name; .)
  105      = "FROM"
  106        GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
  107                                             THEN SemError(200) END .)
  108        "IMPORT"
  109        ImportList ";"
  110      | "IMPORT"
  111        ImportList ";" .
  112    ImportList                            (. VAR n: SymTab.Name; .)
  113      = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindImport)
  114                                             THEN SemError(200) END .)
  115        { ","
  116          GetIdent<n>                     (. IF ~SymTab.Enter(n, SymTab.KindImport)
  117                                             THEN SemError(200) END .) } .
  118    Block <isProc: BOOLEAN>               (. VAR began: BOOLEAN; .)
  119      =                                   (. began := FALSE; .)
  120        { Declaration }
  121        [ "BEGIN"                         (. began := TRUE;
  122                                             IF isProc THEN
  123                                               MGen.ProcEntry(
  124                                                 SymTab.CurProc(),
  125                                                 SymTab.ProcNLocals())
  126                                             ELSE MGen.BeginBody
  127                                             END; .)
  128          StatSeq ]
  129        "END"                             (. IF isProc THEN
  130                                             IF ~began THEN
  131                                               MGen.ProcEntry(
  132                                                 SymTab.CurProc(),
  133                                                 SymTab.ProcNLocals())
  134                                             END;
  135                                             IF SymTab.InFunction() THEN
  136                                               MGen.PushInt(0)
  137                                             END;
  138                                             MGen.Leave(SymTab.CurNPar(),
  139                                               SymTab.InFunction())
  140                                           END; .) .
  141    Declaration = "CONST"
  142                            {
  143                              ConstDecl ";" }
  144                | "TYPE"
  145                            {
  146                              TypeDecl ";" }
  147                | "VAR"
  148                            {
  149                              VarDecl ";" }
  150                | ProcedureDecl ";"
  151                | ModuleDecl ";" .
  152    ConstDecl                             (. VAR n: SymTab.Name;
  153                                               t: SymTab.TypeIndex;
  154                                               lx: MGen.LitStr;
  155                                               cls: INTEGER; .)
  156      = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindConst)
  157                                             THEN SemError(200) END .)
  158        "="                               (. MGen.NoEmitEnter; .)
  159        ConstExpr<t, lx>                  (. SymTab.SetSymType(n, t);
  160                                             cls := SymTab.ClassOf(t);
  161                                             IF cls = SymTab.ClStr THEN
  162                                               SemError(230)
  163                                             ELSIF ~MGen.IsLit(lx) THEN
  164                                               SemError(230)
  165                                             END;
  166                                             MGen.DeclConst(n, lx, t);
  167                                             MGen.NoEmitExit; .) .
  168    ConstExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
  169                                          (. VAR vD: BOOLEAN;
  170                                               vnD: SymTab.Name; .)
  171      = Expr<t, lx, vD, vnD> .
  172    TypeDecl                              (. VAR n: SymTab.Name;
  173                                               t0, t1: SymTab.TypeIndex; .)
  174      = GetIdent<n>                       (. IF ~SymTab.Enter(n, SymTab.KindType)
  175                                             THEN SemError(200) END;
  176                                             t0 := SymTab.NewAlias();
  177                                             SymTab.SetSymType(n, t0); .)
  178        "="
  179        Type<t1>                          (. IF t1 = t0 THEN SemError(223);
  180                                               SymTab.SetTarget(t0,
  181                                                 SymTab.InvalidType)
  182                                             ELSE SymTab.SetTarget(t0, t1) END; .) .
  183    VarDecl                               (. VAR t: SymTab.TypeIndex;
  184                                               i: CARDINAL;
  185                                               nm: SymTab.Name;
  186                                               cls: INTEGER;
  187                                               sl: CARDINAL; .)
  188      = VarIdents ":"
  189        Type<t>                           (. cls := SymTab.ClassOf(t);
  190                                             IF (cls # SymTab.ClInt)
  191                                                & (cls # SymTab.ClReal)
  192                                                & (cls # SymTab.ClBool)
  193                                                & (cls # SymTab.ClChar)
  194                                                & (cls # SymTab.ClEnum)
  195                                                & (cls # SymTab.ClSet)
  196                                                & (cls # SymTab.ClArray)
  197                                                & (cls # SymTab.ClRecord)
  198                                                & (cls # SymTab.ClPtr) THEN
  199                                               SemError(230)
  200                                             END;
  201                                             sl := SymTab.TypeSlots(t);
  202                                             IF sl = 0 THEN
  203                                               SemError(230);
  204                                               sl := 1
  205                                             END;
  206                                             i := 0;
  207                                             WHILE i < SymTab.PendCount() DO
  208                                               SymTab.PendName(i, nm);
  209                                               IF SymTab.SymDepth(nm) = 0 THEN
  210                                                 MGen.DeclVarSized(nm, sl)
  211                                               END;
  212                                               INC(i)
  213                                             END;
  214                                             SymTab.FixPending(t); .) .
  215    VarIdents                             (. VAR n: SymTab.Name; .)
  216      = GetIdent<n>                       (. IF ~SymTab.EnterPending(n,
  217                                               SymTab.KindVar)
  218                                             THEN SemError(200) END .)
  219        { ","
  220          GetIdent<n>                     (. IF ~SymTab.EnterPending(n,
  221                                               SymTab.KindVar)
  222                                             THEN SemError(200) END .) } .
  223    ProcedureDecl                         (. VAR n, m: SymTab.Name;
  224                                               rt: SymTab.TypeIndex;
  225                                               hasR, ok: BOOLEAN;
  226                                               endL: INTEGER; .)
  227      = "PROCEDURE"                       (. hasR := FALSE; .)
  228        GetIdent<n>                       (. IF SymTab.IsForward(n) THEN
  229                                               SymTab.ReuseProc(n)
  230                                             ELSIF ~SymTab.EnterProc(n) THEN
  231                                               SemError(200)
  232                                             END;
  233                                             SymTab.OpenProcScope;
  234                                             endL := MGen.NewLabel();
  235                                             MGen.Jmp(endL); .)
  236        [ "(" FormalParams ")" ]
  237        [ ":" QualIdent<rt>               (. hasR := TRUE; .) ]
  238                                          (. IF hasR THEN
  239                                               ok := SymTab.SetProcRet(rt)
  240                                             ELSE
  241                                               ok := SymTab.SetProcRet(
  242                                                       SymTab.InvalidType)
  243                                             END;
  244                                             IF ~ok THEN SemError(231) END;
  245                                             IF ~SymTab.VerifyProc() THEN
  246                                               SemError(231)
  247                                             END; .)
  248        ";"
  249        ( Block<TRUE> GetIdent<m>         (. IF ~SymTab.Equal(n, m) THEN
  250                                             SemError(202) END;
  251                                             MGen.DefLabel(endL);
  252                                             SymTab.CloseProc; .)
  253        | "FORWARD"                     (. SymTab.SetForward;
  254                                             SymTab.CloseProc;
  255                                             MGen.DefLabel(endL); .) ) .
  256    ModuleDecl                            (. VAR n, m, e: SymTab.Name;
  257                                               noMod, enterOk: BOOLEAN; .)
  258      = "MODULE"                          (. noMod := SymTab.InProc()
  259                                                    OR SymTab.InModule();
  260                                             enterOk := FALSE; .)
  261        GetIdent<n>                       (. IF noMod THEN
  262                                             SemError(230)
  263                                           ELSIF ~SymTab.EnterModule(n) THEN
  264                                             SemError(200)
  265                                           ELSE
  266                                             enterOk := TRUE
  267                                           END; .)
  268        [ "EXPORT"
  269          GetIdent<e>                     (. IF ~noMod & enterOk THEN
  270                                             IF ~SymTab.ModuleAddExp(e) THEN
  271                                               SemError(200)
  272                                             END
  273                                           END; .)
  274          { "," GetIdent<e>               (. IF ~noMod & enterOk THEN
  275                                             IF ~SymTab.ModuleAddExp(e) THEN
  276                                               SemError(200)
  277                                             END
  278                                           END; .) } ]
  279        ";"
  280        { Declaration }
  281        "END"
  282        GetIdent<m>                       (. IF ~SymTab.Equal(n, m) THEN
  283                                             SemError(202)
  284                                           END;
  285                                           IF ~noMod & enterOk THEN
  286                                             IF ~SymTab.ExitModule() THEN
  287                                               SemError(201)
  288                                             END
  289                                           END; .) .
  290    FormalParams = FPSection { ";" FPSection } .
  291    FPSection                             (. VAR isV: BOOLEAN;
  292                                               nn, i: CARDINAL;
  293                                               pn: ARRAY [0 .. 15] OF SymTab.Name;
  294                                               n: SymTab.Name;
  295                                               t: SymTab.TypeIndex; .)
  296      =                                   (. isV := FALSE; nn := 0; .)
  297        [ "VAR"                           (. isV := TRUE; .) ]
  298        GetIdent<n>                       (. IF nn <= HIGH(pn) THEN
  299                                               MGen.CopyName(n, pn[nn])
  300                                             END;
  301                                             INC(nn); .)
  302        { "," GetIdent<n>                 (. IF nn <= HIGH(pn) THEN
  303                                               MGen.CopyName(n, pn[nn])
  304                                             END;
  305                                             INC(nn); .) }
  306        ":" Type<t>                       (. IF ~isV
  307                                                & (t # SymTab.InvalidType)
  308                                                & (SymTab.TypeSlots(t) > 1) THEN
  309                                               SemError(230)
  310                                             END;
  311                                             i := 0;
  312                                             WHILE i < nn DO
  313                                               IF i <= HIGH(pn) THEN
  314                                                 IF ~SymTab.EnterParam(
  315                                                      pn[i], isV, t) THEN
  316                                                   SemError(200)
  317                                                 END
  318                                               END;
  319                                               INC(i)
  320                                             END; .) .
  321    QualIdent <VAR t: SymTab.TypeIndex>
  322                                          (. VAR n, m: SymTab.Name; .)
  323      = GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
  324                                               SemError(201);
  325                                               t := SymTab.InvalidType
  326                                             ELSIF (SymTab.SymKind(n) #
  327                                                    SymTab.KindType)
  328                                               & (SymTab.SymKind(n) #
  329                                                  SymTab.KindPredef)
  330                                               & (SymTab.SymKind(n) #
  331                                                  SymTab.KindImport) THEN
  332                                               SemError(221);
  333                                               t := SymTab.InvalidType
  334                                             ELSE t := SymTab.SymType(n) END; .)
  335        { "."
  336          GetIdent<m>                     (. t := SymTab.InvalidType; .) } .
  337  
  338    (* Types: ProcedureType removed; subrange factored for LL(1) *)
  339    Type <VAR t: SymTab.TypeIndex>
  340      = SimpleType<t> | ArrayType<t> | RecordType<t>
  341      | SetType<t> | PointerType<t> .
  342    SimpleType <VAR t: SymTab.TypeIndex>
  343                                          (. VAR t1, t2: SymTab.TypeIndex;
  344                                               lx1, lx2: MGen.LitStr;
  345                                               vD: BOOLEAN;
  346                                               vnD: SymTab.Name;
  347                                               loI, hiI: INTEGER;
  348                                               lok, hik: BOOLEAN; .)
  349      = QualIdent<t> [ "["
  350                        (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE;
  351                           loI := 0; hiI := -1; .)
  352                        ConstExpr<t1, lx1> (. IF (t1 # SymTab.InvalidType)
  353                                              & (SymTab.ClassOf(t1) #
  354                                                 SymTab.ClInt)
  355                                              & (SymTab.ClassOf(t1) #
  356                                                 SymTab.ClChar)
  357                                              & (SymTab.ClassOf(t1) #
  358                                                 SymTab.ClEnum) THEN
  359                                              SemError(224) END; .)
  360                        ".."
  361                        ConstExpr<t2, lx2> (. IF (t2 # SymTab.InvalidType)
  362                                              & (SymTab.ClassOf(t2) #
  363                                                 SymTab.ClInt)
  364                                              & (SymTab.ClassOf(t2) #
  365                                                 SymTab.ClChar)
  366                                              & (SymTab.ClassOf(t2) #
  367                                                 SymTab.ClEnum) THEN
  368                                              SemError(224) END; .)
  369                        "]"
  370                                       (. IF (t1 # SymTab.InvalidType)
  371                                           & (t2 # SymTab.InvalidType) THEN
  372                                             IF MGen.IsLit(lx1) THEN
  373                                               IF SymTab.ClassOf(t1)
  374                                                  = SymTab.ClChar THEN
  375                                                 loI := MGen.CharOrd(lx1);
  376                                                 lok := TRUE
  377                                               ELSIF MGen.ParseInt(lx1, loI) THEN
  378                                                 lok := TRUE
  379                                               END
  380                                             END;
  381                                             IF MGen.IsLit(lx2) THEN
  382                                               IF SymTab.ClassOf(t2)
  383                                                  = SymTab.ClChar THEN
  384                                                 hiI := MGen.CharOrd(lx2);
  385                                                 hik := TRUE
  386                                               ELSIF MGen.ParseInt(lx2, hiI) THEN
  387                                                 hik := TRUE
  388                                               END
  389                                             END
  390                                           END;
  391                                          IF lok & hik THEN
  392                                            t := SymTab.NewSubB(t1, loI, hiI)
  393                                          ELSE
  394                                            t := SymTab.NewSub(t1);
  395                                            IF (t1 # SymTab.InvalidType)
  396                                               & (t2 # SymTab.InvalidType) THEN
  397                                              SemError(230)
  398                                            END
  399                                          END;
  400                                          MGen.NoEmitExit; .) ]
  401      | "["                               (. MGen.NoEmitEnter; lok := FALSE;
  402                                             hik := FALSE; loI := 0; hiI := -1; .)
  403        ConstExpr<t1, lx1>                (. IF (t1 # SymTab.InvalidType)
  404                                              & (SymTab.ClassOf(t1) #
  405                                                 SymTab.ClInt)
  406                                              & (SymTab.ClassOf(t1) #
  407                                                 SymTab.ClChar)
  408                                              & (SymTab.ClassOf(t1) #
  409                                                 SymTab.ClEnum) THEN
  410                                              SemError(224) END; .)
  411        ".."
  412        ConstExpr<t2, lx2>                (. IF (t2 # SymTab.InvalidType)
  413                                              & (SymTab.ClassOf(t2) #
  414                                                 SymTab.ClInt)
  415                                              & (SymTab.ClassOf(t2) #
  416                                                 SymTab.ClChar)
  417                                              & (SymTab.ClassOf(t2) #
  418                                                 SymTab.ClEnum) THEN
  419                                              SemError(224) END; .)
  420        "]"                               (. IF (t1 # SymTab.InvalidType)
  421                                             & (t2 # SymTab.InvalidType) THEN
  422                                               IF MGen.IsLit(lx1) THEN
  423                                                 IF SymTab.ClassOf(t1)
  424                                                    = SymTab.ClChar THEN
  425                                                   loI := MGen.CharOrd(lx1);
  426                                                   lok := TRUE
  427                                                 ELSIF MGen.ParseInt(lx1,
  428                                                           loI) THEN
  429                                                   lok := TRUE
  430                                                 END
  431                                               END;
  432                                               IF MGen.IsLit(lx2) THEN
  433                                                 IF SymTab.ClassOf(t2)
  434                                                    = SymTab.ClChar THEN
  435                                                   hiI := MGen.CharOrd(lx2);
  436                                                   hik := TRUE
  437                                                 ELSIF MGen.ParseInt(lx2,
  438                                                           hiI) THEN
  439                                                   hik := TRUE
  440                                                 END
  441                                               END
  442                                             END;
  443                                            IF lok & hik THEN
  444                                              t := SymTab.NewSubB(t1, loI, hiI)
  445                                            ELSE
  446                                              t := SymTab.NewSub(t1);
  447                                              IF (t1 # SymTab.InvalidType)
  448                                                 & (t2 # SymTab.InvalidType) THEN
  449                                                SemError(230)
  450                                              END
  451                                            END;
  452                                             MGen.NoEmitExit; .)
  453      | Enum<t> .
  454    Enum <VAR t: SymTab.TypeIndex>
  455                                          (. VAR n: SymTab.Name;
  456                                               ord: INTEGER; .)
  457      = "("                               (. t := SymTab.NewEnum();
  458                                             ord := 0; .)
  459        GetIdent<n>                       (. IF ~SymTab.Enter(n,
  460                                               SymTab.KindConst)
  461                                             THEN SemError(200) END;
  462                                             SymTab.SetSymType(n, t);
  463                                             SymTab.EnumAdd(t);
  464                                             MGen.DeclConstInt(n, ord);
  465                                             INC(ord); .)
  466        { ","
  467          GetIdent<n>                     (. IF ~SymTab.Enter(n,
  468                                               SymTab.KindConst)
  469                                             THEN SemError(200) END;
  470                                             SymTab.SetSymType(n, t);
  471                                             SymTab.EnumAdd(t);
  472                                             MGen.DeclConstInt(n, ord);
  473                                             INC(ord); .) }
  474        ")" .
  475    ArrayType <VAR t: SymTab.TypeIndex>
  476                                          (. VAR s, s2, e: SymTab.TypeIndex;
  477                                               idx: ARRAY [0 .. 7] OF
  478                                                 SymTab.TypeIndex;
  479                                               nc, kk: CARDINAL;
  480                                               loA, hiA: INTEGER;
  481                                               isOpenA: BOOLEAN; .)
  482      = "ARRAY"
  483        [ SimpleType<s>                     (. IF (s # SymTab.InvalidType)
  484                                              & (SymTab.ClassOf(s) #
  485                                                 SymTab.ClInt)
  486                                              & (SymTab.ClassOf(s) #
  487                                                 SymTab.ClChar)
  488                                              & (SymTab.ClassOf(s) #
  489                                                 SymTab.ClEnum) THEN
  490                                              SemError(224) END;
  491                                             nc := 0; isOpenA := FALSE;
  492                                             idx[nc] := s; INC(nc); .)
  493          { ","
  494            SimpleType<s2>                  (. IF (s2 # SymTab.InvalidType)
  495                                              & (SymTab.ClassOf(s2) #
  496                                                 SymTab.ClInt)
  497                                              & (SymTab.ClassOf(s2) #
  498                                                 SymTab.ClChar)
  499                                              & (SymTab.ClassOf(s2) #
  500                                                 SymTab.ClEnum) THEN
  501                                              SemError(224) END;
  502                                             IF nc <= HIGH(idx) THEN
  503                                               idx[nc] := s2; INC(nc)
  504                                             END; .) }
  505        |                                   (. nc := 0; isOpenA := TRUE; .) ]
  506        "OF"
  507        Type<e>                           (. IF isOpenA THEN
  508                                             t := SymTab.NewOpen(e)
  509                                           ELSE
  510                                             t := e;
  511                                             kk := nc;
  512                                             WHILE kk > 0 DO
  513                                               DEC(kk);
  514                                               loA := SymTab.TypeLo(idx[kk]);
  515                                               hiA := SymTab.TypeHi(idx[kk]);
  516                                               IF SymTab.TypeLen(idx[kk]) = 0 THEN
  517                                                 IF idx[kk]
  518                                                    # SymTab.InvalidType THEN
  519                                                   SemError(230)
  520                                                 END;
  521                                                 loA := 0; hiA := -1
  522                                               END;
  523                                               t := SymTab.NewArrayB(t,
  524                                                       loA, hiA)
  525                                             END
  526                                           END; .) .
  527    RecordType <VAR t: SymTab.TypeIndex>
  528      = "RECORD"                          (. t := SymTab.NewRecord(); .)
  529        FieldSeq<t>
  530        "END" .
  531    FieldSeq <rt: SymTab.TypeIndex>
  532      = Field<rt> { ";"
  533                    Field<rt> } .
  534    Field <rt: SymTab.TypeIndex>
  535                                          (. VAR et: SymTab.TypeIndex; .)
  536      = [ FieldIdents<rt> ":"
  537          Type<et>                       (. IF (et # SymTab.InvalidType)
  538                                             & SymTab.IsOpen(et) THEN
  539                                             SemError(230)
  540                                           END;
  541                                           SymTab.FixPendingF(rt, et); .) ] .
  542    FieldIdents <rt: SymTab.TypeIndex>
  543                                          (. VAR n: SymTab.Name; .)
  544      = GetIdent<n>                       (. IF ~SymTab.FieldPending(rt, n)
  545                                             THEN SemError(200) END .)
  546        { ","
  547          GetIdent<n>                     (. IF ~SymTab.FieldPending(rt, n)
  548                                             THEN SemError(200) END .) } .
  549    SetType <VAR t: SymTab.TypeIndex>
  550                                          (. VAR s: SymTab.TypeIndex; .)
  551      = "SET"
  552        "OF"
  553        SimpleType<s>                     (. IF (s # SymTab.InvalidType)
  554                                              & (SymTab.ClassOf(s) #
  555                                                 SymTab.ClInt)
  556                                              & (SymTab.ClassOf(s) #
  557                                                 SymTab.ClChar)
  558                                              & (SymTab.ClassOf(s) #
  559                                                 SymTab.ClEnum) THEN
  560                                              SemError(224) END;
  561                                             t := SymTab.NewSet(s); .) .
  562    PointerType <VAR t: SymTab.TypeIndex>
  563                                          (. VAR b: SymTab.TypeIndex; .)
  564      = "POINTER"
  565        "TO"
  566        Type<b>                           (. t := SymTab.NewPtr(b); .) .
  567  
  568    (* Statements: RETURN added; calls via AssignOrCall *)
  569    StatSeq    = Stat { ";"
  570                       Stat } .
  571    Stat                                  (. VAR lx: INTEGER; .)
  572      = [ AssignOrCall | IfStat | CaseStat | WhileStat
  573        | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat
  574        | NewStat | DispStat | WriteIntStat | WriteStrStat
  575        | "EXIT"                 (. IF MGen.TopLoop(lx) THEN
  576                                      MGen.Jmp(lx)
  577                                    ELSE SemError(230) END; .) ] .
  578    AssignOrCall                          (. VAR dt, et: SymTab.TypeIndex;
  579                                               dk: INTEGER;
  580                                               bn: SymTab.Name;
  581                                               lxD, lxe: MGen.LitStr;
  582                                               vE: BOOLEAN;
  583                                               vnE: SymTab.Name;
  584                                               sfx: BOOLEAN;
  585                                               okC: BOOLEAN;
  586                                               isR, conv,
  587                                               storable, pushedDst,
  588                                               pushedFld: BOOLEAN;
  589                                               dstBytes, srcBytes: CARDINAL;
  590                                               elemDt: SymTab.TypeIndex;
  591                                               modBare: INTEGER; .)
  592      =                                   (. sfx := FALSE; pushedDst := FALSE;
  593                                             pushedFld := FALSE; .)
  594        DesignHead<dt, dk, bn, FALSE, lxD>
  595        DesignTail<dt, dk, bn, FALSE, lxD, sfx>
  596        ( ":="
  597                                          (. storable :=
  598                                               (dk = SymTab.KindVar)
  599                                               OR (dk = SymTab.KindParam)
  600                                               OR (dk = SymTab.KindVarPar);
  601                                             IF (dk = SymTab.KindField)
  602                                                & (~sfx)
  603                                                & (dt # SymTab.InvalidType) THEN
  604                                               MGen.WithAddr(bn);
  605                                               pushedFld := TRUE
  606                                             END;
  607                                             IF storable & ~sfx
  608                                                & (dt # SymTab.InvalidType)
  609                                                & ((SymTab.ClassOf(dt)
  610                                                   = SymTab.ClArray)
  611                                                   OR (SymTab.ClassOf(dt)
  612                                                      = SymTab.ClRecord)) THEN
  613                                               MGen.PushAddr(bn);
  614                                               pushedDst := TRUE
  615                                             END;
  616                                             IF storable & ~sfx
  617                                                & ~pushedDst THEN
  618                                               IF (dt # SymTab.InvalidType)
  619                                                  & (SymTab.TypeSlots(dt)
  620                                                     > 1) THEN
  621                                               ELSE MGen.StoreSetup(bn)
  622                                               END
  623                                             END; .)
  624          Expr<et, lxe, vE, vnE>                                                  (. IF (dt # SymTab.InvalidType)
  625                                             & (dk # SymTab.KindVar)
  626                                             & (dk # SymTab.KindParam)
  627                                             & (dk # SymTab.KindVarPar)
  628                                             & (dk # SymTab.KindField)
  629                                             & (dk # SymTab.KindImport) THEN
  630                                             SemError(210)
  631                                           ELSIF pushedDst THEN
  632                                             IF et = SymTab.InvalidType THEN
  633                                               MGen.Drop; MGen.Drop
  634                                             ELSIF (SymTab.ClassOf(dt)
  635                                                    = SymTab.ClArray)
  636                                                & (SymTab.ClassOf(
  637                                                   SymTab.ArrayElem(dt))
  638                                                   = SymTab.ClChar)
  639                                                & (SymTab.ClassOf(et)
  640                                                   = SymTab.ClStr) THEN
  641                                               srcBytes :=
  642                                                 MGen.StrLenOf(lxe) + 1;
  643                                               dstBytes :=
  644                                                 SymTab.TypeSlots(dt) * 8;
  645                                               IF srcBytes > dstBytes THEN
  646                                                 SemError(210);
  647                                                 MGen.Drop; MGen.Drop
  648                                               ELSE
  649                                                 MGen.PushBytes(srcBytes);
  650                                                 MGen.CopyBlock
  651                                               END
  652                                             ELSIF ~SymTab.Assignable(et,
  653                                                       dt) THEN
  654                                               SemError(210);
  655                                               MGen.Drop; MGen.Drop
  656                                             ELSE
  657                                               dstBytes :=
  658                                                 SymTab.TypeSlots(dt) * 8;
  659                                               MGen.PushBytes(dstBytes);
  660                                               MGen.CopyBlock
  661                                             END
  662                                           ELSIF pushedFld THEN
  663                                             IF et = SymTab.InvalidType THEN
  664                                               MGen.Drop; MGen.Drop
  665                                             ELSIF (SymTab.TypeSlots(dt) > 1) THEN
  666                                               IF (SymTab.ClassOf(dt)
  667                                                  = SymTab.ClArray)
  668                                                  & (SymTab.ClassOf(
  669                                                     SymTab.ArrayElem(dt))
  670                                                     = SymTab.ClChar)
  671                                                  & (SymTab.ClassOf(et)
  672                                                     = SymTab.ClStr) THEN
  673                                                 srcBytes :=
  674                                                   MGen.StrLenOf(lxe) + 1;
  675                                                 dstBytes :=
  676                                                   SymTab.TypeSlots(dt) * 8;
  677                                                 IF srcBytes > dstBytes THEN
  678                                                   SemError(210);
  679                                                   MGen.Drop; MGen.Drop
  680                                                 ELSE
  681                                                   MGen.PushBytes(srcBytes);
  682                                                   MGen.CopyBlock
  683                                                 END
  684                                               ELSIF ~SymTab.Assignable(et,
  685                                                         dt) THEN
  686                                                 SemError(210);
  687                                                 MGen.Drop; MGen.Drop
  688                                               ELSE
  689                                                 dstBytes :=
  690                                                   SymTab.TypeSlots(dt) * 8;
  691                                                 MGen.PushBytes(dstBytes);
  692                                                 MGen.CopyBlock
  693                                               END
  694                                             ELSE
  695                                               IF ~SymTab.Assignable(et,
  696                                                         dt) THEN
  697                                                 SemError(210);
  698                                                 MGen.Drop; MGen.Drop
  699                                               ELSE
  700                                                 isR :=
  701                                                   (SymTab.ClassOf(dt)
  702                                                    = SymTab.ClReal);
  703                                                 conv := isR
  704                                                   & SymTab.IsIntFamily(et);
  705                                                 IF conv THEN
  706                                                   MGen.IntToReal
  707                                                 END;
  708                                                 IF (SymTab.ClassOf(dt)
  709                                                    = SymTab.ClChar)
  710                                                    OR (SymTab.ClassOf(dt)
  711                                                       = SymTab.ClBool) THEN
  712                                                   MGen.StoreByte
  713                                                 ELSE MGen.StoreIndir0
  714                                                 END
  715                                               END
  716                                             END
  717                                           ELSIF (dt # SymTab.InvalidType)
  718                                             & ~sfx
  719                                             & (SymTab.TypeSlots(dt) > 1) THEN
  720                                             IF ~SymTab.Assignable(et, dt) THEN
  721                                               SemError(210)
  722                                             ELSE SemError(230)
  723                                             END
  724                                           ELSIF ~SymTab.Assignable(et, dt) THEN
  725                                             SemError(210) END;
  726                                           IF dk = SymTab.KindImport THEN
  727                                             SemError(230)
  728                                           END;
  729                                           isR := (dt # SymTab.InvalidType)
  730                                                  & ~pushedDst
  731                                                  & ~pushedFld
  732                                                  & (SymTab.ClassOf(dt)
  733                                                     = SymTab.ClReal);
  734                                           conv := isR
  735                                                   & SymTab.IsIntFamily(et);
  736                                           IF pushedDst THEN
  737                                           ELSIF pushedFld THEN
  738                                           ELSIF (dt # SymTab.InvalidType)
  739                                              & sfx THEN
  740                                             IF conv THEN
  741                                               MGen.IntToReal
  742                                             END;
  743                                             IF (SymTab.ClassOf(dt)
  744                                                = SymTab.ClChar)
  745                                                OR (SymTab.ClassOf(dt)
  746                                                   = SymTab.ClBool) THEN
  747                                               MGen.StoreByte
  748                                             ELSE MGen.StoreIndir0
  749                                             END
  750                                           ELSIF storable & ~sfx THEN
  751                                             IF (dt # SymTab.InvalidType)
  752                                                & (SymTab.TypeSlots(dt)
  753                                                   > 1) THEN
  754                                               MGen.Drop
  755                                             ELSE
  756                                               IF conv THEN
  757                                                 MGen.IntToReal
  758                                               END;
  759                                               MGen.StoreFinish(bn)
  760                                             END
  761                                           ELSE MGen.Drop
  762                                           END; .)
  763        | CallTail<bn, lxD, sfx, FALSE, okC, FALSE>
  764        |                             (. IF (SymTab.SymKind(bn)
  765                                                = SymTab.KindModule)
  766                                               & sfx
  767                                               & (SymTab.StrLen(lxD) > 0) THEN
  768                                             modBare := SymTab.ExpProc(bn,
  769                                                              lxD);
  770                                             IF modBare < 0 THEN
  771                                               IF SymTab.ExpKind(bn,
  772                                                    lxD) # -1 THEN
  773                                                 SemError(233)
  774                                               END
  775                                             ELSIF SymTab.ProcNParByNum(
  776                                                      modBare) # 0 THEN
  777                                               SemError(233)
  778                                             ELSE
  779                                               MGen.CallProc(modBare);
  780                                               IF SymTab.ProcRetByNum(
  781                                                    modBare)
  782                                                  # SymTab.InvalidType THEN
  783                                                 MGen.Drop
  784                                               END
  785                                             END
  786                                           ELSE
  787                                             MGen.ActBegin(bn);
  788                                             IF MGen.ActEnd(bn, FALSE,
  789                                                    FALSE) # 0 THEN
  790                                               SemError(233)
  791                                             END
  792                                           END; .) ) .
  793    CallTail <pn: SymTab.Name; exp: SymTab.Name; sfx: BOOLEAN;
  794              inExpr: BOOLEAN; VAR ok: BOOLEAN; hasDead: BOOLEAN>
  795                                          (. VAR t: SymTab.TypeIndex;
  796                                               lx: MGen.LitStr;
  797                                               v: BOOLEAN;
  798                                               vn: SymTab.Name;
  799                                               isModP: BOOLEAN;
  800                                               modPNum: INTEGER;
  801                                               modErr: BOOLEAN; .)
  802      = "("                               (. ok := FALSE; modErr := FALSE;
  803                                             isModP :=
  804                                               (SymTab.SymKind(pn)
  805                                                = SymTab.KindModule)
  806                                               & sfx
  807                                               & (SymTab.StrLen(exp) > 0);
  808                                             IF hasDead THEN MGen.Drop END;
  809                                             IF isModP THEN
  810                                               modPNum := SymTab.ExpProc(pn,
  811                                                                exp);
  812                                               IF modPNum < 0 THEN
  813                                                 IF SymTab.ExpKind(pn,
  814                                                      exp) # -1 THEN
  815                                                   SemError(233)
  816                                                 END;
  817                                                 modErr := TRUE
  818                                               ELSIF inExpr
  819                                                  & (SymTab.ProcRetByNum(
  820                                                       modPNum)
  821                                                     = SymTab.InvalidType)
  822                                               THEN
  823                                                 SemError(233);
  824                                                 modErr := TRUE
  825                                               END;
  826                                               MGen.ActBeginNum(modPNum)
  827                                             ELSE
  828                                               MGen.ActBegin(pn)
  829                                             END; .)
  830        [ Expr<t, lx, v, vn>              (. IF isModP THEN
  831                                             IF ~modErr
  832                                                & (MGen.ActValue(t, v, vn)
  833                                                   # 0) THEN
  834                                               SemError(233);
  835                                               modErr := TRUE
  836                                             END
  837                                           ELSIF MGen.ActValue(t, v, vn) # 0 THEN
  838                                             SemError(233)
  839                                           END; .)
  840          { "," Expr<t, lx, v, vn>        (. IF isModP THEN
  841                                             IF ~modErr
  842                                                & (MGen.ActValue(t, v, vn)
  843                                                   # 0) THEN
  844                                               SemError(233);
  845                                               modErr := TRUE
  846                                             END
  847                                           ELSIF MGen.ActValue(t, v, vn) # 0 THEN
  848                                             SemError(233)
  849                                           END; .) } ]
  850        ")"                               (. IF isModP THEN
  851                                             IF ~modErr THEN
  852                                               IF MGen.ActEndNum(modPNum,
  853                                                    inExpr) # 0 THEN
  854                                                 SemError(233)
  855                                               ELSE ok := TRUE
  856                                               END
  857                                             END
  858                                           ELSIF MGen.ActEnd(pn, sfx,
  859                                                    inExpr) # 0
  860                                           THEN SemError(233)
  861                                           ELSE ok := TRUE
  862                                           END; .) .
  863    IfStat                                (. VAR t: SymTab.TypeIndex;
  864                                               lxC: MGen.LitStr;
  865                                               vC: BOOLEAN;
  866                                               vnC: SymTab.Name;
  867                                               elseL, endL: INTEGER;
  868                                               hasElse: BOOLEAN; .)
  869      = "IF"
  870        Expr<t, lxC, vC, vnC>             (. IF ~SymTab.BoolCheck(t) THEN
  871                                             SemError(214) END;
  872                                             elseL := MGen.NewLabel();
  873                                             endL := MGen.NewLabel();
  874                                             MGen.Jz(elseL);
  875                                             hasElse := FALSE; .)
  876        "THEN"
  877        StatSeq
  878        { "ELSIF"                         (. MGen.Jmp(endL);
  879                                             MGen.DefLabel(elseL); .)
  880          Expr<t, lxC, vC, vnC>           (. IF ~SymTab.BoolCheck(t) THEN
  881                                             SemError(214) END;
  882                                             elseL := MGen.NewLabel();
  883                                             MGen.Jz(elseL); .)
  884          "THEN"
  885          StatSeq }
  886        [ "ELSE"                          (. MGen.Jmp(endL);
  887                                             MGen.DefLabel(elseL);
  888                                             hasElse := TRUE; .)
  889          StatSeq ]
  890        "END"                             (. IF ~hasElse THEN
  891                                             MGen.DefLabel(elseL)
  892                                           END;
  893                                           MGen.DefLabel(endL); .) .
  894    CaseStat                              (. VAR st: SymTab.TypeIndex;
  895                                               lxS: MGen.LitStr;
  896                                               vS: BOOLEAN;
  897                                               vnS: SymTab.Name;
  898                                               tmp, endL: INTEGER; .)
  899      = "CASE"
  900        Expr<st, lxS, vS, vnS>            (. tmp := MGen.TempGlobal();
  901                                             MGen.StoreTemp(tmp);
  902                                             endL := MGen.NewLabel(); .)
  903        "OF"
  904        Case<st, tmp, endL> { "|"
  905                   Case<st, tmp, endL> }
  906        [ "ELSE"
  907          StatSeq ]
  908        "END"                             (. MGen.DefLabel(endL); .) .
  909    Case <sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER>
  910                                          (. VAR lB, lN: INTEGER; .)
  911      = [ LabelList<sel, tmp, lB, lN> ":" (. MGen.DefLabel(lB); .)
  912          StatSeq                         (. MGen.Jmp(endL);
  913                                             MGen.DefLabel(lN); .) ] .
  914    LabelList <sel: SymTab.TypeIndex; tmp: INTEGER;
  915               VAR lB: INTEGER; VAR lN: INTEGER>
  916      =                                   (. lB := MGen.NewLabel();
  917                                             lN := MGen.NewLabel(); .)
  918        Labels<sel, tmp, lB> { ","
  919                      Labels<sel, tmp, lB> }
  920                                          (. MGen.Jmp(lN); .) .
  921    Labels <sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER>
  922                                          (. VAR t, t2: SymTab.TypeIndex;
  923                                               lx1, lx2: MGen.LitStr;
  924                                               v1, v2: BOOLEAN;
  925                                               vn1, vn2: SymTab.Name;
  926                                               ta, tb, chunk: INTEGER;
  927                                               r, hasRange: BOOLEAN; .)
  928      = ConstExpr<t, lx1>                 (. IF ~SymTab.EqCheck(t, sel) THEN
  929                                             SemError(213) END;
  930                                             r := (SymTab.ClassOf(sel)
  931                                                   = SymTab.ClReal)
  932                                                  & (SymTab.ClassOf(t)
  933                                                     = SymTab.ClReal);
  934                                             ta := MGen.TempGlobal();
  935                                             MGen.StoreTemp(ta);
  936                                             hasRange := FALSE; .)
  937        [ ".."
  938          ConstExpr<t2, lx2>              (. IF ~SymTab.EqCheck(t2, sel) THEN
  939                                             SemError(213) END;
  940                                             tb := MGen.TempGlobal();
  941                                             MGen.StoreTemp(tb);
  942                                             hasRange := TRUE; .) ]
  943                                          (. IF hasRange THEN
  944                                               MGen.LoadTemp(tmp);
  945                                               MGen.LoadTemp(ta);
  946                                               IF r THEN MGen.RealGe
  947                                               ELSE MGen.IGe END;
  948                                               MGen.LoadTemp(tmp);
  949                                               MGen.LoadTemp(tb);
  950                                               IF r THEN MGen.RealLe
  951                                               ELSE MGen.ILe END;
  952                                               MGen.And
  953                                             ELSE
  954                                               MGen.LoadTemp(tmp);
  955                                               MGen.LoadTemp(ta);
  956                                               IF r THEN MGen.RealEq
  957                                               ELSE MGen.Eq END
  958                                             END;
  959                                             chunk := MGen.NewLabel();
  960                                             MGen.Jz(chunk);
  961                                             MGen.Jmp(bodyL);
  962                                             MGen.DefLabel(chunk); .) .
  963    WhileStat                             (. VAR t: SymTab.TypeIndex;
  964                                               lxC: MGen.LitStr;
  965                                               vC: BOOLEAN;
  966                                               vnC: SymTab.Name;
  967                                               topL, endL: INTEGER; .)
  968      = "WHILE"                           (. topL := MGen.NewLabel();
  969                                             endL := MGen.NewLabel();
  970                                             MGen.DefLabel(topL); .)
  971        Expr<t, lxC, vC, vnC>             (. IF ~SymTab.BoolCheck(t) THEN
  972                                             SemError(214) END;
  973                                             MGen.Jz(endL); .)
  974        "DO"
  975        StatSeq
  976        "END"                             (. MGen.Jmp(topL);
  977                                             MGen.DefLabel(endL); .) .
  978    RepeatStat                            (. VAR t: SymTab.TypeIndex;
  979                                               lxC: MGen.LitStr;
  980                                               vC: BOOLEAN;
  981                                               vnC: SymTab.Name;
  982                                               topL: INTEGER; .)
  983      = "REPEAT"                          (. topL := MGen.NewLabel();
  984                                             MGen.DefLabel(topL); .)
  985        StatSeq
  986        "UNTIL"
  987        Expr<t, lxC, vC, vnC>             (. IF ~SymTab.BoolCheck(t) THEN
  988                                             SemError(214) END;
  989                                             MGen.Jz(topL); .) .
  990    LoopStat                              (. VAR topL, exitL: INTEGER; .)
  991      = "LOOP"                            (. topL := MGen.NewLabel();
  992                                             exitL := MGen.NewLabel();
  993                                             MGen.DefLabel(topL);
  994                                             MGen.PushLoop(exitL); .)
  995        StatSeq
  996        "END"                             (. MGen.Jmp(topL);
  997                                             MGen.DefLabel(exitL);
  998                                             MGen.PopLoop; .) .
  999    ForStat                               (. VAR n, lv: SymTab.Name;
 1000                                               fk: INTEGER;
 1001                                               lo, hi: SymTab.TypeIndex;
 1002                                               lxLo, lxHi: MGen.LitStr;
 1003                                               vLo, vHi: BOOLEAN;
 1004                                               vnLo, vnHi: SymTab.Name;
 1005                                               byV, ht: INTEGER;
 1006                                               lTop, lChk, lEnd: INTEGER;
 1007                                               neg, storable: BOOLEAN; .)
 1008      = "FOR"
 1009        GetIdent<n>                       (. IF ~SymTab.Lookup(n) THEN
 1010                                              SemError(201);
 1011                                              fk := -1
 1012                                            ELSIF (SymTab.SymKind(n) #
 1013                                                   SymTab.KindVar)
 1014                                              & (SymTab.SymKind(n) #
 1015                                                 SymTab.KindParam)
 1016                                              & (SymTab.SymKind(n) #
 1017                                                 SymTab.KindVarPar)
 1018                                              & (SymTab.SymKind(n) #
 1019                                                 SymTab.KindField) THEN
 1020                                              SemError(220);
 1021                                              fk := -1
 1022                                            ELSIF (SymTab.SymType(n) #
 1023                                                   SymTab.InvalidType)
 1024                                              & ~SymTab.IsIntFamily(
 1025                                                  SymTab.SymType(n)) THEN
 1026                                              SemError(220);
 1027                                              fk := -1
 1028                                            ELSE
 1029                                              fk := SymTab.SymKind(n)
 1030                                            END;
 1031                                            MGen.CopyName(n, lv);
 1032                                            storable := (fk = SymTab.KindVar)
 1033                                              OR (fk = SymTab.KindParam)
 1034                                              OR (fk = SymTab.KindVarPar);
 1035                                            IF storable THEN
 1036                                              MGen.StoreSetup(lv)
 1037                                            END; .)
 1038        ":="
 1039        Expr<lo, lxLo, vLo, vnLo>         (. IF (lo # SymTab.InvalidType)
 1040                                             & ~SymTab.IsIntFamily(lo) THEN
 1041                                             SemError(220) END;
 1042                                             IF storable THEN
 1043                                               MGen.StoreFinish(lv)
 1044                                             ELSE MGen.Drop
 1045                                             END; .)
 1046        "TO"
 1047        Expr<hi, lxHi, vHi, vnHi>         (. IF (hi # SymTab.InvalidType)
 1048                                             & ~SymTab.IsIntFamily(hi) THEN
 1049                                             SemError(220) END;
 1050                                             ht := MGen.TempGlobal();
 1051                                             MGen.StoreTemp(ht);
 1052                                             byV := 1; neg := FALSE; .)
 1053        [ "BY"
 1054          ByLit<byV>                      (. neg := byV < 0; .) ]
 1055        "DO"                              (. lTop := MGen.NewLabel();
 1056                                             lChk := MGen.NewLabel();
 1057                                             lEnd := MGen.NewLabel();
 1058                                             MGen.Jmp(lChk);
 1059                                             MGen.DefLabel(lTop); .)
 1060        StatSeq
 1061        "END"                             (. MGen.PushVar(lv);
 1062                                             MGen.PushInt(byV);
 1063                                             MGen.Add;
 1064                                             IF storable THEN
 1065                                               MGen.StoreFinish(lv)
 1066                                             ELSE MGen.Drop
 1067                                             END;
 1068                                             MGen.DefLabel(lChk);
 1069                                             MGen.PushVar(lv);
 1070                                             MGen.LoadTemp(ht);
 1071                                             IF neg THEN MGen.IGe
 1072                                             ELSE MGen.ILe END;
 1073                                             MGen.Jz(lEnd);
 1074                                             MGen.Jmp(lTop);
 1075                                             MGen.DefLabel(lEnd); .) .
 1076    ByLit <VAR v: INTEGER>                (. VAR s: ARRAY [0 .. 255] OF CHAR; .)
 1077      = integer                           (. LexString(s);
 1078                                             IF ~MGen.ParseInt(s, v) THEN
 1079                                               v := 1
 1080                                             END; .)
 1081      | "-" integer                       (. LexString(s);
 1082                                             IF MGen.ParseInt(s, v) THEN
 1083                                               v := -v
 1084                                             ELSE v := -1
 1085                                             END; .) .
 1086    WithStat                              (. VAR dt: SymTab.TypeIndex;
 1087                                               dk: INTEGER;
 1088                                               bnW: SymTab.Name;
 1089                                               lxW: MGen.LitStr;
 1090                                               sfxW: BOOLEAN;
 1091                                               pushed: BOOLEAN; .)
 1092      = "WITH"
 1093        DesignHead<dt, dk, bnW, FALSE, lxW>
 1094        DesignTail<dt, dk, bnW, FALSE, lxW, sfxW>
 1095                                        (. pushed := FALSE;
 1096                                             IF dt = SymTab.InvalidType THEN
 1097                                               IF sfxW THEN MGen.Drop END
 1098                                             ELSIF SymTab.ClassOf(dt)
 1099                                                    # SymTab.ClRecord THEN
 1100                                               SemError(215);
 1101                                               IF sfxW THEN MGen.Drop END
 1102                                             ELSE
 1103                                               IF ~sfxW THEN
 1104                                                 IF (dk
 1105                                                    = SymTab.KindVar)
 1106                                                    OR (dk
 1107                                                       = SymTab.KindParam)
 1108                                                    OR (dk
 1109                                                    = SymTab.KindVarPar) THEN
 1110                                                   MGen.PushAddr(bnW)
 1111                                                 ELSIF dk
 1112                                                   = SymTab.KindField THEN
 1113                                                   MGen.WithAddr(bnW)
 1114                                                 ELSE MGen.PushInt(0)
 1115                                                 END
 1116                                               END;
 1117                                               MGen.WithEnter(dt);
 1118                                               pushed :=
 1119                                                 SymTab.PushRecord(dt);
 1120                                               IF ~pushed THEN
 1121                                                 SemError(215)
 1122                                               END
 1123                                             END; .)
 1124        "DO"
 1125        StatSeq
 1126        "END"                             (. IF pushed THEN
 1127                                               SymTab.PopScope;
 1128                                               MGen.WithExit
 1129                                             END; .) .
 1130    ReturnStat                            (. VAR t: SymTab.TypeIndex;
 1131                                               lx: MGen.LitStr;
 1132                                               v: BOOLEAN;
 1133                                               vn: SymTab.Name;
 1134                                               hasE, doRet, conv: BOOLEAN; .)
 1135      = "RETURN"                          (. hasE := FALSE; .)
 1136        [ Expr<t, lx, v, vn>              (. hasE := TRUE;
 1137                                             doRet := FALSE;
 1138                                             IF ~SymTab.InProc() THEN
 1139                                               SemError(232)
 1140                                             ELSIF ~SymTab.InFunction() THEN
 1141                                               SemError(232)
 1142                                             ELSIF ~SymTab.Assignable(
 1143                                                       t, SymTab.CurRet()) THEN
 1144                                               SemError(232)
 1145                                             ELSE doRet := TRUE
 1146                                             END;
 1147                                             conv := doRet
 1148                                                     & SymTab.IsIntFamily(t)
 1149                                                     & (SymTab.ClassOf(
 1150                                                          SymTab.CurRet())
 1151                                                        = SymTab.ClReal);
 1152                                             IF doRet THEN
 1153                                               IF conv THEN
 1154                                                 MGen.IntToReal
 1155                                               END;
 1156                                               MGen.Leave(
 1157                                                 SymTab.CurNPar(), TRUE)
 1158                                             ELSE MGen.Drop
 1159                                             END; .) ]
 1160                                           (. IF ~hasE THEN
 1161                                               IF ~SymTab.InProc() THEN
 1162                                                 SemError(232)
 1163                                               ELSIF SymTab.InFunction() THEN
 1164                                                 SemError(232)
 1165                                               ELSE MGen.Leave(
 1166                                                 SymTab.CurNPar(), FALSE)
 1167                                               END
 1168                                             END; .) .
 1169    NewStat                               (. VAR dt: SymTab.TypeIndex;
 1170                                               dk: INTEGER;
 1171                                               bnN: SymTab.Name;
 1172                                               lxN: MGen.LitStr;
 1173                                               sfxN: BOOLEAN;
 1174                                               baseT: SymTab.TypeIndex;
 1175                                               slN: CARDINAL; .)
 1176      = "NEW"
 1177        "(" DesignHead<dt, dk, bnN, FALSE, lxN>
 1178            DesignTail<dt, dk, bnN, FALSE, lxN, sfxN>
 1179        ")"                               (. IF dt = SymTab.InvalidType THEN
 1180                                             IF sfxN THEN MGen.Drop END
 1181                                           ELSIF SymTab.ClassOf(dt)
 1182                                                  # SymTab.ClPtr THEN
 1183                                             SemError(219);
 1184                                             IF sfxN THEN MGen.Drop END
 1185                                           ELSE
 1186                                             baseT := SymTab.PtrBase(dt);
 1187                                             slN := SymTab.TypeSlots(baseT);
 1188                                             IF slN = 0 THEN
 1189                                               SemError(230);
 1190                                               slN := 1
 1191                                             END;
 1192                                             IF ~sfxN THEN
 1193                                               IF (dk = SymTab.KindVar)
 1194                                                  OR (dk
 1195                                                      = SymTab.KindParam)
 1196                                                  OR (dk
 1197                                                   = SymTab.KindVarPar) THEN
 1198                                                 MGen.PushAddr(bnN)
 1199                                               ELSIF dk
 1200                                                 = SymTab.KindField THEN
 1201                                                 MGen.WithAddr(bnN)
 1202                                               ELSE MGen.PushInt(0)
 1203                                               END
 1204                                             END;
 1205                                             MGen.PushBytes(slN * 8);
 1206                                             MGen.AllocOp
 1207                                           END; .) .
 1208    DispStat                              (. VAR dt: SymTab.TypeIndex;
 1209                                               dk: INTEGER;
 1210                                               bnD: SymTab.Name;
 1211                                               lxD: MGen.LitStr;
 1212                                               sfxD: BOOLEAN;
 1213                                               baseT: SymTab.TypeIndex;
 1214                                               slD: CARDINAL; .)
 1215      = "DISPOSE"
 1216        "(" DesignHead<dt, dk, bnD, FALSE, lxD>
 1217            DesignTail<dt, dk, bnD, FALSE, lxD, sfxD>
 1218        ")"                               (. IF dt = SymTab.InvalidType THEN
 1219                                             IF sfxD THEN MGen.Drop END
 1220                                           ELSIF SymTab.ClassOf(dt)
 1221                                                  # SymTab.ClPtr THEN
 1222                                             SemError(219);
 1223                                             IF sfxD THEN MGen.Drop END
 1224                                           ELSE
 1225                                             baseT := SymTab.PtrBase(dt);
 1226                                             slD := SymTab.TypeSlots(baseT);
 1227                                             IF slD = 0 THEN
 1228                                               SemError(230);
 1229                                               slD := 1
 1230                                             END;
 1231                                             IF ~sfxD THEN
 1232                                               IF (dk = SymTab.KindVar)
 1233                                                  OR (dk
 1234                                                      = SymTab.KindParam)
 1235                                                  OR (dk
 1236                                                   = SymTab.KindVarPar) THEN
 1237                                                 MGen.PushAddr(bnD)
 1238                                               ELSIF dk
 1239                                                 = SymTab.KindField THEN
 1240                                                 MGen.WithAddr(bnD)
 1241                                               ELSE MGen.PushInt(0)
 1242                                               END
 1243                                             END;
 1244                                             MGen.PushBytes(slD * 8);
 1245                                             MGen.DeallocOp
 1246                                           END; .) .
 1247    WriteIntStat                          (. VAR t: SymTab.TypeIndex;
 1248                                               lx: MGen.LitStr;
 1249                                               v: BOOLEAN;
 1250                                               vn: SymTab.Name; .)
 1251      = "WriteInt"
 1252        "(" Expr<t, lx, v, vn> ")"        (. IF t = SymTab.InvalidType THEN
 1253                                             MGen.Drop
 1254                                           ELSIF ~SymTab.IsIntFamily(t) THEN
 1255                                             SemError(210);
 1256                                             MGen.Drop
 1257                                           ELSE
 1258                                             MGen.CallPrint
 1259                                           END; .) .
 1260    WriteStrStat                          (. VAR t: SymTab.TypeIndex;
 1261                                               lx: MGen.LitStr;
 1262                                               v: BOOLEAN;
 1263                                               vn: SymTab.Name; .)
 1264      = "WriteString"
 1265        "(" Expr<t, lx, v, vn> ")"        (. IF t = SymTab.InvalidType THEN
 1266                                             MGen.Drop
 1267                                           ELSIF (SymTab.ClassOf(t)
 1268                                                  = SymTab.ClStr) THEN
 1269                                             MGen.PushInt(1);
 1270                                             MGen.SysCall
 1271                                           ELSIF (SymTab.ClassOf(t)
 1272                                                  = SymTab.ClArray)
 1273                                              & (SymTab.ClassOf(
 1274                                                 SymTab.ArrayElem(t))
 1275                                                 = SymTab.ClChar) THEN
 1276                                             MGen.PushInt(1);
 1277                                             MGen.SysCall
 1278                                           ELSE
 1279                                             SemError(210);
 1280                                             MGen.Drop
 1281                                           END; .) .
 1282  
 1283    (* Expressions: Designator without ActualParameters (calls use
 1284       CallTail). Each expression synthesizes its SymTab type in t,
 1285       the source text in lx for single literals ("" otherwise), and
 1286       whether it is a plain variable (v/vn) for VAR actuals.
 1287       Values travel on the MC64 stack. *)
 1288    DesignHead <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
 1289                VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr>
 1290                                          (. VAR n: SymTab.Name;
 1291                                               cls: INTEGER; .)
 1292      = GetIdent<n>                       (. MGen.CopyName(n, bn);
 1293                                             lx[0] := 0C;
 1294                                             IF ~SymTab.Lookup(n) THEN
 1295                                               SemError(201);
 1296                                               t := SymTab.InvalidType; k := -1;
 1297                                               IF doLoad THEN
 1298                                                 MGen.PushInt(0)
 1299                                               END
 1300                                             ELSE
 1301                                               t := SymTab.SymType(n);
 1302                                               k := SymTab.SymKind(n);
 1303                                               IF k = SymTab.KindConst THEN
 1304                                                 IF SymTab.Equal(n, "TRUE") THEN
 1305                                                   t := SymTab.BoolType();
 1306                                                   MGen.CopyName("TRUE", lx);
 1307                                                   IF doLoad THEN
 1308                                                     MGen.PushInt(1)
 1309                                                   END
 1310                                                 ELSIF SymTab.Equal(n,
 1311                                                         "FALSE") THEN
 1312                                                   t := SymTab.BoolType();
 1313                                                   MGen.CopyName("FALSE", lx);
 1314                                                   IF doLoad THEN
 1315                                                     MGen.PushInt(0)
 1316                                                   END
 1317                                                 ELSE
 1318                                                   cls :=
 1319                                                     SymTab.ClassOf(t);
 1320                                                   IF (t #
 1321                                                       SymTab.InvalidType)
 1322                                                      & (cls # SymTab.ClStr)
 1323                                                      & ((cls = SymTab.ClInt)
 1324                                                      OR (cls = SymTab.ClReal)
 1325                                                      OR (cls = SymTab.ClBool)
 1326                                                      OR (cls = SymTab.ClChar)
 1327                                                      OR (cls
 1328                                                          = SymTab.ClEnum)) THEN
 1329                                                     IF doLoad THEN
 1330                                                       MGen.LoadVar(n)
 1331                                                     END
 1332                                                   ELSIF doLoad THEN
 1333                                                     MGen.PushInt(0)
 1334                                                   END
 1335                                                 END
 1336                                                ELSIF (k = SymTab.KindVar)
 1337                                                   OR (k = SymTab.KindParam)
 1338                                                   OR (k
 1339                                                       = SymTab.KindVarPar) THEN
 1340                                                  cls := SymTab.ClassOf(t);
 1341                                                  IF (cls = SymTab.ClInt)
 1342                                                     OR (cls = SymTab.ClReal)
 1343                                                     OR (cls = SymTab.ClBool)
 1344                                                     OR (cls = SymTab.ClChar)
 1345                                                     OR (cls
 1346                                                         = SymTab.ClEnum)
 1347                                                     OR (cls
 1348                                                         = SymTab.ClSet)
 1349                                                     OR (cls
 1350                                                         = SymTab.ClPtr) THEN
 1351                                                    IF doLoad THEN
 1352                                                      MGen.PushVar(n)
 1353                                                    END
 1354                                                  ELSIF (cls
 1355                                                         = SymTab.ClArray)
 1356                                                     OR (cls
 1357                                                         = SymTab.ClRecord) THEN
 1358                                                    IF doLoad THEN
 1359                                                      MGen.PushAddr(n)
 1360                                                    END
 1361                                                  ELSIF t
 1362                                                    = SymTab.InvalidType THEN
 1363                                                    IF doLoad THEN
 1364                                                      MGen.PushInt(0)
 1365                                                    END
 1366                                                  ELSE SemError(230);
 1367                                                    IF doLoad THEN
 1368                                                      MGen.PushInt(0)
 1369                                                    END
 1370                                                  END
 1371                                               ELSE
 1372                                                 IF doLoad THEN
 1373                                                   IF k = SymTab.KindField THEN
 1374                                                     MGen.WithAddr(n);
 1375                                                     cls := SymTab.ClassOf(t);
 1376                                                     IF (t
 1377                                                        = SymTab.InvalidType)
 1378                                                        OR (cls
 1379                                                           = SymTab.ClArray)
 1380                                                        OR (cls
 1381                                                           = SymTab.ClRecord) THEN
 1382                                                     ELSE
 1383                                                       IF (cls
 1384                                                          = SymTab.ClChar)
 1385                                                          OR (cls
 1386                                                             = SymTab.ClBool) THEN
 1387                                                         MGen.LoadByte
 1388                                                       ELSE MGen.LoadIndir
 1389                                                       END
 1390                                                     END
 1391                                                   ELSE MGen.PushInt(0)
 1392                                                   END
 1393                                                 END;
 1394                                                 IF k = SymTab.KindField THEN
 1395                                                 ELSIF k
 1396                                                       = SymTab.KindImport THEN
 1397                                                   SemError(230)
 1398                                                 END
 1399                                               END
 1400                                             END; .) .
 1401    DesignTail <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
 1402                VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr;
 1403                VAR sfx: BOOLEAN>
 1404                                          (. VAR m: SymTab.Name;
 1405                                               it: SymTab.TypeIndex;
 1406                                               lxI: MGen.LitStr;
 1407                                               vI: BOOLEAN;
 1408                                               vnI: SymTab.Name;
 1409                                               loA: INTEGER;
 1410                                               elemT: SymTab.TypeIndex;
 1411                                               esl, ebytes: CARDINAL;
 1412                                               firstT: BOOLEAN;
 1413                                               clsI: INTEGER;
 1414                                               qM: SymTab.Name; .)
 1415      =                                   (. sfx := FALSE; .)
 1416        { "."                             (. firstT := ~sfx;
 1417                                             sfx := TRUE; lx[0] := 0C;
 1418                                             IF ~doLoad & firstT THEN
 1419                                               IF (k = SymTab.KindVar)
 1420                                                  OR (k = SymTab.KindParam)
 1421                                                  OR (k
 1422                                                      = SymTab.KindVarPar) THEN
 1423                                                 MGen.PushAddr(bn)
 1424                                               ELSIF k
 1425                                                 = SymTab.KindField THEN
 1426                                                 MGen.WithAddr(bn)
 1427                                               ELSIF k
 1428                                                 = SymTab.KindModule THEN
 1429                                               ELSE MGen.PushInt(0)
 1430                                               END
 1431                                             END; .)
 1432          GetIdent<m>                     (. IF (k = SymTab.KindModule) THEN
 1433                                               IF SymTab.ExpKind(bn, m) = -1 THEN
 1434                                                 SemError(201);
 1435                                                 MGen.CopyName(m, lx);
 1436                                                 t := SymTab.InvalidType;
 1437                                                 IF doLoad THEN
 1438                                                   MGen.Drop; MGen.PushInt(0)
 1439                                                 ELSIF firstT THEN
 1440                                                 ELSE MGen.Drop
 1441                                                 END
 1442                                               ELSIF SymTab.ExpKind(bn, m)
 1443                                                      = SymTab.KindProc THEN
 1444                                                 MGen.CopyName(m, lx);
 1445                                                 t := SymTab.InvalidType;
 1446                                                 IF doLoad THEN
 1447                                                   MGen.Drop; MGen.PushInt(0)
 1448                                                 ELSIF firstT THEN
 1449                                                 ELSE MGen.Drop
 1450                                                 END
 1451                                               ELSE
 1452                                                 t := SymTab.ExpType(bn, m);
 1453                                                 k := SymTab.ExpKind(bn, m);
 1454                                                 SymTab.ExpQual(bn, m, qM);
 1455                                                 IF doLoad THEN
 1456                                                   MGen.Drop;
 1457                                                   MGen.GlobalAddr(qM)
 1458                                                 ELSE
 1459                                                   IF firstT THEN
 1460                                                   ELSE MGen.Drop
 1461                                                   END;
 1462                                                   MGen.GlobalAddr(qM)
 1463                                                 END
 1464                                               END
 1465                                             ELSIF t = SymTab.InvalidType THEN
 1466                                               IF ~doLoad & firstT THEN
 1467                                                 MGen.Drop
 1468                                               ELSIF doLoad THEN
 1469                                                 MGen.Drop; MGen.PushInt(0)
 1470                                               END
 1471                                             ELSIF SymTab.ClassOf(t) #
 1472                                                   SymTab.ClRecord THEN
 1473                                               SemError(215);
 1474                                               t := SymTab.InvalidType;
 1475                                               IF doLoad THEN
 1476                                                 MGen.Drop; MGen.PushInt(0)
 1477                                               ELSIF firstT THEN
 1478                                                 MGen.Drop
 1479                                               END
 1480                                             ELSIF ~SymTab.FieldExists(t, m) THEN
 1481                                               SemError(216);
 1482                                               t := SymTab.InvalidType;
 1483                                               IF doLoad THEN
 1484                                                 MGen.Drop; MGen.PushInt(0)
 1485                                               ELSIF firstT THEN
 1486                                                 MGen.Drop
 1487                                               END
 1488                                             ELSE
 1489                                               loA := SymTab.FieldOffset(t, m);
 1490                                               elemT := SymTab.FieldType(t, m);
 1491                                               IF loA < 0 THEN
 1492                                                 SemError(216);
 1493                                                 t := SymTab.InvalidType;
 1494                                                 IF doLoad THEN
 1495                                                   MGen.Drop; MGen.PushInt(0)
 1496                                                 ELSIF firstT THEN
 1497                                                   MGen.Drop
 1498                                                 END
 1499                                               ELSE
 1500                                                 MGen.FieldAdd(
 1501                                                   VAL(CARDINAL, loA));
 1502                                                 t := elemT
 1503                                               END
 1504                                             END; .)
 1505        | "["                             (. firstT := ~sfx;
 1506                                             sfx := TRUE; lx[0] := 0C;
 1507                                             IF ~doLoad & firstT THEN
 1508                                               IF (k = SymTab.KindVar)
 1509                                                  OR (k = SymTab.KindParam)
 1510                                                  OR (k
 1511                                                      = SymTab.KindVarPar) THEN
 1512                                                 MGen.PushAddr(bn)
 1513                                               ELSIF k
 1514                                                 = SymTab.KindField THEN
 1515                                                 MGen.WithAddr(bn)
 1516                                               ELSE MGen.PushInt(0)
 1517                                               END
 1518                                             END; .)
 1519          Expr<it, lxI, vI, vnI>          (. IF t = SymTab.InvalidType THEN
 1520                                             MGen.Drop;
 1521                                             IF doLoad THEN
 1522                                               MGen.Drop; MGen.PushInt(0)
 1523                                             ELSE
 1524                                               IF ~firstT THEN
 1525                                               ELSE MGen.Drop
 1526                                               END
 1527                                             END
 1528                                           ELSIF SymTab.ClassOf(t) #
 1529                                                   SymTab.ClArray THEN
 1530                                             SemError(217);
 1531                                             t := SymTab.InvalidType;
 1532                                             MGen.Drop;
 1533                                             IF doLoad THEN
 1534                                               MGen.Drop; MGen.PushInt(0)
 1535                                             ELSE
 1536                                               IF ~firstT THEN
 1537                                               ELSE MGen.Drop
 1538                                               END
 1539                                             END
 1540                                           ELSE
 1541                                             clsI := SymTab.ClassOf(it);
 1542                                             IF (it
 1543                                                # SymTab.InvalidType)
 1544                                                & (clsI # SymTab.ClInt)
 1545                                                & (clsI # SymTab.ClChar)
 1546                                                & (clsI # SymTab.ClEnum)
 1547                                                & (clsI
 1548                                                   # SymTab.ClBool) THEN
 1549                                               SemError(218);
 1550                                               t := SymTab.InvalidType;
 1551                                               MGen.Drop;
 1552                                               IF doLoad THEN
 1553                                                 MGen.Drop; MGen.PushInt(0)
 1554                                               ELSE
 1555                                                 IF ~firstT THEN
 1556                                                 ELSE MGen.Drop
 1557                                                 END
 1558                                               END
 1559                                             ELSE
 1560                                               loA := SymTab.ArrayLo(t);
 1561                                               elemT := SymTab.ArrayElem(t);
 1562                                               esl := SymTab.TypeSlots(elemT);
 1563                                               IF esl = 0 THEN
 1564                                                 SemError(230);
 1565                                                 esl := 1
 1566                                               END;
 1567                                               IF (SymTab.ClassOf(elemT)
 1568                                                  = SymTab.ClChar)
 1569                                                  OR (SymTab.ClassOf(elemT)
 1570                                                     = SymTab.ClBool) THEN
 1571                                                 ebytes := 1
 1572                                               ELSE ebytes := esl * 8
 1573                                               END;
 1574                                               MGen.IdxScale(loA, ebytes);
 1575                                               t := elemT
 1576                                             END
 1577                                           END; .)
 1578          { ","
 1579            Expr<it, lxI, vI, vnI>        (. IF t = SymTab.InvalidType THEN
 1580                                             MGen.Drop;
 1581                                             IF doLoad THEN
 1582                                               MGen.Drop; MGen.PushInt(0);
 1583                                               t := SymTab.InvalidType
 1584                                             END
 1585                                           ELSIF SymTab.ClassOf(t) #
 1586                                                   SymTab.ClArray THEN
 1587                                             SemError(217);
 1588                                             t := SymTab.InvalidType;
 1589                                             MGen.Drop;
 1590                                             IF doLoad THEN
 1591                                               MGen.Drop; MGen.PushInt(0)
 1592                                             END
 1593                                           ELSE
 1594                                             clsI := SymTab.ClassOf(it);
 1595                                             IF (it
 1596                                                # SymTab.InvalidType)
 1597                                                & (clsI # SymTab.ClInt)
 1598                                                & (clsI # SymTab.ClChar)
 1599                                                & (clsI # SymTab.ClEnum)
 1600                                                & (clsI
 1601                                                   # SymTab.ClBool) THEN
 1602                                               SemError(218);
 1603                                               t := SymTab.InvalidType;
 1604                                               MGen.Drop;
 1605                                               IF doLoad THEN
 1606                                                 MGen.Drop; MGen.PushInt(0)
 1607                                               END
 1608                                             ELSE
 1609                                               loA := SymTab.ArrayLo(t);
 1610                                               elemT := SymTab.ArrayElem(t);
 1611                                               esl := SymTab.TypeSlots(elemT);
 1612                                               IF esl = 0 THEN
 1613                                                 SemError(230);
 1614                                                 esl := 1
 1615                                               END;
 1616                                               IF (SymTab.ClassOf(elemT)
 1617                                                  = SymTab.ClChar)
 1618                                                  OR (SymTab.ClassOf(elemT)
 1619                                                     = SymTab.ClBool) THEN
 1620                                                 ebytes := 1
 1621                                               ELSE ebytes := esl * 8
 1622                                               END;
 1623                                               MGen.IdxScale(loA, ebytes);
 1624                                               t := elemT
 1625                                             END
 1626                                           END; .) }
 1627          "]"
 1628        | "^"                             (. firstT := ~sfx;
 1629                                             sfx := TRUE; lx[0] := 0C;
 1630                                             IF ~doLoad & firstT THEN
 1631                                               IF (k = SymTab.KindVar)
 1632                                                  OR (k = SymTab.KindParam)
 1633                                                  OR (k
 1634                                                      = SymTab.KindVarPar) THEN
 1635                                                 MGen.PushAddr(bn)
 1636                                               ELSIF k
 1637                                                 = SymTab.KindField THEN
 1638                                                 MGen.WithAddr(bn)
 1639                                               ELSE MGen.PushInt(0)
 1640                                               END
 1641                                             END; .)
 1642                                          (. IF t = SymTab.InvalidType THEN
 1643                                               IF doLoad THEN
 1644                                                 MGen.Drop; MGen.PushInt(0)
 1645                                               ELSIF firstT THEN
 1646                                                 MGen.Drop
 1647                                               END
 1648                                             ELSIF SymTab.ClassOf(t) #
 1649                                                   SymTab.ClPtr THEN
 1650                                               SemError(219);
 1651                                               t := SymTab.InvalidType;
 1652                                               IF doLoad THEN
 1653                                                 MGen.Drop; MGen.PushInt(0)
 1654                                               ELSIF firstT THEN
 1655                                                 MGen.Drop
 1656                                               END
 1657                                             ELSE
 1658                                               elemT := SymTab.PtrBase(t);
 1659                                               t := elemT;
 1660                                               IF doLoad THEN
 1661                                                 IF ~(firstT
 1662                                                    & ((k
 1663                                                        = SymTab.KindVar)
 1664                                                    OR (k
 1665                                                        = SymTab.KindParam)
 1666                                                    OR (k
 1667                                                        = SymTab.KindVarPar)))
 1668                                                 THEN
 1669                                                   MGen.LoadIndir
 1670                                                 END
 1671                                               ELSE
 1672                                                 MGen.LoadIndir
 1673                                               END
 1674                                             END; .) } .
 1675    Expr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
 1676          VAR v: BOOLEAN; VAR vn: SymTab.Name>
 1677                                          (. VAR t2: SymTab.TypeIndex;
 1678                                               tc, op: INTEGER;
 1679                                               lx2: MGen.LitStr;
 1680                                               v2: BOOLEAN;
 1681                                               vn2: SymTab.Name;
 1682                                               r: BOOLEAN; .)
 1683      = SimExpr<t, lx, v, vn> [ Rel<op> SimExpr<t2, lx2, v2, vn2>
 1684        (. lx[0] := 0C; v := FALSE;
 1685           IF op = SymTab.OpIn THEN
 1686             IF SymTab.InCheck(t, t2) THEN
 1687               t := SymTab.BoolType();
 1688               MGen.BitIn
 1689             ELSE SemError(222);
 1690               t := SymTab.InvalidType;
 1691               MGen.Drop; MGen.Drop; MGen.PushInt(0)
 1692             END
 1693           ELSIF (t # SymTab.InvalidType)
 1694              & (t2 # SymTab.InvalidType)
 1695              & (SymTab.ClassOf(t) = SymTab.ClArray)
 1696              & (SymTab.ClassOf(t2) = SymTab.ClArray)
 1697              & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar)
 1698              & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar)
 1699              & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN
 1700             t := SymTab.BoolType();
 1701             MGen.PushBytes(SymTab.TypeSlots(t) * 8);
 1702             MGen.PushBytes(SymTab.TypeSlots(t2) * 8);
 1703             MGen.StrComp;
 1704             IF op = SymTab.OpEq THEN MGen.Or; MGen.Not
 1705             ELSIF (op = SymTab.OpNeq1)
 1706                   OR (op = SymTab.OpNeq2) THEN MGen.Or
 1707             ELSIF op = SymTab.OpLt THEN
 1708               MGen.Swap; MGen.Drop
 1709             ELSIF op = SymTab.OpLe THEN
 1710               MGen.Drop; MGen.Not
 1711             ELSIF op = SymTab.OpGt THEN
 1712               MGen.Drop
 1713             ELSE
 1714               MGen.Swap; MGen.Drop; MGen.Not
 1715             END
 1716           ELSIF (t # SymTab.InvalidType)
 1717              & (t2 # SymTab.InvalidType)
 1718              & ((SymTab.ClassOf(t) = SymTab.ClArray)
 1719                 OR (SymTab.ClassOf(t) = SymTab.ClRecord)
 1720                 OR (SymTab.ClassOf(t2) = SymTab.ClArray)
 1721                 OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN
 1722             SemError(213); t := SymTab.InvalidType;
 1723             MGen.Drop; MGen.Drop; MGen.PushInt(0)
 1724           ELSE
 1725             tc := SymTab.ClassOf(t);
 1726             IF SymTab.RelCheck(t, t2, op) THEN
 1727               t := SymTab.BoolType()
 1728             ELSE SemError(213); t := SymTab.InvalidType END;
 1729             IF t # SymTab.InvalidType THEN
 1730               r := tc = SymTab.ClReal;
 1731               IF r THEN
 1732                 IF op = SymTab.OpEq THEN MGen.RealEq
 1733                 ELSIF (op = SymTab.OpNeq1)
 1734                       OR (op = SymTab.OpNeq2) THEN MGen.RealNe
 1735                 ELSIF op = SymTab.OpLt THEN MGen.RealLt
 1736                 ELSIF op = SymTab.OpLe THEN MGen.RealLe
 1737                 ELSIF op = SymTab.OpGt THEN MGen.RealGt
 1738                 ELSE MGen.RealGe END
 1739               ELSE
 1740                 IF op = SymTab.OpEq THEN MGen.Eq
 1741                 ELSIF (op = SymTab.OpNeq1)
 1742                       OR (op = SymTab.OpNeq2) THEN MGen.Neq
 1743                 ELSIF op = SymTab.OpLt THEN MGen.ILt
 1744                 ELSIF op = SymTab.OpLe THEN MGen.ILe
 1745                 ELSIF op = SymTab.OpGt THEN MGen.IGt
 1746                 ELSE MGen.IGe END
 1747               END
 1748             ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0)
 1749             END
 1750           END; .) ] .
 1751    Rel <VAR op: INTEGER>
 1752      = "="                     (. op := SymTab.OpEq; .)
 1753      | "#"                     (. op := SymTab.OpNeq1; .)
 1754      | "<>"                    (. op := SymTab.OpNeq2; .)
 1755      | "<"                     (. op := SymTab.OpLt; .)
 1756      | "<="                    (. op := SymTab.OpLe; .)
 1757      | ">"                     (. op := SymTab.OpGt; .)
 1758      | ">="                    (. op := SymTab.OpGe; .)
 1759      | "IN"                    (. op := SymTab.OpIn; .) .
 1760    SimExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
 1761             VAR v: BOOLEAN; VAR vn: SymTab.Name>
 1762                                          (. VAR t2, res2: SymTab.TypeIndex;
 1763                                               op: INTEGER;
 1764                                               lx2: MGen.LitStr;
 1765                                               v2: BOOLEAN;
 1766                                               vn2: SymTab.Name;
 1767                                               neg, isR: BOOLEAN; .)
 1768      =                                   (. neg := FALSE; .)
 1769        [ "+" | "-"                       (. neg := TRUE; .) ]
 1770        Term<t, lx, v, vn>                (. IF neg THEN
 1771                                             v := FALSE;
 1772                                             IF MGen.IsLit(lx) THEN
 1773                                               MGen.NegFold(lx, lx)
 1774                                             ELSE lx[0] := 0C
 1775                                             END;
 1776                                             IF SymTab.ClassOf(t)
 1777                                                = SymTab.ClReal THEN
 1778                                               MGen.NegReal
 1779                                             ELSE MGen.NegInt
 1780                                             END
 1781                                           END; .)
 1782        { AddOp<op> Term<t2, lx2, v2, vn2>
 1783        (. lx[0] := 0C; v := FALSE;
 1784           IF op = SymTab.OpOr THEN
 1785             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
 1786               t := SymTab.BoolType()
 1787             ELSE SemError(212); t := SymTab.InvalidType END;
 1788             MGen.Or
 1789           ELSIF (t # SymTab.InvalidType)
 1790              & (t2 # SymTab.InvalidType)
 1791              & (SymTab.ClassOf(t) = SymTab.ClSet)
 1792              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
 1793             IF op = SymTab.OpAdd THEN
 1794               MGen.Or
 1795             ELSE
 1796               MGen.PushBits(0FFFFFFFFFFFFFFFFH);
 1797               MGen.BitXor;
 1798               MGen.And
 1799             END
 1800           ELSE
 1801             IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
 1802             ELSE SemError(211); t := SymTab.InvalidType END;
 1803             isR := (t # SymTab.InvalidType)
 1804                    & (SymTab.ClassOf(t) = SymTab.ClReal);
 1805             IF op = SymTab.OpAdd THEN
 1806               IF isR THEN MGen.RealAdd ELSE MGen.Add END
 1807             ELSE
 1808               IF isR THEN MGen.RealSub ELSE MGen.Sub END
 1809             END
 1810           END; .) } .
 1811    AddOp <VAR op: INTEGER>
 1812      = "+"                     (. op := SymTab.OpAdd; .)
 1813      | "-"                     (. op := SymTab.OpSub; .)
 1814      | "OR"                    (. op := SymTab.OpOr; .) .
 1815    Term <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
 1816          VAR v: BOOLEAN; VAR vn: SymTab.Name>
 1817                                          (. VAR t2, res2: SymTab.TypeIndex;
 1818                                               op: INTEGER;
 1819                                               lx2: MGen.LitStr;
 1820                                               v2: BOOLEAN;
 1821                                               vn2: SymTab.Name;
 1822                                               isR: BOOLEAN;
 1823                                               mt: INTEGER; .)
 1824      = Fact<t, lx, v, vn> { MulOp<op> Fact<t2, lx2, v2, vn2>
 1825        (. lx[0] := 0C; v := FALSE;
 1826           IF op = SymTab.OpAnd THEN
 1827             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
 1828               t := SymTab.BoolType()
 1829             ELSE SemError(212); t := SymTab.InvalidType END;
 1830             MGen.And
 1831           ELSIF (op = SymTab.OpTimes)
 1832              & (t # SymTab.InvalidType)
 1833              & (t2 # SymTab.InvalidType)
 1834              & (SymTab.ClassOf(t) = SymTab.ClSet)
 1835              & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
 1836             MGen.And
 1837           ELSE
 1838             IF SymTab.ArithCheck(t, t2,
 1839                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
 1840                  res2) THEN t := res2
 1841             ELSE SemError(211); t := SymTab.InvalidType END;
 1842             isR := (t # SymTab.InvalidType)
 1843                    & (SymTab.ClassOf(t) = SymTab.ClReal);
 1844             IF op = SymTab.OpTimes THEN
 1845               IF isR THEN MGen.RealMul ELSE MGen.MulU END
 1846             ELSIF op = SymTab.OpSlash THEN
 1847               IF isR THEN MGen.RealDiv ELSE MGen.DivI END
 1848             ELSIF op = SymTab.OpDiv THEN
 1849               MGen.DivI
 1850             ELSE
 1851               mt := MGen.TempGlobal();
 1852               MGen.ModI(mt)
 1853             END
 1854           END; .) } .
 1855    MulOp <VAR op: INTEGER>
 1856      = "*"                     (. op := SymTab.OpTimes; .)
 1857      | "/"                     (. op := SymTab.OpSlash; .)
 1858      | "DIV"                   (. op := SymTab.OpDiv; .)
 1859      | "MOD"                   (. op := SymTab.OpMod; .)
 1860      | "AND"                   (. op := SymTab.OpAnd; .)
 1861      | "&"                     (. op := SymTab.OpAnd; .) .
 1862    Fact <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
 1863          VAR v: BOOLEAN; VAR vn: SymTab.Name>
 1864                                          (. VAR s: ARRAY [0 .. 255] OF CHAR;
 1865                                               t2, et, dt, st: SymTab.TypeIndex;
 1866                                               dk: INTEGER;
 1867                                               bnF: SymTab.Name;
 1868                                               lxD, lx2: MGen.LitStr;
 1869                                               v2: BOOLEAN;
 1870                                               vn2: SymTab.Name;
 1871                                               vi: INTEGER;
 1872                                               c: CARDINAL;
 1873                                               b: LONGCARD;
 1874                                               sfxF: BOOLEAN;
 1875                                               okF: BOOLEAN; .)
 1876      = integer                         (. LexString(s);
 1877                                           MGen.CopyName(s, lx);
 1878                                           v := FALSE;
 1879                                           IF MGen.ParseInt(s, vi) THEN
 1880                                             MGen.PushInt(vi)
 1881                                           ELSIF MGen.ParseCard(s, c) THEN
 1882                                             MGen.PushBits(
 1883                                               VAL(LONGCARD, c))
 1884                                           ELSE MGen.PushInt(0)
 1885                                           END;
 1886                                           t := SymTab.IntType(); .)
 1887      | real                            (. LexString(s);
 1888                                           MGen.CopyName(s, lx);
 1889                                           v := FALSE;
 1890                                           IF MGen.ParseReal(s, b) THEN
 1891                                             MGen.PushBits(b)
 1892                                           ELSE MGen.PushBits(0H)
 1893                                           END;
 1894                                           t := SymTab.RealType(); .)
 1895      | string                          (. LexString(s);
 1896                                           v := FALSE;
 1897                                           IF SymTab.StrLen(s) <= 3 THEN
 1898                                             t := SymTab.CharType();
 1899                                             MGen.CopyName(s, lx);
 1900                                             MGen.PushInt(
 1901                                               MGen.CharOrd(s))
 1902                                           ELSE t := SymTab.NewStr();
 1903                                             MGen.CopyName(s, lx);
 1904                                             MGen.EmitString(s)
 1905                                           END; .)
 1906      | "HIGH"
 1907        "(" DesignHead<dt, dk, bnF, FALSE, lxD>
 1908            DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
 1909        ")"                               (. lx[0] := 0C; v := FALSE;
 1910                                             IF dt = SymTab.InvalidType THEN
 1911                                               IF sfxF THEN MGen.Drop END;
 1912                                               MGen.PushInt(0);
 1913                                               t := SymTab.InvalidType
 1914                                             ELSIF SymTab.ClassOf(dt)
 1915                                                    # SymTab.ClArray THEN
 1916                                               SemError(217);
 1917                                               IF sfxF THEN MGen.Drop END;
 1918                                               MGen.PushInt(0);
 1919                                               t := SymTab.InvalidType
 1920                                             ELSIF SymTab.IsOpen(dt) THEN
 1921                                               IF sfxF THEN MGen.Drop END;
 1922                                               IF (dk = SymTab.KindParam)
 1923                                                  OR (dk
 1924                                                   = SymTab.KindVarPar) THEN
 1925                                                 IF SymTab.CurDepth()
 1926                                                    = SymTab.SymDepth(bnF) THEN
 1927                                                   MGen.LoadLocal(
 1928                                                     SymTab.SymSlot(bnF) + 1)
 1929                                                 ELSE
 1930                                                   MGen.FrameAddr(
 1931                                                     SymTab.SymSlot(bnF) + 1,
 1932                                                     VAL(CARDINAL,
 1933                                                       SymTab.CurDepth() - 1
 1934                                                       - SymTab.SymDepth(bnF)));
 1935                                                   MGen.LoadIndir
 1936                                                 END;
 1937                                                 MGen.PushInt(1);
 1938                                                 MGen.Sub;
 1939                                                 t := SymTab.IntType()
 1940                                               ELSE
 1941                                                 MGen.PushInt(0);
 1942                                                 t := SymTab.InvalidType
 1943                                               END
 1944                                             ELSE
 1945                                               IF sfxF THEN MGen.Drop END;
 1946                                               MGen.PushInt(
 1947                                                 SymTab.ArrayHi(dt));
 1948                                               t := SymTab.IntType()
 1949                                             END; .)
 1950      | DesignHead<dt, dk, bnF, TRUE, lxD>
 1951        DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
 1952                                          (. t := dt;
 1953                                             MGen.CopyName(lxD, lx);
 1954                                             IF sfxF
 1955                                                & (t # SymTab.InvalidType)
 1956                                                & (SymTab.ClassOf(t)
 1957                                                   # SymTab.ClArray)
 1958                                                & (SymTab.ClassOf(t)
 1959                                                   # SymTab.ClRecord) THEN
 1960                                               IF (SymTab.ClassOf(t)
 1961                                                  = SymTab.ClChar)
 1962                                                  OR (SymTab.ClassOf(t)
 1963                                                     = SymTab.ClBool) THEN
 1964                                                 MGen.LoadByte
 1965                                               ELSE MGen.LoadIndir
 1966                                               END
 1967                                             END;
 1968                                             v := ~sfxF
 1969                                                  & ((dk = SymTab.KindVar)
 1970                                                  OR (dk = SymTab.KindParam)
 1971                                                  OR (dk
 1972                                                      = SymTab.KindVarPar));
 1973                                             MGen.CopyName(bnF, vn); .)
 1974        [ CallTail<bnF, lxD, sfxF, TRUE, okF, TRUE>
 1975                                          (. IF okF THEN
 1976                                               IF SymTab.SymKind(bnF)
 1977                                                  = SymTab.KindProc THEN
 1978                                                 t := SymTab.ProcRet(bnF)
 1979                                               ELSIF (SymTab.SymKind(bnF)
 1980                                                         = SymTab.KindModule)
 1981                                                  & sfxF
 1982                                                  & (SymTab.StrLen(lxD) > 0)
 1983                                                  & (SymTab.ExpProc(bnF,
 1984                                                       lxD) >= 0) THEN
 1985                                                 t := SymTab.ProcRetByNum(
 1986                                                        SymTab.ExpProc(bnF,
 1987                                                          lxD))
 1988                                               ELSE
 1989                                                 t := SymTab.InvalidType
 1990                                               END
 1991                                             ELSE t := SymTab.InvalidType
 1992                                             END;
 1993                                             lx[0] := 0C; v := FALSE; .) ]
 1994      | "("
 1995        Expr<et, lx, v, vn> ")"         (. t := et; .)
 1996      | ( "NOT" | "~" )
 1997        Fact<t2, lx2, v2, vn2>          (. lx[0] := 0C; v := FALSE;
 1998                                           IF SymTab.BoolCheck(t2) THEN
 1999                                             t := SymTab.BoolType()
 2000                                           ELSE SemError(212);
 2001                                             t := SymTab.InvalidType END;
 2002                                           MGen.Not; .)
 2003      | SetLit<st>                      (. lx[0] := 0C; v := FALSE;
 2004                                           t := st; .) .
 2005    SetLit <VAR t: SymTab.TypeIndex>
 2006                                          (. VAR first, et: SymTab.TypeIndex;
 2007                                               lxE, lxE2: MGen.LitStr;
 2008                                               vE, vE2: BOOLEAN;
 2009                                               vnE, vnE2: SymTab.Name;
 2010                                               hasR: BOOLEAN; .)
 2011      = "{"
 2012                                  (. MGen.PushInt(0);
 2013                                     t := SymTab.SetFor(SymTab.IntType()); .)
 2014        [ Elem<et, lxE, lxE2, hasR>   (. first := et;
 2015                                         t := SymTab.SetFor(et);
 2016                                         IF hasR THEN
 2017                                           MGen.PushInt(1); MGen.Add;
 2018                                           MGen.FieldMask
 2019                                         ELSE MGen.Power2 END;
 2020                                         MGen.Or; .)
 2021          { ","
 2022            Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
 2023                                         SemError(222) END;
 2024                                         IF hasR THEN
 2025                                           MGen.PushInt(1); MGen.Add;
 2026                                           MGen.FieldMask
 2027                                         ELSE MGen.Power2 END;
 2028                                         MGen.Or; .) } ]
 2029        "}" .
 2030    Elem <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
 2031          VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN>
 2032                                          (. VAR t2: SymTab.TypeIndex;
 2033                                               vD, vD2: BOOLEAN;
 2034                                               vnD, vnD2: SymTab.Name; .)
 2035      = Expr<t, lx, vD, vnD>              (. hasR := FALSE;
 2036                                             lx2[0] := 0C; .)
 2037        [ ".."
 2038          Expr<t2, lx2, vD2, vnD2>        (. IF ~SymTab.SetElemCheck(t, t2) THEN
 2039                                             SemError(222) END;
 2040                                             hasR := TRUE; .) ] .
 2041  
 2042    GetIdent <VAR n: SymTab.Name>
 2043      = ident                           (. LexName(n); .) .
 2044  
 2045  END M2c.

    0 errors


Statistics:

  nr of terminals:        76 (limit   400)
  nr of non-terminals:    57 (limit   210)
  nr of pragmas:           0 (limit   424)
  nr of symbolnodes:     133 (limit   500)
  nr of graphnodes:      568 (limit  1500)
  nr of conditionsets:     7 (limit   100)
  nr of charactersets:     9 (limit   250)