M2c.atg 118 KB

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