M2c.atg 133 KB

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