M2.atg 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176
  1. COMPILER M2
  2. (* =============================================================================
  3. TopSpeed Modula-2 V3 - COMPLETE GRAMMAR (Coco/R .atg form)
  4. Historical JPI/Clarion V3 dialect, reconstructed from the real TS-V3
  5. corpus (TABLE/GWINM2P/GWINC2M/BYTEFIDD/CLUB/RS/Modbase) + the shipped
  6. CR.MOD reserved words + PIM/ISO Modula-2 reference forms.
  7. This ATG is the deliverable of the "complete V3 grammar" work item.
  8. It intentionally DIVERGES from the modern m2compiler-V3 subset's
  9. locked rules where the corpus proves the original dialect differed:
  10. - identifiers carry '_' and '@' (Graph._VGA, ct__@Fssssi)
  11. - '&' = AND , '~' = NOT , '<>' = '#' (all accepted)
  12. - literal suffixes H (hex), C (char), B (base-8/octal),
  13. plus 0x/0X hex-prefix forms
  14. - `::=` constant alias form (GCoord::=INTEGER)
  15. - anchored type subranges (SHORTINT[-1..1])
  16. - qualified type/designator idents (Client.ClientRec, t2.Root,
  17. p^.Left, S1[sp1], Graph.GetVideoConfig(vc))
  18. - full composite types: ARRAY (fixed + open), RECORD + variants,
  19. SET OF (range/base/enum forms), POINTER TO, PROCEDURE types
  20. - statements: WITH, IN, IS, set constructors {}, shifts << >>,
  21. procedure/function call statements
  22. - Clarion-form classes with multi-parent CLAUSE (extra parent = 230)
  23. Constructs the current scalar backend cannot lower yet PARSE fully
  24. and end with the standard SemError(230) "not supported yet" marker,
  25. exactly like M2.atg's parse-now/lower-later discipline. Semantic
  26. error codes reused from the V1/V2/Test2 family:
  27. 200 duplicate, 201 undeclared, 202 module name mismatch,
  28. 210 bad assignment, 211 bad arithmetic, 212 boolean operand,
  29. 213 incompatible comparison, 214 boolean cond required,
  30. 220 FOR needs integer var/bounds, 221 not a type name,
  31. 222 set operand mismatch, 230 not supported yet,
  32. 231 opaque type outside definition, 232 bad RETURN.
  33. LL(1) notes (accepted as benign, verified correct codegen):
  34. - TypeBlock's CLASS/CLASS IMPLEMENTATION 2-token lookahead
  35. - variant-record CASE labels sharing first-sets with field
  36. identifier lists (classic Modula-2 ambiguity).
  37. ============================================================================= *)
  38. IMPORT SymTab, QbeGen;
  39. CHARACTERS
  40. eol = CHR(13) .
  41. lf = CHR(10) .
  42. letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
  43. digit = "0123456789" .
  44. octDigit = "01234567" .
  45. hexDigit = digit + "ABCDEFabcdef" .
  46. noQuote1 = ANY - "'" - eol .
  47. noQuote2 = ANY - '"' - eol .
  48. IGNORE CHR(9) .. CHR(13)
  49. COMMENTS FROM "(*" TO "*)" NESTED
  50. COMMENTS FROM "//" TO lf
  51. TOKENS
  52. (* V3 identifier: classic letters/digits PLUS '_' and '@' which the
  53. shipped code uses freely (Graph._VGA, _Find, ct__@Fssssi). *)
  54. ident = ( letter | "_" ) { letter | digit | "_" | "@" } .
  55. (* Numbers. V3 kept the PIM qualified forms: trailing H = hex,
  56. trailing C = character constant (hex value), trailing B = base-8
  57. (the Modbase date code needs 60B = 48 = ORD('0'), i.e. octal 60);
  58. modern 0x/0X hex-prefix also accepted (TS Dev Guide). The
  59. CONTEXT("..") clause keeps `1..10` an integer + range operator
  60. rather than the start of a real `1. ...`. *)
  61. integer = digit { digit }
  62. | digit { digit } CONTEXT("..")
  63. | digit { digit } ( "B" | "b" )
  64. | digit { hexDigit } ( "H" | "h" )
  65. | digit { hexDigit } ( "C" | "c" )
  66. | "0x" hexDigit { hexDigit }
  67. | "0X" hexDigit { hexDigit } .
  68. real = digit { digit } "." { digit }
  69. [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
  70. string = "'" { noQuote1 } "'"
  71. | '"' { noQuote2 } '"' .
  72. PRODUCTIONS
  73. M2
  74. = Unit "." .
  75. (* Units: program modules compile fully; DEFINITION and
  76. IMPLEMENTATION modules parse + check now but lower in step 4
  77. (each ends with one 230); same for nested local modules. *)
  78. Unit
  79. = DefUnit
  80. | ImplUnit
  81. | ProgModule .
  82. DefUnit (. VAR m1, m2, pn: SymTab.Name; .)
  83. = "DEFINITION" "MODULE"
  84. GetIdent<m1> (. SymTab.Init; QbeGen.OpenModule(m1);
  85. IF ~SymTab.Enter(m1,
  86. SymTab.KindModule) THEN
  87. SemError(200) END; .)
  88. ";"
  89. { Import }
  90. { ConstBlock | TypeBlock<TRUE> | VarBlock
  91. | ConstDecl ";" (. (* manifest const, no CONST *) .)
  92. | ProcHeading<pn> ";" (. SymTab.CloseProc; .)
  93. | ClassItem ";" }
  94. "END"
  95. GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
  96. SemError(202) END; .)
  97. (. QbeGen.CloseModule;
  98. SemError(230);
  99. SymTab.PrintTable; .) .
  100. ImplUnit (. VAR m1, m2: SymTab.Name; .)
  101. = "IMPLEMENTATION" "MODULE"
  102. GetIdent<m1> (. SymTab.Init; QbeGen.OpenModule(m1);
  103. IF ~SymTab.Enter(m1,
  104. SymTab.KindModule) THEN
  105. SemError(200) END; .)
  106. ";"
  107. { Import }
  108. DeclSeq
  109. [ "BEGIN" (. QbeGen.BeginBody; .)
  110. [ StatSeq ] ]
  111. "END"
  112. GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
  113. SemError(202) END; .)
  114. (. QbeGen.CloseModule;
  115. SemError(230);
  116. SymTab.PrintTable; .) .
  117. ProgModule (. VAR m1, m2: SymTab.Name; .)
  118. = "MODULE"
  119. GetIdent<m1> (. SymTab.Init; QbeGen.OpenModule(m1);
  120. IF ~SymTab.Enter(m1,
  121. SymTab.KindModule) THEN
  122. SemError(200) END; .)
  123. [ Priority ]
  124. ";"
  125. { Import }
  126. DeclSeq
  127. [ "BEGIN" (. QbeGen.BeginBody; .)
  128. [ StatSeq ] ]
  129. "END"
  130. GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
  131. SemError(202) END; .)
  132. (. QbeGen.EndModule(m1);
  133. SymTab.PrintTable; .) .
  134. DeclSeq
  135. = { ConstBlock | TypeBlock<FALSE> | VarBlock
  136. | ConstDecl ";" (. (* manifest const, no CONST *) .)
  137. | [ "INLINE" ] ProcDecl ";"
  138. | NestedModule ";" | ClassItem ";"
  139. | "LABEL" LabelList ";" } .
  140. LabelList (. VAR nm: SymTab.Name; .)
  141. = GetIdent<nm> (. SemError(230); .)
  142. { "," GetIdent<nm> (. SemError(230); .) } .
  143. (* Local module, Wirth form. Parses + checks fully (own scope);
  144. lowering waits for step 4, marked by one 230 at END. *)
  145. NestedModule (. VAR m1, m2: SymTab.Name; .)
  146. = "MODULE"
  147. GetIdent<m1> (. IF ~SymTab.Enter(m1,
  148. SymTab.KindModule) THEN
  149. SemError(200) END;
  150. SymTab.PushScope; .)
  151. [ Priority ]
  152. ";"
  153. { Import }
  154. [ Export ]
  155. DeclSeq
  156. [ "BEGIN"
  157. [ StatSeq ] ]
  158. "END"
  159. GetIdent<m2> (. IF ~SymTab.Equal(m1, m2) THEN
  160. SemError(202) END;
  161. SymTab.PopScope;
  162. SemError(230); .) .
  163. Priority
  164. = "[" integer "]" (. SemError(230); .) .
  165. Export (. VAR nm: SymTab.Name; .)
  166. = "EXPORT" (* names wire up in step 4 *)
  167. [ "QUALIFIED" ]
  168. GetIdent<nm>
  169. { "," GetIdent<nm> }
  170. ";" .
  171. Import (. VAR n: SymTab.Name; .)
  172. = "FROM"
  173. GetIdent<n> (. IF ~SymTab.Enter(n,
  174. SymTab.KindImport) THEN
  175. SemError(200) END; .)
  176. "IMPORT"
  177. ImpList ";"
  178. | "IMPORT"
  179. ImpList ";" .
  180. ImpList (. VAR n: SymTab.Name; .)
  181. = GetIdent<n> (. IF ~SymTab.Enter(n,
  182. SymTab.KindImport) THEN
  183. SemError(200) END; .)
  184. { ","
  185. GetIdent<n> (. IF ~SymTab.Enter(n,
  186. SymTab.KindImport) THEN
  187. SemError(200) END; .) } .
  188. (* Opaque "TYPE T;" needs isDef (definition units); elsewhere 231. *)
  189. TypeBlock<isDef: BOOLEAN>
  190. = "TYPE" { TypeItem<isDef> ";" | ClassItem ";" } .
  191. TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
  192. t: SymTab.TypeIndex; .)
  193. = GetIdent<n> (. IF ~SymTab.Enter(n,
  194. SymTab.KindType) THEN
  195. SemError(200) END; .)
  196. ( "=" Type<t> (. SymTab.SetSymType(n, t); .)
  197. | (. IF ~isDef THEN
  198. SemError(231) END;
  199. SymTab.SetSymType(n,
  200. SymTab.NewAlias()); .) ) .
  201. (* V3 TYPE surface. Start-symbols are all distinct:
  202. ident (named / anchored subrange), '[' (bare subrange),
  203. '(' (enum) , ARRAY , RECORD , SET , POINTER , PROCEDURE . *)
  204. Type<VAR t: SymTab.TypeIndex>
  205. = TypeIdent2<t> [ "["
  206. SubrangeRest<t> (. (* anchored subrange:
  207. SHORTINT[-1..1],
  208. SHORTCARD[0..7] *) .)
  209. "]" ]
  210. | "[" SubrangeRest<t> "]"
  211. | Enum<t>
  212. | ArrayType<t>
  213. | RecordType<t>
  214. | SetType<t>
  215. | PointerType<t>
  216. | "VIRTUAL" "POINTER" TypeIdent2<t> (. SemError(230); .)
  217. | ProcType<t> .
  218. (* Qualified type ident: Client.ClientRec, SYSTEM.WORD. *)
  219. TypeIdent2<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
  220. k: INTEGER; .)
  221. = GetIdent<n> (. IF ~SymTab.Lookup(n) THEN
  222. SemError(201);
  223. t := SymTab.InvalidType
  224. ELSE k := SymTab.SymKind(n);
  225. IF (k = SymTab.KindType)
  226. OR (k = SymTab.KindPredef) THEN
  227. t := SymTab.SymType(n)
  228. ELSIF k = SymTab.KindImport THEN
  229. t := SymTab.InvalidType
  230. ELSE SemError(221);
  231. t := SymTab.InvalidType
  232. END
  233. END; .)
  234. { "." GetIdent<n> (. SemError(230);
  235. t := SymTab.InvalidType; .) } .
  236. (* '[' Expr '..' Expr ']' (bare or anchored). Folds literal bounds
  237. into a NewSubR subrange; anything else parses but lowers later. *)
  238. SubrangeRest<VAR t: SymTab.TypeIndex>
  239. (. VAR tlo, thi: SymTab.TypeIndex;
  240. qlo, qhi: QbeGen.QVal;
  241. lo, hi: INTEGER; .)
  242. = Expr<tlo, qlo> ".." Expr<thi, qhi>
  243. (. IF (tlo = SymTab.InvalidType)
  244. OR (thi = SymTab.InvalidType) THEN
  245. t := SymTab.InvalidType
  246. ELSIF (SymTab.ClassOf(tlo) #
  247. SymTab.ClInt)
  248. OR (SymTab.ClassOf(thi) #
  249. SymTab.ClInt) THEN
  250. SemError(230);
  251. t := SymTab.InvalidType
  252. ELSIF ~SymTab.ConstInt(qlo, lo)
  253. OR ~SymTab.ConstInt(qhi, hi)
  254. OR (lo > hi) THEN
  255. SemError(230);
  256. t := SymTab.InvalidType
  257. ELSE t := SymTab.NewSubR(lo, hi)
  258. END; .) .
  259. Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
  260. = "(" (. t := SymTab.NewEnum(); .)
  261. GetIdent<n> (. IF ~SymTab.Enter(n,
  262. SymTab.KindConst) THEN
  263. SemError(200) END;
  264. SymTab.SetSymType(n, t); .)
  265. { "," GetIdent<n> (. IF ~SymTab.Enter(n,
  266. SymTab.KindConst) THEN
  267. SemError(200) END;
  268. SymTab.SetSymType(n, t); .) }
  269. ")" .
  270. (* ARRAY [lo..hi] OF T / ARRAY OF T (open formal) / multi bound *)
  271. ArrayType<VAR t: SymTab.TypeIndex> (. VAR e: SymTab.TypeIndex;
  272. i: CARDINAL; .)
  273. = "ARRAY"
  274. ( "[" Bound { "," Bound } "]" (. t := SymTab.InvalidType; .)
  275. | Bound (. t := SymTab.InvalidType; .)
  276. | (. t := SymTab.InvalidType; .) )
  277. "OF" Type<e> (. t := SymTab.NewOpenArray(e);
  278. SemError(230); .) .
  279. Bound (. VAR t: SymTab.TypeIndex;
  280. q: QbeGen.QVal; .)
  281. = Expr<t, q> [ ".." Expr<t, q> ] (. SemError(230); .) .
  282. (* RECORD with field lists and tagless/tagged variant CASE.
  283. FieldListSequence is the classic PIM form: fields separated by
  284. ';', alternatives by '|', optional ELSE. The label-vs-field
  285. first-set overlap is the known benign LL(1) advisory. *)
  286. RecordType<VAR t: SymTab.TypeIndex>
  287. (. VAR n: SymTab.Name;
  288. rt: SymTab.TypeIndex; .)
  289. = "RECORD" (. rt := SymTab.NewRecord();
  290. t := rt; .)
  291. FieldListSequence<rt>
  292. "END" (. SemError(230); .) .
  293. FieldListSequence<rec: SymTab.TypeIndex>
  294. = [ FieldList<rec> { ";" [ FieldList<rec> ] } ] .
  295. FieldList<rec: SymTab.TypeIndex> (. VAR tag: SymTab.Name;
  296. ti: SymTab.TypeIndex; .)
  297. = "CASE" (. SemError(230); .)
  298. ( GetIdent<tag> ":" (. (* named selector *) .)
  299. | ":" (. (* anonymous selector *) .)
  300. | (. (* no selector *) .) )
  301. Type<ti>
  302. "OF" VariantList<rec>
  303. "END"
  304. | FieldIdents<rec> .
  305. FieldIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
  306. t: SymTab.TypeIndex; .)
  307. = GetIdent<n> (. IF ~SymTab.FieldPending(rec, n)
  308. THEN SemError(200) END; .)
  309. { "," GetIdent<n> (. IF ~SymTab.FieldPending(rec, n)
  310. THEN SemError(200) END; .) }
  311. ":" Type<t> (. SymTab.FixPendingF(rec, t); .) .
  312. VariantList<rec: SymTab.TypeIndex>
  313. = [ "|" ] Variant<rec> { "|" [ Variant<rec> ] }
  314. [ "ELSE" FieldListSequence<rec> ] .
  315. Variant<rec: SymTab.TypeIndex>
  316. = VariantLabels ":" (. SymTab.PushScope; .)
  317. FieldListSequence<rec> (. SymTab.PopScope; .) .
  318. VariantLabels
  319. = VariantLabel { "," VariantLabel } .
  320. VariantLabel (. VAR t1, t2: SymTab.TypeIndex;
  321. q1, q2: QbeGen.QVal; .)
  322. = Expr<t1, q1> (. SemError(230); .)
  323. [ ".." Expr<t2, q2> (. SemError(230); .) ] .
  324. (* SET OF base: SHORTCARD[0..7], [0..31], CHAR, Direction,
  325. (RShift, LShift, Ctrl, ...) *)
  326. SetType<VAR t: SymTab.TypeIndex> (. VAR b: SymTab.TypeIndex; .)
  327. = "SET" "OF"
  328. ( TypeIdent2<b> (. t := SymTab.NewSet(b);
  329. SemError(230); .)
  330. | "[" SubrangeRest<b> "]" (. t := SymTab.NewSet(b);
  331. SemError(230); .)
  332. | Enum<b> (. t := SymTab.NewSet(b);
  333. SemError(230); .) ) .
  334. PointerType<VAR t: SymTab.TypeIndex> (. VAR b: SymTab.TypeIndex; .)
  335. = "POINTER" "TO" Type<b> (. t := SymTab.NewPtr(b);
  336. SemError(230); .) .
  337. (* PROCEDURE type: Action = PROCEDURE(ElementPtr); IPROC =
  338. PROCEDURE(); CompareProc = PROCEDURE(ADDRESS,ADDRESS,CARDINAL)
  339. : CompareType; *)
  340. ProcType<VAR t: SymTab.TypeIndex> (. VAR b: SymTab.TypeIndex; .)
  341. = "PROCEDURE" (. t := SymTab.InvalidType;
  342. SemError(230); .)
  343. [ "(" [ ProcTypeParam { ","
  344. ProcTypeParam } ] ")" ]
  345. [ ":" TypeIdent2<b> (. SemError(230); .) ] .
  346. ProcTypeParam (. VAR b: SymTab.TypeIndex; .)
  347. = [ "VAR" ] Type<b> (. SemError(230); .) .
  348. (* Clarion-form classes (docs/OOP.txt): declaration + (single or
  349. multiple) parent clause + IMPLEMENTATION blocks. Scopes and
  350. member checks now; lowering (vtable, dispatch, THIS) later —
  351. one 230 per class/impl block. Methods end with ";" per the
  352. Table example. *)
  353. (* Single CLASS item in both loops: separating declaration from
  354. IMPLEMENTATION at the loop level needs 2-token lookahead
  355. (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
  356. The second token decides after CLASS is consumed. *)
  357. ClassItem
  358. = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
  359. ClassRest (. VAR cn, m2, pn, q: SymTab.Name;
  360. ct: SymTab.TypeIndex; .)
  361. = GetIdent<cn> (. IF ~SymTab.Enter(cn,
  362. SymTab.KindType) THEN
  363. SemError(200) END;
  364. ct := SymTab.NewClass();
  365. SymTab.SetSymType(cn, ct);
  366. SymTab.PushClassScope(ct); .)
  367. [ Parents<ct> ]
  368. ";"
  369. { ClassField<ct> ";" }
  370. (* V3 class methods: pure declaration (';' only), FORWARD, or a
  371. fully bodied method whose body starts with BEGIN (the corpus
  372. form). Each bodied/FORWARD method owns its trailing ';'. *)
  373. { MethodHeading<pn> ";"
  374. ( "FORWARD" (. SymTab.MarkFwd;
  375. SymTab.CloseProc; .)
  376. ";"
  377. | "BEGIN" [ StatSeq ] "END"
  378. GetIdent<q> (. IF ~SymTab.Equal(pn, q) THEN
  379. SemError(202) END;
  380. SymTab.CloseProc;
  381. SemError(230); .)
  382. ";"
  383. | (. SymTab.CloseProc; .) ) }
  384. [ "BEGIN" (. SemError(230); .)
  385. [ StatSeq ] ]
  386. "END"
  387. GetIdent<m2> (. IF ~SymTab.Equal(cn, m2) THEN
  388. SemError(202) END;
  389. SymTab.PopScope;
  390. SemError(230); .) .
  391. (* V3 class header may list several parents
  392. (CLASS GenElem (Element, Base2);); this grammar accepts the
  393. list and rejects every parent after the first at 230 — the
  394. current backend lowers single inheritance only. *)
  395. Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
  396. = "(" Parent1<ct>
  397. { "," GetIdent<p> (. SemError(230); .) }
  398. ")" .
  399. Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
  400. pt: SymTab.TypeIndex; .)
  401. = GetIdent<p> (. IF ~SymTab.Lookup(p) THEN
  402. SemError(201)
  403. ELSE pt := SymTab.SymType(p);
  404. IF SymTab.ClassOf(pt) #
  405. SymTab.ClClass THEN
  406. SemError(230)
  407. ELSE SymTab.SetParent(ct, pt)
  408. END
  409. END; .) .
  410. ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
  411. t: SymTab.TypeIndex; .)
  412. = GetIdent<n>
  413. ( "=" GetIdent<rhs> (. IF ~SymTab.Enter(n,
  414. SymTab.KindConst) THEN
  415. SemError(200) END;
  416. IF SymTab.Lookup(rhs) THEN
  417. SymTab.SetSymType(n,
  418. SymTab.SymType(rhs))
  419. END; .)
  420. | (. IF ~SymTab.FieldPending(ct,
  421. n) THEN
  422. SemError(200) END; .)
  423. { "," GetIdent<n> (. IF ~SymTab.FieldPending(ct,
  424. n) THEN
  425. SemError(200) END; .) }
  426. ":" TypeIdent2<t> (. SymTab.FixPendingF(ct, t); .) ) .
  427. MethodHeading<VAR pn: SymTab.Name> (. VAR wantVirt: BOOLEAN; .)
  428. = (. wantVirt := FALSE; .)
  429. [ "VIRTUAL" (. wantVirt := TRUE; .) ]
  430. ProcHeading<pn> (. IF wantVirt THEN
  431. SymTab.MarkVirtual END; .) .
  432. ClassImplRest (. VAR cn, m2: SymTab.Name;
  433. ct: SymTab.TypeIndex; .)
  434. = GetIdent<cn> (. IF ~SymTab.Lookup(cn) THEN
  435. SemError(201);
  436. ct := SymTab.InvalidType
  437. ELSE ct := SymTab.SymType(cn);
  438. IF SymTab.ClassOf(ct) #
  439. SymTab.ClClass THEN
  440. SemError(230);
  441. ct := SymTab.InvalidType
  442. END
  443. END;
  444. IF ct #
  445. SymTab.InvalidType THEN
  446. IF ~SymTab.PushClassMembers(
  447. ct) THEN
  448. SemError(230) END
  449. END; .)
  450. ";" { MethodImpl<ct> ";" }
  451. [ "BEGIN" (. QbeGen.BeginBody; .)
  452. [ StatSeq ] ]
  453. "END"
  454. GetIdent<m2> (. IF ~SymTab.Equal(cn, m2) THEN
  455. SemError(202) END;
  456. SymTab.PopScope;
  457. SemError(230); .) .
  458. MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name; .)
  459. = MethodHeading<pn> ";"
  460. (. IF (ct #
  461. SymTab.InvalidType)
  462. & ~SymTab.MethodExists(ct,
  463. pn) THEN
  464. SemError(201) END; .)
  465. ( "FORWARD" (. SymTab.MarkFwd;
  466. SymTab.CloseProc; .)
  467. | Block<pn> (. SymTab.CloseProc;
  468. SemError(230); .) ) .
  469. (* E1) double-colon constant alias: Name ::= Expr ;
  470. GCoord::=INTEGER; TXBuffer ::= IOBase; *)
  471. ConstBlock
  472. = "CONST" { ConstDecl ";" } .
  473. ConstDecl (. VAR n: SymTab.Name;
  474. t: SymTab.TypeIndex;
  475. qv: QbeGen.QVal;
  476. cls: INTEGER; .)
  477. = GetIdent<n> (. IF ~SymTab.Enter(n,
  478. SymTab.KindConst) THEN
  479. SemError(200) END; .)
  480. ( "::=" (. SemError(230); .)
  481. Expr<t, qv> (. SymTab.SetSymType(n, t);
  482. QbeGen.DeclConst(n, "0",
  483. SymTab.InvalidType); .)
  484. | "="
  485. Expr<t, qv> (. SymTab.SetSymType(n, t);
  486. cls := SymTab.ClassOf(t);
  487. IF cls = SymTab.ClStr THEN
  488. SemError(230)
  489. ELSIF ~QbeGen.IsImm(qv) THEN
  490. SemError(230) END;
  491. QbeGen.DeclConst(n, qv, t); .) ) .
  492. VarBlock
  493. = "VAR" { VarDecl ";" } .
  494. VarDecl (. VAR nm: SymTab.Name;
  495. t: SymTab.TypeIndex;
  496. i: CARDINAL;
  497. cls: INTEGER; .)
  498. = VarIdents ":"
  499. (* V3 VAR types may be composites; the scalar phase lowers the
  500. integer/char/bool/real family and reports 230 for the rest. *)
  501. Type<t> (. cls := SymTab.ClassOf(t);
  502. IF (t # SymTab.InvalidType)
  503. & (cls # SymTab.ClInt)
  504. & (cls # SymTab.ClBool)
  505. & (cls # SymTab.ClChar)
  506. & (cls # SymTab.ClReal) THEN
  507. SemError(230) END;
  508. i := 0;
  509. WHILE i < SymTab.PendCount() DO
  510. SymTab.PendName(i, nm);
  511. QbeGen.DeclVar(nm, t);
  512. INC(i)
  513. END;
  514. IF NOT SymTab.FixPending(t) THEN END; .) .
  515. VarIdents (. VAR n: SymTab.Name;
  516. t: SymTab.TypeIndex;
  517. q: QbeGen.QVal; .)
  518. = GetIdent<n> (. IF ~SymTab.EnterPending(n,
  519. SymTab.KindVar) THEN
  520. SemError(200) END; .)
  521. [ "[" Expr<t, q> (. SemError(230); .)
  522. [ ":" Expr<t, q> (. SemError(230); .) ]
  523. "]" ]
  524. { ","
  525. GetIdent<n> (. IF ~SymTab.EnterPending(n,
  526. SymTab.KindVar) THEN
  527. SemError(200) END; .)
  528. [ "[" Expr<t, q> (. SemError(230); .)
  529. [ ":" Expr<t, q> (. SemError(230); .) ]
  530. "]" ] } .
  531. ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
  532. = GetIdent<n> (. IF ~SymTab.EnterParam(n, isV) THEN
  533. SemError(200) END; .)
  534. { "," GetIdent<n> (. IF ~SymTab.EnterParam(n, isV) THEN
  535. SemError(200) END; .) } .
  536. (* Procedure headings enter now (scopes, params, result); bodies
  537. parse + check with one 230 at END (lowering = step 4).
  538. FORWARD marks; the body heading re-enters (signature compare
  539. tightens in step 4). *)
  540. ProcHeading<VAR pn: SymTab.Name> (. VAR t: SymTab.TypeIndex; .)
  541. = "PROCEDURE"
  542. GetIdent<pn> (. IF ~SymTab.EnterProc(pn) THEN
  543. IF ~SymTab.ReenterProc(pn) THEN
  544. SemError(200) END
  545. END; .)
  546. [ FormalParams ]
  547. [ ":" TypeIdent2<t> (. IF NOT SymTab.SetProcRes(t) THEN END; .) ] .
  548. FormalParams
  549. = "(" [ ParamSection { ";" ParamSection } ] ")" .
  550. ParamSection (. VAR t: SymTab.TypeIndex;
  551. isV: BOOLEAN; .)
  552. = (. isV := FALSE; .)
  553. [ "VAR" (. isV := TRUE; .) ]
  554. ParIdents<isV> ":" Type<t> (. IF NOT SymTab.FixPending(t) THEN END; .) .
  555. ProcDecl (. VAR pn, assem: SymTab.Name;
  556. at: SymTab.TypeIndex;
  557. ak: INTEGER;
  558. aq: QbeGen.QVal; .)
  559. = ProcHeading<pn>
  560. ( ";"
  561. ( "FORWARD" (. SymTab.MarkFwd;
  562. SymTab.CloseProc; .)
  563. | "IN" GetIdent<assem> (. SymTab.CloseProc;
  564. SemError(230); .)
  565. | Block<pn> (. SymTab.CloseProc;
  566. SemError(230); .) )
  567. | "=" Design<at, ak, aq, assem> (. SymTab.CloseProc;
  568. SemError(230); .)
  569. "(" [ ActualParams ] ")" ) .
  570. Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
  571. = DeclSeq
  572. [ "BEGIN"
  573. [ StatSeq ] ]
  574. "END"
  575. GetIdent<m2> (. IF ~SymTab.Equal(pn, m2) THEN
  576. SemError(202) END; .) .
  577. StatSeq
  578. = Statement { ";" [ Statement ] } .
  579. (* Statements. Assignments and procedure/function calls both start
  580. with a designator, so they share one factored production: after
  581. the designator, ':=' selects assignment, '(' a call, anything
  582. else is a parameterless procedure-call statement. *)
  583. Statement (. VAR lx: QbeGen.QVal;
  584. lqn: SymTab.Name; .)
  585. = DesignStat
  586. | IfStat
  587. | WhileStat
  588. | RepeatStat
  589. | LoopStat
  590. | ForStat
  591. | CaseStat
  592. | WithStat
  593. | ReturnStat
  594. | "GOTO" GetIdent<lqn> (. SemError(230); .)
  595. | "EXIT" (. IF QbeGen.TopLoop(lx) THEN
  596. QbeGen.Jmp(lx)
  597. ELSE SemError(230) END; .) .
  598. DesignStat (. VAR dt, et: SymTab.TypeIndex;
  599. dk: INTEGER;
  600. qd, qe, qt: QbeGen.QVal;
  601. qn: SymTab.Name;
  602. isR, conv: BOOLEAN; .)
  603. = Design2<dt, dk, qd, qn>
  604. ( ":=" Expr<et, qe> (. IF (dt # SymTab.InvalidType)
  605. & (dk # SymTab.KindVar)
  606. & (dk # SymTab.KindParam) THEN
  607. SemError(210)
  608. ELSIF ~SymTab.Assignable(et,
  609. dt) THEN
  610. SemError(210) END;
  611. isR := (dt #
  612. SymTab.InvalidType)
  613. & (SymTab.ClassOf(dt)
  614. = SymTab.ClReal);
  615. conv := isR
  616. & SymTab.IsIntFamily(et);
  617. IF ((dk = SymTab.KindVar)
  618. OR (dk = SymTab.KindParam))
  619. & (dt # SymTab.InvalidType)
  620. & (et # SymTab.InvalidType) THEN
  621. IF conv THEN
  622. QbeGen.ConvIR(qe, qt);
  623. QbeGen.StoreVar(qn, qt, TRUE)
  624. ELSE
  625. QbeGen.StoreVar(qn, qe, isR)
  626. END
  627. END; .)
  628. | "(" [ ActualParams ] ")" (. SemError(230); .)
  629. | (. SemError(230); .) ) .
  630. ActualParams (. VAR t: SymTab.TypeIndex;
  631. q: QbeGen.QVal; .)
  632. = Expr<t, q> { "," Expr<t, q> } .
  633. IfStat (. VAR t: SymTab.TypeIndex;
  634. q, lThen, lElse, lEnd:
  635. QbeGen.QVal;
  636. hasElse: BOOLEAN; .)
  637. = "IF" (. hasElse := FALSE; .)
  638. Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
  639. SemError(214) END;
  640. QbeGen.NewLabel(lThen);
  641. QbeGen.NewLabel(lElse);
  642. QbeGen.NewLabel(lEnd);
  643. QbeGen.Jnz(q, lThen, lElse);
  644. QbeGen.EmitLabel(lThen); .)
  645. "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .)
  646. { "ELSIF" (. QbeGen.EmitLabel(lElse);
  647. QbeGen.NewLabel(lElse); .)
  648. Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
  649. SemError(214) END;
  650. QbeGen.NewLabel(lThen);
  651. QbeGen.Jnz(q, lThen, lElse);
  652. QbeGen.EmitLabel(lThen); .)
  653. "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .) }
  654. [ "ELSE" (. QbeGen.EmitLabel(lElse);
  655. hasElse := TRUE; .)
  656. [ StatSeq ] ]
  657. "END" (. IF hasElse THEN
  658. QbeGen.EmitLabel(lEnd)
  659. ELSE QbeGen.EmitLabel(lElse);
  660. QbeGen.EmitLabel(lEnd)
  661. END; .) .
  662. WhileStat (. VAR t: SymTab.TypeIndex;
  663. q, lTop, lBody, lEnd:
  664. QbeGen.QVal; .)
  665. = "WHILE" (. QbeGen.NewLabel(lTop);
  666. QbeGen.NewLabel(lBody);
  667. QbeGen.NewLabel(lEnd);
  668. QbeGen.EmitLabel(lTop); .)
  669. Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
  670. SemError(214) END;
  671. QbeGen.Jnz(q, lBody, lEnd);
  672. QbeGen.EmitLabel(lBody); .)
  673. "DO" [ StatSeq ] (. QbeGen.Jmp(lTop); .)
  674. "END" (. QbeGen.EmitLabel(lEnd); .) .
  675. RepeatStat (. VAR t: SymTab.TypeIndex;
  676. q, lTop, lEnd: QbeGen.QVal; .)
  677. = "REPEAT" (. QbeGen.NewLabel(lTop);
  678. QbeGen.NewLabel(lEnd);
  679. QbeGen.EmitLabel(lTop); .)
  680. [ StatSeq ]
  681. "UNTIL" Expr<t, q> (. IF ~SymTab.BoolCheck(t) THEN
  682. SemError(214) END;
  683. QbeGen.Jnz(q, lEnd, lTop);
  684. QbeGen.EmitLabel(lEnd); .) .
  685. LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .)
  686. = "LOOP" (. QbeGen.NewLabel(lTop);
  687. QbeGen.NewLabel(lEnd);
  688. QbeGen.PushLoop(lEnd);
  689. QbeGen.EmitLabel(lTop); .)
  690. [ StatSeq ]
  691. "END" (. QbeGen.Jmp(lTop);
  692. QbeGen.PopLoop;
  693. QbeGen.EmitLabel(lEnd); .) .
  694. (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
  695. Runtime direction would need a compare-select; the literal
  696. sign picks cslew/csegew at "DO" time. *)
  697. ForStat (. VAR lv: SymTab.Name;
  698. tlo, thi, tby:
  699. SymTab.TypeIndex;
  700. qlo, qhi, qby, qt, qk, qb:
  701. QbeGen.QVal;
  702. lTop, lBody, lEnd:
  703. QbeGen.QVal;
  704. by: INTEGER;
  705. ok: BOOLEAN; .)
  706. = "FOR" (. by := 1; .)
  707. GetIdent<lv> (. ok := SymTab.Lookup(lv);
  708. IF ~ok THEN
  709. SemError(201)
  710. ELSIF (SymTab.SymKind(lv) #
  711. SymTab.KindVar)
  712. & (SymTab.SymKind(lv) #
  713. SymTab.KindParam) THEN
  714. SemError(220); ok := FALSE
  715. ELSIF ~SymTab.IsIntFamily(
  716. SymTab.SymType(lv)) THEN
  717. SemError(220); ok := FALSE
  718. END; .)
  719. ":=" Expr<tlo, qlo> (. IF ~SymTab.IsIntFamily(tlo) THEN
  720. SemError(220); ok := FALSE
  721. END; .)
  722. "TO" Expr<thi, qhi> (. IF ~SymTab.IsIntFamily(thi) THEN
  723. SemError(220); ok := FALSE
  724. END; .)
  725. [ "BY" Expr<tby, qby> (. IF (tby #
  726. SymTab.InvalidType)
  727. & ~SymTab.IsIntFamily(tby) THEN
  728. SemError(220); ok := FALSE
  729. END;
  730. IF ~SymTab.ConstInt(qby, by) THEN
  731. SemError(230); by := 1
  732. ELSIF by = 0 THEN
  733. SemError(220); by := 1
  734. END; .) ]
  735. "DO" (. IF ok THEN
  736. QbeGen.StoreVar(lv, qlo,
  737. FALSE) END;
  738. QbeGen.NewLabel(lTop);
  739. QbeGen.NewLabel(lBody);
  740. QbeGen.NewLabel(lEnd);
  741. QbeGen.EmitLabel(lTop);
  742. QbeGen.LoadVar(lv, FALSE, qt);
  743. QbeGen.NewTemp(qk);
  744. IF by > 0 THEN
  745. QbeGen.Op3("cslew", qk,
  746. qt, qhi, FALSE)
  747. ELSE QbeGen.Op3("csgew", qk,
  748. qt, qhi, FALSE)
  749. END;
  750. QbeGen.Jnz(qk, lBody, lEnd);
  751. QbeGen.EmitLabel(lBody); .)
  752. [ StatSeq ]
  753. "END" (. IF ok THEN
  754. QbeGen.LoadVar(lv, FALSE,
  755. qt);
  756. QbeGen.IntStr(by, qb);
  757. QbeGen.NewTemp(qk);
  758. QbeGen.Op3("add", qk,
  759. qt, qb, FALSE);
  760. QbeGen.StoreVar(lv, qk,
  761. FALSE) END;
  762. QbeGen.Jmp(lTop);
  763. QbeGen.EmitLabel(lEnd); .) .
  764. CaseStat (. VAR tsel: SymTab.TypeIndex;
  765. qsel, lEnd: QbeGen.QVal; .)
  766. = "CASE" Expr<tsel, qsel> (. QbeGen.NewLabel(lEnd); .)
  767. "OF" [ "|" ]
  768. { CaseAlt<tsel, qsel, lEnd>
  769. [ ";" ] [ "|" ] }
  770. [ "ELSE" [ StatSeq ] ]
  771. "END" (. QbeGen.EmitLabel(lEnd); .) .
  772. (* Compare-chain lowering: each alternative ends its match-tests
  773. with "jmp lAfter", so the no-match fallthrough skips the body:
  774. "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
  775. lAfter:". Falls into the next alternative, ELSE, or END. *)
  776. CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  777. lEnd: QbeGen.QVal> (. VAR lBody, lAfter: QbeGen.QVal; .)
  778. = (. QbeGen.NewLabel(lBody);
  779. QbeGen.NewLabel(lAfter); .)
  780. CaseLabel<tsel, qsel, lBody>
  781. { "," CaseLabel<tsel, qsel, lBody> }
  782. ":" (. QbeGen.Jmp(lAfter);
  783. QbeGen.EmitLabel(lBody); .)
  784. [ StatSeq (. QbeGen.Jmp(lEnd); .) ]
  785. (. QbeGen.EmitLabel(lAfter); .) .
  786. CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
  787. lBody: QbeGen.QVal> (. VAR t2, t3: SymTab.TypeIndex;
  788. q2, q3, qc, qd, qe:
  789. QbeGen.QVal;
  790. lNext: QbeGen.QVal; .)
  791. = Expr<t2, q2> (. IF (t2 #
  792. SymTab.InvalidType)
  793. & (tsel #
  794. SymTab.InvalidType)
  795. & ~SymTab.EqCheck(t2,
  796. tsel) THEN
  797. SemError(213) END;
  798. IF ~QbeGen.IsImm(q2) THEN
  799. SemError(230);
  800. QbeGen.CopyOp("0", q2)
  801. END;
  802. QbeGen.NewLabel(lNext);
  803. QbeGen.Cmp(SymTab.OpEq,
  804. qsel, q2, qc, FALSE);
  805. QbeGen.Jnz(qc, lBody, lNext);
  806. QbeGen.EmitLabel(lNext); .)
  807. [ ".." Expr<t3, q3> (. IF (t3 #
  808. SymTab.InvalidType)
  809. & (tsel #
  810. SymTab.InvalidType)
  811. & ~SymTab.EqCheck(t3,
  812. tsel) THEN
  813. SemError(213) END;
  814. IF ~QbeGen.IsImm(q3) THEN
  815. SemError(230);
  816. QbeGen.CopyOp("0", q3)
  817. END;
  818. QbeGen.Cmp(SymTab.OpGe,
  819. qsel, q2, qc, FALSE);
  820. QbeGen.Cmp(SymTab.OpLe,
  821. qsel, q3, qd, FALSE);
  822. QbeGen.NewTemp(qe);
  823. QbeGen.Op3("and", qe, qc, qd,
  824. FALSE);
  825. QbeGen.NewLabel(lNext);
  826. QbeGen.Jnz(qe, lBody, lNext);
  827. QbeGen.EmitLabel(lNext); .) ] .
  828. ReturnStat (. VAR t: SymTab.TypeIndex;
  829. q: QbeGen.QVal;
  830. res: SymTab.TypeIndex;
  831. hadE: BOOLEAN; .)
  832. = "RETURN" (. hadE := FALSE; .)
  833. [ Expr<t, q> (. hadE := TRUE; .) ]
  834. (. IF ~SymTab.InProc() THEN
  835. SemError(232)
  836. ELSE res := SymTab.CurRes();
  837. IF ~hadE THEN
  838. IF res #
  839. SymTab.InvalidType THEN
  840. SemError(232) END
  841. ELSIF (res =
  842. SymTab.InvalidType)
  843. OR (t #
  844. SymTab.InvalidType)
  845. & ~SymTab.Assignable(t,
  846. res) THEN
  847. SemError(232)
  848. END
  849. END; .) .
  850. (* WITH pushes the record's fields as an inner scope (classic
  851. short-hand member access); record lowering is still 230. *)
  852. WithStat (. VAR t: SymTab.TypeIndex;
  853. k: INTEGER;
  854. q: QbeGen.QVal;
  855. qn: SymTab.Name; .)
  856. = "WITH" Design2<t, k, q, qn> (. IF ~SymTab.PushRecord(t) THEN
  857. SemError(230) END; .)
  858. "DO" [ StatSeq ]
  859. "END" (. SymTab.PopScope;
  860. SemError(230); .) .
  861. (* Designators (E3): simple names behave exactly like the scalar
  862. phase; '.' '^' '[' selector chains parse and report one 230
  863. (member/pointer/array lowering arrives with step 3). *)
  864. Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  865. VAR q: QbeGen.QVal; VAR qn: SymTab.Name>
  866. (. VAR n: SymTab.Name;
  867. cls: INTEGER; .)
  868. = GetIdent<n> (. QbeGen.CopyOp(n, qn);
  869. IF ~SymTab.Lookup(n) THEN
  870. SemError(201);
  871. t := SymTab.InvalidType;
  872. k := -1;
  873. QbeGen.CopyOp("0", q)
  874. ELSE
  875. t := SymTab.SymType(n);
  876. k := SymTab.SymKind(n);
  877. IF k = SymTab.KindConst THEN
  878. IF SymTab.Equal(n,
  879. "TRUE") THEN
  880. t := SymTab.BoolType();
  881. QbeGen.CopyOp("1", q)
  882. ELSIF SymTab.Equal(n,
  883. "FALSE") THEN
  884. t := SymTab.BoolType();
  885. QbeGen.CopyOp("0", q)
  886. ELSE
  887. cls := SymTab.ClassOf(t);
  888. IF (t # SymTab.InvalidType)
  889. & ((cls = SymTab.ClInt)
  890. OR (cls = SymTab.ClChar)
  891. OR (cls = SymTab.ClReal)) THEN
  892. QbeGen.LoadVar(n,
  893. cls = SymTab.ClReal, q)
  894. ELSE
  895. IF t # SymTab.InvalidType
  896. THEN SemError(230)
  897. END;
  898. QbeGen.CopyOp("0", q)
  899. END
  900. END
  901. ELSIF (k = SymTab.KindVar)
  902. OR (k = SymTab.KindParam) THEN
  903. cls := SymTab.ClassOf(t);
  904. IF (cls = SymTab.ClInt)
  905. OR (cls = SymTab.ClBool)
  906. OR (cls = SymTab.ClChar)
  907. OR (cls = SymTab.ClReal) THEN
  908. QbeGen.LoadVar(n,
  909. cls = SymTab.ClReal, q)
  910. ELSE SemError(230);
  911. QbeGen.CopyOp("0", q)
  912. END
  913. ELSE QbeGen.CopyOp("0", q);
  914. IF (k = SymTab.KindImport)
  915. OR (k = SymTab.KindProc)
  916. OR (k = SymTab.KindField) THEN
  917. SemError(230)
  918. END
  919. END
  920. END; .) .
  921. Design2<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  922. VAR q: QbeGen.QVal; VAR qn: SymTab.Name>
  923. = Design<t, k, q, qn>
  924. { "." GetIdent<qn> (. SemError(230);
  925. t := SymTab.InvalidType; .)
  926. | "^" (. SemError(230);
  927. t := SymTab.InvalidType; .)
  928. | "[" ExprList "]" (. SemError(230);
  929. t := SymTab.InvalidType; .)
  930. | "(" [ ActualParams ] ")" (. SemError(230);
  931. t := SymTab.InvalidType; .) } .
  932. ExprList (. VAR t: SymTab.TypeIndex;
  933. q: QbeGen.QVal; .)
  934. = Expr<t, q> { "," Expr<t, q> } .
  935. (* Expressions. After SimExpr the optional suffix is decided by a
  936. distinct first token: relation (= # <> < <= > >=), IN, or IS. *)
  937. Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  938. (. VAR t2: SymTab.TypeIndex;
  939. op: INTEGER;
  940. q2, qt: QbeGen.QVal;
  941. isR: BOOLEAN; .)
  942. = SimExpr<t, q>
  943. [ Rel<op> SimExpr<t2, q2>
  944. (. IF SymTab.RelCheck(t, t2, op) THEN
  945. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  946. t := SymTab.BoolType()
  947. ELSE SemError(213); t := SymTab.InvalidType;
  948. isR := FALSE END;
  949. IF t # SymTab.InvalidType THEN
  950. QbeGen.Cmp(op, q, q2, qt, isR);
  951. QbeGen.CopyOp(qt, q)
  952. ELSE QbeGen.CopyOp("0", q)
  953. END; .)
  954. | "IN" SimExpr<t2, q2> (. IF ~SymTab.InCheck(t, t2) THEN
  955. SemError(222) END;
  956. SemError(230);
  957. QbeGen.CopyOp("0", q);
  958. t := SymTab.InvalidType; .)
  959. | "IS" TypeIdent2<t2> (. SemError(213);
  960. SemError(230);
  961. QbeGen.CopyOp("0", q);
  962. t := SymTab.InvalidType; .) ] .
  963. (* V3 relations keep both PIM '#" and the '<>' alias. *)
  964. Rel<VAR op: INTEGER>
  965. = "=" (. op := SymTab.OpEq; .)
  966. | "#" (. op := SymTab.OpNeq1; .)
  967. | "<>" (. op := SymTab.OpNeq1; .)
  968. | "<" (. op := SymTab.OpLt; .)
  969. | "<=" (. op := SymTab.OpLe; .)
  970. | ">" (. op := SymTab.OpGt; .)
  971. | ">=" (. op := SymTab.OpGe; .) .
  972. SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  973. (. VAR t2, res2: SymTab.TypeIndex;
  974. op: INTEGER;
  975. q2, qt: QbeGen.QVal;
  976. neg, isR: BOOLEAN; .)
  977. = (. neg := FALSE; .)
  978. [ "+" | "-" (. neg := TRUE; .) ]
  979. Term<t, q> (. IF neg THEN
  980. IF QbeGen.IsImm(q) THEN
  981. QbeGen.NegFold(q, q)
  982. ELSE QbeGen.NewTemp(qt);
  983. QbeGen.NegQ(q, qt,
  984. SymTab.ClassOf(t)
  985. = SymTab.ClReal);
  986. QbeGen.CopyOp(qt, q)
  987. END
  988. END; .)
  989. { AddOp<op> Term<t2, q2>
  990. (. IF op = SymTab.OpOr THEN
  991. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  992. t := SymTab.BoolType()
  993. ELSE SemError(212); t := SymTab.InvalidType END;
  994. IF t # SymTab.InvalidType THEN
  995. QbeGen.NewTemp(qt);
  996. QbeGen.Op3("or", qt, q, q2, FALSE);
  997. QbeGen.CopyOp(qt, q)
  998. ELSE QbeGen.CopyOp("0", q)
  999. END
  1000. ELSE
  1001. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
  1002. t := res2
  1003. ELSE SemError(211); t := SymTab.InvalidType END;
  1004. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  1005. IF t # SymTab.InvalidType THEN
  1006. QbeGen.NewTemp(qt);
  1007. IF op = SymTab.OpAdd THEN
  1008. QbeGen.Op3("add", qt, q, q2, isR)
  1009. ELSE
  1010. QbeGen.Op3("sub", qt, q, q2, isR)
  1011. END;
  1012. QbeGen.CopyOp(qt, q)
  1013. ELSE QbeGen.CopyOp("0", q)
  1014. END
  1015. END; .) } .
  1016. AddOp<VAR op: INTEGER>
  1017. = "+" (. op := SymTab.OpAdd; .)
  1018. | "-" (. op := SymTab.OpSub; .)
  1019. | "OR" (. op := SymTab.OpOr; .) .
  1020. (* Term holds multiplication, AND (word or '&'), and the V3 shift
  1021. operators << >>. MulOp start symbols are all distinct. *)
  1022. Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  1023. (. VAR t2, res2: SymTab.TypeIndex;
  1024. op: INTEGER;
  1025. q2, qt: QbeGen.QVal;
  1026. isR: BOOLEAN; .)
  1027. = Fact<t, q> { MulOp<op> Fact<t2, q2>
  1028. (. IF (op = SymTab.OpAnd) THEN
  1029. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  1030. t := SymTab.BoolType()
  1031. ELSE SemError(212); t := SymTab.InvalidType END;
  1032. IF t # SymTab.InvalidType THEN
  1033. QbeGen.NewTemp(qt);
  1034. QbeGen.Op3("and", qt, q, q2, FALSE);
  1035. QbeGen.CopyOp(qt, q)
  1036. ELSE QbeGen.CopyOp("0", q)
  1037. END
  1038. ELSIF (op = 10) OR (op = 11) THEN
  1039. (* << and >> : V3 word shifts; QBE shl/sar. *)
  1040. IF ~SymTab.IsIntFamily(t) OR ~SymTab.IsIntFamily(t2) THEN
  1041. SemError(211); t := SymTab.InvalidType END;
  1042. IF t # SymTab.InvalidType THEN
  1043. QbeGen.NewTemp(qt);
  1044. IF op = 10 THEN QbeGen.Op3("shl", qt, q, q2, FALSE)
  1045. ELSE QbeGen.Op3("sar", qt, q, q2, FALSE) END;
  1046. QbeGen.CopyOp(qt, q)
  1047. ELSE QbeGen.CopyOp("0", q)
  1048. END
  1049. ELSE
  1050. IF SymTab.ArithCheck(t, t2,
  1051. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  1052. res2) THEN t := res2
  1053. ELSE SemError(211); t := SymTab.InvalidType END;
  1054. isR := SymTab.ClassOf(t) = SymTab.ClReal;
  1055. IF t # SymTab.InvalidType THEN
  1056. QbeGen.NewTemp(qt);
  1057. IF op = SymTab.OpTimes THEN
  1058. QbeGen.Op3("mul", qt, q, q2, isR)
  1059. ELSIF (op = SymTab.OpDiv)
  1060. OR (op = SymTab.OpSlash) THEN
  1061. QbeGen.Op3("div", qt, q, q2, isR)
  1062. ELSE
  1063. QbeGen.Op3("rem", qt, q, q2, isR)
  1064. END;
  1065. QbeGen.CopyOp(qt, q)
  1066. ELSE QbeGen.CopyOp("0", q)
  1067. END
  1068. END; .) } .
  1069. MulOp<VAR op: INTEGER>
  1070. = "*" (. op := SymTab.OpTimes; .)
  1071. | "/" (. op := SymTab.OpSlash; .)
  1072. | "DIV" (. op := SymTab.OpDiv; .)
  1073. | "MOD" (. op := SymTab.OpMod; .)
  1074. | "AND" (. op := SymTab.OpAnd; .)
  1075. | "&" (. op := SymTab.OpAnd; .)
  1076. | "<<" (. op := 10; .)
  1077. | ">>" (. op := 11; .) .
  1078. Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
  1079. (. VAR s: ARRAY [0 .. 255] OF CHAR;
  1080. et, dt, t2, b:
  1081. SymTab.TypeIndex;
  1082. dk: INTEGER;
  1083. qd, q2: QbeGen.QVal;
  1084. qn: SymTab.Name;
  1085. isCh: BOOLEAN; .)
  1086. = integer (. LexString(s);
  1087. QbeGen.NormLit(s, q, isCh);
  1088. IF isCh THEN
  1089. t := SymTab.CharType()
  1090. ELSE t := SymTab.IntType()
  1091. END; .)
  1092. | real (. LexString(s);
  1093. QbeGen.NormReal(s, q);
  1094. t := SymTab.RealType(); .)
  1095. | string (. LexString(s);
  1096. IF SymTab.StrLen(s) <= 3 THEN
  1097. t := SymTab.CharType();
  1098. QbeGen.IntStr(
  1099. QbeGen.CharVal(s), q)
  1100. ELSE t := SymTab.NewStr();
  1101. SemError(230);
  1102. QbeGen.CopyOp("0", q)
  1103. END; .)
  1104. | "{" [ SetItems ] "}" (. SemError(230);
  1105. QbeGen.CopyOp("0", q);
  1106. t := SymTab.InvalidType; .)
  1107. | "[" Expr<et, q> ":" Expr<t2, q2>
  1108. (. SemError(230);
  1109. QbeGen.CopyOp("0", q);
  1110. t := SymTab.InvalidType; .)
  1111. [ TypeIdent2<b> ] "]"
  1112. MapTail
  1113. | Design2<dt, dk, qd, qn> (. t := dt;
  1114. QbeGen.CopyOp(qd, q); .)
  1115. | "(" Expr<et, q> ")" (. t := et; .)
  1116. | "NOT" Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
  1117. t := SymTab.BoolType()
  1118. ELSE SemError(212);
  1119. t := SymTab.InvalidType END;
  1120. IF t # SymTab.InvalidType THEN
  1121. QbeGen.NotQ(q2, q)
  1122. ELSE QbeGen.CopyOp("0", q)
  1123. END; .)
  1124. | "~" Fact<t2, q2> (. IF SymTab.BoolCheck(t2) THEN
  1125. t := SymTab.BoolType()
  1126. ELSE SemError(212);
  1127. t := SymTab.InvalidType END;
  1128. IF t # SymTab.InvalidType THEN
  1129. QbeGen.NotQ(q2, q)
  1130. ELSE QbeGen.CopyOp("0", q)
  1131. END; .) .
  1132. MapTail (* suffix chain after a mapped-array
  1133. constructor: deref, field or
  1134. subscript, like a designator. *)
  1135. (. VAR mq: SymTab.Name;
  1136. et: SymTab.TypeIndex;
  1137. q2: QbeGen.QVal; .)
  1138. = { "." GetIdent<mq> (. SemError(230); .)
  1139. | "^" (. SemError(230); .)
  1140. | "[" Expr<et, q2> "]" (. SemError(230); .)
  1141. | "(" [ ActualParams ] ")" (. SemError(230); .) } .
  1142. SetItems
  1143. = SetItem { "," SetItem } .
  1144. SetItem (. VAR t1, t2: SymTab.TypeIndex;
  1145. q1, q2: QbeGen.QVal; .)
  1146. = Expr<t1, q1> (. SemError(230); .)
  1147. [ ".." Expr<t2, q2> (. SemError(230); .) ] .
  1148. GetIdent<VAR n: SymTab.Name>
  1149. = ident (. LexName(n); .) .
  1150. END M2.