M2.atg 229 KB

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