| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176 |
- 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
- | ConstDecl ";" (. (* manifest const, no CONST *) .)
- | 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(m1);
- SymTab.PrintTable; .) .
- DeclSeq
- = { ConstBlock | TypeBlock<FALSE> | VarBlock
- | ConstDecl ";" (. (* manifest const, no CONST *) .)
- | [ "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.NewOpenArray(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> ":" (. (* named selector *) .)
- | ":" (. (* anonymous selector *) .)
- | (. (* no selector *) .) )
- 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;
- IF NOT SymTab.FixPending(t) THEN END; .) .
- 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> (. IF NOT SymTab.SetProcRes(t) THEN END; .) ] .
- FormalParams
- = "(" [ ParamSection { ";" ParamSection } ] ")" .
- ParamSection (. VAR t: SymTab.TypeIndex;
- isV: BOOLEAN; .)
- = (. isV := FALSE; .)
- [ "VAR" (. isV := TRUE; .) ]
- ParIdents<isV> ":" Type<t> (. IF NOT SymTab.FixPending(t) THEN END; .) .
- 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.
|