M2.lst 253 KB

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