M2c.atg 114 KB

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