M2.atg 228 KB

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