M2.atg 185 KB

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