Lower.mod 67 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886
  1. IMPLEMENTATION MODULE Lower;
  2. (* Scalar/boolean/control-flow walk (L0-L2): see Lower.def and
  3. docs/plan-lower.md. No FORWARD declarations: sequence iteration and
  4. statement dispatch are merged into CanStmt / LowerStmt. *)
  5. IMPORT AST, SymTab, QbeGen;
  6. (* ---------------- self-contained symbol tables (zero SymTab surface) ----
  7. Flat arrays only, no ARRAY OF RECORD: a record's array field loses its
  8. length word in static array data, and V3 miscompiles that when the
  9. field is passed as an open array (docs/wip/nested-array-field-bug.mod).
  10. Names live in flat CHAR arrays indexed manually at slot * 64. *)
  11. CONST
  12. MaxSym = 512;
  13. MaxName = 63;
  14. MaxProc = 64;
  15. MaxPar = 32;
  16. VAR
  17. symName : ARRAY [0 .. MaxSym * 64 - 1] OF CHAR;
  18. symKind : ARRAY [0 .. MaxSym - 1] OF INTEGER;
  19. symTy : ARRAY [0 .. MaxSym - 1] OF SymTab.TypeIndex;
  20. nSyms : CARDINAL;
  21. procName : ARRAY [0 .. MaxProc * 64 - 1] OF CHAR;
  22. procUid : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  23. procRes : ARRAY [0 .. MaxProc - 1] OF SymTab.TypeIndex;
  24. procDep : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  25. procExt : ARRAY [0 .. MaxProc - 1] OF BOOLEAN;
  26. procNpar : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  27. parTy : ARRAY [0 .. MaxProc * MaxPar - 1] OF SymTab.TypeIndex;
  28. parVar : ARRAY [0 .. MaxProc * MaxPar - 1] OF BOOLEAN;
  29. parName : ARRAY [0 .. MaxProc * MaxPar * 64 - 1] OF CHAR;
  30. nProcs : CARDINAL;
  31. withRec : ARRAY [0 .. 15] OF SymTab.TypeIndex;
  32. withTop : CARDINAL;
  33. curMethCls : SymTab.TypeIndex; (* class bound by the last obj.Method *)
  34. curImplCls : SymTab.TypeIndex; (* class whose implementation is open *)
  35. curUnitName : SymTab.Name; (* unit being re-emitted (LowerSession) *)
  36. PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
  37. VAR i: CARDINAL;
  38. BEGIN
  39. i := 0;
  40. WHILE (i < MaxName) AND (src[i] # CHR(0)) DO dst[i] := src[i]; INC(i) END;
  41. dst[i] := CHR(0)
  42. END CopyN;
  43. PROCEDURE CopySpan (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR;
  44. srcOff, dstOff: CARDINAL);
  45. VAR i: CARDINAL;
  46. BEGIN
  47. i := 0;
  48. WHILE (i < MaxName) AND (src[srcOff + i] # CHR(0)) DO
  49. dst[dstOff + i] := src[srcOff + i]; INC(i)
  50. END;
  51. dst[dstOff + i] := CHR(0)
  52. END CopySpan;
  53. PROCEDURE Reset;
  54. BEGIN
  55. nSyms := 0; nProcs := 0
  56. END Reset;
  57. PROCEDURE NoteVar (name: ARRAY OF CHAR; kind: INTEGER; t: SymTab.TypeIndex);
  58. BEGIN
  59. IF nSyms >= MaxSym THEN RETURN END;
  60. CopySpan(name, symName, 0, nSyms * 64);
  61. symKind[nSyms] := kind; symTy[nSyms] := t; INC(nSyms)
  62. END NoteVar;
  63. PROCEDURE ScopeEnter;
  64. BEGIN
  65. END ScopeEnter;
  66. PROCEDURE ScopeLeave;
  67. BEGIN
  68. END ScopeLeave;
  69. PROCEDURE NoteProc (name: ARRAY OF CHAR; uid: CARDINAL;
  70. res: SymTab.TypeIndex; depth: CARDINAL; ext: BOOLEAN);
  71. BEGIN
  72. IF nProcs >= MaxProc THEN RETURN END;
  73. CopySpan(name, procName, 0, nProcs * 64);
  74. procUid[nProcs] := uid; procRes[nProcs] := res;
  75. procDep[nProcs] := depth; procExt[nProcs] := ext;
  76. procNpar[nProcs] := 0;
  77. INC(nProcs)
  78. END NoteProc;
  79. PROCEDURE SetProcRes (t: SymTab.TypeIndex);
  80. BEGIN
  81. IF nProcs > 0 THEN procRes[nProcs - 1] := t END
  82. END SetProcRes;
  83. PROCEDURE NoteParam (name: ARRAY OF CHAR; t: SymTab.TypeIndex; isVar: BOOLEAN);
  84. VAR j: CARDINAL;
  85. BEGIN
  86. IF nProcs = 0 THEN RETURN END;
  87. j := procNpar[nProcs - 1];
  88. IF j >= MaxPar THEN RETURN END;
  89. CopySpan(name, parName, 0, (nProcs - 1) * MaxPar * 64 + j * 64);
  90. parTy[(nProcs - 1) * MaxPar + j] := t;
  91. parVar[(nProcs - 1) * MaxPar + j] := isVar;
  92. procNpar[nProcs - 1] := j + 1
  93. END NoteParam;
  94. PROCEDURE FindSym (name: ARRAY OF CHAR; VAR kind: INTEGER;
  95. VAR t: SymTab.TypeIndex): BOOLEAN;
  96. VAR i: CARDINAL; j: CARDINAL; ok: BOOLEAN;
  97. BEGIN
  98. i := nSyms;
  99. WHILE i > 0 DO
  100. DEC(i);
  101. ok := TRUE; j := 0;
  102. WHILE ok AND (j < 64) AND (symName[i * 64 + j] # CHR(0)) DO
  103. IF symName[i * 64 + j] # name[j] THEN ok := FALSE END;
  104. INC(j)
  105. END;
  106. IF ok AND (symName[i * 64 + j] = name[j]) THEN
  107. kind := symKind[i]; t := symTy[i]; RETURN TRUE
  108. END
  109. END;
  110. RETURN FALSE
  111. END FindSym;
  112. PROCEDURE FindProc (name: ARRAY OF CHAR): INTEGER;
  113. VAR i: CARDINAL; j: CARDINAL; ok: BOOLEAN;
  114. BEGIN
  115. i := nProcs;
  116. WHILE i > 0 DO
  117. DEC(i);
  118. ok := TRUE; j := 0;
  119. WHILE ok AND (j < 64) AND (procName[i * 64 + j] # CHR(0)) DO
  120. IF procName[i * 64 + j] # name[j] THEN ok := FALSE END;
  121. INC(j)
  122. END;
  123. IF ok AND (procName[i * 64 + j] = name[j]) THEN RETURN VAL(INTEGER, i) END
  124. END;
  125. RETURN -1
  126. END FindProc;
  127. PROCEDURE Resolve (nm: ARRAY OF CHAR; VAR k: INTEGER;
  128. VAR t: SymTab.TypeIndex): BOOLEAN;
  129. VAR kind: INTEGER; ti: SymTab.TypeIndex;
  130. BEGIN
  131. IF FindSym(nm, kind, ti) THEN k := kind; t := ti; RETURN TRUE END;
  132. IF SymTab.Lookup(nm) THEN k := SymTab.SymKind(nm); t := SymTab.SymType(nm);
  133. RETURN TRUE
  134. END;
  135. RETURN FALSE
  136. END Resolve;
  137. PROCEDURE ProcInfo (nm: ARRAY OF CHAR; VAR uid: CARDINAL;
  138. VAR res: SymTab.TypeIndex; VAR depth: CARDINAL;
  139. VAR ext: BOOLEAN; VAR npar: CARDINAL): BOOLEAN;
  140. VAR i: INTEGER;
  141. BEGIN
  142. i := FindProc(nm);
  143. IF i < 0 THEN RETURN FALSE END;
  144. uid := procUid[i]; res := procRes[i]; depth := procDep[i];
  145. ext := procExt[i]; npar := procNpar[i];
  146. RETURN TRUE
  147. END ProcInfo;
  148. PROCEDURE ParamInfo (nm: ARRAY OF CHAR; i: CARDINAL;
  149. VAR t: SymTab.TypeIndex; VAR isVar: BOOLEAN;
  150. VAR pn: ARRAY OF CHAR): BOOLEAN;
  151. VAR k: INTEGER;
  152. BEGIN
  153. k := FindProc(nm);
  154. IF (k < 0) OR (i >= procNpar[k]) THEN RETURN FALSE END;
  155. t := parTy[VAL(CARDINAL, k) * MaxPar + i];
  156. isVar := parVar[VAL(CARDINAL, k) * MaxPar + i];
  157. CopySpan(parName, pn, VAL(CARDINAL, k) * MaxPar * 64 + i * 64, 0);
  158. RETURN TRUE
  159. END ParamInfo;
  160. PROCEDURE WithField (nm: ARRAY OF CHAR; VAR k: INTEGER;
  161. VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal): BOOLEAN;
  162. (* Resolves a bare ident as a field of an open WITH record (innermost
  163. first), leaving the field address in q and k=KindField. *)
  164. VAR wt: CARDINAL; fo: INTEGER; qb: QbeGen.QVal;
  165. BEGIN
  166. wt := withTop;
  167. WHILE wt > 0 DO
  168. DEC(wt);
  169. IF SymTab.FieldExists(withRec[wt], nm) THEN
  170. t := SymTab.FieldType(withRec[wt], nm);
  171. fo := SymTab.FieldOffset(withRec[wt], nm);
  172. k := SymTab.KindField;
  173. IF QbeGen.TopWith(qb) THEN QbeGen.FieldAddr(qb, fo, q)
  174. ELSE QbeGen.CopyOp("0", q)
  175. END;
  176. RETURN TRUE
  177. END
  178. END;
  179. RETURN FALSE
  180. END WithField;
  181. PROCEDURE Name (n: AST.Node; VAR s: ARRAY OF CHAR);
  182. BEGIN
  183. IF n = AST.NoNode THEN s[0] := CHR(0)
  184. ELSE AST.Txt(AST.Child(n, 0), s)
  185. END
  186. END Name;
  187. PROCEDURE ParamName (proc: ARRAY OF CHAR; i: CARDINAL;
  188. VAR s: ARRAY OF CHAR);
  189. VAR t: SymTab.TypeIndex; isV: BOOLEAN;
  190. BEGIN
  191. IF NOT ParamInfo(proc, i, t, isV, s) THEN s[0] := CHR(0) END
  192. END ParamName;
  193. PROCEDURE IsArith (op: INTEGER): BOOLEAN;
  194. BEGIN
  195. RETURN (op = AST.OpAdd) OR (op = AST.OpSub) OR (op = AST.OpMul)
  196. OR (op = AST.OpDiv) OR (op = AST.OpMod)
  197. END IsArith;
  198. PROCEDURE IsRel (op: INTEGER): BOOLEAN;
  199. BEGIN
  200. RETURN ((op >= AST.OpEq) AND (op <= AST.OpGe)) OR (op = AST.OpIn)
  201. END IsRel;
  202. PROCEDURE RelSym (a: INTEGER; VAR s: INTEGER): BOOLEAN;
  203. BEGIN
  204. IF a = AST.OpEq THEN s := SymTab.OpEq
  205. ELSIF a = AST.OpNe THEN s := SymTab.OpNeq1
  206. ELSIF a = AST.OpLt THEN s := SymTab.OpLt
  207. ELSIF a = AST.OpLe THEN s := SymTab.OpLe
  208. ELSIF a = AST.OpGt THEN s := SymTab.OpGt
  209. ELSIF a = AST.OpGe THEN s := SymTab.OpGe
  210. ELSE RETURN FALSE
  211. END;
  212. RETURN TRUE
  213. END RelSym;
  214. PROCEDURE IsScalarClass (cls: INTEGER): BOOLEAN;
  215. BEGIN
  216. RETURN (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
  217. OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
  218. OR (cls = SymTab.ClEnum)
  219. END IsScalarClass;
  220. PROCEDURE IsSimpleScalar (n: AST.Node): BOOLEAN;
  221. VAR nm: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  222. BEGIN
  223. IF (AST.Kind(n) # AST.NkDesignator) OR (AST.NChild(n) # 1) THEN
  224. RETURN FALSE END;
  225. IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
  226. Name(AST.Child(n, 0), nm);
  227. IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
  228. IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
  229. AND (k # SymTab.KindConst) THEN
  230. RETURN FALSE END;
  231. IF SymTab.Equal(nm, "TRUE") OR SymTab.Equal(nm, "FALSE") THEN
  232. RETURN TRUE END;
  233. RETURN IsScalarClass(SymTab.ClassOf(t))
  234. END IsSimpleScalar;
  235. PROCEDURE CalleeName (call: AST.Node; VAR nm: SymTab.Name);
  236. (* The callee of NkCall: child 0 is a designator (or bare ident). *)
  237. VAR d: AST.Node;
  238. BEGIN
  239. nm[0] := CHR(0);
  240. d := AST.Child(call, 0);
  241. IF d = AST.NoNode THEN RETURN END;
  242. IF AST.Kind(d) = AST.NkDesignator THEN d := AST.Child(d, 0) END;
  243. IF (d # AST.NoNode) AND (AST.Kind(d) = AST.NkIdent) THEN Name(d, nm) END
  244. END CalleeName;
  245. PROCEDURE IsCall (n: AST.Node): BOOLEAN;
  246. VAR nm: SymTab.Name;
  247. BEGIN
  248. IF (AST.Kind(n) # AST.NkCall) OR (AST.NChild(n) < 1) THEN RETURN FALSE END;
  249. CalleeName(n, nm);
  250. RETURN FindProc(nm) >= 0
  251. END IsCall;
  252. PROCEDURE CanCallArgs (n: AST.Node): BOOLEAN;
  253. VAR nm: SymTab.Name; i: CARDINAL;
  254. uid, depth, np: CARDINAL; res: SymTab.TypeIndex; ext: BOOLEAN;
  255. BEGIN
  256. CalleeName(n, nm);
  257. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END;
  258. IF np # (AST.NChild(n) - 1) THEN RETURN FALSE END;
  259. i := 1;
  260. WHILE i < AST.NChild(n) DO
  261. IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
  262. INC(i)
  263. END;
  264. RETURN TRUE
  265. END CanCallArgs;
  266. PROCEDURE CanType (t: SymTab.TypeIndex): BOOLEAN;
  267. VAR cls: INTEGER;
  268. BEGIN
  269. IF t = SymTab.InvalidType THEN RETURN FALSE END;
  270. cls := SymTab.ClassOf(t);
  271. RETURN (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
  272. OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
  273. OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal)
  274. OR (cls = SymTab.ClLong) OR (cls = SymTab.ClArray)
  275. OR (cls = SymTab.ClSet) OR (cls = SymTab.ClRecord)
  276. OR (cls = SymTab.ClPtr) OR (cls = SymTab.ClClass)
  277. END CanType;
  278. PROCEDURE CanWithField (nm: ARRAY OF CHAR; VAR t: SymTab.TypeIndex): BOOLEAN;
  279. VAR wt: CARDINAL;
  280. BEGIN
  281. wt := withTop;
  282. WHILE wt > 0 DO
  283. DEC(wt);
  284. IF SymTab.FieldExists(withRec[wt], nm) THEN
  285. t := SymTab.FieldType(withRec[wt], nm); RETURN TRUE
  286. END
  287. END;
  288. RETURN FALSE
  289. END CanWithField;
  290. PROCEDURE DesignTypeOf (n: AST.Node): SymTab.TypeIndex;
  291. (* Static type of a designator (no emit); used to push WITH scopes. *)
  292. VAR nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  293. i: CARDINAL; sel: AST.Node;
  294. BEGIN
  295. IF (n = AST.NoNode) OR (AST.Kind(n) # AST.NkDesignator) THEN
  296. RETURN SymTab.InvalidType
  297. END;
  298. Name(AST.Child(n, 0), nm);
  299. IF NOT Resolve(nm, k, t) THEN
  300. IF NOT CanWithField(nm, t) THEN RETURN SymTab.InvalidType END
  301. END;
  302. i := 1;
  303. WHILE i < AST.NChild(n) DO
  304. sel := AST.Child(n, i);
  305. IF AST.Op(sel) = AST.SelField THEN
  306. Name(AST.Child(sel, 0), fn); t := SymTab.FieldType(t, fn)
  307. ELSIF AST.Op(sel) = AST.SelIndex THEN
  308. t := SymTab.ArrayElem(t)
  309. ELSIF AST.Op(sel) = AST.SelDeref THEN
  310. t := SymTab.PtrBase(t)
  311. END;
  312. INC(i)
  313. END;
  314. RETURN t
  315. END DesignTypeOf;
  316. PROCEDURE CanDesign (n: AST.Node): BOOLEAN;
  317. VAR nm, fn, mal: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  318. i: CARDINAL; sel: AST.Node;
  319. BEGIN
  320. IF AST.Kind(n) # AST.NkDesignator THEN RETURN FALSE END;
  321. IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
  322. Name(AST.Child(n, 0), nm);
  323. IF NOT Resolve(nm, k, t) THEN
  324. IF CanWithField(nm, t) THEN
  325. k := SymTab.KindField
  326. ELSIF (curImplCls # SymTab.InvalidType)
  327. AND SymTab.MethodExists(curImplCls, nm) THEN
  328. k := SymTab.KindProc
  329. ELSE RETURN FALSE
  330. END
  331. END;
  332. IF k = SymTab.KindModule THEN
  333. (* qualified name: the first .field resolves the export *)
  334. ELSE
  335. IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
  336. AND (k # SymTab.KindConst) AND (k # SymTab.KindField) THEN
  337. RETURN FALSE
  338. END;
  339. IF NOT CanType(t) THEN RETURN FALSE END
  340. END;
  341. i := 1;
  342. WHILE i < AST.NChild(n) DO
  343. sel := AST.Child(n, i);
  344. IF AST.Op(sel) = AST.SelField THEN
  345. Name(AST.Child(sel, 0), fn);
  346. IF k = SymTab.KindModule THEN
  347. IF NOT SymTab.MaterializeAlias(nm, fn, mal) THEN RETURN FALSE END;
  348. t := SymTab.SymType(mal); k := SymTab.SymKind(mal)
  349. ELSIF t = SymTab.InvalidType THEN RETURN FALSE
  350. ELSIF (SymTab.ClassOf(t) = SymTab.ClClass)
  351. AND SymTab.MethodExists(t, fn) THEN
  352. k := SymTab.KindProc; t := SymTab.InvalidType
  353. ELSIF (SymTab.ClassOf(t) # SymTab.ClRecord)
  354. AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
  355. RETURN FALSE
  356. ELSIF NOT SymTab.FieldExists(t, fn) THEN RETURN FALSE
  357. ELSE t := SymTab.FieldType(t, fn)
  358. END
  359. ELSIF AST.Op(sel) = AST.SelIndex THEN
  360. IF (t = SymTab.InvalidType)
  361. OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN RETURN FALSE END;
  362. IF NOT CanExpr(AST.Child(sel, 0)) THEN RETURN FALSE END;
  363. t := SymTab.ArrayElem(t)
  364. ELSIF AST.Op(sel) = AST.SelDeref THEN
  365. IF (t = SymTab.InvalidType)
  366. OR (SymTab.ClassOf(t) # SymTab.ClPtr) THEN RETURN FALSE END;
  367. t := SymTab.PtrBase(t)
  368. ELSE RETURN FALSE
  369. END;
  370. IF (k # SymTab.KindProc) AND NOT CanType(t) THEN RETURN FALSE END;
  371. INC(i)
  372. END;
  373. RETURN TRUE
  374. END CanDesign;
  375. PROCEDURE IsMethodCall (n: AST.Node): BOOLEAN;
  376. (* n is a call whose callee resolves to a class method: `obj.Method`,
  377. `p^.Method`, or a bare sibling name inside an implementation. *)
  378. VAR d, sel: AST.Node; nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  379. i: CARDINAL;
  380. BEGIN
  381. IF (AST.Kind(n) # AST.NkCall) OR (AST.NChild(n) < 1) THEN RETURN FALSE END;
  382. d := AST.Child(n, 0);
  383. IF AST.Kind(d) # AST.NkDesignator THEN RETURN FALSE END;
  384. IF AST.NChild(d) = 1 THEN
  385. (* bare name: a sibling method inside a class implementation? *)
  386. Name(AST.Child(d, 0), nm);
  387. RETURN (curImplCls # SymTab.InvalidType)
  388. AND SymTab.MethodExists(curImplCls, nm)
  389. END;
  390. Name(AST.Child(d, 0), nm);
  391. IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
  392. i := 1;
  393. WHILE i < AST.NChild(d) DO
  394. sel := AST.Child(d, i);
  395. IF AST.Op(sel) = AST.SelField THEN
  396. Name(AST.Child(sel, 0), fn);
  397. IF (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClClass)
  398. AND SymTab.MethodExists(t, fn) THEN
  399. RETURN i = AST.NChild(d) - 1
  400. END;
  401. IF (t = SymTab.InvalidType) OR NOT SymTab.FieldExists(t, fn) THEN
  402. RETURN FALSE
  403. END;
  404. t := SymTab.FieldType(t, fn)
  405. ELSIF AST.Op(sel) = AST.SelIndex THEN
  406. IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN
  407. RETURN FALSE
  408. END;
  409. t := SymTab.ArrayElem(t)
  410. ELSIF AST.Op(sel) = AST.SelDeref THEN
  411. IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClPtr) THEN
  412. RETURN FALSE
  413. END;
  414. t := SymTab.PtrBase(t)
  415. ELSE RETURN FALSE
  416. END;
  417. INC(i)
  418. END;
  419. RETURN FALSE
  420. END IsMethodCall;
  421. PROCEDURE CanMethodCall (n: AST.Node): BOOLEAN;
  422. VAR i: CARDINAL;
  423. BEGIN
  424. IF NOT IsMethodCall(n) THEN RETURN FALSE END;
  425. i := 1;
  426. WHILE i < AST.NChild(n) DO
  427. IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
  428. INC(i)
  429. END;
  430. RETURN TRUE
  431. END CanMethodCall;
  432. PROCEDURE CalleeAlias (call: AST.Node; VAR mal: SymTab.Name): BOOLEAN;
  433. (* Callee is `M.P` (module-qualified): materialize the export alias. *)
  434. VAR d, sel: AST.Node; nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  435. BEGIN
  436. d := AST.Child(call, 0);
  437. IF (AST.Kind(d) # AST.NkDesignator) OR (AST.NChild(d) # 2) THEN
  438. RETURN FALSE
  439. END;
  440. sel := AST.Child(d, 1);
  441. IF AST.Op(sel) # AST.SelField THEN RETURN FALSE END;
  442. Name(AST.Child(d, 0), nm);
  443. IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
  444. IF k # SymTab.KindModule THEN RETURN FALSE END;
  445. Name(AST.Child(sel, 0), fn);
  446. RETURN SymTab.MaterializeAlias(nm, fn, mal)
  447. END CalleeAlias;
  448. PROCEDURE IsQualifiedCall (n: AST.Node): BOOLEAN;
  449. VAR mal: SymTab.Name;
  450. BEGIN
  451. IF AST.Kind(n) # AST.NkCall THEN RETURN FALSE END;
  452. RETURN CalleeAlias(n, mal)
  453. END IsQualifiedCall;
  454. PROCEDURE CanQualifiedCall (n: AST.Node): BOOLEAN;
  455. VAR i: CARDINAL;
  456. BEGIN
  457. i := 1;
  458. WHILE i < AST.NChild(n) DO
  459. IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
  460. INC(i)
  461. END;
  462. RETURN TRUE
  463. END CanQualifiedCall;
  464. PROCEDURE CanBuiltin (n: AST.Node): BOOLEAN;
  465. VAR i: CARDINAL;
  466. BEGIN
  467. i := 1;
  468. WHILE i < AST.NChild(n) DO
  469. IF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE END;
  470. INC(i)
  471. END;
  472. RETURN TRUE
  473. END CanBuiltin;
  474. PROCEDURE CanCaseLabel (lab: AST.Node): BOOLEAN;
  475. BEGIN
  476. IF AST.Kind(lab) = AST.NkSubrange THEN
  477. RETURN CanExpr(AST.Child(lab, 0)) AND CanExpr(AST.Child(lab, 1))
  478. END;
  479. RETURN CanExpr(lab)
  480. END CanCaseLabel;
  481. PROCEDURE CanExpr (n: AST.Node): BOOLEAN;
  482. VAR op: INTEGER; nm: SymTab.Name; i: CARDINAL;
  483. BEGIN
  484. IF n = AST.NoNode THEN RETURN FALSE END;
  485. IF AST.Kind(n) = AST.NkIntLit THEN RETURN TRUE END;
  486. IF AST.Kind(n) = AST.NkCharLit THEN RETURN TRUE END;
  487. IF AST.Kind(n) = AST.NkRealLit THEN RETURN TRUE END;
  488. IF AST.Kind(n) = AST.NkStrLit THEN RETURN TRUE END;
  489. IF AST.Kind(n) = AST.NkSetLit THEN
  490. i := 0;
  491. WHILE i < AST.NChild(n) DO
  492. IF AST.Kind(AST.Child(n, i)) = AST.NkSubrange THEN
  493. IF NOT CanExpr(AST.Child(AST.Child(n, i), 0)) THEN RETURN FALSE END;
  494. IF NOT CanExpr(AST.Child(AST.Child(n, i), 1)) THEN RETURN FALSE END
  495. ELSIF NOT CanExpr(AST.Child(n, i)) THEN RETURN FALSE
  496. END;
  497. INC(i)
  498. END;
  499. RETURN TRUE
  500. END;
  501. IF AST.Kind(n) = AST.NkDesignator THEN RETURN CanDesign(n) END;
  502. IF AST.Kind(n) = AST.NkCall THEN
  503. IF IsMethodCall(n) THEN RETURN CanMethodCall(n) END;
  504. IF IsQualifiedCall(n) THEN RETURN CanQualifiedCall(n) END;
  505. CalleeName(n, nm);
  506. IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
  507. RETURN IsCall(n) AND CanCallArgs(n)
  508. END;
  509. IF AST.Kind(n) = AST.NkUnary THEN
  510. op := AST.Op(n);
  511. IF (op # AST.OpSub) AND (op # AST.OpNot) THEN RETURN FALSE END;
  512. RETURN CanExpr(AST.Child(n, 0))
  513. END;
  514. IF AST.Kind(n) = AST.NkBinExpr THEN
  515. op := AST.Op(n);
  516. IF NOT (IsArith(op) OR IsRel(op)
  517. OR (op = AST.OpAnd) OR (op = AST.OpOr)) THEN
  518. RETURN FALSE END;
  519. RETURN CanExpr(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1))
  520. END;
  521. RETURN FALSE
  522. END CanExpr;
  523. PROCEDURE CanStmt (n: AST.Node): BOOLEAN;
  524. VAR i: CARDINAL; k: INTEGER; by: AST.Node; nm: SymTab.Name;
  525. arm: AST.Node; j: CARDINAL; withSave: CARDINAL; ok: BOOLEAN;
  526. BEGIN
  527. IF n = AST.NoNode THEN RETURN TRUE END;
  528. k := AST.Kind(n);
  529. IF k = AST.NkBlock THEN
  530. i := 0;
  531. WHILE i < AST.NChild(n) DO
  532. IF NOT CanStmt(AST.Child(n, i)) THEN RETURN FALSE END;
  533. INC(i)
  534. END;
  535. RETURN TRUE
  536. END;
  537. IF k = AST.NkAssign THEN
  538. RETURN CanDesign(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1))
  539. END;
  540. IF k = AST.NkIf THEN
  541. RETURN CanExpr(AST.Child(n, 0)) AND CanStmt(AST.Child(n, 1))
  542. AND CanStmt(AST.Child(n, 2))
  543. END;
  544. IF k = AST.NkWhile THEN
  545. RETURN CanExpr(AST.Child(n, 0)) AND CanStmt(AST.Child(n, 1))
  546. END;
  547. IF k = AST.NkRepeat THEN
  548. RETURN CanStmt(AST.Child(n, 0)) AND CanExpr(AST.Child(n, 1))
  549. END;
  550. IF k = AST.NkLoop THEN RETURN CanStmt(AST.Child(n, 0)) END;
  551. IF k = AST.NkExit THEN RETURN TRUE END;
  552. IF k = AST.NkFor THEN
  553. by := AST.Child(n, 3);
  554. IF (by # AST.NoNode) AND (AST.Kind(by) # AST.NkIntLit) THEN
  555. RETURN FALSE END;
  556. RETURN (AST.Kind(AST.Child(n, 0)) = AST.NkIdent)
  557. AND CanExpr(AST.Child(n, 1)) AND CanExpr(AST.Child(n, 2))
  558. AND CanStmt(AST.Child(n, 4))
  559. END;
  560. IF k = AST.NkWith THEN
  561. withSave := withTop;
  562. j := 0;
  563. WHILE j + 1 < AST.NChild(n) DO
  564. IF NOT CanDesign(AST.Child(n, j)) THEN
  565. withTop := withSave; RETURN FALSE
  566. END;
  567. IF withTop <= HIGH(withRec) THEN
  568. withRec[withTop] := DesignTypeOf(AST.Child(n, j)); INC(withTop)
  569. END;
  570. INC(j)
  571. END;
  572. ok := CanStmt(AST.Child(n, AST.NChild(n) - 1));
  573. withTop := withSave;
  574. RETURN ok
  575. END;
  576. IF k = AST.NkCase THEN
  577. IF NOT CanExpr(AST.Child(n, 0)) THEN RETURN FALSE END;
  578. i := 1;
  579. WHILE i < AST.NChild(n) DO
  580. arm := AST.Child(n, i);
  581. IF AST.Op(arm) = 1 THEN
  582. IF NOT CanStmt(AST.Child(arm, 0)) THEN RETURN FALSE END
  583. ELSE
  584. j := 0;
  585. WHILE j + 1 < AST.NChild(arm) DO
  586. IF NOT CanCaseLabel(AST.Child(arm, j)) THEN RETURN FALSE END;
  587. INC(j)
  588. END;
  589. IF NOT CanStmt(AST.Child(arm, AST.NChild(arm) - 1)) THEN
  590. RETURN FALSE
  591. END
  592. END;
  593. INC(i)
  594. END;
  595. RETURN TRUE
  596. END;
  597. IF k = AST.NkHalt THEN
  598. IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
  599. RETURN CanExpr(AST.Child(n, 0))
  600. END;
  601. IF k = AST.NkReturn THEN
  602. IF AST.Child(n, 0) = AST.NoNode THEN RETURN TRUE END;
  603. RETURN CanExpr(AST.Child(n, 0))
  604. END;
  605. IF k = AST.NkCall THEN
  606. IF IsMethodCall(n) THEN RETURN CanMethodCall(n) END;
  607. IF IsQualifiedCall(n) THEN RETURN CanQualifiedCall(n) END;
  608. CalleeName(n, nm);
  609. IF IsBuiltin(nm) THEN RETURN CanBuiltin(n) END;
  610. RETURN IsCall(n) AND CanCallArgs(n)
  611. END;
  612. RETURN FALSE
  613. END CanStmt;
  614. PROCEDURE CanMethod (m: AST.Node; ct: SymTab.TypeIndex): BOOLEAN;
  615. VAR nm: SymTab.Name; uid, depth, np: CARDINAL; res, t: SymTab.TypeIndex;
  616. ext, isV: BOOLEAN; pn: SymTab.Name; i: CARDINAL; ok: BOOLEAN;
  617. save: CARDINAL; saveCls: SymTab.TypeIndex;
  618. BEGIN
  619. IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN FALSE END;
  620. Name(AST.Child(m, 0), nm);
  621. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END;
  622. IF (res # SymTab.InvalidType) AND NOT CanType(res) THEN RETURN FALSE END;
  623. i := 0;
  624. WHILE i < np DO
  625. IF NOT ParamInfo(nm, i, t, isV, pn) THEN RETURN FALSE END;
  626. IF NOT CanType(t) THEN RETURN FALSE END;
  627. INC(i)
  628. END;
  629. save := withTop;
  630. saveCls := curImplCls;
  631. curImplCls := ct;
  632. IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END;
  633. ok := CanDecls(AST.Child(m, 2)) AND CanStmt(AST.Child(m, 1));
  634. withTop := save;
  635. curImplCls := saveCls;
  636. RETURN ok
  637. END CanMethod;
  638. PROCEDURE CanMethods (seq: AST.Node; ct: SymTab.TypeIndex): BOOLEAN;
  639. VAR i: CARDINAL; m: AST.Node;
  640. BEGIN
  641. IF seq = AST.NoNode THEN RETURN TRUE END;
  642. i := 0;
  643. WHILE i < AST.NChild(seq) DO
  644. m := AST.Child(seq, i);
  645. IF i = AST.MaxChild - 1 THEN
  646. IF NOT CanMethods(m, ct) THEN RETURN FALSE END
  647. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN
  648. IF NOT CanMethods(m, ct) THEN RETURN FALSE END
  649. ELSIF AST.Kind(m) = AST.NkProcDecl THEN
  650. IF NOT CanMethod(m, ct) THEN RETURN FALSE END
  651. END;
  652. INC(i)
  653. END;
  654. RETURN TRUE
  655. END CanMethods;
  656. PROCEDURE CanDecl (c: AST.Node): BOOLEAN;
  657. VAR i: CARDINAL; nm: SymTab.Name; k: INTEGER; ct: SymTab.TypeIndex;
  658. BEGIN
  659. IF AST.Kind(c) = AST.NkClassDecl THEN
  660. IF AST.Op(c) = 1 THEN
  661. Name(AST.Child(c, 0), nm);
  662. IF NOT Resolve(nm, k, ct) THEN RETURN FALSE END;
  663. IF SymTab.ClassOf(ct) # SymTab.ClClass THEN RETURN FALSE END;
  664. IF NOT CanMethods(AST.Child(c, 3), ct) THEN RETURN FALSE END;
  665. IF AST.Child(c, 2) # AST.NoNode THEN
  666. IF NOT CanStmt(AST.Child(c, 2)) THEN RETURN FALSE END
  667. END;
  668. RETURN TRUE
  669. END;
  670. RETURN TRUE
  671. END;
  672. IF AST.Kind(c) = AST.NkUnit THEN
  673. IF AST.Child(c, 3) # AST.NoNode THEN RETURN FALSE END;
  674. RETURN CanDecls(AST.Child(c, 1)) AND CanStmt(AST.Child(c, 2))
  675. END;
  676. IF AST.Kind(c) = AST.NkTypeDecl THEN RETURN TRUE END;
  677. IF AST.Kind(c) = AST.NkVarDecl THEN
  678. IF NOT CanType(AST.Ty(c)) THEN RETURN FALSE END;
  679. IF AST.NChild(c) < 1 THEN RETURN FALSE END;
  680. i := 0;
  681. WHILE i < AST.NChild(c) DO
  682. IF AST.Kind(AST.Child(c, i)) # AST.NkIdent THEN RETURN FALSE END;
  683. INC(i)
  684. END;
  685. RETURN TRUE
  686. END;
  687. IF AST.Kind(c) = AST.NkConstDecl THEN
  688. RETURN IsScalarClass(SymTab.ClassOf(AST.Ty(c)))
  689. AND (AST.Kind(AST.Child(c, 1)) = AST.NkIntLit)
  690. END;
  691. IF AST.Kind(c) = AST.NkProcDecl THEN RETURN CanProc(c) END;
  692. RETURN FALSE
  693. END CanDecl;
  694. PROCEDURE CanDecls (seq: AST.Node): BOOLEAN;
  695. VAR i: CARDINAL; c: AST.Node;
  696. BEGIN
  697. IF seq = AST.NoNode THEN RETURN TRUE END;
  698. i := 0;
  699. WHILE i < AST.NChild(seq) DO
  700. c := AST.Child(seq, i);
  701. IF i = AST.MaxChild - 1 THEN
  702. IF NOT CanDecls(c) THEN RETURN FALSE END
  703. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN
  704. IF NOT CanDecls(c) THEN RETURN FALSE END
  705. ELSIF NOT CanDecl(c) THEN RETURN FALSE
  706. END;
  707. INC(i)
  708. END;
  709. RETURN TRUE
  710. END CanDecls;
  711. PROCEDURE CanLower (unit: AST.Node): BOOLEAN;
  712. BEGIN
  713. withTop := 0;
  714. curImplCls := SymTab.InvalidType;
  715. IF AST.Kind(unit) # AST.NkUnit THEN RETURN FALSE END;
  716. IF AST.Kind(AST.Child(unit, 0)) # AST.NkIdent THEN RETURN FALSE END;
  717. RETURN CanDecls(AST.Child(unit, 1)) AND CanStmt(AST.Child(unit, 2))
  718. END CanLower;
  719. PROCEDURE CanProc (proc: AST.Node): BOOLEAN;
  720. VAR nm: SymTab.Name; i: CARDINAL;
  721. uid, depth, np: CARDINAL; res: SymTab.TypeIndex; ext: BOOLEAN;
  722. t: SymTab.TypeIndex; isV: BOOLEAN; pn: SymTab.Name;
  723. BEGIN
  724. IF AST.Op(proc) # 0 THEN RETURN FALSE END;
  725. Name(AST.Child(proc, 0), nm);
  726. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN FALSE END;
  727. IF (res # SymTab.InvalidType) AND NOT IsScalarClass(SymTab.ClassOf(res)) THEN
  728. RETURN FALSE END;
  729. i := 0;
  730. WHILE i < np DO
  731. IF NOT ParamInfo(nm, i, t, isV, pn) THEN RETURN FALSE END;
  732. IF NOT CanType(t) THEN RETURN FALSE END;
  733. INC(i)
  734. END;
  735. RETURN CanDecls(AST.Child(proc, 2)) AND CanStmt(AST.Child(proc, 1))
  736. END CanProc;
  737. PROCEDURE FinalLoad (t: SymTab.TypeIndex; sfx: BOOLEAN; VAR q: QbeGen.QVal);
  738. (* Fact's final load after a designator/result suffix: scalars/pointers
  739. are loaded from their address; aggregates keep the address. *)
  740. VAR cls: INTEGER; q2: QbeGen.QVal;
  741. BEGIN
  742. IF NOT sfx THEN RETURN END;
  743. IF t = SymTab.InvalidType THEN QbeGen.CopyOp("0", q); RETURN END;
  744. cls := SymTab.ClassOf(t);
  745. IF (cls # SymTab.ClRecord) AND (cls # SymTab.ClSet)
  746. AND (cls # SymTab.ClArray) AND (cls # SymTab.ClClass) THEN
  747. QbeGen.ElemLoad(q, t, q2); QbeGen.CopyOp(q2, q)
  748. END
  749. END FinalLoad;
  750. PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  751. VAR q: QbeGen.QVal; VAR qn: SymTab.Name;
  752. VAR sfx: BOOLEAN);
  753. (* Base ident then selectors (mirrors the grammar's Design). Leaves the
  754. address in q with sfx=TRUE for selectors; base vars/consts load. *)
  755. VAR nm, fn, mal: SymTab.Name; cv: QbeGen.QVal; cls, op: INTEGER;
  756. i: CARDINAL; sel: AST.Node; eT, it: SymTab.TypeIndex;
  757. iq, ql, qlo, qhi, qe: QbeGen.QVal;
  758. lo, hi, fo: INTEGER; isOpen: BOOLEAN;
  759. BEGIN
  760. Name(AST.Child(n, 0), nm);
  761. QbeGen.CopyOp(nm, qn);
  762. sfx := FALSE;
  763. IF NOT Resolve(nm, k, t) THEN
  764. IF WithField(nm, k, t, q) THEN
  765. sfx := TRUE
  766. ELSIF (curImplCls # SymTab.InvalidType)
  767. AND SymTab.MethodExists(curImplCls, nm) THEN
  768. (* bare sibling method name inside a class implementation *)
  769. QbeGen.ThisBase(q);
  770. QbeGen.ArmRecv(q);
  771. curMethCls := curImplCls; k := SymTab.KindProc;
  772. t := SymTab.InvalidType; sfx := FALSE
  773. ELSE
  774. t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
  775. END
  776. END;
  777. IF k = SymTab.KindConst THEN
  778. IF SymTab.Equal(nm, "TRUE") THEN
  779. t := SymTab.BoolType(); QbeGen.CopyOp("1", q)
  780. ELSIF SymTab.Equal(nm, "FALSE") THEN
  781. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  782. ELSIF SymTab.Equal(nm, "NIL") THEN
  783. QbeGen.CopyOp("0", q)
  784. ELSIF SymTab.GetSymVal(nm, cv) AND QbeGen.IsImm(cv) THEN
  785. QbeGen.CopyOp(cv, q)
  786. ELSE QbeGen.CopyOp("0", q)
  787. END
  788. ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
  789. cls := SymTab.ClassOf(t);
  790. IF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
  791. OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
  792. OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal) THEN
  793. QbeGen.LoadVar(nm, cls = SymTab.ClReal, q)
  794. ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
  795. QbeGen.LoadPtr(nm, q)
  796. ELSIF cls = SymTab.ClLong THEN
  797. QbeGen.LoadLong(nm, q)
  798. ELSE QbeGen.AddrOf(nm, q)
  799. END
  800. ELSIF k = SymTab.KindField THEN
  801. (* q already holds the field address (WithField) *)
  802. ELSE QbeGen.CopyOp("0", q)
  803. END;
  804. i := 1;
  805. WHILE i < AST.NChild(n) DO
  806. sel := AST.Child(n, i);
  807. op := AST.Op(sel);
  808. IF op = AST.SelField THEN
  809. Name(AST.Child(sel, 0), fn);
  810. IF k = SymTab.KindModule THEN
  811. (* qualified L.x: materialize the export, then load it *)
  812. IF SymTab.MaterializeAlias(nm, fn, mal) THEN
  813. QbeGen.CopyOp(mal, qn);
  814. t := SymTab.SymType(mal); k := SymTab.SymKind(mal); sfx := FALSE;
  815. IF k = SymTab.KindProc THEN QbeGen.CopyOp("0", q)
  816. ELSIF NOT QbeGen.LoadDesignator(mal, t, k, q) THEN
  817. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  818. END
  819. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  820. END
  821. ELSIF t = SymTab.InvalidType THEN
  822. ELSIF (SymTab.ClassOf(t) = SymTab.ClClass)
  823. AND SymTab.MethodExists(t, fn) THEN
  824. (* obj.Method: bind the receiver; the call supplies the value *)
  825. QbeGen.ArmRecv(q);
  826. QbeGen.CopyOp(fn, qn);
  827. curMethCls := t; k := SymTab.KindProc; t := SymTab.InvalidType
  828. ELSIF NOT SymTab.FieldExists(t, fn) THEN t := SymTab.InvalidType
  829. ELSE
  830. fo := SymTab.FieldOffset(t, fn);
  831. t := SymTab.FieldType(t, fn);
  832. QbeGen.FieldAddr(q, fo, qe);
  833. QbeGen.CopyOp(qe, q);
  834. sfx := TRUE
  835. END
  836. ELSIF op = AST.SelIndex THEN
  837. LowerExpr(AST.Child(sel, 0), it, iq);
  838. IF t = SymTab.InvalidType THEN
  839. ELSE
  840. QbeGen.WidenIndex(iq, ql);
  841. isOpen := SymTab.IsOpenArray(t);
  842. IF isOpen THEN
  843. QbeGen.CopyOp("0", qlo);
  844. IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN
  845. QbeGen.OpenHiChar(q, qhi)
  846. ELSE QbeGen.OpenHi(q, qhi)
  847. END
  848. ELSE
  849. lo := SymTab.ArrayLo(t); hi := SymTab.ArrayHi(t);
  850. IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN
  851. hi := hi + 1
  852. END;
  853. QbeGen.IntStr(lo, qlo); QbeGen.IntStr(hi, qhi)
  854. END;
  855. QbeGen.CheckRange(ql, qlo, qhi);
  856. eT := SymTab.ArrayElem(t);
  857. QbeGen.ElemAddr(q, ql, qlo, t, qe);
  858. IF SymTab.ClassOf(eT) = SymTab.ClArray THEN
  859. QbeGen.ElemLoad(qe, eT, q)
  860. ELSE QbeGen.CopyOp(qe, q)
  861. END;
  862. t := eT; sfx := TRUE
  863. END
  864. ELSIF op = AST.SelDeref THEN
  865. IF t = SymTab.InvalidType THEN
  866. ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN t := SymTab.InvalidType
  867. ELSE
  868. IF sfx THEN QbeGen.ElemLoad(q, t, qe); QbeGen.CopyOp(qe, q) END;
  869. t := SymTab.PtrBase(t); sfx := TRUE
  870. END
  871. END;
  872. INC(i)
  873. END
  874. END LowerDesign;
  875. PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
  876. VAR q: QbeGen.QVal; want: BOOLEAN);
  877. VAR nm, pn: SymTab.Name; i: CARDINAL; at, ft, res: SymTab.TypeIndex;
  878. qa, qt, qe, mg: QbeGen.QVal; conv, isV, qual: BOOLEAN;
  879. uid, depth, np: CARDINAL; ext: BOOLEAN;
  880. BEGIN
  881. qual := CalleeAlias(n, nm);
  882. IF qual THEN
  883. uid := SymTab.ProcUid(nm); res := SymTab.ProcRes(nm);
  884. depth := SymTab.ProcDepthOf(nm); ext := SymTab.IsExternal(nm);
  885. np := SymTab.ProcNPar(nm)
  886. ELSE
  887. CalleeName(n, nm);
  888. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN END
  889. END;
  890. QbeGen.Mangled(nm, uid, mg);
  891. QbeGen.CallBegin(mg, res, depth, ext);
  892. i := 1;
  893. WHILE i < AST.NChild(n) DO
  894. LowerExpr(AST.Child(n, i), at, qe);
  895. IF qual THEN
  896. ft := SymTab.ParamType(nm, i - 1);
  897. isV := SymTab.ParamIsVar(nm, i - 1)
  898. ELSE
  899. IF NOT ParamInfo(nm, i - 1, ft, isV, pn) THEN END
  900. END;
  901. IF isV THEN
  902. IF QbeGen.AddrOfVal(qe, qa) THEN
  903. IF NOT QbeGen.CallArg(qa, "l") THEN END
  904. END
  905. ELSE
  906. conv := (SymTab.ClassOf(ft) = SymTab.ClReal)
  907. AND SymTab.IsIntFamily(at);
  908. IF conv THEN
  909. QbeGen.ConvIR(qe, qt);
  910. IF NOT QbeGen.CallArg(qt, "d") THEN END
  911. ELSE
  912. IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
  913. END
  914. END;
  915. INC(i)
  916. END;
  917. IF want THEN
  918. t := res; QbeGen.CallEnd(TRUE, q)
  919. ELSE
  920. t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
  921. END
  922. END LowerCall;
  923. PROCEDURE IsBuiltin (nm: ARRAY OF CHAR): BOOLEAN;
  924. BEGIN
  925. RETURN SymTab.Equal(nm, "ABS") OR SymTab.Equal(nm, "CAP")
  926. OR SymTab.Equal(nm, "CHR") OR SymTab.Equal(nm, "ORD")
  927. OR SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE")
  928. OR SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX")
  929. OR SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE")
  930. OR SymTab.Equal(nm, "ADR")
  931. OR SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC")
  932. OR SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL")
  933. OR SymTab.Equal(nm, "NEW") OR SymTab.Equal(nm, "DISPOSE")
  934. END IsBuiltin;
  935. PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
  936. VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  937. (* Value builtins (Fact). *)
  938. VAR et, et2, dt: SymTab.TypeIndex; qa, qt, q2, qd: QbeGen.QVal;
  939. k, lo, hi: INTEGER; qn: SymTab.Name; sfx: BOOLEAN; isMax: BOOLEAN;
  940. BEGIN
  941. IF SymTab.Equal(nm, "ABS") THEN
  942. LowerExpr(AST.Child(n, 1), et, q);
  943. QbeGen.AbsQ(q, qa, SymTab.ClassOf(et) = SymTab.ClReal);
  944. QbeGen.CopyOp(qa, q); t := et
  945. ELSIF SymTab.Equal(nm, "CAP") THEN
  946. LowerExpr(AST.Child(n, 1), et, q);
  947. QbeGen.CapQ(q, qa); QbeGen.CopyOp(qa, q); t := SymTab.CharType()
  948. ELSIF SymTab.Equal(nm, "CHR") THEN
  949. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.CharType()
  950. ELSIF SymTab.Equal(nm, "ORD") THEN
  951. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType()
  952. ELSIF SymTab.Equal(nm, "SIZE") THEN
  953. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  954. QbeGen.IntStr(VAL(INTEGER, SymTab.ObjectSize(dt)), q);
  955. t := SymTab.IntType()
  956. ELSIF SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") THEN
  957. isMax := SymTab.Equal(nm, "MAX");
  958. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  959. IF SymTab.ClassOf(dt) = SymTab.ClReal THEN
  960. IF isMax THEN QbeGen.NormReal("3.402823e38", q)
  961. ELSE QbeGen.NormReal("-3.402823e38", q) END;
  962. t := SymTab.RealType()
  963. ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN
  964. IF isMax THEN QbeGen.CopyOp("9223372036854775807", q)
  965. ELSE QbeGen.CopyOp("-9223372036854775808", q) END;
  966. t := SymTab.LongType()
  967. ELSIF SymTab.TypeBounds(dt, lo, hi) THEN
  968. IF isMax THEN QbeGen.IntStr(hi, q) ELSE QbeGen.IntStr(lo, q) END;
  969. t := SymTab.IntType()
  970. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  971. END
  972. ELSIF SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") THEN
  973. LowerExpr(AST.Child(n, 1), et, q);
  974. LowerExpr(AST.Child(n, 2), et2, q2);
  975. QbeGen.SetShift(q, q2, SymTab.SetWords(et), SymTab.SetCount(et),
  976. SymTab.Equal(nm, "ROTATE"), qt);
  977. t := et; QbeGen.CopyOp(qt, q)
  978. ELSIF SymTab.Equal(nm, "ADR") THEN
  979. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  980. IF sfx THEN QbeGen.CopyOp(qd, q)
  981. ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
  982. QbeGen.AddrOf(qn, q)
  983. ELSE QbeGen.CopyOp("0", q)
  984. END;
  985. t := SymTab.AddrType()
  986. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  987. END
  988. END LowerBuiltinExpr;
  989. PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name);
  990. (* Statement builtins (AssOrCall): INC/DEC, INCL/EXCL, NEW/DISPOSE. *)
  991. VAR dt, at, et2, bt: SymTab.TypeIndex; dk: INTEGER;
  992. qd, qv, qe, qn2, qstep, qm: QbeGen.QVal;
  993. qn: SymTab.Name; sfx, isInc: BOOLEAN;
  994. BEGIN
  995. IF SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") THEN
  996. isInc := SymTab.Equal(nm, "INC");
  997. QbeGen.CopyOp("1", qstep);
  998. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  999. IF AST.NChild(n) > 2 THEN LowerExpr(AST.Child(n, 2), et2, qstep) END;
  1000. IF dt = SymTab.InvalidType THEN
  1001. ELSE
  1002. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
  1003. ELSE QbeGen.LoadVar(qn, FALSE, qv)
  1004. END;
  1005. QbeGen.NewTemp(qn2);
  1006. IF isInc THEN QbeGen.Op3("add", qn2, qv, qstep, FALSE)
  1007. ELSE QbeGen.Op3("sub", qn2, qv, qstep, FALSE)
  1008. END;
  1009. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qn2, dt)
  1010. ELSE QbeGen.StoreVar(qn, qn2, FALSE)
  1011. END
  1012. END
  1013. ELSIF SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") THEN
  1014. isInc := SymTab.Equal(nm, "INCL");
  1015. LowerDesign(AST.Child(n, 1), at, dk, qd, qn, sfx);
  1016. LowerExpr(AST.Child(n, 2), et2, qe);
  1017. IF at = SymTab.InvalidType THEN
  1018. ELSIF SymTab.ClassOf(at) # SymTab.ClSet THEN
  1019. ELSE
  1020. IF isInc THEN QbeGen.SetBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
  1021. ELSE QbeGen.SetClearBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
  1022. END
  1023. END
  1024. ELSIF SymTab.Equal(nm, "NEW") THEN
  1025. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1026. IF dt = SymTab.InvalidType THEN
  1027. ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
  1028. ELSE
  1029. bt := SymTab.PtrBase(dt);
  1030. IF bt # SymTab.InvalidType THEN
  1031. QbeGen.NewHeap(bt, qm); QbeGen.InitHeap(qm, bt);
  1032. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qm, dt)
  1033. ELSE QbeGen.StorePtr(qn, qm)
  1034. END
  1035. END
  1036. END
  1037. ELSIF SymTab.Equal(nm, "DISPOSE") THEN
  1038. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1039. IF dt = SymTab.InvalidType THEN
  1040. ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
  1041. ELSE
  1042. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
  1043. ELSE QbeGen.LoadPtr(qn, qv)
  1044. END;
  1045. QbeGen.FreeHeap(qv);
  1046. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, "0", dt)
  1047. ELSE QbeGen.StorePtr(qn, "0")
  1048. END
  1049. END
  1050. END
  1051. END LowerBuiltinStmt;
  1052. PROCEDURE LowerMethod (m: AST.Node; ct: SymTab.TypeIndex);
  1053. (* A class method: hidden THIS receiver, then declared formals; the body
  1054. runs with THIS pushed as the WITH base (bare field names resolve). *)
  1055. VAR nm, txt: SymTab.Name; mg, thisQ: QbeGen.QVal;
  1056. uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1057. pv, ext: BOOLEAN; j: CARDINAL; saveCls: SymTab.TypeIndex;
  1058. BEGIN
  1059. IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN END;
  1060. Name(AST.Child(m, 0), nm);
  1061. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN END;
  1062. QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
  1063. QbeGen.BeginFunc(mg);
  1064. IF NOT QbeGen.FuncParam("THIS", TRUE, ct) THEN END;
  1065. j := 0;
  1066. WHILE j < np DO
  1067. IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
  1068. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
  1069. INC(j)
  1070. END;
  1071. QbeGen.SetFuncRes(res);
  1072. QbeGen.EndFuncHeader;
  1073. QbeGen.ThisBase(thisQ);
  1074. saveCls := curImplCls;
  1075. curImplCls := ct;
  1076. QbeGen.PushWith(thisQ);
  1077. IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END;
  1078. LowerDecls(AST.Child(m, 2));
  1079. LowerStmt(AST.Child(m, 1));
  1080. IF withTop > 0 THEN DEC(withTop) END;
  1081. curImplCls := saveCls;
  1082. QbeGen.PopWith;
  1083. QbeGen.EndFunc(res)
  1084. END LowerMethod;
  1085. PROCEDURE LowerMethods (seq: AST.Node; ct: SymTab.TypeIndex);
  1086. VAR i: CARDINAL; m: AST.Node;
  1087. BEGIN
  1088. IF seq = AST.NoNode THEN RETURN END;
  1089. i := 0;
  1090. WHILE i < AST.NChild(seq) DO
  1091. m := AST.Child(seq, i);
  1092. IF i = AST.MaxChild - 1 THEN LowerMethods(m, ct)
  1093. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethods(m, ct)
  1094. ELSIF AST.Kind(m) = AST.NkProcDecl THEN LowerMethod(m, ct)
  1095. END;
  1096. INC(i)
  1097. END
  1098. END LowerMethods;
  1099. PROCEDURE LowerMethodHeadings (seq: AST.Node; ct: SymTab.TypeIndex);
  1100. (* Class-declaration method headings: emit+discard a function header per
  1101. method so the backend temp counters advance exactly as the legacy
  1102. parse did (the implementation's temps then line up). *)
  1103. VAR i, j: CARDINAL; m: AST.Node; nm, txt: SymTab.Name;
  1104. mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1105. pv, ext: BOOLEAN;
  1106. BEGIN
  1107. IF seq = AST.NoNode THEN RETURN END;
  1108. i := 0;
  1109. WHILE i < AST.NChild(seq) DO
  1110. m := AST.Child(seq, i);
  1111. IF i = AST.MaxChild - 1 THEN LowerMethodHeadings(m, ct)
  1112. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethodHeadings(m, ct)
  1113. ELSIF AST.Kind(m) = AST.NkProcDecl THEN
  1114. Name(AST.Child(m, 0), nm);
  1115. IF ProcInfo(nm, uid, res, depth, ext, np) THEN
  1116. QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
  1117. QbeGen.BeginFunc(mg);
  1118. j := 0;
  1119. WHILE j < np DO
  1120. IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
  1121. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
  1122. INC(j)
  1123. END;
  1124. QbeGen.SetFuncRes(res);
  1125. QbeGen.AbortFunc
  1126. END
  1127. END;
  1128. INC(i)
  1129. END
  1130. END LowerMethodHeadings;
  1131. PROCEDURE LowerMethodCall (n: AST.Node; VAR t: SymTab.TypeIndex;
  1132. VAR q: QbeGen.QVal; want: BOOLEAN);
  1133. VAR d: AST.Node; ct, res, ft, at: SymTab.TypeIndex;
  1134. cq, mg, qa, qt, qe: QbeGen.QVal; fn, pn: SymTab.Name;
  1135. k, vs: INTEGER; i: CARDINAL; sfx, isV, conv: BOOLEAN;
  1136. BEGIN
  1137. d := AST.Child(n, 0);
  1138. curMethCls := SymTab.InvalidType;
  1139. LowerDesign(d, ct, k, cq, pn, sfx);
  1140. ct := curMethCls;
  1141. IF ct = SymTab.InvalidType THEN
  1142. t := SymTab.InvalidType; QbeGen.CopyOp("0", q); RETURN
  1143. END;
  1144. IF AST.NChild(d) = 1 THEN
  1145. Name(AST.Child(d, 0), fn)
  1146. ELSE
  1147. Name(AST.Child(AST.Child(d, AST.NChild(d) - 1), 0), fn)
  1148. END;
  1149. res := SymTab.ClassMethodRes(ct, fn);
  1150. vs := SymTab.VirtSlot(ct, fn);
  1151. IF vs >= 0 THEN QbeGen.VirtCallBegin(cq, vs, res)
  1152. ELSE
  1153. QbeGen.Mangled(fn, SymTab.ClassMethodUid(ct, fn), mg);
  1154. QbeGen.CallBegin(mg, res, 0, FALSE)
  1155. END;
  1156. i := 1;
  1157. WHILE i < AST.NChild(n) DO
  1158. LowerExpr(AST.Child(n, i), at, qe);
  1159. ft := SymTab.ClassMethodParamType(ct, fn, i - 1);
  1160. isV := SymTab.ClassMethodParamIsVar(ct, fn, i - 1);
  1161. IF isV THEN
  1162. IF QbeGen.AddrOfVal(qe, qa) THEN
  1163. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1164. END
  1165. ELSE
  1166. conv := (SymTab.ClassOf(ft) = SymTab.ClReal) AND SymTab.IsIntFamily(at);
  1167. IF conv THEN
  1168. QbeGen.ConvIR(qe, qt);
  1169. IF NOT QbeGen.CallArg(qt, "d") THEN END
  1170. ELSE
  1171. IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
  1172. END
  1173. END;
  1174. INC(i)
  1175. END;
  1176. IF want THEN t := res; QbeGen.CallEnd(TRUE, q)
  1177. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
  1178. END
  1179. END LowerMethodCall;
  1180. PROCEDURE LowerCase (n: AST.Node);
  1181. (* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). *)
  1182. VAR i, j: CARDINAL; arm, lab: AST.Node; tsel, t2, t3: SymTab.TypeIndex;
  1183. qsel, q2, q3, qc, qd, qe, lEnd, lBody, lAfter, lNext: QbeGen.QVal;
  1184. BEGIN
  1185. LowerExpr(AST.Child(n, 0), tsel, qsel);
  1186. QbeGen.NewLabel(lEnd);
  1187. i := 1;
  1188. WHILE i < AST.NChild(n) DO
  1189. arm := AST.Child(n, i);
  1190. IF AST.Op(arm) = 1 THEN
  1191. (* ELSE arm: emitted after the alternatives *)
  1192. ELSE
  1193. QbeGen.NewLabel(lBody); QbeGen.NewLabel(lAfter);
  1194. j := 0;
  1195. WHILE j + 1 < AST.NChild(arm) DO
  1196. lab := AST.Child(arm, j);
  1197. IF AST.Kind(lab) = AST.NkSubrange THEN
  1198. LowerExpr(AST.Child(lab, 0), t2, q2);
  1199. QbeGen.NewLabel(lNext);
  1200. QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
  1201. QbeGen.Jnz(qc, lBody, lNext);
  1202. QbeGen.EmitLabel(lNext);
  1203. LowerExpr(AST.Child(lab, 1), t3, q3);
  1204. QbeGen.Cmp(SymTab.OpGe, qsel, q2, qc, FALSE);
  1205. QbeGen.Cmp(SymTab.OpLe, qsel, q3, qd, FALSE);
  1206. QbeGen.NewTemp(qe);
  1207. QbeGen.Op3("and", qe, qc, qd, FALSE);
  1208. QbeGen.NewLabel(lNext);
  1209. QbeGen.Jnz(qe, lBody, lNext);
  1210. QbeGen.EmitLabel(lNext)
  1211. ELSE
  1212. LowerExpr(lab, t2, q2);
  1213. QbeGen.NewLabel(lNext);
  1214. QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
  1215. QbeGen.Jnz(qc, lBody, lNext);
  1216. QbeGen.EmitLabel(lNext)
  1217. END;
  1218. INC(j)
  1219. END;
  1220. QbeGen.Jmp(lAfter);
  1221. QbeGen.EmitLabel(lBody);
  1222. LowerStmt(AST.Child(arm, AST.NChild(arm) - 1));
  1223. QbeGen.Jmp(lEnd);
  1224. QbeGen.EmitLabel(lAfter)
  1225. END;
  1226. INC(i)
  1227. END;
  1228. i := 1;
  1229. WHILE i < AST.NChild(n) DO
  1230. arm := AST.Child(n, i);
  1231. IF AST.Op(arm) = 1 THEN LowerStmt(AST.Child(arm, 0)) END;
  1232. INC(i)
  1233. END;
  1234. QbeGen.EmitLabel(lEnd)
  1235. END LowerCase;
  1236. PROCEDURE LowerWith (n: AST.Node);
  1237. (* WITH: push each record's base address, lower the body, pop. *)
  1238. VAR i: CARDINAL; dt: SymTab.TypeIndex; dk: INTEGER; qd: QbeGen.QVal;
  1239. qn: SymTab.Name; sfx: BOOLEAN;
  1240. BEGIN
  1241. i := 0;
  1242. WHILE i + 1 < AST.NChild(n) DO
  1243. LowerDesign(AST.Child(n, i), dt, dk, qd, qn, sfx);
  1244. QbeGen.PushWith(qd);
  1245. IF withTop <= HIGH(withRec) THEN
  1246. withRec[withTop] := dt; INC(withTop)
  1247. END;
  1248. INC(i)
  1249. END;
  1250. LowerStmt(AST.Child(n, AST.NChild(n) - 1));
  1251. WHILE withTop > 0 DO DEC(withTop); QbeGen.PopWith END
  1252. END LowerWith;
  1253. PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
  1254. VAR q: QbeGen.QVal; VAR k: INTEGER;
  1255. VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
  1256. asAddr: BOOLEAN);
  1257. VAR t2: SymTab.TypeIndex; q2, qt, qf, qs, qr: QbeGen.QVal;
  1258. lNext, lFalse, lTrue, lDone: QbeGen.QVal;
  1259. kind, op, rop: INTEGER;
  1260. folded, isR, isCh: BOOLEAN;
  1261. i: CARDINAL; el: AST.Node;
  1262. lw, rw, mw: CARDINAL; idx: INTEGER; fok, isL: BOOLEAN;
  1263. lt, rt: SymTab.TypeIndex; qw: QbeGen.QVal;
  1264. BEGIN
  1265. IF AST.Kind(n) = AST.NkDesignator THEN
  1266. LowerDesign(n, t, k, q, qn, sfx);
  1267. IF NOT asAddr THEN FinalLoad(t, sfx, q) END;
  1268. RETURN
  1269. END;
  1270. k := -1; qn[0] := CHR(0); sfx := FALSE;
  1271. IF AST.Kind(n) = AST.NkIntLit THEN
  1272. Name(n, qn); QbeGen.NormInt(qn, q); t := SymTab.IntType()
  1273. ELSIF AST.Kind(n) = AST.NkCharLit THEN
  1274. Name(n, qn); QbeGen.NormLit(qn, q, isCh); t := SymTab.CharType()
  1275. ELSIF AST.Kind(n) = AST.NkRealLit THEN
  1276. Name(n, qn); QbeGen.NormReal(qn, q); t := SymTab.RealType()
  1277. ELSIF AST.Kind(n) = AST.NkStrLit THEN
  1278. Name(n, qn);
  1279. IF SymTab.StrLen(qn) = 3 THEN
  1280. t := SymTab.CharType(); QbeGen.IntStr(QbeGen.CharVal(qn), q)
  1281. ELSE
  1282. t := SymTab.NewStr(); QbeGen.DeclStr(qn, q); QbeGen.NoteAddr(q, q)
  1283. END
  1284. ELSIF AST.Kind(n) = AST.NkSetLit THEN
  1285. t := SymTab.NewSet(SymTab.NewSubR(0, 255));
  1286. QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8);
  1287. i := 0;
  1288. WHILE i < AST.NChild(n) DO
  1289. el := AST.Child(n, i);
  1290. IF AST.Kind(el) = AST.NkSubrange THEN
  1291. LowerExpr(AST.Child(el, 0), t2, q2);
  1292. LowerExpr(AST.Child(el, 1), t2, qt);
  1293. QbeGen.SetRange(q, q2, qt, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  1294. ELSE
  1295. LowerExpr(el, t2, q2);
  1296. QbeGen.SetBit(q, q2, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  1297. END;
  1298. INC(i)
  1299. END
  1300. ELSIF AST.Kind(n) = AST.NkDesignator THEN
  1301. LowerDesign(n, t, k, q, qn, sfx)
  1302. ELSIF AST.Kind(n) = AST.NkCall THEN
  1303. IF IsMethodCall(n) THEN LowerMethodCall(n, t, q, TRUE)
  1304. ELSE
  1305. CalleeName(n, qn);
  1306. IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
  1307. ELSE LowerCall(n, t, q, TRUE)
  1308. END
  1309. END
  1310. ELSIF AST.Kind(n) = AST.NkUnary THEN
  1311. LowerExpr(AST.Child(n, 0), t, q);
  1312. IF AST.Op(n) = AST.OpSub THEN
  1313. IF QbeGen.IsImm(q) THEN QbeGen.NegFold(q, q)
  1314. ELSE QbeGen.NewTemp(qt); QbeGen.NegQ(q, qt, FALSE); QbeGen.CopyOp(qt, q)
  1315. END
  1316. ELSE
  1317. QbeGen.NotQ(q, qt); QbeGen.CopyOp(qt, q); t := SymTab.BoolType()
  1318. END
  1319. ELSIF AST.Kind(n) = AST.NkBinExpr THEN
  1320. op := AST.Op(n);
  1321. IF IsRel(op) THEN
  1322. LowerExpr(AST.Child(n, 0), t, q);
  1323. LowerExpr(AST.Child(n, 1), t2, q2);
  1324. rop := SymTab.OpEq; folded := RelSym(op, rop);
  1325. IF op = AST.OpIn THEN
  1326. QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2), SymTab.SetCount(t2), qt);
  1327. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1328. ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
  1329. OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
  1330. QbeGen.CmpL(rop, q, q2, qt);
  1331. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1332. ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
  1333. OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  1334. QbeGen.CmpSet(rop, q, q2, SymTab.SetWords(t), SymTab.SetWords(t2), qt);
  1335. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1336. ELSIF SymTab.StrCompat(t, t2) THEN
  1337. QbeGen.StrEq(rop, q, q2, qt);
  1338. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1339. ELSIF SymTab.IsLongFamily(t) OR SymTab.IsLongFamily(t2) THEN
  1340. IF SymTab.IsIntFamily(t) THEN QbeGen.WidenLong(q, qf); QbeGen.CopyOp(qf, q) END;
  1341. IF SymTab.IsIntFamily(t2) THEN QbeGen.WidenLong(q2, qf); QbeGen.CopyOp(qf, q2) END;
  1342. QbeGen.CmpLong(rop, q, q2, qt);
  1343. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  1344. ELSE
  1345. isR := (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClReal);
  1346. t := SymTab.BoolType();
  1347. QbeGen.Cmp(rop, q, q2, qt, isR);
  1348. QbeGen.CopyOp(qt, q)
  1349. END
  1350. ELSIF op = AST.OpAnd THEN
  1351. LowerExpr(AST.Child(n, 0), t, q);
  1352. QbeGen.DelayBegin;
  1353. LowerExpr(AST.Child(n, 1), t2, q2);
  1354. QbeGen.DelayEnd;
  1355. QbeGen.Slot4(qs);
  1356. QbeGen.NewLabel(lNext); QbeGen.NewLabel(lFalse); QbeGen.NewLabel(lDone);
  1357. QbeGen.Jnz(q, lNext, lFalse);
  1358. QbeGen.EmitLabel(lNext);
  1359. QbeGen.DelayFlush;
  1360. QbeGen.StoreW(qs, q2);
  1361. QbeGen.Jmp(lDone);
  1362. QbeGen.EmitLabel(lFalse);
  1363. QbeGen.StoreW(qs, "0");
  1364. QbeGen.Jmp(lDone);
  1365. QbeGen.EmitLabel(lDone);
  1366. QbeGen.LoadW(qs, qr);
  1367. QbeGen.CopyOp(qr, q);
  1368. t := SymTab.BoolType()
  1369. ELSIF op = AST.OpOr THEN
  1370. LowerExpr(AST.Child(n, 0), t, q);
  1371. QbeGen.DelayBegin;
  1372. LowerExpr(AST.Child(n, 1), t2, q2);
  1373. QbeGen.DelayEnd;
  1374. QbeGen.Slot4(qs);
  1375. QbeGen.NewLabel(lTrue); QbeGen.NewLabel(lNext); QbeGen.NewLabel(lDone);
  1376. QbeGen.Jnz(q, lTrue, lNext);
  1377. QbeGen.EmitLabel(lTrue);
  1378. QbeGen.StoreW(qs, "1");
  1379. QbeGen.Jmp(lDone);
  1380. QbeGen.EmitLabel(lNext);
  1381. QbeGen.DelayFlush;
  1382. QbeGen.StoreW(qs, q2);
  1383. QbeGen.Jmp(lDone);
  1384. QbeGen.EmitLabel(lDone);
  1385. QbeGen.LoadW(qs, qr);
  1386. QbeGen.CopyOp(qr, q);
  1387. t := SymTab.BoolType()
  1388. ELSE
  1389. LowerExpr(AST.Child(n, 0), t, q);
  1390. LowerExpr(AST.Child(n, 1), t2, q2);
  1391. IF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  1392. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  1393. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  1394. (* set union/diff (Add/Sub) or intersection/symdiff (Mul/Div) *)
  1395. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  1396. mw := lw; IF rw > mw THEN mw := rw END;
  1397. IF op = AST.OpAdd THEN idx := 0
  1398. ELSIF op = AST.OpSub THEN idx := 2
  1399. ELSIF op = AST.OpMul THEN idx := 1
  1400. ELSE idx := 3
  1401. END;
  1402. QbeGen.SetBinOp(idx, q, q2, lw, rw, qt);
  1403. t := SymTab.NewSet(SymTab.NewSubR(0, VAL(INTEGER, mw) * 32 - 1));
  1404. QbeGen.CopyOp(qt, q)
  1405. ELSIF (op = AST.OpAdd)
  1406. AND (SymTab.StrCompat(t, t2)
  1407. OR (SymTab.IsStrType(t) AND (SymTab.ClassOf(t2) = SymTab.ClChar))
  1408. OR ((SymTab.ClassOf(t) = SymTab.ClChar) AND SymTab.IsStrType(t2))) THEN
  1409. QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2), qt, fok);
  1410. IF NOT fok THEN
  1411. IF SymTab.StrCompat(t, t2) THEN QbeGen.StrCat(q, q2, qt)
  1412. ELSIF SymTab.IsStrType(t) THEN
  1413. QbeGen.DeclCharStr(q2, qs); QbeGen.StrCat(q, qs, qt)
  1414. ELSE
  1415. QbeGen.DeclCharStr(q, qs); QbeGen.StrCat(qs, q2, qt)
  1416. END
  1417. END;
  1418. t := SymTab.NewStr(); QbeGen.CopyOp(qt, q)
  1419. ELSE
  1420. lt := t; rt := t2;
  1421. IF (SymTab.ClassOf(lt) = SymTab.ClReal)
  1422. OR (SymTab.ClassOf(rt) = SymTab.ClReal) THEN
  1423. t := SymTab.RealType()
  1424. ELSIF SymTab.IsLongFamily(lt) OR SymTab.IsLongFamily(rt) THEN
  1425. t := SymTab.LongType()
  1426. ELSE t := SymTab.IntType()
  1427. END;
  1428. isL := SymTab.IsLongFamily(t);
  1429. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  1430. kind := 0;
  1431. IF op = AST.OpSub THEN kind := 1
  1432. ELSIF op = AST.OpMul THEN kind := 2
  1433. ELSIF op = AST.OpDiv THEN kind := 3
  1434. ELSIF op = AST.OpMod THEN kind := 4
  1435. END;
  1436. folded := FALSE;
  1437. IF (NOT isL) AND (NOT isR) AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  1438. folded := QbeGen.Fold2(kind, q, q2, qf)
  1439. END;
  1440. IF folded THEN QbeGen.CopyOp(qf, q)
  1441. ELSE
  1442. IF isL THEN
  1443. IF SymTab.IsIntFamily(lt) THEN
  1444. QbeGen.WidenLong(q, qw); QbeGen.CopyOp(qw, q)
  1445. END;
  1446. IF SymTab.IsIntFamily(rt) THEN
  1447. QbeGen.WidenLong(q2, qw); QbeGen.CopyOp(qw, q2)
  1448. END;
  1449. QbeGen.NewTemp(qt);
  1450. IF op = AST.OpAdd THEN QbeGen.Op3L("add", qt, q, q2)
  1451. ELSIF op = AST.OpSub THEN QbeGen.Op3L("sub", qt, q, q2)
  1452. ELSIF op = AST.OpMul THEN QbeGen.Op3L("mul", qt, q, q2)
  1453. ELSE QbeGen.Op3L("div", qt, q, q2)
  1454. END
  1455. ELSE
  1456. QbeGen.NewTemp(qt);
  1457. IF op = AST.OpAdd THEN QbeGen.Op3("add", qt, q, q2, isR)
  1458. ELSIF op = AST.OpSub THEN QbeGen.Op3("sub", qt, q, q2, isR)
  1459. ELSIF op = AST.OpMul THEN QbeGen.Op3("mul", qt, q, q2, isR)
  1460. ELSIF op = AST.OpDiv THEN QbeGen.Op3("div", qt, q, q2, isR)
  1461. ELSE QbeGen.Op3("rem", qt, q, q2, isR)
  1462. END
  1463. END;
  1464. QbeGen.CopyOp(qt, q)
  1465. END
  1466. END
  1467. END
  1468. END
  1469. END LowerExprFull;
  1470. PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex;
  1471. VAR q: QbeGen.QVal);
  1472. VAR k: INTEGER; qn: SymTab.Name; sfx: BOOLEAN;
  1473. BEGIN
  1474. LowerExprFull(n, t, q, k, qn, sfx, FALSE)
  1475. END LowerExpr;
  1476. PROCEDURE LowerStmt (seq: AST.Node);
  1477. VAR i: CARDINAL; c, els, by: AST.Node; k: INTEGER;
  1478. t, t2, dt, et: SymTab.TypeIndex;
  1479. q, q2, qt, qf, qd, qe: QbeGen.QVal;
  1480. qlo, qhi, qk, qb, ql: QbeGen.QVal;
  1481. lTop, lBody, lEnd, lThen, lElse, lNext, lFalse, lDone, lx: QbeGen.QVal;
  1482. qn, lv: SymTab.Name;
  1483. kind, op, rop, cls: INTEGER;
  1484. sfx, folded, isR, conv, wconv, hasElse: BOOLEAN;
  1485. BEGIN
  1486. IF seq = AST.NoNode THEN RETURN END;
  1487. k := AST.Kind(seq);
  1488. IF k = AST.NkBlock THEN
  1489. i := 0;
  1490. WHILE i < AST.NChild(seq) DO
  1491. LowerStmt(AST.Child(seq, i)); INC(i)
  1492. END
  1493. ELSIF k = AST.NkAssign THEN
  1494. LowerDesign(AST.Child(seq, 0), dt, cls, qd, qn, sfx);
  1495. LowerExpr(AST.Child(seq, 1), et, qe);
  1496. isR := (dt # SymTab.InvalidType) AND (SymTab.ClassOf(dt) = SymTab.ClReal);
  1497. conv := isR AND SymTab.IsIntFamily(et);
  1498. wconv := (dt # SymTab.InvalidType) AND SymTab.IsLongFamily(dt)
  1499. AND SymTab.IsIntFamily(et);
  1500. IF sfx OR (cls = SymTab.KindField) THEN
  1501. IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  1502. IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
  1503. AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
  1504. ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
  1505. ELSE QbeGen.CopyArray(qd, qe, dt)
  1506. END
  1507. ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
  1508. QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et))
  1509. ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
  1510. QbeGen.CopyRecord(qd, qe, dt)
  1511. ELSIF SymTab.IsLongFamily(dt) THEN
  1512. IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.ElemStore(qd, ql, dt)
  1513. ELSE QbeGen.ElemStore(qd, qe, dt)
  1514. END
  1515. ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.ElemStore(qd, qt, dt)
  1516. ELSE QbeGen.ElemStore(qd, qe, dt)
  1517. END
  1518. ELSE
  1519. IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  1520. IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
  1521. AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
  1522. ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
  1523. ELSE QbeGen.CopyArray(qd, qe, dt)
  1524. END
  1525. ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
  1526. QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et))
  1527. ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
  1528. QbeGen.CopyRecord(qd, qe, dt)
  1529. ELSIF (SymTab.ClassOf(dt) = SymTab.ClPtr)
  1530. OR (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
  1531. QbeGen.StorePtr(qn, qe)
  1532. ELSIF SymTab.IsLongFamily(dt) THEN
  1533. IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.StoreLong(qn, ql)
  1534. ELSE QbeGen.StoreLong(qn, qe)
  1535. END
  1536. ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.StoreVar(qn, qt, TRUE)
  1537. ELSE QbeGen.StoreVar(qn, qe, isR)
  1538. END
  1539. END
  1540. ELSIF k = AST.NkIf THEN
  1541. LowerExpr(AST.Child(seq, 0), t, q);
  1542. QbeGen.NewLabel(lThen); QbeGen.NewLabel(lElse); QbeGen.NewLabel(lEnd);
  1543. QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen);
  1544. LowerStmt(AST.Child(seq, 1));
  1545. QbeGen.Jmp(lEnd);
  1546. els := AST.Child(seq, 2); hasElse := FALSE;
  1547. WHILE (els # AST.NoNode) AND (AST.Kind(els) = AST.NkIf) DO
  1548. QbeGen.EmitLabel(lElse); QbeGen.NewLabel(lElse);
  1549. LowerExpr(AST.Child(els, 0), t, q);
  1550. QbeGen.NewLabel(lThen); QbeGen.Jnz(q, lThen, lElse);
  1551. QbeGen.EmitLabel(lThen);
  1552. LowerStmt(AST.Child(els, 1));
  1553. QbeGen.Jmp(lEnd);
  1554. els := AST.Child(els, 2)
  1555. END;
  1556. IF els # AST.NoNode THEN
  1557. QbeGen.EmitLabel(lElse); hasElse := TRUE; LowerStmt(els)
  1558. END;
  1559. IF hasElse THEN QbeGen.EmitLabel(lEnd)
  1560. ELSE QbeGen.EmitLabel(lElse); QbeGen.EmitLabel(lEnd)
  1561. END
  1562. ELSIF k = AST.NkWhile THEN
  1563. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd);
  1564. QbeGen.EmitLabel(lTop);
  1565. LowerExpr(AST.Child(seq, 0), t, q);
  1566. QbeGen.Jnz(q, lBody, lEnd); QbeGen.EmitLabel(lBody);
  1567. LowerStmt(AST.Child(seq, 1));
  1568. QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd)
  1569. ELSIF k = AST.NkRepeat THEN
  1570. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd); QbeGen.EmitLabel(lTop);
  1571. LowerStmt(AST.Child(seq, 0));
  1572. LowerExpr(AST.Child(seq, 1), t, q);
  1573. QbeGen.Jnz(q, lEnd, lTop); QbeGen.EmitLabel(lEnd)
  1574. ELSIF k = AST.NkLoop THEN
  1575. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd);
  1576. QbeGen.PushLoop(lEnd); QbeGen.EmitLabel(lTop);
  1577. LowerStmt(AST.Child(seq, 0));
  1578. QbeGen.Jmp(lTop); QbeGen.PopLoop; QbeGen.EmitLabel(lEnd)
  1579. ELSIF k = AST.NkExit THEN
  1580. IF QbeGen.TopLoop(lx) THEN QbeGen.Jmp(lx) END
  1581. ELSIF k = AST.NkFor THEN
  1582. Name(AST.Child(seq, 0), lv);
  1583. LowerExpr(AST.Child(seq, 1), t, qlo);
  1584. LowerExpr(AST.Child(seq, 2), t2, qhi);
  1585. QbeGen.StoreVar(lv, qlo, FALSE);
  1586. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd);
  1587. QbeGen.EmitLabel(lTop);
  1588. QbeGen.LoadVar(lv, FALSE, qt);
  1589. QbeGen.NewTemp(qk);
  1590. QbeGen.Op3("cslew", qk, qt, qhi, FALSE);
  1591. QbeGen.Jnz(qk, lBody, lEnd);
  1592. QbeGen.EmitLabel(lBody);
  1593. LowerStmt(AST.Child(seq, 4));
  1594. QbeGen.LoadVar(lv, FALSE, qt);
  1595. QbeGen.IntStr(1, qb);
  1596. QbeGen.NewTemp(qk);
  1597. QbeGen.Op3("add", qk, qt, qb, FALSE);
  1598. QbeGen.StoreVar(lv, qk, FALSE);
  1599. QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd)
  1600. ELSIF k = AST.NkHalt THEN
  1601. IF AST.Child(seq, 0) # AST.NoNode THEN
  1602. LowerExpr(AST.Child(seq, 0), t, q) END;
  1603. QbeGen.HaltQ
  1604. ELSIF k = AST.NkReturn THEN
  1605. IF AST.Child(seq, 0) = AST.NoNode THEN
  1606. QbeGen.EmitRet(q, FALSE)
  1607. ELSE
  1608. LowerExpr(AST.Child(seq, 0), t, q);
  1609. conv := (SymTab.ClassOf(SymTab.CurRes()) = SymTab.ClReal)
  1610. AND SymTab.IsIntFamily(t);
  1611. IF conv THEN QbeGen.ConvIR(q, qt); QbeGen.EmitRet(qt, TRUE)
  1612. ELSE QbeGen.EmitRet(q, TRUE)
  1613. END
  1614. END
  1615. ELSIF k = AST.NkCase THEN LowerCase(seq)
  1616. ELSIF k = AST.NkWith THEN LowerWith(seq)
  1617. ELSIF k = AST.NkCall THEN
  1618. IF IsMethodCall(seq) THEN LowerMethodCall(seq, t, q, FALSE)
  1619. ELSE
  1620. CalleeName(seq, qn);
  1621. IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
  1622. ELSE LowerCall(seq, t, q, FALSE)
  1623. END
  1624. END
  1625. END
  1626. END LowerStmt;
  1627. PROCEDURE ReenterGlobals (seq: AST.Node);
  1628. (* Re-registers a nested module's non-exported globals in the enclosing
  1629. (still-open) module scope, so QbeGen.GlobalRef can resolve their
  1630. "<outer>_<name>" symbols after the nested scope has been popped. *)
  1631. VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name;
  1632. BEGIN
  1633. IF seq = AST.NoNode THEN RETURN END;
  1634. i := 0;
  1635. WHILE i < AST.NChild(seq) DO
  1636. c := AST.Child(seq, i);
  1637. IF i = AST.MaxChild - 1 THEN ReenterGlobals(c)
  1638. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN ReenterGlobals(c)
  1639. ELSIF AST.Kind(c) = AST.NkVarDecl THEN
  1640. j := 0;
  1641. WHILE j < AST.NChild(c) DO
  1642. Name(AST.Child(c, j), nm);
  1643. IF SymTab.ReenterModGlobal(nm, SymTab.KindVar, curUnitName) THEN
  1644. SymTab.SetSymType(nm, AST.Ty(c))
  1645. END;
  1646. INC(j)
  1647. END
  1648. END;
  1649. INC(i)
  1650. END
  1651. END ReenterGlobals;
  1652. PROCEDURE LowerDecls (seq: AST.Node);
  1653. VAR i, j: CARDINAL; c: AST.Node; nm, txt: SymTab.Name; qv: QbeGen.QVal;
  1654. mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1655. ext, pv: BOOLEAN; kk: INTEGER; ct: SymTab.TypeIndex;
  1656. BEGIN
  1657. IF seq = AST.NoNode THEN RETURN END;
  1658. i := 0;
  1659. WHILE i < AST.NChild(seq) DO
  1660. c := AST.Child(seq, i);
  1661. IF i = AST.MaxChild - 1 THEN LowerDecls(c)
  1662. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDecls(c)
  1663. ELSIF AST.Kind(c) = AST.NkClassDecl THEN
  1664. Name(AST.Child(c, 0), nm);
  1665. IF Resolve(nm, kk, ct) THEN
  1666. IF SymTab.ClassOf(ct) = SymTab.ClClass THEN
  1667. IF AST.Op(c) = 1 THEN
  1668. LowerMethods(AST.Child(c, 3), ct);
  1669. IF AST.Child(c, 2) # AST.NoNode THEN
  1670. QbeGen.BeginInit(nm);
  1671. LowerStmt(AST.Child(c, 2));
  1672. QbeGen.EndInit
  1673. END
  1674. ELSE
  1675. LowerMethodHeadings(AST.Child(c, 3), ct)
  1676. END
  1677. END
  1678. END
  1679. ELSIF AST.Kind(c) = AST.NkUnit THEN
  1680. Name(AST.Child(c, 0), nm);
  1681. ReenterGlobals(AST.Child(c, 1));
  1682. LowerDecls(AST.Child(c, 1));
  1683. IF AST.Child(c, 2) # AST.NoNode THEN
  1684. QbeGen.BeginInit(nm);
  1685. LowerStmt(AST.Child(c, 2));
  1686. QbeGen.EndInit
  1687. END
  1688. ELSIF AST.Kind(c) = AST.NkVarDecl THEN
  1689. j := 0;
  1690. WHILE j < AST.NChild(c) DO
  1691. Name(AST.Child(c, j), nm);
  1692. QbeGen.DeclVar(nm, AST.Ty(c));
  1693. INC(j)
  1694. END
  1695. ELSIF AST.Kind(c) = AST.NkConstDecl THEN
  1696. Name(AST.Child(c, 0), nm);
  1697. Name(AST.Child(c, 1), txt);
  1698. QbeGen.NormInt(txt, qv);
  1699. QbeGen.DeclConst(nm, qv, AST.Ty(c))
  1700. ELSIF AST.Kind(c) = AST.NkProcDecl THEN
  1701. Name(AST.Child(c, 0), nm);
  1702. IF ProcInfo(nm, uid, res, depth, ext, np) THEN
  1703. QbeGen.Mangled(nm, uid, mg);
  1704. QbeGen.BeginFunc(mg);
  1705. j := 0;
  1706. WHILE j < np DO
  1707. IF ParamInfo(nm, j, pt, pv, txt) THEN
  1708. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END
  1709. END;
  1710. INC(j)
  1711. END;
  1712. QbeGen.SetFuncRes(res);
  1713. IF AST.Child(c, 1) = AST.NoNode THEN
  1714. (* declaration-only (definition module): replay the heading *)
  1715. QbeGen.AbortFunc
  1716. ELSE
  1717. QbeGen.EndFuncHeader;
  1718. LowerDecls(AST.Child(c, 2));
  1719. LowerStmt(AST.Child(c, 1));
  1720. QbeGen.EndFunc(res)
  1721. END
  1722. END
  1723. END;
  1724. INC(i)
  1725. END
  1726. END LowerDecls;
  1727. PROCEDURE MaterializeGlobals (unitName: ARRAY OF CHAR; decls: AST.Node);
  1728. (* Make a unit's module-level VAR/CONST visible in the (global) scope
  1729. Lower runs in at session end, so GlobalRef resolves "<unit>_<name>". *)
  1730. VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name;
  1731. BEGIN
  1732. IF decls = AST.NoNode THEN RETURN END;
  1733. i := 0;
  1734. WHILE i < AST.NChild(decls) DO
  1735. c := AST.Child(decls, i);
  1736. IF i = AST.MaxChild - 1 THEN MaterializeGlobals(unitName, c)
  1737. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN MaterializeGlobals(unitName, c)
  1738. ELSIF (AST.Kind(c) = AST.NkVarDecl) OR (AST.Kind(c) = AST.NkConstDecl) THEN
  1739. j := 0;
  1740. WHILE j < AST.NChild(c) DO
  1741. IF AST.Kind(AST.Child(c, j)) = AST.NkIdent THEN
  1742. Name(AST.Child(c, j), nm);
  1743. IF NOT SymTab.Materialize(unitName, nm) THEN END
  1744. END;
  1745. INC(j)
  1746. END
  1747. ELSIF (AST.Kind(c) = AST.NkTypeDecl) OR (AST.Kind(c) = AST.NkClassDecl) THEN
  1748. IF AST.NChild(c) >= 1 THEN
  1749. Name(AST.Child(c, 0), nm);
  1750. IF NOT SymTab.Materialize(unitName, nm) THEN END
  1751. END
  1752. END;
  1753. INC(i)
  1754. END
  1755. END MaterializeGlobals;
  1756. PROCEDURE LowerOneUnit (u: AST.Node; isProg: BOOLEAN);
  1757. VAR nm: SymTab.Name;
  1758. BEGIN
  1759. Name(AST.Child(u, 0), nm);
  1760. CopySpan(nm, curUnitName, 0, 0);
  1761. QbeGen.SetModule(nm);
  1762. MaterializeGlobals(nm, AST.Child(u, 1));
  1763. LowerDecls(AST.Child(u, 1));
  1764. IF isProg THEN
  1765. QbeGen.BeginBody;
  1766. LowerStmt(AST.Child(u, 2))
  1767. ELSIF AST.Child(u, 2) # AST.NoNode THEN
  1768. QbeGen.BeginInit(nm);
  1769. LowerStmt(AST.Child(u, 2));
  1770. QbeGen.EndInit
  1771. END
  1772. END LowerOneUnit;
  1773. PROCEDURE LowerSession (units: ARRAY OF AST.Node; n: CARDINAL;
  1774. progName: ARRAY OF CHAR);
  1775. (* Re-emit a whole session (all units, in order) into one image. *)
  1776. VAR i, j: CARDINAL; out: ARRAY [0 .. 255] OF CHAR; pn: SymTab.Name;
  1777. BEGIN
  1778. IF n = 0 THEN RETURN END;
  1779. Name(AST.Child(units[n - 1], 0), pn);
  1780. j := 0;
  1781. WHILE (j <= 254) AND (pn[j] # CHR(0)) DO
  1782. out[j] := pn[j]; INC(j)
  1783. END;
  1784. out[j] := "L"; INC(j); out[j] := CHR(0);
  1785. withTop := 0;
  1786. curImplCls := SymTab.InvalidType;
  1787. QbeGen.OpenModule(progName);
  1788. QbeGen.SetOutName(out);
  1789. i := 0;
  1790. WHILE i < n DO
  1791. LowerOneUnit(units[i], i = n - 1);
  1792. INC(i)
  1793. END;
  1794. QbeGen.EndModule(pn)
  1795. END LowerSession;
  1796. PROCEDURE LowerUnit (unit: AST.Node);
  1797. VAR nm: SymTab.Name; out: ARRAY [0 .. 255] OF CHAR; i: CARDINAL;
  1798. BEGIN
  1799. withTop := 0;
  1800. curImplCls := SymTab.InvalidType;
  1801. Name(AST.Child(unit, 0), nm);
  1802. i := 0;
  1803. WHILE (i <= 254) AND (i <= HIGH(nm)) AND (nm[i] # CHR(0)) DO
  1804. out[i] := nm[i]; INC(i)
  1805. END;
  1806. out[i] := "L"; INC(i); out[i] := CHR(0);
  1807. QbeGen.OpenModule(nm);
  1808. QbeGen.SetOutName(out);
  1809. QbeGen.SetModule(nm);
  1810. LowerDecls(AST.Child(unit, 1));
  1811. QbeGen.BeginBody;
  1812. LowerStmt(AST.Child(unit, 2));
  1813. QbeGen.EndModule(nm)
  1814. END LowerUnit;
  1815. BEGIN
  1816. END Lower.