M2c.lst 128 KB

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