M2.atg 223 KB

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