| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259 |
- Coco/R - Compiler-Compiler V1.53
- Released by Pat Terry 17 September 2002
- Source file: M2.atg
- Grammar Tests:
- Deletable symbols:
- DeclSeq
- Undefined nonterminals: -- none --
- Unreachable nonterminals: -- none --
- Circular derivations: -- none --
- Underivable nonterminals: -- none --
- LL(1) conditions:
- LL(1) error in TypeBlock: "CLASS" is the start & successor of a deletable structure
- Listing:
- 1 COMPILER M2
- 2 (* Step 1 — minimal integer pipeline (m2compiler-V3).
- 3 Subset: program MODULE + CONST (literal) + VAR INTEGER +
- 4 assignment + integer expressions (+ - * DIV MOD, leading sign,
- 5 parens). Fresh QBE backend (QbeGen) to gen_ssa/<Module>.ssa;
- 6 assemble with qbe, link with cc.
- 7
- 8 Test convention: a global VAR ExitCode : INTEGER makes generated
- 9 $main return its value as the process exit code, else return 0.
- 10
- 11 Semantic errors reuse the V1/V2/Test2 family: 200 duplicate,
- 12 201 undeclared, 202 module name mismatch, 210 bad assignment,
- 13 211 bad arithmetic, 221 not a type, 230 not supported yet,
- 14 231 opaque type outside definition.
- 15 Scalar-phase TYPEs (named, integer subrange, enum) check fully;
- 16 composite forms wait for step 3. Procedure headings (formals,
- 17 result, FORWARD) enter scopes now; bodies parse + check with one
- 18 230 at END (lowering = step 4).
- 19 Statements: assignment, IF/ELSIF/ELSE, WHILE, REPEAT/UNTIL,
- 20 LOOP/EXIT (230 outside LOOP), FOR/TO/static-sign-BY, full CASE
- 21 (labels, ranges, ELSE; compare-chain), RETURN with 232 checks
- 22 (outside proc / value mismatch / missing value). WITH waits for
- 23 records (step 3). Boolean connectives are eager (or/and/xor);
- 24 relations yield 0/1 via cXXw.
- 25 Clarion-form classes (docs/OOP.txt): CLASS decl + single
- 26 inheritance + CLASS IMPLEMENTATION blocks, methods with ";"
- 27 (per the Table example, not the sketch's ","), VIRTUAL flagged.
- 28 Scopes and member checks now; lowering later (one 230 per
- 29 class/impl block). Classic identifiers: no underscores, so the
- 30 Table example's _names stay lexically out of reach.
- 31 Step 3.1 arrays: "ARRAY [lo..hi, ...] OF T" (folded literal
- 32 bounds, int/char) and open "ARRAY OF T" formals; index suffixes
- 33 with per-level checks (217/218, trap on breach via $abort);
- 34 whole-array ":=" with runtime count check + blit; string
- 35 literals lower as descriptors (1-char stays CHAR, empty works);
- 36 array/string "=" is 213 (no built-in whole comparison).
- 37 Step 3.3 sets: multi-word masks (no header, static words) over
- 38 bases ≤ 256 values; literals are SET OF [0..255] (222 on
- 39 out-of-span); + - * / as or/and/xor-not, IN with span trap,
- 40 =/# word-wise (lenient cross-base); CASE labels reject sets.
- 41 Step 3.4 records: flat blobs; array fields are pointers to static
- 42 descriptors (locked amendment — one layout per type); nested
- 43 records inline; static declaration-order offsets; field chains
- 44 mix with indexes; WITH pushes fields + bases (215/216);
- 45 whole-record deep copy; record/set/class "=" is 213.
- 46 Step 3.6 pointers: vars (l), NIL as a real type (FNil — assignment
- 47 and =/# work, everything else 210-214/222), ^ deref with sfx
- 48 discipline (address flows, load at use; chains compose),
- 49 pointer =/# via ceql/cnel (< > etc. are 213), NEW/DISPOSE as
- 50 builtin statements via extern malloc/free (recursive skeleton
- 51 init; DISPOSE shallow and nils, deviating from Wirth-undefined);
- 52 nil-deref is raw (no check). *)
- 53
- 54 IMPORT SymTab, QbeGen;
- 55
- 56 CHARACTERS
- 57 eol = CHR(13) .
- 58 lf = CHR(10) .
- 59 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
- 60 digit = "0123456789" .
- 61 hexDigit = digit + "ABCDEFabcdef" .
- 62 noQuote1 = ANY - "'" - eol .
- 63 noQuote2 = ANY - '"' - eol .
- 64
- 65 IGNORE CHR(9) .. CHR(13)
- 66
- 67 COMMENTS FROM "(*" TO "*)" NESTED
- 68 COMMENTS FROM "//" TO lf
- 69
- 70 TOKENS
- 71 ident = letter { letter | digit } .
- 72 integer = digit { digit }
- 73 | digit { digit } CONTEXT("..")
- 74 | "0x" hexDigit { hexDigit }
- 75 | "0X" hexDigit { hexDigit } .
- 76 real = digit { digit } "." { digit }
- 77 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
- 78 string = "'" { noQuote1 } "'"
- 79 | '"' { noQuote2 } '"' .
- 80 charConst = digit { digit } ( "C" | "c" ) .
- 81
- 82 PRODUCTIONS
- 83 M2
- 84 = Unit "." .
- 85 (* Units: program modules compile fully; DEFINITION and
- 86 IMPLEMENTATION modules parse + check now but lower in step 4
- 87 (each ends with one 230); same for nested local modules. *)
- 88 Unit
- 89 = DefUnit
- 90 | ImplUnit
- 91 | ProgModule .
- 92 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
- 93 and one program (last) into one image. Units share the symbol
- 94 table; imports materialize exported names. *)
- 95 DefUnit (. VAR m1, m2, pn: SymTab.Name; .)
- 96 = "DEFINITION" "MODULE"
- 97 GetIdent<m1> (. IF NOT SymTab.BeginDef(m1) THEN
- 98 SemError(200) END;
- 99 QbeGen.SetModule(m1); .)
- 100 ";"
- 101 { Import }
- 102 { ConstBlock | TypeBlock<TRUE> | VarBlock
- 103 | ProcHeading<pn> ";" (. SymTab.CloseProc;
- 104 QbeGen.AbortFunc; .) }
- 105 "END"
- 106 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
- 107 SemError(202) END;
- 108 SymTab.EndUnit; .) .
- 109 ImplUnit (. VAR m1, m2: SymTab.Name; .)
- 110 = "IMPLEMENTATION" "MODULE"
- 111 GetIdent<m1> (. IF NOT SymTab.BeginImpl(m1) THEN
- 112 SemError(201) END;
- 113 QbeGen.SetModule(m1); .)
- 114 ";"
- 115 { Import }
- 116 DeclSeq
- 117 [ "BEGIN" (. QbeGen.BeginInit(m1); .)
- 118 [ StatSeq ] (. QbeGen.EndInit; .) ]
- 119 "END"
- 120 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
- 121 SemError(202) END;
- 122 SymTab.EndUnit; .) .
- 123 ProgModule (. VAR m1, m2: SymTab.Name; .)
- 124 = "MODULE"
- 125 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
- 126 SemError(200) END;
- 127 QbeGen.SetModule(m1); .)
- 128 [ Priority ]
- 129 ";"
- 130 { Import }
- 131 DeclSeq
- 132 [ "BEGIN" (. QbeGen.BeginBody; .)
- 133 [ StatSeq ] ]
- 134 "END"
- 135 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
- 136 SemError(202) END;
- 137 QbeGen.EndModule(m1);
- 138 SymTab.EndUnit; .) .
- 139 DeclSeq
- 140 = { ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
- 141 | NestedModule ";" | ClassItem ";" } .
- 142 (* Local module, Wirth form. Declarations lower like top-level ones
- 143 (same QBE module prefix); a BEGIN body becomes an init function
- 144 that main calls; the EXPORT list is hoisted into the enclosing
- 145 scope at END. *)
- 146 NestedModule (. VAR m1, m2: SymTab.Name;
- 147 expNames: ARRAY [0 .. 63] OF SymTab.Name;
- 148 expCount, k: CARDINAL; .)
- 149 = "MODULE"
- 150 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
- 151 SymTab.KindModule) THEN
- 152 SemError(200) END;
- 153 SymTab.PushScope;
- 154 expCount := 0; .)
- 155 [ Priority ]
- 156 ";"
- 157 { Import }
- 158 [ "EXPORT" [ "QUALIFIED" ]
- 159 GetIdent<expNames[expCount]> (. INC(expCount); .)
- 160 { "," GetIdent<expNames[expCount]>
- 161 (. INC(expCount); .) }
- 162 ";" ]
- 163 DeclSeq
- 164 [ "BEGIN" (. QbeGen.BeginInit(m1); .)
- 165 [ StatSeq ] (. QbeGen.EndInit; .) ]
- 166 "END"
- 167 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
- 168 SemError(202) END;
- 169 k := 0;
- 170 WHILE k < expCount DO
- 171 SymTab.ExportUp(expNames[k]);
- 172 INC(k)
- 173 END;
- 174 SymTab.PopScope; .) .
- 175 Priority
- 176 = "[" integer "]" (. SemError(230); .) .
- 177 (* Imports (4.3): FROM materializes the names (unqualified use);
- 178 plain IMPORT only demands the module exists — qualified `L.x`
- 179 materializes on first use (Design). *)
- 180 (* Unknown modules stay unchecked stubs (legacy, so hand-written
- 181 import lines don't fail); a known module's missing export is
- 182 201. *)
- 183 Import (. VAR n: SymTab.Name; .)
- 184 = "FROM"
- 185 GetIdent<n>
- 186 "IMPORT"
- 187 ImpList<n> ";"
- 188 | "IMPORT"
- 189 ImpModList ";" .
- 190 ImpList<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
- 191 = ImpName<mod>
- 192 { "," ImpName<mod> } .
- 193 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
- 194 accepted and ignored: the built-in applies regardless. *)
- 195 ImpName<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
- 196 = GetIdent<n> (. IF SymTab.ModKnown(mod)
- 197 AND NOT SymTab.ImportFrom(mod, n) THEN
- 198 SemError(201) END; .)
- 199 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
- 200 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
- 201 | "INC" | "DEC" ) .
- 202 ImpModList (. VAR n: SymTab.Name; .)
- 203 = GetIdent<n>
- 204 { "," GetIdent<n> } .
- 205 (* Opaque TYPE declarations (definition modules). The targetless
- 206 alias resolves to InvalidType until step 4 completes it. *)
- 207 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
- 208 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
- 209 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
- 210 TypeBlock<isDef: BOOLEAN>
- 211 = "TYPE" (. SymTab.BeginTypeBlock; .)
- 212 { TypeItem<isDef> ";" | ClassItem ";" }
- 213 (. SymTab.EndTypeBlock; .) .
- 214 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
- 215 t, op: SymTab.TypeIndex; .)
- 216 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
- 217 IF op = SymTab.InvalidType THEN
- 218 IF NOT SymTab.Enter(n,
- 219 SymTab.KindType) THEN
- 220 SemError(200) END
- 221 END; .)
- 222 ( "=" Type<t, FALSE> (. IF op # SymTab.InvalidType THEN
- 223 SymTab.SetTarget(op, t)
- 224 ELSE SymTab.SetSymType(n, t)
- 225 END; .)
- 226 | (. IF op # SymTab.InvalidType THEN
- 227 (* stays opaque *)
- 228 ELSIF NOT isDef THEN
- 229 SemError(231)
- 230 ELSE SymTab.SetSymType(n,
- 231 SymTab.NewAlias()) END; .) ) .
- 232 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
- 233 = TypeIdent<t>
- 234 | Subrange<t>
- 235 | Enum<t>
- 236 | ArrayType<t, allowOpen>
- 237 | SetType<t>
- 238 | RecordType<t>
- 239 | PointerType<t>
- 240 | ProcType<t> .
- 241 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
- 242 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
- 243 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
- 244 are code pointers; params are collected into the descriptor. *)
- 245 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
- 246 isV: BOOLEAN; .)
- 247 = "PROCEDURE" (. res := SymTab.InvalidType;
- 248 t := SymTab.NewProcType(res); .)
- 249 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
- 250 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
- 251 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
- 252 isV: BOOLEAN;
- 253 cnt, k: CARDINAL;
- 254 names: ARRAY [0 .. 15] OF SymTab.Name; .)
- 255 = (. isV := FALSE; cnt := 0; .)
- 256 [ "VAR" (. isV := TRUE; .) ]
- 257 GetIdent<names[cnt]> (. INC(cnt); .)
- 258 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
- 259 ( ":" Type<pt, FALSE> (. k := 0;
- 260 WHILE k < cnt DO
- 261 SymTab.ProcTypeAdd(t, isV, pt);
- 262 INC(k)
- 263 END; .)
- 264 | (. (* type-only parameter list:
- 265 each name is a type (GNU
- 266 shorthand used by the
- 267 Coco/R scanner frame) *)
- 268 k := 0;
- 269 WHILE k < cnt DO
- 270 IF SymTab.Lookup(names[k])
- 271 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
- 272 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
- 273 pt := SymTab.SymType(names[k])
- 274 ELSE SemError(201);
- 275 pt := SymTab.InvalidType
- 276 END;
- 277 SymTab.ProcTypeAdd(t, isV, pt);
- 278 INC(k)
- 279 END; .) ) .
- 280 (* Arrays: "OF" without bounds is an open formal (allowed only
- 281 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
- 282 out. Bounds are folded literals (int/char); anything else 230.
- 283 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
- 284 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
- 285 (. VAR elem: SymTab.TypeIndex;
- 286 ok: BOOLEAN;
- 287 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
- 288 nb, k: CARDINAL; .)
- 289 = "ARRAY"
- 290 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
- 291 SemError(230) END;
- 292 t := SymTab.NewOpenArray(elem); .)
- 293 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
- 294 BoundPair<ok>
- 295 { "," BoundPair<ok> }
- 296 "]" (. (* snapshot before the element
- 297 type, which reuses the bound
- 298 buffer for a nested ARRAY *)
- 299 nb := SymTab.BoundCount();
- 300 k := 0;
- 301 WHILE k < nb DO
- 302 bnds[k] := SymTab.BoundLo(k);
- 303 bndh[k] := SymTab.BoundHi(k);
- 304 INC(k)
- 305 END; .)
- 306 "OF" Type<elem, FALSE>
- 307 (. IF ok THEN
- 308 k := nb;
- 309 WHILE k > 0 DO
- 310 DEC(k);
- 311 elem := SymTab.NewArrayB(
- 312 elem, bnds[k], bndh[k])
- 313 END;
- 314 t := elem
- 315 ELSE t := SymTab.InvalidType
- 316 END; .) ) .
- 317 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
- 318 qlo, qhi: QbeGen.QVal;
- 319 lo, hi: INTEGER;
- 320 cl, cl2: INTEGER; .)
- 321 = Expr<tlo, qlo> ".." Expr<thi, qhi>
- 322 (. IF (tlo = SymTab.InvalidType)
- 323 OR (thi = SymTab.InvalidType) THEN
- 324 ok := FALSE
- 325 ELSE cl := SymTab.ClassOf(tlo);
- 326 cl2 := SymTab.ClassOf(thi);
- 327 IF ((cl # SymTab.ClInt)
- 328 AND (cl # SymTab.ClChar))
- 329 OR ((cl2 # SymTab.ClInt)
- 330 AND (cl2 # SymTab.ClChar)) THEN
- 331 SemError(230); ok := FALSE
- 332 ELSIF NOT SymTab.ConstInt(qlo, lo)
- 333 OR NOT SymTab.ConstInt(qhi, hi)
- 334 OR (lo > hi) THEN
- 335 SemError(230); ok := FALSE
- 336 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
- 337 SemError(230); ok := FALSE
- 338 END;
- 339 END; .) .
- 340 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
- 341 bounded subranges; enums wait for ordinals, INTEGER is
- 342 unbounded). Literals are SET OF [0..255]; assignment and
- 343 comparison across suitable bases are lenient (masks over min
- 344 words + zero-check extras), out-of-span literals are 222. *)
- 345 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
- 346 blo, bhi, bspan: INTEGER;
- 347 bcls: INTEGER; .)
- 348 = "SET" "OF" Type<base, FALSE>
- 349 (. IF base = SymTab.InvalidType THEN
- 350 t := SymTab.InvalidType
- 351 ELSE bcls :=
- 352 SymTab.ClassOf(base);
- 353 IF bcls = SymTab.ClBool THEN
- 354 blo := 0; bspan := 2
- 355 ELSIF bcls = SymTab.ClChar THEN
- 356 blo := 0; bspan := 256
- 357 ELSIF SymTab.SubBounds(base,
- 358 blo, bhi) THEN
- 359 bspan := bhi - blo + 1
- 360 ELSE bspan := 0 END;
- 361 IF (bspan <= 0)
- 362 OR (bspan > 256) THEN
- 363 SemError(230);
- 364 t := SymTab.InvalidType
- 365 ELSE t := SymTab.NewSet(base)
- 366 END
- 367 END; .) .
- 368 (* Records: flat blobs; array fields are pointers to static
- 369 descriptors (locked amendment), nested records inline. Field
- 370 offsets static and declaration-ordered. *)
- 371 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex; .)
- 372 = "RECORD" (. t := SymTab.NewRecord(); .)
- 373 [ RecField<t> { ";" [ RecField<t> ] } ]
- 374 "END" .
- 375 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
- 376 t2: SymTab.TypeIndex; .)
- 377 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
- 378 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
- 379 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
- 380 n) THEN
- 381 SemError(200) END; .)
- 382 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
- 383 n) THEN
- 384 SemError(200) END; .) } .
- 385 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
- 386 k: INTEGER;
- 387 dotted: BOOLEAN; .)
- 388 = GetIdent<n> (. dotted := FALSE;
- 389 IF NOT SymTab.Lookup(n) THEN
- 390 k := -1;
- 391 t := SymTab.ForwardType(n);
- 392 IF t = SymTab.InvalidType THEN
- 393 SemError(201)
- 394 END
- 395 ELSE k := SymTab.SymKind(n);
- 396 IF (k = SymTab.KindType)
- 397 OR (k = SymTab.KindPredef) THEN
- 398 t := SymTab.SymType(n)
- 399 ELSE t := SymTab.InvalidType
- 400 END
- 401 END; .)
- 402 [ "." GetIdent<qid> (. dotted := TRUE;
- 403 IF k = SymTab.KindModule THEN
- 404 t := SymTab.QualType(n, qid);
- 405 IF t = SymTab.InvalidType THEN
- 406 SemError(201)
- 407 END
- 408 ELSE SemError(221);
- 409 t := SymTab.InvalidType
- 410 END; .) ]
- 411 (. IF NOT dotted THEN
- 412 IF (k = SymTab.KindModule)
- 413 OR ((k # SymTab.KindType)
- 414 AND (k # SymTab.KindPredef)
- 415 AND (k # SymTab.KindImport)
- 416 AND (k # -1)) THEN
- 417 SemError(221)
- 418 END
- 419 END; .) .
- 420 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
- 421 qlo, qhi: QbeGen.QVal;
- 422 lo, hi: INTEGER; .)
- 423 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
- 424 (. IF (tlo = SymTab.InvalidType)
- 425 OR (thi = SymTab.InvalidType) THEN
- 426 t := SymTab.InvalidType
- 427 ELSIF (SymTab.ClassOf(tlo) #
- 428 SymTab.ClInt)
- 429 OR (SymTab.ClassOf(thi) #
- 430 SymTab.ClInt) THEN
- 431 SemError(230);
- 432 t := SymTab.InvalidType
- 433 ELSIF NOT SymTab.ConstInt(qlo, lo)
- 434 OR NOT SymTab.ConstInt(qhi, hi)
- 435 OR (lo > hi) THEN
- 436 SemError(230);
- 437 t := SymTab.InvalidType
- 438 ELSE t := SymTab.NewSubR(lo, hi)
- 439 END; .)
- 440 "]" .
- 441 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
- 442 = "(" (. t := SymTab.NewEnum(); .)
- 443 GetIdent<n> (. IF NOT SymTab.Enter(n,
- 444 SymTab.KindConst) THEN
- 445 SemError(200) END;
- 446 SymTab.SetSymType(n, t); .)
- 447 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
- 448 SymTab.KindConst) THEN
- 449 SemError(200) END;
- 450 SymTab.SetSymType(n, t); .) }
- 451 ")" .
- 452 (* Clarion-form classes (docs/OOP.txt): declaration + single
- 453 inheritance + IMPLEMENTATION blocks. Scopes and member checks
- 454 now; lowering (vtable, dispatch, THIS) later — one 230 per
- 455 class/impl block. Methods end with ";" per the Table example
- 456 (not "," as in the sketch). No underscores in identifiers. *)
- 457 (* Single CLASS item in both loops: separating declaration from
- 458 IMPLEMENTATION at the loop level needs 2-token lookahead
- 459 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
- 460 The second token decides after CLASS is consumed. A misplaced
- 461 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
- 462 whole unit ends 230 until lowering). *)
- 463 ClassItem
- 464 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
- 465 ClassRest (. VAR cn, m2, pn: SymTab.Name;
- 466 ct: SymTab.TypeIndex; .)
- 467 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
- 468 SymTab.KindType) THEN
- 469 SemError(200) END;
- 470 ct := SymTab.NewClass();
- 471 SymTab.SetSymType(cn, ct);
- 472 SymTab.PushClassScope(ct); .)
- 473 [ Parents<ct> ]
- 474 ";"
- 475 { ClassField<ct> ";" }
- 476 { MethodHeading<pn> ";" (. SymTab.CloseProc;
- 477 QbeGen.AbortFunc; .) }
- 478 "END"
- 479 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
- 480 SemError(202) END;
- 481 SymTab.PopScope;
- 482 SemError(230); .) .
- 483 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
- 484 = "(" Parent1<ct>
- 485 { "," GetIdent<p> (. SemError(230); .) }
- 486 ")" .
- 487 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
- 488 pt: SymTab.TypeIndex; .)
- 489 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
- 490 SemError(201)
- 491 ELSE pt := SymTab.SymType(p);
- 492 IF SymTab.ClassOf(pt) #
- 493 SymTab.ClClass THEN
- 494 SemError(230)
- 495 ELSE SymTab.SetParent(ct, pt)
- 496 END
- 497 END; .) .
- 498 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
- 499 t: SymTab.TypeIndex; .)
- 500 = GetIdent<n>
- 501 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
- 502 SymTab.KindConst) THEN
- 503 SemError(200) END;
- 504 IF SymTab.Lookup(rhs) THEN
- 505 SymTab.SetSymType(n,
- 506 SymTab.SymType(rhs))
- 507 END; .)
- 508 | (. IF NOT SymTab.FieldPending(ct,
- 509 n) THEN
- 510 SemError(200) END; .)
- 511 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
- 512 n) THEN
- 513 SemError(200) END; .) }
- 514 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t); .) ) .
- 515 MethodHeading<VAR pn: SymTab.Name> (. VAR wantVirt: BOOLEAN; .)
- 516 = (. wantVirt := FALSE; .)
- 517 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
- 518 ProcHeading<pn> (. IF wantVirt THEN
- 519 SymTab.MarkVirtual END; .) .
- 520 ClassImplRest (. VAR cn, m2: SymTab.Name;
- 521 ct: SymTab.TypeIndex; .)
- 522 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
- 523 SemError(201);
- 524 ct := SymTab.InvalidType
- 525 ELSE ct := SymTab.SymType(cn);
- 526 IF SymTab.ClassOf(ct) #
- 527 SymTab.ClClass THEN
- 528 SemError(230);
- 529 ct := SymTab.InvalidType
- 530 END
- 531 END;
- 532 IF ct #
- 533 SymTab.InvalidType THEN
- 534 IF NOT SymTab.PushClassMembers(
- 535 ct) THEN
- 536 SemError(230) END
- 537 END; .)
- 538 ";" { MethodImpl<ct> ";" }
- 539 [ "BEGIN"
- 540 [ StatSeq ] ]
- 541 "END"
- 542 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
- 543 SemError(202) END;
- 544 SymTab.PopScope;
- 545 SemError(230); .) .
- 546 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name; .)
- 547 = (. QbeGen.SetNoEmit(TRUE); .)
- 548 MethodHeading<pn> ";"
- 549 (. IF (ct #
- 550 SymTab.InvalidType)
- 551 AND NOT SymTab.MethodExists(ct,
- 552 pn) THEN
- 553 SemError(201) END; .)
- 554 ( "FORWARD" (. SymTab.MarkFwd;
- 555 SymTab.CloseProc; .)
- 556 | Block<pn> (. SymTab.CloseProc; .) )
- 557 (. QbeGen.AbortFunc;
- 558 QbeGen.SetNoEmit(FALSE);
- 559 SemError(230); .) .
- 560 ConstBlock
- 561 = "CONST" { ConstDecl ";" } .
- 562 ConstDecl (. VAR n: SymTab.Name;
- 563 t: SymTab.TypeIndex;
- 564 qv: QbeGen.QVal;
- 565 cls: INTEGER; .)
- 566 = GetIdent<n> (. IF NOT SymTab.Enter(n,
- 567 SymTab.KindConst) THEN
- 568 SemError(200) END; .)
- 569 "="
- 570 Expr<t, qv> (. SymTab.SetSymType(n, t);
- 571 cls := SymTab.ClassOf(t);
- 572 IF cls = SymTab.ClStr THEN
- 573 SemError(230)
- 574 ELSIF NOT QbeGen.IsImm(qv) THEN
- 575 SemError(230) END;
- 576 SymTab.SetSymVal(n, qv);
- 577 QbeGen.DeclConst(n, qv, t); .) .
- 578 VarBlock
- 579 = "VAR" { VarDecl ";" } .
- 580 VarDecl (. VAR nm: SymTab.Name;
- 581 t: SymTab.TypeIndex;
- 582 i: CARDINAL;
- 583 cls: INTEGER; .)
- 584 = VarIdents ":"
- 585 Type<t, FALSE> (. cls := SymTab.ClassOf(t);
- 586 IF (t # SymTab.InvalidType)
- 587 AND (cls # SymTab.ClInt)
- 588 AND (cls # SymTab.ClBool)
- 589 AND (cls # SymTab.ClChar)
- 590 AND (cls # SymTab.ClReal)
- 591 AND (cls # SymTab.ClArray)
- 592 AND (cls # SymTab.ClSet)
- 593 AND (cls # SymTab.ClRecord)
- 594 AND (cls # SymTab.ClPtr)
- 595 AND (cls # SymTab.ClLong)
- 596 AND (cls # SymTab.ClProc) THEN
- 597 SemError(230) END;
- 598 IF QbeGen.LocFull() THEN
- 599 SemError(233) END;
- 600 i := 0;
- 601 WHILE i < SymTab.PendCount() DO
- 602 SymTab.PendName(i, nm);
- 603 QbeGen.DeclVar(nm, t);
- 604 INC(i)
- 605 END;
- 606 SymTab.FixPending(t); .) .
- 607 VarIdents (. VAR n: SymTab.Name; .)
- 608 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
- 609 SymTab.KindVar) THEN
- 610 SemError(200) END; .)
- 611 { ","
- 612 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
- 613 SymTab.KindVar) THEN
- 614 SemError(200) END; .) } .
- 615 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
- 616 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
- 617 SemError(200) END; .)
- 618 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
- 619 SemError(200) END; .) } .
- 620 (* Procedure headings enter scopes/params/result and buffer the
- 621 QBE header; bodies lower to functions (4.1, module level only).
- 622 FORWARD marks; the body heading re-enters (signature compare
- 623 deferred). Nested procedures parse + check, lowering = 4.2. *)
- 624 ProcHeading<VAR pn: SymTab.Name> (. VAR t: SymTab.TypeIndex;
- 625 mg: QbeGen.QVal; .)
- 626 = "PROCEDURE"
- 627 GetIdent<pn> (. IF NOT SymTab.EnterProc(pn) THEN
- 628 IF NOT SymTab.ReenterProc(pn) THEN
- 629 IF NOT SymTab.ResumeProc(pn) THEN
- 630 SemError(200) END
- 631 END
- 632 END;
- 633 QbeGen.Mangled(pn,
- 634 SymTab.ProcUid(pn), mg);
- 635 QbeGen.BeginFunc(mg); .)
- 636 [ FormalParams ]
- 637 [ ":" TypeIdent<t> (. SymTab.SetProcRes(t);
- 638 QbeGen.SetFuncRes(t);
- 639 IF (t #
- 640 SymTab.InvalidType)
- 641 AND ((SymTab.ClassOf(t)
- 642 = SymTab.ClArray)
- 643 OR (SymTab.ClassOf(t)
- 644 = SymTab.ClRecord)
- 645 OR (SymTab.ClassOf(t)
- 646 = SymTab.ClSet)
- 647 OR (SymTab.ClassOf(t)
- 648 = SymTab.ClClass)) THEN
- 649 SemError(230) END; .) ] .
- 650 FormalParams
- 651 = "(" [ ParamSection { ";" ParamSection } ] ")" .
- 652 ParamSection (. VAR t: SymTab.TypeIndex;
- 653 nm: SymTab.Name;
- 654 i: CARDINAL;
- 655 isV: BOOLEAN; .)
- 656 = (. isV := FALSE; .)
- 657 [ "VAR" (. isV := TRUE; .) ]
- 658 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
- 659 WHILE i < SymTab.PendCount() DO
- 660 SymTab.PendName(i, nm);
- 661 (* value open arrays are
- 662 passed as descriptor
- 663 addresses (no copy):
- 664 same representation as
- 665 VAR formals *)
- 666 IF NOT QbeGen.FuncParam(nm,
- 667 isV
- 668 OR SymTab.IsOpenArray(t),
- 669 t) THEN
- 670 SemError(233) END;
- 671 INC(i)
- 672 END;
- 673 SymTab.FixPending(t); .) .
- 674 (* Nested procedures lower like top-level ones (4.2): the
- 675 static link gives them their parent's frame. Methods keep
- 676 parse-now/230-later. *)
- 677 ProcDecl (. VAR pn: SymTab.Name; .)
- 678 = ProcHeading<pn> ";"
- 679 ( "FORWARD" (. SymTab.MarkFwd;
- 680 SymTab.CloseProc;
- 681 QbeGen.AbortFunc; .)
- 682 | "EXTERNAL" (. SymTab.MarkExternal("");
- 683 SymTab.CloseProc;
- 684 QbeGen.AbortFunc; .)
- 685 | (. QbeGen.EndFuncHeader; .)
- 686 Block<pn> (. SymTab.CloseProc;
- 687 QbeGen.EndFunc(
- 688 SymTab.ProcRes(pn)); .) ) .
- 689 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
- 690 = DeclSeq
- 691 [ "BEGIN"
- 692 [ StatSeq ] ]
- 693 "END"
- 694 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
- 695 SemError(202) END; .) .
- 696 StatSeq
- 697 = Statement { ";" [ Statement ] } .
- 698 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
- 699 are accepted: the statement after ';' is optional. *)
- 700 Statement (. VAR lx: QbeGen.QVal; .)
- 701 = AssOrCall
- 702 | IfStat
- 703 | WhileStat
- 704 | RepeatStat
- 705 | LoopStat
- 706 | ForStat
- 707 | CaseStat
- 708 | WithStat
- 709 | ReturnStat
- 710 | HaltStat
- 711 | NewStat
- 712 | DisposeStat
- 713 | IncDecStat
- 714 | "EXIT" (. IF QbeGen.TopLoop(lx) THEN
- 715 QbeGen.Jmp(lx)
- 716 ELSE SemError(230) END; .) .
- 717 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
- 718 integer designator. *)
- 719 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
- 720 dk: INTEGER;
- 721 qd, qv, qn2, qstep:
- 722 QbeGen.QVal;
- 723 qn: SymTab.Name;
- 724 sfx, isInc: BOOLEAN; .)
- 725 = (. isInc := TRUE; .)
- 726 ( "INC" (. isInc := TRUE; .)
- 727 | "DEC" (. isInc := FALSE; .) )
- 728 "(" (. QbeGen.CopyOp("1", qstep); .)
- 729 Design<dt, dk, qd, qn, sfx>
- 730 [ "," Expr<et2, qstep> ]
- 731 ")" (. IF dt = SymTab.InvalidType THEN
- 732 ELSIF (dk # SymTab.KindVar)
- 733 AND (dk # SymTab.KindParam)
- 734 AND (dk # SymTab.KindField) THEN
- 735 SemError(210)
- 736 ELSIF NOT SymTab.IsIntFamily(dt) THEN
- 737 SemError(211)
- 738 ELSE
- 739 IF sfx
- 740 OR (dk = SymTab.KindField) THEN
- 741 QbeGen.ElemLoad(qd, dt, qv)
- 742 ELSE QbeGen.LoadVar(qn,
- 743 FALSE, qv)
- 744 END;
- 745 QbeGen.NewTemp(qn2);
- 746 IF isInc THEN
- 747 QbeGen.Op3("add", qn2, qv,
- 748 qstep, FALSE)
- 749 ELSE QbeGen.Op3("sub", qn2, qv,
- 750 qstep, FALSE)
- 751 END;
- 752 IF sfx
- 753 OR (dk = SymTab.KindField) THEN
- 754 QbeGen.ElemStore(qd, qn2,
- 755 dt)
- 756 ELSE QbeGen.StoreVar(qn,
- 757 qn2, FALSE)
- 758 END
- 759 END; .) .
- 760 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
- 761 Targets are pointer designators; DISPOSE nils afterwards (safer
- 762 than Wirth-undefined; documented). DISPOSE is shallow. *)
- 763 NewStat (. VAR dt: SymTab.TypeIndex;
- 764 dk: INTEGER;
- 765 qd, qm: QbeGen.QVal;
- 766 qn: SymTab.Name;
- 767 sfx: BOOLEAN;
- 768 bt: SymTab.TypeIndex; .)
- 769 = "NEW" "(" Design<dt, dk, qd, qn, sfx> ")"
- 770 (. IF dt = SymTab.InvalidType THEN
- 771 ELSIF (dk # SymTab.KindVar)
- 772 AND (dk # SymTab.KindParam)
- 773 AND (dk # SymTab.KindField) THEN
- 774 SemError(210)
- 775 ELSIF SymTab.ClassOf(dt) #
- 776 SymTab.ClPtr THEN
- 777 SemError(219)
- 778 ELSE bt := SymTab.PtrBase(dt);
- 779 IF bt #
- 780 SymTab.InvalidType THEN
- 781 QbeGen.NewHeap(bt, qm);
- 782 QbeGen.InitHeap(qm, bt);
- 783 IF sfx
- 784 OR (dk =
- 785 SymTab.KindField) THEN
- 786 QbeGen.ElemStore(qd, qm,
- 787 dt)
- 788 ELSE QbeGen.StorePtr(qn,
- 789 qm)
- 790 END
- 791 END
- 792 END; .) .
- 793 DisposeStat (. VAR dt: SymTab.TypeIndex;
- 794 dk: INTEGER;
- 795 qd, qv: QbeGen.QVal;
- 796 qn: SymTab.Name;
- 797 sfx: BOOLEAN; .)
- 798 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> ")"
- 799 (. IF dt = SymTab.InvalidType THEN
- 800 ELSIF (dk # SymTab.KindVar)
- 801 AND (dk # SymTab.KindParam)
- 802 AND (dk # SymTab.KindField) THEN
- 803 SemError(210)
- 804 ELSIF SymTab.ClassOf(dt) #
- 805 SymTab.ClPtr THEN
- 806 SemError(219)
- 807 ELSE
- 808 IF sfx
- 809 OR (dk =
- 810 SymTab.KindField) THEN
- 811 QbeGen.ElemLoad(qd, dt,
- 812 qv)
- 813 ELSE QbeGen.LoadPtr(qn, qv)
- 814 END;
- 815 QbeGen.FreeHeap(qv);
- 816 IF sfx
- 817 OR (dk =
- 818 SymTab.KindField) THEN
- 819 QbeGen.ElemStore(qd, "0",
- 820 dt)
- 821 ELSE QbeGen.StorePtr(qn,
- 822 "0")
- 823 END
- 824 END; .) .
- 825 (* WITH pushes each record's fields (inner wins) plus its base
- 826 address; field designators resolve through both stacks. *)
- 827 WithStat (. VAR nW: CARDINAL; .)
- 828 = "WITH" (. nW := 0; .)
- 829 WithItem<nW> { "," WithItem<nW> }
- 830 "DO" [ StatSeq ] "END"
- 831 (. WHILE nW > 0 DO
- 832 SymTab.PopScope;
- 833 QbeGen.PopWith;
- 834 DEC(nW)
- 835 END; .) .
- 836 WithItem<VAR nW: CARDINAL> (. VAR dt: SymTab.TypeIndex;
- 837 dk: INTEGER;
- 838 qd, qe: QbeGen.QVal;
- 839 qn: SymTab.Name;
- 840 sfx: BOOLEAN; .)
- 841 = Design<dt, dk, qd, qn, sfx>
- 842 (. IF dt = SymTab.InvalidType THEN
- 843 ELSIF (SymTab.ClassOf(dt) #
- 844 SymTab.ClRecord)
- 845 AND (SymTab.ClassOf(dt) #
- 846 SymTab.ClClass) THEN
- 847 SemError(215)
- 848 ELSIF SymTab.PushRecord(dt) THEN
- 849 QbeGen.PushWith(qd);
- 850 INC(nW)
- 851 END; .) .
- 852 (* Assignment or procedure-statement call (4.1, module level).
- 853 Bare `P;` is a syntax error; function-as-statement is 233. *)
- 854 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
- 855 dk: INTEGER;
- 856 qd, qe, qt, ql: QbeGen.QVal;
- 857 qn: SymTab.Name;
- 858 ct2, res0: SymTab.TypeIndex;
- 859 q2, mg0: QbeGen.QVal;
- 860 isR, conv, wconv: BOOLEAN;
- 861 called, sfx: BOOLEAN; .)
- 862 = Design<dt, dk, qd, qn, sfx>
- 863 ( ":="
- 864 Expr<et, qe> (. IF (dt # SymTab.InvalidType)
- 865 AND (dk # SymTab.KindVar)
- 866 AND (dk # SymTab.KindParam)
- 867 AND (dk # SymTab.KindField) THEN
- 868 SemError(210)
- 869 ELSIF NOT SymTab.Assignable(et,
- 870 dt) THEN
- 871 SemError(210)
- 872 ELSIF (dt # SymTab.InvalidType)
- 873 AND (SymTab.ClassOf(dt) =
- 874 SymTab.ClClass) THEN
- 875 SemError(230) END;
- 876 isR := (dt #
- 877 SymTab.InvalidType)
- 878 AND (SymTab.ClassOf(dt)
- 879 = SymTab.ClReal);
- 880 conv := isR
- 881 AND SymTab.IsIntFamily(et);
- 882 wconv := (dt #
- 883 SymTab.InvalidType)
- 884 AND SymTab.IsLongFamily(dt)
- 885 AND SymTab.IsIntFamily(et);
- 886 IF ((dk = SymTab.KindVar)
- 887 OR (dk = SymTab.KindParam)
- 888 OR (dk = SymTab.KindField))
- 889 AND (dt # SymTab.InvalidType)
- 890 AND (et # SymTab.InvalidType)
- 891 AND (SymTab.ClassOf(dt) #
- 892 SymTab.ClClass) THEN
- 893 IF sfx
- 894 OR (dk = SymTab.KindField) THEN
- 895 IF SymTab.ClassOf(dt) =
- 896 SymTab.ClArray THEN
- 897 QbeGen.CopyArray(qd, qe,
- 898 dt)
- 899 ELSIF SymTab.ClassOf(dt) =
- 900 SymTab.ClSet THEN
- 901 QbeGen.CopySet(qd, qe,
- 902 SymTab.SetWords(dt),
- 903 SymTab.SetWords(et))
- 904 ELSIF SymTab.ClassOf(dt) =
- 905 SymTab.ClRecord THEN
- 906 QbeGen.CopyRecord(qd, qe,
- 907 dt)
- 908 ELSIF SymTab.IsLongFamily(dt) THEN
- 909 IF wconv THEN
- 910 QbeGen.WidenLong(qe, ql);
- 911 QbeGen.ElemStore(qd, ql,
- 912 dt)
- 913 ELSE QbeGen.ElemStore(qd, qe,
- 914 dt)
- 915 END
- 916 ELSIF conv THEN
- 917 QbeGen.ConvIR(qe, qt);
- 918 QbeGen.ElemStore(qd, qt,
- 919 dt)
- 920 ELSE QbeGen.ElemStore(qd, qe,
- 921 dt)
- 922 END
- 923 ELSIF SymTab.ClassOf(dt) =
- 924 SymTab.ClArray THEN
- 925 QbeGen.CopyArray(qd, qe, dt)
- 926 ELSIF SymTab.ClassOf(dt) =
- 927 SymTab.ClSet THEN
- 928 QbeGen.CopySet(qd, qe,
- 929 SymTab.SetWords(dt),
- 930 SymTab.SetWords(et))
- 931 ELSIF SymTab.ClassOf(dt) =
- 932 SymTab.ClRecord THEN
- 933 QbeGen.CopyRecord(qd, qe, dt)
- 934 ELSIF (SymTab.ClassOf(dt) =
- 935 SymTab.ClPtr)
- 936 OR (SymTab.ClassOf(dt) =
- 937 SymTab.ClProc) THEN
- 938 QbeGen.StorePtr(qn, qe)
- 939 ELSIF SymTab.IsLongFamily(dt) THEN
- 940 IF wconv THEN
- 941 QbeGen.WidenLong(qe, ql);
- 942 QbeGen.StoreLong(qn, ql)
- 943 ELSE QbeGen.StoreLong(qn, qe)
- 944 END
- 945 ELSIF conv THEN
- 946 QbeGen.ConvIR(qe, qt);
- 947 QbeGen.StoreVar(qn, qt, TRUE)
- 948 ELSE
- 949 QbeGen.StoreVar(qn, qe, isR)
- 950 END
- 951 END; .)
- 952 | ArgList<qn, dt, qd, FALSE, ct2, q2, called>
- 953 | (* bare `P;`: proper parameterless
- 954 procedure call; anything else
- 955 here is 233 (was a bare syntax
- 956 error before 4.2) *)
- 957 (. IF (dk = SymTab.KindProc)
- 958 AND NOT sfx THEN
- 959 res0 := SymTab.ProcRes(qn);
- 960 IF res0 #
- 961 SymTab.InvalidType THEN
- 962 SemError(233)
- 963 ELSIF SymTab.ProcNPar(qn) #
- 964 0 THEN
- 965 SemError(233)
- 966 ELSE QbeGen.Mangled(qn,
- 967 SymTab.ProcUid(qn), mg0);
- 968 QbeGen.CallBegin(mg0,
- 969 res0,
- 970 SymTab.ProcDepthOf(qn),
- 971 SymTab.IsExternal(qn));
- 972 QbeGen.CallEnd(FALSE, q2)
- 973 END
- 974 ELSE SemError(233)
- 975 END; .) ) .
- 976 (* Actual-parameter list shared by statement and expression calls.
- 977 want selects CallEnd's result handling; t/q carry the call
- 978 value (statement calls discard). Arity/type failures are 233;
- 979 evaluation code still emits so the .ssa stays assembleable. *)
- 980 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
- 981 want: BOOLEAN;
- 982 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
- 983 VAR called: BOOLEAN> (. VAR i: CARDINAL;
- 984 res: SymTab.TypeIndex;
- 985 mg: QbeGen.QVal;
- 986 ok, ind: BOOLEAN; .)
- 987 = "(" (. called := TRUE;
- 988 ok := TRUE;
- 989 ind := FALSE;
- 990 IF SymTab.SymKind(pn) =
- 991 SymTab.KindProc THEN
- 992 res := SymTab.ProcRes(pn);
- 993 QbeGen.Mangled(pn,
- 994 SymTab.ProcUid(pn), mg);
- 995 QbeGen.CallBegin(mg, res,
- 996 SymTab.ProcDepthOf(pn),
- 997 SymTab.IsExternal(pn))
- 998 ELSIF (pt # SymTab.InvalidType)
- 999 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
- 1000 ind := TRUE;
- 1001 res :=
- 1002 SymTab.ProcTypeRes(pt);
- 1003 QbeGen.CallBeginInd(callee,
- 1004 res, FALSE)
- 1005 ELSE SemError(233);
- 1006 ok := FALSE;
- 1007 res := SymTab.InvalidType
- 1008 END;
- 1009 i := 0; .)
- 1010 [ ActParam<pn, pt, ind, i> (. INC(i); .)
- 1011 { "," ActParam<pn, pt, ind, i> (. INC(i); .) } ]
- 1012 ")" (. IF ok THEN
- 1013 IF ind THEN
- 1014 IF i #
- 1015 SymTab.ProcTypeNPar(pt) THEN
- 1016 SemError(233); ok := FALSE
- 1017 END
- 1018 ELSIF i #
- 1019 SymTab.ProcNPar(pn) THEN
- 1020 SemError(233); ok := FALSE
- 1021 END
- 1022 END;
- 1023 IF NOT ok THEN
- 1024 t := SymTab.InvalidType;
- 1025 QbeGen.CopyOp("0", q)
- 1026 ELSIF want THEN
- 1027 IF res =
- 1028 SymTab.InvalidType THEN
- 1029 SemError(233);
- 1030 t := SymTab.InvalidType;
- 1031 QbeGen.CopyOp("0", q)
- 1032 ELSE t := res;
- 1033 QbeGen.CallEnd(TRUE, q)
- 1034 END
- 1035 ELSE
- 1036 IF res #
- 1037 SymTab.InvalidType THEN
- 1038 SemError(233)
- 1039 END;
- 1040 t := SymTab.InvalidType;
- 1041 QbeGen.CopyOp("0", q);
- 1042 QbeGen.CallEnd(FALSE, q)
- 1043 END; .) .
- 1044 (* One actual: VAR formals take recorded designator addresses
- 1045 (233 otherwise); value formals take converted expressions. *)
- 1046 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
- 1047 i: CARDINAL> (. VAR at, ft: SymTab.TypeIndex;
- 1048 qe, qa, qt: QbeGen.QVal;
- 1049 isV, conv: BOOLEAN; .)
- 1050 = Expr<at, qe> (. IF ind THEN
- 1051 ft :=
- 1052 SymTab.ProcTypeParamType(pt,
- 1053 i);
- 1054 isV :=
- 1055 SymTab.ProcTypeParamIsVar(pt,
- 1056 i)
- 1057 ELSE
- 1058 ft := SymTab.ParamType(pn, i);
- 1059 isV := SymTab.ParamIsVar(pn, i)
- 1060 END;
- 1061 IF (at = SymTab.InvalidType)
- 1062 OR (ft =
- 1063 SymTab.InvalidType) THEN
- 1064 ELSIF isV THEN
- 1065 IF (SymTab.ClassOf(at)
- 1066 = SymTab.ClChar)
- 1067 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
- 1068 AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
- 1069 = SymTab.ClChar)
- 1070 AND QbeGen.IsImm(qe) THEN
- 1071 (* 1-char string
- 1072 literal passed to
- 1073 a VAR ARRAY OF CHAR *)
- 1074 QbeGen.DeclCharStr(qe,
- 1075 qa);
- 1076 IF NOT QbeGen.CallArg(qa,
- 1077 "l") THEN
- 1078 SemError(233)
- 1079 END
- 1080 ELSIF NOT QbeGen.AddrOfVal(qe,
- 1081 qa) THEN
- 1082 SemError(233)
- 1083 ELSIF NOT SymTab.VarParamOk(at,
- 1084 ft) THEN
- 1085 SemError(233)
- 1086 ELSIF NOT QbeGen.CallArg(qa,
- 1087 "l") THEN
- 1088 SemError(233)
- 1089 END
- 1090 ELSE
- 1091 IF (SymTab.ClassOf(at)
- 1092 = SymTab.ClChar)
- 1093 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
- 1094 AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
- 1095 = SymTab.ClChar)
- 1096 AND QbeGen.IsImm(qe) THEN
- 1097 (* 1-char string
- 1098 literal passed to
- 1099 ARRAY OF CHAR *)
- 1100 QbeGen.DeclCharStr(qe,
- 1101 qa);
- 1102 IF NOT QbeGen.CallArg(qa,
- 1103 "l") THEN
- 1104 SemError(233)
- 1105 END
- 1106 ELSIF NOT SymTab.Assignable(at,
- 1107 ft) THEN
- 1108 SemError(233)
- 1109 ELSE
- 1110 conv := (SymTab.ClassOf(
- 1111 ft) = SymTab.ClReal)
- 1112 AND SymTab.IsIntFamily(at);
- 1113 IF conv THEN
- 1114 QbeGen.ConvIR(qe, qt);
- 1115 IF NOT QbeGen.CallArg(qt,
- 1116 "d") THEN
- 1117 SemError(233)
- 1118 END
- 1119 ELSIF NOT QbeGen.CallArg(qe,
- 1120 QbeGen.ArgClass(ft)) THEN
- 1121 SemError(233)
- 1122 END
- 1123 END
- 1124 END; .) .
- 1125 IfStat (. VAR t: SymTab.TypeIndex;
- 1126 q, lThen, lElse, lEnd:
- 1127 QbeGen.QVal;
- 1128 hasElse: BOOLEAN; .)
- 1129 = "IF" (. hasElse := FALSE; .)
- 1130 Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
- 1131 SemError(214) END;
- 1132 QbeGen.NewLabel(lThen);
- 1133 QbeGen.NewLabel(lElse);
- 1134 QbeGen.NewLabel(lEnd);
- 1135 QbeGen.Jnz(q, lThen, lElse);
- 1136 QbeGen.EmitLabel(lThen); .)
- 1137 "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .)
- 1138 { "ELSIF" (. QbeGen.EmitLabel(lElse);
- 1139 QbeGen.NewLabel(lElse); .)
- 1140 Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
- 1141 SemError(214) END;
- 1142 QbeGen.NewLabel(lThen);
- 1143 QbeGen.Jnz(q, lThen, lElse);
- 1144 QbeGen.EmitLabel(lThen); .)
- 1145 "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .) }
- 1146 [ "ELSE" (. QbeGen.EmitLabel(lElse);
- 1147 hasElse := TRUE; .)
- 1148 [ StatSeq ] ]
- 1149 "END" (. IF hasElse THEN
- 1150 QbeGen.EmitLabel(lEnd)
- 1151 ELSE QbeGen.EmitLabel(lElse);
- 1152 QbeGen.EmitLabel(lEnd)
- 1153 END; .) .
- 1154 WhileStat (. VAR t: SymTab.TypeIndex;
- 1155 q, lTop, lBody, lEnd:
- 1156 QbeGen.QVal; .)
- 1157 = "WHILE" (. QbeGen.NewLabel(lTop);
- 1158 QbeGen.NewLabel(lBody);
- 1159 QbeGen.NewLabel(lEnd);
- 1160 QbeGen.EmitLabel(lTop); .)
- 1161 Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
- 1162 SemError(214) END;
- 1163 QbeGen.Jnz(q, lBody, lEnd);
- 1164 QbeGen.EmitLabel(lBody); .)
- 1165 "DO" [ StatSeq ] (. QbeGen.Jmp(lTop); .)
- 1166 "END" (. QbeGen.EmitLabel(lEnd); .) .
- 1167 RepeatStat (. VAR t: SymTab.TypeIndex;
- 1168 q, lTop, lEnd: QbeGen.QVal; .)
- 1169 = "REPEAT" (. QbeGen.NewLabel(lTop);
- 1170 QbeGen.NewLabel(lEnd);
- 1171 QbeGen.EmitLabel(lTop); .)
- 1172 [ StatSeq ]
- 1173 "UNTIL" Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
- 1174 SemError(214) END;
- 1175 QbeGen.Jnz(q, lEnd, lTop);
- 1176 QbeGen.EmitLabel(lEnd); .) .
- 1177 LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .)
- 1178 = "LOOP" (. QbeGen.NewLabel(lTop);
- 1179 QbeGen.NewLabel(lEnd);
- 1180 QbeGen.PushLoop(lEnd);
- 1181 QbeGen.EmitLabel(lTop); .)
- 1182 [ StatSeq ]
- 1183 "END" (. QbeGen.Jmp(lTop);
- 1184 QbeGen.PopLoop;
- 1185 QbeGen.EmitLabel(lEnd); .) .
- 1186 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
- 1187 Runtime direction would need a compare-select; the literal
- 1188 sign picks cslew/csegew at "DO" time. *)
- 1189 ForStat (. VAR lv: SymTab.Name;
- 1190 tlo, thi, tby:
- 1191 SymTab.TypeIndex;
- 1192 qlo, qhi, qby, qt, qk, qb:
- 1193 QbeGen.QVal;
- 1194 lTop, lBody, lEnd:
- 1195 QbeGen.QVal;
- 1196 by: INTEGER;
- 1197 ok: BOOLEAN; .)
- 1198 = "FOR" (. by := 1; .)
- 1199 GetIdent<lv> (. ok := SymTab.Lookup(lv);
- 1200 IF NOT ok THEN
- 1201 SemError(201)
- 1202 ELSIF (SymTab.SymKind(lv) #
- 1203 SymTab.KindVar)
- 1204 AND (SymTab.SymKind(lv) #
- 1205 SymTab.KindParam) THEN
- 1206 SemError(220); ok := FALSE
- 1207 ELSIF NOT SymTab.IsIntFamily(
- 1208 SymTab.SymType(lv)) THEN
- 1209 SemError(220); ok := FALSE
- 1210 END; .)
- 1211 ":=" Expr<tlo, qlo> (. IF NOT SymTab.IsIntFamily(tlo) THEN
- 1212 SemError(220); ok := FALSE
- 1213 END; .)
- 1214 "TO" Expr<thi, qhi> (. IF NOT SymTab.IsIntFamily(thi) THEN
- 1215 SemError(220); ok := FALSE
- 1216 END; .)
- 1217 [ "BY" Expr<tby, qby> (. IF (tby #
- 1218 SymTab.InvalidType)
- 1219 AND NOT SymTab.IsIntFamily(tby) THEN
- 1220 SemError(220); ok := FALSE
- 1221 END;
- 1222 IF NOT SymTab.ConstInt(qby, by) THEN
- 1223 SemError(230); by := 1
- 1224 ELSIF by = 0 THEN
- 1225 SemError(220); by := 1
- 1226 END; .) ]
- 1227 "DO" (. IF ok THEN
- 1228 QbeGen.StoreVar(lv, qlo,
- 1229 FALSE) END;
- 1230 QbeGen.NewLabel(lTop);
- 1231 QbeGen.NewLabel(lBody);
- 1232 QbeGen.NewLabel(lEnd);
- 1233 QbeGen.EmitLabel(lTop);
- 1234 QbeGen.LoadVar(lv, FALSE, qt);
- 1235 QbeGen.NewTemp(qk);
- 1236 IF by > 0 THEN
- 1237 QbeGen.Op3("cslew", qk,
- 1238 qt, qhi, FALSE)
- 1239 ELSE QbeGen.Op3("csgew", qk,
- 1240 qt, qhi, FALSE)
- 1241 END;
- 1242 QbeGen.Jnz(qk, lBody, lEnd);
- 1243 QbeGen.EmitLabel(lBody); .)
- 1244 [ StatSeq ]
- 1245 "END" (. IF ok THEN
- 1246 QbeGen.LoadVar(lv, FALSE,
- 1247 qt);
- 1248 QbeGen.IntStr(by, qb);
- 1249 QbeGen.NewTemp(qk);
- 1250 QbeGen.Op3("add", qk,
- 1251 qt, qb, FALSE);
- 1252 QbeGen.StoreVar(lv, qk,
- 1253 FALSE) END;
- 1254 QbeGen.Jmp(lTop);
- 1255 QbeGen.EmitLabel(lEnd); .) .
- 1256 CaseStat (. VAR tsel: SymTab.TypeIndex;
- 1257 qsel, lEnd: QbeGen.QVal; .)
- 1258 = "CASE" Expr<tsel, qsel> (. QbeGen.NewLabel(lEnd); .)
- 1259 "OF" CaseAlt<tsel, qsel, lEnd>
- 1260 { "|" CaseAlt<tsel, qsel, lEnd> }
- 1261 [ "ELSE" [ StatSeq ] ]
- 1262 "END" (. QbeGen.EmitLabel(lEnd); .) .
- 1263 (* Compare-chain lowering: each alternative ends its match-tests
- 1264 with "jmp lAfter", so the no-match fallthrough skips the body:
- 1265 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
- 1266 lAfter:". Falls into the next alternative, ELSE, or END. *)
- 1267 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1268 lEnd: QbeGen.QVal> (. VAR lBody, lAfter: QbeGen.QVal; .)
- 1269 = (. QbeGen.NewLabel(lBody);
- 1270 QbeGen.NewLabel(lAfter); .)
- 1271 CaseLabel<tsel, qsel, lBody>
- 1272 { "," CaseLabel<tsel, qsel, lBody> }
- 1273 ":" (. QbeGen.Jmp(lAfter);
- 1274 QbeGen.EmitLabel(lBody); .)
- 1275 [ StatSeq ] (. QbeGen.Jmp(lEnd);
- 1276 QbeGen.EmitLabel(lAfter); .) .
- 1277 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1278 lBody: QbeGen.QVal> (. VAR t2, t3: SymTab.TypeIndex;
- 1279 q2, q3, qc, qd, qe:
- 1280 QbeGen.QVal;
- 1281 lNext: QbeGen.QVal; .)
- 1282 = Expr<t2, q2> (. IF (t2 #
- 1283 SymTab.InvalidType)
- 1284 AND (tsel #
- 1285 SymTab.InvalidType)
- 1286 AND ((SymTab.ClassOf(t2) =
- 1287 SymTab.ClSet)
- 1288 OR (SymTab.ClassOf(tsel) =
- 1289 SymTab.ClSet)) THEN
- 1290 SemError(230)
- 1291 ELSIF (t2 #
- 1292 SymTab.InvalidType)
- 1293 AND (tsel #
- 1294 SymTab.InvalidType)
- 1295 AND NOT SymTab.EqCheck(t2,
- 1296 tsel) THEN
- 1297 SemError(213) END;
- 1298 IF NOT QbeGen.IsImm(q2) THEN
- 1299 SemError(230);
- 1300 QbeGen.CopyOp("0", q2)
- 1301 END;
- 1302 QbeGen.NewLabel(lNext);
- 1303 QbeGen.Cmp(SymTab.OpEq,
- 1304 qsel, q2, qc, FALSE);
- 1305 QbeGen.Jnz(qc, lBody, lNext);
- 1306 QbeGen.EmitLabel(lNext); .)
- 1307 [ ".." Expr<t3, q3> (. IF (t3 #
- 1308 SymTab.InvalidType)
- 1309 AND (tsel #
- 1310 SymTab.InvalidType)
- 1311 AND NOT SymTab.EqCheck(t3,
- 1312 tsel) THEN
- 1313 SemError(213) END;
- 1314 IF NOT QbeGen.IsImm(q3) THEN
- 1315 SemError(230);
- 1316 QbeGen.CopyOp("0", q3)
- 1317 END;
- 1318 QbeGen.Cmp(SymTab.OpGe,
- 1319 qsel, q2, qc, FALSE);
- 1320 QbeGen.Cmp(SymTab.OpLe,
- 1321 qsel, q3, qd, FALSE);
- 1322 QbeGen.NewTemp(qe);
- 1323 QbeGen.Op3("and", qe, qc, qd,
- 1324 FALSE);
- 1325 QbeGen.NewLabel(lNext);
- 1326 QbeGen.Jnz(qe, lBody, lNext);
- 1327 QbeGen.EmitLabel(lNext); .) ] .
- 1328 ReturnStat (. VAR t: SymTab.TypeIndex;
- 1329 q, qt: QbeGen.QVal;
- 1330 res: SymTab.TypeIndex;
- 1331 hadE, conv: BOOLEAN; .)
- 1332 = "RETURN" (. hadE := FALSE; .)
- 1333 [ Expr<t, q> (. hadE := TRUE; .) ]
- 1334 (. conv := FALSE;
- 1335 IF NOT SymTab.InProc() THEN
- 1336 SemError(232)
- 1337 ELSE res := SymTab.CurRes();
- 1338 IF NOT hadE THEN
- 1339 IF res #
- 1340 SymTab.InvalidType THEN
- 1341 SemError(232)
- 1342 ELSE QbeGen.EmitRet(q,
- 1343 FALSE)
- 1344 END
- 1345 ELSIF (res =
- 1346 SymTab.InvalidType)
- 1347 OR (t #
- 1348 SymTab.InvalidType)
- 1349 AND NOT SymTab.Assignable(t,
- 1350 res) THEN
- 1351 SemError(232)
- 1352 ELSE
- 1353 conv := (SymTab.ClassOf(
- 1354 res) = SymTab.ClReal)
- 1355 AND SymTab.IsIntFamily(t);
- 1356 IF conv THEN
- 1357 QbeGen.ConvIR(q, qt);
- 1358 QbeGen.EmitRet(qt, TRUE)
- 1359 ELSE QbeGen.EmitRet(q, TRUE)
- 1360 END
- 1361 END
- 1362 END; .) .
- 1363 HaltStat (. VAR t: SymTab.TypeIndex;
- 1364 q: QbeGen.QVal; .)
- 1365 = "HALT" [ "(" Expr<t, q> ")" ] (. QbeGen.HaltQ; .) .
- 1366 (* Designator: scalar loads, array addresses, and index suffixes.
- 1367 Each index descends one level (bounds-checked, trap on breach);
- 1368 nested levels reload the inner descriptor address. q ends as the
- 1369 value (scalars), the descriptor address (plain arrays), or the
- 1370 element address (indexed); sfx marks the indexed form. *)
- 1371 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
- 1372 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
- 1373 (. VAR n, fn, mal: SymTab.Name;
- 1374 cls: INTEGER;
- 1375 curT, it, eT, bt:
- 1376 SymTab.TypeIndex;
- 1377 iq, ql, qlo, qhi, qe:
- 1378 QbeGen.QVal;
- 1379 lo, hi: INTEGER;
- 1380 fo: INTEGER;
- 1381 isOpen: BOOLEAN;
- 1382 qb, cv: QbeGen.QVal; .)
- 1383 = GetIdent<n> (. QbeGen.CopyOp(n, qn);
- 1384 sfx := FALSE;
- 1385 IF NOT SymTab.Lookup(n) THEN
- 1386 SemError(201);
- 1387 t := SymTab.InvalidType;
- 1388 k := -1;
- 1389 QbeGen.CopyOp("0", q)
- 1390 ELSE
- 1391 t := SymTab.SymType(n);
- 1392 k := SymTab.SymKind(n);
- 1393 IF k = SymTab.KindConst THEN
- 1394 IF SymTab.Equal(n,
- 1395 "TRUE") THEN
- 1396 t := SymTab.BoolType();
- 1397 QbeGen.CopyOp("1", q)
- 1398 ELSIF SymTab.Equal(n,
- 1399 "FALSE") THEN
- 1400 t := SymTab.BoolType();
- 1401 QbeGen.CopyOp("0", q)
- 1402 ELSIF SymTab.Equal(n,
- 1403 "NIL") THEN
- 1404 QbeGen.CopyOp("0", q)
- 1405 ELSE
- 1406 cls :=
- 1407 SymTab.ClassOf(t);
- 1408 IF (t #
- 1409 SymTab.InvalidType)
- 1410 AND ((cls = SymTab.ClInt)
- 1411 OR (cls
- 1412 = SymTab.ClChar)
- 1413 OR (cls
- 1414 = SymTab.ClReal)
- 1415 OR (cls
- 1416 = SymTab.ClNil)) THEN
- 1417 IF cls = SymTab.ClNil THEN
- 1418 QbeGen.CopyOp("0", q)
- 1419 ELSIF ((cls
- 1420 = SymTab.ClInt)
- 1421 OR (cls
- 1422 = SymTab.ClChar))
- 1423 AND SymTab.GetSymVal(n, cv)
- 1424 AND QbeGen.IsImm(cv) THEN
- 1425 QbeGen.CopyOp(cv, q)
- 1426 ELSE
- 1427 QbeGen.LoadVar(n,
- 1428 cls = SymTab.ClReal,
- 1429 q)
- 1430 END
- 1431 ELSE
- 1432 IF t #
- 1433 SymTab.InvalidType THEN
- 1434 SemError(230)
- 1435 END;
- 1436 QbeGen.CopyOp("0", q)
- 1437 END
- 1438 END
- 1439 ELSIF (k = SymTab.KindVar)
- 1440 OR (k = SymTab.KindParam) THEN
- 1441 cls :=
- 1442 SymTab.ClassOf(t);
- 1443 IF (cls = SymTab.ClInt)
- 1444 OR (cls = SymTab.ClBool)
- 1445 OR (cls = SymTab.ClChar)
- 1446 OR (cls
- 1447 = SymTab.ClReal) THEN
- 1448 QbeGen.LoadVar(n,
- 1449 cls = SymTab.ClReal, q)
- 1450 ELSIF (cls = SymTab.ClPtr)
- 1451 OR (cls = SymTab.ClProc) THEN
- 1452 QbeGen.LoadPtr(n, q)
- 1453 ELSIF cls = SymTab.ClLong THEN
- 1454 QbeGen.LoadLong(n, q)
- 1455 ELSIF (cls
- 1456 = SymTab.ClArray)
- 1457 OR (cls
- 1458 = SymTab.ClSet)
- 1459 OR (cls
- 1460 = SymTab.ClRecord)
- 1461 OR (cls
- 1462 = SymTab.ClClass) THEN
- 1463 QbeGen.AddrOf(n, q)
- 1464 ELSE SemError(230);
- 1465 QbeGen.CopyOp("0", q)
- 1466 END
- 1467 ELSE QbeGen.CopyOp("0", q);
- 1468 IF k = SymTab.KindImport THEN
- 1469 SemError(230)
- 1470 ELSIF k =
- 1471 SymTab.KindProc THEN
- 1472 (* bare procedure name:
- 1473 a following ArgList
- 1474 makes it a call;
- 1475 otherwise Fact
- 1476 reports 230 *)
- 1477 ELSE
- 1478 IF k = SymTab.KindField THEN
- 1479 IF QbeGen.TopWith(qb) THEN
- 1480 fo :=
- 1481 SymTab.FieldOffset(
- 1482 SymTab.FieldOwner(n),
- 1483 n);
- 1484 QbeGen.FieldAddr(qb,
- 1485 fo, q);
- 1486 sfx := TRUE
- 1487 ELSE SemError(230);
- 1488 QbeGen.CopyOp("0", q)
- 1489 END
- 1490 END
- 1491 END
- 1492 END
- 1493 END; .)
- 1494 { "[" Expr<it, iq>
- 1495 (. IF t = SymTab.InvalidType THEN
- 1496 ELSIF SymTab.ClassOf(t) #
- 1497 SymTab.ClArray THEN
- 1498 SemError(217);
- 1499 t := SymTab.InvalidType
- 1500 ELSIF NOT SymTab.IsIntFamily(it)
- 1501 AND (SymTab.ClassOf(it) #
- 1502 SymTab.ClChar) THEN
- 1503 SemError(218);
- 1504 t := SymTab.InvalidType
- 1505 ELSE
- 1506 QbeGen.WidenIndex(iq, ql);
- 1507 isOpen :=
- 1508 SymTab.IsOpenArray(t);
- 1509 IF isOpen THEN
- 1510 QbeGen.CopyOp("0", qlo);
- 1511 QbeGen.OpenHi(q, qhi)
- 1512 ELSE
- 1513 lo := SymTab.ArrayLo(t);
- 1514 hi := SymTab.ArrayHi(t);
- 1515 QbeGen.IntStr(lo, qlo);
- 1516 QbeGen.IntStr(hi, qhi)
- 1517 END;
- 1518 QbeGen.CheckRange(ql, qlo,
- 1519 qhi);
- 1520 eT := SymTab.ArrayElem(t);
- 1521 QbeGen.ElemAddr(q, ql, qlo,
- 1522 t, qe);
- 1523 IF SymTab.ClassOf(eT) =
- 1524 SymTab.ClArray THEN
- 1525 QbeGen.ElemLoad(qe, eT, q)
- 1526 ELSE QbeGen.CopyOp(qe, q)
- 1527 END;
- 1528 t := eT; sfx := TRUE
- 1529 END; .)
- 1530 { "," Expr<it, iq>
- 1531 (. IF t = SymTab.InvalidType THEN
- 1532 ELSIF SymTab.ClassOf(t) #
- 1533 SymTab.ClArray THEN
- 1534 SemError(217);
- 1535 t := SymTab.InvalidType
- 1536 ELSIF NOT SymTab.IsIntFamily(it)
- 1537 AND (SymTab.ClassOf(it) #
- 1538 SymTab.ClChar) THEN
- 1539 SemError(218);
- 1540 t := SymTab.InvalidType
- 1541 ELSE
- 1542 QbeGen.WidenIndex(iq, ql);
- 1543 isOpen :=
- 1544 SymTab.IsOpenArray(t);
- 1545 IF isOpen THEN
- 1546 QbeGen.CopyOp("0", qlo);
- 1547 QbeGen.OpenHi(q, qhi)
- 1548 ELSE
- 1549 lo := SymTab.ArrayLo(t);
- 1550 hi := SymTab.ArrayHi(t);
- 1551 QbeGen.IntStr(lo, qlo);
- 1552 QbeGen.IntStr(hi, qhi)
- 1553 END;
- 1554 QbeGen.CheckRange(ql, qlo,
- 1555 qhi);
- 1556 eT := SymTab.ArrayElem(t);
- 1557 QbeGen.ElemAddr(q, ql, qlo,
- 1558 t, qe);
- 1559 IF SymTab.ClassOf(eT) =
- 1560 SymTab.ClArray THEN
- 1561 QbeGen.ElemLoad(qe, eT, q)
- 1562 ELSE QbeGen.CopyOp(qe, q)
- 1563 END;
- 1564 t := eT; sfx := TRUE
- 1565 END; .) }
- 1566 "]"
- 1567 | "." GetIdent<fn>
- 1568 (. IF k = SymTab.KindModule THEN
- 1569 (* qualified L.x: materialize
- 1570 the export, then load it *)
- 1571 IF NOT SymTab.MaterializeAlias(n,
- 1572 fn, mal) THEN
- 1573 SemError(201);
- 1574 t := SymTab.InvalidType;
- 1575 QbeGen.CopyOp("0", q)
- 1576 ELSE
- 1577 QbeGen.CopyOp(mal, qn);
- 1578 t := SymTab.SymType(mal);
- 1579 k := SymTab.SymKind(mal);
- 1580 sfx := FALSE;
- 1581 IF k = SymTab.KindProc THEN
- 1582 (* call: ArgList supplies
- 1583 the value *)
- 1584 QbeGen.CopyOp("0", q)
- 1585 ELSIF NOT QbeGen.LoadDesignator(
- 1586 mal, t, k, q) THEN
- 1587 SemError(230);
- 1588 QbeGen.CopyOp("0", q)
- 1589 END
- 1590 END
- 1591 ELSIF t = SymTab.InvalidType THEN
- 1592 ELSIF (SymTab.ClassOf(t) #
- 1593 SymTab.ClRecord)
- 1594 AND (SymTab.ClassOf(t) #
- 1595 SymTab.ClClass) THEN
- 1596 SemError(215);
- 1597 t := SymTab.InvalidType
- 1598 ELSIF NOT SymTab.FieldExists(t,
- 1599 fn) THEN
- 1600 SemError(216);
- 1601 t := SymTab.InvalidType
- 1602 ELSE
- 1603 fo := SymTab.FieldOffset(t,
- 1604 fn);
- 1605 t := SymTab.FieldType(t, fn);
- 1606 QbeGen.FieldAddr(q, fo, qe);
- 1607 (* array fields are inline:
- 1608 the field address is the
- 1609 descriptor, like records *)
- 1610 QbeGen.CopyOp(qe, q);
- 1611 sfx := TRUE
- 1612 END; .)
- 1613 | "^"
- 1614 (. IF t = SymTab.InvalidType THEN
- 1615 ELSIF SymTab.ClassOf(t) #
- 1616 SymTab.ClPtr THEN
- 1617 SemError(219);
- 1618 t := SymTab.InvalidType
- 1619 ELSE
- 1620 bt := SymTab.PtrBase(t);
- 1621 IF bt = SymTab.InvalidType THEN
- 1622 ELSE
- 1623 IF sfx THEN
- 1624 QbeGen.ElemLoad(q, t,
- 1625 qb);
- 1626 QbeGen.CopyOp(qb, q)
- 1627 END;
- 1628 t := bt;
- 1629 IF (SymTab.ClassOf(bt) =
- 1630 SymTab.ClInt)
- 1631 OR (SymTab.ClassOf(bt) =
- 1632 SymTab.ClBool)
- 1633 OR (SymTab.ClassOf(bt) =
- 1634 SymTab.ClChar)
- 1635 OR (SymTab.ClassOf(bt) =
- 1636 SymTab.ClReal) THEN
- 1637 sfx := TRUE
- 1638 ELSE sfx := FALSE
- 1639 END
- 1640 END
- 1641 END; .) } .
- 1642 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1643 (. VAR t2: SymTab.TypeIndex;
- 1644 op: INTEGER;
- 1645 q2, qt, wl: QbeGen.QVal;
- 1646 isR: BOOLEAN; .)
- 1647 = SimExpr<t, q>
- 1648 [ Rel<op> SimExpr<t2, q2>
- 1649 (. IF op = SymTab.OpIn THEN
- 1650 IF SymTab.InCheck(t, t2) THEN
- 1651 IF (t = SymTab.InvalidType)
- 1652 OR (t2 = SymTab.InvalidType) THEN
- 1653 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1654 ELSE
- 1655 QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
- 1656 SymTab.SetCount(t2), qt);
- 1657 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1658 END
- 1659 ELSE SemError(222); t := SymTab.InvalidType;
- 1660 QbeGen.CopyOp("0", q)
- 1661 END
- 1662 ELSIF SymTab.RelCheck(t, t2, op) THEN
- 1663 IF (t = SymTab.InvalidType)
- 1664 OR (t2 = SymTab.InvalidType) THEN
- 1665 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1666 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
- 1667 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
- 1668 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
- 1669 AND (op # SymTab.OpNeq2) THEN
- 1670 SemError(213); t := SymTab.InvalidType;
- 1671 QbeGen.CopyOp("0", q)
- 1672 ELSE
- 1673 QbeGen.CmpL(op, q, q2, qt);
- 1674 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1675 END
- 1676 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
- 1677 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1678 QbeGen.CmpSet(op, q, q2,
- 1679 SymTab.SetWords(t), SymTab.SetWords(t2), qt);
- 1680 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1681 ELSIF SymTab.IsLongFamily(t)
- 1682 OR SymTab.IsLongFamily(t2) THEN
- 1683 IF SymTab.IsIntFamily(t) THEN
- 1684 QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
- 1685 END;
- 1686 IF SymTab.IsIntFamily(t2) THEN
- 1687 QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
- 1688 END;
- 1689 QbeGen.CmpLong(op, q, q2, qt);
- 1690 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1691 ELSE
- 1692 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1693 t := SymTab.BoolType();
- 1694 QbeGen.Cmp(op, q, q2, qt, isR);
- 1695 QbeGen.CopyOp(qt, q)
- 1696 END
- 1697 ELSE SemError(213); t := SymTab.InvalidType;
- 1698 QbeGen.CopyOp("0", q)
- 1699 END; .) ] .
- 1700 Rel<VAR op: INTEGER>
- 1701 = "=" (. op := SymTab.OpEq; .)
- 1702 | "#" (. op := SymTab.OpNeq1; .)
- 1703 | "<" (. op := SymTab.OpLt; .)
- 1704 | "<=" (. op := SymTab.OpLe; .)
- 1705 | ">" (. op := SymTab.OpGt; .)
- 1706 | ">=" (. op := SymTab.OpGe; .)
- 1707 | "IN" (. op := SymTab.OpIn; .) .
- 1708 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1709 (. VAR t2, res2, lt, rt:
- 1710 SymTab.TypeIndex;
- 1711 op: INTEGER;
- 1712 q2, qt, wq, qf:
- 1713 QbeGen.QVal;
- 1714 neg, isR, isL, folded:
- 1715 BOOLEAN;
- 1716 lw, rw, mw: CARDINAL; .)
- 1717 = (. neg := FALSE; .)
- 1718 [ "+" | "-" (. neg := TRUE; .) ]
- 1719 Term<t, q> (. IF neg THEN
- 1720 IF QbeGen.IsImm(q) THEN
- 1721 QbeGen.NegFold(q, q)
- 1722 ELSE QbeGen.NewTemp(qt);
- 1723 QbeGen.NegQ(q, qt,
- 1724 SymTab.ClassOf(t)
- 1725 = SymTab.ClReal);
- 1726 QbeGen.CopyOp(qt, q)
- 1727 END
- 1728 END; .)
- 1729 { AddOp<op> Term<t2, q2>
- 1730 (. IF op = SymTab.OpOr THEN
- 1731 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
- 1732 t := SymTab.BoolType()
- 1733 ELSE SemError(212); t := SymTab.InvalidType END;
- 1734 IF t # SymTab.InvalidType THEN
- 1735 QbeGen.NewTemp(qt);
- 1736 QbeGen.Op3("or", qt, q, q2, FALSE);
- 1737 QbeGen.CopyOp(qt, q)
- 1738 ELSE QbeGen.CopyOp("0", q)
- 1739 END
- 1740 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
- 1741 AND (SymTab.ClassOf(t) = SymTab.ClSet)
- 1742 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1743 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1744 mw := lw;
- 1745 IF rw > mw THEN mw := rw END;
- 1746 IF op = SymTab.OpAdd THEN
- 1747 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
- 1748 ELSE
- 1749 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
- 1750 END;
- 1751 t := SymTab.NewSet(
- 1752 SymTab.NewSubR(0,
- 1753 VAL(INTEGER, mw) * 32 - 1));
- 1754 QbeGen.CopyOp(qt, q)
- 1755 ELSE
- 1756 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
- 1757 lt := t; rt := t2; t := res2
- 1758 ELSE SemError(211); t := SymTab.InvalidType END;
- 1759 IF t # SymTab.InvalidType THEN
- 1760 isL := SymTab.IsLongFamily(t);
- 1761 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1762 folded := FALSE;
- 1763 IF (NOT isL) AND (NOT isR)
- 1764 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
- 1765 IF op = SymTab.OpAdd THEN
- 1766 folded := QbeGen.Fold2(0, q, q2, qf)
- 1767 ELSE
- 1768 folded := QbeGen.Fold2(1, q, q2, qf)
- 1769 END
- 1770 END;
- 1771 IF folded THEN QbeGen.CopyOp(qf, q)
- 1772 ELSE
- 1773 IF isL THEN
- 1774 IF SymTab.IsIntFamily(lt) THEN
- 1775 QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
- 1776 END;
- 1777 IF SymTab.IsIntFamily(rt) THEN
- 1778 QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
- 1779 END;
- 1780 QbeGen.NewTemp(qt);
- 1781 IF op = SymTab.OpAdd THEN
- 1782 QbeGen.Op3L("add", qt, q, q2)
- 1783 ELSE
- 1784 QbeGen.Op3L("sub", qt, q, q2)
- 1785 END
- 1786 ELSE
- 1787 QbeGen.NewTemp(qt);
- 1788 IF op = SymTab.OpAdd THEN
- 1789 QbeGen.Op3("add", qt, q, q2, isR)
- 1790 ELSE
- 1791 QbeGen.Op3("sub", qt, q, q2, isR)
- 1792 END
- 1793 END;
- 1794 QbeGen.CopyOp(qt, q)
- 1795 END
- 1796 ELSE QbeGen.CopyOp("0", q)
- 1797 END
- 1798 END; .) } .
- 1799 AddOp<VAR op: INTEGER>
- 1800 = "+" (. op := SymTab.OpAdd; .)
- 1801 | "-" (. op := SymTab.OpSub; .)
- 1802 | "OR" (. op := SymTab.OpOr; .) .
- 1803 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1804 (. VAR t2, res2, lt, rt:
- 1805 SymTab.TypeIndex;
- 1806 op: INTEGER;
- 1807 q2, qt, wq, qf:
- 1808 QbeGen.QVal;
- 1809 isR, isL, folded: BOOLEAN;
- 1810 lw, rw, mw: CARDINAL; .)
- 1811 = Fact<t, q> { MulOp<op> Fact<t2, q2>
- 1812 (. IF op = SymTab.OpAnd THEN
- 1813 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
- 1814 t := SymTab.BoolType()
- 1815 ELSE SemError(212); t := SymTab.InvalidType END;
- 1816 IF t # SymTab.InvalidType THEN
- 1817 QbeGen.NewTemp(qt);
- 1818 QbeGen.Op3("and", qt, q, q2, FALSE);
- 1819 QbeGen.CopyOp(qt, q)
- 1820 ELSE QbeGen.CopyOp("0", q)
- 1821 END
- 1822 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
- 1823 AND (SymTab.ClassOf(t) = SymTab.ClSet)
- 1824 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1825 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1826 mw := lw;
- 1827 IF rw > mw THEN mw := rw END;
- 1828 IF op = SymTab.OpTimes THEN
- 1829 QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
- 1830 ELSE
- 1831 QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
- 1832 END;
- 1833 t := SymTab.NewSet(
- 1834 SymTab.NewSubR(0,
- 1835 VAL(INTEGER, mw) * 32 - 1));
- 1836 QbeGen.CopyOp(qt, q)
- 1837 ELSE
- 1838 IF SymTab.ArithCheck(t, t2,
- 1839 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
- 1840 res2) THEN
- 1841 lt := t; rt := t2; t := res2
- 1842 ELSE SemError(211); t := SymTab.InvalidType END;
- 1843 IF t # SymTab.InvalidType THEN
- 1844 isL := SymTab.IsLongFamily(t);
- 1845 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1846 folded := FALSE;
- 1847 IF (NOT isL) AND (NOT isR)
- 1848 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
- 1849 IF op = SymTab.OpTimes THEN
- 1850 folded := QbeGen.Fold2(2, q, q2, qf)
- 1851 ELSIF op = SymTab.OpDiv THEN
- 1852 folded := QbeGen.Fold2(3, q, q2, qf)
- 1853 ELSIF op = SymTab.OpMod THEN
- 1854 folded := QbeGen.Fold2(4, q, q2, qf)
- 1855 END
- 1856 END;
- 1857 IF folded THEN QbeGen.CopyOp(qf, q)
- 1858 ELSE
- 1859 IF isL THEN
- 1860 IF SymTab.IsIntFamily(lt) THEN
- 1861 QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
- 1862 END;
- 1863 IF SymTab.IsIntFamily(rt) THEN
- 1864 QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
- 1865 END;
- 1866 QbeGen.NewTemp(qt);
- 1867 IF op = SymTab.OpTimes THEN
- 1868 QbeGen.Op3L("mul", qt, q, q2)
- 1869 ELSIF (op = SymTab.OpDiv)
- 1870 OR (op = SymTab.OpSlash) THEN
- 1871 QbeGen.Op3L("div", qt, q, q2)
- 1872 ELSE
- 1873 QbeGen.Op3L("rem", qt, q, q2)
- 1874 END
- 1875 ELSE
- 1876 QbeGen.NewTemp(qt);
- 1877 IF op = SymTab.OpTimes THEN
- 1878 QbeGen.Op3("mul", qt, q, q2, isR)
- 1879 ELSIF (op = SymTab.OpDiv)
- 1880 OR (op = SymTab.OpSlash) THEN
- 1881 QbeGen.Op3("div", qt, q, q2, isR)
- 1882 ELSE
- 1883 QbeGen.Op3("rem", qt, q, q2, isR)
- 1884 END
- 1885 END;
- 1886 QbeGen.CopyOp(qt, q)
- 1887 END
- 1888 ELSE QbeGen.CopyOp("0", q)
- 1889 END
- 1890 END; .) } .
- 1891 MulOp<VAR op: INTEGER>
- 1892 = "*" (. op := SymTab.OpTimes; .)
- 1893 | "/" (. op := SymTab.OpSlash; .)
- 1894 | "DIV" (. op := SymTab.OpDiv; .)
- 1895 | "MOD" (. op := SymTab.OpMod; .)
- 1896 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
- 1897 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1898 (. VAR s: ARRAY [0 .. 255] OF CHAR;
- 1899 et, dt, t2, st, ct2:
- 1900 SymTab.TypeIndex;
- 1901 dk: INTEGER;
- 1902 qd, q2, sq, qa, qm0, qr:
- 1903 QbeGen.QVal;
- 1904 qn, vn: SymTab.Name;
- 1905 vt: SymTab.TypeIndex;
- 1906 c1, c2: INTEGER;
- 1907 called, isHigh, sfx, isCh:
- 1908 BOOLEAN; .)
- 1909 = integer (. LexString(s);
- 1910 QbeGen.NormInt(s, q);
- 1911 t := SymTab.IntType(); .)
- 1912 | charConst (. LexString(s);
- 1913 QbeGen.NormLit(s, q, isCh);
- 1914 t := SymTab.CharType(); .)
- 1915 | real (. LexString(s);
- 1916 QbeGen.NormReal(s, q);
- 1917 t := SymTab.RealType(); .)
- 1918 | string (. LexString(s);
- 1919 IF SymTab.StrLen(s) = 3 THEN
- 1920 t := SymTab.CharType();
- 1921 QbeGen.IntStr(
- 1922 QbeGen.CharVal(s), q)
- 1923 ELSE t := SymTab.NewStr();
- 1924 QbeGen.DeclStr(s, q);
- 1925 (* a literal's value IS its
- 1926 static descriptor address *)
- 1927 QbeGen.NoteAddr(q, q)
- 1928 END; .)
- 1929 | Design<dt, dk, qd, qn, sfx> (. called := FALSE;
- 1930 t := dt;
- 1931 IF sfx THEN
- 1932 IF dt =
- 1933 SymTab.InvalidType THEN
- 1934 QbeGen.CopyOp("0", q)
- 1935 ELSIF (SymTab.ClassOf(dt) =
- 1936 SymTab.ClRecord)
- 1937 OR (SymTab.ClassOf(dt) =
- 1938 SymTab.ClSet)
- 1939 OR (SymTab.ClassOf(dt) =
- 1940 SymTab.ClArray)
- 1941 OR (SymTab.ClassOf(dt) =
- 1942 SymTab.ClClass) THEN
- 1943 QbeGen.CopyOp(qd, q)
- 1944 ELSE QbeGen.ElemLoad(qd, dt,
- 1945 q)
- 1946 END
- 1947 ELSE QbeGen.CopyOp(qd, q)
- 1948 END;
- 1949 IF (dk = SymTab.KindVar)
- 1950 OR (dk = SymTab.KindParam)
- 1951 OR (dk =
- 1952 SymTab.KindField) THEN
- 1953 IF sfx THEN
- 1954 QbeGen.NoteAddr(q, qd)
- 1955 ELSE
- 1956 QbeGen.AddrOf(qn, qa);
- 1957 QbeGen.NoteAddr(q, qa)
- 1958 END
- 1959 ELSIF sfx
- 1960 AND (dt #
- 1961 SymTab.InvalidType)
- 1962 AND ((SymTab.ClassOf(dt) =
- 1963 SymTab.ClArray)
- 1964 OR (SymTab.ClassOf(dt) =
- 1965 SymTab.ClSet)
- 1966 OR (SymTab.ClassOf(dt) =
- 1967 SymTab.ClRecord)) THEN
- 1968 QbeGen.NoteAddr(qd, qd)
- 1969 END; .)
- 1970 [ TypedSetLit<dt, q> (. t := dt; .) ]
- 1971 [ ArgList<qn, dt, qd, TRUE, ct2, q2, called>
- 1972 (. t := ct2;
- 1973 QbeGen.CopyOp(q2, q); .) ]
- 1974 (. IF NOT called
- 1975 AND (dk = SymTab.KindProc) THEN
- 1976 (* bare zero-arg function
- 1977 call (parentheses may be
- 1978 omitted); a proper or
- 1979 parameterised proc here
- 1980 is 230 *)
- 1981 IF (SymTab.ProcNPar(qn) = 0)
- 1982 AND (SymTab.ProcRes(qn) #
- 1983 SymTab.InvalidType) THEN
- 1984 QbeGen.Mangled(qn,
- 1985 SymTab.ProcUid(qn), qm0);
- 1986 QbeGen.CallBegin(qm0,
- 1987 SymTab.ProcRes(qn),
- 1988 SymTab.ProcDepthOf(qn),
- 1989 SymTab.IsExternal(qn));
- 1990 QbeGen.CallEnd(TRUE, q);
- 1991 t := SymTab.ProcRes(qn)
- 1992 ELSE
- 1993 (* procedure used as a
- 1994 value (assign to a
- 1995 procedure variable):
- 1996 its code address *)
- 1997 t := SymTab.ProcTypeOf(qn);
- 1998 QbeGen.Mangled(qn,
- 1999 SymTab.ProcUid(qn), qm0);
- 2000 QbeGen.ProcAddr(qm0, q)
- 2001 END
- 2002 END; .)
- 2003 | ( "HIGH" (. isHigh := TRUE; .)
- 2004 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
- 2005 "(" Design<dt, dk, qd, qn, sfx> ")"
- 2006 (. IF dt = SymTab.InvalidType THEN
- 2007 ELSIF SymTab.ClassOf(dt) #
- 2008 SymTab.ClArray THEN
- 2009 SemError(217);
- 2010 t := SymTab.InvalidType;
- 2011 QbeGen.CopyOp("0", q)
- 2012 ELSE
- 2013 IF isHigh THEN
- 2014 IF SymTab.IsOpenArray(dt) THEN
- 2015 QbeGen.OpenHi(qd, qr)
- 2016 ELSE
- 2017 QbeGen.IntStr(
- 2018 SymTab.ArrayHi(dt), qr)
- 2019 END
- 2020 ELSE
- 2021 IF SymTab.IsOpenArray(dt) THEN
- 2022 QbeGen.LoadCount(qd, qr)
- 2023 ELSE
- 2024 QbeGen.IntStr(VAL(
- 2025 INTEGER,
- 2026 SymTab.ArrayLen(dt)),
- 2027 qr)
- 2028 END
- 2029 END;
- 2030 t := SymTab.IntType();
- 2031 QbeGen.CopyOp(qr, q)
- 2032 END; .)
- 2033 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
- 2034 (. IF dt = SymTab.InvalidType THEN
- 2035 t := SymTab.InvalidType;
- 2036 QbeGen.CopyOp("0", q)
- 2037 ELSE
- 2038 QbeGen.IntStr(VAL(INTEGER,
- 2039 SymTab.ObjectSize(dt)), q);
- 2040 t := SymTab.IntType()
- 2041 END; .)
- 2042 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
- 2043 (. IF dt = SymTab.InvalidType THEN
- 2044 t := SymTab.InvalidType;
- 2045 QbeGen.CopyOp("0", q)
- 2046 ELSE
- 2047 IF sfx THEN
- 2048 QbeGen.CopyOp(qd, q)
- 2049 ELSIF (dk = SymTab.KindVar)
- 2050 OR (dk = SymTab.KindParam) THEN
- 2051 QbeGen.AddrOf(qn, q)
- 2052 ELSE SemError(230);
- 2053 QbeGen.CopyOp("0", q)
- 2054 END;
- 2055 t := SymTab.AddrType()
- 2056 END; .)
- 2057 | "CHR" "(" Expr<et, q> ")"
- 2058 (. IF (et # SymTab.InvalidType)
- 2059 AND NOT SymTab.IsIntFamily(et) THEN
- 2060 SemError(211) END;
- 2061 t := SymTab.CharType(); .)
- 2062 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
- 2063 (. IF et # SymTab.InvalidType THEN
- 2064 IF (SymTab.ClassOf(et) #
- 2065 SymTab.ClChar)
- 2066 AND (SymTab.ClassOf(et) #
- 2067 SymTab.ClBool)
- 2068 AND (SymTab.ClassOf(et) #
- 2069 SymTab.ClEnum)
- 2070 AND NOT SymTab.IsIntFamily(et) THEN
- 2071 SemError(211) END
- 2072 END;
- 2073 t := SymTab.IntType(); .)
- 2074 | "CAP" "(" Expr<et, q> ")"
- 2075 (. QbeGen.CapQ(q, qa);
- 2076 QbeGen.CopyOp(qa, q);
- 2077 t := SymTab.CharType(); .)
- 2078 | "ABS" "(" Expr<et, q> ")"
- 2079 (. IF (et # SymTab.InvalidType)
- 2080 AND NOT SymTab.IsIntFamily(et)
- 2081 AND (SymTab.ClassOf(et) #
- 2082 SymTab.ClReal) THEN
- 2083 SemError(211)
- 2084 ELSE QbeGen.AbsQ(q, qa,
- 2085 SymTab.ClassOf(et) =
- 2086 SymTab.ClReal);
- 2087 QbeGen.CopyOp(qa, q)
- 2088 END;
- 2089 t := et; .)
- 2090 | "VAL" "(" GetIdent<vn> "," Expr<et, q> ")"
- 2091 (. IF NOT SymTab.Lookup(vn) THEN
- 2092 SemError(201);
- 2093 t := SymTab.InvalidType
- 2094 ELSE vt := SymTab.SymType(vn);
- 2095 IF vt = SymTab.InvalidType THEN
- 2096 t := SymTab.InvalidType
- 2097 ELSIF et =
- 2098 SymTab.InvalidType THEN
- 2099 t := vt
- 2100 ELSE
- 2101 c1 := SymTab.ClassOf(et);
- 2102 c2 := SymTab.ClassOf(vt);
- 2103 IF ((c1 = SymTab.ClInt)
- 2104 OR (c1 =
- 2105 SymTab.ClChar)
- 2106 OR (c1 =
- 2107 SymTab.ClBool)
- 2108 OR (c1 =
- 2109 SymTab.ClEnum))
- 2110 AND ((c2 = SymTab.ClInt)
- 2111 OR (c2 =
- 2112 SymTab.ClChar)
- 2113 OR (c2 =
- 2114 SymTab.ClBool)
- 2115 OR (c2 =
- 2116 SymTab.ClEnum)) THEN
- 2117 t := vt
- 2118 ELSIF (c1 = SymTab.ClPtr)
- 2119 AND (c2 = SymTab.ClPtr) THEN
- 2120 t := vt
- 2121 ELSIF (c1 = SymTab.ClReal)
- 2122 AND (c2 = SymTab.ClReal) THEN
- 2123 t := vt
- 2124 ELSE SemError(230);
- 2125 t := SymTab.InvalidType
- 2126 END
- 2127 END
- 2128 END; .)
- 2129 | "(" Expr<et, q> ")" (. t := et; .)
- 2130 | SetLit<st, sq> (. t := st;
- 2131 QbeGen.CopyOp(sq, q); .)
- 2132 | ( "NOT" | "~" ) Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
- 2133 t := SymTab.BoolType()
- 2134 ELSE SemError(212);
- 2135 t := SymTab.InvalidType END;
- 2136 IF t # SymTab.InvalidType THEN
- 2137 QbeGen.NotQ(q2, q)
- 2138 ELSE QbeGen.CopyOp("0", q)
- 2139 END; .) .
- 2140 (* Set literals are SET OF [0..255] (8 words); elements validated
- 2141 0..255 statically when foldable (222 otherwise), runtime trap
- 2142 for computed elements. Ranges always lower via SetRange. *)
- 2143 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2144 = "{" (. t := SymTab.NewSet(
- 2145 SymTab.NewSubR(0, 255));
- 2146 QbeGen.NewSetTemp(8, q);
- 2147 QbeGen.SetZero(q, 8); .)
- 2148 [ SetElem<t, q> { "," SetElem<t, q> } ]
- 2149 "}" .
- 2150 (* Typed set constructor: TypeName{ elems } — e.g. BITSET{0},
- 2151 BITSET{}. The declared type (not SET OF [0..255]) sets the
- 2152 width and element span. *)
- 2153 TypedSetLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 2154 (. VAR nw: CARDINAL; .)
- 2155 = "{" (. IF SymTab.ClassOf(vt) #
- 2156 SymTab.ClSet THEN
- 2157 SemError(230); nw := 8
- 2158 ELSE nw := SymTab.SetWords(vt);
- 2159 IF nw = 0 THEN nw := 8 END
- 2160 END;
- 2161 QbeGen.NewSetTemp(nw, q);
- 2162 QbeGen.SetZero(q, nw); .)
- 2163 [ SetElem<vt, q> { "," SetElem<vt, q> } ]
- 2164 "}" .
- 2165 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal> (. VAR et, et2: SymTab.TypeIndex;
- 2166 qe, q2: QbeGen.QVal;
- 2167 v, v2: INTEGER;
- 2168 lo: INTEGER;
- 2169 span: CARDINAL;
- 2170 cl, cl2: INTEGER;
- 2171 hasR: BOOLEAN; .)
- 2172 = (. hasR := FALSE; .)
- 2173 Expr<et, qe>
- 2174 [ ".." Expr<et2, q2> (. hasR := TRUE; .) ]
- 2175 (. lo := SymTab.SetBaseLo(st);
- 2176 span := SymTab.SetCount(st);
- 2177 IF (et = SymTab.InvalidType)
- 2178 OR (hasR AND (et2 =
- 2179 SymTab.InvalidType)) THEN
- 2180 ELSE cl :=
- 2181 SymTab.ClassOf(et);
- 2182 IF hasR THEN
- 2183 cl2 :=
- 2184 SymTab.ClassOf(et2)
- 2185 ELSE cl2 := SymTab.ClInt
- 2186 END;
- 2187 IF ((cl # SymTab.ClInt)
- 2188 AND (cl # SymTab.ClChar)
- 2189 AND (cl # SymTab.ClBool))
- 2190 OR (hasR AND
- 2191 ((cl2
- 2192 # SymTab.ClInt)
- 2193 AND (cl2
- 2194 # SymTab.ClChar)
- 2195 AND (cl2
- 2196 # SymTab.ClBool))) THEN
- 2197 SemError(222)
- 2198 ELSIF hasR
- 2199 AND SymTab.ConstInt(qe, v)
- 2200 AND SymTab.ConstInt(q2,
- 2201 v2)
- 2202 AND ((v < lo)
- 2203 OR (v2 < lo)
- 2204 OR (v >= lo +
- 2205 VAL(INTEGER, span))
- 2206 OR (v2 >= lo +
- 2207 VAL(INTEGER, span))
- 2208 OR (v > v2)) THEN
- 2209 SemError(222)
- 2210 ELSIF hasR THEN
- 2211 QbeGen.SetRange(sq, qe, q2,
- 2212 lo, span)
- 2213 ELSIF SymTab.ConstInt(qe,
- 2214 v)
- 2215 AND ((v < lo)
- 2216 OR (v >= lo +
- 2217 VAL(INTEGER,
- 2218 span))) THEN
- 2219 SemError(222)
- 2220 ELSE QbeGen.SetBit(sq, qe,
- 2221 lo, span)
- 2222 END
- 2223 END; .) .
- 2224 GetIdent<VAR n: SymTab.Name>
- 2225 = ident (. LexName(n); .) .
- 2226
- 2227 END M2.
- 0 errors
- Statistics:
- nr of terminals: 94 (limit 400)
- nr of non-terminals: 78 (limit 210)
- nr of pragmas: 0 (limit 406)
- nr of symbolnodes: 172 (limit 500)
- nr of graphnodes: 862 (limit 1500)
- nr of conditionsets: 9 (limit 100)
- nr of charactersets: 12 (limit 250)
|
