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