M2c.atg 120 KB

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