M2.atg 270 KB

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