M2.atg 267 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663
  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"
  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. = "SET" (. allowFwdType := FALSE; .)
  1514. "OF" Type<base, FALSE>
  1515. (. IF base = SymTab.InvalidType THEN
  1516. t := SymTab.InvalidType
  1517. ELSIF SymTab.Unresolved(base) THEN
  1518. (* an opaque/formal base: defer
  1519. the span check until the
  1520. base is completed *)
  1521. t := SymTab.NewSet(base)
  1522. ELSE bcls :=
  1523. SymTab.ClassOf(base);
  1524. (* a subrange keeps its own
  1525. span even when its base is
  1526. CHAR/BOOLEAN/an enum *)
  1527. IF SymTab.SubBounds(base,
  1528. blo, bhi) THEN
  1529. bspan := bhi - blo + 1
  1530. ELSIF bcls = SymTab.ClBool THEN
  1531. blo := 0; bspan := 2
  1532. ELSIF bcls = SymTab.ClChar THEN
  1533. blo := 0; bspan := 256
  1534. ELSIF bcls = SymTab.ClByte THEN
  1535. blo := 0; bspan := 256
  1536. ELSIF bcls = SymTab.ClSByte THEN
  1537. blo := -128; bspan := 256
  1538. ELSIF bcls = SymTab.ClWord16 THEN
  1539. blo := 0; bspan := 65536
  1540. ELSIF bcls = SymTab.ClSWord16 THEN
  1541. blo := -32768; bspan := 65536
  1542. ELSIF bcls = SymTab.ClEnum THEN
  1543. blo := 0;
  1544. bspan := VAL(INTEGER,
  1545. SymTab.EnumCount(base))
  1546. ELSE bspan := 0 END;
  1547. IF (bspan <= 0)
  1548. OR (bspan > 65536) THEN
  1549. SemError(230);
  1550. t := SymTab.InvalidType
  1551. ELSE t := SymTab.NewSet(base)
  1552. END
  1553. END; .) .
  1554. (* PACKEDSET: same base rules as SET, but 1/2/4-byte storage. V3
  1555. limits the span to 32 bits (SetBytes 1..4); wider packed sets are
  1556. an implementation limit (230). *)
  1557. PackSetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
  1558. blo, bhi, bspan: INTEGER;
  1559. bcls: INTEGER; .)
  1560. = "PACKEDSET" (. allowFwdType := FALSE; .)
  1561. "OF" Type<base, FALSE>
  1562. (. IF base = SymTab.InvalidType THEN
  1563. t := SymTab.InvalidType
  1564. ELSIF SymTab.Unresolved(base) THEN
  1565. t := SymTab.NewPackSet(base)
  1566. ELSE bcls :=
  1567. SymTab.ClassOf(base);
  1568. IF SymTab.SubBounds(base,
  1569. blo, bhi) THEN
  1570. bspan := bhi - blo + 1
  1571. ELSIF bcls = SymTab.ClBool THEN
  1572. blo := 0; bspan := 2
  1573. ELSIF bcls = SymTab.ClChar THEN
  1574. blo := 0; bspan := 256
  1575. ELSIF bcls = SymTab.ClByte THEN
  1576. blo := 0; bspan := 256
  1577. ELSIF bcls = SymTab.ClSByte THEN
  1578. blo := -128; bspan := 256
  1579. ELSIF bcls = SymTab.ClWord16 THEN
  1580. blo := 0; bspan := 65536
  1581. ELSIF bcls = SymTab.ClSWord16 THEN
  1582. blo := -32768; bspan := 65536
  1583. ELSIF bcls = SymTab.ClEnum THEN
  1584. blo := 0;
  1585. bspan := VAL(INTEGER,
  1586. SymTab.EnumCount(base))
  1587. ELSE bspan := 0 END;
  1588. IF (bspan <= 0)
  1589. OR (bspan > 32) THEN
  1590. SemError(230);
  1591. t := SymTab.InvalidType
  1592. ELSE t := SymTab.NewPackSet(base)
  1593. END
  1594. END; .) .
  1595. (* Records: flat blobs; array fields are pointers to static
  1596. descriptors (locked amendment), nested records inline. Field
  1597. offsets static and declaration-ordered. *)
  1598. (* Field list: plain fields and (optionally) one variant part. The
  1599. variant part is a `CASE ... END` item; because it starts with the
  1600. CASE keyword it is unambiguously distinguishable from a field
  1601. (which starts with an identifier). *)
  1602. RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
  1603. tagOk: BOOLEAN; .)
  1604. = "RECORD" (. allowFwdType := FALSE;
  1605. t := SymTab.NewRecord(); .)
  1606. [ RecItem<t> { ";" [ RecItem<t> ] } ]
  1607. "END" (. SymTab.LayoutRecord(t); .) .
  1608. RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
  1609. = RecField<rec>
  1610. | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
  1611. (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
  1612. an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
  1613. CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
  1614. tagN: SymTab.Name;
  1615. tagged: BOOLEAN; .)
  1616. = "CASE" (. SymTab.ResetFields(rec);
  1617. tagged := FALSE; .)
  1618. [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
  1619. tagN) THEN
  1620. SemError(200) END;
  1621. tagged := TRUE; .) ]
  1622. ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
  1623. AND NOT SymTab.IsOrdinal(tagT) THEN
  1624. SemError(224)
  1625. END;
  1626. IF tagged THEN
  1627. SymTab.FixPendingF(rec, tagT);
  1628. SymTab.SetVariantTag(rec, tagN)
  1629. END; .)
  1630. "OF"
  1631. RecFieldList<rec>
  1632. { "|" (. SymTab.ResetFields(rec); .)
  1633. RecFieldList<rec> }
  1634. [ "ELSE" ]
  1635. "END" .
  1636. (* A variant branch: `labels : fields` (fields and their trailing ";"
  1637. optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
  1638. tolerates). A branch may itself contain a nested variant CASE. *)
  1639. RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
  1640. lv1, lv2: QbeGen.QVal; .)
  1641. = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
  1642. { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
  1643. ":"
  1644. [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
  1645. | "ELSE" ) ] .
  1646. ArmField<rec: SymTab.TypeIndex>
  1647. = RecField<rec>
  1648. | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
  1649. (* Variant case label: a constant (or a constant range). Values are
  1650. not interpreted (the layout overlays regardless). *)
  1651. VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  1652. (. VAR lname: SymTab.Name; .)
  1653. = ( ident (. LexName(lname);
  1654. QbeGen.CopyOp("0", q);
  1655. t := SymTab.IntType(); .)
  1656. | integer (. LexString(lname);
  1657. QbeGen.CopyOp("0", q);
  1658. t := SymTab.IntType(); .)
  1659. | charConst (. LexString(lname);
  1660. QbeGen.CopyOp("0", q);
  1661. t := SymTab.CharType(); .) ) .
  1662. RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
  1663. t2: SymTab.TypeIndex; .)
  1664. = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
  1665. RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
  1666. = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
  1667. n) THEN
  1668. SemError(200) END; .)
  1669. { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
  1670. n) THEN
  1671. SemError(200) END; .) } .
  1672. TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
  1673. k: INTEGER;
  1674. dotted: BOOLEAN; .)
  1675. = GetIdent<n> (. dotted := FALSE;
  1676. IF NOT SymTab.Lookup(n) THEN
  1677. (* declaration before use: an
  1678. undeclared type is 201,
  1679. except as a POINTER's base
  1680. (allowFwdType) *)
  1681. k := -1;
  1682. IF allowFwdType THEN
  1683. t := SymTab.ForwardType(n)
  1684. ELSE t := SymTab.InvalidType
  1685. END;
  1686. IF t = SymTab.InvalidType THEN
  1687. SemError(201)
  1688. END
  1689. ELSE k := SymTab.SymKind(n);
  1690. IF (k = SymTab.KindType)
  1691. OR (k = SymTab.KindPredef) THEN
  1692. t := SymTab.SymType(n)
  1693. ELSE t := SymTab.InvalidType
  1694. END
  1695. END; .)
  1696. [ "." GetIdent<qid> (. dotted := TRUE;
  1697. IF k = SymTab.KindModule THEN
  1698. t := SymTab.QualType(n, qid);
  1699. IF t = SymTab.InvalidType THEN
  1700. SemError(201)
  1701. END
  1702. ELSE SemError(221);
  1703. t := SymTab.InvalidType
  1704. END; .) ]
  1705. (. IF NOT dotted THEN
  1706. IF (k = SymTab.KindModule)
  1707. OR ((k # SymTab.KindType)
  1708. AND (k # SymTab.KindPredef)
  1709. AND (k # SymTab.KindImport)
  1710. AND (k # -1)) THEN
  1711. SemError(221)
  1712. END
  1713. END; .) .
  1714. Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
  1715. qlo, qhi: QbeGen.QVal;
  1716. lo, hi: INTEGER; .)
  1717. = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
  1718. (. IF (tlo = SymTab.InvalidType)
  1719. OR (thi = SymTab.InvalidType) THEN
  1720. t := SymTab.InvalidType
  1721. ELSIF NOT SymTab.IsOrdinal(tlo)
  1722. OR NOT SymTab.IsOrdinal(thi) THEN
  1723. SemError(230);
  1724. t := SymTab.InvalidType
  1725. ELSIF NOT SymTab.ConstInt(qlo, lo)
  1726. OR NOT SymTab.ConstInt(qhi, hi)
  1727. OR (lo > hi) THEN
  1728. SemError(230);
  1729. t := SymTab.InvalidType
  1730. ELSE IF SymTab.SameType(tlo, thi) THEN
  1731. (* keep the base type: ['A'..'Z']
  1732. is character, [red..blue]
  1733. that enumeration *)
  1734. t := SymTab.NewSubB(lo, hi, tlo)
  1735. ELSE t := SymTab.NewSubR(lo, hi)
  1736. END
  1737. END; .)
  1738. "]" .
  1739. Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
  1740. ord: INTEGER;
  1741. qv: QbeGen.QVal; .)
  1742. = "(" (. t := SymTab.NewEnum();
  1743. ord := 0; .)
  1744. GetIdent<n> (. IF NOT SymTab.Enter(n,
  1745. SymTab.KindConst) THEN
  1746. SemError(200) END;
  1747. SymTab.SetSymType(n, t);
  1748. QbeGen.IntStr(ord, qv);
  1749. SymTab.SetSymVal(n, qv);
  1750. SymTab.NoteEnumLit(t, n);
  1751. Lower.NoteVar(n,
  1752. SymTab.KindConst, t);
  1753. Lower.NoteConstVal(qv);
  1754. INC(ord); .)
  1755. { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
  1756. SymTab.KindConst) THEN
  1757. SemError(200) END;
  1758. SymTab.SetSymType(n, t);
  1759. QbeGen.IntStr(ord, qv);
  1760. SymTab.SetSymVal(n, qv);
  1761. SymTab.NoteEnumLit(t, n);
  1762. Lower.NoteVar(n,
  1763. SymTab.KindConst, t);
  1764. Lower.NoteConstVal(qv);
  1765. INC(ord); .) }
  1766. ")" (. SymTab.SetEnumCount(t,
  1767. VAL(CARDINAL, ord)); .) .
  1768. (* Clarion-form classes (docs/OOP.txt): declaration + single
  1769. inheritance + IMPLEMENTATION blocks. Scopes and member checks
  1770. now; lowering (vtable, dispatch, THIS) later — one 230 per
  1771. class/impl block. Methods end with ";" per the Table example
  1772. (not "," as in the sketch). No underscores in identifiers. *)
  1773. (* Single CLASS item in both loops: separating declaration from
  1774. IMPLEMENTATION at the loop level needs 2-token lookahead
  1775. (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
  1776. The second token decides after CLASS is consumed. A misplaced
  1777. CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
  1778. whole unit ends 230 until lowering). *)
  1779. ClassItem
  1780. = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
  1781. ClassRest (. VAR cn, m2, pn: SymTab.Name;
  1782. ct: SymTab.TypeIndex; .)
  1783. = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
  1784. SymTab.KindType) THEN
  1785. SemError(200) END;
  1786. ct := SymTab.NewClass();
  1787. SymTab.SetSymType(cn, ct);
  1788. SymTab.PushClassScope(ct);
  1789. astCls := AST.MakeNode(AST.NkClassDecl);
  1790. AST.SetChild(astCls, 0,
  1791. AST.MakeLeaf(AST.NkIdent, cn));
  1792. astClsP := AST.NoNode;
  1793. astClsPTail := AST.NoNode;
  1794. astClsF := AST.NoNode;
  1795. astClsFTail := AST.NoNode;
  1796. astClsM := AST.NoNode;
  1797. astClsMTail := AST.NoNode; .)
  1798. [ Parents<ct> ]
  1799. ";"
  1800. { ClassField<ct> ";" }
  1801. { MethodHeading<pn, SymTab.InvalidType> ";"
  1802. (. Lower.ScopeLeave;
  1803. SymTab.CloseProc;
  1804. QbeGen.AbortFunc; .) }
  1805. "END"
  1806. GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
  1807. SemError(202) END;
  1808. SymTab.LayoutClass(ct);
  1809. SymTab.PopScope;
  1810. AST.SetChild(astCls, 1, astClsP);
  1811. AST.SetChild(astCls, 2, astClsF);
  1812. AST.SetChild(astCls, 3, astClsM);
  1813. astDecl := astCls; .) .
  1814. Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
  1815. = "(" Parent1<ct>
  1816. { "," GetIdent<p> (. SemError(230); .) }
  1817. ")" .
  1818. Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
  1819. pt: SymTab.TypeIndex; .)
  1820. = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
  1821. SemError(201)
  1822. ELSE pt := SymTab.SymType(p);
  1823. IF SymTab.ClassOf(pt) #
  1824. SymTab.ClClass THEN
  1825. SemError(230)
  1826. ELSE SymTab.SetParent(ct, pt)
  1827. END
  1828. END;
  1829. AstAppend(AST.NkFieldDecl,
  1830. astClsP, astClsPTail,
  1831. AST.MakeLeaf(AST.NkIdent, p)); .) .
  1832. ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
  1833. t: SymTab.TypeIndex;
  1834. astNode: AST.Node; .)
  1835. = GetIdent<n>
  1836. ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
  1837. SymTab.KindConst) THEN
  1838. SemError(200) END;
  1839. astNode := AST.MakeNode(AST.NkConstDecl);
  1840. AST.SetChild(astNode, 0,
  1841. AST.MakeLeaf(AST.NkIdent, n));
  1842. AST.SetChild(astNode, 1,
  1843. AST.MakeLeaf(AST.NkIdent, rhs));
  1844. AstAppend(AST.NkFieldDecl,
  1845. astClsF, astClsFTail, astNode);
  1846. IF SymTab.Lookup(rhs) THEN
  1847. SymTab.SetSymType(n,
  1848. SymTab.SymType(rhs))
  1849. END; .)
  1850. | (. IF NOT SymTab.FieldPending(ct,
  1851. n) THEN
  1852. SemError(200) END;
  1853. astNode := AST.MakeNode(AST.NkVarDecl);
  1854. AST.SetChild(astNode, 0,
  1855. AST.MakeLeaf(AST.NkIdent, n)); .)
  1856. { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
  1857. n) THEN
  1858. SemError(200) END;
  1859. AST.SetChild(astNode,
  1860. AST.NChild(astNode),
  1861. AST.MakeLeaf(AST.NkIdent, n)); .) }
  1862. ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
  1863. AST.SetTy(astNode, t);
  1864. AstAppend(AST.NkFieldDecl,
  1865. astClsF, astClsFTail, astNode); .) ) .
  1866. MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
  1867. (. VAR wantVirt: BOOLEAN; .)
  1868. = (. wantVirt := FALSE; .)
  1869. [ "VIRTUAL" (. wantVirt := TRUE; .) ]
  1870. ProcHeading<pn, ct> (. IF wantVirt THEN
  1871. SymTab.MarkVirtual END;
  1872. astMethod := AST.MakeNode(AST.NkProcDecl);
  1873. AST.SetChild(astMethod, 0,
  1874. AST.MakeLeaf(AST.NkIdent, pn));
  1875. IF wantVirt THEN
  1876. AST.SetOp(astMethod, 3)
  1877. ELSE AST.SetOp(astMethod, 0)
  1878. END;
  1879. AstAppend(AST.NkFieldDecl,
  1880. astClsM, astClsMTail, astMethod); .) .
  1881. ClassImplRest (. VAR cn, m2: SymTab.Name;
  1882. ct: SymTab.TypeIndex;
  1883. astBody, astHandler: AST.Node;
  1884. astFinallyBody, astFinallyHandler:
  1885. AST.Node;
  1886. hasExcept, hasFinally: BOOLEAN; .)
  1887. = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
  1888. SemError(201);
  1889. ct := SymTab.InvalidType
  1890. ELSE ct := SymTab.SymType(cn);
  1891. IF SymTab.ClassOf(ct) #
  1892. SymTab.ClClass THEN
  1893. SemError(230);
  1894. ct := SymTab.InvalidType
  1895. END
  1896. END;
  1897. astCls := AST.MakeNode(AST.NkClassDecl);
  1898. AST.SetOp(astCls, 1);
  1899. AST.SetChild(astCls, 0,
  1900. AST.MakeLeaf(AST.NkIdent, cn));
  1901. astClsM := AST.NoNode;
  1902. astClsMTail := AST.NoNode;
  1903. astStmt := AST.NoNode;
  1904. inHandler := FALSE;
  1905. astHandler := AST.NoNode;
  1906. astFinallyBody := AST.NoNode;
  1907. astFinallyHandler := AST.NoNode;
  1908. hasExcept := FALSE;
  1909. hasFinally := FALSE;
  1910. IF ct #
  1911. SymTab.InvalidType THEN
  1912. IF NOT SymTab.PushClassMembers(
  1913. ct) THEN
  1914. SemError(230) END;
  1915. SymTab.PushImplClass(ct)
  1916. END; .)
  1917. ";" { MethodImpl<ct> ";" }
  1918. (. astStmt := AST.NoNode; .)
  1919. [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
  1920. .)
  1921. [ StatSeq ] ]
  1922. (. astBody := astStmt; .)
  1923. [ "EXCEPT" (. hasExcept := TRUE;
  1924. inHandler := TRUE; .)
  1925. [ StatSeq ] (. astHandler := astStmt;
  1926. inHandler := FALSE .) ]
  1927. [ "FINALLY" (. hasFinally := TRUE;
  1928. inHandler := FALSE; .)
  1929. [ StatSeq ] (. astFinallyBody := astStmt; .)
  1930. [ "EXCEPT" (. inHandler := TRUE; .)
  1931. [ StatSeq ] (. astFinallyHandler := astStmt;
  1932. inHandler := FALSE .) ] ]
  1933. "END"
  1934. GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
  1935. SemError(202) END;
  1936. SymTab.PopImplClass;
  1937. SymTab.PopScope;
  1938. astStmt := MakeModuleBody(astBody,
  1939. astHandler, astFinallyBody,
  1940. astFinallyHandler,
  1941. hasExcept, hasFinally);
  1942. AST.SetChild(astCls, 1, AST.NoNode);
  1943. AST.SetChild(astCls, 2, astStmt);
  1944. AST.SetChild(astCls, 3, astClsM);
  1945. astDecl := astCls; .) .
  1946. MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
  1947. thisQ: QbeGen.QVal;
  1948. methRes: SymTab.TypeIndex; .)
  1949. = MethodHeading<pn, ct> ";"
  1950. (. IF (ct #
  1951. SymTab.InvalidType)
  1952. AND NOT SymTab.MethodExists(ct,
  1953. pn) THEN
  1954. SemError(201) END; .)
  1955. ( "FORWARD" (. AST.SetOp(astMethod, 1);
  1956. SymTab.MarkFwd;
  1957. QbeGen.AbortFunc;
  1958. Lower.ScopeLeave;
  1959. SymTab.CloseProc; .)
  1960. | (.
  1961. (* bind the receiver: bare
  1962. field names resolve
  1963. against THIS *)
  1964. QbeGen.CopyOp("@", thisQ);
  1965. QbeGen.PushWith(thisQ); .)
  1966. Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
  1967. AST.SetChild(astMethod, 2, astBlkDecls);
  1968. QbeGen.PopWith;
  1969. methRes := SymTab.CurRes();
  1970. Lower.ScopeLeave;
  1971. SymTab.CloseProc;
  1972. QbeGen.EndFunc(methRes); .) ) .
  1973. ConstBlock (. VAR astSeq, astTail: AST.Node; .)
  1974. = "CONST" (. astSeq := AST.NoNode;
  1975. astTail := AST.NoNode; .)
  1976. { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
  1977. astSeq, astTail, astDecl); .) }
  1978. (. astDecl := astSeq; .) .
  1979. ConstDecl (. VAR n: SymTab.Name;
  1980. t: SymTab.TypeIndex;
  1981. qv: QbeGen.QVal;
  1982. cls: INTEGER;
  1983. mk: ARRAY [0 .. 15] OF CARDINAL;
  1984. mw: CARDINAL;
  1985. mlo: INTEGER;
  1986. astNode: AST.Node; .)
  1987. = GetIdent<n> (. IF NOT SymTab.Enter(n,
  1988. SymTab.KindConst) THEN
  1989. SemError(200) END; .)
  1990. "="
  1991. Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
  1992. AST.SetChild(astNode, 0,
  1993. AST.MakeLeaf(AST.NkIdent, n));
  1994. AST.SetChild(astNode, 1, astCur);
  1995. AST.SetTy(astNode, t);
  1996. astDecl := astNode;
  1997. Lower.NoteVar(n, SymTab.KindConst, t);
  1998. Lower.NoteConstVal(qv);
  1999. SymTab.SetSymType(n, t);
  2000. cls := SymTab.ClassOf(t);
  2001. IF cls = SymTab.ClSet THEN
  2002. (* a SET CONST needs static
  2003. data: fold its mask now
  2004. (the grammar sees the
  2005. element values) and let
  2006. Lower re-emit it *)
  2007. IF Lower.SetConstMaskOf(
  2008. AST.Child(astNode, 1),
  2009. mk, mw, mlo) THEN
  2010. Lower.NoteSetMask(n, mk, mw,
  2011. mlo);
  2012. SymTab.SetSymVal(n, qv)
  2013. ELSE
  2014. SemError(230)
  2015. END
  2016. ELSIF (cls = SymTab.ClArray)
  2017. OR (cls = SymTab.ClRecord)
  2018. OR (cls = SymTab.ClClass)
  2019. OR (cls = SymTab.ClStr)
  2020. OR (cls = SymTab.ClUStr) THEN
  2021. (* an aggregate/string
  2022. constant: qv is its
  2023. descriptor address; no
  2024. scalar data *)
  2025. SymTab.SetSymVal(n, qv)
  2026. ELSIF NOT QbeGen.IsImm(qv) THEN
  2027. SemError(230)
  2028. ELSE
  2029. SymTab.SetSymVal(n, qv);
  2030. END; .) .
  2031. VarBlock (. VAR astSeq, astTail: AST.Node; .)
  2032. = "VAR" (. astSeq := AST.NoNode;
  2033. astTail := AST.NoNode; .)
  2034. { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
  2035. astSeq, astTail, astDecl); .) }
  2036. (. astDecl := astSeq; .) .
  2037. VarDecl (. VAR nm: SymTab.Name;
  2038. t: SymTab.TypeIndex;
  2039. i: CARDINAL;
  2040. cls: INTEGER;
  2041. astNode, astTail: AST.Node; .)
  2042. = VarIdents ":"
  2043. Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
  2044. astTail := astNode;
  2045. i := 0;
  2046. WHILE i < SymTab.PendCount() DO
  2047. SymTab.PendName(i, nm);
  2048. Lower.NoteVar(nm, SymTab.KindVar, t);
  2049. (* chunked: a VAR list can
  2050. exceed AST.MaxChild *)
  2051. AstAppend(AST.NkBlock,
  2052. astNode, astTail,
  2053. AST.MakeLeaf(AST.NkIdent, nm));
  2054. INC(i)
  2055. END;
  2056. AST.SetTy(astNode, t);
  2057. astDecl := astNode;
  2058. cls := SymTab.ClassOf(t);
  2059. IF (t # SymTab.InvalidType)
  2060. AND NOT SymTab.IsUnresolved(t)
  2061. AND (cls # SymTab.ClInt)
  2062. AND (cls # SymTab.ClBool)
  2063. AND (cls # SymTab.ClChar)
  2064. AND (cls # SymTab.ClReal)
  2065. AND (cls # SymTab.ClArray)
  2066. AND (cls # SymTab.ClSet)
  2067. AND (cls # SymTab.ClRecord)
  2068. AND (cls # SymTab.ClPtr)
  2069. AND (cls # SymTab.ClLong)
  2070. AND (cls # SymTab.ClProc)
  2071. AND (cls # SymTab.ClUChar)
  2072. AND (cls # SymTab.ClUStr)
  2073. AND (cls # SymTab.ClEnum)
  2074. AND (cls # SymTab.ClByte)
  2075. AND (cls # SymTab.ClSByte)
  2076. AND (cls # SymTab.ClWord16)
  2077. AND (cls # SymTab.ClSWord16)
  2078. AND (cls # SymTab.ClClass) THEN
  2079. SemError(230) END;
  2080. IF QbeGen.LocFull() THEN
  2081. SemError(233) END;
  2082. i := 0;
  2083. IF SymTab.IsUnresolved(t)
  2084. AND NOT SymTab.InProc() THEN
  2085. (* a forward-typed global:
  2086. defer emission until the
  2087. TYPE block completes *)
  2088. AST.SetOp(astNode, 1);
  2089. WHILE i < SymTab.PendCount() DO
  2090. SymTab.PendName(i, nm);
  2091. IF nPendVar <=
  2092. HIGH(pendVarName) THEN
  2093. pendVarName[nPendVar] := nm;
  2094. pendVarT[nPendVar] := t;
  2095. INC(nPendVar)
  2096. END;
  2097. INC(i)
  2098. END
  2099. ELSE
  2100. WHILE i < SymTab.PendCount() DO
  2101. SymTab.PendName(i, nm);
  2102. INC(i)
  2103. END
  2104. END;
  2105. (* a plain VAR list, not a
  2106. heading: the signature
  2107. result is discarded *)
  2108. IF NOT SymTab.FixPending(t) THEN
  2109. END; .) .
  2110. VarIdents (. VAR n: SymTab.Name; .)
  2111. = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
  2112. SymTab.KindVar) THEN
  2113. SemError(200) END; .)
  2114. { ","
  2115. GetIdent<n> (. IF NOT SymTab.EnterPending(n,
  2116. SymTab.KindVar) THEN
  2117. SemError(200) END; .) } .
  2118. ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
  2119. = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
  2120. SemError(200) END; .)
  2121. { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
  2122. SemError(200) END; .) } .
  2123. (* Procedure headings enter scopes/params/result and buffer the
  2124. QBE header; bodies lower to functions (4.1, module level only).
  2125. FORWARD marks; the body heading re-enters (signature compare
  2126. deferred). Nested procedures parse + check, lowering = 4.2. *)
  2127. (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
  2128. __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
  2129. annotate C built-ins; V3 parses and ignores them. *)
  2130. ProcPragma
  2131. = "__BUILTIN__"
  2132. | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
  2133. ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
  2134. (. VAR t: SymTab.TypeIndex;
  2135. mg: QbeGen.QVal; .)
  2136. = "PROCEDURE"
  2137. [ ProcPragma ]
  2138. GetIdent<pn> (. IF methCls #
  2139. SymTab.InvalidType THEN
  2140. (* a method: resume the
  2141. declared symbol (reuse
  2142. its uid) *)
  2143. IF NOT SymTab.ResumeMethod(
  2144. methCls, pn) THEN
  2145. SemError(200) END
  2146. ELSIF NOT SymTab.EnterProc(pn) THEN
  2147. IF NOT SymTab.ReenterProc(pn) THEN
  2148. IF NOT SymTab.ResumeProc(pn) THEN
  2149. SemError(200) END
  2150. END
  2151. END;
  2152. Lower.ScopeEnter;
  2153. Lower.NoteProc(pn,
  2154. SymTab.ProcUid(pn),
  2155. SymTab.InvalidType,
  2156. SymTab.ProcDepthOf(pn),
  2157. FALSE);
  2158. QbeGen.BeginFunc("");
  2159. IF methCls #
  2160. SymTab.InvalidType THEN
  2161. (* hidden THIS receiver:
  2162. a VAR param of the
  2163. class type, pushed as
  2164. the WITH base *)
  2165. IF NOT SymTab.EnterThisParam(
  2166. methCls) THEN
  2167. SemError(200) END;
  2168. IF NOT QbeGen.FuncParam(
  2169. "THIS", TRUE,
  2170. methCls) THEN
  2171. SemError(233) END
  2172. END; .)
  2173. [ FormalParams ]
  2174. [ ":" ( TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
  2175. SemError(235) END;
  2176. Lower.SetProcRes(t); .)
  2177. | "PROC" (. (* PROC result: the procedure
  2178. value type *)
  2179. IF NOT SymTab.SetProcRes(
  2180. SymTab.AddrType()) THEN
  2181. SemError(235) END;
  2182. Lower.SetProcRes(
  2183. SymTab.AddrType()); .) ) ] .
  2184. FormalParams
  2185. = "(" [ ParamSection { ";" ParamSection } ] ")" .
  2186. ParamSection (. VAR t: SymTab.TypeIndex;
  2187. nm: SymTab.Name;
  2188. i: CARDINAL;
  2189. isV: BOOLEAN; .)
  2190. = (. isV := FALSE; .)
  2191. [ "VAR" (. isV := TRUE; .) ]
  2192. ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
  2193. WHILE i < SymTab.PendCount() DO
  2194. SymTab.PendName(i, nm);
  2195. Lower.NoteParam(nm, t, isV);
  2196. Lower.NoteVar(nm, SymTab.KindParam, t);
  2197. (* value open arrays are
  2198. passed as descriptor
  2199. addresses (no copy):
  2200. same representation as
  2201. VAR formals *)
  2202. IF NOT QbeGen.FuncParam(nm,
  2203. isV
  2204. OR SymTab.IsOpenArray(t),
  2205. t) THEN
  2206. SemError(233) END;
  2207. INC(i)
  2208. END;
  2209. IF NOT SymTab.FixPending(t) THEN
  2210. SemError(235) END; .) .
  2211. (* Nested procedures lower like top-level ones (4.2): the
  2212. static link gives them their parent's frame. Methods keep
  2213. parse-now/230-later. *)
  2214. ProcDecl (. VAR pn: SymTab.Name;
  2215. saveFun: SymTab.Name;
  2216. astNode: AST.Node; .)
  2217. = ProcHeading<pn, SymTab.InvalidType> ";"
  2218. (. astNode := AST.MakeNode(AST.NkProcDecl);
  2219. AST.SetOp(astNode, 0);
  2220. AST.SetChild(astNode, 0,
  2221. AST.MakeLeaf(AST.NkIdent, pn));
  2222. Lower.NoteProcNode(astNode); .)
  2223. ( "FORWARD" (. AST.SetOp(astNode, 1);
  2224. astDecl := astNode;
  2225. Lower.ScopeLeave;
  2226. SymTab.MarkFwd;
  2227. SymTab.CloseProc;
  2228. QbeGen.AbortFunc; .)
  2229. | "EXTERNAL" (. AST.SetOp(astNode, 2);
  2230. astDecl := astNode;
  2231. Lower.MarkProcExternal;
  2232. Lower.ScopeLeave;
  2233. SymTab.MarkExternal("");
  2234. SymTab.CloseProc;
  2235. QbeGen.AbortFunc; .)
  2236. |
  2237. (. allowDefer := TRUE; deferredBody := FALSE;
  2238. curProcNode := astNode;
  2239. saveFun := curFun;
  2240. curFun := pn; .)
  2241. Block<pn> (. curFun := saveFun;
  2242. IF deferredBody THEN
  2243. (* body skipped: close like
  2244. FORWARD (no body node) *)
  2245. astDecl := astNode;
  2246. Lower.ScopeLeave;
  2247. SymTab.CloseProc;
  2248. QbeGen.AbortFunc
  2249. ELSE
  2250. AST.SetChild(astNode, 1, astStmt);
  2251. AST.SetChild(astNode, 2, astBlkDecls);
  2252. astDecl := astNode;
  2253. Lower.ScopeLeave;
  2254. SymTab.CloseProc;
  2255. QbeGen.EndFunc(
  2256. SymTab.ProcRes(pn))
  2257. END; .) ) .
  2258. Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN;
  2259. astBody, astHandler: AST.Node;
  2260. hasExcept, saveHandler: BOOLEAN; .)
  2261. = (. dfr := FALSE;
  2262. saveHandler := inHandler;
  2263. inHandler := FALSE;
  2264. astHandler := AST.NoNode;
  2265. hasExcept := FALSE;
  2266. IF allowDefer AND twoPhaseParse
  2267. AND NOT repassing THEN
  2268. dfr := DeferSkip(pn)
  2269. END;
  2270. allowDefer := FALSE;
  2271. .)
  2272. DeclSeq (. astBlkDecls := astDecl;
  2273. astStmt := AST.NoNode;
  2274. nLab := 0; nGot := 0; .)
  2275. [ "BEGIN" (. (* an empty body is still a
  2276. body: mark it so Lower
  2277. does not read it as a
  2278. definition heading *)
  2279. IF NOT dfr THEN
  2280. IF astStmt = AST.NoNode THEN
  2281. astStmt :=
  2282. AST.MakeNode(AST.NkBlock)
  2283. END
  2284. END; .)
  2285. [ StatSeq ] ]
  2286. (. astBody := astStmt; .)
  2287. [ "EXCEPT" (. hasExcept := TRUE;
  2288. inHandler := TRUE; .)
  2289. [ StatSeq ] (. astHandler := astStmt;
  2290. inHandler := FALSE .) ]
  2291. "END"
  2292. GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
  2293. SemError(202) END;
  2294. inHandler := saveHandler;
  2295. IF hasExcept THEN
  2296. astStmt := WrapExcept(astBody,
  2297. astHandler)
  2298. END;
  2299. CheckGotos; .) .
  2300. (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
  2301. level body once the unit's declarations are complete. Inlined at
  2302. both call sites because a stand-alone epsilon production is
  2303. "unreachable" to Coco/R (referenced only from actions). *)
  2304. StatSeq (. VAR astSeq, astTail: AST.Node; .)
  2305. = (. astSeq := AST.NoNode;
  2306. astTail := AST.NoNode; .)
  2307. Statement (. AstAppend(AST.NkBlock,
  2308. astSeq, astTail, astStmt); .)
  2309. { ";" [ Statement (. AstAppend(AST.NkBlock,
  2310. astSeq, astTail, astStmt); .) ] }
  2311. (. astStmt := astSeq; .) .
  2312. (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
  2313. are accepted: the statement after ';' is optional. *)
  2314. Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
  2315. = (. astStmt := AST.NoNode; .)
  2316. ( AssOrCall
  2317. | IfStat
  2318. | WhileStat
  2319. | RepeatStat
  2320. | LoopStat
  2321. | ForStat
  2322. | CaseStat
  2323. | WithStat
  2324. | ReturnStat
  2325. | HaltStat
  2326. | NewStat
  2327. | DisposeStat
  2328. | IncDecStat
  2329. | InclExclStat
  2330. | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
  2331. SemError(230) END;
  2332. astStmt := AST.MakeNode(AST.NkExit); .)
  2333. | "RETRY" (. IF NOT inHandler THEN
  2334. SemError(237) END;
  2335. astStmt := AST.MakeNode(AST.NkRetry); .)
  2336. | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
  2337. astStmt := AST.MakeNode(AST.NkGoto);
  2338. AST.SetChild(astStmt, 0,
  2339. AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
  2340. (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
  2341. InclExclStat (. VAR at, et2: SymTab.TypeIndex;
  2342. dk: INTEGER;
  2343. qd, qe: QbeGen.QVal;
  2344. qn: SymTab.Name;
  2345. sfx, isInc: BOOLEAN;
  2346. astNode, astD: AST.Node; .)
  2347. = ( "INCL" (. isInc := TRUE; .)
  2348. | "EXCL" (. isInc := FALSE; .) )
  2349. "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
  2350. Expr<et2, qe> ")"
  2351. (. astNode := AST.MakeNode(AST.NkCall);
  2352. IF isInc THEN
  2353. AST.SetChild(astNode, 0,
  2354. AST.MakeLeaf(AST.NkIdent, "INCL"))
  2355. ELSE AST.SetChild(astNode, 0,
  2356. AST.MakeLeaf(AST.NkIdent, "EXCL"))
  2357. END;
  2358. IF astD # AST.NoNode THEN
  2359. AST.SetChild(astNode, 1, astD) END;
  2360. IF astCur # AST.NoNode THEN
  2361. AST.SetChild(astNode, 2, astCur) END;
  2362. astStmt := astNode; .)
  2363. (. IF (at # SymTab.InvalidType)
  2364. AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
  2365. SemError(222)
  2366. END; .) .
  2367. (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
  2368. integer designator. *)
  2369. IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
  2370. dk: INTEGER;
  2371. qd, qv, qn2, qstep:
  2372. QbeGen.QVal;
  2373. qn: SymTab.Name;
  2374. sfx, isInc: BOOLEAN;
  2375. astNode, astD, astStep:
  2376. AST.Node; .)
  2377. = (. isInc := TRUE; .)
  2378. ( "INC" (. isInc := TRUE; .)
  2379. | "DEC" (. isInc := FALSE; .) )
  2380. "(" (. astStep := AST.NoNode; .)
  2381. Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
  2382. [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
  2383. ")" (. astNode := AST.MakeNode(AST.NkCall);
  2384. IF isInc THEN
  2385. AST.SetChild(astNode, 0,
  2386. AST.MakeLeaf(AST.NkIdent, "INC"))
  2387. ELSE AST.SetChild(astNode, 0,
  2388. AST.MakeLeaf(AST.NkIdent, "DEC"))
  2389. END;
  2390. IF astD # AST.NoNode THEN
  2391. AST.SetChild(astNode, 1, astD) END;
  2392. IF astStep # AST.NoNode THEN
  2393. AST.SetChild(astNode, 2, astStep) END;
  2394. astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
  2395. ELSIF (dk # SymTab.KindVar)
  2396. AND (dk # SymTab.KindParam)
  2397. AND (dk # SymTab.KindField) THEN
  2398. SemError(210)
  2399. ELSIF NOT SymTab.IsOrdinal(dt) THEN
  2400. SemError(211)
  2401. END; .) .
  2402. (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
  2403. Targets are pointer designators; DISPOSE nils afterwards (safer
  2404. than Wirth-undefined; documented). DISPOSE is shallow. *)
  2405. NewStat (. VAR dt: SymTab.TypeIndex;
  2406. dk: INTEGER;
  2407. qd, qm: QbeGen.QVal;
  2408. qn: SymTab.Name;
  2409. sfx: BOOLEAN;
  2410. bt: SymTab.TypeIndex;
  2411. astNode, astD: AST.Node; .)
  2412. = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
  2413. (. astNode := AST.MakeNode(AST.NkCall);
  2414. AST.SetChild(astNode, 0,
  2415. AST.MakeLeaf(AST.NkIdent, "NEW"));
  2416. IF astD # AST.NoNode THEN
  2417. AST.SetChild(astNode, 1, astD) END;
  2418. astStmt := astNode; .)
  2419. (. IF dt = SymTab.InvalidType THEN
  2420. ELSIF (dk # SymTab.KindVar)
  2421. AND (dk # SymTab.KindParam)
  2422. AND (dk # SymTab.KindField) THEN
  2423. SemError(210)
  2424. ELSIF SymTab.ClassOf(dt) #
  2425. SymTab.ClPtr THEN
  2426. SemError(219)
  2427. END; .) .
  2428. DisposeStat (. VAR dt: SymTab.TypeIndex;
  2429. dk: INTEGER;
  2430. qd, qv: QbeGen.QVal;
  2431. qn: SymTab.Name;
  2432. sfx: BOOLEAN;
  2433. astNode, astD: AST.Node; .)
  2434. = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
  2435. (. astNode := AST.MakeNode(AST.NkCall);
  2436. AST.SetChild(astNode, 0,
  2437. AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
  2438. IF astD # AST.NoNode THEN
  2439. AST.SetChild(astNode, 1, astD) END;
  2440. astStmt := astNode; .)
  2441. (. IF dt = SymTab.InvalidType THEN
  2442. ELSIF (dk # SymTab.KindVar)
  2443. AND (dk # SymTab.KindParam)
  2444. AND (dk # SymTab.KindField) THEN
  2445. SemError(210)
  2446. ELSIF SymTab.ClassOf(dt) #
  2447. SymTab.ClPtr THEN
  2448. SemError(219)
  2449. END; .) .
  2450. (* WITH pushes each record's fields (inner wins) plus its base
  2451. address; field designators resolve through both stacks. *)
  2452. WithStat (. VAR nW: CARDINAL;
  2453. astNode: AST.Node; .)
  2454. = "WITH" (. nW := 0;
  2455. astNode := AST.MakeNode(AST.NkWith); .)
  2456. WithItem<nW, astNode> { "," WithItem<nW, astNode> }
  2457. "DO" (. astStmt := AST.NoNode; .)
  2458. [ StatSeq ] "END" (. AST.SetChild(astNode,
  2459. AST.NChild(astNode), astStmt);
  2460. astStmt := astNode;
  2461. WHILE nW > 0 DO
  2462. SymTab.PopScope;
  2463. QbeGen.PopWith;
  2464. DEC(nW)
  2465. END; .) .
  2466. WithItem<VAR nW: CARDINAL; wnode: AST.Node>
  2467. (. VAR dt: SymTab.TypeIndex;
  2468. dk: INTEGER;
  2469. qd, qe: QbeGen.QVal;
  2470. qn: SymTab.Name;
  2471. sfx: BOOLEAN; .)
  2472. = Design<dt, dk, qd, qn, sfx>
  2473. (. IF astCur # AST.NoNode THEN
  2474. AST.SetChild(wnode,
  2475. AST.NChild(wnode), astCur) END;
  2476. IF dt = SymTab.InvalidType THEN
  2477. ELSIF (SymTab.ClassOf(dt) #
  2478. SymTab.ClRecord)
  2479. AND (SymTab.ClassOf(dt) #
  2480. SymTab.ClClass) THEN
  2481. SemError(215)
  2482. ELSIF SymTab.PushRecord(dt) THEN
  2483. QbeGen.PushWith(qd);
  2484. INC(nW)
  2485. END; .) .
  2486. (* Assignment or procedure-statement call (4.1, module level).
  2487. Bare `P;` is a syntax error; function-as-statement is 233. *)
  2488. AssOrCall (. VAR dt, et: SymTab.TypeIndex;
  2489. dk: INTEGER;
  2490. qd, qe, qt, ql: QbeGen.QVal;
  2491. qn: SymTab.Name;
  2492. ct2, res0: SymTab.TypeIndex;
  2493. q2, mg0: QbeGen.QVal;
  2494. isR, conv, wconv: BOOLEAN;
  2495. called, sfx: BOOLEAN;
  2496. astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
  2497. n: SymTab.Name; astLab, astNode: AST.Node; .)
  2498. = GetIdent<n>
  2499. ( ":" (. NoteLabel(n);
  2500. astNode := AST.MakeNode(AST.NkLabel);
  2501. AST.SetChild(astNode, 0,
  2502. AST.MakeLeaf(AST.NkIdent, n));
  2503. astLab := AST.MakeNode(AST.NkBlock);
  2504. AST.SetChild(astLab, 0, astNode); .)
  2505. Statement (. IF astStmt # AST.NoNode THEN
  2506. AST.SetChild(astLab, 1, astStmt) END;
  2507. astStmt := astLab; .)
  2508. | DesignTail<n, dt, dk, qd, qn, sfx>
  2509. (. astLhs := astCur; astNArgs := 0; .)
  2510. ( ":="
  2511. Expr<et, qe> (. astStmt := AST.MakeBin(
  2512. AST.NkAssign, 0, astLhs, astCur);
  2513. IF (dt # SymTab.InvalidType)
  2514. AND (dk # SymTab.KindVar)
  2515. AND (dk # SymTab.KindParam)
  2516. AND (dk # SymTab.KindField) THEN
  2517. SemError(210)
  2518. ELSIF NOT SymTab.Assignable(et,
  2519. dt) THEN
  2520. SemError(210)
  2521. ELSIF (dt # SymTab.InvalidType)
  2522. AND (SymTab.ClassOf(dt) =
  2523. SymTab.ClClass) THEN
  2524. SemError(230) END;
  2525. isR := (dt #
  2526. SymTab.InvalidType)
  2527. AND (SymTab.ClassOf(dt)
  2528. = SymTab.ClReal);
  2529. conv := isR
  2530. AND SymTab.IsIntFamily(et);
  2531. wconv := (dt #
  2532. SymTab.InvalidType)
  2533. AND SymTab.IsLongFamily(dt)
  2534. AND SymTab.IsIntFamily(et);
  2535. IF ((dk = SymTab.KindVar)
  2536. OR (dk = SymTab.KindParam)
  2537. OR (dk = SymTab.KindField))
  2538. AND (dt # SymTab.InvalidType)
  2539. AND (et # SymTab.InvalidType)
  2540. AND (SymTab.ClassOf(dt) #
  2541. SymTab.ClClass) THEN
  2542. END; .)
  2543. | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
  2544. (. astRes := AstCallNode(astLhs);
  2545. sfx := FALSE; .)
  2546. ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
  2547. ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
  2548. AST.NkAssign, 0, astRes, astCur);
  2549. IF NOT sfx THEN
  2550. SemError(233)
  2551. ELSIF (ct2 # SymTab.InvalidType)
  2552. AND NOT SymTab.Assignable(et, ct2) THEN
  2553. SemError(210)
  2554. END; .)
  2555. | (. (* discarding the result of a
  2556. foreign C varargs call
  2557. (printf/snprintf) is accepted;
  2558. an ordinary Modula-2 function
  2559. used as a statement stays 233 *)
  2560. IF (ct2 # SymTab.InvalidType)
  2561. AND NOT SymTab.Varargs(qn) THEN
  2562. SemError(233) END;
  2563. astStmt := astRes; .) )
  2564. | (* bare `P;`: proper parameterless
  2565. procedure call; anything else
  2566. here is 233 (was a bare syntax
  2567. error before 4.2) *)
  2568. (. astStmt := AstCallNode(astLhs);
  2569. IF (dk = SymTab.KindProc)
  2570. AND NOT sfx THEN
  2571. res0 := SymTab.ProcRes(qn);
  2572. IF res0 #
  2573. SymTab.InvalidType THEN
  2574. SemError(233)
  2575. ELSIF SymTab.ProcNPar(qn) #
  2576. 0 THEN
  2577. SemError(233)
  2578. END
  2579. ELSIF (dt # SymTab.InvalidType)
  2580. AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
  2581. IF SymTab.ProcTypeRes(dt) #
  2582. SymTab.InvalidType THEN
  2583. SemError(233)
  2584. ELSIF SymTab.ProcTypeNPar(dt) #
  2585. 0 THEN
  2586. SemError(233)
  2587. END
  2588. ELSE SemError(233)
  2589. END; .) ) ) .
  2590. (* Actual-parameter list shared by statement and expression calls.
  2591. want selects CallEnd's result handling; t/q carry the call
  2592. value (statement calls discard). Arity/type failures are 233;
  2593. evaluation code still emits so the .ssa stays assembleable. *)
  2594. ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
  2595. want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
  2596. VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
  2597. VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
  2598. vs: INTEGER;
  2599. res: SymTab.TypeIndex;
  2600. mg: QbeGen.QVal;
  2601. ok, ind, isMeth, va, isConv: BOOLEAN; .)
  2602. = "(" (. called := TRUE;
  2603. ok := TRUE;
  2604. ind := FALSE;
  2605. isConv := FALSE;
  2606. isMeth := methCls #
  2607. SymTab.InvalidType;
  2608. IF isMeth THEN
  2609. res := SymTab.ClassMethodRes(methCls, pn)
  2610. ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
  2611. res := SymTab.ProcRes(pn)
  2612. ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
  2613. OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
  2614. (* ISO type conversion T(x):
  2615. one value, result is T *)
  2616. isConv := TRUE;
  2617. res := SymTab.SymType(pn)
  2618. ELSIF (pt # SymTab.InvalidType)
  2619. AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
  2620. ind := TRUE;
  2621. res := SymTab.ProcTypeRes(pt)
  2622. ELSE SemError(233);
  2623. ok := FALSE;
  2624. res := SymTab.InvalidType
  2625. END;
  2626. i := 0; .)
  2627. [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
  2628. { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
  2629. ")" (. IF ok THEN
  2630. IF isConv THEN
  2631. (* a conversion takes
  2632. exactly one value *)
  2633. IF i # 1 THEN
  2634. SemError(233); ok := FALSE
  2635. END
  2636. ELSE
  2637. IF isMeth THEN
  2638. np := SymTab.ClassMethodNPar(
  2639. methCls, pn)
  2640. ELSIF ind THEN
  2641. np := SymTab.ProcTypeNPar(pt)
  2642. ELSE np := SymTab.ProcNPar(pn)
  2643. END;
  2644. va := (NOT isMeth) AND (NOT ind)
  2645. AND (SymTab.SymKind(pn) =
  2646. SymTab.KindProc)
  2647. AND SymTab.Varargs(pn);
  2648. IF (i # np) AND NOT va THEN
  2649. SemError(233); ok := FALSE
  2650. END
  2651. END
  2652. END;
  2653. IF NOT ok THEN
  2654. t := SymTab.InvalidType;
  2655. QbeGen.CopyOp("0", q)
  2656. ELSIF want THEN
  2657. IF res =
  2658. SymTab.InvalidType THEN
  2659. IF NOT soft THEN SemError(233) END;
  2660. t := SymTab.InvalidType;
  2661. QbeGen.CopyOp("0", q)
  2662. ELSE t := res;
  2663. QbeGen.CopyOp("@", q)
  2664. END
  2665. ELSE
  2666. (* a function call used as
  2667. a statement: allowed for
  2668. a foreign C varargs proc
  2669. (printf/snprintf), whose
  2670. result is conventionally
  2671. discarded; ordinary
  2672. Modula-2 functions keep
  2673. the 233 diagnostic *)
  2674. IF (res # SymTab.InvalidType)
  2675. AND NOT va THEN
  2676. SemError(233)
  2677. END;
  2678. t := SymTab.InvalidType;
  2679. QbeGen.CopyOp("0", q);
  2680. END; .) .
  2681. (* One actual: VAR formals take recorded designator addresses
  2682. (233 otherwise); value formals take converted expressions. *)
  2683. ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
  2684. methCls: SymTab.TypeIndex; i: CARDINAL>
  2685. (. VAR at, ft: SymTab.TypeIndex;
  2686. qe, qa, qt: QbeGen.QVal;
  2687. isV, conv, va: BOOLEAN;
  2688. cl: CHAR;
  2689. savedN, aj: CARDINAL;
  2690. savedArgs: ARRAY [0 .. 31]
  2691. OF AST.Node;
  2692. astActual: AST.Node; .)
  2693. = (. (* Parsing the actual can clobber
  2694. the enclosing call's argument
  2695. list (Factor resets astNArgs),
  2696. so save/restore it. *)
  2697. savedN := astNArgs; aj := 0;
  2698. WHILE aj <= HIGH(astArgs) DO
  2699. savedArgs[aj] := astArgs[aj];
  2700. INC(aj)
  2701. END; .)
  2702. Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
  2703. astActual := astCur;
  2704. astNArgs := savedN; aj := 0;
  2705. WHILE aj <= HIGH(astArgs) DO
  2706. astArgs[aj] := savedArgs[aj];
  2707. INC(aj)
  2708. END;
  2709. IF astNArgs <= HIGH(astArgs) THEN
  2710. astArgs[astNArgs] := astCur;
  2711. INC(astNArgs)
  2712. ELSE SemError(230)
  2713. (* > 32 actuals: impl limit *)
  2714. END;
  2715. va := (NOT ind)
  2716. AND (methCls =
  2717. SymTab.InvalidType)
  2718. AND (SymTab.SymKind(pn) =
  2719. SymTab.KindProc)
  2720. AND SymTab.Varargs(pn);
  2721. IF ind THEN
  2722. ft :=
  2723. SymTab.ProcTypeParamType(pt,
  2724. i);
  2725. isV :=
  2726. SymTab.ProcTypeParamIsVar(pt,
  2727. i)
  2728. ELSIF methCls #
  2729. SymTab.InvalidType THEN
  2730. ft :=
  2731. SymTab.ClassMethodParamType(
  2732. methCls, pn, i);
  2733. isV :=
  2734. SymTab.ClassMethodParamIsVar(
  2735. methCls, pn, i)
  2736. ELSE
  2737. ft := SymTab.ParamType(pn, i);
  2738. isV := SymTab.ParamIsVar(pn, i)
  2739. END;
  2740. IF (at = SymTab.InvalidType) THEN
  2741. ELSIF ft = SymTab.InvalidType THEN
  2742. ELSIF isV THEN
  2743. IF (SymTab.ClassOf(at) = SymTab.ClChar)
  2744. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  2745. AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
  2746. AND QbeGen.IsImm(qe) THEN
  2747. ELSIF (AST.Kind(astActual) #
  2748. AST.NkDesignator)
  2749. AND (AST.Kind(astActual) # AST.NkStrLit) THEN
  2750. SemError(233)
  2751. ELSIF NOT SymTab.VarParamOk(at, ft)
  2752. AND NOT SymTab.ByteBufOk(at, ft) THEN
  2753. SemError(233)
  2754. END
  2755. ELSE
  2756. IF (SymTab.ClassOf(at) = SymTab.ClChar)
  2757. AND (SymTab.ClassOf(ft) = SymTab.ClArray)
  2758. AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
  2759. AND QbeGen.IsImm(qe) THEN
  2760. ELSIF NOT SymTab.Assignable(at, ft)
  2761. AND NOT SymTab.ByteBufOk(at, ft) THEN
  2762. SemError(233)
  2763. END
  2764. END; .) .
  2765. IfStat (. VAR t: SymTab.TypeIndex;
  2766. q: QbeGen.QVal;
  2767. hasElse: BOOLEAN;
  2768. astCond, astIf, astLast,
  2769. astNode: AST.Node; .)
  2770. = "IF" (. hasElse := FALSE; .)
  2771. Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
  2772. IF NOT SymTab.BoolCheck(t) THEN
  2773. SemError(214) END; .)
  2774. "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
  2775. AST.SetChild(astNode, 0, astCond);
  2776. AST.SetChild(astNode, 1, astStmt);
  2777. astIf := astNode;
  2778. astLast := astNode; .)
  2779. { "ELSIF"
  2780. Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
  2781. IF NOT SymTab.BoolCheck(t) THEN
  2782. SemError(214) END; .)
  2783. "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
  2784. AST.SetChild(astNode, 0, astCond);
  2785. AST.SetChild(astNode, 1, astStmt);
  2786. AST.SetChild(astLast, 2, astNode);
  2787. astLast := astNode; .) }
  2788. [ "ELSE" (. hasElse := TRUE;
  2789. astStmt := AST.NoNode; .)
  2790. [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
  2791. "END" (. astStmt := astIf; .) .
  2792. WhileStat (. VAR t: SymTab.TypeIndex;
  2793. q: QbeGen.QVal;
  2794. astCond, astNode: AST.Node; .)
  2795. = "WHILE" (. astStmt := AST.NoNode; .)
  2796. Expr<t, q> (. astCond := astCur;
  2797. IF NOT SymTab.BoolCheck(t) THEN
  2798. SemError(214) END; .)
  2799. "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
  2800. AST.SetChild(astNode, 0, astCond);
  2801. AST.SetChild(astNode, 1, astStmt);
  2802. astStmt := astNode; .)
  2803. "END" .
  2804. RepeatStat (. VAR t: SymTab.TypeIndex;
  2805. q: QbeGen.QVal;
  2806. astCond, astBody, astNode:
  2807. AST.Node; .)
  2808. = "REPEAT" (. astStmt := AST.NoNode; .)
  2809. [ StatSeq ] (. astBody := astStmt; .)
  2810. "UNTIL" Expr<t, q> (. astCond := astCur;
  2811. astNode := AST.MakeNode(AST.NkRepeat);
  2812. AST.SetChild(astNode, 0, astBody);
  2813. AST.SetChild(astNode, 1, astCond);
  2814. astStmt := astNode;
  2815. IF NOT SymTab.BoolCheck(t) THEN
  2816. SemError(214) END; .) .
  2817. LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
  2818. = "LOOP" (. astStmt := AST.NoNode;
  2819. QbeGen.NewLabel(lEnd);
  2820. QbeGen.PushLoop(lEnd); .)
  2821. [ StatSeq ]
  2822. "END" (. astNode := AST.MakeNode(AST.NkLoop);
  2823. AST.SetChild(astNode, 0, astStmt);
  2824. astStmt := astNode;
  2825. QbeGen.PopLoop; .) .
  2826. (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
  2827. Runtime direction would need a compare-select; the literal
  2828. sign picks cslew/csegew at "DO" time. *)
  2829. ForStat (. VAR lv: SymTab.Name;
  2830. tlo, thi, tby:
  2831. SymTab.TypeIndex;
  2832. qlo, qhi, qby, qt, qk, qb:
  2833. QbeGen.QVal;
  2834. lTop, lBody, lEnd:
  2835. QbeGen.QVal;
  2836. by: INTEGER;
  2837. ok: BOOLEAN;
  2838. astVar, astLo, astHi, astBy,
  2839. astNode: AST.Node; .)
  2840. = "FOR" (. by := 1; .)
  2841. GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
  2842. astStmt := AST.NoNode;
  2843. astBy := AST.NoNode;
  2844. ok := SymTab.Lookup(lv);
  2845. IF NOT ok THEN
  2846. SemError(201)
  2847. ELSIF (SymTab.SymKind(lv) #
  2848. SymTab.KindVar)
  2849. AND (SymTab.SymKind(lv) #
  2850. SymTab.KindParam) THEN
  2851. SemError(220); ok := FALSE
  2852. ELSIF NOT SymTab.IsOrdinal(
  2853. SymTab.SymType(lv)) THEN
  2854. SemError(220); ok := FALSE
  2855. END; .)
  2856. ":=" Expr<tlo, qlo> (. astLo := astCur;
  2857. IF NOT SymTab.Assignable(tlo,
  2858. SymTab.SymType(lv)) THEN
  2859. SemError(220); ok := FALSE
  2860. END; .)
  2861. "TO" Expr<thi, qhi> (. astHi := astCur;
  2862. IF NOT SymTab.Assignable(thi,
  2863. SymTab.SymType(lv)) THEN
  2864. SemError(220); ok := FALSE
  2865. END; .)
  2866. [ "BY" Expr<tby, qby> (. astBy := astCur;
  2867. IF (tby #
  2868. SymTab.InvalidType)
  2869. AND NOT SymTab.IsIntFamily(tby) THEN
  2870. SemError(220); ok := FALSE
  2871. END;
  2872. IF NOT SymTab.ConstInt(qby, by) THEN
  2873. SemError(230); by := 1
  2874. ELSIF by = 0 THEN
  2875. SemError(220); by := 1
  2876. END; .) ]
  2877. "DO"
  2878. [ StatSeq ]
  2879. "END" (. astNode := AST.MakeNode(AST.NkFor);
  2880. AST.SetChild(astNode, 0, astVar);
  2881. AST.SetChild(astNode, 1, astLo);
  2882. AST.SetChild(astNode, 2, astHi);
  2883. AST.SetChild(astNode, 3, astBy);
  2884. AST.SetChild(astNode, 4, astStmt);
  2885. astStmt := astNode;
  2886. .) .
  2887. CaseStat (. VAR tsel: SymTab.TypeIndex;
  2888. qsel, lEnd: QbeGen.QVal;
  2889. arm, astNode, astArms,
  2890. astArmsTail: AST.Node; .)
  2891. = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
  2892. AST.SetChild(astNode, 0, astCur);
  2893. astArms := AST.NoNode;
  2894. astArmsTail := AST.NoNode;
  2895. .)
  2896. "OF" [ "|" ] CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
  2897. { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
  2898. [ "ELSE" (. astStmt := AST.NoNode; .)
  2899. [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
  2900. AST.SetOp(arm, 1);
  2901. AST.SetChild(arm, 0, astStmt);
  2902. AstAppend(AST.NkBlock,
  2903. astArms, astArmsTail, arm); .) ]
  2904. "END" (. AST.SetChild(astNode, 1, astArms);
  2905. astStmt := astNode;
  2906. .) .
  2907. (* Compare-chain lowering: each alternative ends its match-tests
  2908. with "jmp lAfter", so the no-match fallthrough skips the body:
  2909. "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
  2910. lAfter:". Falls into the next alternative, ELSE, or END. *)
  2911. CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  2912. lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
  2913. (. VAR arm: AST.Node; .)
  2914. = (. arm := AST.MakeNode(AST.NkCaseArm); .)
  2915. CaseLabel<tsel, qsel, arm>
  2916. { "," CaseLabel<tsel, qsel, arm> }
  2917. ":" (. astStmt := AST.NoNode; .)
  2918. [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
  2919. astStmt);
  2920. AstAppend(AST.NkBlock,
  2921. arms, armsTail, arm);
  2922. .) .
  2923. CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  2924. arm: AST.Node>
  2925. (. VAR t2, t3: SymTab.TypeIndex;
  2926. q2, q3, qc, qd, qe:
  2927. QbeGen.QVal;
  2928. astLab: AST.Node;
  2929. lNext: QbeGen.QVal; .)
  2930. = Expr<t2, q2> (. astLab := astCur;
  2931. IF SymTab.IsEmptyStr(t2)
  2932. AND (SymTab.ClassOf(tsel) =
  2933. SymTab.ClChar) THEN
  2934. (* ISO: '' as a CASE label
  2935. is the terminator *)
  2936. QbeGen.CopyOp("0", q2);
  2937. t2 := SymTab.CharType()
  2938. END;
  2939. IF (t2 #
  2940. SymTab.InvalidType)
  2941. AND (tsel #
  2942. SymTab.InvalidType)
  2943. AND NOT SymTab.EqCheck(t2,
  2944. tsel) THEN
  2945. SemError(213) END;
  2946. (* set labels are not immediates:
  2947. the CASE chain uses CmpSet *)
  2948. IF (SymTab.ClassOf(t2) # SymTab.ClSet)
  2949. AND NOT QbeGen.IsImm(q2) THEN
  2950. SemError(230)
  2951. END; .)
  2952. [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
  2953. AST.NkSubrange, 0, astLab, astCur);
  2954. IF SymTab.IsEmptyStr(t3)
  2955. AND (SymTab.ClassOf(tsel) =
  2956. SymTab.ClChar) THEN
  2957. QbeGen.CopyOp("0", q3);
  2958. t3 := SymTab.CharType()
  2959. END;
  2960. IF (t3 #
  2961. SymTab.InvalidType)
  2962. AND (tsel #
  2963. SymTab.InvalidType)
  2964. AND NOT SymTab.EqCheck(t3,
  2965. tsel) THEN
  2966. SemError(213) END;
  2967. IF (SymTab.ClassOf(t3) # SymTab.ClSet)
  2968. AND NOT QbeGen.IsImm(q3) THEN
  2969. SemError(230)
  2970. END; .) ]
  2971. (. AST.SetChild(arm,
  2972. AST.NChild(arm), astLab); .) .
  2973. ReturnStat (. VAR t: SymTab.TypeIndex;
  2974. q, qt: QbeGen.QVal;
  2975. res: SymTab.TypeIndex;
  2976. hadE, conv: BOOLEAN;
  2977. astVal, astNode: AST.Node; .)
  2978. = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
  2979. [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
  2980. (. astNode := AST.MakeNode(AST.NkReturn);
  2981. IF hadE THEN
  2982. AST.SetChild(astNode, 0, astVal)
  2983. END;
  2984. astStmt := astNode;
  2985. conv := FALSE;
  2986. IF NOT SymTab.InProc() THEN
  2987. (* A bare RETURN in a module
  2988. body/finally leaves that
  2989. initialisation/finalisation
  2990. part; a value is illegal. *)
  2991. IF hadE THEN SemError(232) END
  2992. ELSE res := SymTab.CurRes();
  2993. IF NOT hadE THEN
  2994. IF res #
  2995. SymTab.InvalidType THEN
  2996. SemError(232)
  2997. END
  2998. ELSIF (res =
  2999. SymTab.InvalidType)
  3000. OR (t #
  3001. SymTab.InvalidType)
  3002. AND NOT SymTab.Assignable(t,
  3003. res) THEN
  3004. SemError(232)
  3005. END
  3006. END; .) .
  3007. HaltStat (. VAR t: SymTab.TypeIndex;
  3008. q: QbeGen.QVal;
  3009. astVal, astNode: AST.Node; .)
  3010. = "HALT" (. astVal := AST.NoNode; .)
  3011. [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
  3012. (. astNode := AST.MakeNode(AST.NkHalt);
  3013. IF astVal # AST.NoNode THEN
  3014. AST.SetChild(astNode, 0, astVal)
  3015. END;
  3016. astStmt := astNode;
  3017. .) .
  3018. (* Designator: scalar loads, array addresses, and index suffixes.
  3019. Each index descends one level (bounds-checked, trap on breach);
  3020. nested levels reload the inner descriptor address. q ends as the
  3021. value (scalars), the descriptor address (plain arrays), or the
  3022. element address (indexed); sfx marks the indexed form. *)
  3023. Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  3024. VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
  3025. (. VAR n: SymTab.Name; .)
  3026. = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
  3027. (* The part of Design after the identifier: resolve it and walk the
  3028. selectors. Split out so a statement can decide between a label
  3029. (`ident :`) and a designator (`ident := ...`) with one token. *)
  3030. DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  3031. VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
  3032. (. VAR fn, mal: SymTab.Name;
  3033. cls: INTEGER;
  3034. ic: SymTab.TypeIndex;
  3035. curT, it, eT, bt:
  3036. SymTab.TypeIndex;
  3037. iq, ql, qlo, qhi, qe:
  3038. QbeGen.QVal;
  3039. lo, hi: INTEGER;
  3040. fo: INTEGER;
  3041. isOpen: BOOLEAN;
  3042. qb, cv: QbeGen.QVal;
  3043. r: BOOLEAN;
  3044. astDes, astSel: AST.Node; .)
  3045. = (. methCls := SymTab.InvalidType;
  3046. QbeGen.CopyOp(n, qn);
  3047. sfx := FALSE;
  3048. IF NOT SymTab.Lookup(n) THEN
  3049. (* a bare method name inside
  3050. a CLASS IMPLEMENTATION
  3051. is a sibling call on
  3052. THIS *)
  3053. ic := SymTab.CurImplClass();
  3054. IF (ic #
  3055. SymTab.InvalidType)
  3056. AND SymTab.MethodExists(ic, n) THEN
  3057. sfx := FALSE;
  3058. QbeGen.CopyOp("@", q);
  3059. methCls := ic;
  3060. k := SymTab.KindProc;
  3061. t := SymTab.InvalidType
  3062. ELSIF SymTab.InProc() THEN
  3063. (* not declared anywhere
  3064. in scope: with bodies
  3065. parsed at unit end this
  3066. is a genuine 201 (a
  3067. nested-local forward is
  3068. no longer tolerated). *)
  3069. SemError(201);
  3070. t := SymTab.InvalidType;
  3071. k := -1;
  3072. QbeGen.CopyOp("0", q)
  3073. ELSE
  3074. SemError(201);
  3075. t :=
  3076. SymTab.InvalidType;
  3077. k := -1;
  3078. QbeGen.CopyOp("0", q)
  3079. END
  3080. ELSE
  3081. t := SymTab.SymType(n);
  3082. k := SymTab.SymKind(n);
  3083. IF k = SymTab.KindConst THEN
  3084. IF SymTab.Equal(n,
  3085. "TRUE") THEN
  3086. t := SymTab.BoolType();
  3087. QbeGen.CopyOp("1", q)
  3088. ELSIF SymTab.Equal(n,
  3089. "FALSE") THEN
  3090. t := SymTab.BoolType();
  3091. QbeGen.CopyOp("0", q)
  3092. ELSIF SymTab.Equal(n,
  3093. "NIL") THEN
  3094. QbeGen.CopyOp("0", q)
  3095. ELSE
  3096. cls :=
  3097. SymTab.ClassOf(t);
  3098. IF (t #
  3099. SymTab.InvalidType)
  3100. AND ((cls = SymTab.ClInt)
  3101. OR (cls
  3102. = SymTab.ClChar)
  3103. OR (cls
  3104. = SymTab.ClEnum)
  3105. OR (cls
  3106. = SymTab.ClReal)
  3107. OR (cls
  3108. = SymTab.ClLong)
  3109. OR (cls
  3110. = SymTab.ClNil)
  3111. OR (cls = SymTab.ClByte)
  3112. OR (cls = SymTab.ClSByte)
  3113. OR (cls = SymTab.ClWord16)
  3114. OR (cls = SymTab.ClSWord16)
  3115. OR (cls = SymTab.ClBool)) THEN
  3116. IF cls = SymTab.ClNil THEN
  3117. QbeGen.CopyOp("0", q)
  3118. ELSIF ((cls
  3119. = SymTab.ClInt)
  3120. OR (cls
  3121. = SymTab.ClChar)
  3122. OR (cls
  3123. = SymTab.ClEnum)
  3124. OR (cls
  3125. = SymTab.ClLong)
  3126. OR (cls = SymTab.ClByte)
  3127. OR (cls = SymTab.ClSByte)
  3128. OR (cls = SymTab.ClWord16)
  3129. OR (cls = SymTab.ClSWord16)
  3130. OR (cls = SymTab.ClBool))
  3131. AND SymTab.GetSymVal(n, cv)
  3132. AND QbeGen.IsImm(cv) THEN
  3133. QbeGen.CopyOp(cv, q)
  3134. ELSE
  3135. QbeGen.LoadVar(n,
  3136. cls = SymTab.ClReal,
  3137. q)
  3138. END
  3139. ELSIF (cls = SymTab.ClArray)
  3140. OR (cls = SymTab.ClRecord)
  3141. OR (cls = SymTab.ClClass)
  3142. OR (cls = SymTab.ClStr)
  3143. OR (cls = SymTab.ClUStr)
  3144. OR (cls = SymTab.ClSet) THEN
  3145. (* aggregate constant:
  3146. its value IS the
  3147. descriptor address *)
  3148. IF SymTab.GetSymVal(n, cv) THEN
  3149. QbeGen.CopyOp(cv, q)
  3150. ELSE
  3151. QbeGen.CopyOp("0", q)
  3152. END
  3153. ELSE
  3154. IF t #
  3155. SymTab.InvalidType THEN
  3156. SemError(230)
  3157. END;
  3158. QbeGen.CopyOp("0", q)
  3159. END
  3160. END
  3161. ELSIF (k = SymTab.KindVar)
  3162. OR (k = SymTab.KindParam) THEN
  3163. cls := SymTab.ClassOf(t);
  3164. IF (cls # SymTab.ClInt)
  3165. AND (cls # SymTab.ClBool)
  3166. AND (cls # SymTab.ClChar)
  3167. AND (cls # SymTab.ClUChar)
  3168. AND (cls # SymTab.ClEnum)
  3169. AND (cls # SymTab.ClReal)
  3170. AND (cls # SymTab.ClPtr)
  3171. AND (cls # SymTab.ClProc)
  3172. AND (cls # SymTab.ClLong)
  3173. AND (cls # SymTab.ClArray)
  3174. AND (cls # SymTab.ClSet)
  3175. AND (cls # SymTab.ClRecord)
  3176. AND (cls # SymTab.ClUStr)
  3177. AND (cls # SymTab.ClByte)
  3178. AND (cls # SymTab.ClSByte)
  3179. AND (cls # SymTab.ClWord16)
  3180. AND (cls # SymTab.ClSWord16)
  3181. AND (cls # SymTab.ClClass) THEN
  3182. SemError(230);
  3183. QbeGen.CopyOp("0", q)
  3184. ELSE QbeGen.CopyOp("@", q)
  3185. END
  3186. ELSE QbeGen.CopyOp("0", q);
  3187. IF k = SymTab.KindImport THEN
  3188. SemError(230)
  3189. ELSIF k =
  3190. SymTab.KindProc THEN
  3191. (* bare procedure name:
  3192. a following ArgList
  3193. makes it a call;
  3194. otherwise Fact
  3195. reports 230 *)
  3196. ELSE
  3197. IF k = SymTab.KindField THEN
  3198. IF QbeGen.TopWith(qb) THEN
  3199. sfx := TRUE
  3200. ELSE SemError(230);
  3201. QbeGen.CopyOp("0", q)
  3202. END
  3203. END
  3204. END
  3205. END
  3206. END; .)
  3207. (. astDes := AST.MakeNode(AST.NkDesignator);
  3208. AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
  3209. { "[" Expr<it, iq>
  3210. (. AST.SetChild(astDes, AST.NChild(astDes),
  3211. AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
  3212. ELSIF SymTab.ClassOf(t) #
  3213. SymTab.ClArray THEN
  3214. SemError(217);
  3215. t := SymTab.InvalidType
  3216. ELSIF NOT SymTab.IsIntFamily(it)
  3217. AND (SymTab.ClassOf(it) #
  3218. SymTab.ClChar)
  3219. AND (SymTab.ClassOf(it) #
  3220. SymTab.ClEnum)
  3221. AND (SymTab.ClassOf(it) #
  3222. SymTab.ClBool) THEN
  3223. SemError(218);
  3224. t := SymTab.InvalidType
  3225. ELSE
  3226. eT := SymTab.ArrayElem(t);
  3227. t := eT; sfx := TRUE
  3228. END; .)
  3229. { "," Expr<it, iq>
  3230. (. AST.SetChild(astDes, AST.NChild(astDes),
  3231. AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
  3232. ELSIF SymTab.ClassOf(t) #
  3233. SymTab.ClArray THEN
  3234. SemError(217);
  3235. t := SymTab.InvalidType
  3236. ELSIF NOT SymTab.IsIntFamily(it)
  3237. AND (SymTab.ClassOf(it) #
  3238. SymTab.ClChar)
  3239. AND (SymTab.ClassOf(it) #
  3240. SymTab.ClEnum)
  3241. AND (SymTab.ClassOf(it) #
  3242. SymTab.ClBool) THEN
  3243. SemError(218);
  3244. t := SymTab.InvalidType
  3245. ELSE
  3246. eT := SymTab.ArrayElem(t);
  3247. t := eT; sfx := TRUE
  3248. END; .) }
  3249. "]"
  3250. | "." GetIdent<fn>
  3251. (. astSel := AST.MakeNode(AST.NkSelector);
  3252. AST.SetOp(astSel, AST.SelField);
  3253. AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
  3254. AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
  3255. (* qualified L.x: materialize
  3256. the export, then load it *)
  3257. IF NOT SymTab.MaterializeAlias(n,
  3258. fn, mal) THEN
  3259. SemError(201);
  3260. t := SymTab.InvalidType;
  3261. QbeGen.CopyOp("0", q)
  3262. ELSE
  3263. QbeGen.CopyOp(mal, qn);
  3264. t := SymTab.SymType(mal);
  3265. k := SymTab.SymKind(mal);
  3266. sfx := FALSE;
  3267. IF k = SymTab.KindProc THEN
  3268. (* call: ArgList supplies
  3269. the value *)
  3270. QbeGen.CopyOp("0", q)
  3271. ELSIF k = SymTab.KindConst THEN
  3272. IF SymTab.GetSymVal(mal,
  3273. cv)
  3274. THEN QbeGen.CopyOp(cv, q)
  3275. ELSE QbeGen.CopyOp("0", q)
  3276. END
  3277. END
  3278. END
  3279. ELSIF t = SymTab.InvalidType THEN
  3280. ELSIF (SymTab.ClassOf(t) #
  3281. SymTab.ClRecord)
  3282. AND (SymTab.ClassOf(t) #
  3283. SymTab.ClClass) THEN
  3284. SemError(215);
  3285. t := SymTab.InvalidType
  3286. ELSIF (SymTab.ClassOf(t) =
  3287. SymTab.ClClass)
  3288. AND SymTab.MethodExists(t, fn) THEN
  3289. (* obj.Method: bind the
  3290. method and pass obj as
  3291. the hidden receiver; q
  3292. already holds the
  3293. object's address *)
  3294. QbeGen.CopyOp(fn, n);
  3295. QbeGen.CopyOp(fn, qn);
  3296. methCls := t;
  3297. k := SymTab.KindProc;
  3298. t := SymTab.InvalidType
  3299. ELSIF NOT SymTab.FieldExists(t,
  3300. fn) THEN
  3301. SemError(216);
  3302. t := SymTab.InvalidType
  3303. ELSE
  3304. t := SymTab.FieldType(t, fn);
  3305. sfx := TRUE
  3306. END; .)
  3307. | "^"
  3308. (. astSel := AST.MakeNode(AST.NkSelector);
  3309. AST.SetOp(astSel, AST.SelDeref);
  3310. AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
  3311. ELSIF SymTab.ClassOf(t) #
  3312. SymTab.ClPtr THEN
  3313. SemError(219);
  3314. t := SymTab.InvalidType
  3315. ELSE
  3316. bt := SymTab.PtrBase(t);
  3317. IF bt = SymTab.InvalidType THEN
  3318. ELSE
  3319. t := bt;
  3320. sfx := TRUE
  3321. END
  3322. END; .) } (. astCur := astDes; .) .
  3323. (* Result suffix (ISO component after a function call): `F()^`,
  3324. `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
  3325. (a value, or a descriptor address for aggregates); each component
  3326. descends one level exactly like the Design components. *)
  3327. ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
  3328. VAR sfx: BOOLEAN; VAR node: AST.Node;
  3329. VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
  3330. VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
  3331. iq, ql, qlo, qhi, qe, qb:
  3332. QbeGen.QVal;
  3333. lo, hi, fo: INTEGER;
  3334. isOpen: BOOLEAN;
  3335. fname: SymTab.Name;
  3336. astWrap, astSel: AST.Node; .)
  3337. = "[" Expr<it, iq>
  3338. (. isM := FALSE;
  3339. IF AST.Kind(node) # AST.NkDesignator THEN
  3340. astWrap := AST.MakeNode(
  3341. AST.NkDesignator);
  3342. AST.SetChild(astWrap, 0, node);
  3343. node := astWrap
  3344. END;
  3345. AST.SetChild(node, AST.NChild(node),
  3346. AST.MakeUn(AST.NkSelector,
  3347. AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
  3348. ELSIF SymTab.ClassOf(t) #
  3349. SymTab.ClArray THEN
  3350. SemError(217);
  3351. t := SymTab.InvalidType
  3352. ELSIF NOT SymTab.IsIntFamily(it)
  3353. AND (SymTab.ClassOf(it) # SymTab.ClChar)
  3354. AND (SymTab.ClassOf(it) # SymTab.ClEnum)
  3355. AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
  3356. SemError(218);
  3357. t := SymTab.InvalidType
  3358. ELSE
  3359. eT := SymTab.ArrayElem(t);
  3360. t := eT; sfx := TRUE
  3361. END; .)
  3362. "]"
  3363. | "." GetIdent<fname>
  3364. (. isM := FALSE;
  3365. IF AST.Kind(node) # AST.NkDesignator THEN
  3366. astWrap := AST.MakeNode(
  3367. AST.NkDesignator);
  3368. AST.SetChild(astWrap, 0, node);
  3369. node := astWrap
  3370. END;
  3371. AST.SetChild(node, AST.NChild(node),
  3372. AST.MakeUn(AST.NkSelector,
  3373. AST.SelField,
  3374. AST.MakeLeaf(AST.NkIdent,
  3375. fname))); IF t = SymTab.InvalidType THEN
  3376. ELSIF (SymTab.ClassOf(t) #
  3377. SymTab.ClRecord)
  3378. AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
  3379. SemError(215);
  3380. t := SymTab.InvalidType
  3381. ELSIF (SymTab.ClassOf(t) =
  3382. SymTab.ClClass)
  3383. AND SymTab.MethodExists(t, fname) THEN
  3384. (* a method on the call result:
  3385. a following ArgList makes
  3386. the call *)
  3387. mname := fname;
  3388. methCls := t; isM := TRUE;
  3389. t := SymTab.InvalidType
  3390. ELSIF NOT SymTab.FieldExists(t,
  3391. fname) THEN
  3392. SemError(216);
  3393. t := SymTab.InvalidType
  3394. ELSE
  3395. t := SymTab.FieldType(t, fname);
  3396. sfx := TRUE
  3397. END; .)
  3398. | "^" (. isM := FALSE;
  3399. IF AST.Kind(node) # AST.NkDesignator THEN
  3400. astWrap := AST.MakeNode(
  3401. AST.NkDesignator);
  3402. AST.SetChild(astWrap, 0, node);
  3403. node := astWrap
  3404. END;
  3405. astSel := AST.MakeNode(AST.NkSelector);
  3406. AST.SetOp(astSel, AST.SelDeref);
  3407. AST.SetChild(node,
  3408. AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
  3409. ELSIF SymTab.ClassOf(t) #
  3410. SymTab.ClPtr THEN
  3411. SemError(219);
  3412. t := SymTab.InvalidType
  3413. ELSE
  3414. bt := SymTab.PtrBase(t);
  3415. IF bt # SymTab.InvalidType THEN
  3416. t := bt; sfx := TRUE
  3417. END
  3418. END; .) .
  3419. Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  3420. (. VAR t2: SymTab.TypeIndex;
  3421. op: INTEGER;
  3422. q2, qt, wl: QbeGen.QVal;
  3423. astA, astB: AST.Node;
  3424. astOp: INTEGER;
  3425. astMade: BOOLEAN;
  3426. isR: BOOLEAN;
  3427. v1, v2: INTEGER;
  3428. b: BOOLEAN; .)
  3429. = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
  3430. [ Rel<op> SimExpr<t2, q2>
  3431. (. astB := astCur; astMade := TRUE;
  3432. astOp := AST.OpEq;
  3433. IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
  3434. ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
  3435. ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
  3436. ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
  3437. ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
  3438. ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
  3439. ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
  3440. END;
  3441. IF op = SymTab.OpIn THEN
  3442. IF SymTab.InCheck(t, t2) THEN
  3443. IF (t = SymTab.InvalidType)
  3444. OR (t2 = SymTab.InvalidType) THEN
  3445. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  3446. ELSE
  3447. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  3448. END
  3449. ELSE SemError(222); t := SymTab.InvalidType;
  3450. QbeGen.CopyOp("0", q)
  3451. END
  3452. ELSIF SymTab.RelCheck(t, t2, op) THEN
  3453. IF (t = SymTab.InvalidType)
  3454. OR (t2 = SymTab.InvalidType) THEN
  3455. t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
  3456. ELSIF SymTab.IsOrdinal(t) AND SymTab.IsOrdinal(t2)
  3457. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2)
  3458. AND SymTab.ConstInt(q, v1)
  3459. AND SymTab.ConstInt(q2, v2) THEN
  3460. (* fold a relation of two ordinal constants (needed for
  3461. ORD(boolean) in a CONST initialiser) *)
  3462. IF op = SymTab.OpEq THEN b := v1 = v2
  3463. ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN
  3464. b := v1 # v2
  3465. ELSIF op = SymTab.OpLt THEN b := v1 < v2
  3466. ELSIF op = SymTab.OpLe THEN b := v1 <= v2
  3467. ELSIF op = SymTab.OpGt THEN b := v1 > v2
  3468. ELSE b := v1 >= v2
  3469. END;
  3470. t := SymTab.BoolType();
  3471. IF b THEN QbeGen.CopyOp("1", q)
  3472. ELSE QbeGen.CopyOp("0", q)
  3473. END
  3474. ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
  3475. OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
  3476. IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
  3477. AND (op # SymTab.OpNeq2) THEN
  3478. SemError(213); t := SymTab.InvalidType;
  3479. QbeGen.CopyOp("0", q)
  3480. ELSE
  3481. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  3482. END
  3483. ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
  3484. OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  3485. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  3486. ELSIF SymTab.StrCompat(t, t2) THEN
  3487. QbeGen.StrEq(op, q, q2, qt);
  3488. t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
  3489. ELSIF SymTab.IsLongFamily(t)
  3490. OR SymTab.IsLongFamily(t2) THEN
  3491. t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
  3492. ELSE
  3493. t := SymTab.BoolType();
  3494. QbeGen.CopyOp("@", q)
  3495. END
  3496. ELSE SemError(213); t := SymTab.InvalidType;
  3497. QbeGen.CopyOp("0", q)
  3498. END;
  3499. astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
  3500. (. IF NOT astMade THEN astCur := astA END; .)
  3501. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  3502. Rel<VAR op: INTEGER>
  3503. = "=" (. op := SymTab.OpEq; .)
  3504. | "#" (. op := SymTab.OpNeq1; .)
  3505. | "<" (. op := SymTab.OpLt; .)
  3506. | "<=" (. op := SymTab.OpLe; .)
  3507. | ">" (. op := SymTab.OpGt; .)
  3508. | ">=" (. op := SymTab.OpGe; .)
  3509. | "IN" (. op := SymTab.OpIn; .) .
  3510. SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  3511. (. VAR t2, res2, lt, rt:
  3512. SymTab.TypeIndex;
  3513. op: INTEGER;
  3514. q2, qt, wq, qf, q2a, q2b:
  3515. QbeGen.QVal;
  3516. neg, isR, isL, folded:
  3517. BOOLEAN;
  3518. fok: BOOLEAN;
  3519. lw, rw, mw: CARDINAL;
  3520. lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
  3521. astA, astB: AST.Node;
  3522. astSign, astOp: INTEGER;
  3523. v1, v2: INTEGER;
  3524. s: ARRAY [0 .. 255] OF CHAR; .)
  3525. = (. neg := FALSE; astSign := 0; .)
  3526. [ "+" (. neg := TRUE; astSign := 1; .)
  3527. | "-" (. neg := TRUE; astSign := -1; .) ]
  3528. Term<t, q> (. astA := astCur;
  3529. IF neg AND QbeGen.IsImm(q) THEN
  3530. QbeGen.NegFold(q, q)
  3531. END;
  3532. IF astSign < 0 THEN
  3533. astCur := AST.MakeUn(
  3534. AST.NkUnary, AST.OpSub, astA);
  3535. astA := astCur
  3536. END; .)
  3537. { AddOp<op>
  3538. Term<t2, q2> (. astB := astCur; .)
  3539. (. astOp := AST.OpAdd;
  3540. IF op = SymTab.OpSub THEN astOp := AST.OpSub
  3541. ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
  3542. astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
  3543. astCur := astA;
  3544. IF op = SymTab.OpOr THEN
  3545. (* short-circuit: if q is true the RHS is skipped *)
  3546. IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
  3547. t := SymTab.BoolType()
  3548. ELSE SemError(212); t := SymTab.InvalidType END;
  3549. IF t # SymTab.InvalidType THEN
  3550. QbeGen.CopyOp("@", q)
  3551. ELSE QbeGen.CopyOp("0", q)
  3552. END
  3553. ELSIF (op = SymTab.OpAdd)
  3554. AND (SymTab.ClassOf(t) = SymTab.ClChar)
  3555. AND (SymTab.ClassOf(t2) = SymTab.ClChar)
  3556. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  3557. (* "W" + "o": two one-character string literals concatenate
  3558. to a two-character string (they are CHAR-typed immediates) *)
  3559. IF SymTab.ConstInt(q, v1) AND SymTab.ConstInt(q2, v2)
  3560. AND (v1 >= 0) AND (v1 <= 255)
  3561. AND (v2 >= 0) AND (v2 <= 255) THEN
  3562. s[0] := '"'; s[1] := CHR(v1); s[2] := CHR(v2);
  3563. s[3] := '"'; s[4] := CHR(0);
  3564. QbeGen.DeclStr(s, qt); QbeGen.CopyOp(qt, q);
  3565. t := SymTab.NewStr();
  3566. astA := AST.MakeLeaf(AST.NkStrLit, s);
  3567. astCur := astA
  3568. ELSE SemError(211); t := SymTab.InvalidType;
  3569. QbeGen.CopyOp("0", q)
  3570. END
  3571. ELSIF (op = SymTab.OpAdd)
  3572. AND (SymTab.UStrCompat(t, t2)
  3573. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  3574. AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
  3575. OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
  3576. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
  3577. OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
  3578. AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
  3579. (* UString concatenation: a UCHAR operand becomes a
  3580. 1-codepoint UString; the result is a descriptor in the
  3581. shim's concat buffer. Work on copies so neither
  3582. operand is clobbered. *)
  3583. t := SymTab.NewUStr();
  3584. QbeGen.CopyOp("@", q)
  3585. ELSIF (op = SymTab.OpAdd)
  3586. AND (SymTab.StrCompat(t, t2)
  3587. OR (SymTab.IsStrType(t)
  3588. AND (SymTab.ClassOf(t2) = SymTab.ClChar))
  3589. OR ((SymTab.ClassOf(t) = SymTab.ClChar)
  3590. AND SymTab.IsStrType(t2))) THEN
  3591. (* string concatenation; a CHAR operand becomes a
  3592. 1-character string literal. When both operands are
  3593. constants, fold to a single string literal so a
  3594. constructor element stays compile-time. *)
  3595. QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
  3596. qt, fok);
  3597. IF fok THEN QbeGen.CopyOp(qt, q)
  3598. ELSE QbeGen.CopyOp("@", q)
  3599. END;
  3600. t := SymTab.NewStr()
  3601. ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  3602. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  3603. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  3604. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  3605. mw := lw;
  3606. IF rw > mw THEN mw := rw END;
  3607. t := SymTab.NewSet(
  3608. SymTab.NewSubR(0,
  3609. VAL(INTEGER, mw) * 32 - 1));
  3610. QbeGen.CopyOp("@", q)
  3611. ELSE
  3612. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
  3613. lt := t; rt := t2; t := res2
  3614. ELSE SemError(211); t := SymTab.InvalidType END;
  3615. IF t # SymTab.InvalidType THEN
  3616. isL := SymTab.IsLongFamily(t);
  3617. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  3618. folded := FALSE;
  3619. IF (NOT isL) AND (NOT isR)
  3620. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  3621. IF op = SymTab.OpAdd THEN
  3622. folded := QbeGen.Fold2(0, q, q2, qf)
  3623. ELSE
  3624. folded := QbeGen.Fold2(1, q, q2, qf)
  3625. END
  3626. END;
  3627. IF folded THEN QbeGen.CopyOp(qf, q)
  3628. ELSE
  3629. QbeGen.CopyOp("@", q)
  3630. END
  3631. ELSE QbeGen.CopyOp("0", q)
  3632. END
  3633. END; .) }
  3634. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  3635. AddOp<VAR op: INTEGER>
  3636. = "+" (. op := SymTab.OpAdd; .)
  3637. | "-" (. op := SymTab.OpSub; .)
  3638. | "OR" (. op := SymTab.OpOr; .) .
  3639. Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  3640. (. VAR t2, res2, lt, rt:
  3641. SymTab.TypeIndex;
  3642. op: INTEGER;
  3643. q2, qt, wq, qf:
  3644. QbeGen.QVal;
  3645. isR, isL, folded: BOOLEAN;
  3646. lw, rw, mw: CARDINAL;
  3647. lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
  3648. astA, astB: AST.Node;
  3649. astOp: INTEGER; .)
  3650. = Fact<t, q> (. astA := astCur; .) { MulOp<op>
  3651. Fact<t2, q2> (. astB := astCur; .)
  3652. (. astOp := AST.OpMul;
  3653. IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
  3654. ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
  3655. ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
  3656. ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
  3657. astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
  3658. astCur := astA;
  3659. IF op = SymTab.OpAnd THEN
  3660. (* short-circuit: if q is false the RHS is skipped *)
  3661. IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
  3662. t := SymTab.BoolType()
  3663. ELSE SemError(212); t := SymTab.InvalidType END;
  3664. IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
  3665. ELSE QbeGen.CopyOp("0", q)
  3666. END
  3667. ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
  3668. AND (SymTab.ClassOf(t) = SymTab.ClSet)
  3669. AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  3670. lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
  3671. mw := lw;
  3672. IF rw > mw THEN mw := rw END;
  3673. t := SymTab.NewSet(
  3674. SymTab.NewSubR(0,
  3675. VAL(INTEGER, mw) * 32 - 1));
  3676. QbeGen.CopyOp("@", q)
  3677. ELSE
  3678. IF SymTab.ArithCheck(t, t2,
  3679. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  3680. res2) THEN
  3681. lt := t; rt := t2; t := res2
  3682. ELSE SemError(211); t := SymTab.InvalidType END;
  3683. IF t # SymTab.InvalidType THEN
  3684. isL := SymTab.IsLongFamily(t);
  3685. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  3686. folded := FALSE;
  3687. IF (NOT isL) AND (NOT isR)
  3688. AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
  3689. IF op = SymTab.OpTimes THEN
  3690. folded := QbeGen.Fold2(2, q, q2, qf)
  3691. ELSIF op = SymTab.OpDiv THEN
  3692. folded := QbeGen.Fold2(3, q, q2, qf)
  3693. ELSIF op = SymTab.OpMod THEN
  3694. folded := QbeGen.Fold2(4, q, q2, qf)
  3695. END
  3696. END;
  3697. IF folded THEN QbeGen.CopyOp(qf, q)
  3698. ELSE
  3699. QbeGen.CopyOp("@", q)
  3700. END
  3701. ELSE QbeGen.CopyOp("0", q)
  3702. END
  3703. END; .) }
  3704. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  3705. MulOp<VAR op: INTEGER>
  3706. = "*" (. op := SymTab.OpTimes; .)
  3707. | "/" (. op := SymTab.OpSlash; .)
  3708. | "DIV" (. op := SymTab.OpDiv; .)
  3709. | "MOD" (. op := SymTab.OpMod; .)
  3710. | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
  3711. Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  3712. (. VAR s: ARRAY [0 .. 255] OF CHAR;
  3713. et, dt, t2, st, ct2, et2:
  3714. SymTab.TypeIndex;
  3715. dk: INTEGER;
  3716. qd, q2, sq, qa, qm0, qr, qt:
  3717. QbeGen.QVal;
  3718. qn, vn: SymTab.Name;
  3719. vt: SymTab.TypeIndex;
  3720. c1, c2: INTEGER;
  3721. lo, hi: INTEGER;
  3722. isMax: BOOLEAN;
  3723. called, isHigh, sfx, isCh,
  3724. isU, uok, isStr: BOOLEAN;
  3725. ucp: INTEGER; astIsLit: BOOLEAN;
  3726. astD: AST.Node;
  3727. astCall: BOOLEAN;
  3728. astNode, astNot: AST.Node;
  3729. j: CARDINAL;
  3730. astArg2: AST.Node;
  3731. astBrace: AST.Node;
  3732. astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
  3733. isConvF: BOOLEAN;
  3734. fi, fj: CARDINAL; .)
  3735. = (. astIsLit := FALSE; .)
  3736. ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
  3737. astIsLit := TRUE;
  3738. astCur := AST.MakeLeaf(
  3739. AST.NkIntLit, q);
  3740. t := SymTab.IntType(); .)
  3741. | "__FUNCTION__" (. (* fold to the current procedure
  3742. (module name at unit level) *)
  3743. s[0] := '"'; fi := 1; fj := 0;
  3744. IF curFun[0] = CHR(0) THEN
  3745. WHILE (unitName[fj] # CHR(0))
  3746. AND (fi < HIGH(s)) DO
  3747. s[fi] := unitName[fj];
  3748. INC(fi); INC(fj)
  3749. END
  3750. ELSE
  3751. WHILE (curFun[fj] # CHR(0))
  3752. AND (fi < HIGH(s)) DO
  3753. s[fi] := curFun[fj];
  3754. INC(fi); INC(fj)
  3755. END
  3756. END;
  3757. s[fi] := '"';
  3758. s[fi + 1] := CHR(0);
  3759. astIsLit := TRUE;
  3760. astCur := AST.MakeLeaf(
  3761. AST.NkStrLit, s);
  3762. t := SymTab.NewStr();
  3763. QbeGen.DeclStr(s, q); .)
  3764. | "__FILE__" (. (* fold to the quoted file name *)
  3765. s[0] := '"'; fi := 1; fj := 0;
  3766. WHILE (M2S.fileName[fj] # CHR(0))
  3767. AND (fi < HIGH(s)) DO
  3768. s[fi] := M2S.fileName[fj];
  3769. INC(fi); INC(fj)
  3770. END;
  3771. s[fi] := '"';
  3772. s[fi + 1] := CHR(0);
  3773. astIsLit := TRUE;
  3774. astCur := AST.MakeLeaf(
  3775. AST.NkStrLit, s);
  3776. t := SymTab.NewStr();
  3777. QbeGen.DeclStr(s, q); .)
  3778. | integer (. LexString(s);
  3779. QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
  3780. t := SymTab.IntType(); .)
  3781. | charConst (. LexString(s);
  3782. QbeGen.NormLit(s, q, isCh);
  3783. astIsLit := TRUE;
  3784. astCur := AST.MakeLeaf(
  3785. AST.NkCharLit, s);
  3786. t := SymTab.CharType(); .)
  3787. | real (. LexString(s);
  3788. QbeGen.NormReal(s, q);
  3789. astIsLit := TRUE;
  3790. astCur := AST.MakeLeaf(
  3791. AST.NkRealLit, s);
  3792. t := SymTab.RealType(); .)
  3793. | string (. LexString(s);
  3794. astIsLit := TRUE;
  3795. astCur := AST.MakeLeaf(
  3796. AST.NkStrLit, s);
  3797. IF SymTab.StrLen(s) = 3 THEN
  3798. t := SymTab.CharType();
  3799. QbeGen.IntStr(
  3800. QbeGen.CharVal(s), q)
  3801. ELSIF SymTab.StrLen(s) = 2 THEN
  3802. (* empty string: a string value
  3803. for arrays, 0 for CHAR *)
  3804. t := SymTab.NewEmptyStr();
  3805. QbeGen.DeclStr(s, q)
  3806. ELSE t := SymTab.NewStr();
  3807. QbeGen.DeclStr(s, q);
  3808. (* a literal's value IS its
  3809. static descriptor address *)
  3810. END; .)
  3811. | ustring (. LexString(s);
  3812. astIsLit := TRUE;
  3813. astCur := AST.MakeLeaf(
  3814. AST.NkStrLit, s);
  3815. QbeGen.DeclUStr(s, q, isU, ucp,
  3816. uok);
  3817. IF NOT uok THEN
  3818. SemError(234);
  3819. t := SymTab.InvalidType
  3820. ELSIF isU THEN
  3821. t := SymTab.UCharType();
  3822. QbeGen.IntStr(ucp, q)
  3823. ELSE
  3824. t := SymTab.NewUStr();
  3825. END; .)
  3826. | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
  3827. astNArgs := 0; called := FALSE;
  3828. t := dt;
  3829. IF dk = SymTab.KindConst THEN
  3830. QbeGen.CopyOp(qd, q)
  3831. ELSE QbeGen.CopyOp("@", q)
  3832. END; .)
  3833. [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
  3834. astBrace := astCur; .) ]
  3835. [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
  3836. (. astCall := TRUE;
  3837. IF (SymTab.SymKind(qn) = SymTab.KindType)
  3838. OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
  3839. (* T(x): emit as the VAL builtin so Lower's
  3840. conversion rules apply unchanged *)
  3841. astNode := AST.MakeNode(AST.NkCall);
  3842. AST.SetChild(astNode, 0,
  3843. AST.MakeLeaf(AST.NkIdent, "VAL"));
  3844. AST.SetChild(astNode, 1,
  3845. AST.MakeLeaf(AST.NkIdent, qn));
  3846. IF astNArgs = 1 THEN
  3847. AST.SetChild(astNode, 2, astArgs[0])
  3848. END;
  3849. isConvF := TRUE
  3850. ELSE astNode := AstCallNode(astD)
  3851. END;
  3852. astRes := astNode;
  3853. t := ct2;
  3854. QbeGen.CopyOp(q2, q);
  3855. IF isConvF AND QbeGen.IsImm(convQ)
  3856. AND OrdClass(convT) AND OrdClass(ct2) THEN
  3857. QbeGen.CopyOp(convQ, q)
  3858. END;
  3859. sfx := FALSE; .)
  3860. { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
  3861. [ (. astNArgs := 0; .)
  3862. ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
  3863. (. astNode := AstCallNode(astRes);
  3864. astRes := astNode;
  3865. t := ct2;
  3866. QbeGen.CopyOp(q2, q);
  3867. sfx := FALSE; .) ] }
  3868. (. IF sfx THEN
  3869. IF t = SymTab.InvalidType THEN
  3870. QbeGen.CopyOp("0", q)
  3871. ELSIF (SymTab.ClassOf(t) #
  3872. SymTab.ClRecord)
  3873. AND (SymTab.ClassOf(t) # SymTab.ClSet)
  3874. AND (SymTab.ClassOf(t) # SymTab.ClArray)
  3875. AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
  3876. QbeGen.CopyOp("@", q)
  3877. END
  3878. END; .) ]
  3879. (. IF called THEN
  3880. astCur := astRes
  3881. ELSIF astCall THEN
  3882. astCur := astBrace
  3883. ELSE astCur := astD
  3884. END;
  3885. astIsLit := TRUE;
  3886. IF NOT called
  3887. AND (dk = SymTab.KindProc) THEN
  3888. (* bare zero-arg function
  3889. call (parentheses may be
  3890. omitted); a proper or
  3891. parameterised proc here
  3892. is 230 *)
  3893. IF (SymTab.ProcNPar(qn) = 0)
  3894. AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
  3895. t := SymTab.ProcRes(qn);
  3896. QbeGen.CopyOp("@", q);
  3897. astCur := AST.MakeNode(AST.NkCall);
  3898. AST.SetChild(astCur, 0, astD)
  3899. ELSE
  3900. t := SymTab.ProcTypeOf(qn);
  3901. QbeGen.CopyOp("@", q)
  3902. END
  3903. END; .)
  3904. | ( "HIGH" (. isHigh := TRUE; .)
  3905. | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
  3906. "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
  3907. isU := FALSE; .)
  3908. | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
  3909. isStr := TRUE;
  3910. isU := FALSE;
  3911. IF SymTab.StrLen(s) = 3 THEN
  3912. dt := SymTab.CharType();
  3913. QbeGen.IntStr(QbeGen.CharVal(s),
  3914. qd)
  3915. ELSE
  3916. dt := SymTab.NewStr();
  3917. QbeGen.DeclStr(s, qd);
  3918. END;
  3919. dk := -1;
  3920. qn[0] := CHR(0); .)
  3921. | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
  3922. QbeGen.DeclUStr(s, qd, isU, ucp,
  3923. uok);
  3924. isStr := FALSE;
  3925. IF NOT uok THEN
  3926. SemError(234);
  3927. dt := SymTab.InvalidType
  3928. ELSIF isU THEN
  3929. (* one codepoint: a UCHAR;
  3930. LEN is 1, HIGH is 0 *)
  3931. dt := SymTab.UCharType();
  3932. QbeGen.IntStr(ucp, qd)
  3933. ELSE
  3934. dt := SymTab.NewUStr();
  3935. END;
  3936. dk := -1;
  3937. qn[0] := CHR(0); .) )
  3938. ")"
  3939. (. astNode := AST.MakeNode(AST.NkCall);
  3940. IF isHigh THEN AST.SetChild(astNode, 0,
  3941. AST.MakeLeaf(AST.NkIdent, "HIGH"))
  3942. ELSE AST.SetChild(astNode, 0,
  3943. AST.MakeLeaf(AST.NkIdent, "LEN")) END;
  3944. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  3945. astCur := astNode; astIsLit := TRUE;
  3946. IF (dt # SymTab.InvalidType)
  3947. AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
  3948. (* UString: the count is
  3949. the descriptor header *)
  3950. t := SymTab.IntType();
  3951. QbeGen.CopyOp("@", q)
  3952. ELSIF (dt # SymTab.InvalidType)
  3953. AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
  3954. (* single UCHAR codepoint *)
  3955. IF isHigh THEN
  3956. QbeGen.CopyOp("0", qr)
  3957. ELSE
  3958. QbeGen.CopyOp("1", qr)
  3959. END;
  3960. t := SymTab.IntType();
  3961. QbeGen.CopyOp(qr, q)
  3962. ELSIF isStr THEN
  3963. (* fold: content length at
  3964. compile time *)
  3965. IF SymTab.StrLen(s) = 3 THEN
  3966. c1 := 1
  3967. ELSE
  3968. c1 :=
  3969. SymTab.StrLen(s) - 2
  3970. END;
  3971. IF isHigh THEN
  3972. DEC(c1)
  3973. END;
  3974. QbeGen.IntStr(c1, qr);
  3975. t := SymTab.IntType();
  3976. QbeGen.CopyOp(qr, q)
  3977. ELSIF dt = SymTab.InvalidType THEN
  3978. t := SymTab.InvalidType;
  3979. QbeGen.CopyOp("0", q)
  3980. ELSIF SymTab.ClassOf(dt) =
  3981. SymTab.ClStr THEN
  3982. (* HIGH/LEN of a string
  3983. CONST: its pooled literal
  3984. knows its length *)
  3985. IF QbeGen.StrLitLen(qd, c1) THEN
  3986. IF isHigh THEN DEC(c1) END;
  3987. QbeGen.IntStr(VAL(INTEGER, c1),
  3988. qr);
  3989. t := SymTab.IntType();
  3990. QbeGen.CopyOp(qr, q)
  3991. ELSE SemError(217);
  3992. t := SymTab.InvalidType;
  3993. QbeGen.CopyOp("0", q)
  3994. END
  3995. ELSIF SymTab.ClassOf(dt) #
  3996. SymTab.ClArray THEN
  3997. SemError(217);
  3998. t := SymTab.InvalidType;
  3999. QbeGen.CopyOp("0", q)
  4000. ELSE
  4001. IF SymTab.IsOpenArray(dt) THEN
  4002. t := SymTab.IntType();
  4003. QbeGen.CopyOp("@", q)
  4004. ELSE
  4005. IF isHigh THEN
  4006. QbeGen.IntStr(
  4007. SymTab.ArrayHi(dt), qr)
  4008. ELSE
  4009. QbeGen.IntStr(VAL(
  4010. INTEGER,
  4011. SymTab.ArrayLen(dt)),
  4012. qr)
  4013. END;
  4014. t := SymTab.IntType();
  4015. QbeGen.CopyOp(qr, q)
  4016. END
  4017. END; .)
  4018. | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
  4019. (. astNode := AST.MakeNode(AST.NkCall);
  4020. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
  4021. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4022. astCur := astNode; astIsLit := TRUE; .)
  4023. (. IF dt = SymTab.InvalidType THEN
  4024. t := SymTab.InvalidType;
  4025. QbeGen.CopyOp("0", q)
  4026. ELSE
  4027. QbeGen.IntStr(VAL(INTEGER,
  4028. SymTab.ObjectSize(dt)), q);
  4029. t := SymTab.IntType()
  4030. END; .)
  4031. | ( "SHIFT" (. isMax := FALSE; .)
  4032. | "ROTATE" (. isMax := TRUE; .) )
  4033. "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
  4034. (. astNode := AST.MakeNode(AST.NkCall);
  4035. IF isMax THEN AST.SetChild(astNode, 0,
  4036. AST.MakeLeaf(AST.NkIdent, "ROTATE"))
  4037. ELSE AST.SetChild(astNode, 0,
  4038. AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
  4039. IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
  4040. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
  4041. astCur := astNode; astIsLit := TRUE;
  4042. (* set shift/rotate: isMax
  4043. doubles as "rotate" *)
  4044. IF (et # SymTab.InvalidType)
  4045. AND (SymTab.ClassOf(et) =
  4046. SymTab.ClSet) THEN
  4047. t := et;
  4048. QbeGen.CopyOp("@", q)
  4049. ELSE SemError(230);
  4050. t := SymTab.InvalidType;
  4051. QbeGen.CopyOp("0", q)
  4052. END; .)
  4053. | ( "MIN" (. isMax := FALSE; .)
  4054. | "MAX" (. isMax := TRUE; .) )
  4055. "(" Design<dt, dk, qd, qn, sfx> ")"
  4056. (. astNode := AST.MakeNode(AST.NkCall);
  4057. IF isMax THEN AST.SetChild(astNode, 0,
  4058. AST.MakeLeaf(AST.NkIdent, "MAX"))
  4059. ELSE AST.SetChild(astNode, 0,
  4060. AST.MakeLeaf(AST.NkIdent, "MIN")) END;
  4061. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4062. astCur := astNode; astIsLit := TRUE;
  4063. IF (dt # SymTab.InvalidType)
  4064. AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
  4065. (* REAL/LONGREAL: the
  4066. implementation bounds *)
  4067. IF isMax THEN
  4068. QbeGen.NormReal(
  4069. "3.402823e38", q)
  4070. ELSE QbeGen.NormReal(
  4071. "-3.402823e38", q)
  4072. END;
  4073. t := SymTab.RealType()
  4074. ELSIF (dt #
  4075. SymTab.InvalidType)
  4076. AND (SymTab.ClassOf(dt) =
  4077. SymTab.ClLong) THEN
  4078. IF isMax THEN
  4079. QbeGen.CopyOp(
  4080. "9223372036854775807", q)
  4081. ELSE QbeGen.CopyOp(
  4082. "-9223372036854775808", q)
  4083. END;
  4084. t := SymTab.LongType()
  4085. ELSIF SymTab.TypeBounds(dt, lo,
  4086. hi) THEN
  4087. IF isMax THEN
  4088. QbeGen.IntStr(hi, q)
  4089. ELSE QbeGen.IntStr(lo, q)
  4090. END;
  4091. (* a set's bounds are those
  4092. of its base type *)
  4093. IF SymTab.ClassOf(dt) =
  4094. SymTab.ClSet THEN
  4095. t := SymTab.SetBase(dt)
  4096. ELSE t := SymTab.IntType()
  4097. END
  4098. ELSE SemError(230);
  4099. t := SymTab.InvalidType;
  4100. QbeGen.CopyOp("0", q)
  4101. END; .)
  4102. | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
  4103. (. astNode := AST.MakeNode(AST.NkCall);
  4104. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
  4105. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4106. astCur := astNode; astIsLit := TRUE; .)
  4107. (. IF dt = SymTab.InvalidType THEN
  4108. t := SymTab.InvalidType;
  4109. QbeGen.CopyOp("0", q)
  4110. ELSE
  4111. IF sfx
  4112. OR (dk = SymTab.KindVar)
  4113. OR (dk = SymTab.KindParam) THEN
  4114. QbeGen.CopyOp("@", q)
  4115. ELSE SemError(230);
  4116. QbeGen.CopyOp("0", q)
  4117. END;
  4118. t := SymTab.AddrType()
  4119. END; .)
  4120. | "CHR" "(" Expr<et, q> ")"
  4121. (. astNode := AST.MakeNode(AST.NkCall);
  4122. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
  4123. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4124. astCur := astNode; astIsLit := TRUE; .)
  4125. (. IF (et # SymTab.InvalidType)
  4126. AND NOT SymTab.IsIntFamily(et) THEN
  4127. SemError(211) END;
  4128. t := SymTab.CharType(); .)
  4129. | "ORD" "(" Expr<et, q> ")"
  4130. (. astNode := AST.MakeNode(AST.NkCall);
  4131. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
  4132. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4133. astCur := astNode; astIsLit := TRUE; .)
  4134. (. IF et # SymTab.InvalidType THEN
  4135. IF (SymTab.ClassOf(et) #
  4136. SymTab.ClChar)
  4137. AND (SymTab.ClassOf(et) #
  4138. SymTab.ClBool)
  4139. AND (SymTab.ClassOf(et) #
  4140. SymTab.ClEnum)
  4141. AND NOT SymTab.IsIntFamily(et)
  4142. AND NOT SymTab.IsPackedSet(et) THEN
  4143. SemError(211) END
  4144. END;
  4145. t := SymTab.IntType(); .)
  4146. | "CAP" "(" Expr<et, q> ")"
  4147. (. astNode := AST.MakeNode(AST.NkCall);
  4148. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
  4149. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4150. astCur := astNode; astIsLit := TRUE; .)
  4151. (. IF QbeGen.IsImm(q)
  4152. AND SymTab.ConstInt(q, lo) THEN
  4153. IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
  4154. QbeGen.IntStr(lo, q)
  4155. ELSE QbeGen.CopyOp("@", q)
  4156. END;
  4157. t := SymTab.CharType(); .)
  4158. | "UCHR" "(" Expr<et, q> ")"
  4159. (. astNode := AST.MakeNode(AST.NkCall);
  4160. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
  4161. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4162. astCur := astNode; astIsLit := TRUE; .)
  4163. (. (* UCHR: the UCHAR constructor.
  4164. CHAR -> UCHAR (identity);
  4165. INTEGER familly -> UCHAR
  4166. (codepoint value). *)
  4167. IF (et # SymTab.InvalidType)
  4168. AND (SymTab.ClassOf(et) # SymTab.ClChar)
  4169. AND NOT SymTab.IsIntFamily(et) THEN
  4170. SemError(211) END;
  4171. t := SymTab.UCharType(); .)
  4172. | "CHR8" "(" Expr<et, q> ")"
  4173. (. astNode := AST.MakeNode(AST.NkCall);
  4174. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
  4175. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4176. astCur := astNode; astIsLit := TRUE; .)
  4177. (. IF (et # SymTab.InvalidType)
  4178. AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
  4179. SemError(211) END;
  4180. t := SymTab.CharType(); .)
  4181. | "UORD" "(" Expr<et, q> ")"
  4182. (. astNode := AST.MakeNode(AST.NkCall);
  4183. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
  4184. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4185. astCur := astNode; astIsLit := TRUE; .)
  4186. (. (* UORD(u): the codepoint as a
  4187. 32-bit ordinal (INTEGER),
  4188. cf. ORD for CHAR. *)
  4189. IF (et # SymTab.InvalidType)
  4190. AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
  4191. SemError(211) END;
  4192. t := SymTab.IntType(); .)
  4193. | "ABS" "(" Expr<et, q> ")"
  4194. (. astNode := AST.MakeNode(AST.NkCall);
  4195. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
  4196. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4197. astCur := astNode; astIsLit := TRUE; .)
  4198. (. IF (et # SymTab.InvalidType)
  4199. AND NOT SymTab.IsIntFamily(et)
  4200. AND (SymTab.ClassOf(et) #
  4201. SymTab.ClReal) THEN
  4202. SemError(211)
  4203. ELSIF QbeGen.IsImm(q)
  4204. AND SymTab.ConstInt(q, lo) THEN
  4205. IF lo < 0 THEN lo := -lo END;
  4206. QbeGen.IntStr(lo, q)
  4207. ELSE QbeGen.CopyOp("@", q)
  4208. END;
  4209. t := et; .)
  4210. | "ODD" "(" Expr<et, q> ")"
  4211. (. astNode := AST.MakeNode(AST.NkCall);
  4212. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
  4213. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
  4214. astCur := astNode; astIsLit := TRUE; .)
  4215. (. IF (et # SymTab.InvalidType)
  4216. AND NOT SymTab.IsIntFamily(et) THEN
  4217. SemError(211) END;
  4218. t := SymTab.BoolType();
  4219. IF QbeGen.IsImm(q)
  4220. AND SymTab.ConstInt(q, lo) THEN
  4221. IF (lo MOD 2) # 0 THEN
  4222. QbeGen.CopyOp("1", q)
  4223. ELSE QbeGen.CopyOp("0", q)
  4224. END
  4225. ELSE QbeGen.CopyOp("@", q)
  4226. END; .)
  4227. | "TRUNC" "(" Expr<et, q> ")"
  4228. (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
  4229. astNode := AST.MakeNode(AST.NkCall);
  4230. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
  4231. AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
  4232. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
  4233. astCur := astNode; astIsLit := TRUE; .)
  4234. (. t := SymTab.IntType();
  4235. QbeGen.CopyOp("@", q); .)
  4236. | "FLOAT" "(" Expr<et, q> ")"
  4237. (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
  4238. astNode := AST.MakeNode(AST.NkCall);
  4239. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
  4240. AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
  4241. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
  4242. astCur := astNode; astIsLit := TRUE; .)
  4243. (. t := SymTab.RealType();
  4244. IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
  4245. ELSE QbeGen.CopyOp("@", q) END; .)
  4246. | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
  4247. (. astNode := AST.MakeNode(AST.NkCall);
  4248. AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
  4249. IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
  4250. IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
  4251. astCur := astNode; astIsLit := TRUE; .)
  4252. (. IF NOT SymTab.Lookup(vn) THEN
  4253. SemError(201);
  4254. t := SymTab.InvalidType
  4255. ELSE vt := SymTab.SymType(vn);
  4256. IF vt = SymTab.InvalidType THEN
  4257. t := SymTab.InvalidType
  4258. ELSIF et =
  4259. SymTab.InvalidType THEN
  4260. t := vt
  4261. ELSE
  4262. c1 := SymTab.ClassOf(et);
  4263. c2 := SymTab.ClassOf(vt);
  4264. IF ((c1 = SymTab.ClInt)
  4265. OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
  4266. OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
  4267. AND (c2 = SymTab.ClLong) THEN
  4268. IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
  4269. t := vt
  4270. ELSIF (c1 = SymTab.ClLong)
  4271. AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
  4272. OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
  4273. OR (c2 = SymTab.ClSWord16)) THEN
  4274. IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
  4275. t := vt
  4276. ELSIF ((c1 = SymTab.ClInt)
  4277. OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
  4278. OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
  4279. AND (c2 = SymTab.ClReal) THEN
  4280. IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
  4281. QbeGen.CopyOp(qa, q);
  4282. t := vt
  4283. ELSIF (c1 = SymTab.ClLong)
  4284. AND (c2 = SymTab.ClReal) THEN
  4285. IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
  4286. QbeGen.CopyOp(qa, q);
  4287. t := vt
  4288. ELSIF (c1 = SymTab.ClReal)
  4289. AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
  4290. OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
  4291. OR (c2 = SymTab.ClSWord16)) THEN
  4292. QbeGen.ConvRI(q, qa);
  4293. QbeGen.CopyOp(qa, q);
  4294. t := vt
  4295. ELSIF (c1 = SymTab.ClReal)
  4296. AND (c2 = SymTab.ClLong) THEN
  4297. QbeGen.ConvRL(q, qa);
  4298. QbeGen.CopyOp(qa, q);
  4299. t := vt
  4300. ELSIF (c1 = SymTab.ClLong)
  4301. AND (c2 = SymTab.ClLong) THEN
  4302. t := vt
  4303. ELSIF ((c1 = SymTab.ClInt)
  4304. OR (c1 =
  4305. SymTab.ClChar)
  4306. OR (c1 =
  4307. SymTab.ClBool)
  4308. OR (c1 =
  4309. SymTab.ClByte)
  4310. OR (c1 =
  4311. SymTab.ClSByte)
  4312. OR (c1 =
  4313. SymTab.ClWord16)
  4314. OR (c1 =
  4315. SymTab.ClSWord16)
  4316. OR (c1 =
  4317. SymTab.ClEnum))
  4318. AND ((c2 = SymTab.ClInt)
  4319. OR (c2 =
  4320. SymTab.ClChar)
  4321. OR (c2 =
  4322. SymTab.ClBool)
  4323. OR (c2 =
  4324. SymTab.ClByte)
  4325. OR (c2 =
  4326. SymTab.ClSByte)
  4327. OR (c2 =
  4328. SymTab.ClWord16)
  4329. OR (c2 =
  4330. SymTab.ClSWord16)
  4331. OR (c2 =
  4332. SymTab.ClEnum)) THEN
  4333. t := vt
  4334. ELSIF (c1 = SymTab.ClPtr)
  4335. AND (c2 = SymTab.ClPtr) THEN
  4336. t := vt
  4337. ELSIF ((c1 = SymTab.ClProc)
  4338. AND (c2 = SymTab.ClProc))
  4339. OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
  4340. OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
  4341. t := vt
  4342. ELSIF (c1 = SymTab.ClReal)
  4343. AND (c2 = SymTab.ClReal) THEN
  4344. t := vt
  4345. ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
  4346. OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
  4347. (* a set <-> its machine word (BITSET) *)
  4348. t := vt
  4349. ELSE SemError(230);
  4350. t := SymTab.InvalidType
  4351. END
  4352. END
  4353. END; .)
  4354. | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
  4355. | SetLit<st, sq> (. astIsLit := TRUE; t := st;
  4356. QbeGen.CopyOp(sq, q); .)
  4357. | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
  4358. IF SymTab.BoolCheck(t2) THEN
  4359. t := SymTab.BoolType()
  4360. ELSE SemError(212);
  4361. t := SymTab.InvalidType END;
  4362. IF t # SymTab.InvalidType THEN
  4363. QbeGen.CopyOp("@", q)
  4364. ELSE QbeGen.CopyOp("0", q)
  4365. END;
  4366. astIsLit := TRUE;
  4367. astCur := AST.MakeUn(
  4368. AST.NkUnary, AST.OpNot, astNot); .)
  4369. )
  4370. (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
  4371. (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
  4372. (* Set literals are SET OF [0..255] (8 words); elements validated
  4373. 0..255 statically when foldable (222 otherwise), runtime trap
  4374. for computed elements. Ranges always lower via SetRange. *)
  4375. SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  4376. (. VAR astNode: AST.Node; .)
  4377. = "{" (. t := SymTab.NewSet(
  4378. SymTab.NewSubR(0, 255));
  4379. astNode := AST.MakeNode(AST.NkSetLit);
  4380. QbeGen.NewSetTemp(8, q);
  4381. QbeGen.SetZero(q, 8); .)
  4382. [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
  4383. "}" (. astCur := astNode; .) .
  4384. (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
  4385. or ArrayName{...} (an array constructor, GNU Modula-2). The
  4386. declared type sets the width (set) or element type (array). *)
  4387. TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  4388. (. VAR nw: CARDINAL;
  4389. astNode, astTail: AST.Node;
  4390. savedCls: INTEGER; .)
  4391. = "{" (. savedCls := braceCls;
  4392. astNode := AST.MakeNode(AST.NkBraceLit);
  4393. AST.SetTy(astNode, vt);
  4394. astTail := astNode;
  4395. IF vt = SymTab.InvalidType THEN
  4396. braceCls := -1
  4397. ELSE braceCls :=
  4398. SymTab.ClassOf(vt)
  4399. END;
  4400. IF braceCls = SymTab.ClSet THEN
  4401. IF vt = SymTab.InvalidType THEN
  4402. nw := 8
  4403. ELSE nw := SymTab.SetWords(vt);
  4404. IF nw = 0 THEN nw := 8 END
  4405. END;
  4406. QbeGen.NewSetTemp(nw, q);
  4407. QbeGen.SetZero(q, nw)
  4408. ELSIF (braceCls =
  4409. SymTab.ClArray)
  4410. OR (braceCls =
  4411. SymTab.ClRecord)
  4412. OR (braceCls =
  4413. SymTab.ClClass) THEN
  4414. QbeGen.CtorBegin(vt)
  4415. ELSE
  4416. IF vt # SymTab.InvalidType THEN
  4417. SemError(230) END;
  4418. braceCls := -1
  4419. END; .)
  4420. [ BraceElem<vt, q, astNode, astTail>
  4421. { "," BraceElem<vt, q, astNode, astTail> } ]
  4422. "}" (. IF (braceCls = SymTab.ClArray)
  4423. OR (braceCls =
  4424. SymTab.ClRecord)
  4425. OR (braceCls =
  4426. SymTab.ClClass) THEN
  4427. QbeGen.CtorEnd(q)
  4428. ELSIF braceCls # SymTab.ClSet THEN
  4429. QbeGen.CopyOp("0", q)
  4430. END;
  4431. braceCls := savedCls; .)
  4432. (. astCur := astNode; .) .
  4433. BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
  4434. VAR node, tail: AST.Node>
  4435. (. VAR et, et2: SymTab.TypeIndex;
  4436. qe, q2: QbeGen.QVal;
  4437. v, v2, reps, k: INTEGER;
  4438. elem: SymTab.TypeIndex;
  4439. lo: INTEGER;
  4440. span: CARDINAL;
  4441. cl, cl2: INTEGER;
  4442. hasR, hasB: BOOLEAN;
  4443. astEl: AST.Node; .)
  4444. = (. hasR := FALSE; hasB := FALSE;
  4445. reps := 1; .)
  4446. Expr<et, qe> (. astEl := astCur; .)
  4447. [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
  4448. AST.NkSubrange, 0, astEl, astCur);
  4449. hasR := TRUE; .) ]
  4450. [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
  4451. (. IF braceCls = SymTab.ClSet THEN
  4452. IF hasB THEN SemError(230) END;
  4453. lo := SymTab.SetBaseLo(vt);
  4454. span := SymTab.SetCount(vt);
  4455. IF (et = SymTab.InvalidType)
  4456. OR (hasR AND (et2 =
  4457. SymTab.InvalidType)) THEN
  4458. ELSE cl :=
  4459. SymTab.ClassOf(et);
  4460. IF hasR THEN
  4461. cl2 :=
  4462. SymTab.ClassOf(et2)
  4463. ELSE cl2 := SymTab.ClInt
  4464. END;
  4465. IF NOT SymTab.SetElemClassOk(cl)
  4466. OR (hasR AND NOT
  4467. SymTab.SetElemClassOk(cl2))
  4468. THEN
  4469. SemError(222)
  4470. ELSIF hasR
  4471. AND SymTab.ConstInt(qe, v)
  4472. AND SymTab.ConstInt(q2,
  4473. v2)
  4474. AND ((v < lo)
  4475. OR (v2 < lo)
  4476. OR (v >= lo +
  4477. VAL(INTEGER, span))
  4478. OR (v2 >= lo +
  4479. VAL(INTEGER, span))
  4480. OR (v > v2)) THEN
  4481. SemError(222)
  4482. ELSIF hasR THEN
  4483. QbeGen.SetRange(sq, qe, q2,
  4484. lo, span)
  4485. ELSIF SymTab.ConstInt(qe,
  4486. v)
  4487. AND ((v < lo)
  4488. OR (v >= lo +
  4489. VAL(INTEGER,
  4490. span))) THEN
  4491. SemError(222)
  4492. ELSE QbeGen.SetBit(sq, qe,
  4493. lo, span)
  4494. END
  4495. END
  4496. ELSIF (braceCls = SymTab.ClArray)
  4497. OR (braceCls =
  4498. SymTab.ClRecord)
  4499. OR (braceCls =
  4500. SymTab.ClClass) THEN
  4501. IF hasR THEN SemError(230) END;
  4502. reps := 1;
  4503. IF hasB THEN
  4504. IF SymTab.ConstInt(q2, v2)
  4505. AND (v2 >= 1) THEN
  4506. reps := v2
  4507. ELSE SemError(230)
  4508. END
  4509. END;
  4510. k := 0;
  4511. WHILE k < reps DO
  4512. QbeGen.CtorElem(qe);
  4513. INC(k)
  4514. END
  4515. END; .)
  4516. (. (* the BY form repeats the
  4517. element; keep the AST in
  4518. step with CtorElem *)
  4519. k := 0;
  4520. WHILE k < reps DO
  4521. AstAppend(AST.NkBlock,
  4522. node, tail, astEl);
  4523. INC(k)
  4524. END; .) .
  4525. SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
  4526. qe, q2: QbeGen.QVal;
  4527. v, v2: INTEGER;
  4528. lo: INTEGER;
  4529. span: CARDINAL;
  4530. cl, cl2: INTEGER;
  4531. hasR: BOOLEAN;
  4532. astEl: AST.Node; .)
  4533. = (. hasR := FALSE; .)
  4534. Expr<et, qe> (. astEl := astCur; .)
  4535. [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
  4536. AST.NkSubrange, 0, astEl, astCur);
  4537. hasR := TRUE; .) ]
  4538. (. lo := SymTab.SetBaseLo(st);
  4539. span := SymTab.SetCount(st);
  4540. IF (et = SymTab.InvalidType)
  4541. OR (hasR AND (et2 =
  4542. SymTab.InvalidType)) THEN
  4543. ELSE cl :=
  4544. SymTab.ClassOf(et);
  4545. IF hasR THEN
  4546. cl2 :=
  4547. SymTab.ClassOf(et2)
  4548. ELSE cl2 := SymTab.ClInt
  4549. END;
  4550. IF NOT SymTab.SetElemClassOk(cl)
  4551. OR (hasR AND NOT
  4552. SymTab.SetElemClassOk(cl2))
  4553. THEN
  4554. SemError(222)
  4555. ELSIF hasR
  4556. AND SymTab.ConstInt(qe, v)
  4557. AND SymTab.ConstInt(q2,
  4558. v2)
  4559. AND ((v < lo)
  4560. OR (v2 < lo)
  4561. OR (v >= lo +
  4562. VAL(INTEGER, span))
  4563. OR (v2 >= lo +
  4564. VAL(INTEGER, span))
  4565. OR (v > v2)) THEN
  4566. SemError(222)
  4567. ELSIF hasR THEN
  4568. QbeGen.SetRange(sq, qe, q2,
  4569. lo, span)
  4570. ELSIF SymTab.ConstInt(qe,
  4571. v)
  4572. AND ((v < lo)
  4573. OR (v >= lo +
  4574. VAL(INTEGER,
  4575. span))) THEN
  4576. SemError(222)
  4577. ELSE QbeGen.SetBit(sq, qe,
  4578. lo, span)
  4579. END
  4580. END; .)
  4581. (. AST.SetChild(node,
  4582. AST.NChild(node), astEl); .) .
  4583. GetIdent<VAR n: SymTab.Name>
  4584. = ident (. LexName(n); .) .
  4585. END M2.