M2c.lst 140 KB

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