M2c.lst 136 KB

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