Lower.mod 125 KB

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