| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847 |
- 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
- 81 PRODUCTIONS
- 82 M2
- 83 = Unit "." .
- 84 (* Units: program modules compile fully; DEFINITION and
- 85 IMPLEMENTATION modules parse + check now but lower in step 4
- 86 (each ends with one 230); same for nested local modules. *)
- 87 Unit
- 88 = DefUnit
- 89 | ImplUnit
- 90 | ProgModule .
- 91 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
- 92 and one program (last) into one image. Units share the symbol
- 93 table; imports materialize exported names. *)
- 94 DefUnit (. VAR m1, m2, pn: SymTab.Name; .)
- 95 = "DEFINITION" "MODULE"
- 96 GetIdent<m1> (. IF ~SymTab.BeginDef(m1) THEN
- 97 SemError(200) END;
- 98 QbeGen.SetModule(m1); .)
- 99 ";"
- 100 { Import }
- 101 { ConstBlock | TypeBlock<TRUE> | VarBlock
- 102 | ProcHeading<pn> ";" (. SymTab.CloseProc;
- 103 QbeGen.AbortFunc; .) }
- 104 "END"
- 105 GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
- 106 SemError(202) END;
- 107 SymTab.EndUnit; .) .
- 108 ImplUnit (. VAR m1, m2: SymTab.Name; .)
- 109 = "IMPLEMENTATION" "MODULE"
- 110 GetIdent<m1> (. IF ~SymTab.BeginImpl(m1) THEN
- 111 SemError(201) END;
- 112 QbeGen.SetModule(m1); .)
- 113 ";"
- 114 { Import }
- 115 DeclSeq
- 116 [ "BEGIN" (. QbeGen.BeginInit(m1); .)
- 117 [ StatSeq ] (. QbeGen.EndInit; .) ]
- 118 "END"
- 119 GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
- 120 SemError(202) END;
- 121 SymTab.EndUnit; .) .
- 122 ProgModule (. VAR m1, m2: SymTab.Name; .)
- 123 = "MODULE"
- 124 GetIdent<m1> (. IF ~SymTab.BeginProg(m1) THEN
- 125 SemError(200) END;
- 126 QbeGen.SetModule(m1); .)
- 127 [ Priority ]
- 128 ";"
- 129 { Import }
- 130 DeclSeq
- 131 [ "BEGIN" (. QbeGen.BeginBody; .)
- 132 [ StatSeq ] ]
- 133 "END"
- 134 GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
- 135 SemError(202) END;
- 136 QbeGen.EndModule(m1);
- 137 SymTab.EndUnit; .) .
- 138 DeclSeq
- 139 = { ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
- 140 | NestedModule ";" | ClassItem ";" } .
- 141 (* Local module, Wirth form. Parses + checks fully (own scope);
- 142 lowering waits for step 4, marked by one 230 at END. *)
- 143 NestedModule (. VAR m1, m2: SymTab.Name; .)
- 144 = "MODULE"
- 145 GetIdent<m1> (. IF ~SymTab.Enter(m1,
- 146 SymTab.KindModule) THEN
- 147 SemError(200) END;
- 148 SymTab.PushScope; .)
- 149 [ Priority ]
- 150 ";"
- 151 { Import }
- 152 [ Export ]
- 153 DeclSeq
- 154 [ "BEGIN"
- 155 [ StatSeq ] ]
- 156 "END"
- 157 GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
- 158 SemError(202) END;
- 159 SymTab.PopScope;
- 160 SemError(230); .) .
- 161 Priority
- 162 = "[" integer "]" (. SemError(230); .) .
- 163 Export (. VAR nm: SymTab.Name; .)
- 164 = "EXPORT" (* names wire up in step 4 *)
- 165 [ "QUALIFIED" ]
- 166 GetIdent<nm>
- 167 { "," GetIdent<nm> }
- 168 ";" .
- 169 (* Imports (4.3): FROM materializes the names (unqualified use);
- 170 plain IMPORT only demands the module exists — qualified `L.x`
- 171 materializes on first use (Design). *)
- 172 (* Unknown modules stay unchecked stubs (legacy, so hand-written
- 173 import lines don't fail); a known module's missing export is
- 174 201. *)
- 175 Import (. VAR n: SymTab.Name; .)
- 176 = "FROM"
- 177 GetIdent<n>
- 178 "IMPORT"
- 179 ImpList<n> ";"
- 180 | "IMPORT"
- 181 ImpModList ";" .
- 182 ImpList<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
- 183 = GetIdent<n> (. IF SymTab.ModKnown(mod)
- 184 & ~SymTab.ImportFrom(mod, n) THEN
- 185 SemError(201) END; .)
- 186 { ","
- 187 GetIdent<n> (. IF SymTab.ModKnown(mod)
- 188 & ~SymTab.ImportFrom(mod, n) THEN
- 189 SemError(201) END; .) } .
- 190 ImpModList (. VAR n: SymTab.Name; .)
- 191 = GetIdent<n>
- 192 { "," GetIdent<n> } .
- 193 (* Opaque TYPE declarations (definition modules). The targetless
- 194 alias resolves to InvalidType until step 4 completes it. *)
- 195 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
- 196 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
- 197 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
- 198 TypeBlock<isDef: BOOLEAN>
- 199 = "TYPE" { TypeItem<isDef> ";" | ClassItem ";" } .
- 200 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
- 201 t, op: SymTab.TypeIndex; .)
- 202 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
- 203 IF op = SymTab.InvalidType THEN
- 204 IF ~SymTab.Enter(n,
- 205 SymTab.KindType) THEN
- 206 SemError(200) END
- 207 END; .)
- 208 ( "=" Type<t, FALSE> (. IF op # SymTab.InvalidType THEN
- 209 SymTab.SetTarget(op, t)
- 210 ELSE SymTab.SetSymType(n, t)
- 211 END; .)
- 212 | (. IF op # SymTab.InvalidType THEN
- 213 (* stays opaque *)
- 214 ELSIF ~isDef THEN
- 215 SemError(231)
- 216 ELSE SymTab.SetSymType(n,
- 217 SymTab.NewAlias()) END; .) ) .
- 218 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
- 219 = TypeIdent<t>
- 220 | Subrange<t>
- 221 | Enum<t>
- 222 | ArrayType<t, allowOpen>
- 223 | SetType<t>
- 224 | RecordType<t>
- 225 | PointerType<t> .
- 226 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
- 227 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
- 228 (* Arrays: "OF" without bounds is an open formal (allowed only
- 229 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
- 230 out. Bounds are folded literals (int/char); anything else 230.
- 231 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
- 232 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
- 233 (. VAR elem: SymTab.TypeIndex;
- 234 ok: BOOLEAN; .)
- 235 = "ARRAY"
- 236 ( "OF" Type<elem, FALSE> (. IF ~allowOpen THEN
- 237 SemError(230) END;
- 238 t := SymTab.NewOpenArray(elem); .)
- 239 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
- 240 BoundPair<ok>
- 241 { "," BoundPair<ok> }
- 242 "]" "OF" Type<elem, FALSE>
- 243 (. IF ok THEN
- 244 t := SymTab.NestArray(elem)
- 245 ELSE t := SymTab.InvalidType
- 246 END; .) ) .
- 247 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
- 248 qlo, qhi: QbeGen.QVal;
- 249 lo, hi: INTEGER;
- 250 cl, cl2: INTEGER; .)
- 251 = Expr<tlo, qlo> ".." Expr<thi, qhi>
- 252 (. IF (tlo = SymTab.InvalidType)
- 253 OR (thi = SymTab.InvalidType) THEN
- 254 ok := FALSE
- 255 ELSE cl := SymTab.ClassOf(tlo);
- 256 cl2 := SymTab.ClassOf(thi);
- 257 IF ((cl # SymTab.ClInt)
- 258 & (cl # SymTab.ClChar))
- 259 OR ((cl2 # SymTab.ClInt)
- 260 & (cl2 # SymTab.ClChar)) THEN
- 261 SemError(230); ok := FALSE
- 262 ELSIF ~SymTab.ConstInt(qlo, lo)
- 263 OR ~SymTab.ConstInt(qhi, hi)
- 264 OR (lo > hi) THEN
- 265 SemError(230); ok := FALSE
- 266 ELSIF ~SymTab.BoundAdd(lo, hi) THEN
- 267 SemError(230); ok := FALSE
- 268 END;
- 269 END; .) .
- 270 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
- 271 bounded subranges; enums wait for ordinals, INTEGER is
- 272 unbounded). Literals are SET OF [0..255]; assignment and
- 273 comparison across suitable bases are lenient (masks over min
- 274 words + zero-check extras), out-of-span literals are 222. *)
- 275 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
- 276 blo, bhi, bspan: INTEGER;
- 277 bcls: INTEGER; .)
- 278 = "SET" "OF" Type<base, FALSE>
- 279 (. IF base = SymTab.InvalidType THEN
- 280 t := SymTab.InvalidType
- 281 ELSE bcls :=
- 282 SymTab.ClassOf(base);
- 283 IF bcls = SymTab.ClBool THEN
- 284 blo := 0; bspan := 2
- 285 ELSIF bcls = SymTab.ClChar THEN
- 286 blo := 0; bspan := 256
- 287 ELSIF SymTab.SubBounds(base,
- 288 blo, bhi) THEN
- 289 bspan := bhi - blo + 1
- 290 ELSE bspan := 0 END;
- 291 IF (bspan <= 0)
- 292 OR (bspan > 256) THEN
- 293 SemError(230);
- 294 t := SymTab.InvalidType
- 295 ELSE t := SymTab.NewSet(base)
- 296 END
- 297 END; .) .
- 298 (* Records: flat blobs; array fields are pointers to static
- 299 descriptors (locked amendment), nested records inline. Field
- 300 offsets static and declaration-ordered. *)
- 301 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex; .)
- 302 = "RECORD" (. t := SymTab.NewRecord(); .)
- 303 [ RecField<t> { ";" RecField<t> } ]
- 304 "END" .
- 305 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
- 306 t2: SymTab.TypeIndex; .)
- 307 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
- 308 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
- 309 = GetIdent<n> (. IF ~SymTab.FieldPending(rec,
- 310 n) THEN
- 311 SemError(200) END; .)
- 312 { "," GetIdent<n> (. IF ~SymTab.FieldPending(rec,
- 313 n) THEN
- 314 SemError(200) END; .) } .
- 315 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
- 316 k: INTEGER; .)
- 317 = GetIdent<n> (. IF ~SymTab.Lookup(n) THEN
- 318 SemError(201);
- 319 t := SymTab.InvalidType
- 320 ELSE k := SymTab.SymKind(n);
- 321 IF (k = SymTab.KindType)
- 322 OR (k = SymTab.KindPredef) THEN
- 323 t := SymTab.SymType(n)
- 324 ELSIF k = SymTab.KindImport THEN
- 325 t := SymTab.InvalidType
- 326 ELSE SemError(221);
- 327 t := SymTab.InvalidType
- 328 END
- 329 END; .) .
- 330 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
- 331 qlo, qhi: QbeGen.QVal;
- 332 lo, hi: INTEGER; .)
- 333 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
- 334 (. IF (tlo = SymTab.InvalidType)
- 335 OR (thi = SymTab.InvalidType) THEN
- 336 t := SymTab.InvalidType
- 337 ELSIF (SymTab.ClassOf(tlo) #
- 338 SymTab.ClInt)
- 339 OR (SymTab.ClassOf(thi) #
- 340 SymTab.ClInt) THEN
- 341 SemError(230);
- 342 t := SymTab.InvalidType
- 343 ELSIF ~SymTab.ConstInt(qlo, lo)
- 344 OR ~SymTab.ConstInt(qhi, hi)
- 345 OR (lo > hi) THEN
- 346 SemError(230);
- 347 t := SymTab.InvalidType
- 348 ELSE t := SymTab.NewSubR(lo, hi)
- 349 END; .)
- 350 "]" .
- 351 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
- 352 = "(" (. t := SymTab.NewEnum(); .)
- 353 GetIdent<n> (. IF ~SymTab.Enter(n,
- 354 SymTab.KindConst) THEN
- 355 SemError(200) END;
- 356 SymTab.SetSymType(n, t); .)
- 357 { "," GetIdent<n> (. IF ~SymTab.Enter(n,
- 358 SymTab.KindConst) THEN
- 359 SemError(200) END;
- 360 SymTab.SetSymType(n, t); .) }
- 361 ")" .
- 362 (* Clarion-form classes (docs/OOP.txt): declaration + single
- 363 inheritance + IMPLEMENTATION blocks. Scopes and member checks
- 364 now; lowering (vtable, dispatch, THIS) later — one 230 per
- 365 class/impl block. Methods end with ";" per the Table example
- 366 (not "," as in the sketch). No underscores in identifiers. *)
- 367 (* Single CLASS item in both loops: separating declaration from
- 368 IMPLEMENTATION at the loop level needs 2-token lookahead
- 369 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
- 370 The second token decides after CLASS is consumed. A misplaced
- 371 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
- 372 whole unit ends 230 until lowering). *)
- 373 ClassItem
- 374 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
- 375 ClassRest (. VAR cn, m2, pn: SymTab.Name;
- 376 ct: SymTab.TypeIndex; .)
- 377 = GetIdent<cn> (. IF ~SymTab.Enter(cn,
- 378 SymTab.KindType) THEN
- 379 SemError(200) END;
- 380 ct := SymTab.NewClass();
- 381 SymTab.SetSymType(cn, ct);
- 382 SymTab.PushClassScope(ct); .)
- 383 [ Parents<ct> ]
- 384 ";"
- 385 { ClassField<ct> ";" }
- 386 { MethodHeading<pn> ";" (. SymTab.CloseProc;
- 387 QbeGen.AbortFunc; .) }
- 388 "END"
- 389 GetIdent<m2> (. IF ~SymTab.Equal(cn, m2) THEN
- 390 SemError(202) END;
- 391 SymTab.PopScope;
- 392 SemError(230); .) .
- 393 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
- 394 = "(" Parent1<ct>
- 395 { "," GetIdent<p> (. SemError(230); .) }
- 396 ")" .
- 397 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
- 398 pt: SymTab.TypeIndex; .)
- 399 = GetIdent<p> (. IF ~SymTab.Lookup(p) THEN
- 400 SemError(201)
- 401 ELSE pt := SymTab.SymType(p);
- 402 IF SymTab.ClassOf(pt) #
- 403 SymTab.ClClass THEN
- 404 SemError(230)
- 405 ELSE SymTab.SetParent(ct, pt)
- 406 END
- 407 END; .) .
- 408 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
- 409 t: SymTab.TypeIndex; .)
- 410 = GetIdent<n>
- 411 ( "=" GetIdent<rhs> (. IF ~SymTab.Enter(n,
- 412 SymTab.KindConst) THEN
- 413 SemError(200) END;
- 414 IF SymTab.Lookup(rhs) THEN
- 415 SymTab.SetSymType(n,
- 416 SymTab.SymType(rhs))
- 417 END; .)
- 418 | (. IF ~SymTab.FieldPending(ct,
- 419 n) THEN
- 420 SemError(200) END; .)
- 421 { "," GetIdent<n> (. IF ~SymTab.FieldPending(ct,
- 422 n) THEN
- 423 SemError(200) END; .) }
- 424 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t); .) ) .
- 425 MethodHeading<VAR pn: SymTab.Name> (. VAR wantVirt: BOOLEAN; .)
- 426 = (. wantVirt := FALSE; .)
- 427 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
- 428 ProcHeading<pn> (. IF wantVirt THEN
- 429 SymTab.MarkVirtual END; .) .
- 430 ClassImplRest (. VAR cn, m2: SymTab.Name;
- 431 ct: SymTab.TypeIndex; .)
- 432 = GetIdent<cn> (. IF ~SymTab.Lookup(cn) THEN
- 433 SemError(201);
- 434 ct := SymTab.InvalidType
- 435 ELSE ct := SymTab.SymType(cn);
- 436 IF SymTab.ClassOf(ct) #
- 437 SymTab.ClClass THEN
- 438 SemError(230);
- 439 ct := SymTab.InvalidType
- 440 END
- 441 END;
- 442 IF ct #
- 443 SymTab.InvalidType THEN
- 444 IF ~SymTab.PushClassMembers(
- 445 ct) THEN
- 446 SemError(230) END
- 447 END; .)
- 448 ";" { MethodImpl<ct> ";" }
- 449 [ "BEGIN"
- 450 [ StatSeq ] ]
- 451 "END"
- 452 GetIdent<m2> (. IF ~SymTab.Equal(cn, m2) THEN
- 453 SemError(202) END;
- 454 SymTab.PopScope;
- 455 SemError(230); .) .
- 456 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name; .)
- 457 = (. QbeGen.SetNoEmit(TRUE); .)
- 458 MethodHeading<pn> ";"
- 459 (. IF (ct #
- 460 SymTab.InvalidType)
- 461 & ~SymTab.MethodExists(ct,
- 462 pn) THEN
- 463 SemError(201) END; .)
- 464 ( "FORWARD" (. SymTab.MarkFwd;
- 465 SymTab.CloseProc; .)
- 466 | Block<pn> (. SymTab.CloseProc; .) )
- 467 (. QbeGen.AbortFunc;
- 468 QbeGen.SetNoEmit(FALSE);
- 469 SemError(230); .) .
- 470 ConstBlock
- 471 = "CONST" { ConstDecl ";" } .
- 472 ConstDecl (. VAR n: SymTab.Name;
- 473 t: SymTab.TypeIndex;
- 474 qv: QbeGen.QVal;
- 475 cls: INTEGER; .)
- 476 = GetIdent<n> (. IF ~SymTab.Enter(n,
- 477 SymTab.KindConst) THEN
- 478 SemError(200) END; .)
- 479 "="
- 480 Expr<t, qv> (. SymTab.SetSymType(n, t);
- 481 cls := SymTab.ClassOf(t);
- 482 IF cls = SymTab.ClStr THEN
- 483 SemError(230)
- 484 ELSIF ~QbeGen.IsImm(qv) THEN
- 485 SemError(230) END;
- 486 QbeGen.DeclConst(n, qv, t); .) .
- 487 VarBlock
- 488 = "VAR" { VarDecl ";" } .
- 489 VarDecl (. VAR nm: SymTab.Name;
- 490 t: SymTab.TypeIndex;
- 491 i: CARDINAL;
- 492 cls: INTEGER; .)
- 493 = VarIdents ":"
- 494 Type<t, FALSE> (. cls := SymTab.ClassOf(t);
- 495 IF (t # SymTab.InvalidType)
- 496 & (cls # SymTab.ClInt)
- 497 & (cls # SymTab.ClBool)
- 498 & (cls # SymTab.ClChar)
- 499 & (cls # SymTab.ClReal)
- 500 & (cls # SymTab.ClArray)
- 501 & (cls # SymTab.ClSet)
- 502 & (cls # SymTab.ClRecord)
- 503 & (cls # SymTab.ClPtr) THEN
- 504 SemError(230) END;
- 505 IF QbeGen.LocFull() THEN
- 506 SemError(233) END;
- 507 i := 0;
- 508 WHILE i < SymTab.PendCount() DO
- 509 SymTab.PendName(i, nm);
- 510 QbeGen.DeclVar(nm, t);
- 511 INC(i)
- 512 END;
- 513 SymTab.FixPending(t); .) .
- 514 VarIdents (. VAR n: SymTab.Name; .)
- 515 = GetIdent<n> (. IF ~SymTab.EnterPending(n,
- 516 SymTab.KindVar) THEN
- 517 SemError(200) END; .)
- 518 { ","
- 519 GetIdent<n> (. IF ~SymTab.EnterPending(n,
- 520 SymTab.KindVar) THEN
- 521 SemError(200) END; .) } .
- 522 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
- 523 = GetIdent<n> (. IF ~SymTab.EnterParam(n, isV) THEN
- 524 SemError(200) END; .)
- 525 { "," GetIdent<n> (. IF ~SymTab.EnterParam(n, isV) THEN
- 526 SemError(200) END; .) } .
- 527 (* Procedure headings enter scopes/params/result and buffer the
- 528 QBE header; bodies lower to functions (4.1, module level only).
- 529 FORWARD marks; the body heading re-enters (signature compare
- 530 deferred). Nested procedures parse + check, lowering = 4.2. *)
- 531 ProcHeading<VAR pn: SymTab.Name> (. VAR t: SymTab.TypeIndex;
- 532 mg: QbeGen.QVal; .)
- 533 = "PROCEDURE"
- 534 GetIdent<pn> (. IF ~SymTab.EnterProc(pn) THEN
- 535 IF ~SymTab.ReenterProc(pn) THEN
- 536 IF ~SymTab.ResumeProc(pn) THEN
- 537 SemError(200) END
- 538 END
- 539 END;
- 540 QbeGen.Mangled(pn,
- 541 SymTab.ProcUid(pn), mg);
- 542 QbeGen.BeginFunc(mg); .)
- 543 [ FormalParams ]
- 544 [ ":" TypeIdent<t> (. SymTab.SetProcRes(t);
- 545 QbeGen.SetFuncRes(t);
- 546 IF (t #
- 547 SymTab.InvalidType)
- 548 & ((SymTab.ClassOf(t)
- 549 = SymTab.ClArray)
- 550 OR (SymTab.ClassOf(t)
- 551 = SymTab.ClRecord)
- 552 OR (SymTab.ClassOf(t)
- 553 = SymTab.ClSet)
- 554 OR (SymTab.ClassOf(t)
- 555 = SymTab.ClClass)) THEN
- 556 SemError(230) END; .) ] .
- 557 FormalParams
- 558 = "(" [ ParamSection { ";" ParamSection } ] ")" .
- 559 ParamSection (. VAR t: SymTab.TypeIndex;
- 560 nm: SymTab.Name;
- 561 i: CARDINAL;
- 562 isV: BOOLEAN; .)
- 563 = (. isV := FALSE; .)
- 564 [ "VAR" (. isV := TRUE; .) ]
- 565 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
- 566 WHILE i < SymTab.PendCount() DO
- 567 SymTab.PendName(i, nm);
- 568 IF ~QbeGen.FuncParam(nm,
- 569 isV, t) THEN
- 570 SemError(233) END;
- 571 INC(i)
- 572 END;
- 573 SymTab.FixPending(t);
- 574 IF ~isV
- 575 & SymTab.IsOpenArray(t) THEN
- 576 SemError(230) END; .) .
- 577 (* Nested procedures lower like top-level ones (4.2): the
- 578 static link gives them their parent's frame. Methods keep
- 579 parse-now/230-later. *)
- 580 ProcDecl (. VAR pn: SymTab.Name; .)
- 581 = ProcHeading<pn> ";"
- 582 ( "FORWARD" (. SymTab.MarkFwd;
- 583 SymTab.CloseProc;
- 584 QbeGen.AbortFunc; .)
- 585 | "EXTERNAL" (. SymTab.MarkExternal("");
- 586 SymTab.CloseProc;
- 587 QbeGen.AbortFunc; .)
- 588 | (. QbeGen.EndFuncHeader; .)
- 589 Block<pn> (. SymTab.CloseProc;
- 590 QbeGen.EndFunc(
- 591 SymTab.ProcRes(pn)); .) ) .
- 592 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
- 593 = DeclSeq
- 594 [ "BEGIN"
- 595 [ StatSeq ] ]
- 596 "END"
- 597 GetIdent<m2> (. IF ~SymTab.Equal(pn, m2) THEN
- 598 SemError(202) END; .) .
- 599 StatSeq
- 600 = Statement { ";" Statement } .
- 601 Statement (. VAR lx: QbeGen.QVal; .)
- 602 = AssOrCall
- 603 | IfStat
- 604 | WhileStat
- 605 | RepeatStat
- 606 | LoopStat
- 607 | ForStat
- 608 | CaseStat
- 609 | WithStat
- 610 | ReturnStat
- 611 | NewStat
- 612 | DisposeStat
- 613 | "EXIT" (. IF QbeGen.TopLoop(lx) THEN
- 614 QbeGen.Jmp(lx)
- 615 ELSE SemError(230) END; .) .
- 616 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
- 617 Targets are pointer designators; DISPOSE nils afterwards (safer
- 618 than Wirth-undefined; documented). DISPOSE is shallow. *)
- 619 NewStat (. VAR dt: SymTab.TypeIndex;
- 620 dk: INTEGER;
- 621 qd, qm: QbeGen.QVal;
- 622 qn: SymTab.Name;
- 623 sfx: BOOLEAN;
- 624 bt: SymTab.TypeIndex; .)
- 625 = "NEW" "(" Design<dt, dk, qd, qn, sfx> ")"
- 626 (. IF dt = SymTab.InvalidType THEN
- 627 ELSIF (dk # SymTab.KindVar)
- 628 & (dk # SymTab.KindParam)
- 629 & (dk # SymTab.KindField) THEN
- 630 SemError(210)
- 631 ELSIF SymTab.ClassOf(dt) #
- 632 SymTab.ClPtr THEN
- 633 SemError(219)
- 634 ELSE bt := SymTab.PtrBase(dt);
- 635 IF bt #
- 636 SymTab.InvalidType THEN
- 637 QbeGen.NewHeap(bt, qm);
- 638 QbeGen.InitHeap(qm, bt);
- 639 IF sfx
- 640 OR (dk =
- 641 SymTab.KindField) THEN
- 642 QbeGen.ElemStore(qd, qm,
- 643 dt)
- 644 ELSE QbeGen.StorePtr(qn,
- 645 qm)
- 646 END
- 647 END
- 648 END; .) .
- 649 DisposeStat (. VAR dt: SymTab.TypeIndex;
- 650 dk: INTEGER;
- 651 qd, qv: QbeGen.QVal;
- 652 qn: SymTab.Name;
- 653 sfx: BOOLEAN; .)
- 654 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> ")"
- 655 (. IF dt = SymTab.InvalidType THEN
- 656 ELSIF (dk # SymTab.KindVar)
- 657 & (dk # SymTab.KindParam)
- 658 & (dk # SymTab.KindField) THEN
- 659 SemError(210)
- 660 ELSIF SymTab.ClassOf(dt) #
- 661 SymTab.ClPtr THEN
- 662 SemError(219)
- 663 ELSE
- 664 IF sfx
- 665 OR (dk =
- 666 SymTab.KindField) THEN
- 667 QbeGen.ElemLoad(qd, dt,
- 668 qv)
- 669 ELSE QbeGen.LoadPtr(qn, qv)
- 670 END;
- 671 QbeGen.FreeHeap(qv);
- 672 IF sfx
- 673 OR (dk =
- 674 SymTab.KindField) THEN
- 675 QbeGen.ElemStore(qd, "0",
- 676 dt)
- 677 ELSE QbeGen.StorePtr(qn,
- 678 "0")
- 679 END
- 680 END; .) .
- 681 (* WITH pushes each record's fields (inner wins) plus its base
- 682 address; field designators resolve through both stacks. *)
- 683 WithStat (. VAR nW: CARDINAL; .)
- 684 = "WITH" (. nW := 0; .)
- 685 WithItem<nW> { "," WithItem<nW> }
- 686 "DO" StatSeq "END"
- 687 (. WHILE nW > 0 DO
- 688 SymTab.PopScope;
- 689 QbeGen.PopWith;
- 690 DEC(nW)
- 691 END; .) .
- 692 WithItem<VAR nW: CARDINAL> (. VAR dt: SymTab.TypeIndex;
- 693 dk: INTEGER;
- 694 qd, qe: QbeGen.QVal;
- 695 qn: SymTab.Name;
- 696 sfx: BOOLEAN; .)
- 697 = Design<dt, dk, qd, qn, sfx>
- 698 (. IF dt = SymTab.InvalidType THEN
- 699 ELSIF (SymTab.ClassOf(dt) #
- 700 SymTab.ClRecord)
- 701 & (SymTab.ClassOf(dt) #
- 702 SymTab.ClClass) THEN
- 703 SemError(215)
- 704 ELSIF SymTab.PushRecord(dt) THEN
- 705 QbeGen.PushWith(qd);
- 706 INC(nW)
- 707 END; .) .
- 708 (* Assignment or procedure-statement call (4.1, module level).
- 709 Bare `P;` is a syntax error; function-as-statement is 233. *)
- 710 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
- 711 dk: INTEGER;
- 712 qd, qe, qt: QbeGen.QVal;
- 713 qn: SymTab.Name;
- 714 ct2, res0: SymTab.TypeIndex;
- 715 q2, mg0: QbeGen.QVal;
- 716 isR, conv: BOOLEAN;
- 717 called, sfx: BOOLEAN; .)
- 718 = Design<dt, dk, qd, qn, sfx>
- 719 ( ":="
- 720 Expr<et, qe> (. IF (dt # SymTab.InvalidType)
- 721 & (dk # SymTab.KindVar)
- 722 & (dk # SymTab.KindParam)
- 723 & (dk # SymTab.KindField) THEN
- 724 SemError(210)
- 725 ELSIF ~SymTab.Assignable(et,
- 726 dt) THEN
- 727 SemError(210)
- 728 ELSIF (dt # SymTab.InvalidType)
- 729 & (SymTab.ClassOf(dt) =
- 730 SymTab.ClClass) THEN
- 731 SemError(230) END;
- 732 isR := (dt #
- 733 SymTab.InvalidType)
- 734 & (SymTab.ClassOf(dt)
- 735 = SymTab.ClReal);
- 736 conv := isR
- 737 & SymTab.IsIntFamily(et);
- 738 IF ((dk = SymTab.KindVar)
- 739 OR (dk = SymTab.KindParam)
- 740 OR (dk = SymTab.KindField))
- 741 & (dt # SymTab.InvalidType)
- 742 & (et # SymTab.InvalidType)
- 743 & (SymTab.ClassOf(dt) #
- 744 SymTab.ClClass) THEN
- 745 IF sfx
- 746 OR (dk = SymTab.KindField) THEN
- 747 IF SymTab.ClassOf(dt) =
- 748 SymTab.ClArray THEN
- 749 QbeGen.CopyArray(qd, qe,
- 750 dt)
- 751 ELSIF SymTab.ClassOf(dt) =
- 752 SymTab.ClSet THEN
- 753 QbeGen.CopySet(qd, qe,
- 754 SymTab.SetWords(dt),
- 755 SymTab.SetWords(et))
- 756 ELSIF SymTab.ClassOf(dt) =
- 757 SymTab.ClRecord THEN
- 758 QbeGen.CopyRecord(qd, qe,
- 759 dt)
- 760 ELSIF conv THEN
- 761 QbeGen.ConvIR(qe, qt);
- 762 QbeGen.ElemStore(qd, qt,
- 763 dt)
- 764 ELSE QbeGen.ElemStore(qd, qe,
- 765 dt)
- 766 END
- 767 ELSIF SymTab.ClassOf(dt) =
- 768 SymTab.ClArray THEN
- 769 QbeGen.CopyArray(qd, qe, dt)
- 770 ELSIF SymTab.ClassOf(dt) =
- 771 SymTab.ClSet THEN
- 772 QbeGen.CopySet(qd, qe,
- 773 SymTab.SetWords(dt),
- 774 SymTab.SetWords(et))
- 775 ELSIF SymTab.ClassOf(dt) =
- 776 SymTab.ClRecord THEN
- 777 QbeGen.CopyRecord(qd, qe, dt)
- 778 ELSIF SymTab.ClassOf(dt) =
- 779 SymTab.ClPtr THEN
- 780 QbeGen.StorePtr(qn, qe)
- 781 ELSIF conv THEN
- 782 QbeGen.ConvIR(qe, qt);
- 783 QbeGen.StoreVar(qn, qt, TRUE)
- 784 ELSE
- 785 QbeGen.StoreVar(qn, qe, isR)
- 786 END
- 787 END; .)
- 788 | ArgList<qn, FALSE, ct2, q2, called>
- 789 | (* bare `P;`: proper parameterless
- 790 procedure call; anything else
- 791 here is 233 (was a bare syntax
- 792 error before 4.2) *)
- 793 (. IF (dk = SymTab.KindProc)
- 794 & ~sfx THEN
- 795 res0 := SymTab.ProcRes(qn);
- 796 IF res0 #
- 797 SymTab.InvalidType THEN
- 798 SemError(233)
- 799 ELSIF SymTab.ProcNPar(qn) #
- 800 0 THEN
- 801 SemError(233)
- 802 ELSE QbeGen.Mangled(qn,
- 803 SymTab.ProcUid(qn), mg0);
- 804 QbeGen.CallBegin(mg0,
- 805 res0,
- 806 SymTab.ProcDepthOf(qn),
- 807 SymTab.IsExternal(qn));
- 808 QbeGen.CallEnd(FALSE, q2)
- 809 END
- 810 ELSE SemError(233)
- 811 END; .) ) .
- 812 (* Actual-parameter list shared by statement and expression calls.
- 813 want selects CallEnd's result handling; t/q carry the call
- 814 value (statement calls discard). Arity/type failures are 233;
- 815 evaluation code still emits so the .ssa stays assembleable. *)
- 816 ArgList<pn: SymTab.Name; want: BOOLEAN;
- 817 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
- 818 VAR called: BOOLEAN> (. VAR i: CARDINAL;
- 819 res: SymTab.TypeIndex;
- 820 mg: QbeGen.QVal;
- 821 ok: BOOLEAN; .)
- 822 = "(" (. called := TRUE;
- 823 res := SymTab.ProcRes(pn);
- 824 ok := TRUE;
- 825 IF SymTab.SymKind(pn) #
- 826 SymTab.KindProc THEN
- 827 SemError(233); ok := FALSE
- 828 ELSE QbeGen.Mangled(pn,
- 829 SymTab.ProcUid(pn), mg);
- 830 QbeGen.CallBegin(mg, res,
- 831 SymTab.ProcDepthOf(pn),
- 832 SymTab.IsExternal(pn))
- 833 END;
- 834 i := 0; .)
- 835 [ ActParam<pn, i> (. INC(i); .)
- 836 { "," ActParam<pn, i> (. INC(i); .) } ]
- 837 ")" (. IF ok THEN
- 838 IF i #
- 839 SymTab.ProcNPar(pn) THEN
- 840 SemError(233); ok := FALSE
- 841 END
- 842 END;
- 843 IF ~ok THEN
- 844 t := SymTab.InvalidType;
- 845 QbeGen.CopyOp("0", q)
- 846 ELSIF want THEN
- 847 IF res =
- 848 SymTab.InvalidType THEN
- 849 SemError(233);
- 850 t := SymTab.InvalidType;
- 851 QbeGen.CopyOp("0", q)
- 852 ELSE t := res;
- 853 QbeGen.CallEnd(TRUE, q)
- 854 END
- 855 ELSE
- 856 IF res #
- 857 SymTab.InvalidType THEN
- 858 SemError(233)
- 859 END;
- 860 t := SymTab.InvalidType;
- 861 QbeGen.CopyOp("0", q);
- 862 QbeGen.CallEnd(FALSE, q)
- 863 END; .) .
- 864 (* One actual: VAR formals take recorded designator addresses
- 865 (233 otherwise); value formals take converted expressions. *)
- 866 ActParam<pn: SymTab.Name; i: CARDINAL>(. VAR at, ft: SymTab.TypeIndex;
- 867 qe, qa, qt: QbeGen.QVal;
- 868 isV, conv: BOOLEAN; .)
- 869 = Expr<at, qe> (. ft := SymTab.ParamType(pn, i);
- 870 isV := SymTab.ParamIsVar(pn, i);
- 871 IF (at = SymTab.InvalidType)
- 872 OR (ft =
- 873 SymTab.InvalidType) THEN
- 874 ELSIF isV THEN
- 875 IF ~QbeGen.AddrOfVal(qe,
- 876 qa) THEN
- 877 SemError(233)
- 878 ELSIF ~SymTab.VarParamOk(at,
- 879 ft) THEN
- 880 SemError(233)
- 881 ELSIF ~QbeGen.CallArg(qa,
- 882 "l") THEN
- 883 SemError(233)
- 884 END
- 885 ELSE
- 886 IF ~SymTab.Assignable(at,
- 887 ft) THEN
- 888 SemError(233)
- 889 ELSE
- 890 conv := (SymTab.ClassOf(
- 891 ft) = SymTab.ClReal)
- 892 & SymTab.IsIntFamily(at);
- 893 IF conv THEN
- 894 QbeGen.ConvIR(qe, qt);
- 895 IF ~QbeGen.CallArg(qt,
- 896 "d") THEN
- 897 SemError(233)
- 898 END
- 899 ELSIF ~QbeGen.CallArg(qe,
- 900 QbeGen.ArgClass(ft)) THEN
- 901 SemError(233)
- 902 END
- 903 END
- 904 END; .) .
- 905 IfStat (. VAR t: SymTab.TypeIndex;
- 906 q, lThen, lElse, lEnd:
- 907 QbeGen.QVal;
- 908 hasElse: BOOLEAN; .)
- 909 = "IF" (. hasElse := FALSE; .)
- 910 Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
- 911 SemError(214) END;
- 912 QbeGen.NewLabel(lThen);
- 913 QbeGen.NewLabel(lElse);
- 914 QbeGen.NewLabel(lEnd);
- 915 QbeGen.Jnz(q, lThen, lElse);
- 916 QbeGen.EmitLabel(lThen); .)
- 917 "THEN" StatSeq (. QbeGen.Jmp(lEnd); .)
- 918 { "ELSIF" (. QbeGen.EmitLabel(lElse);
- 919 QbeGen.NewLabel(lElse); .)
- 920 Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
- 921 SemError(214) END;
- 922 QbeGen.NewLabel(lThen);
- 923 QbeGen.Jnz(q, lThen, lElse);
- 924 QbeGen.EmitLabel(lThen); .)
- 925 "THEN" StatSeq (. QbeGen.Jmp(lEnd); .) }
- 926 [ "ELSE" (. QbeGen.EmitLabel(lElse);
- 927 hasElse := TRUE; .)
- 928 StatSeq ]
- 929 "END" (. IF hasElse THEN
- 930 QbeGen.EmitLabel(lEnd)
- 931 ELSE QbeGen.EmitLabel(lElse);
- 932 QbeGen.EmitLabel(lEnd)
- 933 END; .) .
- 934 WhileStat (. VAR t: SymTab.TypeIndex;
- 935 q, lTop, lBody, lEnd:
- 936 QbeGen.QVal; .)
- 937 = "WHILE" (. QbeGen.NewLabel(lTop);
- 938 QbeGen.NewLabel(lBody);
- 939 QbeGen.NewLabel(lEnd);
- 940 QbeGen.EmitLabel(lTop); .)
- 941 Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
- 942 SemError(214) END;
- 943 QbeGen.Jnz(q, lBody, lEnd);
- 944 QbeGen.EmitLabel(lBody); .)
- 945 "DO" StatSeq (. QbeGen.Jmp(lTop); .)
- 946 "END" (. QbeGen.EmitLabel(lEnd); .) .
- 947 RepeatStat (. VAR t: SymTab.TypeIndex;
- 948 q, lTop, lEnd: QbeGen.QVal; .)
- 949 = "REPEAT" (. QbeGen.NewLabel(lTop);
- 950 QbeGen.NewLabel(lEnd);
- 951 QbeGen.EmitLabel(lTop); .)
- 952 StatSeq
- 953 "UNTIL" Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
- 954 SemError(214) END;
- 955 QbeGen.Jnz(q, lEnd, lTop);
- 956 QbeGen.EmitLabel(lEnd); .) .
- 957 LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .)
- 958 = "LOOP" (. QbeGen.NewLabel(lTop);
- 959 QbeGen.NewLabel(lEnd);
- 960 QbeGen.PushLoop(lEnd);
- 961 QbeGen.EmitLabel(lTop); .)
- 962 StatSeq
- 963 "END" (. QbeGen.Jmp(lTop);
- 964 QbeGen.PopLoop;
- 965 QbeGen.EmitLabel(lEnd); .) .
- 966 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
- 967 Runtime direction would need a compare-select; the literal
- 968 sign picks cslew/csegew at "DO" time. *)
- 969 ForStat (. VAR lv: SymTab.Name;
- 970 tlo, thi, tby:
- 971 SymTab.TypeIndex;
- 972 qlo, qhi, qby, qt, qk, qb:
- 973 QbeGen.QVal;
- 974 lTop, lBody, lEnd:
- 975 QbeGen.QVal;
- 976 by: INTEGER;
- 977 ok: BOOLEAN; .)
- 978 = "FOR" (. by := 1; .)
- 979 GetIdent<lv> (. ok := SymTab.Lookup(lv);
- 980 IF ~ok THEN
- 981 SemError(201)
- 982 ELSIF (SymTab.SymKind(lv) #
- 983 SymTab.KindVar)
- 984 & (SymTab.SymKind(lv) #
- 985 SymTab.KindParam) THEN
- 986 SemError(220); ok := FALSE
- 987 ELSIF ~SymTab.IsIntFamily(
- 988 SymTab.SymType(lv)) THEN
- 989 SemError(220); ok := FALSE
- 990 END; .)
- 991 ":=" Expr<tlo, qlo> (. IF ~SymTab.IsIntFamily(tlo) THEN
- 992 SemError(220); ok := FALSE
- 993 END; .)
- 994 "TO" Expr<thi, qhi> (. IF ~SymTab.IsIntFamily(thi) THEN
- 995 SemError(220); ok := FALSE
- 996 END; .)
- 997 [ "BY" Expr<tby, qby> (. IF (tby #
- 998 SymTab.InvalidType)
- 999 & ~SymTab.IsIntFamily(tby) THEN
- 1000 SemError(220); ok := FALSE
- 1001 END;
- 1002 IF ~SymTab.ConstInt(qby, by) THEN
- 1003 SemError(230); by := 1
- 1004 ELSIF by = 0 THEN
- 1005 SemError(220); by := 1
- 1006 END; .) ]
- 1007 "DO" (. IF ok THEN
- 1008 QbeGen.StoreVar(lv, qlo,
- 1009 FALSE) END;
- 1010 QbeGen.NewLabel(lTop);
- 1011 QbeGen.NewLabel(lBody);
- 1012 QbeGen.NewLabel(lEnd);
- 1013 QbeGen.EmitLabel(lTop);
- 1014 QbeGen.LoadVar(lv, FALSE, qt);
- 1015 QbeGen.NewTemp(qk);
- 1016 IF by > 0 THEN
- 1017 QbeGen.Op3("cslew", qk,
- 1018 qt, qhi, FALSE)
- 1019 ELSE QbeGen.Op3("csgew", qk,
- 1020 qt, qhi, FALSE)
- 1021 END;
- 1022 QbeGen.Jnz(qk, lBody, lEnd);
- 1023 QbeGen.EmitLabel(lBody); .)
- 1024 StatSeq
- 1025 "END" (. IF ok THEN
- 1026 QbeGen.LoadVar(lv, FALSE,
- 1027 qt);
- 1028 QbeGen.IntStr(by, qb);
- 1029 QbeGen.NewTemp(qk);
- 1030 QbeGen.Op3("add", qk,
- 1031 qt, qb, FALSE);
- 1032 QbeGen.StoreVar(lv, qk,
- 1033 FALSE) END;
- 1034 QbeGen.Jmp(lTop);
- 1035 QbeGen.EmitLabel(lEnd); .) .
- 1036 CaseStat (. VAR tsel: SymTab.TypeIndex;
- 1037 qsel, lEnd: QbeGen.QVal; .)
- 1038 = "CASE" Expr<tsel, qsel> (. QbeGen.NewLabel(lEnd); .)
- 1039 "OF" CaseAlt<tsel, qsel, lEnd>
- 1040 { "|" CaseAlt<tsel, qsel, lEnd> }
- 1041 [ "ELSE" StatSeq ]
- 1042 "END" (. QbeGen.EmitLabel(lEnd); .) .
- 1043 (* Compare-chain lowering: each alternative ends its match-tests
- 1044 with "jmp lAfter", so the no-match fallthrough skips the body:
- 1045 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
- 1046 lAfter:". Falls into the next alternative, ELSE, or END. *)
- 1047 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1048 lEnd: QbeGen.QVal> (. VAR lBody, lAfter: QbeGen.QVal; .)
- 1049 = (. QbeGen.NewLabel(lBody);
- 1050 QbeGen.NewLabel(lAfter); .)
- 1051 CaseLabel<tsel, qsel, lBody>
- 1052 { "," CaseLabel<tsel, qsel, lBody> }
- 1053 ":" (. QbeGen.Jmp(lAfter);
- 1054 QbeGen.EmitLabel(lBody); .)
- 1055 StatSeq (. QbeGen.Jmp(lEnd);
- 1056 QbeGen.EmitLabel(lAfter); .) .
- 1057 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
- 1058 lBody: QbeGen.QVal> (. VAR t2, t3: SymTab.TypeIndex;
- 1059 q2, q3, qc, qd, qe:
- 1060 QbeGen.QVal;
- 1061 lNext: QbeGen.QVal; .)
- 1062 = Expr<t2, q2> (. IF (t2 #
- 1063 SymTab.InvalidType)
- 1064 & (tsel #
- 1065 SymTab.InvalidType)
- 1066 & ((SymTab.ClassOf(t2) =
- 1067 SymTab.ClSet)
- 1068 OR (SymTab.ClassOf(tsel) =
- 1069 SymTab.ClSet)) THEN
- 1070 SemError(230)
- 1071 ELSIF (t2 #
- 1072 SymTab.InvalidType)
- 1073 & (tsel #
- 1074 SymTab.InvalidType)
- 1075 & ~SymTab.EqCheck(t2,
- 1076 tsel) THEN
- 1077 SemError(213) END;
- 1078 IF ~QbeGen.IsImm(q2) THEN
- 1079 SemError(230);
- 1080 QbeGen.CopyOp("0", q2)
- 1081 END;
- 1082 QbeGen.NewLabel(lNext);
- 1083 QbeGen.Cmp(SymTab.OpEq,
- 1084 qsel, q2, qc, FALSE);
- 1085 QbeGen.Jnz(qc, lBody, lNext);
- 1086 QbeGen.EmitLabel(lNext); .)
- 1087 [ ".." Expr<t3, q3> (. IF (t3 #
- 1088 SymTab.InvalidType)
- 1089 & (tsel #
- 1090 SymTab.InvalidType)
- 1091 & ~SymTab.EqCheck(t3,
- 1092 tsel) THEN
- 1093 SemError(213) END;
- 1094 IF ~QbeGen.IsImm(q3) THEN
- 1095 SemError(230);
- 1096 QbeGen.CopyOp("0", q3)
- 1097 END;
- 1098 QbeGen.Cmp(SymTab.OpGe,
- 1099 qsel, q2, qc, FALSE);
- 1100 QbeGen.Cmp(SymTab.OpLe,
- 1101 qsel, q3, qd, FALSE);
- 1102 QbeGen.NewTemp(qe);
- 1103 QbeGen.Op3("and", qe, qc, qd,
- 1104 FALSE);
- 1105 QbeGen.NewLabel(lNext);
- 1106 QbeGen.Jnz(qe, lBody, lNext);
- 1107 QbeGen.EmitLabel(lNext); .) ] .
- 1108 ReturnStat (. VAR t: SymTab.TypeIndex;
- 1109 q, qt: QbeGen.QVal;
- 1110 res: SymTab.TypeIndex;
- 1111 hadE, conv: BOOLEAN; .)
- 1112 = "RETURN" (. hadE := FALSE; .)
- 1113 [ Expr<t, q> (. hadE := TRUE; .) ]
- 1114 (. conv := FALSE;
- 1115 IF ~SymTab.InProc() THEN
- 1116 SemError(232)
- 1117 ELSE res := SymTab.CurRes();
- 1118 IF ~hadE THEN
- 1119 IF res #
- 1120 SymTab.InvalidType THEN
- 1121 SemError(232)
- 1122 ELSE QbeGen.EmitRet(q,
- 1123 FALSE)
- 1124 END
- 1125 ELSIF (res =
- 1126 SymTab.InvalidType)
- 1127 OR (t #
- 1128 SymTab.InvalidType)
- 1129 & ~SymTab.Assignable(t,
- 1130 res) THEN
- 1131 SemError(232)
- 1132 ELSE
- 1133 conv := (SymTab.ClassOf(
- 1134 res) = SymTab.ClReal)
- 1135 & SymTab.IsIntFamily(t);
- 1136 IF conv THEN
- 1137 QbeGen.ConvIR(q, qt);
- 1138 QbeGen.EmitRet(qt, TRUE)
- 1139 ELSE QbeGen.EmitRet(q, TRUE)
- 1140 END
- 1141 END
- 1142 END; .) .
- 1143 (* Designator: scalar loads, array addresses, and index suffixes.
- 1144 Each index descends one level (bounds-checked, trap on breach);
- 1145 nested levels reload the inner descriptor address. q ends as the
- 1146 value (scalars), the descriptor address (plain arrays), or the
- 1147 element address (indexed); sfx marks the indexed form. *)
- 1148 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
- 1149 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
- 1150 (. VAR n, fn, mal: SymTab.Name;
- 1151 cls: INTEGER;
- 1152 curT, it, eT, bt:
- 1153 SymTab.TypeIndex;
- 1154 iq, ql, qlo, qhi, qe:
- 1155 QbeGen.QVal;
- 1156 lo, hi: INTEGER;
- 1157 fo: INTEGER;
- 1158 isOpen: BOOLEAN;
- 1159 qb: QbeGen.QVal; .)
- 1160 = GetIdent<n> (. QbeGen.CopyOp(n, qn);
- 1161 sfx := FALSE;
- 1162 IF ~SymTab.Lookup(n) THEN
- 1163 SemError(201);
- 1164 t := SymTab.InvalidType;
- 1165 k := -1;
- 1166 QbeGen.CopyOp("0", q)
- 1167 ELSE
- 1168 t := SymTab.SymType(n);
- 1169 k := SymTab.SymKind(n);
- 1170 IF k = SymTab.KindConst THEN
- 1171 IF SymTab.Equal(n,
- 1172 "TRUE") THEN
- 1173 t := SymTab.BoolType();
- 1174 QbeGen.CopyOp("1", q)
- 1175 ELSIF SymTab.Equal(n,
- 1176 "FALSE") THEN
- 1177 t := SymTab.BoolType();
- 1178 QbeGen.CopyOp("0", q)
- 1179 ELSIF SymTab.Equal(n,
- 1180 "NIL") THEN
- 1181 QbeGen.CopyOp("0", q)
- 1182 ELSE
- 1183 cls :=
- 1184 SymTab.ClassOf(t);
- 1185 IF (t #
- 1186 SymTab.InvalidType)
- 1187 & ((cls = SymTab.ClInt)
- 1188 OR (cls
- 1189 = SymTab.ClChar)
- 1190 OR (cls
- 1191 = SymTab.ClReal)
- 1192 OR (cls
- 1193 = SymTab.ClNil)) THEN
- 1194 IF cls = SymTab.ClNil THEN
- 1195 QbeGen.CopyOp("0", q)
- 1196 ELSE
- 1197 QbeGen.LoadVar(n,
- 1198 cls = SymTab.ClReal,
- 1199 q)
- 1200 END
- 1201 ELSE
- 1202 IF t #
- 1203 SymTab.InvalidType THEN
- 1204 SemError(230)
- 1205 END;
- 1206 QbeGen.CopyOp("0", q)
- 1207 END
- 1208 END
- 1209 ELSIF (k = SymTab.KindVar)
- 1210 OR (k = SymTab.KindParam) THEN
- 1211 cls :=
- 1212 SymTab.ClassOf(t);
- 1213 IF (cls = SymTab.ClInt)
- 1214 OR (cls = SymTab.ClBool)
- 1215 OR (cls = SymTab.ClChar)
- 1216 OR (cls
- 1217 = SymTab.ClReal) THEN
- 1218 QbeGen.LoadVar(n,
- 1219 cls = SymTab.ClReal, q)
- 1220 ELSIF cls = SymTab.ClPtr THEN
- 1221 QbeGen.LoadPtr(n, q)
- 1222 ELSIF (cls
- 1223 = SymTab.ClArray)
- 1224 OR (cls
- 1225 = SymTab.ClSet)
- 1226 OR (cls
- 1227 = SymTab.ClRecord)
- 1228 OR (cls
- 1229 = SymTab.ClClass) THEN
- 1230 QbeGen.AddrOf(n, q)
- 1231 ELSE SemError(230);
- 1232 QbeGen.CopyOp("0", q)
- 1233 END
- 1234 ELSE QbeGen.CopyOp("0", q);
- 1235 IF k = SymTab.KindImport THEN
- 1236 SemError(230)
- 1237 ELSIF k =
- 1238 SymTab.KindProc THEN
- 1239 (* bare procedure name:
- 1240 a following ArgList
- 1241 makes it a call;
- 1242 otherwise Fact
- 1243 reports 230 *)
- 1244 ELSE
- 1245 IF k = SymTab.KindField THEN
- 1246 IF QbeGen.TopWith(qb) THEN
- 1247 fo :=
- 1248 SymTab.FieldOffset(
- 1249 SymTab.FieldOwner(n),
- 1250 n);
- 1251 QbeGen.FieldAddr(qb,
- 1252 fo, q);
- 1253 sfx := TRUE
- 1254 ELSE SemError(230);
- 1255 QbeGen.CopyOp("0", q)
- 1256 END
- 1257 END
- 1258 END
- 1259 END
- 1260 END; .)
- 1261 { "[" Expr<it, iq>
- 1262 (. IF t = SymTab.InvalidType THEN
- 1263 ELSIF SymTab.ClassOf(t) #
- 1264 SymTab.ClArray THEN
- 1265 SemError(217);
- 1266 t := SymTab.InvalidType
- 1267 ELSIF ~SymTab.IsIntFamily(it)
- 1268 & (SymTab.ClassOf(it) #
- 1269 SymTab.ClChar) THEN
- 1270 SemError(218);
- 1271 t := SymTab.InvalidType
- 1272 ELSE
- 1273 QbeGen.WidenIndex(iq, ql);
- 1274 isOpen :=
- 1275 SymTab.IsOpenArray(t);
- 1276 IF isOpen THEN
- 1277 QbeGen.CopyOp("0", qlo);
- 1278 QbeGen.OpenHi(q, qhi)
- 1279 ELSE
- 1280 lo := SymTab.ArrayLo(t);
- 1281 hi := SymTab.ArrayHi(t);
- 1282 QbeGen.IntStr(lo, qlo);
- 1283 QbeGen.IntStr(hi, qhi)
- 1284 END;
- 1285 QbeGen.CheckRange(ql, qlo,
- 1286 qhi);
- 1287 eT := SymTab.ArrayElem(t);
- 1288 QbeGen.ElemAddr(q, ql, qlo,
- 1289 t, qe);
- 1290 IF SymTab.ClassOf(eT) =
- 1291 SymTab.ClArray THEN
- 1292 QbeGen.ElemLoad(qe, eT, q)
- 1293 ELSE QbeGen.CopyOp(qe, q)
- 1294 END;
- 1295 t := eT; sfx := TRUE
- 1296 END; .)
- 1297 { "," Expr<it, iq>
- 1298 (. IF t = SymTab.InvalidType THEN
- 1299 ELSIF SymTab.ClassOf(t) #
- 1300 SymTab.ClArray THEN
- 1301 SemError(217);
- 1302 t := SymTab.InvalidType
- 1303 ELSIF ~SymTab.IsIntFamily(it)
- 1304 & (SymTab.ClassOf(it) #
- 1305 SymTab.ClChar) THEN
- 1306 SemError(218);
- 1307 t := SymTab.InvalidType
- 1308 ELSE
- 1309 QbeGen.WidenIndex(iq, ql);
- 1310 isOpen :=
- 1311 SymTab.IsOpenArray(t);
- 1312 IF isOpen THEN
- 1313 QbeGen.CopyOp("0", qlo);
- 1314 QbeGen.OpenHi(q, qhi)
- 1315 ELSE
- 1316 lo := SymTab.ArrayLo(t);
- 1317 hi := SymTab.ArrayHi(t);
- 1318 QbeGen.IntStr(lo, qlo);
- 1319 QbeGen.IntStr(hi, qhi)
- 1320 END;
- 1321 QbeGen.CheckRange(ql, qlo,
- 1322 qhi);
- 1323 eT := SymTab.ArrayElem(t);
- 1324 QbeGen.ElemAddr(q, ql, qlo,
- 1325 t, qe);
- 1326 IF SymTab.ClassOf(eT) =
- 1327 SymTab.ClArray THEN
- 1328 QbeGen.ElemLoad(qe, eT, q)
- 1329 ELSE QbeGen.CopyOp(qe, q)
- 1330 END;
- 1331 t := eT; sfx := TRUE
- 1332 END; .) }
- 1333 "]"
- 1334 | "." GetIdent<fn>
- 1335 (. IF k = SymTab.KindModule THEN
- 1336 (* qualified L.x: materialize
- 1337 the export, then load it *)
- 1338 IF ~SymTab.MaterializeAlias(n,
- 1339 fn, mal) THEN
- 1340 SemError(201);
- 1341 t := SymTab.InvalidType;
- 1342 QbeGen.CopyOp("0", q)
- 1343 ELSE
- 1344 QbeGen.CopyOp(mal, qn);
- 1345 t := SymTab.SymType(mal);
- 1346 k := SymTab.SymKind(mal);
- 1347 sfx := FALSE;
- 1348 IF k = SymTab.KindProc THEN
- 1349 (* call: ArgList supplies
- 1350 the value *)
- 1351 QbeGen.CopyOp("0", q)
- 1352 ELSIF ~QbeGen.LoadDesignator(
- 1353 mal, t, k, q) THEN
- 1354 SemError(230);
- 1355 QbeGen.CopyOp("0", q)
- 1356 END
- 1357 END
- 1358 ELSIF t = SymTab.InvalidType THEN
- 1359 ELSIF (SymTab.ClassOf(t) #
- 1360 SymTab.ClRecord)
- 1361 & (SymTab.ClassOf(t) #
- 1362 SymTab.ClClass) THEN
- 1363 SemError(215);
- 1364 t := SymTab.InvalidType
- 1365 ELSIF ~SymTab.FieldExists(t,
- 1366 fn) THEN
- 1367 SemError(216);
- 1368 t := SymTab.InvalidType
- 1369 ELSE
- 1370 fo := SymTab.FieldOffset(t,
- 1371 fn);
- 1372 t := SymTab.FieldType(t, fn);
- 1373 QbeGen.FieldAddr(q, fo, qe);
- 1374 IF SymTab.ClassOf(t) =
- 1375 SymTab.ClArray THEN
- 1376 QbeGen.ElemLoad(qe, t, q)
- 1377 ELSE QbeGen.CopyOp(qe, q)
- 1378 END;
- 1379 sfx := TRUE
- 1380 END; .)
- 1381 | "^"
- 1382 (. IF t = SymTab.InvalidType THEN
- 1383 ELSIF SymTab.ClassOf(t) #
- 1384 SymTab.ClPtr THEN
- 1385 SemError(219);
- 1386 t := SymTab.InvalidType
- 1387 ELSE
- 1388 bt := SymTab.PtrBase(t);
- 1389 IF bt = SymTab.InvalidType THEN
- 1390 ELSE
- 1391 IF sfx THEN
- 1392 QbeGen.ElemLoad(q, t,
- 1393 qb);
- 1394 QbeGen.CopyOp(qb, q)
- 1395 END;
- 1396 t := bt;
- 1397 IF (SymTab.ClassOf(bt) =
- 1398 SymTab.ClInt)
- 1399 OR (SymTab.ClassOf(bt) =
- 1400 SymTab.ClBool)
- 1401 OR (SymTab.ClassOf(bt) =
- 1402 SymTab.ClChar)
- 1403 OR (SymTab.ClassOf(bt) =
- 1404 SymTab.ClReal) THEN
- 1405 sfx := TRUE
- 1406 ELSE sfx := FALSE
- 1407 END
- 1408 END
- 1409 END; .) } .
- 1410 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1411 (. VAR t2: SymTab.TypeIndex;
- 1412 op: INTEGER;
- 1413 q2, qt: QbeGen.QVal;
- 1414 isR: BOOLEAN; .)
- 1415 = SimExpr<t, q>
- 1416 [ Rel<op> SimExpr<t2, q2>
- 1417 (. IF op = SymTab.OpIn THEN
- 1418 IF SymTab.InCheck(t, t2) THEN
- 1419 IF (t = SymTab.InvalidType)
- 1420 OR (t2 = SymTab.InvalidType) THEN
- 1421 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1422 ELSE
- 1423 QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
- 1424 SymTab.SetCount(t2), qt);
- 1425 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1426 END
- 1427 ELSE SemError(222); t := SymTab.InvalidType;
- 1428 QbeGen.CopyOp("0", q)
- 1429 END
- 1430 ELSIF SymTab.RelCheck(t, t2, op) THEN
- 1431 IF (t = SymTab.InvalidType)
- 1432 OR (t2 = SymTab.InvalidType) THEN
- 1433 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
- 1434 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
- 1435 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
- 1436 IF (op # SymTab.OpEq) & (op # SymTab.OpNeq1)
- 1437 & (op # SymTab.OpNeq2) THEN
- 1438 SemError(213); t := SymTab.InvalidType;
- 1439 QbeGen.CopyOp("0", q)
- 1440 ELSE
- 1441 QbeGen.CmpL(op, q, q2, qt);
- 1442 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1443 END
- 1444 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
- 1445 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1446 QbeGen.CmpSet(op, q, q2,
- 1447 SymTab.SetWords(t), SymTab.SetWords(t2), qt);
- 1448 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
- 1449 ELSE
- 1450 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1451 t := SymTab.BoolType();
- 1452 QbeGen.Cmp(op, q, q2, qt, isR);
- 1453 QbeGen.CopyOp(qt, q)
- 1454 END
- 1455 ELSE SemError(213); t := SymTab.InvalidType;
- 1456 QbeGen.CopyOp("0", q)
- 1457 END; .) ] .
- 1458 Rel<VAR op: INTEGER>
- 1459 = "=" (. op := SymTab.OpEq; .)
- 1460 | "#" (. op := SymTab.OpNeq1; .)
- 1461 | "<" (. op := SymTab.OpLt; .)
- 1462 | "<=" (. op := SymTab.OpLe; .)
- 1463 | ">" (. op := SymTab.OpGt; .)
- 1464 | ">=" (. op := SymTab.OpGe; .)
- 1465 | "IN" (. op := SymTab.OpIn; .) .
- 1466 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1467 (. VAR t2, res2: SymTab.TypeIndex;
- 1468 op: INTEGER;
- 1469 q2, qt: QbeGen.QVal;
- 1470 neg, isR: BOOLEAN;
- 1471 lw, rw, mw: CARDINAL; .)
- 1472 = (. neg := FALSE; .)
- 1473 [ "+" | "-" (. neg := TRUE; .) ]
- 1474 Term<t, q> (. IF neg THEN
- 1475 IF QbeGen.IsImm(q) THEN
- 1476 QbeGen.NegFold(q, q)
- 1477 ELSE QbeGen.NewTemp(qt);
- 1478 QbeGen.NegQ(q, qt,
- 1479 SymTab.ClassOf(t)
- 1480 = SymTab.ClReal);
- 1481 QbeGen.CopyOp(qt, q)
- 1482 END
- 1483 END; .)
- 1484 { AddOp<op> Term<t2, q2>
- 1485 (. IF op = SymTab.OpOr THEN
- 1486 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
- 1487 t := SymTab.BoolType()
- 1488 ELSE SemError(212); t := SymTab.InvalidType END;
- 1489 IF t # SymTab.InvalidType THEN
- 1490 QbeGen.NewTemp(qt);
- 1491 QbeGen.Op3("or", qt, q, q2, FALSE);
- 1492 QbeGen.CopyOp(qt, q)
- 1493 ELSE QbeGen.CopyOp("0", q)
- 1494 END
- 1495 ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType)
- 1496 & (SymTab.ClassOf(t) = SymTab.ClSet)
- 1497 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1498 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1499 mw := lw;
- 1500 IF rw > mw THEN mw := rw END;
- 1501 IF op = SymTab.OpAdd THEN
- 1502 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
- 1503 ELSE
- 1504 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
- 1505 END;
- 1506 t := SymTab.NewSet(
- 1507 SymTab.NewSubR(0,
- 1508 VAL(INTEGER, mw) * 32 - 1));
- 1509 QbeGen.CopyOp(qt, q)
- 1510 ELSE
- 1511 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
- 1512 t := res2
- 1513 ELSE SemError(211); t := SymTab.InvalidType END;
- 1514 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1515 IF t # SymTab.InvalidType THEN
- 1516 QbeGen.NewTemp(qt);
- 1517 IF op = SymTab.OpAdd THEN
- 1518 QbeGen.Op3("add", qt, q, q2, isR)
- 1519 ELSE
- 1520 QbeGen.Op3("sub", qt, q, q2, isR)
- 1521 END;
- 1522 QbeGen.CopyOp(qt, q)
- 1523 ELSE QbeGen.CopyOp("0", q)
- 1524 END
- 1525 END; .) } .
- 1526 AddOp<VAR op: INTEGER>
- 1527 = "+" (. op := SymTab.OpAdd; .)
- 1528 | "-" (. op := SymTab.OpSub; .)
- 1529 | "OR" (. op := SymTab.OpOr; .) .
- 1530 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1531 (. VAR t2, res2: SymTab.TypeIndex;
- 1532 op: INTEGER;
- 1533 q2, qt: QbeGen.QVal;
- 1534 isR: BOOLEAN;
- 1535 lw, rw, mw: CARDINAL; .)
- 1536 = Fact<t, q> { MulOp<op> Fact<t2, q2>
- 1537 (. IF op = SymTab.OpAnd THEN
- 1538 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
- 1539 t := SymTab.BoolType()
- 1540 ELSE SemError(212); t := SymTab.InvalidType END;
- 1541 IF t # SymTab.InvalidType THEN
- 1542 QbeGen.NewTemp(qt);
- 1543 QbeGen.Op3("and", qt, q, q2, FALSE);
- 1544 QbeGen.CopyOp(qt, q)
- 1545 ELSE QbeGen.CopyOp("0", q)
- 1546 END
- 1547 ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType)
- 1548 & (SymTab.ClassOf(t) = SymTab.ClSet)
- 1549 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
- 1550 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
- 1551 mw := lw;
- 1552 IF rw > mw THEN mw := rw END;
- 1553 IF op = SymTab.OpTimes THEN
- 1554 QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
- 1555 ELSE
- 1556 QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
- 1557 END;
- 1558 t := SymTab.NewSet(
- 1559 SymTab.NewSubR(0,
- 1560 VAL(INTEGER, mw) * 32 - 1));
- 1561 QbeGen.CopyOp(qt, q)
- 1562 ELSE
- 1563 IF SymTab.ArithCheck(t, t2,
- 1564 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
- 1565 res2) THEN t := res2
- 1566 ELSE SemError(211); t := SymTab.InvalidType END;
- 1567 isR := SymTab.ClassOf(t) = SymTab.ClReal;
- 1568 IF t # SymTab.InvalidType THEN
- 1569 QbeGen.NewTemp(qt);
- 1570 IF op = SymTab.OpTimes THEN
- 1571 QbeGen.Op3("mul", qt, q, q2, isR)
- 1572 ELSIF (op = SymTab.OpDiv)
- 1573 OR (op = SymTab.OpSlash) THEN
- 1574 QbeGen.Op3("div", qt, q, q2, isR)
- 1575 ELSE
- 1576 QbeGen.Op3("rem", qt, q, q2, isR)
- 1577 END;
- 1578 QbeGen.CopyOp(qt, q)
- 1579 ELSE QbeGen.CopyOp("0", q)
- 1580 END
- 1581 END; .) } .
- 1582 MulOp<VAR op: INTEGER>
- 1583 = "*" (. op := SymTab.OpTimes; .)
- 1584 | "/" (. op := SymTab.OpSlash; .)
- 1585 | "DIV" (. op := SymTab.OpDiv; .)
- 1586 | "MOD" (. op := SymTab.OpMod; .)
- 1587 | "AND" (. op := SymTab.OpAnd; .) .
- 1588 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1589 (. VAR s: ARRAY [0 .. 255] OF CHAR;
- 1590 et, dt, t2, st, ct2:
- 1591 SymTab.TypeIndex;
- 1592 dk: INTEGER;
- 1593 qd, q2, sq, qa, qm0, qr:
- 1594 QbeGen.QVal;
- 1595 qn: SymTab.Name;
- 1596 called, isHigh, sfx:
- 1597 BOOLEAN; .)
- 1598 = integer (. LexString(s);
- 1599 QbeGen.NormInt(s, q);
- 1600 t := SymTab.IntType(); .)
- 1601 | real (. LexString(s);
- 1602 QbeGen.NormReal(s, q);
- 1603 t := SymTab.RealType(); .)
- 1604 | string (. LexString(s);
- 1605 IF SymTab.StrLen(s) = 3 THEN
- 1606 t := SymTab.CharType();
- 1607 QbeGen.IntStr(
- 1608 QbeGen.CharVal(s), q)
- 1609 ELSE t := SymTab.NewStr();
- 1610 QbeGen.DeclStr(s, q);
- 1611 (* a literal's value IS its
- 1612 static descriptor address *)
- 1613 QbeGen.NoteAddr(q, q)
- 1614 END; .)
- 1615 | Design<dt, dk, qd, qn, sfx> (. called := FALSE;
- 1616 t := dt;
- 1617 IF sfx THEN
- 1618 IF dt =
- 1619 SymTab.InvalidType THEN
- 1620 QbeGen.CopyOp("0", q)
- 1621 ELSIF (SymTab.ClassOf(dt) =
- 1622 SymTab.ClRecord)
- 1623 OR (SymTab.ClassOf(dt) =
- 1624 SymTab.ClSet)
- 1625 OR (SymTab.ClassOf(dt) =
- 1626 SymTab.ClClass) THEN
- 1627 QbeGen.CopyOp(qd, q)
- 1628 ELSE QbeGen.ElemLoad(qd, dt,
- 1629 q)
- 1630 END
- 1631 ELSE QbeGen.CopyOp(qd, q)
- 1632 END;
- 1633 IF (dk = SymTab.KindVar)
- 1634 OR (dk = SymTab.KindParam)
- 1635 OR (dk =
- 1636 SymTab.KindField) THEN
- 1637 IF sfx THEN
- 1638 QbeGen.NoteAddr(q, qd)
- 1639 ELSE
- 1640 QbeGen.AddrOf(qn, qa);
- 1641 QbeGen.NoteAddr(q, qa)
- 1642 END
- 1643 ELSIF sfx
- 1644 & (dt #
- 1645 SymTab.InvalidType)
- 1646 & ((SymTab.ClassOf(dt) =
- 1647 SymTab.ClArray)
- 1648 OR (SymTab.ClassOf(dt) =
- 1649 SymTab.ClSet)
- 1650 OR (SymTab.ClassOf(dt) =
- 1651 SymTab.ClRecord)) THEN
- 1652 QbeGen.NoteAddr(qd, qd)
- 1653 END; .)
- 1654 [ ArgList<qn, TRUE, ct2, q2, called>
- 1655 (. t := ct2;
- 1656 QbeGen.CopyOp(q2, q); .) ]
- 1657 (. IF ~called
- 1658 & (dk = SymTab.KindProc) THEN
- 1659 (* bare zero-arg function
- 1660 call (parentheses may be
- 1661 omitted); a proper or
- 1662 parameterised proc here
- 1663 is 230 *)
- 1664 IF (SymTab.ProcNPar(qn) = 0)
- 1665 & (SymTab.ProcRes(qn) #
- 1666 SymTab.InvalidType) THEN
- 1667 QbeGen.Mangled(qn,
- 1668 SymTab.ProcUid(qn), qm0);
- 1669 QbeGen.CallBegin(qm0,
- 1670 SymTab.ProcRes(qn),
- 1671 SymTab.ProcDepthOf(qn),
- 1672 SymTab.IsExternal(qn));
- 1673 QbeGen.CallEnd(TRUE, q);
- 1674 t := SymTab.ProcRes(qn)
- 1675 ELSE SemError(230)
- 1676 END
- 1677 END; .)
- 1678 | ( "HIGH" (. isHigh := TRUE; .)
- 1679 | "LEN" (. isHigh := FALSE; .) )
- 1680 "(" Design<dt, dk, qd, qn, sfx> ")"
- 1681 (. IF dt = SymTab.InvalidType THEN
- 1682 ELSIF SymTab.ClassOf(dt) #
- 1683 SymTab.ClArray THEN
- 1684 SemError(217);
- 1685 t := SymTab.InvalidType;
- 1686 QbeGen.CopyOp("0", q)
- 1687 ELSE
- 1688 IF isHigh THEN
- 1689 IF SymTab.IsOpenArray(dt) THEN
- 1690 QbeGen.OpenHi(qd, qr)
- 1691 ELSE
- 1692 QbeGen.IntStr(
- 1693 SymTab.ArrayHi(dt), qr)
- 1694 END
- 1695 ELSE
- 1696 IF SymTab.IsOpenArray(dt) THEN
- 1697 QbeGen.LoadCount(qd, qr)
- 1698 ELSE
- 1699 QbeGen.IntStr(VAL(
- 1700 INTEGER,
- 1701 SymTab.ArrayLen(dt)),
- 1702 qr)
- 1703 END
- 1704 END;
- 1705 t := SymTab.IntType();
- 1706 QbeGen.CopyOp(qr, q)
- 1707 END; .)
- 1708 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
- 1709 (. IF dt = SymTab.InvalidType THEN
- 1710 t := SymTab.InvalidType;
- 1711 QbeGen.CopyOp("0", q)
- 1712 ELSE
- 1713 QbeGen.IntStr(VAL(INTEGER,
- 1714 SymTab.ObjectSize(dt)), q);
- 1715 t := SymTab.IntType()
- 1716 END; .)
- 1717 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
- 1718 (. IF dt = SymTab.InvalidType THEN
- 1719 t := SymTab.InvalidType;
- 1720 QbeGen.CopyOp("0", q)
- 1721 ELSE
- 1722 IF sfx THEN
- 1723 QbeGen.CopyOp(qd, q)
- 1724 ELSIF (dk = SymTab.KindVar)
- 1725 OR (dk = SymTab.KindParam) THEN
- 1726 QbeGen.AddrOf(qn, q)
- 1727 ELSE SemError(230);
- 1728 QbeGen.CopyOp("0", q)
- 1729 END;
- 1730 t := SymTab.AddrType()
- 1731 END; .)
- 1732 | "(" Expr<et, q> ")" (. t := et; .)
- 1733 | SetLit<st, sq> (. t := st;
- 1734 QbeGen.CopyOp(sq, q); .)
- 1735 | "NOT" Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
- 1736 t := SymTab.BoolType()
- 1737 ELSE SemError(212);
- 1738 t := SymTab.InvalidType END;
- 1739 IF t # SymTab.InvalidType THEN
- 1740 QbeGen.NotQ(q2, q)
- 1741 ELSE QbeGen.CopyOp("0", q)
- 1742 END; .) .
- 1743 (* Set literals are SET OF [0..255] (8 words); elements validated
- 1744 0..255 statically when foldable (222 otherwise), runtime trap
- 1745 for computed elements. Ranges always lower via SetRange. *)
- 1746 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
- 1747 = "{" (. t := SymTab.NewSet(
- 1748 SymTab.NewSubR(0, 255));
- 1749 QbeGen.NewSetTemp(8, q);
- 1750 QbeGen.SetZero(q, 8); .)
- 1751 [ SetElem<t, q> { "," SetElem<t, q> } ]
- 1752 "}" .
- 1753 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal> (. VAR et, et2: SymTab.TypeIndex;
- 1754 qe, q2: QbeGen.QVal;
- 1755 v, v2: INTEGER;
- 1756 lo: INTEGER;
- 1757 span: CARDINAL;
- 1758 cl, cl2: INTEGER;
- 1759 hasR: BOOLEAN; .)
- 1760 = (. hasR := FALSE; .)
- 1761 Expr<et, qe>
- 1762 [ ".." Expr<et2, q2> (. hasR := TRUE; .) ]
- 1763 (. lo := SymTab.SetBaseLo(st);
- 1764 span := SymTab.SetCount(st);
- 1765 IF (et = SymTab.InvalidType)
- 1766 OR (hasR & (et2 =
- 1767 SymTab.InvalidType)) THEN
- 1768 ELSE cl :=
- 1769 SymTab.ClassOf(et);
- 1770 IF hasR THEN
- 1771 cl2 :=
- 1772 SymTab.ClassOf(et2)
- 1773 ELSE cl2 := SymTab.ClInt
- 1774 END;
- 1775 IF ((cl # SymTab.ClInt)
- 1776 & (cl # SymTab.ClChar)
- 1777 & (cl # SymTab.ClBool))
- 1778 OR (hasR &
- 1779 ((cl2
- 1780 # SymTab.ClInt)
- 1781 & (cl2
- 1782 # SymTab.ClChar)
- 1783 & (cl2
- 1784 # SymTab.ClBool))) THEN
- 1785 SemError(222)
- 1786 ELSIF hasR
- 1787 & SymTab.ConstInt(qe, v)
- 1788 & SymTab.ConstInt(q2,
- 1789 v2)
- 1790 & ((v < lo)
- 1791 OR (v2 < lo)
- 1792 OR (v >= lo +
- 1793 VAL(INTEGER, span))
- 1794 OR (v2 >= lo +
- 1795 VAL(INTEGER, span))
- 1796 OR (v > v2)) THEN
- 1797 SemError(222)
- 1798 ELSIF hasR THEN
- 1799 QbeGen.SetRange(sq, qe, q2,
- 1800 lo, span)
- 1801 ELSIF SymTab.ConstInt(qe,
- 1802 v)
- 1803 & ((v < lo)
- 1804 OR (v >= lo +
- 1805 VAL(INTEGER,
- 1806 span))) THEN
- 1807 SemError(222)
- 1808 ELSE QbeGen.SetBit(sq, qe,
- 1809 lo, span)
- 1810 END
- 1811 END; .) .
- 1812 GetIdent<VAR n: SymTab.Name>
- 1813 = ident (. LexName(n); .) .
- 1814
- 1815 END M2.
- 0 errors
- Statistics:
- nr of terminals: 81 (limit 400)
- nr of non-terminals: 73 (limit 210)
- nr of pragmas: 0 (limit 419)
- nr of symbolnodes: 154 (limit 500)
- nr of graphnodes: 696 (limit 1500)
- nr of conditionsets: 7 (limit 100)
- nr of charactersets: 11 (limit 250)
|
