M2.atg 148 KB

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