M2c.atg 107 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884
  1. COMPILER M2c
  2. (* Modula-2 program modules with procedures and composites, MC64 backend
  3. (see MGen for details).
  4. - program module only, no DEFINITION / IMPLEMENTATION split
  5. - no local modules, no EXPORT, no PRIORITY
  6. - procedures: declarations (nested), value and VAR parameters,
  7. functions with RETURN, recursion, FORWARD headings;
  8. no procedure types/variables, no cones
  9. - composites (Phase 3): fixed ARRAYs (bounds, 1D/multi-D indexing,
  10. unchecked, byte-packed CHAR/BOOLEAN), RECORDs (field offsets,
  11. .field, WITH incl. nested), SETs (+ union, - difference,
  12. * intersection, inclusive .. ranges), POINTERs (NEW/DISPOSE via
  13. VM ALLOCATE, ^, NIL), strings (ARRAY OF CHAR literal assign).
  14. Open arrays deferred; whole array/record copy deferred except
  15. string literals; VAR actuals must be simple (no a[i]/p^/fields
  16. as VAR actuals, 233); value composite params rejected (230);
  17. composite function returns rejected (unchecked, avoid wrong LEAVE).
  18. - statements: assignment, procedure call, IF, CASE, WHILE,
  19. REPEAT, LOOP/EXIT, FOR, WITH, RETURN, NEW, DISPOSE
  20. - symbol table (SymTab) with static type checking: error codes
  21. 200/201/202 and 210-224 (as before), plus 231 (procedure
  22. forward mismatch or missing body), 232 (bad RETURN), 233
  23. (invalid procedure call); same lenient rules (single pass,
  24. declare-before-use, except POINTER bases may be same-scope
  25. aliases with structural pointer compatibility in Assignable;
  26. INTEGER, CARDINAL and subranges form one
  27. integer family; no mixed INTEGER/REAL arithmetic; INTEGER
  28. assigns to REAL; 1-character literal is CHAR; InvalidType
  29. suppresses follow-on errors)
  30. - backend (MGen): single-module MC64 image <ModName>.MC4,
  31. runnable with mcint. Procedures take table entries 1..N
  32. (0 = module body), run with ENTER frames, called via ED
  33. (global), EC (directly nested) or EE (display walk); actuals
  34. evaluate left-to-right into temps, then push reversed.
  35. Lowered: scalar + composite globals/frame vars (multi-slot,
  36. byte sizes, field/element offsets), CONST literals,
  37. SET masks with literals/ranges/IN/=/#/+-/*; full scalar +
  38. composite expressions (scaled indexing via IdxScale, field
  39. via FieldAdd, deref via 41H/60H, byte ops 0DH/1DH for CHAR);
  40. control flow via E0/E1 jumps; composite assign via
  41. StoreIndir0/StoreByte (scalar elems) and copy_block (strings).
  42. The rest parses and type-checks
  43. but gets error 230: open arrays, whole array/record copy
  44. (except string literals), value composite params/returns,
  45. non-literal CONST expressions and BY steps,
  46. EXIT outside LOOP, imported names used as values.
  47. - test convention (the language has no I/O): a global
  48. VAR ExitCode : INTEGER;
  49. is printed as decimal + CRLF through an embedded helper;
  50. without it the program just ends.
  51. - known semantic edges: INTEGER DIV/MOD truncate toward zero;
  52. CARDINAL past MAXINT compares as signed; AND/OR are eager;
  53. REAL widens to binary64; unchecked ARRAY indexing (no DA/DB);
  54. NIL dereference reads 0 (no static check, no VM trap yet);
  55. CHAR/BOOLEAN arrays byte-packed (1 byte/elem, slots over-
  56. allocated 8x); at most 64 procedures, 64 actuals
  57. per call, 16 names per FP-section, 8-deep nested calls,
  58. 8-deep WITH, 1024 slots max per type. *)
  59. IMPORT SymTab, MGen;
  60. CHARACTERS
  61. eol = CHR(13) .
  62. letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
  63. digit = "0123456789" .
  64. hexDigit = digit + "ABCDEF" .
  65. noQuote1 = ANY - "'" - eol .
  66. noQuote2 = ANY - '"' - eol .
  67. IGNORE CHR(9) .. CHR(13)
  68. COMMENTS
  69. FROM "(*" TO "*)" NESTED
  70. TOKENS
  71. ident = letter { letter | digit } .
  72. integer = digit { digit }
  73. | digit { digit } CONTEXT("..")
  74. | digit { hexDigit } "H" .
  75. real = digit { digit } "." { digit }
  76. [ "E" [ "+" | "-" ] digit { digit } ] .
  77. string = "'" { noQuote1 } "'"
  78. | '"' { noQuote2 } '"' .
  79. PRODUCTIONS
  80. M2c (. VAR m1, m2: SymTab.Name; .)
  81. = "MODULE"
  82. GetIdent<m1> (. SymTab.Init; MGen.OpenModule(m1);
  83. IF ~SymTab.Enter(m1, SymTab.KindModule)
  84. THEN SemError(200) END .)
  85. ";"
  86. { Import } Block<FALSE> GetIdent<m2>
  87. (. IF ~SymTab.Equal(m1, m2)
  88. THEN SemError(202) END .)
  89. "." (. IF SymTab.AnyForward() THEN
  90. SemError(231)
  91. END;
  92. MGen.EndModule;
  93. SymTab.PrintTable; .) .
  94. Import (. VAR n: SymTab.Name; .)
  95. = "FROM"
  96. GetIdent<n> (. IF ~SymTab.Enter(n, SymTab.KindImport)
  97. THEN SemError(200) END .)
  98. "IMPORT"
  99. ImportList ";"
  100. | "IMPORT"
  101. ImportList ";" .
  102. ImportList (. VAR n: SymTab.Name; .)
  103. = GetIdent<n> (. IF ~SymTab.Enter(n, SymTab.KindImport)
  104. THEN SemError(200) END .)
  105. { ","
  106. GetIdent<n> (. IF ~SymTab.Enter(n, SymTab.KindImport)
  107. THEN SemError(200) END .) } .
  108. Block <isProc: BOOLEAN> (. VAR began: BOOLEAN; .)
  109. = (. began := FALSE; .)
  110. { Declaration }
  111. [ "BEGIN" (. began := TRUE;
  112. IF isProc THEN
  113. MGen.ProcEntry(
  114. SymTab.CurProc(),
  115. SymTab.ProcNLocals())
  116. ELSE MGen.BeginBody
  117. END; .)
  118. StatSeq ]
  119. "END" (. IF isProc THEN
  120. IF ~began THEN
  121. MGen.ProcEntry(
  122. SymTab.CurProc(),
  123. SymTab.ProcNLocals())
  124. END;
  125. IF SymTab.InFunction() THEN
  126. MGen.PushInt(0)
  127. END;
  128. MGen.Leave(SymTab.CurNPar(),
  129. SymTab.InFunction())
  130. END; .) .
  131. Declaration = "CONST"
  132. {
  133. ConstDecl ";" }
  134. | "TYPE"
  135. {
  136. TypeDecl ";" }
  137. | "VAR"
  138. {
  139. VarDecl ";" }
  140. | ProcedureDecl ";" .
  141. ConstDecl (. VAR n: SymTab.Name;
  142. t: SymTab.TypeIndex;
  143. lx: MGen.LitStr;
  144. cls: INTEGER; .)
  145. = GetIdent<n> (. IF ~SymTab.Enter(n, SymTab.KindConst)
  146. THEN SemError(200) END .)
  147. "=" (. MGen.NoEmitEnter; .)
  148. ConstExpr<t, lx> (. SymTab.SetSymType(n, t);
  149. cls := SymTab.ClassOf(t);
  150. IF cls = SymTab.ClStr THEN
  151. SemError(230)
  152. ELSIF ~MGen.IsLit(lx) THEN
  153. SemError(230)
  154. END;
  155. MGen.DeclConst(n, lx, t);
  156. MGen.NoEmitExit; .) .
  157. ConstExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr>
  158. (. VAR vD: BOOLEAN;
  159. vnD: SymTab.Name; .)
  160. = Expr<t, lx, vD, vnD> .
  161. TypeDecl (. VAR n: SymTab.Name;
  162. t0, t1: SymTab.TypeIndex; .)
  163. = GetIdent<n> (. IF ~SymTab.Enter(n, SymTab.KindType)
  164. THEN SemError(200) END;
  165. t0 := SymTab.NewAlias();
  166. SymTab.SetSymType(n, t0); .)
  167. "="
  168. Type<t1> (. IF t1 = t0 THEN SemError(223);
  169. SymTab.SetTarget(t0,
  170. SymTab.InvalidType)
  171. ELSE SymTab.SetTarget(t0, t1) END; .) .
  172. VarDecl (. VAR t: SymTab.TypeIndex;
  173. i: CARDINAL;
  174. nm: SymTab.Name;
  175. cls: INTEGER;
  176. sl: CARDINAL; .)
  177. = VarIdents ":"
  178. Type<t> (. cls := SymTab.ClassOf(t);
  179. IF (cls # SymTab.ClInt)
  180. & (cls # SymTab.ClReal)
  181. & (cls # SymTab.ClBool)
  182. & (cls # SymTab.ClChar)
  183. & (cls # SymTab.ClEnum)
  184. & (cls # SymTab.ClSet)
  185. & (cls # SymTab.ClArray)
  186. & (cls # SymTab.ClRecord)
  187. & (cls # SymTab.ClPtr) THEN
  188. SemError(230)
  189. END;
  190. sl := SymTab.TypeSlots(t);
  191. IF sl = 0 THEN
  192. SemError(230);
  193. sl := 1
  194. END;
  195. i := 0;
  196. WHILE i < SymTab.PendCount() DO
  197. SymTab.PendName(i, nm);
  198. IF SymTab.SymDepth(nm) = 0 THEN
  199. MGen.DeclVarSized(nm, sl)
  200. END;
  201. INC(i)
  202. END;
  203. SymTab.FixPending(t); .) .
  204. VarIdents (. VAR n: SymTab.Name; .)
  205. = GetIdent<n> (. IF ~SymTab.EnterPending(n,
  206. SymTab.KindVar)
  207. THEN SemError(200) END .)
  208. { ","
  209. GetIdent<n> (. IF ~SymTab.EnterPending(n,
  210. SymTab.KindVar)
  211. THEN SemError(200) END .) } .
  212. ProcedureDecl (. VAR n, m: SymTab.Name;
  213. rt: SymTab.TypeIndex;
  214. hasR, ok: BOOLEAN;
  215. endL: INTEGER; .)
  216. = "PROCEDURE" (. hasR := FALSE; .)
  217. GetIdent<n> (. IF SymTab.IsForward(n) THEN
  218. SymTab.ReuseProc(n)
  219. ELSIF ~SymTab.EnterProc(n) THEN
  220. SemError(200)
  221. END;
  222. SymTab.OpenProcScope;
  223. endL := MGen.NewLabel();
  224. MGen.Jmp(endL); .)
  225. [ "(" FormalParams ")" ]
  226. [ ":" QualIdent<rt> (. hasR := TRUE; .) ]
  227. (. IF hasR THEN
  228. ok := SymTab.SetProcRet(rt)
  229. ELSE
  230. ok := SymTab.SetProcRet(
  231. SymTab.InvalidType)
  232. END;
  233. IF ~ok THEN SemError(231) END;
  234. IF ~SymTab.VerifyProc() THEN
  235. SemError(231)
  236. END; .)
  237. ";"
  238. ( Block<TRUE> GetIdent<m> (. IF ~SymTab.Equal(n, m) THEN
  239. SemError(202) END;
  240. MGen.DefLabel(endL);
  241. SymTab.CloseProc; .)
  242. | "FORWARD" (. SymTab.SetForward;
  243. SymTab.CloseProc;
  244. MGen.DefLabel(endL); .) ) .
  245. FormalParams = FPSection { ";" FPSection } .
  246. FPSection (. VAR isV: BOOLEAN;
  247. nn, i: CARDINAL;
  248. pn: ARRAY [0 .. 15] OF SymTab.Name;
  249. n: SymTab.Name;
  250. t: SymTab.TypeIndex; .)
  251. = (. isV := FALSE; nn := 0; .)
  252. [ "VAR" (. isV := TRUE; .) ]
  253. GetIdent<n> (. IF nn <= HIGH(pn) THEN
  254. MGen.CopyName(n, pn[nn])
  255. END;
  256. INC(nn); .)
  257. { "," GetIdent<n> (. IF nn <= HIGH(pn) THEN
  258. MGen.CopyName(n, pn[nn])
  259. END;
  260. INC(nn); .) }
  261. ":" Type<t> (. IF ~isV
  262. & (t # SymTab.InvalidType)
  263. & (SymTab.TypeSlots(t) > 1) THEN
  264. SemError(230)
  265. END;
  266. i := 0;
  267. WHILE i < nn DO
  268. IF i <= HIGH(pn) THEN
  269. IF ~SymTab.EnterParam(
  270. pn[i], isV, t) THEN
  271. SemError(200)
  272. END
  273. END;
  274. INC(i)
  275. END; .) .
  276. QualIdent <VAR t: SymTab.TypeIndex>
  277. (. VAR n, m: SymTab.Name; .)
  278. = GetIdent<n> (. IF ~SymTab.Lookup(n) THEN
  279. SemError(201);
  280. t := SymTab.InvalidType
  281. ELSIF (SymTab.SymKind(n) #
  282. SymTab.KindType)
  283. & (SymTab.SymKind(n) #
  284. SymTab.KindPredef)
  285. & (SymTab.SymKind(n) #
  286. SymTab.KindImport) THEN
  287. SemError(221);
  288. t := SymTab.InvalidType
  289. ELSE t := SymTab.SymType(n) END; .)
  290. { "."
  291. GetIdent<m> (. t := SymTab.InvalidType; .) } .
  292. (* Types: ProcedureType removed; subrange factored for LL(1) *)
  293. Type <VAR t: SymTab.TypeIndex>
  294. = SimpleType<t> | ArrayType<t> | RecordType<t>
  295. | SetType<t> | PointerType<t> .
  296. SimpleType <VAR t: SymTab.TypeIndex>
  297. (. VAR t1, t2: SymTab.TypeIndex;
  298. lx1, lx2: MGen.LitStr;
  299. vD: BOOLEAN;
  300. vnD: SymTab.Name;
  301. loI, hiI: INTEGER;
  302. lok, hik: BOOLEAN; .)
  303. = QualIdent<t> [ "["
  304. (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE;
  305. loI := 0; hiI := -1; .)
  306. ConstExpr<t1, lx1> (. IF (t1 # SymTab.InvalidType)
  307. & (SymTab.ClassOf(t1) #
  308. SymTab.ClInt)
  309. & (SymTab.ClassOf(t1) #
  310. SymTab.ClChar)
  311. & (SymTab.ClassOf(t1) #
  312. SymTab.ClEnum) THEN
  313. SemError(224) END; .)
  314. ".."
  315. ConstExpr<t2, lx2> (. IF (t2 # SymTab.InvalidType)
  316. & (SymTab.ClassOf(t2) #
  317. SymTab.ClInt)
  318. & (SymTab.ClassOf(t2) #
  319. SymTab.ClChar)
  320. & (SymTab.ClassOf(t2) #
  321. SymTab.ClEnum) THEN
  322. SemError(224) END; .)
  323. "]"
  324. (. IF (t1 # SymTab.InvalidType)
  325. & (t2 # SymTab.InvalidType) THEN
  326. IF MGen.IsLit(lx1) THEN
  327. IF SymTab.ClassOf(t1)
  328. = SymTab.ClChar THEN
  329. loI := MGen.CharOrd(lx1);
  330. lok := TRUE
  331. ELSIF MGen.ParseInt(lx1, loI) THEN
  332. lok := TRUE
  333. END
  334. END;
  335. IF MGen.IsLit(lx2) THEN
  336. IF SymTab.ClassOf(t2)
  337. = SymTab.ClChar THEN
  338. hiI := MGen.CharOrd(lx2);
  339. hik := TRUE
  340. ELSIF MGen.ParseInt(lx2, hiI) THEN
  341. hik := TRUE
  342. END
  343. END
  344. END;
  345. IF lok & hik THEN
  346. t := SymTab.NewSubB(t1, loI, hiI)
  347. ELSE
  348. t := SymTab.NewSub(t1);
  349. IF (t1 # SymTab.InvalidType)
  350. & (t2 # SymTab.InvalidType) THEN
  351. SemError(230)
  352. END
  353. END;
  354. MGen.NoEmitExit; .) ]
  355. | "[" (. MGen.NoEmitEnter; lok := FALSE;
  356. hik := FALSE; loI := 0; hiI := -1; .)
  357. ConstExpr<t1, lx1> (. IF (t1 # SymTab.InvalidType)
  358. & (SymTab.ClassOf(t1) #
  359. SymTab.ClInt)
  360. & (SymTab.ClassOf(t1) #
  361. SymTab.ClChar)
  362. & (SymTab.ClassOf(t1) #
  363. SymTab.ClEnum) THEN
  364. SemError(224) END; .)
  365. ".."
  366. ConstExpr<t2, lx2> (. IF (t2 # SymTab.InvalidType)
  367. & (SymTab.ClassOf(t2) #
  368. SymTab.ClInt)
  369. & (SymTab.ClassOf(t2) #
  370. SymTab.ClChar)
  371. & (SymTab.ClassOf(t2) #
  372. SymTab.ClEnum) THEN
  373. SemError(224) END; .)
  374. "]" (. IF (t1 # SymTab.InvalidType)
  375. & (t2 # SymTab.InvalidType) THEN
  376. IF MGen.IsLit(lx1) THEN
  377. IF SymTab.ClassOf(t1)
  378. = SymTab.ClChar THEN
  379. loI := MGen.CharOrd(lx1);
  380. lok := TRUE
  381. ELSIF MGen.ParseInt(lx1,
  382. loI) THEN
  383. lok := TRUE
  384. END
  385. END;
  386. IF MGen.IsLit(lx2) THEN
  387. IF SymTab.ClassOf(t2)
  388. = SymTab.ClChar THEN
  389. hiI := MGen.CharOrd(lx2);
  390. hik := TRUE
  391. ELSIF MGen.ParseInt(lx2,
  392. hiI) THEN
  393. hik := TRUE
  394. END
  395. END
  396. END;
  397. IF lok & hik THEN
  398. t := SymTab.NewSubB(t1, loI, hiI)
  399. ELSE
  400. t := SymTab.NewSub(t1);
  401. IF (t1 # SymTab.InvalidType)
  402. & (t2 # SymTab.InvalidType) THEN
  403. SemError(230)
  404. END
  405. END;
  406. MGen.NoEmitExit; .)
  407. | Enum<t> .
  408. Enum <VAR t: SymTab.TypeIndex>
  409. (. VAR n: SymTab.Name;
  410. ord: INTEGER; .)
  411. = "(" (. t := SymTab.NewEnum();
  412. ord := 0; .)
  413. GetIdent<n> (. IF ~SymTab.Enter(n,
  414. SymTab.KindConst)
  415. THEN SemError(200) END;
  416. SymTab.SetSymType(n, t);
  417. SymTab.EnumAdd(t);
  418. MGen.DeclConstInt(n, ord);
  419. INC(ord); .)
  420. { ","
  421. GetIdent<n> (. IF ~SymTab.Enter(n,
  422. SymTab.KindConst)
  423. THEN SemError(200) END;
  424. SymTab.SetSymType(n, t);
  425. SymTab.EnumAdd(t);
  426. MGen.DeclConstInt(n, ord);
  427. INC(ord); .) }
  428. ")" .
  429. ArrayType <VAR t: SymTab.TypeIndex>
  430. (. VAR s, s2, e: SymTab.TypeIndex;
  431. idx: ARRAY [0 .. 7] OF
  432. SymTab.TypeIndex;
  433. nc, kk: CARDINAL;
  434. loA, hiA: INTEGER;
  435. isOpenA: BOOLEAN; .)
  436. = "ARRAY"
  437. [ SimpleType<s> (. IF (s # SymTab.InvalidType)
  438. & (SymTab.ClassOf(s) #
  439. SymTab.ClInt)
  440. & (SymTab.ClassOf(s) #
  441. SymTab.ClChar)
  442. & (SymTab.ClassOf(s) #
  443. SymTab.ClEnum) THEN
  444. SemError(224) END;
  445. nc := 0; isOpenA := FALSE;
  446. idx[nc] := s; INC(nc); .)
  447. { ","
  448. SimpleType<s2> (. IF (s2 # SymTab.InvalidType)
  449. & (SymTab.ClassOf(s2) #
  450. SymTab.ClInt)
  451. & (SymTab.ClassOf(s2) #
  452. SymTab.ClChar)
  453. & (SymTab.ClassOf(s2) #
  454. SymTab.ClEnum) THEN
  455. SemError(224) END;
  456. IF nc <= HIGH(idx) THEN
  457. idx[nc] := s2; INC(nc)
  458. END; .) }
  459. | (. nc := 0; isOpenA := TRUE; .) ]
  460. "OF"
  461. Type<e> (. IF isOpenA THEN
  462. t := SymTab.NewOpen(e)
  463. ELSE
  464. t := e;
  465. kk := nc;
  466. WHILE kk > 0 DO
  467. DEC(kk);
  468. loA := SymTab.TypeLo(idx[kk]);
  469. hiA := SymTab.TypeHi(idx[kk]);
  470. IF SymTab.TypeLen(idx[kk]) = 0 THEN
  471. IF idx[kk]
  472. # SymTab.InvalidType THEN
  473. SemError(230)
  474. END;
  475. loA := 0; hiA := -1
  476. END;
  477. t := SymTab.NewArrayB(t,
  478. loA, hiA)
  479. END
  480. END; .) .
  481. RecordType <VAR t: SymTab.TypeIndex>
  482. = "RECORD" (. t := SymTab.NewRecord(); .)
  483. FieldSeq<t>
  484. "END" .
  485. FieldSeq <rt: SymTab.TypeIndex>
  486. = Field<rt> { ";"
  487. Field<rt> } .
  488. Field <rt: SymTab.TypeIndex>
  489. (. VAR et: SymTab.TypeIndex; .)
  490. = [ FieldIdents<rt> ":"
  491. Type<et> (. IF (et # SymTab.InvalidType)
  492. & SymTab.IsOpen(et) THEN
  493. SemError(230)
  494. END;
  495. SymTab.FixPendingF(rt, et); .) ] .
  496. FieldIdents <rt: SymTab.TypeIndex>
  497. (. VAR n: SymTab.Name; .)
  498. = GetIdent<n> (. IF ~SymTab.FieldPending(rt, n)
  499. THEN SemError(200) END .)
  500. { ","
  501. GetIdent<n> (. IF ~SymTab.FieldPending(rt, n)
  502. THEN SemError(200) END .) } .
  503. SetType <VAR t: SymTab.TypeIndex>
  504. (. VAR s: SymTab.TypeIndex; .)
  505. = "SET"
  506. "OF"
  507. SimpleType<s> (. IF (s # SymTab.InvalidType)
  508. & (SymTab.ClassOf(s) #
  509. SymTab.ClInt)
  510. & (SymTab.ClassOf(s) #
  511. SymTab.ClChar)
  512. & (SymTab.ClassOf(s) #
  513. SymTab.ClEnum) THEN
  514. SemError(224) END;
  515. t := SymTab.NewSet(s); .) .
  516. PointerType <VAR t: SymTab.TypeIndex>
  517. (. VAR b: SymTab.TypeIndex; .)
  518. = "POINTER"
  519. "TO"
  520. Type<b> (. t := SymTab.NewPtr(b); .) .
  521. (* Statements: RETURN added; calls via AssignOrCall *)
  522. StatSeq = Stat { ";"
  523. Stat } .
  524. Stat (. VAR lx: INTEGER; .)
  525. = [ AssignOrCall | IfStat | CaseStat | WhileStat
  526. | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat
  527. | NewStat | DispStat | WriteIntStat | WriteStrStat
  528. | "EXIT" (. IF MGen.TopLoop(lx) THEN
  529. MGen.Jmp(lx)
  530. ELSE SemError(230) END; .) ] .
  531. AssignOrCall (. VAR dt, et: SymTab.TypeIndex;
  532. dk: INTEGER;
  533. bn: SymTab.Name;
  534. lxD, lxe: MGen.LitStr;
  535. vE: BOOLEAN;
  536. vnE: SymTab.Name;
  537. sfx: BOOLEAN;
  538. okC: BOOLEAN;
  539. isR, conv,
  540. storable, pushedDst,
  541. pushedFld: BOOLEAN;
  542. dstBytes, srcBytes: CARDINAL;
  543. elemDt: SymTab.TypeIndex; .)
  544. = (. sfx := FALSE; pushedDst := FALSE;
  545. pushedFld := FALSE; .)
  546. DesignHead<dt, dk, bn, FALSE, lxD>
  547. ( DesignTail<dt, dk, bn, FALSE, lxD, sfx> ":="
  548. (. storable :=
  549. (dk = SymTab.KindVar)
  550. OR (dk = SymTab.KindParam)
  551. OR (dk = SymTab.KindVarPar);
  552. IF (dk = SymTab.KindField)
  553. & (~sfx)
  554. & (dt # SymTab.InvalidType) THEN
  555. MGen.WithAddr(bn);
  556. pushedFld := TRUE
  557. END;
  558. IF storable & ~sfx
  559. & (dt # SymTab.InvalidType)
  560. & ((SymTab.ClassOf(dt)
  561. = SymTab.ClArray)
  562. OR (SymTab.ClassOf(dt)
  563. = SymTab.ClRecord)) THEN
  564. MGen.PushAddr(bn);
  565. pushedDst := TRUE
  566. END;
  567. IF storable & ~sfx
  568. & ~pushedDst THEN
  569. IF (dt # SymTab.InvalidType)
  570. & (SymTab.TypeSlots(dt)
  571. > 1) THEN
  572. ELSE MGen.StoreSetup(bn)
  573. END
  574. END; .)
  575. Expr<et, lxe, vE, vnE> (. IF (dt # SymTab.InvalidType)
  576. & (dk # SymTab.KindVar)
  577. & (dk # SymTab.KindParam)
  578. & (dk # SymTab.KindVarPar)
  579. & (dk # SymTab.KindField)
  580. & (dk # SymTab.KindImport) THEN
  581. SemError(210)
  582. ELSIF pushedDst THEN
  583. IF et = SymTab.InvalidType THEN
  584. MGen.Drop; MGen.Drop
  585. ELSIF (SymTab.ClassOf(dt)
  586. = SymTab.ClArray)
  587. & (SymTab.ClassOf(
  588. SymTab.ArrayElem(dt))
  589. = SymTab.ClChar)
  590. & (SymTab.ClassOf(et)
  591. = SymTab.ClStr) THEN
  592. srcBytes :=
  593. MGen.StrLenOf(lxe) + 1;
  594. dstBytes :=
  595. SymTab.TypeSlots(dt) * 8;
  596. IF srcBytes > dstBytes THEN
  597. SemError(210);
  598. MGen.Drop; MGen.Drop
  599. ELSE
  600. MGen.PushBytes(srcBytes);
  601. MGen.CopyBlock
  602. END
  603. ELSIF ~SymTab.Assignable(et,
  604. dt) THEN
  605. SemError(210);
  606. MGen.Drop; MGen.Drop
  607. ELSE
  608. dstBytes :=
  609. SymTab.TypeSlots(dt) * 8;
  610. MGen.PushBytes(dstBytes);
  611. MGen.CopyBlock
  612. END
  613. ELSIF pushedFld THEN
  614. IF et = SymTab.InvalidType THEN
  615. MGen.Drop; MGen.Drop
  616. ELSIF (SymTab.TypeSlots(dt) > 1) THEN
  617. IF (SymTab.ClassOf(dt)
  618. = SymTab.ClArray)
  619. & (SymTab.ClassOf(
  620. SymTab.ArrayElem(dt))
  621. = SymTab.ClChar)
  622. & (SymTab.ClassOf(et)
  623. = SymTab.ClStr) THEN
  624. srcBytes :=
  625. MGen.StrLenOf(lxe) + 1;
  626. dstBytes :=
  627. SymTab.TypeSlots(dt) * 8;
  628. IF srcBytes > dstBytes THEN
  629. SemError(210);
  630. MGen.Drop; MGen.Drop
  631. ELSE
  632. MGen.PushBytes(srcBytes);
  633. MGen.CopyBlock
  634. END
  635. ELSIF ~SymTab.Assignable(et,
  636. dt) THEN
  637. SemError(210);
  638. MGen.Drop; MGen.Drop
  639. ELSE
  640. dstBytes :=
  641. SymTab.TypeSlots(dt) * 8;
  642. MGen.PushBytes(dstBytes);
  643. MGen.CopyBlock
  644. END
  645. ELSE
  646. IF ~SymTab.Assignable(et,
  647. dt) THEN
  648. SemError(210);
  649. MGen.Drop; MGen.Drop
  650. ELSE
  651. isR :=
  652. (SymTab.ClassOf(dt)
  653. = SymTab.ClReal);
  654. conv := isR
  655. & SymTab.IsIntFamily(et);
  656. IF conv THEN
  657. MGen.IntToReal
  658. END;
  659. IF (SymTab.ClassOf(dt)
  660. = SymTab.ClChar)
  661. OR (SymTab.ClassOf(dt)
  662. = SymTab.ClBool) THEN
  663. MGen.StoreByte
  664. ELSE MGen.StoreIndir0
  665. END
  666. END
  667. END
  668. ELSIF (dt # SymTab.InvalidType)
  669. & ~sfx
  670. & (SymTab.TypeSlots(dt) > 1) THEN
  671. IF ~SymTab.Assignable(et, dt) THEN
  672. SemError(210)
  673. ELSE SemError(230)
  674. END
  675. ELSIF ~SymTab.Assignable(et, dt) THEN
  676. SemError(210) END;
  677. IF dk = SymTab.KindImport THEN
  678. SemError(230)
  679. END;
  680. isR := (dt # SymTab.InvalidType)
  681. & ~pushedDst
  682. & ~pushedFld
  683. & (SymTab.ClassOf(dt)
  684. = SymTab.ClReal);
  685. conv := isR
  686. & SymTab.IsIntFamily(et);
  687. IF pushedDst THEN
  688. ELSIF pushedFld THEN
  689. ELSIF (dt # SymTab.InvalidType)
  690. & sfx THEN
  691. IF conv THEN
  692. MGen.IntToReal
  693. END;
  694. IF (SymTab.ClassOf(dt)
  695. = SymTab.ClChar)
  696. OR (SymTab.ClassOf(dt)
  697. = SymTab.ClBool) THEN
  698. MGen.StoreByte
  699. ELSE MGen.StoreIndir0
  700. END
  701. ELSIF storable & ~sfx THEN
  702. IF (dt # SymTab.InvalidType)
  703. & (SymTab.TypeSlots(dt)
  704. > 1) THEN
  705. MGen.Drop
  706. ELSE
  707. IF conv THEN
  708. MGen.IntToReal
  709. END;
  710. MGen.StoreFinish(bn)
  711. END
  712. ELSE MGen.Drop
  713. END; .)
  714. | CallTail<bn, sfx, FALSE, okC, FALSE>
  715. | (. MGen.ActBegin(bn);
  716. IF MGen.ActEnd(bn, FALSE, FALSE) # 0 THEN
  717. SemError(233)
  718. END; .) ) .
  719. CallTail <pn: SymTab.Name; sfx: BOOLEAN; inExpr: BOOLEAN;
  720. VAR ok: BOOLEAN; hasDead: BOOLEAN>
  721. (. VAR t: SymTab.TypeIndex;
  722. lx: MGen.LitStr;
  723. v: BOOLEAN;
  724. vn: SymTab.Name; .)
  725. = "(" (. ok := FALSE;
  726. IF hasDead THEN MGen.Drop END;
  727. MGen.ActBegin(pn); .)
  728. [ Expr<t, lx, v, vn> (. IF MGen.ActValue(t, v, vn) # 0 THEN
  729. SemError(233)
  730. END; .)
  731. { "," Expr<t, lx, v, vn> (. IF MGen.ActValue(t, v, vn) # 0 THEN
  732. SemError(233)
  733. END; .) } ]
  734. ")" (. IF MGen.ActEnd(pn, sfx, inExpr) # 0
  735. THEN SemError(233)
  736. ELSE ok := TRUE
  737. END; .) .
  738. IfStat (. VAR t: SymTab.TypeIndex;
  739. lxC: MGen.LitStr;
  740. vC: BOOLEAN;
  741. vnC: SymTab.Name;
  742. elseL, endL: INTEGER;
  743. hasElse: BOOLEAN; .)
  744. = "IF"
  745. Expr<t, lxC, vC, vnC> (. IF ~SymTab.BoolCheck(t) THEN
  746. SemError(214) END;
  747. elseL := MGen.NewLabel();
  748. endL := MGen.NewLabel();
  749. MGen.Jz(elseL);
  750. hasElse := FALSE; .)
  751. "THEN"
  752. StatSeq
  753. { "ELSIF" (. MGen.Jmp(endL);
  754. MGen.DefLabel(elseL); .)
  755. Expr<t, lxC, vC, vnC> (. IF ~SymTab.BoolCheck(t) THEN
  756. SemError(214) END;
  757. elseL := MGen.NewLabel();
  758. MGen.Jz(elseL); .)
  759. "THEN"
  760. StatSeq }
  761. [ "ELSE" (. MGen.Jmp(endL);
  762. MGen.DefLabel(elseL);
  763. hasElse := TRUE; .)
  764. StatSeq ]
  765. "END" (. IF ~hasElse THEN
  766. MGen.DefLabel(elseL)
  767. END;
  768. MGen.DefLabel(endL); .) .
  769. CaseStat (. VAR st: SymTab.TypeIndex;
  770. lxS: MGen.LitStr;
  771. vS: BOOLEAN;
  772. vnS: SymTab.Name;
  773. tmp, endL: INTEGER; .)
  774. = "CASE"
  775. Expr<st, lxS, vS, vnS> (. tmp := MGen.TempGlobal();
  776. MGen.StoreTemp(tmp);
  777. endL := MGen.NewLabel(); .)
  778. "OF"
  779. Case<st, tmp, endL> { "|"
  780. Case<st, tmp, endL> }
  781. [ "ELSE"
  782. StatSeq ]
  783. "END" (. MGen.DefLabel(endL); .) .
  784. Case <sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER>
  785. (. VAR lB, lN: INTEGER; .)
  786. = [ LabelList<sel, tmp, lB, lN> ":" (. MGen.DefLabel(lB); .)
  787. StatSeq (. MGen.Jmp(endL);
  788. MGen.DefLabel(lN); .) ] .
  789. LabelList <sel: SymTab.TypeIndex; tmp: INTEGER;
  790. VAR lB: INTEGER; VAR lN: INTEGER>
  791. = (. lB := MGen.NewLabel();
  792. lN := MGen.NewLabel(); .)
  793. Labels<sel, tmp, lB> { ","
  794. Labels<sel, tmp, lB> }
  795. (. MGen.Jmp(lN); .) .
  796. Labels <sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER>
  797. (. VAR t, t2: SymTab.TypeIndex;
  798. lx1, lx2: MGen.LitStr;
  799. v1, v2: BOOLEAN;
  800. vn1, vn2: SymTab.Name;
  801. ta, tb, chunk: INTEGER;
  802. r, hasRange: BOOLEAN; .)
  803. = ConstExpr<t, lx1> (. IF ~SymTab.EqCheck(t, sel) THEN
  804. SemError(213) END;
  805. r := (SymTab.ClassOf(sel)
  806. = SymTab.ClReal)
  807. & (SymTab.ClassOf(t)
  808. = SymTab.ClReal);
  809. ta := MGen.TempGlobal();
  810. MGen.StoreTemp(ta);
  811. hasRange := FALSE; .)
  812. [ ".."
  813. ConstExpr<t2, lx2> (. IF ~SymTab.EqCheck(t2, sel) THEN
  814. SemError(213) END;
  815. tb := MGen.TempGlobal();
  816. MGen.StoreTemp(tb);
  817. hasRange := TRUE; .) ]
  818. (. IF hasRange THEN
  819. MGen.LoadTemp(tmp);
  820. MGen.LoadTemp(ta);
  821. IF r THEN MGen.RealGe
  822. ELSE MGen.IGe END;
  823. MGen.LoadTemp(tmp);
  824. MGen.LoadTemp(tb);
  825. IF r THEN MGen.RealLe
  826. ELSE MGen.ILe END;
  827. MGen.And
  828. ELSE
  829. MGen.LoadTemp(tmp);
  830. MGen.LoadTemp(ta);
  831. IF r THEN MGen.RealEq
  832. ELSE MGen.Eq END
  833. END;
  834. chunk := MGen.NewLabel();
  835. MGen.Jz(chunk);
  836. MGen.Jmp(bodyL);
  837. MGen.DefLabel(chunk); .) .
  838. WhileStat (. VAR t: SymTab.TypeIndex;
  839. lxC: MGen.LitStr;
  840. vC: BOOLEAN;
  841. vnC: SymTab.Name;
  842. topL, endL: INTEGER; .)
  843. = "WHILE" (. topL := MGen.NewLabel();
  844. endL := MGen.NewLabel();
  845. MGen.DefLabel(topL); .)
  846. Expr<t, lxC, vC, vnC> (. IF ~SymTab.BoolCheck(t) THEN
  847. SemError(214) END;
  848. MGen.Jz(endL); .)
  849. "DO"
  850. StatSeq
  851. "END" (. MGen.Jmp(topL);
  852. MGen.DefLabel(endL); .) .
  853. RepeatStat (. VAR t: SymTab.TypeIndex;
  854. lxC: MGen.LitStr;
  855. vC: BOOLEAN;
  856. vnC: SymTab.Name;
  857. topL: INTEGER; .)
  858. = "REPEAT" (. topL := MGen.NewLabel();
  859. MGen.DefLabel(topL); .)
  860. StatSeq
  861. "UNTIL"
  862. Expr<t, lxC, vC, vnC> (. IF ~SymTab.BoolCheck(t) THEN
  863. SemError(214) END;
  864. MGen.Jz(topL); .) .
  865. LoopStat (. VAR topL, exitL: INTEGER; .)
  866. = "LOOP" (. topL := MGen.NewLabel();
  867. exitL := MGen.NewLabel();
  868. MGen.DefLabel(topL);
  869. MGen.PushLoop(exitL); .)
  870. StatSeq
  871. "END" (. MGen.Jmp(topL);
  872. MGen.DefLabel(exitL);
  873. MGen.PopLoop; .) .
  874. ForStat (. VAR n, lv: SymTab.Name;
  875. fk: INTEGER;
  876. lo, hi: SymTab.TypeIndex;
  877. lxLo, lxHi: MGen.LitStr;
  878. vLo, vHi: BOOLEAN;
  879. vnLo, vnHi: SymTab.Name;
  880. byV, ht: INTEGER;
  881. lTop, lChk, lEnd: INTEGER;
  882. neg, storable: BOOLEAN; .)
  883. = "FOR"
  884. GetIdent<n> (. IF ~SymTab.Lookup(n) THEN
  885. SemError(201);
  886. fk := -1
  887. ELSIF (SymTab.SymKind(n) #
  888. SymTab.KindVar)
  889. & (SymTab.SymKind(n) #
  890. SymTab.KindParam)
  891. & (SymTab.SymKind(n) #
  892. SymTab.KindVarPar)
  893. & (SymTab.SymKind(n) #
  894. SymTab.KindField) THEN
  895. SemError(220);
  896. fk := -1
  897. ELSIF (SymTab.SymType(n) #
  898. SymTab.InvalidType)
  899. & ~SymTab.IsIntFamily(
  900. SymTab.SymType(n)) THEN
  901. SemError(220);
  902. fk := -1
  903. ELSE
  904. fk := SymTab.SymKind(n)
  905. END;
  906. MGen.CopyName(n, lv);
  907. storable := (fk = SymTab.KindVar)
  908. OR (fk = SymTab.KindParam)
  909. OR (fk = SymTab.KindVarPar);
  910. IF storable THEN
  911. MGen.StoreSetup(lv)
  912. END; .)
  913. ":="
  914. Expr<lo, lxLo, vLo, vnLo> (. IF (lo # SymTab.InvalidType)
  915. & ~SymTab.IsIntFamily(lo) THEN
  916. SemError(220) END;
  917. IF storable THEN
  918. MGen.StoreFinish(lv)
  919. ELSE MGen.Drop
  920. END; .)
  921. "TO"
  922. Expr<hi, lxHi, vHi, vnHi> (. IF (hi # SymTab.InvalidType)
  923. & ~SymTab.IsIntFamily(hi) THEN
  924. SemError(220) END;
  925. ht := MGen.TempGlobal();
  926. MGen.StoreTemp(ht);
  927. byV := 1; neg := FALSE; .)
  928. [ "BY"
  929. ByLit<byV> (. neg := byV < 0; .) ]
  930. "DO" (. lTop := MGen.NewLabel();
  931. lChk := MGen.NewLabel();
  932. lEnd := MGen.NewLabel();
  933. MGen.Jmp(lChk);
  934. MGen.DefLabel(lTop); .)
  935. StatSeq
  936. "END" (. MGen.PushVar(lv);
  937. MGen.PushInt(byV);
  938. MGen.Add;
  939. IF storable THEN
  940. MGen.StoreFinish(lv)
  941. ELSE MGen.Drop
  942. END;
  943. MGen.DefLabel(lChk);
  944. MGen.PushVar(lv);
  945. MGen.LoadTemp(ht);
  946. IF neg THEN MGen.IGe
  947. ELSE MGen.ILe END;
  948. MGen.Jz(lEnd);
  949. MGen.Jmp(lTop);
  950. MGen.DefLabel(lEnd); .) .
  951. ByLit <VAR v: INTEGER> (. VAR s: ARRAY [0 .. 255] OF CHAR; .)
  952. = integer (. LexString(s);
  953. IF ~MGen.ParseInt(s, v) THEN
  954. v := 1
  955. END; .)
  956. | "-" integer (. LexString(s);
  957. IF MGen.ParseInt(s, v) THEN
  958. v := -v
  959. ELSE v := -1
  960. END; .) .
  961. WithStat (. VAR dt: SymTab.TypeIndex;
  962. dk: INTEGER;
  963. bnW: SymTab.Name;
  964. lxW: MGen.LitStr;
  965. sfxW: BOOLEAN;
  966. pushed: BOOLEAN; .)
  967. = "WITH"
  968. DesignHead<dt, dk, bnW, FALSE, lxW>
  969. DesignTail<dt, dk, bnW, FALSE, lxW, sfxW>
  970. (. pushed := FALSE;
  971. IF dt = SymTab.InvalidType THEN
  972. IF sfxW THEN MGen.Drop END
  973. ELSIF SymTab.ClassOf(dt)
  974. # SymTab.ClRecord THEN
  975. SemError(215);
  976. IF sfxW THEN MGen.Drop END
  977. ELSE
  978. IF ~sfxW THEN
  979. IF (dk
  980. = SymTab.KindVar)
  981. OR (dk
  982. = SymTab.KindParam)
  983. OR (dk
  984. = SymTab.KindVarPar) THEN
  985. MGen.PushAddr(bnW)
  986. ELSIF dk
  987. = SymTab.KindField THEN
  988. MGen.WithAddr(bnW)
  989. ELSE MGen.PushInt(0)
  990. END
  991. END;
  992. MGen.WithEnter(dt);
  993. pushed :=
  994. SymTab.PushRecord(dt);
  995. IF ~pushed THEN
  996. SemError(215)
  997. END
  998. END; .)
  999. "DO"
  1000. StatSeq
  1001. "END" (. IF pushed THEN
  1002. SymTab.PopScope;
  1003. MGen.WithExit
  1004. END; .) .
  1005. ReturnStat (. VAR t: SymTab.TypeIndex;
  1006. lx: MGen.LitStr;
  1007. v: BOOLEAN;
  1008. vn: SymTab.Name;
  1009. hasE, doRet, conv: BOOLEAN; .)
  1010. = "RETURN" (. hasE := FALSE; .)
  1011. [ Expr<t, lx, v, vn> (. hasE := TRUE;
  1012. doRet := FALSE;
  1013. IF ~SymTab.InProc() THEN
  1014. SemError(232)
  1015. ELSIF ~SymTab.InFunction() THEN
  1016. SemError(232)
  1017. ELSIF ~SymTab.Assignable(
  1018. t, SymTab.CurRet()) THEN
  1019. SemError(232)
  1020. ELSE doRet := TRUE
  1021. END;
  1022. conv := doRet
  1023. & SymTab.IsIntFamily(t)
  1024. & (SymTab.ClassOf(
  1025. SymTab.CurRet())
  1026. = SymTab.ClReal);
  1027. IF doRet THEN
  1028. IF conv THEN
  1029. MGen.IntToReal
  1030. END;
  1031. MGen.Leave(
  1032. SymTab.CurNPar(), TRUE)
  1033. ELSE MGen.Drop
  1034. END; .) ]
  1035. (. IF ~hasE THEN
  1036. IF ~SymTab.InProc() THEN
  1037. SemError(232)
  1038. ELSIF SymTab.InFunction() THEN
  1039. SemError(232)
  1040. ELSE MGen.Leave(
  1041. SymTab.CurNPar(), FALSE)
  1042. END
  1043. END; .) .
  1044. NewStat (. VAR dt: SymTab.TypeIndex;
  1045. dk: INTEGER;
  1046. bnN: SymTab.Name;
  1047. lxN: MGen.LitStr;
  1048. sfxN: BOOLEAN;
  1049. baseT: SymTab.TypeIndex;
  1050. slN: CARDINAL; .)
  1051. = "NEW"
  1052. "(" DesignHead<dt, dk, bnN, FALSE, lxN>
  1053. DesignTail<dt, dk, bnN, FALSE, lxN, sfxN>
  1054. ")" (. IF dt = SymTab.InvalidType THEN
  1055. IF sfxN THEN MGen.Drop END
  1056. ELSIF SymTab.ClassOf(dt)
  1057. # SymTab.ClPtr THEN
  1058. SemError(219);
  1059. IF sfxN THEN MGen.Drop END
  1060. ELSE
  1061. baseT := SymTab.PtrBase(dt);
  1062. slN := SymTab.TypeSlots(baseT);
  1063. IF slN = 0 THEN
  1064. SemError(230);
  1065. slN := 1
  1066. END;
  1067. IF ~sfxN THEN
  1068. IF (dk = SymTab.KindVar)
  1069. OR (dk
  1070. = SymTab.KindParam)
  1071. OR (dk
  1072. = SymTab.KindVarPar) THEN
  1073. MGen.PushAddr(bnN)
  1074. ELSIF dk
  1075. = SymTab.KindField THEN
  1076. MGen.WithAddr(bnN)
  1077. ELSE MGen.PushInt(0)
  1078. END
  1079. END;
  1080. MGen.PushBytes(slN * 8);
  1081. MGen.AllocOp
  1082. END; .) .
  1083. DispStat (. VAR dt: SymTab.TypeIndex;
  1084. dk: INTEGER;
  1085. bnD: SymTab.Name;
  1086. lxD: MGen.LitStr;
  1087. sfxD: BOOLEAN;
  1088. baseT: SymTab.TypeIndex;
  1089. slD: CARDINAL; .)
  1090. = "DISPOSE"
  1091. "(" DesignHead<dt, dk, bnD, FALSE, lxD>
  1092. DesignTail<dt, dk, bnD, FALSE, lxD, sfxD>
  1093. ")" (. IF dt = SymTab.InvalidType THEN
  1094. IF sfxD THEN MGen.Drop END
  1095. ELSIF SymTab.ClassOf(dt)
  1096. # SymTab.ClPtr THEN
  1097. SemError(219);
  1098. IF sfxD THEN MGen.Drop END
  1099. ELSE
  1100. baseT := SymTab.PtrBase(dt);
  1101. slD := SymTab.TypeSlots(baseT);
  1102. IF slD = 0 THEN
  1103. SemError(230);
  1104. slD := 1
  1105. END;
  1106. IF ~sfxD THEN
  1107. IF (dk = SymTab.KindVar)
  1108. OR (dk
  1109. = SymTab.KindParam)
  1110. OR (dk
  1111. = SymTab.KindVarPar) THEN
  1112. MGen.PushAddr(bnD)
  1113. ELSIF dk
  1114. = SymTab.KindField THEN
  1115. MGen.WithAddr(bnD)
  1116. ELSE MGen.PushInt(0)
  1117. END
  1118. END;
  1119. MGen.PushBytes(slD * 8);
  1120. MGen.DeallocOp
  1121. END; .) .
  1122. WriteIntStat (. VAR t: SymTab.TypeIndex;
  1123. lx: MGen.LitStr;
  1124. v: BOOLEAN;
  1125. vn: SymTab.Name; .)
  1126. = "WriteInt"
  1127. "(" Expr<t, lx, v, vn> ")" (. IF t = SymTab.InvalidType THEN
  1128. MGen.Drop
  1129. ELSIF ~SymTab.IsIntFamily(t) THEN
  1130. SemError(210);
  1131. MGen.Drop
  1132. ELSE
  1133. MGen.CallPrint
  1134. END; .) .
  1135. WriteStrStat (. VAR t: SymTab.TypeIndex;
  1136. lx: MGen.LitStr;
  1137. v: BOOLEAN;
  1138. vn: SymTab.Name; .)
  1139. = "WriteString"
  1140. "(" Expr<t, lx, v, vn> ")" (. IF t = SymTab.InvalidType THEN
  1141. MGen.Drop
  1142. ELSIF (SymTab.ClassOf(t)
  1143. = SymTab.ClStr) THEN
  1144. MGen.PushInt(1);
  1145. MGen.SysCall
  1146. ELSIF (SymTab.ClassOf(t)
  1147. = SymTab.ClArray)
  1148. & (SymTab.ClassOf(
  1149. SymTab.ArrayElem(t))
  1150. = SymTab.ClChar) THEN
  1151. MGen.PushInt(1);
  1152. MGen.SysCall
  1153. ELSE
  1154. SemError(210);
  1155. MGen.Drop
  1156. END; .) .
  1157. (* Expressions: Designator without ActualParameters (calls use
  1158. CallTail). Each expression synthesizes its SymTab type in t,
  1159. the source text in lx for single literals ("" otherwise), and
  1160. whether it is a plain variable (v/vn) for VAR actuals.
  1161. Values travel on the MC64 stack. *)
  1162. DesignHead <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  1163. VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr>
  1164. (. VAR n: SymTab.Name;
  1165. cls: INTEGER; .)
  1166. = GetIdent<n> (. MGen.CopyName(n, bn);
  1167. lx[0] := 0C;
  1168. IF ~SymTab.Lookup(n) THEN
  1169. SemError(201);
  1170. t := SymTab.InvalidType; k := -1;
  1171. IF doLoad THEN
  1172. MGen.PushInt(0)
  1173. END
  1174. ELSE
  1175. t := SymTab.SymType(n);
  1176. k := SymTab.SymKind(n);
  1177. IF k = SymTab.KindConst THEN
  1178. IF SymTab.Equal(n, "TRUE") THEN
  1179. t := SymTab.BoolType();
  1180. MGen.CopyName("TRUE", lx);
  1181. IF doLoad THEN
  1182. MGen.PushInt(1)
  1183. END
  1184. ELSIF SymTab.Equal(n,
  1185. "FALSE") THEN
  1186. t := SymTab.BoolType();
  1187. MGen.CopyName("FALSE", lx);
  1188. IF doLoad THEN
  1189. MGen.PushInt(0)
  1190. END
  1191. ELSE
  1192. cls :=
  1193. SymTab.ClassOf(t);
  1194. IF (t #
  1195. SymTab.InvalidType)
  1196. & (cls # SymTab.ClStr)
  1197. & ((cls = SymTab.ClInt)
  1198. OR (cls = SymTab.ClReal)
  1199. OR (cls = SymTab.ClBool)
  1200. OR (cls = SymTab.ClChar)
  1201. OR (cls
  1202. = SymTab.ClEnum)) THEN
  1203. IF doLoad THEN
  1204. MGen.LoadVar(n)
  1205. END
  1206. ELSIF doLoad THEN
  1207. MGen.PushInt(0)
  1208. END
  1209. END
  1210. ELSIF (k = SymTab.KindVar)
  1211. OR (k = SymTab.KindParam)
  1212. OR (k
  1213. = SymTab.KindVarPar) THEN
  1214. cls := SymTab.ClassOf(t);
  1215. IF (cls = SymTab.ClInt)
  1216. OR (cls = SymTab.ClReal)
  1217. OR (cls = SymTab.ClBool)
  1218. OR (cls = SymTab.ClChar)
  1219. OR (cls
  1220. = SymTab.ClEnum)
  1221. OR (cls
  1222. = SymTab.ClSet)
  1223. OR (cls
  1224. = SymTab.ClPtr) THEN
  1225. IF doLoad THEN
  1226. MGen.PushVar(n)
  1227. END
  1228. ELSIF (cls
  1229. = SymTab.ClArray)
  1230. OR (cls
  1231. = SymTab.ClRecord) THEN
  1232. IF doLoad THEN
  1233. MGen.PushAddr(n)
  1234. END
  1235. ELSIF t
  1236. = SymTab.InvalidType THEN
  1237. IF doLoad THEN
  1238. MGen.PushInt(0)
  1239. END
  1240. ELSE SemError(230);
  1241. IF doLoad THEN
  1242. MGen.PushInt(0)
  1243. END
  1244. END
  1245. ELSE
  1246. IF doLoad THEN
  1247. IF k = SymTab.KindField THEN
  1248. MGen.WithAddr(n);
  1249. cls := SymTab.ClassOf(t);
  1250. IF (t
  1251. = SymTab.InvalidType)
  1252. OR (cls
  1253. = SymTab.ClArray)
  1254. OR (cls
  1255. = SymTab.ClRecord) THEN
  1256. ELSE
  1257. IF (cls
  1258. = SymTab.ClChar)
  1259. OR (cls
  1260. = SymTab.ClBool) THEN
  1261. MGen.LoadByte
  1262. ELSE MGen.LoadIndir
  1263. END
  1264. END
  1265. ELSE MGen.PushInt(0)
  1266. END
  1267. END;
  1268. IF k = SymTab.KindField THEN
  1269. ELSIF k
  1270. = SymTab.KindImport THEN
  1271. SemError(230)
  1272. END
  1273. END
  1274. END; .) .
  1275. DesignTail <VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  1276. VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr;
  1277. VAR sfx: BOOLEAN>
  1278. (. VAR m: SymTab.Name;
  1279. it: SymTab.TypeIndex;
  1280. lxI: MGen.LitStr;
  1281. vI: BOOLEAN;
  1282. vnI: SymTab.Name;
  1283. loA: INTEGER;
  1284. elemT: SymTab.TypeIndex;
  1285. esl, ebytes: CARDINAL;
  1286. firstT: BOOLEAN;
  1287. clsI: INTEGER; .)
  1288. = (. sfx := FALSE; .)
  1289. { "." (. firstT := ~sfx;
  1290. sfx := TRUE; lx[0] := 0C;
  1291. IF ~doLoad & firstT THEN
  1292. IF (k = SymTab.KindVar)
  1293. OR (k = SymTab.KindParam)
  1294. OR (k
  1295. = SymTab.KindVarPar) THEN
  1296. MGen.PushAddr(bn)
  1297. ELSIF k
  1298. = SymTab.KindField THEN
  1299. MGen.WithAddr(bn)
  1300. ELSE MGen.PushInt(0)
  1301. END
  1302. END; .)
  1303. GetIdent<m> (. IF t = SymTab.InvalidType THEN
  1304. IF ~doLoad & firstT THEN
  1305. MGen.Drop
  1306. ELSIF doLoad THEN
  1307. MGen.Drop; MGen.PushInt(0)
  1308. END
  1309. ELSIF SymTab.ClassOf(t) #
  1310. SymTab.ClRecord THEN
  1311. SemError(215);
  1312. t := SymTab.InvalidType;
  1313. IF doLoad THEN
  1314. MGen.Drop; MGen.PushInt(0)
  1315. ELSIF firstT THEN
  1316. MGen.Drop
  1317. END
  1318. ELSIF ~SymTab.FieldExists(t, m) THEN
  1319. SemError(216);
  1320. t := SymTab.InvalidType;
  1321. IF doLoad THEN
  1322. MGen.Drop; MGen.PushInt(0)
  1323. ELSIF firstT THEN
  1324. MGen.Drop
  1325. END
  1326. ELSE
  1327. loA := SymTab.FieldOffset(t, m);
  1328. elemT := SymTab.FieldType(t, m);
  1329. IF loA < 0 THEN
  1330. SemError(216);
  1331. t := SymTab.InvalidType;
  1332. IF doLoad THEN
  1333. MGen.Drop; MGen.PushInt(0)
  1334. ELSIF firstT THEN
  1335. MGen.Drop
  1336. END
  1337. ELSE
  1338. MGen.FieldAdd(
  1339. VAL(CARDINAL, loA));
  1340. t := elemT
  1341. END
  1342. END; .)
  1343. | "[" (. firstT := ~sfx;
  1344. sfx := TRUE; lx[0] := 0C;
  1345. IF ~doLoad & firstT THEN
  1346. IF (k = SymTab.KindVar)
  1347. OR (k = SymTab.KindParam)
  1348. OR (k
  1349. = SymTab.KindVarPar) THEN
  1350. MGen.PushAddr(bn)
  1351. ELSIF k
  1352. = SymTab.KindField THEN
  1353. MGen.WithAddr(bn)
  1354. ELSE MGen.PushInt(0)
  1355. END
  1356. END; .)
  1357. Expr<it, lxI, vI, vnI> (. IF t = SymTab.InvalidType THEN
  1358. MGen.Drop;
  1359. IF doLoad THEN
  1360. MGen.Drop; MGen.PushInt(0)
  1361. ELSE
  1362. IF ~firstT THEN
  1363. ELSE MGen.Drop
  1364. END
  1365. END
  1366. ELSIF SymTab.ClassOf(t) #
  1367. SymTab.ClArray THEN
  1368. SemError(217);
  1369. t := SymTab.InvalidType;
  1370. MGen.Drop;
  1371. IF doLoad THEN
  1372. MGen.Drop; MGen.PushInt(0)
  1373. ELSE
  1374. IF ~firstT THEN
  1375. ELSE MGen.Drop
  1376. END
  1377. END
  1378. ELSE
  1379. clsI := SymTab.ClassOf(it);
  1380. IF (it
  1381. # SymTab.InvalidType)
  1382. & (clsI # SymTab.ClInt)
  1383. & (clsI # SymTab.ClChar)
  1384. & (clsI # SymTab.ClEnum)
  1385. & (clsI
  1386. # SymTab.ClBool) THEN
  1387. SemError(218);
  1388. t := SymTab.InvalidType;
  1389. MGen.Drop;
  1390. IF doLoad THEN
  1391. MGen.Drop; MGen.PushInt(0)
  1392. ELSE
  1393. IF ~firstT THEN
  1394. ELSE MGen.Drop
  1395. END
  1396. END
  1397. ELSE
  1398. loA := SymTab.ArrayLo(t);
  1399. elemT := SymTab.ArrayElem(t);
  1400. esl := SymTab.TypeSlots(elemT);
  1401. IF esl = 0 THEN
  1402. SemError(230);
  1403. esl := 1
  1404. END;
  1405. IF (SymTab.ClassOf(elemT)
  1406. = SymTab.ClChar)
  1407. OR (SymTab.ClassOf(elemT)
  1408. = SymTab.ClBool) THEN
  1409. ebytes := 1
  1410. ELSE ebytes := esl * 8
  1411. END;
  1412. MGen.IdxScale(loA, ebytes);
  1413. t := elemT
  1414. END
  1415. END; .)
  1416. { ","
  1417. Expr<it, lxI, vI, vnI> (. IF t = SymTab.InvalidType THEN
  1418. MGen.Drop;
  1419. IF doLoad THEN
  1420. MGen.Drop; MGen.PushInt(0);
  1421. t := SymTab.InvalidType
  1422. END
  1423. ELSIF SymTab.ClassOf(t) #
  1424. SymTab.ClArray THEN
  1425. SemError(217);
  1426. t := SymTab.InvalidType;
  1427. MGen.Drop;
  1428. IF doLoad THEN
  1429. MGen.Drop; MGen.PushInt(0)
  1430. END
  1431. ELSE
  1432. clsI := SymTab.ClassOf(it);
  1433. IF (it
  1434. # SymTab.InvalidType)
  1435. & (clsI # SymTab.ClInt)
  1436. & (clsI # SymTab.ClChar)
  1437. & (clsI # SymTab.ClEnum)
  1438. & (clsI
  1439. # SymTab.ClBool) THEN
  1440. SemError(218);
  1441. t := SymTab.InvalidType;
  1442. MGen.Drop;
  1443. IF doLoad THEN
  1444. MGen.Drop; MGen.PushInt(0)
  1445. END
  1446. ELSE
  1447. loA := SymTab.ArrayLo(t);
  1448. elemT := SymTab.ArrayElem(t);
  1449. esl := SymTab.TypeSlots(elemT);
  1450. IF esl = 0 THEN
  1451. SemError(230);
  1452. esl := 1
  1453. END;
  1454. IF (SymTab.ClassOf(elemT)
  1455. = SymTab.ClChar)
  1456. OR (SymTab.ClassOf(elemT)
  1457. = SymTab.ClBool) THEN
  1458. ebytes := 1
  1459. ELSE ebytes := esl * 8
  1460. END;
  1461. MGen.IdxScale(loA, ebytes);
  1462. t := elemT
  1463. END
  1464. END; .) }
  1465. "]"
  1466. | "^" (. firstT := ~sfx;
  1467. sfx := TRUE; lx[0] := 0C;
  1468. IF ~doLoad & firstT THEN
  1469. IF (k = SymTab.KindVar)
  1470. OR (k = SymTab.KindParam)
  1471. OR (k
  1472. = SymTab.KindVarPar) THEN
  1473. MGen.PushAddr(bn)
  1474. ELSIF k
  1475. = SymTab.KindField THEN
  1476. MGen.WithAddr(bn)
  1477. ELSE MGen.PushInt(0)
  1478. END
  1479. END; .)
  1480. (. IF t = SymTab.InvalidType THEN
  1481. IF doLoad THEN
  1482. MGen.Drop; MGen.PushInt(0)
  1483. ELSIF firstT THEN
  1484. MGen.Drop
  1485. END
  1486. ELSIF SymTab.ClassOf(t) #
  1487. SymTab.ClPtr THEN
  1488. SemError(219);
  1489. t := SymTab.InvalidType;
  1490. IF doLoad THEN
  1491. MGen.Drop; MGen.PushInt(0)
  1492. ELSIF firstT THEN
  1493. MGen.Drop
  1494. END
  1495. ELSE
  1496. elemT := SymTab.PtrBase(t);
  1497. t := elemT;
  1498. IF doLoad THEN
  1499. IF ~(firstT
  1500. & ((k
  1501. = SymTab.KindVar)
  1502. OR (k
  1503. = SymTab.KindParam)
  1504. OR (k
  1505. = SymTab.KindVarPar)))
  1506. THEN
  1507. MGen.LoadIndir
  1508. END
  1509. ELSE
  1510. MGen.LoadIndir
  1511. END
  1512. END; .) } .
  1513. Expr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  1514. VAR v: BOOLEAN; VAR vn: SymTab.Name>
  1515. (. VAR t2: SymTab.TypeIndex;
  1516. tc, op: INTEGER;
  1517. lx2: MGen.LitStr;
  1518. v2: BOOLEAN;
  1519. vn2: SymTab.Name;
  1520. r: BOOLEAN; .)
  1521. = SimExpr<t, lx, v, vn> [ Rel<op> SimExpr<t2, lx2, v2, vn2>
  1522. (. lx[0] := 0C; v := FALSE;
  1523. IF op = SymTab.OpIn THEN
  1524. IF SymTab.InCheck(t, t2) THEN
  1525. t := SymTab.BoolType();
  1526. MGen.BitIn
  1527. ELSE SemError(222);
  1528. t := SymTab.InvalidType;
  1529. MGen.Drop; MGen.Drop; MGen.PushInt(0)
  1530. END
  1531. ELSIF (t # SymTab.InvalidType)
  1532. & (t2 # SymTab.InvalidType)
  1533. & (SymTab.ClassOf(t) = SymTab.ClArray)
  1534. & (SymTab.ClassOf(t2) = SymTab.ClArray)
  1535. & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar)
  1536. & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar)
  1537. & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN
  1538. t := SymTab.BoolType();
  1539. MGen.PushBytes(SymTab.TypeSlots(t) * 8);
  1540. MGen.PushBytes(SymTab.TypeSlots(t2) * 8);
  1541. MGen.StrComp;
  1542. IF op = SymTab.OpEq THEN MGen.Or; MGen.Not
  1543. ELSIF (op = SymTab.OpNeq1)
  1544. OR (op = SymTab.OpNeq2) THEN MGen.Or
  1545. ELSIF op = SymTab.OpLt THEN
  1546. MGen.Swap; MGen.Drop
  1547. ELSIF op = SymTab.OpLe THEN
  1548. MGen.Drop; MGen.Not
  1549. ELSIF op = SymTab.OpGt THEN
  1550. MGen.Drop
  1551. ELSE
  1552. MGen.Swap; MGen.Drop; MGen.Not
  1553. END
  1554. ELSIF (t # SymTab.InvalidType)
  1555. & (t2 # SymTab.InvalidType)
  1556. & ((SymTab.ClassOf(t) = SymTab.ClArray)
  1557. OR (SymTab.ClassOf(t) = SymTab.ClRecord)
  1558. OR (SymTab.ClassOf(t2) = SymTab.ClArray)
  1559. OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN
  1560. SemError(213); t := SymTab.InvalidType;
  1561. MGen.Drop; MGen.Drop; MGen.PushInt(0)
  1562. ELSE
  1563. tc := SymTab.ClassOf(t);
  1564. IF SymTab.RelCheck(t, t2, op) THEN
  1565. t := SymTab.BoolType()
  1566. ELSE SemError(213); t := SymTab.InvalidType END;
  1567. IF t # SymTab.InvalidType THEN
  1568. r := tc = SymTab.ClReal;
  1569. IF r THEN
  1570. IF op = SymTab.OpEq THEN MGen.RealEq
  1571. ELSIF (op = SymTab.OpNeq1)
  1572. OR (op = SymTab.OpNeq2) THEN MGen.RealNe
  1573. ELSIF op = SymTab.OpLt THEN MGen.RealLt
  1574. ELSIF op = SymTab.OpLe THEN MGen.RealLe
  1575. ELSIF op = SymTab.OpGt THEN MGen.RealGt
  1576. ELSE MGen.RealGe END
  1577. ELSE
  1578. IF op = SymTab.OpEq THEN MGen.Eq
  1579. ELSIF (op = SymTab.OpNeq1)
  1580. OR (op = SymTab.OpNeq2) THEN MGen.Neq
  1581. ELSIF op = SymTab.OpLt THEN MGen.ILt
  1582. ELSIF op = SymTab.OpLe THEN MGen.ILe
  1583. ELSIF op = SymTab.OpGt THEN MGen.IGt
  1584. ELSE MGen.IGe END
  1585. END
  1586. ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0)
  1587. END
  1588. END; .) ] .
  1589. Rel <VAR op: INTEGER>
  1590. = "=" (. op := SymTab.OpEq; .)
  1591. | "#" (. op := SymTab.OpNeq1; .)
  1592. | "<>" (. op := SymTab.OpNeq2; .)
  1593. | "<" (. op := SymTab.OpLt; .)
  1594. | "<=" (. op := SymTab.OpLe; .)
  1595. | ">" (. op := SymTab.OpGt; .)
  1596. | ">=" (. op := SymTab.OpGe; .)
  1597. | "IN" (. op := SymTab.OpIn; .) .
  1598. SimExpr <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  1599. VAR v: BOOLEAN; VAR vn: SymTab.Name>
  1600. (. VAR t2, res2: SymTab.TypeIndex;
  1601. op: INTEGER;
  1602. lx2: MGen.LitStr;
  1603. v2: BOOLEAN;
  1604. vn2: SymTab.Name;
  1605. neg, isR: BOOLEAN; .)
  1606. = (. neg := FALSE; .)
  1607. [ "+" | "-" (. neg := TRUE; .) ]
  1608. Term<t, lx, v, vn> (. IF neg THEN
  1609. v := FALSE;
  1610. IF MGen.IsLit(lx) THEN
  1611. MGen.NegFold(lx, lx)
  1612. ELSE lx[0] := 0C
  1613. END;
  1614. IF SymTab.ClassOf(t)
  1615. = SymTab.ClReal THEN
  1616. MGen.NegReal
  1617. ELSE MGen.NegInt
  1618. END
  1619. END; .)
  1620. { AddOp<op> Term<t2, lx2, v2, vn2>
  1621. (. lx[0] := 0C; v := FALSE;
  1622. IF op = SymTab.OpOr THEN
  1623. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  1624. t := SymTab.BoolType()
  1625. ELSE SemError(212); t := SymTab.InvalidType END;
  1626. MGen.Or
  1627. ELSIF (t # SymTab.InvalidType)
  1628. & (t2 # SymTab.InvalidType)
  1629. & (SymTab.ClassOf(t) = SymTab.ClSet)
  1630. & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  1631. IF op = SymTab.OpAdd THEN
  1632. MGen.Or
  1633. ELSE
  1634. MGen.PushBits(0FFFFFFFFFFFFFFFFH);
  1635. MGen.BitXor;
  1636. MGen.And
  1637. END
  1638. ELSE
  1639. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
  1640. ELSE SemError(211); t := SymTab.InvalidType END;
  1641. isR := (t # SymTab.InvalidType)
  1642. & (SymTab.ClassOf(t) = SymTab.ClReal);
  1643. IF op = SymTab.OpAdd THEN
  1644. IF isR THEN MGen.RealAdd ELSE MGen.Add END
  1645. ELSE
  1646. IF isR THEN MGen.RealSub ELSE MGen.Sub END
  1647. END
  1648. END; .) } .
  1649. AddOp <VAR op: INTEGER>
  1650. = "+" (. op := SymTab.OpAdd; .)
  1651. | "-" (. op := SymTab.OpSub; .)
  1652. | "OR" (. op := SymTab.OpOr; .) .
  1653. Term <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  1654. VAR v: BOOLEAN; VAR vn: SymTab.Name>
  1655. (. VAR t2, res2: SymTab.TypeIndex;
  1656. op: INTEGER;
  1657. lx2: MGen.LitStr;
  1658. v2: BOOLEAN;
  1659. vn2: SymTab.Name;
  1660. isR: BOOLEAN;
  1661. mt: INTEGER; .)
  1662. = Fact<t, lx, v, vn> { MulOp<op> Fact<t2, lx2, v2, vn2>
  1663. (. lx[0] := 0C; v := FALSE;
  1664. IF op = SymTab.OpAnd THEN
  1665. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  1666. t := SymTab.BoolType()
  1667. ELSE SemError(212); t := SymTab.InvalidType END;
  1668. MGen.And
  1669. ELSIF (op = SymTab.OpTimes)
  1670. & (t # SymTab.InvalidType)
  1671. & (t2 # SymTab.InvalidType)
  1672. & (SymTab.ClassOf(t) = SymTab.ClSet)
  1673. & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  1674. MGen.And
  1675. ELSE
  1676. IF SymTab.ArithCheck(t, t2,
  1677. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  1678. res2) THEN t := res2
  1679. ELSE SemError(211); t := SymTab.InvalidType END;
  1680. isR := (t # SymTab.InvalidType)
  1681. & (SymTab.ClassOf(t) = SymTab.ClReal);
  1682. IF op = SymTab.OpTimes THEN
  1683. IF isR THEN MGen.RealMul ELSE MGen.MulU END
  1684. ELSIF op = SymTab.OpSlash THEN
  1685. IF isR THEN MGen.RealDiv ELSE MGen.DivI END
  1686. ELSIF op = SymTab.OpDiv THEN
  1687. MGen.DivI
  1688. ELSE
  1689. mt := MGen.TempGlobal();
  1690. MGen.ModI(mt)
  1691. END
  1692. END; .) } .
  1693. MulOp <VAR op: INTEGER>
  1694. = "*" (. op := SymTab.OpTimes; .)
  1695. | "/" (. op := SymTab.OpSlash; .)
  1696. | "DIV" (. op := SymTab.OpDiv; .)
  1697. | "MOD" (. op := SymTab.OpMod; .)
  1698. | "AND" (. op := SymTab.OpAnd; .)
  1699. | "&" (. op := SymTab.OpAnd; .) .
  1700. Fact <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  1701. VAR v: BOOLEAN; VAR vn: SymTab.Name>
  1702. (. VAR s: ARRAY [0 .. 255] OF CHAR;
  1703. t2, et, dt, st: SymTab.TypeIndex;
  1704. dk: INTEGER;
  1705. bnF: SymTab.Name;
  1706. lxD, lx2: MGen.LitStr;
  1707. v2: BOOLEAN;
  1708. vn2: SymTab.Name;
  1709. vi: INTEGER;
  1710. c: CARDINAL;
  1711. b: LONGCARD;
  1712. sfxF: BOOLEAN;
  1713. okF: BOOLEAN; .)
  1714. = integer (. LexString(s);
  1715. MGen.CopyName(s, lx);
  1716. v := FALSE;
  1717. IF MGen.ParseInt(s, vi) THEN
  1718. MGen.PushInt(vi)
  1719. ELSIF MGen.ParseCard(s, c) THEN
  1720. MGen.PushBits(
  1721. VAL(LONGCARD, c))
  1722. ELSE MGen.PushInt(0)
  1723. END;
  1724. t := SymTab.IntType(); .)
  1725. | real (. LexString(s);
  1726. MGen.CopyName(s, lx);
  1727. v := FALSE;
  1728. IF MGen.ParseReal(s, b) THEN
  1729. MGen.PushBits(b)
  1730. ELSE MGen.PushBits(0H)
  1731. END;
  1732. t := SymTab.RealType(); .)
  1733. | string (. LexString(s);
  1734. v := FALSE;
  1735. IF SymTab.StrLen(s) <= 3 THEN
  1736. t := SymTab.CharType();
  1737. MGen.CopyName(s, lx);
  1738. MGen.PushInt(
  1739. MGen.CharOrd(s))
  1740. ELSE t := SymTab.NewStr();
  1741. MGen.CopyName(s, lx);
  1742. MGen.EmitString(s)
  1743. END; .)
  1744. | "HIGH"
  1745. "(" DesignHead<dt, dk, bnF, FALSE, lxD>
  1746. DesignTail<dt, dk, bnF, FALSE, lxD, sfxF>
  1747. ")" (. lx[0] := 0C; v := FALSE;
  1748. IF dt = SymTab.InvalidType THEN
  1749. IF sfxF THEN MGen.Drop END;
  1750. MGen.PushInt(0);
  1751. t := SymTab.InvalidType
  1752. ELSIF SymTab.ClassOf(dt)
  1753. # SymTab.ClArray THEN
  1754. SemError(217);
  1755. IF sfxF THEN MGen.Drop END;
  1756. MGen.PushInt(0);
  1757. t := SymTab.InvalidType
  1758. ELSIF SymTab.IsOpen(dt) THEN
  1759. IF sfxF THEN MGen.Drop END;
  1760. IF (dk = SymTab.KindParam)
  1761. OR (dk
  1762. = SymTab.KindVarPar) THEN
  1763. IF SymTab.CurDepth()
  1764. = SymTab.SymDepth(bnF) THEN
  1765. MGen.LoadLocal(
  1766. SymTab.SymSlot(bnF) + 1)
  1767. ELSE
  1768. MGen.FrameAddr(
  1769. SymTab.SymSlot(bnF) + 1,
  1770. VAL(CARDINAL,
  1771. SymTab.CurDepth() - 1
  1772. - SymTab.SymDepth(bnF)));
  1773. MGen.LoadIndir
  1774. END;
  1775. MGen.PushInt(1);
  1776. MGen.Sub;
  1777. t := SymTab.IntType()
  1778. ELSE
  1779. MGen.PushInt(0);
  1780. t := SymTab.InvalidType
  1781. END
  1782. ELSE
  1783. IF sfxF THEN MGen.Drop END;
  1784. MGen.PushInt(
  1785. SymTab.ArrayHi(dt));
  1786. t := SymTab.IntType()
  1787. END; .)
  1788. | DesignHead<dt, dk, bnF, TRUE, lxD>
  1789. DesignTail<dt, dk, bnF, TRUE, lxD, sfxF>
  1790. (. t := dt;
  1791. MGen.CopyName(lxD, lx);
  1792. IF sfxF
  1793. & (t # SymTab.InvalidType)
  1794. & (SymTab.ClassOf(t)
  1795. # SymTab.ClArray)
  1796. & (SymTab.ClassOf(t)
  1797. # SymTab.ClRecord) THEN
  1798. IF (SymTab.ClassOf(t)
  1799. = SymTab.ClChar)
  1800. OR (SymTab.ClassOf(t)
  1801. = SymTab.ClBool) THEN
  1802. MGen.LoadByte
  1803. ELSE MGen.LoadIndir
  1804. END
  1805. END;
  1806. v := ~sfxF
  1807. & ((dk = SymTab.KindVar)
  1808. OR (dk = SymTab.KindParam)
  1809. OR (dk
  1810. = SymTab.KindVarPar));
  1811. MGen.CopyName(bnF, vn); .)
  1812. [ CallTail<bnF, sfxF, TRUE, okF, TRUE>
  1813. (. IF okF THEN
  1814. IF SymTab.SymKind(bnF)
  1815. = SymTab.KindProc THEN
  1816. t := SymTab.ProcRet(bnF)
  1817. ELSE
  1818. t := SymTab.InvalidType
  1819. END
  1820. ELSE t := SymTab.InvalidType
  1821. END;
  1822. lx[0] := 0C; v := FALSE; .) ]
  1823. | "("
  1824. Expr<et, lx, v, vn> ")" (. t := et; .)
  1825. | ( "NOT" | "~" )
  1826. Fact<t2, lx2, v2, vn2> (. lx[0] := 0C; v := FALSE;
  1827. IF SymTab.BoolCheck(t2) THEN
  1828. t := SymTab.BoolType()
  1829. ELSE SemError(212);
  1830. t := SymTab.InvalidType END;
  1831. MGen.Not; .)
  1832. | SetLit<st> (. lx[0] := 0C; v := FALSE;
  1833. t := st; .) .
  1834. SetLit <VAR t: SymTab.TypeIndex>
  1835. (. VAR first, et: SymTab.TypeIndex;
  1836. lxE, lxE2: MGen.LitStr;
  1837. vE, vE2: BOOLEAN;
  1838. vnE, vnE2: SymTab.Name;
  1839. hasR: BOOLEAN; .)
  1840. = "{"
  1841. (. MGen.PushInt(0);
  1842. t := SymTab.SetFor(SymTab.IntType()); .)
  1843. [ Elem<et, lxE, lxE2, hasR> (. first := et;
  1844. t := SymTab.SetFor(et);
  1845. IF hasR THEN
  1846. MGen.PushInt(1); MGen.Add;
  1847. MGen.FieldMask
  1848. ELSE MGen.Power2 END;
  1849. MGen.Or; .)
  1850. { ","
  1851. Elem<et, lxE, lxE2, hasR> (. IF ~SymTab.SetElemCheck(first, et) THEN
  1852. SemError(222) END;
  1853. IF hasR THEN
  1854. MGen.PushInt(1); MGen.Add;
  1855. MGen.FieldMask
  1856. ELSE MGen.Power2 END;
  1857. MGen.Or; .) } ]
  1858. "}" .
  1859. Elem <VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  1860. VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN>
  1861. (. VAR t2: SymTab.TypeIndex;
  1862. vD, vD2: BOOLEAN;
  1863. vnD, vnD2: SymTab.Name; .)
  1864. = Expr<t, lx, vD, vnD> (. hasR := FALSE;
  1865. lx2[0] := 0C; .)
  1866. [ ".."
  1867. Expr<t2, lx2, vD2, vnD2> (. IF ~SymTab.SetElemCheck(t, t2) THEN
  1868. SemError(222) END;
  1869. hasR := TRUE; .) ] .
  1870. GetIdent <VAR n: SymTab.Name>
  1871. = ident (. LexName(n); .) .
  1872. END M2c.