M2c.atg 100 KB

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