Lower.mod 108 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868
  1. IMPLEMENTATION MODULE Lower;
  2. (* Scalar/boolean/control-flow walk (L0-L2): see Lower.def and
  3. docs/plan-lower.md. The mutually recursive walkers are declared in
  4. Lower.def (gm2's link pass rejects FORWARD, V3 has no whole-module
  5. pass, so a definition-visible declaration breaks the cycle). *)
  6. IMPORT AST, SymTab, QbeGen;
  7. (* ---------------- self-contained symbol tables (zero SymTab surface) ----
  8. Flat arrays only, no ARRAY OF RECORD: a record's array field loses its
  9. length word in static array data, and V3 miscompiles that when the
  10. field is passed as an open array (docs/wip/nested-array-field-bug.mod).
  11. Names live in flat CHAR arrays indexed manually at slot * 64. *)
  12. CONST
  13. MaxSym = 8192; (* whole-session: >4096 vars/consts/params *)
  14. MaxName = 63;
  15. MaxProc = 2048; (* whole-session: the compiler declares >1200 procs *)
  16. MaxImp = 512; (* per-unit imports *)
  17. MaxPar = 32;
  18. HashSize = 16384; (* power of two > MaxSym, MaxProc: open addressing *)
  19. MaxCFold = 256; (* named compile-time set constants per session *)
  20. MaxCFoldW = 16; (* mask words (512 bits); wider sets are a 230 *)
  21. VAR
  22. symName : ARRAY [0 .. MaxSym * 64 - 1] OF CHAR;
  23. symKind : ARRAY [0 .. MaxSym - 1] OF INTEGER;
  24. symTy : ARRAY [0 .. MaxSym - 1] OF SymTab.TypeIndex;
  25. symVal : ARRAY [0 .. MaxSym * 64 - 1] OF CHAR; (* const value, flat *)
  26. nSyms : CARDINAL;
  27. procName : ARRAY [0 .. MaxProc * 64 - 1] OF CHAR;
  28. procUid : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  29. procRes : ARRAY [0 .. MaxProc - 1] OF SymTab.TypeIndex;
  30. procDep : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  31. procExt : ARRAY [0 .. MaxProc - 1] OF BOOLEAN;
  32. procVa : ARRAY [0 .. MaxProc - 1] OF BOOLEAN; (* C varargs *)
  33. procNpar : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  34. parTy : ARRAY [0 .. MaxProc * MaxPar - 1] OF SymTab.TypeIndex;
  35. parVar : ARRAY [0 .. MaxProc * MaxPar - 1] OF BOOLEAN;
  36. parName : ARRAY [0 .. MaxProc * MaxPar * 64 - 1] OF CHAR;
  37. nProcs : CARDINAL;
  38. (* Open-addressing indexes into symName/procName: entry = index+1,
  39. 0 = empty. A whole-session linear scan is too slow (thousands of
  40. lookups over thousands of entries), so FindSym/FindProc hash. *)
  41. symHash : ARRAY [0 .. HashSize - 1] OF INTEGER;
  42. procHash : ARRAY [0 .. HashSize - 1] OF INTEGER;
  43. (* Per-unit imports (FROM M IMPORT P): the exact proc entry for a
  44. name, so an unqualified call resolves to the imported proc even
  45. when another module declares the same name. Reset each unit. *)
  46. impProc : ARRAY [0 .. MaxImp - 1] OF INTEGER;
  47. impName : ARRAY [0 .. MaxImp * 64 - 1] OF CHAR;
  48. nImps : CARDINAL;
  49. (* Record-array globals too large to expand inline: their template is
  50. emitted with their data and their elements are initialised by a
  51. run-time loop (QbeGen.InitRecArray) in the unit's init. Per unit. *)
  52. nCountInit : CARDINAL;
  53. countArr : ARRAY [0 .. 63] OF SymTab.Name;
  54. countTyp : ARRAY [0 .. 63] OF SymTab.TypeIndex;
  55. (* GOTO/labels: user label name -> QbeGen label, per procedure. *)
  56. nUserLab : CARDINAL;
  57. userLabNm : ARRAY [0 .. 255 * 64 - 1] OF CHAR;
  58. userLabQ : ARRAY [0 .. 255] OF QbeGen.QVal;
  59. (* Scoping: each symbol records the procedure that owns it (-1 =
  60. module level); FindSym searches the emitted procedure's chain
  61. innermost-first so common names (s, i, k) do not collide across
  62. procedures. *)
  63. symOwner : ARRAY [0 .. MaxSym - 1] OF INTEGER;
  64. procParent : ARRAY [0 .. MaxProc - 1] OF INTEGER;
  65. procSymBase : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  66. procSymTop : ARRAY [0 .. MaxProc - 1] OF CARDINAL;
  67. scopeStack : ARRAY [0 .. MaxProc - 1] OF INTEGER;
  68. scopeTop : CARDINAL;
  69. curScopeProc : INTEGER; (* owner while parsing: enclosing proc *)
  70. emitProc : INTEGER; (* owner while emitting: current proc *)
  71. qualUid : CARDINAL; (* uid of the last M.P alias resolved *)
  72. qualIsVar : BOOLEAN; (* last M.P alias is a proc-typed variable *)
  73. withRec : ARRAY [0 .. 15] OF SymTab.TypeIndex;
  74. withTop : CARDINAL;
  75. curMethCls : SymTab.TypeIndex; (* class bound by the last obj.Method *)
  76. curImplCls : SymTab.TypeIndex; (* class whose implementation is open *)
  77. curUnitName : SymTab.Name; (* unit being re-emitted (LowerSession) *)
  78. (* Compile-time set constants (SET CONSTs): masks the grammar computes
  79. and Lower re-emits as pooled static data. Name-keyed, latest wins,
  80. exactly like symVal. *)
  81. cfoldN : CARDINAL;
  82. cfoldName : ARRAY [0 .. MaxCFold * 64 - 1] OF CHAR;
  83. cfoldW : ARRAY [0 .. MaxCFold - 1] OF CARDINAL;
  84. cfoldLo : ARRAY [0 .. MaxCFold - 1] OF INTEGER;
  85. cfoldMask : ARRAY [0 .. MaxCFold * MaxCFoldW - 1] OF CARDINAL;
  86. PROCEDURE CopyN (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR);
  87. VAR i: CARDINAL;
  88. BEGIN
  89. i := 0;
  90. WHILE (i < MaxName) AND (src[i] # CHR(0)) DO dst[i] := src[i]; INC(i) END;
  91. dst[i] := CHR(0)
  92. END CopyN;
  93. PROCEDURE CopySpan (VAR src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR;
  94. srcOff, dstOff: CARDINAL);
  95. (* src is a VAR open array on purpose: gm2 copies a value open-array
  96. formal to a stack VLA of its full length, which overflows the stack
  97. for the multi-megabyte tables below. *)
  98. VAR i: CARDINAL;
  99. BEGIN
  100. i := 0;
  101. WHILE (i < MaxName) AND (src[srcOff + i] # CHR(0)) DO
  102. dst[dstOff + i] := src[srcOff + i]; INC(i)
  103. END;
  104. dst[dstOff + i] := CHR(0)
  105. END CopySpan;
  106. PROCEDURE HashStr (name: ARRAY OF CHAR): CARDINAL;
  107. VAR h: CARDINAL; i: CARDINAL;
  108. BEGIN
  109. h := 5381; i := 0;
  110. WHILE (i <= HIGH(name)) AND (name[i] # CHR(0)) DO
  111. h := (h * 33 + VAL(CARDINAL, ORD(name[i]))) MOD HashSize; INC(i)
  112. END;
  113. RETURN h
  114. END HashStr;
  115. PROCEDURE SpanEq (VAR arr: ARRAY OF CHAR; off: CARDINAL;
  116. name: ARRAY OF CHAR): BOOLEAN;
  117. VAR j: CARDINAL;
  118. BEGIN
  119. j := 0;
  120. WHILE (j < MaxName) AND (name[j] # CHR(0)) DO
  121. IF arr[off + j] # name[j] THEN RETURN FALSE END;
  122. INC(j)
  123. END;
  124. RETURN arr[off + j] = name[j]
  125. END SpanEq;
  126. PROCEDURE HashPut (VAR htab: ARRAY OF INTEGER; VAR names: ARRAY OF CHAR;
  127. name: ARRAY OF CHAR; idx: CARDINAL);
  128. (* Insert idx, replacing an existing entry with the same name so the
  129. latest declaration wins (the linear scan used to search backward). *)
  130. VAR h: CARDINAL;
  131. BEGIN
  132. h := HashStr(name);
  133. LOOP
  134. IF htab[h] = 0 THEN htab[h] := VAL(INTEGER, idx) + 1; RETURN END;
  135. IF SpanEq(names, VAL(CARDINAL, htab[h] - 1) * 64, name) THEN
  136. htab[h] := VAL(INTEGER, idx) + 1; RETURN
  137. END;
  138. h := (h + 1) MOD HashSize
  139. END
  140. END HashPut;
  141. PROCEDURE HashGet (VAR htab: ARRAY OF INTEGER; VAR names: ARRAY OF CHAR;
  142. name: ARRAY OF CHAR): INTEGER;
  143. VAR h: CARDINAL;
  144. BEGIN
  145. h := HashStr(name);
  146. LOOP
  147. IF htab[h] = 0 THEN RETURN -1 END;
  148. IF SpanEq(names, VAL(CARDINAL, htab[h] - 1) * 64, name) THEN
  149. RETURN htab[h] - 1
  150. END;
  151. h := (h + 1) MOD HashSize
  152. END
  153. END HashGet;
  154. PROCEDURE Reset;
  155. VAR i: CARDINAL;
  156. BEGIN
  157. nSyms := 0; nProcs := 0;
  158. scopeTop := 0; curScopeProc := -1; emitProc := -1;
  159. i := 0;
  160. WHILE i < HashSize DO symHash[i] := 0; procHash[i] := 0; INC(i) END
  161. END Reset;
  162. PROCEDURE NoteVar (name: ARRAY OF CHAR; kind: INTEGER; t: SymTab.TypeIndex);
  163. BEGIN
  164. IF nSyms >= MaxSym THEN RETURN END;
  165. CopySpan(name, symName, 0, nSyms * 64);
  166. symKind[nSyms] := kind; symTy[nSyms] := t;
  167. symOwner[nSyms] := curScopeProc;
  168. HashPut(symHash, symName, name, nSyms);
  169. INC(nSyms)
  170. END NoteVar;
  171. PROCEDURE NoteConstVal (val: ARRAY OF CHAR);
  172. (* Records the evaluated value of the CONST just entered by NoteVar.
  173. Const values are per-unit and cross-module names collide (every
  174. module has EOL), so they live here, not in SymTab. *)
  175. BEGIN
  176. IF nSyms > 0 THEN CopySpan(val, symVal, 0, (nSyms - 1) * 64) END
  177. END NoteConstVal;
  178. PROCEDURE ScopeEnter;
  179. (* Called at a procedure heading, before NoteProc. Pushes the enclosing
  180. procedure as the parent scope. *)
  181. BEGIN
  182. IF scopeTop <= HIGH(scopeStack) THEN
  183. scopeStack[scopeTop] := curScopeProc;
  184. INC(scopeTop)
  185. END
  186. END ScopeEnter;
  187. PROCEDURE ScopeLeave;
  188. BEGIN
  189. IF curScopeProc >= 0 THEN procSymTop[curScopeProc] := nSyms END;
  190. IF scopeTop > 0 THEN
  191. DEC(scopeTop);
  192. curScopeProc := scopeStack[scopeTop]
  193. END
  194. END ScopeLeave;
  195. PROCEDURE ReenterScopeProc (ty: INTEGER);
  196. (* Restores a previously noted proc entry as current for the re-parse
  197. pass (its registration ran once in the skip pass): pushes the
  198. current owner and resumes ty, so the Block-end ScopeLeave pops back
  199. and nested NoteProc/NoteVar attach under the right parent. *)
  200. BEGIN
  201. IF (ty < 0) OR (ty >= VAL(INTEGER, nProcs)) THEN RETURN END;
  202. IF scopeTop <= HIGH(scopeStack) THEN
  203. scopeStack[scopeTop] := curScopeProc;
  204. INC(scopeTop)
  205. END;
  206. curScopeProc := ty
  207. END ReenterScopeProc;
  208. PROCEDURE CurScopeProc (): INTEGER;
  209. (* The proc entry NoteProc most recently made current (ty stamped on the
  210. NkProcDecl); captured by the parser's span table for the re-parse. *)
  211. BEGIN
  212. RETURN curScopeProc
  213. END CurScopeProc;
  214. PROCEDURE NoteProc (name: ARRAY OF CHAR; uid: CARDINAL;
  215. res: SymTab.TypeIndex; depth: CARDINAL; ext: BOOLEAN);
  216. BEGIN
  217. IF nProcs >= MaxProc THEN RETURN END;
  218. CopySpan(name, procName, 0, nProcs * 64);
  219. procUid[nProcs] := uid; procRes[nProcs] := res;
  220. procDep[nProcs] := depth; procExt[nProcs] := ext;
  221. procNpar[nProcs] := 0;
  222. procParent[nProcs] := curScopeProc;
  223. procSymBase[nProcs] := nSyms;
  224. curScopeProc := VAL(INTEGER, nProcs);
  225. HashPut(procHash, procName, name, nProcs);
  226. INC(nProcs)
  227. END NoteProc;
  228. PROCEDURE AliasProc (name: ARRAY OF CHAR; uid: CARDINAL;
  229. res: SymTab.TypeIndex; depth: CARDINAL; ext: BOOLEAN);
  230. (* A generic procedure formal bound to an actual procedure: add a
  231. proc-table entry so calls through the formal resolve to the actual,
  232. without disturbing the scope stack (unlike NoteProc). *)
  233. BEGIN
  234. IF nProcs >= MaxProc THEN RETURN END;
  235. CopySpan(name, procName, 0, nProcs * 64);
  236. procUid[nProcs] := uid; procRes[nProcs] := res;
  237. procDep[nProcs] := depth; procExt[nProcs] := ext;
  238. procNpar[nProcs] := 0;
  239. procParent[nProcs] := -1;
  240. procSymBase[nProcs] := nSyms;
  241. HashPut(procHash, procName, name, nProcs);
  242. INC(nProcs)
  243. END AliasProc;
  244. PROCEDURE MarkProcExternal;
  245. (* The grammar calls this from the EXTERNAL branch, after NoteProc, so
  246. the walk records that the callee takes no static link. *)
  247. BEGIN
  248. IF nProcs > 0 THEN procExt[nProcs - 1] := TRUE END
  249. END MarkProcExternal;
  250. PROCEDURE NoteCProc (name: ARRAY OF CHAR);
  251. (* FROM libc IMPORT P: note its signature (real prototypes for the
  252. known C functions, permissive no-result varargs otherwise). NoteProc
  253. sets curScopeProc; restore it so the next import is not seen as
  254. nested. *)
  255. VAR save: INTEGER; i: CARDINAL;
  256. BEGIN
  257. save := curScopeProc;
  258. curScopeProc := -1;
  259. NoteProc(name, 0, SymTab.ProcRes(name), 0, TRUE);
  260. curScopeProc := save;
  261. IF nProcs > 0 THEN
  262. procExt[nProcs - 1] := TRUE;
  263. procVa[nProcs - 1] := SymTab.Varargs(name);
  264. procParent[nProcs - 1] := -1;
  265. i := 0;
  266. WHILE i < SymTab.ProcNPar(name) DO
  267. NoteParam("", SymTab.ParamType(name, i),
  268. SymTab.ParamIsVar(name, i));
  269. INC(i)
  270. END
  271. END
  272. END NoteCProc;
  273. PROCEDURE NoteProcNode (n: AST.Node);
  274. (* Records the proc-table index in the NkProcDecl's ty field, so
  275. LowerDecls can find the exact entry. FindProc(name) would return the
  276. last duplicate (e.g. the two nested `Sep`s), giving the wrong uid and
  277. the wrong scope for its locals. *)
  278. BEGIN
  279. IF nProcs > 0 THEN AST.SetTy(n, VAL(INTEGER, nProcs - 1)) END
  280. END NoteProcNode;
  281. PROCEDURE ProcInfoIdx (pi: INTEGER; VAR uid: CARDINAL;
  282. VAR res: SymTab.TypeIndex; VAR depth: CARDINAL;
  283. VAR ext: BOOLEAN; VAR npar: CARDINAL): BOOLEAN;
  284. BEGIN
  285. IF (pi < 0) OR (pi >= VAL(INTEGER, nProcs)) THEN RETURN FALSE END;
  286. uid := procUid[pi]; res := procRes[pi]; depth := procDep[pi];
  287. ext := procExt[pi]; npar := procNpar[pi];
  288. IF npar > MaxPar THEN npar := MaxPar END;
  289. RETURN TRUE
  290. END ProcInfoIdx;
  291. PROCEDURE ParamInfoIdx (pi: INTEGER; i: CARDINAL;
  292. VAR t: SymTab.TypeIndex; VAR isVar: BOOLEAN;
  293. VAR pn: ARRAY OF CHAR): BOOLEAN;
  294. BEGIN
  295. IF (pi < 0) OR (pi >= MaxProc)
  296. OR (i >= procNpar[pi]) OR (procNpar[pi] > MaxPar) THEN
  297. RETURN FALSE
  298. END;
  299. t := parTy[VAL(CARDINAL, pi) * MaxPar + i];
  300. isVar := parVar[VAL(CARDINAL, pi) * MaxPar + i];
  301. CopySpan(parName, pn, VAL(CARDINAL, pi) * MaxPar * 64 + i * 64, 0);
  302. RETURN TRUE
  303. END ParamInfoIdx;
  304. PROCEDURE SetProcRes (t: SymTab.TypeIndex);
  305. BEGIN
  306. IF nProcs > 0 THEN procRes[nProcs - 1] := t END
  307. END SetProcRes;
  308. PROCEDURE NoteParam (name: ARRAY OF CHAR; t: SymTab.TypeIndex; isVar: BOOLEAN);
  309. VAR j: CARDINAL;
  310. BEGIN
  311. IF nProcs = 0 THEN RETURN END;
  312. j := procNpar[nProcs - 1];
  313. IF j >= MaxPar THEN RETURN END;
  314. CopySpan(name, parName, 0, (nProcs - 1) * MaxPar * 64 + j * 64);
  315. parTy[(nProcs - 1) * MaxPar + j] := t;
  316. parVar[(nProcs - 1) * MaxPar + j] := isVar;
  317. procNpar[nProcs - 1] := j + 1
  318. END NoteParam;
  319. PROCEDURE NameEq (i: CARDINAL; name: ARRAY OF CHAR): BOOLEAN;
  320. VAR j: CARDINAL;
  321. BEGIN
  322. j := 0;
  323. WHILE (j < MaxName) AND (name[j] # CHR(0)) DO
  324. IF symName[i * 64 + j] # name[j] THEN RETURN FALSE END;
  325. INC(j)
  326. END;
  327. RETURN symName[i * 64 + j] = name[j]
  328. END NameEq;
  329. PROCEDURE FindSym (name: ARRAY OF CHAR; VAR kind: INTEGER;
  330. VAR t: SymTab.TypeIndex): BOOLEAN;
  331. (* Locals/params of the emitted procedure (and its enclosing procedures)
  332. shadow module-level symbols, so walk the scope chain innermost-first
  333. and only then fall back to the hash for a module-level symbol. *)
  334. VAR i: INTEGER; owner: INTEGER;
  335. BEGIN
  336. owner := emitProc;
  337. WHILE owner >= 0 DO
  338. (* procSymTop is unset for headings that never ScopeLeave (class
  339. method declarations); fall back to the whole table then. *)
  340. IF procSymTop[owner] > 0 THEN
  341. i := VAL(INTEGER, procSymTop[owner]) - 1
  342. ELSE i := VAL(INTEGER, nSyms) - 1
  343. END;
  344. WHILE i >= VAL(INTEGER, procSymBase[owner]) DO
  345. IF (symOwner[i] = owner) AND NameEq(VAL(CARDINAL, i), name) THEN
  346. kind := symKind[i]; t := symTy[i]; RETURN TRUE
  347. END;
  348. DEC(i)
  349. END;
  350. owner := procParent[owner]
  351. END;
  352. i := HashGet(symHash, symName, name);
  353. IF (i >= 0) AND (symOwner[i] = -1) THEN
  354. kind := symKind[i]; t := symTy[i]; RETURN TRUE
  355. END;
  356. RETURN FALSE
  357. END FindSym;
  358. PROCEDURE GetConstVal (name: ARRAY OF CHAR; VAR v: ARRAY OF CHAR): BOOLEAN;
  359. VAR i: INTEGER;
  360. BEGIN
  361. i := HashGet(symHash, symName, name);
  362. IF (i >= 0) AND (symKind[i] = SymTab.KindConst) THEN
  363. CopySpan(symVal, v, VAL(CARDINAL, i) * 64, 0);
  364. IF v[0] # CHR(0) THEN RETURN TRUE END
  365. END;
  366. (* a literal propagated with its enum type lives only in SymTab *)
  367. v[0] := CHR(0);
  368. RETURN SymTab.GetSymVal(name, v)
  369. END GetConstVal;
  370. PROCEDURE SetConstVal (name: ARRAY OF CHAR; val: ARRAY OF CHAR);
  371. (* Refresh a CONST's recorded value after Lower re-emits its aggregate
  372. constructor (the grammar's value was suppressed under NoEmit). *)
  373. VAR i: INTEGER;
  374. BEGIN
  375. i := HashGet(symHash, symName, name);
  376. IF i >= 0 THEN CopySpan(val, symVal, 0, VAL(CARDINAL, i) * 64) END
  377. END SetConstVal;
  378. PROCEDURE ProcNameEq (i: CARDINAL; name: ARRAY OF CHAR): BOOLEAN;
  379. VAR j: CARDINAL;
  380. BEGIN
  381. j := 0;
  382. WHILE (j < MaxName) AND (name[j] # CHR(0)) DO
  383. IF procName[i * 64 + j] # name[j] THEN RETURN FALSE END;
  384. INC(j)
  385. END;
  386. RETURN procName[i * 64 + j] = name[j]
  387. END ProcNameEq;
  388. PROCEDURE ProcVisible (i: INTEGER): BOOLEAN;
  389. (* TRUE when proc i is nested directly in the emitted procedure or one
  390. of its enclosing procedures (or is module-level). *)
  391. VAR owner: INTEGER;
  392. BEGIN
  393. owner := emitProc;
  394. WHILE owner >= 0 DO
  395. IF procParent[i] = owner THEN RETURN TRUE END;
  396. owner := procParent[owner]
  397. END;
  398. RETURN procParent[i] = -1
  399. END ProcVisible;
  400. PROCEDURE ImpNameEq (i: CARDINAL; name: ARRAY OF CHAR): BOOLEAN;
  401. BEGIN
  402. RETURN SpanEq(impName, i * 64, name)
  403. END ImpNameEq;
  404. PROCEDURE FindProc (name: ARRAY OF CHAR): INTEGER;
  405. (* Scope-aware: a nested procedure (e.g. one of two `Sep`s) must resolve
  406. to the one in the emitted procedure's chain, not the last duplicate.
  407. The current unit's imports win over any same-named proc. *)
  408. VAR i: INTEGER; owner: INTEGER;
  409. BEGIN
  410. i := 0;
  411. WHILE i < VAL(INTEGER, nImps) DO
  412. IF ImpNameEq(VAL(CARDINAL, i), name) THEN RETURN impProc[i] END;
  413. INC(i)
  414. END;
  415. i := HashGet(procHash, procName, name);
  416. IF (i >= 0) AND ProcVisible(i) THEN RETURN i END;
  417. owner := emitProc;
  418. WHILE owner >= 0 DO
  419. i := VAL(INTEGER, nProcs) - 1;
  420. WHILE i > 0 DO
  421. DEC(i);
  422. IF (procParent[i] = owner) AND ProcNameEq(VAL(CARDINAL, i), name) THEN
  423. RETURN i
  424. END
  425. END;
  426. owner := procParent[owner]
  427. END;
  428. i := VAL(INTEGER, nProcs) - 1;
  429. WHILE i > 0 DO
  430. DEC(i);
  431. IF (procParent[i] = -1) AND ProcNameEq(VAL(CARDINAL, i), name) THEN
  432. RETURN i
  433. END
  434. END;
  435. RETURN -1
  436. END FindProc;
  437. PROCEDURE FindProcByUid (uid: CARDINAL): INTEGER;
  438. (* Exact proc entry for a module-qualified call (M.P): the base name may
  439. be duplicated across modules, but the uid is unique. *)
  440. VAR i: INTEGER;
  441. BEGIN
  442. i := VAL(INTEGER, nProcs);
  443. WHILE i > 0 DO
  444. DEC(i);
  445. IF procUid[i] = uid THEN RETURN i END
  446. END;
  447. RETURN -1
  448. END FindProcByUid;
  449. PROCEDURE NoteImportedProc (name: ARRAY OF CHAR);
  450. (* FROM M IMPORT P (a procedure): remember the exact proc entry so an
  451. unqualified call resolves to the imported proc, not a same-named
  452. proc declared in another module. Reset at each unit. *)
  453. VAR pi: INTEGER;
  454. BEGIN
  455. IF SymTab.SymKind(name) # SymTab.KindProc THEN RETURN END;
  456. pi := FindProcByUid(SymTab.ProcUid(name));
  457. IF pi < 0 THEN RETURN END;
  458. IF nImps >= MaxImp THEN RETURN END;
  459. impProc[nImps] := pi;
  460. CopySpan(name, impName, 0, nImps * 64);
  461. INC(nImps)
  462. END NoteImportedProc;
  463. PROCEDURE Resolve (nm: ARRAY OF CHAR; VAR k: INTEGER;
  464. VAR t: SymTab.TypeIndex): BOOLEAN;
  465. VAR kind: INTEGER; ti: SymTab.TypeIndex;
  466. BEGIN
  467. IF FindSym(nm, kind, ti) THEN k := kind; t := ti; RETURN TRUE END;
  468. IF SymTab.Lookup(nm) THEN k := SymTab.SymKind(nm); t := SymTab.SymType(nm);
  469. RETURN TRUE
  470. END;
  471. (* A bare procedure used as a value: it lives in the proc table.
  472. Sibling method names must fall through so LowerDesign can bind
  473. THIS, so exclude methods of the open class implementation. *)
  474. IF FindProc(nm) >= 0 THEN
  475. IF (curImplCls = SymTab.InvalidType)
  476. OR NOT SymTab.MethodExists(curImplCls, nm) THEN
  477. k := SymTab.KindProc; t := SymTab.InvalidType; RETURN TRUE
  478. END
  479. END;
  480. RETURN FALSE
  481. END Resolve;
  482. PROCEDURE ProcInfo (nm: ARRAY OF CHAR; VAR uid: CARDINAL;
  483. VAR res: SymTab.TypeIndex; VAR depth: CARDINAL;
  484. VAR ext: BOOLEAN; VAR npar: CARDINAL): BOOLEAN;
  485. VAR i: INTEGER;
  486. BEGIN
  487. i := FindProc(nm);
  488. IF (i < 0) OR (i >= MaxProc) THEN RETURN FALSE END;
  489. uid := procUid[i]; res := procRes[i]; depth := procDep[i];
  490. ext := procExt[i]; npar := procNpar[i];
  491. IF npar > MaxPar THEN npar := MaxPar END;
  492. RETURN TRUE
  493. END ProcInfo;
  494. PROCEDURE ParamInfo (nm: ARRAY OF CHAR; i: CARDINAL;
  495. VAR t: SymTab.TypeIndex; VAR isVar: BOOLEAN;
  496. VAR pn: ARRAY OF CHAR): BOOLEAN;
  497. VAR k: INTEGER;
  498. BEGIN
  499. k := FindProc(nm);
  500. IF (k < 0) OR (k >= MaxProc) THEN RETURN FALSE END;
  501. IF (i >= procNpar[k]) OR (procNpar[k] > MaxPar) THEN RETURN FALSE END;
  502. t := parTy[VAL(CARDINAL, k) * MaxPar + i];
  503. isVar := parVar[VAL(CARDINAL, k) * MaxPar + i];
  504. CopySpan(parName, pn, VAL(CARDINAL, k) * MaxPar * 64 + i * 64, 0);
  505. RETURN TRUE
  506. END ParamInfo;
  507. PROCEDURE WithField (nm: ARRAY OF CHAR; VAR k: INTEGER;
  508. VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal): BOOLEAN;
  509. (* Resolves a bare ident as a field of an open WITH record (innermost
  510. first), leaving the field address in q and k=KindField. *)
  511. VAR wt: CARDINAL; fo: INTEGER; qb: QbeGen.QVal;
  512. BEGIN
  513. wt := withTop;
  514. WHILE wt > 0 DO
  515. DEC(wt);
  516. IF SymTab.FieldExists(withRec[wt], nm) THEN
  517. t := SymTab.FieldType(withRec[wt], nm);
  518. fo := SymTab.FieldOffset(withRec[wt], nm);
  519. k := SymTab.KindField;
  520. IF QbeGen.TopWith(qb) THEN QbeGen.FieldAddr(qb, fo, q)
  521. ELSE QbeGen.CopyOp("0", q)
  522. END;
  523. RETURN TRUE
  524. END
  525. END;
  526. RETURN FALSE
  527. END WithField;
  528. PROCEDURE Name (n: AST.Node; VAR s: ARRAY OF CHAR);
  529. BEGIN
  530. IF n = AST.NoNode THEN s[0] := CHR(0)
  531. ELSE AST.Txt(AST.Child(n, 0), s)
  532. END
  533. END Name;
  534. (* ---------------- compile-time set constants ----------------
  535. A SET CONST's value must be static data. Set literals are emitted as
  536. runtime temporaries, so the grammar computes the bit mask here (where
  537. the element expressions are already validated) and Lower re-emits it
  538. as a pooled descriptor (`QbeGen.PoolSet`). Only masks up to MaxCFoldW
  539. words (512 bits) are folded; a wider SET CONST stays a clear 230. *)
  540. PROCEDURE Pow2 (b: INTEGER): CARDINAL;
  541. VAR p: CARDINAL; k: INTEGER;
  542. BEGIN
  543. p := 1; k := 0;
  544. WHILE k < b DO p := p * 2; INC(k) END;
  545. RETURN p
  546. END Pow2;
  547. PROCEDURE MaskZero (VAR mask: ARRAY OF CARDINAL; words: CARDINAL);
  548. VAR i: CARDINAL;
  549. BEGIN
  550. i := 0;
  551. WHILE (i < words) AND (i <= HIGH(mask)) DO mask[i] := 0; INC(i) END
  552. END MaskZero;
  553. PROCEDURE MaskSetBit (VAR mask: ARRAY OF CARDINAL; bit: INTEGER);
  554. VAR w, b: INTEGER; p: CARDINAL; idx: CARDINAL;
  555. BEGIN
  556. IF (bit < 0) OR (bit >= VAL(INTEGER, MaxCFoldW) * 32) THEN RETURN END;
  557. w := bit DIV 32; b := bit MOD 32;
  558. IF w > VAL(INTEGER, HIGH(mask)) THEN RETURN END;
  559. idx := VAL(CARDINAL, w); p := Pow2(b);
  560. IF (mask[idx] DIV p) MOD 2 = 0 THEN mask[idx] := mask[idx] + p END
  561. END MaskSetBit;
  562. PROCEDURE MaskGetBit (VAR mask: ARRAY OF CARDINAL; bit: INTEGER): INTEGER;
  563. VAR w, b: INTEGER; p: CARDINAL;
  564. BEGIN
  565. IF (bit < 0) OR (bit >= VAL(INTEGER, MaxCFoldW) * 32) THEN RETURN 0 END;
  566. w := bit DIV 32; b := bit MOD 32;
  567. IF w > VAL(INTEGER, HIGH(mask)) THEN RETURN 0 END;
  568. p := Pow2(b);
  569. IF (mask[VAL(CARDINAL, w)] DIV p) MOD 2 = 1 THEN RETURN 1 END;
  570. RETURN 0
  571. END MaskGetBit;
  572. PROCEDURE EvalOrdConst (n: AST.Node; VAR v: INTEGER): BOOLEAN;
  573. (* The integer value of a compile-time ordinal expression, matching the
  574. grammar's folding (literals, named CONSTs, unary +/-, + - * DIV MOD). *)
  575. VAR k: INTEGER; s, cv: QbeGen.QVal; nm, qnm, al: SymTab.Name;
  576. a, b: INTEGER; isCh: BOOLEAN;
  577. BEGIN
  578. IF n = AST.NoNode THEN RETURN FALSE END;
  579. k := AST.Kind(n);
  580. IF k = AST.NkIntLit THEN
  581. Name(n, s); QbeGen.NormInt(s, cv); RETURN SymTab.ConstInt(cv, v)
  582. ELSIF k = AST.NkCharLit THEN
  583. Name(n, s);
  584. IF (s[0] = "'") OR (s[0] = '"') THEN
  585. v := QbeGen.CharVal(s); RETURN TRUE
  586. END;
  587. QbeGen.NormLit(s, cv, isCh); RETURN SymTab.ConstInt(cv, v)
  588. ELSIF k = AST.NkStrLit THEN
  589. (* a 1-character string literal "c" is a CHAR constant *)
  590. Name(n, s);
  591. IF SymTab.StrLen(s) = 3 THEN v := QbeGen.CharVal(s); RETURN TRUE END;
  592. RETURN FALSE
  593. ELSIF k = AST.NkDesignator THEN
  594. IF (AST.NChild(n) = 1) AND (AST.Kind(AST.Child(n, 0)) = AST.NkIdent) THEN
  595. Name(AST.Child(n, 0), nm);
  596. IF SymTab.Equal(nm, "TRUE") THEN v := 1; RETURN TRUE END;
  597. IF SymTab.Equal(nm, "FALSE") THEN v := 0; RETURN TRUE END;
  598. IF SymTab.Lookup(nm) AND (SymTab.SymKind(nm) = SymTab.KindConst)
  599. AND SymTab.GetSymVal(nm, cv) AND QbeGen.IsImm(cv) THEN
  600. RETURN SymTab.ConstInt(cv, v)
  601. END;
  602. RETURN FALSE
  603. ELSIF (AST.NChild(n) = 2) AND (AST.Kind(AST.Child(n, 0)) = AST.NkIdent)
  604. AND (AST.Kind(AST.Child(n, 1)) = AST.NkSelector)
  605. AND (AST.Op(AST.Child(n, 1)) = AST.SelField) THEN
  606. (* M.lit: a module-qualified constant (enum literal / CONST) *)
  607. Name(AST.Child(n, 0), nm);
  608. Name(AST.Child(AST.Child(n, 1), 0), qnm);
  609. IF SymTab.MaterializeAlias(nm, qnm, al)
  610. AND SymTab.GetSymVal(al, cv) AND QbeGen.IsImm(cv) THEN
  611. RETURN SymTab.ConstInt(cv, v)
  612. END;
  613. RETURN FALSE
  614. END;
  615. RETURN FALSE
  616. ELSIF k = AST.NkUnary THEN
  617. IF AST.Op(n) = AST.OpSub THEN
  618. IF EvalOrdConst(AST.Child(n, 0), v) THEN v := -v; RETURN TRUE END
  619. ELSIF AST.Op(n) = AST.OpAdd THEN
  620. RETURN EvalOrdConst(AST.Child(n, 0), v)
  621. END;
  622. RETURN FALSE
  623. ELSIF k = AST.NkBinExpr THEN
  624. IF EvalOrdConst(AST.Child(n, 0), a)
  625. AND EvalOrdConst(AST.Child(n, 1), b) THEN
  626. IF AST.Op(n) = AST.OpAdd THEN v := a + b
  627. ELSIF AST.Op(n) = AST.OpSub THEN v := a - b
  628. ELSIF AST.Op(n) = AST.OpMul THEN v := a * b
  629. ELSIF AST.Op(n) = AST.OpDiv THEN
  630. IF b = 0 THEN RETURN FALSE END; v := a DIV b
  631. ELSIF AST.Op(n) = AST.OpMod THEN
  632. IF b = 0 THEN RETURN FALSE END; v := a MOD b
  633. ELSE RETURN FALSE
  634. END;
  635. RETURN TRUE
  636. END;
  637. RETURN FALSE
  638. END;
  639. RETURN FALSE
  640. END EvalOrdConst;
  641. PROCEDURE EvalSetElem (el: AST.Node; VAR mask: ARRAY OF CARDINAL;
  642. lo: INTEGER; span: CARDINAL): BOOLEAN;
  643. VAR a, b: INTEGER;
  644. BEGIN
  645. IF AST.Kind(el) = AST.NkSubrange THEN
  646. IF NOT EvalOrdConst(AST.Child(el, 0), a)
  647. OR NOT EvalOrdConst(AST.Child(el, 1), b) THEN RETURN FALSE END;
  648. IF (a < lo) OR (b < lo) OR (a > b)
  649. OR (b >= lo + VAL(INTEGER, span)) THEN RETURN FALSE END;
  650. WHILE a <= b DO MaskSetBit(mask, a - lo); INC(a) END;
  651. RETURN TRUE
  652. END;
  653. IF NOT EvalOrdConst(el, a) THEN RETURN FALSE END;
  654. IF (a < lo) OR (a >= lo + VAL(INTEGER, span)) THEN RETURN FALSE END;
  655. MaskSetBit(mask, a - lo);
  656. RETURN TRUE
  657. END EvalSetElem;
  658. PROCEDURE NoteSetMask (name: ARRAY OF CHAR; mask: ARRAY OF CARDINAL;
  659. words: CARDINAL; lo: INTEGER);
  660. VAR i: CARDINAL;
  661. BEGIN
  662. IF cfoldN >= MaxCFold THEN RETURN END;
  663. CopySpan(name, cfoldName, 0, cfoldN * 64);
  664. cfoldW[cfoldN] := words; cfoldLo[cfoldN] := lo;
  665. i := 0;
  666. WHILE i < MaxCFoldW DO
  667. IF (i < words) AND (i <= HIGH(mask)) THEN
  668. cfoldMask[cfoldN * MaxCFoldW + i] := mask[i]
  669. ELSE cfoldMask[cfoldN * MaxCFoldW + i] := 0
  670. END;
  671. INC(i)
  672. END;
  673. INC(cfoldN)
  674. END NoteSetMask;
  675. PROCEDURE LookupSetMask (name: ARRAY OF CHAR; VAR mask: ARRAY OF CARDINAL;
  676. VAR words: CARDINAL; VAR lo: INTEGER): BOOLEAN;
  677. VAR i: INTEGER; k: CARDINAL;
  678. BEGIN
  679. i := VAL(INTEGER, cfoldN) - 1;
  680. WHILE i >= 0 DO
  681. IF SpanEq(cfoldName, VAL(CARDINAL, i) * 64, name) THEN
  682. words := cfoldW[i]; lo := cfoldLo[i];
  683. k := 0;
  684. WHILE (k < words) AND (k <= HIGH(mask)) DO
  685. mask[k] := cfoldMask[VAL(CARDINAL, i) * MaxCFoldW + k]; INC(k)
  686. END;
  687. RETURN TRUE
  688. END;
  689. DEC(i)
  690. END;
  691. RETURN FALSE
  692. END LookupSetMask;
  693. PROCEDURE EvalSetConst (n: AST.Node; VAR mask: ARRAY OF CARDINAL;
  694. VAR words: CARDINAL; VAR lo: INTEGER): BOOLEAN;
  695. VAR k, i, a, b, r: INTEGER;
  696. t: SymTab.TypeIndex;
  697. span: CARDINAL;
  698. seq, el, next: AST.Node;
  699. m1, m2: ARRAY [0 .. MaxCFoldW - 1] OF CARDINAL;
  700. w1, w2: CARDINAL;
  701. l1, l2: INTEGER;
  702. op: INTEGER;
  703. nm: SymTab.Name;
  704. BEGIN
  705. IF n = AST.NoNode THEN RETURN FALSE END;
  706. k := AST.Kind(n);
  707. IF (k = AST.NkSetLit) OR (k = AST.NkBraceLit) THEN
  708. t := AST.Ty(n);
  709. IF (k = AST.NkBraceLit) AND (SymTab.ClassOf(t) # SymTab.ClSet) THEN
  710. RETURN FALSE
  711. END;
  712. IF t = SymTab.InvalidType THEN
  713. lo := 0; words := 8; span := 256
  714. ELSE
  715. lo := SymTab.SetBaseLo(t); words := SymTab.SetWords(t);
  716. span := SymTab.SetCount(t);
  717. IF words = 0 THEN words := 8; span := 256; lo := 0 END
  718. END;
  719. IF words > MaxCFoldW THEN RETURN FALSE END;
  720. MaskZero(mask, words);
  721. IF k = AST.NkSetLit THEN
  722. i := 0;
  723. WHILE i < VAL(INTEGER, AST.NChild(n)) DO
  724. el := AST.Child(n, VAL(CARDINAL, i));
  725. IF NOT EvalSetElem(el, mask, lo, span) THEN RETURN FALSE END;
  726. INC(i)
  727. END
  728. ELSE
  729. seq := n;
  730. WHILE seq # AST.NoNode DO
  731. i := 0;
  732. WHILE i < VAL(INTEGER, AST.NChild(seq)) DO
  733. el := AST.Child(seq, VAL(CARDINAL, i));
  734. IF AST.Kind(el) # AST.NkBlock THEN
  735. IF NOT EvalSetElem(el, mask, lo, span) THEN RETURN FALSE END
  736. END;
  737. INC(i)
  738. END;
  739. next := AST.NoNode;
  740. IF AST.NChild(seq) > 0 THEN
  741. next := AST.Child(seq, AST.NChild(seq) - 1);
  742. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  743. END;
  744. seq := next
  745. END
  746. END;
  747. RETURN TRUE
  748. ELSIF k = AST.NkDesignator THEN
  749. IF (AST.NChild(n) # 1) OR (AST.Kind(AST.Child(n, 0)) # AST.NkIdent) THEN
  750. RETURN FALSE END;
  751. Name(AST.Child(n, 0), nm);
  752. RETURN LookupSetMask(nm, mask, words, lo)
  753. ELSIF k = AST.NkBinExpr THEN
  754. op := AST.Op(n);
  755. IF (op # AST.OpAdd) AND (op # AST.OpSub)
  756. AND (op # AST.OpMul) AND (op # AST.OpDiv) THEN
  757. RETURN FALSE END;
  758. IF NOT EvalSetConst(AST.Child(n, 0), m1, w1, l1)
  759. OR NOT EvalSetConst(AST.Child(n, 1), m2, w2, l2) THEN
  760. RETURN FALSE END;
  761. IF l1 # l2 THEN RETURN FALSE END;
  762. lo := l1;
  763. words := w1; IF w2 > words THEN words := w2 END;
  764. IF words > MaxCFoldW THEN RETURN FALSE END;
  765. MaskZero(mask, words);
  766. i := 0;
  767. WHILE i < VAL(INTEGER, words) * 32 DO
  768. a := MaskGetBit(m1, i); b := MaskGetBit(m2, i);
  769. IF op = AST.OpAdd THEN r := a; IF b = 1 THEN r := 1 END
  770. ELSIF op = AST.OpMul THEN
  771. IF (a = 1) AND (b = 1) THEN r := 1 ELSE r := 0 END
  772. ELSIF op = AST.OpSub THEN r := a; IF b = 1 THEN r := 0 END
  773. ELSE r := (a + b) MOD 2
  774. END;
  775. IF r # 0 THEN MaskSetBit(mask, i) END;
  776. INC(i)
  777. END;
  778. RETURN TRUE
  779. END;
  780. RETURN FALSE
  781. END EvalSetConst;
  782. PROCEDURE SetConstMaskOf (n: AST.Node; VAR mask: ARRAY OF CARDINAL;
  783. VAR words: CARDINAL; VAR lo: INTEGER): BOOLEAN;
  784. BEGIN
  785. words := 0; lo := 0;
  786. RETURN EvalSetConst(n, mask, words, lo)
  787. END SetConstMaskOf;
  788. PROCEDURE ParamName (proc: ARRAY OF CHAR; i: CARDINAL;
  789. VAR s: ARRAY OF CHAR);
  790. VAR t: SymTab.TypeIndex; isV: BOOLEAN;
  791. BEGIN
  792. IF NOT ParamInfo(proc, i, t, isV, s) THEN s[0] := CHR(0) END
  793. END ParamName;
  794. PROCEDURE IsArith (op: INTEGER): BOOLEAN;
  795. BEGIN
  796. RETURN (op = AST.OpAdd) OR (op = AST.OpSub) OR (op = AST.OpMul)
  797. OR (op = AST.OpDiv) OR (op = AST.OpMod)
  798. END IsArith;
  799. PROCEDURE IsRel (op: INTEGER): BOOLEAN;
  800. BEGIN
  801. RETURN ((op >= AST.OpEq) AND (op <= AST.OpGe)) OR (op = AST.OpIn)
  802. END IsRel;
  803. PROCEDURE RelSym (a: INTEGER; VAR s: INTEGER): BOOLEAN;
  804. BEGIN
  805. IF a = AST.OpEq THEN s := SymTab.OpEq
  806. ELSIF a = AST.OpNe THEN s := SymTab.OpNeq1
  807. ELSIF a = AST.OpLt THEN s := SymTab.OpLt
  808. ELSIF a = AST.OpLe THEN s := SymTab.OpLe
  809. ELSIF a = AST.OpGt THEN s := SymTab.OpGt
  810. ELSIF a = AST.OpGe THEN s := SymTab.OpGe
  811. ELSE RETURN FALSE
  812. END;
  813. RETURN TRUE
  814. END RelSym;
  815. PROCEDURE IsScalarClass (cls: INTEGER): BOOLEAN;
  816. BEGIN
  817. RETURN (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
  818. OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
  819. OR (cls = SymTab.ClEnum)
  820. END IsScalarClass;
  821. PROCEDURE IsSimpleScalar (n: AST.Node): BOOLEAN;
  822. VAR nm: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  823. BEGIN
  824. IF (AST.Kind(n) # AST.NkDesignator) OR (AST.NChild(n) # 1) THEN
  825. RETURN FALSE END;
  826. IF AST.Kind(AST.Child(n, 0)) # AST.NkIdent THEN RETURN FALSE END;
  827. Name(AST.Child(n, 0), nm);
  828. IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
  829. IF (k # SymTab.KindVar) AND (k # SymTab.KindParam)
  830. AND (k # SymTab.KindConst) THEN
  831. RETURN FALSE END;
  832. IF SymTab.Equal(nm, "TRUE") OR SymTab.Equal(nm, "FALSE") THEN
  833. RETURN TRUE END;
  834. RETURN IsScalarClass(SymTab.ClassOf(t))
  835. END IsSimpleScalar;
  836. PROCEDURE CalleeName (call: AST.Node; VAR nm: SymTab.Name);
  837. (* The callee of NkCall: child 0 is a designator (or bare ident). *)
  838. VAR d: AST.Node;
  839. BEGIN
  840. nm[0] := CHR(0);
  841. d := AST.Child(call, 0);
  842. IF d = AST.NoNode THEN RETURN END;
  843. IF AST.Kind(d) = AST.NkDesignator THEN d := AST.Child(d, 0) END;
  844. IF (d # AST.NoNode) AND (AST.Kind(d) = AST.NkIdent) THEN Name(d, nm) END
  845. END CalleeName;
  846. PROCEDURE CallResultType (call: AST.Node; VAR t: SymTab.TypeIndex): BOOLEAN;
  847. (* The result type of a call used as a designator base (F().M()). *)
  848. VAR nm: SymTab.Name; uid, depth, np: CARDINAL; res: SymTab.TypeIndex;
  849. ext: BOOLEAN; pi: INTEGER;
  850. BEGIN
  851. t := SymTab.InvalidType;
  852. CalleeName(call, nm);
  853. pi := FindProc(nm);
  854. IF pi >= 0 THEN
  855. IF ProcInfoIdx(pi, uid, res, depth, ext, np) THEN t := res; RETURN TRUE END;
  856. RETURN FALSE
  857. END;
  858. IF SymTab.Lookup(nm) AND (SymTab.SymKind(nm) = SymTab.KindProc) THEN
  859. t := SymTab.ProcRes(nm); RETURN TRUE
  860. END;
  861. RETURN FALSE
  862. END CallResultType;
  863. PROCEDURE IsMethodCall (n: AST.Node): BOOLEAN;
  864. (* n is a call whose callee resolves to a class method: `obj.Method`,
  865. `p^.Method`, or a bare sibling name inside an implementation. *)
  866. VAR d, sel: AST.Node; nm, fn: SymTab.Name; k: INTEGER; t: SymTab.TypeIndex;
  867. i: CARDINAL;
  868. BEGIN
  869. IF (AST.Kind(n) # AST.NkCall) OR (AST.NChild(n) < 1) THEN RETURN FALSE END;
  870. d := AST.Child(n, 0);
  871. IF AST.Kind(d) # AST.NkDesignator THEN RETURN FALSE END;
  872. IF AST.NChild(d) = 1 THEN
  873. (* bare name: a sibling method inside a class implementation? *)
  874. Name(AST.Child(d, 0), nm);
  875. RETURN (curImplCls # SymTab.InvalidType)
  876. AND SymTab.MethodExists(curImplCls, nm)
  877. END;
  878. IF AST.Kind(AST.Child(d, 0)) = AST.NkCall THEN
  879. (* F().M(): the base is a call; take its result type *)
  880. IF NOT CallResultType(AST.Child(d, 0), t) THEN RETURN FALSE END
  881. ELSE
  882. Name(AST.Child(d, 0), nm);
  883. IF NOT Resolve(nm, k, t) THEN RETURN FALSE END
  884. END;
  885. i := 1;
  886. WHILE i < AST.NChild(d) DO
  887. sel := AST.Child(d, i);
  888. IF AST.Op(sel) = AST.SelField THEN
  889. Name(AST.Child(sel, 0), fn);
  890. IF (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClClass)
  891. AND SymTab.MethodExists(t, fn) THEN
  892. RETURN i = AST.NChild(d) - 1
  893. END;
  894. IF (t = SymTab.InvalidType) OR NOT SymTab.FieldExists(t, fn) THEN
  895. RETURN FALSE
  896. END;
  897. t := SymTab.FieldType(t, fn)
  898. ELSIF AST.Op(sel) = AST.SelIndex THEN
  899. IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClArray) THEN
  900. RETURN FALSE
  901. END;
  902. t := SymTab.ArrayElem(t)
  903. ELSIF AST.Op(sel) = AST.SelDeref THEN
  904. IF (t = SymTab.InvalidType) OR (SymTab.ClassOf(t) # SymTab.ClPtr) THEN
  905. RETURN FALSE
  906. END;
  907. t := SymTab.PtrBase(t)
  908. ELSE RETURN FALSE
  909. END;
  910. INC(i)
  911. END;
  912. RETURN FALSE
  913. END IsMethodCall;
  914. PROCEDURE CalleeAlias (call: AST.Node; VAR mal: SymTab.Name): BOOLEAN;
  915. (* Callee is `M.P` (module-qualified): materialize the export alias. *)
  916. VAR d, sel: AST.Node; nm, fn, al: SymTab.Name; k: INTEGER;
  917. t: SymTab.TypeIndex;
  918. BEGIN
  919. d := AST.Child(call, 0);
  920. IF (AST.Kind(d) # AST.NkDesignator) OR (AST.NChild(d) # 2) THEN
  921. RETURN FALSE
  922. END;
  923. sel := AST.Child(d, 1);
  924. IF AST.Op(sel) # AST.SelField THEN RETURN FALSE END;
  925. Name(AST.Child(d, 0), nm);
  926. IF NOT Resolve(nm, k, t) THEN RETURN FALSE END;
  927. IF k # SymTab.KindModule THEN RETURN FALSE END;
  928. Name(AST.Child(sel, 0), fn);
  929. IF NOT SymTab.MaterializeAlias(nm, fn, al) THEN RETURN FALSE END;
  930. (* Lower's proc table is keyed by the base name (the mangled symbol
  931. is <base>_<uid>), so return fn, not the materialized alias. The
  932. uid comes from the alias, which is module-exact. *)
  933. qualIsVar := SymTab.SymKind(al) # SymTab.KindProc;
  934. qualUid := SymTab.ProcUid(al);
  935. CopyN(fn, mal);
  936. RETURN TRUE
  937. END CalleeAlias;
  938. PROCEDURE FinalLoad (t: SymTab.TypeIndex; sfx: BOOLEAN; VAR q: QbeGen.QVal);
  939. (* Fact's final load after a designator/result suffix: scalars/pointers
  940. are loaded from their address; aggregates keep the address. *)
  941. VAR cls: INTEGER; q2: QbeGen.QVal;
  942. BEGIN
  943. IF NOT sfx THEN RETURN END;
  944. IF t = SymTab.InvalidType THEN QbeGen.CopyOp("0", q); RETURN END;
  945. cls := SymTab.ClassOf(t);
  946. IF (cls # SymTab.ClRecord) AND (cls # SymTab.ClSet)
  947. AND (cls # SymTab.ClArray) AND (cls # SymTab.ClClass) THEN
  948. QbeGen.ElemLoad(q, t, q2); QbeGen.CopyOp(q2, q)
  949. END
  950. END FinalLoad;
  951. PROCEDURE LowerDesign (n: AST.Node; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  952. VAR q: QbeGen.QVal; VAR qn: SymTab.Name;
  953. VAR sfx: BOOLEAN);
  954. (* Base ident then selectors (mirrors the grammar's Design). Leaves the
  955. address in q with sfx=TRUE for selectors; base vars/consts load. *)
  956. VAR nm, fn, mal: SymTab.Name; cv: QbeGen.QVal; cls, op: INTEGER;
  957. i: CARDINAL; sel: AST.Node; eT, it: SymTab.TypeIndex;
  958. iq, ql, qlo, qhi, qe: QbeGen.QVal;
  959. lo, hi, fo: INTEGER; isOpen: BOOLEAN;
  960. BEGIN
  961. IF AST.Kind(AST.Child(n, 0)) = AST.NkCall THEN
  962. (* a call result used as a designator base: P()^, P()^.field,
  963. A()[i]. The call yields a value (a pointer/record address);
  964. sfx=FALSE so a following ^ does not reload it. *)
  965. LowerExpr(AST.Child(n, 0), t, q);
  966. k := -1; qn[0] := CHR(0); sfx := FALSE
  967. ELSE
  968. Name(AST.Child(n, 0), nm);
  969. QbeGen.CopyOp(nm, qn);
  970. sfx := FALSE;
  971. IF NOT Resolve(nm, k, t) THEN
  972. IF WithField(nm, k, t, q) THEN
  973. sfx := TRUE
  974. ELSIF (curImplCls # SymTab.InvalidType)
  975. AND SymTab.MethodExists(curImplCls, nm) THEN
  976. (* bare sibling method name inside a class implementation *)
  977. QbeGen.ThisBase(q);
  978. QbeGen.ArmRecv(q);
  979. curMethCls := curImplCls; k := SymTab.KindProc;
  980. t := SymTab.InvalidType; sfx := FALSE
  981. ELSE
  982. t := SymTab.InvalidType; k := -1; QbeGen.CopyOp("0", q); RETURN
  983. END
  984. END;
  985. IF k = SymTab.KindConst THEN
  986. IF SymTab.Equal(nm, "TRUE") THEN
  987. t := SymTab.BoolType(); QbeGen.CopyOp("1", q)
  988. ELSIF SymTab.Equal(nm, "FALSE") THEN
  989. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  990. ELSIF SymTab.Equal(nm, "NIL") THEN
  991. QbeGen.CopyOp("0", q)
  992. ELSE
  993. cls := SymTab.ClassOf(t);
  994. IF (cls = SymTab.ClArray) OR (cls = SymTab.ClRecord)
  995. OR (cls = SymTab.ClClass) OR (cls = SymTab.ClStr)
  996. OR (cls = SymTab.ClUStr) OR (cls = SymTab.ClSet) THEN
  997. (* aggregate/string const: its value IS the descriptor address *)
  998. IF GetConstVal(nm, cv) THEN QbeGen.CopyOp(cv, q)
  999. ELSE QbeGen.CopyOp("0", q)
  1000. END
  1001. ELSIF (cls = SymTab.ClInt) OR (cls = SymTab.ClChar)
  1002. OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClLong)
  1003. OR (cls = SymTab.ClBool)
  1004. OR (cls = SymTab.ClByte) OR (cls = SymTab.ClSByte) THEN
  1005. IF GetConstVal(nm, cv) AND QbeGen.IsImm(cv) THEN
  1006. QbeGen.CopyOp(cv, q)
  1007. ELSE QbeGen.CopyOp("0", q)
  1008. END
  1009. ELSIF cls = SymTab.ClReal THEN
  1010. (* a real CONST lives in its data symbol; load it *)
  1011. QbeGen.LoadVar(nm, TRUE, q)
  1012. ELSE QbeGen.CopyOp("0", q)
  1013. END
  1014. END
  1015. ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
  1016. cls := SymTab.ClassOf(t);
  1017. IF AST.Op(n) = 1 THEN
  1018. (* a forward module-level reference: the grammar's FwdAddrOper
  1019. leaves an address (sfx=TRUE), not a loaded value *)
  1020. QbeGen.AddrOf(nm, q); sfx := TRUE
  1021. ELSIF SymTab.IsSmallInt(t) THEN
  1022. QbeGen.LoadShortVar(nm, SymTab.IsSignedSmallInt(t),
  1023. SymTab.SmallIntBytes(t), q)
  1024. ELSIF (cls = SymTab.ClInt) OR (cls = SymTab.ClBool)
  1025. OR (cls = SymTab.ClChar) OR (cls = SymTab.ClUChar)
  1026. OR (cls = SymTab.ClEnum) OR (cls = SymTab.ClReal) THEN
  1027. QbeGen.LoadVar(nm, cls = SymTab.ClReal, q)
  1028. ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc) THEN
  1029. QbeGen.LoadPtr(nm, q)
  1030. ELSIF cls = SymTab.ClLong THEN
  1031. QbeGen.LoadLong(nm, q)
  1032. ELSE QbeGen.AddrOf(nm, q)
  1033. END
  1034. ELSIF k = SymTab.KindField THEN
  1035. (* q already holds the field address (WithField) *)
  1036. ELSE QbeGen.CopyOp("0", q)
  1037. END;
  1038. END;
  1039. i := 1;
  1040. WHILE i < AST.NChild(n) DO
  1041. sel := AST.Child(n, i);
  1042. op := AST.Op(sel);
  1043. IF op = AST.SelField THEN
  1044. Name(AST.Child(sel, 0), fn);
  1045. IF k = SymTab.KindModule THEN
  1046. (* qualified L.x: materialize the export, then load it *)
  1047. IF SymTab.MaterializeAlias(nm, fn, mal) THEN
  1048. QbeGen.CopyOp(mal, qn);
  1049. t := SymTab.SymType(mal); k := SymTab.SymKind(mal); sfx := FALSE;
  1050. IF k = SymTab.KindProc THEN QbeGen.CopyOp("0", q)
  1051. ELSIF NOT QbeGen.LoadDesignator(mal, t, k, q) THEN
  1052. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1053. END
  1054. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1055. END
  1056. ELSIF t = SymTab.InvalidType THEN
  1057. ELSIF (SymTab.ClassOf(t) = SymTab.ClClass)
  1058. AND SymTab.MethodExists(t, fn) THEN
  1059. (* obj.Method: bind the receiver; the call supplies the value *)
  1060. QbeGen.ArmRecv(q);
  1061. QbeGen.CopyOp(fn, qn);
  1062. curMethCls := t; k := SymTab.KindProc; t := SymTab.InvalidType
  1063. ELSIF NOT SymTab.FieldExists(t, fn) THEN t := SymTab.InvalidType
  1064. ELSE
  1065. fo := SymTab.FieldOffset(t, fn);
  1066. t := SymTab.FieldType(t, fn);
  1067. QbeGen.FieldAddr(q, fo, qe);
  1068. QbeGen.CopyOp(qe, q);
  1069. sfx := TRUE
  1070. END
  1071. ELSIF op = AST.SelIndex THEN
  1072. LowerExpr(AST.Child(sel, 0), it, iq);
  1073. IF t = SymTab.InvalidType THEN
  1074. ELSE
  1075. QbeGen.WidenIndex(iq, ql);
  1076. isOpen := SymTab.IsOpenArray(t);
  1077. IF isOpen THEN
  1078. QbeGen.CopyOp("0", qlo);
  1079. IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN
  1080. QbeGen.OpenHiChar(q, qhi)
  1081. ELSE QbeGen.OpenHi(q, qhi)
  1082. END
  1083. ELSE
  1084. lo := SymTab.ArrayLo(t); hi := SymTab.ArrayHi(t);
  1085. IF SymTab.IsCharArray(t) OR SymTab.IsUCharArray(t) THEN
  1086. hi := hi + 1
  1087. END;
  1088. QbeGen.IntStr(lo, qlo); QbeGen.IntStr(hi, qhi)
  1089. END;
  1090. QbeGen.CheckRange(ql, qlo, qhi);
  1091. eT := SymTab.ArrayElem(t);
  1092. QbeGen.ElemAddr(q, ql, qlo, t, qe);
  1093. IF SymTab.ClassOf(eT) = SymTab.ClArray THEN
  1094. QbeGen.ElemLoad(qe, eT, q)
  1095. ELSE QbeGen.CopyOp(qe, q)
  1096. END;
  1097. t := eT; sfx := TRUE
  1098. END
  1099. ELSIF op = AST.SelDeref THEN
  1100. IF t = SymTab.InvalidType THEN
  1101. ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN t := SymTab.InvalidType
  1102. ELSE
  1103. IF sfx THEN QbeGen.ElemLoad(q, t, qe); QbeGen.CopyOp(qe, q) END;
  1104. t := SymTab.PtrBase(t); sfx := TRUE
  1105. END
  1106. END;
  1107. INC(i)
  1108. END
  1109. END LowerDesign;
  1110. PROCEDURE CompositeRes (t: SymTab.TypeIndex): BOOLEAN;
  1111. (* TRUE for a composite (by-value) function result: record/array/set.
  1112. Such results use a hidden destination pointer (sret). *)
  1113. VAR cls: INTEGER;
  1114. BEGIN
  1115. IF t = SymTab.InvalidType THEN RETURN FALSE END;
  1116. cls := SymTab.ClassOf(t);
  1117. RETURN (cls = SymTab.ClRecord) OR (cls = SymTab.ClArray)
  1118. OR (cls = SymTab.ClSet) OR (cls = SymTab.ClClass)
  1119. END CompositeRes;
  1120. PROCEDURE UserLabel (name: ARRAY OF CHAR; VAR q: QbeGen.QVal);
  1121. (* The QbeGen label for a user label/goto name (per procedure). *)
  1122. VAR i: CARDINAL;
  1123. BEGIN
  1124. i := 0;
  1125. WHILE i < nUserLab DO
  1126. IF SpanEq(userLabNm, i * 64, name) THEN q := userLabQ[i]; RETURN END;
  1127. INC(i)
  1128. END;
  1129. QbeGen.NewLabel(q);
  1130. IF nUserLab <= HIGH(userLabQ) THEN
  1131. CopySpan(name, userLabNm, 0, nUserLab * 64);
  1132. userLabQ[nUserLab] := q;
  1133. INC(nUserLab)
  1134. END
  1135. END UserLabel;
  1136. PROCEDURE LowerCall (n: AST.Node; VAR t: SymTab.TypeIndex;
  1137. VAR q: QbeGen.QVal; want: BOOLEAN);
  1138. VAR nm, pn, cqn: SymTab.Name; i, ai: CARDINAL; at, ft, res: SymTab.TypeIndex;
  1139. qa, qt, qe, mg, qres: QbeGen.QVal; conv, isV, qual, ind, isC, va: BOOLEAN;
  1140. uid, depth, np: CARDINAL; ext: BOOLEAN; ck: INTEGER; pi: INTEGER;
  1141. ct: SymTab.TypeIndex; csfx: BOOLEAN; cl: CHAR;
  1142. seq, next, arg: AST.Node;
  1143. BEGIN
  1144. qual := CalleeAlias(n, nm);
  1145. ind := FALSE; isC := FALSE; va := FALSE; pi := -1; ext := FALSE;
  1146. IF qual AND qualIsVar THEN
  1147. (* M.Error where Error is a procedure-typed variable: indirect. *)
  1148. LowerDesign(AST.Child(n, 0), ct, ck, qa, cqn, csfx);
  1149. IF (ct # SymTab.InvalidType)
  1150. AND (SymTab.ClassOf(ct) = SymTab.ClProc) THEN
  1151. ind := TRUE;
  1152. res := SymTab.ProcTypeRes(ct);
  1153. np := SymTab.ProcTypeNPar(ct);
  1154. QbeGen.CallBeginInd(qa, res, FALSE)
  1155. ELSE
  1156. res := SymTab.InvalidType;
  1157. QbeGen.CallBegin(nm, res, 0, FALSE)
  1158. END
  1159. ELSIF qual THEN
  1160. (* M.P: the base name may be duplicated across modules, so select
  1161. the exact proc entry by the alias's uid. *)
  1162. pi := FindProcByUid(qualUid);
  1163. IF ProcInfoIdx(pi, uid, res, depth, ext, np) THEN
  1164. IF ext THEN QbeGen.CopyOp(nm, mg) ELSE QbeGen.Mangled(nm, uid, mg) END;
  1165. QbeGen.CallBegin(mg, res, depth, ext)
  1166. ELSE
  1167. res := SymTab.InvalidType;
  1168. QbeGen.CallBegin(nm, res, 0, FALSE)
  1169. END
  1170. ELSE
  1171. CalleeName(n, nm);
  1172. IF FindSym(nm, ck, ct)
  1173. AND ((ck = SymTab.KindVar) OR (ck = SymTab.KindParam))
  1174. AND (SymTab.ClassOf(ct) = SymTab.ClProc) THEN
  1175. (* indirect call through a procedure-typed variable *)
  1176. ind := TRUE;
  1177. LowerDesign(AST.Child(n, 0), ct, ck, qa, cqn, csfx);
  1178. res := SymTab.ProcTypeRes(ct);
  1179. np := SymTab.ProcTypeNPar(ct);
  1180. QbeGen.CallBeginInd(qa, res, FALSE)
  1181. ELSIF ProcInfo(nm, uid, res, depth, ext, np) THEN
  1182. pi := FindProc(nm);
  1183. IF ext THEN
  1184. (* External callee: bind to its C link name (the procedure's
  1185. own name); SymTab.ProcLink cannot be consulted after
  1186. EndUnit. *)
  1187. QbeGen.CopyOp(nm, mg)
  1188. ELSE
  1189. QbeGen.Mangled(nm, uid, mg)
  1190. END;
  1191. QbeGen.CallBegin(mg, res, depth, ext)
  1192. ELSE
  1193. (* not in Lower's table: a predef C proc (SYSTEM.TRANSFER,
  1194. NEWPROCESS, ...) lives in SymTab with a C link name *)
  1195. IF SymTab.Lookup(nm) AND (SymTab.SymKind(nm) = SymTab.KindProc) THEN
  1196. isC := TRUE;
  1197. res := SymTab.ProcRes(nm);
  1198. np := SymTab.ProcNPar(nm);
  1199. IF SymTab.ProcLink(nm, pn) THEN
  1200. QbeGen.CallBegin(pn, res, 0, TRUE)
  1201. ELSE
  1202. QbeGen.CallBegin(nm, res, 0, FALSE)
  1203. END
  1204. ELSE
  1205. res := SymTab.InvalidType;
  1206. QbeGen.CallBegin(nm, res, 0, FALSE)
  1207. END
  1208. END
  1209. END;
  1210. IF CompositeRes(res) THEN
  1211. (* composite result: pass a hidden destination pointer first *)
  1212. QbeGen.AllocLocal(res, qres);
  1213. IF NOT QbeGen.CallArg(qres, "l") THEN END
  1214. END;
  1215. va := (pi >= 0) AND (pi < VAL(INTEGER, nProcs)) AND procVa[pi];
  1216. (* actuals are a chunked sequence (AstCallNode): follow the NkBlock
  1217. continuations so a call with >MaxChild-1 arguments is complete *)
  1218. ai := 0;
  1219. seq := n;
  1220. WHILE seq # AST.NoNode DO
  1221. i := 0;
  1222. IF seq = n THEN i := 1 END; (* skip the callee in the head *)
  1223. WHILE i < AST.NChild(seq) DO
  1224. arg := AST.Child(seq, i);
  1225. IF AST.Kind(arg) # AST.NkBlock THEN
  1226. LowerExpr(arg, at, qe);
  1227. IF ind THEN
  1228. ft := SymTab.ProcTypeParamType(ct, ai);
  1229. isV := SymTab.ProcTypeParamIsVar(ct, ai)
  1230. ELSIF va THEN
  1231. ft := at; isV := FALSE
  1232. ELSIF isC THEN
  1233. ft := SymTab.ParamType(nm, ai);
  1234. isV := SymTab.ParamIsVar(nm, ai)
  1235. ELSE
  1236. IF NOT ParamInfoIdx(pi, ai, ft, isV, pn) THEN END
  1237. END;
  1238. IF (NOT va) AND SymTab.IsEmptyStr(at)
  1239. AND (ft # SymTab.InvalidType)
  1240. AND (SymTab.ClassOf(ft) = SymTab.ClChar) THEN
  1241. (* ISO: empty string actual for a CHAR formal is 0 *)
  1242. QbeGen.CopyOp("0", qe); at := SymTab.CharType()
  1243. END;
  1244. IF va THEN
  1245. (* permissive C variadic argument *)
  1246. QbeGen.CArgAdd(qe, at, qa, cl)
  1247. ELSIF isV THEN
  1248. IF (SymTab.ClassOf(at) = SymTab.ClChar)
  1249. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  1250. AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
  1251. AND QbeGen.IsImm(qe) THEN
  1252. (* 1-char string literal passed to a VAR ARRAY OF CHAR:
  1253. pass its static descriptor *)
  1254. QbeGen.DeclCharStr(qe, qa);
  1255. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1256. ELSIF SymTab.IsByteBuf(ft)
  1257. AND (SymTab.ClassOf(at) # SymTab.ClArray)
  1258. AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
  1259. (* gm2 ext: wrap the scalar actual as a stack byte-buffer
  1260. descriptor (count = SIZE(actual), payload = a copy) *)
  1261. QbeGen.OpenScalarDesc(qe, at, ft, qa);
  1262. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1263. ELSIF QbeGen.AddrOfVal(qe, qa) THEN
  1264. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1265. END
  1266. ELSE
  1267. IF (SymTab.ClassOf(at) = SymTab.ClChar)
  1268. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  1269. AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
  1270. AND QbeGen.IsImm(qe) THEN
  1271. (* 1-char string literal passed to ARRAY OF CHAR: pass its
  1272. static descriptor, not the char code *)
  1273. QbeGen.DeclCharStr(qe, qa);
  1274. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1275. ELSIF SymTab.IsByteBuf(ft)
  1276. AND (SymTab.ClassOf(at) # SymTab.ClArray)
  1277. AND (SymTab.ClassOf(at) # SymTab.ClStr) THEN
  1278. (* gm2 ext: wrap the scalar actual as a stack byte-buffer
  1279. descriptor (count = SIZE(actual), payload = a copy) *)
  1280. QbeGen.OpenScalarDesc(qe, at, ft, qa);
  1281. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1282. ELSE
  1283. conv := (SymTab.ClassOf(ft) = SymTab.ClReal)
  1284. AND SymTab.IsIntFamily(at);
  1285. IF conv THEN
  1286. QbeGen.ConvIR(qe, qt);
  1287. IF NOT QbeGen.CallArg(qt, "d") THEN END
  1288. ELSE
  1289. IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
  1290. END
  1291. END
  1292. END;
  1293. INC(ai)
  1294. END;
  1295. INC(i)
  1296. END;
  1297. next := AST.NoNode;
  1298. IF AST.NChild(seq) > 0 THEN
  1299. next := AST.Child(seq, AST.NChild(seq) - 1);
  1300. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  1301. END;
  1302. seq := next
  1303. END;
  1304. IF want THEN
  1305. t := res; QbeGen.CallEnd(TRUE, q);
  1306. IF CompositeRes(res) THEN QbeGen.CopyOp(qres, q) END
  1307. ELSE
  1308. t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
  1309. END
  1310. END LowerCall;
  1311. PROCEDURE IsBuiltin (nm: ARRAY OF CHAR): BOOLEAN;
  1312. BEGIN
  1313. RETURN SymTab.Equal(nm, "ABS") OR SymTab.Equal(nm, "ODD")
  1314. OR SymTab.Equal(nm, "CAP")
  1315. OR SymTab.Equal(nm, "CHR") OR SymTab.Equal(nm, "ORD")
  1316. OR SymTab.Equal(nm, "UCHR") OR SymTab.Equal(nm, "CHR8")
  1317. OR SymTab.Equal(nm, "UORD")
  1318. OR SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE")
  1319. OR SymTab.Equal(nm, "LEN") OR SymTab.Equal(nm, "HIGH")
  1320. OR SymTab.Equal(nm, "VAL")
  1321. OR SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX")
  1322. OR SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE")
  1323. OR SymTab.Equal(nm, "ADR")
  1324. OR SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC")
  1325. OR SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL")
  1326. OR SymTab.Equal(nm, "NEW") OR SymTab.Equal(nm, "DISPOSE")
  1327. END IsBuiltin;
  1328. PROCEDURE LowerProcAddr (nm: ARRAY OF CHAR; VAR q: QbeGen.QVal);
  1329. (* Code address of a procedure used as a value (assign to a procedure
  1330. variable): $<base>_<uid>, or the plain C link for external procs.
  1331. Declared before LowerBuiltinExpr, which uses it for ADR. *)
  1332. VAR uid, depth, np: CARDINAL; res: SymTab.TypeIndex; ext: BOOLEAN;
  1333. mg: QbeGen.QVal;
  1334. base: SymTab.Name; ok: BOOLEAN;
  1335. BEGIN
  1336. ok := ProcInfo(nm, uid, res, depth, ext, np);
  1337. IF NOT ok THEN
  1338. (* a qualified/imported procedure appears under its base symbol
  1339. name in the proc table *)
  1340. IF SymTab.SymBase(nm, base) THEN
  1341. ok := ProcInfo(base, uid, res, depth, ext, np)
  1342. END
  1343. END;
  1344. IF ok THEN
  1345. IF ext THEN QbeGen.CopyOp(nm, mg) ELSE QbeGen.Mangled(nm, uid, mg) END;
  1346. QbeGen.ProcAddr(mg, q)
  1347. ELSE QbeGen.CopyOp("0", q)
  1348. END
  1349. END LowerProcAddr;
  1350. PROCEDURE LowerBuiltinExpr (n: AST.Node; nm: SymTab.Name;
  1351. VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  1352. (* Value builtins (Fact). *)
  1353. VAR et, et2, dt, vt: SymTab.TypeIndex; qa, qt, q2, qd, qr: QbeGen.QVal;
  1354. k, lo, hi, c1, c2, ucp: INTEGER; qn, vn: SymTab.Name; sfx: BOOLEAN;
  1355. isMax, isU, uok: BOOLEAN;
  1356. BEGIN
  1357. IF SymTab.Equal(nm, "ODD") THEN
  1358. LowerExpr(AST.Child(n, 1), et, q);
  1359. QbeGen.NewTemp(qt);
  1360. QbeGen.Op3("and", qt, q, "1", FALSE); (* x & 1 *)
  1361. QbeGen.NewTemp(qa);
  1362. QbeGen.Cmp(SymTab.OpNeq1, qt, "0", qa, FALSE); (* <> 0 *)
  1363. QbeGen.CopyOp(qa, q); t := SymTab.BoolType()
  1364. ELSIF SymTab.Equal(nm, "ABS") THEN
  1365. LowerExpr(AST.Child(n, 1), et, q);
  1366. QbeGen.AbsQ(q, qa, SymTab.ClassOf(et) = SymTab.ClReal);
  1367. QbeGen.CopyOp(qa, q); t := et
  1368. ELSIF SymTab.Equal(nm, "CAP") THEN
  1369. LowerExpr(AST.Child(n, 1), et, q);
  1370. QbeGen.CapQ(q, qa); QbeGen.CopyOp(qa, q); t := SymTab.CharType()
  1371. ELSIF SymTab.Equal(nm, "CHR") THEN
  1372. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.CharType()
  1373. ELSIF SymTab.Equal(nm, "ORD") THEN
  1374. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType()
  1375. ELSIF SymTab.Equal(nm, "UCHR") THEN
  1376. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.UCharType()
  1377. ELSIF SymTab.Equal(nm, "CHR8") THEN
  1378. LowerExpr(AST.Child(n, 1), et, q);
  1379. QbeGen.WidenLong(q, qa); QbeGen.CheckRange(qa, "0", "255");
  1380. t := SymTab.CharType()
  1381. ELSIF SymTab.Equal(nm, "UORD") THEN
  1382. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType()
  1383. ELSIF SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE") THEN
  1384. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1385. QbeGen.IntStr(VAL(INTEGER, SymTab.ObjectSize(dt)), q);
  1386. t := SymTab.IntType()
  1387. ELSIF SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") THEN
  1388. isMax := SymTab.Equal(nm, "MAX");
  1389. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1390. IF SymTab.ClassOf(dt) = SymTab.ClReal THEN
  1391. IF isMax THEN QbeGen.NormReal("3.402823e38", q)
  1392. ELSE QbeGen.NormReal("-3.402823e38", q) END;
  1393. t := SymTab.RealType()
  1394. ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN
  1395. IF isMax THEN QbeGen.CopyOp("9223372036854775807", q)
  1396. ELSE QbeGen.CopyOp("-9223372036854775808", q) END;
  1397. t := SymTab.LongType()
  1398. ELSIF SymTab.TypeBounds(dt, lo, hi) THEN
  1399. IF isMax THEN QbeGen.IntStr(hi, q) ELSE QbeGen.IntStr(lo, q) END;
  1400. t := SymTab.IntType()
  1401. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1402. END
  1403. ELSIF SymTab.Equal(nm, "LEN") OR SymTab.Equal(nm, "HIGH") THEN
  1404. IF AST.Kind(AST.Child(n, 1)) = AST.NkStrLit THEN
  1405. (* LEN("literal"): the content length of the literal; a real
  1406. string literal is still declared, as the grammar does *)
  1407. Name(AST.Child(n, 1), qn);
  1408. IF (qn[0] = "U") OR (qn[0] = "u") THEN
  1409. QbeGen.DeclUStr(qn, qd, isU, ucp, uok);
  1410. IF NOT uok THEN t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1411. ELSIF isU THEN
  1412. IF SymTab.Equal(nm, "HIGH") THEN QbeGen.CopyOp("0", q)
  1413. ELSE QbeGen.CopyOp("1", q)
  1414. END;
  1415. t := SymTab.IntType()
  1416. ELSE
  1417. QbeGen.UStrLen(qd, qr);
  1418. IF SymTab.Equal(nm, "HIGH") THEN QbeGen.DecQ(qr) END;
  1419. QbeGen.CopyOp(qr, q); t := SymTab.IntType()
  1420. END
  1421. ELSE
  1422. IF SymTab.StrLen(qn) = 3 THEN c1 := 1
  1423. ELSE QbeGen.DeclStr(qn, qd); c1 := SymTab.StrLen(qn) - 2
  1424. END;
  1425. IF SymTab.Equal(nm, "HIGH") THEN DEC(c1) END;
  1426. QbeGen.IntStr(c1, q); t := SymTab.IntType()
  1427. END
  1428. ELSE
  1429. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1430. IF dt = SymTab.InvalidType THEN
  1431. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1432. ELSIF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  1433. IF SymTab.Equal(nm, "HIGH") THEN
  1434. IF SymTab.IsOpenArray(dt) THEN QbeGen.OpenHi(qd, q)
  1435. ELSE QbeGen.IntStr(SymTab.ArrayHi(dt), q) END
  1436. ELSE
  1437. IF SymTab.IsOpenArray(dt) THEN QbeGen.LoadCount(qd, q)
  1438. ELSE QbeGen.IntStr(VAL(INTEGER, SymTab.ArrayLen(dt)), q) END
  1439. END;
  1440. t := SymTab.IntType()
  1441. ELSE
  1442. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1443. END
  1444. END;
  1445. ELSIF SymTab.Equal(nm, "VAL") THEN
  1446. Name(AST.Child(n, 1), vn);
  1447. IF NOT SymTab.Lookup(vn) THEN
  1448. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1449. ELSE
  1450. vt := SymTab.SymType(vn);
  1451. LowerExpr(AST.Child(n, 2), et, q);
  1452. c1 := SymTab.ClassOf(et); c2 := SymTab.ClassOf(vt);
  1453. IF ((c1 = SymTab.ClInt) OR (c1 = SymTab.ClByte)
  1454. OR (c1 = SymTab.ClSByte) OR (c1 = SymTab.ClWord16)
  1455. OR (c1 = SymTab.ClSWord16))
  1456. AND (c2 = SymTab.ClLong) THEN
  1457. QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1458. ELSIF (c1 = SymTab.ClLong) AND ((c2 = SymTab.ClInt)
  1459. OR (c2 = SymTab.ClByte) OR (c2 = SymTab.ClSByte)
  1460. OR (c2 = SymTab.ClWord16) OR (c2 = SymTab.ClSWord16)) THEN
  1461. QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1462. ELSIF ((c1 = SymTab.ClInt) OR (c1 = SymTab.ClByte)
  1463. OR (c1 = SymTab.ClSByte) OR (c1 = SymTab.ClWord16)
  1464. OR (c1 = SymTab.ClSWord16))
  1465. AND (c2 = SymTab.ClReal) THEN
  1466. QbeGen.ConvIR(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1467. ELSIF (c1 = SymTab.ClLong) AND (c2 = SymTab.ClReal) THEN
  1468. QbeGen.ConvLR(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1469. ELSIF (c1 = SymTab.ClReal) AND ((c2 = SymTab.ClInt)
  1470. OR (c2 = SymTab.ClByte) OR (c2 = SymTab.ClSByte)
  1471. OR (c2 = SymTab.ClWord16) OR (c2 = SymTab.ClSWord16)) THEN
  1472. QbeGen.ConvRI(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1473. ELSIF (c1 = SymTab.ClReal) AND (c2 = SymTab.ClLong) THEN
  1474. QbeGen.ConvRL(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1475. ELSIF (c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt) THEN
  1476. (* a set as its (first) machine word *)
  1477. QbeGen.LoadW(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1478. ELSIF (c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet) THEN
  1479. (* a word as a set value: zero-filled one-word temp *)
  1480. c2 := SymTab.SetWords(vt);
  1481. IF c2 = 0 THEN c2 := 1 END;
  1482. QbeGen.NewSetTemp(VAL(CARDINAL, c2), qa);
  1483. QbeGen.SetZero(qa, VAL(CARDINAL, c2));
  1484. QbeGen.StoreW(qa, q); QbeGen.CopyOp(qa, q); t := vt
  1485. ELSE t := vt (* same representation: no-op *)
  1486. END
  1487. END
  1488. ELSIF SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") THEN
  1489. LowerExpr(AST.Child(n, 1), et, q);
  1490. LowerExpr(AST.Child(n, 2), et2, q2);
  1491. QbeGen.SetShift(q, q2, SymTab.SetWords(et), SymTab.SetCount(et),
  1492. SymTab.Equal(nm, "ROTATE"), qt);
  1493. t := et; QbeGen.CopyOp(qt, q)
  1494. ELSIF SymTab.Equal(nm, "ADR") THEN
  1495. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1496. IF k = SymTab.KindProc THEN
  1497. (* ADR of a procedure is its code address *)
  1498. LowerProcAddr(qn, q)
  1499. ELSIF sfx THEN QbeGen.CopyOp(qd, q)
  1500. ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
  1501. QbeGen.AddrOf(qn, q)
  1502. ELSE QbeGen.CopyOp("0", q)
  1503. END;
  1504. t := SymTab.AddrType()
  1505. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1506. END
  1507. END LowerBuiltinExpr;
  1508. PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name);
  1509. (* Statement builtins (AssOrCall): INC/DEC, INCL/EXCL, NEW/DISPOSE. *)
  1510. VAR dt, at, et2, bt: SymTab.TypeIndex; dk: INTEGER;
  1511. qd, qv, qe, qn2, qstep, qm: QbeGen.QVal;
  1512. qn: SymTab.Name; sfx, isInc: BOOLEAN;
  1513. BEGIN
  1514. IF SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") THEN
  1515. isInc := SymTab.Equal(nm, "INC");
  1516. QbeGen.CopyOp("1", qstep);
  1517. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1518. IF AST.NChild(n) > 2 THEN LowerExpr(AST.Child(n, 2), et2, qstep) END;
  1519. IF dt = SymTab.InvalidType THEN
  1520. ELSE
  1521. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
  1522. ELSIF SymTab.IsSmallInt(dt) THEN
  1523. QbeGen.LoadShortVar(qn, SymTab.IsSignedSmallInt(dt),
  1524. SymTab.SmallIntBytes(dt), qv)
  1525. ELSE QbeGen.LoadVar(qn, FALSE, qv)
  1526. END;
  1527. QbeGen.NewTemp(qn2);
  1528. IF isInc THEN QbeGen.Op3("add", qn2, qv, qstep, FALSE)
  1529. ELSE QbeGen.Op3("sub", qn2, qv, qstep, FALSE)
  1530. END;
  1531. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qn2, dt)
  1532. ELSIF SymTab.IsSmallInt(dt) THEN
  1533. QbeGen.StoreShortVar(qn, SymTab.SmallIntBytes(dt), qn2)
  1534. ELSE QbeGen.StoreVar(qn, qn2, FALSE)
  1535. END
  1536. END
  1537. ELSIF SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") THEN
  1538. isInc := SymTab.Equal(nm, "INCL");
  1539. LowerDesign(AST.Child(n, 1), at, dk, qd, qn, sfx);
  1540. LowerExpr(AST.Child(n, 2), et2, qe);
  1541. IF at = SymTab.InvalidType THEN
  1542. ELSIF SymTab.ClassOf(at) # SymTab.ClSet THEN
  1543. ELSE
  1544. IF isInc THEN QbeGen.SetBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
  1545. ELSE QbeGen.SetClearBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
  1546. END
  1547. END
  1548. ELSIF SymTab.Equal(nm, "NEW") THEN
  1549. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1550. IF dt = SymTab.InvalidType THEN
  1551. ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
  1552. ELSE
  1553. bt := SymTab.PtrBase(dt);
  1554. IF bt # SymTab.InvalidType THEN
  1555. QbeGen.NewHeap(bt, qm); QbeGen.InitHeap(qm, bt);
  1556. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qm, dt)
  1557. ELSE QbeGen.StorePtr(qn, qm)
  1558. END
  1559. END
  1560. END
  1561. ELSIF SymTab.Equal(nm, "DISPOSE") THEN
  1562. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1563. IF dt = SymTab.InvalidType THEN
  1564. ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
  1565. ELSE
  1566. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
  1567. ELSE QbeGen.LoadPtr(qn, qv)
  1568. END;
  1569. QbeGen.FreeHeap(qv);
  1570. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, "0", dt)
  1571. ELSE QbeGen.StorePtr(qn, "0")
  1572. END
  1573. END
  1574. END
  1575. END LowerBuiltinStmt;
  1576. PROCEDURE LowerMethod (m: AST.Node; ct: SymTab.TypeIndex);
  1577. (* A class method: hidden THIS receiver, then declared formals; the body
  1578. runs with THIS pushed as the WITH base (bare field names resolve). *)
  1579. VAR nm, txt: SymTab.Name; mg, thisQ: QbeGen.QVal;
  1580. uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1581. pv, ext: BOOLEAN; j: CARDINAL; saveCls: SymTab.TypeIndex;
  1582. savedProc: INTEGER;
  1583. BEGIN
  1584. IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN END;
  1585. Name(AST.Child(m, 0), nm);
  1586. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN END;
  1587. QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
  1588. QbeGen.BeginFunc(mg);
  1589. IF NOT QbeGen.FuncParam("THIS", TRUE, ct) THEN END;
  1590. IF CompositeRes(res) THEN
  1591. IF NOT QbeGen.FuncParam("__res", TRUE, res) THEN END
  1592. END;
  1593. j := 0;
  1594. WHILE j < np DO
  1595. IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
  1596. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
  1597. INC(j)
  1598. END;
  1599. QbeGen.SetFuncRes(res);
  1600. QbeGen.EndFuncHeader;
  1601. QbeGen.ThisBase(thisQ);
  1602. saveCls := curImplCls;
  1603. curImplCls := ct;
  1604. QbeGen.PushWith(thisQ);
  1605. IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END;
  1606. savedProc := emitProc;
  1607. emitProc := FindProc(nm);
  1608. LowerDecls(AST.Child(m, 2));
  1609. nUserLab := 0;
  1610. LowerStmt(AST.Child(m, 1));
  1611. emitProc := savedProc;
  1612. IF withTop > 0 THEN DEC(withTop) END;
  1613. curImplCls := saveCls;
  1614. QbeGen.PopWith;
  1615. QbeGen.EndFunc(res)
  1616. END LowerMethod;
  1617. PROCEDURE LowerMethods (seq: AST.Node; ct: SymTab.TypeIndex);
  1618. VAR i: CARDINAL; m: AST.Node;
  1619. BEGIN
  1620. IF seq = AST.NoNode THEN RETURN END;
  1621. i := 0;
  1622. WHILE i < AST.NChild(seq) DO
  1623. m := AST.Child(seq, i);
  1624. IF i = AST.MaxChild - 1 THEN LowerMethods(m, ct)
  1625. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethods(m, ct)
  1626. ELSIF AST.Kind(m) = AST.NkProcDecl THEN LowerMethod(m, ct)
  1627. END;
  1628. INC(i)
  1629. END
  1630. END LowerMethods;
  1631. PROCEDURE LowerMethodHeadings (seq: AST.Node; ct: SymTab.TypeIndex);
  1632. (* Class-declaration method headings: emit+discard a function header per
  1633. method so the backend temp counters advance exactly as the legacy
  1634. parse did (the implementation's temps then line up). *)
  1635. VAR i, j: CARDINAL; m: AST.Node; nm, txt: SymTab.Name;
  1636. mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1637. pv, ext: BOOLEAN;
  1638. BEGIN
  1639. IF seq = AST.NoNode THEN RETURN END;
  1640. i := 0;
  1641. WHILE i < AST.NChild(seq) DO
  1642. m := AST.Child(seq, i);
  1643. IF i = AST.MaxChild - 1 THEN LowerMethodHeadings(m, ct)
  1644. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethodHeadings(m, ct)
  1645. ELSIF AST.Kind(m) = AST.NkProcDecl THEN
  1646. Name(AST.Child(m, 0), nm);
  1647. IF ProcInfo(nm, uid, res, depth, ext, np) THEN
  1648. QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
  1649. QbeGen.BeginFunc(mg);
  1650. j := 0;
  1651. WHILE j < np DO
  1652. IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
  1653. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
  1654. INC(j)
  1655. END;
  1656. QbeGen.SetFuncRes(res);
  1657. QbeGen.AbortFunc
  1658. END
  1659. END;
  1660. INC(i)
  1661. END
  1662. END LowerMethodHeadings;
  1663. PROCEDURE LowerMethodCall (n: AST.Node; VAR t: SymTab.TypeIndex;
  1664. VAR q: QbeGen.QVal; want: BOOLEAN);
  1665. VAR d: AST.Node; ct, res, ft, at: SymTab.TypeIndex;
  1666. cq, mg, qa, qt, qe, qres: QbeGen.QVal; fn, pn: SymTab.Name;
  1667. k, vs: INTEGER; i: CARDINAL; sfx, isV, conv: BOOLEAN;
  1668. BEGIN
  1669. d := AST.Child(n, 0);
  1670. curMethCls := SymTab.InvalidType;
  1671. LowerDesign(d, ct, k, cq, pn, sfx);
  1672. ct := curMethCls;
  1673. IF ct = SymTab.InvalidType THEN
  1674. t := SymTab.InvalidType; QbeGen.CopyOp("0", q); RETURN
  1675. END;
  1676. IF AST.NChild(d) = 1 THEN
  1677. Name(AST.Child(d, 0), fn)
  1678. ELSE
  1679. Name(AST.Child(AST.Child(d, AST.NChild(d) - 1), 0), fn)
  1680. END;
  1681. res := SymTab.ClassMethodRes(ct, fn);
  1682. vs := SymTab.VirtSlot(ct, fn);
  1683. IF vs >= 0 THEN QbeGen.VirtCallBegin(cq, vs, res)
  1684. ELSE
  1685. QbeGen.Mangled(fn, SymTab.ClassMethodUid(ct, fn), mg);
  1686. QbeGen.CallBegin(mg, res, 0, FALSE)
  1687. END;
  1688. IF CompositeRes(res) THEN
  1689. QbeGen.AllocLocal(res, qres);
  1690. IF NOT QbeGen.CallArg(qres, "l") THEN END
  1691. END;
  1692. i := 1;
  1693. WHILE i < AST.NChild(n) DO
  1694. LowerExpr(AST.Child(n, i), at, qe);
  1695. ft := SymTab.ClassMethodParamType(ct, fn, i - 1);
  1696. isV := SymTab.ClassMethodParamIsVar(ct, fn, i - 1);
  1697. IF isV THEN
  1698. IF QbeGen.AddrOfVal(qe, qa) THEN
  1699. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1700. END
  1701. ELSE
  1702. conv := (SymTab.ClassOf(ft) = SymTab.ClReal) AND SymTab.IsIntFamily(at);
  1703. IF conv THEN
  1704. QbeGen.ConvIR(qe, qt);
  1705. IF NOT QbeGen.CallArg(qt, "d") THEN END
  1706. ELSE
  1707. IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
  1708. END
  1709. END;
  1710. INC(i)
  1711. END;
  1712. IF want THEN t := res; QbeGen.CallEnd(TRUE, q);
  1713. IF CompositeRes(res) THEN QbeGen.CopyOp(qres, q) END
  1714. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
  1715. END
  1716. END LowerMethodCall;
  1717. PROCEDURE LowerCase (n: AST.Node);
  1718. (* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). The
  1719. arm list is chunked (AstAppend) so a CASE with more than MaxChild
  1720. alternatives is not truncated. *)
  1721. VAR i, j: CARDINAL; arm, lab, seq, next: AST.Node;
  1722. tsel, t2, t3: SymTab.TypeIndex;
  1723. qsel, q2, q3, qc, qd, qe, lEnd, lBody, lAfter, lNext: QbeGen.QVal;
  1724. BEGIN
  1725. LowerExpr(AST.Child(n, 0), tsel, qsel);
  1726. QbeGen.NewLabel(lEnd);
  1727. (* pass 1: alternatives (ELSE arms come after) *)
  1728. seq := AST.Child(n, 1);
  1729. WHILE seq # AST.NoNode DO
  1730. i := 0;
  1731. WHILE i < AST.NChild(seq) DO
  1732. arm := AST.Child(seq, i);
  1733. IF AST.Kind(arm) = AST.NkBlock THEN
  1734. (* continuation chunk *)
  1735. ELSIF AST.Op(arm) = 1 THEN
  1736. (* ELSE arm: emitted in pass 2 *)
  1737. ELSE
  1738. QbeGen.NewLabel(lBody); QbeGen.NewLabel(lAfter);
  1739. j := 0;
  1740. WHILE j + 1 < AST.NChild(arm) DO
  1741. lab := AST.Child(arm, j);
  1742. IF AST.Kind(lab) = AST.NkSubrange THEN
  1743. LowerExpr(AST.Child(lab, 0), t2, q2);
  1744. IF SymTab.IsEmptyStr(t2)
  1745. AND (SymTab.ClassOf(tsel) = SymTab.ClChar) THEN
  1746. QbeGen.CopyOp("0", q2); t2 := SymTab.CharType()
  1747. END;
  1748. QbeGen.NewLabel(lNext);
  1749. QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
  1750. QbeGen.Jnz(qc, lBody, lNext);
  1751. QbeGen.EmitLabel(lNext);
  1752. LowerExpr(AST.Child(lab, 1), t3, q3);
  1753. IF SymTab.IsEmptyStr(t3)
  1754. AND (SymTab.ClassOf(tsel) = SymTab.ClChar) THEN
  1755. QbeGen.CopyOp("0", q3); t3 := SymTab.CharType()
  1756. END;
  1757. QbeGen.Cmp(SymTab.OpGe, qsel, q2, qc, FALSE);
  1758. QbeGen.Cmp(SymTab.OpLe, qsel, q3, qd, FALSE);
  1759. QbeGen.NewTemp(qe);
  1760. QbeGen.Op3("and", qe, qc, qd, FALSE);
  1761. QbeGen.NewLabel(lNext);
  1762. QbeGen.Jnz(qe, lBody, lNext);
  1763. QbeGen.EmitLabel(lNext)
  1764. ELSE
  1765. LowerExpr(lab, t2, q2);
  1766. IF SymTab.IsEmptyStr(t2)
  1767. AND (SymTab.ClassOf(tsel) = SymTab.ClChar) THEN
  1768. QbeGen.CopyOp("0", q2); t2 := SymTab.CharType()
  1769. END;
  1770. QbeGen.NewLabel(lNext);
  1771. IF (SymTab.ClassOf(tsel) = SymTab.ClSet)
  1772. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  1773. QbeGen.CmpSet(SymTab.OpEq, qsel, q2,
  1774. SymTab.SetWords(tsel), SymTab.SetWords(t2), qc)
  1775. ELSE
  1776. QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE)
  1777. END;
  1778. QbeGen.Jnz(qc, lBody, lNext);
  1779. QbeGen.EmitLabel(lNext)
  1780. END;
  1781. INC(j)
  1782. END;
  1783. QbeGen.Jmp(lAfter);
  1784. QbeGen.EmitLabel(lBody);
  1785. LowerStmt(AST.Child(arm, AST.NChild(arm) - 1));
  1786. QbeGen.Jmp(lEnd);
  1787. QbeGen.EmitLabel(lAfter)
  1788. END;
  1789. INC(i)
  1790. END;
  1791. next := AST.NoNode;
  1792. IF AST.NChild(seq) > 0 THEN
  1793. next := AST.Child(seq, AST.NChild(seq) - 1);
  1794. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  1795. END;
  1796. seq := next
  1797. END;
  1798. (* pass 2: ELSE arms *)
  1799. seq := AST.Child(n, 1);
  1800. WHILE seq # AST.NoNode DO
  1801. i := 0;
  1802. WHILE i < AST.NChild(seq) DO
  1803. arm := AST.Child(seq, i);
  1804. IF (AST.Kind(arm) # AST.NkBlock) AND (AST.Op(arm) = 1) THEN
  1805. LowerStmt(AST.Child(arm, 0))
  1806. END;
  1807. INC(i)
  1808. END;
  1809. next := AST.NoNode;
  1810. IF AST.NChild(seq) > 0 THEN
  1811. next := AST.Child(seq, AST.NChild(seq) - 1);
  1812. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  1813. END;
  1814. seq := next
  1815. END;
  1816. QbeGen.EmitLabel(lEnd)
  1817. END LowerCase;
  1818. PROCEDURE LowerWith (n: AST.Node);
  1819. (* WITH: push each record's base address, lower the body, pop only the
  1820. levels this WITH pushed (a nested WITH must restore the outer one). *)
  1821. VAR i, base: CARDINAL; dt: SymTab.TypeIndex; dk: INTEGER;
  1822. qd: QbeGen.QVal; qn: SymTab.Name; sfx: BOOLEAN;
  1823. BEGIN
  1824. base := withTop;
  1825. i := 0;
  1826. WHILE i + 1 < AST.NChild(n) DO
  1827. LowerDesign(AST.Child(n, i), dt, dk, qd, qn, sfx);
  1828. QbeGen.PushWith(qd);
  1829. IF withTop <= HIGH(withRec) THEN
  1830. withRec[withTop] := dt; INC(withTop)
  1831. END;
  1832. INC(i)
  1833. END;
  1834. LowerStmt(AST.Child(n, AST.NChild(n) - 1));
  1835. WHILE withTop > base DO DEC(withTop); QbeGen.PopWith END
  1836. END LowerWith;
  1837. PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
  1838. VAR q: QbeGen.QVal; VAR k: INTEGER;
  1839. VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
  1840. asAddr: BOOLEAN);
  1841. VAR t2: SymTab.TypeIndex; q2, qt, qf, qs, qr, qaddr, qa, qb: QbeGen.QVal;
  1842. lNext, lFalse, lTrue, lDone: QbeGen.QVal;
  1843. kind, op, rop, ucp: INTEGER;
  1844. folded, isR, isCh, isU, uok: BOOLEAN;
  1845. i: CARDINAL; el, seq, next: AST.Node;
  1846. lw, rw, mw: CARDINAL; idx: INTEGER; fok, isL: BOOLEAN;
  1847. lt, rt: SymTab.TypeIndex; qw: QbeGen.QVal;
  1848. BEGIN
  1849. IF AST.Kind(n) = AST.NkDesignator THEN
  1850. LowerDesign(n, t, k, q, qn, sfx);
  1851. IF k = SymTab.KindProc THEN
  1852. (* bare procedure used as a value: its code address *)
  1853. LowerProcAddr(qn, q);
  1854. RETURN
  1855. END;
  1856. (* Record value->address for VAR actuals, mirroring the grammar's
  1857. Design. AddrOfVal cannot rely on the grammar's notes: its ring
  1858. (256) wraps long before a whole-session emit finishes. *)
  1859. IF sfx THEN QbeGen.CopyOp(q, qaddr) ELSE QbeGen.AddrOf(qn, qaddr) END;
  1860. IF NOT asAddr THEN FinalLoad(t, sfx, q) END;
  1861. IF (k = SymTab.KindVar) OR (k = SymTab.KindParam)
  1862. OR (k = SymTab.KindField) THEN
  1863. QbeGen.NoteAddr(q, qaddr)
  1864. ELSIF sfx AND (t # SymTab.InvalidType)
  1865. AND ((SymTab.ClassOf(t) = SymTab.ClArray)
  1866. OR (SymTab.ClassOf(t) = SymTab.ClSet)
  1867. OR (SymTab.ClassOf(t) = SymTab.ClRecord)) THEN
  1868. QbeGen.NoteAddr(q, qaddr)
  1869. END;
  1870. RETURN
  1871. END;
  1872. k := -1; qn[0] := CHR(0); sfx := FALSE;
  1873. IF AST.Kind(n) = AST.NkIntLit THEN
  1874. Name(n, qn); QbeGen.NormInt(qn, q); t := SymTab.IntType()
  1875. ELSIF AST.Kind(n) = AST.NkCharLit THEN
  1876. Name(n, qn); QbeGen.NormLit(qn, q, isCh); t := SymTab.CharType()
  1877. ELSIF AST.Kind(n) = AST.NkRealLit THEN
  1878. Name(n, qn); QbeGen.NormReal(qn, q); t := SymTab.RealType()
  1879. ELSIF AST.Kind(n) = AST.NkStrLit THEN
  1880. Name(n, qn);
  1881. IF (qn[0] = "U") OR (qn[0] = "u") THEN
  1882. (* U"..." / U'...': one codepoint -> UCHAR, else a ustring *)
  1883. QbeGen.DeclUStr(qn, q, isU, ucp, uok);
  1884. IF NOT uok THEN
  1885. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1886. ELSIF isU THEN
  1887. t := SymTab.UCharType(); QbeGen.IntStr(ucp, q)
  1888. ELSE
  1889. t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewUStr() END; QbeGen.NoteAddr(q, q)
  1890. END
  1891. ELSIF SymTab.StrLen(qn) = 3 THEN
  1892. t := SymTab.CharType(); QbeGen.IntStr(QbeGen.CharVal(qn), q)
  1893. ELSE
  1894. t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewStr() END; QbeGen.DeclStr(qn, q); QbeGen.NoteAddr(q, q)
  1895. END
  1896. ELSIF AST.Kind(n) = AST.NkSetLit THEN
  1897. t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewSet(SymTab.NewSubR(0, 255)) END;
  1898. QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8);
  1899. i := 0;
  1900. WHILE i < AST.NChild(n) DO
  1901. el := AST.Child(n, i);
  1902. IF AST.Kind(el) = AST.NkSubrange THEN
  1903. LowerExpr(AST.Child(el, 0), t2, q2);
  1904. LowerExpr(AST.Child(el, 1), t2, qt);
  1905. QbeGen.SetRange(q, q2, qt, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  1906. ELSE
  1907. LowerExpr(el, t2, q2);
  1908. QbeGen.SetBit(q, q2, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  1909. END;
  1910. INC(i)
  1911. END
  1912. ELSIF AST.Kind(n) = AST.NkBraceLit THEN
  1913. (* T{...} typed brace literal: a set here (the type was recorded by
  1914. the grammar in the node's ty field). Array/record/class
  1915. constructors are not lowered here yet. *)
  1916. t := AST.Ty(n);
  1917. IF (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClSet) THEN
  1918. IF SymTab.SetWords(t) = 0 THEN
  1919. QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8)
  1920. ELSE
  1921. QbeGen.NewSetTemp(SymTab.SetWords(t), q);
  1922. QbeGen.SetZero(q, SymTab.SetWords(t))
  1923. END;
  1924. seq := n;
  1925. WHILE seq # AST.NoNode DO
  1926. i := 0;
  1927. WHILE i < AST.NChild(seq) DO
  1928. el := AST.Child(seq, i);
  1929. IF AST.Kind(el) # AST.NkBlock THEN
  1930. IF AST.Kind(el) = AST.NkSubrange THEN
  1931. LowerExpr(AST.Child(el, 0), t2, q2);
  1932. LowerExpr(AST.Child(el, 1), t2, qt);
  1933. QbeGen.SetRange(q, q2, qt, SymTab.SetBaseLo(t),
  1934. SymTab.SetCount(t))
  1935. ELSE
  1936. LowerExpr(el, t2, q2);
  1937. QbeGen.SetBit(q, q2, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  1938. END
  1939. END;
  1940. INC(i)
  1941. END;
  1942. next := AST.NoNode;
  1943. IF AST.NChild(seq) > 0 THEN
  1944. next := AST.Child(seq, AST.NChild(seq) - 1);
  1945. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  1946. END;
  1947. seq := next
  1948. END
  1949. ELSIF (t # SymTab.InvalidType)
  1950. AND ((SymTab.ClassOf(t) = SymTab.ClArray)
  1951. OR (SymTab.ClassOf(t) = SymTab.ClRecord)
  1952. OR (SymTab.ClassOf(t) = SymTab.ClClass)) THEN
  1953. (* T{...} aggregate constructor *)
  1954. QbeGen.CtorBegin(t);
  1955. seq := n;
  1956. WHILE seq # AST.NoNode DO
  1957. i := 0;
  1958. WHILE i < AST.NChild(seq) DO
  1959. el := AST.Child(seq, i);
  1960. IF AST.Kind(el) # AST.NkBlock THEN
  1961. LowerExpr(el, t2, q2);
  1962. QbeGen.CtorElem(q2)
  1963. END;
  1964. INC(i)
  1965. END;
  1966. next := AST.NoNode;
  1967. IF AST.NChild(seq) > 0 THEN
  1968. next := AST.Child(seq, AST.NChild(seq) - 1);
  1969. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  1970. END;
  1971. seq := next
  1972. END;
  1973. QbeGen.CtorEnd(q)
  1974. ELSE
  1975. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1976. END
  1977. ELSIF AST.Kind(n) = AST.NkDesignator THEN
  1978. LowerDesign(n, t, k, q, qn, sfx)
  1979. ELSIF AST.Kind(n) = AST.NkCall THEN
  1980. IF IsMethodCall(n) THEN LowerMethodCall(n, t, q, TRUE)
  1981. ELSE
  1982. CalleeName(n, qn);
  1983. IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
  1984. ELSE LowerCall(n, t, q, TRUE)
  1985. END
  1986. END
  1987. ELSIF AST.Kind(n) = AST.NkUnary THEN
  1988. LowerExpr(AST.Child(n, 0), t, q);
  1989. IF AST.Op(n) = AST.OpSub THEN
  1990. IF QbeGen.IsImm(q) THEN QbeGen.NegFold(q, q)
  1991. ELSE QbeGen.NewTemp(qt);
  1992. QbeGen.NegQ(q, qt, SymTab.ClassOf(t) = SymTab.ClReal);
  1993. QbeGen.CopyOp(qt, q)
  1994. END
  1995. ELSE
  1996. QbeGen.NotQ(q, qt); QbeGen.CopyOp(qt, q); t := SymTab.BoolType()
  1997. END
  1998. ELSIF AST.Kind(n) = AST.NkBinExpr THEN
  1999. op := AST.Op(n);
  2000. IF IsRel(op) THEN
  2001. LowerExpr(AST.Child(n, 0), t, q);
  2002. LowerExpr(AST.Child(n, 1), t2, q2);
  2003. (* ISO: an empty string compared with CHAR is the terminator;
  2004. against a CHAR array it stays a string (StrEq below). *)
  2005. IF (t # SymTab.InvalidType) AND SymTab.IsEmptyStr(t)
  2006. AND (t2 # SymTab.InvalidType)
  2007. AND (SymTab.ClassOf(t2) = SymTab.ClChar) THEN
  2008. QbeGen.CopyOp("0", q); t := SymTab.CharType()
  2009. ELSIF (t2 # SymTab.InvalidType) AND SymTab.IsEmptyStr(t2)
  2010. AND (t # SymTab.InvalidType)
  2011. AND (SymTab.ClassOf(t) = SymTab.ClChar) THEN
  2012. QbeGen.CopyOp("0", q2); t2 := SymTab.CharType()
  2013. END;
  2014. rop := SymTab.OpEq; folded := RelSym(op, rop);
  2015. IF op = AST.OpIn THEN
  2016. QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2), SymTab.SetCount(t2), qt);
  2017. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2018. ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
  2019. OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
  2020. QbeGen.CmpL(rop, q, q2, qt);
  2021. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2022. ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
  2023. OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2024. QbeGen.CmpSet(rop, q, q2, SymTab.SetWords(t), SymTab.SetWords(t2), qt);
  2025. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2026. ELSIF SymTab.StrCompat(t, t2) THEN
  2027. QbeGen.StrEq(rop, q, q2, qt);
  2028. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2029. ELSIF SymTab.IsLongFamily(t) OR SymTab.IsLongFamily(t2) THEN
  2030. IF SymTab.IsIntFamily(t) THEN QbeGen.WidenLong(q, qf); QbeGen.CopyOp(qf, q) END;
  2031. IF SymTab.IsIntFamily(t2) THEN QbeGen.WidenLong(q2, qf); QbeGen.CopyOp(qf, q2) END;
  2032. QbeGen.CmpLong(rop, q, q2, qt);
  2033. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2034. ELSE
  2035. isR := (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClReal);
  2036. t := SymTab.BoolType();
  2037. QbeGen.Cmp(rop, q, q2, qt, isR);
  2038. QbeGen.CopyOp(qt, q)
  2039. END
  2040. ELSIF op = AST.OpAnd THEN
  2041. LowerExpr(AST.Child(n, 0), t, q);
  2042. QbeGen.DelayBegin;
  2043. LowerExpr(AST.Child(n, 1), t2, q2);
  2044. QbeGen.DelayEnd;
  2045. QbeGen.Slot4(qs);
  2046. QbeGen.NewLabel(lNext); QbeGen.NewLabel(lFalse); QbeGen.NewLabel(lDone);
  2047. QbeGen.Jnz(q, lNext, lFalse);
  2048. QbeGen.EmitLabel(lNext);
  2049. QbeGen.DelayFlush;
  2050. QbeGen.StoreW(qs, q2);
  2051. QbeGen.Jmp(lDone);
  2052. QbeGen.EmitLabel(lFalse);
  2053. QbeGen.StoreW(qs, "0");
  2054. QbeGen.Jmp(lDone);
  2055. QbeGen.EmitLabel(lDone);
  2056. QbeGen.LoadW(qs, qr);
  2057. QbeGen.CopyOp(qr, q);
  2058. t := SymTab.BoolType()
  2059. ELSIF op = AST.OpOr THEN
  2060. LowerExpr(AST.Child(n, 0), t, q);
  2061. QbeGen.DelayBegin;
  2062. LowerExpr(AST.Child(n, 1), t2, q2);
  2063. QbeGen.DelayEnd;
  2064. QbeGen.Slot4(qs);
  2065. QbeGen.NewLabel(lTrue); QbeGen.NewLabel(lNext); QbeGen.NewLabel(lDone);
  2066. QbeGen.Jnz(q, lTrue, lNext);
  2067. QbeGen.EmitLabel(lTrue);
  2068. QbeGen.StoreW(qs, "1");
  2069. QbeGen.Jmp(lDone);
  2070. QbeGen.EmitLabel(lNext);
  2071. QbeGen.DelayFlush;
  2072. QbeGen.StoreW(qs, q2);
  2073. QbeGen.Jmp(lDone);
  2074. QbeGen.EmitLabel(lDone);
  2075. QbeGen.LoadW(qs, qr);
  2076. QbeGen.CopyOp(qr, q);
  2077. t := SymTab.BoolType()
  2078. ELSE
  2079. LowerExpr(AST.Child(n, 0), t, q);
  2080. LowerExpr(AST.Child(n, 1), t2, q2);
  2081. IF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  2082. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  2083. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2084. (* set union/diff (Add/Sub) or intersection/symdiff (Mul/Div) *)
  2085. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  2086. mw := lw; IF rw > mw THEN mw := rw END;
  2087. IF op = AST.OpAdd THEN idx := 0
  2088. ELSIF op = AST.OpSub THEN idx := 2
  2089. ELSIF op = AST.OpMul THEN idx := 1
  2090. ELSE idx := 3
  2091. END;
  2092. QbeGen.SetBinOp(idx, q, q2, lw, rw, qt);
  2093. t := SymTab.NewSet(SymTab.NewSubR(0, VAL(INTEGER, mw) * 32 - 1));
  2094. QbeGen.CopyOp(qt, q)
  2095. ELSIF (op = AST.OpAdd)
  2096. AND (SymTab.StrCompat(t, t2)
  2097. OR (SymTab.IsStrType(t) AND (SymTab.ClassOf(t2) = SymTab.ClChar))
  2098. OR ((SymTab.ClassOf(t) = SymTab.ClChar) AND SymTab.IsStrType(t2))) THEN
  2099. QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2), qt, fok);
  2100. IF NOT fok THEN
  2101. IF SymTab.StrCompat(t, t2) THEN QbeGen.StrCat(q, q2, qt)
  2102. ELSIF SymTab.IsStrType(t) THEN
  2103. QbeGen.DeclCharStr(q2, qs); QbeGen.StrCat(q, qs, qt)
  2104. ELSE
  2105. QbeGen.DeclCharStr(q, qs); QbeGen.StrCat(qs, q2, qt)
  2106. END
  2107. END;
  2108. t := SymTab.NewStr(); QbeGen.CopyOp(qt, q)
  2109. ELSIF (op = AST.OpAdd)
  2110. AND (SymTab.UStrCompat(t, t2)
  2111. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  2112. AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
  2113. OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
  2114. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
  2115. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  2116. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
  2117. (* UString concatenation: a UCHAR operand becomes a
  2118. 1-codepoint UString; the result is a descriptor *)
  2119. IF SymTab.ClassOf(t) = SymTab.ClUStr THEN QbeGen.CopyOp(q, qa)
  2120. ELSE QbeGen.UStrFrom(q, qa)
  2121. END;
  2122. IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN QbeGen.UStrCat(qa, q2, qt)
  2123. ELSE QbeGen.UStrFrom(q2, qb); QbeGen.UStrCat(qa, qb, qt)
  2124. END;
  2125. t := SymTab.NewUStr(); QbeGen.CopyOp(qt, q)
  2126. ELSE
  2127. lt := t; rt := t2;
  2128. IF (SymTab.ClassOf(lt) = SymTab.ClReal)
  2129. OR (SymTab.ClassOf(rt) = SymTab.ClReal) THEN
  2130. t := SymTab.RealType()
  2131. ELSIF SymTab.IsLongFamily(lt) OR SymTab.IsLongFamily(rt) THEN
  2132. t := SymTab.LongType()
  2133. ELSE t := SymTab.IntType()
  2134. END;
  2135. isL := SymTab.IsLongFamily(t);
  2136. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  2137. kind := 0;
  2138. IF op = AST.OpSub THEN kind := 1
  2139. ELSIF op = AST.OpMul THEN kind := 2
  2140. ELSIF op = AST.OpDiv THEN kind := 3
  2141. ELSIF op = AST.OpMod THEN kind := 4
  2142. END;
  2143. folded := FALSE;
  2144. IF (NOT isL) AND (NOT isR) AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  2145. folded := QbeGen.Fold2(kind, q, q2, qf)
  2146. END;
  2147. IF folded THEN QbeGen.CopyOp(qf, q)
  2148. ELSE
  2149. IF isL THEN
  2150. IF SymTab.IsIntFamily(lt) THEN
  2151. QbeGen.WidenLong(q, qw); QbeGen.CopyOp(qw, q)
  2152. END;
  2153. IF SymTab.IsIntFamily(rt) THEN
  2154. QbeGen.WidenLong(q2, qw); QbeGen.CopyOp(qw, q2)
  2155. END;
  2156. QbeGen.NewTemp(qt);
  2157. IF op = AST.OpAdd THEN QbeGen.Op3L("add", qt, q, q2)
  2158. ELSIF op = AST.OpSub THEN QbeGen.Op3L("sub", qt, q, q2)
  2159. ELSIF op = AST.OpMul THEN QbeGen.Op3L("mul", qt, q, q2)
  2160. ELSE QbeGen.Op3L("div", qt, q, q2)
  2161. END
  2162. ELSE
  2163. QbeGen.NewTemp(qt);
  2164. IF op = AST.OpAdd THEN QbeGen.Op3("add", qt, q, q2, isR)
  2165. ELSIF op = AST.OpSub THEN QbeGen.Op3("sub", qt, q, q2, isR)
  2166. ELSIF op = AST.OpMul THEN QbeGen.Op3("mul", qt, q, q2, isR)
  2167. ELSIF op = AST.OpDiv THEN QbeGen.Op3("div", qt, q, q2, isR)
  2168. ELSE QbeGen.Op3("rem", qt, q, q2, isR)
  2169. END
  2170. END;
  2171. QbeGen.CopyOp(qt, q)
  2172. END
  2173. END
  2174. END
  2175. END
  2176. END LowerExprFull;
  2177. PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex;
  2178. VAR q: QbeGen.QVal);
  2179. VAR k: INTEGER; qn: SymTab.Name; sfx: BOOLEAN;
  2180. BEGIN
  2181. LowerExprFull(n, t, q, k, qn, sfx, FALSE)
  2182. END LowerExpr;
  2183. PROCEDURE LowerStmt (seq: AST.Node);
  2184. VAR i: CARDINAL; c, els, by: AST.Node; k: INTEGER;
  2185. t, t2, t3, dt, et: SymTab.TypeIndex;
  2186. q, q2, qt, qf, qd, qe: QbeGen.QVal;
  2187. qlo, qhi, qk, qb, ql, qby: QbeGen.QVal; step: INTEGER;
  2188. lTop, lBody, lEnd, lThen, lElse, lNext, lFalse, lDone, lx: QbeGen.QVal;
  2189. qn, lv: SymTab.Name;
  2190. kind, op, rop, cls: INTEGER;
  2191. sfx, folded, isR, conv, wconv, hasElse: BOOLEAN;
  2192. BEGIN
  2193. IF seq = AST.NoNode THEN RETURN END;
  2194. k := AST.Kind(seq);
  2195. IF k = AST.NkBlock THEN
  2196. i := 0;
  2197. WHILE i < AST.NChild(seq) DO
  2198. LowerStmt(AST.Child(seq, i)); INC(i)
  2199. END
  2200. ELSIF k = AST.NkAssign THEN
  2201. LowerDesign(AST.Child(seq, 0), dt, cls, qd, qn, sfx);
  2202. LowerExpr(AST.Child(seq, 1), et, qe);
  2203. IF (dt # SymTab.InvalidType) AND (et # SymTab.InvalidType)
  2204. AND SymTab.IsEmptyStr(et)
  2205. AND (SymTab.ClassOf(dt) = SymTab.ClChar) THEN
  2206. (* ISO: the empty string assigned to CHAR is the terminator *)
  2207. QbeGen.CopyOp("0", qe); et := SymTab.CharType()
  2208. END;
  2209. isR := (dt # SymTab.InvalidType) AND (SymTab.ClassOf(dt) = SymTab.ClReal);
  2210. conv := isR AND SymTab.IsIntFamily(et);
  2211. wconv := (dt # SymTab.InvalidType) AND SymTab.IsLongFamily(dt)
  2212. AND SymTab.IsIntFamily(et);
  2213. IF sfx OR (cls = SymTab.KindField) THEN
  2214. IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  2215. IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
  2216. AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
  2217. ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
  2218. ELSE QbeGen.CopyArray(qd, qe, dt)
  2219. END
  2220. ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
  2221. QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et))
  2222. ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
  2223. QbeGen.CopyRecord(qd, qe, dt)
  2224. ELSIF SymTab.IsLongFamily(dt) THEN
  2225. IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.ElemStore(qd, ql, dt)
  2226. ELSE QbeGen.ElemStore(qd, qe, dt)
  2227. END
  2228. ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.ElemStore(qd, qt, dt)
  2229. ELSE QbeGen.ElemStore(qd, qe, dt)
  2230. END
  2231. ELSE
  2232. IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  2233. IF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
  2234. AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
  2235. ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
  2236. ELSE QbeGen.CopyArray(qd, qe, dt)
  2237. END
  2238. ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
  2239. QbeGen.CopySet(qd, qe, SymTab.SetWords(dt), SymTab.SetWords(et))
  2240. ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
  2241. QbeGen.CopyRecord(qd, qe, dt)
  2242. ELSIF SymTab.IsSmallInt(dt) THEN
  2243. QbeGen.StoreShortVar(qn, SymTab.SmallIntBytes(dt), qe)
  2244. ELSIF (SymTab.ClassOf(dt) = SymTab.ClPtr)
  2245. OR (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
  2246. QbeGen.StorePtr(qn, qe)
  2247. ELSIF SymTab.IsLongFamily(dt) THEN
  2248. IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.StoreLong(qn, ql)
  2249. ELSE QbeGen.StoreLong(qn, qe)
  2250. END
  2251. ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.StoreVar(qn, qt, TRUE)
  2252. ELSE QbeGen.StoreVar(qn, qe, isR)
  2253. END
  2254. END
  2255. ELSIF k = AST.NkIf THEN
  2256. LowerExpr(AST.Child(seq, 0), t, q);
  2257. QbeGen.NewLabel(lThen); QbeGen.NewLabel(lElse); QbeGen.NewLabel(lEnd);
  2258. QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen);
  2259. LowerStmt(AST.Child(seq, 1));
  2260. QbeGen.Jmp(lEnd);
  2261. els := AST.Child(seq, 2); hasElse := FALSE;
  2262. WHILE (els # AST.NoNode) AND (AST.Kind(els) = AST.NkIf) DO
  2263. QbeGen.EmitLabel(lElse); QbeGen.NewLabel(lElse);
  2264. LowerExpr(AST.Child(els, 0), t, q);
  2265. QbeGen.NewLabel(lThen); QbeGen.Jnz(q, lThen, lElse);
  2266. QbeGen.EmitLabel(lThen);
  2267. LowerStmt(AST.Child(els, 1));
  2268. QbeGen.Jmp(lEnd);
  2269. els := AST.Child(els, 2)
  2270. END;
  2271. IF els # AST.NoNode THEN
  2272. QbeGen.EmitLabel(lElse); hasElse := TRUE; LowerStmt(els)
  2273. END;
  2274. IF hasElse THEN QbeGen.EmitLabel(lEnd)
  2275. ELSE QbeGen.EmitLabel(lElse); QbeGen.EmitLabel(lEnd)
  2276. END
  2277. ELSIF k = AST.NkWhile THEN
  2278. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd);
  2279. QbeGen.EmitLabel(lTop);
  2280. LowerExpr(AST.Child(seq, 0), t, q);
  2281. QbeGen.Jnz(q, lBody, lEnd); QbeGen.EmitLabel(lBody);
  2282. LowerStmt(AST.Child(seq, 1));
  2283. QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd)
  2284. ELSIF k = AST.NkRepeat THEN
  2285. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd); QbeGen.EmitLabel(lTop);
  2286. LowerStmt(AST.Child(seq, 0));
  2287. LowerExpr(AST.Child(seq, 1), t, q);
  2288. QbeGen.Jnz(q, lEnd, lTop); QbeGen.EmitLabel(lEnd)
  2289. ELSIF k = AST.NkLoop THEN
  2290. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd);
  2291. QbeGen.PushLoop(lEnd); QbeGen.EmitLabel(lTop);
  2292. LowerStmt(AST.Child(seq, 0));
  2293. QbeGen.Jmp(lTop); QbeGen.PopLoop; QbeGen.EmitLabel(lEnd)
  2294. ELSIF k = AST.NkExit THEN
  2295. IF QbeGen.TopLoop(lx) THEN QbeGen.Jmp(lx) END
  2296. ELSIF k = AST.NkFor THEN
  2297. Name(AST.Child(seq, 0), lv);
  2298. LowerExpr(AST.Child(seq, 1), t, qlo);
  2299. LowerExpr(AST.Child(seq, 2), t2, qhi);
  2300. IF SymTab.IsEmptyStr(t) THEN
  2301. QbeGen.CopyOp("0", qlo); t := SymTab.CharType()
  2302. END;
  2303. IF SymTab.IsEmptyStr(t2) THEN
  2304. QbeGen.CopyOp("0", qhi); t2 := SymTab.CharType()
  2305. END;
  2306. (* optional BY step: a constant, default +1; its sign also
  2307. selects the termination comparison *)
  2308. step := 1;
  2309. IF AST.Child(seq, 3) # AST.NoNode THEN
  2310. LowerExpr(AST.Child(seq, 3), t3, qby);
  2311. IF NOT SymTab.ConstInt(qby, step) THEN step := 1
  2312. ELSIF step = 0 THEN step := 1
  2313. END
  2314. END;
  2315. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2316. QbeGen.StoreShortVar(lv,
  2317. SymTab.SmallIntBytes(SymTab.SymType(lv)), qlo)
  2318. ELSE QbeGen.StoreVar(lv, qlo, FALSE)
  2319. END;
  2320. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd);
  2321. QbeGen.EmitLabel(lTop);
  2322. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2323. QbeGen.LoadShortVar(lv,
  2324. SymTab.IsSignedSmallInt(SymTab.SymType(lv)),
  2325. SymTab.SmallIntBytes(SymTab.SymType(lv)), qt)
  2326. ELSE QbeGen.LoadVar(lv, FALSE, qt)
  2327. END;
  2328. QbeGen.NewTemp(qk);
  2329. IF step > 0 THEN QbeGen.Op3("cslew", qk, qt, qhi, FALSE)
  2330. ELSE QbeGen.Op3("csgew", qk, qt, qhi, FALSE)
  2331. END;
  2332. QbeGen.Jnz(qk, lBody, lEnd);
  2333. QbeGen.EmitLabel(lBody);
  2334. LowerStmt(AST.Child(seq, 4));
  2335. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2336. QbeGen.LoadShortVar(lv,
  2337. SymTab.IsSignedSmallInt(SymTab.SymType(lv)),
  2338. SymTab.SmallIntBytes(SymTab.SymType(lv)), qt)
  2339. ELSE QbeGen.LoadVar(lv, FALSE, qt)
  2340. END;
  2341. QbeGen.IntStr(step, qb);
  2342. QbeGen.NewTemp(qk);
  2343. QbeGen.Op3("add", qk, qt, qb, FALSE);
  2344. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2345. QbeGen.StoreShortVar(lv,
  2346. SymTab.SmallIntBytes(SymTab.SymType(lv)), qk)
  2347. ELSE QbeGen.StoreVar(lv, qk, FALSE)
  2348. END;
  2349. QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd)
  2350. ELSIF k = AST.NkHalt THEN
  2351. IF AST.Child(seq, 0) # AST.NoNode THEN
  2352. LowerExpr(AST.Child(seq, 0), t, q) END;
  2353. QbeGen.HaltQ
  2354. ELSIF k = AST.NkGoto THEN
  2355. Name(AST.Child(seq, 0), qn);
  2356. UserLabel(qn, q);
  2357. QbeGen.Jmp(q)
  2358. ELSIF k = AST.NkLabel THEN
  2359. Name(AST.Child(seq, 0), qn);
  2360. UserLabel(qn, q);
  2361. QbeGen.EmitLabel(q)
  2362. ELSIF k = AST.NkReturn THEN
  2363. IF AST.Child(seq, 0) = AST.NoNode THEN
  2364. QbeGen.EmitRet(q, FALSE)
  2365. ELSE
  2366. LowerExpr(AST.Child(seq, 0), t, q);
  2367. IF SymTab.IsEmptyStr(t)
  2368. AND (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs))
  2369. AND (SymTab.ClassOf(procRes[emitProc]) = SymTab.ClChar) THEN
  2370. QbeGen.CopyOp("0", q); t := SymTab.CharType()
  2371. END;
  2372. IF (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs))
  2373. AND CompositeRes(procRes[emitProc]) THEN
  2374. (* composite result: copy into the hidden destination *)
  2375. QbeGen.AddrOf("__res", qt);
  2376. IF SymTab.ClassOf(procRes[emitProc]) = SymTab.ClArray THEN
  2377. QbeGen.CopyArray(qt, q, procRes[emitProc])
  2378. ELSIF SymTab.ClassOf(procRes[emitProc]) = SymTab.ClSet THEN
  2379. QbeGen.CopySet(qt, q, SymTab.SetWords(procRes[emitProc]),
  2380. SymTab.SetWords(procRes[emitProc]))
  2381. ELSE QbeGen.CopyRecord(qt, q, procRes[emitProc])
  2382. END;
  2383. QbeGen.EmitRet("0", FALSE)
  2384. ELSE
  2385. conv := (SymTab.ClassOf(SymTab.CurRes()) = SymTab.ClReal)
  2386. AND SymTab.IsIntFamily(t);
  2387. IF conv THEN QbeGen.ConvIR(q, qt); QbeGen.EmitRet(qt, TRUE)
  2388. ELSE QbeGen.EmitRet(q, TRUE)
  2389. END
  2390. END
  2391. END
  2392. ELSIF k = AST.NkCase THEN LowerCase(seq)
  2393. ELSIF k = AST.NkWith THEN LowerWith(seq)
  2394. ELSIF k = AST.NkCall THEN
  2395. IF IsMethodCall(seq) THEN LowerMethodCall(seq, t, q, FALSE)
  2396. ELSE
  2397. CalleeName(seq, qn);
  2398. IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
  2399. ELSE LowerCall(seq, t, q, FALSE)
  2400. END
  2401. END
  2402. END
  2403. END LowerStmt;
  2404. PROCEDURE ReenterGlobals (seq: AST.Node);
  2405. (* Re-registers a nested module's non-exported globals in the enclosing
  2406. (still-open) module scope, so QbeGen.GlobalRef can resolve their
  2407. "<outer>_<name>" symbols after the nested scope has been popped. *)
  2408. VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name; chunk, vn: AST.Node;
  2409. BEGIN
  2410. IF seq = AST.NoNode THEN RETURN END;
  2411. i := 0;
  2412. WHILE i < AST.NChild(seq) DO
  2413. c := AST.Child(seq, i);
  2414. IF i = AST.MaxChild - 1 THEN ReenterGlobals(c)
  2415. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN ReenterGlobals(c)
  2416. ELSIF AST.Kind(c) = AST.NkVarDecl THEN
  2417. chunk := c;
  2418. WHILE chunk # AST.NoNode DO
  2419. j := 0;
  2420. WHILE j < AST.NChild(chunk) DO
  2421. vn := AST.Child(chunk, j);
  2422. IF AST.Kind(vn) = AST.NkIdent THEN
  2423. Name(vn, nm);
  2424. IF SymTab.ReenterModGlobal(nm, SymTab.KindVar, curUnitName) THEN
  2425. SymTab.SetSymType(nm, AST.Ty(c))
  2426. END
  2427. END;
  2428. INC(j)
  2429. END;
  2430. IF AST.NChild(chunk) > 0 THEN
  2431. vn := AST.Child(chunk, AST.NChild(chunk) - 1);
  2432. IF AST.Kind(vn) = AST.NkBlock THEN chunk := vn
  2433. ELSE chunk := AST.NoNode END
  2434. ELSE chunk := AST.NoNode END
  2435. END
  2436. ELSIF (AST.Kind(c) = AST.NkTypeDecl)
  2437. OR (AST.Kind(c) = AST.NkClassDecl) THEN
  2438. (* a nested module's TYPE/CLASS: re-register it so ObjectSize and
  2439. GlobalRef can resolve it after the nested scope is popped *)
  2440. IF AST.NChild(c) >= 1 THEN
  2441. Name(AST.Child(c, 0), nm);
  2442. IF SymTab.ReenterModGlobal(nm, SymTab.KindType, curUnitName) THEN
  2443. SymTab.SetSymType(nm, AST.Ty(c))
  2444. END
  2445. END
  2446. END;
  2447. INC(i)
  2448. END
  2449. END ReenterGlobals;
  2450. PROCEDURE ReenterImports (seq: AST.Node);
  2451. (* A nested module's FROM-imports live in its (now popped) scope. Copy
  2452. them into the enclosing scope so lowering the nested module's
  2453. declarations and body can still resolve the imported names. *)
  2454. VAR i, j: CARDINAL;
  2455. c, cn: AST.Node;
  2456. mod, nm: SymTab.Name;
  2457. BEGIN
  2458. IF seq = AST.NoNode THEN RETURN END;
  2459. i := 0;
  2460. WHILE i < AST.NChild(seq) DO
  2461. c := AST.Child(seq, i);
  2462. IF i = AST.MaxChild - 1 THEN ReenterImports(c)
  2463. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN ReenterImports(c)
  2464. ELSIF (AST.Kind(c) = AST.NkImport) AND (AST.NChild(c) >= 1) THEN
  2465. Name(AST.Child(c, 0), mod);
  2466. IF SymTab.Equal(mod, "libc") THEN
  2467. j := 1;
  2468. WHILE j < AST.NChild(c) DO
  2469. cn := AST.Child(c, j);
  2470. IF AST.Kind(cn) = AST.NkIdent THEN
  2471. Name(cn, nm);
  2472. IF SymTab.DeclareCProc(nm) THEN NoteCProc(nm) END
  2473. END;
  2474. INC(j)
  2475. END
  2476. ELSIF SymTab.ModKnown(mod)
  2477. AND NOT SymTab.Equal(mod, "SYSTEM") THEN
  2478. j := 1;
  2479. WHILE j < AST.NChild(c) DO
  2480. cn := AST.Child(c, j);
  2481. IF AST.Kind(cn) = AST.NkIdent THEN
  2482. Name(cn, nm);
  2483. (* plain IMPORT lists modules; only FROM adds names *)
  2484. IF SymTab.SymKind(nm) # SymTab.KindModule THEN
  2485. IF NOT SymTab.ImportFrom(mod, nm) THEN END
  2486. END
  2487. END;
  2488. INC(j)
  2489. END
  2490. END
  2491. END;
  2492. INC(i)
  2493. END
  2494. END ReenterImports;
  2495. PROCEDURE EmitVarNames (c: AST.Node);
  2496. (* Emit DeclVar for each name of an NkVarDecl; the names are a chunked
  2497. sequence (AstAppend), so follow NkBlock continuations. *)
  2498. VAR j: CARDINAL; chunk, vn: AST.Node; nm: SymTab.Name;
  2499. BEGIN
  2500. chunk := c;
  2501. WHILE chunk # AST.NoNode DO
  2502. j := 0;
  2503. WHILE j < AST.NChild(chunk) DO
  2504. vn := AST.Child(chunk, j);
  2505. IF AST.Kind(vn) = AST.NkIdent THEN
  2506. Name(vn, nm);
  2507. QbeGen.DeclVar(nm, AST.Ty(c));
  2508. IF (NOT QbeGen.InFunction())
  2509. AND (SymTab.ClassOf(AST.Ty(c)) = SymTab.ClArray)
  2510. AND QbeGen.RecArrayNeedsInit(SymTab.ArrayLen(AST.Ty(c)),
  2511. AST.Ty(c))
  2512. AND (nCountInit <= HIGH(countArr)) THEN
  2513. QbeGen.DeclRecTemplate(nm, SymTab.ArrayElem(AST.Ty(c)));
  2514. countArr[nCountInit] := nm;
  2515. countTyp[nCountInit] := AST.Ty(c);
  2516. INC(nCountInit)
  2517. END
  2518. END;
  2519. INC(j)
  2520. END;
  2521. IF AST.NChild(chunk) > 0 THEN
  2522. vn := AST.Child(chunk, AST.NChild(chunk) - 1);
  2523. IF AST.Kind(vn) = AST.NkBlock THEN chunk := vn
  2524. ELSE chunk := AST.NoNode END
  2525. ELSE chunk := AST.NoNode END
  2526. END
  2527. END EmitVarNames;
  2528. PROCEDURE EmitCountInits;
  2529. (* Initialise the length words of record-array globals that were emitted
  2530. compactly (recorded by EmitVarNames). *)
  2531. VAR k: CARDINAL;
  2532. BEGIN
  2533. k := 0;
  2534. WHILE k < nCountInit DO
  2535. QbeGen.InitRecArray(countArr[k], countTyp[k]);
  2536. INC(k)
  2537. END
  2538. END EmitCountInits;
  2539. PROCEDURE LowerDecls (seq: AST.Node);
  2540. VAR i, j: CARDINAL; c: AST.Node; nm, txt, gn: SymTab.Name; qv: QbeGen.QVal;
  2541. mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  2542. ext, pv: BOOLEAN; kk: INTEGER; ct: SymTab.TypeIndex; savedProc: INTEGER;
  2543. chunk, vn: AST.Node; pi: INTEGER;
  2544. mk: ARRAY [0 .. MaxCFoldW - 1] OF CARDINAL; mw: CARDINAL; mlo: INTEGER;
  2545. BEGIN
  2546. IF seq = AST.NoNode THEN RETURN END;
  2547. i := 0;
  2548. WHILE i < AST.NChild(seq) DO
  2549. c := AST.Child(seq, i);
  2550. IF i = AST.MaxChild - 1 THEN LowerDecls(c)
  2551. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDecls(c)
  2552. ELSIF AST.Kind(c) = AST.NkClassDecl THEN
  2553. Name(AST.Child(c, 0), nm);
  2554. IF Resolve(nm, kk, ct) THEN
  2555. IF SymTab.ClassOf(ct) = SymTab.ClClass THEN
  2556. IF AST.Op(c) = 1 THEN
  2557. LowerMethods(AST.Child(c, 3), ct);
  2558. IF AST.Child(c, 2) # AST.NoNode THEN
  2559. QbeGen.BeginInit(nm);
  2560. LowerStmt(AST.Child(c, 2));
  2561. QbeGen.EndInit
  2562. END
  2563. ELSE
  2564. LowerMethodHeadings(AST.Child(c, 3), ct)
  2565. END
  2566. END
  2567. END
  2568. ELSIF AST.Kind(c) = AST.NkUnit THEN
  2569. Name(AST.Child(c, 0), nm);
  2570. ReenterImports(AST.Child(c, 3));
  2571. ReenterGlobals(AST.Child(c, 1));
  2572. LowerDecls(AST.Child(c, 1));
  2573. IF AST.Child(c, 2) # AST.NoNode THEN
  2574. QbeGen.BeginInit(nm);
  2575. LowerStmt(AST.Child(c, 2));
  2576. QbeGen.EndInit
  2577. END
  2578. ELSIF AST.Kind(c) = AST.NkVarDecl THEN
  2579. (* op=1 marks a forward-typed global: emit it after the rest,
  2580. as the grammar's FlushPend does *)
  2581. IF AST.Op(c) # 1 THEN EmitVarNames(c) END
  2582. ELSIF AST.Kind(c) = AST.NkConstDecl THEN
  2583. Name(AST.Child(c, 0), nm);
  2584. kk := SymTab.ClassOf(AST.Ty(c));
  2585. IF kk = SymTab.ClSet THEN
  2586. (* SET CONST: static data from the mask the grammar computed.
  2587. A module-level const is emitted under its global name
  2588. (<unit>_<name>) so a client's qualified reference binds. *)
  2589. IF LookupSetMask(nm, mk, mw, mlo) THEN
  2590. IF SymTab.GlobalRef(nm, gn) THEN
  2591. QbeGen.PoolSetNamed(gn, mk, mw, qv)
  2592. ELSE QbeGen.PoolSet(mk, mw, qv)
  2593. END;
  2594. SetConstVal(nm, qv)
  2595. ELSE SetConstVal(nm, "0")
  2596. END
  2597. ELSIF (kk = SymTab.ClArray) OR (kk = SymTab.ClRecord)
  2598. OR (kk = SymTab.ClClass) OR (kk = SymTab.ClStr)
  2599. OR (kk = SymTab.ClUStr) THEN
  2600. (* aggregate/string CONST: re-emit the constructor/string so
  2601. its static data is produced (the grammar's CtorEnd/DeclStr
  2602. are suppressed under NoEmit), then refresh the value *)
  2603. LowerExpr(AST.Child(c, 1), ct, qv);
  2604. SetConstVal(nm, qv)
  2605. ELSIF GetConstVal(nm, qv) AND QbeGen.IsImm(qv) THEN
  2606. (* scalar: use the evaluated value recorded by NoteConstVal *)
  2607. QbeGen.DeclConst(nm, qv, AST.Ty(c))
  2608. END
  2609. ELSIF AST.Kind(c) = AST.NkProcDecl THEN
  2610. Name(AST.Child(c, 0), nm);
  2611. pi := AST.Ty(c); (* proc-table index recorded by NoteProcNode *)
  2612. IF (pi < 0) OR (pi >= VAL(INTEGER, nProcs)) THEN pi := FindProc(nm) END;
  2613. IF ProcInfoIdx(pi, uid, res, depth, ext, np) THEN
  2614. QbeGen.Mangled(nm, uid, mg);
  2615. QbeGen.BeginFunc(mg);
  2616. IF CompositeRes(res) THEN
  2617. IF NOT QbeGen.FuncParam("__res", TRUE, res) THEN END
  2618. END;
  2619. j := 0;
  2620. WHILE j < np DO
  2621. IF ParamInfoIdx(pi, j, pt, pv, txt) THEN
  2622. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END
  2623. END;
  2624. INC(j)
  2625. END;
  2626. QbeGen.SetFuncRes(res);
  2627. IF AST.Child(c, 1) = AST.NoNode THEN
  2628. (* declaration-only (definition module): replay the heading *)
  2629. QbeGen.AbortFunc
  2630. ELSE
  2631. QbeGen.EndFuncHeader;
  2632. savedProc := emitProc;
  2633. emitProc := pi;
  2634. LowerDecls(AST.Child(c, 2));
  2635. nUserLab := 0;
  2636. LowerStmt(AST.Child(c, 1));
  2637. emitProc := savedProc;
  2638. QbeGen.EndFunc(res)
  2639. END
  2640. END
  2641. END;
  2642. INC(i)
  2643. END
  2644. END LowerDecls;
  2645. PROCEDURE MaterializeGlobals (unitName: ARRAY OF CHAR; decls: AST.Node);
  2646. (* Make a unit's module-level VAR/CONST visible in the (global) scope
  2647. Lower runs in at session end, so GlobalRef resolves "<unit>_<name>". *)
  2648. VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name; chunk, vn: AST.Node;
  2649. BEGIN
  2650. IF decls = AST.NoNode THEN RETURN END;
  2651. i := 0;
  2652. WHILE i < AST.NChild(decls) DO
  2653. c := AST.Child(decls, i);
  2654. IF i = AST.MaxChild - 1 THEN MaterializeGlobals(unitName, c)
  2655. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN MaterializeGlobals(unitName, c)
  2656. ELSIF (AST.Kind(c) = AST.NkVarDecl) OR (AST.Kind(c) = AST.NkConstDecl) THEN
  2657. chunk := c;
  2658. WHILE chunk # AST.NoNode DO
  2659. j := 0;
  2660. WHILE j < AST.NChild(chunk) DO
  2661. vn := AST.Child(chunk, j);
  2662. IF AST.Kind(vn) = AST.NkIdent THEN
  2663. Name(vn, nm);
  2664. IF NOT SymTab.MaterializeReplace(unitName, nm) THEN END
  2665. END;
  2666. INC(j)
  2667. END;
  2668. IF AST.NChild(chunk) > 0 THEN
  2669. vn := AST.Child(chunk, AST.NChild(chunk) - 1);
  2670. IF AST.Kind(vn) = AST.NkBlock THEN chunk := vn
  2671. ELSE chunk := AST.NoNode END
  2672. ELSE chunk := AST.NoNode END
  2673. END
  2674. ELSIF (AST.Kind(c) = AST.NkTypeDecl) OR (AST.Kind(c) = AST.NkClassDecl) THEN
  2675. IF AST.NChild(c) >= 1 THEN
  2676. Name(AST.Child(c, 0), nm);
  2677. IF NOT SymTab.MaterializeReplace(unitName, nm) THEN END
  2678. END
  2679. END;
  2680. INC(i)
  2681. END
  2682. END MaterializeGlobals;
  2683. PROCEDURE LowerDeferredVars (seq: AST.Node);
  2684. (* Emit the forward-typed globals (NkVarDecl op=1) after the rest of the
  2685. unit's declarations, matching the grammar's FlushPend ordering. *)
  2686. VAR i: CARDINAL; c: AST.Node;
  2687. BEGIN
  2688. IF seq = AST.NoNode THEN RETURN END;
  2689. i := 0;
  2690. WHILE i < AST.NChild(seq) DO
  2691. c := AST.Child(seq, i);
  2692. IF i = AST.MaxChild - 1 THEN LowerDeferredVars(c)
  2693. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDeferredVars(c)
  2694. ELSIF (AST.Kind(c) = AST.NkVarDecl) AND (AST.Op(c) = 1) THEN
  2695. EmitVarNames(c)
  2696. END;
  2697. INC(i)
  2698. END
  2699. END LowerDeferredVars;
  2700. PROCEDURE LowerOneUnit (u: AST.Node; isProg: BOOLEAN);
  2701. VAR nm: SymTab.Name;
  2702. BEGIN
  2703. nCountInit := 0;
  2704. Name(AST.Child(u, 0), nm);
  2705. CopySpan(nm, curUnitName, 0, 0);
  2706. QbeGen.SetModule(nm);
  2707. MaterializeGlobals(nm, AST.Child(u, 1));
  2708. LowerDecls(AST.Child(u, 1));
  2709. LowerDeferredVars(AST.Child(u, 1));
  2710. IF isProg THEN
  2711. QbeGen.BeginBody;
  2712. EmitCountInits;
  2713. nUserLab := 0;
  2714. LowerStmt(AST.Child(u, 2))
  2715. ELSIF AST.Child(u, 2) # AST.NoNode THEN
  2716. QbeGen.BeginInit(nm);
  2717. EmitCountInits;
  2718. nUserLab := 0;
  2719. LowerStmt(AST.Child(u, 2));
  2720. QbeGen.EndInit
  2721. ELSIF nCountInit > 0 THEN
  2722. QbeGen.BeginInit(nm);
  2723. EmitCountInits;
  2724. QbeGen.EndInit
  2725. END
  2726. END LowerOneUnit;
  2727. PROCEDURE BeginSession (progName: ARRAY OF CHAR);
  2728. (* Per-unit Lower emission. The grammar still runs its inline emit while
  2729. parsing, but under NoEmit it only mutates QbeGen's counters (nothing
  2730. reaches the buffer). For each unit: BeginUnit snapshots the state
  2731. *before* parsing; after parsing, LowerUnitNow restores that snapshot
  2732. and lets Lower re-emit the unit from the same counter values the
  2733. legacy inline path would have used, so the image stays byte-identical.
  2734. EndSession writes the accumulated session image. *)
  2735. BEGIN
  2736. withTop := 0;
  2737. curImplCls := SymTab.InvalidType;
  2738. scopeTop := 0; curScopeProc := -1; emitProc := -1;
  2739. QbeGen.OpenModule(progName);
  2740. QbeGen.SetNoEmit(TRUE)
  2741. END BeginSession;
  2742. PROCEDURE BeginUnit;
  2743. (* Snapshot the pre-parse state so Lower can discard the grammar's
  2744. suppressed inline mutations for this unit. *)
  2745. BEGIN
  2746. nImps := 0;
  2747. QbeGen.SaveSession
  2748. END BeginUnit;
  2749. PROCEDURE LowerUnitNow (unit: AST.Node; isProg: BOOLEAN);
  2750. VAR nm: SymTab.Name; scoped: BOOLEAN;
  2751. BEGIN
  2752. IF unit = AST.NoNode THEN RETURN END;
  2753. QbeGen.RestoreSession;
  2754. QbeGen.SetNoEmit(FALSE);
  2755. (* Lower the unit in its own module scope, so type lookups resolve
  2756. locally and nothing needs to be copied into globScope. *)
  2757. Name(AST.Child(unit, 0), nm);
  2758. scoped := SymTab.EnterLowerScope(nm);
  2759. LowerOneUnit(unit, isProg);
  2760. IF scoped THEN SymTab.LeaveLowerScope END;
  2761. QbeGen.SetNoEmit(TRUE)
  2762. END LowerUnitNow;
  2763. PROCEDURE EndSession;
  2764. VAR scoped: BOOLEAN;
  2765. BEGIN
  2766. QbeGen.SetNoEmit(FALSE);
  2767. (* EndModule probes the program module's ExitCode symbol. *)
  2768. scoped := SymTab.EnterLowerScope(curUnitName);
  2769. QbeGen.EndModule(curUnitName);
  2770. IF scoped THEN SymTab.LeaveLowerScope END
  2771. END EndSession;
  2772. BEGIN
  2773. scopeTop := 0; curScopeProc := -1; emitProc := -1
  2774. END Lower.