Lower.mod 64 KB

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