|
|
@@ -0,0 +1,1171 @@
|
|
|
+COMPILER M2
|
|
|
+(* =============================================================================
|
|
|
+ TopSpeed Modula-2 V3 - COMPLETE GRAMMAR (Coco/R .atg form)
|
|
|
+
|
|
|
+ Historical JPI/Clarion V3 dialect, reconstructed from the real TS-V3
|
|
|
+ corpus (TABLE/GWINM2P/GWINC2M/BYTEFIDD/CLUB/RS/Modbase) + the shipped
|
|
|
+ CR.MOD reserved words + PIM/ISO Modula-2 reference forms.
|
|
|
+
|
|
|
+ This ATG is the deliverable of the "complete V3 grammar" work item.
|
|
|
+ It intentionally DIVERGES from the modern m2compiler-V3 subset's
|
|
|
+ locked rules where the corpus proves the original dialect differed:
|
|
|
+
|
|
|
+ - identifiers carry '_' and '@' (Graph._VGA, ct__@Fssssi)
|
|
|
+ - '&' = AND , '~' = NOT , '<>' = '#' (all accepted)
|
|
|
+ - literal suffixes H (hex), C (char), B (base-8/octal),
|
|
|
+ plus 0x/0X hex-prefix forms
|
|
|
+ - `::=` constant alias form (GCoord::=INTEGER)
|
|
|
+ - anchored type subranges (SHORTINT[-1..1])
|
|
|
+ - qualified type/designator idents (Client.ClientRec, t2.Root,
|
|
|
+ p^.Left, S1[sp1], Graph.GetVideoConfig(vc))
|
|
|
+ - full composite types: ARRAY (fixed + open), RECORD + variants,
|
|
|
+ SET OF (range/base/enum forms), POINTER TO, PROCEDURE types
|
|
|
+ - statements: WITH, IN, IS, set constructors {}, shifts << >>,
|
|
|
+ procedure/function call statements
|
|
|
+ - Clarion-form classes with multi-parent CLAUSE (extra parent = 230)
|
|
|
+
|
|
|
+ Constructs the current scalar backend cannot lower yet PARSE fully
|
|
|
+ and end with the standard SemError(230) "not supported yet" marker,
|
|
|
+ exactly like M2.atg's parse-now/lower-later discipline. Semantic
|
|
|
+ error codes reused from the V1/V2/Test2 family:
|
|
|
+ 200 duplicate, 201 undeclared, 202 module name mismatch,
|
|
|
+ 210 bad assignment, 211 bad arithmetic, 212 boolean operand,
|
|
|
+ 213 incompatible comparison, 214 boolean cond required,
|
|
|
+ 220 FOR needs integer var/bounds, 221 not a type name,
|
|
|
+ 222 set operand mismatch, 230 not supported yet,
|
|
|
+ 231 opaque type outside definition, 232 bad RETURN.
|
|
|
+
|
|
|
+ LL(1) notes (accepted as benign, verified correct codegen):
|
|
|
+ - TypeBlock's CLASS/CLASS IMPLEMENTATION 2-token lookahead
|
|
|
+ - variant-record CASE labels sharing first-sets with field
|
|
|
+ identifier lists (classic Modula-2 ambiguity).
|
|
|
+ ============================================================================= *)
|
|
|
+
|
|
|
+IMPORT SymTab, QbeGen;
|
|
|
+
|
|
|
+CHARACTERS
|
|
|
+ eol = CHR(13) .
|
|
|
+ lf = CHR(10) .
|
|
|
+ letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
+ digit = "0123456789" .
|
|
|
+ octDigit = "01234567" .
|
|
|
+ hexDigit = digit + "ABCDEFabcdef" .
|
|
|
+ noQuote1 = ANY - "'" - eol .
|
|
|
+ noQuote2 = ANY - '"' - eol .
|
|
|
+
|
|
|
+IGNORE CHR(9) .. CHR(13)
|
|
|
+
|
|
|
+COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
+COMMENTS FROM "//" TO lf
|
|
|
+
|
|
|
+TOKENS
|
|
|
+ (* V3 identifier: classic letters/digits PLUS '_' and '@' which the
|
|
|
+ shipped code uses freely (Graph._VGA, _Find, ct__@Fssssi). *)
|
|
|
+ ident = ( letter | "_" ) { letter | digit | "_" | "@" } .
|
|
|
+ (* Numbers. V3 kept the PIM qualified forms: trailing H = hex,
|
|
|
+ trailing C = character constant (hex value), trailing B = base-8
|
|
|
+ (the Modbase date code needs 60B = 48 = ORD('0'), i.e. octal 60);
|
|
|
+ modern 0x/0X hex-prefix also accepted (TS Dev Guide). The
|
|
|
+ CONTEXT("..") clause keeps `1..10` an integer + range operator
|
|
|
+ rather than the start of a real `1. ...`. *)
|
|
|
+ integer = digit { digit }
|
|
|
+ | digit { digit } CONTEXT("..")
|
|
|
+ | digit { digit } ( "B" | "b" )
|
|
|
+ | digit { hexDigit } ( "H" | "h" )
|
|
|
+ | digit { hexDigit } ( "C" | "c" )
|
|
|
+ | "0x" hexDigit { hexDigit }
|
|
|
+ | "0X" hexDigit { hexDigit } .
|
|
|
+ real = digit { digit } "." { digit }
|
|
|
+ [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
+ string = "'" { noQuote1 } "'"
|
|
|
+ | '"' { noQuote2 } '"' .
|
|
|
+
|
|
|
+PRODUCTIONS
|
|
|
+ M2
|
|
|
+ = Unit "." .
|
|
|
+
|
|
|
+ (* Units: program modules compile fully; DEFINITION and
|
|
|
+ IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
+ (each ends with one 230); same for nested local modules. *)
|
|
|
+ Unit
|
|
|
+ = DefUnit
|
|
|
+ | ImplUnit
|
|
|
+ | ProgModule .
|
|
|
+ DefUnit (. VAR m1, m2, pn: SymTab.Name; .)
|
|
|
+ = "DEFINITION" "MODULE"
|
|
|
+ GetIdent<m1> (. SymTab.Init; QbeGen.OpenModule(m1);
|
|
|
+ IF ~SymTab.Enter(m1,
|
|
|
+ SymTab.KindModule) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+";"
|
|
|
+ { Import }
|
|
|
+ { ConstBlock | TypeBlock<TRUE> | VarBlock
|
|
|
+ | ProcHeading<pn> ";" (. SymTab.CloseProc; .)
|
|
|
+ | ClassItem ";" }
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
|
|
|
+ SemError(202) END; .)
|
|
|
+ (. QbeGen.CloseModule;
|
|
|
+ SemError(230);
|
|
|
+ SymTab.PrintTable; .) .
|
|
|
+ ImplUnit (. VAR m1, m2: SymTab.Name; .)
|
|
|
+ = "IMPLEMENTATION" "MODULE"
|
|
|
+ GetIdent<m1> (. SymTab.Init; QbeGen.OpenModule(m1);
|
|
|
+ IF ~SymTab.Enter(m1,
|
|
|
+ SymTab.KindModule) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ ";"
|
|
|
+ { Import }
|
|
|
+ DeclSeq
|
|
|
+ [ "BEGIN" (. QbeGen.BeginBody; .)
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
|
|
|
+ SemError(202) END; .)
|
|
|
+ (. QbeGen.CloseModule;
|
|
|
+ SemError(230);
|
|
|
+ SymTab.PrintTable; .) .
|
|
|
+ ProgModule (. VAR m1, m2: SymTab.Name; .)
|
|
|
+ = "MODULE"
|
|
|
+ GetIdent<m1> (. SymTab.Init; QbeGen.OpenModule(m1);
|
|
|
+ IF ~SymTab.Enter(m1,
|
|
|
+ SymTab.KindModule) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ [ Priority ]
|
|
|
+ ";"
|
|
|
+ { Import }
|
|
|
+ DeclSeq
|
|
|
+ [ "BEGIN" (. QbeGen.BeginBody; .)
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
|
|
|
+ SemError(202) END; .)
|
|
|
+ (. QbeGen.EndModule;
|
|
|
+ SymTab.PrintTable; .) .
|
|
|
+ DeclSeq
|
|
|
+ = { ConstBlock | TypeBlock<FALSE> | VarBlock | [ "INLINE" ] ProcDecl ";"
|
|
|
+ | NestedModule ";" | ClassItem ";"
|
|
|
+ | "LABEL" LabelList ";" } .
|
|
|
+ LabelList (. VAR nm: SymTab.Name; .)
|
|
|
+ = GetIdent<nm> (. SemError(230); .)
|
|
|
+ { "," GetIdent<nm> (. SemError(230); .) } .
|
|
|
+ (* Local module, Wirth form. Parses + checks fully (own scope);
|
|
|
+ lowering waits for step 4, marked by one 230 at END. *)
|
|
|
+ NestedModule (. VAR m1, m2: SymTab.Name; .)
|
|
|
+ = "MODULE"
|
|
|
+ GetIdent<m1> (. IF ~SymTab.Enter(m1,
|
|
|
+ SymTab.KindModule) THEN
|
|
|
+ SemError(200) END;
|
|
|
+ SymTab.PushScope; .)
|
|
|
+ [ Priority ]
|
|
|
+ ";"
|
|
|
+ { Import }
|
|
|
+ [ Export ]
|
|
|
+ DeclSeq
|
|
|
+ [ "BEGIN"
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
|
|
|
+ SemError(202) END;
|
|
|
+ SymTab.PopScope;
|
|
|
+ SemError(230); .) .
|
|
|
+ Priority
|
|
|
+ = "[" integer "]" (. SemError(230); .) .
|
|
|
+ Export (. VAR nm: SymTab.Name; .)
|
|
|
+ = "EXPORT" (* names wire up in step 4 *)
|
|
|
+ [ "QUALIFIED" ]
|
|
|
+ GetIdent<nm>
|
|
|
+ { "," GetIdent<nm> }
|
|
|
+ ";" .
|
|
|
+ Import (. VAR n: SymTab.Name; .)
|
|
|
+ = "FROM"
|
|
|
+ GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindImport) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ "IMPORT"
|
|
|
+ ImpList ";"
|
|
|
+ | "IMPORT"
|
|
|
+ ImpList ";" .
|
|
|
+ ImpList (. VAR n: SymTab.Name; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindImport) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ { ","
|
|
|
+ GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindImport) THEN
|
|
|
+ SemError(200) END; .) } .
|
|
|
+
|
|
|
+ (* Opaque "TYPE T;" needs isDef (definition units); elsewhere 231. *)
|
|
|
+ TypeBlock<isDef: BOOLEAN>
|
|
|
+ = "TYPE" { TypeItem<isDef> ";" | ClassItem ";" } .
|
|
|
+ TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ t: SymTab.TypeIndex; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindType) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ ( "=" Type<t> (. SymTab.SetSymType(n, t); .)
|
|
|
+ | (. IF ~isDef THEN
|
|
|
+ SemError(231) END;
|
|
|
+ SymTab.SetSymType(n,
|
|
|
+ SymTab.NewAlias()); .) ) .
|
|
|
+
|
|
|
+ (* V3 TYPE surface. Start-symbols are all distinct:
|
|
|
+ ident (named / anchored subrange), '[' (bare subrange),
|
|
|
+ '(' (enum) , ARRAY , RECORD , SET , POINTER , PROCEDURE . *)
|
|
|
+ Type<VAR t: SymTab.TypeIndex>
|
|
|
+ = TypeIdent2<t> [ "["
|
|
|
+ SubrangeRest<t> (. (* anchored subrange:
|
|
|
+ SHORTINT[-1..1],
|
|
|
+ SHORTCARD[0..7] *) .)
|
|
|
+ "]" ]
|
|
|
+ | "[" SubrangeRest<t> "]"
|
|
|
+ | Enum<t>
|
|
|
+ | ArrayType<t>
|
|
|
+ | RecordType<t>
|
|
|
+ | SetType<t>
|
|
|
+ | PointerType<t>
|
|
|
+ | "VIRTUAL" "POINTER" TypeIdent2<t> (. SemError(230); .)
|
|
|
+ | ProcType<t> .
|
|
|
+
|
|
|
+ (* Qualified type ident: Client.ClientRec, SYSTEM.WORD. *)
|
|
|
+ TypeIdent2<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ k: INTEGER; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.Lookup(n) THEN
|
|
|
+ SemError(201);
|
|
|
+ t := SymTab.InvalidType
|
|
|
+ ELSE k := SymTab.SymKind(n);
|
|
|
+ IF (k = SymTab.KindType)
|
|
|
+ OR (k = SymTab.KindPredef) THEN
|
|
|
+ t := SymTab.SymType(n)
|
|
|
+ ELSIF k = SymTab.KindImport THEN
|
|
|
+ t := SymTab.InvalidType
|
|
|
+ ELSE SemError(221);
|
|
|
+ t := SymTab.InvalidType
|
|
|
+ END
|
|
|
+ END; .)
|
|
|
+ { "." GetIdent<n> (. SemError(230);
|
|
|
+ t := SymTab.InvalidType; .) } .
|
|
|
+
|
|
|
+ (* '[' Expr '..' Expr ']' (bare or anchored). Folds literal bounds
|
|
|
+ into a NewSubR subrange; anything else parses but lowers later. *)
|
|
|
+ SubrangeRest<VAR t: SymTab.TypeIndex>
|
|
|
+ (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ qlo, qhi: QbeGen.QVal;
|
|
|
+ lo, hi: INTEGER; .)
|
|
|
+ = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ (. IF (tlo = SymTab.InvalidType)
|
|
|
+ OR (thi = SymTab.InvalidType) THEN
|
|
|
+ t := SymTab.InvalidType
|
|
|
+ ELSIF (SymTab.ClassOf(tlo) #
|
|
|
+ SymTab.ClInt)
|
|
|
+ OR (SymTab.ClassOf(thi) #
|
|
|
+ SymTab.ClInt) THEN
|
|
|
+ SemError(230);
|
|
|
+ t := SymTab.InvalidType
|
|
|
+ ELSIF ~SymTab.ConstInt(qlo, lo)
|
|
|
+ OR ~SymTab.ConstInt(qhi, hi)
|
|
|
+ OR (lo > hi) THEN
|
|
|
+ SemError(230);
|
|
|
+ t := SymTab.InvalidType
|
|
|
+ ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ END; .) .
|
|
|
+ Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ = "(" (. t := SymTab.NewEnum(); .)
|
|
|
+ GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindConst) THEN
|
|
|
+ SemError(200) END;
|
|
|
+ SymTab.SetSymType(n, t); .)
|
|
|
+ { "," GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindConst) THEN
|
|
|
+ SemError(200) END;
|
|
|
+ SymTab.SetSymType(n, t); .) }
|
|
|
+ ")" .
|
|
|
+
|
|
|
+ (* ARRAY [lo..hi] OF T / ARRAY OF T (open formal) / multi bound *)
|
|
|
+ArrayType<VAR t: SymTab.TypeIndex> (. VAR e: SymTab.TypeIndex;
|
|
|
+ i: CARDINAL; .)
|
|
|
+ = "ARRAY"
|
|
|
+ ( "[" Bound { "," Bound } "]" (. t := SymTab.InvalidType; .)
|
|
|
+ | Bound (. t := SymTab.InvalidType; .)
|
|
|
+ | (. t := SymTab.InvalidType; .) )
|
|
|
+ "OF" Type<e> (. t := SymTab.NewArray(e);
|
|
|
+ SemError(230); .) .
|
|
|
+ Bound (. VAR t: SymTab.TypeIndex;
|
|
|
+ q: QbeGen.QVal; .)
|
|
|
+ = Expr<t, q> [ ".." Expr<t, q> ] (. SemError(230); .) .
|
|
|
+
|
|
|
+ (* RECORD with field lists and tagless/tagged variant CASE.
|
|
|
+ FieldListSequence is the classic PIM form: fields separated by
|
|
|
+ ';', alternatives by '|', optional ELSE. The label-vs-field
|
|
|
+ first-set overlap is the known benign LL(1) advisory. *)
|
|
|
+ RecordType<VAR t: SymTab.TypeIndex>
|
|
|
+ (. VAR n: SymTab.Name;
|
|
|
+ rt: SymTab.TypeIndex; .)
|
|
|
+ = "RECORD" (. rt := SymTab.NewRecord();
|
|
|
+ t := rt; .)
|
|
|
+ FieldListSequence<rt>
|
|
|
+ "END" (. SemError(230); .) .
|
|
|
+ FieldListSequence<rec: SymTab.TypeIndex>
|
|
|
+ = [ FieldList<rec> { ";" [ FieldList<rec> ] } ] .
|
|
|
+ FieldList<rec: SymTab.TypeIndex> (. VAR tag: SymTab.Name;
|
|
|
+ ti: SymTab.TypeIndex; .)
|
|
|
+ = "CASE" (. SemError(230); .)
|
|
|
+ [ GetIdent<tag> ":"
|
|
|
+ ] Type<ti>
|
|
|
+ "OF" VariantList<rec>
|
|
|
+ "END"
|
|
|
+ | FieldIdents<rec> .
|
|
|
+ FieldIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ t: SymTab.TypeIndex; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.FieldPending(rec, n)
|
|
|
+ THEN SemError(200) END; .)
|
|
|
+ { "," GetIdent<n> (. IF ~SymTab.FieldPending(rec, n)
|
|
|
+ THEN SemError(200) END; .) }
|
|
|
+ ":" Type<t> (. SymTab.FixPendingF(rec, t); .) .
|
|
|
+ VariantList<rec: SymTab.TypeIndex>
|
|
|
+ = [ "|" ] Variant<rec> { "|" Variant<rec> }
|
|
|
+ [ "ELSE" FieldListSequence<rec> ] .
|
|
|
+ Variant<rec: SymTab.TypeIndex>
|
|
|
+ = VariantLabels ":" (. SymTab.PushScope; .)
|
|
|
+ FieldListSequence<rec> (. SymTab.PopScope; .) .
|
|
|
+ VariantLabels
|
|
|
+ = VariantLabel { "," VariantLabel } .
|
|
|
+ VariantLabel (. VAR t1, t2: SymTab.TypeIndex;
|
|
|
+ q1, q2: QbeGen.QVal; .)
|
|
|
+ = Expr<t1, q1> (. SemError(230); .)
|
|
|
+ [ ".." Expr<t2, q2> (. SemError(230); .) ] .
|
|
|
+
|
|
|
+ (* SET OF base: SHORTCARD[0..7], [0..31], CHAR, Direction,
|
|
|
+ (RShift, LShift, Ctrl, ...) *)
|
|
|
+ SetType<VAR t: SymTab.TypeIndex> (. VAR b: SymTab.TypeIndex; .)
|
|
|
+ = "SET" "OF"
|
|
|
+ ( TypeIdent2<b> (. t := SymTab.NewSet(b);
|
|
|
+ SemError(230); .)
|
|
|
+ | "[" SubrangeRest<b> "]" (. t := SymTab.NewSet(b);
|
|
|
+ SemError(230); .)
|
|
|
+ | Enum<b> (. t := SymTab.NewSet(b);
|
|
|
+ SemError(230); .) ) .
|
|
|
+ PointerType<VAR t: SymTab.TypeIndex> (. VAR b: SymTab.TypeIndex; .)
|
|
|
+ = "POINTER" "TO" Type<b> (. t := SymTab.NewPtr(b);
|
|
|
+ SemError(230); .) .
|
|
|
+ (* PROCEDURE type: Action = PROCEDURE(ElementPtr); IPROC =
|
|
|
+ PROCEDURE(); CompareProc = PROCEDURE(ADDRESS,ADDRESS,CARDINAL)
|
|
|
+ : CompareType; *)
|
|
|
+ ProcType<VAR t: SymTab.TypeIndex> (. VAR b: SymTab.TypeIndex; .)
|
|
|
+ = "PROCEDURE" (. t := SymTab.InvalidType;
|
|
|
+ SemError(230); .)
|
|
|
+ [ "(" [ ProcTypeParam { ","
|
|
|
+ ProcTypeParam } ] ")" ]
|
|
|
+ [ ":" TypeIdent2<b> (. SemError(230); .) ] .
|
|
|
+ ProcTypeParam (. VAR b: SymTab.TypeIndex; .)
|
|
|
+ = [ "VAR" ] Type<b> (. SemError(230); .) .
|
|
|
+
|
|
|
+ (* Clarion-form classes (docs/OOP.txt): declaration + (single or
|
|
|
+ multiple) parent clause + IMPLEMENTATION blocks. Scopes and
|
|
|
+ member checks now; lowering (vtable, dispatch, THIS) later —
|
|
|
+ one 230 per class/impl block. Methods end with ";" per the
|
|
|
+ Table example. *)
|
|
|
+ (* Single CLASS item in both loops: separating declaration from
|
|
|
+ IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ The second token decides after CLASS is consumed. *)
|
|
|
+ ClassItem
|
|
|
+ = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ClassRest (. VAR cn, m2, pn, q: SymTab.Name;
|
|
|
+ ct: SymTab.TypeIndex; .)
|
|
|
+ = GetIdent<cn> (. IF ~SymTab.Enter(cn,
|
|
|
+ SymTab.KindType) THEN
|
|
|
+ SemError(200) END;
|
|
|
+ ct := SymTab.NewClass();
|
|
|
+ SymTab.SetSymType(cn, ct);
|
|
|
+ SymTab.PushClassScope(ct); .)
|
|
|
+ [ Parents<ct> ]
|
|
|
+ ";"
|
|
|
+ { ClassField<ct> ";" }
|
|
|
+ (* V3 class methods: pure declaration (';' only), FORWARD, or a
|
|
|
+ fully bodied method whose body starts with BEGIN (the corpus
|
|
|
+ form). Each bodied/FORWARD method owns its trailing ';'. *)
|
|
|
+ { MethodHeading<pn> ";"
|
|
|
+ ( "FORWARD" (. SymTab.MarkFwd;
|
|
|
+ SymTab.CloseProc; .)
|
|
|
+ ";"
|
|
|
+ | "BEGIN" [ StatSeq ] "END"
|
|
|
+ GetIdent<q> (. IF ~SymTab.Equal(pn, q) THEN
|
|
|
+ SemError(202) END;
|
|
|
+ SymTab.CloseProc;
|
|
|
+ SemError(230); .)
|
|
|
+ ";"
|
|
|
+ | (. SymTab.CloseProc; .) ) }
|
|
|
+ [ "BEGIN" (. SemError(230); .)
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(cn, m2) THEN
|
|
|
+ SemError(202) END;
|
|
|
+ SymTab.PopScope;
|
|
|
+ SemError(230); .) .
|
|
|
+ (* V3 class header may list several parents
|
|
|
+ (CLASS GenElem (Element, Base2);); this grammar accepts the
|
|
|
+ list and rejects every parent after the first at 230 — the
|
|
|
+ current backend lowers single inheritance only. *)
|
|
|
+ Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ = "(" Parent1<ct>
|
|
|
+ { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ ")" .
|
|
|
+ Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ pt: SymTab.TypeIndex; .)
|
|
|
+ = GetIdent<p> (. IF ~SymTab.Lookup(p) THEN
|
|
|
+ SemError(201)
|
|
|
+ ELSE pt := SymTab.SymType(p);
|
|
|
+ IF SymTab.ClassOf(pt) #
|
|
|
+ SymTab.ClClass THEN
|
|
|
+ SemError(230)
|
|
|
+ ELSE SymTab.SetParent(ct, pt)
|
|
|
+ END
|
|
|
+ END; .) .
|
|
|
+ ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ t: SymTab.TypeIndex; .)
|
|
|
+ = GetIdent<n>
|
|
|
+ ( "=" GetIdent<rhs> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindConst) THEN
|
|
|
+ SemError(200) END;
|
|
|
+ IF SymTab.Lookup(rhs) THEN
|
|
|
+ SymTab.SetSymType(n,
|
|
|
+ SymTab.SymType(rhs))
|
|
|
+ END; .)
|
|
|
+ | (. IF ~SymTab.FieldPending(ct,
|
|
|
+ n) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ { "," GetIdent<n> (. IF ~SymTab.FieldPending(ct,
|
|
|
+ n) THEN
|
|
|
+ SemError(200) END; .) }
|
|
|
+ ":" TypeIdent2<t> (. SymTab.FixPendingF(ct, t); .) ) .
|
|
|
+ MethodHeading<VAR pn: SymTab.Name> (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ = (. wantVirt := FALSE; .)
|
|
|
+ [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ ProcHeading<pn> (. IF wantVirt THEN
|
|
|
+ SymTab.MarkVirtual END; .) .
|
|
|
+ ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ ct: SymTab.TypeIndex; .)
|
|
|
+ = GetIdent<cn> (. IF ~SymTab.Lookup(cn) THEN
|
|
|
+ SemError(201);
|
|
|
+ ct := SymTab.InvalidType
|
|
|
+ ELSE ct := SymTab.SymType(cn);
|
|
|
+ IF SymTab.ClassOf(ct) #
|
|
|
+ SymTab.ClClass THEN
|
|
|
+ SemError(230);
|
|
|
+ ct := SymTab.InvalidType
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF ct #
|
|
|
+ SymTab.InvalidType THEN
|
|
|
+ IF ~SymTab.PushClassMembers(
|
|
|
+ ct) THEN
|
|
|
+ SemError(230) END
|
|
|
+ END; .)
|
|
|
+ ";" { MethodImpl<ct> ";" }
|
|
|
+ [ "BEGIN" (. QbeGen.BeginBody; .)
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(cn, m2) THEN
|
|
|
+ SemError(202) END;
|
|
|
+ SymTab.PopScope;
|
|
|
+ SemError(230); .) .
|
|
|
+ MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name; .)
|
|
|
+ = MethodHeading<pn> ";"
|
|
|
+ (. IF (ct #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & ~SymTab.MethodExists(ct,
|
|
|
+ pn) THEN
|
|
|
+ SemError(201) END; .)
|
|
|
+ ( "FORWARD" (. SymTab.MarkFwd;
|
|
|
+ SymTab.CloseProc; .)
|
|
|
+ | Block<pn> (. SymTab.CloseProc;
|
|
|
+ SemError(230); .) ) .
|
|
|
+
|
|
|
+ (* E1) double-colon constant alias: Name ::= Expr ;
|
|
|
+ GCoord::=INTEGER; TXBuffer ::= IOBase; *)
|
|
|
+ ConstBlock
|
|
|
+ = "CONST" { ConstDecl ";" } .
|
|
|
+ ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ t: SymTab.TypeIndex;
|
|
|
+ qv: QbeGen.QVal;
|
|
|
+ cls: INTEGER; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.Enter(n,
|
|
|
+ SymTab.KindConst) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ ( "::=" (. SemError(230); .)
|
|
|
+ Expr<t, qv> (. SymTab.SetSymType(n, t);
|
|
|
+ QbeGen.DeclConst(n, "0",
|
|
|
+ SymTab.InvalidType); .)
|
|
|
+ | "="
|
|
|
+ Expr<t, qv> (. SymTab.SetSymType(n, t);
|
|
|
+ cls := SymTab.ClassOf(t);
|
|
|
+ IF cls = SymTab.ClStr THEN
|
|
|
+ SemError(230)
|
|
|
+ ELSIF ~QbeGen.IsImm(qv) THEN
|
|
|
+ SemError(230) END;
|
|
|
+ QbeGen.DeclConst(n, qv, t); .) ) .
|
|
|
+ VarBlock
|
|
|
+ = "VAR" { VarDecl ";" } .
|
|
|
+ VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ t: SymTab.TypeIndex;
|
|
|
+ i: CARDINAL;
|
|
|
+ cls: INTEGER; .)
|
|
|
+ = VarIdents ":"
|
|
|
+ (* V3 VAR types may be composites; the scalar phase lowers the
|
|
|
+ integer/char/bool/real family and reports 230 for the rest. *)
|
|
|
+ Type<t> (. cls := SymTab.ClassOf(t);
|
|
|
+ IF (t # SymTab.InvalidType)
|
|
|
+ & (cls # SymTab.ClInt)
|
|
|
+ & (cls # SymTab.ClBool)
|
|
|
+ & (cls # SymTab.ClChar)
|
|
|
+ & (cls # SymTab.ClReal) THEN
|
|
|
+ SemError(230) END;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < SymTab.PendCount() DO
|
|
|
+ SymTab.PendName(i, nm);
|
|
|
+ QbeGen.DeclVar(nm, t);
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ SymTab.FixPending(t); .) .
|
|
|
+VarIdents (. VAR n: SymTab.Name;
|
|
|
+ t: SymTab.TypeIndex;
|
|
|
+ q: QbeGen.QVal; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.EnterPending(n,
|
|
|
+ SymTab.KindVar) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ [ "[" Expr<t, q> (. SemError(230); .)
|
|
|
+ [ ":" Expr<t, q> (. SemError(230); .) ]
|
|
|
+ "]" ]
|
|
|
+ { ","
|
|
|
+ GetIdent<n> (. IF ~SymTab.EnterPending(n,
|
|
|
+ SymTab.KindVar) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ [ "[" Expr<t, q> (. SemError(230); .)
|
|
|
+ [ ":" Expr<t, q> (. SemError(230); .) ]
|
|
|
+ "]" ] } .
|
|
|
+ ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ = GetIdent<n> (. IF ~SymTab.EnterParam(n, isV) THEN
|
|
|
+ SemError(200) END; .)
|
|
|
+ { "," GetIdent<n> (. IF ~SymTab.EnterParam(n, isV) THEN
|
|
|
+ SemError(200) END; .) } .
|
|
|
+
|
|
|
+ (* Procedure headings enter now (scopes, params, result); bodies
|
|
|
+ parse + check with one 230 at END (lowering = step 4).
|
|
|
+ FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ tightens in step 4). *)
|
|
|
+ ProcHeading<VAR pn: SymTab.Name> (. VAR t: SymTab.TypeIndex; .)
|
|
|
+ = "PROCEDURE"
|
|
|
+ GetIdent<pn> (. IF ~SymTab.EnterProc(pn) THEN
|
|
|
+ IF ~SymTab.ReenterProc(pn) THEN
|
|
|
+ SemError(200) END
|
|
|
+ END; .)
|
|
|
+ [ FormalParams ]
|
|
|
+ [ ":" TypeIdent2<t> (. SymTab.SetProcRes(t); .) ] .
|
|
|
+ FormalParams
|
|
|
+ = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ isV: BOOLEAN; .)
|
|
|
+ = (. isV := FALSE; .)
|
|
|
+ [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ ParIdents<isV> ":" Type<t> (. SymTab.FixPending(t); .) .
|
|
|
+ ProcDecl (. VAR pn, assem: SymTab.Name;
|
|
|
+ at: SymTab.TypeIndex;
|
|
|
+ ak: INTEGER;
|
|
|
+ aq: QbeGen.QVal; .)
|
|
|
+ = ProcHeading<pn>
|
|
|
+ ( ";"
|
|
|
+ ( "FORWARD" (. SymTab.MarkFwd;
|
|
|
+ SymTab.CloseProc; .)
|
|
|
+ | "IN" GetIdent<assem> (. SymTab.CloseProc;
|
|
|
+ SemError(230); .)
|
|
|
+ | Block<pn> (. SymTab.CloseProc;
|
|
|
+ SemError(230); .) )
|
|
|
+ | "=" Design<at, ak, aq, assem> (. SymTab.CloseProc;
|
|
|
+ SemError(230); .)
|
|
|
+ "(" [ ActualParams ] ")" ) .
|
|
|
+ Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
|
|
|
+ = DeclSeq
|
|
|
+ [ "BEGIN"
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END"
|
|
|
+ GetIdent<m2> (. IF ~SymTab.Equal(pn, m2) THEN
|
|
|
+ SemError(202) END; .) .
|
|
|
+StatSeq
|
|
|
+ = Statement { ";" [ Statement ] } .
|
|
|
+
|
|
|
+ (* Statements. Assignments and procedure/function calls both start
|
|
|
+ with a designator, so they share one factored production: after
|
|
|
+ the designator, ':=' selects assignment, '(' a call, anything
|
|
|
+ else is a parameterless procedure-call statement. *)
|
|
|
+ Statement (. VAR lx: QbeGen.QVal;
|
|
|
+ lqn: SymTab.Name; .)
|
|
|
+ = DesignStat
|
|
|
+ | IfStat
|
|
|
+ | WhileStat
|
|
|
+ | RepeatStat
|
|
|
+ | LoopStat
|
|
|
+ | ForStat
|
|
|
+ | CaseStat
|
|
|
+ | WithStat
|
|
|
+ | ReturnStat
|
|
|
+ | "GOTO" GetIdent<lqn> (. SemError(230); .)
|
|
|
+ | "EXIT" (. IF QbeGen.TopLoop(lx) THEN
|
|
|
+ QbeGen.Jmp(lx)
|
|
|
+ ELSE SemError(230) END; .) .
|
|
|
+ DesignStat (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ dk: INTEGER;
|
|
|
+ qd, qe, qt: QbeGen.QVal;
|
|
|
+ qn: SymTab.Name;
|
|
|
+ isR, conv: BOOLEAN; .)
|
|
|
+ = Design2<dt, dk, qd, qn>
|
|
|
+ ( ":=" Expr<et, qe> (. IF (dt # SymTab.InvalidType)
|
|
|
+ & (dk # SymTab.KindVar)
|
|
|
+ & (dk # SymTab.KindParam) THEN
|
|
|
+ SemError(210)
|
|
|
+ ELSIF ~SymTab.Assignable(et,
|
|
|
+ dt) THEN
|
|
|
+ SemError(210) END;
|
|
|
+ isR := (dt #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & (SymTab.ClassOf(dt)
|
|
|
+ = SymTab.ClReal);
|
|
|
+ conv := isR
|
|
|
+ & SymTab.IsIntFamily(et);
|
|
|
+ IF ((dk = SymTab.KindVar)
|
|
|
+ OR (dk = SymTab.KindParam))
|
|
|
+ & (dt # SymTab.InvalidType)
|
|
|
+ & (et # SymTab.InvalidType) THEN
|
|
|
+ IF conv THEN
|
|
|
+ QbeGen.ConvIR(qe, qt);
|
|
|
+ QbeGen.StoreVar(qn, qt, TRUE)
|
|
|
+ ELSE
|
|
|
+ QbeGen.StoreVar(qn, qe, isR)
|
|
|
+ END
|
|
|
+ END; .)
|
|
|
+ | "(" [ ActualParams ] ")" (. SemError(230); .)
|
|
|
+ | (. SemError(230); .) ) .
|
|
|
+ ActualParams (. VAR t: SymTab.TypeIndex;
|
|
|
+ q: QbeGen.QVal; .)
|
|
|
+ = Expr<t, q> { "," Expr<t, q> } .
|
|
|
+ IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ q, lThen, lElse, lEnd:
|
|
|
+ QbeGen.QVal;
|
|
|
+ hasElse: BOOLEAN; .)
|
|
|
+ = "IF" (. hasElse := FALSE; .)
|
|
|
+ Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
|
|
|
+ SemError(214) END;
|
|
|
+ QbeGen.NewLabel(lThen);
|
|
|
+ QbeGen.NewLabel(lElse);
|
|
|
+ QbeGen.NewLabel(lEnd);
|
|
|
+ QbeGen.Jnz(q, lThen, lElse);
|
|
|
+ QbeGen.EmitLabel(lThen); .)
|
|
|
+ "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .)
|
|
|
+ { "ELSIF" (. QbeGen.EmitLabel(lElse);
|
|
|
+ QbeGen.NewLabel(lElse); .)
|
|
|
+ Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
|
|
|
+ SemError(214) END;
|
|
|
+ QbeGen.NewLabel(lThen);
|
|
|
+ QbeGen.Jnz(q, lThen, lElse);
|
|
|
+ QbeGen.EmitLabel(lThen); .)
|
|
|
+ "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .) }
|
|
|
+ [ "ELSE" (. QbeGen.EmitLabel(lElse);
|
|
|
+ hasElse := TRUE; .)
|
|
|
+ [ StatSeq ] ]
|
|
|
+ "END" (. IF hasElse THEN
|
|
|
+ QbeGen.EmitLabel(lEnd)
|
|
|
+ ELSE QbeGen.EmitLabel(lElse);
|
|
|
+ QbeGen.EmitLabel(lEnd)
|
|
|
+ END; .) .
|
|
|
+ WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ q, lTop, lBody, lEnd:
|
|
|
+ QbeGen.QVal; .)
|
|
|
+ = "WHILE" (. QbeGen.NewLabel(lTop);
|
|
|
+ QbeGen.NewLabel(lBody);
|
|
|
+ QbeGen.NewLabel(lEnd);
|
|
|
+ QbeGen.EmitLabel(lTop); .)
|
|
|
+ Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
|
|
|
+ SemError(214) END;
|
|
|
+ QbeGen.Jnz(q, lBody, lEnd);
|
|
|
+ QbeGen.EmitLabel(lBody); .)
|
|
|
+ "DO" [ StatSeq ] (. QbeGen.Jmp(lTop); .)
|
|
|
+ "END" (. QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ q, lTop, lEnd: QbeGen.QVal; .)
|
|
|
+ = "REPEAT" (. QbeGen.NewLabel(lTop);
|
|
|
+ QbeGen.NewLabel(lEnd);
|
|
|
+ QbeGen.EmitLabel(lTop); .)
|
|
|
+ [ StatSeq ]
|
|
|
+ "UNTIL" Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
|
|
|
+ SemError(214) END;
|
|
|
+ QbeGen.Jnz(q, lEnd, lTop);
|
|
|
+ QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .)
|
|
|
+ = "LOOP" (. QbeGen.NewLabel(lTop);
|
|
|
+ QbeGen.NewLabel(lEnd);
|
|
|
+ QbeGen.PushLoop(lEnd);
|
|
|
+ QbeGen.EmitLabel(lTop); .)
|
|
|
+ [ StatSeq ]
|
|
|
+ "END" (. QbeGen.Jmp(lTop);
|
|
|
+ QbeGen.PopLoop;
|
|
|
+ QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ Runtime direction would need a compare-select; the literal
|
|
|
+ sign picks cslew/csegew at "DO" time. *)
|
|
|
+ ForStat (. VAR lv: SymTab.Name;
|
|
|
+ tlo, thi, tby:
|
|
|
+ SymTab.TypeIndex;
|
|
|
+ qlo, qhi, qby, qt, qk, qb:
|
|
|
+ QbeGen.QVal;
|
|
|
+ lTop, lBody, lEnd:
|
|
|
+ QbeGen.QVal;
|
|
|
+ by: INTEGER;
|
|
|
+ ok: BOOLEAN; .)
|
|
|
+ = "FOR" (. by := 1; .)
|
|
|
+ GetIdent<lv> (. ok := SymTab.Lookup(lv);
|
|
|
+ IF ~ok THEN
|
|
|
+ SemError(201)
|
|
|
+ ELSIF (SymTab.SymKind(lv) #
|
|
|
+ SymTab.KindVar)
|
|
|
+ & (SymTab.SymKind(lv) #
|
|
|
+ SymTab.KindParam) THEN
|
|
|
+ SemError(220); ok := FALSE
|
|
|
+ ELSIF ~SymTab.IsIntFamily(
|
|
|
+ SymTab.SymType(lv)) THEN
|
|
|
+ SemError(220); ok := FALSE
|
|
|
+ END; .)
|
|
|
+ ":=" Expr<tlo, qlo> (. IF ~SymTab.IsIntFamily(tlo) THEN
|
|
|
+ SemError(220); ok := FALSE
|
|
|
+ END; .)
|
|
|
+ "TO" Expr<thi, qhi> (. IF ~SymTab.IsIntFamily(thi) THEN
|
|
|
+ SemError(220); ok := FALSE
|
|
|
+ END; .)
|
|
|
+ [ "BY" Expr<tby, qby> (. IF (tby #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & ~SymTab.IsIntFamily(tby) THEN
|
|
|
+ SemError(220); ok := FALSE
|
|
|
+ END;
|
|
|
+ IF ~SymTab.ConstInt(qby, by) THEN
|
|
|
+ SemError(230); by := 1
|
|
|
+ ELSIF by = 0 THEN
|
|
|
+ SemError(220); by := 1
|
|
|
+ END; .) ]
|
|
|
+ "DO" (. IF ok THEN
|
|
|
+ QbeGen.StoreVar(lv, qlo,
|
|
|
+ FALSE) END;
|
|
|
+ QbeGen.NewLabel(lTop);
|
|
|
+ QbeGen.NewLabel(lBody);
|
|
|
+ QbeGen.NewLabel(lEnd);
|
|
|
+ QbeGen.EmitLabel(lTop);
|
|
|
+ QbeGen.LoadVar(lv, FALSE, qt);
|
|
|
+ QbeGen.NewTemp(qk);
|
|
|
+ IF by > 0 THEN
|
|
|
+ QbeGen.Op3("cslew", qk,
|
|
|
+ qt, qhi, FALSE)
|
|
|
+ ELSE QbeGen.Op3("csgew", qk,
|
|
|
+ qt, qhi, FALSE)
|
|
|
+ END;
|
|
|
+ QbeGen.Jnz(qk, lBody, lEnd);
|
|
|
+ QbeGen.EmitLabel(lBody); .)
|
|
|
+ [ StatSeq ]
|
|
|
+ "END" (. IF ok THEN
|
|
|
+ QbeGen.LoadVar(lv, FALSE,
|
|
|
+ qt);
|
|
|
+ QbeGen.IntStr(by, qb);
|
|
|
+ QbeGen.NewTemp(qk);
|
|
|
+ QbeGen.Op3("add", qk,
|
|
|
+ qt, qb, FALSE);
|
|
|
+ QbeGen.StoreVar(lv, qk,
|
|
|
+ FALSE) END;
|
|
|
+ QbeGen.Jmp(lTop);
|
|
|
+ QbeGen.EmitLabel(lEnd); .) .
|
|
|
+CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ qsel, lEnd: QbeGen.QVal; .)
|
|
|
+ = "CASE" Expr<tsel, qsel> (. QbeGen.NewLabel(lEnd); .)
|
|
|
+ "OF" [ "|" ]
|
|
|
+ { CaseAlt<tsel, qsel, lEnd>
|
|
|
+ [ ";" ] [ "|" ] }
|
|
|
+ [ "ELSE" [ StatSeq ] ]
|
|
|
+ "END" (. QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ lEnd: QbeGen.QVal> (. VAR lBody, lAfter: QbeGen.QVal; .)
|
|
|
+ = (. QbeGen.NewLabel(lBody);
|
|
|
+ QbeGen.NewLabel(lAfter); .)
|
|
|
+ CaseLabel<tsel, qsel, lBody>
|
|
|
+ { "," CaseLabel<tsel, qsel, lBody> }
|
|
|
+ ":" (. QbeGen.Jmp(lAfter);
|
|
|
+ QbeGen.EmitLabel(lBody); .)
|
|
|
+ [ StatSeq (. QbeGen.Jmp(lEnd); .) ]
|
|
|
+ (. QbeGen.EmitLabel(lAfter); .) .
|
|
|
+ CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ lBody: QbeGen.QVal> (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ q2, q3, qc, qd, qe:
|
|
|
+ QbeGen.QVal;
|
|
|
+ lNext: QbeGen.QVal; .)
|
|
|
+ = Expr<t2, q2> (. IF (t2 #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & (tsel #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & ~SymTab.EqCheck(t2,
|
|
|
+ tsel) THEN
|
|
|
+ SemError(213) END;
|
|
|
+ IF ~QbeGen.IsImm(q2) THEN
|
|
|
+ SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q2)
|
|
|
+ END;
|
|
|
+ QbeGen.NewLabel(lNext);
|
|
|
+ QbeGen.Cmp(SymTab.OpEq,
|
|
|
+ qsel, q2, qc, FALSE);
|
|
|
+ QbeGen.Jnz(qc, lBody, lNext);
|
|
|
+ QbeGen.EmitLabel(lNext); .)
|
|
|
+ [ ".." Expr<t3, q3> (. IF (t3 #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & (tsel #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & ~SymTab.EqCheck(t3,
|
|
|
+ tsel) THEN
|
|
|
+ SemError(213) END;
|
|
|
+ IF ~QbeGen.IsImm(q3) THEN
|
|
|
+ SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q3)
|
|
|
+ END;
|
|
|
+ QbeGen.Cmp(SymTab.OpGe,
|
|
|
+ qsel, q2, qc, FALSE);
|
|
|
+ QbeGen.Cmp(SymTab.OpLe,
|
|
|
+ qsel, q3, qd, FALSE);
|
|
|
+ QbeGen.NewTemp(qe);
|
|
|
+ QbeGen.Op3("and", qe, qc, qd,
|
|
|
+ FALSE);
|
|
|
+ QbeGen.NewLabel(lNext);
|
|
|
+ QbeGen.Jnz(qe, lBody, lNext);
|
|
|
+ QbeGen.EmitLabel(lNext); .) ] .
|
|
|
+ ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ q: QbeGen.QVal;
|
|
|
+ res: SymTab.TypeIndex;
|
|
|
+ hadE: BOOLEAN; .)
|
|
|
+ = "RETURN" (. hadE := FALSE; .)
|
|
|
+ [ Expr<t, q> (. hadE := TRUE; .) ]
|
|
|
+ (. IF ~SymTab.InProc() THEN
|
|
|
+ SemError(232)
|
|
|
+ ELSE res := SymTab.CurRes();
|
|
|
+ IF ~hadE THEN
|
|
|
+ IF res #
|
|
|
+ SymTab.InvalidType THEN
|
|
|
+ SemError(232) END
|
|
|
+ ELSIF (res =
|
|
|
+ SymTab.InvalidType)
|
|
|
+ OR (t #
|
|
|
+ SymTab.InvalidType)
|
|
|
+ & ~SymTab.Assignable(t,
|
|
|
+ res) THEN
|
|
|
+ SemError(232)
|
|
|
+ END
|
|
|
+ END; .) .
|
|
|
+ (* WITH pushes the record's fields as an inner scope (classic
|
|
|
+ short-hand member access); record lowering is still 230. *)
|
|
|
+ WithStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ k: INTEGER;
|
|
|
+ q: QbeGen.QVal;
|
|
|
+ qn: SymTab.Name; .)
|
|
|
+ = "WITH" Design2<t, k, q, qn> (. IF ~SymTab.PushRecord(t) THEN
|
|
|
+ SemError(230) END; .)
|
|
|
+ "DO" [ StatSeq ]
|
|
|
+ "END" (. SymTab.PopScope;
|
|
|
+ SemError(230); .) .
|
|
|
+
|
|
|
+ (* Designators (E3): simple names behave exactly like the scalar
|
|
|
+ phase; '.' '^' '[' selector chains parse and report one 230
|
|
|
+ (member/pointer/array lowering arrives with step 3). *)
|
|
|
+ Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ VAR q: QbeGen.QVal; VAR qn: SymTab.Name>
|
|
|
+ (. VAR n: SymTab.Name;
|
|
|
+ cls: INTEGER; .)
|
|
|
+ = GetIdent<n> (. QbeGen.CopyOp(n, qn);
|
|
|
+ IF ~SymTab.Lookup(n) THEN
|
|
|
+ SemError(201);
|
|
|
+ t := SymTab.InvalidType;
|
|
|
+ k := -1;
|
|
|
+ QbeGen.CopyOp("0", q)
|
|
|
+ ELSE
|
|
|
+ t := SymTab.SymType(n);
|
|
|
+ k := SymTab.SymKind(n);
|
|
|
+ IF k = SymTab.KindConst THEN
|
|
|
+ IF SymTab.Equal(n,
|
|
|
+ "TRUE") THEN
|
|
|
+ t := SymTab.BoolType();
|
|
|
+ QbeGen.CopyOp("1", q)
|
|
|
+ ELSIF SymTab.Equal(n,
|
|
|
+ "FALSE") THEN
|
|
|
+ t := SymTab.BoolType();
|
|
|
+ QbeGen.CopyOp("0", q)
|
|
|
+ ELSE
|
|
|
+ cls := SymTab.ClassOf(t);
|
|
|
+ IF (t # SymTab.InvalidType)
|
|
|
+ & ((cls = SymTab.ClInt)
|
|
|
+ OR (cls = SymTab.ClChar)
|
|
|
+ OR (cls = SymTab.ClReal)) THEN
|
|
|
+ QbeGen.LoadVar(n,
|
|
|
+ cls = SymTab.ClReal, q)
|
|
|
+ ELSE
|
|
|
+ IF t # SymTab.InvalidType
|
|
|
+ THEN SemError(230)
|
|
|
+ END;
|
|
|
+ QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ ELSIF (k = SymTab.KindVar)
|
|
|
+ OR (k = SymTab.KindParam) THEN
|
|
|
+ cls := SymTab.ClassOf(t);
|
|
|
+ IF (cls = SymTab.ClInt)
|
|
|
+ OR (cls = SymTab.ClBool)
|
|
|
+ OR (cls = SymTab.ClChar)
|
|
|
+ OR (cls = SymTab.ClReal) THEN
|
|
|
+ QbeGen.LoadVar(n,
|
|
|
+ cls = SymTab.ClReal, q)
|
|
|
+ ELSE SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ ELSE QbeGen.CopyOp("0", q);
|
|
|
+ IF (k = SymTab.KindImport)
|
|
|
+ OR (k = SymTab.KindProc)
|
|
|
+ OR (k = SymTab.KindField) THEN
|
|
|
+ SemError(230)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END; .) .
|
|
|
+ Design2<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ VAR q: QbeGen.QVal; VAR qn: SymTab.Name>
|
|
|
+ = Design<t, k, q, qn>
|
|
|
+{ "." GetIdent<qn> (. SemError(230);
|
|
|
+ t := SymTab.InvalidType; .)
|
|
|
+ | "^" (. SemError(230);
|
|
|
+ t := SymTab.InvalidType; .)
|
|
|
+ | "[" ExprList "]" (. SemError(230);
|
|
|
+ t := SymTab.InvalidType; .)
|
|
|
+ | "(" [ ActualParams ] ")" (. SemError(230);
|
|
|
+ t := SymTab.InvalidType; .) } .
|
|
|
+ ExprList (. VAR t: SymTab.TypeIndex;
|
|
|
+ q: QbeGen.QVal; .)
|
|
|
+ = Expr<t, q> { "," Expr<t, q> } .
|
|
|
+
|
|
|
+ (* Expressions. After SimExpr the optional suffix is decided by a
|
|
|
+ distinct first token: relation (= # <> < <= > >=), IN, or IS. *)
|
|
|
+ Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ (. VAR t2: SymTab.TypeIndex;
|
|
|
+ op: INTEGER;
|
|
|
+ q2, qt: QbeGen.QVal;
|
|
|
+ isR: BOOLEAN; .)
|
|
|
+ = SimExpr<t, q>
|
|
|
+ [ Rel<op> SimExpr<t2, q2>
|
|
|
+ (. IF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ t := SymTab.BoolType()
|
|
|
+ ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ isR := FALSE END;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.Cmp(op, q, q2, qt, isR);
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END; .)
|
|
|
+ | "IN" SimExpr<t2, q2> (. IF ~SymTab.InCheck(t, t2) THEN
|
|
|
+ SemError(222) END;
|
|
|
+ SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q);
|
|
|
+ t := SymTab.InvalidType; .)
|
|
|
+ | "IS" TypeIdent2<t2> (. SemError(213);
|
|
|
+ SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q);
|
|
|
+ t := SymTab.InvalidType; .) ] .
|
|
|
+ (* V3 relations keep both PIM '#" and the '<>' alias. *)
|
|
|
+ Rel<VAR op: INTEGER>
|
|
|
+ = "=" (. op := SymTab.OpEq; .)
|
|
|
+ | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ | "<>" (. op := SymTab.OpNeq1; .)
|
|
|
+ | "<" (. op := SymTab.OpLt; .)
|
|
|
+ | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ | ">" (. op := SymTab.OpGt; .)
|
|
|
+ | ">=" (. op := SymTab.OpGe; .) .
|
|
|
+ SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ (. VAR t2, res2: SymTab.TypeIndex;
|
|
|
+ op: INTEGER;
|
|
|
+ q2, qt: QbeGen.QVal;
|
|
|
+ neg, isR: BOOLEAN; .)
|
|
|
+ = (. neg := FALSE; .)
|
|
|
+ [ "+" | "-" (. neg := TRUE; .) ]
|
|
|
+ Term<t, q> (. IF neg THEN
|
|
|
+ IF QbeGen.IsImm(q) THEN
|
|
|
+ QbeGen.NegFold(q, q)
|
|
|
+ ELSE QbeGen.NewTemp(qt);
|
|
|
+ QbeGen.NegQ(q, qt,
|
|
|
+ SymTab.ClassOf(t)
|
|
|
+ = SymTab.ClReal);
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ END
|
|
|
+ END; .)
|
|
|
+ { AddOp<op> Term<t2, q2>
|
|
|
+ (. IF op = SymTab.OpOr THEN
|
|
|
+ IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
|
|
|
+ t := SymTab.BoolType()
|
|
|
+ ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NewTemp(qt);
|
|
|
+ QbeGen.Op3("or", qt, q, q2, FALSE);
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ t := res2
|
|
|
+ ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NewTemp(qt);
|
|
|
+ IF op = SymTab.OpAdd THEN
|
|
|
+ QbeGen.Op3("add", qt, q, q2, isR)
|
|
|
+ ELSE
|
|
|
+ QbeGen.Op3("sub", qt, q, q2, isR)
|
|
|
+ END;
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ END; .) } .
|
|
|
+ AddOp<VAR op: INTEGER>
|
|
|
+ = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ | "-" (. op := SymTab.OpSub; .)
|
|
|
+ | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ (* Term holds multiplication, AND (word or '&'), and the V3 shift
|
|
|
+ operators << >>. MulOp start symbols are all distinct. *)
|
|
|
+ Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ (. VAR t2, res2: SymTab.TypeIndex;
|
|
|
+ op: INTEGER;
|
|
|
+ q2, qt: QbeGen.QVal;
|
|
|
+ isR: BOOLEAN; .)
|
|
|
+ = Fact<t, q> { MulOp<op> Fact<t2, q2>
|
|
|
+ (. IF (op = SymTab.OpAnd) THEN
|
|
|
+ IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
|
|
|
+ t := SymTab.BoolType()
|
|
|
+ ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NewTemp(qt);
|
|
|
+ QbeGen.Op3("and", qt, q, q2, FALSE);
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ ELSIF (op = 10) OR (op = 11) THEN
|
|
|
+ (* << and >> : V3 word shifts; QBE shl/sar. *)
|
|
|
+ IF ~SymTab.IsIntFamily(t) OR ~SymTab.IsIntFamily(t2) THEN
|
|
|
+ SemError(211); t := SymTab.InvalidType END;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NewTemp(qt);
|
|
|
+ IF op = 10 THEN QbeGen.Op3("shl", qt, q, q2, FALSE)
|
|
|
+ ELSE QbeGen.Op3("sar", qt, q, q2, FALSE) END;
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF SymTab.ArithCheck(t, t2,
|
|
|
+ (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ res2) THEN t := res2
|
|
|
+ ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NewTemp(qt);
|
|
|
+ IF op = SymTab.OpTimes THEN
|
|
|
+ QbeGen.Op3("mul", qt, q, q2, isR)
|
|
|
+ ELSIF (op = SymTab.OpDiv)
|
|
|
+ OR (op = SymTab.OpSlash) THEN
|
|
|
+ QbeGen.Op3("div", qt, q, q2, isR)
|
|
|
+ ELSE
|
|
|
+ QbeGen.Op3("rem", qt, q, q2, isR)
|
|
|
+ END;
|
|
|
+ QbeGen.CopyOp(qt, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END
|
|
|
+ END; .) } .
|
|
|
+ MulOp<VAR op: INTEGER>
|
|
|
+ = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ | "AND" (. op := SymTab.OpAnd; .)
|
|
|
+ | "&" (. op := SymTab.OpAnd; .)
|
|
|
+ | "<<" (. op := 10; .)
|
|
|
+ | ">>" (. op := 11; .) .
|
|
|
+ Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ et, dt, t2, b:
|
|
|
+ SymTab.TypeIndex;
|
|
|
+ dk: INTEGER;
|
|
|
+ qd, q2: QbeGen.QVal;
|
|
|
+ qn: SymTab.Name;
|
|
|
+ isCh: BOOLEAN; .)
|
|
|
+ = integer (. LexString(s);
|
|
|
+ QbeGen.NormLit(s, q, isCh);
|
|
|
+ IF isCh THEN
|
|
|
+ t := SymTab.CharType()
|
|
|
+ ELSE t := SymTab.IntType()
|
|
|
+ END; .)
|
|
|
+ | real (. LexString(s);
|
|
|
+ QbeGen.NormReal(s, q);
|
|
|
+ t := SymTab.RealType(); .)
|
|
|
+ | string (. LexString(s);
|
|
|
+ IF SymTab.StrLen(s) <= 3 THEN
|
|
|
+ t := SymTab.CharType();
|
|
|
+ QbeGen.IntStr(
|
|
|
+ QbeGen.CharVal(s), q)
|
|
|
+ ELSE t := SymTab.NewStr();
|
|
|
+ SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q)
|
|
|
+ END; .)
|
|
|
+ | "{" [ SetItems ] "}" (. SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q);
|
|
|
+ t := SymTab.InvalidType; .)
|
|
|
+ | "[" Expr<et, q> ":" Expr<t2, q2>
|
|
|
+ (. SemError(230);
|
|
|
+ QbeGen.CopyOp("0", q);
|
|
|
+ t := SymTab.InvalidType; .)
|
|
|
+ [ TypeIdent2<b> ] "]"
|
|
|
+ MapTail
|
|
|
+ | Design2<dt, dk, qd, qn> (. t := dt;
|
|
|
+ QbeGen.CopyOp(qd, q); .)
|
|
|
+ | "(" Expr<et, q> ")" (. t := et; .)
|
|
|
+ | "NOT" Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
|
|
|
+ t := SymTab.BoolType()
|
|
|
+ ELSE SemError(212);
|
|
|
+ t := SymTab.InvalidType END;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NotQ(q2, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END; .)
|
|
|
+ | "~" Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
|
|
|
+ t := SymTab.BoolType()
|
|
|
+ ELSE SemError(212);
|
|
|
+ t := SymTab.InvalidType END;
|
|
|
+ IF t # SymTab.InvalidType THEN
|
|
|
+ QbeGen.NotQ(q2, q)
|
|
|
+ ELSE QbeGen.CopyOp("0", q)
|
|
|
+ END; .) .
|
|
|
+ MapTail (* suffix chain after a mapped-array
|
|
|
+ constructor: deref, field or
|
|
|
+ subscript, like a designator. *)
|
|
|
+ (. VAR mq: SymTab.Name;
|
|
|
+ et: SymTab.TypeIndex;
|
|
|
+ q2: QbeGen.QVal; .)
|
|
|
+ = { "." GetIdent<mq> (. SemError(230); .)
|
|
|
+ | "^" (. SemError(230); .)
|
|
|
+ | "[" Expr<et, q2> "]" (. SemError(230); .)
|
|
|
+ | "(" [ ActualParams ] ")" (. SemError(230); .) } .
|
|
|
+ SetItems
|
|
|
+ = SetItem { "," SetItem } .
|
|
|
+ SetItem (. VAR t1, t2: SymTab.TypeIndex;
|
|
|
+ q1, q2: QbeGen.QVal; .)
|
|
|
+ = Expr<t1, q1> (. SemError(230); .)
|
|
|
+ [ ".." Expr<t2, q2> (. SemError(230); .) ] .
|
|
|
+ GetIdent<VAR n: SymTab.Name>
|
|
|
+ = ident (. LexName(n); .) .
|
|
|
+
|
|
|
+END M2.
|