|
|
@@ -182,3469 +182,3507 @@ Listing:
|
|
|
164 RETURN n
|
|
|
165 END AstCallNode;
|
|
|
166
|
|
|
- 167 CHARACTERS
|
|
|
- 168 eol = CHR(13) .
|
|
|
- 169 lf = CHR(10) .
|
|
|
- 170 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
- 171 digit = "0123456789" .
|
|
|
- 172 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
- 173 noQuote1 = ANY - "'" - eol .
|
|
|
- 174 noQuote2 = ANY - '"' - eol .
|
|
|
- 175
|
|
|
- 176 IGNORE CHR(9) .. CHR(13)
|
|
|
- 177
|
|
|
- 178 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
- 179 COMMENTS FROM "//" TO lf
|
|
|
- 180
|
|
|
- 181 TOKENS
|
|
|
- 182 ident = letter { letter | digit } .
|
|
|
- 183 integer = digit { digit }
|
|
|
- 184 | digit { digit } CONTEXT("..")
|
|
|
- 185 | "0x" hexDigit { hexDigit }
|
|
|
- 186 | "0X" hexDigit { hexDigit } .
|
|
|
- 187 real = digit { digit } "." { digit }
|
|
|
- 188 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
- 189 string = "'" { noQuote1 } "'"
|
|
|
- 190 | '"' { noQuote2 } '"' .
|
|
|
- 191 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
- 192 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
- 193
|
|
|
- 194 PRODUCTIONS
|
|
|
- 195 M2
|
|
|
- 196 = (. AST.Init; twoPhase := TRUE; astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; .)
|
|
|
- 197 Unit "." .
|
|
|
- 198 (* Units: program modules compile fully; DEFINITION and
|
|
|
- 199 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
- 200 (each ends with one 230); same for nested local modules. *)
|
|
|
- 201 Unit
|
|
|
- 202 = DefUnit
|
|
|
- 203 | ImplUnit
|
|
|
- 204 | ProgModule .
|
|
|
- 205 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
- 206 and one program (last) into one image. Units share the symbol
|
|
|
- 207 table; imports materialize exported names. *)
|
|
|
- 208 DefUnit (. VAR m1, m2, pn: SymTab.Name; .)
|
|
|
- 209 = "DEFINITION" "MODULE"
|
|
|
- 210 GetIdent<m1> (. IF NOT SymTab.BeginDef(m1) THEN
|
|
|
- 211 SemError(200) END;
|
|
|
- 212 QbeGen.SetModule(m1); .)
|
|
|
- 213 ";"
|
|
|
- 214 { Import }
|
|
|
- 215 [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
|
|
|
- 216 list: parsed, and the
|
|
|
- 217 names are already exported
|
|
|
- 218 by the module scope *) .)
|
|
|
- 219 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
- 220 { ConstBlock | TypeBlock<TRUE> | VarBlock
|
|
|
- 221 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 222 (. SymTab.CloseProc;
|
|
|
- 223 QbeGen.AbortFunc; .) }
|
|
|
- 224 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 225 AST.SetChild(astUnit, 0,
|
|
|
- 226 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 227 astDecl := AST.NoNode;
|
|
|
- 228 astStmt := AST.NoNode; .)
|
|
|
- 229 "END"
|
|
|
- 230 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 231 SemError(202) END;
|
|
|
- 232 SymTab.EndUnit; .) .
|
|
|
- 233 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
- 234 k: CARDINAL;
|
|
|
- 235 fname: SymTab.Name;
|
|
|
- 236 unres: BOOLEAN;
|
|
|
- 237 astNode: AST.Node; .)
|
|
|
- 238 = "IMPLEMENTATION" "MODULE"
|
|
|
- 239 GetIdent<m1> (. IF NOT SymTab.BeginImpl(m1) THEN
|
|
|
- 240 SemError(201) END;
|
|
|
- 241 astStmt := AST.NoNode;
|
|
|
- 242 astDecl := AST.NoNode;
|
|
|
- 243 nPendVar := 0;
|
|
|
- 244 QbeGen.SetModule(m1); .)
|
|
|
- 245 ";"
|
|
|
- 246 { Import }
|
|
|
- 247 DeclSeq
|
|
|
- 248 [ "BEGIN" (. FlushPend;
|
|
|
- 249 k := 0;
|
|
|
- 250 WHILE k < SymTab.FwdPending() DO
|
|
|
- 251 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 252 IF unres THEN SemError(201) END;
|
|
|
- 253 INC(k)
|
|
|
- 254 END;
|
|
|
- 255 SymTab.FwdClear;
|
|
|
- 256 FwdVarFlush;
|
|
|
- 257 QbeGen.BeginInit(m1); .)
|
|
|
- 258 [ StatSeq ] (. QbeGen.EndInit; .) ]
|
|
|
- 259 "END"
|
|
|
- 260 GetIdent<m2> (. FlushPend;
|
|
|
- 261 k := 0;
|
|
|
- 262 WHILE k < SymTab.FwdPending() DO
|
|
|
- 263 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 264 IF unres THEN SemError(201) END;
|
|
|
- 265 INC(k)
|
|
|
- 266 END;
|
|
|
- 267 SymTab.FwdClear;
|
|
|
- 268 FwdVarFlush;
|
|
|
- 269 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 270 AST.SetChild(astNode, 0,
|
|
|
- 271 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 272 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 273 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 274 astUnit := astNode;
|
|
|
- 275 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 276 SemError(202) END;
|
|
|
- 277 SymTab.EndUnit; .) .
|
|
|
- 278 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 279 k: CARDINAL;
|
|
|
- 280 fname: SymTab.Name;
|
|
|
- 281 unres: BOOLEAN;
|
|
|
- 282 astNode: AST.Node; .)
|
|
|
- 283 = "MODULE"
|
|
|
- 284 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
- 285 SemError(200) END;
|
|
|
- 286 astStmt := AST.NoNode;
|
|
|
- 287 astDecl := AST.NoNode;
|
|
|
- 288 nPendVar := 0;
|
|
|
- 289 QbeGen.SetModule(m1); .)
|
|
|
- 290 [ Priority ]
|
|
|
- 291 ";"
|
|
|
- 292 { Import }
|
|
|
- 293 DeclSeq
|
|
|
- 294 [ "BEGIN" (. FlushPend;
|
|
|
- 295 k := 0;
|
|
|
- 296 WHILE k < SymTab.FwdPending() DO
|
|
|
- 297 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 298 IF unres THEN SemError(201) END;
|
|
|
- 299 INC(k)
|
|
|
- 300 END;
|
|
|
- 301 SymTab.FwdClear;
|
|
|
- 302 FwdVarFlush;
|
|
|
- 303 QbeGen.BeginBody; .)
|
|
|
- 304 [ StatSeq ] ]
|
|
|
- 305 "END"
|
|
|
- 306 GetIdent<m2> (. FlushPend;
|
|
|
- 307 k := 0;
|
|
|
- 308 WHILE k < SymTab.FwdPending() DO
|
|
|
- 309 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 310 IF unres THEN SemError(201) END;
|
|
|
- 311 INC(k)
|
|
|
- 312 END;
|
|
|
- 313 SymTab.FwdClear;
|
|
|
- 314 FwdVarFlush;
|
|
|
- 315 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 316 SemError(202) END;
|
|
|
- 317 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 318 AST.SetChild(astNode, 0,
|
|
|
- 319 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 320 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 321 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 322 astUnit := astNode;
|
|
|
- 323 QbeGen.EndModule(m1);
|
|
|
- 324 SymTab.EndUnit; .) .
|
|
|
- 325 DeclSeq (. VAR astSeq: AST.Node; .)
|
|
|
- 326 = (. astSeq := AST.MakeNode(AST.NkDeclSeq); .)
|
|
|
- 327 { (. astDecl := AST.NoNode; .)
|
|
|
- 328 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
- 329 | NestedModule ";" | ClassItem ";" )
|
|
|
- 330 (. IF astDecl # AST.NoNode THEN
|
|
|
- 331 AST.SetChild(astSeq,
|
|
|
- 332 AST.NChild(astSeq), astDecl) END; .) }
|
|
|
- 333 (. astDecl := astSeq; .) .
|
|
|
- 334 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
- 335 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
- 336 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
- 337 scope at END. *)
|
|
|
- 338 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 339 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
- 340 expCount, k: CARDINAL; .)
|
|
|
- 341 = "MODULE"
|
|
|
- 342 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
- 343 SymTab.KindModule) THEN
|
|
|
- 344 SemError(200) END;
|
|
|
- 345 SymTab.PushScope;
|
|
|
- 346 expCount := 0; .)
|
|
|
- 347 [ Priority ]
|
|
|
- 348 ";"
|
|
|
- 349 { Import }
|
|
|
- 350 [ "EXPORT" [ "QUALIFIED" ]
|
|
|
- 351 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
- 352 { "," GetIdent<expNames[expCount]>
|
|
|
- 353 (. INC(expCount); .) }
|
|
|
- 354 ";" ]
|
|
|
- 355 DeclSeq
|
|
|
- 356 [ "BEGIN" (. QbeGen.BeginInit(m1); .)
|
|
|
- 357 [ StatSeq ] (. QbeGen.EndInit; .) ]
|
|
|
- 358 "END"
|
|
|
- 359 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 360 SemError(202) END;
|
|
|
- 361 k := 0;
|
|
|
- 362 WHILE k < expCount DO
|
|
|
- 363 SymTab.ExportUp(expNames[k]);
|
|
|
- 364 INC(k)
|
|
|
- 365 END;
|
|
|
- 366 SymTab.PopScope; .) .
|
|
|
- 367 Priority
|
|
|
- 368 = "[" integer "]" (. SemError(230); .) .
|
|
|
- 369 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
- 370 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
- 371 materializes on first use (Design). *)
|
|
|
- 372 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
- 373 import lines don't fail); a known module's missing export is
|
|
|
- 374 201. *)
|
|
|
- 375 Import (. VAR n: SymTab.Name; .)
|
|
|
- 376 = "FROM"
|
|
|
- 377 GetIdent<n>
|
|
|
- 378 "IMPORT"
|
|
|
- 379 ImpList<n> ";"
|
|
|
- 380 | "IMPORT"
|
|
|
- 381 ImpModList ";" .
|
|
|
- 382 ImpList<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
|
|
|
- 383 = ImpName<mod>
|
|
|
- 384 { "," ImpName<mod> } .
|
|
|
- 385 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
- 386 accepted and ignored: the built-in applies regardless. *)
|
|
|
- 387 ImpName<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
|
|
|
- 388 = GetIdent<n> (. IF SymTab.Equal(mod, "libc") THEN
|
|
|
- 389 (* intrinsic C library:
|
|
|
- 390 permissive external *)
|
|
|
- 391 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
- 392 SemError(201) END
|
|
|
- 393 ELSIF SymTab.ModKnown(mod)
|
|
|
- 394 AND NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
- 395 SemError(201) END; .)
|
|
|
- 396 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
- 397 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
|
|
|
- 398 | "UCHR" | "CHR8" | "UORD"
|
|
|
- 399 | "INC" | "DEC" ) .
|
|
|
- 400 ImpModList (. VAR n: SymTab.Name; .)
|
|
|
- 401 = GetIdent<n>
|
|
|
- 402 { "," GetIdent<n> } .
|
|
|
- 403 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
- 404 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
- 405 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
- 406 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
- 407 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
- 408 TypeBlock<isDef: BOOLEAN>
|
|
|
- 409 = "TYPE" (. SymTab.BeginTypeBlock; .)
|
|
|
- 410 { TypeItem<isDef> ";" | ClassItem ";" }
|
|
|
- 411 (. SymTab.EndTypeBlock; .) .
|
|
|
- 412 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
- 413 t, op: SymTab.TypeIndex;
|
|
|
- 414 astNode: AST.Node; .)
|
|
|
- 415 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
- 416 IF op = SymTab.InvalidType THEN
|
|
|
- 417 IF NOT SymTab.Enter(n,
|
|
|
- 418 SymTab.KindType) THEN
|
|
|
- 419 SemError(200) END
|
|
|
- 420 END; .)
|
|
|
- 421 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
- 422 AST.SetChild(astNode, 0,
|
|
|
- 423 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 424 AST.SetTy(astNode, t);
|
|
|
- 425 astDecl := astNode;
|
|
|
- 426 IF op # SymTab.InvalidType THEN
|
|
|
- 427 SymTab.SetTarget(op, t)
|
|
|
- 428 ELSE SymTab.SetSymType(n, t)
|
|
|
- 429 END; .)
|
|
|
- 430 | (. IF op # SymTab.InvalidType THEN
|
|
|
- 431 (* stays opaque *)
|
|
|
- 432 ELSIF NOT isDef THEN
|
|
|
- 433 SemError(231)
|
|
|
- 434 ELSE SymTab.SetSymType(n,
|
|
|
- 435 SymTab.NewAlias()) END; .) ) .
|
|
|
- 436 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 437 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
- 438 | Subrange<t>
|
|
|
- 439 | Enum<t>
|
|
|
- 440 | ArrayType<t, allowOpen>
|
|
|
- 441 | SetType<t>
|
|
|
- 442 | RecordType<t>
|
|
|
- 443 | PointerType<t>
|
|
|
- 444 | ProcType<t> .
|
|
|
- 445 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
- 446 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
|
|
|
- 447 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
- 448 are code pointers; params are collected into the descriptor. *)
|
|
|
- 449 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
- 450 isV: BOOLEAN; .)
|
|
|
- 451 = "PROCEDURE" (. res := SymTab.InvalidType;
|
|
|
- 452 t := SymTab.NewProcType(res); .)
|
|
|
- 453 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
- 454 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
- 455 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
- 456 isV: BOOLEAN;
|
|
|
- 457 cnt, k: CARDINAL;
|
|
|
- 458 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
- 459 = (. isV := FALSE; cnt := 0; .)
|
|
|
- 460 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 461 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 462 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
- 463 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
- 464 WHILE k < cnt DO
|
|
|
- 465 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 466 INC(k)
|
|
|
- 467 END; .)
|
|
|
- 468 | (. (* type-only parameter list:
|
|
|
- 469 each name is a type (GNU
|
|
|
- 470 shorthand used by the
|
|
|
- 471 Coco/R scanner frame) *)
|
|
|
- 472 k := 0;
|
|
|
- 473 WHILE k < cnt DO
|
|
|
- 474 IF SymTab.Lookup(names[k])
|
|
|
- 475 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
- 476 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
- 477 pt := SymTab.SymType(names[k])
|
|
|
- 478 ELSE SemError(201);
|
|
|
- 479 pt := SymTab.InvalidType
|
|
|
- 480 END;
|
|
|
- 481 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 482 INC(k)
|
|
|
- 483 END; .) )
|
|
|
- 484 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
- 485 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
- 486 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
- 487 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
- 488 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
- 489 out. Bounds are folded literals (int/char); anything else 230.
|
|
|
- 490 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
- 491 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 492 (. VAR elem: SymTab.TypeIndex;
|
|
|
- 493 ok: BOOLEAN;
|
|
|
- 494 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
- 495 nb, k: CARDINAL;
|
|
|
- 496 idx: SymTab.TypeIndex;
|
|
|
- 497 ilo, ihi: INTEGER; .)
|
|
|
- 498 = "ARRAY"
|
|
|
- 499 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
|
|
|
- 500 SemError(230) END;
|
|
|
- 501 t := SymTab.NewOpenArray(elem); .)
|
|
|
- 502 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
- 503 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
- 504 type's ordinal bounds give the
|
|
|
- 505 [lo..hi] pair *)
|
|
|
- 506 IF SymTab.TypeBounds(idx, ilo,
|
|
|
- 507 ihi)
|
|
|
- 508 THEN t := SymTab.NewArrayB(elem,
|
|
|
- 509 ilo, ihi)
|
|
|
- 510 ELSE SemError(230);
|
|
|
- 511 t := SymTab.InvalidType
|
|
|
- 512 END; .)
|
|
|
- 513 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
|
|
|
- 514 BoundPair<ok>
|
|
|
- 515 { "," BoundPair<ok> }
|
|
|
- 516 "]" (. (* snapshot before the element
|
|
|
- 517 type, which reuses the bound
|
|
|
- 518 buffer for a nested ARRAY *)
|
|
|
- 519 nb := SymTab.BoundCount();
|
|
|
- 520 k := 0;
|
|
|
- 521 WHILE k < nb DO
|
|
|
- 522 bnds[k] := SymTab.BoundLo(k);
|
|
|
- 523 bndh[k] := SymTab.BoundHi(k);
|
|
|
- 524 INC(k)
|
|
|
- 525 END; .)
|
|
|
- 526 "OF" Type<elem, FALSE>
|
|
|
- 527 (. IF ok THEN
|
|
|
- 528 k := nb;
|
|
|
- 529 WHILE k > 0 DO
|
|
|
- 530 DEC(k);
|
|
|
- 531 elem := SymTab.NewArrayB(
|
|
|
- 532 elem, bnds[k], bndh[k])
|
|
|
- 533 END;
|
|
|
- 534 t := elem
|
|
|
- 535 ELSE t := SymTab.InvalidType
|
|
|
- 536 END; .) ) .
|
|
|
- 537 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 538 qlo, qhi: QbeGen.QVal;
|
|
|
- 539 lo, hi: INTEGER;
|
|
|
- 540 cl, cl2: INTEGER; .)
|
|
|
- 541 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 542 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 543 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 544 ok := FALSE
|
|
|
- 545 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
- 546 cl2 := SymTab.ClassOf(thi);
|
|
|
- 547 IF ((cl # SymTab.ClInt)
|
|
|
- 548 AND (cl # SymTab.ClChar))
|
|
|
- 549 OR ((cl2 # SymTab.ClInt)
|
|
|
- 550 AND (cl2 # SymTab.ClChar)) THEN
|
|
|
- 551 SemError(230); ok := FALSE
|
|
|
- 552 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 553 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 554 OR (lo > hi) THEN
|
|
|
- 555 SemError(230); ok := FALSE
|
|
|
- 556 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
- 557 SemError(230); ok := FALSE
|
|
|
- 558 END;
|
|
|
- 559 END; .) .
|
|
|
- 560 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
- 561 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
- 562 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
- 563 comparison across suitable bases are lenient (masks over min
|
|
|
- 564 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
- 565 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 566 blo, bhi, bspan: INTEGER;
|
|
|
- 567 bcls: INTEGER; .)
|
|
|
- 568 = "SET" "OF" Type<base, FALSE>
|
|
|
- 569 (. IF base = SymTab.InvalidType THEN
|
|
|
- 570 t := SymTab.InvalidType
|
|
|
- 571 ELSE bcls :=
|
|
|
- 572 SymTab.ClassOf(base);
|
|
|
- 573 IF bcls = SymTab.ClBool THEN
|
|
|
- 574 blo := 0; bspan := 2
|
|
|
- 575 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 576 blo := 0; bspan := 256
|
|
|
- 577 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 578 blo := 0;
|
|
|
- 579 bspan := VAL(INTEGER,
|
|
|
- 580 SymTab.EnumCount(base))
|
|
|
- 581 ELSIF SymTab.SubBounds(base,
|
|
|
- 582 blo, bhi) THEN
|
|
|
- 583 bspan := bhi - blo + 1
|
|
|
- 584 ELSE bspan := 0 END;
|
|
|
- 585 IF (bspan <= 0)
|
|
|
- 586 OR (bspan > 65536) THEN
|
|
|
- 587 SemError(230);
|
|
|
- 588 t := SymTab.InvalidType
|
|
|
- 589 ELSE t := SymTab.NewSet(base)
|
|
|
- 590 END
|
|
|
- 591 END; .) .
|
|
|
- 592 (* Records: flat blobs; array fields are pointers to static
|
|
|
- 593 descriptors (locked amendment), nested records inline. Field
|
|
|
- 594 offsets static and declaration-ordered. *)
|
|
|
- 595 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
- 596 variant part is a `CASE ... END` item; because it starts with the
|
|
|
- 597 CASE keyword it is unambiguously distinguishable from a field
|
|
|
- 598 (which starts with an identifier). *)
|
|
|
- 599 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
- 600 tagOk: BOOLEAN; .)
|
|
|
- 601 = "RECORD" (. t := SymTab.NewRecord(); .)
|
|
|
- 602 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
- 603 "END" .
|
|
|
- 604 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
- 605 = RecField<rec>
|
|
|
- 606 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 607 (* A variant part: CASE tag : Type OF variants. The layout overlays
|
|
|
- 608 every branch from the tag slot (see SymTab.ComputeOffsets). *)
|
|
|
- 609 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
- 610 tagN: SymTab.Name; .)
|
|
|
- 611 = "CASE" (. SymTab.ResetFields(rec); .)
|
|
|
- 612 GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 613 tagN) THEN
|
|
|
- 614 SemError(200) END; .)
|
|
|
- 615 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
- 616 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
- 617 SemError(224)
|
|
|
- 618 END;
|
|
|
- 619 SymTab.FixPendingF(rec, tagT);
|
|
|
- 620 SymTab.SetVariantTag(rec, tagN); .)
|
|
|
- 621 "OF"
|
|
|
- 622 RecFieldList<rec>
|
|
|
- 623 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
- 624 RecFieldList<rec> }
|
|
|
- 625 "END" .
|
|
|
- 626 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
- 627 lv1, lv2: QbeGen.QVal; .)
|
|
|
- 628 = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
|
|
|
- 629 RecField<rec> { ";" [ RecField<rec> ] } .
|
|
|
- 630 (* Variant case label: a constant (or a constant range). Values are
|
|
|
- 631 not interpreted (the layout overlays regardless). *)
|
|
|
- 632 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 633 (. VAR lname: SymTab.Name; .)
|
|
|
- 634 = ( ident (. LexName(lname);
|
|
|
- 635 QbeGen.CopyOp("0", q);
|
|
|
- 636 t := SymTab.IntType(); .)
|
|
|
- 637 | integer (. LexString(lname);
|
|
|
- 638 QbeGen.CopyOp("0", q);
|
|
|
- 639 t := SymTab.IntType(); .)
|
|
|
- 640 | charConst (. LexString(lname);
|
|
|
- 641 QbeGen.CopyOp("0", q);
|
|
|
- 642 t := SymTab.CharType(); .) ) .
|
|
|
- 643 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 644 t2: SymTab.TypeIndex; .)
|
|
|
- 645 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
- 646 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
- 647 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 648 n) THEN
|
|
|
- 649 SemError(200) END; .)
|
|
|
- 650 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 651 n) THEN
|
|
|
- 652 SemError(200) END; .) } .
|
|
|
- 653 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
- 654 k: INTEGER;
|
|
|
- 655 dotted: BOOLEAN; .)
|
|
|
- 656 = GetIdent<n> (. dotted := FALSE;
|
|
|
- 657 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 658 k := -1;
|
|
|
- 659 t := SymTab.ForwardType(n);
|
|
|
- 660 IF t = SymTab.InvalidType THEN
|
|
|
- 661 SemError(201)
|
|
|
- 662 END
|
|
|
- 663 ELSE k := SymTab.SymKind(n);
|
|
|
- 664 IF (k = SymTab.KindType)
|
|
|
- 665 OR (k = SymTab.KindPredef) THEN
|
|
|
- 666 t := SymTab.SymType(n)
|
|
|
- 667 ELSE t := SymTab.InvalidType
|
|
|
- 668 END
|
|
|
- 669 END; .)
|
|
|
- 670 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
- 671 IF k = SymTab.KindModule THEN
|
|
|
- 672 t := SymTab.QualType(n, qid);
|
|
|
- 673 IF t = SymTab.InvalidType THEN
|
|
|
- 674 SemError(201)
|
|
|
- 675 END
|
|
|
- 676 ELSE SemError(221);
|
|
|
- 677 t := SymTab.InvalidType
|
|
|
- 678 END; .) ]
|
|
|
- 679 (. IF NOT dotted THEN
|
|
|
- 680 IF (k = SymTab.KindModule)
|
|
|
- 681 OR ((k # SymTab.KindType)
|
|
|
- 682 AND (k # SymTab.KindPredef)
|
|
|
- 683 AND (k # SymTab.KindImport)
|
|
|
- 684 AND (k # -1)) THEN
|
|
|
- 685 SemError(221)
|
|
|
- 686 END
|
|
|
- 687 END; .) .
|
|
|
- 688 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 689 qlo, qhi: QbeGen.QVal;
|
|
|
- 690 lo, hi: INTEGER; .)
|
|
|
- 691 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 692 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 693 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 694 t := SymTab.InvalidType
|
|
|
- 695 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
- 696 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
- 697 SemError(230);
|
|
|
- 698 t := SymTab.InvalidType
|
|
|
- 699 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 700 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 701 OR (lo > hi) THEN
|
|
|
- 702 SemError(230);
|
|
|
- 703 t := SymTab.InvalidType
|
|
|
- 704 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
- 705 END; .)
|
|
|
- 706 "]" .
|
|
|
- 707 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 708 ord: INTEGER;
|
|
|
- 709 qv: QbeGen.QVal; .)
|
|
|
- 710 = "(" (. t := SymTab.NewEnum();
|
|
|
- 711 ord := 0; .)
|
|
|
- 712 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 713 SymTab.KindConst) THEN
|
|
|
- 714 SemError(200) END;
|
|
|
- 715 SymTab.SetSymType(n, t);
|
|
|
- 716 QbeGen.IntStr(ord, qv);
|
|
|
- 717 SymTab.SetSymVal(n, qv);
|
|
|
- 718 INC(ord); .)
|
|
|
- 719 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 720 SymTab.KindConst) THEN
|
|
|
- 721 SemError(200) END;
|
|
|
- 722 SymTab.SetSymType(n, t);
|
|
|
- 723 QbeGen.IntStr(ord, qv);
|
|
|
- 724 SymTab.SetSymVal(n, qv);
|
|
|
- 725 INC(ord); .) }
|
|
|
- 726 ")" (. SymTab.SetEnumCount(t,
|
|
|
- 727 VAL(CARDINAL, ord)); .) .
|
|
|
- 728 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
- 729 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
- 730 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
- 731 class/impl block. Methods end with ";" per the Table example
|
|
|
- 732 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
- 733 (* Single CLASS item in both loops: separating declaration from
|
|
|
- 734 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
- 735 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
- 736 The second token decides after CLASS is consumed. A misplaced
|
|
|
- 737 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
- 738 whole unit ends 230 until lowering). *)
|
|
|
- 739 ClassItem
|
|
|
- 740 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
- 741 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
- 742 ct: SymTab.TypeIndex; .)
|
|
|
- 743 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
- 744 SymTab.KindType) THEN
|
|
|
- 745 SemError(200) END;
|
|
|
- 746 ct := SymTab.NewClass();
|
|
|
- 747 SymTab.SetSymType(cn, ct);
|
|
|
- 748 SymTab.PushClassScope(ct); .)
|
|
|
- 749 [ Parents<ct> ]
|
|
|
- 750 ";"
|
|
|
- 751 { ClassField<ct> ";" }
|
|
|
- 752 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 753 (. SymTab.CloseProc;
|
|
|
- 754 QbeGen.AbortFunc; .) }
|
|
|
- 755 "END"
|
|
|
- 756 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 757 SemError(202) END;
|
|
|
- 758 SymTab.LayoutClass(ct);
|
|
|
- 759 SymTab.PopScope; .) .
|
|
|
- 760 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
- 761 = "(" Parent1<ct>
|
|
|
- 762 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
- 763 ")" .
|
|
|
- 764 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
- 765 pt: SymTab.TypeIndex; .)
|
|
|
- 766 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
- 767 SemError(201)
|
|
|
- 768 ELSE pt := SymTab.SymType(p);
|
|
|
- 769 IF SymTab.ClassOf(pt) #
|
|
|
- 770 SymTab.ClClass THEN
|
|
|
- 771 SemError(230)
|
|
|
- 772 ELSE SymTab.SetParent(ct, pt)
|
|
|
- 773 END
|
|
|
- 774 END; .) .
|
|
|
- 775 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
- 776 t: SymTab.TypeIndex; .)
|
|
|
- 777 = GetIdent<n>
|
|
|
- 778 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
- 779 SymTab.KindConst) THEN
|
|
|
- 780 SemError(200) END;
|
|
|
- 781 IF SymTab.Lookup(rhs) THEN
|
|
|
- 782 SymTab.SetSymType(n,
|
|
|
- 783 SymTab.SymType(rhs))
|
|
|
- 784 END; .)
|
|
|
- 785 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 786 n) THEN
|
|
|
- 787 SemError(200) END; .)
|
|
|
- 788 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 789 n) THEN
|
|
|
- 790 SemError(200) END; .) }
|
|
|
- 791 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t); .) ) .
|
|
|
- 792 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
- 793 (. VAR wantVirt: BOOLEAN; .)
|
|
|
- 794 = (. wantVirt := FALSE; .)
|
|
|
- 795 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
- 796 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
- 797 SymTab.MarkVirtual END; .) .
|
|
|
- 798 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
- 799 ct: SymTab.TypeIndex; .)
|
|
|
- 800 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
- 801 SemError(201);
|
|
|
- 802 ct := SymTab.InvalidType
|
|
|
- 803 ELSE ct := SymTab.SymType(cn);
|
|
|
- 804 IF SymTab.ClassOf(ct) #
|
|
|
- 805 SymTab.ClClass THEN
|
|
|
- 806 SemError(230);
|
|
|
- 807 ct := SymTab.InvalidType
|
|
|
- 808 END
|
|
|
- 809 END;
|
|
|
- 810 IF ct #
|
|
|
- 811 SymTab.InvalidType THEN
|
|
|
- 812 IF NOT SymTab.PushClassMembers(
|
|
|
- 813 ct) THEN
|
|
|
- 814 SemError(230) END;
|
|
|
- 815 SymTab.PushImplClass(ct)
|
|
|
- 816 END; .)
|
|
|
- 817 ";" { MethodImpl<ct> ";" }
|
|
|
- 818 [ "BEGIN" (. QbeGen.BeginInit(cn); .)
|
|
|
- 819 [ StatSeq ] (. QbeGen.EndInit; .) ]
|
|
|
- 820 "END"
|
|
|
- 821 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 822 SemError(202) END;
|
|
|
- 823 SymTab.PopImplClass;
|
|
|
- 824 SymTab.PopScope; .) .
|
|
|
- 825 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
- 826 thisQ: QbeGen.QVal;
|
|
|
- 827 methRes: SymTab.TypeIndex; .)
|
|
|
- 828 = MethodHeading<pn, ct> ";"
|
|
|
- 829 (. IF (ct #
|
|
|
- 830 SymTab.InvalidType)
|
|
|
- 831 AND NOT SymTab.MethodExists(ct,
|
|
|
- 832 pn) THEN
|
|
|
- 833 SemError(201) END; .)
|
|
|
- 834 ( "FORWARD" (. SymTab.MarkFwd;
|
|
|
- 835 QbeGen.AbortFunc;
|
|
|
- 836 SymTab.CloseProc; .)
|
|
|
- 837 | (. QbeGen.EndFuncHeader;
|
|
|
- 838 (* bind the receiver: bare
|
|
|
- 839 field names resolve
|
|
|
- 840 against THIS *)
|
|
|
- 841 QbeGen.ThisBase(thisQ);
|
|
|
- 842 QbeGen.PushWith(thisQ); .)
|
|
|
- 843 Block<pn> (. QbeGen.PopWith;
|
|
|
- 844 methRes := SymTab.CurRes();
|
|
|
- 845 SymTab.CloseProc;
|
|
|
- 846 QbeGen.EndFunc(methRes); .) ) .
|
|
|
- 847 ConstBlock (. VAR astSeq: AST.Node; .)
|
|
|
- 848 = "CONST" (. astSeq := AST.MakeNode(AST.NkDeclSeq);
|
|
|
- 849 astDecl := AST.NoNode; .)
|
|
|
- 850 { ConstDecl ";" (. IF astDecl # AST.NoNode THEN
|
|
|
- 851 AST.SetChild(astSeq,
|
|
|
- 852 AST.NChild(astSeq), astDecl) END; .) }
|
|
|
- 853 (. astDecl := astSeq; .) .
|
|
|
- 854 ConstDecl (. VAR n: SymTab.Name;
|
|
|
- 855 t: SymTab.TypeIndex;
|
|
|
- 856 qv: QbeGen.QVal;
|
|
|
- 857 cls: INTEGER;
|
|
|
- 858 astNode: AST.Node; .)
|
|
|
- 859 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 860 SymTab.KindConst) THEN
|
|
|
- 861 SemError(200) END; .)
|
|
|
- 862 "="
|
|
|
- 863 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 864 AST.SetChild(astNode, 0,
|
|
|
- 865 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 866 AST.SetChild(astNode, 1, astCur);
|
|
|
- 867 AST.SetTy(astNode, t);
|
|
|
- 868 astDecl := astNode;
|
|
|
- 869 SymTab.SetSymType(n, t);
|
|
|
- 870 cls := SymTab.ClassOf(t);
|
|
|
- 871 IF (cls = SymTab.ClArray)
|
|
|
- 872 OR (cls = SymTab.ClRecord)
|
|
|
- 873 OR (cls = SymTab.ClClass)
|
|
|
- 874 OR (cls = SymTab.ClStr)
|
|
|
- 875 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 876 (* an aggregate/string
|
|
|
- 877 constant: qv is its
|
|
|
- 878 descriptor address; no
|
|
|
- 879 scalar data *)
|
|
|
- 880 SymTab.SetSymVal(n, qv)
|
|
|
- 881 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
- 882 SemError(230)
|
|
|
- 883 ELSE
|
|
|
- 884 SymTab.SetSymVal(n, qv);
|
|
|
- 885 QbeGen.DeclConst(n, qv, t)
|
|
|
- 886 END; .) .
|
|
|
- 887 VarBlock (. VAR astSeq: AST.Node; .)
|
|
|
- 888 = "VAR" (. astSeq := AST.MakeNode(AST.NkDeclSeq);
|
|
|
- 889 astDecl := AST.NoNode; .)
|
|
|
- 890 { VarDecl ";" (. IF astDecl # AST.NoNode THEN
|
|
|
- 891 AST.SetChild(astSeq,
|
|
|
- 892 AST.NChild(astSeq), astDecl) END; .) }
|
|
|
- 893 (. astDecl := astSeq; .) .
|
|
|
- 894 VarDecl (. VAR nm: SymTab.Name;
|
|
|
- 895 t: SymTab.TypeIndex;
|
|
|
- 896 i: CARDINAL;
|
|
|
- 897 cls: INTEGER;
|
|
|
- 898 astNode: AST.Node; .)
|
|
|
- 899 = VarIdents ":"
|
|
|
- 900 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 901 i := 0;
|
|
|
- 902 WHILE i < SymTab.PendCount() DO
|
|
|
- 903 SymTab.PendName(i, nm);
|
|
|
- 904 AST.SetChild(astNode,
|
|
|
- 905 AST.NChild(astNode),
|
|
|
- 906 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
- 907 INC(i)
|
|
|
- 908 END;
|
|
|
- 909 AST.SetTy(astNode, t);
|
|
|
- 910 astDecl := astNode;
|
|
|
- 911 cls := SymTab.ClassOf(t);
|
|
|
- 912 IF (t # SymTab.InvalidType)
|
|
|
- 913 AND NOT SymTab.IsUnresolved(t)
|
|
|
- 914 AND (cls # SymTab.ClInt)
|
|
|
- 915 AND (cls # SymTab.ClBool)
|
|
|
- 916 AND (cls # SymTab.ClChar)
|
|
|
- 917 AND (cls # SymTab.ClReal)
|
|
|
- 918 AND (cls # SymTab.ClArray)
|
|
|
- 919 AND (cls # SymTab.ClSet)
|
|
|
- 920 AND (cls # SymTab.ClRecord)
|
|
|
- 921 AND (cls # SymTab.ClPtr)
|
|
|
- 922 AND (cls # SymTab.ClLong)
|
|
|
- 923 AND (cls # SymTab.ClProc)
|
|
|
- 924 AND (cls # SymTab.ClUChar)
|
|
|
- 925 AND (cls # SymTab.ClUStr)
|
|
|
- 926 AND (cls # SymTab.ClEnum)
|
|
|
- 927 AND (cls # SymTab.ClClass) THEN
|
|
|
- 928 SemError(230) END;
|
|
|
- 929 IF QbeGen.LocFull() THEN
|
|
|
- 930 SemError(233) END;
|
|
|
- 931 i := 0;
|
|
|
- 932 IF SymTab.IsUnresolved(t)
|
|
|
- 933 AND NOT SymTab.InProc() THEN
|
|
|
- 934 (* a forward-typed global:
|
|
|
- 935 defer emission until the
|
|
|
- 936 TYPE block completes *)
|
|
|
- 937 WHILE i < SymTab.PendCount() DO
|
|
|
- 938 SymTab.PendName(i, nm);
|
|
|
- 939 IF nPendVar <=
|
|
|
- 940 HIGH(pendVarName) THEN
|
|
|
- 941 pendVarName[nPendVar] := nm;
|
|
|
- 942 pendVarT[nPendVar] := t;
|
|
|
- 943 INC(nPendVar)
|
|
|
- 944 END;
|
|
|
- 945 INC(i)
|
|
|
- 946 END
|
|
|
- 947 ELSE
|
|
|
- 948 WHILE i < SymTab.PendCount() DO
|
|
|
- 949 SymTab.PendName(i, nm);
|
|
|
- 950 QbeGen.DeclVar(nm, t);
|
|
|
- 951 INC(i)
|
|
|
- 952 END
|
|
|
- 953 END;
|
|
|
- 954 (* a plain VAR list, not a
|
|
|
- 955 heading: the signature
|
|
|
- 956 result is discarded *)
|
|
|
- 957 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 958 END; .) .
|
|
|
- 959 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
- 960 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 961 SymTab.KindVar) THEN
|
|
|
- 962 SemError(200) END; .)
|
|
|
- 963 { ","
|
|
|
- 964 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 965 SymTab.KindVar) THEN
|
|
|
- 966 SemError(200) END; .) } .
|
|
|
- 967 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
- 968 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 969 SemError(200) END; .)
|
|
|
- 970 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 971 SemError(200) END; .) } .
|
|
|
- 972 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
- 973 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
- 974 FORWARD marks; the body heading re-enters (signature compare
|
|
|
- 975 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
- 976 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
- 977 (. VAR t: SymTab.TypeIndex;
|
|
|
- 978 mg: QbeGen.QVal; .)
|
|
|
- 979 = "PROCEDURE"
|
|
|
- 980 GetIdent<pn> (. IF methCls #
|
|
|
- 981 SymTab.InvalidType THEN
|
|
|
- 982 (* a method: resume the
|
|
|
- 983 declared symbol (reuse
|
|
|
- 984 its uid) *)
|
|
|
- 985 IF NOT SymTab.ResumeMethod(
|
|
|
- 986 methCls, pn) THEN
|
|
|
- 987 SemError(200) END
|
|
|
- 988 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
- 989 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
- 990 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
- 991 SemError(200) END
|
|
|
- 992 END
|
|
|
- 993 END;
|
|
|
- 994 IF methCls #
|
|
|
- 995 SymTab.InvalidType THEN
|
|
|
- 996 QbeGen.Mangled(pn,
|
|
|
- 997 SymTab.MethUid(), mg)
|
|
|
- 998 ELSE
|
|
|
- 999 QbeGen.Mangled(pn,
|
|
|
- 1000 SymTab.ProcUid(pn), mg)
|
|
|
- 1001 END;
|
|
|
- 1002 QbeGen.BeginFunc(mg);
|
|
|
- 1003 IF methCls #
|
|
|
- 1004 SymTab.InvalidType THEN
|
|
|
- 1005 (* hidden THIS receiver:
|
|
|
- 1006 a VAR param of the
|
|
|
- 1007 class type, pushed as
|
|
|
- 1008 the WITH base *)
|
|
|
- 1009 IF NOT SymTab.EnterThisParam(
|
|
|
- 1010 methCls) THEN
|
|
|
- 1011 SemError(200) END;
|
|
|
- 1012 IF NOT QbeGen.FuncParam(
|
|
|
- 1013 "THIS", TRUE,
|
|
|
- 1014 methCls) THEN
|
|
|
- 1015 SemError(233) END
|
|
|
- 1016 END; .)
|
|
|
- 1017 [ FormalParams ]
|
|
|
- 1018 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
- 1019 SemError(235) END;
|
|
|
- 1020 QbeGen.SetFuncRes(t);
|
|
|
- 1021 IF (t #
|
|
|
- 1022 SymTab.InvalidType)
|
|
|
- 1023 AND ((SymTab.ClassOf(t)
|
|
|
- 1024 = SymTab.ClArray)
|
|
|
- 1025 OR (SymTab.ClassOf(t)
|
|
|
- 1026 = SymTab.ClRecord)
|
|
|
- 1027 OR (SymTab.ClassOf(t)
|
|
|
- 1028 = SymTab.ClSet)
|
|
|
- 1029 OR (SymTab.ClassOf(t)
|
|
|
- 1030 = SymTab.ClClass)) THEN
|
|
|
- 1031 SemError(230) END; .) ] .
|
|
|
- 1032 FormalParams
|
|
|
- 1033 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
- 1034 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
- 1035 nm: SymTab.Name;
|
|
|
- 1036 i: CARDINAL;
|
|
|
- 1037 isV: BOOLEAN; .)
|
|
|
- 1038 = (. isV := FALSE; .)
|
|
|
- 1039 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1040 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
- 1041 WHILE i < SymTab.PendCount() DO
|
|
|
- 1042 SymTab.PendName(i, nm);
|
|
|
- 1043 (* value open arrays are
|
|
|
- 1044 passed as descriptor
|
|
|
- 1045 addresses (no copy):
|
|
|
- 1046 same representation as
|
|
|
- 1047 VAR formals *)
|
|
|
- 1048 IF NOT QbeGen.FuncParam(nm,
|
|
|
- 1049 isV
|
|
|
- 1050 OR SymTab.IsOpenArray(t),
|
|
|
- 1051 t) THEN
|
|
|
- 1052 SemError(233) END;
|
|
|
- 1053 INC(i)
|
|
|
- 1054 END;
|
|
|
- 1055 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1056 SemError(235) END; .) .
|
|
|
- 1057 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
- 1058 static link gives them their parent's frame. Methods keep
|
|
|
- 1059 parse-now/230-later. *)
|
|
|
- 1060 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
- 1061 astNode: AST.Node; .)
|
|
|
- 1062 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1063 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1064 AST.SetChild(astNode, 0,
|
|
|
- 1065 AST.MakeLeaf(AST.NkIdent, pn)); .)
|
|
|
- 1066 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
- 1067 astDecl := astNode;
|
|
|
- 1068 SymTab.MarkFwd;
|
|
|
- 1069 SymTab.CloseProc;
|
|
|
- 1070 QbeGen.AbortFunc; .)
|
|
|
- 1071 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
- 1072 astDecl := astNode;
|
|
|
- 1073 SymTab.MarkExternal("");
|
|
|
- 1074 SymTab.CloseProc;
|
|
|
- 1075 QbeGen.AbortFunc; .)
|
|
|
- 1076 | (. QbeGen.EndFuncHeader; .)
|
|
|
- 1077 Block<pn> (. AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1078 astDecl := astNode;
|
|
|
- 1079 SymTab.CloseProc;
|
|
|
- 1080 QbeGen.EndFunc(
|
|
|
- 1081 SymTab.ProcRes(pn)); .) ) .
|
|
|
- 1082 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
|
|
|
- 1083 = DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 1084 [ "BEGIN"
|
|
|
- 1085 [ StatSeq ] ]
|
|
|
- 1086 "END"
|
|
|
- 1087 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
- 1088 SemError(202) END; .) .
|
|
|
- 1089 StatSeq (. VAR astSeq: AST.Node; .)
|
|
|
- 1090 = (. astSeq := AST.MakeNode(AST.NkBlock); .)
|
|
|
- 1091 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 1092 AST.SetChild(astSeq,
|
|
|
- 1093 AST.NChild(astSeq), astStmt) END; .)
|
|
|
- 1094 { ";" [ Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 1095 AST.SetChild(astSeq,
|
|
|
- 1096 AST.NChild(astSeq), astStmt) END; .) ] }
|
|
|
- 1097 (. astStmt := astSeq; .) .
|
|
|
- 1098 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
- 1099 are accepted: the statement after ';' is optional. *)
|
|
|
- 1100 Statement (. VAR lx: QbeGen.QVal; .)
|
|
|
- 1101 = (. astStmt := AST.NoNode; .)
|
|
|
- 1102 ( AssOrCall
|
|
|
- 1103 | IfStat
|
|
|
- 1104 | WhileStat
|
|
|
- 1105 | RepeatStat
|
|
|
- 1106 | LoopStat
|
|
|
- 1107 | ForStat
|
|
|
- 1108 | CaseStat
|
|
|
- 1109 | WithStat
|
|
|
- 1110 | ReturnStat
|
|
|
- 1111 | HaltStat
|
|
|
- 1112 | NewStat
|
|
|
- 1113 | DisposeStat
|
|
|
- 1114 | IncDecStat
|
|
|
- 1115 | InclExclStat
|
|
|
- 1116 | "EXIT" (. IF QbeGen.TopLoop(lx) THEN
|
|
|
- 1117 QbeGen.Jmp(lx)
|
|
|
- 1118 ELSE SemError(230) END;
|
|
|
- 1119 astStmt := AST.MakeNode(AST.NkExit); .) ) .
|
|
|
- 1120 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
- 1121 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
- 1122 dk: INTEGER;
|
|
|
- 1123 qd, qe: QbeGen.QVal;
|
|
|
- 1124 qn: SymTab.Name;
|
|
|
- 1125 sfx, isInc: BOOLEAN;
|
|
|
- 1126 astNode, astD: AST.Node; .)
|
|
|
- 1127 = ( "INCL" (. isInc := TRUE; .)
|
|
|
- 1128 | "EXCL" (. isInc := FALSE; .) )
|
|
|
- 1129 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
- 1130 Expr<et2, qe> ")"
|
|
|
- 1131 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1132 IF isInc THEN
|
|
|
- 1133 AST.SetChild(astNode, 0,
|
|
|
- 1134 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
- 1135 ELSE AST.SetChild(astNode, 0,
|
|
|
- 1136 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
- 1137 END;
|
|
|
- 1138 IF astD # AST.NoNode THEN
|
|
|
- 1139 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1140 IF astCur # AST.NoNode THEN
|
|
|
- 1141 AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 1142 astStmt := astNode; .)
|
|
|
- 1143 (. IF at = SymTab.InvalidType THEN
|
|
|
- 1144 ELSIF SymTab.ClassOf(at) #
|
|
|
- 1145 SymTab.ClSet THEN
|
|
|
- 1146 SemError(222)
|
|
|
- 1147 ELSE
|
|
|
- 1148 IF isInc THEN
|
|
|
- 1149 QbeGen.SetBit(qd, qe,
|
|
|
- 1150 SymTab.SetBaseLo(at),
|
|
|
- 1151 SymTab.SetCount(at))
|
|
|
- 1152 ELSE
|
|
|
- 1153 QbeGen.SetClearBit(qd, qe,
|
|
|
- 1154 SymTab.SetBaseLo(at),
|
|
|
- 1155 SymTab.SetCount(at))
|
|
|
- 1156 END
|
|
|
- 1157 END; .) .
|
|
|
- 1158 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
- 1159 integer designator. *)
|
|
|
- 1160 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
- 1161 dk: INTEGER;
|
|
|
- 1162 qd, qv, qn2, qstep:
|
|
|
- 1163 QbeGen.QVal;
|
|
|
- 1164 qn: SymTab.Name;
|
|
|
- 1165 sfx, isInc: BOOLEAN;
|
|
|
- 1166 astNode, astD, astStep:
|
|
|
- 1167 AST.Node; .)
|
|
|
- 1168 = (. isInc := TRUE; .)
|
|
|
- 1169 ( "INC" (. isInc := TRUE; .)
|
|
|
- 1170 | "DEC" (. isInc := FALSE; .) )
|
|
|
- 1171 "(" (. QbeGen.CopyOp("1", qstep); astStep := AST.NoNode; .)
|
|
|
- 1172 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
- 1173 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
- 1174 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1175 IF isInc THEN
|
|
|
- 1176 AST.SetChild(astNode, 0,
|
|
|
- 1177 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
- 1178 ELSE AST.SetChild(astNode, 0,
|
|
|
- 1179 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
- 1180 END;
|
|
|
- 1181 IF astD # AST.NoNode THEN
|
|
|
- 1182 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1183 IF astStep # AST.NoNode THEN
|
|
|
- 1184 AST.SetChild(astNode, 2, astStep) END;
|
|
|
- 1185 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1186 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1187 AND (dk # SymTab.KindParam)
|
|
|
- 1188 AND (dk # SymTab.KindField) THEN
|
|
|
- 1189 SemError(210)
|
|
|
- 1190 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
- 1191 SemError(211)
|
|
|
- 1192 ELSE
|
|
|
- 1193 IF sfx
|
|
|
- 1194 OR (dk = SymTab.KindField) THEN
|
|
|
- 1195 QbeGen.ElemLoad(qd, dt, qv)
|
|
|
- 1196 ELSE QbeGen.LoadVar(qn,
|
|
|
- 1197 FALSE, qv)
|
|
|
- 1198 END;
|
|
|
- 1199 QbeGen.NewTemp(qn2);
|
|
|
- 1200 IF isInc THEN
|
|
|
- 1201 QbeGen.Op3("add", qn2, qv,
|
|
|
- 1202 qstep, FALSE)
|
|
|
- 1203 ELSE QbeGen.Op3("sub", qn2, qv,
|
|
|
- 1204 qstep, FALSE)
|
|
|
- 1205 END;
|
|
|
- 1206 IF sfx
|
|
|
- 1207 OR (dk = SymTab.KindField) THEN
|
|
|
- 1208 QbeGen.ElemStore(qd, qn2,
|
|
|
- 1209 dt)
|
|
|
- 1210 ELSE QbeGen.StoreVar(qn,
|
|
|
- 1211 qn2, FALSE)
|
|
|
- 1212 END
|
|
|
- 1213 END; .) .
|
|
|
- 1214 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
- 1215 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
- 1216 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
- 1217 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1218 dk: INTEGER;
|
|
|
- 1219 qd, qm: QbeGen.QVal;
|
|
|
- 1220 qn: SymTab.Name;
|
|
|
- 1221 sfx: BOOLEAN;
|
|
|
- 1222 bt: SymTab.TypeIndex;
|
|
|
- 1223 astNode, astD: AST.Node; .)
|
|
|
- 1224 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 1225 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1226 AST.SetChild(astNode, 0,
|
|
|
- 1227 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
- 1228 IF astD # AST.NoNode THEN
|
|
|
- 1229 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1230 astStmt := astNode; .)
|
|
|
- 1231 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1232 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1233 AND (dk # SymTab.KindParam)
|
|
|
- 1234 AND (dk # SymTab.KindField) THEN
|
|
|
- 1235 SemError(210)
|
|
|
- 1236 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 1237 SymTab.ClPtr THEN
|
|
|
- 1238 SemError(219)
|
|
|
- 1239 ELSE bt := SymTab.PtrBase(dt);
|
|
|
- 1240 IF bt #
|
|
|
- 1241 SymTab.InvalidType THEN
|
|
|
- 1242 QbeGen.NewHeap(bt, qm);
|
|
|
- 1243 QbeGen.InitHeap(qm, bt);
|
|
|
- 1244 IF sfx
|
|
|
- 1245 OR (dk =
|
|
|
- 1246 SymTab.KindField) THEN
|
|
|
- 1247 QbeGen.ElemStore(qd, qm,
|
|
|
- 1248 dt)
|
|
|
- 1249 ELSE QbeGen.StorePtr(qn,
|
|
|
- 1250 qm)
|
|
|
- 1251 END
|
|
|
- 1252 END
|
|
|
- 1253 END; .) .
|
|
|
- 1254 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1255 dk: INTEGER;
|
|
|
- 1256 qd, qv: QbeGen.QVal;
|
|
|
- 1257 qn: SymTab.Name;
|
|
|
- 1258 sfx: BOOLEAN;
|
|
|
- 1259 astNode, astD: AST.Node; .)
|
|
|
- 1260 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 1261 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1262 AST.SetChild(astNode, 0,
|
|
|
- 1263 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
- 1264 IF astD # AST.NoNode THEN
|
|
|
- 1265 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1266 astStmt := astNode; .)
|
|
|
- 1267 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1268 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1269 AND (dk # SymTab.KindParam)
|
|
|
- 1270 AND (dk # SymTab.KindField) THEN
|
|
|
- 1271 SemError(210)
|
|
|
- 1272 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 1273 SymTab.ClPtr THEN
|
|
|
- 1274 SemError(219)
|
|
|
- 1275 ELSE
|
|
|
- 1276 IF sfx
|
|
|
- 1277 OR (dk =
|
|
|
- 1278 SymTab.KindField) THEN
|
|
|
- 1279 QbeGen.ElemLoad(qd, dt,
|
|
|
- 1280 qv)
|
|
|
- 1281 ELSE QbeGen.LoadPtr(qn, qv)
|
|
|
- 1282 END;
|
|
|
- 1283 QbeGen.FreeHeap(qv);
|
|
|
- 1284 IF sfx
|
|
|
- 1285 OR (dk =
|
|
|
- 1286 SymTab.KindField) THEN
|
|
|
- 1287 QbeGen.ElemStore(qd, "0",
|
|
|
- 1288 dt)
|
|
|
- 1289 ELSE QbeGen.StorePtr(qn,
|
|
|
- 1290 "0")
|
|
|
- 1291 END
|
|
|
- 1292 END; .) .
|
|
|
- 1293 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
- 1294 address; field designators resolve through both stacks. *)
|
|
|
- 1295 WithStat (. VAR nW: CARDINAL;
|
|
|
- 1296 astNode: AST.Node; .)
|
|
|
- 1297 = "WITH" (. nW := 0;
|
|
|
- 1298 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
- 1299 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
- 1300 "DO" (. astStmt := AST.NoNode; .)
|
|
|
- 1301 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
- 1302 AST.NChild(astNode), astStmt);
|
|
|
- 1303 astStmt := astNode;
|
|
|
- 1304 WHILE nW > 0 DO
|
|
|
- 1305 SymTab.PopScope;
|
|
|
- 1306 QbeGen.PopWith;
|
|
|
- 1307 DEC(nW)
|
|
|
+ 167 PROCEDURE AstAppend (kind: INTEGER; VAR head, tail: AST.Node;
|
|
|
+ 168 item: AST.Node);
|
|
|
+ 169 (* Appends `item` to a chunked sequence: each node holds up to
|
|
|
+ 170 AST.MaxChild-1 items; child[MaxChild-1] continues into the next
|
|
|
+ 171 chunk. Unbounded, so blocks/decl sequences are not capped at 8. *)
|
|
|
+ 172 VAR n: AST.Node;
|
|
|
+ 173 BEGIN
|
|
|
+ 174 IF item = AST.NoNode THEN RETURN END;
|
|
|
+ 175 IF head = AST.NoNode THEN
|
|
|
+ 176 head := AST.MakeNode(kind); tail := head
|
|
|
+ 177 END;
|
|
|
+ 178 IF AST.NChild(tail) >= AST.MaxChild - 1 THEN
|
|
|
+ 179 n := AST.MakeNode(kind);
|
|
|
+ 180 AST.SetChild(tail, AST.MaxChild - 1, n);
|
|
|
+ 181 tail := n
|
|
|
+ 182 END;
|
|
|
+ 183 AST.SetChild(tail, AST.NChild(tail), item)
|
|
|
+ 184 END AstAppend;
|
|
|
+ 185
|
|
|
+ 186 CHARACTERS
|
|
|
+ 187 eol = CHR(13) .
|
|
|
+ 188 lf = CHR(10) .
|
|
|
+ 189 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
+ 190 digit = "0123456789" .
|
|
|
+ 191 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
+ 192 noQuote1 = ANY - "'" - eol .
|
|
|
+ 193 noQuote2 = ANY - '"' - eol .
|
|
|
+ 194
|
|
|
+ 195 IGNORE CHR(9) .. CHR(13)
|
|
|
+ 196
|
|
|
+ 197 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
+ 198 COMMENTS FROM "//" TO lf
|
|
|
+ 199
|
|
|
+ 200 TOKENS
|
|
|
+ 201 ident = letter { letter | digit } .
|
|
|
+ 202 integer = digit { digit }
|
|
|
+ 203 | digit { digit } CONTEXT("..")
|
|
|
+ 204 | "0x" hexDigit { hexDigit }
|
|
|
+ 205 | "0X" hexDigit { hexDigit } .
|
|
|
+ 206 real = digit { digit } "." { digit }
|
|
|
+ 207 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
+ 208 string = "'" { noQuote1 } "'"
|
|
|
+ 209 | '"' { noQuote2 } '"' .
|
|
|
+ 210 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
+ 211 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
+ 212
|
|
|
+ 213 PRODUCTIONS
|
|
|
+ 214 M2
|
|
|
+ 215 = (. AST.Init; twoPhase := TRUE; astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; .)
|
|
|
+ 216 Unit "." .
|
|
|
+ 217 (* Units: program modules compile fully; DEFINITION and
|
|
|
+ 218 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
+ 219 (each ends with one 230); same for nested local modules. *)
|
|
|
+ 220 Unit
|
|
|
+ 221 = DefUnit
|
|
|
+ 222 | ImplUnit
|
|
|
+ 223 | ProgModule .
|
|
|
+ 224 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
+ 225 and one program (last) into one image. Units share the symbol
|
|
|
+ 226 table; imports materialize exported names. *)
|
|
|
+ 227 DefUnit (. VAR m1, m2, pn: SymTab.Name; .)
|
|
|
+ 228 = "DEFINITION" "MODULE"
|
|
|
+ 229 GetIdent<m1> (. IF NOT SymTab.BeginDef(m1) THEN
|
|
|
+ 230 SemError(200) END;
|
|
|
+ 231 QbeGen.SetModule(m1); .)
|
|
|
+ 232 ";"
|
|
|
+ 233 { Import }
|
|
|
+ 234 [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
|
|
|
+ 235 list: parsed, and the
|
|
|
+ 236 names are already exported
|
|
|
+ 237 by the module scope *) .)
|
|
|
+ 238 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
+ 239 { ConstBlock | TypeBlock<TRUE> | VarBlock
|
|
|
+ 240 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 241 (. SymTab.CloseProc;
|
|
|
+ 242 QbeGen.AbortFunc; .) }
|
|
|
+ 243 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 244 AST.SetChild(astUnit, 0,
|
|
|
+ 245 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 246 astDecl := AST.NoNode;
|
|
|
+ 247 astStmt := AST.NoNode; .)
|
|
|
+ 248 "END"
|
|
|
+ 249 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 250 SemError(202) END;
|
|
|
+ 251 SymTab.EndUnit; .) .
|
|
|
+ 252 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
+ 253 k: CARDINAL;
|
|
|
+ 254 fname: SymTab.Name;
|
|
|
+ 255 unres: BOOLEAN;
|
|
|
+ 256 astNode: AST.Node; .)
|
|
|
+ 257 = "IMPLEMENTATION" "MODULE"
|
|
|
+ 258 GetIdent<m1> (. IF NOT SymTab.BeginImpl(m1) THEN
|
|
|
+ 259 SemError(201) END;
|
|
|
+ 260 astStmt := AST.NoNode;
|
|
|
+ 261 astDecl := AST.NoNode;
|
|
|
+ 262 nPendVar := 0;
|
|
|
+ 263 QbeGen.SetModule(m1); .)
|
|
|
+ 264 ";"
|
|
|
+ 265 { Import }
|
|
|
+ 266 DeclSeq
|
|
|
+ 267 [ "BEGIN" (. FlushPend;
|
|
|
+ 268 k := 0;
|
|
|
+ 269 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 270 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 271 IF unres THEN SemError(201) END;
|
|
|
+ 272 INC(k)
|
|
|
+ 273 END;
|
|
|
+ 274 SymTab.FwdClear;
|
|
|
+ 275 FwdVarFlush;
|
|
|
+ 276 QbeGen.BeginInit(m1); .)
|
|
|
+ 277 [ StatSeq ] (. QbeGen.EndInit; .) ]
|
|
|
+ 278 "END"
|
|
|
+ 279 GetIdent<m2> (. FlushPend;
|
|
|
+ 280 k := 0;
|
|
|
+ 281 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 282 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 283 IF unres THEN SemError(201) END;
|
|
|
+ 284 INC(k)
|
|
|
+ 285 END;
|
|
|
+ 286 SymTab.FwdClear;
|
|
|
+ 287 FwdVarFlush;
|
|
|
+ 288 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 289 AST.SetChild(astNode, 0,
|
|
|
+ 290 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 291 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 292 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 293 astUnit := astNode;
|
|
|
+ 294 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 295 SemError(202) END;
|
|
|
+ 296 SymTab.EndUnit; .) .
|
|
|
+ 297 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 298 k: CARDINAL;
|
|
|
+ 299 fname: SymTab.Name;
|
|
|
+ 300 unres: BOOLEAN;
|
|
|
+ 301 astNode: AST.Node; .)
|
|
|
+ 302 = "MODULE"
|
|
|
+ 303 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
+ 304 SemError(200) END;
|
|
|
+ 305 astStmt := AST.NoNode;
|
|
|
+ 306 astDecl := AST.NoNode;
|
|
|
+ 307 nPendVar := 0;
|
|
|
+ 308 QbeGen.SetModule(m1); .)
|
|
|
+ 309 [ Priority ]
|
|
|
+ 310 ";"
|
|
|
+ 311 { Import }
|
|
|
+ 312 DeclSeq
|
|
|
+ 313 [ "BEGIN" (. FlushPend;
|
|
|
+ 314 k := 0;
|
|
|
+ 315 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 316 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 317 IF unres THEN SemError(201) END;
|
|
|
+ 318 INC(k)
|
|
|
+ 319 END;
|
|
|
+ 320 SymTab.FwdClear;
|
|
|
+ 321 FwdVarFlush;
|
|
|
+ 322 QbeGen.BeginBody; .)
|
|
|
+ 323 [ StatSeq ] ]
|
|
|
+ 324 "END"
|
|
|
+ 325 GetIdent<m2> (. FlushPend;
|
|
|
+ 326 k := 0;
|
|
|
+ 327 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 328 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 329 IF unres THEN SemError(201) END;
|
|
|
+ 330 INC(k)
|
|
|
+ 331 END;
|
|
|
+ 332 SymTab.FwdClear;
|
|
|
+ 333 FwdVarFlush;
|
|
|
+ 334 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 335 SemError(202) END;
|
|
|
+ 336 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 337 AST.SetChild(astNode, 0,
|
|
|
+ 338 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 339 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 340 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 341 astUnit := astNode;
|
|
|
+ 342 QbeGen.EndModule(m1);
|
|
|
+ 343 SymTab.EndUnit; .) .
|
|
|
+ 344 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 345 = (. astSeq := AST.NoNode;
|
|
|
+ 346 astTail := AST.NoNode; .)
|
|
|
+ 347 { (. astDecl := AST.NoNode; .)
|
|
|
+ 348 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
+ 349 | NestedModule ";" | ClassItem ";" )
|
|
|
+ 350 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 351 astSeq, astTail, astDecl); .) }
|
|
|
+ 352 (. astDecl := astSeq; .) .
|
|
|
+ 353 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
+ 354 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
+ 355 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
+ 356 scope at END. *)
|
|
|
+ 357 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 358 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ 359 expCount, k: CARDINAL; .)
|
|
|
+ 360 = "MODULE"
|
|
|
+ 361 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
+ 362 SymTab.KindModule) THEN
|
|
|
+ 363 SemError(200) END;
|
|
|
+ 364 SymTab.PushScope;
|
|
|
+ 365 expCount := 0; .)
|
|
|
+ 366 [ Priority ]
|
|
|
+ 367 ";"
|
|
|
+ 368 { Import }
|
|
|
+ 369 [ "EXPORT" [ "QUALIFIED" ]
|
|
|
+ 370 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
+ 371 { "," GetIdent<expNames[expCount]>
|
|
|
+ 372 (. INC(expCount); .) }
|
|
|
+ 373 ";" ]
|
|
|
+ 374 DeclSeq
|
|
|
+ 375 [ "BEGIN" (. QbeGen.BeginInit(m1); .)
|
|
|
+ 376 [ StatSeq ] (. QbeGen.EndInit; .) ]
|
|
|
+ 377 "END"
|
|
|
+ 378 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 379 SemError(202) END;
|
|
|
+ 380 k := 0;
|
|
|
+ 381 WHILE k < expCount DO
|
|
|
+ 382 SymTab.ExportUp(expNames[k]);
|
|
|
+ 383 INC(k)
|
|
|
+ 384 END;
|
|
|
+ 385 SymTab.PopScope; .) .
|
|
|
+ 386 Priority
|
|
|
+ 387 = "[" integer "]" (. SemError(230); .) .
|
|
|
+ 388 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
+ 389 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
+ 390 materializes on first use (Design). *)
|
|
|
+ 391 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
+ 392 import lines don't fail); a known module's missing export is
|
|
|
+ 393 201. *)
|
|
|
+ 394 Import (. VAR n: SymTab.Name; .)
|
|
|
+ 395 = "FROM"
|
|
|
+ 396 GetIdent<n>
|
|
|
+ 397 "IMPORT"
|
|
|
+ 398 ImpList<n> ";"
|
|
|
+ 399 | "IMPORT"
|
|
|
+ 400 ImpModList ";" .
|
|
|
+ 401 ImpList<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
|
|
|
+ 402 = ImpName<mod>
|
|
|
+ 403 { "," ImpName<mod> } .
|
|
|
+ 404 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
+ 405 accepted and ignored: the built-in applies regardless. *)
|
|
|
+ 406 ImpName<mod: SymTab.Name> (. VAR n: SymTab.Name; .)
|
|
|
+ 407 = GetIdent<n> (. IF SymTab.Equal(mod, "libc") THEN
|
|
|
+ 408 (* intrinsic C library:
|
|
|
+ 409 permissive external *)
|
|
|
+ 410 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
+ 411 SemError(201) END
|
|
|
+ 412 ELSIF SymTab.ModKnown(mod)
|
|
|
+ 413 AND NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
+ 414 SemError(201) END; .)
|
|
|
+ 415 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
+ 416 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
|
|
|
+ 417 | "UCHR" | "CHR8" | "UORD"
|
|
|
+ 418 | "INC" | "DEC" ) .
|
|
|
+ 419 ImpModList (. VAR n: SymTab.Name; .)
|
|
|
+ 420 = GetIdent<n>
|
|
|
+ 421 { "," GetIdent<n> } .
|
|
|
+ 422 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
+ 423 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
+ 424 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
+ 425 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
+ 426 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
+ 427 TypeBlock<isDef: BOOLEAN>
|
|
|
+ 428 = "TYPE" (. SymTab.BeginTypeBlock; .)
|
|
|
+ 429 { TypeItem<isDef> ";" | ClassItem ";" }
|
|
|
+ 430 (. SymTab.EndTypeBlock; .) .
|
|
|
+ 431 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ 432 t, op: SymTab.TypeIndex;
|
|
|
+ 433 astNode: AST.Node; .)
|
|
|
+ 434 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
+ 435 IF op = SymTab.InvalidType THEN
|
|
|
+ 436 IF NOT SymTab.Enter(n,
|
|
|
+ 437 SymTab.KindType) THEN
|
|
|
+ 438 SemError(200) END
|
|
|
+ 439 END; .)
|
|
|
+ 440 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
+ 441 AST.SetChild(astNode, 0,
|
|
|
+ 442 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 443 AST.SetTy(astNode, t);
|
|
|
+ 444 astDecl := astNode;
|
|
|
+ 445 IF op # SymTab.InvalidType THEN
|
|
|
+ 446 SymTab.SetTarget(op, t)
|
|
|
+ 447 ELSE SymTab.SetSymType(n, t)
|
|
|
+ 448 END; .)
|
|
|
+ 449 | (. IF op # SymTab.InvalidType THEN
|
|
|
+ 450 (* stays opaque *)
|
|
|
+ 451 ELSIF NOT isDef THEN
|
|
|
+ 452 SemError(231)
|
|
|
+ 453 ELSE SymTab.SetSymType(n,
|
|
|
+ 454 SymTab.NewAlias()) END; .) ) .
|
|
|
+ 455 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 456 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
+ 457 | Subrange<t>
|
|
|
+ 458 | Enum<t>
|
|
|
+ 459 | ArrayType<t, allowOpen>
|
|
|
+ 460 | SetType<t>
|
|
|
+ 461 | RecordType<t>
|
|
|
+ 462 | PointerType<t>
|
|
|
+ 463 | ProcType<t> .
|
|
|
+ 464 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
+ 465 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
|
|
|
+ 466 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
+ 467 are code pointers; params are collected into the descriptor. *)
|
|
|
+ 468 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
+ 469 isV: BOOLEAN; .)
|
|
|
+ 470 = "PROCEDURE" (. res := SymTab.InvalidType;
|
|
|
+ 471 t := SymTab.NewProcType(res); .)
|
|
|
+ 472 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
+ 473 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
+ 474 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
+ 475 isV: BOOLEAN;
|
|
|
+ 476 cnt, k: CARDINAL;
|
|
|
+ 477 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
+ 478 = (. isV := FALSE; cnt := 0; .)
|
|
|
+ 479 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 480 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 481 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
+ 482 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
+ 483 WHILE k < cnt DO
|
|
|
+ 484 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 485 INC(k)
|
|
|
+ 486 END; .)
|
|
|
+ 487 | (. (* type-only parameter list:
|
|
|
+ 488 each name is a type (GNU
|
|
|
+ 489 shorthand used by the
|
|
|
+ 490 Coco/R scanner frame) *)
|
|
|
+ 491 k := 0;
|
|
|
+ 492 WHILE k < cnt DO
|
|
|
+ 493 IF SymTab.Lookup(names[k])
|
|
|
+ 494 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
+ 495 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
+ 496 pt := SymTab.SymType(names[k])
|
|
|
+ 497 ELSE SemError(201);
|
|
|
+ 498 pt := SymTab.InvalidType
|
|
|
+ 499 END;
|
|
|
+ 500 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 501 INC(k)
|
|
|
+ 502 END; .) )
|
|
|
+ 503 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
+ 504 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
+ 505 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
+ 506 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
+ 507 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
+ 508 out. Bounds are folded literals (int/char); anything else 230.
|
|
|
+ 509 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
+ 510 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 511 (. VAR elem: SymTab.TypeIndex;
|
|
|
+ 512 ok: BOOLEAN;
|
|
|
+ 513 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
+ 514 nb, k: CARDINAL;
|
|
|
+ 515 idx: SymTab.TypeIndex;
|
|
|
+ 516 ilo, ihi: INTEGER; .)
|
|
|
+ 517 = "ARRAY"
|
|
|
+ 518 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
|
|
|
+ 519 SemError(230) END;
|
|
|
+ 520 t := SymTab.NewOpenArray(elem); .)
|
|
|
+ 521 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
+ 522 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
+ 523 type's ordinal bounds give the
|
|
|
+ 524 [lo..hi] pair *)
|
|
|
+ 525 IF SymTab.TypeBounds(idx, ilo,
|
|
|
+ 526 ihi)
|
|
|
+ 527 THEN t := SymTab.NewArrayB(elem,
|
|
|
+ 528 ilo, ihi)
|
|
|
+ 529 ELSE SemError(230);
|
|
|
+ 530 t := SymTab.InvalidType
|
|
|
+ 531 END; .)
|
|
|
+ 532 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
|
|
|
+ 533 BoundPair<ok>
|
|
|
+ 534 { "," BoundPair<ok> }
|
|
|
+ 535 "]" (. (* snapshot before the element
|
|
|
+ 536 type, which reuses the bound
|
|
|
+ 537 buffer for a nested ARRAY *)
|
|
|
+ 538 nb := SymTab.BoundCount();
|
|
|
+ 539 k := 0;
|
|
|
+ 540 WHILE k < nb DO
|
|
|
+ 541 bnds[k] := SymTab.BoundLo(k);
|
|
|
+ 542 bndh[k] := SymTab.BoundHi(k);
|
|
|
+ 543 INC(k)
|
|
|
+ 544 END; .)
|
|
|
+ 545 "OF" Type<elem, FALSE>
|
|
|
+ 546 (. IF ok THEN
|
|
|
+ 547 k := nb;
|
|
|
+ 548 WHILE k > 0 DO
|
|
|
+ 549 DEC(k);
|
|
|
+ 550 elem := SymTab.NewArrayB(
|
|
|
+ 551 elem, bnds[k], bndh[k])
|
|
|
+ 552 END;
|
|
|
+ 553 t := elem
|
|
|
+ 554 ELSE t := SymTab.InvalidType
|
|
|
+ 555 END; .) ) .
|
|
|
+ 556 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 557 qlo, qhi: QbeGen.QVal;
|
|
|
+ 558 lo, hi: INTEGER;
|
|
|
+ 559 cl, cl2: INTEGER; .)
|
|
|
+ 560 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 561 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 562 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 563 ok := FALSE
|
|
|
+ 564 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
+ 565 cl2 := SymTab.ClassOf(thi);
|
|
|
+ 566 IF ((cl # SymTab.ClInt)
|
|
|
+ 567 AND (cl # SymTab.ClChar))
|
|
|
+ 568 OR ((cl2 # SymTab.ClInt)
|
|
|
+ 569 AND (cl2 # SymTab.ClChar)) THEN
|
|
|
+ 570 SemError(230); ok := FALSE
|
|
|
+ 571 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 572 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 573 OR (lo > hi) THEN
|
|
|
+ 574 SemError(230); ok := FALSE
|
|
|
+ 575 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
+ 576 SemError(230); ok := FALSE
|
|
|
+ 577 END;
|
|
|
+ 578 END; .) .
|
|
|
+ 579 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
+ 580 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
+ 581 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
+ 582 comparison across suitable bases are lenient (masks over min
|
|
|
+ 583 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
+ 584 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 585 blo, bhi, bspan: INTEGER;
|
|
|
+ 586 bcls: INTEGER; .)
|
|
|
+ 587 = "SET" "OF" Type<base, FALSE>
|
|
|
+ 588 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 589 t := SymTab.InvalidType
|
|
|
+ 590 ELSE bcls :=
|
|
|
+ 591 SymTab.ClassOf(base);
|
|
|
+ 592 IF bcls = SymTab.ClBool THEN
|
|
|
+ 593 blo := 0; bspan := 2
|
|
|
+ 594 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 595 blo := 0; bspan := 256
|
|
|
+ 596 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 597 blo := 0;
|
|
|
+ 598 bspan := VAL(INTEGER,
|
|
|
+ 599 SymTab.EnumCount(base))
|
|
|
+ 600 ELSIF SymTab.SubBounds(base,
|
|
|
+ 601 blo, bhi) THEN
|
|
|
+ 602 bspan := bhi - blo + 1
|
|
|
+ 603 ELSE bspan := 0 END;
|
|
|
+ 604 IF (bspan <= 0)
|
|
|
+ 605 OR (bspan > 65536) THEN
|
|
|
+ 606 SemError(230);
|
|
|
+ 607 t := SymTab.InvalidType
|
|
|
+ 608 ELSE t := SymTab.NewSet(base)
|
|
|
+ 609 END
|
|
|
+ 610 END; .) .
|
|
|
+ 611 (* Records: flat blobs; array fields are pointers to static
|
|
|
+ 612 descriptors (locked amendment), nested records inline. Field
|
|
|
+ 613 offsets static and declaration-ordered. *)
|
|
|
+ 614 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
+ 615 variant part is a `CASE ... END` item; because it starts with the
|
|
|
+ 616 CASE keyword it is unambiguously distinguishable from a field
|
|
|
+ 617 (which starts with an identifier). *)
|
|
|
+ 618 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 619 tagOk: BOOLEAN; .)
|
|
|
+ 620 = "RECORD" (. t := SymTab.NewRecord(); .)
|
|
|
+ 621 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
+ 622 "END" .
|
|
|
+ 623 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
+ 624 = RecField<rec>
|
|
|
+ 625 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 626 (* A variant part: CASE tag : Type OF variants. The layout overlays
|
|
|
+ 627 every branch from the tag slot (see SymTab.ComputeOffsets). *)
|
|
|
+ 628 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
+ 629 tagN: SymTab.Name; .)
|
|
|
+ 630 = "CASE" (. SymTab.ResetFields(rec); .)
|
|
|
+ 631 GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 632 tagN) THEN
|
|
|
+ 633 SemError(200) END; .)
|
|
|
+ 634 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
+ 635 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
+ 636 SemError(224)
|
|
|
+ 637 END;
|
|
|
+ 638 SymTab.FixPendingF(rec, tagT);
|
|
|
+ 639 SymTab.SetVariantTag(rec, tagN); .)
|
|
|
+ 640 "OF"
|
|
|
+ 641 RecFieldList<rec>
|
|
|
+ 642 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
+ 643 RecFieldList<rec> }
|
|
|
+ 644 "END" .
|
|
|
+ 645 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
+ 646 lv1, lv2: QbeGen.QVal; .)
|
|
|
+ 647 = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
|
|
|
+ 648 RecField<rec> { ";" [ RecField<rec> ] } .
|
|
|
+ 649 (* Variant case label: a constant (or a constant range). Values are
|
|
|
+ 650 not interpreted (the layout overlays regardless). *)
|
|
|
+ 651 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 652 (. VAR lname: SymTab.Name; .)
|
|
|
+ 653 = ( ident (. LexName(lname);
|
|
|
+ 654 QbeGen.CopyOp("0", q);
|
|
|
+ 655 t := SymTab.IntType(); .)
|
|
|
+ 656 | integer (. LexString(lname);
|
|
|
+ 657 QbeGen.CopyOp("0", q);
|
|
|
+ 658 t := SymTab.IntType(); .)
|
|
|
+ 659 | charConst (. LexString(lname);
|
|
|
+ 660 QbeGen.CopyOp("0", q);
|
|
|
+ 661 t := SymTab.CharType(); .) ) .
|
|
|
+ 662 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 663 t2: SymTab.TypeIndex; .)
|
|
|
+ 664 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
+ 665 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ 666 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 667 n) THEN
|
|
|
+ 668 SemError(200) END; .)
|
|
|
+ 669 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 670 n) THEN
|
|
|
+ 671 SemError(200) END; .) } .
|
|
|
+ 672 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
+ 673 k: INTEGER;
|
|
|
+ 674 dotted: BOOLEAN; .)
|
|
|
+ 675 = GetIdent<n> (. dotted := FALSE;
|
|
|
+ 676 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 677 k := -1;
|
|
|
+ 678 t := SymTab.ForwardType(n);
|
|
|
+ 679 IF t = SymTab.InvalidType THEN
|
|
|
+ 680 SemError(201)
|
|
|
+ 681 END
|
|
|
+ 682 ELSE k := SymTab.SymKind(n);
|
|
|
+ 683 IF (k = SymTab.KindType)
|
|
|
+ 684 OR (k = SymTab.KindPredef) THEN
|
|
|
+ 685 t := SymTab.SymType(n)
|
|
|
+ 686 ELSE t := SymTab.InvalidType
|
|
|
+ 687 END
|
|
|
+ 688 END; .)
|
|
|
+ 689 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
+ 690 IF k = SymTab.KindModule THEN
|
|
|
+ 691 t := SymTab.QualType(n, qid);
|
|
|
+ 692 IF t = SymTab.InvalidType THEN
|
|
|
+ 693 SemError(201)
|
|
|
+ 694 END
|
|
|
+ 695 ELSE SemError(221);
|
|
|
+ 696 t := SymTab.InvalidType
|
|
|
+ 697 END; .) ]
|
|
|
+ 698 (. IF NOT dotted THEN
|
|
|
+ 699 IF (k = SymTab.KindModule)
|
|
|
+ 700 OR ((k # SymTab.KindType)
|
|
|
+ 701 AND (k # SymTab.KindPredef)
|
|
|
+ 702 AND (k # SymTab.KindImport)
|
|
|
+ 703 AND (k # -1)) THEN
|
|
|
+ 704 SemError(221)
|
|
|
+ 705 END
|
|
|
+ 706 END; .) .
|
|
|
+ 707 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 708 qlo, qhi: QbeGen.QVal;
|
|
|
+ 709 lo, hi: INTEGER; .)
|
|
|
+ 710 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 711 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 712 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 713 t := SymTab.InvalidType
|
|
|
+ 714 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
+ 715 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
+ 716 SemError(230);
|
|
|
+ 717 t := SymTab.InvalidType
|
|
|
+ 718 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 719 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 720 OR (lo > hi) THEN
|
|
|
+ 721 SemError(230);
|
|
|
+ 722 t := SymTab.InvalidType
|
|
|
+ 723 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ 724 END; .)
|
|
|
+ 725 "]" .
|
|
|
+ 726 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 727 ord: INTEGER;
|
|
|
+ 728 qv: QbeGen.QVal; .)
|
|
|
+ 729 = "(" (. t := SymTab.NewEnum();
|
|
|
+ 730 ord := 0; .)
|
|
|
+ 731 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 732 SymTab.KindConst) THEN
|
|
|
+ 733 SemError(200) END;
|
|
|
+ 734 SymTab.SetSymType(n, t);
|
|
|
+ 735 QbeGen.IntStr(ord, qv);
|
|
|
+ 736 SymTab.SetSymVal(n, qv);
|
|
|
+ 737 INC(ord); .)
|
|
|
+ 738 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 739 SymTab.KindConst) THEN
|
|
|
+ 740 SemError(200) END;
|
|
|
+ 741 SymTab.SetSymType(n, t);
|
|
|
+ 742 QbeGen.IntStr(ord, qv);
|
|
|
+ 743 SymTab.SetSymVal(n, qv);
|
|
|
+ 744 INC(ord); .) }
|
|
|
+ 745 ")" (. SymTab.SetEnumCount(t,
|
|
|
+ 746 VAL(CARDINAL, ord)); .) .
|
|
|
+ 747 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
+ 748 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
+ 749 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
+ 750 class/impl block. Methods end with ";" per the Table example
|
|
|
+ 751 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
+ 752 (* Single CLASS item in both loops: separating declaration from
|
|
|
+ 753 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ 754 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ 755 The second token decides after CLASS is consumed. A misplaced
|
|
|
+ 756 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
+ 757 whole unit ends 230 until lowering). *)
|
|
|
+ 758 ClassItem
|
|
|
+ 759 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ 760 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
+ 761 ct: SymTab.TypeIndex; .)
|
|
|
+ 762 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
+ 763 SymTab.KindType) THEN
|
|
|
+ 764 SemError(200) END;
|
|
|
+ 765 ct := SymTab.NewClass();
|
|
|
+ 766 SymTab.SetSymType(cn, ct);
|
|
|
+ 767 SymTab.PushClassScope(ct); .)
|
|
|
+ 768 [ Parents<ct> ]
|
|
|
+ 769 ";"
|
|
|
+ 770 { ClassField<ct> ";" }
|
|
|
+ 771 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 772 (. SymTab.CloseProc;
|
|
|
+ 773 QbeGen.AbortFunc; .) }
|
|
|
+ 774 "END"
|
|
|
+ 775 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 776 SemError(202) END;
|
|
|
+ 777 SymTab.LayoutClass(ct);
|
|
|
+ 778 SymTab.PopScope; .) .
|
|
|
+ 779 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ 780 = "(" Parent1<ct>
|
|
|
+ 781 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ 782 ")" .
|
|
|
+ 783 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ 784 pt: SymTab.TypeIndex; .)
|
|
|
+ 785 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
+ 786 SemError(201)
|
|
|
+ 787 ELSE pt := SymTab.SymType(p);
|
|
|
+ 788 IF SymTab.ClassOf(pt) #
|
|
|
+ 789 SymTab.ClClass THEN
|
|
|
+ 790 SemError(230)
|
|
|
+ 791 ELSE SymTab.SetParent(ct, pt)
|
|
|
+ 792 END
|
|
|
+ 793 END; .) .
|
|
|
+ 794 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ 795 t: SymTab.TypeIndex; .)
|
|
|
+ 796 = GetIdent<n>
|
|
|
+ 797 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
+ 798 SymTab.KindConst) THEN
|
|
|
+ 799 SemError(200) END;
|
|
|
+ 800 IF SymTab.Lookup(rhs) THEN
|
|
|
+ 801 SymTab.SetSymType(n,
|
|
|
+ 802 SymTab.SymType(rhs))
|
|
|
+ 803 END; .)
|
|
|
+ 804 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 805 n) THEN
|
|
|
+ 806 SemError(200) END; .)
|
|
|
+ 807 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 808 n) THEN
|
|
|
+ 809 SemError(200) END; .) }
|
|
|
+ 810 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t); .) ) .
|
|
|
+ 811 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
+ 812 (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ 813 = (. wantVirt := FALSE; .)
|
|
|
+ 814 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ 815 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
+ 816 SymTab.MarkVirtual END; .) .
|
|
|
+ 817 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ 818 ct: SymTab.TypeIndex; .)
|
|
|
+ 819 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
+ 820 SemError(201);
|
|
|
+ 821 ct := SymTab.InvalidType
|
|
|
+ 822 ELSE ct := SymTab.SymType(cn);
|
|
|
+ 823 IF SymTab.ClassOf(ct) #
|
|
|
+ 824 SymTab.ClClass THEN
|
|
|
+ 825 SemError(230);
|
|
|
+ 826 ct := SymTab.InvalidType
|
|
|
+ 827 END
|
|
|
+ 828 END;
|
|
|
+ 829 IF ct #
|
|
|
+ 830 SymTab.InvalidType THEN
|
|
|
+ 831 IF NOT SymTab.PushClassMembers(
|
|
|
+ 832 ct) THEN
|
|
|
+ 833 SemError(230) END;
|
|
|
+ 834 SymTab.PushImplClass(ct)
|
|
|
+ 835 END; .)
|
|
|
+ 836 ";" { MethodImpl<ct> ";" }
|
|
|
+ 837 [ "BEGIN" (. QbeGen.BeginInit(cn); .)
|
|
|
+ 838 [ StatSeq ] (. QbeGen.EndInit; .) ]
|
|
|
+ 839 "END"
|
|
|
+ 840 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 841 SemError(202) END;
|
|
|
+ 842 SymTab.PopImplClass;
|
|
|
+ 843 SymTab.PopScope; .) .
|
|
|
+ 844 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
+ 845 thisQ: QbeGen.QVal;
|
|
|
+ 846 methRes: SymTab.TypeIndex; .)
|
|
|
+ 847 = MethodHeading<pn, ct> ";"
|
|
|
+ 848 (. IF (ct #
|
|
|
+ 849 SymTab.InvalidType)
|
|
|
+ 850 AND NOT SymTab.MethodExists(ct,
|
|
|
+ 851 pn) THEN
|
|
|
+ 852 SemError(201) END; .)
|
|
|
+ 853 ( "FORWARD" (. SymTab.MarkFwd;
|
|
|
+ 854 QbeGen.AbortFunc;
|
|
|
+ 855 SymTab.CloseProc; .)
|
|
|
+ 856 | (. QbeGen.EndFuncHeader;
|
|
|
+ 857 (* bind the receiver: bare
|
|
|
+ 858 field names resolve
|
|
|
+ 859 against THIS *)
|
|
|
+ 860 QbeGen.ThisBase(thisQ);
|
|
|
+ 861 QbeGen.PushWith(thisQ); .)
|
|
|
+ 862 Block<pn> (. QbeGen.PopWith;
|
|
|
+ 863 methRes := SymTab.CurRes();
|
|
|
+ 864 SymTab.CloseProc;
|
|
|
+ 865 QbeGen.EndFunc(methRes); .) ) .
|
|
|
+ 866 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 867 = "CONST" (. astSeq := AST.NoNode;
|
|
|
+ 868 astTail := AST.NoNode; .)
|
|
|
+ 869 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 870 astSeq, astTail, astDecl); .) }
|
|
|
+ 871 (. astDecl := astSeq; .) .
|
|
|
+ 872 ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ 873 t: SymTab.TypeIndex;
|
|
|
+ 874 qv: QbeGen.QVal;
|
|
|
+ 875 cls: INTEGER;
|
|
|
+ 876 astNode: AST.Node; .)
|
|
|
+ 877 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 878 SymTab.KindConst) THEN
|
|
|
+ 879 SemError(200) END; .)
|
|
|
+ 880 "="
|
|
|
+ 881 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 882 AST.SetChild(astNode, 0,
|
|
|
+ 883 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 884 AST.SetChild(astNode, 1, astCur);
|
|
|
+ 885 AST.SetTy(astNode, t);
|
|
|
+ 886 astDecl := astNode;
|
|
|
+ 887 SymTab.SetSymType(n, t);
|
|
|
+ 888 cls := SymTab.ClassOf(t);
|
|
|
+ 889 IF (cls = SymTab.ClArray)
|
|
|
+ 890 OR (cls = SymTab.ClRecord)
|
|
|
+ 891 OR (cls = SymTab.ClClass)
|
|
|
+ 892 OR (cls = SymTab.ClStr)
|
|
|
+ 893 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 894 (* an aggregate/string
|
|
|
+ 895 constant: qv is its
|
|
|
+ 896 descriptor address; no
|
|
|
+ 897 scalar data *)
|
|
|
+ 898 SymTab.SetSymVal(n, qv)
|
|
|
+ 899 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
+ 900 SemError(230)
|
|
|
+ 901 ELSE
|
|
|
+ 902 SymTab.SetSymVal(n, qv);
|
|
|
+ 903 QbeGen.DeclConst(n, qv, t)
|
|
|
+ 904 END; .) .
|
|
|
+ 905 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 906 = "VAR" (. astSeq := AST.NoNode;
|
|
|
+ 907 astTail := AST.NoNode; .)
|
|
|
+ 908 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 909 astSeq, astTail, astDecl); .) }
|
|
|
+ 910 (. astDecl := astSeq; .) .
|
|
|
+ 911 VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ 912 t: SymTab.TypeIndex;
|
|
|
+ 913 i: CARDINAL;
|
|
|
+ 914 cls: INTEGER;
|
|
|
+ 915 astNode: AST.Node; .)
|
|
|
+ 916 = VarIdents ":"
|
|
|
+ 917 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 918 i := 0;
|
|
|
+ 919 WHILE i < SymTab.PendCount() DO
|
|
|
+ 920 SymTab.PendName(i, nm);
|
|
|
+ 921 AST.SetChild(astNode,
|
|
|
+ 922 AST.NChild(astNode),
|
|
|
+ 923 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
+ 924 INC(i)
|
|
|
+ 925 END;
|
|
|
+ 926 AST.SetTy(astNode, t);
|
|
|
+ 927 astDecl := astNode;
|
|
|
+ 928 cls := SymTab.ClassOf(t);
|
|
|
+ 929 IF (t # SymTab.InvalidType)
|
|
|
+ 930 AND NOT SymTab.IsUnresolved(t)
|
|
|
+ 931 AND (cls # SymTab.ClInt)
|
|
|
+ 932 AND (cls # SymTab.ClBool)
|
|
|
+ 933 AND (cls # SymTab.ClChar)
|
|
|
+ 934 AND (cls # SymTab.ClReal)
|
|
|
+ 935 AND (cls # SymTab.ClArray)
|
|
|
+ 936 AND (cls # SymTab.ClSet)
|
|
|
+ 937 AND (cls # SymTab.ClRecord)
|
|
|
+ 938 AND (cls # SymTab.ClPtr)
|
|
|
+ 939 AND (cls # SymTab.ClLong)
|
|
|
+ 940 AND (cls # SymTab.ClProc)
|
|
|
+ 941 AND (cls # SymTab.ClUChar)
|
|
|
+ 942 AND (cls # SymTab.ClUStr)
|
|
|
+ 943 AND (cls # SymTab.ClEnum)
|
|
|
+ 944 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 945 SemError(230) END;
|
|
|
+ 946 IF QbeGen.LocFull() THEN
|
|
|
+ 947 SemError(233) END;
|
|
|
+ 948 i := 0;
|
|
|
+ 949 IF SymTab.IsUnresolved(t)
|
|
|
+ 950 AND NOT SymTab.InProc() THEN
|
|
|
+ 951 (* a forward-typed global:
|
|
|
+ 952 defer emission until the
|
|
|
+ 953 TYPE block completes *)
|
|
|
+ 954 WHILE i < SymTab.PendCount() DO
|
|
|
+ 955 SymTab.PendName(i, nm);
|
|
|
+ 956 IF nPendVar <=
|
|
|
+ 957 HIGH(pendVarName) THEN
|
|
|
+ 958 pendVarName[nPendVar] := nm;
|
|
|
+ 959 pendVarT[nPendVar] := t;
|
|
|
+ 960 INC(nPendVar)
|
|
|
+ 961 END;
|
|
|
+ 962 INC(i)
|
|
|
+ 963 END
|
|
|
+ 964 ELSE
|
|
|
+ 965 WHILE i < SymTab.PendCount() DO
|
|
|
+ 966 SymTab.PendName(i, nm);
|
|
|
+ 967 QbeGen.DeclVar(nm, t);
|
|
|
+ 968 INC(i)
|
|
|
+ 969 END
|
|
|
+ 970 END;
|
|
|
+ 971 (* a plain VAR list, not a
|
|
|
+ 972 heading: the signature
|
|
|
+ 973 result is discarded *)
|
|
|
+ 974 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 975 END; .) .
|
|
|
+ 976 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
+ 977 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 978 SymTab.KindVar) THEN
|
|
|
+ 979 SemError(200) END; .)
|
|
|
+ 980 { ","
|
|
|
+ 981 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 982 SymTab.KindVar) THEN
|
|
|
+ 983 SemError(200) END; .) } .
|
|
|
+ 984 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ 985 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 986 SemError(200) END; .)
|
|
|
+ 987 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 988 SemError(200) END; .) } .
|
|
|
+ 989 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
+ 990 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
+ 991 FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ 992 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
+ 993 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
+ 994 (. VAR t: SymTab.TypeIndex;
|
|
|
+ 995 mg: QbeGen.QVal; .)
|
|
|
+ 996 = "PROCEDURE"
|
|
|
+ 997 GetIdent<pn> (. IF methCls #
|
|
|
+ 998 SymTab.InvalidType THEN
|
|
|
+ 999 (* a method: resume the
|
|
|
+ 1000 declared symbol (reuse
|
|
|
+ 1001 its uid) *)
|
|
|
+ 1002 IF NOT SymTab.ResumeMethod(
|
|
|
+ 1003 methCls, pn) THEN
|
|
|
+ 1004 SemError(200) END
|
|
|
+ 1005 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
+ 1006 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
+ 1007 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
+ 1008 SemError(200) END
|
|
|
+ 1009 END
|
|
|
+ 1010 END;
|
|
|
+ 1011 IF methCls #
|
|
|
+ 1012 SymTab.InvalidType THEN
|
|
|
+ 1013 QbeGen.Mangled(pn,
|
|
|
+ 1014 SymTab.MethUid(), mg)
|
|
|
+ 1015 ELSE
|
|
|
+ 1016 QbeGen.Mangled(pn,
|
|
|
+ 1017 SymTab.ProcUid(pn), mg)
|
|
|
+ 1018 END;
|
|
|
+ 1019 QbeGen.BeginFunc(mg);
|
|
|
+ 1020 IF methCls #
|
|
|
+ 1021 SymTab.InvalidType THEN
|
|
|
+ 1022 (* hidden THIS receiver:
|
|
|
+ 1023 a VAR param of the
|
|
|
+ 1024 class type, pushed as
|
|
|
+ 1025 the WITH base *)
|
|
|
+ 1026 IF NOT SymTab.EnterThisParam(
|
|
|
+ 1027 methCls) THEN
|
|
|
+ 1028 SemError(200) END;
|
|
|
+ 1029 IF NOT QbeGen.FuncParam(
|
|
|
+ 1030 "THIS", TRUE,
|
|
|
+ 1031 methCls) THEN
|
|
|
+ 1032 SemError(233) END
|
|
|
+ 1033 END; .)
|
|
|
+ 1034 [ FormalParams ]
|
|
|
+ 1035 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
+ 1036 SemError(235) END;
|
|
|
+ 1037 QbeGen.SetFuncRes(t);
|
|
|
+ 1038 IF (t #
|
|
|
+ 1039 SymTab.InvalidType)
|
|
|
+ 1040 AND ((SymTab.ClassOf(t)
|
|
|
+ 1041 = SymTab.ClArray)
|
|
|
+ 1042 OR (SymTab.ClassOf(t)
|
|
|
+ 1043 = SymTab.ClRecord)
|
|
|
+ 1044 OR (SymTab.ClassOf(t)
|
|
|
+ 1045 = SymTab.ClSet)
|
|
|
+ 1046 OR (SymTab.ClassOf(t)
|
|
|
+ 1047 = SymTab.ClClass)) THEN
|
|
|
+ 1048 SemError(230) END; .) ] .
|
|
|
+ 1049 FormalParams
|
|
|
+ 1050 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ 1051 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1052 nm: SymTab.Name;
|
|
|
+ 1053 i: CARDINAL;
|
|
|
+ 1054 isV: BOOLEAN; .)
|
|
|
+ 1055 = (. isV := FALSE; .)
|
|
|
+ 1056 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1057 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
+ 1058 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1059 SymTab.PendName(i, nm);
|
|
|
+ 1060 (* value open arrays are
|
|
|
+ 1061 passed as descriptor
|
|
|
+ 1062 addresses (no copy):
|
|
|
+ 1063 same representation as
|
|
|
+ 1064 VAR formals *)
|
|
|
+ 1065 IF NOT QbeGen.FuncParam(nm,
|
|
|
+ 1066 isV
|
|
|
+ 1067 OR SymTab.IsOpenArray(t),
|
|
|
+ 1068 t) THEN
|
|
|
+ 1069 SemError(233) END;
|
|
|
+ 1070 INC(i)
|
|
|
+ 1071 END;
|
|
|
+ 1072 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1073 SemError(235) END; .) .
|
|
|
+ 1074 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
+ 1075 static link gives them their parent's frame. Methods keep
|
|
|
+ 1076 parse-now/230-later. *)
|
|
|
+ 1077 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
+ 1078 astNode: AST.Node; .)
|
|
|
+ 1079 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1080 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1081 AST.SetChild(astNode, 0,
|
|
|
+ 1082 AST.MakeLeaf(AST.NkIdent, pn)); .)
|
|
|
+ 1083 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
+ 1084 astDecl := astNode;
|
|
|
+ 1085 SymTab.MarkFwd;
|
|
|
+ 1086 SymTab.CloseProc;
|
|
|
+ 1087 QbeGen.AbortFunc; .)
|
|
|
+ 1088 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
+ 1089 astDecl := astNode;
|
|
|
+ 1090 SymTab.MarkExternal("");
|
|
|
+ 1091 SymTab.CloseProc;
|
|
|
+ 1092 QbeGen.AbortFunc; .)
|
|
|
+ 1093 | (. QbeGen.EndFuncHeader; .)
|
|
|
+ 1094 Block<pn> (. AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 1095 astDecl := astNode;
|
|
|
+ 1096 SymTab.CloseProc;
|
|
|
+ 1097 QbeGen.EndFunc(
|
|
|
+ 1098 SymTab.ProcRes(pn)); .) ) .
|
|
|
+ 1099 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
|
|
|
+ 1100 = DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 1101 [ "BEGIN"
|
|
|
+ 1102 [ StatSeq ] ]
|
|
|
+ 1103 "END"
|
|
|
+ 1104 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
+ 1105 SemError(202) END; .) .
|
|
|
+ 1106 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1107 = (. astSeq := AST.NoNode;
|
|
|
+ 1108 astTail := AST.NoNode; .)
|
|
|
+ 1109 Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 1110 astSeq, astTail, astStmt); .)
|
|
|
+ 1111 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 1112 astSeq, astTail, astStmt); .) ] }
|
|
|
+ 1113 (. astStmt := astSeq; .) .
|
|
|
+ 1114 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
+ 1115 are accepted: the statement after ';' is optional. *)
|
|
|
+ 1116 Statement (. VAR lx: QbeGen.QVal; .)
|
|
|
+ 1117 = (. astStmt := AST.NoNode; .)
|
|
|
+ 1118 ( AssOrCall
|
|
|
+ 1119 | IfStat
|
|
|
+ 1120 | WhileStat
|
|
|
+ 1121 | RepeatStat
|
|
|
+ 1122 | LoopStat
|
|
|
+ 1123 | ForStat
|
|
|
+ 1124 | CaseStat
|
|
|
+ 1125 | WithStat
|
|
|
+ 1126 | ReturnStat
|
|
|
+ 1127 | HaltStat
|
|
|
+ 1128 | NewStat
|
|
|
+ 1129 | DisposeStat
|
|
|
+ 1130 | IncDecStat
|
|
|
+ 1131 | InclExclStat
|
|
|
+ 1132 | "EXIT" (. IF QbeGen.TopLoop(lx) THEN
|
|
|
+ 1133 QbeGen.Jmp(lx)
|
|
|
+ 1134 ELSE SemError(230) END;
|
|
|
+ 1135 astStmt := AST.MakeNode(AST.NkExit); .) ) .
|
|
|
+ 1136 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
+ 1137 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
+ 1138 dk: INTEGER;
|
|
|
+ 1139 qd, qe: QbeGen.QVal;
|
|
|
+ 1140 qn: SymTab.Name;
|
|
|
+ 1141 sfx, isInc: BOOLEAN;
|
|
|
+ 1142 astNode, astD: AST.Node; .)
|
|
|
+ 1143 = ( "INCL" (. isInc := TRUE; .)
|
|
|
+ 1144 | "EXCL" (. isInc := FALSE; .) )
|
|
|
+ 1145 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
+ 1146 Expr<et2, qe> ")"
|
|
|
+ 1147 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1148 IF isInc THEN
|
|
|
+ 1149 AST.SetChild(astNode, 0,
|
|
|
+ 1150 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
+ 1151 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 1152 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
+ 1153 END;
|
|
|
+ 1154 IF astD # AST.NoNode THEN
|
|
|
+ 1155 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1156 IF astCur # AST.NoNode THEN
|
|
|
+ 1157 AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 1158 astStmt := astNode; .)
|
|
|
+ 1159 (. IF at = SymTab.InvalidType THEN
|
|
|
+ 1160 ELSIF SymTab.ClassOf(at) #
|
|
|
+ 1161 SymTab.ClSet THEN
|
|
|
+ 1162 SemError(222)
|
|
|
+ 1163 ELSE
|
|
|
+ 1164 IF isInc THEN
|
|
|
+ 1165 QbeGen.SetBit(qd, qe,
|
|
|
+ 1166 SymTab.SetBaseLo(at),
|
|
|
+ 1167 SymTab.SetCount(at))
|
|
|
+ 1168 ELSE
|
|
|
+ 1169 QbeGen.SetClearBit(qd, qe,
|
|
|
+ 1170 SymTab.SetBaseLo(at),
|
|
|
+ 1171 SymTab.SetCount(at))
|
|
|
+ 1172 END
|
|
|
+ 1173 END; .) .
|
|
|
+ 1174 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
+ 1175 integer designator. *)
|
|
|
+ 1176 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
+ 1177 dk: INTEGER;
|
|
|
+ 1178 qd, qv, qn2, qstep:
|
|
|
+ 1179 QbeGen.QVal;
|
|
|
+ 1180 qn: SymTab.Name;
|
|
|
+ 1181 sfx, isInc: BOOLEAN;
|
|
|
+ 1182 astNode, astD, astStep:
|
|
|
+ 1183 AST.Node; .)
|
|
|
+ 1184 = (. isInc := TRUE; .)
|
|
|
+ 1185 ( "INC" (. isInc := TRUE; .)
|
|
|
+ 1186 | "DEC" (. isInc := FALSE; .) )
|
|
|
+ 1187 "(" (. QbeGen.CopyOp("1", qstep); astStep := AST.NoNode; .)
|
|
|
+ 1188 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
+ 1189 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
+ 1190 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1191 IF isInc THEN
|
|
|
+ 1192 AST.SetChild(astNode, 0,
|
|
|
+ 1193 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
+ 1194 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 1195 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
+ 1196 END;
|
|
|
+ 1197 IF astD # AST.NoNode THEN
|
|
|
+ 1198 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1199 IF astStep # AST.NoNode THEN
|
|
|
+ 1200 AST.SetChild(astNode, 2, astStep) END;
|
|
|
+ 1201 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1202 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1203 AND (dk # SymTab.KindParam)
|
|
|
+ 1204 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1205 SemError(210)
|
|
|
+ 1206 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
+ 1207 SemError(211)
|
|
|
+ 1208 ELSE
|
|
|
+ 1209 IF sfx
|
|
|
+ 1210 OR (dk = SymTab.KindField) THEN
|
|
|
+ 1211 QbeGen.ElemLoad(qd, dt, qv)
|
|
|
+ 1212 ELSE QbeGen.LoadVar(qn,
|
|
|
+ 1213 FALSE, qv)
|
|
|
+ 1214 END;
|
|
|
+ 1215 QbeGen.NewTemp(qn2);
|
|
|
+ 1216 IF isInc THEN
|
|
|
+ 1217 QbeGen.Op3("add", qn2, qv,
|
|
|
+ 1218 qstep, FALSE)
|
|
|
+ 1219 ELSE QbeGen.Op3("sub", qn2, qv,
|
|
|
+ 1220 qstep, FALSE)
|
|
|
+ 1221 END;
|
|
|
+ 1222 IF sfx
|
|
|
+ 1223 OR (dk = SymTab.KindField) THEN
|
|
|
+ 1224 QbeGen.ElemStore(qd, qn2,
|
|
|
+ 1225 dt)
|
|
|
+ 1226 ELSE QbeGen.StoreVar(qn,
|
|
|
+ 1227 qn2, FALSE)
|
|
|
+ 1228 END
|
|
|
+ 1229 END; .) .
|
|
|
+ 1230 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
+ 1231 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
+ 1232 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
+ 1233 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1234 dk: INTEGER;
|
|
|
+ 1235 qd, qm: QbeGen.QVal;
|
|
|
+ 1236 qn: SymTab.Name;
|
|
|
+ 1237 sfx: BOOLEAN;
|
|
|
+ 1238 bt: SymTab.TypeIndex;
|
|
|
+ 1239 astNode, astD: AST.Node; .)
|
|
|
+ 1240 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 1241 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1242 AST.SetChild(astNode, 0,
|
|
|
+ 1243 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
+ 1244 IF astD # AST.NoNode THEN
|
|
|
+ 1245 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1246 astStmt := astNode; .)
|
|
|
+ 1247 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1248 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1249 AND (dk # SymTab.KindParam)
|
|
|
+ 1250 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1251 SemError(210)
|
|
|
+ 1252 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 1253 SymTab.ClPtr THEN
|
|
|
+ 1254 SemError(219)
|
|
|
+ 1255 ELSE bt := SymTab.PtrBase(dt);
|
|
|
+ 1256 IF bt #
|
|
|
+ 1257 SymTab.InvalidType THEN
|
|
|
+ 1258 QbeGen.NewHeap(bt, qm);
|
|
|
+ 1259 QbeGen.InitHeap(qm, bt);
|
|
|
+ 1260 IF sfx
|
|
|
+ 1261 OR (dk =
|
|
|
+ 1262 SymTab.KindField) THEN
|
|
|
+ 1263 QbeGen.ElemStore(qd, qm,
|
|
|
+ 1264 dt)
|
|
|
+ 1265 ELSE QbeGen.StorePtr(qn,
|
|
|
+ 1266 qm)
|
|
|
+ 1267 END
|
|
|
+ 1268 END
|
|
|
+ 1269 END; .) .
|
|
|
+ 1270 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1271 dk: INTEGER;
|
|
|
+ 1272 qd, qv: QbeGen.QVal;
|
|
|
+ 1273 qn: SymTab.Name;
|
|
|
+ 1274 sfx: BOOLEAN;
|
|
|
+ 1275 astNode, astD: AST.Node; .)
|
|
|
+ 1276 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 1277 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1278 AST.SetChild(astNode, 0,
|
|
|
+ 1279 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
+ 1280 IF astD # AST.NoNode THEN
|
|
|
+ 1281 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1282 astStmt := astNode; .)
|
|
|
+ 1283 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1284 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1285 AND (dk # SymTab.KindParam)
|
|
|
+ 1286 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1287 SemError(210)
|
|
|
+ 1288 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 1289 SymTab.ClPtr THEN
|
|
|
+ 1290 SemError(219)
|
|
|
+ 1291 ELSE
|
|
|
+ 1292 IF sfx
|
|
|
+ 1293 OR (dk =
|
|
|
+ 1294 SymTab.KindField) THEN
|
|
|
+ 1295 QbeGen.ElemLoad(qd, dt,
|
|
|
+ 1296 qv)
|
|
|
+ 1297 ELSE QbeGen.LoadPtr(qn, qv)
|
|
|
+ 1298 END;
|
|
|
+ 1299 QbeGen.FreeHeap(qv);
|
|
|
+ 1300 IF sfx
|
|
|
+ 1301 OR (dk =
|
|
|
+ 1302 SymTab.KindField) THEN
|
|
|
+ 1303 QbeGen.ElemStore(qd, "0",
|
|
|
+ 1304 dt)
|
|
|
+ 1305 ELSE QbeGen.StorePtr(qn,
|
|
|
+ 1306 "0")
|
|
|
+ 1307 END
|
|
|
1308 END; .) .
|
|
|
- 1309 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
- 1310 (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1311 dk: INTEGER;
|
|
|
- 1312 qd, qe: QbeGen.QVal;
|
|
|
- 1313 qn: SymTab.Name;
|
|
|
- 1314 sfx: BOOLEAN; .)
|
|
|
- 1315 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 1316 (. IF astCur # AST.NoNode THEN
|
|
|
- 1317 AST.SetChild(wnode,
|
|
|
- 1318 AST.NChild(wnode), astCur) END;
|
|
|
- 1319 IF dt = SymTab.InvalidType THEN
|
|
|
- 1320 ELSIF (SymTab.ClassOf(dt) #
|
|
|
- 1321 SymTab.ClRecord)
|
|
|
- 1322 AND (SymTab.ClassOf(dt) #
|
|
|
- 1323 SymTab.ClClass) THEN
|
|
|
- 1324 SemError(215)
|
|
|
- 1325 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
- 1326 QbeGen.PushWith(qd);
|
|
|
- 1327 INC(nW)
|
|
|
- 1328 END; .) .
|
|
|
- 1329 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
- 1330 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
- 1331 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
- 1332 dk: INTEGER;
|
|
|
- 1333 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
- 1334 qn: SymTab.Name;
|
|
|
- 1335 ct2, res0: SymTab.TypeIndex;
|
|
|
- 1336 q2, mg0: QbeGen.QVal;
|
|
|
- 1337 isR, conv, wconv: BOOLEAN;
|
|
|
- 1338 called, sfx: BOOLEAN;
|
|
|
- 1339 astLhs: AST.Node; .)
|
|
|
- 1340 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 1341 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
- 1342 ( ":="
|
|
|
- 1343 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 1344 AST.NkAssign, 0, astLhs, astCur);
|
|
|
- 1345 IF (dt # SymTab.InvalidType)
|
|
|
- 1346 AND (dk # SymTab.KindVar)
|
|
|
- 1347 AND (dk # SymTab.KindParam)
|
|
|
- 1348 AND (dk # SymTab.KindField) THEN
|
|
|
- 1349 SemError(210)
|
|
|
- 1350 ELSIF NOT SymTab.Assignable(et,
|
|
|
- 1351 dt) THEN
|
|
|
- 1352 SemError(210)
|
|
|
- 1353 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 1354 AND (SymTab.ClassOf(dt) =
|
|
|
- 1355 SymTab.ClClass) THEN
|
|
|
- 1356 SemError(230) END;
|
|
|
- 1357 isR := (dt #
|
|
|
- 1358 SymTab.InvalidType)
|
|
|
- 1359 AND (SymTab.ClassOf(dt)
|
|
|
- 1360 = SymTab.ClReal);
|
|
|
- 1361 conv := isR
|
|
|
- 1362 AND SymTab.IsIntFamily(et);
|
|
|
- 1363 wconv := (dt #
|
|
|
- 1364 SymTab.InvalidType)
|
|
|
- 1365 AND SymTab.IsLongFamily(dt)
|
|
|
- 1366 AND SymTab.IsIntFamily(et);
|
|
|
- 1367 IF ((dk = SymTab.KindVar)
|
|
|
- 1368 OR (dk = SymTab.KindParam)
|
|
|
- 1369 OR (dk = SymTab.KindField))
|
|
|
- 1370 AND (dt # SymTab.InvalidType)
|
|
|
- 1371 AND (et # SymTab.InvalidType)
|
|
|
- 1372 AND (SymTab.ClassOf(dt) #
|
|
|
- 1373 SymTab.ClClass) THEN
|
|
|
- 1374 IF sfx
|
|
|
- 1375 OR (dk = SymTab.KindField) THEN
|
|
|
- 1376 IF SymTab.ClassOf(dt) =
|
|
|
- 1377 SymTab.ClArray THEN
|
|
|
- 1378 IF (et # SymTab.InvalidType)
|
|
|
- 1379 AND (SymTab.ClassOf(et) = SymTab.ClUStr)
|
|
|
- 1380 AND SymTab.IsUCharArray(dt) THEN
|
|
|
- 1381 QbeGen.UAssign(qd, qe)
|
|
|
- 1382 ELSIF SymTab.StrCompat(dt,
|
|
|
- 1383 et) THEN
|
|
|
- 1384 QbeGen.StrAssign(qd,
|
|
|
- 1385 qe)
|
|
|
- 1386 ELSE
|
|
|
- 1387 QbeGen.CopyArray(qd,
|
|
|
- 1388 qe, dt)
|
|
|
- 1389 END
|
|
|
- 1390 ELSIF SymTab.ClassOf(dt) =
|
|
|
- 1391 SymTab.ClSet THEN
|
|
|
- 1392 QbeGen.CopySet(qd, qe,
|
|
|
- 1393 SymTab.SetWords(dt),
|
|
|
- 1394 SymTab.SetWords(et))
|
|
|
- 1395 ELSIF SymTab.ClassOf(dt) =
|
|
|
- 1396 SymTab.ClRecord THEN
|
|
|
- 1397 QbeGen.CopyRecord(qd, qe,
|
|
|
- 1398 dt)
|
|
|
- 1399 ELSIF SymTab.IsLongFamily(dt) THEN
|
|
|
- 1400 IF wconv THEN
|
|
|
- 1401 QbeGen.WidenLong(qe, ql);
|
|
|
- 1402 QbeGen.ElemStore(qd, ql,
|
|
|
- 1403 dt)
|
|
|
- 1404 ELSE QbeGen.ElemStore(qd, qe,
|
|
|
- 1405 dt)
|
|
|
- 1406 END
|
|
|
- 1407 ELSIF conv THEN
|
|
|
- 1408 QbeGen.ConvIR(qe, qt);
|
|
|
- 1409 QbeGen.ElemStore(qd, qt,
|
|
|
- 1410 dt)
|
|
|
- 1411 ELSE QbeGen.ElemStore(qd, qe,
|
|
|
- 1412 dt)
|
|
|
- 1413 END
|
|
|
- 1414 ELSIF SymTab.ClassOf(dt) =
|
|
|
- 1415 SymTab.ClArray THEN
|
|
|
- 1416 IF (et # SymTab.InvalidType)
|
|
|
- 1417 AND (SymTab.ClassOf(et) = SymTab.ClUStr)
|
|
|
- 1418 AND SymTab.IsUCharArray(dt) THEN
|
|
|
- 1419 QbeGen.UAssign(qd, qe)
|
|
|
- 1420 ELSIF SymTab.StrCompat(dt,
|
|
|
- 1421 et) THEN
|
|
|
- 1422 QbeGen.StrAssign(qd, qe)
|
|
|
- 1423 ELSE
|
|
|
- 1424 QbeGen.CopyArray(qd, qe,
|
|
|
- 1425 dt)
|
|
|
- 1426 END
|
|
|
- 1427 ELSIF SymTab.ClassOf(dt) =
|
|
|
- 1428 SymTab.ClSet THEN
|
|
|
- 1429 QbeGen.CopySet(qd, qe,
|
|
|
- 1430 SymTab.SetWords(dt),
|
|
|
- 1431 SymTab.SetWords(et))
|
|
|
- 1432 ELSIF SymTab.ClassOf(dt) =
|
|
|
- 1433 SymTab.ClRecord THEN
|
|
|
- 1434 QbeGen.CopyRecord(qd, qe, dt)
|
|
|
- 1435 ELSIF (SymTab.ClassOf(dt) =
|
|
|
- 1436 SymTab.ClPtr)
|
|
|
- 1437 OR (SymTab.ClassOf(dt) =
|
|
|
- 1438 SymTab.ClProc) THEN
|
|
|
- 1439 QbeGen.StorePtr(qn, qe)
|
|
|
- 1440 ELSIF SymTab.IsLongFamily(dt) THEN
|
|
|
- 1441 IF wconv THEN
|
|
|
- 1442 QbeGen.WidenLong(qe, ql);
|
|
|
- 1443 QbeGen.StoreLong(qn, ql)
|
|
|
- 1444 ELSE QbeGen.StoreLong(qn, qe)
|
|
|
- 1445 END
|
|
|
- 1446 ELSIF conv THEN
|
|
|
- 1447 QbeGen.ConvIR(qe, qt);
|
|
|
- 1448 QbeGen.StoreVar(qn, qt, TRUE)
|
|
|
- 1449 ELSE
|
|
|
- 1450 QbeGen.StoreVar(qn, qe, isR)
|
|
|
- 1451 END
|
|
|
- 1452 END; .)
|
|
|
- 1453 | ArgList<qn, dt, qd, FALSE, FALSE, methCls, ct2, q2, called>
|
|
|
- 1454 (. astStmt := AstCallNode(astLhs); .)
|
|
|
- 1455 | (* bare `P;`: proper parameterless
|
|
|
- 1456 procedure call; anything else
|
|
|
- 1457 here is 233 (was a bare syntax
|
|
|
- 1458 error before 4.2) *)
|
|
|
- 1459 (. astStmt := AstCallNode(astLhs);
|
|
|
- 1460 IF (dk = SymTab.KindProc)
|
|
|
- 1461 AND NOT sfx THEN
|
|
|
- 1462 res0 := SymTab.ProcRes(qn);
|
|
|
- 1463 IF res0 #
|
|
|
- 1464 SymTab.InvalidType THEN
|
|
|
- 1465 SemError(233)
|
|
|
- 1466 ELSIF SymTab.ProcNPar(qn) #
|
|
|
- 1467 0 THEN
|
|
|
- 1468 SemError(233)
|
|
|
- 1469 ELSE QbeGen.Mangled(qn,
|
|
|
- 1470 SymTab.ProcUid(qn), mg0);
|
|
|
- 1471 QbeGen.CallBegin(mg0,
|
|
|
- 1472 res0,
|
|
|
- 1473 SymTab.ProcDepthOf(qn),
|
|
|
- 1474 SymTab.IsExternal(qn));
|
|
|
- 1475 QbeGen.CallEnd(FALSE, q2)
|
|
|
- 1476 END
|
|
|
- 1477 ELSE SemError(233)
|
|
|
- 1478 END; .) ) .
|
|
|
- 1479 (* Actual-parameter list shared by statement and expression calls.
|
|
|
- 1480 want selects CallEnd's result handling; t/q carry the call
|
|
|
- 1481 value (statement calls discard). Arity/type failures are 233;
|
|
|
- 1482 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
- 1483 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
- 1484 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
- 1485 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 1486 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
- 1487 vs: INTEGER;
|
|
|
- 1488 res: SymTab.TypeIndex;
|
|
|
- 1489 mg: QbeGen.QVal;
|
|
|
- 1490 ok, ind, isMeth, va: BOOLEAN; .)
|
|
|
- 1491 = "(" (. called := TRUE;
|
|
|
- 1492 ok := TRUE;
|
|
|
- 1493 ind := FALSE;
|
|
|
- 1494 isMeth := methCls #
|
|
|
- 1495 SymTab.InvalidType;
|
|
|
- 1496 IF isMeth THEN
|
|
|
- 1497 (* class method: the
|
|
|
- 1498 receiver is armed.
|
|
|
- 1499 Virtual -> dispatch
|
|
|
- 1500 through the vtable;
|
|
|
- 1501 otherwise a static
|
|
|
- 1502 call. *)
|
|
|
- 1503 res := SymTab.ClassMethodRes(
|
|
|
- 1504 methCls, pn);
|
|
|
- 1505 vs := SymTab.VirtSlot(
|
|
|
- 1506 methCls, pn);
|
|
|
- 1507 IF vs >= 0 THEN
|
|
|
- 1508 QbeGen.VirtCallBegin(
|
|
|
- 1509 callee, vs, res)
|
|
|
- 1510 ELSE
|
|
|
- 1511 QbeGen.Mangled(pn,
|
|
|
- 1512 SymTab.ClassMethodUid(
|
|
|
- 1513 methCls, pn), mg);
|
|
|
- 1514 QbeGen.CallBegin(mg, res, 0,
|
|
|
- 1515 FALSE)
|
|
|
- 1516 END
|
|
|
- 1517 ELSIF SymTab.SymKind(pn) =
|
|
|
- 1518 SymTab.KindProc THEN
|
|
|
- 1519 res := SymTab.ProcRes(pn);
|
|
|
- 1520 QbeGen.Mangled(pn,
|
|
|
- 1521 SymTab.ProcUid(pn), mg);
|
|
|
- 1522 QbeGen.CallBegin(mg, res,
|
|
|
- 1523 SymTab.ProcDepthOf(pn),
|
|
|
- 1524 SymTab.IsExternal(pn))
|
|
|
- 1525 ELSIF (pt # SymTab.InvalidType)
|
|
|
- 1526 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
- 1527 ind := TRUE;
|
|
|
- 1528 res :=
|
|
|
- 1529 SymTab.ProcTypeRes(pt);
|
|
|
- 1530 QbeGen.CallBeginInd(callee,
|
|
|
- 1531 res, FALSE)
|
|
|
- 1532 ELSE SemError(233);
|
|
|
- 1533 ok := FALSE;
|
|
|
- 1534 res := SymTab.InvalidType
|
|
|
- 1535 END;
|
|
|
- 1536 i := 0; .)
|
|
|
- 1537 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
- 1538 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
- 1539 ")" (. IF ok THEN
|
|
|
- 1540 IF isMeth THEN
|
|
|
- 1541 np := SymTab.ClassMethodNPar(
|
|
|
- 1542 methCls, pn)
|
|
|
- 1543 ELSIF ind THEN
|
|
|
- 1544 np := SymTab.ProcTypeNPar(pt)
|
|
|
- 1545 ELSE np := SymTab.ProcNPar(pn)
|
|
|
- 1546 END;
|
|
|
- 1547 va := (NOT isMeth) AND (NOT ind)
|
|
|
- 1548 AND (SymTab.SymKind(pn) =
|
|
|
- 1549 SymTab.KindProc)
|
|
|
- 1550 AND SymTab.Varargs(pn);
|
|
|
- 1551 IF (i # np) AND NOT va THEN
|
|
|
- 1552 SemError(233); ok := FALSE
|
|
|
- 1553 END
|
|
|
- 1554 END;
|
|
|
- 1555 IF NOT ok THEN
|
|
|
- 1556 t := SymTab.InvalidType;
|
|
|
- 1557 QbeGen.CopyOp("0", q)
|
|
|
- 1558 ELSIF want THEN
|
|
|
- 1559 IF res =
|
|
|
- 1560 SymTab.InvalidType THEN
|
|
|
- 1561 SemError(233);
|
|
|
- 1562 t := SymTab.InvalidType;
|
|
|
- 1563 QbeGen.CopyOp("0", q)
|
|
|
- 1564 ELSE t := res;
|
|
|
- 1565 QbeGen.CallEnd(TRUE, q)
|
|
|
- 1566 END
|
|
|
- 1567 ELSE
|
|
|
- 1568 IF res #
|
|
|
- 1569 SymTab.InvalidType THEN
|
|
|
- 1570 SemError(233)
|
|
|
- 1571 END;
|
|
|
+ 1309 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
+ 1310 address; field designators resolve through both stacks. *)
|
|
|
+ 1311 WithStat (. VAR nW: CARDINAL;
|
|
|
+ 1312 astNode: AST.Node; .)
|
|
|
+ 1313 = "WITH" (. nW := 0;
|
|
|
+ 1314 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
+ 1315 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
+ 1316 "DO" (. astStmt := AST.NoNode; .)
|
|
|
+ 1317 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
+ 1318 AST.NChild(astNode), astStmt);
|
|
|
+ 1319 astStmt := astNode;
|
|
|
+ 1320 WHILE nW > 0 DO
|
|
|
+ 1321 SymTab.PopScope;
|
|
|
+ 1322 QbeGen.PopWith;
|
|
|
+ 1323 DEC(nW)
|
|
|
+ 1324 END; .) .
|
|
|
+ 1325 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
+ 1326 (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1327 dk: INTEGER;
|
|
|
+ 1328 qd, qe: QbeGen.QVal;
|
|
|
+ 1329 qn: SymTab.Name;
|
|
|
+ 1330 sfx: BOOLEAN; .)
|
|
|
+ 1331 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 1332 (. IF astCur # AST.NoNode THEN
|
|
|
+ 1333 AST.SetChild(wnode,
|
|
|
+ 1334 AST.NChild(wnode), astCur) END;
|
|
|
+ 1335 IF dt = SymTab.InvalidType THEN
|
|
|
+ 1336 ELSIF (SymTab.ClassOf(dt) #
|
|
|
+ 1337 SymTab.ClRecord)
|
|
|
+ 1338 AND (SymTab.ClassOf(dt) #
|
|
|
+ 1339 SymTab.ClClass) THEN
|
|
|
+ 1340 SemError(215)
|
|
|
+ 1341 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
+ 1342 QbeGen.PushWith(qd);
|
|
|
+ 1343 INC(nW)
|
|
|
+ 1344 END; .) .
|
|
|
+ 1345 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
+ 1346 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
+ 1347 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ 1348 dk: INTEGER;
|
|
|
+ 1349 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
+ 1350 qn: SymTab.Name;
|
|
|
+ 1351 ct2, res0: SymTab.TypeIndex;
|
|
|
+ 1352 q2, mg0: QbeGen.QVal;
|
|
|
+ 1353 isR, conv, wconv: BOOLEAN;
|
|
|
+ 1354 called, sfx: BOOLEAN;
|
|
|
+ 1355 astLhs: AST.Node; .)
|
|
|
+ 1356 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 1357 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
+ 1358 ( ":="
|
|
|
+ 1359 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 1360 AST.NkAssign, 0, astLhs, astCur);
|
|
|
+ 1361 IF (dt # SymTab.InvalidType)
|
|
|
+ 1362 AND (dk # SymTab.KindVar)
|
|
|
+ 1363 AND (dk # SymTab.KindParam)
|
|
|
+ 1364 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1365 SemError(210)
|
|
|
+ 1366 ELSIF NOT SymTab.Assignable(et,
|
|
|
+ 1367 dt) THEN
|
|
|
+ 1368 SemError(210)
|
|
|
+ 1369 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 1370 AND (SymTab.ClassOf(dt) =
|
|
|
+ 1371 SymTab.ClClass) THEN
|
|
|
+ 1372 SemError(230) END;
|
|
|
+ 1373 isR := (dt #
|
|
|
+ 1374 SymTab.InvalidType)
|
|
|
+ 1375 AND (SymTab.ClassOf(dt)
|
|
|
+ 1376 = SymTab.ClReal);
|
|
|
+ 1377 conv := isR
|
|
|
+ 1378 AND SymTab.IsIntFamily(et);
|
|
|
+ 1379 wconv := (dt #
|
|
|
+ 1380 SymTab.InvalidType)
|
|
|
+ 1381 AND SymTab.IsLongFamily(dt)
|
|
|
+ 1382 AND SymTab.IsIntFamily(et);
|
|
|
+ 1383 IF ((dk = SymTab.KindVar)
|
|
|
+ 1384 OR (dk = SymTab.KindParam)
|
|
|
+ 1385 OR (dk = SymTab.KindField))
|
|
|
+ 1386 AND (dt # SymTab.InvalidType)
|
|
|
+ 1387 AND (et # SymTab.InvalidType)
|
|
|
+ 1388 AND (SymTab.ClassOf(dt) #
|
|
|
+ 1389 SymTab.ClClass) THEN
|
|
|
+ 1390 IF sfx
|
|
|
+ 1391 OR (dk = SymTab.KindField) THEN
|
|
|
+ 1392 IF SymTab.ClassOf(dt) =
|
|
|
+ 1393 SymTab.ClArray THEN
|
|
|
+ 1394 IF (et # SymTab.InvalidType)
|
|
|
+ 1395 AND (SymTab.ClassOf(et) = SymTab.ClUStr)
|
|
|
+ 1396 AND SymTab.IsUCharArray(dt) THEN
|
|
|
+ 1397 QbeGen.UAssign(qd, qe)
|
|
|
+ 1398 ELSIF SymTab.StrCompat(dt,
|
|
|
+ 1399 et) THEN
|
|
|
+ 1400 QbeGen.StrAssign(qd,
|
|
|
+ 1401 qe)
|
|
|
+ 1402 ELSE
|
|
|
+ 1403 QbeGen.CopyArray(qd,
|
|
|
+ 1404 qe, dt)
|
|
|
+ 1405 END
|
|
|
+ 1406 ELSIF SymTab.ClassOf(dt) =
|
|
|
+ 1407 SymTab.ClSet THEN
|
|
|
+ 1408 QbeGen.CopySet(qd, qe,
|
|
|
+ 1409 SymTab.SetWords(dt),
|
|
|
+ 1410 SymTab.SetWords(et))
|
|
|
+ 1411 ELSIF SymTab.ClassOf(dt) =
|
|
|
+ 1412 SymTab.ClRecord THEN
|
|
|
+ 1413 QbeGen.CopyRecord(qd, qe,
|
|
|
+ 1414 dt)
|
|
|
+ 1415 ELSIF SymTab.IsLongFamily(dt) THEN
|
|
|
+ 1416 IF wconv THEN
|
|
|
+ 1417 QbeGen.WidenLong(qe, ql);
|
|
|
+ 1418 QbeGen.ElemStore(qd, ql,
|
|
|
+ 1419 dt)
|
|
|
+ 1420 ELSE QbeGen.ElemStore(qd, qe,
|
|
|
+ 1421 dt)
|
|
|
+ 1422 END
|
|
|
+ 1423 ELSIF conv THEN
|
|
|
+ 1424 QbeGen.ConvIR(qe, qt);
|
|
|
+ 1425 QbeGen.ElemStore(qd, qt,
|
|
|
+ 1426 dt)
|
|
|
+ 1427 ELSE QbeGen.ElemStore(qd, qe,
|
|
|
+ 1428 dt)
|
|
|
+ 1429 END
|
|
|
+ 1430 ELSIF SymTab.ClassOf(dt) =
|
|
|
+ 1431 SymTab.ClArray THEN
|
|
|
+ 1432 IF (et # SymTab.InvalidType)
|
|
|
+ 1433 AND (SymTab.ClassOf(et) = SymTab.ClUStr)
|
|
|
+ 1434 AND SymTab.IsUCharArray(dt) THEN
|
|
|
+ 1435 QbeGen.UAssign(qd, qe)
|
|
|
+ 1436 ELSIF SymTab.StrCompat(dt,
|
|
|
+ 1437 et) THEN
|
|
|
+ 1438 QbeGen.StrAssign(qd, qe)
|
|
|
+ 1439 ELSE
|
|
|
+ 1440 QbeGen.CopyArray(qd, qe,
|
|
|
+ 1441 dt)
|
|
|
+ 1442 END
|
|
|
+ 1443 ELSIF SymTab.ClassOf(dt) =
|
|
|
+ 1444 SymTab.ClSet THEN
|
|
|
+ 1445 QbeGen.CopySet(qd, qe,
|
|
|
+ 1446 SymTab.SetWords(dt),
|
|
|
+ 1447 SymTab.SetWords(et))
|
|
|
+ 1448 ELSIF SymTab.ClassOf(dt) =
|
|
|
+ 1449 SymTab.ClRecord THEN
|
|
|
+ 1450 QbeGen.CopyRecord(qd, qe, dt)
|
|
|
+ 1451 ELSIF (SymTab.ClassOf(dt) =
|
|
|
+ 1452 SymTab.ClPtr)
|
|
|
+ 1453 OR (SymTab.ClassOf(dt) =
|
|
|
+ 1454 SymTab.ClProc) THEN
|
|
|
+ 1455 QbeGen.StorePtr(qn, qe)
|
|
|
+ 1456 ELSIF SymTab.IsLongFamily(dt) THEN
|
|
|
+ 1457 IF wconv THEN
|
|
|
+ 1458 QbeGen.WidenLong(qe, ql);
|
|
|
+ 1459 QbeGen.StoreLong(qn, ql)
|
|
|
+ 1460 ELSE QbeGen.StoreLong(qn, qe)
|
|
|
+ 1461 END
|
|
|
+ 1462 ELSIF conv THEN
|
|
|
+ 1463 QbeGen.ConvIR(qe, qt);
|
|
|
+ 1464 QbeGen.StoreVar(qn, qt, TRUE)
|
|
|
+ 1465 ELSE
|
|
|
+ 1466 QbeGen.StoreVar(qn, qe, isR)
|
|
|
+ 1467 END
|
|
|
+ 1468 END; .)
|
|
|
+ 1469 | ArgList<qn, dt, qd, FALSE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 1470 (. astStmt := AstCallNode(astLhs); .)
|
|
|
+ 1471 | (* bare `P;`: proper parameterless
|
|
|
+ 1472 procedure call; anything else
|
|
|
+ 1473 here is 233 (was a bare syntax
|
|
|
+ 1474 error before 4.2) *)
|
|
|
+ 1475 (. astStmt := AstCallNode(astLhs);
|
|
|
+ 1476 IF (dk = SymTab.KindProc)
|
|
|
+ 1477 AND NOT sfx THEN
|
|
|
+ 1478 res0 := SymTab.ProcRes(qn);
|
|
|
+ 1479 IF res0 #
|
|
|
+ 1480 SymTab.InvalidType THEN
|
|
|
+ 1481 SemError(233)
|
|
|
+ 1482 ELSIF SymTab.ProcNPar(qn) #
|
|
|
+ 1483 0 THEN
|
|
|
+ 1484 SemError(233)
|
|
|
+ 1485 ELSE QbeGen.Mangled(qn,
|
|
|
+ 1486 SymTab.ProcUid(qn), mg0);
|
|
|
+ 1487 QbeGen.CallBegin(mg0,
|
|
|
+ 1488 res0,
|
|
|
+ 1489 SymTab.ProcDepthOf(qn),
|
|
|
+ 1490 SymTab.IsExternal(qn));
|
|
|
+ 1491 QbeGen.CallEnd(FALSE, q2)
|
|
|
+ 1492 END
|
|
|
+ 1493 ELSE SemError(233)
|
|
|
+ 1494 END; .) ) .
|
|
|
+ 1495 (* Actual-parameter list shared by statement and expression calls.
|
|
|
+ 1496 want selects CallEnd's result handling; t/q carry the call
|
|
|
+ 1497 value (statement calls discard). Arity/type failures are 233;
|
|
|
+ 1498 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
+ 1499 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
+ 1500 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
+ 1501 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 1502 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
+ 1503 vs: INTEGER;
|
|
|
+ 1504 res: SymTab.TypeIndex;
|
|
|
+ 1505 mg: QbeGen.QVal;
|
|
|
+ 1506 ok, ind, isMeth, va: BOOLEAN; .)
|
|
|
+ 1507 = "(" (. called := TRUE;
|
|
|
+ 1508 ok := TRUE;
|
|
|
+ 1509 ind := FALSE;
|
|
|
+ 1510 isMeth := methCls #
|
|
|
+ 1511 SymTab.InvalidType;
|
|
|
+ 1512 IF isMeth THEN
|
|
|
+ 1513 (* class method: the
|
|
|
+ 1514 receiver is armed.
|
|
|
+ 1515 Virtual -> dispatch
|
|
|
+ 1516 through the vtable;
|
|
|
+ 1517 otherwise a static
|
|
|
+ 1518 call. *)
|
|
|
+ 1519 res := SymTab.ClassMethodRes(
|
|
|
+ 1520 methCls, pn);
|
|
|
+ 1521 vs := SymTab.VirtSlot(
|
|
|
+ 1522 methCls, pn);
|
|
|
+ 1523 IF vs >= 0 THEN
|
|
|
+ 1524 QbeGen.VirtCallBegin(
|
|
|
+ 1525 callee, vs, res)
|
|
|
+ 1526 ELSE
|
|
|
+ 1527 QbeGen.Mangled(pn,
|
|
|
+ 1528 SymTab.ClassMethodUid(
|
|
|
+ 1529 methCls, pn), mg);
|
|
|
+ 1530 QbeGen.CallBegin(mg, res, 0,
|
|
|
+ 1531 FALSE)
|
|
|
+ 1532 END
|
|
|
+ 1533 ELSIF SymTab.SymKind(pn) =
|
|
|
+ 1534 SymTab.KindProc THEN
|
|
|
+ 1535 res := SymTab.ProcRes(pn);
|
|
|
+ 1536 QbeGen.Mangled(pn,
|
|
|
+ 1537 SymTab.ProcUid(pn), mg);
|
|
|
+ 1538 QbeGen.CallBegin(mg, res,
|
|
|
+ 1539 SymTab.ProcDepthOf(pn),
|
|
|
+ 1540 SymTab.IsExternal(pn))
|
|
|
+ 1541 ELSIF (pt # SymTab.InvalidType)
|
|
|
+ 1542 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
+ 1543 ind := TRUE;
|
|
|
+ 1544 res :=
|
|
|
+ 1545 SymTab.ProcTypeRes(pt);
|
|
|
+ 1546 QbeGen.CallBeginInd(callee,
|
|
|
+ 1547 res, FALSE)
|
|
|
+ 1548 ELSE SemError(233);
|
|
|
+ 1549 ok := FALSE;
|
|
|
+ 1550 res := SymTab.InvalidType
|
|
|
+ 1551 END;
|
|
|
+ 1552 i := 0; .)
|
|
|
+ 1553 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
+ 1554 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
+ 1555 ")" (. IF ok THEN
|
|
|
+ 1556 IF isMeth THEN
|
|
|
+ 1557 np := SymTab.ClassMethodNPar(
|
|
|
+ 1558 methCls, pn)
|
|
|
+ 1559 ELSIF ind THEN
|
|
|
+ 1560 np := SymTab.ProcTypeNPar(pt)
|
|
|
+ 1561 ELSE np := SymTab.ProcNPar(pn)
|
|
|
+ 1562 END;
|
|
|
+ 1563 va := (NOT isMeth) AND (NOT ind)
|
|
|
+ 1564 AND (SymTab.SymKind(pn) =
|
|
|
+ 1565 SymTab.KindProc)
|
|
|
+ 1566 AND SymTab.Varargs(pn);
|
|
|
+ 1567 IF (i # np) AND NOT va THEN
|
|
|
+ 1568 SemError(233); ok := FALSE
|
|
|
+ 1569 END
|
|
|
+ 1570 END;
|
|
|
+ 1571 IF NOT ok THEN
|
|
|
1572 t := SymTab.InvalidType;
|
|
|
- 1573 QbeGen.CopyOp("0", q);
|
|
|
- 1574 QbeGen.CallEnd(FALSE, q)
|
|
|
- 1575 END; .) .
|
|
|
- 1576 (* One actual: VAR formals take recorded designator addresses
|
|
|
- 1577 (233 otherwise); value formals take converted expressions. *)
|
|
|
- 1578 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
- 1579 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
- 1580 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
- 1581 qe, qa, qt: QbeGen.QVal;
|
|
|
- 1582 isV, conv, va: BOOLEAN;
|
|
|
- 1583 cl: CHAR; .)
|
|
|
- 1584 = Expr<at, qe> (. IF astNArgs <= HIGH(astArgs) THEN
|
|
|
- 1585 astArgs[astNArgs] := astCur;
|
|
|
- 1586 INC(astNArgs)
|
|
|
- 1587 END;
|
|
|
- 1588 va := (NOT ind)
|
|
|
- 1589 AND (methCls =
|
|
|
- 1590 SymTab.InvalidType)
|
|
|
- 1591 AND (SymTab.SymKind(pn) =
|
|
|
- 1592 SymTab.KindProc)
|
|
|
- 1593 AND SymTab.Varargs(pn);
|
|
|
- 1594 IF ind THEN
|
|
|
- 1595 ft :=
|
|
|
- 1596 SymTab.ProcTypeParamType(pt,
|
|
|
- 1597 i);
|
|
|
- 1598 isV :=
|
|
|
- 1599 SymTab.ProcTypeParamIsVar(pt,
|
|
|
- 1600 i)
|
|
|
- 1601 ELSIF methCls #
|
|
|
- 1602 SymTab.InvalidType THEN
|
|
|
- 1603 ft :=
|
|
|
- 1604 SymTab.ClassMethodParamType(
|
|
|
- 1605 methCls, pn, i);
|
|
|
- 1606 isV :=
|
|
|
- 1607 SymTab.ClassMethodParamIsVar(
|
|
|
- 1608 methCls, pn, i)
|
|
|
- 1609 ELSE
|
|
|
- 1610 ft := SymTab.ParamType(pn, i);
|
|
|
- 1611 isV := SymTab.ParamIsVar(pn, i)
|
|
|
- 1612 END;
|
|
|
- 1613 IF (at = SymTab.InvalidType) THEN
|
|
|
- 1614 ELSIF ft = SymTab.InvalidType THEN
|
|
|
- 1615 IF va THEN
|
|
|
- 1616 QbeGen.CArgAdd(qe, at, qa, cl)
|
|
|
- 1617 END
|
|
|
- 1618 ELSIF isV THEN
|
|
|
- 1619 IF (SymTab.ClassOf(at)
|
|
|
- 1620 = SymTab.ClChar)
|
|
|
- 1621 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 1622 AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
|
|
|
- 1623 = SymTab.ClChar)
|
|
|
- 1624 AND QbeGen.IsImm(qe) THEN
|
|
|
- 1625 (* 1-char string
|
|
|
- 1626 literal passed to
|
|
|
- 1627 a VAR ARRAY OF CHAR *)
|
|
|
- 1628 QbeGen.DeclCharStr(qe,
|
|
|
- 1629 qa);
|
|
|
- 1630 IF NOT QbeGen.CallArg(qa,
|
|
|
- 1631 "l") THEN
|
|
|
- 1632 SemError(233)
|
|
|
- 1633 END
|
|
|
- 1634 ELSIF NOT QbeGen.AddrOfVal(qe,
|
|
|
- 1635 qa) THEN
|
|
|
- 1636 SemError(233)
|
|
|
- 1637 ELSIF NOT SymTab.VarParamOk(at,
|
|
|
- 1638 ft) THEN
|
|
|
- 1639 SemError(233)
|
|
|
- 1640 ELSIF NOT QbeGen.CallArg(qa,
|
|
|
- 1641 "l") THEN
|
|
|
- 1642 SemError(233)
|
|
|
- 1643 END
|
|
|
- 1644 ELSE
|
|
|
- 1645 IF (SymTab.ClassOf(at)
|
|
|
- 1646 = SymTab.ClChar)
|
|
|
- 1647 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 1648 AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
|
|
|
- 1649 = SymTab.ClChar)
|
|
|
- 1650 AND QbeGen.IsImm(qe) THEN
|
|
|
- 1651 (* 1-char string
|
|
|
- 1652 literal passed to
|
|
|
- 1653 ARRAY OF CHAR *)
|
|
|
- 1654 QbeGen.DeclCharStr(qe,
|
|
|
- 1655 qa);
|
|
|
- 1656 IF NOT QbeGen.CallArg(qa,
|
|
|
- 1657 "l") THEN
|
|
|
- 1658 SemError(233)
|
|
|
- 1659 END
|
|
|
- 1660 ELSIF NOT SymTab.Assignable(at,
|
|
|
- 1661 ft) THEN
|
|
|
- 1662 SemError(233)
|
|
|
- 1663 ELSE
|
|
|
- 1664 conv := (SymTab.ClassOf(
|
|
|
- 1665 ft) = SymTab.ClReal)
|
|
|
- 1666 AND SymTab.IsIntFamily(at);
|
|
|
- 1667 IF conv THEN
|
|
|
- 1668 QbeGen.ConvIR(qe, qt);
|
|
|
- 1669 IF NOT QbeGen.CallArg(qt,
|
|
|
- 1670 "d") THEN
|
|
|
- 1671 SemError(233)
|
|
|
- 1672 END
|
|
|
- 1673 ELSIF NOT QbeGen.CallArg(qe,
|
|
|
- 1674 QbeGen.ArgClass(ft)) THEN
|
|
|
- 1675 SemError(233)
|
|
|
- 1676 END
|
|
|
- 1677 END
|
|
|
- 1678 END; .) .
|
|
|
- 1679 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1680 q, lThen, lElse, lEnd:
|
|
|
- 1681 QbeGen.QVal;
|
|
|
- 1682 hasElse: BOOLEAN;
|
|
|
- 1683 astCond, astIf, astLast,
|
|
|
- 1684 astNode: AST.Node; .)
|
|
|
- 1685 = "IF" (. hasElse := FALSE; .)
|
|
|
- 1686 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 1687 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 1688 SemError(214) END;
|
|
|
- 1689 QbeGen.NewLabel(lThen);
|
|
|
- 1690 QbeGen.NewLabel(lElse);
|
|
|
- 1691 QbeGen.NewLabel(lEnd);
|
|
|
- 1692 QbeGen.Jnz(q, lThen, lElse);
|
|
|
- 1693 QbeGen.EmitLabel(lThen); .)
|
|
|
- 1694 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 1695 AST.SetChild(astNode, 0, astCond);
|
|
|
- 1696 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1697 astIf := astNode;
|
|
|
- 1698 astLast := astNode;
|
|
|
- 1699 QbeGen.Jmp(lEnd); .)
|
|
|
- 1700 { "ELSIF" (. QbeGen.EmitLabel(lElse);
|
|
|
- 1701 QbeGen.NewLabel(lElse); .)
|
|
|
- 1702 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 1573 QbeGen.CopyOp("0", q)
|
|
|
+ 1574 ELSIF want THEN
|
|
|
+ 1575 IF res =
|
|
|
+ 1576 SymTab.InvalidType THEN
|
|
|
+ 1577 SemError(233);
|
|
|
+ 1578 t := SymTab.InvalidType;
|
|
|
+ 1579 QbeGen.CopyOp("0", q)
|
|
|
+ 1580 ELSE t := res;
|
|
|
+ 1581 QbeGen.CallEnd(TRUE, q)
|
|
|
+ 1582 END
|
|
|
+ 1583 ELSE
|
|
|
+ 1584 IF res #
|
|
|
+ 1585 SymTab.InvalidType THEN
|
|
|
+ 1586 SemError(233)
|
|
|
+ 1587 END;
|
|
|
+ 1588 t := SymTab.InvalidType;
|
|
|
+ 1589 QbeGen.CopyOp("0", q);
|
|
|
+ 1590 QbeGen.CallEnd(FALSE, q)
|
|
|
+ 1591 END; .) .
|
|
|
+ 1592 (* One actual: VAR formals take recorded designator addresses
|
|
|
+ 1593 (233 otherwise); value formals take converted expressions. *)
|
|
|
+ 1594 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
+ 1595 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
+ 1596 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
+ 1597 qe, qa, qt: QbeGen.QVal;
|
|
|
+ 1598 isV, conv, va: BOOLEAN;
|
|
|
+ 1599 cl: CHAR; .)
|
|
|
+ 1600 = Expr<at, qe> (. IF astNArgs <= HIGH(astArgs) THEN
|
|
|
+ 1601 astArgs[astNArgs] := astCur;
|
|
|
+ 1602 INC(astNArgs)
|
|
|
+ 1603 END;
|
|
|
+ 1604 va := (NOT ind)
|
|
|
+ 1605 AND (methCls =
|
|
|
+ 1606 SymTab.InvalidType)
|
|
|
+ 1607 AND (SymTab.SymKind(pn) =
|
|
|
+ 1608 SymTab.KindProc)
|
|
|
+ 1609 AND SymTab.Varargs(pn);
|
|
|
+ 1610 IF ind THEN
|
|
|
+ 1611 ft :=
|
|
|
+ 1612 SymTab.ProcTypeParamType(pt,
|
|
|
+ 1613 i);
|
|
|
+ 1614 isV :=
|
|
|
+ 1615 SymTab.ProcTypeParamIsVar(pt,
|
|
|
+ 1616 i)
|
|
|
+ 1617 ELSIF methCls #
|
|
|
+ 1618 SymTab.InvalidType THEN
|
|
|
+ 1619 ft :=
|
|
|
+ 1620 SymTab.ClassMethodParamType(
|
|
|
+ 1621 methCls, pn, i);
|
|
|
+ 1622 isV :=
|
|
|
+ 1623 SymTab.ClassMethodParamIsVar(
|
|
|
+ 1624 methCls, pn, i)
|
|
|
+ 1625 ELSE
|
|
|
+ 1626 ft := SymTab.ParamType(pn, i);
|
|
|
+ 1627 isV := SymTab.ParamIsVar(pn, i)
|
|
|
+ 1628 END;
|
|
|
+ 1629 IF (at = SymTab.InvalidType) THEN
|
|
|
+ 1630 ELSIF ft = SymTab.InvalidType THEN
|
|
|
+ 1631 IF va THEN
|
|
|
+ 1632 QbeGen.CArgAdd(qe, at, qa, cl)
|
|
|
+ 1633 END
|
|
|
+ 1634 ELSIF isV THEN
|
|
|
+ 1635 IF (SymTab.ClassOf(at)
|
|
|
+ 1636 = SymTab.ClChar)
|
|
|
+ 1637 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 1638 AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
|
|
|
+ 1639 = SymTab.ClChar)
|
|
|
+ 1640 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 1641 (* 1-char string
|
|
|
+ 1642 literal passed to
|
|
|
+ 1643 a VAR ARRAY OF CHAR *)
|
|
|
+ 1644 QbeGen.DeclCharStr(qe,
|
|
|
+ 1645 qa);
|
|
|
+ 1646 IF NOT QbeGen.CallArg(qa,
|
|
|
+ 1647 "l") THEN
|
|
|
+ 1648 SemError(233)
|
|
|
+ 1649 END
|
|
|
+ 1650 ELSIF NOT QbeGen.AddrOfVal(qe,
|
|
|
+ 1651 qa) THEN
|
|
|
+ 1652 SemError(233)
|
|
|
+ 1653 ELSIF NOT SymTab.VarParamOk(at,
|
|
|
+ 1654 ft) THEN
|
|
|
+ 1655 SemError(233)
|
|
|
+ 1656 ELSIF NOT QbeGen.CallArg(qa,
|
|
|
+ 1657 "l") THEN
|
|
|
+ 1658 SemError(233)
|
|
|
+ 1659 END
|
|
|
+ 1660 ELSE
|
|
|
+ 1661 IF (SymTab.ClassOf(at)
|
|
|
+ 1662 = SymTab.ClChar)
|
|
|
+ 1663 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 1664 AND (SymTab.ClassOf(SymTab.ArrayElem(ft))
|
|
|
+ 1665 = SymTab.ClChar)
|
|
|
+ 1666 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 1667 (* 1-char string
|
|
|
+ 1668 literal passed to
|
|
|
+ 1669 ARRAY OF CHAR *)
|
|
|
+ 1670 QbeGen.DeclCharStr(qe,
|
|
|
+ 1671 qa);
|
|
|
+ 1672 IF NOT QbeGen.CallArg(qa,
|
|
|
+ 1673 "l") THEN
|
|
|
+ 1674 SemError(233)
|
|
|
+ 1675 END
|
|
|
+ 1676 ELSIF NOT SymTab.Assignable(at,
|
|
|
+ 1677 ft) THEN
|
|
|
+ 1678 SemError(233)
|
|
|
+ 1679 ELSE
|
|
|
+ 1680 conv := (SymTab.ClassOf(
|
|
|
+ 1681 ft) = SymTab.ClReal)
|
|
|
+ 1682 AND SymTab.IsIntFamily(at);
|
|
|
+ 1683 IF conv THEN
|
|
|
+ 1684 QbeGen.ConvIR(qe, qt);
|
|
|
+ 1685 IF NOT QbeGen.CallArg(qt,
|
|
|
+ 1686 "d") THEN
|
|
|
+ 1687 SemError(233)
|
|
|
+ 1688 END
|
|
|
+ 1689 ELSIF NOT QbeGen.CallArg(qe,
|
|
|
+ 1690 QbeGen.ArgClass(ft)) THEN
|
|
|
+ 1691 SemError(233)
|
|
|
+ 1692 END
|
|
|
+ 1693 END
|
|
|
+ 1694 END; .) .
|
|
|
+ 1695 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1696 q, lThen, lElse, lEnd:
|
|
|
+ 1697 QbeGen.QVal;
|
|
|
+ 1698 hasElse: BOOLEAN;
|
|
|
+ 1699 astCond, astIf, astLast,
|
|
|
+ 1700 astNode: AST.Node; .)
|
|
|
+ 1701 = "IF" (. hasElse := FALSE; .)
|
|
|
+ 1702 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
1703 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
1704 SemError(214) END;
|
|
|
1705 QbeGen.NewLabel(lThen);
|
|
|
- 1706 QbeGen.Jnz(q, lThen, lElse);
|
|
|
- 1707 QbeGen.EmitLabel(lThen); .)
|
|
|
- 1708 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 1709 AST.SetChild(astNode, 0, astCond);
|
|
|
- 1710 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1711 AST.SetChild(astLast, 2, astNode);
|
|
|
- 1712 astLast := astNode;
|
|
|
- 1713 QbeGen.Jmp(lEnd); .) }
|
|
|
- 1714 [ "ELSE" (. QbeGen.EmitLabel(lElse);
|
|
|
- 1715 hasElse := TRUE;
|
|
|
- 1716 astStmt := AST.NoNode; .)
|
|
|
- 1717 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
- 1718 "END" (. astStmt := astIf;
|
|
|
- 1719 IF hasElse THEN
|
|
|
- 1720 QbeGen.EmitLabel(lEnd)
|
|
|
- 1721 ELSE QbeGen.EmitLabel(lElse);
|
|
|
- 1722 QbeGen.EmitLabel(lEnd)
|
|
|
- 1723 END; .) .
|
|
|
- 1724 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1725 q, lTop, lBody, lEnd:
|
|
|
- 1726 QbeGen.QVal;
|
|
|
- 1727 astCond, astNode: AST.Node; .)
|
|
|
- 1728 = "WHILE" (. astStmt := AST.NoNode;
|
|
|
- 1729 QbeGen.NewLabel(lTop);
|
|
|
- 1730 QbeGen.NewLabel(lBody);
|
|
|
- 1731 QbeGen.NewLabel(lEnd);
|
|
|
- 1732 QbeGen.EmitLabel(lTop); .)
|
|
|
- 1733 Expr<t, q> (. astCond := astCur;
|
|
|
- 1734 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 1735 SemError(214) END;
|
|
|
- 1736 QbeGen.Jnz(q, lBody, lEnd);
|
|
|
- 1737 QbeGen.EmitLabel(lBody); .)
|
|
|
- 1738 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
- 1739 AST.SetChild(astNode, 0, astCond);
|
|
|
- 1740 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1741 astStmt := astNode;
|
|
|
- 1742 QbeGen.Jmp(lTop); .)
|
|
|
- 1743 "END" (. QbeGen.EmitLabel(lEnd); .) .
|
|
|
- 1744 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1745 q, lTop, lEnd: QbeGen.QVal;
|
|
|
- 1746 astCond, astBody, astNode:
|
|
|
- 1747 AST.Node; .)
|
|
|
- 1748 = "REPEAT" (. astStmt := AST.NoNode;
|
|
|
- 1749 QbeGen.NewLabel(lTop);
|
|
|
- 1750 QbeGen.NewLabel(lEnd);
|
|
|
- 1751 QbeGen.EmitLabel(lTop); .)
|
|
|
- 1752 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
- 1753 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
- 1754 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
- 1755 AST.SetChild(astNode, 0, astBody);
|
|
|
- 1756 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 1706 QbeGen.NewLabel(lElse);
|
|
|
+ 1707 QbeGen.NewLabel(lEnd);
|
|
|
+ 1708 QbeGen.Jnz(q, lThen, lElse);
|
|
|
+ 1709 QbeGen.EmitLabel(lThen); .)
|
|
|
+ 1710 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 1711 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 1712 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 1713 astIf := astNode;
|
|
|
+ 1714 astLast := astNode;
|
|
|
+ 1715 QbeGen.Jmp(lEnd); .)
|
|
|
+ 1716 { "ELSIF" (. QbeGen.EmitLabel(lElse);
|
|
|
+ 1717 QbeGen.NewLabel(lElse); .)
|
|
|
+ 1718 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 1719 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 1720 SemError(214) END;
|
|
|
+ 1721 QbeGen.NewLabel(lThen);
|
|
|
+ 1722 QbeGen.Jnz(q, lThen, lElse);
|
|
|
+ 1723 QbeGen.EmitLabel(lThen); .)
|
|
|
+ 1724 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 1725 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 1726 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 1727 AST.SetChild(astLast, 2, astNode);
|
|
|
+ 1728 astLast := astNode;
|
|
|
+ 1729 QbeGen.Jmp(lEnd); .) }
|
|
|
+ 1730 [ "ELSE" (. QbeGen.EmitLabel(lElse);
|
|
|
+ 1731 hasElse := TRUE;
|
|
|
+ 1732 astStmt := AST.NoNode; .)
|
|
|
+ 1733 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
+ 1734 "END" (. astStmt := astIf;
|
|
|
+ 1735 IF hasElse THEN
|
|
|
+ 1736 QbeGen.EmitLabel(lEnd)
|
|
|
+ 1737 ELSE QbeGen.EmitLabel(lElse);
|
|
|
+ 1738 QbeGen.EmitLabel(lEnd)
|
|
|
+ 1739 END; .) .
|
|
|
+ 1740 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1741 q, lTop, lBody, lEnd:
|
|
|
+ 1742 QbeGen.QVal;
|
|
|
+ 1743 astCond, astNode: AST.Node; .)
|
|
|
+ 1744 = "WHILE" (. astStmt := AST.NoNode;
|
|
|
+ 1745 QbeGen.NewLabel(lTop);
|
|
|
+ 1746 QbeGen.NewLabel(lBody);
|
|
|
+ 1747 QbeGen.NewLabel(lEnd);
|
|
|
+ 1748 QbeGen.EmitLabel(lTop); .)
|
|
|
+ 1749 Expr<t, q> (. astCond := astCur;
|
|
|
+ 1750 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 1751 SemError(214) END;
|
|
|
+ 1752 QbeGen.Jnz(q, lBody, lEnd);
|
|
|
+ 1753 QbeGen.EmitLabel(lBody); .)
|
|
|
+ 1754 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
+ 1755 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 1756 AST.SetChild(astNode, 1, astStmt);
|
|
|
1757 astStmt := astNode;
|
|
|
- 1758 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 1759 SemError(214) END;
|
|
|
- 1760 QbeGen.Jnz(q, lEnd, lTop);
|
|
|
- 1761 QbeGen.EmitLabel(lEnd); .) .
|
|
|
- 1762 LoopStat (. VAR lTop, lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
- 1763 = "LOOP" (. QbeGen.NewLabel(lTop);
|
|
|
- 1764 astStmt := AST.NoNode;
|
|
|
- 1765 QbeGen.NewLabel(lEnd);
|
|
|
- 1766 QbeGen.PushLoop(lEnd);
|
|
|
+ 1758 QbeGen.Jmp(lTop); .)
|
|
|
+ 1759 "END" (. QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ 1760 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1761 q, lTop, lEnd: QbeGen.QVal;
|
|
|
+ 1762 astCond, astBody, astNode:
|
|
|
+ 1763 AST.Node; .)
|
|
|
+ 1764 = "REPEAT" (. astStmt := AST.NoNode;
|
|
|
+ 1765 QbeGen.NewLabel(lTop);
|
|
|
+ 1766 QbeGen.NewLabel(lEnd);
|
|
|
1767 QbeGen.EmitLabel(lTop); .)
|
|
|
- 1768 [ StatSeq ]
|
|
|
- 1769 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
- 1770 AST.SetChild(astNode, 0, astStmt);
|
|
|
- 1771 astStmt := astNode;
|
|
|
- 1772 QbeGen.Jmp(lTop);
|
|
|
- 1773 QbeGen.PopLoop;
|
|
|
- 1774 QbeGen.EmitLabel(lEnd); .) .
|
|
|
- 1775 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
- 1776 Runtime direction would need a compare-select; the literal
|
|
|
- 1777 sign picks cslew/csegew at "DO" time. *)
|
|
|
- 1778 ForStat (. VAR lv: SymTab.Name;
|
|
|
- 1779 tlo, thi, tby:
|
|
|
- 1780 SymTab.TypeIndex;
|
|
|
- 1781 qlo, qhi, qby, qt, qk, qb:
|
|
|
- 1782 QbeGen.QVal;
|
|
|
- 1783 lTop, lBody, lEnd:
|
|
|
- 1784 QbeGen.QVal;
|
|
|
- 1785 by: INTEGER;
|
|
|
- 1786 ok: BOOLEAN;
|
|
|
- 1787 astVar, astLo, astHi, astBy,
|
|
|
- 1788 astNode: AST.Node; .)
|
|
|
- 1789 = "FOR" (. by := 1; .)
|
|
|
- 1790 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
- 1791 astStmt := AST.NoNode;
|
|
|
- 1792 astBy := AST.NoNode;
|
|
|
- 1793 ok := SymTab.Lookup(lv);
|
|
|
- 1794 IF NOT ok THEN
|
|
|
- 1795 SemError(201)
|
|
|
- 1796 ELSIF (SymTab.SymKind(lv) #
|
|
|
- 1797 SymTab.KindVar)
|
|
|
- 1798 AND (SymTab.SymKind(lv) #
|
|
|
- 1799 SymTab.KindParam) THEN
|
|
|
- 1800 SemError(220); ok := FALSE
|
|
|
- 1801 ELSIF NOT SymTab.IsIntFamily(
|
|
|
- 1802 SymTab.SymType(lv)) THEN
|
|
|
- 1803 SemError(220); ok := FALSE
|
|
|
- 1804 END; .)
|
|
|
- 1805 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
- 1806 IF NOT SymTab.IsIntFamily(tlo) THEN
|
|
|
- 1807 SemError(220); ok := FALSE
|
|
|
- 1808 END; .)
|
|
|
- 1809 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
- 1810 IF NOT SymTab.IsIntFamily(thi) THEN
|
|
|
- 1811 SemError(220); ok := FALSE
|
|
|
- 1812 END; .)
|
|
|
- 1813 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
- 1814 IF (tby #
|
|
|
- 1815 SymTab.InvalidType)
|
|
|
- 1816 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
- 1817 SemError(220); ok := FALSE
|
|
|
- 1818 END;
|
|
|
- 1819 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
- 1820 SemError(230); by := 1
|
|
|
- 1821 ELSIF by = 0 THEN
|
|
|
- 1822 SemError(220); by := 1
|
|
|
- 1823 END; .) ]
|
|
|
- 1824 "DO" (. IF ok THEN
|
|
|
- 1825 QbeGen.StoreVar(lv, qlo,
|
|
|
- 1826 FALSE) END;
|
|
|
- 1827 QbeGen.NewLabel(lTop);
|
|
|
- 1828 QbeGen.NewLabel(lBody);
|
|
|
- 1829 QbeGen.NewLabel(lEnd);
|
|
|
- 1830 QbeGen.EmitLabel(lTop);
|
|
|
- 1831 QbeGen.LoadVar(lv, FALSE, qt);
|
|
|
- 1832 QbeGen.NewTemp(qk);
|
|
|
- 1833 IF by > 0 THEN
|
|
|
- 1834 QbeGen.Op3("cslew", qk,
|
|
|
- 1835 qt, qhi, FALSE)
|
|
|
- 1836 ELSE QbeGen.Op3("csgew", qk,
|
|
|
- 1837 qt, qhi, FALSE)
|
|
|
- 1838 END;
|
|
|
- 1839 QbeGen.Jnz(qk, lBody, lEnd);
|
|
|
- 1840 QbeGen.EmitLabel(lBody); .)
|
|
|
- 1841 [ StatSeq ]
|
|
|
- 1842 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
- 1843 AST.SetChild(astNode, 0, astVar);
|
|
|
- 1844 AST.SetChild(astNode, 1, astLo);
|
|
|
- 1845 AST.SetChild(astNode, 2, astHi);
|
|
|
- 1846 AST.SetChild(astNode, 3, astBy);
|
|
|
- 1847 AST.SetChild(astNode, 4, astStmt);
|
|
|
- 1848 astStmt := astNode;
|
|
|
- 1849 IF ok THEN
|
|
|
- 1850 QbeGen.LoadVar(lv, FALSE,
|
|
|
- 1851 qt);
|
|
|
- 1852 QbeGen.IntStr(by, qb);
|
|
|
- 1853 QbeGen.NewTemp(qk);
|
|
|
- 1854 QbeGen.Op3("add", qk,
|
|
|
- 1855 qt, qb, FALSE);
|
|
|
- 1856 QbeGen.StoreVar(lv, qk,
|
|
|
- 1857 FALSE) END;
|
|
|
- 1858 QbeGen.Jmp(lTop);
|
|
|
- 1859 QbeGen.EmitLabel(lEnd); .) .
|
|
|
- 1860 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
- 1861 qsel, lEnd: QbeGen.QVal;
|
|
|
- 1862 arm, astNode: AST.Node; .)
|
|
|
- 1863 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
- 1864 AST.SetChild(astNode, 0, astCur);
|
|
|
- 1865 QbeGen.NewLabel(lEnd); .)
|
|
|
- 1866 "OF" CaseAlt<tsel, qsel, lEnd, astNode>
|
|
|
- 1867 { "|" CaseAlt<tsel, qsel, lEnd, astNode> }
|
|
|
- 1868 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
- 1869 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 1870 AST.SetOp(arm, 1);
|
|
|
- 1871 AST.SetChild(arm, 0, astStmt);
|
|
|
- 1872 AST.SetChild(astNode,
|
|
|
- 1873 AST.NChild(astNode), arm); .) ]
|
|
|
- 1874 "END" (. astStmt := astNode;
|
|
|
+ 1768 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
+ 1769 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
+ 1770 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
+ 1771 AST.SetChild(astNode, 0, astBody);
|
|
|
+ 1772 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 1773 astStmt := astNode;
|
|
|
+ 1774 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 1775 SemError(214) END;
|
|
|
+ 1776 QbeGen.Jnz(q, lEnd, lTop);
|
|
|
+ 1777 QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ 1778 LoopStat (. VAR lTop, lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
+ 1779 = "LOOP" (. QbeGen.NewLabel(lTop);
|
|
|
+ 1780 astStmt := AST.NoNode;
|
|
|
+ 1781 QbeGen.NewLabel(lEnd);
|
|
|
+ 1782 QbeGen.PushLoop(lEnd);
|
|
|
+ 1783 QbeGen.EmitLabel(lTop); .)
|
|
|
+ 1784 [ StatSeq ]
|
|
|
+ 1785 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
+ 1786 AST.SetChild(astNode, 0, astStmt);
|
|
|
+ 1787 astStmt := astNode;
|
|
|
+ 1788 QbeGen.Jmp(lTop);
|
|
|
+ 1789 QbeGen.PopLoop;
|
|
|
+ 1790 QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ 1791 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ 1792 Runtime direction would need a compare-select; the literal
|
|
|
+ 1793 sign picks cslew/csegew at "DO" time. *)
|
|
|
+ 1794 ForStat (. VAR lv: SymTab.Name;
|
|
|
+ 1795 tlo, thi, tby:
|
|
|
+ 1796 SymTab.TypeIndex;
|
|
|
+ 1797 qlo, qhi, qby, qt, qk, qb:
|
|
|
+ 1798 QbeGen.QVal;
|
|
|
+ 1799 lTop, lBody, lEnd:
|
|
|
+ 1800 QbeGen.QVal;
|
|
|
+ 1801 by: INTEGER;
|
|
|
+ 1802 ok: BOOLEAN;
|
|
|
+ 1803 astVar, astLo, astHi, astBy,
|
|
|
+ 1804 astNode: AST.Node; .)
|
|
|
+ 1805 = "FOR" (. by := 1; .)
|
|
|
+ 1806 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
+ 1807 astStmt := AST.NoNode;
|
|
|
+ 1808 astBy := AST.NoNode;
|
|
|
+ 1809 ok := SymTab.Lookup(lv);
|
|
|
+ 1810 IF NOT ok THEN
|
|
|
+ 1811 SemError(201)
|
|
|
+ 1812 ELSIF (SymTab.SymKind(lv) #
|
|
|
+ 1813 SymTab.KindVar)
|
|
|
+ 1814 AND (SymTab.SymKind(lv) #
|
|
|
+ 1815 SymTab.KindParam) THEN
|
|
|
+ 1816 SemError(220); ok := FALSE
|
|
|
+ 1817 ELSIF NOT SymTab.IsIntFamily(
|
|
|
+ 1818 SymTab.SymType(lv)) THEN
|
|
|
+ 1819 SemError(220); ok := FALSE
|
|
|
+ 1820 END; .)
|
|
|
+ 1821 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
+ 1822 IF NOT SymTab.IsIntFamily(tlo) THEN
|
|
|
+ 1823 SemError(220); ok := FALSE
|
|
|
+ 1824 END; .)
|
|
|
+ 1825 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
+ 1826 IF NOT SymTab.IsIntFamily(thi) THEN
|
|
|
+ 1827 SemError(220); ok := FALSE
|
|
|
+ 1828 END; .)
|
|
|
+ 1829 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
+ 1830 IF (tby #
|
|
|
+ 1831 SymTab.InvalidType)
|
|
|
+ 1832 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
+ 1833 SemError(220); ok := FALSE
|
|
|
+ 1834 END;
|
|
|
+ 1835 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
+ 1836 SemError(230); by := 1
|
|
|
+ 1837 ELSIF by = 0 THEN
|
|
|
+ 1838 SemError(220); by := 1
|
|
|
+ 1839 END; .) ]
|
|
|
+ 1840 "DO" (. IF ok THEN
|
|
|
+ 1841 QbeGen.StoreVar(lv, qlo,
|
|
|
+ 1842 FALSE) END;
|
|
|
+ 1843 QbeGen.NewLabel(lTop);
|
|
|
+ 1844 QbeGen.NewLabel(lBody);
|
|
|
+ 1845 QbeGen.NewLabel(lEnd);
|
|
|
+ 1846 QbeGen.EmitLabel(lTop);
|
|
|
+ 1847 QbeGen.LoadVar(lv, FALSE, qt);
|
|
|
+ 1848 QbeGen.NewTemp(qk);
|
|
|
+ 1849 IF by > 0 THEN
|
|
|
+ 1850 QbeGen.Op3("cslew", qk,
|
|
|
+ 1851 qt, qhi, FALSE)
|
|
|
+ 1852 ELSE QbeGen.Op3("csgew", qk,
|
|
|
+ 1853 qt, qhi, FALSE)
|
|
|
+ 1854 END;
|
|
|
+ 1855 QbeGen.Jnz(qk, lBody, lEnd);
|
|
|
+ 1856 QbeGen.EmitLabel(lBody); .)
|
|
|
+ 1857 [ StatSeq ]
|
|
|
+ 1858 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
+ 1859 AST.SetChild(astNode, 0, astVar);
|
|
|
+ 1860 AST.SetChild(astNode, 1, astLo);
|
|
|
+ 1861 AST.SetChild(astNode, 2, astHi);
|
|
|
+ 1862 AST.SetChild(astNode, 3, astBy);
|
|
|
+ 1863 AST.SetChild(astNode, 4, astStmt);
|
|
|
+ 1864 astStmt := astNode;
|
|
|
+ 1865 IF ok THEN
|
|
|
+ 1866 QbeGen.LoadVar(lv, FALSE,
|
|
|
+ 1867 qt);
|
|
|
+ 1868 QbeGen.IntStr(by, qb);
|
|
|
+ 1869 QbeGen.NewTemp(qk);
|
|
|
+ 1870 QbeGen.Op3("add", qk,
|
|
|
+ 1871 qt, qb, FALSE);
|
|
|
+ 1872 QbeGen.StoreVar(lv, qk,
|
|
|
+ 1873 FALSE) END;
|
|
|
+ 1874 QbeGen.Jmp(lTop);
|
|
|
1875 QbeGen.EmitLabel(lEnd); .) .
|
|
|
- 1876 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
- 1877 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
- 1878 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
- 1879 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
- 1880 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 1881 lEnd: QbeGen.QVal; cnode: AST.Node>
|
|
|
- 1882 (. VAR lBody, lAfter: QbeGen.QVal;
|
|
|
- 1883 arm: AST.Node; .)
|
|
|
- 1884 = (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 1885 QbeGen.NewLabel(lBody);
|
|
|
- 1886 QbeGen.NewLabel(lAfter); .)
|
|
|
- 1887 CaseLabel<tsel, qsel, lBody, arm>
|
|
|
- 1888 { "," CaseLabel<tsel, qsel, lBody, arm> }
|
|
|
- 1889 ":" (. astStmt := AST.NoNode;
|
|
|
- 1890 QbeGen.Jmp(lAfter);
|
|
|
- 1891 QbeGen.EmitLabel(lBody); .)
|
|
|
- 1892 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
- 1893 astStmt);
|
|
|
- 1894 AST.SetChild(cnode,
|
|
|
- 1895 AST.NChild(cnode), arm);
|
|
|
- 1896 QbeGen.Jmp(lEnd);
|
|
|
- 1897 QbeGen.EmitLabel(lAfter); .) .
|
|
|
- 1898 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 1899 lBody: QbeGen.QVal; arm: AST.Node>
|
|
|
- 1900 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
- 1901 q2, q3, qc, qd, qe:
|
|
|
- 1902 QbeGen.QVal;
|
|
|
- 1903 astLab: AST.Node;
|
|
|
- 1904 lNext: QbeGen.QVal; .)
|
|
|
- 1905 = Expr<t2, q2> (. astLab := astCur;
|
|
|
- 1906 IF (t2 #
|
|
|
- 1907 SymTab.InvalidType)
|
|
|
- 1908 AND (tsel #
|
|
|
- 1909 SymTab.InvalidType)
|
|
|
- 1910 AND ((SymTab.ClassOf(t2) =
|
|
|
- 1911 SymTab.ClSet)
|
|
|
- 1912 OR (SymTab.ClassOf(tsel) =
|
|
|
- 1913 SymTab.ClSet)) THEN
|
|
|
- 1914 SemError(230)
|
|
|
- 1915 ELSIF (t2 #
|
|
|
- 1916 SymTab.InvalidType)
|
|
|
- 1917 AND (tsel #
|
|
|
- 1918 SymTab.InvalidType)
|
|
|
- 1919 AND NOT SymTab.EqCheck(t2,
|
|
|
- 1920 tsel) THEN
|
|
|
- 1921 SemError(213) END;
|
|
|
- 1922 IF NOT QbeGen.IsImm(q2) THEN
|
|
|
- 1923 SemError(230);
|
|
|
- 1924 QbeGen.CopyOp("0", q2)
|
|
|
- 1925 END;
|
|
|
- 1926 QbeGen.NewLabel(lNext);
|
|
|
- 1927 QbeGen.Cmp(SymTab.OpEq,
|
|
|
- 1928 qsel, q2, qc, FALSE);
|
|
|
- 1929 QbeGen.Jnz(qc, lBody, lNext);
|
|
|
- 1930 QbeGen.EmitLabel(lNext); .)
|
|
|
- 1931 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
- 1932 AST.NkSubrange, 0, astLab, astCur);
|
|
|
- 1933 IF (t3 #
|
|
|
- 1934 SymTab.InvalidType)
|
|
|
- 1935 AND (tsel #
|
|
|
- 1936 SymTab.InvalidType)
|
|
|
- 1937 AND NOT SymTab.EqCheck(t3,
|
|
|
- 1938 tsel) THEN
|
|
|
- 1939 SemError(213) END;
|
|
|
- 1940 IF NOT QbeGen.IsImm(q3) THEN
|
|
|
- 1941 SemError(230);
|
|
|
- 1942 QbeGen.CopyOp("0", q3)
|
|
|
- 1943 END;
|
|
|
- 1944 QbeGen.Cmp(SymTab.OpGe,
|
|
|
- 1945 qsel, q2, qc, FALSE);
|
|
|
- 1946 QbeGen.Cmp(SymTab.OpLe,
|
|
|
- 1947 qsel, q3, qd, FALSE);
|
|
|
- 1948 QbeGen.NewTemp(qe);
|
|
|
- 1949 QbeGen.Op3("and", qe, qc, qd,
|
|
|
- 1950 FALSE);
|
|
|
- 1951 QbeGen.NewLabel(lNext);
|
|
|
- 1952 QbeGen.Jnz(qe, lBody, lNext);
|
|
|
- 1953 QbeGen.EmitLabel(lNext); .) ]
|
|
|
- 1954 (. AST.SetChild(arm,
|
|
|
- 1955 AST.NChild(arm), astLab); .) .
|
|
|
- 1956 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1957 q, qt: QbeGen.QVal;
|
|
|
- 1958 res: SymTab.TypeIndex;
|
|
|
- 1959 hadE, conv: BOOLEAN;
|
|
|
- 1960 astVal, astNode: AST.Node; .)
|
|
|
- 1961 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
- 1962 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
- 1963 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
- 1964 IF hadE THEN
|
|
|
- 1965 AST.SetChild(astNode, 0, astVal)
|
|
|
- 1966 END;
|
|
|
- 1967 astStmt := astNode;
|
|
|
- 1968 conv := FALSE;
|
|
|
- 1969 IF NOT SymTab.InProc() THEN
|
|
|
- 1970 SemError(232)
|
|
|
- 1971 ELSE res := SymTab.CurRes();
|
|
|
- 1972 IF NOT hadE THEN
|
|
|
- 1973 IF res #
|
|
|
- 1974 SymTab.InvalidType THEN
|
|
|
- 1975 SemError(232)
|
|
|
- 1976 ELSE QbeGen.EmitRet(q,
|
|
|
- 1977 FALSE)
|
|
|
- 1978 END
|
|
|
- 1979 ELSIF (res =
|
|
|
- 1980 SymTab.InvalidType)
|
|
|
- 1981 OR (t #
|
|
|
- 1982 SymTab.InvalidType)
|
|
|
- 1983 AND NOT SymTab.Assignable(t,
|
|
|
- 1984 res) THEN
|
|
|
- 1985 SemError(232)
|
|
|
- 1986 ELSE
|
|
|
- 1987 conv := (SymTab.ClassOf(
|
|
|
- 1988 res) = SymTab.ClReal)
|
|
|
- 1989 AND SymTab.IsIntFamily(t);
|
|
|
- 1990 IF conv THEN
|
|
|
- 1991 QbeGen.ConvIR(q, qt);
|
|
|
- 1992 QbeGen.EmitRet(qt, TRUE)
|
|
|
- 1993 ELSE QbeGen.EmitRet(q, TRUE)
|
|
|
+ 1876 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ 1877 qsel, lEnd: QbeGen.QVal;
|
|
|
+ 1878 arm, astNode: AST.Node; .)
|
|
|
+ 1879 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
+ 1880 AST.SetChild(astNode, 0, astCur);
|
|
|
+ 1881 QbeGen.NewLabel(lEnd); .)
|
|
|
+ 1882 "OF" CaseAlt<tsel, qsel, lEnd, astNode>
|
|
|
+ 1883 { "|" CaseAlt<tsel, qsel, lEnd, astNode> }
|
|
|
+ 1884 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
+ 1885 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 1886 AST.SetOp(arm, 1);
|
|
|
+ 1887 AST.SetChild(arm, 0, astStmt);
|
|
|
+ 1888 AST.SetChild(astNode,
|
|
|
+ 1889 AST.NChild(astNode), arm); .) ]
|
|
|
+ 1890 "END" (. astStmt := astNode;
|
|
|
+ 1891 QbeGen.EmitLabel(lEnd); .) .
|
|
|
+ 1892 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ 1893 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ 1894 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ 1895 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ 1896 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 1897 lEnd: QbeGen.QVal; cnode: AST.Node>
|
|
|
+ 1898 (. VAR lBody, lAfter: QbeGen.QVal;
|
|
|
+ 1899 arm: AST.Node; .)
|
|
|
+ 1900 = (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 1901 QbeGen.NewLabel(lBody);
|
|
|
+ 1902 QbeGen.NewLabel(lAfter); .)
|
|
|
+ 1903 CaseLabel<tsel, qsel, lBody, arm>
|
|
|
+ 1904 { "," CaseLabel<tsel, qsel, lBody, arm> }
|
|
|
+ 1905 ":" (. astStmt := AST.NoNode;
|
|
|
+ 1906 QbeGen.Jmp(lAfter);
|
|
|
+ 1907 QbeGen.EmitLabel(lBody); .)
|
|
|
+ 1908 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
+ 1909 astStmt);
|
|
|
+ 1910 AST.SetChild(cnode,
|
|
|
+ 1911 AST.NChild(cnode), arm);
|
|
|
+ 1912 QbeGen.Jmp(lEnd);
|
|
|
+ 1913 QbeGen.EmitLabel(lAfter); .) .
|
|
|
+ 1914 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 1915 lBody: QbeGen.QVal; arm: AST.Node>
|
|
|
+ 1916 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ 1917 q2, q3, qc, qd, qe:
|
|
|
+ 1918 QbeGen.QVal;
|
|
|
+ 1919 astLab: AST.Node;
|
|
|
+ 1920 lNext: QbeGen.QVal; .)
|
|
|
+ 1921 = Expr<t2, q2> (. astLab := astCur;
|
|
|
+ 1922 IF (t2 #
|
|
|
+ 1923 SymTab.InvalidType)
|
|
|
+ 1924 AND (tsel #
|
|
|
+ 1925 SymTab.InvalidType)
|
|
|
+ 1926 AND ((SymTab.ClassOf(t2) =
|
|
|
+ 1927 SymTab.ClSet)
|
|
|
+ 1928 OR (SymTab.ClassOf(tsel) =
|
|
|
+ 1929 SymTab.ClSet)) THEN
|
|
|
+ 1930 SemError(230)
|
|
|
+ 1931 ELSIF (t2 #
|
|
|
+ 1932 SymTab.InvalidType)
|
|
|
+ 1933 AND (tsel #
|
|
|
+ 1934 SymTab.InvalidType)
|
|
|
+ 1935 AND NOT SymTab.EqCheck(t2,
|
|
|
+ 1936 tsel) THEN
|
|
|
+ 1937 SemError(213) END;
|
|
|
+ 1938 IF NOT QbeGen.IsImm(q2) THEN
|
|
|
+ 1939 SemError(230);
|
|
|
+ 1940 QbeGen.CopyOp("0", q2)
|
|
|
+ 1941 END;
|
|
|
+ 1942 QbeGen.NewLabel(lNext);
|
|
|
+ 1943 QbeGen.Cmp(SymTab.OpEq,
|
|
|
+ 1944 qsel, q2, qc, FALSE);
|
|
|
+ 1945 QbeGen.Jnz(qc, lBody, lNext);
|
|
|
+ 1946 QbeGen.EmitLabel(lNext); .)
|
|
|
+ 1947 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
+ 1948 AST.NkSubrange, 0, astLab, astCur);
|
|
|
+ 1949 IF (t3 #
|
|
|
+ 1950 SymTab.InvalidType)
|
|
|
+ 1951 AND (tsel #
|
|
|
+ 1952 SymTab.InvalidType)
|
|
|
+ 1953 AND NOT SymTab.EqCheck(t3,
|
|
|
+ 1954 tsel) THEN
|
|
|
+ 1955 SemError(213) END;
|
|
|
+ 1956 IF NOT QbeGen.IsImm(q3) THEN
|
|
|
+ 1957 SemError(230);
|
|
|
+ 1958 QbeGen.CopyOp("0", q3)
|
|
|
+ 1959 END;
|
|
|
+ 1960 QbeGen.Cmp(SymTab.OpGe,
|
|
|
+ 1961 qsel, q2, qc, FALSE);
|
|
|
+ 1962 QbeGen.Cmp(SymTab.OpLe,
|
|
|
+ 1963 qsel, q3, qd, FALSE);
|
|
|
+ 1964 QbeGen.NewTemp(qe);
|
|
|
+ 1965 QbeGen.Op3("and", qe, qc, qd,
|
|
|
+ 1966 FALSE);
|
|
|
+ 1967 QbeGen.NewLabel(lNext);
|
|
|
+ 1968 QbeGen.Jnz(qe, lBody, lNext);
|
|
|
+ 1969 QbeGen.EmitLabel(lNext); .) ]
|
|
|
+ 1970 (. AST.SetChild(arm,
|
|
|
+ 1971 AST.NChild(arm), astLab); .) .
|
|
|
+ 1972 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1973 q, qt: QbeGen.QVal;
|
|
|
+ 1974 res: SymTab.TypeIndex;
|
|
|
+ 1975 hadE, conv: BOOLEAN;
|
|
|
+ 1976 astVal, astNode: AST.Node; .)
|
|
|
+ 1977 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
+ 1978 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
+ 1979 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
+ 1980 IF hadE THEN
|
|
|
+ 1981 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 1982 END;
|
|
|
+ 1983 astStmt := astNode;
|
|
|
+ 1984 conv := FALSE;
|
|
|
+ 1985 IF NOT SymTab.InProc() THEN
|
|
|
+ 1986 SemError(232)
|
|
|
+ 1987 ELSE res := SymTab.CurRes();
|
|
|
+ 1988 IF NOT hadE THEN
|
|
|
+ 1989 IF res #
|
|
|
+ 1990 SymTab.InvalidType THEN
|
|
|
+ 1991 SemError(232)
|
|
|
+ 1992 ELSE QbeGen.EmitRet(q,
|
|
|
+ 1993 FALSE)
|
|
|
1994 END
|
|
|
- 1995 END
|
|
|
- 1996 END; .) .
|
|
|
- 1997 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1998 q: QbeGen.QVal;
|
|
|
- 1999 astVal, astNode: AST.Node; .)
|
|
|
- 2000 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
- 2001 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
- 2002 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
- 2003 IF astVal # AST.NoNode THEN
|
|
|
- 2004 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2005 END;
|
|
|
- 2006 astStmt := astNode;
|
|
|
- 2007 QbeGen.HaltQ; .) .
|
|
|
- 2008 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
- 2009 Each index descends one level (bounds-checked, trap on breach);
|
|
|
- 2010 nested levels reload the inner descriptor address. q ends as the
|
|
|
- 2011 value (scalars), the descriptor address (plain arrays), or the
|
|
|
- 2012 element address (indexed); sfx marks the indexed form. *)
|
|
|
- 2013 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2014 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2015 (. VAR n, fn, mal: SymTab.Name;
|
|
|
- 2016 cls: INTEGER;
|
|
|
- 2017 ic: SymTab.TypeIndex;
|
|
|
- 2018 curT, it, eT, bt:
|
|
|
- 2019 SymTab.TypeIndex;
|
|
|
- 2020 iq, ql, qlo, qhi, qe:
|
|
|
- 2021 QbeGen.QVal;
|
|
|
- 2022 lo, hi: INTEGER;
|
|
|
- 2023 fo: INTEGER;
|
|
|
- 2024 isOpen: BOOLEAN;
|
|
|
- 2025 qb, cv: QbeGen.QVal;
|
|
|
- 2026 fid, fref, slot: INTEGER;
|
|
|
- 2027 r: BOOLEAN;
|
|
|
- 2028 astDes, astSel: AST.Node; .)
|
|
|
- 2029 = GetIdent<n> (. methCls := SymTab.InvalidType;
|
|
|
- 2030 QbeGen.CopyOp(n, qn);
|
|
|
- 2031 sfx := FALSE;
|
|
|
- 2032 fid := 0; fref := 0; slot := 0;
|
|
|
- 2033 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 2034 (* a bare method name inside
|
|
|
- 2035 a CLASS IMPLEMENTATION
|
|
|
- 2036 is a sibling call on
|
|
|
- 2037 THIS *)
|
|
|
- 2038 ic := SymTab.CurImplClass();
|
|
|
- 2039 IF (ic #
|
|
|
- 2040 SymTab.InvalidType)
|
|
|
- 2041 AND SymTab.MethodExists(ic, n) THEN
|
|
|
- 2042 sfx := FALSE;
|
|
|
- 2043 QbeGen.ThisBase(q);
|
|
|
- 2044 QbeGen.ArmRecv(q);
|
|
|
- 2045 methCls := ic;
|
|
|
- 2046 k := SymTab.KindProc;
|
|
|
- 2047 t := SymTab.InvalidType
|
|
|
- 2048 ELSIF SymTab.InProc() THEN
|
|
|
- 2049 (* not declared yet: a
|
|
|
- 2050 forward reference to a
|
|
|
- 2051 module-level variable
|
|
|
- 2052 declared further down. *)
|
|
|
- 2053 k := SymTab.KindVar;
|
|
|
- 2054 r := SymTab.FwdVarRef(n, k,
|
|
|
- 2055 fref, t);
|
|
|
- 2056 slot := QbeGen.FwdDesignator();
|
|
|
- 2057 FwdVarNote(fref, slot);
|
|
|
- 2058 fid := slot;
|
|
|
- 2059 QbeGen.FwdAddrOper(fid, q);
|
|
|
- 2060 sfx := TRUE
|
|
|
- 2061 ELSE
|
|
|
- 2062 SemError(201);
|
|
|
- 2063 t :=
|
|
|
- 2064 SymTab.InvalidType;
|
|
|
- 2065 k := -1;
|
|
|
- 2066 QbeGen.CopyOp("0", q)
|
|
|
- 2067 END
|
|
|
- 2068 ELSE
|
|
|
- 2069 t := SymTab.SymType(n);
|
|
|
- 2070 k := SymTab.SymKind(n);
|
|
|
- 2071 IF k = SymTab.KindConst THEN
|
|
|
- 2072 IF SymTab.Equal(n,
|
|
|
- 2073 "TRUE") THEN
|
|
|
- 2074 t := SymTab.BoolType();
|
|
|
- 2075 QbeGen.CopyOp("1", q)
|
|
|
- 2076 ELSIF SymTab.Equal(n,
|
|
|
- 2077 "FALSE") THEN
|
|
|
- 2078 t := SymTab.BoolType();
|
|
|
- 2079 QbeGen.CopyOp("0", q)
|
|
|
- 2080 ELSIF SymTab.Equal(n,
|
|
|
- 2081 "NIL") THEN
|
|
|
- 2082 QbeGen.CopyOp("0", q)
|
|
|
- 2083 ELSE
|
|
|
- 2084 cls :=
|
|
|
- 2085 SymTab.ClassOf(t);
|
|
|
- 2086 IF (t #
|
|
|
- 2087 SymTab.InvalidType)
|
|
|
- 2088 AND ((cls = SymTab.ClInt)
|
|
|
- 2089 OR (cls
|
|
|
- 2090 = SymTab.ClChar)
|
|
|
- 2091 OR (cls
|
|
|
- 2092 = SymTab.ClEnum)
|
|
|
- 2093 OR (cls
|
|
|
- 2094 = SymTab.ClReal)
|
|
|
- 2095 OR (cls
|
|
|
- 2096 = SymTab.ClLong)
|
|
|
- 2097 OR (cls
|
|
|
- 2098 = SymTab.ClNil)) THEN
|
|
|
- 2099 IF cls = SymTab.ClNil THEN
|
|
|
- 2100 QbeGen.CopyOp("0", q)
|
|
|
- 2101 ELSIF ((cls
|
|
|
- 2102 = SymTab.ClInt)
|
|
|
- 2103 OR (cls
|
|
|
- 2104 = SymTab.ClChar)
|
|
|
- 2105 OR (cls
|
|
|
- 2106 = SymTab.ClEnum)
|
|
|
- 2107 OR (cls
|
|
|
- 2108 = SymTab.ClLong))
|
|
|
- 2109 AND SymTab.GetSymVal(n, cv)
|
|
|
- 2110 AND QbeGen.IsImm(cv) THEN
|
|
|
- 2111 QbeGen.CopyOp(cv, q)
|
|
|
- 2112 ELSE
|
|
|
- 2113 QbeGen.LoadVar(n,
|
|
|
- 2114 cls = SymTab.ClReal,
|
|
|
- 2115 q)
|
|
|
- 2116 END
|
|
|
- 2117 ELSIF (cls = SymTab.ClArray)
|
|
|
- 2118 OR (cls = SymTab.ClRecord)
|
|
|
- 2119 OR (cls = SymTab.ClClass)
|
|
|
- 2120 OR (cls = SymTab.ClStr)
|
|
|
- 2121 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 2122 (* aggregate constant:
|
|
|
- 2123 its value IS the
|
|
|
- 2124 descriptor address *)
|
|
|
- 2125 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
- 2126 QbeGen.CopyOp(cv, q)
|
|
|
- 2127 ELSE
|
|
|
- 2128 QbeGen.CopyOp("0", q)
|
|
|
- 2129 END
|
|
|
- 2130 ELSE
|
|
|
- 2131 IF t #
|
|
|
- 2132 SymTab.InvalidType THEN
|
|
|
- 2133 SemError(230)
|
|
|
- 2134 END;
|
|
|
- 2135 QbeGen.CopyOp("0", q)
|
|
|
- 2136 END
|
|
|
- 2137 END
|
|
|
- 2138 ELSIF (k = SymTab.KindVar)
|
|
|
- 2139 OR (k = SymTab.KindParam) THEN
|
|
|
- 2140 cls :=
|
|
|
- 2141 SymTab.ClassOf(t);
|
|
|
- 2142 IF (cls = SymTab.ClInt)
|
|
|
- 2143 OR (cls = SymTab.ClBool)
|
|
|
- 2144 OR (cls = SymTab.ClChar)
|
|
|
- 2145 OR (cls = SymTab.ClUChar)
|
|
|
- 2146 OR (cls = SymTab.ClEnum)
|
|
|
- 2147 OR (cls
|
|
|
- 2148 = SymTab.ClReal) THEN
|
|
|
- 2149 QbeGen.LoadVar(n,
|
|
|
- 2150 cls = SymTab.ClReal, q)
|
|
|
- 2151 ELSIF (cls = SymTab.ClPtr)
|
|
|
- 2152 OR (cls = SymTab.ClProc) THEN
|
|
|
- 2153 QbeGen.LoadPtr(n, q)
|
|
|
- 2154 ELSIF cls = SymTab.ClLong THEN
|
|
|
- 2155 QbeGen.LoadLong(n, q)
|
|
|
- 2156 ELSIF (cls
|
|
|
- 2157 = SymTab.ClArray)
|
|
|
- 2158 OR (cls
|
|
|
- 2159 = SymTab.ClSet)
|
|
|
- 2160 OR (cls
|
|
|
- 2161 = SymTab.ClRecord)
|
|
|
- 2162 OR (cls
|
|
|
- 2163 = SymTab.ClUStr)
|
|
|
- 2164 OR (cls
|
|
|
- 2165 = SymTab.ClClass) THEN
|
|
|
- 2166 QbeGen.AddrOf(n, q)
|
|
|
- 2167 ELSE SemError(230);
|
|
|
- 2168 QbeGen.CopyOp("0", q)
|
|
|
- 2169 END
|
|
|
- 2170 ELSE QbeGen.CopyOp("0", q);
|
|
|
- 2171 IF k = SymTab.KindImport THEN
|
|
|
- 2172 SemError(230)
|
|
|
- 2173 ELSIF k =
|
|
|
- 2174 SymTab.KindProc THEN
|
|
|
- 2175 (* bare procedure name:
|
|
|
- 2176 a following ArgList
|
|
|
- 2177 makes it a call;
|
|
|
- 2178 otherwise Fact
|
|
|
- 2179 reports 230 *)
|
|
|
- 2180 ELSE
|
|
|
- 2181 IF k = SymTab.KindField THEN
|
|
|
- 2182 IF QbeGen.TopWith(qb) THEN
|
|
|
- 2183 fo :=
|
|
|
- 2184 SymTab.FieldOffset(
|
|
|
- 2185 SymTab.FieldOwner(n),
|
|
|
- 2186 n);
|
|
|
- 2187 QbeGen.FieldAddr(qb,
|
|
|
- 2188 fo, q);
|
|
|
- 2189 sfx := TRUE
|
|
|
- 2190 ELSE SemError(230);
|
|
|
- 2191 QbeGen.CopyOp("0", q)
|
|
|
- 2192 END
|
|
|
- 2193 END
|
|
|
- 2194 END
|
|
|
- 2195 END
|
|
|
- 2196 END; .)
|
|
|
- 2197 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
- 2198 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 2199 { "[" Expr<it, iq>
|
|
|
- 2200 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2201 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2202 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2203 SymTab.ClArray THEN
|
|
|
- 2204 SemError(217);
|
|
|
- 2205 t := SymTab.InvalidType
|
|
|
- 2206 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2207 AND (SymTab.ClassOf(it) #
|
|
|
- 2208 SymTab.ClChar)
|
|
|
- 2209 AND (SymTab.ClassOf(it) #
|
|
|
- 2210 SymTab.ClEnum) THEN
|
|
|
- 2211 SemError(218);
|
|
|
- 2212 t := SymTab.InvalidType
|
|
|
- 2213 ELSE
|
|
|
- 2214 QbeGen.WidenIndex(iq, ql);
|
|
|
- 2215 isOpen :=
|
|
|
- 2216 SymTab.IsOpenArray(t);
|
|
|
- 2217 IF isOpen THEN
|
|
|
- 2218 QbeGen.CopyOp("0", qlo);
|
|
|
- 2219 IF SymTab.IsCharArray(t)
|
|
|
- 2220 OR SymTab.IsUCharArray(t) THEN
|
|
|
- 2221 QbeGen.OpenHiChar(q, qhi)
|
|
|
- 2222 ELSE QbeGen.OpenHi(q, qhi)
|
|
|
- 2223 END
|
|
|
- 2224 ELSE
|
|
|
- 2225 lo := SymTab.ArrayLo(t);
|
|
|
- 2226 hi := SymTab.ArrayHi(t);
|
|
|
- 2227 IF SymTab.IsCharArray(t)
|
|
|
- 2228 OR SymTab.IsUCharArray(t) THEN
|
|
|
- 2229 hi := hi + 1
|
|
|
- 2230 END;
|
|
|
- 2231 QbeGen.IntStr(lo, qlo);
|
|
|
- 2232 QbeGen.IntStr(hi, qhi)
|
|
|
- 2233 END;
|
|
|
- 2234 QbeGen.CheckRange(ql, qlo,
|
|
|
- 2235 qhi);
|
|
|
- 2236 eT := SymTab.ArrayElem(t);
|
|
|
- 2237 QbeGen.ElemAddr(q, ql, qlo,
|
|
|
- 2238 t, qe);
|
|
|
- 2239 IF SymTab.ClassOf(eT) =
|
|
|
- 2240 SymTab.ClArray THEN
|
|
|
- 2241 QbeGen.ElemLoad(qe, eT, q)
|
|
|
- 2242 ELSE QbeGen.CopyOp(qe, q)
|
|
|
- 2243 END;
|
|
|
- 2244 t := eT; sfx := TRUE
|
|
|
- 2245 END; .)
|
|
|
- 2246 { "," Expr<it, iq>
|
|
|
- 2247 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2248 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2249 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2250 SymTab.ClArray THEN
|
|
|
- 2251 SemError(217);
|
|
|
- 2252 t := SymTab.InvalidType
|
|
|
- 2253 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2254 AND (SymTab.ClassOf(it) #
|
|
|
- 2255 SymTab.ClChar)
|
|
|
- 2256 AND (SymTab.ClassOf(it) #
|
|
|
- 2257 SymTab.ClEnum) THEN
|
|
|
- 2258 SemError(218);
|
|
|
- 2259 t := SymTab.InvalidType
|
|
|
- 2260 ELSE
|
|
|
- 2261 QbeGen.WidenIndex(iq, ql);
|
|
|
- 2262 isOpen :=
|
|
|
- 2263 SymTab.IsOpenArray(t);
|
|
|
- 2264 IF isOpen THEN
|
|
|
- 2265 QbeGen.CopyOp("0", qlo);
|
|
|
- 2266 IF SymTab.IsCharArray(t)
|
|
|
- 2267 OR SymTab.IsUCharArray(t) THEN
|
|
|
- 2268 QbeGen.OpenHiChar(q, qhi)
|
|
|
- 2269 ELSE QbeGen.OpenHi(q, qhi)
|
|
|
- 2270 END
|
|
|
- 2271 ELSE
|
|
|
- 2272 lo := SymTab.ArrayLo(t);
|
|
|
- 2273 hi := SymTab.ArrayHi(t);
|
|
|
- 2274 IF SymTab.IsCharArray(t)
|
|
|
- 2275 OR SymTab.IsUCharArray(t) THEN
|
|
|
- 2276 hi := hi + 1
|
|
|
- 2277 END;
|
|
|
- 2278 QbeGen.IntStr(lo, qlo);
|
|
|
- 2279 QbeGen.IntStr(hi, qhi)
|
|
|
- 2280 END;
|
|
|
- 2281 QbeGen.CheckRange(ql, qlo,
|
|
|
- 2282 qhi);
|
|
|
- 2283 eT := SymTab.ArrayElem(t);
|
|
|
- 2284 QbeGen.ElemAddr(q, ql, qlo,
|
|
|
- 2285 t, qe);
|
|
|
- 2286 IF SymTab.ClassOf(eT) =
|
|
|
- 2287 SymTab.ClArray THEN
|
|
|
- 2288 QbeGen.ElemLoad(qe, eT, q)
|
|
|
- 2289 ELSE QbeGen.CopyOp(qe, q)
|
|
|
- 2290 END;
|
|
|
- 2291 t := eT; sfx := TRUE
|
|
|
- 2292 END; .) }
|
|
|
- 2293 "]"
|
|
|
- 2294 | "." GetIdent<fn>
|
|
|
- 2295 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2296 AST.SetOp(astSel, AST.SelField);
|
|
|
- 2297 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
- 2298 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
- 2299 (* qualified L.x: materialize
|
|
|
- 2300 the export, then load it *)
|
|
|
- 2301 IF NOT SymTab.MaterializeAlias(n,
|
|
|
- 2302 fn, mal) THEN
|
|
|
- 2303 SemError(201);
|
|
|
- 2304 t := SymTab.InvalidType;
|
|
|
- 2305 QbeGen.CopyOp("0", q)
|
|
|
- 2306 ELSE
|
|
|
- 2307 QbeGen.CopyOp(mal, qn);
|
|
|
- 2308 t := SymTab.SymType(mal);
|
|
|
- 2309 k := SymTab.SymKind(mal);
|
|
|
- 2310 sfx := FALSE;
|
|
|
- 2311 IF k = SymTab.KindProc THEN
|
|
|
- 2312 (* call: ArgList supplies
|
|
|
- 2313 the value *)
|
|
|
- 2314 QbeGen.CopyOp("0", q)
|
|
|
- 2315 ELSIF NOT QbeGen.LoadDesignator(
|
|
|
- 2316 mal, t, k, q) THEN
|
|
|
- 2317 SemError(230);
|
|
|
- 2318 QbeGen.CopyOp("0", q)
|
|
|
- 2319 END
|
|
|
- 2320 END
|
|
|
- 2321 ELSIF t = SymTab.InvalidType THEN
|
|
|
- 2322 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2323 SymTab.ClRecord)
|
|
|
- 2324 AND (SymTab.ClassOf(t) #
|
|
|
- 2325 SymTab.ClClass) THEN
|
|
|
- 2326 SemError(215);
|
|
|
- 2327 t := SymTab.InvalidType
|
|
|
- 2328 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 2329 SymTab.ClClass)
|
|
|
- 2330 AND SymTab.MethodExists(t, fn) THEN
|
|
|
- 2331 (* obj.Method: bind the
|
|
|
- 2332 method and pass obj as
|
|
|
- 2333 the hidden receiver; q
|
|
|
- 2334 already holds the
|
|
|
- 2335 object's address *)
|
|
|
- 2336 QbeGen.ArmRecv(q);
|
|
|
- 2337 QbeGen.CopyOp(fn, n);
|
|
|
- 2338 QbeGen.CopyOp(fn, qn);
|
|
|
- 2339 methCls := t;
|
|
|
- 2340 k := SymTab.KindProc;
|
|
|
- 2341 t := SymTab.InvalidType
|
|
|
- 2342 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 2343 fn) THEN
|
|
|
- 2344 SemError(216);
|
|
|
- 2345 t := SymTab.InvalidType
|
|
|
- 2346 ELSE
|
|
|
- 2347 fo := SymTab.FieldOffset(t,
|
|
|
- 2348 fn);
|
|
|
- 2349 t := SymTab.FieldType(t, fn);
|
|
|
- 2350 QbeGen.FieldAddr(q, fo, qe);
|
|
|
- 2351 (* array fields are inline:
|
|
|
- 2352 the field address is the
|
|
|
- 2353 descriptor, like records *)
|
|
|
- 2354 QbeGen.CopyOp(qe, q);
|
|
|
- 2355 sfx := TRUE
|
|
|
- 2356 END; .)
|
|
|
- 2357 | "^"
|
|
|
- 2358 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2359 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 2360 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 2361 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2362 SymTab.ClPtr THEN
|
|
|
- 2363 SemError(219);
|
|
|
- 2364 t := SymTab.InvalidType
|
|
|
- 2365 ELSE
|
|
|
- 2366 bt := SymTab.PtrBase(t);
|
|
|
- 2367 IF bt = SymTab.InvalidType THEN
|
|
|
- 2368 ELSE
|
|
|
- 2369 IF sfx THEN
|
|
|
- 2370 QbeGen.ElemLoad(q, t,
|
|
|
- 2371 qb);
|
|
|
- 2372 QbeGen.CopyOp(qb, q)
|
|
|
- 2373 END;
|
|
|
- 2374 t := bt;
|
|
|
- 2375 (* q holds the pointee
|
|
|
- 2376 address: Fact loads
|
|
|
- 2377 scalars/pointers and uses
|
|
|
- 2378 the address for
|
|
|
- 2379 aggregates; the VAR-actual
|
|
|
- 2380 note is q itself. *)
|
|
|
- 2381 sfx := TRUE
|
|
|
- 2382 END
|
|
|
- 2383 END; .) } (. astCur := astDes; .) .
|
|
|
- 2384 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
- 2385 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
- 2386 (a value, or a descriptor address for aggregates); each component
|
|
|
- 2387 descends one level exactly like the Design components. *)
|
|
|
- 2388 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2389 VAR sfx: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
- 2390 iq, ql, qlo, qhi, qe, qb:
|
|
|
- 2391 QbeGen.QVal;
|
|
|
- 2392 lo, hi, fo: INTEGER;
|
|
|
- 2393 isOpen: BOOLEAN;
|
|
|
- 2394 fname: SymTab.Name; .)
|
|
|
- 2395 = "[" Expr<it, iq>
|
|
|
- 2396 (. IF t = SymTab.InvalidType THEN
|
|
|
- 2397 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2398 SymTab.ClArray THEN
|
|
|
- 2399 SemError(217);
|
|
|
- 2400 t := SymTab.InvalidType
|
|
|
- 2401 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2402 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
- 2403 AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
|
|
|
- 2404 SemError(218);
|
|
|
- 2405 t := SymTab.InvalidType
|
|
|
- 2406 ELSE
|
|
|
- 2407 QbeGen.WidenIndex(iq, ql);
|
|
|
- 2408 isOpen :=
|
|
|
- 2409 SymTab.IsOpenArray(t);
|
|
|
- 2410 IF isOpen THEN
|
|
|
- 2411 QbeGen.CopyOp("0", qlo);
|
|
|
- 2412 IF SymTab.IsCharArray(t)
|
|
|
- 2413 OR SymTab.IsUCharArray(t) THEN
|
|
|
- 2414 QbeGen.OpenHiChar(q, qhi)
|
|
|
- 2415 ELSE QbeGen.OpenHi(q, qhi)
|
|
|
- 2416 END
|
|
|
- 2417 ELSE
|
|
|
- 2418 lo := SymTab.ArrayLo(t);
|
|
|
- 2419 hi := SymTab.ArrayHi(t);
|
|
|
- 2420 IF SymTab.IsCharArray(t)
|
|
|
- 2421 OR SymTab.IsUCharArray(t) THEN
|
|
|
- 2422 hi := hi + 1
|
|
|
- 2423 END;
|
|
|
- 2424 QbeGen.IntStr(lo, qlo);
|
|
|
- 2425 QbeGen.IntStr(hi, qhi)
|
|
|
- 2426 END;
|
|
|
- 2427 QbeGen.CheckRange(ql, qlo,
|
|
|
- 2428 qhi);
|
|
|
- 2429 eT := SymTab.ArrayElem(t);
|
|
|
- 2430 QbeGen.ElemAddr(q, ql, qlo,
|
|
|
- 2431 t, qe);
|
|
|
- 2432 IF SymTab.ClassOf(eT) =
|
|
|
- 2433 SymTab.ClArray THEN
|
|
|
- 2434 QbeGen.ElemLoad(qe, eT, q)
|
|
|
- 2435 ELSE QbeGen.CopyOp(qe, q)
|
|
|
- 2436 END;
|
|
|
- 2437 t := eT; sfx := TRUE
|
|
|
- 2438 END; .)
|
|
|
- 2439 "]"
|
|
|
- 2440 | "." GetIdent<fname>
|
|
|
- 2441 (. IF t = SymTab.InvalidType THEN
|
|
|
- 2442 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2443 SymTab.ClRecord)
|
|
|
- 2444 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 2445 SemError(215);
|
|
|
- 2446 t := SymTab.InvalidType
|
|
|
- 2447 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 2448 fname) THEN
|
|
|
- 2449 SemError(216);
|
|
|
- 2450 t := SymTab.InvalidType
|
|
|
- 2451 ELSE
|
|
|
- 2452 fo := SymTab.FieldOffset(t,
|
|
|
- 2453 fname);
|
|
|
- 2454 t := SymTab.FieldType(t, fname);
|
|
|
- 2455 QbeGen.FieldAddr(q, fo, qe);
|
|
|
- 2456 QbeGen.CopyOp(qe, q);
|
|
|
- 2457 sfx := TRUE
|
|
|
- 2458 END; .)
|
|
|
- 2459 | "^" (. IF t = SymTab.InvalidType THEN
|
|
|
- 2460 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2461 SymTab.ClPtr THEN
|
|
|
- 2462 SemError(219);
|
|
|
- 2463 t := SymTab.InvalidType
|
|
|
- 2464 ELSE
|
|
|
- 2465 bt := SymTab.PtrBase(t);
|
|
|
- 2466 IF bt # SymTab.InvalidType THEN
|
|
|
- 2467 IF sfx THEN
|
|
|
- 2468 QbeGen.ElemLoad(q, t, qb);
|
|
|
- 2469 QbeGen.CopyOp(qb, q)
|
|
|
- 2470 END;
|
|
|
- 2471 t := bt; sfx := TRUE
|
|
|
- 2472 END
|
|
|
- 2473 END; .) .
|
|
|
- 2474 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2475 (. VAR t2: SymTab.TypeIndex;
|
|
|
- 2476 op: INTEGER;
|
|
|
- 2477 q2, qt, wl: QbeGen.QVal;
|
|
|
- 2478 astA, astB: AST.Node;
|
|
|
- 2479 astOp: INTEGER;
|
|
|
- 2480 astMade: BOOLEAN;
|
|
|
- 2481 isR: BOOLEAN; .)
|
|
|
- 2482 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
- 2483 [ Rel<op> SimExpr<t2, q2>
|
|
|
- 2484 (. astB := astCur; astMade := TRUE;
|
|
|
- 2485 astOp := AST.OpEq;
|
|
|
- 2486 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
- 2487 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
- 2488 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
- 2489 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
- 2490 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
- 2491 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
- 2492 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
- 2493 END;
|
|
|
- 2494 IF op = SymTab.OpIn THEN
|
|
|
- 2495 IF SymTab.InCheck(t, t2) THEN
|
|
|
- 2496 IF (t = SymTab.InvalidType)
|
|
|
- 2497 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 2498 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 2499 ELSE
|
|
|
- 2500 QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
|
|
|
- 2501 SymTab.SetCount(t2), qt);
|
|
|
- 2502 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2503 END
|
|
|
- 2504 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
- 2505 QbeGen.CopyOp("0", q)
|
|
|
- 2506 END
|
|
|
- 2507 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
- 2508 IF (t = SymTab.InvalidType)
|
|
|
- 2509 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 2510 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 2511 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
- 2512 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
- 2513 IF SymTab.IsFwdVar(t) OR SymTab.IsFwdVar(t2) THEN
|
|
|
- 2514 QbeGen.Cmp(op, q, q2, qt, FALSE);
|
|
|
- 2515 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2516 ELSIF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
- 2517 AND (op # SymTab.OpNeq2) THEN
|
|
|
- 2518 SemError(213); t := SymTab.InvalidType;
|
|
|
- 2519 QbeGen.CopyOp("0", q)
|
|
|
- 2520 ELSE
|
|
|
- 2521 QbeGen.CmpL(op, q, q2, qt);
|
|
|
- 2522 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2523 END
|
|
|
- 2524 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2525 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2526 QbeGen.CmpSet(op, q, q2,
|
|
|
- 2527 SymTab.SetWords(t), SymTab.SetWords(t2), qt);
|
|
|
- 2528 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2529 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
- 2530 QbeGen.StrEq(op, q, q2, qt);
|
|
|
- 2531 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2532 ELSIF SymTab.IsLongFamily(t)
|
|
|
- 2533 OR SymTab.IsLongFamily(t2) THEN
|
|
|
- 2534 IF SymTab.IsIntFamily(t) THEN
|
|
|
- 2535 QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
|
|
|
- 2536 END;
|
|
|
- 2537 IF SymTab.IsIntFamily(t2) THEN
|
|
|
- 2538 QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
|
|
|
- 2539 END;
|
|
|
- 2540 QbeGen.CmpLong(op, q, q2, qt);
|
|
|
- 2541 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2542 ELSE
|
|
|
- 2543 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 2544 t := SymTab.BoolType();
|
|
|
- 2545 QbeGen.Cmp(op, q, q2, qt, isR);
|
|
|
- 2546 QbeGen.CopyOp(qt, q)
|
|
|
- 2547 END
|
|
|
- 2548 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
- 2549 QbeGen.CopyOp("0", q)
|
|
|
- 2550 END;
|
|
|
- 2551 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
- 2552 (. IF NOT astMade THEN astCur := astA END; .) .
|
|
|
- 2553 Rel<VAR op: INTEGER>
|
|
|
- 2554 = "=" (. op := SymTab.OpEq; .)
|
|
|
- 2555 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
- 2556 | "<" (. op := SymTab.OpLt; .)
|
|
|
- 2557 | "<=" (. op := SymTab.OpLe; .)
|
|
|
- 2558 | ">" (. op := SymTab.OpGt; .)
|
|
|
- 2559 | ">=" (. op := SymTab.OpGe; .)
|
|
|
- 2560 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
- 2561 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2562 (. VAR t2, res2, lt, rt:
|
|
|
- 2563 SymTab.TypeIndex;
|
|
|
- 2564 op: INTEGER;
|
|
|
- 2565 q2, qt, wq, qf, q2a, q2b:
|
|
|
- 2566 QbeGen.QVal;
|
|
|
- 2567 neg, isR, isL, folded:
|
|
|
- 2568 BOOLEAN;
|
|
|
- 2569 fok: BOOLEAN;
|
|
|
- 2570 lw, rw, mw: CARDINAL;
|
|
|
- 2571 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 2572 astA, astB: AST.Node;
|
|
|
- 2573 astSign, astOp: INTEGER; .)
|
|
|
- 2574 = (. neg := FALSE; astSign := 0; .)
|
|
|
- 2575 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
- 2576 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
- 2577 Term<t, q> (. astA := astCur; IF neg THEN
|
|
|
- 2578 IF QbeGen.IsImm(q) THEN
|
|
|
- 2579 QbeGen.NegFold(q, q)
|
|
|
- 2580 ELSE QbeGen.NewTemp(qt);
|
|
|
- 2581 QbeGen.NegQ(q, qt,
|
|
|
- 2582 SymTab.ClassOf(t)
|
|
|
- 2583 = SymTab.ClReal);
|
|
|
- 2584 QbeGen.CopyOp(qt, q)
|
|
|
- 2585 END
|
|
|
- 2586 END;
|
|
|
- 2587 IF astSign < 0 THEN
|
|
|
- 2588 astCur := AST.MakeUn(
|
|
|
- 2589 AST.NkUnary, AST.OpSub, astA);
|
|
|
- 2590 astA := astCur
|
|
|
- 2591 END; .)
|
|
|
- 2592 { AddOp<op> (. IF op = SymTab.OpOr THEN
|
|
|
- 2593 QbeGen.DelayBegin END; .)
|
|
|
- 2594 Term<t2, q2> (. astB := astCur; IF op = SymTab.OpOr THEN
|
|
|
- 2595 QbeGen.DelayEnd END; .)
|
|
|
- 2596 (. astOp := AST.OpAdd;
|
|
|
- 2597 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
- 2598 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
- 2599 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 2600 astCur := astA;
|
|
|
- 2601 IF op = SymTab.OpOr THEN
|
|
|
- 2602 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
- 2603 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 2604 t := SymTab.BoolType()
|
|
|
- 2605 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 2606 IF t # SymTab.InvalidType THEN
|
|
|
- 2607 QbeGen.Slot4(qs);
|
|
|
- 2608 QbeGen.NewLabel(lTrue);
|
|
|
- 2609 QbeGen.NewLabel(lNext);
|
|
|
- 2610 QbeGen.NewLabel(lDone);
|
|
|
- 2611 QbeGen.Jnz(q, lTrue, lNext);
|
|
|
- 2612 QbeGen.EmitLabel(lTrue);
|
|
|
- 2613 QbeGen.StoreW(qs, "1");
|
|
|
- 2614 QbeGen.Jmp(lDone);
|
|
|
- 2615 QbeGen.EmitLabel(lNext);
|
|
|
- 2616 QbeGen.DelayFlush;
|
|
|
- 2617 QbeGen.StoreW(qs, q2);
|
|
|
- 2618 QbeGen.Jmp(lDone);
|
|
|
- 2619 QbeGen.EmitLabel(lDone);
|
|
|
- 2620 QbeGen.LoadW(qs, qr);
|
|
|
- 2621 QbeGen.CopyOp(qr, q)
|
|
|
- 2622 ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
|
|
|
- 2623 END
|
|
|
- 2624 ELSIF (op = SymTab.OpAdd)
|
|
|
- 2625 AND (SymTab.UStrCompat(t, t2)
|
|
|
- 2626 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 2627 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
- 2628 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
- 2629 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
- 2630 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 2631 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
- 2632 (* UString concatenation: a UCHAR operand becomes a
|
|
|
- 2633 1-codepoint UString; the result is a descriptor in the
|
|
|
- 2634 shim's concat buffer. Work on copies so neither
|
|
|
- 2635 operand is clobbered. *)
|
|
|
- 2636 IF SymTab.ClassOf(t) = SymTab.ClUStr THEN
|
|
|
- 2637 QbeGen.CopyOp(q, q2a)
|
|
|
- 2638 ELSE
|
|
|
- 2639 QbeGen.UStrFrom(q, q2a)
|
|
|
- 2640 END;
|
|
|
- 2641 IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN
|
|
|
- 2642 QbeGen.UStrCat(q2a, q2, qt)
|
|
|
- 2643 ELSE
|
|
|
- 2644 QbeGen.UStrFrom(q2, q2b);
|
|
|
- 2645 QbeGen.UStrCat(q2a, q2b, qt)
|
|
|
- 2646 END;
|
|
|
- 2647 t := SymTab.NewUStr();
|
|
|
- 2648 QbeGen.CopyOp(qt, q)
|
|
|
- 2649 ELSIF (op = SymTab.OpAdd)
|
|
|
- 2650 AND (SymTab.StrCompat(t, t2)
|
|
|
- 2651 OR (SymTab.IsStrType(t)
|
|
|
- 2652 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
- 2653 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 2654 AND SymTab.IsStrType(t2))) THEN
|
|
|
- 2655 (* string concatenation; a CHAR operand becomes a
|
|
|
- 2656 1-character string literal. When both operands are
|
|
|
- 2657 constants, fold to a single string literal so a
|
|
|
- 2658 constructor element stays compile-time. *)
|
|
|
- 2659 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
- 2660 qt, fok);
|
|
|
- 2661 IF NOT fok THEN
|
|
|
- 2662 IF SymTab.StrCompat(t, t2) THEN
|
|
|
- 2663 QbeGen.StrCat(q, q2, qt)
|
|
|
- 2664 ELSIF SymTab.IsStrType(t) THEN
|
|
|
- 2665 QbeGen.DeclCharStr(q2, qs);
|
|
|
- 2666 QbeGen.StrCat(q, qs, qt)
|
|
|
- 2667 ELSE
|
|
|
- 2668 QbeGen.DeclCharStr(q, qs);
|
|
|
- 2669 QbeGen.StrCat(qs, q2, qt)
|
|
|
- 2670 END
|
|
|
- 2671 END;
|
|
|
- 2672 t := SymTab.NewStr();
|
|
|
- 2673 QbeGen.CopyOp(qt, q)
|
|
|
- 2674 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 2675 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2676 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2677 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 2678 mw := lw;
|
|
|
- 2679 IF rw > mw THEN mw := rw END;
|
|
|
- 2680 IF op = SymTab.OpAdd THEN
|
|
|
- 2681 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
|
|
|
+ 1995 ELSIF (res =
|
|
|
+ 1996 SymTab.InvalidType)
|
|
|
+ 1997 OR (t #
|
|
|
+ 1998 SymTab.InvalidType)
|
|
|
+ 1999 AND NOT SymTab.Assignable(t,
|
|
|
+ 2000 res) THEN
|
|
|
+ 2001 SemError(232)
|
|
|
+ 2002 ELSE
|
|
|
+ 2003 conv := (SymTab.ClassOf(
|
|
|
+ 2004 res) = SymTab.ClReal)
|
|
|
+ 2005 AND SymTab.IsIntFamily(t);
|
|
|
+ 2006 IF conv THEN
|
|
|
+ 2007 QbeGen.ConvIR(q, qt);
|
|
|
+ 2008 QbeGen.EmitRet(qt, TRUE)
|
|
|
+ 2009 ELSE QbeGen.EmitRet(q, TRUE)
|
|
|
+ 2010 END
|
|
|
+ 2011 END
|
|
|
+ 2012 END; .) .
|
|
|
+ 2013 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2014 q: QbeGen.QVal;
|
|
|
+ 2015 astVal, astNode: AST.Node; .)
|
|
|
+ 2016 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
+ 2017 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
+ 2018 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
+ 2019 IF astVal # AST.NoNode THEN
|
|
|
+ 2020 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2021 END;
|
|
|
+ 2022 astStmt := astNode;
|
|
|
+ 2023 QbeGen.HaltQ; .) .
|
|
|
+ 2024 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
+ 2025 Each index descends one level (bounds-checked, trap on breach);
|
|
|
+ 2026 nested levels reload the inner descriptor address. q ends as the
|
|
|
+ 2027 value (scalars), the descriptor address (plain arrays), or the
|
|
|
+ 2028 element address (indexed); sfx marks the indexed form. *)
|
|
|
+ 2029 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2030 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2031 (. VAR n, fn, mal: SymTab.Name;
|
|
|
+ 2032 cls: INTEGER;
|
|
|
+ 2033 ic: SymTab.TypeIndex;
|
|
|
+ 2034 curT, it, eT, bt:
|
|
|
+ 2035 SymTab.TypeIndex;
|
|
|
+ 2036 iq, ql, qlo, qhi, qe:
|
|
|
+ 2037 QbeGen.QVal;
|
|
|
+ 2038 lo, hi: INTEGER;
|
|
|
+ 2039 fo: INTEGER;
|
|
|
+ 2040 isOpen: BOOLEAN;
|
|
|
+ 2041 qb, cv: QbeGen.QVal;
|
|
|
+ 2042 fid, fref, slot: INTEGER;
|
|
|
+ 2043 r: BOOLEAN;
|
|
|
+ 2044 astDes, astSel: AST.Node; .)
|
|
|
+ 2045 = GetIdent<n> (. methCls := SymTab.InvalidType;
|
|
|
+ 2046 QbeGen.CopyOp(n, qn);
|
|
|
+ 2047 sfx := FALSE;
|
|
|
+ 2048 fid := 0; fref := 0; slot := 0;
|
|
|
+ 2049 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 2050 (* a bare method name inside
|
|
|
+ 2051 a CLASS IMPLEMENTATION
|
|
|
+ 2052 is a sibling call on
|
|
|
+ 2053 THIS *)
|
|
|
+ 2054 ic := SymTab.CurImplClass();
|
|
|
+ 2055 IF (ic #
|
|
|
+ 2056 SymTab.InvalidType)
|
|
|
+ 2057 AND SymTab.MethodExists(ic, n) THEN
|
|
|
+ 2058 sfx := FALSE;
|
|
|
+ 2059 QbeGen.ThisBase(q);
|
|
|
+ 2060 QbeGen.ArmRecv(q);
|
|
|
+ 2061 methCls := ic;
|
|
|
+ 2062 k := SymTab.KindProc;
|
|
|
+ 2063 t := SymTab.InvalidType
|
|
|
+ 2064 ELSIF SymTab.InProc() THEN
|
|
|
+ 2065 (* not declared yet: a
|
|
|
+ 2066 forward reference to a
|
|
|
+ 2067 module-level variable
|
|
|
+ 2068 declared further down. *)
|
|
|
+ 2069 k := SymTab.KindVar;
|
|
|
+ 2070 r := SymTab.FwdVarRef(n, k,
|
|
|
+ 2071 fref, t);
|
|
|
+ 2072 slot := QbeGen.FwdDesignator();
|
|
|
+ 2073 FwdVarNote(fref, slot);
|
|
|
+ 2074 fid := slot;
|
|
|
+ 2075 QbeGen.FwdAddrOper(fid, q);
|
|
|
+ 2076 sfx := TRUE
|
|
|
+ 2077 ELSE
|
|
|
+ 2078 SemError(201);
|
|
|
+ 2079 t :=
|
|
|
+ 2080 SymTab.InvalidType;
|
|
|
+ 2081 k := -1;
|
|
|
+ 2082 QbeGen.CopyOp("0", q)
|
|
|
+ 2083 END
|
|
|
+ 2084 ELSE
|
|
|
+ 2085 t := SymTab.SymType(n);
|
|
|
+ 2086 k := SymTab.SymKind(n);
|
|
|
+ 2087 IF k = SymTab.KindConst THEN
|
|
|
+ 2088 IF SymTab.Equal(n,
|
|
|
+ 2089 "TRUE") THEN
|
|
|
+ 2090 t := SymTab.BoolType();
|
|
|
+ 2091 QbeGen.CopyOp("1", q)
|
|
|
+ 2092 ELSIF SymTab.Equal(n,
|
|
|
+ 2093 "FALSE") THEN
|
|
|
+ 2094 t := SymTab.BoolType();
|
|
|
+ 2095 QbeGen.CopyOp("0", q)
|
|
|
+ 2096 ELSIF SymTab.Equal(n,
|
|
|
+ 2097 "NIL") THEN
|
|
|
+ 2098 QbeGen.CopyOp("0", q)
|
|
|
+ 2099 ELSE
|
|
|
+ 2100 cls :=
|
|
|
+ 2101 SymTab.ClassOf(t);
|
|
|
+ 2102 IF (t #
|
|
|
+ 2103 SymTab.InvalidType)
|
|
|
+ 2104 AND ((cls = SymTab.ClInt)
|
|
|
+ 2105 OR (cls
|
|
|
+ 2106 = SymTab.ClChar)
|
|
|
+ 2107 OR (cls
|
|
|
+ 2108 = SymTab.ClEnum)
|
|
|
+ 2109 OR (cls
|
|
|
+ 2110 = SymTab.ClReal)
|
|
|
+ 2111 OR (cls
|
|
|
+ 2112 = SymTab.ClLong)
|
|
|
+ 2113 OR (cls
|
|
|
+ 2114 = SymTab.ClNil)) THEN
|
|
|
+ 2115 IF cls = SymTab.ClNil THEN
|
|
|
+ 2116 QbeGen.CopyOp("0", q)
|
|
|
+ 2117 ELSIF ((cls
|
|
|
+ 2118 = SymTab.ClInt)
|
|
|
+ 2119 OR (cls
|
|
|
+ 2120 = SymTab.ClChar)
|
|
|
+ 2121 OR (cls
|
|
|
+ 2122 = SymTab.ClEnum)
|
|
|
+ 2123 OR (cls
|
|
|
+ 2124 = SymTab.ClLong))
|
|
|
+ 2125 AND SymTab.GetSymVal(n, cv)
|
|
|
+ 2126 AND QbeGen.IsImm(cv) THEN
|
|
|
+ 2127 QbeGen.CopyOp(cv, q)
|
|
|
+ 2128 ELSE
|
|
|
+ 2129 QbeGen.LoadVar(n,
|
|
|
+ 2130 cls = SymTab.ClReal,
|
|
|
+ 2131 q)
|
|
|
+ 2132 END
|
|
|
+ 2133 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 2134 OR (cls = SymTab.ClRecord)
|
|
|
+ 2135 OR (cls = SymTab.ClClass)
|
|
|
+ 2136 OR (cls = SymTab.ClStr)
|
|
|
+ 2137 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 2138 (* aggregate constant:
|
|
|
+ 2139 its value IS the
|
|
|
+ 2140 descriptor address *)
|
|
|
+ 2141 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
+ 2142 QbeGen.CopyOp(cv, q)
|
|
|
+ 2143 ELSE
|
|
|
+ 2144 QbeGen.CopyOp("0", q)
|
|
|
+ 2145 END
|
|
|
+ 2146 ELSE
|
|
|
+ 2147 IF t #
|
|
|
+ 2148 SymTab.InvalidType THEN
|
|
|
+ 2149 SemError(230)
|
|
|
+ 2150 END;
|
|
|
+ 2151 QbeGen.CopyOp("0", q)
|
|
|
+ 2152 END
|
|
|
+ 2153 END
|
|
|
+ 2154 ELSIF (k = SymTab.KindVar)
|
|
|
+ 2155 OR (k = SymTab.KindParam) THEN
|
|
|
+ 2156 cls :=
|
|
|
+ 2157 SymTab.ClassOf(t);
|
|
|
+ 2158 IF (cls = SymTab.ClInt)
|
|
|
+ 2159 OR (cls = SymTab.ClBool)
|
|
|
+ 2160 OR (cls = SymTab.ClChar)
|
|
|
+ 2161 OR (cls = SymTab.ClUChar)
|
|
|
+ 2162 OR (cls = SymTab.ClEnum)
|
|
|
+ 2163 OR (cls
|
|
|
+ 2164 = SymTab.ClReal) THEN
|
|
|
+ 2165 QbeGen.LoadVar(n,
|
|
|
+ 2166 cls = SymTab.ClReal, q)
|
|
|
+ 2167 ELSIF (cls = SymTab.ClPtr)
|
|
|
+ 2168 OR (cls = SymTab.ClProc) THEN
|
|
|
+ 2169 QbeGen.LoadPtr(n, q)
|
|
|
+ 2170 ELSIF cls = SymTab.ClLong THEN
|
|
|
+ 2171 QbeGen.LoadLong(n, q)
|
|
|
+ 2172 ELSIF (cls
|
|
|
+ 2173 = SymTab.ClArray)
|
|
|
+ 2174 OR (cls
|
|
|
+ 2175 = SymTab.ClSet)
|
|
|
+ 2176 OR (cls
|
|
|
+ 2177 = SymTab.ClRecord)
|
|
|
+ 2178 OR (cls
|
|
|
+ 2179 = SymTab.ClUStr)
|
|
|
+ 2180 OR (cls
|
|
|
+ 2181 = SymTab.ClClass) THEN
|
|
|
+ 2182 QbeGen.AddrOf(n, q)
|
|
|
+ 2183 ELSE SemError(230);
|
|
|
+ 2184 QbeGen.CopyOp("0", q)
|
|
|
+ 2185 END
|
|
|
+ 2186 ELSE QbeGen.CopyOp("0", q);
|
|
|
+ 2187 IF k = SymTab.KindImport THEN
|
|
|
+ 2188 SemError(230)
|
|
|
+ 2189 ELSIF k =
|
|
|
+ 2190 SymTab.KindProc THEN
|
|
|
+ 2191 (* bare procedure name:
|
|
|
+ 2192 a following ArgList
|
|
|
+ 2193 makes it a call;
|
|
|
+ 2194 otherwise Fact
|
|
|
+ 2195 reports 230 *)
|
|
|
+ 2196 ELSE
|
|
|
+ 2197 IF k = SymTab.KindField THEN
|
|
|
+ 2198 IF QbeGen.TopWith(qb) THEN
|
|
|
+ 2199 fo :=
|
|
|
+ 2200 SymTab.FieldOffset(
|
|
|
+ 2201 SymTab.FieldOwner(n),
|
|
|
+ 2202 n);
|
|
|
+ 2203 QbeGen.FieldAddr(qb,
|
|
|
+ 2204 fo, q);
|
|
|
+ 2205 sfx := TRUE
|
|
|
+ 2206 ELSE SemError(230);
|
|
|
+ 2207 QbeGen.CopyOp("0", q)
|
|
|
+ 2208 END
|
|
|
+ 2209 END
|
|
|
+ 2210 END
|
|
|
+ 2211 END
|
|
|
+ 2212 END; .)
|
|
|
+ 2213 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
+ 2214 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 2215 { "[" Expr<it, iq>
|
|
|
+ 2216 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2217 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2218 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2219 SymTab.ClArray THEN
|
|
|
+ 2220 SemError(217);
|
|
|
+ 2221 t := SymTab.InvalidType
|
|
|
+ 2222 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2223 AND (SymTab.ClassOf(it) #
|
|
|
+ 2224 SymTab.ClChar)
|
|
|
+ 2225 AND (SymTab.ClassOf(it) #
|
|
|
+ 2226 SymTab.ClEnum) THEN
|
|
|
+ 2227 SemError(218);
|
|
|
+ 2228 t := SymTab.InvalidType
|
|
|
+ 2229 ELSE
|
|
|
+ 2230 QbeGen.WidenIndex(iq, ql);
|
|
|
+ 2231 isOpen :=
|
|
|
+ 2232 SymTab.IsOpenArray(t);
|
|
|
+ 2233 IF isOpen THEN
|
|
|
+ 2234 QbeGen.CopyOp("0", qlo);
|
|
|
+ 2235 IF SymTab.IsCharArray(t)
|
|
|
+ 2236 OR SymTab.IsUCharArray(t) THEN
|
|
|
+ 2237 QbeGen.OpenHiChar(q, qhi)
|
|
|
+ 2238 ELSE QbeGen.OpenHi(q, qhi)
|
|
|
+ 2239 END
|
|
|
+ 2240 ELSE
|
|
|
+ 2241 lo := SymTab.ArrayLo(t);
|
|
|
+ 2242 hi := SymTab.ArrayHi(t);
|
|
|
+ 2243 IF SymTab.IsCharArray(t)
|
|
|
+ 2244 OR SymTab.IsUCharArray(t) THEN
|
|
|
+ 2245 hi := hi + 1
|
|
|
+ 2246 END;
|
|
|
+ 2247 QbeGen.IntStr(lo, qlo);
|
|
|
+ 2248 QbeGen.IntStr(hi, qhi)
|
|
|
+ 2249 END;
|
|
|
+ 2250 QbeGen.CheckRange(ql, qlo,
|
|
|
+ 2251 qhi);
|
|
|
+ 2252 eT := SymTab.ArrayElem(t);
|
|
|
+ 2253 QbeGen.ElemAddr(q, ql, qlo,
|
|
|
+ 2254 t, qe);
|
|
|
+ 2255 IF SymTab.ClassOf(eT) =
|
|
|
+ 2256 SymTab.ClArray THEN
|
|
|
+ 2257 QbeGen.ElemLoad(qe, eT, q)
|
|
|
+ 2258 ELSE QbeGen.CopyOp(qe, q)
|
|
|
+ 2259 END;
|
|
|
+ 2260 t := eT; sfx := TRUE
|
|
|
+ 2261 END; .)
|
|
|
+ 2262 { "," Expr<it, iq>
|
|
|
+ 2263 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2264 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2265 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2266 SymTab.ClArray THEN
|
|
|
+ 2267 SemError(217);
|
|
|
+ 2268 t := SymTab.InvalidType
|
|
|
+ 2269 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2270 AND (SymTab.ClassOf(it) #
|
|
|
+ 2271 SymTab.ClChar)
|
|
|
+ 2272 AND (SymTab.ClassOf(it) #
|
|
|
+ 2273 SymTab.ClEnum) THEN
|
|
|
+ 2274 SemError(218);
|
|
|
+ 2275 t := SymTab.InvalidType
|
|
|
+ 2276 ELSE
|
|
|
+ 2277 QbeGen.WidenIndex(iq, ql);
|
|
|
+ 2278 isOpen :=
|
|
|
+ 2279 SymTab.IsOpenArray(t);
|
|
|
+ 2280 IF isOpen THEN
|
|
|
+ 2281 QbeGen.CopyOp("0", qlo);
|
|
|
+ 2282 IF SymTab.IsCharArray(t)
|
|
|
+ 2283 OR SymTab.IsUCharArray(t) THEN
|
|
|
+ 2284 QbeGen.OpenHiChar(q, qhi)
|
|
|
+ 2285 ELSE QbeGen.OpenHi(q, qhi)
|
|
|
+ 2286 END
|
|
|
+ 2287 ELSE
|
|
|
+ 2288 lo := SymTab.ArrayLo(t);
|
|
|
+ 2289 hi := SymTab.ArrayHi(t);
|
|
|
+ 2290 IF SymTab.IsCharArray(t)
|
|
|
+ 2291 OR SymTab.IsUCharArray(t) THEN
|
|
|
+ 2292 hi := hi + 1
|
|
|
+ 2293 END;
|
|
|
+ 2294 QbeGen.IntStr(lo, qlo);
|
|
|
+ 2295 QbeGen.IntStr(hi, qhi)
|
|
|
+ 2296 END;
|
|
|
+ 2297 QbeGen.CheckRange(ql, qlo,
|
|
|
+ 2298 qhi);
|
|
|
+ 2299 eT := SymTab.ArrayElem(t);
|
|
|
+ 2300 QbeGen.ElemAddr(q, ql, qlo,
|
|
|
+ 2301 t, qe);
|
|
|
+ 2302 IF SymTab.ClassOf(eT) =
|
|
|
+ 2303 SymTab.ClArray THEN
|
|
|
+ 2304 QbeGen.ElemLoad(qe, eT, q)
|
|
|
+ 2305 ELSE QbeGen.CopyOp(qe, q)
|
|
|
+ 2306 END;
|
|
|
+ 2307 t := eT; sfx := TRUE
|
|
|
+ 2308 END; .) }
|
|
|
+ 2309 "]"
|
|
|
+ 2310 | "." GetIdent<fn>
|
|
|
+ 2311 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2312 AST.SetOp(astSel, AST.SelField);
|
|
|
+ 2313 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
+ 2314 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
+ 2315 (* qualified L.x: materialize
|
|
|
+ 2316 the export, then load it *)
|
|
|
+ 2317 IF NOT SymTab.MaterializeAlias(n,
|
|
|
+ 2318 fn, mal) THEN
|
|
|
+ 2319 SemError(201);
|
|
|
+ 2320 t := SymTab.InvalidType;
|
|
|
+ 2321 QbeGen.CopyOp("0", q)
|
|
|
+ 2322 ELSE
|
|
|
+ 2323 QbeGen.CopyOp(mal, qn);
|
|
|
+ 2324 t := SymTab.SymType(mal);
|
|
|
+ 2325 k := SymTab.SymKind(mal);
|
|
|
+ 2326 sfx := FALSE;
|
|
|
+ 2327 IF k = SymTab.KindProc THEN
|
|
|
+ 2328 (* call: ArgList supplies
|
|
|
+ 2329 the value *)
|
|
|
+ 2330 QbeGen.CopyOp("0", q)
|
|
|
+ 2331 ELSIF NOT QbeGen.LoadDesignator(
|
|
|
+ 2332 mal, t, k, q) THEN
|
|
|
+ 2333 SemError(230);
|
|
|
+ 2334 QbeGen.CopyOp("0", q)
|
|
|
+ 2335 END
|
|
|
+ 2336 END
|
|
|
+ 2337 ELSIF t = SymTab.InvalidType THEN
|
|
|
+ 2338 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2339 SymTab.ClRecord)
|
|
|
+ 2340 AND (SymTab.ClassOf(t) #
|
|
|
+ 2341 SymTab.ClClass) THEN
|
|
|
+ 2342 SemError(215);
|
|
|
+ 2343 t := SymTab.InvalidType
|
|
|
+ 2344 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 2345 SymTab.ClClass)
|
|
|
+ 2346 AND SymTab.MethodExists(t, fn) THEN
|
|
|
+ 2347 (* obj.Method: bind the
|
|
|
+ 2348 method and pass obj as
|
|
|
+ 2349 the hidden receiver; q
|
|
|
+ 2350 already holds the
|
|
|
+ 2351 object's address *)
|
|
|
+ 2352 QbeGen.ArmRecv(q);
|
|
|
+ 2353 QbeGen.CopyOp(fn, n);
|
|
|
+ 2354 QbeGen.CopyOp(fn, qn);
|
|
|
+ 2355 methCls := t;
|
|
|
+ 2356 k := SymTab.KindProc;
|
|
|
+ 2357 t := SymTab.InvalidType
|
|
|
+ 2358 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 2359 fn) THEN
|
|
|
+ 2360 SemError(216);
|
|
|
+ 2361 t := SymTab.InvalidType
|
|
|
+ 2362 ELSE
|
|
|
+ 2363 fo := SymTab.FieldOffset(t,
|
|
|
+ 2364 fn);
|
|
|
+ 2365 t := SymTab.FieldType(t, fn);
|
|
|
+ 2366 QbeGen.FieldAddr(q, fo, qe);
|
|
|
+ 2367 (* array fields are inline:
|
|
|
+ 2368 the field address is the
|
|
|
+ 2369 descriptor, like records *)
|
|
|
+ 2370 QbeGen.CopyOp(qe, q);
|
|
|
+ 2371 sfx := TRUE
|
|
|
+ 2372 END; .)
|
|
|
+ 2373 | "^"
|
|
|
+ 2374 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2375 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 2376 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 2377 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2378 SymTab.ClPtr THEN
|
|
|
+ 2379 SemError(219);
|
|
|
+ 2380 t := SymTab.InvalidType
|
|
|
+ 2381 ELSE
|
|
|
+ 2382 bt := SymTab.PtrBase(t);
|
|
|
+ 2383 IF bt = SymTab.InvalidType THEN
|
|
|
+ 2384 ELSE
|
|
|
+ 2385 IF sfx THEN
|
|
|
+ 2386 QbeGen.ElemLoad(q, t,
|
|
|
+ 2387 qb);
|
|
|
+ 2388 QbeGen.CopyOp(qb, q)
|
|
|
+ 2389 END;
|
|
|
+ 2390 t := bt;
|
|
|
+ 2391 (* q holds the pointee
|
|
|
+ 2392 address: Fact loads
|
|
|
+ 2393 scalars/pointers and uses
|
|
|
+ 2394 the address for
|
|
|
+ 2395 aggregates; the VAR-actual
|
|
|
+ 2396 note is q itself. *)
|
|
|
+ 2397 sfx := TRUE
|
|
|
+ 2398 END
|
|
|
+ 2399 END; .) } (. astCur := astDes; .) .
|
|
|
+ 2400 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
+ 2401 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
+ 2402 (a value, or a descriptor address for aggregates); each component
|
|
|
+ 2403 descends one level exactly like the Design components. *)
|
|
|
+ 2404 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 2405 VAR sfx: BOOLEAN; VAR node: AST.Node> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
+ 2406 iq, ql, qlo, qhi, qe, qb:
|
|
|
+ 2407 QbeGen.QVal;
|
|
|
+ 2408 lo, hi, fo: INTEGER;
|
|
|
+ 2409 isOpen: BOOLEAN;
|
|
|
+ 2410 fname: SymTab.Name;
|
|
|
+ 2411 astWrap, astSel: AST.Node; .)
|
|
|
+ 2412 = "[" Expr<it, iq>
|
|
|
+ 2413 (. IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2414 astWrap := AST.MakeNode(
|
|
|
+ 2415 AST.NkDesignator);
|
|
|
+ 2416 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2417 node := astWrap
|
|
|
+ 2418 END;
|
|
|
+ 2419 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 2420 AST.MakeUn(AST.NkSelector,
|
|
|
+ 2421 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2422 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2423 SymTab.ClArray THEN
|
|
|
+ 2424 SemError(217);
|
|
|
+ 2425 t := SymTab.InvalidType
|
|
|
+ 2426 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2427 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
+ 2428 AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
|
|
|
+ 2429 SemError(218);
|
|
|
+ 2430 t := SymTab.InvalidType
|
|
|
+ 2431 ELSE
|
|
|
+ 2432 QbeGen.WidenIndex(iq, ql);
|
|
|
+ 2433 isOpen :=
|
|
|
+ 2434 SymTab.IsOpenArray(t);
|
|
|
+ 2435 IF isOpen THEN
|
|
|
+ 2436 QbeGen.CopyOp("0", qlo);
|
|
|
+ 2437 IF SymTab.IsCharArray(t)
|
|
|
+ 2438 OR SymTab.IsUCharArray(t) THEN
|
|
|
+ 2439 QbeGen.OpenHiChar(q, qhi)
|
|
|
+ 2440 ELSE QbeGen.OpenHi(q, qhi)
|
|
|
+ 2441 END
|
|
|
+ 2442 ELSE
|
|
|
+ 2443 lo := SymTab.ArrayLo(t);
|
|
|
+ 2444 hi := SymTab.ArrayHi(t);
|
|
|
+ 2445 IF SymTab.IsCharArray(t)
|
|
|
+ 2446 OR SymTab.IsUCharArray(t) THEN
|
|
|
+ 2447 hi := hi + 1
|
|
|
+ 2448 END;
|
|
|
+ 2449 QbeGen.IntStr(lo, qlo);
|
|
|
+ 2450 QbeGen.IntStr(hi, qhi)
|
|
|
+ 2451 END;
|
|
|
+ 2452 QbeGen.CheckRange(ql, qlo,
|
|
|
+ 2453 qhi);
|
|
|
+ 2454 eT := SymTab.ArrayElem(t);
|
|
|
+ 2455 QbeGen.ElemAddr(q, ql, qlo,
|
|
|
+ 2456 t, qe);
|
|
|
+ 2457 IF SymTab.ClassOf(eT) =
|
|
|
+ 2458 SymTab.ClArray THEN
|
|
|
+ 2459 QbeGen.ElemLoad(qe, eT, q)
|
|
|
+ 2460 ELSE QbeGen.CopyOp(qe, q)
|
|
|
+ 2461 END;
|
|
|
+ 2462 t := eT; sfx := TRUE
|
|
|
+ 2463 END; .)
|
|
|
+ 2464 "]"
|
|
|
+ 2465 | "." GetIdent<fname>
|
|
|
+ 2466 (. IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2467 astWrap := AST.MakeNode(
|
|
|
+ 2468 AST.NkDesignator);
|
|
|
+ 2469 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2470 node := astWrap
|
|
|
+ 2471 END;
|
|
|
+ 2472 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 2473 AST.MakeUn(AST.NkSelector,
|
|
|
+ 2474 AST.SelField,
|
|
|
+ 2475 AST.MakeLeaf(AST.NkIdent,
|
|
|
+ 2476 fname))); IF t = SymTab.InvalidType THEN
|
|
|
+ 2477 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2478 SymTab.ClRecord)
|
|
|
+ 2479 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 2480 SemError(215);
|
|
|
+ 2481 t := SymTab.InvalidType
|
|
|
+ 2482 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 2483 fname) THEN
|
|
|
+ 2484 SemError(216);
|
|
|
+ 2485 t := SymTab.InvalidType
|
|
|
+ 2486 ELSE
|
|
|
+ 2487 fo := SymTab.FieldOffset(t,
|
|
|
+ 2488 fname);
|
|
|
+ 2489 t := SymTab.FieldType(t, fname);
|
|
|
+ 2490 QbeGen.FieldAddr(q, fo, qe);
|
|
|
+ 2491 QbeGen.CopyOp(qe, q);
|
|
|
+ 2492 sfx := TRUE
|
|
|
+ 2493 END; .)
|
|
|
+ 2494 | "^" (. IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2495 astWrap := AST.MakeNode(
|
|
|
+ 2496 AST.NkDesignator);
|
|
|
+ 2497 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2498 node := astWrap
|
|
|
+ 2499 END;
|
|
|
+ 2500 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2501 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 2502 AST.SetChild(node,
|
|
|
+ 2503 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 2504 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2505 SymTab.ClPtr THEN
|
|
|
+ 2506 SemError(219);
|
|
|
+ 2507 t := SymTab.InvalidType
|
|
|
+ 2508 ELSE
|
|
|
+ 2509 bt := SymTab.PtrBase(t);
|
|
|
+ 2510 IF bt # SymTab.InvalidType THEN
|
|
|
+ 2511 IF sfx THEN
|
|
|
+ 2512 QbeGen.ElemLoad(q, t, qb);
|
|
|
+ 2513 QbeGen.CopyOp(qb, q)
|
|
|
+ 2514 END;
|
|
|
+ 2515 t := bt; sfx := TRUE
|
|
|
+ 2516 END
|
|
|
+ 2517 END; .) .
|
|
|
+ 2518 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2519 (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 2520 op: INTEGER;
|
|
|
+ 2521 q2, qt, wl: QbeGen.QVal;
|
|
|
+ 2522 astA, astB: AST.Node;
|
|
|
+ 2523 astOp: INTEGER;
|
|
|
+ 2524 astMade: BOOLEAN;
|
|
|
+ 2525 isR: BOOLEAN; .)
|
|
|
+ 2526 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
+ 2527 [ Rel<op> SimExpr<t2, q2>
|
|
|
+ 2528 (. astB := astCur; astMade := TRUE;
|
|
|
+ 2529 astOp := AST.OpEq;
|
|
|
+ 2530 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
+ 2531 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
+ 2532 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
+ 2533 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
+ 2534 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
+ 2535 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
+ 2536 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
+ 2537 END;
|
|
|
+ 2538 IF op = SymTab.OpIn THEN
|
|
|
+ 2539 IF SymTab.InCheck(t, t2) THEN
|
|
|
+ 2540 IF (t = SymTab.InvalidType)
|
|
|
+ 2541 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 2542 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 2543 ELSE
|
|
|
+ 2544 QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2),
|
|
|
+ 2545 SymTab.SetCount(t2), qt);
|
|
|
+ 2546 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2547 END
|
|
|
+ 2548 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
+ 2549 QbeGen.CopyOp("0", q)
|
|
|
+ 2550 END
|
|
|
+ 2551 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ 2552 IF (t = SymTab.InvalidType)
|
|
|
+ 2553 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 2554 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 2555 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
+ 2556 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
+ 2557 IF SymTab.IsFwdVar(t) OR SymTab.IsFwdVar(t2) THEN
|
|
|
+ 2558 QbeGen.Cmp(op, q, q2, qt, FALSE);
|
|
|
+ 2559 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2560 ELSIF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
+ 2561 AND (op # SymTab.OpNeq2) THEN
|
|
|
+ 2562 SemError(213); t := SymTab.InvalidType;
|
|
|
+ 2563 QbeGen.CopyOp("0", q)
|
|
|
+ 2564 ELSE
|
|
|
+ 2565 QbeGen.CmpL(op, q, q2, qt);
|
|
|
+ 2566 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2567 END
|
|
|
+ 2568 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2569 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2570 QbeGen.CmpSet(op, q, q2,
|
|
|
+ 2571 SymTab.SetWords(t), SymTab.SetWords(t2), qt);
|
|
|
+ 2572 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2573 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 2574 QbeGen.StrEq(op, q, q2, qt);
|
|
|
+ 2575 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2576 ELSIF SymTab.IsLongFamily(t)
|
|
|
+ 2577 OR SymTab.IsLongFamily(t2) THEN
|
|
|
+ 2578 IF SymTab.IsIntFamily(t) THEN
|
|
|
+ 2579 QbeGen.WidenLong(q, wl); QbeGen.CopyOp(wl, q)
|
|
|
+ 2580 END;
|
|
|
+ 2581 IF SymTab.IsIntFamily(t2) THEN
|
|
|
+ 2582 QbeGen.WidenLong(q2, wl); QbeGen.CopyOp(wl, q2)
|
|
|
+ 2583 END;
|
|
|
+ 2584 QbeGen.CmpLong(op, q, q2, qt);
|
|
|
+ 2585 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2586 ELSE
|
|
|
+ 2587 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2588 t := SymTab.BoolType();
|
|
|
+ 2589 QbeGen.Cmp(op, q, q2, qt, isR);
|
|
|
+ 2590 QbeGen.CopyOp(qt, q)
|
|
|
+ 2591 END
|
|
|
+ 2592 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ 2593 QbeGen.CopyOp("0", q)
|
|
|
+ 2594 END;
|
|
|
+ 2595 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
+ 2596 (. IF NOT astMade THEN astCur := astA END; .) .
|
|
|
+ 2597 Rel<VAR op: INTEGER>
|
|
|
+ 2598 = "=" (. op := SymTab.OpEq; .)
|
|
|
+ 2599 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ 2600 | "<" (. op := SymTab.OpLt; .)
|
|
|
+ 2601 | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ 2602 | ">" (. op := SymTab.OpGt; .)
|
|
|
+ 2603 | ">=" (. op := SymTab.OpGe; .)
|
|
|
+ 2604 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
+ 2605 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2606 (. VAR t2, res2, lt, rt:
|
|
|
+ 2607 SymTab.TypeIndex;
|
|
|
+ 2608 op: INTEGER;
|
|
|
+ 2609 q2, qt, wq, qf, q2a, q2b:
|
|
|
+ 2610 QbeGen.QVal;
|
|
|
+ 2611 neg, isR, isL, folded:
|
|
|
+ 2612 BOOLEAN;
|
|
|
+ 2613 fok: BOOLEAN;
|
|
|
+ 2614 lw, rw, mw: CARDINAL;
|
|
|
+ 2615 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 2616 astA, astB: AST.Node;
|
|
|
+ 2617 astSign, astOp: INTEGER; .)
|
|
|
+ 2618 = (. neg := FALSE; astSign := 0; .)
|
|
|
+ 2619 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
+ 2620 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
+ 2621 Term<t, q> (. astA := astCur; IF neg THEN
|
|
|
+ 2622 IF QbeGen.IsImm(q) THEN
|
|
|
+ 2623 QbeGen.NegFold(q, q)
|
|
|
+ 2624 ELSE QbeGen.NewTemp(qt);
|
|
|
+ 2625 QbeGen.NegQ(q, qt,
|
|
|
+ 2626 SymTab.ClassOf(t)
|
|
|
+ 2627 = SymTab.ClReal);
|
|
|
+ 2628 QbeGen.CopyOp(qt, q)
|
|
|
+ 2629 END
|
|
|
+ 2630 END;
|
|
|
+ 2631 IF astSign < 0 THEN
|
|
|
+ 2632 astCur := AST.MakeUn(
|
|
|
+ 2633 AST.NkUnary, AST.OpSub, astA);
|
|
|
+ 2634 astA := astCur
|
|
|
+ 2635 END; .)
|
|
|
+ 2636 { AddOp<op> (. IF op = SymTab.OpOr THEN
|
|
|
+ 2637 QbeGen.DelayBegin END; .)
|
|
|
+ 2638 Term<t2, q2> (. astB := astCur; IF op = SymTab.OpOr THEN
|
|
|
+ 2639 QbeGen.DelayEnd END; .)
|
|
|
+ 2640 (. astOp := AST.OpAdd;
|
|
|
+ 2641 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
+ 2642 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
+ 2643 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 2644 astCur := astA;
|
|
|
+ 2645 IF op = SymTab.OpOr THEN
|
|
|
+ 2646 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
+ 2647 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 2648 t := SymTab.BoolType()
|
|
|
+ 2649 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 2650 IF t # SymTab.InvalidType THEN
|
|
|
+ 2651 QbeGen.Slot4(qs);
|
|
|
+ 2652 QbeGen.NewLabel(lTrue);
|
|
|
+ 2653 QbeGen.NewLabel(lNext);
|
|
|
+ 2654 QbeGen.NewLabel(lDone);
|
|
|
+ 2655 QbeGen.Jnz(q, lTrue, lNext);
|
|
|
+ 2656 QbeGen.EmitLabel(lTrue);
|
|
|
+ 2657 QbeGen.StoreW(qs, "1");
|
|
|
+ 2658 QbeGen.Jmp(lDone);
|
|
|
+ 2659 QbeGen.EmitLabel(lNext);
|
|
|
+ 2660 QbeGen.DelayFlush;
|
|
|
+ 2661 QbeGen.StoreW(qs, q2);
|
|
|
+ 2662 QbeGen.Jmp(lDone);
|
|
|
+ 2663 QbeGen.EmitLabel(lDone);
|
|
|
+ 2664 QbeGen.LoadW(qs, qr);
|
|
|
+ 2665 QbeGen.CopyOp(qr, q)
|
|
|
+ 2666 ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
|
|
|
+ 2667 END
|
|
|
+ 2668 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 2669 AND (SymTab.UStrCompat(t, t2)
|
|
|
+ 2670 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 2671 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
+ 2672 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
+ 2673 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
+ 2674 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 2675 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
+ 2676 (* UString concatenation: a UCHAR operand becomes a
|
|
|
+ 2677 1-codepoint UString; the result is a descriptor in the
|
|
|
+ 2678 shim's concat buffer. Work on copies so neither
|
|
|
+ 2679 operand is clobbered. *)
|
|
|
+ 2680 IF SymTab.ClassOf(t) = SymTab.ClUStr THEN
|
|
|
+ 2681 QbeGen.CopyOp(q, q2a)
|
|
|
2682 ELSE
|
|
|
- 2683 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
|
|
|
+ 2683 QbeGen.UStrFrom(q, q2a)
|
|
|
2684 END;
|
|
|
- 2685 t := SymTab.NewSet(
|
|
|
- 2686 SymTab.NewSubR(0,
|
|
|
- 2687 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 2688 QbeGen.CopyOp(qt, q)
|
|
|
- 2689 ELSE
|
|
|
- 2690 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
- 2691 lt := t; rt := t2; t := res2
|
|
|
- 2692 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 2693 IF t # SymTab.InvalidType THEN
|
|
|
- 2694 isL := SymTab.IsLongFamily(t);
|
|
|
- 2695 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 2696 folded := FALSE;
|
|
|
- 2697 IF (NOT isL) AND (NOT isR)
|
|
|
- 2698 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 2699 IF op = SymTab.OpAdd THEN
|
|
|
- 2700 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
- 2701 ELSE
|
|
|
- 2702 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
- 2703 END
|
|
|
- 2704 END;
|
|
|
- 2705 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 2706 ELSE
|
|
|
- 2707 IF isL THEN
|
|
|
- 2708 IF SymTab.IsIntFamily(lt) THEN
|
|
|
- 2709 QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
|
|
|
- 2710 END;
|
|
|
- 2711 IF SymTab.IsIntFamily(rt) THEN
|
|
|
- 2712 QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
|
|
|
- 2713 END;
|
|
|
- 2714 QbeGen.NewTemp(qt);
|
|
|
- 2715 IF op = SymTab.OpAdd THEN
|
|
|
- 2716 QbeGen.Op3L("add", qt, q, q2)
|
|
|
- 2717 ELSE
|
|
|
- 2718 QbeGen.Op3L("sub", qt, q, q2)
|
|
|
- 2719 END
|
|
|
- 2720 ELSE
|
|
|
- 2721 QbeGen.NewTemp(qt);
|
|
|
- 2722 IF op = SymTab.OpAdd THEN
|
|
|
- 2723 QbeGen.Op3("add", qt, q, q2, isR)
|
|
|
- 2724 ELSE
|
|
|
- 2725 QbeGen.Op3("sub", qt, q, q2, isR)
|
|
|
- 2726 END
|
|
|
- 2727 END;
|
|
|
- 2728 QbeGen.CopyOp(qt, q)
|
|
|
- 2729 END
|
|
|
- 2730 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2731 END
|
|
|
- 2732 END; .) } .
|
|
|
- 2733 AddOp<VAR op: INTEGER>
|
|
|
- 2734 = "+" (. op := SymTab.OpAdd; .)
|
|
|
- 2735 | "-" (. op := SymTab.OpSub; .)
|
|
|
- 2736 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
- 2737 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2738 (. VAR t2, res2, lt, rt:
|
|
|
- 2739 SymTab.TypeIndex;
|
|
|
- 2740 op: INTEGER;
|
|
|
- 2741 q2, qt, wq, qf:
|
|
|
- 2742 QbeGen.QVal;
|
|
|
- 2743 isR, isL, folded: BOOLEAN;
|
|
|
- 2744 lw, rw, mw: CARDINAL;
|
|
|
- 2745 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 2746 astA, astB: AST.Node;
|
|
|
- 2747 astOp: INTEGER; .)
|
|
|
- 2748 = Fact<t, q> (. astA := astCur; .) { MulOp<op> (. IF op = SymTab.OpAnd THEN
|
|
|
- 2749 QbeGen.DelayBegin END; .)
|
|
|
- 2750 Fact<t2, q2> (. astB := astCur; IF op = SymTab.OpAnd THEN
|
|
|
- 2751 QbeGen.DelayEnd END; .)
|
|
|
- 2752 (. astOp := AST.OpMul;
|
|
|
- 2753 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
- 2754 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
- 2755 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
- 2756 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
- 2757 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 2758 astCur := astA;
|
|
|
- 2759 IF op = SymTab.OpAnd THEN
|
|
|
- 2760 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
- 2761 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 2762 t := SymTab.BoolType()
|
|
|
- 2763 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 2764 IF t # SymTab.InvalidType THEN
|
|
|
- 2765 QbeGen.Slot4(qs);
|
|
|
- 2766 QbeGen.NewLabel(lNext);
|
|
|
- 2767 QbeGen.NewLabel(lFalse);
|
|
|
- 2768 QbeGen.NewLabel(lDone);
|
|
|
- 2769 QbeGen.Jnz(q, lNext, lFalse);
|
|
|
- 2770 QbeGen.EmitLabel(lNext);
|
|
|
- 2771 QbeGen.DelayFlush;
|
|
|
- 2772 QbeGen.StoreW(qs, q2);
|
|
|
- 2773 QbeGen.Jmp(lDone);
|
|
|
- 2774 QbeGen.EmitLabel(lFalse);
|
|
|
- 2775 QbeGen.StoreW(qs, "0");
|
|
|
- 2776 QbeGen.Jmp(lDone);
|
|
|
- 2777 QbeGen.EmitLabel(lDone);
|
|
|
- 2778 QbeGen.LoadW(qs, qr);
|
|
|
- 2779 QbeGen.CopyOp(qr, q)
|
|
|
- 2780 ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
|
|
|
- 2781 END
|
|
|
- 2782 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 2783 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2784 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2785 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 2786 mw := lw;
|
|
|
- 2787 IF rw > mw THEN mw := rw END;
|
|
|
- 2788 IF op = SymTab.OpTimes THEN
|
|
|
- 2789 QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
|
|
|
- 2790 ELSE
|
|
|
- 2791 QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
|
|
|
- 2792 END;
|
|
|
- 2793 t := SymTab.NewSet(
|
|
|
- 2794 SymTab.NewSubR(0,
|
|
|
- 2795 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 2796 QbeGen.CopyOp(qt, q)
|
|
|
- 2797 ELSE
|
|
|
- 2798 IF SymTab.ArithCheck(t, t2,
|
|
|
- 2799 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
- 2800 res2) THEN
|
|
|
- 2801 lt := t; rt := t2; t := res2
|
|
|
- 2802 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 2803 IF t # SymTab.InvalidType THEN
|
|
|
- 2804 isL := SymTab.IsLongFamily(t);
|
|
|
- 2805 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 2806 folded := FALSE;
|
|
|
- 2807 IF (NOT isL) AND (NOT isR)
|
|
|
- 2808 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 2809 IF op = SymTab.OpTimes THEN
|
|
|
- 2810 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
- 2811 ELSIF op = SymTab.OpDiv THEN
|
|
|
- 2812 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
- 2813 ELSIF op = SymTab.OpMod THEN
|
|
|
- 2814 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
- 2815 END
|
|
|
- 2816 END;
|
|
|
- 2817 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 2818 ELSE
|
|
|
- 2819 IF isL THEN
|
|
|
- 2820 IF SymTab.IsIntFamily(lt) THEN
|
|
|
- 2821 QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
|
|
|
- 2822 END;
|
|
|
- 2823 IF SymTab.IsIntFamily(rt) THEN
|
|
|
- 2824 QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
|
|
|
- 2825 END;
|
|
|
- 2826 QbeGen.NewTemp(qt);
|
|
|
- 2827 IF op = SymTab.OpTimes THEN
|
|
|
- 2828 QbeGen.Op3L("mul", qt, q, q2)
|
|
|
- 2829 ELSIF (op = SymTab.OpDiv)
|
|
|
- 2830 OR (op = SymTab.OpSlash) THEN
|
|
|
- 2831 QbeGen.Op3L("div", qt, q, q2)
|
|
|
- 2832 ELSE
|
|
|
- 2833 QbeGen.Op3L("rem", qt, q, q2)
|
|
|
- 2834 END
|
|
|
- 2835 ELSE
|
|
|
- 2836 QbeGen.NewTemp(qt);
|
|
|
- 2837 IF op = SymTab.OpTimes THEN
|
|
|
- 2838 QbeGen.Op3("mul", qt, q, q2, isR)
|
|
|
- 2839 ELSIF (op = SymTab.OpDiv)
|
|
|
- 2840 OR (op = SymTab.OpSlash) THEN
|
|
|
- 2841 QbeGen.Op3("div", qt, q, q2, isR)
|
|
|
- 2842 ELSE
|
|
|
- 2843 QbeGen.Op3("rem", qt, q, q2, isR)
|
|
|
- 2844 END
|
|
|
- 2845 END;
|
|
|
- 2846 QbeGen.CopyOp(qt, q)
|
|
|
- 2847 END
|
|
|
- 2848 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2849 END
|
|
|
- 2850 END; .) } .
|
|
|
- 2851 MulOp<VAR op: INTEGER>
|
|
|
- 2852 = "*" (. op := SymTab.OpTimes; .)
|
|
|
- 2853 | "/" (. op := SymTab.OpSlash; .)
|
|
|
- 2854 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
- 2855 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
- 2856 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
- 2857 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2858 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 2859 et, dt, t2, st, ct2, et2:
|
|
|
- 2860 SymTab.TypeIndex;
|
|
|
- 2861 dk: INTEGER;
|
|
|
- 2862 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
- 2863 QbeGen.QVal;
|
|
|
- 2864 qn, vn: SymTab.Name;
|
|
|
- 2865 vt: SymTab.TypeIndex;
|
|
|
- 2866 c1, c2: INTEGER;
|
|
|
- 2867 lo, hi: INTEGER;
|
|
|
- 2868 isMax: BOOLEAN;
|
|
|
- 2869 called, isHigh, sfx, isCh,
|
|
|
- 2870 isU, uok, isStr: BOOLEAN;
|
|
|
- 2871 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
- 2872 astD: AST.Node;
|
|
|
- 2873 astCall: BOOLEAN;
|
|
|
- 2874 astNode, astNot: AST.Node;
|
|
|
- 2875 j: CARDINAL;
|
|
|
- 2876 astArg2: AST.Node;
|
|
|
- 2877 astBrace: AST.Node; .)
|
|
|
- 2878 = (. astIsLit := FALSE; .)
|
|
|
- 2879 ( integer (. LexString(s);
|
|
|
- 2880 QbeGen.NormInt(s, q); IF twoPhase THEN astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s) END;
|
|
|
- 2881 t := SymTab.IntType(); .)
|
|
|
- 2882 | charConst (. LexString(s);
|
|
|
- 2883 QbeGen.NormLit(s, q, isCh);
|
|
|
- 2884 IF twoPhase THEN
|
|
|
- 2885 astIsLit := TRUE;
|
|
|
- 2886 astCur := AST.MakeLeaf(
|
|
|
- 2887 AST.NkCharLit, s)
|
|
|
- 2888 END;
|
|
|
- 2889 t := SymTab.CharType(); .)
|
|
|
- 2890 | real (. LexString(s);
|
|
|
- 2891 QbeGen.NormReal(s, q);
|
|
|
- 2892 IF twoPhase THEN
|
|
|
- 2893 astIsLit := TRUE;
|
|
|
- 2894 astCur := AST.MakeLeaf(
|
|
|
- 2895 AST.NkRealLit, s)
|
|
|
- 2896 END;
|
|
|
- 2897 t := SymTab.RealType(); .)
|
|
|
- 2898 | string (. LexString(s);
|
|
|
- 2899 IF twoPhase THEN
|
|
|
- 2900 astIsLit := TRUE;
|
|
|
- 2901 astCur := AST.MakeLeaf(
|
|
|
- 2902 AST.NkStrLit, s)
|
|
|
- 2903 END;
|
|
|
- 2904 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 2905 t := SymTab.CharType();
|
|
|
- 2906 QbeGen.IntStr(
|
|
|
- 2907 QbeGen.CharVal(s), q)
|
|
|
- 2908 ELSE t := SymTab.NewStr();
|
|
|
- 2909 QbeGen.DeclStr(s, q);
|
|
|
- 2910 (* a literal's value IS its
|
|
|
- 2911 static descriptor address *)
|
|
|
- 2912 QbeGen.NoteAddr(q, q)
|
|
|
- 2913 END; .)
|
|
|
- 2914 | ustring (. LexString(s);
|
|
|
- 2915 IF twoPhase THEN
|
|
|
- 2916 astIsLit := TRUE;
|
|
|
- 2917 astCur := AST.MakeLeaf(
|
|
|
- 2918 AST.NkStrLit, s)
|
|
|
- 2919 END;
|
|
|
- 2920 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
- 2921 uok);
|
|
|
- 2922 IF NOT uok THEN
|
|
|
- 2923 SemError(234);
|
|
|
- 2924 t := SymTab.InvalidType
|
|
|
- 2925 ELSIF isU THEN
|
|
|
- 2926 t := SymTab.UCharType();
|
|
|
- 2927 QbeGen.IntStr(ucp, q)
|
|
|
- 2928 ELSE
|
|
|
- 2929 t := SymTab.NewUStr();
|
|
|
- 2930 QbeGen.NoteAddr(q, q)
|
|
|
- 2931 END; .)
|
|
|
- 2932 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
- 2933 astNArgs := 0; called := FALSE;
|
|
|
- 2934 t := dt;
|
|
|
- 2935 IF sfx THEN
|
|
|
- 2936 IF dt =
|
|
|
- 2937 SymTab.InvalidType THEN
|
|
|
- 2938 QbeGen.CopyOp("0", q)
|
|
|
- 2939 ELSIF (SymTab.ClassOf(dt) =
|
|
|
- 2940 SymTab.ClRecord)
|
|
|
- 2941 OR (SymTab.ClassOf(dt) =
|
|
|
- 2942 SymTab.ClSet)
|
|
|
- 2943 OR (SymTab.ClassOf(dt) =
|
|
|
- 2944 SymTab.ClArray)
|
|
|
- 2945 OR (SymTab.ClassOf(dt) =
|
|
|
- 2946 SymTab.ClClass) THEN
|
|
|
- 2947 QbeGen.CopyOp(qd, q)
|
|
|
- 2948 ELSE QbeGen.ElemLoad(qd, dt,
|
|
|
- 2949 q)
|
|
|
- 2950 END
|
|
|
- 2951 ELSE QbeGen.CopyOp(qd, q)
|
|
|
- 2952 END;
|
|
|
- 2953 IF (dk = SymTab.KindVar)
|
|
|
- 2954 OR (dk = SymTab.KindParam)
|
|
|
- 2955 OR (dk =
|
|
|
- 2956 SymTab.KindField) THEN
|
|
|
- 2957 IF sfx THEN
|
|
|
- 2958 QbeGen.NoteAddr(q, qd)
|
|
|
- 2959 ELSE
|
|
|
- 2960 QbeGen.AddrOf(qn, qa);
|
|
|
- 2961 QbeGen.NoteAddr(q, qa)
|
|
|
- 2962 END
|
|
|
- 2963 ELSIF sfx
|
|
|
- 2964 AND (dt #
|
|
|
- 2965 SymTab.InvalidType)
|
|
|
- 2966 AND ((SymTab.ClassOf(dt) =
|
|
|
- 2967 SymTab.ClArray)
|
|
|
- 2968 OR (SymTab.ClassOf(dt) =
|
|
|
- 2969 SymTab.ClSet)
|
|
|
- 2970 OR (SymTab.ClassOf(dt) =
|
|
|
- 2971 SymTab.ClRecord)) THEN
|
|
|
- 2972 QbeGen.NoteAddr(qd, qd)
|
|
|
- 2973 END; .)
|
|
|
- 2974 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
- 2975 astBrace := astCur; .) ]
|
|
|
- 2976 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 2977 (. astCall := TRUE; t := ct2;
|
|
|
- 2978 QbeGen.CopyOp(q2, q);
|
|
|
- 2979 sfx := FALSE; .)
|
|
|
- 2980 { ResultComp<t, q, sfx> }
|
|
|
- 2981 (. IF sfx THEN
|
|
|
- 2982 IF t = SymTab.InvalidType THEN
|
|
|
+ 2685 IF SymTab.ClassOf(t2) = SymTab.ClUStr THEN
|
|
|
+ 2686 QbeGen.UStrCat(q2a, q2, qt)
|
|
|
+ 2687 ELSE
|
|
|
+ 2688 QbeGen.UStrFrom(q2, q2b);
|
|
|
+ 2689 QbeGen.UStrCat(q2a, q2b, qt)
|
|
|
+ 2690 END;
|
|
|
+ 2691 t := SymTab.NewUStr();
|
|
|
+ 2692 QbeGen.CopyOp(qt, q)
|
|
|
+ 2693 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 2694 AND (SymTab.StrCompat(t, t2)
|
|
|
+ 2695 OR (SymTab.IsStrType(t)
|
|
|
+ 2696 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
+ 2697 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 2698 AND SymTab.IsStrType(t2))) THEN
|
|
|
+ 2699 (* string concatenation; a CHAR operand becomes a
|
|
|
+ 2700 1-character string literal. When both operands are
|
|
|
+ 2701 constants, fold to a single string literal so a
|
|
|
+ 2702 constructor element stays compile-time. *)
|
|
|
+ 2703 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
+ 2704 qt, fok);
|
|
|
+ 2705 IF NOT fok THEN
|
|
|
+ 2706 IF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 2707 QbeGen.StrCat(q, q2, qt)
|
|
|
+ 2708 ELSIF SymTab.IsStrType(t) THEN
|
|
|
+ 2709 QbeGen.DeclCharStr(q2, qs);
|
|
|
+ 2710 QbeGen.StrCat(q, qs, qt)
|
|
|
+ 2711 ELSE
|
|
|
+ 2712 QbeGen.DeclCharStr(q, qs);
|
|
|
+ 2713 QbeGen.StrCat(qs, q2, qt)
|
|
|
+ 2714 END
|
|
|
+ 2715 END;
|
|
|
+ 2716 t := SymTab.NewStr();
|
|
|
+ 2717 QbeGen.CopyOp(qt, q)
|
|
|
+ 2718 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 2719 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2720 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2721 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 2722 mw := lw;
|
|
|
+ 2723 IF rw > mw THEN mw := rw END;
|
|
|
+ 2724 IF op = SymTab.OpAdd THEN
|
|
|
+ 2725 QbeGen.SetBinOp(0, q, q2, lw, rw, qt)
|
|
|
+ 2726 ELSE
|
|
|
+ 2727 QbeGen.SetBinOp(2, q, q2, lw, rw, qt)
|
|
|
+ 2728 END;
|
|
|
+ 2729 t := SymTab.NewSet(
|
|
|
+ 2730 SymTab.NewSubR(0,
|
|
|
+ 2731 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 2732 QbeGen.CopyOp(qt, q)
|
|
|
+ 2733 ELSE
|
|
|
+ 2734 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ 2735 lt := t; rt := t2; t := res2
|
|
|
+ 2736 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 2737 IF t # SymTab.InvalidType THEN
|
|
|
+ 2738 isL := SymTab.IsLongFamily(t);
|
|
|
+ 2739 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2740 folded := FALSE;
|
|
|
+ 2741 IF (NOT isL) AND (NOT isR)
|
|
|
+ 2742 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 2743 IF op = SymTab.OpAdd THEN
|
|
|
+ 2744 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
+ 2745 ELSE
|
|
|
+ 2746 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
+ 2747 END
|
|
|
+ 2748 END;
|
|
|
+ 2749 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 2750 ELSE
|
|
|
+ 2751 IF isL THEN
|
|
|
+ 2752 IF SymTab.IsIntFamily(lt) THEN
|
|
|
+ 2753 QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
|
|
|
+ 2754 END;
|
|
|
+ 2755 IF SymTab.IsIntFamily(rt) THEN
|
|
|
+ 2756 QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
|
|
|
+ 2757 END;
|
|
|
+ 2758 QbeGen.NewTemp(qt);
|
|
|
+ 2759 IF op = SymTab.OpAdd THEN
|
|
|
+ 2760 QbeGen.Op3L("add", qt, q, q2)
|
|
|
+ 2761 ELSE
|
|
|
+ 2762 QbeGen.Op3L("sub", qt, q, q2)
|
|
|
+ 2763 END
|
|
|
+ 2764 ELSE
|
|
|
+ 2765 QbeGen.NewTemp(qt);
|
|
|
+ 2766 IF op = SymTab.OpAdd THEN
|
|
|
+ 2767 QbeGen.Op3("add", qt, q, q2, isR)
|
|
|
+ 2768 ELSE
|
|
|
+ 2769 QbeGen.Op3("sub", qt, q, q2, isR)
|
|
|
+ 2770 END
|
|
|
+ 2771 END;
|
|
|
+ 2772 QbeGen.CopyOp(qt, q)
|
|
|
+ 2773 END
|
|
|
+ 2774 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2775 END
|
|
|
+ 2776 END; .) } .
|
|
|
+ 2777 AddOp<VAR op: INTEGER>
|
|
|
+ 2778 = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ 2779 | "-" (. op := SymTab.OpSub; .)
|
|
|
+ 2780 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ 2781 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2782 (. VAR t2, res2, lt, rt:
|
|
|
+ 2783 SymTab.TypeIndex;
|
|
|
+ 2784 op: INTEGER;
|
|
|
+ 2785 q2, qt, wq, qf:
|
|
|
+ 2786 QbeGen.QVal;
|
|
|
+ 2787 isR, isL, folded: BOOLEAN;
|
|
|
+ 2788 lw, rw, mw: CARDINAL;
|
|
|
+ 2789 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 2790 astA, astB: AST.Node;
|
|
|
+ 2791 astOp: INTEGER; .)
|
|
|
+ 2792 = Fact<t, q> (. astA := astCur; .) { MulOp<op> (. IF op = SymTab.OpAnd THEN
|
|
|
+ 2793 QbeGen.DelayBegin END; .)
|
|
|
+ 2794 Fact<t2, q2> (. astB := astCur; IF op = SymTab.OpAnd THEN
|
|
|
+ 2795 QbeGen.DelayEnd END; .)
|
|
|
+ 2796 (. astOp := AST.OpMul;
|
|
|
+ 2797 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
+ 2798 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
+ 2799 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
+ 2800 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
+ 2801 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 2802 astCur := astA;
|
|
|
+ 2803 IF op = SymTab.OpAnd THEN
|
|
|
+ 2804 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
+ 2805 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 2806 t := SymTab.BoolType()
|
|
|
+ 2807 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 2808 IF t # SymTab.InvalidType THEN
|
|
|
+ 2809 QbeGen.Slot4(qs);
|
|
|
+ 2810 QbeGen.NewLabel(lNext);
|
|
|
+ 2811 QbeGen.NewLabel(lFalse);
|
|
|
+ 2812 QbeGen.NewLabel(lDone);
|
|
|
+ 2813 QbeGen.Jnz(q, lNext, lFalse);
|
|
|
+ 2814 QbeGen.EmitLabel(lNext);
|
|
|
+ 2815 QbeGen.DelayFlush;
|
|
|
+ 2816 QbeGen.StoreW(qs, q2);
|
|
|
+ 2817 QbeGen.Jmp(lDone);
|
|
|
+ 2818 QbeGen.EmitLabel(lFalse);
|
|
|
+ 2819 QbeGen.StoreW(qs, "0");
|
|
|
+ 2820 QbeGen.Jmp(lDone);
|
|
|
+ 2821 QbeGen.EmitLabel(lDone);
|
|
|
+ 2822 QbeGen.LoadW(qs, qr);
|
|
|
+ 2823 QbeGen.CopyOp(qr, q)
|
|
|
+ 2824 ELSE QbeGen.DelayFlush; QbeGen.CopyOp("0", q)
|
|
|
+ 2825 END
|
|
|
+ 2826 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 2827 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2828 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2829 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 2830 mw := lw;
|
|
|
+ 2831 IF rw > mw THEN mw := rw END;
|
|
|
+ 2832 IF op = SymTab.OpTimes THEN
|
|
|
+ 2833 QbeGen.SetBinOp(1, q, q2, lw, rw, qt)
|
|
|
+ 2834 ELSE
|
|
|
+ 2835 QbeGen.SetBinOp(3, q, q2, lw, rw, qt)
|
|
|
+ 2836 END;
|
|
|
+ 2837 t := SymTab.NewSet(
|
|
|
+ 2838 SymTab.NewSubR(0,
|
|
|
+ 2839 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 2840 QbeGen.CopyOp(qt, q)
|
|
|
+ 2841 ELSE
|
|
|
+ 2842 IF SymTab.ArithCheck(t, t2,
|
|
|
+ 2843 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ 2844 res2) THEN
|
|
|
+ 2845 lt := t; rt := t2; t := res2
|
|
|
+ 2846 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 2847 IF t # SymTab.InvalidType THEN
|
|
|
+ 2848 isL := SymTab.IsLongFamily(t);
|
|
|
+ 2849 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2850 folded := FALSE;
|
|
|
+ 2851 IF (NOT isL) AND (NOT isR)
|
|
|
+ 2852 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 2853 IF op = SymTab.OpTimes THEN
|
|
|
+ 2854 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
+ 2855 ELSIF op = SymTab.OpDiv THEN
|
|
|
+ 2856 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
+ 2857 ELSIF op = SymTab.OpMod THEN
|
|
|
+ 2858 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
+ 2859 END
|
|
|
+ 2860 END;
|
|
|
+ 2861 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 2862 ELSE
|
|
|
+ 2863 IF isL THEN
|
|
|
+ 2864 IF SymTab.IsIntFamily(lt) THEN
|
|
|
+ 2865 QbeGen.WidenLong(q, wq); QbeGen.CopyOp(wq, q)
|
|
|
+ 2866 END;
|
|
|
+ 2867 IF SymTab.IsIntFamily(rt) THEN
|
|
|
+ 2868 QbeGen.WidenLong(q2, wq); QbeGen.CopyOp(wq, q2)
|
|
|
+ 2869 END;
|
|
|
+ 2870 QbeGen.NewTemp(qt);
|
|
|
+ 2871 IF op = SymTab.OpTimes THEN
|
|
|
+ 2872 QbeGen.Op3L("mul", qt, q, q2)
|
|
|
+ 2873 ELSIF (op = SymTab.OpDiv)
|
|
|
+ 2874 OR (op = SymTab.OpSlash) THEN
|
|
|
+ 2875 QbeGen.Op3L("div", qt, q, q2)
|
|
|
+ 2876 ELSE
|
|
|
+ 2877 QbeGen.Op3L("rem", qt, q, q2)
|
|
|
+ 2878 END
|
|
|
+ 2879 ELSE
|
|
|
+ 2880 QbeGen.NewTemp(qt);
|
|
|
+ 2881 IF op = SymTab.OpTimes THEN
|
|
|
+ 2882 QbeGen.Op3("mul", qt, q, q2, isR)
|
|
|
+ 2883 ELSIF (op = SymTab.OpDiv)
|
|
|
+ 2884 OR (op = SymTab.OpSlash) THEN
|
|
|
+ 2885 QbeGen.Op3("div", qt, q, q2, isR)
|
|
|
+ 2886 ELSE
|
|
|
+ 2887 QbeGen.Op3("rem", qt, q, q2, isR)
|
|
|
+ 2888 END
|
|
|
+ 2889 END;
|
|
|
+ 2890 QbeGen.CopyOp(qt, q)
|
|
|
+ 2891 END
|
|
|
+ 2892 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2893 END
|
|
|
+ 2894 END; .) } .
|
|
|
+ 2895 MulOp<VAR op: INTEGER>
|
|
|
+ 2896 = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ 2897 | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ 2898 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ 2899 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ 2900 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
+ 2901 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2902 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 2903 et, dt, t2, st, ct2, et2:
|
|
|
+ 2904 SymTab.TypeIndex;
|
|
|
+ 2905 dk: INTEGER;
|
|
|
+ 2906 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
+ 2907 QbeGen.QVal;
|
|
|
+ 2908 qn, vn: SymTab.Name;
|
|
|
+ 2909 vt: SymTab.TypeIndex;
|
|
|
+ 2910 c1, c2: INTEGER;
|
|
|
+ 2911 lo, hi: INTEGER;
|
|
|
+ 2912 isMax: BOOLEAN;
|
|
|
+ 2913 called, isHigh, sfx, isCh,
|
|
|
+ 2914 isU, uok, isStr: BOOLEAN;
|
|
|
+ 2915 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
+ 2916 astD: AST.Node;
|
|
|
+ 2917 astCall: BOOLEAN;
|
|
|
+ 2918 astNode, astNot: AST.Node;
|
|
|
+ 2919 j: CARDINAL;
|
|
|
+ 2920 astArg2: AST.Node;
|
|
|
+ 2921 astBrace: AST.Node;
|
|
|
+ 2922 astRes: AST.Node; .)
|
|
|
+ 2923 = (. astIsLit := FALSE; .)
|
|
|
+ 2924 ( integer (. LexString(s);
|
|
|
+ 2925 QbeGen.NormInt(s, q); IF twoPhase THEN astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s) END;
|
|
|
+ 2926 t := SymTab.IntType(); .)
|
|
|
+ 2927 | charConst (. LexString(s);
|
|
|
+ 2928 QbeGen.NormLit(s, q, isCh);
|
|
|
+ 2929 IF twoPhase THEN
|
|
|
+ 2930 astIsLit := TRUE;
|
|
|
+ 2931 astCur := AST.MakeLeaf(
|
|
|
+ 2932 AST.NkCharLit, s)
|
|
|
+ 2933 END;
|
|
|
+ 2934 t := SymTab.CharType(); .)
|
|
|
+ 2935 | real (. LexString(s);
|
|
|
+ 2936 QbeGen.NormReal(s, q);
|
|
|
+ 2937 IF twoPhase THEN
|
|
|
+ 2938 astIsLit := TRUE;
|
|
|
+ 2939 astCur := AST.MakeLeaf(
|
|
|
+ 2940 AST.NkRealLit, s)
|
|
|
+ 2941 END;
|
|
|
+ 2942 t := SymTab.RealType(); .)
|
|
|
+ 2943 | string (. LexString(s);
|
|
|
+ 2944 IF twoPhase THEN
|
|
|
+ 2945 astIsLit := TRUE;
|
|
|
+ 2946 astCur := AST.MakeLeaf(
|
|
|
+ 2947 AST.NkStrLit, s)
|
|
|
+ 2948 END;
|
|
|
+ 2949 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 2950 t := SymTab.CharType();
|
|
|
+ 2951 QbeGen.IntStr(
|
|
|
+ 2952 QbeGen.CharVal(s), q)
|
|
|
+ 2953 ELSE t := SymTab.NewStr();
|
|
|
+ 2954 QbeGen.DeclStr(s, q);
|
|
|
+ 2955 (* a literal's value IS its
|
|
|
+ 2956 static descriptor address *)
|
|
|
+ 2957 QbeGen.NoteAddr(q, q)
|
|
|
+ 2958 END; .)
|
|
|
+ 2959 | ustring (. LexString(s);
|
|
|
+ 2960 IF twoPhase THEN
|
|
|
+ 2961 astIsLit := TRUE;
|
|
|
+ 2962 astCur := AST.MakeLeaf(
|
|
|
+ 2963 AST.NkStrLit, s)
|
|
|
+ 2964 END;
|
|
|
+ 2965 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
+ 2966 uok);
|
|
|
+ 2967 IF NOT uok THEN
|
|
|
+ 2968 SemError(234);
|
|
|
+ 2969 t := SymTab.InvalidType
|
|
|
+ 2970 ELSIF isU THEN
|
|
|
+ 2971 t := SymTab.UCharType();
|
|
|
+ 2972 QbeGen.IntStr(ucp, q)
|
|
|
+ 2973 ELSE
|
|
|
+ 2974 t := SymTab.NewUStr();
|
|
|
+ 2975 QbeGen.NoteAddr(q, q)
|
|
|
+ 2976 END; .)
|
|
|
+ 2977 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
+ 2978 astNArgs := 0; called := FALSE;
|
|
|
+ 2979 t := dt;
|
|
|
+ 2980 IF sfx THEN
|
|
|
+ 2981 IF dt =
|
|
|
+ 2982 SymTab.InvalidType THEN
|
|
|
2983 QbeGen.CopyOp("0", q)
|
|
|
- 2984 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2984 ELSIF (SymTab.ClassOf(dt) =
|
|
|
2985 SymTab.ClRecord)
|
|
|
- 2986 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
- 2987 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
- 2988 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 2989 QbeGen.ElemLoad(q, t, q2);
|
|
|
- 2990 QbeGen.CopyOp(q2, q)
|
|
|
- 2991 END
|
|
|
- 2992 END; .) ]
|
|
|
- 2993 (. IF called THEN
|
|
|
- 2994 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2995 AST.SetChild(astNode, 0, astD);
|
|
|
- 2996 j := 0;
|
|
|
- 2997 WHILE (j < astNArgs)
|
|
|
- 2998 AND (AST.NChild(astNode) <
|
|
|
- 2999 AST.MaxChild) DO
|
|
|
- 3000 AST.SetChild(astNode,
|
|
|
- 3001 AST.NChild(astNode), astArgs[j]);
|
|
|
- 3002 INC(j)
|
|
|
- 3003 END;
|
|
|
- 3004 astCur := astNode
|
|
|
- 3005 ELSIF astCall THEN
|
|
|
- 3006 astCur := astBrace
|
|
|
- 3007 ELSE astCur := astD
|
|
|
- 3008 END;
|
|
|
- 3009 astIsLit := TRUE;
|
|
|
- 3010 IF NOT called
|
|
|
- 3011 AND (dk = SymTab.KindProc) THEN
|
|
|
- 3012 (* bare zero-arg function
|
|
|
- 3013 call (parentheses may be
|
|
|
- 3014 omitted); a proper or
|
|
|
- 3015 parameterised proc here
|
|
|
- 3016 is 230 *)
|
|
|
- 3017 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
- 3018 AND (SymTab.ProcRes(qn) #
|
|
|
- 3019 SymTab.InvalidType) THEN
|
|
|
- 3020 QbeGen.Mangled(qn,
|
|
|
- 3021 SymTab.ProcUid(qn), qm0);
|
|
|
- 3022 QbeGen.CallBegin(qm0,
|
|
|
- 3023 SymTab.ProcRes(qn),
|
|
|
- 3024 SymTab.ProcDepthOf(qn),
|
|
|
- 3025 SymTab.IsExternal(qn));
|
|
|
- 3026 QbeGen.CallEnd(TRUE, q);
|
|
|
- 3027 t := SymTab.ProcRes(qn)
|
|
|
- 3028 ELSE
|
|
|
- 3029 (* procedure used as a
|
|
|
- 3030 value (assign to a
|
|
|
- 3031 procedure variable):
|
|
|
- 3032 its code address *)
|
|
|
- 3033 t := SymTab.ProcTypeOf(qn);
|
|
|
- 3034 QbeGen.Mangled(qn,
|
|
|
- 3035 SymTab.ProcUid(qn), qm0);
|
|
|
- 3036 QbeGen.ProcAddr(qm0, q)
|
|
|
- 3037 END
|
|
|
- 3038 END; .)
|
|
|
- 3039 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
- 3040 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
- 3041 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
- 3042 isU := FALSE; .)
|
|
|
- 3043 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3044 isStr := TRUE;
|
|
|
- 3045 isU := FALSE;
|
|
|
- 3046 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3047 dt := SymTab.CharType();
|
|
|
- 3048 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
- 3049 qd)
|
|
|
- 3050 ELSE
|
|
|
- 3051 dt := SymTab.NewStr();
|
|
|
- 3052 QbeGen.DeclStr(s, qd);
|
|
|
- 3053 QbeGen.NoteAddr(qd, qd)
|
|
|
- 3054 END;
|
|
|
- 3055 dk := -1;
|
|
|
- 3056 qn[0] := CHR(0); .)
|
|
|
- 3057 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3058 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
- 3059 uok);
|
|
|
- 3060 isStr := FALSE;
|
|
|
- 3061 IF NOT uok THEN
|
|
|
- 3062 SemError(234);
|
|
|
- 3063 dt := SymTab.InvalidType
|
|
|
- 3064 ELSIF isU THEN
|
|
|
- 3065 (* one codepoint: a UCHAR;
|
|
|
- 3066 LEN is 1, HIGH is 0 *)
|
|
|
- 3067 dt := SymTab.UCharType();
|
|
|
- 3068 QbeGen.IntStr(ucp, qd)
|
|
|
- 3069 ELSE
|
|
|
- 3070 dt := SymTab.NewUStr();
|
|
|
- 3071 QbeGen.NoteAddr(qd, qd)
|
|
|
- 3072 END;
|
|
|
- 3073 dk := -1;
|
|
|
- 3074 qn[0] := CHR(0); .) )
|
|
|
- 3075 ")"
|
|
|
- 3076 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3077 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
- 3078 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
- 3079 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3080 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
- 3081 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3082 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3083 IF (dt # SymTab.InvalidType)
|
|
|
- 3084 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
- 3085 (* UString: the count is
|
|
|
- 3086 the descriptor header *)
|
|
|
- 3087 IF isHigh THEN
|
|
|
- 3088 QbeGen.UStrLen(qd, qr);
|
|
|
- 3089 QbeGen.DecQ(qr)
|
|
|
- 3090 ELSE
|
|
|
- 3091 QbeGen.UStrLen(qd, qr)
|
|
|
- 3092 END;
|
|
|
- 3093 t := SymTab.IntType();
|
|
|
- 3094 QbeGen.CopyOp(qr, q)
|
|
|
- 3095 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 3096 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
- 3097 (* single UCHAR codepoint *)
|
|
|
- 3098 IF isHigh THEN
|
|
|
- 3099 QbeGen.CopyOp("0", qr)
|
|
|
- 3100 ELSE
|
|
|
- 3101 QbeGen.CopyOp("1", qr)
|
|
|
- 3102 END;
|
|
|
- 3103 t := SymTab.IntType();
|
|
|
- 3104 QbeGen.CopyOp(qr, q)
|
|
|
- 3105 ELSIF isStr THEN
|
|
|
- 3106 (* fold: content length at
|
|
|
- 3107 compile time *)
|
|
|
- 3108 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3109 c1 := 1
|
|
|
- 3110 ELSE
|
|
|
- 3111 c1 :=
|
|
|
- 3112 SymTab.StrLen(s) - 2
|
|
|
- 3113 END;
|
|
|
- 3114 IF isHigh THEN
|
|
|
- 3115 DEC(c1)
|
|
|
- 3116 END;
|
|
|
- 3117 QbeGen.IntStr(c1, qr);
|
|
|
- 3118 t := SymTab.IntType();
|
|
|
- 3119 QbeGen.CopyOp(qr, q)
|
|
|
- 3120 ELSIF dt = SymTab.InvalidType THEN
|
|
|
- 3121 t := SymTab.InvalidType;
|
|
|
- 3122 QbeGen.CopyOp("0", q)
|
|
|
- 3123 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 3124 SymTab.ClArray THEN
|
|
|
- 3125 SemError(217);
|
|
|
- 3126 t := SymTab.InvalidType;
|
|
|
- 3127 QbeGen.CopyOp("0", q)
|
|
|
- 3128 ELSE
|
|
|
- 3129 IF isHigh THEN
|
|
|
- 3130 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3131 QbeGen.OpenHi(qd, qr)
|
|
|
- 3132 ELSE
|
|
|
- 3133 QbeGen.IntStr(
|
|
|
- 3134 SymTab.ArrayHi(dt), qr)
|
|
|
- 3135 END
|
|
|
- 3136 ELSE
|
|
|
- 3137 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3138 QbeGen.LoadCount(qd, qr)
|
|
|
- 3139 ELSE
|
|
|
- 3140 QbeGen.IntStr(VAL(
|
|
|
- 3141 INTEGER,
|
|
|
- 3142 SymTab.ArrayLen(dt)),
|
|
|
- 3143 qr)
|
|
|
- 3144 END
|
|
|
- 3145 END;
|
|
|
- 3146 t := SymTab.IntType();
|
|
|
- 3147 QbeGen.CopyOp(qr, q)
|
|
|
- 3148 END; .)
|
|
|
- 3149 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3150 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3151 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
- 3152 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3153 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3154 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3155 t := SymTab.InvalidType;
|
|
|
- 3156 QbeGen.CopyOp("0", q)
|
|
|
- 3157 ELSE
|
|
|
- 3158 QbeGen.IntStr(VAL(INTEGER,
|
|
|
- 3159 SymTab.ObjectSize(dt)), q);
|
|
|
- 3160 t := SymTab.IntType()
|
|
|
- 3161 END; .)
|
|
|
- 3162 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
- 3163 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
- 3164 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
- 3165 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3166 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3167 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
- 3168 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3169 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
- 3170 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3171 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3172 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3173 (* set shift/rotate: isMax
|
|
|
- 3174 doubles as "rotate" *)
|
|
|
- 3175 IF (et # SymTab.InvalidType)
|
|
|
- 3176 AND (SymTab.ClassOf(et) =
|
|
|
- 3177 SymTab.ClSet) THEN
|
|
|
- 3178 QbeGen.SetShift(q, q2,
|
|
|
- 3179 SymTab.SetWords(et),
|
|
|
- 3180 SymTab.SetCount(et), isMax,
|
|
|
- 3181 qt);
|
|
|
- 3182 t := et;
|
|
|
- 3183 QbeGen.CopyOp(qt, q)
|
|
|
- 3184 ELSE SemError(230);
|
|
|
- 3185 t := SymTab.InvalidType;
|
|
|
- 3186 QbeGen.CopyOp("0", q)
|
|
|
- 3187 END; .)
|
|
|
- 3188 | ( "MIN" (. isMax := FALSE; .)
|
|
|
- 3189 | "MAX" (. isMax := TRUE; .) )
|
|
|
- 3190 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3191 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3192 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3193 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
- 3194 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3195 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
- 3196 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3197 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3198 IF (dt # SymTab.InvalidType)
|
|
|
- 3199 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
- 3200 (* REAL/LONGREAL: the
|
|
|
- 3201 implementation bounds *)
|
|
|
- 3202 IF isMax THEN
|
|
|
- 3203 QbeGen.NormReal(
|
|
|
- 3204 "3.402823e38", q)
|
|
|
- 3205 ELSE QbeGen.NormReal(
|
|
|
- 3206 "-3.402823e38", q)
|
|
|
- 3207 END;
|
|
|
- 3208 t := SymTab.RealType()
|
|
|
- 3209 ELSIF (dt #
|
|
|
- 3210 SymTab.InvalidType)
|
|
|
- 3211 AND (SymTab.ClassOf(dt) =
|
|
|
- 3212 SymTab.ClLong) THEN
|
|
|
- 3213 IF isMax THEN
|
|
|
- 3214 QbeGen.CopyOp(
|
|
|
- 3215 "9223372036854775807", q)
|
|
|
- 3216 ELSE QbeGen.CopyOp(
|
|
|
- 3217 "-9223372036854775808", q)
|
|
|
- 3218 END;
|
|
|
- 3219 t := SymTab.LongType()
|
|
|
- 3220 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
- 3221 hi) THEN
|
|
|
- 3222 IF isMax THEN
|
|
|
- 3223 QbeGen.IntStr(hi, q)
|
|
|
- 3224 ELSE QbeGen.IntStr(lo, q)
|
|
|
- 3225 END;
|
|
|
- 3226 t := SymTab.IntType()
|
|
|
- 3227 ELSE SemError(230);
|
|
|
- 3228 t := SymTab.InvalidType;
|
|
|
- 3229 QbeGen.CopyOp("0", q)
|
|
|
- 3230 END; .)
|
|
|
- 3231 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3232 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3233 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 2986 OR (SymTab.ClassOf(dt) =
|
|
|
+ 2987 SymTab.ClSet)
|
|
|
+ 2988 OR (SymTab.ClassOf(dt) =
|
|
|
+ 2989 SymTab.ClArray)
|
|
|
+ 2990 OR (SymTab.ClassOf(dt) =
|
|
|
+ 2991 SymTab.ClClass) THEN
|
|
|
+ 2992 QbeGen.CopyOp(qd, q)
|
|
|
+ 2993 ELSE QbeGen.ElemLoad(qd, dt,
|
|
|
+ 2994 q)
|
|
|
+ 2995 END
|
|
|
+ 2996 ELSE QbeGen.CopyOp(qd, q)
|
|
|
+ 2997 END;
|
|
|
+ 2998 IF (dk = SymTab.KindVar)
|
|
|
+ 2999 OR (dk = SymTab.KindParam)
|
|
|
+ 3000 OR (dk =
|
|
|
+ 3001 SymTab.KindField) THEN
|
|
|
+ 3002 IF sfx THEN
|
|
|
+ 3003 QbeGen.NoteAddr(q, qd)
|
|
|
+ 3004 ELSE
|
|
|
+ 3005 QbeGen.AddrOf(qn, qa);
|
|
|
+ 3006 QbeGen.NoteAddr(q, qa)
|
|
|
+ 3007 END
|
|
|
+ 3008 ELSIF sfx
|
|
|
+ 3009 AND (dt #
|
|
|
+ 3010 SymTab.InvalidType)
|
|
|
+ 3011 AND ((SymTab.ClassOf(dt) =
|
|
|
+ 3012 SymTab.ClArray)
|
|
|
+ 3013 OR (SymTab.ClassOf(dt) =
|
|
|
+ 3014 SymTab.ClSet)
|
|
|
+ 3015 OR (SymTab.ClassOf(dt) =
|
|
|
+ 3016 SymTab.ClRecord)) THEN
|
|
|
+ 3017 QbeGen.NoteAddr(qd, qd)
|
|
|
+ 3018 END; .)
|
|
|
+ 3019 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
+ 3020 astBrace := astCur; .) ]
|
|
|
+ 3021 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3022 (. astCall := TRUE;
|
|
|
+ 3023 astNode := AstCallNode(astD);
|
|
|
+ 3024 astRes := astNode;
|
|
|
+ 3025 t := ct2;
|
|
|
+ 3026 QbeGen.CopyOp(q2, q);
|
|
|
+ 3027 sfx := FALSE; .)
|
|
|
+ 3028 { ResultComp<t, q, sfx, astRes> }
|
|
|
+ 3029 (. IF sfx THEN
|
|
|
+ 3030 IF t = SymTab.InvalidType THEN
|
|
|
+ 3031 QbeGen.CopyOp("0", q)
|
|
|
+ 3032 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3033 SymTab.ClRecord)
|
|
|
+ 3034 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
+ 3035 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
+ 3036 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3037 QbeGen.ElemLoad(q, t, q2);
|
|
|
+ 3038 QbeGen.CopyOp(q2, q)
|
|
|
+ 3039 END
|
|
|
+ 3040 END; .) ]
|
|
|
+ 3041 (. IF called THEN
|
|
|
+ 3042 astCur := astRes
|
|
|
+ 3043 ELSIF astCall THEN
|
|
|
+ 3044 astCur := astBrace
|
|
|
+ 3045 ELSE astCur := astD
|
|
|
+ 3046 END;
|
|
|
+ 3047 astIsLit := TRUE;
|
|
|
+ 3048 IF NOT called
|
|
|
+ 3049 AND (dk = SymTab.KindProc) THEN
|
|
|
+ 3050 (* bare zero-arg function
|
|
|
+ 3051 call (parentheses may be
|
|
|
+ 3052 omitted); a proper or
|
|
|
+ 3053 parameterised proc here
|
|
|
+ 3054 is 230 *)
|
|
|
+ 3055 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
+ 3056 AND (SymTab.ProcRes(qn) #
|
|
|
+ 3057 SymTab.InvalidType) THEN
|
|
|
+ 3058 QbeGen.Mangled(qn,
|
|
|
+ 3059 SymTab.ProcUid(qn), qm0);
|
|
|
+ 3060 QbeGen.CallBegin(qm0,
|
|
|
+ 3061 SymTab.ProcRes(qn),
|
|
|
+ 3062 SymTab.ProcDepthOf(qn),
|
|
|
+ 3063 SymTab.IsExternal(qn));
|
|
|
+ 3064 QbeGen.CallEnd(TRUE, q);
|
|
|
+ 3065 t := SymTab.ProcRes(qn)
|
|
|
+ 3066 ELSE
|
|
|
+ 3067 (* procedure used as a
|
|
|
+ 3068 value (assign to a
|
|
|
+ 3069 procedure variable):
|
|
|
+ 3070 its code address *)
|
|
|
+ 3071 t := SymTab.ProcTypeOf(qn);
|
|
|
+ 3072 QbeGen.Mangled(qn,
|
|
|
+ 3073 SymTab.ProcUid(qn), qm0);
|
|
|
+ 3074 QbeGen.ProcAddr(qm0, q)
|
|
|
+ 3075 END
|
|
|
+ 3076 END; .)
|
|
|
+ 3077 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
+ 3078 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
+ 3079 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
+ 3080 isU := FALSE; .)
|
|
|
+ 3081 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3082 isStr := TRUE;
|
|
|
+ 3083 isU := FALSE;
|
|
|
+ 3084 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3085 dt := SymTab.CharType();
|
|
|
+ 3086 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
+ 3087 qd)
|
|
|
+ 3088 ELSE
|
|
|
+ 3089 dt := SymTab.NewStr();
|
|
|
+ 3090 QbeGen.DeclStr(s, qd);
|
|
|
+ 3091 QbeGen.NoteAddr(qd, qd)
|
|
|
+ 3092 END;
|
|
|
+ 3093 dk := -1;
|
|
|
+ 3094 qn[0] := CHR(0); .)
|
|
|
+ 3095 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3096 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
+ 3097 uok);
|
|
|
+ 3098 isStr := FALSE;
|
|
|
+ 3099 IF NOT uok THEN
|
|
|
+ 3100 SemError(234);
|
|
|
+ 3101 dt := SymTab.InvalidType
|
|
|
+ 3102 ELSIF isU THEN
|
|
|
+ 3103 (* one codepoint: a UCHAR;
|
|
|
+ 3104 LEN is 1, HIGH is 0 *)
|
|
|
+ 3105 dt := SymTab.UCharType();
|
|
|
+ 3106 QbeGen.IntStr(ucp, qd)
|
|
|
+ 3107 ELSE
|
|
|
+ 3108 dt := SymTab.NewUStr();
|
|
|
+ 3109 QbeGen.NoteAddr(qd, qd)
|
|
|
+ 3110 END;
|
|
|
+ 3111 dk := -1;
|
|
|
+ 3112 qn[0] := CHR(0); .) )
|
|
|
+ 3113 ")"
|
|
|
+ 3114 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3115 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
+ 3116 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
+ 3117 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3118 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
+ 3119 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3120 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3121 IF (dt # SymTab.InvalidType)
|
|
|
+ 3122 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
+ 3123 (* UString: the count is
|
|
|
+ 3124 the descriptor header *)
|
|
|
+ 3125 IF isHigh THEN
|
|
|
+ 3126 QbeGen.UStrLen(qd, qr);
|
|
|
+ 3127 QbeGen.DecQ(qr)
|
|
|
+ 3128 ELSE
|
|
|
+ 3129 QbeGen.UStrLen(qd, qr)
|
|
|
+ 3130 END;
|
|
|
+ 3131 t := SymTab.IntType();
|
|
|
+ 3132 QbeGen.CopyOp(qr, q)
|
|
|
+ 3133 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 3134 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
+ 3135 (* single UCHAR codepoint *)
|
|
|
+ 3136 IF isHigh THEN
|
|
|
+ 3137 QbeGen.CopyOp("0", qr)
|
|
|
+ 3138 ELSE
|
|
|
+ 3139 QbeGen.CopyOp("1", qr)
|
|
|
+ 3140 END;
|
|
|
+ 3141 t := SymTab.IntType();
|
|
|
+ 3142 QbeGen.CopyOp(qr, q)
|
|
|
+ 3143 ELSIF isStr THEN
|
|
|
+ 3144 (* fold: content length at
|
|
|
+ 3145 compile time *)
|
|
|
+ 3146 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3147 c1 := 1
|
|
|
+ 3148 ELSE
|
|
|
+ 3149 c1 :=
|
|
|
+ 3150 SymTab.StrLen(s) - 2
|
|
|
+ 3151 END;
|
|
|
+ 3152 IF isHigh THEN
|
|
|
+ 3153 DEC(c1)
|
|
|
+ 3154 END;
|
|
|
+ 3155 QbeGen.IntStr(c1, qr);
|
|
|
+ 3156 t := SymTab.IntType();
|
|
|
+ 3157 QbeGen.CopyOp(qr, q)
|
|
|
+ 3158 ELSIF dt = SymTab.InvalidType THEN
|
|
|
+ 3159 t := SymTab.InvalidType;
|
|
|
+ 3160 QbeGen.CopyOp("0", q)
|
|
|
+ 3161 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 3162 SymTab.ClArray THEN
|
|
|
+ 3163 SemError(217);
|
|
|
+ 3164 t := SymTab.InvalidType;
|
|
|
+ 3165 QbeGen.CopyOp("0", q)
|
|
|
+ 3166 ELSE
|
|
|
+ 3167 IF isHigh THEN
|
|
|
+ 3168 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 3169 QbeGen.OpenHi(qd, qr)
|
|
|
+ 3170 ELSE
|
|
|
+ 3171 QbeGen.IntStr(
|
|
|
+ 3172 SymTab.ArrayHi(dt), qr)
|
|
|
+ 3173 END
|
|
|
+ 3174 ELSE
|
|
|
+ 3175 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 3176 QbeGen.LoadCount(qd, qr)
|
|
|
+ 3177 ELSE
|
|
|
+ 3178 QbeGen.IntStr(VAL(
|
|
|
+ 3179 INTEGER,
|
|
|
+ 3180 SymTab.ArrayLen(dt)),
|
|
|
+ 3181 qr)
|
|
|
+ 3182 END
|
|
|
+ 3183 END;
|
|
|
+ 3184 t := SymTab.IntType();
|
|
|
+ 3185 QbeGen.CopyOp(qr, q)
|
|
|
+ 3186 END; .)
|
|
|
+ 3187 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3188 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3189 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
+ 3190 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3191 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3192 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3193 t := SymTab.InvalidType;
|
|
|
+ 3194 QbeGen.CopyOp("0", q)
|
|
|
+ 3195 ELSE
|
|
|
+ 3196 QbeGen.IntStr(VAL(INTEGER,
|
|
|
+ 3197 SymTab.ObjectSize(dt)), q);
|
|
|
+ 3198 t := SymTab.IntType()
|
|
|
+ 3199 END; .)
|
|
|
+ 3200 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
+ 3201 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
+ 3202 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
+ 3203 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3204 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3205 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
+ 3206 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3207 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
+ 3208 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3209 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3210 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3211 (* set shift/rotate: isMax
|
|
|
+ 3212 doubles as "rotate" *)
|
|
|
+ 3213 IF (et # SymTab.InvalidType)
|
|
|
+ 3214 AND (SymTab.ClassOf(et) =
|
|
|
+ 3215 SymTab.ClSet) THEN
|
|
|
+ 3216 QbeGen.SetShift(q, q2,
|
|
|
+ 3217 SymTab.SetWords(et),
|
|
|
+ 3218 SymTab.SetCount(et), isMax,
|
|
|
+ 3219 qt);
|
|
|
+ 3220 t := et;
|
|
|
+ 3221 QbeGen.CopyOp(qt, q)
|
|
|
+ 3222 ELSE SemError(230);
|
|
|
+ 3223 t := SymTab.InvalidType;
|
|
|
+ 3224 QbeGen.CopyOp("0", q)
|
|
|
+ 3225 END; .)
|
|
|
+ 3226 | ( "MIN" (. isMax := FALSE; .)
|
|
|
+ 3227 | "MAX" (. isMax := TRUE; .) )
|
|
|
+ 3228 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3229 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3230 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3231 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
+ 3232 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3233 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
3234 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3235 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3236 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3237 t := SymTab.InvalidType;
|
|
|
- 3238 QbeGen.CopyOp("0", q)
|
|
|
- 3239 ELSE
|
|
|
- 3240 IF sfx THEN
|
|
|
- 3241 QbeGen.CopyOp(qd, q)
|
|
|
- 3242 ELSIF (dk = SymTab.KindVar)
|
|
|
- 3243 OR (dk = SymTab.KindParam) THEN
|
|
|
- 3244 QbeGen.AddrOf(qn, q)
|
|
|
- 3245 ELSE SemError(230);
|
|
|
- 3246 QbeGen.CopyOp("0", q)
|
|
|
- 3247 END;
|
|
|
- 3248 t := SymTab.AddrType()
|
|
|
- 3249 END; .)
|
|
|
- 3250 | "CHR" "(" Expr<et, q> ")"
|
|
|
- 3251 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3252 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
- 3253 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3254 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3255 (. IF (et # SymTab.InvalidType)
|
|
|
- 3256 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3257 SemError(211) END;
|
|
|
- 3258 t := SymTab.CharType(); .)
|
|
|
- 3259 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
|
|
|
- 3260 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3261 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
- 3262 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3263 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3264 (. IF et # SymTab.InvalidType THEN
|
|
|
- 3265 IF (SymTab.ClassOf(et) #
|
|
|
- 3266 SymTab.ClChar)
|
|
|
- 3267 AND (SymTab.ClassOf(et) #
|
|
|
- 3268 SymTab.ClBool)
|
|
|
- 3269 AND (SymTab.ClassOf(et) #
|
|
|
- 3270 SymTab.ClEnum)
|
|
|
- 3271 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3272 SemError(211) END
|
|
|
- 3273 END;
|
|
|
- 3274 t := SymTab.IntType(); .)
|
|
|
- 3275 | "CAP" "(" Expr<et, q> ")"
|
|
|
- 3276 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3277 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
- 3278 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3279 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3280 (. QbeGen.CapQ(q, qa);
|
|
|
- 3281 QbeGen.CopyOp(qa, q);
|
|
|
- 3282 t := SymTab.CharType(); .)
|
|
|
- 3283 | "UCHR" "(" Expr<et, q> ")"
|
|
|
- 3284 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3285 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
- 3286 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3287 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3288 (. (* UCHR: the UCHAR constructor.
|
|
|
- 3289 CHAR -> UCHAR (identity);
|
|
|
- 3290 INTEGER familly -> UCHAR
|
|
|
- 3291 (codepoint value). *)
|
|
|
- 3292 IF (et # SymTab.InvalidType)
|
|
|
- 3293 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
- 3294 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3235 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3236 IF (dt # SymTab.InvalidType)
|
|
|
+ 3237 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
+ 3238 (* REAL/LONGREAL: the
|
|
|
+ 3239 implementation bounds *)
|
|
|
+ 3240 IF isMax THEN
|
|
|
+ 3241 QbeGen.NormReal(
|
|
|
+ 3242 "3.402823e38", q)
|
|
|
+ 3243 ELSE QbeGen.NormReal(
|
|
|
+ 3244 "-3.402823e38", q)
|
|
|
+ 3245 END;
|
|
|
+ 3246 t := SymTab.RealType()
|
|
|
+ 3247 ELSIF (dt #
|
|
|
+ 3248 SymTab.InvalidType)
|
|
|
+ 3249 AND (SymTab.ClassOf(dt) =
|
|
|
+ 3250 SymTab.ClLong) THEN
|
|
|
+ 3251 IF isMax THEN
|
|
|
+ 3252 QbeGen.CopyOp(
|
|
|
+ 3253 "9223372036854775807", q)
|
|
|
+ 3254 ELSE QbeGen.CopyOp(
|
|
|
+ 3255 "-9223372036854775808", q)
|
|
|
+ 3256 END;
|
|
|
+ 3257 t := SymTab.LongType()
|
|
|
+ 3258 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
+ 3259 hi) THEN
|
|
|
+ 3260 IF isMax THEN
|
|
|
+ 3261 QbeGen.IntStr(hi, q)
|
|
|
+ 3262 ELSE QbeGen.IntStr(lo, q)
|
|
|
+ 3263 END;
|
|
|
+ 3264 t := SymTab.IntType()
|
|
|
+ 3265 ELSE SemError(230);
|
|
|
+ 3266 t := SymTab.InvalidType;
|
|
|
+ 3267 QbeGen.CopyOp("0", q)
|
|
|
+ 3268 END; .)
|
|
|
+ 3269 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3270 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3271 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 3272 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3273 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3274 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3275 t := SymTab.InvalidType;
|
|
|
+ 3276 QbeGen.CopyOp("0", q)
|
|
|
+ 3277 ELSE
|
|
|
+ 3278 IF sfx THEN
|
|
|
+ 3279 QbeGen.CopyOp(qd, q)
|
|
|
+ 3280 ELSIF (dk = SymTab.KindVar)
|
|
|
+ 3281 OR (dk = SymTab.KindParam) THEN
|
|
|
+ 3282 QbeGen.AddrOf(qn, q)
|
|
|
+ 3283 ELSE SemError(230);
|
|
|
+ 3284 QbeGen.CopyOp("0", q)
|
|
|
+ 3285 END;
|
|
|
+ 3286 t := SymTab.AddrType()
|
|
|
+ 3287 END; .)
|
|
|
+ 3288 | "CHR" "(" Expr<et, q> ")"
|
|
|
+ 3289 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3290 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
+ 3291 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3292 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3293 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3294 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
3295 SemError(211) END;
|
|
|
- 3296 t := SymTab.UCharType(); .)
|
|
|
- 3297 | "CHR8" "(" Expr<et, q> ")"
|
|
|
+ 3296 t := SymTab.CharType(); .)
|
|
|
+ 3297 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
|
|
|
3298 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3299 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
+ 3299 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
3300 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
3301 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3302 (. IF (et # SymTab.InvalidType)
|
|
|
- 3303 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3304 SemError(211) END;
|
|
|
- 3305 QbeGen.WidenLong(q, qa);
|
|
|
- 3306 QbeGen.CheckRange(qa, "0", "255");
|
|
|
- 3307 t := SymTab.CharType(); .)
|
|
|
- 3308 | "UORD" "(" Expr<et, q> ")"
|
|
|
- 3309 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3310 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
- 3311 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3312 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3313 (. (* UORD(u): the codepoint as a
|
|
|
- 3314 32-bit ordinal (INTEGER),
|
|
|
- 3315 cf. ORD for CHAR. *)
|
|
|
- 3316 IF (et # SymTab.InvalidType)
|
|
|
- 3317 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3318 SemError(211) END;
|
|
|
- 3319 t := SymTab.IntType(); .)
|
|
|
- 3320 | "ABS" "(" Expr<et, q> ")"
|
|
|
- 3321 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3322 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
- 3323 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3324 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3325 (. IF (et # SymTab.InvalidType)
|
|
|
- 3326 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 3327 AND (SymTab.ClassOf(et) #
|
|
|
- 3328 SymTab.ClReal) THEN
|
|
|
- 3329 SemError(211)
|
|
|
- 3330 ELSE QbeGen.AbsQ(q, qa,
|
|
|
- 3331 SymTab.ClassOf(et) =
|
|
|
- 3332 SymTab.ClReal);
|
|
|
- 3333 QbeGen.CopyOp(qa, q)
|
|
|
- 3334 END;
|
|
|
- 3335 t := et; .)
|
|
|
- 3336 | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
- 3337 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3338 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3339 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3340 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3341 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3342 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
- 3343 SemError(201);
|
|
|
- 3344 t := SymTab.InvalidType
|
|
|
- 3345 ELSE vt := SymTab.SymType(vn);
|
|
|
- 3346 IF vt = SymTab.InvalidType THEN
|
|
|
- 3347 t := SymTab.InvalidType
|
|
|
- 3348 ELSIF et =
|
|
|
- 3349 SymTab.InvalidType THEN
|
|
|
- 3350 t := vt
|
|
|
- 3351 ELSE
|
|
|
- 3352 c1 := SymTab.ClassOf(et);
|
|
|
- 3353 c2 := SymTab.ClassOf(vt);
|
|
|
- 3354 IF (c1 = SymTab.ClInt)
|
|
|
- 3355 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3356 QbeGen.WidenLong(q, qa);
|
|
|
- 3357 QbeGen.CopyOp(qa, q);
|
|
|
- 3358 t := vt
|
|
|
- 3359 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3360 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3361 QbeGen.NarrowLong(q, qa);
|
|
|
- 3362 QbeGen.CopyOp(qa, q);
|
|
|
- 3363 t := vt
|
|
|
- 3364 ELSIF (c1 = SymTab.ClInt)
|
|
|
- 3365 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3366 QbeGen.ConvIR(q, qa);
|
|
|
- 3367 QbeGen.CopyOp(qa, q);
|
|
|
- 3368 t := vt
|
|
|
- 3369 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3370 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3371 QbeGen.ConvLR(q, qa);
|
|
|
- 3372 QbeGen.CopyOp(qa, q);
|
|
|
- 3373 t := vt
|
|
|
- 3374 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3375 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3376 QbeGen.ConvRI(q, qa);
|
|
|
- 3377 QbeGen.CopyOp(qa, q);
|
|
|
- 3378 t := vt
|
|
|
- 3379 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3380 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3381 QbeGen.ConvRL(q, qa);
|
|
|
- 3382 QbeGen.CopyOp(qa, q);
|
|
|
- 3383 t := vt
|
|
|
- 3384 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 3385 OR (c1 =
|
|
|
- 3386 SymTab.ClChar)
|
|
|
- 3387 OR (c1 =
|
|
|
- 3388 SymTab.ClBool)
|
|
|
- 3389 OR (c1 =
|
|
|
- 3390 SymTab.ClEnum))
|
|
|
- 3391 AND ((c2 = SymTab.ClInt)
|
|
|
- 3392 OR (c2 =
|
|
|
- 3393 SymTab.ClChar)
|
|
|
- 3394 OR (c2 =
|
|
|
- 3395 SymTab.ClBool)
|
|
|
- 3396 OR (c2 =
|
|
|
- 3397 SymTab.ClEnum)) THEN
|
|
|
- 3398 t := vt
|
|
|
- 3399 ELSIF (c1 = SymTab.ClPtr)
|
|
|
- 3400 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 3302 (. IF et # SymTab.InvalidType THEN
|
|
|
+ 3303 IF (SymTab.ClassOf(et) #
|
|
|
+ 3304 SymTab.ClChar)
|
|
|
+ 3305 AND (SymTab.ClassOf(et) #
|
|
|
+ 3306 SymTab.ClBool)
|
|
|
+ 3307 AND (SymTab.ClassOf(et) #
|
|
|
+ 3308 SymTab.ClEnum)
|
|
|
+ 3309 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3310 SemError(211) END
|
|
|
+ 3311 END;
|
|
|
+ 3312 t := SymTab.IntType(); .)
|
|
|
+ 3313 | "CAP" "(" Expr<et, q> ")"
|
|
|
+ 3314 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3315 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
+ 3316 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3317 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3318 (. QbeGen.CapQ(q, qa);
|
|
|
+ 3319 QbeGen.CopyOp(qa, q);
|
|
|
+ 3320 t := SymTab.CharType(); .)
|
|
|
+ 3321 | "UCHR" "(" Expr<et, q> ")"
|
|
|
+ 3322 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3323 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
+ 3324 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3325 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3326 (. (* UCHR: the UCHAR constructor.
|
|
|
+ 3327 CHAR -> UCHAR (identity);
|
|
|
+ 3328 INTEGER familly -> UCHAR
|
|
|
+ 3329 (codepoint value). *)
|
|
|
+ 3330 IF (et # SymTab.InvalidType)
|
|
|
+ 3331 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
+ 3332 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3333 SemError(211) END;
|
|
|
+ 3334 t := SymTab.UCharType(); .)
|
|
|
+ 3335 | "CHR8" "(" Expr<et, q> ")"
|
|
|
+ 3336 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3337 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
+ 3338 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3339 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3340 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3341 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3342 SemError(211) END;
|
|
|
+ 3343 QbeGen.WidenLong(q, qa);
|
|
|
+ 3344 QbeGen.CheckRange(qa, "0", "255");
|
|
|
+ 3345 t := SymTab.CharType(); .)
|
|
|
+ 3346 | "UORD" "(" Expr<et, q> ")"
|
|
|
+ 3347 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3348 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
+ 3349 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3350 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3351 (. (* UORD(u): the codepoint as a
|
|
|
+ 3352 32-bit ordinal (INTEGER),
|
|
|
+ 3353 cf. ORD for CHAR. *)
|
|
|
+ 3354 IF (et # SymTab.InvalidType)
|
|
|
+ 3355 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3356 SemError(211) END;
|
|
|
+ 3357 t := SymTab.IntType(); .)
|
|
|
+ 3358 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 3359 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3360 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3361 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3362 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3363 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3364 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 3365 AND (SymTab.ClassOf(et) #
|
|
|
+ 3366 SymTab.ClReal) THEN
|
|
|
+ 3367 SemError(211)
|
|
|
+ 3368 ELSE QbeGen.AbsQ(q, qa,
|
|
|
+ 3369 SymTab.ClassOf(et) =
|
|
|
+ 3370 SymTab.ClReal);
|
|
|
+ 3371 QbeGen.CopyOp(qa, q)
|
|
|
+ 3372 END;
|
|
|
+ 3373 t := et; .)
|
|
|
+ 3374 | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
+ 3375 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3376 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3377 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3378 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3379 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3380 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
+ 3381 SemError(201);
|
|
|
+ 3382 t := SymTab.InvalidType
|
|
|
+ 3383 ELSE vt := SymTab.SymType(vn);
|
|
|
+ 3384 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3385 t := SymTab.InvalidType
|
|
|
+ 3386 ELSIF et =
|
|
|
+ 3387 SymTab.InvalidType THEN
|
|
|
+ 3388 t := vt
|
|
|
+ 3389 ELSE
|
|
|
+ 3390 c1 := SymTab.ClassOf(et);
|
|
|
+ 3391 c2 := SymTab.ClassOf(vt);
|
|
|
+ 3392 IF (c1 = SymTab.ClInt)
|
|
|
+ 3393 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3394 QbeGen.WidenLong(q, qa);
|
|
|
+ 3395 QbeGen.CopyOp(qa, q);
|
|
|
+ 3396 t := vt
|
|
|
+ 3397 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3398 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3399 QbeGen.NarrowLong(q, qa);
|
|
|
+ 3400 QbeGen.CopyOp(qa, q);
|
|
|
3401 t := vt
|
|
|
- 3402 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3403 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3404 t := vt
|
|
|
- 3405 ELSE SemError(230);
|
|
|
- 3406 t := SymTab.InvalidType
|
|
|
- 3407 END
|
|
|
- 3408 END
|
|
|
- 3409 END; .)
|
|
|
- 3410 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
- 3411 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
- 3412 QbeGen.CopyOp(sq, q); .)
|
|
|
- 3413 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
- 3414 IF SymTab.BoolCheck(t2) THEN
|
|
|
- 3415 t := SymTab.BoolType()
|
|
|
- 3416 ELSE SemError(212);
|
|
|
- 3417 t := SymTab.InvalidType END;
|
|
|
- 3418 IF t # SymTab.InvalidType THEN
|
|
|
- 3419 QbeGen.NotQ(q2, q)
|
|
|
- 3420 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3421 END;
|
|
|
- 3422 astIsLit := TRUE;
|
|
|
- 3423 astCur := AST.MakeUn(
|
|
|
- 3424 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
- 3425 )
|
|
|
- 3426 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .) .
|
|
|
- 3427 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
- 3428 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
- 3429 for computed elements. Ranges always lower via SetRange. *)
|
|
|
- 3430 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3431 (. VAR astNode: AST.Node; .)
|
|
|
- 3432 = "{" (. t := SymTab.NewSet(
|
|
|
- 3433 SymTab.NewSubR(0, 255));
|
|
|
- 3434 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
- 3435 QbeGen.NewSetTemp(8, q);
|
|
|
- 3436 QbeGen.SetZero(q, 8); .)
|
|
|
- 3437 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
- 3438 "}" (. astCur := astNode; .) .
|
|
|
- 3439 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
- 3440 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
- 3441 declared type sets the width (set) or element type (array). *)
|
|
|
- 3442 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3443 (. VAR nw: CARDINAL;
|
|
|
- 3444 astNode: AST.Node;
|
|
|
- 3445 savedCls: INTEGER; .)
|
|
|
- 3446 = "{" (. savedCls := braceCls;
|
|
|
- 3447 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
- 3448 IF vt = SymTab.InvalidType THEN
|
|
|
- 3449 braceCls := -1
|
|
|
- 3450 ELSE braceCls :=
|
|
|
- 3451 SymTab.ClassOf(vt)
|
|
|
- 3452 END;
|
|
|
- 3453 IF braceCls = SymTab.ClSet THEN
|
|
|
- 3454 IF vt = SymTab.InvalidType THEN
|
|
|
- 3455 nw := 8
|
|
|
- 3456 ELSE nw := SymTab.SetWords(vt);
|
|
|
- 3457 IF nw = 0 THEN nw := 8 END
|
|
|
- 3458 END;
|
|
|
- 3459 QbeGen.NewSetTemp(nw, q);
|
|
|
- 3460 QbeGen.SetZero(q, nw)
|
|
|
- 3461 ELSIF (braceCls =
|
|
|
- 3462 SymTab.ClArray)
|
|
|
- 3463 OR (braceCls =
|
|
|
- 3464 SymTab.ClRecord)
|
|
|
- 3465 OR (braceCls =
|
|
|
- 3466 SymTab.ClClass) THEN
|
|
|
- 3467 QbeGen.CtorBegin(vt)
|
|
|
- 3468 ELSE
|
|
|
- 3469 IF vt # SymTab.InvalidType THEN
|
|
|
- 3470 SemError(230) END;
|
|
|
- 3471 braceCls := -1
|
|
|
- 3472 END; .)
|
|
|
- 3473 [ BraceElem<vt, q, astNode> { "," BraceElem<vt, q, astNode> } ]
|
|
|
- 3474 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
- 3475 OR (braceCls =
|
|
|
- 3476 SymTab.ClRecord)
|
|
|
- 3477 OR (braceCls =
|
|
|
- 3478 SymTab.ClClass) THEN
|
|
|
- 3479 QbeGen.CtorEnd(q)
|
|
|
- 3480 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
- 3481 QbeGen.CopyOp("0", q)
|
|
|
- 3482 END;
|
|
|
- 3483 braceCls := savedCls; .)
|
|
|
- 3484 (. astCur := astNode; .) .
|
|
|
- 3485 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal; node: AST.Node>
|
|
|
- 3486 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 3487 qe, q2: QbeGen.QVal;
|
|
|
- 3488 v, v2, reps, k: INTEGER;
|
|
|
- 3489 elem: SymTab.TypeIndex;
|
|
|
- 3490 lo: INTEGER;
|
|
|
- 3491 span: CARDINAL;
|
|
|
- 3492 cl, cl2: INTEGER;
|
|
|
- 3493 hasR, hasB: BOOLEAN;
|
|
|
- 3494 astEl: AST.Node; .)
|
|
|
- 3495 = (. hasR := FALSE; hasB := FALSE; .)
|
|
|
- 3496 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 3497 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 3498 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 3499 hasR := TRUE; .) ]
|
|
|
- 3500 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
- 3501 (. IF braceCls = SymTab.ClSet THEN
|
|
|
- 3502 IF hasB THEN SemError(230) END;
|
|
|
- 3503 lo := SymTab.SetBaseLo(vt);
|
|
|
- 3504 span := SymTab.SetCount(vt);
|
|
|
- 3505 IF (et = SymTab.InvalidType)
|
|
|
- 3506 OR (hasR AND (et2 =
|
|
|
- 3507 SymTab.InvalidType)) THEN
|
|
|
- 3508 ELSE cl :=
|
|
|
- 3509 SymTab.ClassOf(et);
|
|
|
- 3510 IF hasR THEN
|
|
|
- 3511 cl2 :=
|
|
|
- 3512 SymTab.ClassOf(et2)
|
|
|
- 3513 ELSE cl2 := SymTab.ClInt
|
|
|
- 3514 END;
|
|
|
- 3515 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 3516 OR (hasR AND NOT
|
|
|
- 3517 SymTab.SetElemClassOk(cl2))
|
|
|
- 3518 THEN
|
|
|
- 3519 SemError(222)
|
|
|
- 3520 ELSIF hasR
|
|
|
- 3521 AND SymTab.ConstInt(qe, v)
|
|
|
- 3522 AND SymTab.ConstInt(q2,
|
|
|
- 3523 v2)
|
|
|
- 3524 AND ((v < lo)
|
|
|
- 3525 OR (v2 < lo)
|
|
|
- 3526 OR (v >= lo +
|
|
|
- 3527 VAL(INTEGER, span))
|
|
|
- 3528 OR (v2 >= lo +
|
|
|
- 3529 VAL(INTEGER, span))
|
|
|
- 3530 OR (v > v2)) THEN
|
|
|
- 3531 SemError(222)
|
|
|
- 3532 ELSIF hasR THEN
|
|
|
- 3533 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 3534 lo, span)
|
|
|
- 3535 ELSIF SymTab.ConstInt(qe,
|
|
|
- 3536 v)
|
|
|
- 3537 AND ((v < lo)
|
|
|
- 3538 OR (v >= lo +
|
|
|
- 3539 VAL(INTEGER,
|
|
|
- 3540 span))) THEN
|
|
|
- 3541 SemError(222)
|
|
|
- 3542 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 3543 lo, span)
|
|
|
- 3544 END
|
|
|
- 3545 END
|
|
|
- 3546 ELSIF (braceCls = SymTab.ClArray)
|
|
|
- 3547 OR (braceCls =
|
|
|
- 3548 SymTab.ClRecord)
|
|
|
- 3549 OR (braceCls =
|
|
|
- 3550 SymTab.ClClass) THEN
|
|
|
- 3551 IF hasR THEN SemError(230) END;
|
|
|
- 3552 reps := 1;
|
|
|
- 3553 IF hasB THEN
|
|
|
- 3554 IF SymTab.ConstInt(q2, v2)
|
|
|
- 3555 AND (v2 >= 1) THEN
|
|
|
- 3556 reps := v2
|
|
|
- 3557 ELSE SemError(230)
|
|
|
- 3558 END
|
|
|
- 3559 END;
|
|
|
- 3560 k := 0;
|
|
|
- 3561 WHILE k < reps DO
|
|
|
- 3562 QbeGen.CtorElem(qe);
|
|
|
- 3563 INC(k)
|
|
|
- 3564 END
|
|
|
- 3565 END; .)
|
|
|
- 3566 (. AST.SetChild(node,
|
|
|
- 3567 AST.NChild(node), astEl); .) .
|
|
|
- 3568 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 3569 qe, q2: QbeGen.QVal;
|
|
|
- 3570 v, v2: INTEGER;
|
|
|
- 3571 lo: INTEGER;
|
|
|
- 3572 span: CARDINAL;
|
|
|
- 3573 cl, cl2: INTEGER;
|
|
|
- 3574 hasR: BOOLEAN;
|
|
|
- 3575 astEl: AST.Node; .)
|
|
|
- 3576 = (. hasR := FALSE; .)
|
|
|
- 3577 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 3578 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 3579 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 3580 hasR := TRUE; .) ]
|
|
|
- 3581 (. lo := SymTab.SetBaseLo(st);
|
|
|
- 3582 span := SymTab.SetCount(st);
|
|
|
- 3583 IF (et = SymTab.InvalidType)
|
|
|
- 3584 OR (hasR AND (et2 =
|
|
|
- 3585 SymTab.InvalidType)) THEN
|
|
|
- 3586 ELSE cl :=
|
|
|
- 3587 SymTab.ClassOf(et);
|
|
|
- 3588 IF hasR THEN
|
|
|
- 3589 cl2 :=
|
|
|
- 3590 SymTab.ClassOf(et2)
|
|
|
- 3591 ELSE cl2 := SymTab.ClInt
|
|
|
- 3592 END;
|
|
|
- 3593 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 3594 OR (hasR AND NOT
|
|
|
- 3595 SymTab.SetElemClassOk(cl2))
|
|
|
- 3596 THEN
|
|
|
- 3597 SemError(222)
|
|
|
- 3598 ELSIF hasR
|
|
|
- 3599 AND SymTab.ConstInt(qe, v)
|
|
|
- 3600 AND SymTab.ConstInt(q2,
|
|
|
- 3601 v2)
|
|
|
- 3602 AND ((v < lo)
|
|
|
- 3603 OR (v2 < lo)
|
|
|
- 3604 OR (v >= lo +
|
|
|
- 3605 VAL(INTEGER, span))
|
|
|
- 3606 OR (v2 >= lo +
|
|
|
- 3607 VAL(INTEGER, span))
|
|
|
- 3608 OR (v > v2)) THEN
|
|
|
- 3609 SemError(222)
|
|
|
- 3610 ELSIF hasR THEN
|
|
|
- 3611 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 3612 lo, span)
|
|
|
- 3613 ELSIF SymTab.ConstInt(qe,
|
|
|
- 3614 v)
|
|
|
- 3615 AND ((v < lo)
|
|
|
- 3616 OR (v >= lo +
|
|
|
- 3617 VAL(INTEGER,
|
|
|
- 3618 span))) THEN
|
|
|
- 3619 SemError(222)
|
|
|
- 3620 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 3621 lo, span)
|
|
|
- 3622 END
|
|
|
- 3623 END; .)
|
|
|
- 3624 (. AST.SetChild(node,
|
|
|
- 3625 AST.NChild(node), astEl); .) .
|
|
|
- 3626 GetIdent<VAR n: SymTab.Name>
|
|
|
- 3627 = ident (. LexName(n); .) .
|
|
|
- 3628
|
|
|
- 3629 END M2.
|
|
|
+ 3402 ELSIF (c1 = SymTab.ClInt)
|
|
|
+ 3403 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3404 QbeGen.ConvIR(q, qa);
|
|
|
+ 3405 QbeGen.CopyOp(qa, q);
|
|
|
+ 3406 t := vt
|
|
|
+ 3407 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3408 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3409 QbeGen.ConvLR(q, qa);
|
|
|
+ 3410 QbeGen.CopyOp(qa, q);
|
|
|
+ 3411 t := vt
|
|
|
+ 3412 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3413 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3414 QbeGen.ConvRI(q, qa);
|
|
|
+ 3415 QbeGen.CopyOp(qa, q);
|
|
|
+ 3416 t := vt
|
|
|
+ 3417 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3418 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3419 QbeGen.ConvRL(q, qa);
|
|
|
+ 3420 QbeGen.CopyOp(qa, q);
|
|
|
+ 3421 t := vt
|
|
|
+ 3422 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 3423 OR (c1 =
|
|
|
+ 3424 SymTab.ClChar)
|
|
|
+ 3425 OR (c1 =
|
|
|
+ 3426 SymTab.ClBool)
|
|
|
+ 3427 OR (c1 =
|
|
|
+ 3428 SymTab.ClEnum))
|
|
|
+ 3429 AND ((c2 = SymTab.ClInt)
|
|
|
+ 3430 OR (c2 =
|
|
|
+ 3431 SymTab.ClChar)
|
|
|
+ 3432 OR (c2 =
|
|
|
+ 3433 SymTab.ClBool)
|
|
|
+ 3434 OR (c2 =
|
|
|
+ 3435 SymTab.ClEnum)) THEN
|
|
|
+ 3436 t := vt
|
|
|
+ 3437 ELSIF (c1 = SymTab.ClPtr)
|
|
|
+ 3438 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 3439 t := vt
|
|
|
+ 3440 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3441 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3442 t := vt
|
|
|
+ 3443 ELSE SemError(230);
|
|
|
+ 3444 t := SymTab.InvalidType
|
|
|
+ 3445 END
|
|
|
+ 3446 END
|
|
|
+ 3447 END; .)
|
|
|
+ 3448 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
+ 3449 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
+ 3450 QbeGen.CopyOp(sq, q); .)
|
|
|
+ 3451 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
+ 3452 IF SymTab.BoolCheck(t2) THEN
|
|
|
+ 3453 t := SymTab.BoolType()
|
|
|
+ 3454 ELSE SemError(212);
|
|
|
+ 3455 t := SymTab.InvalidType END;
|
|
|
+ 3456 IF t # SymTab.InvalidType THEN
|
|
|
+ 3457 QbeGen.NotQ(q2, q)
|
|
|
+ 3458 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3459 END;
|
|
|
+ 3460 astIsLit := TRUE;
|
|
|
+ 3461 astCur := AST.MakeUn(
|
|
|
+ 3462 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
+ 3463 )
|
|
|
+ 3464 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .) .
|
|
|
+ 3465 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
+ 3466 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
+ 3467 for computed elements. Ranges always lower via SetRange. *)
|
|
|
+ 3468 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3469 (. VAR astNode: AST.Node; .)
|
|
|
+ 3470 = "{" (. t := SymTab.NewSet(
|
|
|
+ 3471 SymTab.NewSubR(0, 255));
|
|
|
+ 3472 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
+ 3473 QbeGen.NewSetTemp(8, q);
|
|
|
+ 3474 QbeGen.SetZero(q, 8); .)
|
|
|
+ 3475 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
+ 3476 "}" (. astCur := astNode; .) .
|
|
|
+ 3477 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
+ 3478 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
+ 3479 declared type sets the width (set) or element type (array). *)
|
|
|
+ 3480 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3481 (. VAR nw: CARDINAL;
|
|
|
+ 3482 astNode: AST.Node;
|
|
|
+ 3483 savedCls: INTEGER; .)
|
|
|
+ 3484 = "{" (. savedCls := braceCls;
|
|
|
+ 3485 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
+ 3486 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3487 braceCls := -1
|
|
|
+ 3488 ELSE braceCls :=
|
|
|
+ 3489 SymTab.ClassOf(vt)
|
|
|
+ 3490 END;
|
|
|
+ 3491 IF braceCls = SymTab.ClSet THEN
|
|
|
+ 3492 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3493 nw := 8
|
|
|
+ 3494 ELSE nw := SymTab.SetWords(vt);
|
|
|
+ 3495 IF nw = 0 THEN nw := 8 END
|
|
|
+ 3496 END;
|
|
|
+ 3497 QbeGen.NewSetTemp(nw, q);
|
|
|
+ 3498 QbeGen.SetZero(q, nw)
|
|
|
+ 3499 ELSIF (braceCls =
|
|
|
+ 3500 SymTab.ClArray)
|
|
|
+ 3501 OR (braceCls =
|
|
|
+ 3502 SymTab.ClRecord)
|
|
|
+ 3503 OR (braceCls =
|
|
|
+ 3504 SymTab.ClClass) THEN
|
|
|
+ 3505 QbeGen.CtorBegin(vt)
|
|
|
+ 3506 ELSE
|
|
|
+ 3507 IF vt # SymTab.InvalidType THEN
|
|
|
+ 3508 SemError(230) END;
|
|
|
+ 3509 braceCls := -1
|
|
|
+ 3510 END; .)
|
|
|
+ 3511 [ BraceElem<vt, q, astNode> { "," BraceElem<vt, q, astNode> } ]
|
|
|
+ 3512 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
+ 3513 OR (braceCls =
|
|
|
+ 3514 SymTab.ClRecord)
|
|
|
+ 3515 OR (braceCls =
|
|
|
+ 3516 SymTab.ClClass) THEN
|
|
|
+ 3517 QbeGen.CtorEnd(q)
|
|
|
+ 3518 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
+ 3519 QbeGen.CopyOp("0", q)
|
|
|
+ 3520 END;
|
|
|
+ 3521 braceCls := savedCls; .)
|
|
|
+ 3522 (. astCur := astNode; .) .
|
|
|
+ 3523 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal; node: AST.Node>
|
|
|
+ 3524 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 3525 qe, q2: QbeGen.QVal;
|
|
|
+ 3526 v, v2, reps, k: INTEGER;
|
|
|
+ 3527 elem: SymTab.TypeIndex;
|
|
|
+ 3528 lo: INTEGER;
|
|
|
+ 3529 span: CARDINAL;
|
|
|
+ 3530 cl, cl2: INTEGER;
|
|
|
+ 3531 hasR, hasB: BOOLEAN;
|
|
|
+ 3532 astEl: AST.Node; .)
|
|
|
+ 3533 = (. hasR := FALSE; hasB := FALSE; .)
|
|
|
+ 3534 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 3535 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 3536 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 3537 hasR := TRUE; .) ]
|
|
|
+ 3538 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
+ 3539 (. IF braceCls = SymTab.ClSet THEN
|
|
|
+ 3540 IF hasB THEN SemError(230) END;
|
|
|
+ 3541 lo := SymTab.SetBaseLo(vt);
|
|
|
+ 3542 span := SymTab.SetCount(vt);
|
|
|
+ 3543 IF (et = SymTab.InvalidType)
|
|
|
+ 3544 OR (hasR AND (et2 =
|
|
|
+ 3545 SymTab.InvalidType)) THEN
|
|
|
+ 3546 ELSE cl :=
|
|
|
+ 3547 SymTab.ClassOf(et);
|
|
|
+ 3548 IF hasR THEN
|
|
|
+ 3549 cl2 :=
|
|
|
+ 3550 SymTab.ClassOf(et2)
|
|
|
+ 3551 ELSE cl2 := SymTab.ClInt
|
|
|
+ 3552 END;
|
|
|
+ 3553 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 3554 OR (hasR AND NOT
|
|
|
+ 3555 SymTab.SetElemClassOk(cl2))
|
|
|
+ 3556 THEN
|
|
|
+ 3557 SemError(222)
|
|
|
+ 3558 ELSIF hasR
|
|
|
+ 3559 AND SymTab.ConstInt(qe, v)
|
|
|
+ 3560 AND SymTab.ConstInt(q2,
|
|
|
+ 3561 v2)
|
|
|
+ 3562 AND ((v < lo)
|
|
|
+ 3563 OR (v2 < lo)
|
|
|
+ 3564 OR (v >= lo +
|
|
|
+ 3565 VAL(INTEGER, span))
|
|
|
+ 3566 OR (v2 >= lo +
|
|
|
+ 3567 VAL(INTEGER, span))
|
|
|
+ 3568 OR (v > v2)) THEN
|
|
|
+ 3569 SemError(222)
|
|
|
+ 3570 ELSIF hasR THEN
|
|
|
+ 3571 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 3572 lo, span)
|
|
|
+ 3573 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 3574 v)
|
|
|
+ 3575 AND ((v < lo)
|
|
|
+ 3576 OR (v >= lo +
|
|
|
+ 3577 VAL(INTEGER,
|
|
|
+ 3578 span))) THEN
|
|
|
+ 3579 SemError(222)
|
|
|
+ 3580 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 3581 lo, span)
|
|
|
+ 3582 END
|
|
|
+ 3583 END
|
|
|
+ 3584 ELSIF (braceCls = SymTab.ClArray)
|
|
|
+ 3585 OR (braceCls =
|
|
|
+ 3586 SymTab.ClRecord)
|
|
|
+ 3587 OR (braceCls =
|
|
|
+ 3588 SymTab.ClClass) THEN
|
|
|
+ 3589 IF hasR THEN SemError(230) END;
|
|
|
+ 3590 reps := 1;
|
|
|
+ 3591 IF hasB THEN
|
|
|
+ 3592 IF SymTab.ConstInt(q2, v2)
|
|
|
+ 3593 AND (v2 >= 1) THEN
|
|
|
+ 3594 reps := v2
|
|
|
+ 3595 ELSE SemError(230)
|
|
|
+ 3596 END
|
|
|
+ 3597 END;
|
|
|
+ 3598 k := 0;
|
|
|
+ 3599 WHILE k < reps DO
|
|
|
+ 3600 QbeGen.CtorElem(qe);
|
|
|
+ 3601 INC(k)
|
|
|
+ 3602 END
|
|
|
+ 3603 END; .)
|
|
|
+ 3604 (. AST.SetChild(node,
|
|
|
+ 3605 AST.NChild(node), astEl); .) .
|
|
|
+ 3606 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 3607 qe, q2: QbeGen.QVal;
|
|
|
+ 3608 v, v2: INTEGER;
|
|
|
+ 3609 lo: INTEGER;
|
|
|
+ 3610 span: CARDINAL;
|
|
|
+ 3611 cl, cl2: INTEGER;
|
|
|
+ 3612 hasR: BOOLEAN;
|
|
|
+ 3613 astEl: AST.Node; .)
|
|
|
+ 3614 = (. hasR := FALSE; .)
|
|
|
+ 3615 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 3616 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 3617 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 3618 hasR := TRUE; .) ]
|
|
|
+ 3619 (. lo := SymTab.SetBaseLo(st);
|
|
|
+ 3620 span := SymTab.SetCount(st);
|
|
|
+ 3621 IF (et = SymTab.InvalidType)
|
|
|
+ 3622 OR (hasR AND (et2 =
|
|
|
+ 3623 SymTab.InvalidType)) THEN
|
|
|
+ 3624 ELSE cl :=
|
|
|
+ 3625 SymTab.ClassOf(et);
|
|
|
+ 3626 IF hasR THEN
|
|
|
+ 3627 cl2 :=
|
|
|
+ 3628 SymTab.ClassOf(et2)
|
|
|
+ 3629 ELSE cl2 := SymTab.ClInt
|
|
|
+ 3630 END;
|
|
|
+ 3631 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 3632 OR (hasR AND NOT
|
|
|
+ 3633 SymTab.SetElemClassOk(cl2))
|
|
|
+ 3634 THEN
|
|
|
+ 3635 SemError(222)
|
|
|
+ 3636 ELSIF hasR
|
|
|
+ 3637 AND SymTab.ConstInt(qe, v)
|
|
|
+ 3638 AND SymTab.ConstInt(q2,
|
|
|
+ 3639 v2)
|
|
|
+ 3640 AND ((v < lo)
|
|
|
+ 3641 OR (v2 < lo)
|
|
|
+ 3642 OR (v >= lo +
|
|
|
+ 3643 VAL(INTEGER, span))
|
|
|
+ 3644 OR (v2 >= lo +
|
|
|
+ 3645 VAL(INTEGER, span))
|
|
|
+ 3646 OR (v > v2)) THEN
|
|
|
+ 3647 SemError(222)
|
|
|
+ 3648 ELSIF hasR THEN
|
|
|
+ 3649 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 3650 lo, span)
|
|
|
+ 3651 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 3652 v)
|
|
|
+ 3653 AND ((v < lo)
|
|
|
+ 3654 OR (v >= lo +
|
|
|
+ 3655 VAL(INTEGER,
|
|
|
+ 3656 span))) THEN
|
|
|
+ 3657 SemError(222)
|
|
|
+ 3658 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 3659 lo, span)
|
|
|
+ 3660 END
|
|
|
+ 3661 END; .)
|
|
|
+ 3662 (. AST.SetChild(node,
|
|
|
+ 3663 AST.NChild(node), astEl); .) .
|
|
|
+ 3664 GetIdent<VAR n: SymTab.Name>
|
|
|
+ 3665 = ident (. LexName(n); .) .
|
|
|
+ 3666
|
|
|
+ 3667 END M2.
|
|
|
|
|
|
0 errors
|
|
|
|
