M2.atg 210 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686
  1. COMPILER M2
  2. (* Step 1 — minimal integer pipeline (m2compiler-V3).
  3. Subset: program MODULE + CONST (literal) + VAR INTEGER +
  4. assignment + integer expressions (+ - * DIV MOD, leading sign,
  5. parens). Fresh QBE backend (QbeGen) to gen_ssa/<Module>.ssa;
  6. assemble with qbe, link with cc.
  7. Test convention: a global VAR ExitCode : INTEGER makes generated
  8. $main return its value as the process exit code, else return 0.
  9. Semantic errors reuse the V1/V2/Test2 family: 200 duplicate,
  10. 201 undeclared, 202 module name mismatch, 210 bad assignment,
  11. 211 bad arithmetic, 221 not a type, 230 not supported yet,
  12. 231 opaque type outside definition.
  13. Scalar-phase TYPEs (named, integer subrange, enum) check fully;
  14. composite forms wait for step 3. Procedure headings (formals,
  15. result, FORWARD) enter scopes now; bodies parse + check with one
  16. 230 at END (lowering = step 4).
  17. Statements: assignment, IF/ELSIF/ELSE, WHILE, REPEAT/UNTIL,
  18. LOOP/EXIT (230 outside LOOP), FOR/TO/static-sign-BY, full CASE
  19. (labels, ranges, ELSE; compare-chain), RETURN with 232 checks
  20. (outside proc / value mismatch / missing value). WITH waits for
  21. records (step 3). Boolean connectives are eager (or/and/xor);
  22. relations yield 0/1 via cXXw.
  23. Clarion-form classes (docs/OOP.txt): CLASS decl + single
  24. inheritance + CLASS IMPLEMENTATION blocks, methods with ";"
  25. (per the Table example, not the sketch's ","), VIRTUAL flagged.
  26. Scopes and member checks now; lowering later (one 230 per
  27. class/impl block). Classic identifiers: no underscores, so the
  28. Table example's _names stay lexically out of reach.
  29. Step 3.1 arrays: "ARRAY [lo..hi, ...] OF T" (folded literal
  30. bounds, int/char) and open "ARRAY OF T" formals; index suffixes
  31. with per-level checks (217/218, trap on breach via $abort);
  32. whole-array ":=" with runtime count check + blit; string
  33. literals lower as descriptors (1-char stays CHAR, empty works);
  34. array/string "=" is 213 (no built-in whole comparison).
  35. Step 3.3 sets: multi-word masks (no header, static words) over
  36. bases ≤ 256 values; literals are SET OF [0..255] (222 on
  37. out-of-span); + - * / as or/and/xor-not, IN with span trap,
  38. =/# word-wise (lenient cross-base); CASE labels reject sets.
  39. Step 3.4 records: flat blobs; array fields are pointers to static
  40. descriptors (locked amendment — one layout per type); nested
  41. records inline; static declaration-order offsets; field chains
  42. mix with indexes; WITH pushes fields + bases (215/216);
  43. whole-record deep copy; record/set/class "=" is 213.
  44. Step 3.6 pointers: vars (l), NIL as a real type (FNil — assignment
  45. and =/# work, everything else 210-214/222), ^ deref with sfx
  46. discipline (address flows, load at use; chains compose),
  47. pointer =/# via ceql/cnel (< > etc. are 213), NEW/DISPOSE as
  48. builtin statements via extern malloc/free (recursive skeleton
  49. init; DISPOSE shallow and nils, deviating from Wirth-undefined);
  50. nil-deref is raw (no check). *)
  51. IMPORT SymTab, QbeGen, AST, Lower;
  52. VAR
  53. (* Two-phase parse (docs/plan-two-phase-parse.md), milestone 1. When
  54. TRUE each outermost procedure/method body is shadow-skipped at the
  55. token level and the skip verified before the body parses normally.
  56. Set by the driver (-notwophase turns it off); default on.
  57. Blocks being parsed so only outermost bodies probe. *)
  58. twoPhaseParse: BOOLEAN;
  59. (* Two-phase parse spans (milestone 2a): one entry per outermost body
  60. shadow-skipped while twoPhaseParse is on — procedure name and the
  61. buffer offset its body starts at (the lookahead token's nextPos).
  62. Per-parse; nothing consumes the table yet. *)
  63. nSpans: CARDINAL;
  64. spanName: ARRAY [0 .. 1023] OF SymTab.Name;
  65. spanStart: ARRAY [0 .. 1023] OF M2S.INT32;
  66. spanIdx: ARRAY [0 .. 1023] OF CARDINAL;
  67. spanTy: ARRAY [0 .. 1023] OF INTEGER;
  68. spanNode: ARRAY [0 .. 1023] OF AST.Node;
  69. (* Two-phase parse (milestone 2c): phase-1 skips a module-level proc
  70. body (DeferSkip) and phase 2 re-parses it at unit end (RepassAll).
  71. `deferredBody` reports the skip to ProcDecl's close choice;
  72. `repassing` disables deferral during phase 2; `allowDefer` limits
  73. deferral to plain ProcDecls (methods stay inline); `curProcNode` is
  74. the NkProcDecl whose body is about to be parsed. *)
  75. deferredBody: BOOLEAN;
  76. repassing: BOOLEAN;
  77. allowDefer: BOOLEAN;
  78. curProcNode: AST.Node;
  79. (* Result slot for the expression-AST builder (slice 2). Every
  80. Expr/SimExpr/Term/Fact leaves its node here; the combination
  81. productions save it into locals before parsing the next operand.
  82. `astIsLit` in Fact is per-invocation, so a nested Fact cannot make
  83. an outer non-literal Fact look literal. *)
  84. astCur: AST.Node;
  85. (* Actual-argument nodes collected by ActParam for the call being
  86. parsed by ArgList (slice 4). Fact resets the count before the
  87. optional ArgList and then folds the nodes into an NkCall. *)
  88. astNArgs: CARDINAL;
  89. astArgs: ARRAY [0 .. 31] OF AST.Node;
  90. (* Statement-AST result slot (slice 5): the most recently parsed
  91. statement. StatSeq folds these into an NkBlock. *)
  92. astStmt: AST.Node;
  93. (* Declaration-AST result slot (slice 6): the most recently built
  94. declaration; DeclSeq folds these into an NkDeclSeq. *)
  95. astDecl: AST.Node;
  96. (* The local declarations of the most recent Block (a procedure body);
  97. ProcDecl stores them as the proc node's child 2. *)
  98. astBlkDecls: AST.Node;
  99. (* Unit-AST root (slice 7): NkUnit(name, decls, body). *)
  100. astUnit: AST.Node;
  101. (* Import accumulator (slice 11): `{ Import }` appends NkImport
  102. nodes here; each unit stores them as NkUnit child[3]. *)
  103. astImp, astImpTail: AST.Node;
  104. (* Class-AST accumulators (slice 13): the class node currently being
  105. parsed and its parent/field/method lists. Classes are not nested
  106. inside one another, so module-level state is safe. *)
  107. astCls, astClsP, astClsPTail, astClsF, astClsFTail,
  108. astClsM, astClsMTail, astMethod: AST.Node;
  109. (* Class of the method named by the last `obj.Method` designator
  110. (InvalidType when the callee is an ordinary procedure). Set by
  111. Design, consumed by the following ArgList. *)
  112. methCls: SymTab.TypeIndex;
  113. (* Class of the type of the innermost `TypeName{...}` brace
  114. constructor (ClSet or ClArray); dispatches BraceElem. *)
  115. braceCls: INTEGER;
  116. (* Module-level VAR declarations whose type was still an unresolved
  117. forward alias at declaration time; emitted once the TYPE block
  118. completes (module scope only). *)
  119. nPendVar: CARDINAL;
  120. pendVarName: ARRAY [0 .. 255] OF SymTab.Name;
  121. pendVarT: ARRAY [0 .. 255] OF SymTab.TypeIndex;
  122. (* Forward module-level variables referenced from a procedure body. *)
  123. (* GOTO/labels: the label and goto names of the procedure being parsed,
  124. reset per procedure and checked at its END. *)
  125. nLab, nGot: CARDINAL;
  126. labNm, gotNm: ARRAY [0 .. 255] OF SymTab.Name;
  127. (* Generics (Increment 1): the last refining module seen — instance
  128. name, generic name, and the actual type parameters. *)
  129. refInst, refGen: SymTab.Name;
  130. refN: CARDINAL;
  131. refActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
  132. isGen: BOOLEAN;
  133. (* Generics (Increment 2): instantiation re-parse context. When the
  134. driver re-parses a generic's source to instantiate it as `instName`,
  135. instActive is TRUE, the module is renamed, and each type formal is
  136. bound to the corresponding instActual entry. *)
  137. instActive: BOOLEAN;
  138. instName: SymTab.Name;
  139. instActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
  140. instN: CARDINAL;
  141. instFk: CARDINAL; (* formal cursor while binding during re-parse *)
  142. (* Identity of the last-parsed unit and refinement, for the driver's
  143. generic registry and its re-parse decision. *)
  144. unitName: SymTab.Name;
  145. unitWasGen: BOOLEAN;
  146. unitWasDef: BOOLEAN;
  147. refSeen: BOOLEAN;
  148. refIsDef: BOOLEAN;
  149. PROCEDURE CopyNm (src: ARRAY OF CHAR; VAR dst: SymTab.Name);
  150. VAR i: CARDINAL;
  151. BEGIN
  152. i := 0;
  153. WHILE (i <= HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # CHR(0)) DO
  154. dst[i] := src[i]; INC(i)
  155. END;
  156. IF i <= HIGH(dst) THEN dst[i] := CHR(0) END
  157. END CopyNm;
  158. PROCEDURE InInst () : BOOLEAN;
  159. BEGIN RETURN instActive END InInst;
  160. PROCEDURE InstNameGet (VAR nm: SymTab.Name);
  161. BEGIN CopyNm(instName, nm) END InstNameGet;
  162. PROCEDURE InstActualGet (i: CARDINAL) : SymTab.TypeIndex;
  163. BEGIN
  164. IF i >= instN THEN RETURN SymTab.InvalidType END;
  165. RETURN instActual[i]
  166. END InstActualGet;
  167. PROCEDURE InstBegin (name: ARRAY OF CHAR);
  168. BEGIN instActive := TRUE; CopyNm(name, instName); instN := 0;
  169. instFk := 0 END InstBegin;
  170. PROCEDURE InstAddActual (t: SymTab.TypeIndex);
  171. BEGIN
  172. IF instN <= HIGH(instActual) THEN instActual[instN] := t; INC(instN) END
  173. END InstAddActual;
  174. PROCEDURE InstEnd;
  175. BEGIN instActive := FALSE; instN := 0 END InstEnd;
  176. PROCEDURE UnitNameGet (VAR nm: SymTab.Name);
  177. BEGIN CopyNm(unitName, nm) END UnitNameGet;
  178. PROCEDURE UnitIsGeneric () : BOOLEAN;
  179. BEGIN RETURN unitWasGen END UnitIsGeneric;
  180. PROCEDURE UnitIsDefModule () : BOOLEAN;
  181. BEGIN RETURN unitWasDef END UnitIsDefModule;
  182. PROCEDURE RefineSeen () : BOOLEAN;
  183. BEGIN RETURN refSeen END RefineSeen;
  184. PROCEDURE RefineIsDef () : BOOLEAN;
  185. BEGIN RETURN refIsDef END RefineIsDef;
  186. PROCEDURE RefineInst (VAR nm: SymTab.Name);
  187. BEGIN CopyNm(refInst, nm) END RefineInst;
  188. PROCEDURE RefineGen (VAR nm: SymTab.Name);
  189. BEGIN CopyNm(refGen, nm) END RefineGen;
  190. PROCEDURE RefineActualCount () : CARDINAL;
  191. BEGIN RETURN refN END RefineActualCount;
  192. PROCEDURE RefineActualGet (i: CARDINAL) : SymTab.TypeIndex;
  193. BEGIN
  194. IF i >= refN THEN RETURN SymTab.InvalidType END;
  195. RETURN refActual[i]
  196. END RefineActualGet;
  197. PROCEDURE NoteLabel (nm: ARRAY OF CHAR);
  198. (* Record a statement label; duplicate is 200. *)
  199. VAR i: CARDINAL;
  200. BEGIN
  201. i := 0;
  202. WHILE i < nLab DO
  203. IF SymTab.Equal(labNm[i], nm) THEN SemError(200); RETURN END;
  204. INC(i)
  205. END;
  206. IF nLab <= HIGH(labNm) THEN
  207. CopyNm(nm, labNm[nLab]); INC(nLab)
  208. END
  209. END NoteLabel;
  210. PROCEDURE NoteGoto (nm: ARRAY OF CHAR);
  211. VAR i: CARDINAL;
  212. BEGIN
  213. i := 0;
  214. WHILE i < nGot DO
  215. IF SymTab.Equal(gotNm[i], nm) THEN RETURN END;
  216. INC(i)
  217. END;
  218. IF nGot <= HIGH(gotNm) THEN
  219. CopyNm(nm, gotNm[nGot]); INC(nGot)
  220. END
  221. END NoteGoto;
  222. PROCEDURE CheckGotos;
  223. (* At a procedure's END: every GOTO must name a label in that procedure. *)
  224. VAR i, j: CARDINAL; found: BOOLEAN;
  225. BEGIN
  226. i := 0;
  227. WHILE i < nGot DO
  228. found := FALSE; j := 0;
  229. WHILE (j < nLab) AND NOT found DO
  230. IF SymTab.Equal(labNm[j], gotNm[i]) THEN found := TRUE END;
  231. INC(j)
  232. END;
  233. IF NOT found THEN SemError(201) END;
  234. INC(i)
  235. END
  236. END CheckGotos;
  237. PROCEDURE FlushPend;
  238. (* Emit module-level globals whose forward type is now resolved. *)
  239. VAR k: CARDINAL;
  240. BEGIN
  241. k := 0;
  242. WHILE k < nPendVar DO
  243. INC(k)
  244. END;
  245. nPendVar := 0
  246. END FlushPend;
  247. PROCEDURE AstAppend (kind: INTEGER; VAR head, tail: AST.Node;
  248. item: AST.Node);
  249. (* Appends `item` to a chunked sequence: each node holds up to
  250. AST.MaxChild-1 items; child[MaxChild-1] continues into the next
  251. chunk. Unbounded, so blocks/decl sequences are not capped at 8. *)
  252. VAR n: AST.Node;
  253. BEGIN
  254. IF item = AST.NoNode THEN RETURN END;
  255. IF head = AST.NoNode THEN
  256. head := AST.MakeNode(kind); tail := head
  257. END;
  258. IF AST.NChild(tail) >= AST.MaxChild - 1 THEN
  259. n := AST.MakeNode(kind);
  260. AST.SetChild(tail, AST.MaxChild - 1, n);
  261. tail := n
  262. END;
  263. AST.SetChild(tail, AST.NChild(tail), item)
  264. END AstAppend;
  265. PROCEDURE AstCallNode (callee: AST.Node) : AST.Node;
  266. (* Builds NkCall(callee, actuals...) from astArgs/astNArgs. The actuals
  267. are a chunked sequence (AstAppend): a call can have more than
  268. MaxChild-1 arguments (the generic ArgList has 9), and SetChild would
  269. silently drop the tail. NkBlock marks the continuation chunks. *)
  270. VAR n, tail: AST.Node; j: CARDINAL;
  271. BEGIN
  272. n := AST.MakeNode(AST.NkCall);
  273. AST.SetChild(n, 0, callee);
  274. tail := n;
  275. j := 0;
  276. WHILE j < astNArgs DO
  277. AstAppend(AST.NkBlock, n, tail, astArgs[j]);
  278. INC(j)
  279. END;
  280. RETURN n
  281. END AstCallNode;
  282. PROCEDURE GetUnit (): AST.Node;
  283. (* The most recently parsed unit's AST root (for the Lower comparison). *)
  284. BEGIN
  285. RETURN astUnit
  286. END GetUnit;
  287. PROCEDURE SetTwoPhase (b: BOOLEAN);
  288. (* Driver switch for the two-phase parse probe (milestone 1). *)
  289. BEGIN
  290. twoPhaseParse := b
  291. END SetTwoPhase;
  292. PROCEDURE TokIs (kw: ARRAY OF CHAR): BOOLEAN;
  293. (* The current lookahead token's source text equals kw. Compares text,
  294. not token codes, so grammar renumbering cannot desync the skipper. *)
  295. VAR tok: ARRAY [0 .. 63] OF CHAR;
  296. BEGIN
  297. M2S.GetName(M2S.nextPos, M2S.nextLen, tok);
  298. RETURN SymTab.Equal(tok, kw)
  299. END TokIs;
  300. PROCEDURE Adv;
  301. (* Advance one token: exactly the parser frame's Get for a grammar
  302. without pragmas (its pragma branch is empty and the scanner never
  303. returns a token above maxT, so the repeat loop runs once). A
  304. separate name because the frame's Get is declared later in this
  305. module: a bare Get here would bind the imported M2S.Get (which takes
  306. a parameter) under single-pass compilers. *)
  307. BEGIN
  308. M2S.Get(sym);
  309. INC(errDist)
  310. END Adv;
  311. PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32);
  312. (* Records an outermost body span for the re-parse pass (milestone 2).
  313. Diagnostic only for now: nothing consumes the table yet. Declared
  314. before its caller: V3 resolves single-pass (declaration before use),
  315. with no forward tolerance for procedure calls. *)
  316. BEGIN
  317. IF nSpans > HIGH(spanName) THEN RETURN END;
  318. CopyNm(pn, spanName[nSpans]);
  319. spanStart[nSpans] := start;
  320. spanIdx[nSpans] := SymTab.DeferBody();
  321. INC(nSpans)
  322. END NoteSpan;
  323. PROCEDURE Openers (): BOOLEAN;
  324. (* TRUE when the current token opens a block that must be closed by an
  325. END (BEGIN is excluded: a block's BEGIN shares the declaration END;
  326. REPEAT..UNTIL and EXIT/RETURN need no END). *)
  327. BEGIN
  328. RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
  329. OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
  330. OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
  331. OR TokIs("WITH")
  332. END Openers;
  333. PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
  334. (* Phase 1 of the deferral: skip the body starting at the current token
  335. (the first token after the heading's ';') up to the matching END,
  336. verify the END's name, and LEAVE the scanner positioned exactly at
  337. that END (so Block's trailing "END" ident consumes it for real), with
  338. the span recorded for the re-parse pass. On any inconsistency,
  339. restore the scanner and return FALSE so the caller parses normally. *)
  340. VAR depth, guard: CARDINAL;
  341. nm: SymTab.Name;
  342. ok: BOOLEAN;
  343. start, endPos: M2S.INT32;
  344. BEGIN
  345. deferredBody := FALSE;
  346. start := M2S.nextPos;
  347. M2S.PushPos;
  348. depth := 0; guard := 0; ok := TRUE;
  349. LOOP
  350. IF sym = 0 THEN ok := FALSE; EXIT END;
  351. IF TokIs("END") THEN
  352. IF depth = 0 THEN EXIT END;
  353. DEC(depth)
  354. ELSIF Openers() THEN
  355. INC(depth)
  356. END;
  357. Adv;
  358. INC(guard);
  359. IF guard > 1000000 THEN ok := FALSE; EXIT END
  360. END;
  361. IF ok THEN
  362. (* sym is the matching END; check the name after it, then seek back
  363. so Block sees END (its "END" ident then consumes it for real). *)
  364. endPos := M2S.nextPos;
  365. Adv;
  366. M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
  367. IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
  368. IF ok THEN
  369. M2S.SeekTo(endPos); Adv
  370. END
  371. END;
  372. IF ok THEN
  373. NoteSpan(pn, start);
  374. spanTy[nSpans - 1] := Lower.CurScopeProc();
  375. spanNode[nSpans - 1] := curProcNode;
  376. M2S.DropPos; (* keep the scanner at END; discard the snapshot *)
  377. deferredBody := TRUE;
  378. RETURN TRUE
  379. ELSE
  380. M2S.PopPos;
  381. FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
  382. FileIO.WriteString(FileIO.StdOut, pn);
  383. FileIO.WriteLn(FileIO.StdOut);
  384. RETURN FALSE
  385. END
  386. END DeferSkip;
  387. CHARACTERS
  388. eol = CHR(13) .
  389. lf = CHR(10) .
  390. letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
  391. digit = "0123456789" .
  392. hexDigit = digit + "ABCDEFabcdef" .
  393. noQuote1 = ANY - "'" - eol .
  394. noQuote2 = ANY - '"' - eol .
  395. IGNORE CHR(9) .. CHR(13)
  396. COMMENTS FROM "(*" TO "*)" NESTED
  397. COMMENTS FROM "//" TO lf
  398. TOKENS
  399. ident = letter { letter | digit | "_" } .
  400. integer = digit { digit }
  401. | digit { digit } CONTEXT("..")
  402. | "0x" hexDigit { hexDigit }
  403. | "0X" hexDigit { hexDigit } .
  404. real = digit { digit } "." { digit }
  405. [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
  406. string = "'" { noQuote1 } "'"
  407. | '"' { noQuote2 } '"' .
  408. charConst = digit { digit } ( "C" | "c" ) .
  409. ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
  410. PRODUCTIONS
  411. M2
  412. = (. astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
  413. astImp := AST.NoNode;
  414. astImpTail := AST.NoNode;
  415. nSpans := 0;
  416. SymTab.DeferReset; .)
  417. Unit "." .
  418. (* Units: program modules compile fully; DEFINITION and
  419. IMPLEMENTATION modules parse + check now but lower in step 4
  420. (each ends with one 230); same for nested local modules. *)
  421. (* Generics (Increment 1): formal and actual parameters. Formals are
  422. TYPE parameters only; actuals are type identifiers. *)
  423. GenericFormals
  424. = "(" GenericFormal { ";" GenericFormal } ")" .
  425. GenericFormal (. VAR nm: SymTab.Name; .)
  426. = GetIdent<nm> (. IF instActive THEN
  427. IF NOT SymTab.EnterTypeParamBound(nm,
  428. InstActualGet(instFk)) THEN
  429. SemError(200) END
  430. ELSIF NOT SymTab.EnterTypeParam(nm) THEN
  431. SemError(200) END;
  432. INC(instFk); .)
  433. { "," GetIdent<nm> (. IF instActive THEN
  434. IF NOT SymTab.EnterTypeParamBound(nm,
  435. InstActualGet(instFk)) THEN
  436. SemError(200) END
  437. ELSIF NOT SymTab.EnterTypeParam(nm) THEN
  438. SemError(200) END;
  439. INC(instFk); .) }
  440. ":" "TYPE" .
  441. Actuals
  442. = Actual { "," Actual } .
  443. Actual (. VAR at: SymTab.TypeIndex; .)
  444. = TypeIdent<at> (. IF refN <= HIGH(refActual) THEN
  445. refActual[refN] := at; INC(refN)
  446. END; .) .
  447. Unit
  448. = (. isGen := FALSE;
  449. allowDefer := FALSE;
  450. repassing := FALSE; .)
  451. [ "GENERIC" (. isGen := TRUE; .) ]
  452. ( DefUnit | ImplUnit | ProgModule ) .
  453. (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
  454. and one program (last) into one image. Units share the symbol
  455. table; imports materialize exported names. *)
  456. DefUnit (. VAR m1, m2, pn: SymTab.Name;
  457. g: SymTab.Name;
  458. astSeq, astTail, astProc: AST.Node; .)
  459. = (. refN := 0; refSeen := FALSE; .)
  460. "DEFINITION" "MODULE"
  461. GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
  462. IF instActive THEN
  463. IF NOT SymTab.Reenter(m1,
  464. SymTab.UnitDef) THEN
  465. SemError(200) END
  466. ELSIF NOT SymTab.BeginDef(m1) THEN
  467. SemError(200) END;
  468. QbeGen.SetModule(m1);
  469. CopyNm(m1, unitName);
  470. unitWasGen := isGen
  471. AND NOT instActive;
  472. unitWasDef := TRUE; .)
  473. [ GenericFormals ]
  474. ( ";"
  475. { Import (. AstAppend(AST.NkDeclSeq,
  476. astImp, astImpTail, astDecl); .) }
  477. [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
  478. list: parsed, and the
  479. names are already exported
  480. by the module scope *) .)
  481. GetIdent<pn> { "," GetIdent<pn> } ";" ]
  482. (. astSeq := AST.NoNode;
  483. astTail := AST.NoNode; .)
  484. { ConstBlock (. AstAppend(AST.NkDeclSeq,
  485. astSeq, astTail, astDecl); .)
  486. | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
  487. astSeq, astTail, astDecl); .)
  488. | VarBlock (. AstAppend(AST.NkDeclSeq,
  489. astSeq, astTail, astDecl); .)
  490. | ProcHeading<pn, SymTab.InvalidType> ";"
  491. (. (* a heading only: record it so
  492. Lower can replay it *)
  493. astProc := AST.MakeNode(AST.NkProcDecl);
  494. AST.SetOp(astProc, 0);
  495. AST.SetChild(astProc, 0,
  496. AST.MakeLeaf(AST.NkIdent, pn));
  497. AstAppend(AST.NkDeclSeq,
  498. astSeq, astTail, astProc);
  499. Lower.NoteProcNode(astProc);
  500. Lower.ScopeLeave;
  501. SymTab.CloseProc;
  502. QbeGen.AbortFunc; .) }
  503. (. astUnit := AST.MakeNode(AST.NkUnit);
  504. AST.SetChild(astUnit, 0,
  505. AST.MakeLeaf(AST.NkIdent, m1));
  506. AST.SetChild(astUnit, 1, astSeq);
  507. AST.SetChild(astUnit, 3, astImp);
  508. astDecl := AST.NoNode;
  509. astStmt := AST.NoNode; .)
  510. "END"
  511. GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
  512. IF NOT SymTab.Equal(m1, m2) THEN
  513. SemError(202) END;
  514. SymTab.EndUnit; .)
  515. | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
  516. (. CopyNm(m1, refInst);
  517. CopyNm(g, refGen);
  518. refSeen := TRUE; refIsDef := TRUE;
  519. astUnit := AST.MakeNode(AST.NkUnit);
  520. AST.SetChild(astUnit, 0,
  521. AST.MakeLeaf(AST.NkIdent, m1));
  522. astDecl := AST.NoNode;
  523. astStmt := AST.NoNode; .)
  524. "END"
  525. GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
  526. SemError(202) END;
  527. SymTab.EndUnit; .) ) .
  528. ImplUnit (. VAR m1, m2: SymTab.Name;
  529. g: SymTab.Name;
  530. k: CARDINAL;
  531. rp: CARDINAL;
  532. rpOk: BOOLEAN;
  533. rErrs: INTEGER;
  534. rDecl, rStmt: AST.Node;
  535. rnm: SymTab.Name;
  536. rSym, rErr: CARDINAL;
  537. fname: SymTab.Name;
  538. unres: BOOLEAN;
  539. astNode: AST.Node; .)
  540. = (. refN := 0; refSeen := FALSE; .)
  541. "IMPLEMENTATION" "MODULE"
  542. GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
  543. IF instActive THEN
  544. IF NOT SymTab.Reenter(m1,
  545. SymTab.UnitImpl) THEN
  546. SemError(201) END
  547. ELSIF NOT SymTab.BeginImpl(m1) THEN
  548. SemError(201) END;
  549. astStmt := AST.NoNode;
  550. astDecl := AST.NoNode;
  551. astImp := AST.NoNode;
  552. astImpTail := AST.NoNode;
  553. nPendVar := 0;
  554. CopyNm(m1, unitName);
  555. unitWasGen := isGen AND NOT instActive;
  556. unitWasDef := FALSE;
  557. QbeGen.SetModule(m1); .)
  558. [ GenericFormals ]
  559. ( ";"
  560. { Import (. AstAppend(AST.NkDeclSeq,
  561. astImp, astImpTail, astDecl); .) }
  562. DeclSeq (. astStmt := AST.NoNode; .)
  563. [ "BEGIN" (. FlushPend;
  564. k := 0;
  565. WHILE k < SymTab.FwdPending() DO
  566. SymTab.FwdInfo(k, fname, unres);
  567. IF unres THEN SemError(201) END;
  568. INC(k)
  569. END;
  570. SymTab.FwdClear;
  571. nLab := 0; nGot := 0; .)
  572. [ StatSeq ] ]
  573. (. IF twoPhaseParse THEN
  574. rSym := sym; rErr := errDist;
  575. rDecl := astDecl; rStmt := astStmt;
  576. M2S.PushPos;
  577. repassing := TRUE;
  578. rp := 0;
  579. WHILE rp < nSpans DO
  580. k := 0;
  581. WHILE (k <= HIGH(rnm))
  582. AND (spanName[rp][k] # CHR(0)) DO
  583. rnm[k] := spanName[rp][k]; INC(k)
  584. END;
  585. rnm[k] := CHR(0);
  586. M2S.SeekTo(spanStart[rp]);
  587. Adv;
  588. rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
  589. IF NOT rpOk THEN
  590. FileIO.WriteString(FileIO.StdOut,
  591. "twophase reenter failed");
  592. FileIO.WriteLn(FileIO.StdOut)
  593. END;
  594. Lower.ReenterScopeProc(spanTy[rp]);
  595. QbeGen.BeginFunc("");
  596. Block(rnm);
  597. AST.SetChild(spanNode[rp], 1, astStmt);
  598. AST.SetChild(spanNode[rp], 2, astBlkDecls);
  599. Lower.ScopeLeave;
  600. SymTab.CloseProc;
  601. QbeGen.EndFunc(SymTab.ProcRes(rnm));
  602. INC(rp)
  603. END;
  604. rErrs := M2S.errors;
  605. repassing := FALSE;
  606. M2S.PopPos;
  607. sym := rSym; errDist := rErr;
  608. M2S.errors := rErrs;
  609. astDecl := rDecl; astStmt := rStmt
  610. END; .)
  611. "END"
  612. GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
  613. FlushPend;
  614. k := 0;
  615. WHILE k < SymTab.FwdPending() DO
  616. SymTab.FwdInfo(k, fname, unres);
  617. IF unres THEN SemError(201) END;
  618. INC(k)
  619. END;
  620. SymTab.FwdClear;
  621. astNode := AST.MakeNode(AST.NkUnit);
  622. AST.SetChild(astNode, 0,
  623. AST.MakeLeaf(AST.NkIdent, m1));
  624. AST.SetChild(astNode, 1, astDecl);
  625. AST.SetChild(astNode, 2, astStmt);
  626. AST.SetChild(astNode, 3, astImp);
  627. astUnit := astNode;
  628. IF NOT SymTab.Equal(m1, m2) THEN
  629. SemError(202) END;
  630. CheckGotos;
  631. SymTab.EndUnit; .)
  632. | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
  633. (. CopyNm(m1, refInst);
  634. CopyNm(g, refGen);
  635. refSeen := TRUE; refIsDef := FALSE;
  636. astNode := AST.MakeNode(AST.NkUnit);
  637. AST.SetChild(astNode, 0,
  638. AST.MakeLeaf(AST.NkIdent, m1));
  639. astDecl := AST.NoNode;
  640. astStmt := AST.NoNode; .)
  641. "END"
  642. GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
  643. SemError(202) END;
  644. SymTab.EndUnit; .) ) .
  645. ProgModule (. VAR m1, m2: SymTab.Name;
  646. k: CARDINAL;
  647. rp: CARDINAL;
  648. rpOk: BOOLEAN;
  649. rErrs: INTEGER;
  650. rDecl, rStmt: AST.Node;
  651. rnm: SymTab.Name;
  652. rSym, rErr: CARDINAL;
  653. fname: SymTab.Name;
  654. unres: BOOLEAN;
  655. astNode: AST.Node; .)
  656. = "MODULE"
  657. GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
  658. SemError(200) END;
  659. astStmt := AST.NoNode;
  660. astDecl := AST.NoNode;
  661. astImp := AST.NoNode;
  662. astImpTail := AST.NoNode;
  663. nPendVar := 0;
  664. QbeGen.SetModule(m1); .)
  665. [ Priority ]
  666. ";"
  667. { Import (. AstAppend(AST.NkDeclSeq,
  668. astImp, astImpTail, astDecl); .) }
  669. DeclSeq (. astStmt := AST.NoNode; .)
  670. [ "BEGIN" (. FlushPend;
  671. k := 0;
  672. WHILE k < SymTab.FwdPending() DO
  673. SymTab.FwdInfo(k, fname, unres);
  674. IF unres THEN SemError(201) END;
  675. INC(k)
  676. END;
  677. SymTab.FwdClear;
  678. nLab := 0; nGot := 0; .)
  679. [ StatSeq ] ]
  680. (. IF twoPhaseParse THEN
  681. rSym := sym; rErr := errDist;
  682. rDecl := astDecl; rStmt := astStmt;
  683. M2S.PushPos;
  684. repassing := TRUE;
  685. rp := 0;
  686. WHILE rp < nSpans DO
  687. k := 0;
  688. WHILE (k <= HIGH(rnm))
  689. AND (spanName[rp][k] # CHR(0)) DO
  690. rnm[k] := spanName[rp][k]; INC(k)
  691. END;
  692. rnm[k] := CHR(0);
  693. M2S.SeekTo(spanStart[rp]);
  694. Adv;
  695. rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
  696. IF NOT rpOk THEN
  697. FileIO.WriteString(FileIO.StdOut,
  698. "twophase reenter failed");
  699. FileIO.WriteLn(FileIO.StdOut)
  700. END;
  701. Lower.ReenterScopeProc(spanTy[rp]);
  702. QbeGen.BeginFunc("");
  703. Block(rnm);
  704. AST.SetChild(spanNode[rp], 1, astStmt);
  705. AST.SetChild(spanNode[rp], 2, astBlkDecls);
  706. Lower.ScopeLeave;
  707. SymTab.CloseProc;
  708. QbeGen.EndFunc(SymTab.ProcRes(rnm));
  709. INC(rp)
  710. END;
  711. rErrs := M2S.errors;
  712. repassing := FALSE;
  713. M2S.PopPos;
  714. sym := rSym; errDist := rErr;
  715. M2S.errors := rErrs;
  716. astDecl := rDecl; astStmt := rStmt
  717. END; .)
  718. "END"
  719. GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
  720. FlushPend;
  721. k := 0;
  722. WHILE k < SymTab.FwdPending() DO
  723. SymTab.FwdInfo(k, fname, unres);
  724. IF unres THEN SemError(201) END;
  725. INC(k)
  726. END;
  727. SymTab.FwdClear;
  728. IF NOT SymTab.Equal(m1, m2) THEN
  729. SemError(202) END;
  730. astNode := AST.MakeNode(AST.NkUnit);
  731. AST.SetChild(astNode, 0,
  732. AST.MakeLeaf(AST.NkIdent, m1));
  733. AST.SetChild(astNode, 1, astDecl);
  734. AST.SetChild(astNode, 2, astStmt);
  735. AST.SetChild(astNode, 3, astImp);
  736. astUnit := astNode;
  737. CheckGotos;
  738. SymTab.EndUnit; .) .
  739. DeclSeq (. VAR astSeq, astTail: AST.Node; .)
  740. = (. astSeq := AST.NoNode;
  741. astTail := AST.NoNode; .)
  742. { (. astDecl := AST.NoNode; .)
  743. ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
  744. | NestedModule ";" | ClassItem ";" )
  745. (. AstAppend(AST.NkDeclSeq,
  746. astSeq, astTail, astDecl); .) }
  747. (. astDecl := astSeq; .) .
  748. (* Local module, Wirth form. Declarations lower like top-level ones
  749. (same QBE module prefix); a BEGIN body becomes an init function
  750. that main calls; the EXPORT list is hoisted into the enclosing
  751. scope at END. *)
  752. NestedModule (. VAR m1, m2: SymTab.Name;
  753. expNames: ARRAY [0 .. 63] OF SymTab.Name;
  754. expCount, k: CARDINAL;
  755. astNode, nImp, nImpTail:
  756. AST.Node; .)
  757. = "MODULE"
  758. GetIdent<m1> (. IF NOT SymTab.Enter(m1,
  759. SymTab.KindModule) THEN
  760. SemError(200) END;
  761. SymTab.PushScope;
  762. expCount := 0;
  763. astNode := AST.MakeNode(AST.NkUnit);
  764. AST.SetChild(astNode, 0,
  765. AST.MakeLeaf(AST.NkIdent, m1));
  766. astStmt := AST.NoNode;
  767. astDecl := AST.NoNode;
  768. nImp := AST.NoNode;
  769. nImpTail := AST.NoNode; .)
  770. [ Priority ]
  771. ";"
  772. { Import (. AstAppend(AST.NkDeclSeq,
  773. nImp, nImpTail, astDecl); .) }
  774. [ "EXPORT" [ "QUALIFIED" ]
  775. GetIdent<expNames[expCount]> (. INC(expCount); .)
  776. { "," GetIdent<expNames[expCount]>
  777. (. INC(expCount); .) }
  778. ";" ]
  779. DeclSeq (. astStmt := AST.NoNode; .)
  780. [ "BEGIN" (. astStmt := AST.NoNode;
  781. .)
  782. [ StatSeq ] ]
  783. "END"
  784. GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
  785. AST.SetChild(astNode, 2, astStmt);
  786. AST.SetChild(astNode, 3, nImp);
  787. astDecl := astNode;
  788. IF NOT SymTab.Equal(m1, m2) THEN
  789. SemError(202) END;
  790. k := 0;
  791. WHILE k < expCount DO
  792. SymTab.ExportUp(expNames[k]);
  793. INC(k)
  794. END;
  795. SymTab.PopScope; .) .
  796. Priority
  797. = "[" integer "]" (. SemError(230); .) .
  798. (* Imports (4.3): FROM materializes the names (unqualified use);
  799. plain IMPORT only demands the module exists — qualified `L.x`
  800. materializes on first use (Design). *)
  801. (* Unknown modules stay unchecked stubs (legacy, so hand-written
  802. import lines don't fail); a known module's missing export is
  803. 201. *)
  804. Import (. VAR n: SymTab.Name;
  805. astImport: AST.Node; .)
  806. = "FROM"
  807. GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
  808. AST.SetChild(astImport, 0,
  809. AST.MakeLeaf(AST.NkIdent, n)); .)
  810. "IMPORT"
  811. ImpList<n, astImport> ";" (. astDecl := astImport; .)
  812. | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
  813. ImpModList<astImport> ";" (. astDecl := astImport; .) .
  814. ImpList<mod: SymTab.Name; node: AST.Node>
  815. (. VAR n: SymTab.Name; .)
  816. = ImpName<mod, node>
  817. { "," ImpName<mod, node> } .
  818. (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
  819. accepted and ignored: the built-in applies regardless. *)
  820. ImpName<mod: SymTab.Name; node: AST.Node>
  821. (. VAR n: SymTab.Name; .)
  822. = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
  823. AST.MakeLeaf(AST.NkIdent, n));
  824. IF SymTab.Equal(mod, "libc") THEN
  825. (* intrinsic C library:
  826. permissive external *)
  827. IF NOT SymTab.DeclareCProc(n) THEN
  828. SemError(201) END;
  829. Lower.NoteCProc(n)
  830. ELSIF SymTab.ModKnown(mod) THEN
  831. IF NOT SymTab.ImportFrom(mod, n) THEN
  832. SemError(201)
  833. ELSE Lower.NoteImportedProc(n)
  834. END
  835. END; .)
  836. | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
  837. | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
  838. | "UCHR" | "CHR8" | "UORD"
  839. | "INC" | "DEC" ) .
  840. ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
  841. = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
  842. AST.MakeLeaf(AST.NkIdent, n)); .)
  843. { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
  844. AST.MakeLeaf(AST.NkIdent, n)); .) } .
  845. (* Opaque TYPE declarations (definition modules). The targetless
  846. alias resolves to InvalidType until step 4 completes it. *)
  847. (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
  848. Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
  849. Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
  850. TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
  851. = "TYPE" (. SymTab.BeginTypeBlock;
  852. astSeq := AST.NoNode;
  853. astTail := AST.NoNode; .)
  854. { (. astDecl := AST.NoNode; .)
  855. ( TypeItem<isDef> ";" | ClassItem ";" )
  856. (. AstAppend(AST.NkDeclSeq,
  857. astSeq, astTail, astDecl); .) }
  858. (. SymTab.EndTypeBlock;
  859. astDecl := astSeq; .) .
  860. TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
  861. t, op: SymTab.TypeIndex;
  862. astNode: AST.Node; .)
  863. = GetIdent<n> (. op := SymTab.OpaqueBase(n);
  864. IF op = SymTab.InvalidType THEN
  865. IF NOT SymTab.Enter(n,
  866. SymTab.KindType) THEN
  867. SemError(200) END
  868. END; .)
  869. ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
  870. AST.SetChild(astNode, 0,
  871. AST.MakeLeaf(AST.NkIdent, n));
  872. AST.SetTy(astNode, t);
  873. astDecl := astNode;
  874. IF op # SymTab.InvalidType THEN
  875. SymTab.SetTarget(op, t)
  876. ELSE SymTab.SetSymType(n, t)
  877. END; .)
  878. | (. IF op # SymTab.InvalidType THEN
  879. (* stays opaque *)
  880. ELSIF NOT isDef THEN
  881. SemError(231)
  882. ELSE SymTab.SetSymType(n,
  883. SymTab.NewAlias()) END; .) ) .
  884. Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
  885. = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
  886. | Subrange<t>
  887. | Enum<t>
  888. | ArrayType<t, allowOpen>
  889. | SetType<t>
  890. | RecordType<t>
  891. | PointerType<t>
  892. | ProcType<t> .
  893. PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
  894. = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
  895. (* Procedure types (step 8.5): PROCEDURE (params): result. Values
  896. are code pointers; params are collected into the descriptor. *)
  897. ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
  898. isV: BOOLEAN; .)
  899. = "PROCEDURE" (. res := SymTab.InvalidType;
  900. t := SymTab.NewProcType(res); .)
  901. [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
  902. [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
  903. ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
  904. isV: BOOLEAN;
  905. cnt, k: CARDINAL;
  906. names: ARRAY [0 .. 15] OF SymTab.Name; .)
  907. = (. isV := FALSE; cnt := 0; .)
  908. [ "VAR" (. isV := TRUE; .) ]
  909. ( GetIdent<names[cnt]> (. INC(cnt); .)
  910. { "," GetIdent<names[cnt]> (. INC(cnt); .) }
  911. ( ":" Type<pt, TRUE> (. k := 0;
  912. WHILE k < cnt DO
  913. SymTab.ProcTypeAdd(t, isV, pt);
  914. INC(k)
  915. END; .)
  916. | (. (* type-only parameter list:
  917. each name is a type (GNU
  918. shorthand used by the
  919. Coco/R scanner frame) *)
  920. k := 0;
  921. WHILE k < cnt DO
  922. IF SymTab.Lookup(names[k])
  923. AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
  924. OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
  925. pt := SymTab.SymType(names[k])
  926. ELSE SemError(201);
  927. pt := SymTab.InvalidType
  928. END;
  929. SymTab.ProcTypeAdd(t, isV, pt);
  930. INC(k)
  931. END; .) )
  932. | Type<pt, TRUE> (. (* unnamed parameter (PIM):
  933. e.g. PROCEDURE (VAR ARRAY OF REAL) *)
  934. SymTab.ProcTypeAdd(t, isV, pt); .) ) .
  935. (* Arrays: "OF" without bounds is an open formal (allowed only
  936. where allowOpen); "[lo..hi, ...]" nests bounded levels inside
  937. out. Bounds are folded literals (int/char); anything else 230.
  938. Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
  939. ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
  940. (. VAR elem: SymTab.TypeIndex;
  941. ok: BOOLEAN;
  942. bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
  943. nb, k: CARDINAL;
  944. idx: SymTab.TypeIndex;
  945. ilo, ihi: INTEGER; .)
  946. = "ARRAY"
  947. ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
  948. SemError(230) END;
  949. t := SymTab.NewOpenArray(elem); .)
  950. | TypeIdent<idx> [ Subrange<idx> ]
  951. "OF" Type<elem, FALSE> (. (* index-type array: the index
  952. type's ordinal bounds give the
  953. [lo..hi] pair *)
  954. IF SymTab.TypeBounds(idx, ilo,
  955. ihi)
  956. THEN t := SymTab.NewArrayB(elem,
  957. ilo, ihi)
  958. ELSE SemError(230);
  959. t := SymTab.InvalidType
  960. END; .)
  961. | "[" (. SymTab.BoundBegin; ok := TRUE; .)
  962. BoundPair<ok>
  963. { "," BoundPair<ok> }
  964. "]" (. (* snapshot before the element
  965. type, which reuses the bound
  966. buffer for a nested ARRAY *)
  967. nb := SymTab.BoundCount();
  968. k := 0;
  969. WHILE k < nb DO
  970. bnds[k] := SymTab.BoundLo(k);
  971. bndh[k] := SymTab.BoundHi(k);
  972. INC(k)
  973. END; .)
  974. "OF" Type<elem, FALSE>
  975. (. IF ok THEN
  976. k := nb;
  977. WHILE k > 0 DO
  978. DEC(k);
  979. elem := SymTab.NewArrayB(
  980. elem, bnds[k], bndh[k])
  981. END;
  982. t := elem
  983. ELSE t := SymTab.InvalidType
  984. END; .) ) .
  985. BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
  986. qlo, qhi: QbeGen.QVal;
  987. lo, hi: INTEGER;
  988. cl, cl2: INTEGER; .)
  989. = Expr<tlo, qlo> ".." Expr<thi, qhi>
  990. (. IF (tlo = SymTab.InvalidType)
  991. OR (thi = SymTab.InvalidType) THEN
  992. ok := FALSE
  993. ELSE cl := SymTab.ClassOf(tlo);
  994. cl2 := SymTab.ClassOf(thi);
  995. IF ((cl # SymTab.ClInt)
  996. AND (cl # SymTab.ClChar))
  997. OR ((cl2 # SymTab.ClInt)
  998. AND (cl2 # SymTab.ClChar)) THEN
  999. SemError(230); ok := FALSE
  1000. ELSIF NOT SymTab.ConstInt(qlo, lo)
  1001. OR NOT SymTab.ConstInt(qhi, hi)
  1002. OR (lo > hi) THEN
  1003. SemError(230); ok := FALSE
  1004. ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
  1005. SemError(230); ok := FALSE
  1006. END;
  1007. END; .) .
  1008. (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
  1009. bounded subranges; enums wait for ordinals, INTEGER is
  1010. unbounded). Literals are SET OF [0..255]; assignment and
  1011. comparison across suitable bases are lenient (masks over min
  1012. words + zero-check extras), out-of-span literals are 222. *)
  1013. SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
  1014. blo, bhi, bspan: INTEGER;
  1015. bcls: INTEGER; .)
  1016. = "SET" "OF" Type<base, FALSE>
  1017. (. IF base = SymTab.InvalidType THEN
  1018. t := SymTab.InvalidType
  1019. ELSE bcls :=
  1020. SymTab.ClassOf(base);
  1021. IF bcls = SymTab.ClBool THEN
  1022. blo := 0; bspan := 2
  1023. ELSIF bcls = SymTab.ClChar THEN
  1024. blo := 0; bspan := 256
  1025. ELSIF bcls = SymTab.ClEnum THEN
  1026. blo := 0;
  1027. bspan := VAL(INTEGER,
  1028. SymTab.EnumCount(base))
  1029. ELSIF SymTab.SubBounds(base,
  1030. blo, bhi) THEN
  1031. bspan := bhi - blo + 1
  1032. ELSE bspan := 0 END;
  1033. IF (bspan <= 0)
  1034. OR (bspan > 65536) THEN
  1035. SemError(230);
  1036. t := SymTab.InvalidType
  1037. ELSE t := SymTab.NewSet(base)
  1038. END
  1039. END; .) .
  1040. (* Records: flat blobs; array fields are pointers to static
  1041. descriptors (locked amendment), nested records inline. Field
  1042. offsets static and declaration-ordered. *)
  1043. (* Field list: plain fields and (optionally) one variant part. The
  1044. variant part is a `CASE ... END` item; because it starts with the
  1045. CASE keyword it is unambiguously distinguishable from a field
  1046. (which starts with an identifier). *)
  1047. RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
  1048. tagOk: BOOLEAN; .)
  1049. = "RECORD" (. t := SymTab.NewRecord(); .)
  1050. [ RecItem<t> { ";" [ RecItem<t> ] } ]
  1051. "END" (. SymTab.LayoutRecord(t); .) .
  1052. RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
  1053. = RecField<rec>
  1054. | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
  1055. (* A variant part: CASE tag : Type OF variants. The layout overlays
  1056. every branch from the tag slot (see SymTab.ComputeOffsets). *)
  1057. CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
  1058. tagN: SymTab.Name; .)
  1059. = "CASE" (. SymTab.ResetFields(rec); .)
  1060. GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
  1061. tagN) THEN
  1062. SemError(200) END; .)
  1063. ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
  1064. AND NOT SymTab.IsOrdinal(tagT) THEN
  1065. SemError(224)
  1066. END;
  1067. SymTab.FixPendingF(rec, tagT);
  1068. SymTab.SetVariantTag(rec, tagN); .)
  1069. "OF"
  1070. RecFieldList<rec>
  1071. { "|" (. SymTab.ResetFields(rec); .)
  1072. RecFieldList<rec> }
  1073. "END" .
  1074. RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
  1075. lv1, lv2: QbeGen.QVal; .)
  1076. = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
  1077. RecField<rec> { ";" [ RecField<rec> ] } .
  1078. (* Variant case label: a constant (or a constant range). Values are
  1079. not interpreted (the layout overlays regardless). *)
  1080. VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  1081. (. VAR lname: SymTab.Name; .)
  1082. = ( ident (. LexName(lname);
  1083. QbeGen.CopyOp("0", q);
  1084. t := SymTab.IntType(); .)
  1085. | integer (. LexString(lname);
  1086. QbeGen.CopyOp("0", q);
  1087. t := SymTab.IntType(); .)
  1088. | charConst (. LexString(lname);
  1089. QbeGen.CopyOp("0", q);
  1090. t := SymTab.CharType(); .) ) .
  1091. RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
  1092. t2: SymTab.TypeIndex; .)
  1093. = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
  1094. RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
  1095. = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
  1096. n) THEN
  1097. SemError(200) END; .)
  1098. { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
  1099. n) THEN
  1100. SemError(200) END; .) } .
  1101. TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
  1102. k: INTEGER;
  1103. dotted: BOOLEAN; .)
  1104. = GetIdent<n> (. dotted := FALSE;
  1105. IF NOT SymTab.Lookup(n) THEN
  1106. k := -1;
  1107. t := SymTab.ForwardType(n);
  1108. IF t = SymTab.InvalidType THEN
  1109. SemError(201)
  1110. END
  1111. ELSE k := SymTab.SymKind(n);
  1112. IF (k = SymTab.KindType)
  1113. OR (k = SymTab.KindPredef) THEN
  1114. t := SymTab.SymType(n)
  1115. ELSE t := SymTab.InvalidType
  1116. END
  1117. END; .)
  1118. [ "." GetIdent<qid> (. dotted := TRUE;
  1119. IF k = SymTab.KindModule THEN
  1120. t := SymTab.QualType(n, qid);
  1121. IF t = SymTab.InvalidType THEN
  1122. SemError(201)
  1123. END
  1124. ELSE SemError(221);
  1125. t := SymTab.InvalidType
  1126. END; .) ]
  1127. (. IF NOT dotted THEN
  1128. IF (k = SymTab.KindModule)
  1129. OR ((k # SymTab.KindType)
  1130. AND (k # SymTab.KindPredef)
  1131. AND (k # SymTab.KindImport)
  1132. AND (k # -1)) THEN
  1133. SemError(221)
  1134. END
  1135. END; .) .
  1136. Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
  1137. qlo, qhi: QbeGen.QVal;
  1138. lo, hi: INTEGER; .)
  1139. = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
  1140. (. IF (tlo = SymTab.InvalidType)
  1141. OR (thi = SymTab.InvalidType) THEN
  1142. t := SymTab.InvalidType
  1143. ELSIF NOT SymTab.IsOrdinal(tlo)
  1144. OR NOT SymTab.IsOrdinal(thi) THEN
  1145. SemError(230);
  1146. t := SymTab.InvalidType
  1147. ELSIF NOT SymTab.ConstInt(qlo, lo)
  1148. OR NOT SymTab.ConstInt(qhi, hi)
  1149. OR (lo > hi) THEN
  1150. SemError(230);
  1151. t := SymTab.InvalidType
  1152. ELSE t := SymTab.NewSubR(lo, hi)
  1153. END; .)
  1154. "]" .
  1155. Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
  1156. ord: INTEGER;
  1157. qv: QbeGen.QVal; .)
  1158. = "(" (. t := SymTab.NewEnum();
  1159. ord := 0; .)
  1160. GetIdent<n> (. IF NOT SymTab.Enter(n,
  1161. SymTab.KindConst) THEN
  1162. SemError(200) END;
  1163. SymTab.SetSymType(n, t);
  1164. QbeGen.IntStr(ord, qv);
  1165. SymTab.SetSymVal(n, qv);
  1166. Lower.NoteVar(n,
  1167. SymTab.KindConst, t);
  1168. Lower.NoteConstVal(qv);
  1169. INC(ord); .)
  1170. { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
  1171. SymTab.KindConst) THEN
  1172. SemError(200) END;
  1173. SymTab.SetSymType(n, t);
  1174. QbeGen.IntStr(ord, qv);
  1175. SymTab.SetSymVal(n, qv);
  1176. Lower.NoteVar(n,
  1177. SymTab.KindConst, t);
  1178. Lower.NoteConstVal(qv);
  1179. INC(ord); .) }
  1180. ")" (. SymTab.SetEnumCount(t,
  1181. VAL(CARDINAL, ord)); .) .
  1182. (* Clarion-form classes (docs/OOP.txt): declaration + single
  1183. inheritance + IMPLEMENTATION blocks. Scopes and member checks
  1184. now; lowering (vtable, dispatch, THIS) later — one 230 per
  1185. class/impl block. Methods end with ";" per the Table example
  1186. (not "," as in the sketch). No underscores in identifiers. *)
  1187. (* Single CLASS item in both loops: separating declaration from
  1188. IMPLEMENTATION at the loop level needs 2-token lookahead
  1189. (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
  1190. The second token decides after CLASS is consumed. A misplaced
  1191. CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
  1192. whole unit ends 230 until lowering). *)
  1193. ClassItem
  1194. = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
  1195. ClassRest (. VAR cn, m2, pn: SymTab.Name;
  1196. ct: SymTab.TypeIndex; .)
  1197. = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
  1198. SymTab.KindType) THEN
  1199. SemError(200) END;
  1200. ct := SymTab.NewClass();
  1201. SymTab.SetSymType(cn, ct);
  1202. SymTab.PushClassScope(ct);
  1203. astCls := AST.MakeNode(AST.NkClassDecl);
  1204. AST.SetChild(astCls, 0,
  1205. AST.MakeLeaf(AST.NkIdent, cn));
  1206. astClsP := AST.NoNode;
  1207. astClsPTail := AST.NoNode;
  1208. astClsF := AST.NoNode;
  1209. astClsFTail := AST.NoNode;
  1210. astClsM := AST.NoNode;
  1211. astClsMTail := AST.NoNode; .)
  1212. [ Parents<ct> ]
  1213. ";"
  1214. { ClassField<ct> ";" }
  1215. { MethodHeading<pn, SymTab.InvalidType> ";"
  1216. (. Lower.ScopeLeave;
  1217. SymTab.CloseProc;
  1218. QbeGen.AbortFunc; .) }
  1219. "END"
  1220. GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
  1221. SemError(202) END;
  1222. SymTab.LayoutClass(ct);
  1223. SymTab.PopScope;
  1224. AST.SetChild(astCls, 1, astClsP);
  1225. AST.SetChild(astCls, 2, astClsF);
  1226. AST.SetChild(astCls, 3, astClsM);
  1227. astDecl := astCls; .) .
  1228. Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
  1229. = "(" Parent1<ct>
  1230. { "," GetIdent<p> (. SemError(230); .) }
  1231. ")" .
  1232. Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
  1233. pt: SymTab.TypeIndex; .)
  1234. = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
  1235. SemError(201)
  1236. ELSE pt := SymTab.SymType(p);
  1237. IF SymTab.ClassOf(pt) #
  1238. SymTab.ClClass THEN
  1239. SemError(230)
  1240. ELSE SymTab.SetParent(ct, pt)
  1241. END
  1242. END;
  1243. AstAppend(AST.NkFieldDecl,
  1244. astClsP, astClsPTail,
  1245. AST.MakeLeaf(AST.NkIdent, p)); .) .
  1246. ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
  1247. t: SymTab.TypeIndex;
  1248. astNode: AST.Node; .)
  1249. = GetIdent<n>
  1250. ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
  1251. SymTab.KindConst) THEN
  1252. SemError(200) END;
  1253. astNode := AST.MakeNode(AST.NkConstDecl);
  1254. AST.SetChild(astNode, 0,
  1255. AST.MakeLeaf(AST.NkIdent, n));
  1256. AST.SetChild(astNode, 1,
  1257. AST.MakeLeaf(AST.NkIdent, rhs));
  1258. AstAppend(AST.NkFieldDecl,
  1259. astClsF, astClsFTail, astNode);
  1260. IF SymTab.Lookup(rhs) THEN
  1261. SymTab.SetSymType(n,
  1262. SymTab.SymType(rhs))
  1263. END; .)
  1264. | (. IF NOT SymTab.FieldPending(ct,
  1265. n) THEN
  1266. SemError(200) END;
  1267. astNode := AST.MakeNode(AST.NkVarDecl);
  1268. AST.SetChild(astNode, 0,
  1269. AST.MakeLeaf(AST.NkIdent, n)); .)
  1270. { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
  1271. n) THEN
  1272. SemError(200) END;
  1273. AST.SetChild(astNode,
  1274. AST.NChild(astNode),
  1275. AST.MakeLeaf(AST.NkIdent, n)); .) }
  1276. ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
  1277. AST.SetTy(astNode, t);
  1278. AstAppend(AST.NkFieldDecl,
  1279. astClsF, astClsFTail, astNode); .) ) .
  1280. MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
  1281. (. VAR wantVirt: BOOLEAN; .)
  1282. = (. wantVirt := FALSE; .)
  1283. [ "VIRTUAL" (. wantVirt := TRUE; .) ]
  1284. ProcHeading<pn, ct> (. IF wantVirt THEN
  1285. SymTab.MarkVirtual END;
  1286. astMethod := AST.MakeNode(AST.NkProcDecl);
  1287. AST.SetChild(astMethod, 0,
  1288. AST.MakeLeaf(AST.NkIdent, pn));
  1289. IF wantVirt THEN
  1290. AST.SetOp(astMethod, 3)
  1291. ELSE AST.SetOp(astMethod, 0)
  1292. END;
  1293. AstAppend(AST.NkFieldDecl,
  1294. astClsM, astClsMTail, astMethod); .) .
  1295. ClassImplRest (. VAR cn, m2: SymTab.Name;
  1296. ct: SymTab.TypeIndex; .)
  1297. = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
  1298. SemError(201);
  1299. ct := SymTab.InvalidType
  1300. ELSE ct := SymTab.SymType(cn);
  1301. IF SymTab.ClassOf(ct) #
  1302. SymTab.ClClass THEN
  1303. SemError(230);
  1304. ct := SymTab.InvalidType
  1305. END
  1306. END;
  1307. astCls := AST.MakeNode(AST.NkClassDecl);
  1308. AST.SetOp(astCls, 1);
  1309. AST.SetChild(astCls, 0,
  1310. AST.MakeLeaf(AST.NkIdent, cn));
  1311. astClsM := AST.NoNode;
  1312. astClsMTail := AST.NoNode;
  1313. astStmt := AST.NoNode;
  1314. IF ct #
  1315. SymTab.InvalidType THEN
  1316. IF NOT SymTab.PushClassMembers(
  1317. ct) THEN
  1318. SemError(230) END;
  1319. SymTab.PushImplClass(ct)
  1320. END; .)
  1321. ";" { MethodImpl<ct> ";" }
  1322. (. astStmt := AST.NoNode; .)
  1323. [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
  1324. .)
  1325. [ StatSeq ] ]
  1326. "END"
  1327. GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
  1328. SemError(202) END;
  1329. SymTab.PopImplClass;
  1330. SymTab.PopScope;
  1331. AST.SetChild(astCls, 1, AST.NoNode);
  1332. AST.SetChild(astCls, 2, astStmt);
  1333. AST.SetChild(astCls, 3, astClsM);
  1334. astDecl := astCls; .) .
  1335. MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
  1336. thisQ: QbeGen.QVal;
  1337. methRes: SymTab.TypeIndex; .)
  1338. = MethodHeading<pn, ct> ";"
  1339. (. IF (ct #
  1340. SymTab.InvalidType)
  1341. AND NOT SymTab.MethodExists(ct,
  1342. pn) THEN
  1343. SemError(201) END; .)
  1344. ( "FORWARD" (. AST.SetOp(astMethod, 1);
  1345. SymTab.MarkFwd;
  1346. QbeGen.AbortFunc;
  1347. Lower.ScopeLeave;
  1348. SymTab.CloseProc; .)
  1349. | (.
  1350. (* bind the receiver: bare
  1351. field names resolve
  1352. against THIS *)
  1353. QbeGen.CopyOp("@", thisQ);
  1354. QbeGen.PushWith(thisQ); .)
  1355. Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
  1356. AST.SetChild(astMethod, 2, astBlkDecls);
  1357. QbeGen.PopWith;
  1358. methRes := SymTab.CurRes();
  1359. Lower.ScopeLeave;
  1360. SymTab.CloseProc;
  1361. QbeGen.EndFunc(methRes); .) ) .
  1362. ConstBlock (. VAR astSeq, astTail: AST.Node; .)
  1363. = "CONST" (. astSeq := AST.NoNode;
  1364. astTail := AST.NoNode; .)
  1365. { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
  1366. astSeq, astTail, astDecl); .) }
  1367. (. astDecl := astSeq; .) .
  1368. ConstDecl (. VAR n: SymTab.Name;
  1369. t: SymTab.TypeIndex;
  1370. qv: QbeGen.QVal;
  1371. cls: INTEGER;
  1372. astNode: AST.Node; .)
  1373. = GetIdent<n> (. IF NOT SymTab.Enter(n,
  1374. SymTab.KindConst) THEN
  1375. SemError(200) END; .)
  1376. "="
  1377. Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
  1378. AST.SetChild(astNode, 0,
  1379. AST.MakeLeaf(AST.NkIdent, n));
  1380. AST.SetChild(astNode, 1, astCur);
  1381. AST.SetTy(astNode, t);
  1382. astDecl := astNode;
  1383. Lower.NoteVar(n, SymTab.KindConst, t);
  1384. Lower.NoteConstVal(qv);
  1385. SymTab.SetSymType(n, t);
  1386. cls := SymTab.ClassOf(t);
  1387. IF (cls = SymTab.ClArray)
  1388. OR (cls = SymTab.ClRecord)
  1389. OR (cls = SymTab.ClClass)
  1390. OR (cls = SymTab.ClStr)
  1391. OR (cls = SymTab.ClUStr) THEN
  1392. (* an aggregate/string
  1393. constant: qv is its
  1394. descriptor address; no
  1395. scalar data *)
  1396. SymTab.SetSymVal(n, qv)
  1397. ELSIF NOT QbeGen.IsImm(qv) THEN
  1398. SemError(230)
  1399. ELSE
  1400. SymTab.SetSymVal(n, qv);
  1401. END; .) .
  1402. VarBlock (. VAR astSeq, astTail: AST.Node; .)
  1403. = "VAR" (. astSeq := AST.NoNode;
  1404. astTail := AST.NoNode; .)
  1405. { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
  1406. astSeq, astTail, astDecl); .) }
  1407. (. astDecl := astSeq; .) .
  1408. VarDecl (. VAR nm: SymTab.Name;
  1409. t: SymTab.TypeIndex;
  1410. i: CARDINAL;
  1411. cls: INTEGER;
  1412. astNode, astTail: AST.Node; .)
  1413. = VarIdents ":"
  1414. Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
  1415. astTail := astNode;
  1416. i := 0;
  1417. WHILE i < SymTab.PendCount() DO
  1418. SymTab.PendName(i, nm);
  1419. Lower.NoteVar(nm, SymTab.KindVar, t);
  1420. (* chunked: a VAR list can
  1421. exceed AST.MaxChild *)
  1422. AstAppend(AST.NkBlock,
  1423. astNode, astTail,
  1424. AST.MakeLeaf(AST.NkIdent, nm));
  1425. INC(i)
  1426. END;
  1427. AST.SetTy(astNode, t);
  1428. astDecl := astNode;
  1429. cls := SymTab.ClassOf(t);
  1430. IF (t # SymTab.InvalidType)
  1431. AND NOT SymTab.IsUnresolved(t)
  1432. AND (cls # SymTab.ClInt)
  1433. AND (cls # SymTab.ClBool)
  1434. AND (cls # SymTab.ClChar)
  1435. AND (cls # SymTab.ClReal)
  1436. AND (cls # SymTab.ClArray)
  1437. AND (cls # SymTab.ClSet)
  1438. AND (cls # SymTab.ClRecord)
  1439. AND (cls # SymTab.ClPtr)
  1440. AND (cls # SymTab.ClLong)
  1441. AND (cls # SymTab.ClProc)
  1442. AND (cls # SymTab.ClUChar)
  1443. AND (cls # SymTab.ClUStr)
  1444. AND (cls # SymTab.ClEnum)
  1445. AND (cls # SymTab.ClClass) THEN
  1446. SemError(230) END;
  1447. IF QbeGen.LocFull() THEN
  1448. SemError(233) END;
  1449. i := 0;
  1450. IF SymTab.IsUnresolved(t)
  1451. AND NOT SymTab.InProc() THEN
  1452. (* a forward-typed global:
  1453. defer emission until the
  1454. TYPE block completes *)
  1455. AST.SetOp(astNode, 1);
  1456. WHILE i < SymTab.PendCount() DO
  1457. SymTab.PendName(i, nm);
  1458. IF nPendVar <=
  1459. HIGH(pendVarName) THEN
  1460. pendVarName[nPendVar] := nm;
  1461. pendVarT[nPendVar] := t;
  1462. INC(nPendVar)
  1463. END;
  1464. INC(i)
  1465. END
  1466. ELSE
  1467. WHILE i < SymTab.PendCount() DO
  1468. SymTab.PendName(i, nm);
  1469. INC(i)
  1470. END
  1471. END;
  1472. (* a plain VAR list, not a
  1473. heading: the signature
  1474. result is discarded *)
  1475. IF NOT SymTab.FixPending(t) THEN
  1476. END; .) .
  1477. VarIdents (. VAR n: SymTab.Name; .)
  1478. = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
  1479. SymTab.KindVar) THEN
  1480. SemError(200) END; .)
  1481. { ","
  1482. GetIdent<n> (. IF NOT SymTab.EnterPending(n,
  1483. SymTab.KindVar) THEN
  1484. SemError(200) END; .) } .
  1485. ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
  1486. = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
  1487. SemError(200) END; .)
  1488. { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
  1489. SemError(200) END; .) } .
  1490. (* Procedure headings enter scopes/params/result and buffer the
  1491. QBE header; bodies lower to functions (4.1, module level only).
  1492. FORWARD marks; the body heading re-enters (signature compare
  1493. deferred). Nested procedures parse + check, lowering = 4.2. *)
  1494. ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
  1495. (. VAR t: SymTab.TypeIndex;
  1496. mg: QbeGen.QVal; .)
  1497. = "PROCEDURE"
  1498. GetIdent<pn> (. IF methCls #
  1499. SymTab.InvalidType THEN
  1500. (* a method: resume the
  1501. declared symbol (reuse
  1502. its uid) *)
  1503. IF NOT SymTab.ResumeMethod(
  1504. methCls, pn) THEN
  1505. SemError(200) END
  1506. ELSIF NOT SymTab.EnterProc(pn) THEN
  1507. IF NOT SymTab.ReenterProc(pn) THEN
  1508. IF NOT SymTab.ResumeProc(pn) THEN
  1509. SemError(200) END
  1510. END
  1511. END;
  1512. Lower.ScopeEnter;
  1513. Lower.NoteProc(pn,
  1514. SymTab.ProcUid(pn),
  1515. SymTab.InvalidType,
  1516. SymTab.ProcDepthOf(pn),
  1517. FALSE);
  1518. QbeGen.BeginFunc("");
  1519. IF methCls #
  1520. SymTab.InvalidType THEN
  1521. (* hidden THIS receiver:
  1522. a VAR param of the
  1523. class type, pushed as
  1524. the WITH base *)
  1525. IF NOT SymTab.EnterThisParam(
  1526. methCls) THEN
  1527. SemError(200) END;
  1528. IF NOT QbeGen.FuncParam(
  1529. "THIS", TRUE,
  1530. methCls) THEN
  1531. SemError(233) END
  1532. END; .)
  1533. [ FormalParams ]
  1534. [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
  1535. SemError(235) END;
  1536. Lower.SetProcRes(t); .) ] .
  1537. FormalParams
  1538. = "(" [ ParamSection { ";" ParamSection } ] ")" .
  1539. ParamSection (. VAR t: SymTab.TypeIndex;
  1540. nm: SymTab.Name;
  1541. i: CARDINAL;
  1542. isV: BOOLEAN; .)
  1543. = (. isV := FALSE; .)
  1544. [ "VAR" (. isV := TRUE; .) ]
  1545. ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
  1546. WHILE i < SymTab.PendCount() DO
  1547. SymTab.PendName(i, nm);
  1548. Lower.NoteParam(nm, t, isV);
  1549. Lower.NoteVar(nm, SymTab.KindParam, t);
  1550. (* value open arrays are
  1551. passed as descriptor
  1552. addresses (no copy):
  1553. same representation as
  1554. VAR formals *)
  1555. IF NOT QbeGen.FuncParam(nm,
  1556. isV
  1557. OR SymTab.IsOpenArray(t),
  1558. t) THEN
  1559. SemError(233) END;
  1560. INC(i)
  1561. END;
  1562. IF NOT SymTab.FixPending(t) THEN
  1563. SemError(235) END; .) .
  1564. (* Nested procedures lower like top-level ones (4.2): the
  1565. static link gives them their parent's frame. Methods keep
  1566. parse-now/230-later. *)
  1567. ProcDecl (. VAR pn: SymTab.Name;
  1568. astNode: AST.Node; .)
  1569. = ProcHeading<pn, SymTab.InvalidType> ";"
  1570. (. astNode := AST.MakeNode(AST.NkProcDecl);
  1571. AST.SetOp(astNode, 0);
  1572. AST.SetChild(astNode, 0,
  1573. AST.MakeLeaf(AST.NkIdent, pn));
  1574. Lower.NoteProcNode(astNode); .)
  1575. ( "FORWARD" (. AST.SetOp(astNode, 1);
  1576. astDecl := astNode;
  1577. Lower.ScopeLeave;
  1578. SymTab.MarkFwd;
  1579. SymTab.CloseProc;
  1580. QbeGen.AbortFunc; .)
  1581. | "EXTERNAL" (. AST.SetOp(astNode, 2);
  1582. astDecl := astNode;
  1583. Lower.MarkProcExternal;
  1584. Lower.ScopeLeave;
  1585. SymTab.MarkExternal("");
  1586. SymTab.CloseProc;
  1587. QbeGen.AbortFunc; .)
  1588. |
  1589. (. allowDefer := TRUE; deferredBody := FALSE;
  1590. curProcNode := astNode; .)
  1591. Block<pn> (. IF deferredBody THEN
  1592. (* body skipped: close like
  1593. FORWARD (no body node) *)
  1594. astDecl := astNode;
  1595. Lower.ScopeLeave;
  1596. SymTab.CloseProc;
  1597. QbeGen.AbortFunc
  1598. ELSE
  1599. AST.SetChild(astNode, 1, astStmt);
  1600. AST.SetChild(astNode, 2, astBlkDecls);
  1601. astDecl := astNode;
  1602. Lower.ScopeLeave;
  1603. SymTab.CloseProc;
  1604. QbeGen.EndFunc(
  1605. SymTab.ProcRes(pn))
  1606. END; .) ) .
  1607. Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
  1608. = (. dfr := FALSE;
  1609. IF allowDefer AND twoPhaseParse
  1610. AND NOT repassing THEN
  1611. dfr := DeferSkip(pn)
  1612. END;
  1613. allowDefer := FALSE;
  1614. .)
  1615. DeclSeq (. astBlkDecls := astDecl;
  1616. astStmt := AST.NoNode;
  1617. nLab := 0; nGot := 0; .)
  1618. [ "BEGIN" (. (* an empty body is still a
  1619. body: mark it so Lower
  1620. does not read it as a
  1621. definition heading *)
  1622. IF NOT dfr THEN
  1623. IF astStmt = AST.NoNode THEN
  1624. astStmt :=
  1625. AST.MakeNode(AST.NkBlock)
  1626. END
  1627. END; .)
  1628. [ StatSeq ] ]
  1629. "END"
  1630. GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
  1631. SemError(202) END;
  1632. CheckGotos; .) .
  1633. (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
  1634. level body once the unit's declarations are complete. Inlined at
  1635. both call sites because a stand-alone epsilon production is
  1636. "unreachable" to Coco/R (referenced only from actions). *)
  1637. StatSeq (. VAR astSeq, astTail: AST.Node; .)
  1638. = (. astSeq := AST.NoNode;
  1639. astTail := AST.NoNode; .)
  1640. Statement (. AstAppend(AST.NkBlock,
  1641. astSeq, astTail, astStmt); .)
  1642. { ";" [ Statement (. AstAppend(AST.NkBlock,
  1643. astSeq, astTail, astStmt); .) ] }
  1644. (. astStmt := astSeq; .) .
  1645. (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
  1646. are accepted: the statement after ';' is optional. *)
  1647. Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
  1648. = (. astStmt := AST.NoNode; .)
  1649. ( AssOrCall
  1650. | IfStat
  1651. | WhileStat
  1652. | RepeatStat
  1653. | LoopStat
  1654. | ForStat
  1655. | CaseStat
  1656. | WithStat
  1657. | ReturnStat
  1658. | HaltStat
  1659. | NewStat
  1660. | DisposeStat
  1661. | IncDecStat
  1662. | InclExclStat
  1663. | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
  1664. SemError(230) END;
  1665. astStmt := AST.MakeNode(AST.NkExit); .)
  1666. | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
  1667. astStmt := AST.MakeNode(AST.NkGoto);
  1668. AST.SetChild(astStmt, 0,
  1669. AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
  1670. (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
  1671. InclExclStat (. VAR at, et2: SymTab.TypeIndex;
  1672. dk: INTEGER;
  1673. qd, qe: QbeGen.QVal;
  1674. qn: SymTab.Name;
  1675. sfx, isInc: BOOLEAN;
  1676. astNode, astD: AST.Node; .)
  1677. = ( "INCL" (. isInc := TRUE; .)
  1678. | "EXCL" (. isInc := FALSE; .) )
  1679. "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
  1680. Expr<et2, qe> ")"
  1681. (. astNode := AST.MakeNode(AST.NkCall);
  1682. IF isInc THEN
  1683. AST.SetChild(astNode, 0,
  1684. AST.MakeLeaf(AST.NkIdent, "INCL"))
  1685. ELSE AST.SetChild(astNode, 0,
  1686. AST.MakeLeaf(AST.NkIdent, "EXCL"))
  1687. END;
  1688. IF astD # AST.NoNode THEN
  1689. AST.SetChild(astNode, 1, astD) END;
  1690. IF astCur # AST.NoNode THEN
  1691. AST.SetChild(astNode, 2, astCur) END;
  1692. astStmt := astNode; .)
  1693. (. IF (at # SymTab.InvalidType)
  1694. AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
  1695. SemError(222)
  1696. END; .) .
  1697. (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
  1698. integer designator. *)
  1699. IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
  1700. dk: INTEGER;
  1701. qd, qv, qn2, qstep:
  1702. QbeGen.QVal;
  1703. qn: SymTab.Name;
  1704. sfx, isInc: BOOLEAN;
  1705. astNode, astD, astStep:
  1706. AST.Node; .)
  1707. = (. isInc := TRUE; .)
  1708. ( "INC" (. isInc := TRUE; .)
  1709. | "DEC" (. isInc := FALSE; .) )
  1710. "(" (. astStep := AST.NoNode; .)
  1711. Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
  1712. [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
  1713. ")" (. astNode := AST.MakeNode(AST.NkCall);
  1714. IF isInc THEN
  1715. AST.SetChild(astNode, 0,
  1716. AST.MakeLeaf(AST.NkIdent, "INC"))
  1717. ELSE AST.SetChild(astNode, 0,
  1718. AST.MakeLeaf(AST.NkIdent, "DEC"))
  1719. END;
  1720. IF astD # AST.NoNode THEN
  1721. AST.SetChild(astNode, 1, astD) END;
  1722. IF astStep # AST.NoNode THEN
  1723. AST.SetChild(astNode, 2, astStep) END;
  1724. astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
  1725. ELSIF (dk # SymTab.KindVar)
  1726. AND (dk # SymTab.KindParam)
  1727. AND (dk # SymTab.KindField) THEN
  1728. SemError(210)
  1729. ELSIF NOT SymTab.IsIntFamily(dt) THEN
  1730. SemError(211)
  1731. END; .) .
  1732. (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
  1733. Targets are pointer designators; DISPOSE nils afterwards (safer
  1734. than Wirth-undefined; documented). DISPOSE is shallow. *)
  1735. NewStat (. VAR dt: SymTab.TypeIndex;
  1736. dk: INTEGER;
  1737. qd, qm: QbeGen.QVal;
  1738. qn: SymTab.Name;
  1739. sfx: BOOLEAN;
  1740. bt: SymTab.TypeIndex;
  1741. astNode, astD: AST.Node; .)
  1742. = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
  1743. (. astNode := AST.MakeNode(AST.NkCall);
  1744. AST.SetChild(astNode, 0,
  1745. AST.MakeLeaf(AST.NkIdent, "NEW"));
  1746. IF astD # AST.NoNode THEN
  1747. AST.SetChild(astNode, 1, astD) END;
  1748. astStmt := astNode; .)
  1749. (. IF dt = SymTab.InvalidType THEN
  1750. ELSIF (dk # SymTab.KindVar)
  1751. AND (dk # SymTab.KindParam)
  1752. AND (dk # SymTab.KindField) THEN
  1753. SemError(210)
  1754. ELSIF SymTab.ClassOf(dt) #
  1755. SymTab.ClPtr THEN
  1756. SemError(219)
  1757. END; .) .
  1758. DisposeStat (. VAR dt: SymTab.TypeIndex;
  1759. dk: INTEGER;
  1760. qd, qv: QbeGen.QVal;
  1761. qn: SymTab.Name;
  1762. sfx: BOOLEAN;
  1763. astNode, astD: AST.Node; .)
  1764. = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
  1765. (. astNode := AST.MakeNode(AST.NkCall);
  1766. AST.SetChild(astNode, 0,
  1767. AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
  1768. IF astD # AST.NoNode THEN
  1769. AST.SetChild(astNode, 1, astD) END;
  1770. astStmt := astNode; .)
  1771. (. IF dt = SymTab.InvalidType THEN
  1772. ELSIF (dk # SymTab.KindVar)
  1773. AND (dk # SymTab.KindParam)
  1774. AND (dk # SymTab.KindField) THEN
  1775. SemError(210)
  1776. ELSIF SymTab.ClassOf(dt) #
  1777. SymTab.ClPtr THEN
  1778. SemError(219)
  1779. END; .) .
  1780. (* WITH pushes each record's fields (inner wins) plus its base
  1781. address; field designators resolve through both stacks. *)
  1782. WithStat (. VAR nW: CARDINAL;
  1783. astNode: AST.Node; .)
  1784. = "WITH" (. nW := 0;
  1785. astNode := AST.MakeNode(AST.NkWith); .)
  1786. WithItem<nW, astNode> { "," WithItem<nW, astNode> }
  1787. "DO" (. astStmt := AST.NoNode; .)
  1788. [ StatSeq ] "END" (. AST.SetChild(astNode,
  1789. AST.NChild(astNode), astStmt);
  1790. astStmt := astNode;
  1791. WHILE nW > 0 DO
  1792. SymTab.PopScope;
  1793. QbeGen.PopWith;
  1794. DEC(nW)
  1795. END; .) .
  1796. WithItem<VAR nW: CARDINAL; wnode: AST.Node>
  1797. (. VAR dt: SymTab.TypeIndex;
  1798. dk: INTEGER;
  1799. qd, qe: QbeGen.QVal;
  1800. qn: SymTab.Name;
  1801. sfx: BOOLEAN; .)
  1802. = Design<dt, dk, qd, qn, sfx>
  1803. (. IF astCur # AST.NoNode THEN
  1804. AST.SetChild(wnode,
  1805. AST.NChild(wnode), astCur) END;
  1806. IF dt = SymTab.InvalidType THEN
  1807. ELSIF (SymTab.ClassOf(dt) #
  1808. SymTab.ClRecord)
  1809. AND (SymTab.ClassOf(dt) #
  1810. SymTab.ClClass) THEN
  1811. SemError(215)
  1812. ELSIF SymTab.PushRecord(dt) THEN
  1813. QbeGen.PushWith(qd);
  1814. INC(nW)
  1815. END; .) .
  1816. (* Assignment or procedure-statement call (4.1, module level).
  1817. Bare `P;` is a syntax error; function-as-statement is 233. *)
  1818. AssOrCall (. VAR dt, et: SymTab.TypeIndex;
  1819. dk: INTEGER;
  1820. qd, qe, qt, ql: QbeGen.QVal;
  1821. qn: SymTab.Name;
  1822. ct2, res0: SymTab.TypeIndex;
  1823. q2, mg0: QbeGen.QVal;
  1824. isR, conv, wconv: BOOLEAN;
  1825. called, sfx: BOOLEAN;
  1826. astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
  1827. n: SymTab.Name; astLab, astNode: AST.Node; .)
  1828. = GetIdent<n>
  1829. ( ":" (. NoteLabel(n);
  1830. astNode := AST.MakeNode(AST.NkLabel);
  1831. AST.SetChild(astNode, 0,
  1832. AST.MakeLeaf(AST.NkIdent, n));
  1833. astLab := AST.MakeNode(AST.NkBlock);
  1834. AST.SetChild(astLab, 0, astNode); .)
  1835. Statement (. IF astStmt # AST.NoNode THEN
  1836. AST.SetChild(astLab, 1, astStmt) END;
  1837. astStmt := astLab; .)
  1838. | DesignTail<n, dt, dk, qd, qn, sfx>
  1839. (. astLhs := astCur; astNArgs := 0; .)
  1840. ( ":="
  1841. Expr<et, qe> (. astStmt := AST.MakeBin(
  1842. AST.NkAssign, 0, astLhs, astCur);
  1843. IF (dt # SymTab.InvalidType)
  1844. AND (dk # SymTab.KindVar)
  1845. AND (dk # SymTab.KindParam)
  1846. AND (dk # SymTab.KindField) THEN
  1847. SemError(210)
  1848. ELSIF NOT SymTab.Assignable(et,
  1849. dt) THEN
  1850. SemError(210)
  1851. ELSIF (dt # SymTab.InvalidType)
  1852. AND (SymTab.ClassOf(dt) =
  1853. SymTab.ClClass) THEN
  1854. SemError(230) END;
  1855. isR := (dt #
  1856. SymTab.InvalidType)
  1857. AND (SymTab.ClassOf(dt)
  1858. = SymTab.ClReal);
  1859. conv := isR
  1860. AND SymTab.IsIntFamily(et);
  1861. wconv := (dt #
  1862. SymTab.InvalidType)
  1863. AND SymTab.IsLongFamily(dt)
  1864. AND SymTab.IsIntFamily(et);
  1865. IF ((dk = SymTab.KindVar)
  1866. OR (dk = SymTab.KindParam)
  1867. OR (dk = SymTab.KindField))
  1868. AND (dt # SymTab.InvalidType)
  1869. AND (et # SymTab.InvalidType)
  1870. AND (SymTab.ClassOf(dt) #
  1871. SymTab.ClClass) THEN
  1872. END; .)
  1873. | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
  1874. (. astRes := AstCallNode(astLhs);
  1875. sfx := FALSE; .)
  1876. ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
  1877. ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
  1878. AST.NkAssign, 0, astRes, astCur);
  1879. IF NOT sfx THEN
  1880. SemError(233)
  1881. ELSIF (ct2 # SymTab.InvalidType)
  1882. AND NOT SymTab.Assignable(et, ct2) THEN
  1883. SemError(210)
  1884. END; .)
  1885. | (. IF ct2 #
  1886. SymTab.InvalidType THEN
  1887. SemError(233) END;
  1888. astStmt := astRes; .) )
  1889. | (* bare `P;`: proper parameterless
  1890. procedure call; anything else
  1891. here is 233 (was a bare syntax
  1892. error before 4.2) *)
  1893. (. astStmt := AstCallNode(astLhs);
  1894. IF (dk = SymTab.KindProc)
  1895. AND NOT sfx THEN
  1896. res0 := SymTab.ProcRes(qn);
  1897. IF res0 #
  1898. SymTab.InvalidType THEN
  1899. SemError(233)
  1900. ELSIF SymTab.ProcNPar(qn) #
  1901. 0 THEN
  1902. SemError(233)
  1903. END
  1904. ELSE SemError(233)
  1905. END; .) ) ) .
  1906. (* Actual-parameter list shared by statement and expression calls.
  1907. want selects CallEnd's result handling; t/q carry the call
  1908. value (statement calls discard). Arity/type failures are 233;
  1909. evaluation code still emits so the .ssa stays assembleable. *)
  1910. ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
  1911. want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
  1912. VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
  1913. VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
  1914. vs: INTEGER;
  1915. res: SymTab.TypeIndex;
  1916. mg: QbeGen.QVal;
  1917. ok, ind, isMeth, va: BOOLEAN; .)
  1918. = "(" (. called := TRUE;
  1919. ok := TRUE;
  1920. ind := FALSE;
  1921. isMeth := methCls #
  1922. SymTab.InvalidType;
  1923. IF isMeth THEN
  1924. res := SymTab.ClassMethodRes(methCls, pn)
  1925. ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
  1926. res := SymTab.ProcRes(pn)
  1927. ELSIF (pt # SymTab.InvalidType)
  1928. AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
  1929. ind := TRUE;
  1930. res := SymTab.ProcTypeRes(pt)
  1931. ELSE SemError(233);
  1932. ok := FALSE;
  1933. res := SymTab.InvalidType
  1934. END;
  1935. i := 0; .)
  1936. [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
  1937. { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
  1938. ")" (. IF ok THEN
  1939. IF isMeth THEN
  1940. np := SymTab.ClassMethodNPar(
  1941. methCls, pn)
  1942. ELSIF ind THEN
  1943. np := SymTab.ProcTypeNPar(pt)
  1944. ELSE np := SymTab.ProcNPar(pn)
  1945. END;
  1946. va := (NOT isMeth) AND (NOT ind)
  1947. AND (SymTab.SymKind(pn) =
  1948. SymTab.KindProc)
  1949. AND SymTab.Varargs(pn);
  1950. IF (i # np) AND NOT va THEN
  1951. SemError(233); ok := FALSE
  1952. END
  1953. END;
  1954. IF NOT ok THEN
  1955. t := SymTab.InvalidType;
  1956. QbeGen.CopyOp("0", q)
  1957. ELSIF want THEN
  1958. IF res =
  1959. SymTab.InvalidType THEN
  1960. IF NOT soft THEN SemError(233) END;
  1961. t := SymTab.InvalidType;
  1962. QbeGen.CopyOp("0", q)
  1963. ELSE t := res;
  1964. QbeGen.CopyOp("@", q)
  1965. END
  1966. ELSE
  1967. IF res #
  1968. SymTab.InvalidType THEN
  1969. SemError(233)
  1970. END;
  1971. t := SymTab.InvalidType;
  1972. QbeGen.CopyOp("0", q);
  1973. END; .) .
  1974. (* One actual: VAR formals take recorded designator addresses
  1975. (233 otherwise); value formals take converted expressions. *)
  1976. ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
  1977. methCls: SymTab.TypeIndex; i: CARDINAL>
  1978. (. VAR at, ft: SymTab.TypeIndex;
  1979. qe, qa, qt: QbeGen.QVal;
  1980. isV, conv, va: BOOLEAN;
  1981. cl: CHAR;
  1982. savedN, aj: CARDINAL;
  1983. savedArgs: ARRAY [0 .. 31]
  1984. OF AST.Node;
  1985. astActual: AST.Node; .)
  1986. = (. (* Parsing the actual can clobber
  1987. the enclosing call's argument
  1988. list (Factor resets astNArgs),
  1989. so save/restore it. *)
  1990. savedN := astNArgs; aj := 0;
  1991. WHILE aj <= HIGH(astArgs) DO
  1992. savedArgs[aj] := astArgs[aj];
  1993. INC(aj)
  1994. END; .)
  1995. Expr<at, qe> (. astActual := astCur;
  1996. astNArgs := savedN; aj := 0;
  1997. WHILE aj <= HIGH(astArgs) DO
  1998. astArgs[aj] := savedArgs[aj];
  1999. INC(aj)
  2000. END;
  2001. IF astNArgs <= HIGH(astArgs) THEN
  2002. astArgs[astNArgs] := astCur;
  2003. INC(astNArgs)
  2004. END;
  2005. va := (NOT ind)
  2006. AND (methCls =
  2007. SymTab.InvalidType)
  2008. AND (SymTab.SymKind(pn) =
  2009. SymTab.KindProc)
  2010. AND SymTab.Varargs(pn);
  2011. IF ind THEN
  2012. ft :=
  2013. SymTab.ProcTypeParamType(pt,
  2014. i);
  2015. isV :=
  2016. SymTab.ProcTypeParamIsVar(pt,
  2017. i)
  2018. ELSIF methCls #
  2019. SymTab.InvalidType THEN
  2020. ft :=
  2021. SymTab.ClassMethodParamType(
  2022. methCls, pn, i);
  2023. isV :=
  2024. SymTab.ClassMethodParamIsVar(
  2025. methCls, pn, i)
  2026. ELSE
  2027. ft := SymTab.ParamType(pn, i);
  2028. isV := SymTab.ParamIsVar(pn, i)
  2029. END;
  2030. IF (at = SymTab.InvalidType) THEN
  2031. ELSIF ft = SymTab.InvalidType THEN
  2032. ELSIF isV THEN
  2033. IF (SymTab.ClassOf(at) = SymTab.ClChar)
  2034. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  2035. AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
  2036. AND QbeGen.IsImm(qe) THEN
  2037. ELSIF (AST.Kind(astActual) #
  2038. AST.NkDesignator)
  2039. AND (AST.Kind(astActual) # AST.NkStrLit) THEN
  2040. SemError(233)
  2041. ELSIF NOT SymTab.VarParamOk(at, ft) THEN
  2042. SemError(233)
  2043. END
  2044. ELSE
  2045. IF (SymTab.ClassOf(at) = SymTab.ClChar)
  2046. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  2047. AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
  2048. AND QbeGen.IsImm(qe) THEN
  2049. ELSIF NOT SymTab.Assignable(at, ft) THEN
  2050. SemError(233)
  2051. END
  2052. END; .) .
  2053. IfStat (. VAR t: SymTab.TypeIndex;
  2054. q: QbeGen.QVal;
  2055. hasElse: BOOLEAN;
  2056. astCond, astIf, astLast,
  2057. astNode: AST.Node; .)
  2058. = "IF" (. hasElse := FALSE; .)
  2059. Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
  2060. IF NOT SymTab.BoolCheck(t) THEN
  2061. SemError(214) END; .)
  2062. "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
  2063. AST.SetChild(astNode, 0, astCond);
  2064. AST.SetChild(astNode, 1, astStmt);
  2065. astIf := astNode;
  2066. astLast := astNode; .)
  2067. { "ELSIF"
  2068. Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
  2069. IF NOT SymTab.BoolCheck(t) THEN
  2070. SemError(214) END; .)
  2071. "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
  2072. AST.SetChild(astNode, 0, astCond);
  2073. AST.SetChild(astNode, 1, astStmt);
  2074. AST.SetChild(astLast, 2, astNode);
  2075. astLast := astNode; .) }
  2076. [ "ELSE" (. hasElse := TRUE;
  2077. astStmt := AST.NoNode; .)
  2078. [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
  2079. "END" (. astStmt := astIf; .) .
  2080. WhileStat (. VAR t: SymTab.TypeIndex;
  2081. q: QbeGen.QVal;
  2082. astCond, astNode: AST.Node; .)
  2083. = "WHILE" (. astStmt := AST.NoNode; .)
  2084. Expr<t, q> (. astCond := astCur;
  2085. IF NOT SymTab.BoolCheck(t) THEN
  2086. SemError(214) END; .)
  2087. "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
  2088. AST.SetChild(astNode, 0, astCond);
  2089. AST.SetChild(astNode, 1, astStmt);
  2090. astStmt := astNode; .)
  2091. "END" .
  2092. RepeatStat (. VAR t: SymTab.TypeIndex;
  2093. q: QbeGen.QVal;
  2094. astCond, astBody, astNode:
  2095. AST.Node; .)
  2096. = "REPEAT" (. astStmt := AST.NoNode; .)
  2097. [ StatSeq ] (. astBody := astStmt; .)
  2098. "UNTIL" Expr<t, q> (. astCond := astCur;
  2099. astNode := AST.MakeNode(AST.NkRepeat);
  2100. AST.SetChild(astNode, 0, astBody);
  2101. AST.SetChild(astNode, 1, astCond);
  2102. astStmt := astNode;
  2103. IF NOT SymTab.BoolCheck(t) THEN
  2104. SemError(214) END; .) .
  2105. LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
  2106. = "LOOP" (. astStmt := AST.NoNode;
  2107. QbeGen.NewLabel(lEnd);
  2108. QbeGen.PushLoop(lEnd); .)
  2109. [ StatSeq ]
  2110. "END" (. astNode := AST.MakeNode(AST.NkLoop);
  2111. AST.SetChild(astNode, 0, astStmt);
  2112. astStmt := astNode;
  2113. QbeGen.PopLoop; .) .
  2114. (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
  2115. Runtime direction would need a compare-select; the literal
  2116. sign picks cslew/csegew at "DO" time. *)
  2117. ForStat (. VAR lv: SymTab.Name;
  2118. tlo, thi, tby:
  2119. SymTab.TypeIndex;
  2120. qlo, qhi, qby, qt, qk, qb:
  2121. QbeGen.QVal;
  2122. lTop, lBody, lEnd:
  2123. QbeGen.QVal;
  2124. by: INTEGER;
  2125. ok: BOOLEAN;
  2126. astVar, astLo, astHi, astBy,
  2127. astNode: AST.Node; .)
  2128. = "FOR" (. by := 1; .)
  2129. GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
  2130. astStmt := AST.NoNode;
  2131. astBy := AST.NoNode;
  2132. ok := SymTab.Lookup(lv);
  2133. IF NOT ok THEN
  2134. SemError(201)
  2135. ELSIF (SymTab.SymKind(lv) #
  2136. SymTab.KindVar)
  2137. AND (SymTab.SymKind(lv) #
  2138. SymTab.KindParam) THEN
  2139. SemError(220); ok := FALSE
  2140. ELSIF NOT SymTab.IsIntFamily(
  2141. SymTab.SymType(lv)) THEN
  2142. SemError(220); ok := FALSE
  2143. END; .)
  2144. ":=" Expr<tlo, qlo> (. astLo := astCur;
  2145. IF NOT SymTab.IsIntFamily(tlo) THEN
  2146. SemError(220); ok := FALSE
  2147. END; .)
  2148. "TO" Expr<thi, qhi> (. astHi := astCur;
  2149. IF NOT SymTab.IsIntFamily(thi) THEN
  2150. SemError(220); ok := FALSE
  2151. END; .)
  2152. [ "BY" Expr<tby, qby> (. astBy := astCur;
  2153. IF (tby #
  2154. SymTab.InvalidType)
  2155. AND NOT SymTab.IsIntFamily(tby) THEN
  2156. SemError(220); ok := FALSE
  2157. END;
  2158. IF NOT SymTab.ConstInt(qby, by) THEN
  2159. SemError(230); by := 1
  2160. ELSIF by = 0 THEN
  2161. SemError(220); by := 1
  2162. END; .) ]
  2163. "DO"
  2164. [ StatSeq ]
  2165. "END" (. astNode := AST.MakeNode(AST.NkFor);
  2166. AST.SetChild(astNode, 0, astVar);
  2167. AST.SetChild(astNode, 1, astLo);
  2168. AST.SetChild(astNode, 2, astHi);
  2169. AST.SetChild(astNode, 3, astBy);
  2170. AST.SetChild(astNode, 4, astStmt);
  2171. astStmt := astNode;
  2172. .) .
  2173. CaseStat (. VAR tsel: SymTab.TypeIndex;
  2174. qsel, lEnd: QbeGen.QVal;
  2175. arm, astNode, astArms,
  2176. astArmsTail: AST.Node; .)
  2177. = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
  2178. AST.SetChild(astNode, 0, astCur);
  2179. astArms := AST.NoNode;
  2180. astArmsTail := AST.NoNode;
  2181. .)
  2182. "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
  2183. { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
  2184. [ "ELSE" (. astStmt := AST.NoNode; .)
  2185. [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
  2186. AST.SetOp(arm, 1);
  2187. AST.SetChild(arm, 0, astStmt);
  2188. AstAppend(AST.NkBlock,
  2189. astArms, astArmsTail, arm); .) ]
  2190. "END" (. AST.SetChild(astNode, 1, astArms);
  2191. astStmt := astNode;
  2192. .) .
  2193. (* Compare-chain lowering: each alternative ends its match-tests
  2194. with "jmp lAfter", so the no-match fallthrough skips the body:
  2195. "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
  2196. lAfter:". Falls into the next alternative, ELSE, or END. *)
  2197. CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  2198. lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
  2199. (. VAR arm: AST.Node; .)
  2200. = (. arm := AST.MakeNode(AST.NkCaseArm); .)
  2201. CaseLabel<tsel, qsel, arm>
  2202. { "," CaseLabel<tsel, qsel, arm> }
  2203. ":" (. astStmt := AST.NoNode; .)
  2204. [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
  2205. astStmt);
  2206. AstAppend(AST.NkBlock,
  2207. arms, armsTail, arm);
  2208. .) .
  2209. CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  2210. arm: AST.Node>
  2211. (. VAR t2, t3: SymTab.TypeIndex;
  2212. q2, q3, qc, qd, qe:
  2213. QbeGen.QVal;
  2214. astLab: AST.Node;
  2215. lNext: QbeGen.QVal; .)
  2216. = Expr<t2, q2> (. astLab := astCur;
  2217. IF (t2 #
  2218. SymTab.InvalidType)
  2219. AND (tsel #
  2220. SymTab.InvalidType)
  2221. AND ((SymTab.ClassOf(t2) =
  2222. SymTab.ClSet)
  2223. OR (SymTab.ClassOf(tsel) =
  2224. SymTab.ClSet)) THEN
  2225. SemError(230)
  2226. ELSIF (t2 #
  2227. SymTab.InvalidType)
  2228. AND (tsel #
  2229. SymTab.InvalidType)
  2230. AND NOT SymTab.EqCheck(t2,
  2231. tsel) THEN
  2232. SemError(213) END;
  2233. IF NOT QbeGen.IsImm(q2) THEN
  2234. SemError(230)
  2235. END; .)
  2236. [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
  2237. AST.NkSubrange, 0, astLab, astCur);
  2238. IF (t3 #
  2239. SymTab.InvalidType)
  2240. AND (tsel #
  2241. SymTab.InvalidType)
  2242. AND NOT SymTab.EqCheck(t3,
  2243. tsel) THEN
  2244. SemError(213) END;
  2245. IF NOT QbeGen.IsImm(q3) THEN
  2246. SemError(230)
  2247. END; .) ]
  2248. (. AST.SetChild(arm,
  2249. AST.NChild(arm), astLab); .) .
  2250. ReturnStat (. VAR t: SymTab.TypeIndex;
  2251. q, qt: QbeGen.QVal;
  2252. res: SymTab.TypeIndex;
  2253. hadE, conv: BOOLEAN;
  2254. astVal, astNode: AST.Node; .)
  2255. = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
  2256. [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
  2257. (. astNode := AST.MakeNode(AST.NkReturn);
  2258. IF hadE THEN
  2259. AST.SetChild(astNode, 0, astVal)
  2260. END;
  2261. astStmt := astNode;
  2262. conv := FALSE;
  2263. IF NOT SymTab.InProc() THEN
  2264. SemError(232)
  2265. ELSE res := SymTab.CurRes();
  2266. IF NOT hadE THEN
  2267. IF res #
  2268. SymTab.InvalidType THEN
  2269. SemError(232)
  2270. END
  2271. ELSIF (res =
  2272. SymTab.InvalidType)
  2273. OR (t #
  2274. SymTab.InvalidType)
  2275. AND NOT SymTab.Assignable(t,
  2276. res) THEN
  2277. SemError(232)
  2278. END
  2279. END; .) .
  2280. HaltStat (. VAR t: SymTab.TypeIndex;
  2281. q: QbeGen.QVal;
  2282. astVal, astNode: AST.Node; .)
  2283. = "HALT" (. astVal := AST.NoNode; .)
  2284. [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
  2285. (. astNode := AST.MakeNode(AST.NkHalt);
  2286. IF astVal # AST.NoNode THEN
  2287. AST.SetChild(astNode, 0, astVal)
  2288. END;
  2289. astStmt := astNode;
  2290. .) .
  2291. (* Designator: scalar loads, array addresses, and index suffixes.
  2292. Each index descends one level (bounds-checked, trap on breach);
  2293. nested levels reload the inner descriptor address. q ends as the
  2294. value (scalars), the descriptor address (plain arrays), or the
  2295. element address (indexed); sfx marks the indexed form. *)
  2296. Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  2297. VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
  2298. (. VAR n: SymTab.Name; .)
  2299. = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
  2300. (* The part of Design after the identifier: resolve it and walk the
  2301. selectors. Split out so a statement can decide between a label
  2302. (`ident :`) and a designator (`ident := ...`) with one token. *)
  2303. DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  2304. VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
  2305. (. VAR fn, mal: SymTab.Name;
  2306. cls: INTEGER;
  2307. ic: SymTab.TypeIndex;
  2308. curT, it, eT, bt:
  2309. SymTab.TypeIndex;
  2310. iq, ql, qlo, qhi, qe:
  2311. QbeGen.QVal;
  2312. lo, hi: INTEGER;
  2313. fo: INTEGER;
  2314. isOpen: BOOLEAN;
  2315. qb, cv: QbeGen.QVal;
  2316. r: BOOLEAN;
  2317. astDes, astSel: AST.Node; .)
  2318. = (. methCls := SymTab.InvalidType;
  2319. QbeGen.CopyOp(n, qn);
  2320. sfx := FALSE;
  2321. IF NOT SymTab.Lookup(n) THEN
  2322. (* a bare method name inside
  2323. a CLASS IMPLEMENTATION
  2324. is a sibling call on
  2325. THIS *)
  2326. ic := SymTab.CurImplClass();
  2327. IF (ic #
  2328. SymTab.InvalidType)
  2329. AND SymTab.MethodExists(ic, n) THEN
  2330. sfx := FALSE;
  2331. QbeGen.CopyOp("@", q);
  2332. methCls := ic;
  2333. k := SymTab.KindProc;
  2334. t := SymTab.InvalidType
  2335. ELSIF SymTab.InProc() THEN
  2336. (* not declared anywhere
  2337. in scope: with bodies
  2338. parsed at unit end this
  2339. is a genuine 201 (a
  2340. nested-local forward is
  2341. no longer tolerated). *)
  2342. SemError(201);
  2343. t := SymTab.InvalidType;
  2344. k := -1;
  2345. QbeGen.CopyOp("0", q)
  2346. ELSE
  2347. SemError(201);
  2348. t :=
  2349. SymTab.InvalidType;
  2350. k := -1;
  2351. QbeGen.CopyOp("0", q)
  2352. END
  2353. ELSE
  2354. t := SymTab.SymType(n);
  2355. k := SymTab.SymKind(n);
  2356. IF k = SymTab.KindConst THEN
  2357. IF SymTab.Equal(n,
  2358. "TRUE") THEN
  2359. t := SymTab.BoolType();
  2360. QbeGen.CopyOp("1", q)
  2361. ELSIF SymTab.Equal(n,
  2362. "FALSE") THEN
  2363. t := SymTab.BoolType();
  2364. QbeGen.CopyOp("0", q)
  2365. ELSIF SymTab.Equal(n,
  2366. "NIL") THEN
  2367. QbeGen.CopyOp("0", q)
  2368. ELSE
  2369. cls :=
  2370. SymTab.ClassOf(t);
  2371. IF (t #
  2372. SymTab.InvalidType)
  2373. AND ((cls = SymTab.ClInt)
  2374. OR (cls
  2375. = SymTab.ClChar)
  2376. OR (cls
  2377. = SymTab.ClEnum)
  2378. OR (cls
  2379. = SymTab.ClReal)
  2380. OR (cls
  2381. = SymTab.ClLong)
  2382. OR (cls
  2383. = SymTab.ClNil)) THEN
  2384. IF cls = SymTab.ClNil THEN
  2385. QbeGen.CopyOp("0", q)
  2386. ELSIF ((cls
  2387. = SymTab.ClInt)
  2388. OR (cls
  2389. = SymTab.ClChar)
  2390. OR (cls
  2391. = SymTab.ClEnum)
  2392. OR (cls
  2393. = SymTab.ClLong))
  2394. AND SymTab.GetSymVal(n, cv)
  2395. AND QbeGen.IsImm(cv) THEN
  2396. QbeGen.CopyOp(cv, q)
  2397. ELSE
  2398. QbeGen.LoadVar(n,
  2399. cls = SymTab.ClReal,
  2400. q)
  2401. END
  2402. ELSIF (cls = SymTab.ClArray)
  2403. OR (cls = SymTab.ClRecord)
  2404. OR (cls = SymTab.ClClass)
  2405. OR (cls = SymTab.ClStr)
  2406. OR (cls = SymTab.ClUStr) THEN
  2407. (* aggregate constant:
  2408. its value IS the
  2409. descriptor address *)
  2410. IF SymTab.GetSymVal(n, cv) THEN
  2411. QbeGen.CopyOp(cv, q)
  2412. ELSE
  2413. QbeGen.CopyOp("0", q)
  2414. END
  2415. ELSE
  2416. IF t #
  2417. SymTab.InvalidType THEN
  2418. SemError(230)
  2419. END;
  2420. QbeGen.CopyOp("0", q)
  2421. END
  2422. END
  2423. ELSIF (k = SymTab.KindVar)
  2424. OR (k = SymTab.KindParam) THEN
  2425. cls := SymTab.ClassOf(t);
  2426. IF (cls # SymTab.ClInt)
  2427. AND (cls # SymTab.ClBool)
  2428. AND (cls # SymTab.ClChar)
  2429. AND (cls # SymTab.ClUChar)
  2430. AND (cls # SymTab.ClEnum)
  2431. AND (cls # SymTab.ClReal)
  2432. AND (cls # SymTab.ClPtr)
  2433. AND (cls # SymTab.ClProc)
  2434. AND (cls # SymTab.ClLong)
  2435. AND (cls # SymTab.ClArray)
  2436. AND (cls # SymTab.ClSet)
  2437. AND (cls # SymTab.ClRecord)
  2438. AND (cls # SymTab.ClUStr)
  2439. AND (cls # SymTab.ClClass) THEN
  2440. SemError(230);
  2441. QbeGen.CopyOp("0", q)
  2442. ELSE QbeGen.CopyOp("@", q)
  2443. END
  2444. ELSE QbeGen.CopyOp("0", q);
  2445. IF k = SymTab.KindImport THEN
  2446. SemError(230)
  2447. ELSIF k =
  2448. SymTab.KindProc THEN
  2449. (* bare procedure name:
  2450. a following ArgList
  2451. makes it a call;
  2452. otherwise Fact
  2453. reports 230 *)
  2454. ELSE
  2455. IF k = SymTab.KindField THEN
  2456. IF QbeGen.TopWith(qb) THEN
  2457. sfx := TRUE
  2458. ELSE SemError(230);
  2459. QbeGen.CopyOp("0", q)
  2460. END
  2461. END
  2462. END
  2463. END
  2464. END; .)
  2465. (. astDes := AST.MakeNode(AST.NkDesignator);
  2466. AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
  2467. { "[" Expr<it, iq>
  2468. (. AST.SetChild(astDes, AST.NChild(astDes),
  2469. AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
  2470. ELSIF SymTab.ClassOf(t) #
  2471. SymTab.ClArray THEN
  2472. SemError(217);
  2473. t := SymTab.InvalidType
  2474. ELSIF NOT SymTab.IsIntFamily(it)
  2475. AND (SymTab.ClassOf(it) #
  2476. SymTab.ClChar)
  2477. AND (SymTab.ClassOf(it) #
  2478. SymTab.ClEnum) THEN
  2479. SemError(218);
  2480. t := SymTab.InvalidType
  2481. ELSE
  2482. eT := SymTab.ArrayElem(t);
  2483. t := eT; sfx := TRUE
  2484. END; .)
  2485. { "," Expr<it, iq>
  2486. (. AST.SetChild(astDes, AST.NChild(astDes),
  2487. AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
  2488. ELSIF SymTab.ClassOf(t) #
  2489. SymTab.ClArray THEN
  2490. SemError(217);
  2491. t := SymTab.InvalidType
  2492. ELSIF NOT SymTab.IsIntFamily(it)
  2493. AND (SymTab.ClassOf(it) #
  2494. SymTab.ClChar)
  2495. AND (SymTab.ClassOf(it) #
  2496. SymTab.ClEnum) THEN
  2497. SemError(218);
  2498. t := SymTab.InvalidType
  2499. ELSE
  2500. eT := SymTab.ArrayElem(t);
  2501. t := eT; sfx := TRUE
  2502. END; .) }
  2503. "]"
  2504. | "." GetIdent<fn>
  2505. (. astSel := AST.MakeNode(AST.NkSelector);
  2506. AST.SetOp(astSel, AST.SelField);
  2507. AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
  2508. AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
  2509. (* qualified L.x: materialize
  2510. the export, then load it *)
  2511. IF NOT SymTab.MaterializeAlias(n,
  2512. fn, mal) THEN
  2513. SemError(201);
  2514. t := SymTab.InvalidType;
  2515. QbeGen.CopyOp("0", q)
  2516. ELSE
  2517. QbeGen.CopyOp(mal, qn);
  2518. t := SymTab.SymType(mal);
  2519. k := SymTab.SymKind(mal);
  2520. sfx := FALSE;
  2521. IF k = SymTab.KindProc THEN
  2522. (* call: ArgList supplies
  2523. the value *)
  2524. QbeGen.CopyOp("0", q)
  2525. END
  2526. END
  2527. ELSIF t = SymTab.InvalidType THEN
  2528. ELSIF (SymTab.ClassOf(t) #
  2529. SymTab.ClRecord)
  2530. AND (SymTab.ClassOf(t) #
  2531. SymTab.ClClass) THEN
  2532. SemError(215);
  2533. t := SymTab.InvalidType
  2534. ELSIF (SymTab.ClassOf(t) =
  2535. SymTab.ClClass)
  2536. AND SymTab.MethodExists(t, fn) THEN
  2537. (* obj.Method: bind the
  2538. method and pass obj as
  2539. the hidden receiver; q
  2540. already holds the
  2541. object's address *)
  2542. QbeGen.CopyOp(fn, n);
  2543. QbeGen.CopyOp(fn, qn);
  2544. methCls := t;
  2545. k := SymTab.KindProc;
  2546. t := SymTab.InvalidType
  2547. ELSIF NOT SymTab.FieldExists(t,
  2548. fn) THEN
  2549. SemError(216);
  2550. t := SymTab.InvalidType
  2551. ELSE
  2552. t := SymTab.FieldType(t, fn);
  2553. sfx := TRUE
  2554. END; .)
  2555. | "^"
  2556. (. astSel := AST.MakeNode(AST.NkSelector);
  2557. AST.SetOp(astSel, AST.SelDeref);
  2558. AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
  2559. ELSIF SymTab.ClassOf(t) #
  2560. SymTab.ClPtr THEN
  2561. SemError(219);
  2562. t := SymTab.InvalidType
  2563. ELSE
  2564. bt := SymTab.PtrBase(t);
  2565. IF bt = SymTab.InvalidType THEN
  2566. ELSE
  2567. t := bt;
  2568. sfx := TRUE
  2569. END
  2570. END; .) } (. astCur := astDes; .) .
  2571. (* Result suffix (ISO component after a function call): `F()^`,
  2572. `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
  2573. (a value, or a descriptor address for aggregates); each component
  2574. descends one level exactly like the Design components. *)
  2575. ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
  2576. VAR sfx: BOOLEAN; VAR node: AST.Node;
  2577. VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
  2578. VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
  2579. iq, ql, qlo, qhi, qe, qb:
  2580. QbeGen.QVal;
  2581. lo, hi, fo: INTEGER;
  2582. isOpen: BOOLEAN;
  2583. fname: SymTab.Name;
  2584. astWrap, astSel: AST.Node; .)
  2585. = "[" Expr<it, iq>
  2586. (. isM := FALSE;
  2587. IF AST.Kind(node) # AST.NkDesignator THEN
  2588. astWrap := AST.MakeNode(
  2589. AST.NkDesignator);
  2590. AST.SetChild(astWrap, 0, node);
  2591. node := astWrap
  2592. END;
  2593. AST.SetChild(node, AST.NChild(node),
  2594. AST.MakeUn(AST.NkSelector,
  2595. AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
  2596. ELSIF SymTab.ClassOf(t) #
  2597. SymTab.ClArray THEN
  2598. SemError(217);
  2599. t := SymTab.InvalidType
  2600. ELSIF NOT SymTab.IsIntFamily(it)
  2601. AND (SymTab.ClassOf(it) # SymTab.ClChar)
  2602. AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
  2603. SemError(218);
  2604. t := SymTab.InvalidType
  2605. ELSE
  2606. eT := SymTab.ArrayElem(t);
  2607. t := eT; sfx := TRUE
  2608. END; .)
  2609. "]"
  2610. | "." GetIdent<fname>
  2611. (. isM := FALSE;
  2612. IF AST.Kind(node) # AST.NkDesignator THEN
  2613. astWrap := AST.MakeNode(
  2614. AST.NkDesignator);
  2615. AST.SetChild(astWrap, 0, node);
  2616. node := astWrap
  2617. END;
  2618. AST.SetChild(node, AST.NChild(node),
  2619. AST.MakeUn(AST.NkSelector,
  2620. AST.SelField,
  2621. AST.MakeLeaf(AST.NkIdent,
  2622. fname))); IF t = SymTab.InvalidType THEN
  2623. ELSIF (SymTab.ClassOf(t) #
  2624. SymTab.ClRecord)
  2625. AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
  2626. SemError(215);
  2627. t := SymTab.InvalidType
  2628. ELSIF (SymTab.ClassOf(t) =
  2629. SymTab.ClClass)
  2630. AND SymTab.MethodExists(t, fname) THEN
  2631. (* a method on the call result:
  2632. a following ArgList makes
  2633. the call *)
  2634. mname := fname;
  2635. methCls := t; isM := TRUE;
  2636. t := SymTab.InvalidType
  2637. ELSIF NOT SymTab.FieldExists(t,
  2638. fname) THEN
  2639. SemError(216);
  2640. t := SymTab.InvalidType
  2641. ELSE
  2642. t := SymTab.FieldType(t, fname);
  2643. sfx := TRUE
  2644. END; .)
  2645. | "^" (. isM := FALSE;
  2646. IF AST.Kind(node) # AST.NkDesignator THEN
  2647. astWrap := AST.MakeNode(
  2648. AST.NkDesignator);
  2649. AST.SetChild(astWrap, 0, node);
  2650. node := astWrap
  2651. END;
  2652. astSel := AST.MakeNode(AST.NkSelector);
  2653. AST.SetOp(astSel, AST.SelDeref);
  2654. AST.SetChild(node,
  2655. AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
  2656. ELSIF SymTab.ClassOf(t) #
  2657. SymTab.ClPtr THEN
  2658. SemError(219);
  2659. t := SymTab.InvalidType
  2660. ELSE
  2661. bt := SymTab.PtrBase(t);
  2662. IF bt # SymTab.InvalidType THEN
  2663. t := bt; sfx := TRUE
  2664. END
  2665. END; .) .
  2666. Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2667. (. VAR t2: SymTab.TypeIndex;
  2668. op: INTEGER;
  2669. q2, qt, wl: QbeGen.QVal;
  2670. astA, astB: AST.Node;
  2671. astOp: INTEGER;
  2672. astMade: BOOLEAN;
  2673. isR: BOOLEAN; .)
  2674. = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
  2675. [ Rel<op> SimExpr<t2, q2>
  2676. (. astB := astCur; astMade := TRUE;
  2677. astOp := AST.OpEq;
  2678. IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
  2679. ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
  2680. ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
  2681. ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
  2682. ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
  2683. ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
  2684. ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
  2685. END;
  2686. IF op = SymTab.OpIn THEN
  2687. IF SymTab.InCheck(t, t2) THEN
  2688. IF (t = SymTab.InvalidType)
  2689. OR (t2 = SymTab.InvalidType) THEN
  2690. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  2691. ELSE
  2692. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  2693. END
  2694. ELSE SemError(222); t := SymTab.InvalidType;
  2695. QbeGen.CopyOp("0", q)
  2696. END
  2697. ELSIF SymTab.RelCheck(t, t2, op) THEN
  2698. IF (t = SymTab.InvalidType)
  2699. OR (t2 = SymTab.InvalidType) THEN
  2700. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  2701. ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
  2702. OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
  2703. IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
  2704. AND (op # SymTab.OpNeq2) THEN
  2705. SemError(213); t := SymTab.InvalidType;
  2706. QbeGen.CopyOp("0", q)
  2707. ELSE
  2708. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  2709. END
  2710. ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
  2711. OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2712. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  2713. ELSIF SymTab.StrCompat(t, t2) THEN
  2714. QbeGen.StrEq(op, q, q2, qt);
  2715. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  2716. ELSIF SymTab.IsLongFamily(t)
  2717. OR SymTab.IsLongFamily(t2) THEN
  2718. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  2719. ELSE
  2720. t := SymTab.BoolType();
  2721. QbeGen.CopyOp("@", q)
  2722. END
  2723. ELSE SemError(213); t := SymTab.InvalidType;
  2724. QbeGen.CopyOp("0", q)
  2725. END;
  2726. astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
  2727. (. IF NOT astMade THEN astCur := astA END; .)
  2728. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  2729. Rel<VAR op: INTEGER>
  2730. = "=" (. op := SymTab.OpEq; .)
  2731. | "#" (. op := SymTab.OpNeq1; .)
  2732. | "<" (. op := SymTab.OpLt; .)
  2733. | "<=" (. op := SymTab.OpLe; .)
  2734. | ">" (. op := SymTab.OpGt; .)
  2735. | ">=" (. op := SymTab.OpGe; .)
  2736. | "IN" (. op := SymTab.OpIn; .) .
  2737. SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2738. (. VAR t2, res2, lt, rt:
  2739. SymTab.TypeIndex;
  2740. op: INTEGER;
  2741. q2, qt, wq, qf, q2a, q2b:
  2742. QbeGen.QVal;
  2743. neg, isR, isL, folded:
  2744. BOOLEAN;
  2745. fok: BOOLEAN;
  2746. lw, rw, mw: CARDINAL;
  2747. lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
  2748. astA, astB: AST.Node;
  2749. astSign, astOp: INTEGER; .)
  2750. = (. neg := FALSE; astSign := 0; .)
  2751. [ "+" (. neg := TRUE; astSign := 1; .)
  2752. | "-" (. neg := TRUE; astSign := -1; .) ]
  2753. Term<t, q> (. astA := astCur;
  2754. IF neg AND QbeGen.IsImm(q) THEN
  2755. QbeGen.NegFold(q, q)
  2756. END;
  2757. IF astSign < 0 THEN
  2758. astCur := AST.MakeUn(
  2759. AST.NkUnary, AST.OpSub, astA);
  2760. astA := astCur
  2761. END; .)
  2762. { AddOp<op>
  2763. Term<t2, q2> (. astB := astCur; .)
  2764. (. astOp := AST.OpAdd;
  2765. IF op = SymTab.OpSub THEN astOp := AST.OpSub
  2766. ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
  2767. astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
  2768. astCur := astA;
  2769. IF op = SymTab.OpOr THEN
  2770. (* short-circuit: if q is true the RHS is skipped *)
  2771. IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
  2772. t := SymTab.BoolType()
  2773. ELSE SemError(212); t := SymTab.InvalidType END;
  2774. IF t # SymTab.InvalidType THEN
  2775. QbeGen.CopyOp("@", q)
  2776. ELSE QbeGen.CopyOp("0", q)
  2777. END
  2778. ELSIF (op = SymTab.OpAdd)
  2779. AND (SymTab.UStrCompat(t, t2)
  2780. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  2781. AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
  2782. OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
  2783. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
  2784. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  2785. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
  2786. (* UString concatenation: a UCHAR operand becomes a
  2787. 1-codepoint UString; the result is a descriptor in the
  2788. shim's concat buffer. Work on copies so neither
  2789. operand is clobbered. *)
  2790. t := SymTab.NewUStr();
  2791. QbeGen.CopyOp("@", q)
  2792. ELSIF (op = SymTab.OpAdd)
  2793. AND (SymTab.StrCompat(t, t2)
  2794. OR (SymTab.IsStrType(t)
  2795. AND (SymTab.ClassOf(t2) = SymTab.ClChar))
  2796. OR ((SymTab.ClassOf(t) = SymTab.ClChar)
  2797. AND SymTab.IsStrType(t2))) THEN
  2798. (* string concatenation; a CHAR operand becomes a
  2799. 1-character string literal. When both operands are
  2800. constants, fold to a single string literal so a
  2801. constructor element stays compile-time. *)
  2802. QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
  2803. qt, fok);
  2804. IF fok THEN QbeGen.CopyOp(qt, q)
  2805. ELSE QbeGen.CopyOp("@", q)
  2806. END;
  2807. t := SymTab.NewStr()
  2808. ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  2809. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  2810. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2811. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  2812. mw := lw;
  2813. IF rw > mw THEN mw := rw END;
  2814. t := SymTab.NewSet(
  2815. SymTab.NewSubR(0,
  2816. VAL(INTEGER, mw) * 32 - 1));
  2817. QbeGen.CopyOp("@", q)
  2818. ELSE
  2819. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
  2820. lt := t; rt := t2; t := res2
  2821. ELSE SemError(211); t := SymTab.InvalidType END;
  2822. IF t # SymTab.InvalidType THEN
  2823. isL := SymTab.IsLongFamily(t);
  2824. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  2825. folded := FALSE;
  2826. IF (NOT isL) AND (NOT isR)
  2827. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  2828. IF op = SymTab.OpAdd THEN
  2829. folded := QbeGen.Fold2(0, q, q2, qf)
  2830. ELSE
  2831. folded := QbeGen.Fold2(1, q, q2, qf)
  2832. END
  2833. END;
  2834. IF folded THEN QbeGen.CopyOp(qf, q)
  2835. ELSE
  2836. QbeGen.CopyOp("@", q)
  2837. END
  2838. ELSE QbeGen.CopyOp("0", q)
  2839. END
  2840. END; .) }
  2841. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  2842. AddOp<VAR op: INTEGER>
  2843. = "+" (. op := SymTab.OpAdd; .)
  2844. | "-" (. op := SymTab.OpSub; .)
  2845. | "OR" (. op := SymTab.OpOr; .) .
  2846. Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2847. (. VAR t2, res2, lt, rt:
  2848. SymTab.TypeIndex;
  2849. op: INTEGER;
  2850. q2, qt, wq, qf:
  2851. QbeGen.QVal;
  2852. isR, isL, folded: BOOLEAN;
  2853. lw, rw, mw: CARDINAL;
  2854. lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
  2855. astA, astB: AST.Node;
  2856. astOp: INTEGER; .)
  2857. = Fact<t, q> (. astA := astCur; .) { MulOp<op>
  2858. Fact<t2, q2> (. astB := astCur; .)
  2859. (. astOp := AST.OpMul;
  2860. IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
  2861. ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
  2862. ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
  2863. ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
  2864. astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
  2865. astCur := astA;
  2866. IF op = SymTab.OpAnd THEN
  2867. (* short-circuit: if q is false the RHS is skipped *)
  2868. IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
  2869. t := SymTab.BoolType()
  2870. ELSE SemError(212); t := SymTab.InvalidType END;
  2871. IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
  2872. ELSE QbeGen.CopyOp("0", q)
  2873. END
  2874. ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  2875. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  2876. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  2877. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  2878. mw := lw;
  2879. IF rw > mw THEN mw := rw END;
  2880. t := SymTab.NewSet(
  2881. SymTab.NewSubR(0,
  2882. VAL(INTEGER, mw) * 32 - 1));
  2883. QbeGen.CopyOp("@", q)
  2884. ELSE
  2885. IF SymTab.ArithCheck(t, t2,
  2886. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  2887. res2) THEN
  2888. lt := t; rt := t2; t := res2
  2889. ELSE SemError(211); t := SymTab.InvalidType END;
  2890. IF t # SymTab.InvalidType THEN
  2891. isL := SymTab.IsLongFamily(t);
  2892. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  2893. folded := FALSE;
  2894. IF (NOT isL) AND (NOT isR)
  2895. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  2896. IF op = SymTab.OpTimes THEN
  2897. folded := QbeGen.Fold2(2, q, q2, qf)
  2898. ELSIF op = SymTab.OpDiv THEN
  2899. folded := QbeGen.Fold2(3, q, q2, qf)
  2900. ELSIF op = SymTab.OpMod THEN
  2901. folded := QbeGen.Fold2(4, q, q2, qf)
  2902. END
  2903. END;
  2904. IF folded THEN QbeGen.CopyOp(qf, q)
  2905. ELSE
  2906. QbeGen.CopyOp("@", q)
  2907. END
  2908. ELSE QbeGen.CopyOp("0", q)
  2909. END
  2910. END; .) }
  2911. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  2912. MulOp<VAR op: INTEGER>
  2913. = "*" (. op := SymTab.OpTimes; .)
  2914. | "/" (. op := SymTab.OpSlash; .)
  2915. | "DIV" (. op := SymTab.OpDiv; .)
  2916. | "MOD" (. op := SymTab.OpMod; .)
  2917. | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
  2918. Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  2919. (. VAR s: ARRAY [0 .. 255] OF CHAR;
  2920. et, dt, t2, st, ct2, et2:
  2921. SymTab.TypeIndex;
  2922. dk: INTEGER;
  2923. qd, q2, sq, qa, qm0, qr, qt:
  2924. QbeGen.QVal;
  2925. qn, vn: SymTab.Name;
  2926. vt: SymTab.TypeIndex;
  2927. c1, c2: INTEGER;
  2928. lo, hi: INTEGER;
  2929. isMax: BOOLEAN;
  2930. called, isHigh, sfx, isCh,
  2931. isU, uok, isStr: BOOLEAN;
  2932. ucp: INTEGER; astIsLit: BOOLEAN;
  2933. astD: AST.Node;
  2934. astCall: BOOLEAN;
  2935. astNode, astNot: AST.Node;
  2936. j: CARDINAL;
  2937. astArg2: AST.Node;
  2938. astBrace: AST.Node;
  2939. astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN; .)
  2940. = (. astIsLit := FALSE; .)
  2941. ( integer (. LexString(s);
  2942. QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
  2943. t := SymTab.IntType(); .)
  2944. | charConst (. LexString(s);
  2945. QbeGen.NormLit(s, q, isCh);
  2946. astIsLit := TRUE;
  2947. astCur := AST.MakeLeaf(
  2948. AST.NkCharLit, s);
  2949. t := SymTab.CharType(); .)
  2950. | real (. LexString(s);
  2951. QbeGen.NormReal(s, q);
  2952. astIsLit := TRUE;
  2953. astCur := AST.MakeLeaf(
  2954. AST.NkRealLit, s);
  2955. t := SymTab.RealType(); .)
  2956. | string (. LexString(s);
  2957. astIsLit := TRUE;
  2958. astCur := AST.MakeLeaf(
  2959. AST.NkStrLit, s);
  2960. IF SymTab.StrLen(s) = 3 THEN
  2961. t := SymTab.CharType();
  2962. QbeGen.IntStr(
  2963. QbeGen.CharVal(s), q)
  2964. ELSE t := SymTab.NewStr();
  2965. QbeGen.DeclStr(s, q);
  2966. (* a literal's value IS its
  2967. static descriptor address *)
  2968. END; .)
  2969. | ustring (. LexString(s);
  2970. astIsLit := TRUE;
  2971. astCur := AST.MakeLeaf(
  2972. AST.NkStrLit, s);
  2973. QbeGen.DeclUStr(s, q, isU, ucp,
  2974. uok);
  2975. IF NOT uok THEN
  2976. SemError(234);
  2977. t := SymTab.InvalidType
  2978. ELSIF isU THEN
  2979. t := SymTab.UCharType();
  2980. QbeGen.IntStr(ucp, q)
  2981. ELSE
  2982. t := SymTab.NewUStr();
  2983. END; .)
  2984. | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
  2985. astNArgs := 0; called := FALSE;
  2986. t := dt;
  2987. IF dk = SymTab.KindConst THEN
  2988. QbeGen.CopyOp(qd, q)
  2989. ELSE QbeGen.CopyOp("@", q)
  2990. END; .)
  2991. [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
  2992. astBrace := astCur; .) ]
  2993. [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
  2994. (. astCall := TRUE;
  2995. astNode := AstCallNode(astD);
  2996. astRes := astNode;
  2997. t := ct2;
  2998. QbeGen.CopyOp(q2, q);
  2999. sfx := FALSE; .)
  3000. { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
  3001. [ (. astNArgs := 0; .)
  3002. ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
  3003. (. astNode := AstCallNode(astRes);
  3004. astRes := astNode;
  3005. t := ct2;
  3006. QbeGen.CopyOp(q2, q);
  3007. sfx := FALSE; .) ] }
  3008. (. IF sfx THEN
  3009. IF t = SymTab.InvalidType THEN
  3010. QbeGen.CopyOp("0", q)
  3011. ELSIF (SymTab.ClassOf(t) #
  3012. SymTab.ClRecord)
  3013. AND (SymTab.ClassOf(t) # SymTab.ClSet)
  3014. AND (SymTab.ClassOf(t) # SymTab.ClArray)
  3015. AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
  3016. QbeGen.CopyOp("@", q)
  3017. END
  3018. END; .) ]
  3019. (. IF called THEN
  3020. astCur := astRes
  3021. ELSIF astCall THEN
  3022. astCur := astBrace
  3023. ELSE astCur := astD
  3024. END;
  3025. astIsLit := TRUE;
  3026. IF NOT called
  3027. AND (dk = SymTab.KindProc) THEN
  3028. (* bare zero-arg function
  3029. call (parentheses may be
  3030. omitted); a proper or
  3031. parameterised proc here
  3032. is 230 *)
  3033. IF (SymTab.ProcNPar(qn) = 0)
  3034. AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
  3035. t := SymTab.ProcRes(qn);
  3036. QbeGen.CopyOp("@", q);
  3037. astCur := AST.MakeNode(AST.NkCall);
  3038. AST.SetChild(astCur, 0, astD)
  3039. ELSE
  3040. t := SymTab.ProcTypeOf(qn);
  3041. QbeGen.CopyOp("@", q)
  3042. END
  3043. END; .)
  3044. | ( "HIGH" (. isHigh := TRUE; .)
  3045. | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
  3046. "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
  3047. isU := FALSE; .)
  3048. | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
  3049. isStr := TRUE;
  3050. isU := FALSE;
  3051. IF SymTab.StrLen(s) = 3 THEN
  3052. dt := SymTab.CharType();
  3053. QbeGen.IntStr(QbeGen.CharVal(s),
  3054. qd)
  3055. ELSE
  3056. dt := SymTab.NewStr();
  3057. QbeGen.DeclStr(s, qd);
  3058. END;
  3059. dk := -1;
  3060. qn[0] := CHR(0); .)
  3061. | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
  3062. QbeGen.DeclUStr(s, qd, isU, ucp,
  3063. uok);
  3064. isStr := FALSE;
  3065. IF NOT uok THEN
  3066. SemError(234);
  3067. dt := SymTab.InvalidType
  3068. ELSIF isU THEN
  3069. (* one codepoint: a UCHAR;
  3070. LEN is 1, HIGH is 0 *)
  3071. dt := SymTab.UCharType();
  3072. QbeGen.IntStr(ucp, qd)
  3073. ELSE
  3074. dt := SymTab.NewUStr();
  3075. END;
  3076. dk := -1;
  3077. qn[0] := CHR(0); .) )
  3078. ")"
  3079. (. astNode := AST.MakeNode(AST.NkCall);
  3080. IF isHigh THEN AST.SetChild(astNode, 0,
  3081. AST.MakeLeaf(AST.NkIdent, "HIGH"))
  3082. ELSE AST.SetChild(astNode, 0,
  3083. AST.MakeLeaf(AST.NkIdent, "LEN")) END;
  3084. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3085. astCur := astNode; astIsLit := TRUE;
  3086. IF (dt # SymTab.InvalidType)
  3087. AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
  3088. (* UString: the count is
  3089. the descriptor header *)
  3090. t := SymTab.IntType();
  3091. QbeGen.CopyOp("@", q)
  3092. ELSIF (dt # SymTab.InvalidType)
  3093. AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
  3094. (* single UCHAR codepoint *)
  3095. IF isHigh THEN
  3096. QbeGen.CopyOp("0", qr)
  3097. ELSE
  3098. QbeGen.CopyOp("1", qr)
  3099. END;
  3100. t := SymTab.IntType();
  3101. QbeGen.CopyOp(qr, q)
  3102. ELSIF isStr THEN
  3103. (* fold: content length at
  3104. compile time *)
  3105. IF SymTab.StrLen(s) = 3 THEN
  3106. c1 := 1
  3107. ELSE
  3108. c1 :=
  3109. SymTab.StrLen(s) - 2
  3110. END;
  3111. IF isHigh THEN
  3112. DEC(c1)
  3113. END;
  3114. QbeGen.IntStr(c1, qr);
  3115. t := SymTab.IntType();
  3116. QbeGen.CopyOp(qr, q)
  3117. ELSIF dt = SymTab.InvalidType THEN
  3118. t := SymTab.InvalidType;
  3119. QbeGen.CopyOp("0", q)
  3120. ELSIF SymTab.ClassOf(dt) #
  3121. SymTab.ClArray THEN
  3122. SemError(217);
  3123. t := SymTab.InvalidType;
  3124. QbeGen.CopyOp("0", q)
  3125. ELSE
  3126. IF SymTab.IsOpenArray(dt) THEN
  3127. t := SymTab.IntType();
  3128. QbeGen.CopyOp("@", q)
  3129. ELSE
  3130. IF isHigh THEN
  3131. QbeGen.IntStr(
  3132. SymTab.ArrayHi(dt), qr)
  3133. ELSE
  3134. QbeGen.IntStr(VAL(
  3135. INTEGER,
  3136. SymTab.ArrayLen(dt)),
  3137. qr)
  3138. END;
  3139. t := SymTab.IntType();
  3140. QbeGen.CopyOp(qr, q)
  3141. END
  3142. END; .)
  3143. | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
  3144. (. astNode := AST.MakeNode(AST.NkCall);
  3145. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
  3146. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3147. astCur := astNode; astIsLit := TRUE; .)
  3148. (. IF dt = SymTab.InvalidType THEN
  3149. t := SymTab.InvalidType;
  3150. QbeGen.CopyOp("0", q)
  3151. ELSE
  3152. QbeGen.IntStr(VAL(INTEGER,
  3153. SymTab.ObjectSize(dt)), q);
  3154. t := SymTab.IntType()
  3155. END; .)
  3156. | ( "SHIFT" (. isMax := FALSE; .)
  3157. | "ROTATE" (. isMax := TRUE; .) )
  3158. "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
  3159. (. astNode := AST.MakeNode(AST.NkCall);
  3160. IF isMax THEN AST.SetChild(astNode, 0,
  3161. AST.MakeLeaf(AST.NkIdent, "ROTATE"))
  3162. ELSE AST.SetChild(astNode, 0,
  3163. AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
  3164. IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
  3165. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
  3166. astCur := astNode; astIsLit := TRUE;
  3167. (* set shift/rotate: isMax
  3168. doubles as "rotate" *)
  3169. IF (et # SymTab.InvalidType)
  3170. AND (SymTab.ClassOf(et) =
  3171. SymTab.ClSet) THEN
  3172. t := et;
  3173. QbeGen.CopyOp("@", q)
  3174. ELSE SemError(230);
  3175. t := SymTab.InvalidType;
  3176. QbeGen.CopyOp("0", q)
  3177. END; .)
  3178. | ( "MIN" (. isMax := FALSE; .)
  3179. | "MAX" (. isMax := TRUE; .) )
  3180. "(" Design<dt, dk, qd, qn, sfx> ")"
  3181. (. astNode := AST.MakeNode(AST.NkCall);
  3182. IF isMax THEN AST.SetChild(astNode, 0,
  3183. AST.MakeLeaf(AST.NkIdent, "MAX"))
  3184. ELSE AST.SetChild(astNode, 0,
  3185. AST.MakeLeaf(AST.NkIdent, "MIN")) END;
  3186. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3187. astCur := astNode; astIsLit := TRUE;
  3188. IF (dt # SymTab.InvalidType)
  3189. AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
  3190. (* REAL/LONGREAL: the
  3191. implementation bounds *)
  3192. IF isMax THEN
  3193. QbeGen.NormReal(
  3194. "3.402823e38", q)
  3195. ELSE QbeGen.NormReal(
  3196. "-3.402823e38", q)
  3197. END;
  3198. t := SymTab.RealType()
  3199. ELSIF (dt #
  3200. SymTab.InvalidType)
  3201. AND (SymTab.ClassOf(dt) =
  3202. SymTab.ClLong) THEN
  3203. IF isMax THEN
  3204. QbeGen.CopyOp(
  3205. "9223372036854775807", q)
  3206. ELSE QbeGen.CopyOp(
  3207. "-9223372036854775808", q)
  3208. END;
  3209. t := SymTab.LongType()
  3210. ELSIF SymTab.TypeBounds(dt, lo,
  3211. hi) THEN
  3212. IF isMax THEN
  3213. QbeGen.IntStr(hi, q)
  3214. ELSE QbeGen.IntStr(lo, q)
  3215. END;
  3216. t := SymTab.IntType()
  3217. ELSE SemError(230);
  3218. t := SymTab.InvalidType;
  3219. QbeGen.CopyOp("0", q)
  3220. END; .)
  3221. | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
  3222. (. astNode := AST.MakeNode(AST.NkCall);
  3223. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
  3224. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3225. astCur := astNode; astIsLit := TRUE; .)
  3226. (. IF dt = SymTab.InvalidType THEN
  3227. t := SymTab.InvalidType;
  3228. QbeGen.CopyOp("0", q)
  3229. ELSE
  3230. IF sfx
  3231. OR (dk = SymTab.KindVar)
  3232. OR (dk = SymTab.KindParam) THEN
  3233. QbeGen.CopyOp("@", q)
  3234. ELSE SemError(230);
  3235. QbeGen.CopyOp("0", q)
  3236. END;
  3237. t := SymTab.AddrType()
  3238. END; .)
  3239. | "CHR" "(" Expr<et, q> ")"
  3240. (. astNode := AST.MakeNode(AST.NkCall);
  3241. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
  3242. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3243. astCur := astNode; astIsLit := TRUE; .)
  3244. (. IF (et # SymTab.InvalidType)
  3245. AND NOT SymTab.IsIntFamily(et) THEN
  3246. SemError(211) END;
  3247. t := SymTab.CharType(); .)
  3248. | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
  3249. (. astNode := AST.MakeNode(AST.NkCall);
  3250. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
  3251. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3252. astCur := astNode; astIsLit := TRUE; .)
  3253. (. IF et # SymTab.InvalidType THEN
  3254. IF (SymTab.ClassOf(et) #
  3255. SymTab.ClChar)
  3256. AND (SymTab.ClassOf(et) #
  3257. SymTab.ClBool)
  3258. AND (SymTab.ClassOf(et) #
  3259. SymTab.ClEnum)
  3260. AND NOT SymTab.IsIntFamily(et) THEN
  3261. SemError(211) END
  3262. END;
  3263. t := SymTab.IntType(); .)
  3264. | "CAP" "(" Expr<et, q> ")"
  3265. (. astNode := AST.MakeNode(AST.NkCall);
  3266. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
  3267. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3268. astCur := astNode; astIsLit := TRUE; .)
  3269. (. QbeGen.CopyOp("@", q);
  3270. t := SymTab.CharType(); .)
  3271. | "UCHR" "(" Expr<et, q> ")"
  3272. (. astNode := AST.MakeNode(AST.NkCall);
  3273. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
  3274. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3275. astCur := astNode; astIsLit := TRUE; .)
  3276. (. (* UCHR: the UCHAR constructor.
  3277. CHAR -> UCHAR (identity);
  3278. INTEGER familly -> UCHAR
  3279. (codepoint value). *)
  3280. IF (et # SymTab.InvalidType)
  3281. AND (SymTab.ClassOf(et) # SymTab.ClChar)
  3282. AND NOT SymTab.IsIntFamily(et) THEN
  3283. SemError(211) END;
  3284. t := SymTab.UCharType(); .)
  3285. | "CHR8" "(" Expr<et, q> ")"
  3286. (. astNode := AST.MakeNode(AST.NkCall);
  3287. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
  3288. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3289. astCur := astNode; astIsLit := TRUE; .)
  3290. (. IF (et # SymTab.InvalidType)
  3291. AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
  3292. SemError(211) END;
  3293. t := SymTab.CharType(); .)
  3294. | "UORD" "(" Expr<et, q> ")"
  3295. (. astNode := AST.MakeNode(AST.NkCall);
  3296. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
  3297. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3298. astCur := astNode; astIsLit := TRUE; .)
  3299. (. (* UORD(u): the codepoint as a
  3300. 32-bit ordinal (INTEGER),
  3301. cf. ORD for CHAR. *)
  3302. IF (et # SymTab.InvalidType)
  3303. AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
  3304. SemError(211) END;
  3305. t := SymTab.IntType(); .)
  3306. | "ABS" "(" Expr<et, q> ")"
  3307. (. astNode := AST.MakeNode(AST.NkCall);
  3308. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
  3309. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3310. astCur := astNode; astIsLit := TRUE; .)
  3311. (. IF (et # SymTab.InvalidType)
  3312. AND NOT SymTab.IsIntFamily(et)
  3313. AND (SymTab.ClassOf(et) #
  3314. SymTab.ClReal) THEN
  3315. SemError(211)
  3316. ELSE QbeGen.CopyOp("@", q)
  3317. END;
  3318. t := et; .)
  3319. | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
  3320. (. astNode := AST.MakeNode(AST.NkCall);
  3321. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
  3322. IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
  3323. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
  3324. astCur := astNode; astIsLit := TRUE; .)
  3325. (. IF NOT SymTab.Lookup(vn) THEN
  3326. SemError(201);
  3327. t := SymTab.InvalidType
  3328. ELSE vt := SymTab.SymType(vn);
  3329. IF vt = SymTab.InvalidType THEN
  3330. t := SymTab.InvalidType
  3331. ELSIF et =
  3332. SymTab.InvalidType THEN
  3333. t := vt
  3334. ELSE
  3335. c1 := SymTab.ClassOf(et);
  3336. c2 := SymTab.ClassOf(vt);
  3337. IF (c1 = SymTab.ClInt)
  3338. AND (c2 = SymTab.ClLong) THEN
  3339. QbeGen.WidenLong(q, qa);
  3340. QbeGen.CopyOp(qa, q);
  3341. t := vt
  3342. ELSIF (c1 = SymTab.ClLong)
  3343. AND (c2 = SymTab.ClInt) THEN
  3344. QbeGen.NarrowLong(q, qa);
  3345. QbeGen.CopyOp(qa, q);
  3346. t := vt
  3347. ELSIF (c1 = SymTab.ClInt)
  3348. AND (c2 = SymTab.ClReal) THEN
  3349. QbeGen.ConvIR(q, qa);
  3350. QbeGen.CopyOp(qa, q);
  3351. t := vt
  3352. ELSIF (c1 = SymTab.ClLong)
  3353. AND (c2 = SymTab.ClReal) THEN
  3354. QbeGen.ConvLR(q, qa);
  3355. QbeGen.CopyOp(qa, q);
  3356. t := vt
  3357. ELSIF (c1 = SymTab.ClReal)
  3358. AND (c2 = SymTab.ClInt) THEN
  3359. QbeGen.ConvRI(q, qa);
  3360. QbeGen.CopyOp(qa, q);
  3361. t := vt
  3362. ELSIF (c1 = SymTab.ClReal)
  3363. AND (c2 = SymTab.ClLong) THEN
  3364. QbeGen.ConvRL(q, qa);
  3365. QbeGen.CopyOp(qa, q);
  3366. t := vt
  3367. ELSIF ((c1 = SymTab.ClInt)
  3368. OR (c1 =
  3369. SymTab.ClChar)
  3370. OR (c1 =
  3371. SymTab.ClBool)
  3372. OR (c1 =
  3373. SymTab.ClEnum))
  3374. AND ((c2 = SymTab.ClInt)
  3375. OR (c2 =
  3376. SymTab.ClChar)
  3377. OR (c2 =
  3378. SymTab.ClBool)
  3379. OR (c2 =
  3380. SymTab.ClEnum)) THEN
  3381. t := vt
  3382. ELSIF (c1 = SymTab.ClPtr)
  3383. AND (c2 = SymTab.ClPtr) THEN
  3384. t := vt
  3385. ELSIF (c1 = SymTab.ClReal)
  3386. AND (c2 = SymTab.ClReal) THEN
  3387. t := vt
  3388. ELSE SemError(230);
  3389. t := SymTab.InvalidType
  3390. END
  3391. END
  3392. END; .)
  3393. | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
  3394. | SetLit<st, sq> (. astIsLit := TRUE; t := st;
  3395. QbeGen.CopyOp(sq, q); .)
  3396. | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
  3397. IF SymTab.BoolCheck(t2) THEN
  3398. t := SymTab.BoolType()
  3399. ELSE SemError(212);
  3400. t := SymTab.InvalidType END;
  3401. IF t # SymTab.InvalidType THEN
  3402. QbeGen.CopyOp("@", q)
  3403. ELSE QbeGen.CopyOp("0", q)
  3404. END;
  3405. astIsLit := TRUE;
  3406. astCur := AST.MakeUn(
  3407. AST.NkUnary, AST.OpNot, astNot); .)
  3408. )
  3409. (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
  3410. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  3411. (* Set literals are SET OF [0..255] (8 words); elements validated
  3412. 0..255 statically when foldable (222 otherwise), runtime trap
  3413. for computed elements. Ranges always lower via SetRange. *)
  3414. SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  3415. (. VAR astNode: AST.Node; .)
  3416. = "{" (. t := SymTab.NewSet(
  3417. SymTab.NewSubR(0, 255));
  3418. astNode := AST.MakeNode(AST.NkSetLit);
  3419. QbeGen.NewSetTemp(8, q);
  3420. QbeGen.SetZero(q, 8); .)
  3421. [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
  3422. "}" (. astCur := astNode; .) .
  3423. (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
  3424. or ArrayName{...} (an array constructor, GNU Modula-2). The
  3425. declared type sets the width (set) or element type (array). *)
  3426. TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  3427. (. VAR nw: CARDINAL;
  3428. astNode, astTail: AST.Node;
  3429. savedCls: INTEGER; .)
  3430. = "{" (. savedCls := braceCls;
  3431. astNode := AST.MakeNode(AST.NkBraceLit);
  3432. AST.SetTy(astNode, vt);
  3433. astTail := astNode;
  3434. IF vt = SymTab.InvalidType THEN
  3435. braceCls := -1
  3436. ELSE braceCls :=
  3437. SymTab.ClassOf(vt)
  3438. END;
  3439. IF braceCls = SymTab.ClSet THEN
  3440. IF vt = SymTab.InvalidType THEN
  3441. nw := 8
  3442. ELSE nw := SymTab.SetWords(vt);
  3443. IF nw = 0 THEN nw := 8 END
  3444. END;
  3445. QbeGen.NewSetTemp(nw, q);
  3446. QbeGen.SetZero(q, nw)
  3447. ELSIF (braceCls =
  3448. SymTab.ClArray)
  3449. OR (braceCls =
  3450. SymTab.ClRecord)
  3451. OR (braceCls =
  3452. SymTab.ClClass) THEN
  3453. QbeGen.CtorBegin(vt)
  3454. ELSE
  3455. IF vt # SymTab.InvalidType THEN
  3456. SemError(230) END;
  3457. braceCls := -1
  3458. END; .)
  3459. [ BraceElem<vt, q, astNode, astTail>
  3460. { "," BraceElem<vt, q, astNode, astTail> } ]
  3461. "}" (. IF (braceCls = SymTab.ClArray)
  3462. OR (braceCls =
  3463. SymTab.ClRecord)
  3464. OR (braceCls =
  3465. SymTab.ClClass) THEN
  3466. QbeGen.CtorEnd(q)
  3467. ELSIF braceCls # SymTab.ClSet THEN
  3468. QbeGen.CopyOp("0", q)
  3469. END;
  3470. braceCls := savedCls; .)
  3471. (. astCur := astNode; .) .
  3472. BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
  3473. VAR node, tail: AST.Node>
  3474. (. VAR et, et2: SymTab.TypeIndex;
  3475. qe, q2: QbeGen.QVal;
  3476. v, v2, reps, k: INTEGER;
  3477. elem: SymTab.TypeIndex;
  3478. lo: INTEGER;
  3479. span: CARDINAL;
  3480. cl, cl2: INTEGER;
  3481. hasR, hasB: BOOLEAN;
  3482. astEl: AST.Node; .)
  3483. = (. hasR := FALSE; hasB := FALSE;
  3484. reps := 1; .)
  3485. Expr<et, qe> (. astEl := astCur; .)
  3486. [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
  3487. AST.NkSubrange, 0, astEl, astCur);
  3488. hasR := TRUE; .) ]
  3489. [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
  3490. (. IF braceCls = SymTab.ClSet THEN
  3491. IF hasB THEN SemError(230) END;
  3492. lo := SymTab.SetBaseLo(vt);
  3493. span := SymTab.SetCount(vt);
  3494. IF (et = SymTab.InvalidType)
  3495. OR (hasR AND (et2 =
  3496. SymTab.InvalidType)) THEN
  3497. ELSE cl :=
  3498. SymTab.ClassOf(et);
  3499. IF hasR THEN
  3500. cl2 :=
  3501. SymTab.ClassOf(et2)
  3502. ELSE cl2 := SymTab.ClInt
  3503. END;
  3504. IF NOT SymTab.SetElemClassOk(cl)
  3505. OR (hasR AND NOT
  3506. SymTab.SetElemClassOk(cl2))
  3507. THEN
  3508. SemError(222)
  3509. ELSIF hasR
  3510. AND SymTab.ConstInt(qe, v)
  3511. AND SymTab.ConstInt(q2,
  3512. v2)
  3513. AND ((v < lo)
  3514. OR (v2 < lo)
  3515. OR (v >= lo +
  3516. VAL(INTEGER, span))
  3517. OR (v2 >= lo +
  3518. VAL(INTEGER, span))
  3519. OR (v > v2)) THEN
  3520. SemError(222)
  3521. ELSIF hasR THEN
  3522. QbeGen.SetRange(sq, qe, q2,
  3523. lo, span)
  3524. ELSIF SymTab.ConstInt(qe,
  3525. v)
  3526. AND ((v < lo)
  3527. OR (v >= lo +
  3528. VAL(INTEGER,
  3529. span))) THEN
  3530. SemError(222)
  3531. ELSE QbeGen.SetBit(sq, qe,
  3532. lo, span)
  3533. END
  3534. END
  3535. ELSIF (braceCls = SymTab.ClArray)
  3536. OR (braceCls =
  3537. SymTab.ClRecord)
  3538. OR (braceCls =
  3539. SymTab.ClClass) THEN
  3540. IF hasR THEN SemError(230) END;
  3541. reps := 1;
  3542. IF hasB THEN
  3543. IF SymTab.ConstInt(q2, v2)
  3544. AND (v2 >= 1) THEN
  3545. reps := v2
  3546. ELSE SemError(230)
  3547. END
  3548. END;
  3549. k := 0;
  3550. WHILE k < reps DO
  3551. QbeGen.CtorElem(qe);
  3552. INC(k)
  3553. END
  3554. END; .)
  3555. (. (* the BY form repeats the
  3556. element; keep the AST in
  3557. step with CtorElem *)
  3558. k := 0;
  3559. WHILE k < reps DO
  3560. AstAppend(AST.NkBlock,
  3561. node, tail, astEl);
  3562. INC(k)
  3563. END; .) .
  3564. SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
  3565. qe, q2: QbeGen.QVal;
  3566. v, v2: INTEGER;
  3567. lo: INTEGER;
  3568. span: CARDINAL;
  3569. cl, cl2: INTEGER;
  3570. hasR: BOOLEAN;
  3571. astEl: AST.Node; .)
  3572. = (. hasR := FALSE; .)
  3573. Expr<et, qe> (. astEl := astCur; .)
  3574. [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
  3575. AST.NkSubrange, 0, astEl, astCur);
  3576. hasR := TRUE; .) ]
  3577. (. lo := SymTab.SetBaseLo(st);
  3578. span := SymTab.SetCount(st);
  3579. IF (et = SymTab.InvalidType)
  3580. OR (hasR AND (et2 =
  3581. SymTab.InvalidType)) THEN
  3582. ELSE cl :=
  3583. SymTab.ClassOf(et);
  3584. IF hasR THEN
  3585. cl2 :=
  3586. SymTab.ClassOf(et2)
  3587. ELSE cl2 := SymTab.ClInt
  3588. END;
  3589. IF NOT SymTab.SetElemClassOk(cl)
  3590. OR (hasR AND NOT
  3591. SymTab.SetElemClassOk(cl2))
  3592. THEN
  3593. SemError(222)
  3594. ELSIF hasR
  3595. AND SymTab.ConstInt(qe, v)
  3596. AND SymTab.ConstInt(q2,
  3597. v2)
  3598. AND ((v < lo)
  3599. OR (v2 < lo)
  3600. OR (v >= lo +
  3601. VAL(INTEGER, span))
  3602. OR (v2 >= lo +
  3603. VAL(INTEGER, span))
  3604. OR (v > v2)) THEN
  3605. SemError(222)
  3606. ELSIF hasR THEN
  3607. QbeGen.SetRange(sq, qe, q2,
  3608. lo, span)
  3609. ELSIF SymTab.ConstInt(qe,
  3610. v)
  3611. AND ((v < lo)
  3612. OR (v >= lo +
  3613. VAL(INTEGER,
  3614. span))) THEN
  3615. SemError(222)
  3616. ELSE QbeGen.SetBit(sq, qe,
  3617. lo, span)
  3618. END
  3619. END; .)
  3620. (. AST.SetChild(node,
  3621. AST.NChild(node), astEl); .) .
  3622. GetIdent<VAR n: SymTab.Name>
  3623. = ident (. LexName(n); .) .
  3624. END M2.