M2.lst 254 KB

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