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