Lower.mod 125 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306
  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. BEGIN
  1564. IF SymTab.Equal(nm, "ODD") THEN
  1565. LowerExpr(AST.Child(n, 1), et, q);
  1566. QbeGen.NewTemp(qt);
  1567. QbeGen.Op3("and", qt, q, "1", FALSE); (* x & 1 *)
  1568. QbeGen.NewTemp(qa);
  1569. QbeGen.Cmp(SymTab.OpNeq1, qt, "0", qa, FALSE); (* <> 0 *)
  1570. QbeGen.CopyOp(qa, q); t := SymTab.BoolType()
  1571. ELSIF SymTab.Equal(nm, "ABS") THEN
  1572. LowerExpr(AST.Child(n, 1), et, q);
  1573. QbeGen.AbsQ(q, qa, SymTab.IsRealType(et));
  1574. QbeGen.CopyOp(qa, q); t := et
  1575. ELSIF SymTab.Equal(nm, "CAP") THEN
  1576. LowerExpr(AST.Child(n, 1), et, q);
  1577. QbeGen.CapQ(q, qa); QbeGen.CopyOp(qa, q); t := SymTab.CharType()
  1578. ELSIF SymTab.Equal(nm, "CHR") THEN
  1579. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.CharType()
  1580. ELSIF SymTab.Equal(nm, "ORD") THEN
  1581. LowerExpr(AST.Child(n, 1), et, q);
  1582. IF SymTab.IsPackedSet(et) THEN
  1583. QbeGen.LoadPacked(q, et, qa); QbeGen.CopyOp(qa, q)
  1584. END;
  1585. t := SymTab.IntType()
  1586. ELSIF SymTab.Equal(nm, "UCHR") THEN
  1587. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.UCharType()
  1588. ELSIF SymTab.Equal(nm, "CHR8") THEN
  1589. LowerExpr(AST.Child(n, 1), et, q);
  1590. QbeGen.WidenLong(q, qa); QbeGen.CheckRange(qa, "0", "255");
  1591. t := SymTab.CharType()
  1592. ELSIF SymTab.Equal(nm, "UORD") THEN
  1593. LowerExpr(AST.Child(n, 1), et, q); t := SymTab.IntType()
  1594. ELSIF SymTab.Equal(nm, "SIZE") OR SymTab.Equal(nm, "TSIZE") THEN
  1595. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1596. IF (dt # SymTab.InvalidType)
  1597. AND (SymTab.ClassOf(dt) = SymTab.ClArray) THEN
  1598. IF lastView THEN
  1599. QbeGen.ViewSize(qd, q)
  1600. ELSIF SymTab.IsOpenArray(dt) THEN
  1601. QbeGen.OpenSize(qd, dt, q)
  1602. ELSIF SymTab.IsMultiArray(dt) THEN
  1603. QbeGen.IntStr(VAL(INTEGER, SymTab.ArrayPayloadSize(dt)), q)
  1604. ELSE
  1605. QbeGen.IntStr(VAL(INTEGER,
  1606. SymTab.ArrayLen(dt) * SymTab.ArrayLeafBytes(dt)), q)
  1607. END
  1608. ELSE
  1609. QbeGen.IntStr(VAL(INTEGER, SymTab.ObjectSize(dt)), q)
  1610. END;
  1611. t := SymTab.IntType()
  1612. ELSIF SymTab.Equal(nm, "MIN") OR SymTab.Equal(nm, "MAX") THEN
  1613. isMax := SymTab.Equal(nm, "MAX");
  1614. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1615. IF SymTab.ClassOf(dt) = SymTab.ClSReal THEN
  1616. IF isMax THEN QbeGen.NormReal("3.402823e38", q)
  1617. ELSE QbeGen.NormReal("-3.402823e38", q) END;
  1618. t := SymTab.ShortRealType()
  1619. ELSIF SymTab.ClassOf(dt) = SymTab.ClReal THEN
  1620. IF isMax THEN QbeGen.NormReal("1.7976931348623157e308", q)
  1621. ELSE QbeGen.NormReal("-1.7976931348623157e308", q) END;
  1622. t := SymTab.RealType()
  1623. ELSIF SymTab.ClassOf(dt) = SymTab.ClLong THEN
  1624. IF isMax THEN QbeGen.CopyOp("9223372036854775807", q)
  1625. ELSE QbeGen.CopyOp("-9223372036854775808", q) END;
  1626. t := SymTab.LongType()
  1627. ELSIF SymTab.TypeBounds(dt, lo, hi) THEN
  1628. IF isMax THEN QbeGen.IntStr(hi, q) ELSE QbeGen.IntStr(lo, q) END;
  1629. t := SymTab.IntType()
  1630. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1631. END
  1632. ELSIF SymTab.Equal(nm, "LEN") OR SymTab.Equal(nm, "HIGH") THEN
  1633. IF AST.Kind(AST.Child(n, 1)) = AST.NkStrLit THEN
  1634. (* LEN("literal"): the content length of the literal; a real
  1635. string literal is still declared, as the grammar does *)
  1636. Name(AST.Child(n, 1), qn);
  1637. IF (qn[0] = "U") OR (qn[0] = "u") THEN
  1638. QbeGen.DeclUStr(qn, qd, isU, ucp, uok);
  1639. IF NOT uok THEN t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1640. ELSIF isU THEN
  1641. IF SymTab.Equal(nm, "HIGH") THEN QbeGen.CopyOp("0", q)
  1642. ELSE QbeGen.CopyOp("1", q)
  1643. END;
  1644. t := SymTab.IntType()
  1645. ELSE
  1646. QbeGen.UStrLen(qd, qr);
  1647. IF SymTab.Equal(nm, "HIGH") THEN QbeGen.DecQ(qr) END;
  1648. QbeGen.CopyOp(qr, q); t := SymTab.IntType()
  1649. END
  1650. ELSE
  1651. IF SymTab.StrLen(qn) = 3 THEN c1 := 1
  1652. ELSE QbeGen.DeclStr(qn, qd); c1 := SymTab.StrLen(qn) - 2
  1653. END;
  1654. IF SymTab.Equal(nm, "HIGH") THEN DEC(c1) END;
  1655. QbeGen.IntStr(c1, q); t := SymTab.IntType()
  1656. END
  1657. ELSE
  1658. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1659. IF dt = SymTab.InvalidType THEN
  1660. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1661. ELSIF SymTab.ClassOf(dt) = SymTab.ClStr THEN
  1662. (* HIGH/LEN of a string CONST: the pooled literal knows its
  1663. length *)
  1664. IF QbeGen.StrLitLen(qd, c1) THEN
  1665. IF SymTab.Equal(nm, "HIGH") THEN DEC(c1) END;
  1666. QbeGen.IntStr(c1, q); t := SymTab.IntType()
  1667. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1668. END
  1669. ELSIF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  1670. IF SymTab.Equal(nm, "HIGH") THEN
  1671. IF SymTab.IsOpenArray(dt) THEN QbeGen.OpenHi(qd, q)
  1672. ELSE QbeGen.IntStr(SymTab.ArrayHi(dt), q) END
  1673. ELSE
  1674. IF SymTab.IsOpenArray(dt) THEN QbeGen.LoadCount(qd, q)
  1675. ELSE QbeGen.IntStr(VAL(INTEGER, SymTab.ArrayLen(dt)), q) END
  1676. END;
  1677. t := SymTab.IntType()
  1678. ELSE
  1679. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1680. END
  1681. END;
  1682. ELSIF SymTab.Equal(nm, "VAL") THEN
  1683. Name(AST.Child(n, 1), vn);
  1684. IF NOT SymTab.Lookup(vn) THEN
  1685. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1686. ELSE
  1687. vt := SymTab.SymType(vn);
  1688. LowerExpr(AST.Child(n, 2), et, q);
  1689. c1 := SymTab.ClassOf(et); c2 := SymTab.ClassOf(vt);
  1690. IF ((c1 = SymTab.ClInt) OR (c1 = SymTab.ClByte)
  1691. OR (c1 = SymTab.ClSByte) OR (c1 = SymTab.ClWord16)
  1692. OR (c1 = SymTab.ClSWord16))
  1693. AND (c2 = SymTab.ClLong) THEN
  1694. QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1695. ELSIF (c1 = SymTab.ClLong) AND ((c2 = SymTab.ClInt)
  1696. OR (c2 = SymTab.ClByte) OR (c2 = SymTab.ClSByte)
  1697. OR (c2 = SymTab.ClWord16) OR (c2 = SymTab.ClSWord16)) THEN
  1698. QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1699. ELSIF ((c1 = SymTab.ClInt) OR (c1 = SymTab.ClByte)
  1700. OR (c1 = SymTab.ClSByte) OR (c1 = SymTab.ClWord16)
  1701. OR (c1 = SymTab.ClSWord16))
  1702. AND ((c2 = SymTab.ClReal) OR (c2 = SymTab.ClSReal)) THEN
  1703. QbeGen.ConvIR(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1704. ELSIF (c1 = SymTab.ClLong)
  1705. AND ((c2 = SymTab.ClReal) OR (c2 = SymTab.ClSReal)) THEN
  1706. QbeGen.ConvLR(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1707. ELSIF ((c1 = SymTab.ClReal) OR (c1 = SymTab.ClSReal))
  1708. AND ((c2 = SymTab.ClInt)
  1709. OR (c2 = SymTab.ClByte) OR (c2 = SymTab.ClSByte)
  1710. OR (c2 = SymTab.ClWord16) OR (c2 = SymTab.ClSWord16)) THEN
  1711. QbeGen.ConvRI(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1712. ELSIF ((c1 = SymTab.ClReal) OR (c1 = SymTab.ClSReal))
  1713. AND (c2 = SymTab.ClLong) THEN
  1714. QbeGen.ConvRL(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1715. ELSIF ((c1 = SymTab.ClReal) OR (c1 = SymTab.ClSReal))
  1716. AND ((c2 = SymTab.ClReal) OR (c2 = SymTab.ClSReal)) THEN
  1717. t := vt
  1718. ELSIF (c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt) THEN
  1719. (* a set as its (first) machine word *)
  1720. QbeGen.LoadW(q, qa); QbeGen.CopyOp(qa, q); t := vt
  1721. ELSIF (c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet) THEN
  1722. (* a word as a set value: zero-filled one-word temp *)
  1723. c2 := SymTab.SetWords(vt);
  1724. IF c2 = 0 THEN c2 := 1 END;
  1725. QbeGen.NewSetTemp(VAL(CARDINAL, c2), qa);
  1726. QbeGen.SetZero(qa, VAL(CARDINAL, c2));
  1727. QbeGen.StoreW(qa, q); QbeGen.CopyOp(qa, q); t := vt
  1728. ELSE t := vt (* same representation: no-op *)
  1729. END
  1730. END
  1731. ELSIF SymTab.Equal(nm, "SHIFT") OR SymTab.Equal(nm, "ROTATE") THEN
  1732. LowerExpr(AST.Child(n, 1), et, q);
  1733. LowerExpr(AST.Child(n, 2), et2, q2);
  1734. QbeGen.SetShift(q, q2, SymTab.SetWords(et), SymTab.SetCount(et),
  1735. SymTab.Equal(nm, "ROTATE"), qt);
  1736. t := et; QbeGen.CopyOp(qt, q)
  1737. ELSIF SymTab.Equal(nm, "ADR") THEN
  1738. LowerDesign(AST.Child(n, 1), dt, k, qd, qn, sfx);
  1739. IF k = SymTab.KindProc THEN
  1740. LowerProcAddr(qn, q)
  1741. ELSIF lastView THEN
  1742. QbeGen.ViewBase(qd, q)
  1743. ELSIF (dt # SymTab.InvalidType)
  1744. AND (SymTab.ClassOf(dt) = SymTab.ClArray)
  1745. AND SymTab.IsOpenArray(dt) AND (NOT sfx) THEN
  1746. IF legacyOpen1D THEN QbeGen.DescData(qd, q)
  1747. ELSE QbeGen.ViewBase(qd, q)
  1748. END
  1749. ELSIF sfx THEN QbeGen.CopyOp(qd, q)
  1750. ELSIF (k = SymTab.KindVar) OR (k = SymTab.KindParam) THEN
  1751. QbeGen.AddrOf(qn, q)
  1752. ELSE QbeGen.CopyOp("0", q)
  1753. END;
  1754. t := SymTab.AddrType()
  1755. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  1756. END
  1757. END LowerBuiltinExpr;
  1758. PROCEDURE LowerBuiltinStmt (n: AST.Node; nm: SymTab.Name);
  1759. (* Statement builtins (AssOrCall): INC/DEC, INCL/EXCL, NEW/DISPOSE. *)
  1760. VAR dt, at, et2, bt: SymTab.TypeIndex; dk: INTEGER;
  1761. qd, qv, qe, qn2, qstep, qm: QbeGen.QVal;
  1762. qn: SymTab.Name; sfx, isInc: BOOLEAN;
  1763. BEGIN
  1764. IF SymTab.Equal(nm, "INC") OR SymTab.Equal(nm, "DEC") THEN
  1765. isInc := SymTab.Equal(nm, "INC");
  1766. QbeGen.CopyOp("1", qstep);
  1767. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1768. IF AST.NChild(n) > 2 THEN LowerExpr(AST.Child(n, 2), et2, qstep) END;
  1769. IF dt = SymTab.InvalidType THEN
  1770. ELSE
  1771. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
  1772. ELSIF SymTab.IsSmallInt(dt) THEN
  1773. QbeGen.LoadShortVar(qn, SymTab.IsSignedSmallInt(dt),
  1774. SymTab.SmallIntBytes(dt), qv)
  1775. ELSE QbeGen.LoadVar(qn, FALSE, qv)
  1776. END;
  1777. QbeGen.NewTemp(qn2);
  1778. IF isInc THEN QbeGen.Op3("add", qn2, qv, qstep, FALSE)
  1779. ELSE QbeGen.Op3("sub", qn2, qv, qstep, FALSE)
  1780. END;
  1781. CheckSub(dt, qn2);
  1782. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qn2, dt)
  1783. ELSIF SymTab.IsSmallInt(dt) THEN
  1784. QbeGen.StoreShortVar(qn, SymTab.SmallIntBytes(dt), qn2)
  1785. ELSE QbeGen.StoreVar(qn, qn2, FALSE)
  1786. END
  1787. END
  1788. ELSIF SymTab.Equal(nm, "INCL") OR SymTab.Equal(nm, "EXCL") THEN
  1789. isInc := SymTab.Equal(nm, "INCL");
  1790. LowerDesign(AST.Child(n, 1), at, dk, qd, qn, sfx);
  1791. LowerExpr(AST.Child(n, 2), et2, qe);
  1792. IF at = SymTab.InvalidType THEN
  1793. ELSIF SymTab.ClassOf(at) # SymTab.ClSet THEN
  1794. ELSE
  1795. IF SymTab.IsBigSet(at) THEN
  1796. IF isInc THEN QbeGen.BigSetBit(qd, qe, SymTab.BigSetSigned(at))
  1797. ELSE QbeGen.BigSetClearBit(qd, qe, SymTab.BigSetSigned(at))
  1798. END
  1799. ELSIF SymTab.IsPackedSet(at) THEN
  1800. IF isInc THEN QbeGen.PackedSetBit(qd, at, qe,
  1801. SymTab.SetBaseLo(at),
  1802. SymTab.SetCount(at))
  1803. ELSE QbeGen.PackedSetClearBit(qd, at, qe,
  1804. SymTab.SetBaseLo(at),
  1805. SymTab.SetCount(at))
  1806. END
  1807. ELSIF isInc THEN QbeGen.SetBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
  1808. ELSE QbeGen.SetClearBit(qd, qe, SymTab.SetBaseLo(at), SymTab.SetCount(at))
  1809. END
  1810. END
  1811. ELSIF SymTab.Equal(nm, "NEW") THEN
  1812. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1813. IF dt = SymTab.InvalidType THEN
  1814. ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
  1815. ELSE
  1816. bt := SymTab.PtrBase(dt);
  1817. IF bt # SymTab.InvalidType THEN
  1818. QbeGen.NewHeap(bt, qm); QbeGen.InitHeap(qm, bt);
  1819. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, qm, dt)
  1820. ELSE QbeGen.StorePtr(qn, qm)
  1821. END
  1822. END
  1823. END
  1824. ELSIF SymTab.Equal(nm, "DISPOSE") THEN
  1825. LowerDesign(AST.Child(n, 1), dt, dk, qd, qn, sfx);
  1826. IF dt = SymTab.InvalidType THEN
  1827. ELSIF SymTab.ClassOf(dt) # SymTab.ClPtr THEN
  1828. ELSE
  1829. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemLoad(qd, dt, qv)
  1830. ELSE QbeGen.LoadPtr(qn, qv)
  1831. END;
  1832. QbeGen.FreeHeap(qv);
  1833. IF sfx OR (dk = SymTab.KindField) THEN QbeGen.ElemStore(qd, "0", dt)
  1834. ELSE QbeGen.StorePtr(qn, "0")
  1835. END
  1836. END
  1837. END
  1838. END LowerBuiltinStmt;
  1839. PROCEDURE LowerMethod (m: AST.Node; ct: SymTab.TypeIndex);
  1840. (* A class method: hidden THIS receiver, then declared formals; the body
  1841. runs with THIS pushed as the WITH base (bare field names resolve). *)
  1842. VAR nm, txt: SymTab.Name; mg, thisQ: QbeGen.QVal;
  1843. uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1844. pv, ext: BOOLEAN; j: CARDINAL; saveCls: SymTab.TypeIndex;
  1845. savedProc: INTEGER;
  1846. BEGIN
  1847. IF (AST.Op(m) # 0) AND (AST.Op(m) # 3) THEN RETURN END;
  1848. Name(AST.Child(m, 0), nm);
  1849. IF NOT ProcInfo(nm, uid, res, depth, ext, np) THEN RETURN END;
  1850. QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
  1851. QbeGen.BeginFunc(mg);
  1852. IF NOT QbeGen.FuncParam("THIS", TRUE, ct) THEN END;
  1853. IF CompositeRes(res) THEN
  1854. IF NOT QbeGen.FuncParam("__res", TRUE, res) THEN END
  1855. END;
  1856. j := 0;
  1857. WHILE j < np DO
  1858. IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
  1859. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
  1860. INC(j)
  1861. END;
  1862. QbeGen.SetFuncRes(res);
  1863. QbeGen.EndFuncHeader;
  1864. QbeGen.ThisBase(thisQ);
  1865. saveCls := curImplCls;
  1866. curImplCls := ct;
  1867. QbeGen.PushWith(thisQ);
  1868. IF withTop <= HIGH(withRec) THEN withRec[withTop] := ct; INC(withTop) END;
  1869. savedProc := emitProc;
  1870. emitProc := FindProc(nm);
  1871. LowerDecls(AST.Child(m, 2));
  1872. nUserLab := 0;
  1873. LowerStmt(AST.Child(m, 1));
  1874. emitProc := savedProc;
  1875. IF withTop > 0 THEN DEC(withTop) END;
  1876. curImplCls := saveCls;
  1877. QbeGen.PopWith;
  1878. QbeGen.EndFunc(res)
  1879. END LowerMethod;
  1880. PROCEDURE LowerMethods (seq: AST.Node; ct: SymTab.TypeIndex);
  1881. VAR i: CARDINAL; m: AST.Node;
  1882. BEGIN
  1883. IF seq = AST.NoNode THEN RETURN END;
  1884. i := 0;
  1885. WHILE i < AST.NChild(seq) DO
  1886. m := AST.Child(seq, i);
  1887. IF i = AST.MaxChild - 1 THEN LowerMethods(m, ct)
  1888. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethods(m, ct)
  1889. ELSIF AST.Kind(m) = AST.NkProcDecl THEN LowerMethod(m, ct)
  1890. END;
  1891. INC(i)
  1892. END
  1893. END LowerMethods;
  1894. PROCEDURE LowerMethodHeadings (seq: AST.Node; ct: SymTab.TypeIndex);
  1895. (* Class-declaration method headings: emit+discard a function header per
  1896. method so the backend temp counters advance exactly as the legacy
  1897. parse did (the implementation's temps then line up). *)
  1898. VAR i, j: CARDINAL; m: AST.Node; nm, txt: SymTab.Name;
  1899. mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  1900. pv, ext: BOOLEAN;
  1901. BEGIN
  1902. IF seq = AST.NoNode THEN RETURN END;
  1903. i := 0;
  1904. WHILE i < AST.NChild(seq) DO
  1905. m := AST.Child(seq, i);
  1906. IF i = AST.MaxChild - 1 THEN LowerMethodHeadings(m, ct)
  1907. ELSIF AST.Kind(m) = AST.NkFieldDecl THEN LowerMethodHeadings(m, ct)
  1908. ELSIF AST.Kind(m) = AST.NkProcDecl THEN
  1909. Name(AST.Child(m, 0), nm);
  1910. IF ProcInfo(nm, uid, res, depth, ext, np) THEN
  1911. QbeGen.Mangled(nm, SymTab.ClassMethodUid(ct, nm), mg);
  1912. QbeGen.BeginFunc(mg);
  1913. j := 0;
  1914. WHILE j < np DO
  1915. IF NOT ParamInfo(nm, j, pt, pv, txt) THEN END;
  1916. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END;
  1917. INC(j)
  1918. END;
  1919. QbeGen.SetFuncRes(res);
  1920. QbeGen.AbortFunc
  1921. END
  1922. END;
  1923. INC(i)
  1924. END
  1925. END LowerMethodHeadings;
  1926. PROCEDURE LowerMethodCall (n: AST.Node; VAR t: SymTab.TypeIndex;
  1927. VAR q: QbeGen.QVal; want: BOOLEAN);
  1928. VAR d: AST.Node; ct, res, ft, at: SymTab.TypeIndex;
  1929. cq, mg, qa, qt, qe, qres: QbeGen.QVal; fn, pn: SymTab.Name;
  1930. k, vs: INTEGER; i: CARDINAL; sfx, isV, conv: BOOLEAN;
  1931. BEGIN
  1932. d := AST.Child(n, 0);
  1933. curMethCls := SymTab.InvalidType;
  1934. LowerDesign(d, ct, k, cq, pn, sfx);
  1935. ct := curMethCls;
  1936. IF ct = SymTab.InvalidType THEN
  1937. t := SymTab.InvalidType; QbeGen.CopyOp("0", q); RETURN
  1938. END;
  1939. IF AST.NChild(d) = 1 THEN
  1940. Name(AST.Child(d, 0), fn)
  1941. ELSE
  1942. Name(AST.Child(AST.Child(d, AST.NChild(d) - 1), 0), fn)
  1943. END;
  1944. res := SymTab.ClassMethodRes(ct, fn);
  1945. vs := SymTab.VirtSlot(ct, fn);
  1946. IF vs >= 0 THEN QbeGen.VirtCallBegin(cq, vs, res)
  1947. ELSE
  1948. QbeGen.Mangled(fn, SymTab.ClassMethodUid(ct, fn), mg);
  1949. QbeGen.CallBegin(mg, res, 0, FALSE)
  1950. END;
  1951. IF CompositeRes(res) THEN
  1952. QbeGen.AllocLocal(res, qres);
  1953. IF NOT QbeGen.CallArg(qres, "l") THEN END
  1954. END;
  1955. i := 1;
  1956. WHILE i < AST.NChild(n) DO
  1957. LowerExpr(AST.Child(n, i), at, qe);
  1958. ft := SymTab.ClassMethodParamType(ct, fn, i - 1);
  1959. isV := SymTab.ClassMethodParamIsVar(ct, fn, i - 1);
  1960. IF isV THEN
  1961. IF QbeGen.AddrOfVal(qe, qa) THEN
  1962. IF NOT QbeGen.CallArg(qa, "l") THEN END
  1963. END
  1964. ELSE
  1965. conv := SymTab.IsRealType(ft) AND SymTab.IsIntFamily(at);
  1966. IF conv THEN
  1967. QbeGen.ConvIR(qe, qt);
  1968. IF NOT QbeGen.CallArg(qt, "d") THEN END
  1969. ELSE
  1970. IF NOT QbeGen.CallArg(qe, QbeGen.ArgClass(ft)) THEN END
  1971. END
  1972. END;
  1973. INC(i)
  1974. END;
  1975. IF want THEN t := res; QbeGen.CallEnd(TRUE, q);
  1976. IF CompositeRes(res) THEN QbeGen.CopyOp(qres, q) END
  1977. ELSE t := SymTab.InvalidType; QbeGen.CopyOp("0", q); QbeGen.CallEnd(FALSE, q)
  1978. END
  1979. END LowerMethodCall;
  1980. PROCEDURE LowerCase (n: AST.Node);
  1981. (* CASE as a compare-chain (mirrors CaseStat/CaseAlt/CaseLabel). The
  1982. arm list is chunked (AstAppend) so a CASE with more than MaxChild
  1983. alternatives is not truncated. *)
  1984. VAR i, j: CARDINAL; arm, lab, seq, next: AST.Node;
  1985. tsel, t2, t3: SymTab.TypeIndex;
  1986. qsel, q2, q3, qc, qd, qe, lEnd, lBody, lAfter, lNext: QbeGen.QVal;
  1987. hasElse: BOOLEAN;
  1988. BEGIN
  1989. LowerExpr(AST.Child(n, 0), tsel, qsel);
  1990. hasElse := FALSE;
  1991. QbeGen.NewLabel(lEnd);
  1992. (* pass 1: alternatives (ELSE arms come after) *)
  1993. seq := AST.Child(n, 1);
  1994. WHILE seq # AST.NoNode DO
  1995. i := 0;
  1996. WHILE i < AST.NChild(seq) DO
  1997. arm := AST.Child(seq, i);
  1998. IF AST.Kind(arm) = AST.NkBlock THEN
  1999. (* continuation chunk *)
  2000. ELSIF AST.Op(arm) = 1 THEN
  2001. (* ELSE arm: emitted in pass 2 *)
  2002. hasElse := TRUE
  2003. ELSE
  2004. QbeGen.NewLabel(lBody); QbeGen.NewLabel(lAfter);
  2005. j := 0;
  2006. WHILE j + 1 < AST.NChild(arm) DO
  2007. lab := AST.Child(arm, j);
  2008. IF AST.Kind(lab) = AST.NkSubrange THEN
  2009. LowerExpr(AST.Child(lab, 0), t2, q2);
  2010. IF SymTab.IsEmptyStr(t2)
  2011. AND (SymTab.ClassOf(tsel) = SymTab.ClChar) THEN
  2012. QbeGen.CopyOp("0", q2); t2 := SymTab.CharType()
  2013. END;
  2014. QbeGen.NewLabel(lNext);
  2015. QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE);
  2016. QbeGen.Jnz(qc, lBody, lNext);
  2017. QbeGen.EmitLabel(lNext);
  2018. LowerExpr(AST.Child(lab, 1), t3, q3);
  2019. IF SymTab.IsEmptyStr(t3)
  2020. AND (SymTab.ClassOf(tsel) = SymTab.ClChar) THEN
  2021. QbeGen.CopyOp("0", q3); t3 := SymTab.CharType()
  2022. END;
  2023. QbeGen.Cmp(SymTab.OpGe, qsel, q2, qc, FALSE);
  2024. QbeGen.Cmp(SymTab.OpLe, qsel, q3, qd, FALSE);
  2025. QbeGen.NewTemp(qe);
  2026. QbeGen.Op3("and", qe, qc, qd, FALSE);
  2027. QbeGen.NewLabel(lNext);
  2028. QbeGen.Jnz(qe, lBody, lNext);
  2029. QbeGen.EmitLabel(lNext)
  2030. ELSE
  2031. LowerExpr(lab, t2, q2);
  2032. IF SymTab.IsEmptyStr(t2)
  2033. AND (SymTab.ClassOf(tsel) = SymTab.ClChar) THEN
  2034. QbeGen.CopyOp("0", q2); t2 := SymTab.CharType()
  2035. END;
  2036. QbeGen.NewLabel(lNext);
  2037. IF (SymTab.ClassOf(tsel) = SymTab.ClSet)
  2038. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2039. QbeGen.CmpSet(SymTab.OpEq, qsel, q2,
  2040. SymTab.SetWords(tsel), SymTab.SetWords(t2), qc)
  2041. ELSE
  2042. QbeGen.Cmp(SymTab.OpEq, qsel, q2, qc, FALSE)
  2043. END;
  2044. QbeGen.Jnz(qc, lBody, lNext);
  2045. QbeGen.EmitLabel(lNext)
  2046. END;
  2047. INC(j)
  2048. END;
  2049. QbeGen.Jmp(lAfter);
  2050. QbeGen.EmitLabel(lBody);
  2051. LowerStmt(AST.Child(arm, AST.NChild(arm) - 1));
  2052. QbeGen.Jmp(lEnd);
  2053. QbeGen.EmitLabel(lAfter)
  2054. END;
  2055. INC(i)
  2056. END;
  2057. next := AST.NoNode;
  2058. IF AST.NChild(seq) > 0 THEN
  2059. next := AST.Child(seq, AST.NChild(seq) - 1);
  2060. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  2061. END;
  2062. seq := next
  2063. END;
  2064. IF NOT hasElse THEN
  2065. QbeGen.TrapCode(2) (* caseSelectException *)
  2066. END;
  2067. (* pass 2: ELSE arms *)
  2068. seq := AST.Child(n, 1);
  2069. WHILE seq # AST.NoNode DO
  2070. i := 0;
  2071. WHILE i < AST.NChild(seq) DO
  2072. arm := AST.Child(seq, i);
  2073. IF (AST.Kind(arm) # AST.NkBlock) AND (AST.Op(arm) = 1) THEN
  2074. LowerStmt(AST.Child(arm, 0))
  2075. END;
  2076. INC(i)
  2077. END;
  2078. next := AST.NoNode;
  2079. IF AST.NChild(seq) > 0 THEN
  2080. next := AST.Child(seq, AST.NChild(seq) - 1);
  2081. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  2082. END;
  2083. seq := next
  2084. END;
  2085. QbeGen.EmitLabel(lEnd)
  2086. END LowerCase;
  2087. PROCEDURE LowerWith (n: AST.Node);
  2088. (* WITH: push each record's base address, lower the body, pop only the
  2089. levels this WITH pushed (a nested WITH must restore the outer one). *)
  2090. VAR i, base: CARDINAL; dt: SymTab.TypeIndex; dk: INTEGER;
  2091. qd: QbeGen.QVal; qn: SymTab.Name; sfx: BOOLEAN;
  2092. BEGIN
  2093. base := withTop;
  2094. i := 0;
  2095. WHILE i + 1 < AST.NChild(n) DO
  2096. LowerDesign(AST.Child(n, i), dt, dk, qd, qn, sfx);
  2097. QbeGen.PushWith(qd);
  2098. IF withTop <= HIGH(withRec) THEN
  2099. withRec[withTop] := dt; INC(withTop)
  2100. END;
  2101. INC(i)
  2102. END;
  2103. LowerStmt(AST.Child(n, AST.NChild(n) - 1));
  2104. WHILE withTop > base DO DEC(withTop); QbeGen.PopWith END
  2105. END LowerWith;
  2106. PROCEDURE LowerExprFull (n: AST.Node; VAR t: SymTab.TypeIndex;
  2107. VAR q: QbeGen.QVal; VAR k: INTEGER;
  2108. VAR qn: SymTab.Name; VAR sfx: BOOLEAN;
  2109. asAddr: BOOLEAN);
  2110. VAR t2: SymTab.TypeIndex; q2, qt, qf, qs, qr, qaddr, qa, qb: QbeGen.QVal;
  2111. lNext, lFalse, lTrue, lDone: QbeGen.QVal;
  2112. kind, op, rop, ucp: INTEGER;
  2113. folded, isR, isCh, isU, uok: BOOLEAN;
  2114. i: CARDINAL; el, seq, next: AST.Node;
  2115. lw, rw, mw: CARDINAL; idx: INTEGER; fok, isL: BOOLEAN;
  2116. lt, rt: SymTab.TypeIndex; qw: QbeGen.QVal;
  2117. BEGIN
  2118. IF AST.Kind(n) = AST.NkDesignator THEN
  2119. LowerDesign(n, t, k, q, qn, sfx);
  2120. IF k = SymTab.KindProc THEN
  2121. (* bare procedure used as a value: its code address *)
  2122. LowerProcAddr(qn, q);
  2123. RETURN
  2124. END;
  2125. (* Record value->address for VAR actuals, mirroring the grammar's
  2126. Design. AddrOfVal cannot rely on the grammar's notes: its ring
  2127. (256) wraps long before a whole-session emit finishes. *)
  2128. IF sfx THEN QbeGen.CopyOp(q, qaddr) ELSE QbeGen.AddrOf(qn, qaddr) END;
  2129. IF NOT asAddr THEN FinalLoad(t, sfx, q) END;
  2130. IF (k = SymTab.KindVar) OR (k = SymTab.KindParam)
  2131. OR (k = SymTab.KindField) THEN
  2132. QbeGen.NoteAddr(q, qaddr)
  2133. ELSIF sfx AND (t # SymTab.InvalidType)
  2134. AND ((SymTab.ClassOf(t) = SymTab.ClArray)
  2135. OR (SymTab.ClassOf(t) = SymTab.ClSet)
  2136. OR (SymTab.ClassOf(t) = SymTab.ClRecord)) THEN
  2137. QbeGen.NoteAddr(q, qaddr)
  2138. END;
  2139. RETURN
  2140. END;
  2141. k := -1; qn[0] := CHR(0); sfx := FALSE;
  2142. IF AST.Kind(n) = AST.NkIntLit THEN
  2143. Name(n, qn); QbeGen.NormInt(qn, q); t := SymTab.IntType()
  2144. ELSIF AST.Kind(n) = AST.NkCharLit THEN
  2145. Name(n, qn); QbeGen.NormLit(qn, q, isCh); t := SymTab.CharType()
  2146. ELSIF AST.Kind(n) = AST.NkRealLit THEN
  2147. Name(n, qn); QbeGen.NormReal(qn, q); t := SymTab.RealType()
  2148. ELSIF AST.Kind(n) = AST.NkStrLit THEN
  2149. Name(n, qn);
  2150. IF (qn[0] = "U") OR (qn[0] = "u") THEN
  2151. (* U"..." / U'...': one codepoint -> UCHAR, else a ustring *)
  2152. QbeGen.DeclUStr(qn, q, isU, ucp, uok);
  2153. IF NOT uok THEN
  2154. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  2155. ELSIF isU THEN
  2156. t := SymTab.UCharType(); QbeGen.IntStr(ucp, q)
  2157. ELSE
  2158. t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewUStr() END; QbeGen.NoteAddr(q, q)
  2159. END
  2160. ELSIF SymTab.StrLen(qn) = 3 THEN
  2161. t := SymTab.CharType(); QbeGen.IntStr(QbeGen.CharVal(qn), q)
  2162. ELSE
  2163. t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewStr() END; QbeGen.DeclStr(qn, q); QbeGen.NoteAddr(q, q)
  2164. END
  2165. ELSIF AST.Kind(n) = AST.NkSetLit THEN
  2166. t := AST.Ty(n); IF t = -1 THEN t := SymTab.NewSet(SymTab.NewSubR(0, 255)) END;
  2167. IF SymTab.IsBigSet(t) THEN
  2168. QbeGen.NewSetTemp(2, q); QbeGen.SetZero(q, 2)
  2169. ELSE
  2170. QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8)
  2171. END;
  2172. i := 0;
  2173. WHILE i < AST.NChild(n) DO
  2174. el := AST.Child(n, i);
  2175. IF AST.Kind(el) = AST.NkSubrange THEN
  2176. LowerExpr(AST.Child(el, 0), t2, q2);
  2177. LowerExpr(AST.Child(el, 1), t2, qt);
  2178. IF SymTab.IsBigSet(t) THEN
  2179. QbeGen.BigSetRange(q, q2, qt, SymTab.BigSetSigned(t))
  2180. ELSE
  2181. QbeGen.SetRange(q, q2, qt, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  2182. END
  2183. ELSE
  2184. LowerExpr(el, t2, q2);
  2185. IF SymTab.IsBigSet(t) THEN
  2186. QbeGen.BigSetBit(q, q2, SymTab.BigSetSigned(t))
  2187. ELSE
  2188. QbeGen.SetBit(q, q2, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  2189. END
  2190. END;
  2191. INC(i)
  2192. END
  2193. ELSIF AST.Kind(n) = AST.NkBraceLit THEN
  2194. (* T{...} typed brace literal: a set here (the type was recorded by
  2195. the grammar in the node's ty field). Array/record/class
  2196. constructors are not lowered here yet. *)
  2197. t := AST.Ty(n);
  2198. IF (t # SymTab.InvalidType) AND (SymTab.ClassOf(t) = SymTab.ClSet) THEN
  2199. IF SymTab.IsBigSet(t) THEN
  2200. QbeGen.NewSetTemp(2, q); QbeGen.SetZero(q, 2)
  2201. ELSIF SymTab.SetWords(t) = 0 THEN
  2202. QbeGen.NewSetTemp(8, q); QbeGen.SetZero(q, 8)
  2203. ELSE
  2204. QbeGen.NewSetTemp(SymTab.SetWords(t), q);
  2205. QbeGen.SetZero(q, SymTab.SetWords(t))
  2206. END;
  2207. seq := n;
  2208. WHILE seq # AST.NoNode DO
  2209. i := 0;
  2210. WHILE i < AST.NChild(seq) DO
  2211. el := AST.Child(seq, i);
  2212. IF AST.Kind(el) # AST.NkBlock THEN
  2213. IF AST.Kind(el) = AST.NkSubrange THEN
  2214. LowerExpr(AST.Child(el, 0), t2, q2);
  2215. LowerExpr(AST.Child(el, 1), t2, qt);
  2216. IF SymTab.IsBigSet(t) THEN
  2217. QbeGen.BigSetRange(q, q2, qt, SymTab.BigSetSigned(t))
  2218. ELSE
  2219. QbeGen.SetRange(q, q2, qt, SymTab.SetBaseLo(t),
  2220. SymTab.SetCount(t))
  2221. END
  2222. ELSE
  2223. LowerExpr(el, t2, q2);
  2224. IF SymTab.IsBigSet(t) THEN
  2225. QbeGen.BigSetBit(q, q2, SymTab.BigSetSigned(t))
  2226. ELSE
  2227. QbeGen.SetBit(q, q2, SymTab.SetBaseLo(t), SymTab.SetCount(t))
  2228. END
  2229. END
  2230. END;
  2231. INC(i)
  2232. END;
  2233. next := AST.NoNode;
  2234. IF AST.NChild(seq) > 0 THEN
  2235. next := AST.Child(seq, AST.NChild(seq) - 1);
  2236. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  2237. END;
  2238. seq := next
  2239. END
  2240. ELSIF (t # SymTab.InvalidType)
  2241. AND ((SymTab.ClassOf(t) = SymTab.ClArray)
  2242. OR (SymTab.ClassOf(t) = SymTab.ClRecord)
  2243. OR (SymTab.ClassOf(t) = SymTab.ClClass)) THEN
  2244. (* T{...} aggregate constructor *)
  2245. QbeGen.CtorBegin(t);
  2246. seq := n;
  2247. WHILE seq # AST.NoNode DO
  2248. i := 0;
  2249. WHILE i < AST.NChild(seq) DO
  2250. el := AST.Child(seq, i);
  2251. IF AST.Kind(el) # AST.NkBlock THEN
  2252. LowerExpr(el, t2, q2);
  2253. QbeGen.CtorElem(q2)
  2254. END;
  2255. INC(i)
  2256. END;
  2257. next := AST.NoNode;
  2258. IF AST.NChild(seq) > 0 THEN
  2259. next := AST.Child(seq, AST.NChild(seq) - 1);
  2260. IF AST.Kind(next) # AST.NkBlock THEN next := AST.NoNode END
  2261. END;
  2262. seq := next
  2263. END;
  2264. QbeGen.CtorEnd(q)
  2265. ELSE
  2266. t := SymTab.InvalidType; QbeGen.CopyOp("0", q)
  2267. END
  2268. ELSIF AST.Kind(n) = AST.NkDesignator THEN
  2269. LowerDesign(n, t, k, q, qn, sfx)
  2270. ELSIF AST.Kind(n) = AST.NkCall THEN
  2271. IF IsMethodCall(n) THEN LowerMethodCall(n, t, q, TRUE)
  2272. ELSE
  2273. CalleeName(n, qn);
  2274. IF IsBuiltin(qn) THEN LowerBuiltinExpr(n, qn, t, q)
  2275. ELSE LowerCall(n, t, q, TRUE)
  2276. END
  2277. END
  2278. ELSIF AST.Kind(n) = AST.NkUnary THEN
  2279. LowerExpr(AST.Child(n, 0), t, q);
  2280. IF AST.Op(n) = AST.OpSub THEN
  2281. IF QbeGen.IsImm(q) THEN QbeGen.NegFold(q, q)
  2282. ELSE QbeGen.NewTemp(qt);
  2283. QbeGen.NegQ(q, qt, SymTab.IsRealType(t));
  2284. QbeGen.CopyOp(qt, q)
  2285. END
  2286. ELSE
  2287. QbeGen.NotQ(q, qt); QbeGen.CopyOp(qt, q); t := SymTab.BoolType()
  2288. END
  2289. ELSIF AST.Kind(n) = AST.NkBinExpr THEN
  2290. op := AST.Op(n);
  2291. IF IsRel(op) THEN
  2292. LowerExpr(AST.Child(n, 0), t, q);
  2293. LowerExpr(AST.Child(n, 1), t2, q2);
  2294. (* ISO: an empty string compared with CHAR is the terminator;
  2295. against a CHAR array it stays a string (StrEq below). *)
  2296. IF (t # SymTab.InvalidType) AND SymTab.IsEmptyStr(t)
  2297. AND (t2 # SymTab.InvalidType)
  2298. AND (SymTab.ClassOf(t2) = SymTab.ClChar) THEN
  2299. QbeGen.CopyOp("0", q); t := SymTab.CharType()
  2300. ELSIF (t2 # SymTab.InvalidType) AND SymTab.IsEmptyStr(t2)
  2301. AND (t # SymTab.InvalidType)
  2302. AND (SymTab.ClassOf(t) = SymTab.ClChar) THEN
  2303. QbeGen.CopyOp("0", q2); t2 := SymTab.CharType()
  2304. END;
  2305. rop := SymTab.OpEq; folded := RelSym(op, rop);
  2306. IF op = AST.OpIn THEN
  2307. IF SymTab.IsBigSet(t2) THEN
  2308. QbeGen.BigInSet(q, q2, SymTab.BigSetSigned(t2), qt)
  2309. ELSIF SymTab.IsPackedSet(t2) THEN
  2310. QbeGen.PackedInSet(q, q2, SymTab.SetBaseLo(t2),
  2311. SymTab.SetCount(t2), t2, qt)
  2312. ELSE QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
  2313. SymTab.SetCount(t2), qt)
  2314. END;
  2315. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2316. ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
  2317. OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
  2318. QbeGen.CmpL(rop, q, q2, qt);
  2319. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2320. ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
  2321. OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2322. IF SymTab.IsBigSet(t) OR SymTab.IsBigSet(t2) THEN
  2323. QbeGen.BigSetEqual(q, q2, qt);
  2324. IF (rop = SymTab.OpNeq1) OR (rop = SymTab.OpNeq2) THEN
  2325. QbeGen.NotQ(qt, q)
  2326. ELSE QbeGen.CopyOp(qt, q)
  2327. END
  2328. ELSIF SymTab.IsPackedSet(t) OR SymTab.IsPackedSet(t2) THEN
  2329. QbeGen.PackedCmpSet(rop, q, t, q2, t2, qt);
  2330. QbeGen.CopyOp(qt, q)
  2331. ELSE QbeGen.CmpSet(rop, q, q2, SymTab.SetWords(t),
  2332. SymTab.SetWords(t2), qt);
  2333. QbeGen.CopyOp(qt, q)
  2334. END;
  2335. t := SymTab.BoolType()
  2336. ELSIF SymTab.StrCompat(t, t2) THEN
  2337. QbeGen.StrEq(rop, q, q2, qt);
  2338. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2339. ELSIF SymTab.IsLongFamily(t) OR SymTab.IsLongFamily(t2) THEN
  2340. IF SymTab.IsIntFamily(t) THEN QbeGen.WidenLong(q, qf); QbeGen.CopyOp(qf, q) END;
  2341. IF SymTab.IsIntFamily(t2) THEN QbeGen.WidenLong(q2, qf); QbeGen.CopyOp(qf, q2) END;
  2342. QbeGen.CmpLong(rop, q, q2, qt);
  2343. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2344. ELSE
  2345. isR := (t # SymTab.InvalidType) AND SymTab.IsRealType(t);
  2346. t := SymTab.BoolType();
  2347. QbeGen.Cmp(rop, q, q2, qt, isR);
  2348. QbeGen.CopyOp(qt, q)
  2349. END
  2350. ELSIF op = AST.OpAnd THEN
  2351. LowerExpr(AST.Child(n, 0), t, q);
  2352. QbeGen.DelayBegin;
  2353. LowerExpr(AST.Child(n, 1), t2, q2);
  2354. QbeGen.DelayEnd;
  2355. QbeGen.Slot4(qs);
  2356. QbeGen.NewLabel(lNext); QbeGen.NewLabel(lFalse); QbeGen.NewLabel(lDone);
  2357. QbeGen.Jnz(q, lNext, lFalse);
  2358. QbeGen.EmitLabel(lNext);
  2359. QbeGen.DelayFlush;
  2360. QbeGen.StoreW(qs, q2);
  2361. QbeGen.Jmp(lDone);
  2362. QbeGen.EmitLabel(lFalse);
  2363. QbeGen.StoreW(qs, "0");
  2364. QbeGen.Jmp(lDone);
  2365. QbeGen.EmitLabel(lDone);
  2366. QbeGen.LoadW(qs, qr);
  2367. QbeGen.CopyOp(qr, q);
  2368. t := SymTab.BoolType()
  2369. ELSIF op = AST.OpOr THEN
  2370. LowerExpr(AST.Child(n, 0), t, q);
  2371. QbeGen.DelayBegin;
  2372. LowerExpr(AST.Child(n, 1), t2, q2);
  2373. QbeGen.DelayEnd;
  2374. QbeGen.Slot4(qs);
  2375. QbeGen.NewLabel(lTrue); QbeGen.NewLabel(lNext); QbeGen.NewLabel(lDone);
  2376. QbeGen.Jnz(q, lTrue, lNext);
  2377. QbeGen.EmitLabel(lTrue);
  2378. QbeGen.StoreW(qs, "1");
  2379. QbeGen.Jmp(lDone);
  2380. QbeGen.EmitLabel(lNext);
  2381. QbeGen.DelayFlush;
  2382. QbeGen.StoreW(qs, q2);
  2383. QbeGen.Jmp(lDone);
  2384. QbeGen.EmitLabel(lDone);
  2385. QbeGen.LoadW(qs, qr);
  2386. QbeGen.CopyOp(qr, q);
  2387. t := SymTab.BoolType()
  2388. ELSE
  2389. LowerExpr(AST.Child(n, 0), t, q);
  2390. LowerExpr(AST.Child(n, 1), t2, q2);
  2391. IF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  2392. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  2393. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2394. (* set union/diff (Add/Sub) or intersection/symdiff (Mul/Div) *)
  2395. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  2396. mw := lw; IF rw > mw THEN mw := rw END;
  2397. IF op = AST.OpAdd THEN idx := 0
  2398. ELSIF op = AST.OpSub THEN idx := 2
  2399. ELSIF op = AST.OpMul THEN idx := 1
  2400. ELSE idx := 3
  2401. END;
  2402. IF SymTab.IsBigSet(t) OR SymTab.IsBigSet(t2) THEN
  2403. QbeGen.NewSetTemp(2, qt);
  2404. QbeGen.SetZero(qt, 2);
  2405. QbeGen.BigSetBin(idx, qt, q, q2);
  2406. IF SymTab.IsBigSet(t) THEN
  2407. t := SymTab.NewBigSet(SymTab.SetBase(t))
  2408. ELSE t := SymTab.NewBigSet(SymTab.SetBase(t2))
  2409. END
  2410. ELSIF SymTab.IsPackedSet(t) OR SymTab.IsPackedSet(t2) THEN
  2411. QbeGen.PackedSetBinOp(idx, q, t, q2, t2, qt);
  2412. t := SymTab.NewSet(SymTab.NewSubR(0, 31))
  2413. ELSE
  2414. QbeGen.SetBinOp(idx, q, q2, lw, rw, qt);
  2415. t := SymTab.NewSet(SymTab.NewSubR(0,
  2416. VAL(INTEGER, mw) * 32 - 1))
  2417. END;
  2418. QbeGen.CopyOp(qt, q)
  2419. ELSIF (op = AST.OpAdd)
  2420. AND (SymTab.StrCompat(t, t2)
  2421. OR (SymTab.IsStrType(t) AND (SymTab.ClassOf(t2) = SymTab.ClChar))
  2422. OR ((SymTab.ClassOf(t) = SymTab.ClChar) AND SymTab.IsStrType(t2))) THEN
  2423. QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2), qt, fok);
  2424. IF NOT fok THEN
  2425. IF SymTab.StrCompat(t, t2) THEN QbeGen.StrCat(q, q2, qt)
  2426. ELSIF SymTab.IsStrType(t) THEN
  2427. QbeGen.DeclCharStr(q2, qs); QbeGen.StrCat(q, qs, qt)
  2428. ELSE
  2429. QbeGen.DeclCharStr(q, qs); QbeGen.StrCat(qs, q2, qt)
  2430. END
  2431. END;
  2432. t := SymTab.NewStr(); QbeGen.CopyOp(qt, q)
  2433. ELSIF (op = AST.OpAdd)
  2434. AND (SymTab.UStrCompat(t, t2)
  2435. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  2436. AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
  2437. OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
  2438. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
  2439. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  2440. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
  2441. (* UString concatenation: a UCHAR operand becomes a
  2442. 1-codepoint UString; the result is a descriptor *)
  2443. IF SymTab.ClassOf(t) = SymTab.ClUStr THEN QbeGen.CopyOp(q, qa)
  2444. ELSE QbeGen.UStrFrom(q, qa)
  2445. END;
  2446. IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN QbeGen.UStrCat(qa, q2, qt)
  2447. ELSE QbeGen.UStrFrom(q2, qb); QbeGen.UStrCat(qa, qb, qt)
  2448. END;
  2449. t := SymTab.NewUStr(); QbeGen.CopyOp(qt, q)
  2450. ELSE
  2451. lt := t; rt := t2;
  2452. IF SymTab.IsRealType(lt) OR SymTab.IsRealType(rt) THEN
  2453. t := SymTab.RealType()
  2454. ELSIF SymTab.IsLongFamily(lt) OR SymTab.IsLongFamily(rt) THEN
  2455. t := SymTab.LongType()
  2456. ELSE t := SymTab.IntType()
  2457. END;
  2458. isL := SymTab.IsLongFamily(t);
  2459. isR := SymTab.IsRealType(t);
  2460. kind := 0;
  2461. IF op = AST.OpSub THEN kind := 1
  2462. ELSIF op = AST.OpMul THEN kind := 2
  2463. ELSIF op = AST.OpDiv THEN kind := 3
  2464. ELSIF op = AST.OpMod THEN kind := 4
  2465. END;
  2466. folded := FALSE;
  2467. IF (NOT isL) AND (NOT isR) AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  2468. folded := QbeGen.Fold2(kind, q, q2, qf)
  2469. END;
  2470. IF folded THEN QbeGen.CopyOp(qf, q)
  2471. ELSE
  2472. IF isL THEN
  2473. IF SymTab.IsIntFamily(lt) THEN
  2474. QbeGen.WidenLong(q, qw); QbeGen.CopyOp(qw, q)
  2475. END;
  2476. IF SymTab.IsIntFamily(rt) THEN
  2477. QbeGen.WidenLong(q2, qw); QbeGen.CopyOp(qw, q2)
  2478. END;
  2479. QbeGen.NewTemp(qt);
  2480. IF op = AST.OpAdd THEN QbeGen.Op3L("add", qt, q, q2)
  2481. ELSIF op = AST.OpSub THEN QbeGen.Op3L("sub", qt, q, q2)
  2482. ELSIF op = AST.OpMul THEN QbeGen.Op3L("mul", qt, q, q2)
  2483. ELSE QbeGen.Op3L("div", qt, q, q2)
  2484. END
  2485. ELSE
  2486. QbeGen.NewTemp(qt);
  2487. IF op = AST.OpAdd THEN QbeGen.Op3("add", qt, q, q2, isR)
  2488. ELSIF op = AST.OpSub THEN QbeGen.Op3("sub", qt, q, q2, isR)
  2489. ELSIF op = AST.OpMul THEN QbeGen.Op3("mul", qt, q, q2, isR)
  2490. ELSIF op = AST.OpDiv THEN QbeGen.Op3("div", qt, q, q2, isR)
  2491. ELSE QbeGen.Op3("rem", qt, q, q2, isR)
  2492. END
  2493. END;
  2494. QbeGen.CopyOp(qt, q)
  2495. END
  2496. END
  2497. END
  2498. END
  2499. END LowerExprFull;
  2500. PROCEDURE LowerExpr (n: AST.Node; VAR t: SymTab.TypeIndex;
  2501. VAR q: QbeGen.QVal);
  2502. VAR k: INTEGER; qn: SymTab.Name; sfx: BOOLEAN;
  2503. BEGIN
  2504. LowerExprFull(n, t, q, k, qn, sfx, FALSE);
  2505. IF AST.Kind(n) # AST.NkDesignator THEN lastView := FALSE END
  2506. END LowerExpr;
  2507. PROCEDURE LowerStmt (seq: AST.Node);
  2508. VAR i: CARDINAL; c, els, by: AST.Node; k: INTEGER;
  2509. t, t2, t3, dt, et: SymTab.TypeIndex;
  2510. q, q2, qt, qf, qd, qe: QbeGen.QVal;
  2511. qlo, qhi, qk, qb, ql, qby: QbeGen.QVal; step: INTEGER;
  2512. lTop, lBody, lEnd, lThen, lElse, lNext, lFalse, lDone, lx: QbeGen.QVal;
  2513. qn, lv: SymTab.Name;
  2514. kind, op, rop, cls: INTEGER;
  2515. sfx, folded, isR, conv, wconv, hasElse, dView, sView: BOOLEAN;
  2516. BEGIN
  2517. IF seq = AST.NoNode THEN RETURN END;
  2518. k := AST.Kind(seq);
  2519. IF k = AST.NkBlock THEN
  2520. i := 0;
  2521. WHILE i < AST.NChild(seq) DO
  2522. LowerStmt(AST.Child(seq, i)); INC(i)
  2523. END
  2524. ELSIF k = AST.NkExcept THEN
  2525. QbeGen.ExcBegin;
  2526. LowerStmt(AST.Child(seq, 0));
  2527. QbeGen.ExcBodyDone;
  2528. QbeGen.ExcHandlerBegin;
  2529. LowerStmt(AST.Child(seq, 1));
  2530. QbeGen.ExcEnd
  2531. ELSIF k = AST.NkRetry THEN
  2532. QbeGen.ExcRetry
  2533. ELSIF k = AST.NkFinally THEN
  2534. (* Module callers split the parts; be safe if one reaches here. *)
  2535. LowerStmt(AST.Child(seq, 0))
  2536. ELSIF k = AST.NkAssign THEN
  2537. LowerDesign(AST.Child(seq, 0), dt, cls, qd, qn, sfx);
  2538. dView := lastView;
  2539. LowerExpr(AST.Child(seq, 1), et, qe);
  2540. sView := lastView;
  2541. IF (dt # SymTab.InvalidType) AND (et # SymTab.InvalidType)
  2542. AND SymTab.IsEmptyStr(et)
  2543. AND (SymTab.ClassOf(dt) = SymTab.ClChar) THEN
  2544. (* ISO: the empty string assigned to CHAR is the terminator *)
  2545. QbeGen.CopyOp("0", qe); et := SymTab.CharType()
  2546. END;
  2547. CheckSub(dt, qe);
  2548. isR := (dt # SymTab.InvalidType) AND SymTab.IsRealType(dt);
  2549. conv := isR AND SymTab.IsIntFamily(et);
  2550. wconv := (dt # SymTab.InvalidType) AND SymTab.IsLongFamily(dt)
  2551. AND SymTab.IsIntFamily(et);
  2552. IF sfx OR (cls = SymTab.KindField) THEN
  2553. IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  2554. IF dView OR sView THEN
  2555. QbeGen.CopyArrayEx(qd, qe, dt, dView, sView)
  2556. ELSIF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
  2557. AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
  2558. ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
  2559. ELSE QbeGen.CopyArray(qd, qe, dt)
  2560. END
  2561. ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
  2562. QbeGen.CopySetVal(qd, dt, qe, et)
  2563. ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
  2564. QbeGen.CopyRecord(qd, qe, dt)
  2565. ELSIF SymTab.IsLongFamily(dt) THEN
  2566. IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.ElemStore(qd, ql, dt)
  2567. ELSE QbeGen.ElemStore(qd, qe, dt)
  2568. END
  2569. ELSIF conv THEN QbeGen.ConvIR(qe, qt); QbeGen.ElemStore(qd, qt, dt)
  2570. ELSE QbeGen.ElemStore(qd, qe, dt)
  2571. END
  2572. ELSE
  2573. IF SymTab.ClassOf(dt) = SymTab.ClArray THEN
  2574. IF dView OR sView THEN
  2575. QbeGen.CopyArrayEx(qd, qe, dt, dView, sView)
  2576. ELSIF (et # SymTab.InvalidType) AND (SymTab.ClassOf(et) = SymTab.ClUStr)
  2577. AND SymTab.IsUCharArray(dt) THEN QbeGen.UAssign(qd, qe)
  2578. ELSIF SymTab.StrCompat(dt, et) THEN QbeGen.StrAssign(qd, qe)
  2579. ELSE QbeGen.CopyArray(qd, qe, dt)
  2580. END
  2581. ELSIF SymTab.ClassOf(dt) = SymTab.ClSet THEN
  2582. QbeGen.CopySetVal(qd, dt, qe, et)
  2583. ELSIF SymTab.ClassOf(dt) = SymTab.ClRecord THEN
  2584. QbeGen.CopyRecord(qd, qe, dt)
  2585. ELSIF SymTab.IsSmallInt(dt) THEN
  2586. QbeGen.StoreShortVar(qn, SymTab.SmallIntBytes(dt), qe)
  2587. ELSIF (SymTab.ClassOf(dt) = SymTab.ClPtr)
  2588. OR (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
  2589. QbeGen.StorePtr(qn, qe)
  2590. ELSIF SymTab.IsLongFamily(dt) THEN
  2591. IF wconv THEN QbeGen.WidenLong(qe, ql); QbeGen.StoreLong(qn, ql)
  2592. ELSE QbeGen.StoreLong(qn, qe)
  2593. END
  2594. ELSIF conv THEN
  2595. QbeGen.ConvIR(qe, qt);
  2596. IF SymTab.IsShortReal(dt) THEN
  2597. QbeGen.StoreShortReal(qn, qt)
  2598. ELSE QbeGen.StoreVar(qn, qt, TRUE)
  2599. END
  2600. ELSIF SymTab.IsShortReal(dt) THEN
  2601. QbeGen.StoreShortReal(qn, qe)
  2602. ELSE QbeGen.StoreVar(qn, qe, isR)
  2603. END
  2604. END
  2605. ELSIF k = AST.NkIf THEN
  2606. LowerExpr(AST.Child(seq, 0), t, q);
  2607. QbeGen.NewLabel(lThen); QbeGen.NewLabel(lElse); QbeGen.NewLabel(lEnd);
  2608. QbeGen.Jnz(q, lThen, lElse); QbeGen.EmitLabel(lThen);
  2609. LowerStmt(AST.Child(seq, 1));
  2610. QbeGen.Jmp(lEnd);
  2611. els := AST.Child(seq, 2); hasElse := FALSE;
  2612. WHILE (els # AST.NoNode) AND (AST.Kind(els) = AST.NkIf) DO
  2613. QbeGen.EmitLabel(lElse); QbeGen.NewLabel(lElse);
  2614. LowerExpr(AST.Child(els, 0), t, q);
  2615. QbeGen.NewLabel(lThen); QbeGen.Jnz(q, lThen, lElse);
  2616. QbeGen.EmitLabel(lThen);
  2617. LowerStmt(AST.Child(els, 1));
  2618. QbeGen.Jmp(lEnd);
  2619. els := AST.Child(els, 2)
  2620. END;
  2621. IF els # AST.NoNode THEN
  2622. QbeGen.EmitLabel(lElse); hasElse := TRUE; LowerStmt(els)
  2623. END;
  2624. IF hasElse THEN QbeGen.EmitLabel(lEnd)
  2625. ELSE QbeGen.EmitLabel(lElse); QbeGen.EmitLabel(lEnd)
  2626. END
  2627. ELSIF k = AST.NkWhile THEN
  2628. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd);
  2629. QbeGen.EmitLabel(lTop);
  2630. LowerExpr(AST.Child(seq, 0), t, q);
  2631. QbeGen.Jnz(q, lBody, lEnd); QbeGen.EmitLabel(lBody);
  2632. LowerStmt(AST.Child(seq, 1));
  2633. QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd)
  2634. ELSIF k = AST.NkRepeat THEN
  2635. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd); QbeGen.EmitLabel(lTop);
  2636. LowerStmt(AST.Child(seq, 0));
  2637. LowerExpr(AST.Child(seq, 1), t, q);
  2638. QbeGen.Jnz(q, lEnd, lTop); QbeGen.EmitLabel(lEnd)
  2639. ELSIF k = AST.NkLoop THEN
  2640. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lEnd);
  2641. QbeGen.PushLoop(lEnd); QbeGen.EmitLabel(lTop);
  2642. LowerStmt(AST.Child(seq, 0));
  2643. QbeGen.Jmp(lTop); QbeGen.PopLoop; QbeGen.EmitLabel(lEnd)
  2644. ELSIF k = AST.NkExit THEN
  2645. IF QbeGen.TopLoop(lx) THEN QbeGen.Jmp(lx) END
  2646. ELSIF k = AST.NkFor THEN
  2647. Name(AST.Child(seq, 0), lv);
  2648. LowerExpr(AST.Child(seq, 1), t, qlo);
  2649. LowerExpr(AST.Child(seq, 2), t2, qhi);
  2650. IF SymTab.IsEmptyStr(t) THEN
  2651. QbeGen.CopyOp("0", qlo); t := SymTab.CharType()
  2652. END;
  2653. IF SymTab.IsEmptyStr(t2) THEN
  2654. QbeGen.CopyOp("0", qhi); t2 := SymTab.CharType()
  2655. END;
  2656. CheckSub(SymTab.SymType(lv), qlo);
  2657. CheckSub(SymTab.SymType(lv), qhi);
  2658. (* optional BY step: a constant, default +1; its sign also
  2659. selects the termination comparison *)
  2660. step := 1;
  2661. IF AST.Child(seq, 3) # AST.NoNode THEN
  2662. LowerExpr(AST.Child(seq, 3), t3, qby);
  2663. IF NOT SymTab.ConstInt(qby, step) THEN step := 1
  2664. ELSIF step = 0 THEN step := 1
  2665. END
  2666. END;
  2667. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2668. QbeGen.StoreShortVar(lv,
  2669. SymTab.SmallIntBytes(SymTab.SymType(lv)), qlo)
  2670. ELSE QbeGen.StoreVar(lv, qlo, FALSE)
  2671. END;
  2672. QbeGen.NewLabel(lTop); QbeGen.NewLabel(lBody); QbeGen.NewLabel(lEnd);
  2673. QbeGen.EmitLabel(lTop);
  2674. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2675. QbeGen.LoadShortVar(lv,
  2676. SymTab.IsSignedSmallInt(SymTab.SymType(lv)),
  2677. SymTab.SmallIntBytes(SymTab.SymType(lv)), qt)
  2678. ELSE QbeGen.LoadVar(lv, FALSE, qt)
  2679. END;
  2680. QbeGen.NewTemp(qk);
  2681. IF step > 0 THEN QbeGen.Op3("cslew", qk, qt, qhi, FALSE)
  2682. ELSE QbeGen.Op3("csgew", qk, qt, qhi, FALSE)
  2683. END;
  2684. QbeGen.Jnz(qk, lBody, lEnd);
  2685. QbeGen.EmitLabel(lBody);
  2686. LowerStmt(AST.Child(seq, 4));
  2687. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2688. QbeGen.LoadShortVar(lv,
  2689. SymTab.IsSignedSmallInt(SymTab.SymType(lv)),
  2690. SymTab.SmallIntBytes(SymTab.SymType(lv)), qt)
  2691. ELSE QbeGen.LoadVar(lv, FALSE, qt)
  2692. END;
  2693. QbeGen.IntStr(step, qb);
  2694. QbeGen.NewTemp(qk);
  2695. QbeGen.Op3("add", qk, qt, qb, FALSE);
  2696. IF SymTab.IsSmallInt(SymTab.SymType(lv)) THEN
  2697. QbeGen.StoreShortVar(lv,
  2698. SymTab.SmallIntBytes(SymTab.SymType(lv)), qk)
  2699. ELSE QbeGen.StoreVar(lv, qk, FALSE)
  2700. END;
  2701. QbeGen.Jmp(lTop); QbeGen.EmitLabel(lEnd)
  2702. ELSIF k = AST.NkHalt THEN
  2703. IF AST.Child(seq, 0) # AST.NoNode THEN
  2704. LowerExpr(AST.Child(seq, 0), t, q) END;
  2705. QbeGen.HaltQ
  2706. ELSIF k = AST.NkGoto THEN
  2707. Name(AST.Child(seq, 0), qn);
  2708. UserLabel(qn, q);
  2709. QbeGen.Jmp(q)
  2710. ELSIF k = AST.NkLabel THEN
  2711. Name(AST.Child(seq, 0), qn);
  2712. UserLabel(qn, q);
  2713. QbeGen.EmitLabel(q)
  2714. ELSIF k = AST.NkReturn THEN
  2715. IF AST.Child(seq, 0) = AST.NoNode THEN
  2716. QbeGen.EmitRet(q, FALSE)
  2717. ELSE
  2718. LowerExpr(AST.Child(seq, 0), t, q);
  2719. IF (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs)) THEN
  2720. CheckSub(procRes[emitProc], q)
  2721. END;
  2722. IF SymTab.IsEmptyStr(t)
  2723. AND (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs))
  2724. AND (SymTab.ClassOf(procRes[emitProc]) = SymTab.ClChar) THEN
  2725. QbeGen.CopyOp("0", q); t := SymTab.CharType()
  2726. END;
  2727. IF (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs))
  2728. AND CompositeRes(procRes[emitProc]) THEN
  2729. (* composite result: copy into the hidden destination *)
  2730. QbeGen.AddrOf("__res", qt);
  2731. IF SymTab.ClassOf(procRes[emitProc]) = SymTab.ClArray THEN
  2732. QbeGen.CopyArray(qt, q, procRes[emitProc])
  2733. ELSIF SymTab.ClassOf(procRes[emitProc]) = SymTab.ClSet THEN
  2734. IF SymTab.IsBigSet(procRes[emitProc]) THEN
  2735. QbeGen.BigSetCopy(qt, q)
  2736. ELSE
  2737. QbeGen.CopySet(qt, q, SymTab.SetWords(procRes[emitProc]),
  2738. SymTab.SetWords(procRes[emitProc]))
  2739. END
  2740. ELSE QbeGen.CopyRecord(qt, q, procRes[emitProc])
  2741. END;
  2742. QbeGen.EmitRet("0", FALSE)
  2743. ELSE
  2744. IF (emitProc >= 0) AND (emitProc < VAL(INTEGER, nProcs)) THEN
  2745. t2 := procRes[emitProc]
  2746. ELSE t2 := SymTab.CurRes()
  2747. END;
  2748. conv := SymTab.IsRealType(t2) AND SymTab.IsIntFamily(t);
  2749. IF conv THEN
  2750. QbeGen.ConvIR(q, qt);
  2751. IF SymTab.IsShortReal(t2) THEN
  2752. QbeGen.ConvSR(qt, q); QbeGen.EmitRet(q, TRUE)
  2753. ELSE QbeGen.EmitRet(qt, TRUE) END
  2754. ELSIF SymTab.IsShortReal(t2) THEN
  2755. QbeGen.ConvSR(q, qt); QbeGen.EmitRet(qt, TRUE)
  2756. ELSE QbeGen.EmitRet(q, TRUE)
  2757. END
  2758. END
  2759. END
  2760. ELSIF k = AST.NkCase THEN LowerCase(seq)
  2761. ELSIF k = AST.NkWith THEN LowerWith(seq)
  2762. ELSIF k = AST.NkCall THEN
  2763. IF IsMethodCall(seq) THEN LowerMethodCall(seq, t, q, FALSE)
  2764. ELSE
  2765. CalleeName(seq, qn);
  2766. IF IsBuiltin(qn) THEN LowerBuiltinStmt(seq, qn)
  2767. ELSE LowerCall(seq, t, q, FALSE)
  2768. END
  2769. END
  2770. END
  2771. END LowerStmt;
  2772. PROCEDURE ReenterGlobals (seq: AST.Node);
  2773. (* Re-registers a nested module's non-exported globals in the enclosing
  2774. (still-open) module scope, so QbeGen.GlobalRef can resolve their
  2775. "<outer>_<name>" symbols after the nested scope has been popped. *)
  2776. VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name; chunk, vn: AST.Node;
  2777. BEGIN
  2778. IF seq = AST.NoNode THEN RETURN END;
  2779. i := 0;
  2780. WHILE i < AST.NChild(seq) DO
  2781. c := AST.Child(seq, i);
  2782. IF i = AST.MaxChild - 1 THEN ReenterGlobals(c)
  2783. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN ReenterGlobals(c)
  2784. ELSIF AST.Kind(c) = AST.NkVarDecl THEN
  2785. chunk := c;
  2786. WHILE chunk # AST.NoNode DO
  2787. j := 0;
  2788. WHILE j < AST.NChild(chunk) DO
  2789. vn := AST.Child(chunk, j);
  2790. IF AST.Kind(vn) = AST.NkIdent THEN
  2791. Name(vn, nm);
  2792. IF SymTab.ReenterModGlobal(nm, SymTab.KindVar, curUnitName) THEN
  2793. SymTab.SetSymType(nm, AST.Ty(c))
  2794. END
  2795. END;
  2796. INC(j)
  2797. END;
  2798. IF AST.NChild(chunk) > 0 THEN
  2799. vn := AST.Child(chunk, AST.NChild(chunk) - 1);
  2800. IF AST.Kind(vn) = AST.NkBlock THEN chunk := vn
  2801. ELSE chunk := AST.NoNode END
  2802. ELSE chunk := AST.NoNode END
  2803. END
  2804. ELSIF (AST.Kind(c) = AST.NkTypeDecl)
  2805. OR (AST.Kind(c) = AST.NkClassDecl) THEN
  2806. (* a nested module's TYPE/CLASS: re-register it so ObjectSize and
  2807. GlobalRef can resolve it after the nested scope is popped *)
  2808. IF AST.NChild(c) >= 1 THEN
  2809. Name(AST.Child(c, 0), nm);
  2810. IF SymTab.ReenterModGlobal(nm, SymTab.KindType, curUnitName) THEN
  2811. SymTab.SetSymType(nm, AST.Ty(c))
  2812. END
  2813. END
  2814. END;
  2815. INC(i)
  2816. END
  2817. END ReenterGlobals;
  2818. PROCEDURE ReenterImports (seq: AST.Node);
  2819. (* A nested module's FROM-imports live in its (now popped) scope. Copy
  2820. them into the enclosing scope so lowering the nested module's
  2821. declarations and body can still resolve the imported names. *)
  2822. VAR i, j: CARDINAL;
  2823. c, cn: AST.Node;
  2824. mod, nm: SymTab.Name;
  2825. BEGIN
  2826. IF seq = AST.NoNode THEN RETURN END;
  2827. i := 0;
  2828. WHILE i < AST.NChild(seq) DO
  2829. c := AST.Child(seq, i);
  2830. IF i = AST.MaxChild - 1 THEN ReenterImports(c)
  2831. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN ReenterImports(c)
  2832. ELSIF (AST.Kind(c) = AST.NkImport) AND (AST.NChild(c) >= 1) THEN
  2833. Name(AST.Child(c, 0), mod);
  2834. IF SymTab.Equal(mod, "libc") THEN
  2835. j := 1;
  2836. WHILE j < AST.NChild(c) DO
  2837. cn := AST.Child(c, j);
  2838. IF AST.Kind(cn) = AST.NkIdent THEN
  2839. Name(cn, nm);
  2840. IF SymTab.DeclareCProc(nm) THEN NoteCProc(nm) END
  2841. END;
  2842. INC(j)
  2843. END
  2844. ELSIF SymTab.ModKnown(mod)
  2845. AND NOT SymTab.Equal(mod, "SYSTEM") 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. (* plain IMPORT lists modules; only FROM adds names *)
  2852. IF SymTab.SymKind(nm) # SymTab.KindModule THEN
  2853. IF NOT SymTab.ImportFrom(mod, nm) THEN END
  2854. END
  2855. END;
  2856. INC(j)
  2857. END
  2858. END
  2859. END;
  2860. INC(i)
  2861. END
  2862. END ReenterImports;
  2863. PROCEDURE EmitVarNames (c: AST.Node);
  2864. (* Emit DeclVar for each name of an NkVarDecl; the names are a chunked
  2865. sequence (AstAppend), so follow NkBlock continuations. *)
  2866. VAR j: CARDINAL; chunk, vn: AST.Node; nm: SymTab.Name;
  2867. BEGIN
  2868. chunk := c;
  2869. WHILE chunk # AST.NoNode DO
  2870. j := 0;
  2871. WHILE j < AST.NChild(chunk) DO
  2872. vn := AST.Child(chunk, j);
  2873. IF AST.Kind(vn) = AST.NkIdent THEN
  2874. Name(vn, nm);
  2875. QbeGen.DeclVar(nm, AST.Ty(c));
  2876. IF (NOT QbeGen.InFunction())
  2877. AND (SymTab.ClassOf(AST.Ty(c)) = SymTab.ClArray)
  2878. AND QbeGen.RecArrayNeedsInit(SymTab.ArrayLen(AST.Ty(c)),
  2879. AST.Ty(c))
  2880. AND (nCountInit <= HIGH(countArr)) THEN
  2881. QbeGen.DeclRecTemplate(nm, SymTab.ArrayElem(AST.Ty(c)));
  2882. countArr[nCountInit] := nm;
  2883. countTyp[nCountInit] := AST.Ty(c);
  2884. INC(nCountInit)
  2885. END
  2886. END;
  2887. INC(j)
  2888. END;
  2889. IF AST.NChild(chunk) > 0 THEN
  2890. vn := AST.Child(chunk, AST.NChild(chunk) - 1);
  2891. IF AST.Kind(vn) = AST.NkBlock THEN chunk := vn
  2892. ELSE chunk := AST.NoNode END
  2893. ELSE chunk := AST.NoNode END
  2894. END
  2895. END EmitVarNames;
  2896. PROCEDURE EmitCountInits;
  2897. (* Initialise the length words of record-array globals that were emitted
  2898. compactly (recorded by EmitVarNames). *)
  2899. VAR k: CARDINAL;
  2900. BEGIN
  2901. k := 0;
  2902. WHILE k < nCountInit DO
  2903. QbeGen.InitRecArray(countArr[k], countTyp[k]);
  2904. INC(k)
  2905. END
  2906. END EmitCountInits;
  2907. PROCEDURE SplitModuleBody (body: AST.Node; VAR init, fin: AST.Node);
  2908. (* A module body is NkFinally(initial, final) when FINALLY is present;
  2909. otherwise it is just the initial body. *)
  2910. BEGIN
  2911. IF (body # AST.NoNode) AND (AST.Kind(body) = AST.NkFinally) THEN
  2912. init := AST.Child(body, 0);
  2913. fin := AST.Child(body, 1)
  2914. ELSE
  2915. init := body;
  2916. fin := AST.NoNode
  2917. END
  2918. END SplitModuleBody;
  2919. PROCEDURE LowerFini (nm: SymTab.Name; fin: AST.Node);
  2920. (* Emit <module>_fini as a separate function, called by main in reverse
  2921. initialization order. *)
  2922. BEGIN
  2923. IF fin # AST.NoNode THEN
  2924. QbeGen.BeginFini(nm);
  2925. nUserLab := 0;
  2926. LowerStmt(fin);
  2927. QbeGen.EndFini
  2928. END
  2929. END LowerFini;
  2930. PROCEDURE LowerDecls (seq: AST.Node);
  2931. VAR i, j: CARDINAL; c: AST.Node; nm, txt, gn: SymTab.Name; qv: QbeGen.QVal;
  2932. mg: QbeGen.QVal; uid, depth, np: CARDINAL; res, pt: SymTab.TypeIndex;
  2933. ext, pv: BOOLEAN; kk: INTEGER; ct: SymTab.TypeIndex; savedProc: INTEGER;
  2934. chunk, vn: AST.Node; pi: INTEGER;
  2935. initBody, finBody: AST.Node;
  2936. mk: ARRAY [0 .. MaxCFoldW - 1] OF CARDINAL; mw: CARDINAL; mlo: INTEGER;
  2937. BEGIN
  2938. IF seq = AST.NoNode THEN RETURN END;
  2939. i := 0;
  2940. WHILE i < AST.NChild(seq) DO
  2941. c := AST.Child(seq, i);
  2942. IF i = AST.MaxChild - 1 THEN LowerDecls(c)
  2943. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDecls(c)
  2944. ELSIF AST.Kind(c) = AST.NkClassDecl THEN
  2945. Name(AST.Child(c, 0), nm);
  2946. IF Resolve(nm, kk, ct) THEN
  2947. IF SymTab.ClassOf(ct) = SymTab.ClClass THEN
  2948. IF AST.Op(c) = 1 THEN
  2949. LowerMethods(AST.Child(c, 3), ct);
  2950. IF AST.Child(c, 2) # AST.NoNode THEN
  2951. SplitModuleBody(AST.Child(c, 2), initBody, finBody);
  2952. QbeGen.BeginInit(nm);
  2953. nUserLab := 0;
  2954. LowerStmt(initBody);
  2955. QbeGen.EndInit;
  2956. LowerFini(nm, finBody)
  2957. END
  2958. ELSE
  2959. LowerMethodHeadings(AST.Child(c, 3), ct)
  2960. END
  2961. END
  2962. END
  2963. ELSIF AST.Kind(c) = AST.NkUnit THEN
  2964. Name(AST.Child(c, 0), nm);
  2965. ReenterImports(AST.Child(c, 3));
  2966. ReenterGlobals(AST.Child(c, 1));
  2967. LowerDecls(AST.Child(c, 1));
  2968. IF AST.Child(c, 2) # AST.NoNode THEN
  2969. SplitModuleBody(AST.Child(c, 2), initBody, finBody);
  2970. QbeGen.BeginInit(nm);
  2971. nUserLab := 0;
  2972. LowerStmt(initBody);
  2973. QbeGen.EndInit;
  2974. LowerFini(nm, finBody)
  2975. END
  2976. ELSIF AST.Kind(c) = AST.NkVarDecl THEN
  2977. (* op=1 marks a forward-typed global: emit it after the rest,
  2978. as the grammar's FlushPend does *)
  2979. IF AST.Op(c) # 1 THEN EmitVarNames(c) END
  2980. ELSIF AST.Kind(c) = AST.NkConstDecl THEN
  2981. Name(AST.Child(c, 0), nm);
  2982. kk := SymTab.ClassOf(AST.Ty(c));
  2983. IF kk = SymTab.ClSet THEN
  2984. (* SET CONST: static data from the mask the grammar computed.
  2985. A module-level const is emitted under its global name
  2986. (<unit>_<name>) so a client's qualified reference binds. *)
  2987. IF LookupSetMask(nm, mk, mw, mlo) THEN
  2988. IF SymTab.GlobalRef(nm, gn) THEN
  2989. QbeGen.PoolSetNamed(gn, mk, mw, qv)
  2990. ELSE QbeGen.PoolSet(mk, mw, qv)
  2991. END;
  2992. SetConstVal(nm, qv)
  2993. ELSE SetConstVal(nm, "0")
  2994. END
  2995. ELSIF (kk = SymTab.ClArray) OR (kk = SymTab.ClRecord)
  2996. OR (kk = SymTab.ClClass) OR (kk = SymTab.ClStr)
  2997. OR (kk = SymTab.ClUStr) THEN
  2998. (* aggregate/string CONST: re-emit the constructor/string so
  2999. its static data is produced (the grammar's CtorEnd/DeclStr
  3000. are suppressed under NoEmit), then refresh the value *)
  3001. LowerExpr(AST.Child(c, 1), ct, qv);
  3002. SetConstVal(nm, qv)
  3003. ELSIF GetConstVal(nm, qv) AND QbeGen.IsImm(qv) THEN
  3004. (* scalar: use the evaluated value recorded by NoteConstVal *)
  3005. QbeGen.DeclConst(nm, qv, AST.Ty(c))
  3006. END
  3007. ELSIF AST.Kind(c) = AST.NkProcDecl THEN
  3008. Name(AST.Child(c, 0), nm);
  3009. pi := AST.Ty(c); (* proc-table index recorded by NoteProcNode *)
  3010. IF (pi < 0) OR (pi >= VAL(INTEGER, nProcs)) THEN pi := FindProc(nm) END;
  3011. IF ProcInfoIdx(pi, uid, res, depth, ext, np) THEN
  3012. QbeGen.Mangled(nm, uid, mg);
  3013. QbeGen.BeginFunc(mg);
  3014. IF CompositeRes(res) THEN
  3015. IF NOT QbeGen.FuncParam("__res", TRUE, res) THEN END
  3016. END;
  3017. j := 0;
  3018. WHILE j < np DO
  3019. IF ParamInfoIdx(pi, j, pt, pv, txt) THEN
  3020. IF NOT QbeGen.FuncParam(txt, pv OR SymTab.IsOpenArray(pt), pt) THEN END
  3021. END;
  3022. INC(j)
  3023. END;
  3024. QbeGen.SetFuncRes(res);
  3025. IF AST.Child(c, 1) = AST.NoNode THEN
  3026. (* declaration-only (definition module): replay the heading *)
  3027. QbeGen.AbortFunc
  3028. ELSE
  3029. QbeGen.EndFuncHeader;
  3030. savedProc := emitProc;
  3031. emitProc := pi;
  3032. LowerDecls(AST.Child(c, 2));
  3033. nUserLab := 0;
  3034. LowerStmt(AST.Child(c, 1));
  3035. emitProc := savedProc;
  3036. QbeGen.EndFunc(res)
  3037. END
  3038. END
  3039. END;
  3040. INC(i)
  3041. END
  3042. END LowerDecls;
  3043. PROCEDURE MaterializeGlobals (unitName: ARRAY OF CHAR; decls: AST.Node);
  3044. (* Make a unit's module-level VAR/CONST visible in the (global) scope
  3045. Lower runs in at session end, so GlobalRef resolves "<unit>_<name>". *)
  3046. VAR i, j: CARDINAL; c: AST.Node; nm: SymTab.Name; chunk, vn: AST.Node;
  3047. BEGIN
  3048. IF decls = AST.NoNode THEN RETURN END;
  3049. i := 0;
  3050. WHILE i < AST.NChild(decls) DO
  3051. c := AST.Child(decls, i);
  3052. IF i = AST.MaxChild - 1 THEN MaterializeGlobals(unitName, c)
  3053. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN MaterializeGlobals(unitName, c)
  3054. ELSIF (AST.Kind(c) = AST.NkVarDecl) OR (AST.Kind(c) = AST.NkConstDecl) THEN
  3055. chunk := c;
  3056. WHILE chunk # AST.NoNode DO
  3057. j := 0;
  3058. WHILE j < AST.NChild(chunk) DO
  3059. vn := AST.Child(chunk, j);
  3060. IF AST.Kind(vn) = AST.NkIdent THEN
  3061. Name(vn, nm);
  3062. IF NOT SymTab.MaterializeReplace(unitName, nm) THEN END
  3063. END;
  3064. INC(j)
  3065. END;
  3066. IF AST.NChild(chunk) > 0 THEN
  3067. vn := AST.Child(chunk, AST.NChild(chunk) - 1);
  3068. IF AST.Kind(vn) = AST.NkBlock THEN chunk := vn
  3069. ELSE chunk := AST.NoNode END
  3070. ELSE chunk := AST.NoNode END
  3071. END
  3072. ELSIF (AST.Kind(c) = AST.NkTypeDecl) OR (AST.Kind(c) = AST.NkClassDecl) THEN
  3073. IF AST.NChild(c) >= 1 THEN
  3074. Name(AST.Child(c, 0), nm);
  3075. IF NOT SymTab.MaterializeReplace(unitName, nm) THEN END
  3076. END
  3077. END;
  3078. INC(i)
  3079. END
  3080. END MaterializeGlobals;
  3081. PROCEDURE LowerDeferredVars (seq: AST.Node);
  3082. (* Emit the forward-typed globals (NkVarDecl op=1) after the rest of the
  3083. unit's declarations, matching the grammar's FlushPend ordering. *)
  3084. VAR i: CARDINAL; c: AST.Node;
  3085. BEGIN
  3086. IF seq = AST.NoNode THEN RETURN END;
  3087. i := 0;
  3088. WHILE i < AST.NChild(seq) DO
  3089. c := AST.Child(seq, i);
  3090. IF i = AST.MaxChild - 1 THEN LowerDeferredVars(c)
  3091. ELSIF AST.Kind(c) = AST.NkDeclSeq THEN LowerDeferredVars(c)
  3092. ELSIF (AST.Kind(c) = AST.NkVarDecl) AND (AST.Op(c) = 1) THEN
  3093. EmitVarNames(c)
  3094. END;
  3095. INC(i)
  3096. END
  3097. END LowerDeferredVars;
  3098. PROCEDURE LowerOneUnit (u: AST.Node; isProg: BOOLEAN);
  3099. VAR nm: SymTab.Name; initBody, finBody: AST.Node;
  3100. BEGIN
  3101. nCountInit := 0;
  3102. Name(AST.Child(u, 0), nm);
  3103. CopySpan(nm, curUnitName, 0, 0);
  3104. QbeGen.SetModule(nm);
  3105. MaterializeGlobals(nm, AST.Child(u, 1));
  3106. LowerDecls(AST.Child(u, 1));
  3107. LowerDeferredVars(AST.Child(u, 1));
  3108. IF AST.Child(u, 2) # AST.NoNode THEN
  3109. SplitModuleBody(AST.Child(u, 2), initBody, finBody)
  3110. ELSE
  3111. initBody := AST.NoNode; finBody := AST.NoNode
  3112. END;
  3113. IF isProg THEN
  3114. (* Program body as its own init function: main calls it, then the
  3115. finalizers, then returns ExitCode. This also makes a module
  3116. RETURN leave only the init function, not main. *)
  3117. QbeGen.BeginInit(nm);
  3118. EmitCountInits;
  3119. nUserLab := 0;
  3120. LowerStmt(initBody);
  3121. QbeGen.EndInit;
  3122. LowerFini(nm, finBody);
  3123. QbeGen.BeginBody
  3124. ELSIF AST.Child(u, 2) # AST.NoNode THEN
  3125. QbeGen.BeginInit(nm);
  3126. EmitCountInits;
  3127. nUserLab := 0;
  3128. LowerStmt(initBody);
  3129. QbeGen.EndInit;
  3130. LowerFini(nm, finBody)
  3131. ELSIF nCountInit > 0 THEN
  3132. QbeGen.BeginInit(nm);
  3133. EmitCountInits;
  3134. QbeGen.EndInit
  3135. ELSIF separateMode AND NOT defUnitMode THEN
  3136. (* Every object exports <module>_init, even when the module has
  3137. no BEGIN body, so a program can call all imported inits.
  3138. A definition lowered only to materialise its globals must not
  3139. define a second init. *)
  3140. QbeGen.BeginInit(nm);
  3141. QbeGen.EndInit
  3142. END
  3143. END LowerOneUnit;
  3144. PROCEDURE SetLegacyOpen1D;
  3145. BEGIN
  3146. legacyOpen1D := TRUE
  3147. END SetLegacyOpen1D;
  3148. PROCEDURE SetSeparate (b: BOOLEAN);
  3149. BEGIN
  3150. separateMode := b
  3151. END SetSeparate;
  3152. PROCEDURE SetDefUnit (b: BOOLEAN);
  3153. BEGIN
  3154. defUnitMode := b
  3155. END SetDefUnit;
  3156. PROCEDURE BeginSession (progName: ARRAY OF CHAR);
  3157. (* Per-unit Lower emission. The grammar still runs its inline emit while
  3158. parsing, but under NoEmit it only mutates QbeGen's counters (nothing
  3159. reaches the buffer). For each unit: BeginUnit snapshots the state
  3160. *before* parsing; after parsing, LowerUnitNow restores that snapshot
  3161. and lets Lower re-emit the unit from the same counter values the
  3162. legacy inline path would have used, so the image stays byte-identical.
  3163. EndSession writes the accumulated session image. *)
  3164. BEGIN
  3165. withTop := 0;
  3166. curImplCls := SymTab.InvalidType;
  3167. scopeTop := 0; curScopeProc := -1; emitProc := -1;
  3168. QbeGen.OpenModule(progName);
  3169. QbeGen.SetNoEmit(TRUE)
  3170. END BeginSession;
  3171. PROCEDURE BeginUnit;
  3172. (* Snapshot the pre-parse state so Lower can discard the grammar's
  3173. suppressed inline mutations for this unit. *)
  3174. BEGIN
  3175. nImps := 0;
  3176. QbeGen.SaveSession
  3177. END BeginUnit;
  3178. PROCEDURE LowerUnitNow (unit: AST.Node; isProg: BOOLEAN);
  3179. VAR nm: SymTab.Name; scoped: BOOLEAN;
  3180. BEGIN
  3181. IF unit = AST.NoNode THEN RETURN END;
  3182. QbeGen.RestoreSession;
  3183. QbeGen.SetNoEmit(FALSE);
  3184. (* Lower the unit in its own module scope, so type lookups resolve
  3185. locally and nothing needs to be copied into globScope. *)
  3186. Name(AST.Child(unit, 0), nm);
  3187. scoped := SymTab.EnterLowerScope(nm);
  3188. LowerOneUnit(unit, isProg);
  3189. IF scoped THEN SymTab.LeaveLowerScope END;
  3190. QbeGen.SetNoEmit(TRUE)
  3191. END LowerUnitNow;
  3192. PROCEDURE EndSession;
  3193. VAR scoped: BOOLEAN;
  3194. BEGIN
  3195. QbeGen.SetNoEmit(FALSE);
  3196. (* EndModule probes the program module's ExitCode symbol. *)
  3197. scoped := SymTab.EnterLowerScope(curUnitName);
  3198. QbeGen.EndModule(curUnitName);
  3199. IF scoped THEN SymTab.LeaveLowerScope END
  3200. END EndSession;
  3201. BEGIN
  3202. scopeTop := 0; curScopeProc := -1; emitProc := -1;
  3203. separateMode := FALSE; defUnitMode := FALSE
  3204. END Lower.