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