M2.atg 132 KB

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