M2.atg 151 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671
  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. SymTab.PushImplClass(ct)
  593. END; .)
  594. ";" { MethodImpl<ct> ";" }
  595. [ "BEGIN" (. QbeGen.BeginInit(cn); .)
  596. [ StatSeq ] (. QbeGen.EndInit; .) ]
  597. "END"
  598. GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
  599. SemError(202) END;
  600. SymTab.PopImplClass;
  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. vs: INTEGER;
  1108. res: SymTab.TypeIndex;
  1109. mg: QbeGen.QVal;
  1110. ok, ind, isMeth: BOOLEAN; .)
  1111. = "(" (. called := TRUE;
  1112. ok := TRUE;
  1113. ind := FALSE;
  1114. isMeth := methCls #
  1115. SymTab.InvalidType;
  1116. IF isMeth THEN
  1117. (* class method: the
  1118. receiver is armed.
  1119. Virtual -> dispatch
  1120. through the vtable;
  1121. otherwise a static
  1122. call. *)
  1123. res := SymTab.ClassMethodRes(
  1124. methCls, pn);
  1125. vs := SymTab.VirtSlot(
  1126. methCls, pn);
  1127. IF vs >= 0 THEN
  1128. QbeGen.VirtCallBegin(
  1129. callee, vs, res)
  1130. ELSE
  1131. QbeGen.Mangled(pn,
  1132. SymTab.ClassMethodUid(
  1133. methCls, pn), mg);
  1134. QbeGen.CallBegin(mg, res, 0,
  1135. FALSE)
  1136. END
  1137. ELSIF SymTab.SymKind(pn) =
  1138. SymTab.KindProc THEN
  1139. res := SymTab.ProcRes(pn);
  1140. QbeGen.Mangled(pn,
  1141. SymTab.ProcUid(pn), mg);
  1142. QbeGen.CallBegin(mg, res,
  1143. SymTab.ProcDepthOf(pn),
  1144. SymTab.IsExternal(pn))
  1145. ELSIF (pt # SymTab.InvalidType)
  1146. AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
  1147. ind := TRUE;
  1148. res :=
  1149. SymTab.ProcTypeRes(pt);
  1150. QbeGen.CallBeginInd(callee,
  1151. res, FALSE)
  1152. ELSE SemError(233);
  1153. ok := FALSE;
  1154. res := SymTab.InvalidType
  1155. END;
  1156. i := 0; .)
  1157. [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
  1158. { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
  1159. ")" (. IF ok THEN
  1160. IF isMeth THEN
  1161. np := SymTab.ClassMethodNPar(
  1162. methCls, pn)
  1163. ELSIF ind THEN
  1164. np := SymTab.ProcTypeNPar(pt)
  1165. ELSE np := SymTab.ProcNPar(pn)
  1166. END;
  1167. IF i # np THEN
  1168. SemError(233); ok := FALSE
  1169. END
  1170. END;
  1171. IF NOT ok THEN
  1172. t := SymTab.InvalidType;
  1173. QbeGen.CopyOp("0", q)
  1174. ELSIF want THEN
  1175. IF res =
  1176. SymTab.InvalidType THEN
  1177. SemError(233);
  1178. t := SymTab.InvalidType;
  1179. QbeGen.CopyOp("0", q)
  1180. ELSE t := res;
  1181. QbeGen.CallEnd(TRUE, q)
  1182. END
  1183. ELSE
  1184. IF res #
  1185. SymTab.InvalidType THEN
  1186. SemError(233)
  1187. END;
  1188. t := SymTab.InvalidType;
  1189. QbeGen.CopyOp("0", q);
  1190. QbeGen.CallEnd(FALSE, q)
  1191. END; .) .
  1192. (* One actual: VAR formals take recorded designator addresses
  1193. (233 otherwise); value formals take converted expressions. *)
  1194. ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
  1195. methCls: SymTab.TypeIndex; i: CARDINAL>
  1196. (. VAR at, ft: SymTab.TypeIndex;
  1197. qe, qa, qt: QbeGen.QVal;
  1198. isV, conv: BOOLEAN; .)
  1199. = Expr<at, qe> (. IF ind THEN
  1200. ft :=
  1201. SymTab.ProcTypeParamType(pt,
  1202. i);
  1203. isV :=
  1204. SymTab.ProcTypeParamIsVar(pt,
  1205. i)
  1206. ELSIF methCls #
  1207. SymTab.InvalidType THEN
  1208. ft :=
  1209. SymTab.ClassMethodParamType(
  1210. methCls, pn, i);
  1211. isV :=
  1212. SymTab.ClassMethodParamIsVar(
  1213. methCls, pn, i)
  1214. ELSE
  1215. ft := SymTab.ParamType(pn, i);
  1216. isV := SymTab.ParamIsVar(pn, i)
  1217. END;
  1218. IF (at = SymTab.InvalidType)
  1219. OR (ft =
  1220. SymTab.InvalidType) THEN
  1221. ELSIF isV THEN
  1222. IF (SymTab.ClassOf(at)
  1223. = SymTab.ClChar)
  1224. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  1225. AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
  1226. = SymTab.ClChar)
  1227. AND QbeGen.IsImm(qe) THEN
  1228. (* 1-char string
  1229. literal passed to
  1230. a VAR ARRAY OF CHAR *)
  1231. QbeGen.DeclCharStr(qe,
  1232. qa);
  1233. IF NOT QbeGen.CallArg(qa,
  1234. "l") THEN
  1235. SemError(233)
  1236. END
  1237. ELSIF NOT QbeGen.AddrOfVal(qe,
  1238. qa) THEN
  1239. SemError(233)
  1240. ELSIF NOT SymTab.VarParamOk(at,
  1241. ft) THEN
  1242. SemError(233)
  1243. ELSIF NOT QbeGen.CallArg(qa,
  1244. "l") THEN
  1245. SemError(233)
  1246. END
  1247. ELSE
  1248. IF (SymTab.ClassOf(at)
  1249. = SymTab.ClChar)
  1250. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  1251. AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
  1252. = SymTab.ClChar)
  1253. AND QbeGen.IsImm(qe) THEN
  1254. (* 1-char string
  1255. literal passed to
  1256. ARRAY OF CHAR *)
  1257. QbeGen.DeclCharStr(qe,
  1258. qa);
  1259. IF NOT QbeGen.CallArg(qa,
  1260. "l") THEN
  1261. SemError(233)
  1262. END
  1263. ELSIF NOT SymTab.Assignable(at,
  1264. ft) THEN
  1265. SemError(233)
  1266. ELSE
  1267. conv := (SymTab.ClassOf(
  1268. ft) = SymTab.ClReal)
  1269. AND SymTab.IsIntFamily(at);
  1270. IF conv THEN
  1271. QbeGen.ConvIR(qe, qt);
  1272. IF NOT QbeGen.CallArg(qt,
  1273. "d") THEN
  1274. SemError(233)
  1275. END
  1276. ELSIF NOT QbeGen.CallArg(qe,
  1277. QbeGen.ArgClass(ft)) THEN
  1278. SemError(233)
  1279. END
  1280. END
  1281. END; .) .
  1282. IfStat (. VAR t: SymTab.TypeIndex;
  1283. q, lThen, lElse, lEnd:
  1284. QbeGen.QVal;
  1285. hasElse: BOOLEAN; .)
  1286. = "IF" (. hasElse := FALSE; .)
  1287. Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
  1288. SemError(214) END;
  1289. QbeGen.NewLabel(lThen);
  1290. QbeGen.NewLabel(lElse);
  1291. QbeGen.NewLabel(lEnd);
  1292. QbeGen.Jnz(q, lThen, lElse);
  1293. QbeGen.EmitLabel(lThen); .)
  1294. "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .)
  1295. { "ELSIF" (. QbeGen.EmitLabel(lElse);
  1296. QbeGen.NewLabel(lElse); .)
  1297. Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
  1298. SemError(214) END;
  1299. QbeGen.NewLabel(lThen);
  1300. QbeGen.Jnz(q, lThen, lElse);
  1301. QbeGen.EmitLabel(lThen); .)
  1302. "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .) }
  1303. [ "ELSE" (. QbeGen.EmitLabel(lElse);
  1304. hasElse := TRUE; .)
  1305. [ StatSeq ] ]
  1306. "END" (. IF hasElse THEN
  1307. QbeGen.EmitLabel(lEnd)
  1308. ELSE QbeGen.EmitLabel(lElse);
  1309. QbeGen.EmitLabel(lEnd)
  1310. END; .) .
  1311. WhileStat (. VAR t: SymTab.TypeIndex;
  1312. q, lTop, lBody, lEnd:
  1313. QbeGen.QVal; .)
  1314. = "WHILE" (. QbeGen.NewLabel(lTop);
  1315. QbeGen.NewLabel(lBody);
  1316. QbeGen.NewLabel(lEnd);
  1317. QbeGen.EmitLabel(lTop); .)
  1318. Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
  1319. SemError(214) END;
  1320. QbeGen.Jnz(q, lBody, lEnd);
  1321. QbeGen.EmitLabel(lBody); .)
  1322. "DO" [ StatSeq ] (. QbeGen.Jmp(lTop); .)
  1323. "END" (. QbeGen.EmitLabel(lEnd); .) .
  1324. RepeatStat (. VAR t: SymTab.TypeIndex;
  1325. q, lTop, lEnd: QbeGen.QVal; .)
  1326. = "REPEAT" (. QbeGen.NewLabel(lTop);
  1327. QbeGen.NewLabel(lEnd);
  1328. QbeGen.EmitLabel(lTop); .)
  1329. [ StatSeq ]
  1330. "UNTIL" Expr<t, q> (. IF NOT SymTab.BoolCheck(t) THEN
  1331. SemError(214) END;
  1332. QbeGen.Jnz(q, lEnd, lTop);
  1333. QbeGen.EmitLabel(lEnd); .) .
  1334. LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .)
  1335. = "LOOP" (. QbeGen.NewLabel(lTop);
  1336. QbeGen.NewLabel(lEnd);
  1337. QbeGen.PushLoop(lEnd);
  1338. QbeGen.EmitLabel(lTop); .)
  1339. [ StatSeq ]
  1340. "END" (. QbeGen.Jmp(lTop);
  1341. QbeGen.PopLoop;
  1342. QbeGen.EmitLabel(lEnd); .) .
  1343. (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
  1344. Runtime direction would need a compare-select; the literal
  1345. sign picks cslew/csegew at "DO" time. *)
  1346. ForStat (. VAR lv: SymTab.Name;
  1347. tlo, thi, tby:
  1348. SymTab.TypeIndex;
  1349. qlo, qhi, qby, qt, qk, qb:
  1350. QbeGen.QVal;
  1351. lTop, lBody, lEnd:
  1352. QbeGen.QVal;
  1353. by: INTEGER;
  1354. ok: BOOLEAN; .)
  1355. = "FOR" (. by := 1; .)
  1356. GetIdent<lv> (. ok := SymTab.Lookup(lv);
  1357. IF NOT ok THEN
  1358. SemError(201)
  1359. ELSIF (SymTab.SymKind(lv) #
  1360. SymTab.KindVar)
  1361. AND (SymTab.SymKind(lv) #
  1362. SymTab.KindParam) THEN
  1363. SemError(220); ok := FALSE
  1364. ELSIF NOT SymTab.IsIntFamily(
  1365. SymTab.SymType(lv)) THEN
  1366. SemError(220); ok := FALSE
  1367. END; .)
  1368. ":=" Expr<tlo, qlo> (. IF NOT SymTab.IsIntFamily(tlo) THEN
  1369. SemError(220); ok := FALSE
  1370. END; .)
  1371. "TO" Expr<thi, qhi> (. IF NOT SymTab.IsIntFamily(thi) THEN
  1372. SemError(220); ok := FALSE
  1373. END; .)
  1374. [ "BY" Expr<tby, qby> (. IF (tby #
  1375. SymTab.InvalidType)
  1376. AND NOT SymTab.IsIntFamily(tby) THEN
  1377. SemError(220); ok := FALSE
  1378. END;
  1379. IF NOT SymTab.ConstInt(qby, by) THEN
  1380. SemError(230); by := 1
  1381. ELSIF by = 0 THEN
  1382. SemError(220); by := 1
  1383. END; .) ]
  1384. "DO" (. IF ok THEN
  1385. QbeGen.StoreVar(lv, qlo,
  1386. FALSE) END;
  1387. QbeGen.NewLabel(lTop);
  1388. QbeGen.NewLabel(lBody);
  1389. QbeGen.NewLabel(lEnd);
  1390. QbeGen.EmitLabel(lTop);
  1391. QbeGen.LoadVar(lv, FALSE, qt);
  1392. QbeGen.NewTemp(qk);
  1393. IF by > 0 THEN
  1394. QbeGen.Op3("cslew", qk,
  1395. qt, qhi, FALSE)
  1396. ELSE QbeGen.Op3("csgew", qk,
  1397. qt, qhi, FALSE)
  1398. END;
  1399. QbeGen.Jnz(qk, lBody, lEnd);
  1400. QbeGen.EmitLabel(lBody); .)
  1401. [ StatSeq ]
  1402. "END" (. IF ok THEN
  1403. QbeGen.LoadVar(lv, FALSE,
  1404. qt);
  1405. QbeGen.IntStr(by, qb);
  1406. QbeGen.NewTemp(qk);
  1407. QbeGen.Op3("add", qk,
  1408. qt, qb, FALSE);
  1409. QbeGen.StoreVar(lv, qk,
  1410. FALSE) END;
  1411. QbeGen.Jmp(lTop);
  1412. QbeGen.EmitLabel(lEnd); .) .
  1413. CaseStat (. VAR tsel: SymTab.TypeIndex;
  1414. qsel, lEnd: QbeGen.QVal; .)
  1415. = "CASE" Expr<tsel, qsel> (. QbeGen.NewLabel(lEnd); .)
  1416. "OF" CaseAlt<tsel, qsel, lEnd>
  1417. { "|" CaseAlt<tsel, qsel, lEnd> }
  1418. [ "ELSE" [ StatSeq ] ]
  1419. "END" (. QbeGen.EmitLabel(lEnd); .) .
  1420. (* Compare-chain lowering: each alternative ends its match-tests
  1421. with "jmp lAfter", so the no-match fallthrough skips the body:
  1422. "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
  1423. lAfter:". Falls into the next alternative, ELSE, or END. *)
  1424. CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  1425. lEnd: QbeGen.QVal> (. VAR lBody, lAfter: QbeGen.QVal; .)
  1426. = (. QbeGen.NewLabel(lBody);
  1427. QbeGen.NewLabel(lAfter); .)
  1428. CaseLabel<tsel, qsel, lBody>
  1429. { "," CaseLabel<tsel, qsel, lBody> }
  1430. ":" (. QbeGen.Jmp(lAfter);
  1431. QbeGen.EmitLabel(lBody); .)
  1432. [ StatSeq ] (. QbeGen.Jmp(lEnd);
  1433. QbeGen.EmitLabel(lAfter); .) .
  1434. CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  1435. lBody: QbeGen.QVal> (. VAR t2, t3: SymTab.TypeIndex;
  1436. q2, q3, qc, qd, qe:
  1437. QbeGen.QVal;
  1438. lNext: QbeGen.QVal; .)
  1439. = Expr<t2, q2> (. IF (t2 #
  1440. SymTab.InvalidType)
  1441. AND (tsel #
  1442. SymTab.InvalidType)
  1443. AND ((SymTab.ClassOf(t2) =
  1444. SymTab.ClSet)
  1445. OR (SymTab.ClassOf(tsel) =
  1446. SymTab.ClSet)) THEN
  1447. SemError(230)
  1448. ELSIF (t2 #
  1449. SymTab.InvalidType)
  1450. AND (tsel #
  1451. SymTab.InvalidType)
  1452. AND NOT SymTab.EqCheck(t2,
  1453. tsel) THEN
  1454. SemError(213) END;
  1455. IF NOT QbeGen.IsImm(q2) THEN
  1456. SemError(230);
  1457. QbeGen.CopyOp("0", q2)
  1458. END;
  1459. QbeGen.NewLabel(lNext);
  1460. QbeGen.Cmp(SymTab.OpEq,
  1461. qsel, q2, qc, FALSE);
  1462. QbeGen.Jnz(qc, lBody, lNext);
  1463. QbeGen.EmitLabel(lNext); .)
  1464. [ ".." Expr<t3, q3> (. IF (t3 #
  1465. SymTab.InvalidType)
  1466. AND (tsel #
  1467. SymTab.InvalidType)
  1468. AND NOT SymTab.EqCheck(t3,
  1469. tsel) THEN
  1470. SemError(213) END;
  1471. IF NOT QbeGen.IsImm(q3) THEN
  1472. SemError(230);
  1473. QbeGen.CopyOp("0", q3)
  1474. END;
  1475. QbeGen.Cmp(SymTab.OpGe,
  1476. qsel, q2, qc, FALSE);
  1477. QbeGen.Cmp(SymTab.OpLe,
  1478. qsel, q3, qd, FALSE);
  1479. QbeGen.NewTemp(qe);
  1480. QbeGen.Op3("and", qe, qc, qd,
  1481. FALSE);
  1482. QbeGen.NewLabel(lNext);
  1483. QbeGen.Jnz(qe, lBody, lNext);
  1484. QbeGen.EmitLabel(lNext); .) ] .
  1485. ReturnStat (. VAR t: SymTab.TypeIndex;
  1486. q, qt: QbeGen.QVal;
  1487. res: SymTab.TypeIndex;
  1488. hadE, conv: BOOLEAN; .)
  1489. = "RETURN" (. hadE := FALSE; .)
  1490. [ Expr<t, q> (. hadE := TRUE; .) ]
  1491. (. conv := FALSE;
  1492. IF NOT SymTab.InProc() THEN
  1493. SemError(232)
  1494. ELSE res := SymTab.CurRes();
  1495. IF NOT hadE THEN
  1496. IF res #
  1497. SymTab.InvalidType THEN
  1498. SemError(232)
  1499. ELSE QbeGen.EmitRet(q,
  1500. FALSE)
  1501. END
  1502. ELSIF (res =
  1503. SymTab.InvalidType)
  1504. OR (t #
  1505. SymTab.InvalidType)
  1506. AND NOT SymTab.Assignable(t,
  1507. res) THEN
  1508. SemError(232)
  1509. ELSE
  1510. conv := (SymTab.ClassOf(
  1511. res) = SymTab.ClReal)
  1512. AND SymTab.IsIntFamily(t);
  1513. IF conv THEN
  1514. QbeGen.ConvIR(q, qt);
  1515. QbeGen.EmitRet(qt, TRUE)
  1516. ELSE QbeGen.EmitRet(q, TRUE)
  1517. END
  1518. END
  1519. END; .) .
  1520. HaltStat (. VAR t: SymTab.TypeIndex;
  1521. q: QbeGen.QVal; .)
  1522. = "HALT" [ "(" Expr<t, q> ")" ] (. QbeGen.HaltQ; .) .
  1523. (* Designator: scalar loads, array addresses, and index suffixes.
  1524. Each index descends one level (bounds-checked, trap on breach);
  1525. nested levels reload the inner descriptor address. q ends as the
  1526. value (scalars), the descriptor address (plain arrays), or the
  1527. element address (indexed); sfx marks the indexed form. *)
  1528. Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  1529. VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
  1530. (. VAR n, fn, mal: SymTab.Name;
  1531. cls: INTEGER;
  1532. ic: SymTab.TypeIndex;
  1533. curT, it, eT, bt:
  1534. SymTab.TypeIndex;
  1535. iq, ql, qlo, qhi, qe:
  1536. QbeGen.QVal;
  1537. lo, hi: INTEGER;
  1538. fo: INTEGER;
  1539. isOpen: BOOLEAN;
  1540. qb, cv: QbeGen.QVal; .)
  1541. = GetIdent<n> (. methCls := SymTab.InvalidType;
  1542. QbeGen.CopyOp(n, qn);
  1543. sfx := FALSE;
  1544. IF NOT SymTab.Lookup(n) THEN
  1545. (* a bare method name inside
  1546. a CLASS IMPLEMENTATION
  1547. is a sibling call on
  1548. THIS *)
  1549. ic := SymTab.CurImplClass();
  1550. IF (ic #
  1551. SymTab.InvalidType)
  1552. AND SymTab.MethodExists(ic, n) THEN
  1553. sfx := FALSE;
  1554. QbeGen.ThisBase(q);
  1555. QbeGen.ArmRecv(q);
  1556. methCls := ic;
  1557. k := SymTab.KindProc;
  1558. t := SymTab.InvalidType
  1559. ELSE
  1560. SemError(201);
  1561. t :=
  1562. SymTab.InvalidType;
  1563. k := -1;
  1564. QbeGen.CopyOp("0", q)
  1565. END
  1566. ELSE
  1567. t := SymTab.SymType(n);
  1568. k := SymTab.SymKind(n);
  1569. IF k = SymTab.KindConst THEN
  1570. IF SymTab.Equal(n,
  1571. "TRUE") THEN
  1572. t := SymTab.BoolType();
  1573. QbeGen.CopyOp("1", q)
  1574. ELSIF SymTab.Equal(n,
  1575. "FALSE") THEN
  1576. t := SymTab.BoolType();
  1577. QbeGen.CopyOp("0", q)
  1578. ELSIF SymTab.Equal(n,
  1579. "NIL") THEN
  1580. QbeGen.CopyOp("0", q)
  1581. ELSE
  1582. cls :=
  1583. SymTab.ClassOf(t);
  1584. IF (t #
  1585. SymTab.InvalidType)
  1586. AND ((cls = SymTab.ClInt)
  1587. OR (cls
  1588. = SymTab.ClChar)
  1589. OR (cls
  1590. = SymTab.ClEnum)
  1591. OR (cls
  1592. = SymTab.ClReal)
  1593. OR (cls
  1594. = SymTab.ClNil)) THEN
  1595. IF cls = SymTab.ClNil THEN
  1596. QbeGen.CopyOp("0", q)
  1597. ELSIF ((cls
  1598. = SymTab.ClInt)
  1599. OR (cls
  1600. = SymTab.ClChar)
  1601. OR (cls
  1602. = SymTab.ClEnum))
  1603. AND SymTab.GetSymVal(n, cv)
  1604. AND QbeGen.IsImm(cv) THEN
  1605. QbeGen.CopyOp(cv, q)
  1606. ELSE
  1607. QbeGen.LoadVar(n,
  1608. cls = SymTab.ClReal,
  1609. q)
  1610. END
  1611. ELSE
  1612. IF t #
  1613. SymTab.InvalidType THEN
  1614. SemError(230)
  1615. END;
  1616. QbeGen.CopyOp("0", q)
  1617. END
  1618. END
  1619. ELSIF (k = SymTab.KindVar)
  1620. OR (k = SymTab.KindParam) THEN
  1621. cls :=
  1622. SymTab.ClassOf(t);
  1623. IF (cls = SymTab.ClInt)
  1624. OR (cls = SymTab.ClBool)
  1625. OR (cls = SymTab.ClChar)
  1626. OR (cls = SymTab.ClUChar)
  1627. OR (cls = SymTab.ClEnum)
  1628. OR (cls
  1629. = SymTab.ClReal) THEN
  1630. QbeGen.LoadVar(n,
  1631. cls = SymTab.ClReal, q)
  1632. ELSIF (cls = SymTab.ClPtr)
  1633. OR (cls = SymTab.ClProc) THEN
  1634. QbeGen.LoadPtr(n, q)
  1635. ELSIF cls = SymTab.ClLong THEN
  1636. QbeGen.LoadLong(n, q)
  1637. ELSIF (cls
  1638. = SymTab.ClArray)
  1639. OR (cls
  1640. = SymTab.ClSet)
  1641. OR (cls
  1642. = SymTab.ClRecord)
  1643. OR (cls
  1644. = SymTab.ClUStr)
  1645. OR (cls
  1646. = SymTab.ClClass) THEN
  1647. QbeGen.AddrOf(n, q)
  1648. ELSE SemError(230);
  1649. QbeGen.CopyOp("0", q)
  1650. END
  1651. ELSE QbeGen.CopyOp("0", q);
  1652. IF k = SymTab.KindImport THEN
  1653. SemError(230)
  1654. ELSIF k =
  1655. SymTab.KindProc THEN
  1656. (* bare procedure name:
  1657. a following ArgList
  1658. makes it a call;
  1659. otherwise Fact
  1660. reports 230 *)
  1661. ELSE
  1662. IF k = SymTab.KindField THEN
  1663. IF QbeGen.TopWith(qb) THEN
  1664. fo :=
  1665. SymTab.FieldOffset(
  1666. SymTab.FieldOwner(n),
  1667. n);
  1668. QbeGen.FieldAddr(qb,
  1669. fo, q);
  1670. sfx := TRUE
  1671. ELSE SemError(230);
  1672. QbeGen.CopyOp("0", q)
  1673. END
  1674. END
  1675. END
  1676. END
  1677. END; .)
  1678. { "[" Expr<it, iq>
  1679. (. IF t = SymTab.InvalidType THEN
  1680. ELSIF SymTab.ClassOf(t) #
  1681. SymTab.ClArray THEN
  1682. SemError(217);
  1683. t := SymTab.InvalidType
  1684. ELSIF NOT SymTab.IsIntFamily(it)
  1685. AND (SymTab.ClassOf(it) #
  1686. SymTab.ClChar) THEN
  1687. SemError(218);
  1688. t := SymTab.InvalidType
  1689. ELSE
  1690. QbeGen.WidenIndex(iq, ql);
  1691. isOpen :=
  1692. SymTab.IsOpenArray(t);
  1693. IF isOpen THEN
  1694. QbeGen.CopyOp("0", qlo);
  1695. IF SymTab.IsCharArray(t)
  1696. OR SymTab.IsUCharArray(t) THEN
  1697. QbeGen.OpenHiChar(q, qhi)
  1698. ELSE QbeGen.OpenHi(q, qhi)
  1699. END
  1700. ELSE
  1701. lo := SymTab.ArrayLo(t);
  1702. hi := SymTab.ArrayHi(t);
  1703. IF SymTab.IsCharArray(t)
  1704. OR SymTab.IsUCharArray(t) THEN
  1705. hi := hi + 1
  1706. END;
  1707. QbeGen.IntStr(lo, qlo);
  1708. QbeGen.IntStr(hi, qhi)
  1709. END;
  1710. QbeGen.CheckRange(ql, qlo,
  1711. qhi);
  1712. eT := SymTab.ArrayElem(t);
  1713. QbeGen.ElemAddr(q, ql, qlo,
  1714. t, qe);
  1715. IF SymTab.ClassOf(eT) =
  1716. SymTab.ClArray THEN
  1717. QbeGen.ElemLoad(qe, eT, q)
  1718. ELSE QbeGen.CopyOp(qe, q)
  1719. END;
  1720. t := eT; sfx := TRUE
  1721. END; .)
  1722. { "," Expr<it, iq>
  1723. (. IF t = SymTab.InvalidType THEN
  1724. ELSIF SymTab.ClassOf(t) #
  1725. SymTab.ClArray THEN
  1726. SemError(217);
  1727. t := SymTab.InvalidType
  1728. ELSIF NOT SymTab.IsIntFamily(it)
  1729. AND (SymTab.ClassOf(it) #
  1730. SymTab.ClChar) THEN
  1731. SemError(218);
  1732. t := SymTab.InvalidType
  1733. ELSE
  1734. QbeGen.WidenIndex(iq, ql);
  1735. isOpen :=
  1736. SymTab.IsOpenArray(t);
  1737. IF isOpen THEN
  1738. QbeGen.CopyOp("0", qlo);
  1739. IF SymTab.IsCharArray(t)
  1740. OR SymTab.IsUCharArray(t) THEN
  1741. QbeGen.OpenHiChar(q, qhi)
  1742. ELSE QbeGen.OpenHi(q, qhi)
  1743. END
  1744. ELSE
  1745. lo := SymTab.ArrayLo(t);
  1746. hi := SymTab.ArrayHi(t);
  1747. IF SymTab.IsCharArray(t)
  1748. OR SymTab.IsUCharArray(t) THEN
  1749. hi := hi + 1
  1750. END;
  1751. QbeGen.IntStr(lo, qlo);
  1752. QbeGen.IntStr(hi, qhi)
  1753. END;
  1754. QbeGen.CheckRange(ql, qlo,
  1755. qhi);
  1756. eT := SymTab.ArrayElem(t);
  1757. QbeGen.ElemAddr(q, ql, qlo,
  1758. t, qe);
  1759. IF SymTab.ClassOf(eT) =
  1760. SymTab.ClArray THEN
  1761. QbeGen.ElemLoad(qe, eT, q)
  1762. ELSE QbeGen.CopyOp(qe, q)
  1763. END;
  1764. t := eT; sfx := TRUE
  1765. END; .) }
  1766. "]"
  1767. | "." GetIdent<fn>
  1768. (. IF k = SymTab.KindModule THEN
  1769. (* qualified L.x: materialize
  1770. the export, then load it *)
  1771. IF NOT SymTab.MaterializeAlias(n,
  1772. fn, mal) THEN
  1773. SemError(201);
  1774. t := SymTab.InvalidType;
  1775. QbeGen.CopyOp("0", q)
  1776. ELSE
  1777. QbeGen.CopyOp(mal, qn);
  1778. t := SymTab.SymType(mal);
  1779. k := SymTab.SymKind(mal);
  1780. sfx := FALSE;
  1781. IF k = SymTab.KindProc THEN
  1782. (* call: ArgList supplies
  1783. the value *)
  1784. QbeGen.CopyOp("0", q)
  1785. ELSIF NOT QbeGen.LoadDesignator(
  1786. mal, t, k, q) THEN
  1787. SemError(230);
  1788. QbeGen.CopyOp("0", q)
  1789. END
  1790. END
  1791. ELSIF t = SymTab.InvalidType THEN
  1792. ELSIF (SymTab.ClassOf(t) #
  1793. SymTab.ClRecord)
  1794. AND (SymTab.ClassOf(t) #
  1795. SymTab.ClClass) THEN
  1796. SemError(215);
  1797. t := SymTab.InvalidType
  1798. ELSIF (SymTab.ClassOf(t) =
  1799. SymTab.ClClass)
  1800. AND SymTab.MethodExists(t, fn) THEN
  1801. (* obj.Method: bind the
  1802. method and pass obj as
  1803. the hidden receiver; q
  1804. already holds the
  1805. object's address *)
  1806. QbeGen.ArmRecv(q);
  1807. QbeGen.CopyOp(fn, n);
  1808. QbeGen.CopyOp(fn, qn);
  1809. methCls := t;
  1810. k := SymTab.KindProc;
  1811. t := SymTab.InvalidType
  1812. ELSIF NOT SymTab.FieldExists(t,
  1813. fn) THEN
  1814. SemError(216);
  1815. t := SymTab.InvalidType
  1816. ELSE
  1817. fo := SymTab.FieldOffset(t,
  1818. fn);
  1819. t := SymTab.FieldType(t, fn);
  1820. QbeGen.FieldAddr(q, fo, qe);
  1821. (* array fields are inline:
  1822. the field address is the
  1823. descriptor, like records *)
  1824. QbeGen.CopyOp(qe, q);
  1825. sfx := TRUE
  1826. END; .)
  1827. | "^"
  1828. (. IF t = SymTab.InvalidType THEN
  1829. ELSIF SymTab.ClassOf(t) #
  1830. SymTab.ClPtr THEN
  1831. SemError(219);
  1832. t := SymTab.InvalidType
  1833. ELSE
  1834. bt := SymTab.PtrBase(t);
  1835. IF bt = SymTab.InvalidType THEN
  1836. ELSE
  1837. IF sfx THEN
  1838. QbeGen.ElemLoad(q, t,
  1839. qb);
  1840. QbeGen.CopyOp(qb, q)
  1841. END;
  1842. t := bt;
  1843. (* q holds the pointee
  1844. address: Fact loads
  1845. scalars/pointers and uses
  1846. the address for
  1847. aggregates; the VAR-actual
  1848. note is q itself. *)
  1849. sfx := TRUE
  1850. END
  1851. END; .) } .
  1852. Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  1853. (. VAR t2: SymTab.TypeIndex;
  1854. op: INTEGER;
  1855. q2, qt, wl: QbeGen.QVal;
  1856. isR: BOOLEAN; .)
  1857. = SimExpr<t, q>
  1858. [ Rel<op> SimExpr<t2, q2>
  1859. (. IF op = SymTab.OpIn THEN
  1860. IF SymTab.InCheck(t, t2) THEN
  1861. IF (t = SymTab.InvalidType)
  1862. OR (t2 = SymTab.InvalidType) THEN
  1863. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  1864. ELSE
  1865. QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
  1866. SymTab.SetCount(t2), qt);
  1867. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1868. END
  1869. ELSE SemError(222); t := SymTab.InvalidType;
  1870. QbeGen.CopyOp("0", q)
  1871. END
  1872. ELSIF SymTab.RelCheck(t, t2, op) THEN
  1873. IF (t = SymTab.InvalidType)
  1874. OR (t2 = SymTab.InvalidType) THEN
  1875. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  1876. ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
  1877. OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
  1878. IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
  1879. AND (op # SymTab.OpNeq2) THEN
  1880. SemError(213); t := SymTab.InvalidType;
  1881. QbeGen.CopyOp("0", q)
  1882. ELSE
  1883. QbeGen.CmpL(op, q, q2, qt);
  1884. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1885. END
  1886. ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
  1887. OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  1888. QbeGen.CmpSet(op, q, q2,
  1889. SymTab.SetWords(t), SymTab.SetWords(t2), qt);
  1890. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1891. ELSIF SymTab.StrCompat(t, t2) THEN
  1892. QbeGen.StrEq(op, q, q2, qt);
  1893. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1894. ELSIF SymTab.IsLongFamily(t)
  1895. OR SymTab.IsLongFamily(t2) THEN
  1896. IF SymTab.IsIntFamily(t) THEN
  1897. QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
  1898. END;
  1899. IF SymTab.IsIntFamily(t2) THEN
  1900. QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
  1901. END;
  1902. QbeGen.CmpLong(op, q, q2, qt);
  1903. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1904. ELSE
  1905. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  1906. t := SymTab.BoolType();
  1907. QbeGen.Cmp(op, q, q2, qt, isR);
  1908. QbeGen.CopyOp(qt, q)
  1909. END
  1910. ELSE SemError(213); t := SymTab.InvalidType;
  1911. QbeGen.CopyOp("0", q)
  1912. END; .) ] .
  1913. Rel<VAR op: INTEGER>
  1914. = "=" (. op := SymTab.OpEq; .)
  1915. | "#" (. op := SymTab.OpNeq1; .)
  1916. | "<" (. op := SymTab.OpLt; .)
  1917. | "<=" (. op := SymTab.OpLe; .)
  1918. | ">" (. op := SymTab.OpGt; .)
  1919. | ">=" (. op := SymTab.OpGe; .)
  1920. | "IN" (. op := SymTab.OpIn; .) .
  1921. SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  1922. (. VAR t2, res2, lt, rt:
  1923. SymTab.TypeIndex;
  1924. op: INTEGER;
  1925. q2, qt, wq, qf, q2a, q2b:
  1926. QbeGen.QVal;
  1927. neg, isR, isL, folded:
  1928. BOOLEAN;
  1929. lw, rw, mw: CARDINAL;
  1930. lTrue, lNext, lDone, qr, qs:
  1931. QbeGen.QVal; .)
  1932. = (. neg := FALSE; .)
  1933. [ "+" | "-" (. neg := TRUE; .) ]
  1934. Term<t, q> (. IF neg THEN
  1935. IF QbeGen.IsImm(q) THEN
  1936. QbeGen.NegFold(q, q)
  1937. ELSE QbeGen.NewTemp(qt);
  1938. QbeGen.NegQ(q, qt,
  1939. SymTab.ClassOf(t)
  1940. = SymTab.ClReal);
  1941. QbeGen.CopyOp(qt, q)
  1942. END
  1943. END; .)
  1944. { AddOp<op> (. IF op = SymTab.OpOr THEN
  1945. QbeGen.DelayBegin END; .)
  1946. Term<t2, q2> (. IF op = SymTab.OpOr THEN
  1947. QbeGen.DelayEnd END; .)
  1948. (. IF op = SymTab.OpOr THEN
  1949. (* short-circuit: if q is true the RHS is skipped *)
  1950. IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
  1951. t := SymTab.BoolType()
  1952. ELSE SemError(212); t := SymTab.InvalidType END;
  1953. IF t # SymTab.InvalidType THEN
  1954. QbeGen.Slot4(qs);
  1955. QbeGen.NewLabel(lTrue);
  1956. QbeGen.NewLabel(lNext);
  1957. QbeGen.NewLabel(lDone);
  1958. QbeGen.Jnz(q, lTrue, lNext);
  1959. QbeGen.EmitLabel(lTrue);
  1960. QbeGen.StoreW(qs, "1");
  1961. QbeGen.Jmp(lDone);
  1962. QbeGen.EmitLabel(lNext);
  1963. QbeGen.DelayFlush;
  1964. QbeGen.StoreW(qs, q2);
  1965. QbeGen.Jmp(lDone);
  1966. QbeGen.EmitLabel(lDone);
  1967. QbeGen.LoadW(qs, qr);
  1968. QbeGen.CopyOp(qr, q)
  1969. ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
  1970. END
  1971. ELSIF (op = SymTab.OpAdd)
  1972. AND (SymTab.UStrCompat(t, t2)
  1973. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  1974. AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
  1975. OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
  1976. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
  1977. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  1978. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
  1979. (* UString concatenation: a UCHAR operand becomes a
  1980. 1-codepoint UString; the result is a descriptor in the
  1981. shim's concat buffer. Work on copies so neither
  1982. operand is clobbered. *)
  1983. IF SymTab.ClassOf(t) = SymTab.ClUStr THEN
  1984. QbeGen.CopyOp(q, q2a)
  1985. ELSE
  1986. QbeGen.UStrFrom(q, q2a)
  1987. END;
  1988. IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN
  1989. QbeGen.UStrCat(q2a, q2, qt)
  1990. ELSE
  1991. QbeGen.UStrFrom(q2, q2b);
  1992. QbeGen.UStrCat(q2a, q2b, qt)
  1993. END;
  1994. t := SymTab.NewUStr();
  1995. QbeGen.CopyOp(qt, q)
  1996. ELSIF (op = SymTab.OpAdd)
  1997. AND (SymTab.StrCompat(t, t2)
  1998. OR (SymTab.IsStrType(t)
  1999. AND (SymTab.ClassOf(t2) = SymTab.ClChar))
  2000. OR ((SymTab.ClassOf(t) = SymTab.ClChar)
  2001. AND SymTab.IsStrType(t2))) THEN
  2002. (* string concatenation; a CHAR operand becomes a
  2003. 1-character string literal *)
  2004. IF SymTab.StrCompat(t, t2) THEN
  2005. QbeGen.StrCat(q, q2, qt)
  2006. ELSIF SymTab.IsStrType(t) THEN
  2007. QbeGen.DeclCharStr(q2, qs);
  2008. QbeGen.StrCat(q, qs, qt)
  2009. ELSE
  2010. QbeGen.DeclCharStr(q, qs);
  2011. QbeGen.StrCat(qs, q2, qt)
  2012. END;
  2013. t := SymTab.NewStr();
  2014. QbeGen.CopyOp(qt, q)
  2015. ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  2016. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  2017. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2018. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  2019. mw := lw;
  2020. IF rw > mw THEN mw := rw END;
  2021. IF op = SymTab.OpAdd THEN
  2022. QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
  2023. ELSE
  2024. QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
  2025. END;
  2026. t := SymTab.NewSet(
  2027. SymTab.NewSubR(0,
  2028. VAL(INTEGER, mw) * 32 - 1));
  2029. QbeGen.CopyOp(qt, q)
  2030. ELSE
  2031. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
  2032. lt := t; rt := t2; t := res2
  2033. ELSE SemError(211); t := SymTab.InvalidType END;
  2034. IF t # SymTab.InvalidType THEN
  2035. isL := SymTab.IsLongFamily(t);
  2036. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  2037. folded := FALSE;
  2038. IF (NOT isL) AND (NOT isR)
  2039. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  2040. IF op = SymTab.OpAdd THEN
  2041. folded := QbeGen.Fold2(0, q, q2, qf)
  2042. ELSE
  2043. folded := QbeGen.Fold2(1, q, q2, qf)
  2044. END
  2045. END;
  2046. IF folded THEN QbeGen.CopyOp(qf, q)
  2047. ELSE
  2048. IF isL THEN
  2049. IF SymTab.IsIntFamily(lt) THEN
  2050. QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
  2051. END;
  2052. IF SymTab.IsIntFamily(rt) THEN
  2053. QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
  2054. END;
  2055. QbeGen.NewTemp(qt);
  2056. IF op = SymTab.OpAdd THEN
  2057. QbeGen.Op3L("add", qt, q, q2)
  2058. ELSE
  2059. QbeGen.Op3L("sub", qt, q, q2)
  2060. END
  2061. ELSE
  2062. QbeGen.NewTemp(qt);
  2063. IF op = SymTab.OpAdd THEN
  2064. QbeGen.Op3("add", qt, q, q2, isR)
  2065. ELSE
  2066. QbeGen.Op3("sub", qt, q, q2, isR)
  2067. END
  2068. END;
  2069. QbeGen.CopyOp(qt, q)
  2070. END
  2071. ELSE QbeGen.CopyOp("0", q)
  2072. END
  2073. END; .) } .
  2074. AddOp<VAR op: INTEGER>
  2075. = "+" (. op := SymTab.OpAdd; .)
  2076. | "-" (. op := SymTab.OpSub; .)
  2077. | "OR" (. op := SymTab.OpOr; .) .
  2078. Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2079. (. VAR t2, res2, lt, rt:
  2080. SymTab.TypeIndex;
  2081. op: INTEGER;
  2082. q2, qt, wq, qf:
  2083. QbeGen.QVal;
  2084. isR, isL, folded: BOOLEAN;
  2085. lw, rw, mw: CARDINAL;
  2086. lNext, lFalse, lDone, qr, qs:
  2087. QbeGen.QVal; .)
  2088. = Fact<t, q> { MulOp<op> (. IF op = SymTab.OpAnd THEN
  2089. QbeGen.DelayBegin END; .)
  2090. Fact<t2, q2> (. IF op = SymTab.OpAnd THEN
  2091. QbeGen.DelayEnd END; .)
  2092. (. IF op = SymTab.OpAnd THEN
  2093. (* short-circuit: if q is false the RHS is skipped *)
  2094. IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
  2095. t := SymTab.BoolType()
  2096. ELSE SemError(212); t := SymTab.InvalidType END;
  2097. IF t # SymTab.InvalidType THEN
  2098. QbeGen.Slot4(qs);
  2099. QbeGen.NewLabel(lNext);
  2100. QbeGen.NewLabel(lFalse);
  2101. QbeGen.NewLabel(lDone);
  2102. QbeGen.Jnz(q, lNext, lFalse);
  2103. QbeGen.EmitLabel(lNext);
  2104. QbeGen.DelayFlush;
  2105. QbeGen.StoreW(qs, q2);
  2106. QbeGen.Jmp(lDone);
  2107. QbeGen.EmitLabel(lFalse);
  2108. QbeGen.StoreW(qs, "0");
  2109. QbeGen.Jmp(lDone);
  2110. QbeGen.EmitLabel(lDone);
  2111. QbeGen.LoadW(qs, qr);
  2112. QbeGen.CopyOp(qr, q)
  2113. ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
  2114. END
  2115. ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  2116. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  2117. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2118. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  2119. mw := lw;
  2120. IF rw > mw THEN mw := rw END;
  2121. IF op = SymTab.OpTimes THEN
  2122. QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
  2123. ELSE
  2124. QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
  2125. END;
  2126. t := SymTab.NewSet(
  2127. SymTab.NewSubR(0,
  2128. VAL(INTEGER, mw) * 32 - 1));
  2129. QbeGen.CopyOp(qt, q)
  2130. ELSE
  2131. IF SymTab.ArithCheck(t, t2,
  2132. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  2133. res2) THEN
  2134. lt := t; rt := t2; t := res2
  2135. ELSE SemError(211); t := SymTab.InvalidType END;
  2136. IF t # SymTab.InvalidType THEN
  2137. isL := SymTab.IsLongFamily(t);
  2138. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  2139. folded := FALSE;
  2140. IF (NOT isL) AND (NOT isR)
  2141. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  2142. IF op = SymTab.OpTimes THEN
  2143. folded := QbeGen.Fold2(2, q, q2, qf)
  2144. ELSIF op = SymTab.OpDiv THEN
  2145. folded := QbeGen.Fold2(3, q, q2, qf)
  2146. ELSIF op = SymTab.OpMod THEN
  2147. folded := QbeGen.Fold2(4, q, q2, qf)
  2148. END
  2149. END;
  2150. IF folded THEN QbeGen.CopyOp(qf, q)
  2151. ELSE
  2152. IF isL THEN
  2153. IF SymTab.IsIntFamily(lt) THEN
  2154. QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
  2155. END;
  2156. IF SymTab.IsIntFamily(rt) THEN
  2157. QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
  2158. END;
  2159. QbeGen.NewTemp(qt);
  2160. IF op = SymTab.OpTimes THEN
  2161. QbeGen.Op3L("mul", qt, q, q2)
  2162. ELSIF (op = SymTab.OpDiv)
  2163. OR (op = SymTab.OpSlash) THEN
  2164. QbeGen.Op3L("div", qt, q, q2)
  2165. ELSE
  2166. QbeGen.Op3L("rem", qt, q, q2)
  2167. END
  2168. ELSE
  2169. QbeGen.NewTemp(qt);
  2170. IF op = SymTab.OpTimes THEN
  2171. QbeGen.Op3("mul", qt, q, q2, isR)
  2172. ELSIF (op = SymTab.OpDiv)
  2173. OR (op = SymTab.OpSlash) THEN
  2174. QbeGen.Op3("div", qt, q, q2, isR)
  2175. ELSE
  2176. QbeGen.Op3("rem", qt, q, q2, isR)
  2177. END
  2178. END;
  2179. QbeGen.CopyOp(qt, q)
  2180. END
  2181. ELSE QbeGen.CopyOp("0", q)
  2182. END
  2183. END; .) } .
  2184. MulOp<VAR op: INTEGER>
  2185. = "*" (. op := SymTab.OpTimes; .)
  2186. | "/" (. op := SymTab.OpSlash; .)
  2187. | "DIV" (. op := SymTab.OpDiv; .)
  2188. | "MOD" (. op := SymTab.OpMod; .)
  2189. | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
  2190. Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2191. (. VAR s: ARRAY [0 .. 255] OF CHAR;
  2192. et, dt, t2, st, ct2:
  2193. SymTab.TypeIndex;
  2194. dk: INTEGER;
  2195. qd, q2, sq, qa, qm0, qr:
  2196. QbeGen.QVal;
  2197. qn, vn: SymTab.Name;
  2198. vt: SymTab.TypeIndex;
  2199. c1, c2: INTEGER;
  2200. called, isHigh, sfx, isCh,
  2201. isU, uok, isStr: BOOLEAN;
  2202. ucp: INTEGER; .)
  2203. = integer (. LexString(s);
  2204. QbeGen.NormInt(s, q);
  2205. t := SymTab.IntType(); .)
  2206. | charConst (. LexString(s);
  2207. QbeGen.NormLit(s, q, isCh);
  2208. t := SymTab.CharType(); .)
  2209. | real (. LexString(s);
  2210. QbeGen.NormReal(s, q);
  2211. t := SymTab.RealType(); .)
  2212. | string (. LexString(s);
  2213. IF SymTab.StrLen(s) = 3 THEN
  2214. t := SymTab.CharType();
  2215. QbeGen.IntStr(
  2216. QbeGen.CharVal(s), q)
  2217. ELSE t := SymTab.NewStr();
  2218. QbeGen.DeclStr(s, q);
  2219. (* a literal's value IS its
  2220. static descriptor address *)
  2221. QbeGen.NoteAddr(q, q)
  2222. END; .)
  2223. | ustring (. LexString(s);
  2224. QbeGen.DeclUStr(s, q, isU, ucp,
  2225. uok);
  2226. IF NOT uok THEN
  2227. SemError(234);
  2228. t := SymTab.InvalidType
  2229. ELSIF isU THEN
  2230. t := SymTab.UCharType();
  2231. QbeGen.IntStr(ucp, q)
  2232. ELSE
  2233. t := SymTab.NewUStr();
  2234. QbeGen.NoteAddr(q, q)
  2235. END; .)
  2236. | Design<dt, dk, qd, qn, sfx> (. called := FALSE;
  2237. t := dt;
  2238. IF sfx THEN
  2239. IF dt =
  2240. SymTab.InvalidType THEN
  2241. QbeGen.CopyOp("0", q)
  2242. ELSIF (SymTab.ClassOf(dt) =
  2243. SymTab.ClRecord)
  2244. OR (SymTab.ClassOf(dt) =
  2245. SymTab.ClSet)
  2246. OR (SymTab.ClassOf(dt) =
  2247. SymTab.ClArray)
  2248. OR (SymTab.ClassOf(dt) =
  2249. SymTab.ClClass) THEN
  2250. QbeGen.CopyOp(qd, q)
  2251. ELSE QbeGen.ElemLoad(qd, dt,
  2252. q)
  2253. END
  2254. ELSE QbeGen.CopyOp(qd, q)
  2255. END;
  2256. IF (dk = SymTab.KindVar)
  2257. OR (dk = SymTab.KindParam)
  2258. OR (dk =
  2259. SymTab.KindField) THEN
  2260. IF sfx THEN
  2261. QbeGen.NoteAddr(q, qd)
  2262. ELSE
  2263. QbeGen.AddrOf(qn, qa);
  2264. QbeGen.NoteAddr(q, qa)
  2265. END
  2266. ELSIF sfx
  2267. AND (dt #
  2268. SymTab.InvalidType)
  2269. AND ((SymTab.ClassOf(dt) =
  2270. SymTab.ClArray)
  2271. OR (SymTab.ClassOf(dt) =
  2272. SymTab.ClSet)
  2273. OR (SymTab.ClassOf(dt) =
  2274. SymTab.ClRecord)) THEN
  2275. QbeGen.NoteAddr(qd, qd)
  2276. END; .)
  2277. [ TypedSetLit<dt, q> (. t := dt; .) ]
  2278. [ ArgList<qn, dt, qd, TRUE, methCls, ct2, q2, called>
  2279. (. t := ct2;
  2280. QbeGen.CopyOp(q2, q); .) ]
  2281. (. IF NOT called
  2282. AND (dk = SymTab.KindProc) THEN
  2283. (* bare zero-arg function
  2284. call (parentheses may be
  2285. omitted); a proper or
  2286. parameterised proc here
  2287. is 230 *)
  2288. IF (SymTab.ProcNPar(qn) = 0)
  2289. AND (SymTab.ProcRes(qn) #
  2290. SymTab.InvalidType) THEN
  2291. QbeGen.Mangled(qn,
  2292. SymTab.ProcUid(qn), qm0);
  2293. QbeGen.CallBegin(qm0,
  2294. SymTab.ProcRes(qn),
  2295. SymTab.ProcDepthOf(qn),
  2296. SymTab.IsExternal(qn));
  2297. QbeGen.CallEnd(TRUE, q);
  2298. t := SymTab.ProcRes(qn)
  2299. ELSE
  2300. (* procedure used as a
  2301. value (assign to a
  2302. procedure variable):
  2303. its code address *)
  2304. t := SymTab.ProcTypeOf(qn);
  2305. QbeGen.Mangled(qn,
  2306. SymTab.ProcUid(qn), qm0);
  2307. QbeGen.ProcAddr(qm0, q)
  2308. END
  2309. END; .)
  2310. | ( "HIGH" (. isHigh := TRUE; .)
  2311. | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
  2312. "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
  2313. isU := FALSE; .)
  2314. | string (. LexString(s);
  2315. isStr := TRUE;
  2316. isU := FALSE;
  2317. IF SymTab.StrLen(s) = 3 THEN
  2318. dt := SymTab.CharType();
  2319. QbeGen.IntStr(QbeGen.CharVal(s),
  2320. qd)
  2321. ELSE
  2322. dt := SymTab.NewStr();
  2323. QbeGen.DeclStr(s, qd);
  2324. QbeGen.NoteAddr(qd, qd)
  2325. END;
  2326. dk := -1;
  2327. qn[0] := CHR(0); .)
  2328. | ustring (. LexString(s);
  2329. QbeGen.DeclUStr(s, qd, isU, ucp,
  2330. uok);
  2331. isStr := FALSE;
  2332. IF NOT uok THEN
  2333. SemError(234);
  2334. dt := SymTab.InvalidType
  2335. ELSIF isU THEN
  2336. (* one codepoint: a UCHAR;
  2337. LEN is 1, HIGH is 0 *)
  2338. dt := SymTab.UCharType();
  2339. QbeGen.IntStr(ucp, qd)
  2340. ELSE
  2341. dt := SymTab.NewUStr();
  2342. QbeGen.NoteAddr(qd, qd)
  2343. END;
  2344. dk := -1;
  2345. qn[0] := CHR(0); .) )
  2346. ")"
  2347. (. IF (dt # SymTab.InvalidType)
  2348. AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
  2349. (* UString: the count is
  2350. the descriptor header *)
  2351. IF isHigh THEN
  2352. QbeGen.UStrLen(qd, qr);
  2353. QbeGen.DecQ(qr)
  2354. ELSE
  2355. QbeGen.UStrLen(qd, qr)
  2356. END;
  2357. t := SymTab.IntType();
  2358. QbeGen.CopyOp(qr, q)
  2359. ELSIF (dt # SymTab.InvalidType)
  2360. AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
  2361. (* single UCHAR codepoint *)
  2362. IF isHigh THEN
  2363. QbeGen.CopyOp("0", qr)
  2364. ELSE
  2365. QbeGen.CopyOp("1", qr)
  2366. END;
  2367. t := SymTab.IntType();
  2368. QbeGen.CopyOp(qr, q)
  2369. ELSIF isStr THEN
  2370. (* fold: content length at
  2371. compile time *)
  2372. IF SymTab.StrLen(s) = 3 THEN
  2373. c1 := 1
  2374. ELSE
  2375. c1 :=
  2376. SymTab.StrLen(s) - 2
  2377. END;
  2378. IF isHigh THEN
  2379. DEC(c1)
  2380. END;
  2381. QbeGen.IntStr(c1, qr);
  2382. t := SymTab.IntType();
  2383. QbeGen.CopyOp(qr, q)
  2384. ELSIF dt = SymTab.InvalidType THEN
  2385. t := SymTab.InvalidType;
  2386. QbeGen.CopyOp("0", q)
  2387. ELSIF SymTab.ClassOf(dt) #
  2388. SymTab.ClArray THEN
  2389. SemError(217);
  2390. t := SymTab.InvalidType;
  2391. QbeGen.CopyOp("0", q)
  2392. ELSE
  2393. IF isHigh THEN
  2394. IF SymTab.IsOpenArray(dt) THEN
  2395. QbeGen.OpenHi(qd, qr)
  2396. ELSE
  2397. QbeGen.IntStr(
  2398. SymTab.ArrayHi(dt), qr)
  2399. END
  2400. ELSE
  2401. IF SymTab.IsOpenArray(dt) THEN
  2402. QbeGen.LoadCount(qd, qr)
  2403. ELSE
  2404. QbeGen.IntStr(VAL(
  2405. INTEGER,
  2406. SymTab.ArrayLen(dt)),
  2407. qr)
  2408. END
  2409. END;
  2410. t := SymTab.IntType();
  2411. QbeGen.CopyOp(qr, q)
  2412. END; .)
  2413. | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
  2414. (. IF dt = SymTab.InvalidType THEN
  2415. t := SymTab.InvalidType;
  2416. QbeGen.CopyOp("0", q)
  2417. ELSE
  2418. QbeGen.IntStr(VAL(INTEGER,
  2419. SymTab.ObjectSize(dt)), q);
  2420. t := SymTab.IntType()
  2421. END; .)
  2422. | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
  2423. (. IF dt = SymTab.InvalidType THEN
  2424. t := SymTab.InvalidType;
  2425. QbeGen.CopyOp("0", q)
  2426. ELSE
  2427. IF sfx THEN
  2428. QbeGen.CopyOp(qd, q)
  2429. ELSIF (dk = SymTab.KindVar)
  2430. OR (dk = SymTab.KindParam) THEN
  2431. QbeGen.AddrOf(qn, q)
  2432. ELSE SemError(230);
  2433. QbeGen.CopyOp("0", q)
  2434. END;
  2435. t := SymTab.AddrType()
  2436. END; .)
  2437. | "CHR" "(" Expr<et, q> ")"
  2438. (. IF (et # SymTab.InvalidType)
  2439. AND NOT SymTab.IsIntFamily(et) THEN
  2440. SemError(211) END;
  2441. t := SymTab.CharType(); .)
  2442. | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
  2443. (. IF et # SymTab.InvalidType THEN
  2444. IF (SymTab.ClassOf(et) #
  2445. SymTab.ClChar)
  2446. AND (SymTab.ClassOf(et) #
  2447. SymTab.ClBool)
  2448. AND (SymTab.ClassOf(et) #
  2449. SymTab.ClEnum)
  2450. AND NOT SymTab.IsIntFamily(et) THEN
  2451. SemError(211) END
  2452. END;
  2453. t := SymTab.IntType(); .)
  2454. | "CAP" "(" Expr<et, q> ")"
  2455. (. QbeGen.CapQ(q, qa);
  2456. QbeGen.CopyOp(qa, q);
  2457. t := SymTab.CharType(); .)
  2458. | "UCHR" "(" Expr<et, q> ")"
  2459. (. (* UCHR: the UCHAR constructor.
  2460. CHAR -> UCHAR (identity);
  2461. INTEGER familly -> UCHAR
  2462. (codepoint value). *)
  2463. IF (et # SymTab.InvalidType)
  2464. AND (SymTab.ClassOf(et) # SymTab.ClChar)
  2465. AND NOT SymTab.IsIntFamily(et) THEN
  2466. SemError(211) END;
  2467. t := SymTab.UCharType(); .)
  2468. | "CHR8" "(" Expr<et, q> ")"
  2469. (. IF (et # SymTab.InvalidType)
  2470. AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
  2471. SemError(211) END;
  2472. QbeGen.WidenLong(q, qa);
  2473. QbeGen.CheckRange(qa, "0", "255");
  2474. t := SymTab.CharType(); .)
  2475. | "UORD" "(" Expr<et, q> ")"
  2476. (. (* UORD(u): the codepoint as a
  2477. 32-bit ordinal (INTEGER),
  2478. cf. ORD for CHAR. *)
  2479. IF (et # SymTab.InvalidType)
  2480. AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
  2481. SemError(211) END;
  2482. t := SymTab.IntType(); .)
  2483. | "ABS" "(" Expr<et, q> ")"
  2484. (. IF (et # SymTab.InvalidType)
  2485. AND NOT SymTab.IsIntFamily(et)
  2486. AND (SymTab.ClassOf(et) #
  2487. SymTab.ClReal) THEN
  2488. SemError(211)
  2489. ELSE QbeGen.AbsQ(q, qa,
  2490. SymTab.ClassOf(et) =
  2491. SymTab.ClReal);
  2492. QbeGen.CopyOp(qa, q)
  2493. END;
  2494. t := et; .)
  2495. | "VAL" "(" GetIdent<vn> "," Expr<et, q> ")"
  2496. (. IF NOT SymTab.Lookup(vn) THEN
  2497. SemError(201);
  2498. t := SymTab.InvalidType
  2499. ELSE vt := SymTab.SymType(vn);
  2500. IF vt = SymTab.InvalidType THEN
  2501. t := SymTab.InvalidType
  2502. ELSIF et =
  2503. SymTab.InvalidType THEN
  2504. t := vt
  2505. ELSE
  2506. c1 := SymTab.ClassOf(et);
  2507. c2 := SymTab.ClassOf(vt);
  2508. IF (c1 = SymTab.ClInt)
  2509. AND (c2 = SymTab.ClLong) THEN
  2510. QbeGen.WidenLong(q, qa);
  2511. QbeGen.CopyOp(qa, q);
  2512. t := vt
  2513. ELSIF (c1 = SymTab.ClLong)
  2514. AND (c2 = SymTab.ClInt) THEN
  2515. QbeGen.NarrowLong(q, qa);
  2516. QbeGen.CopyOp(qa, q);
  2517. t := vt
  2518. ELSIF (c1 = SymTab.ClInt)
  2519. AND (c2 = SymTab.ClReal) THEN
  2520. QbeGen.ConvIR(q, qa);
  2521. QbeGen.CopyOp(qa, q);
  2522. t := vt
  2523. ELSIF (c1 = SymTab.ClLong)
  2524. AND (c2 = SymTab.ClReal) THEN
  2525. QbeGen.ConvLR(q, qa);
  2526. QbeGen.CopyOp(qa, q);
  2527. t := vt
  2528. ELSIF (c1 = SymTab.ClReal)
  2529. AND (c2 = SymTab.ClInt) THEN
  2530. QbeGen.ConvRI(q, qa);
  2531. QbeGen.CopyOp(qa, q);
  2532. t := vt
  2533. ELSIF (c1 = SymTab.ClReal)
  2534. AND (c2 = SymTab.ClLong) THEN
  2535. QbeGen.ConvRL(q, qa);
  2536. QbeGen.CopyOp(qa, q);
  2537. t := vt
  2538. ELSIF ((c1 = SymTab.ClInt)
  2539. OR (c1 =
  2540. SymTab.ClChar)
  2541. OR (c1 =
  2542. SymTab.ClBool)
  2543. OR (c1 =
  2544. SymTab.ClEnum))
  2545. AND ((c2 = SymTab.ClInt)
  2546. OR (c2 =
  2547. SymTab.ClChar)
  2548. OR (c2 =
  2549. SymTab.ClBool)
  2550. OR (c2 =
  2551. SymTab.ClEnum)) THEN
  2552. t := vt
  2553. ELSIF (c1 = SymTab.ClPtr)
  2554. AND (c2 = SymTab.ClPtr) THEN
  2555. t := vt
  2556. ELSIF (c1 = SymTab.ClReal)
  2557. AND (c2 = SymTab.ClReal) THEN
  2558. t := vt
  2559. ELSE SemError(230);
  2560. t := SymTab.InvalidType
  2561. END
  2562. END
  2563. END; .)
  2564. | "(" Expr<et, q> ")" (. t := et; .)
  2565. | SetLit<st, sq> (. t := st;
  2566. QbeGen.CopyOp(sq, q); .)
  2567. | ( "NOT" | "~" ) Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
  2568. t := SymTab.BoolType()
  2569. ELSE SemError(212);
  2570. t := SymTab.InvalidType END;
  2571. IF t # SymTab.InvalidType THEN
  2572. QbeGen.NotQ(q2, q)
  2573. ELSE QbeGen.CopyOp("0", q)
  2574. END; .) .
  2575. (* Set literals are SET OF [0..255] (8 words); elements validated
  2576. 0..255 statically when foldable (222 otherwise), runtime trap
  2577. for computed elements. Ranges always lower via SetRange. *)
  2578. SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2579. = "{" (. t := SymTab.NewSet(
  2580. SymTab.NewSubR(0, 255));
  2581. QbeGen.NewSetTemp(8, q);
  2582. QbeGen.SetZero(q, 8); .)
  2583. [ SetElem<t, q> { "," SetElem<t, q> } ]
  2584. "}" .
  2585. (* Typed set constructor: TypeName{ elems } — e.g. BITSET{0},
  2586. BITSET{}. The declared type (not SET OF [0..255]) sets the
  2587. width and element span. *)
  2588. TypedSetLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2589. (. VAR nw: CARDINAL; .)
  2590. = "{" (. IF SymTab.ClassOf(vt) #
  2591. SymTab.ClSet THEN
  2592. SemError(230); nw := 8
  2593. ELSE nw := SymTab.SetWords(vt);
  2594. IF nw = 0 THEN nw := 8 END
  2595. END;
  2596. QbeGen.NewSetTemp(nw, q);
  2597. QbeGen.SetZero(q, nw); .)
  2598. [ SetElem<vt, q> { "," SetElem<vt, q> } ]
  2599. "}" .
  2600. SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal> (. VAR et, et2: SymTab.TypeIndex;
  2601. qe, q2: QbeGen.QVal;
  2602. v, v2: INTEGER;
  2603. lo: INTEGER;
  2604. span: CARDINAL;
  2605. cl, cl2: INTEGER;
  2606. hasR: BOOLEAN; .)
  2607. = (. hasR := FALSE; .)
  2608. Expr<et, qe>
  2609. [ ".." Expr<et2, q2> (. hasR := TRUE; .) ]
  2610. (. lo := SymTab.SetBaseLo(st);
  2611. span := SymTab.SetCount(st);
  2612. IF (et = SymTab.InvalidType)
  2613. OR (hasR AND (et2 =
  2614. SymTab.InvalidType)) THEN
  2615. ELSE cl :=
  2616. SymTab.ClassOf(et);
  2617. IF hasR THEN
  2618. cl2 :=
  2619. SymTab.ClassOf(et2)
  2620. ELSE cl2 := SymTab.ClInt
  2621. END;
  2622. IF ((cl # SymTab.ClInt)
  2623. AND (cl # SymTab.ClChar)
  2624. AND (cl # SymTab.ClBool))
  2625. OR (hasR AND
  2626. ((cl2
  2627. # SymTab.ClInt)
  2628. AND (cl2
  2629. # SymTab.ClChar)
  2630. AND (cl2
  2631. # SymTab.ClBool))) THEN
  2632. SemError(222)
  2633. ELSIF hasR
  2634. AND SymTab.ConstInt(qe, v)
  2635. AND SymTab.ConstInt(q2,
  2636. v2)
  2637. AND ((v < lo)
  2638. OR (v2 < lo)
  2639. OR (v >= lo +
  2640. VAL(INTEGER, span))
  2641. OR (v2 >= lo +
  2642. VAL(INTEGER, span))
  2643. OR (v > v2)) THEN
  2644. SemError(222)
  2645. ELSIF hasR THEN
  2646. QbeGen.SetRange(sq, qe, q2,
  2647. lo, span)
  2648. ELSIF SymTab.ConstInt(qe,
  2649. v)
  2650. AND ((v < lo)
  2651. OR (v >= lo +
  2652. VAL(INTEGER,
  2653. span))) THEN
  2654. SemError(222)
  2655. ELSE QbeGen.SetBit(sq, qe,
  2656. lo, span)
  2657. END
  2658. END; .) .
  2659. GetIdent<VAR n: SymTab.Name>
  2660. = ident (. LexName(n); .) .
  2661. END M2.