M2.lst 260 KB

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