1(* $Id: IRtoSSA.Mod,v 1.138 2005/10/07 08:35:41 mva Exp $ *) 2MODULE OOC:SSA:IRtoSSA; 3(* Converts the IR of a procedure into its SSA representation. 4 Copyright (C) 2001-2005 Michael van Acken 5 6 This file is part of OOC. 7 8 OOC is free software; you can redistribute it and/or modify it 9 under the terms of the GNU General Public License as published by 10 the Free Software Foundation; either version 2 of the License, or 11 (at your option) any later version. 12 13 OOC is distributed in the hope that it will be useful, but WITHOUT 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 15 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 16 License for more details. 17 18 You should have received a copy of the GNU General Public License 19 along with OOC. If not, write to the Free Software Foundation, 59 20 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 21*) 22 23IMPORT 24 SYSTEM, Log, Object, Object:Boxed, Object:BigInt, 25 Sym := OOC:SymbolTable, OOC:SymbolTable:Predef, OOC:SymbolTable:Builder, 26 TR := OOC:SymbolTable:TypeRules, OOC:IR, 27 OOC:SSA, OOC:SSA:Opcode, OOC:SSA:Opnd, OOC:SSA:Result; 28 29 30PROCEDURE AddStoreBackwardFeed (pb: SSA.ProcBlock; 31 loopEnd: SSA.Instr; storeArg: SSA.Result); 32 VAR 33 collect: SSA.Instr; 34 opnd: SSA.Opnd; 35 BEGIN 36 (* install a pass-through collect instruction between `storeArg' 37 and the use in `loopEnd'; the allocator code uses this instruction 38 to mark some values as live across the whole loop *) 39 collect := pb. AddInstr (Opcode.collect, Opcode.scNone); 40 collect. AddOpnd (storeArg, Opnd.store); 41 opnd := loopEnd. GetOpndClass (Opnd.backwardFeed); 42 IF (opnd = NIL) THEN 43 loopEnd. AddOpnd (collect. AddResult (Result.store), Opnd.backwardFeed); 44 ELSE 45 opnd. ReplaceArg (collect. AddResult (Result.store)); 46 END; 47 END AddStoreBackwardFeed; 48 49PROCEDURE StatmSeq* (pb: SSA.ProcBlock; s: SSA.Result; 50 statmSeq: IR.StatementSeq): SSA.Result; 51(**Translates the statement sequence @oparam{statmSeq} into a straightforward 52 SSA representation. Instructions are added to the procedure block 53 @oparam{pb}. The initial value of @var{store} is taken from the argument 54 @oparam{s}, the final value of @var{store} is the return value of the 55 function. *) 56 VAR 57 statm: IR.Statement; 58 i: LONGINT; 59 60 PROCEDURE Chain (instr: SSA.Instr); 61 BEGIN 62 IF (instr. opcode = Opcode.set) OR 63 (instr. opcode = Opcode.get) OR 64 (instr. opcode = Opcode.copyString) OR 65 (instr. opcode = Opcode.newObject) THEN 66 instr. opndList. ReplaceArg (s); 67 ELSE 68 instr. AddOpnd (s, Opnd.store); 69 END; 70 s := instr. AddResult (Result.store) 71 END Chain; 72 73 PROCEDURE FixAddress(arg: SSA.Result): SSA.Result; 74 BEGIN 75 RETURN pb.FixSubclass(arg, Opcode.scAddress); 76 END FixAddress; 77 78 PROCEDURE FixLength(arg: SSA.Result): SSA.Result; 79 BEGIN 80 RETURN pb.FixSubclass(arg, Opcode.scLength); 81 END FixLength; 82 83 PROCEDURE ^ Call (call: IR.Call): SSA.Instr; 84 PROCEDURE ^ Expression (expr: IR.Expression): SSA.Result; 85 86 PROCEDURE CalculateLength (pb: SSA.ProcBlock; value: IR.Expression; 87 dim: LONGINT; baseArray: SSA.Result): SSA.Result; 88 (* Calculate the one-dimensional length of the variable @oparam{value} or of 89 one of its elements. With @oparam{dim=-1}, return the number of elements 90 of the whole variable. With @oparam{dim>=0}, return the length of an 91 array element of dimension @oparam{dim}. @oparam{baseArray} holds the 92 (virtual, and dead) @oconst{Opcode.get} instruction on the array variable. *) 93 VAR 94 type: Sym.Type; 95 i: LONGINT; 96 97 PROCEDURE RecursiveGetLength (type: Sym.Type; dim: LONGINT): SSA.Result; 98 VAR 99 len: SSA.Result; 100 lenp: SSA.Instr; 101 BEGIN 102 type := type.Deparam(); 103 WITH type: Sym.Array DO 104 IF type.isOpenArray THEN 105 len := pb.AddGetLengthInstr (baseArray(SSA.Instr), dim+1, type); 106 ELSE 107 len := pb.GetConstInt(type.length); 108 END; 109 len := FixLength(len); 110 111 IF TR.IsArray(type.elementType) THEN 112 lenp := pb. AddInstr (Opcode.multiply, Opcode.scLength); 113 lenp. AddOpnd (len, Opnd.arg); 114 lenp. AddOpnd (RecursiveGetLength (type.elementType, dim+1), 115 Opnd.arg); 116 RETURN lenp; 117 ELSE 118 RETURN len; 119 END; 120 ELSE 121 RETURN FixLength(pb.GetConstInt(1)); 122 END; 123 END RecursiveGetLength; 124 125 BEGIN 126 (* if `value' is an index expression, normalize it to the array 127 variable *) 128 WHILE (value IS IR.Index) DO 129 value := value(IR.Index). array; 130 INC (dim); 131 END; 132 133 (* get type of the value we are interested in *) 134 type := value. type; 135 FOR i := 0 TO dim DO 136 type := type.Deparam(); 137 type := type(Sym.Array). elementType; 138 END; 139 140 RETURN RecursiveGetLength (type, dim); 141 END CalculateLength; 142 143 PROCEDURE CalculateSize (pb: SSA.ProcBlock; value: IR.Expression; 144 length: SSA.Result): SSA.Instr; 145 (* Calculate the size of the variable @oparam{value} based on the given 146 length and the (non-array) base type of the index expression 147 @oparam{value}. *) 148 VAR 149 type: Sym.Type; 150 size: SSA.Instr; 151 BEGIN 152 (* if `value' is an index expression, normalize it to the array 153 variable *) 154 WHILE (value IS IR.Index) DO 155 value := value(IR.Index).array; 156 END; 157 158 (* get type of the value we are interested in *) 159 type := value.type; 160 WHILE TR.IsArrayType(type) DO 161 type := TR.ArrayElementType(type); 162 END; 163 type := type.Deparam(); 164 165 size := pb.AddInstr (Opcode.multiply, Opcode.scAddress); 166 size.AddOpnd(FixAddress(length), Opnd.arg); 167 size.AddOpnd(FixAddress(pb.GetConstInt(type.size)), Opnd.arg); 168 RETURN size; 169 END CalculateSize; 170 171 PROCEDURE TypeOfString (type: Sym.Type): Sym.Type; 172 BEGIN 173 WITH type: Sym.Array DO 174 IF (type. elementType IS Sym.PredefType) THEN 175 CASE type. elementType(Sym.PredefType). id OF 176 | Predef.char, Predef.longchar, Predef.ucs4char: 177 RETURN type. elementType; 178 ELSE 179 RETURN NIL; 180 END; 181 ELSE 182 RETURN NIL; 183 END; 184 | type: Sym.PredefType DO 185 CASE type. id OF 186 | Predef.stringChar, Predef.stringLongChar, Predef.stringUCS4Char: 187 RETURN Predef.GetType (type. id-Predef.stringChar+Predef.char); 188 ELSE 189 RETURN NIL; 190 END; 191 ELSE 192 RETURN NIL; 193 END; 194 END TypeOfString; 195 196 PROCEDURE TransferReadDesign (source: SSA.Result; instr: SSA.Instr); 197 VAR 198 opnd: SSA.Opnd; 199 BEGIN 200 IF (source IS SSA.Const) THEN 201 (* copying a string constant *) 202 instr. AddOpnd (source, Opnd.readAdr); 203 ELSE 204 opnd := source. instr. opndList; 205 WHILE (opnd # NIL) DO 206 IF (opnd. class = Opnd.readAdr) OR 207 (opnd. class = Opnd.readDesign) THEN 208 instr. AddOpnd (opnd. arg, opnd. class); 209 END; 210 opnd := opnd. nextOpnd; 211 END; 212 END; 213 END TransferReadDesign; 214 215 PROCEDURE TransferWriteDesign (source: SSA.Result; instr: SSA.Instr); 216 VAR 217 opnd: SSA.Opnd; 218 BEGIN 219 opnd := source. instr. opndList; 220 WHILE (opnd # NIL) DO 221 IF (opnd. class = Opnd.readAdr) THEN 222 instr. AddOpnd (opnd. arg, Opnd.writeAdr); 223 ELSIF (opnd. class = Opnd.readDesign) THEN 224 instr. AddOpnd (opnd. arg, Opnd.writeDesign); 225 END; 226 opnd := opnd. nextOpnd; 227 END; 228 END TransferWriteDesign; 229 230 PROCEDURE CopyString (cp: IR.CopyString): SSA.Instr; 231 VAR 232 instr: SSA.Instr; 233 source, dest, maxLength: SSA.Result; 234 BEGIN 235 source := Expression (cp. source); 236 dest := Expression (cp. dest); 237 maxLength := Expression (cp. maxLength); 238 239 instr := pb. AddInstr (Opcode.copyString, Opcode.scNone); 240 instr. AddOpnd (s, Opnd.store); 241 instr. AddOpnd (pb. GetTypeRef (TypeOfString (cp. source. type)), Opnd.type); 242 instr. AddOpnd (pb. GetTypeRef (TypeOfString (cp. dest. type)), Opnd.type); 243 TransferReadDesign (source, instr); 244 TransferWriteDesign (dest, instr); 245 instr. AddOpnd (maxLength, Opnd.arg); 246 247 RETURN instr; 248 END CopyString; 249 250 PROCEDURE AddException (pb: SSA.ProcBlock; sym: IR.Symbol; 251 opcode: Opcode.Class; subclass: Opcode.Subclass): SSA.Instr; 252 VAR 253 instr: SSA.Instr; 254 res: SSA.Result; 255 BEGIN 256 instr := pb. AddInstr (opcode, subclass); 257 instr. SetPos (sym); 258 res := instr. AddResult (Result.exception); 259 Chain (instr); 260 RETURN instr; 261 END AddException; 262 263 PROCEDURE TypeTag (design: IR.Expression; value: SSA.Result; 264 checkDerefOfNil: BOOLEAN; derefSym: IR.Symbol): SSA.Instr; 265 (* `design' is the variable designator, `value' its translation to SSA *) 266 VAR 267 instr, check: SSA.Instr; 268 type: Sym.Type; 269 BEGIN 270 type := design.type.Deparam(); 271 type := type.Bound(); (* for a type variable, continue with bound *) 272 IF checkDerefOfNil & (type IS Sym.Pointer) THEN 273 check := AddException (pb, derefSym, 274 Opcode.checkPointer, value. subclass); 275 check. AddOpnd (value, Opnd.arg); 276 value := check; 277 END; 278 279 instr := pb. AddInstr (Opcode.typeTag, Opcode.scAddress); 280 IF (type IS Sym.Pointer) THEN 281 instr. AddOpnd (value, Opnd.arg); 282 ELSIF (design IS IR.Var) & 283 design(IR.Var). decl(Sym.VarDecl). isVarParam & 284 TR.IsRecord(design(IR.Var).decl(Sym.VarDecl).type) THEN 285 (* type tag of a VAR parameter *) 286 instr. AddOpnd (value. instr. GetArgClass (Opnd.readDesign), Opnd.arg); 287 ELSE (* static type tag *) 288 instr. AddOpnd (pb. GetTypeRef (type), Opnd.arg); 289 END; 290 RETURN instr; 291 END TypeTag; 292 293 PROCEDURE Copy (cp: IR.Copy): SSA.Instr; 294 VAR 295 expr: IR.Expression; 296 instr, dynTag, staticTag, neq, failed, select: SSA.Instr; 297 source, dest, okStore: SSA.Result; 298 BEGIN 299 (* taking the address of a type casted expression fails, but we can 300 always try to take the address of the original value -- if it is 301 a variable *) 302 expr := cp.source; 303 WHILE (expr IS IR.TypeCast) DO 304 expr := expr(IR.TypeCast).expr; 305 END; 306 source := Expression (expr); 307 dest := Expression (cp. dest); 308 309 IF cp. checkDynamicType THEN 310 dynTag := TypeTag (cp. dest, dest, FALSE, NIL); 311 staticTag := pb. AddInstr (Opcode.typeTag, Opcode.scAddress); 312 staticTag. AddOpnd (pb. GetTypeRef (cp. dest. type), Opnd.arg); 313 314 neq := pb. AddInstr (Opcode.neq, Opcode.scAddress); 315 neq. AddOpnd (staticTag, Opnd.arg); 316 neq. AddOpnd (dynTag, Opnd.arg); 317 okStore := s; 318 319 failed := AddException (pb, cp. dest. sym, 320 Opcode.failedTypeAssert, Opcode.scNone); 321 322 select := pb. AddInstr (Opcode.select, Opcode.scNone); 323 select. AddOpnd (neq, Opnd.arg); 324 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 325 select. AddOpnd (s, Opnd.arg); 326 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 327 select. AddOpnd (okStore, Opnd.arg); 328 329 s := select. AddResult (Result.store); 330 END; 331 332 instr := pb. AddInstr (Opcode.copy, Opcode.scNone); 333 instr. AddOpnd (s, Opnd.store); 334 instr. AddOpnd (pb. GetTypeRef (cp. dest. type), Opnd.type); 335 TransferReadDesign (source, instr); 336 TransferWriteDesign (dest, instr); 337 RETURN instr; 338 END Copy; 339 340 PROCEDURE Expression (expr: IR.Expression): SSA.Result; 341 VAR 342 instr: SSA.Instr; 343 res, baseArray: SSA.Result; 344 opcode: Opcode.Class; 345 dim: LONGINT; 346 type: Sym.Type; 347 v: Boxed.Object; 348 x: BigInt.BigInt; 349 350 PROCEDURE Deref (deref: IR.Deref): SSA.Result; 351 VAR 352 instr, check: SSA.Instr; 353 address: SSA.Result; 354 BEGIN 355 (* take the value of the pointer and use it to start a new "get" 356 instruction *) 357 address := Expression (deref. pointer); 358 IF deref. checkPointer THEN 359 check := AddException (pb, deref. sym, 360 Opcode.checkPointer, address. subclass); 361 check. AddOpnd (address, Opnd.arg); 362 address := check; 363 END; 364 365 instr := pb. AddInstr (Opcode.get, Opcode.TypeToSubclass (deref.type)); 366 instr. AddOpnd (s, Opnd.store); 367 instr. AddOpnd (address, Opnd.readAdr); 368 instr. AddOpnd (pb. GetTypeRef (deref. pointer. type), Opnd.readDesign); 369 instr. AddOpnd (address, Opnd.readDesign); 370 Chain (instr); 371 RETURN instr 372 END Deref; 373 374 PROCEDURE GetIndexBaseArray (indexOp: IR.Expression; VAR dim: LONGINT): SSA.Result; 375 VAR 376 res: SSA.Result; 377 BEGIN 378 WITH indexOp: IR.Index DO 379 res := GetIndexBaseArray (indexOp. array, dim); 380 INC (dim); 381 RETURN res; 382 ELSE 383 dim := -1; 384 RETURN Expression (indexOp); 385 END; 386 END GetIndexBaseArray; 387 388 PROCEDURE Index (indexOp: IR.Index; 389 baseArray: SSA.Result; 390 elementSize: SSA.Result; 391 dim: LONGINT): SSA.Result; 392 (* Handles a sequence of index operations on an array. @oapram{indexOp} is 393 the index operation that is to be translated. @oparam{baseArray} holds 394 the (virtual) @oconst{Opcode.get} operation on the array variable at the 395 very start of the index sequence. @oparam{elementSize} is the size in 396 bytes of the value produced by this index operation. @oparam{dim} is 397 the dimension of @oparam{baseArray} on which @oparam{indexOp} operates. *) 398 VAR 399 instr, elementAdr, scaledIndex, newSize, check: SSA.Instr; 400 baseResult, length, index: SSA.Result; 401 adrOpnd: SSA.Opnd; 402 elementType, arrayType: Sym.Type; 403 BEGIN 404 arrayType := indexOp.array.type.Deparam(); 405 length := pb. AddGetLengthInstr (baseArray(SSA.Instr), dim, 406 arrayType(Sym.Array)); 407 newSize := pb. AddInstr (Opcode.multiply, Opcode.scAddress); 408 newSize. AddOpnd (elementSize, Opnd.arg); 409 newSize. AddOpnd (FixAddress(length), Opnd.arg); 410 411 IF (indexOp. array IS IR.Index) THEN 412 baseResult := Index (indexOp. array(IR.Index), baseArray, 413 newSize, dim-1); 414 ELSE 415 baseResult := baseArray; 416 ASSERT (dim = 0); 417 END; 418 INC (dim); 419 ASSERT (baseResult. instr. opcode = Opcode.get); 420 421 (* take the "get" instruction of the array's designator and change it 422 into a "get" for the array element; the store seen by the index 423 expression is the one that is passed into the old "get", and the new 424 "get" sees the store after the index expression has been evaluated *) 425 instr := baseResult. instr; 426 s := instr. opndList. arg; 427 index := Expression (indexOp. index); 428 IF indexOp. checkIndex THEN 429 check := AddException (pb, indexOp. sym, 430 Opcode.checkIndex, index. subclass); 431 check. AddOpnd (index, Opnd.arg); 432 check. AddOpnd (length, Opnd. arg); 433 index := check; 434 END; 435 instr. opndList. ReplaceArg (s); 436 s := instr. GetResultStore(); 437 438 elementType := indexOp. type; 439 scaledIndex := pb. AddInstr (Opcode.multiply, Opcode.scAddress); 440 scaledIndex. AddOpnd (FixAddress(index), Opnd.arg); 441 scaledIndex. AddOpnd (elementSize, Opnd.arg); 442 443 adrOpnd := instr. opndList. nextOpnd; 444 elementAdr := pb. AddInstr (Opcode.add, Opcode.scAddress); 445 elementAdr. AddOpnd (adrOpnd. arg, Opnd.arg); 446 elementAdr. AddOpnd (scaledIndex, Opnd. arg); 447 adrOpnd. ReplaceArg (elementAdr); 448 instr. AddOpnd (index, Opnd.readDesign); 449 instr. SetSubclass (Opcode.TypeToSubclass (indexOp. type)); 450 451 RETURN instr 452 END Index; 453 454 PROCEDURE SelectField (selectOp: IR.SelectField): SSA.Result; 455 VAR 456 instr, fieldAdr: SSA.Instr; 457 baseResult, offset: SSA.Result; 458 adrOpnd: SSA.Opnd; 459 BEGIN 460 (* take the "get" instruction of the record's designator and 461 change it into a "get" for the record field *) 462 baseResult := Expression (selectOp. record); 463 ASSERT (baseResult. instr. opcode = Opcode.get); 464 instr := baseResult. instr; 465 466 adrOpnd := instr. opndList. nextOpnd; 467 fieldAdr := pb. AddInstr (Opcode.add, Opcode.scAddress); 468 fieldAdr. AddOpnd (adrOpnd. arg, Opnd.arg); 469 offset := pb.GetConstInt(selectOp.field.offset); 470 fieldAdr.AddOpnd(FixAddress(offset), Opnd.arg); 471 adrOpnd. ReplaceArg (fieldAdr); 472 instr. AddOpnd (pb. GetDeclRef (selectOp. field), Opnd.readDesign); 473 instr. SetSubclass (Opcode.TypeToSubclass (selectOp. field. type)); 474 475 RETURN instr 476 END SelectField; 477 478 PROCEDURE AddCompareOp (op: IR.Compare; class: Opcode.Class): SSA.Instr; 479 VAR 480 instr: SSA.Instr; 481 left, right: SSA.Result; 482 typeOfString: Sym.Type; 483 BEGIN 484 typeOfString := TypeOfString (op. left. type); 485 left := Expression (op. left); 486 right := Expression (op. right); 487 488 IF (typeOfString # NIL) THEN (* string compare *) 489 instr := pb. AddInstr (Opcode.cmpString, Opcode.scSigned32); 490 instr. AddOpnd (s, Opnd.store); 491 instr. AddOpnd (pb. GetTypeRef (typeOfString), Opnd.type); 492 TransferReadDesign (left, instr); 493 TransferReadDesign (right, instr); 494 495 left := instr; 496 right := pb. GetConstInt (0); 497 END; 498 499 instr := pb. AddInstr (class, Opcode.scBoolean); 500 instr. AddOpnd (left, Opnd.arg); 501 instr. AddOpnd (right, Opnd.arg); 502 RETURN instr 503 END AddCompareOp; 504 505 PROCEDURE NewObject (new: IR.NewObject): SSA.Instr; 506 VAR 507 instr: SSA.Instr; 508 i: LONGINT; 509 BEGIN 510 instr := pb. AddInstr (Opcode.newObject, Opcode.scAddress); 511 instr. AddOpnd (s, Opnd.store); 512 instr. AddOpnd (pb. GetTypeRef (new. type), Opnd.type); 513 IF (new. length # NIL) THEN 514 FOR i := 0 TO LEN (new. length^)-1 DO 515 instr. AddOpnd (Expression (new. length[i]), Opnd.arg); 516 END; 517 END; 518 Chain (instr); 519 RETURN instr; 520 END NewObject; 521 522 PROCEDURE NewBlock (new: IR.NewBlock): SSA.Instr; 523 VAR 524 instr: SSA.Instr; 525 BEGIN 526 instr := pb. AddInstr (Opcode.newBlock, Opcode.scAddress); 527 instr. AddOpnd (s, Opnd.store); 528 instr. AddOpnd (pb. GetTypeRef (new. type), Opnd.type); 529 instr. AddOpnd (Expression (new. size), Opnd.arg); 530 Chain (instr); 531 RETURN instr; 532 END NewBlock; 533 534 PROCEDURE ShortcutAnd (left, right: IR.Expression): SSA.Result; 535 VAR 536 select, collect: SSA.Instr; 537 storeAfterGuard, bool: SSA.Result; 538 BEGIN 539 select := pb. AddInstr (Opcode.select, Opcode.scNone); 540 select. AddOpnd (Expression (left), Opnd.arg); 541 storeAfterGuard := s; 542 543 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 544 bool := Expression (right); 545 collect := pb. AddInstr (Opcode.collect, Opcode.scNone); 546 collect. AddOpnd (s, Opnd.store); 547 collect. AddOpnd (bool, Opnd.arg); 548 select. AddOpnd (collect. AddResult (Result.store), Opnd.arg); 549 550 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 551 collect := pb. AddInstr (Opcode.collect, Opcode.scNone); 552 collect. AddOpnd (storeAfterGuard, Opnd.store); 553 collect. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 554 select. AddOpnd (collect. AddResult (Result.store), Opnd.arg); 555 556 s := select. AddResult (Result.store); 557 RETURN select. AddResultSubclass (Result.selectValue, Opcode.scBoolean) 558 END ShortcutAnd; 559 560 PROCEDURE ShortcutOr (left, right: IR.Expression): SSA.Result; 561 VAR 562 select, collect: SSA.Instr; 563 storeAfterGuard, bool: SSA.Result; 564 BEGIN 565 select := pb. AddInstr (Opcode.select, Opcode.scNone); 566 select. AddOpnd (Expression (left), Opnd.arg); 567 storeAfterGuard := s; 568 569 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 570 collect := pb. AddInstr (Opcode.collect, Opcode.scNone); 571 collect. AddOpnd (storeAfterGuard, Opnd.store); 572 collect. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 573 select. AddOpnd (collect. AddResult (Result.store), Opnd.arg); 574 575 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 576 bool := Expression (right); 577 collect := pb. AddInstr (Opcode.collect, Opcode.scNone); 578 collect. AddOpnd (s, Opnd.store); 579 collect. AddOpnd (bool, Opnd.arg); 580 select. AddOpnd (collect. AddResult (Result.store), Opnd.arg); 581 582 s := select. AddResult (Result.store); 583 RETURN select. AddResultSubclass (Result.selectValue, Opcode.scBoolean) 584 END ShortcutOr; 585 586 PROCEDURE ReceiverTypeTag(receiver: IR.Expression; 587 referenceType: Sym.Type): SSA.Instr; 588 BEGIN 589 IF (receiver = NIL) OR ~TR.IsTypeVar(referenceType) THEN 590 RETURN pb.GetConstNil(); 591 ELSE 592 RETURN TypeTag(receiver, Expression(receiver), FALSE, NIL); 593 END; 594 END ReceiverTypeTag; 595 596 PROCEDURE TypeTest (test: IR.TypeTest): SSA.Instr; 597 VAR 598 instr, tt: SSA.Instr; 599 BEGIN 600 tt := ReceiverTypeTag(test.receiver, test.origType.qualType); 601 instr := pb. AddInstr (Opcode.typeTest, Opcode.scBoolean); 602 instr. AddOpnd (TypeTag (test. expr, Expression (test. expr), 603 test. checkPointer, test. sym), 604 Opnd.arg); 605 instr. AddOpnd (pb. GetTypeRef (test. referenceType), Opnd.type); 606 instr. AddOpnd (tt, Opnd.arg); 607 RETURN instr 608 END TypeTest; 609 610 PROCEDURE TypeGuard (guard: IR.TypeGuard): SSA.Result; 611 VAR 612 design: SSA.Result; 613 tag, instr, adr: SSA.Instr; 614 opnd: SSA.Opnd; 615 616 PROCEDURE NewTypeGuard (adr, tag: SSA.Result): SSA.Instr; 617 VAR 618 instr, tt: SSA.Instr; 619 BEGIN 620 tt := ReceiverTypeTag(guard.test.receiver, guard.test.origType.qualType); 621 instr := AddException (pb, guard. test. origType. sym, 622 Opcode.typeGuard, adr. instr. subclass); 623 instr. AddOpnd (adr, Opnd.arg); 624 instr. AddOpnd (tag, Opnd.arg); 625 instr. AddOpnd (pb. GetTypeRef (guard. test. referenceType), 626 Opnd.type); 627 instr. AddOpnd (tt, Opnd.arg); 628 RETURN instr; 629 END NewTypeGuard; 630 631 BEGIN 632 design := Expression (guard. test. expr); 633 634 IF guard. checkType THEN 635 IF (design.instr.opcode = Opcode.typeGuard) THEN (* stacked guards *) 636 opnd := design.instr.NthOpnd(3); 637 opnd.ReplaceArg(pb.GetTypeRef(guard.test.referenceType)); 638 RETURN design; 639 ELSE 640 ASSERT (design. instr. opcode = Opcode.get); 641 tag := TypeTag (guard. test. expr, design, 642 guard. checkPointer, guard. sym); 643 IF (guard. test. origExpr IS IR.Var) & 644 (guard. test. origExpr. type IS Sym.Record) THEN 645 (* applying type guard to a record VAR parameter: replace the 646 address _input_ of the get with the type guard instruction *) 647 design. instr. opndList. nextOpnd. ReplaceArg 648 (NewTypeGuard (design. instr. opndList. nextOpnd. arg, tag)); 649 RETURN design; 650 ELSIF (guard.test.origExpr IS IR.Deref) THEN 651 (* need to dereference the tested pointer, because TypeTest 652 dropped this *) 653 adr := NewTypeGuard (design, tag); 654 instr := pb.AddInstr(Opcode.get, 655 Opcode.TypeToSubclass(guard.type)); 656 instr.AddOpnd(s, Opnd.store); 657 instr.AddOpnd(adr, Opnd.readAdr); 658 instr.AddOpnd(pb.GetTypeRef(guard.test.expr.type), 659 Opnd.readDesign); 660 instr.AddOpnd(adr, Opnd.readDesign); 661 Chain (instr); 662 RETURN instr; 663 ELSE 664 RETURN NewTypeGuard (design, tag); 665 END; 666 END; 667 ELSE 668 RETURN design; 669 END; 670 END TypeGuard; 671 672 PROCEDURE TypeCast (cast: IR.TypeCast): SSA.Result; 673 VAR 674 instr: SSA.Instr; 675 scDest: Opcode.Subclass; 676 BEGIN 677 scDest := Opcode.TypeToSubclass (cast. type); 678 instr := pb. AddInstr (Opcode.typeCast, scDest); 679 instr. AddOpnd (Expression (cast. expr), Opnd.arg); 680 RETURN instr; 681 END TypeCast; 682 683 PROCEDURE TypeConv (conv: IR.TypeConv): SSA.Result; 684 VAR 685 instr: SSA.Instr; 686 const: SSA.Result; 687 scSource, scDest: Opcode.Subclass; 688 len: LONGINT; 689 fct: STRING; 690 BEGIN 691 IF TR.IsSTRING(conv.type) THEN 692 (* converting a character or string constant to STRING *) 693 const := Expression(conv.expr); 694 695 instr := pb.AddInstr(Opcode.preloadedVar, Opcode.scAddress); 696 CASE conv.expr.type(Sym.PredefType).id OF 697 | Predef.char: 698 fct := Object.NewLatin1(Builder.stringModuleC+"__NewLatin1Char"); 699 | Predef.stringChar: 700 fct := Object.NewLatin1(Builder.stringModuleC+"__NewLatin1Region"); 701 | Predef.longchar: 702 fct := Object.NewLatin1(Builder.stringModuleC+"__NewUTF16Char"); 703 | Predef.stringLongChar: 704 fct := Object.NewLatin1(Builder.stringModuleC+"__NewUTF16Region"); 705 | Predef.ucs4char: 706 fct := Object.NewLatin1(Builder.stringModuleC+"__NewUCS4Char"); 707 | Predef.stringUCS4Char: 708 fct := Object.NewLatin1(Builder.stringModuleC+"__NewUCS4Region"); 709 END; 710 instr.AddOpnd(pb.GetConst(NEW(Boxed.String, fct), Opcode.scAddress, 711 Predef.GetType(Predef.stringChar)), 712 Opnd.arg); 713 instr.AddOpnd(const, Opnd.arg); 714 IF TR.IsStringConst(conv.expr.type) THEN 715 len := conv.expr(IR.Const).value(Boxed.String).value.length; 716 instr.AddOpnd(pb.GetConstInt(len+1), Opnd.arg); (* array len *) 717 718 instr.AddOpnd(pb.GetConstInt(0), Opnd.arg); (* start *) 719 instr.AddOpnd(pb.GetConstInt(len), Opnd.arg); (* end *) 720 END; 721 RETURN instr; 722 ELSE 723 scDest := Opcode.TypeToSubclass (conv. type); 724 scSource := Opcode.TypeToSubclass (conv. expr. type); 725 IF (scDest # scSource) THEN 726 instr := pb. AddInstr (Opcode.typeConv, scDest); 727 instr. AddOpnd (Expression (conv. expr), Opnd.arg); 728 RETURN instr; 729 ELSE 730 RETURN Expression (conv. expr); 731 END; 732 END; 733 END TypeConv; 734 735 PROCEDURE SelectProc (selectOp: IR.SelectProc): SSA.Result; 736 VAR 737 object: IR.Expression; 738 type : Sym.Type; 739 BEGIN 740 IF selectOp. isStaticCall THEN (* use static address *) 741 RETURN pb. GetAddress (selectOp. tbProc); 742 ELSE (* use dynamic address *) 743 IF (selectOp. receiver IS IR.Deref) THEN 744 object := selectOp. receiver(IR.Deref). pointer; 745 ELSE 746 object := selectOp. receiver; 747 END; 748 type := selectOp. recordType. Deparam(); 749 IF type(Sym.Record).isVtable THEN 750 (* TODO: Add deref check *) 751 instr := pb. AddInstr (Opcode.vtableProcAddress, Opcode.scAddress); 752 instr. AddOpnd (Expression(object), Opnd.arg); 753 ELSE 754 instr := pb. AddInstr (Opcode.tbProcAddress, Opcode.scAddress); 755 instr. AddOpnd (TypeTag (object, 756 Expression (object), 757 selectOp. checkPointer, 758 selectOp. sym), Opnd.arg); 759 END; 760 instr. AddOpnd (pb. GetDeclRef (selectOp. tbProc), Opnd.arg); 761 RETURN instr; 762 END; 763 END SelectProc; 764 765 PROCEDURE Concat (expr: IR.Concat): SSA.Result; 766 VAR 767 i: LONGINT; 768 instr: SSA.Instr; 769 BEGIN 770 instr := pb. AddInstr(Opcode.concat, Opcode.scAddress); 771 FOR i := 0 TO LEN(expr.strings^)-1 DO 772 instr.AddOpnd(Expression(expr.strings[i]), Opnd.arg); 773 END; 774 RETURN instr; 775 END Concat; 776 777 PROCEDURE Constructor(expr: IR.Constructor): SSA.Result; 778 VAR 779 obj, call: SSA.Result; 780 BEGIN 781 obj := NewObject(expr.alloc); 782 IF (expr.init # NIL) THEN 783 call := Expression(expr.init); 784 call.instr.opndList.nextOpnd.ReplaceArg(obj); (* fixup receiver *) 785 END; 786 RETURN obj; 787 END Constructor; 788 789 BEGIN 790 WITH expr: IR.Const DO 791 IF (expr. value = NIL) THEN 792 RETURN pb.GetConst(SSA.nil, Opcode.scAddress, NIL); 793 ELSE 794 v := expr.value; 795 WITH v: Boxed.String DO 796 IF TR.IsStringConst(expr.type) THEN 797 RETURN pb.GetConst(v, Opcode.scAddress, expr.type); 798 ELSE 799 x := BigInt.NewInt(ORD(v.value.CharAt(0))); 800 RETURN pb.GetConst(x, Opcode.TypeToSubclass(expr.type), NIL); 801 END; 802 803 | v: Boxed.Boolean DO 804 RETURN pb.GetConstBool(v.value); 805 806 | v: Boxed.Set DO 807 x := BigInt.NewInt(SYSTEM.VAL(LONGINT, v.value)); 808 RETURN pb.GetConst(x, Opcode.TypeToSubclass(expr.type), NIL); 809 810 ELSE 811 RETURN pb.GetConst(v, Opcode.TypeToSubclass(expr.type), NIL); 812 END; 813 END; 814 815 | expr: IR.ProcedureRef DO 816 RETURN pb. GetAddress (expr. decl) 817 818 | expr: IR.Var DO 819 instr := pb. AddInstr (Opcode.get, Opcode.TypeToSubclass (expr. type)); 820 instr. AddOpnd (s, Opnd.store); 821 instr. AddOpnd (pb. GetAddress (expr. decl), Opnd.readAdr); 822 instr. AddOpnd (pb. GetDeclRef (expr. decl), Opnd.readDesign); 823 Chain (instr); 824 RETURN instr 825 826 | expr: IR.TypeRef DO 827 RETURN pb. GetTypeRef (expr. decl(Sym.TypeDecl). type); 828 829 | expr: IR.Adr DO 830 res := Expression (expr. design); 831 IF (res. instr. opcode = Opcode.get) THEN 832 RETURN pb.FixSubclass(res. instr. GetArgClass (Opnd.readAdr), 833 Opcode.TypeToSubclass(expr.type)); 834 ELSE 835 (* must be a string constant; currently, this is its own address 836 FIXME... we should probably introduce an address opcode here *) 837 RETURN res; 838 END; 839 840 | expr: IR.Len DO 841 IF (expr. variant = IR.lenStringConst) THEN 842 RETURN pb. GetConstInt (expr. arrayVariable(IR.Const). value(Boxed.String). value. length+1); 843 ELSE 844 baseArray := Expression (expr. arrayVariable); 845 type := expr. arrayVariable. type.Deparam(); 846 type := type(Sym.Array).GetNthElementType(expr.dim); 847 RETURN pb. AddGetLengthInstr (baseArray(SSA.Instr), expr. dim, 848 type(Sym.Array)); 849 END; 850 851 | expr: IR.Deref DO 852 RETURN Deref (expr); 853 854 | expr: IR.Index DO 855 baseArray := GetIndexBaseArray (expr, dim); 856 RETURN Index (expr, baseArray, 857 CalculateSize(pb, expr, 858 CalculateLength(pb, expr, -1, baseArray)), 859 dim); 860 861 | expr: IR.SelectField DO 862 RETURN SelectField (expr); 863 864 | expr: IR.SelectProc DO 865 RETURN SelectProc (expr); 866 867 | expr: IR.TypeCast DO 868 RETURN TypeCast (expr); 869 | expr: IR.TypeConv DO 870 RETURN TypeConv (expr); 871 | expr: IR.TypeTag DO 872 RETURN TypeTag (expr. design, Expression (expr. design), FALSE, NIL); 873 | expr: IR.TypeTest DO 874 RETURN TypeTest (expr); 875 | expr: IR.TypeGuard DO 876 RETURN TypeGuard (expr); 877 878 | expr: IR.Negate DO 879 IF TR.IsPredefType(expr.type, Predef.set) THEN 880 opcode := Opcode.logicalComplement; 881 ELSE 882 opcode := Opcode.negate; 883 END; 884 instr := pb. AddInstr (opcode, 885 Opcode.TypeToSubclass (expr. operand. type)); 886 instr. AddOpnd (Expression (expr. operand), Opnd.arg); 887 RETURN instr; 888 | expr: IR.Not DO 889 instr := pb. AddInstr (Opcode.not, Opcode.scBoolean); 890 instr. AddOpnd (Expression (expr. operand), Opnd.arg); 891 RETURN instr; 892 893 | expr: IR.SetMember DO 894 instr := pb. AddInstr (Opcode.setMember, Opcode.scBoolean); 895 instr. AddOpnd (Expression (expr. element), Opnd.arg); 896 instr. AddOpnd (Expression (expr. set), Opnd.arg); 897 RETURN instr; 898 899 | expr: IR.Abs DO 900 instr := pb. AddInstr (Opcode.abs, Opcode.TypeToSubclass (expr. type)); 901 instr. AddOpnd (Expression (expr. operand), Opnd.arg); 902 RETURN instr; 903 904 | expr: IR.Ash DO 905 instr := pb. AddInstr (Opcode.ash, Opcode.TypeToSubclass (expr. type)); 906 instr. AddOpnd (Expression (expr. value), Opnd.arg); 907 instr. AddOpnd (Expression (expr. exp), Opnd.arg); 908 RETURN instr; 909 910 | expr: IR.Cap DO 911 instr := pb. AddInstr (Opcode.cap, Opcode.TypeToSubclass (expr. type)); 912 instr. AddOpnd (Expression (expr. operand), Opnd.arg); 913 RETURN instr; 914 915 | expr: IR.Entier DO 916 instr := pb. AddInstr (Opcode.entier, Opcode.TypeToSubclass (expr. type)); 917 instr. AddOpnd (Expression (expr. operand), Opnd.arg); 918 RETURN instr; 919 920 | expr: IR.Shift DO 921 IF expr. rotate THEN 922 opcode := Opcode.rot; 923 ELSE 924 opcode := Opcode.lsh; 925 END; 926 instr := pb. AddInstr (opcode, Opcode.TypeToSubclass (expr. type)); 927 instr. AddOpnd (Expression (expr. value), Opnd.arg); 928 instr. AddOpnd (Expression (expr. by), Opnd.arg); 929 RETURN instr; 930 931 | expr: IR.Odd DO 932 instr := pb. AddInstr (Opcode.odd, Opcode.TypeToSubclass (expr. type)); 933 instr. AddOpnd (Expression (expr. operand), Opnd.arg); 934 RETURN instr; 935 936 | expr: IR.BinaryArith DO 937 CASE expr.variant OF 938 | IR.arithAdd : opcode := Opcode.add; 939 | IR.arithSub : opcode := Opcode.subtract; 940 | IR.arithMul : opcode := Opcode.multiply; 941 | IR.arithMod : opcode := Opcode.modulo; 942 | IR.arithDivI: opcode := Opcode.divide; 943 | IR.arithDivR: opcode := Opcode.divide; 944 ELSE 945 Log.Int("++ Unknown variant of BinaryArith in Expression", 946 expr. variant); 947 ASSERT (FALSE); 948 END; 949 instr := pb. AddInstr (opcode, Opcode.TypeToSubclass (expr.left.type)); 950 instr. AddOpnd (Expression (expr. left), Opnd.arg); 951 instr. AddOpnd (Expression (expr. right), Opnd.arg); 952 RETURN instr 953 954 | expr: IR.BooleanOp DO 955 CASE expr.variant OF 956 | IR.and: 957 RETURN ShortcutAnd (expr. left, expr. right); 958 | IR.or: 959 RETURN ShortcutOr (expr. left, expr. right); 960 ELSE 961 Log.Type("++ Unknown variant of BooleanOp in Expression", expr); 962 ASSERT (FALSE); 963 END; 964 965 | expr: IR.SetOp DO 966 CASE expr.variant OF 967 | IR.setUnion : opcode := Opcode.logicalOr; 968 | IR.setDiff : opcode := Opcode.logicalSubtr; 969 | IR.setIntersect : opcode := Opcode.logicalAnd; 970 | IR.setSymDiff : opcode := Opcode.logicalXor; 971 ELSE 972 Log.Int("++ Unknown variant of SetOp in Expression", 973 expr. variant); 974 ASSERT (FALSE); 975 END; 976 instr := pb. AddInstr (opcode, Opcode.TypeToSubclass (expr.left.type)); 977 instr. AddOpnd (Expression (expr. left), Opnd.arg); 978 instr. AddOpnd (Expression (expr. right), Opnd.arg); 979 RETURN instr; 980 | expr: IR.SetRange DO 981 instr := pb. AddInstr (Opcode.setRange, Opcode.TypeToSubclass (expr.type)); 982 instr. AddOpnd (Expression (expr. from), Opnd.arg); 983 instr. AddOpnd (Expression (expr. to), Opnd.arg); 984 RETURN instr; 985 | expr: IR.ChangeElement DO 986 CASE expr.variant OF 987 | IR.inclElement: opcode := Opcode.setBit; 988 | IR.exclElement: opcode := Opcode.clearBit; 989 END; 990 instr := pb. AddInstr (opcode, Opcode.TypeToSubclass (expr.set.type)); 991 instr. AddOpnd (Expression (expr. set), Opnd.arg); 992 instr. AddOpnd (Expression (expr. element), Opnd.arg); 993 RETURN instr; 994 995 | expr: IR.Concat DO 996 RETURN Concat(expr); 997 998 | expr: IR.Compare DO 999 CASE expr.variant OF 1000 | IR.equal: 1001 RETURN AddCompareOp (expr, Opcode.eql); 1002 | IR.notEqual: 1003 RETURN AddCompareOp (expr, Opcode.neq); 1004 | IR.less: 1005 RETURN AddCompareOp (expr, Opcode.lss); 1006 | IR.lessEqual: 1007 RETURN AddCompareOp (expr, Opcode.leq); 1008 | IR.greater: 1009 RETURN AddCompareOp (expr, Opcode.gtr); 1010 | IR.greaterEqual: 1011 RETURN AddCompareOp (expr, Opcode.geq); 1012 ELSE 1013 Log.Type("++ Unknown variant of Compare in Expression", expr); 1014 ASSERT (FALSE); 1015 END; 1016 1017 | expr: IR.NewObject DO 1018 RETURN NewObject (expr); 1019 | expr: IR.NewBlock DO 1020 RETURN NewBlock (expr); 1021 1022 | expr: IR.Call DO 1023 instr := Call (expr); 1024 (* the pessimistic assumption is that a function call can have 1025 arbitrary side effects; it's up to later transformations to reduce 1026 the impact of this *) 1027 instr. AddOpnd (s, Opnd.store); 1028 s := instr. AddResult (Result.store); 1029 RETURN instr 1030 1031 | expr: IR.Constructor DO 1032 RETURN Constructor(expr); 1033 | expr: IR.CurrentException DO 1034 RETURN pb.tryContext; 1035 1036 ELSE 1037 Log.Type("++ Unknown type in Expression", expr); 1038 ASSERT (FALSE) 1039 END; 1040 END Expression; 1041 1042 PROCEDURE Assert (assert: IR.Assert); 1043 VAR 1044 predicate: SSA.Result; 1045 instr: SSA.Instr; 1046 BEGIN 1047 IF (assert. predicate = NIL) THEN 1048 instr := AddException (pb, assert. sym, Opcode.halt, Opcode.scNone); 1049 instr. AddOpnd (pb. GetConstInt (assert. code), Opnd.arg); 1050 ELSIF ~assert.disabled THEN 1051 predicate := Expression (assert. predicate); 1052 instr := AddException (pb, assert. sym, Opcode.assert, Opcode.scNone); 1053 instr. AddOpnd (predicate, Opnd.arg); 1054 instr. AddOpnd (pb. GetConstInt (assert. code), Opnd.arg); 1055 END; 1056 END Assert; 1057 1058 PROCEDURE Assignment (assignment: IR.Assignment): SSA.Instr; 1059 VAR 1060 get: SSA.Result; 1061 BEGIN 1062 (* ... shortcut: ignore non-scalar assignments *) 1063 1064 (* FIXME... If this is an AssignOp, then we must evaluate the 1065 variable just once for both the operator and the actual assignment *) 1066 get := Expression (assignment. variable); 1067 RETURN pb. AddSetInstr (get(SSA.Instr), Expression (assignment. value)); 1068 END Assignment; 1069 1070 PROCEDURE Call (call: IR.Call): SSA.Instr; 1071 VAR 1072 instr: SSA.Instr; 1073 i: LONGINT; 1074 fpar: Sym.VarDecl; 1075 type: Sym.Type; 1076 isVarParam: BOOLEAN; 1077 args: POINTER TO ARRAY OF SSA.Result; 1078 BEGIN 1079 (* evaluate arguments right to left, and procedure designator last *) 1080 NEW(args, LEN(call.arguments^)); 1081 FOR i := LEN (call. arguments^)-1 TO 0 BY -1 DO 1082 args[i] := Expression (call. arguments[i]); 1083 END; 1084 1085 instr := pb. AddInstr (Opcode.call, Opcode.TypeToSubclass (call. type)); 1086 instr. AddTypedOpnd (Expression (call. design), Opnd.procAdr, 1087 call. design. type, FALSE); 1088 FOR i := 0 TO LEN (call. arguments^)-1 DO 1089 IF (call. formalPars[i] # NIL) THEN 1090 fpar := call. formalPars[i]; 1091 type := fpar. type; 1092 isVarParam := fpar. isPassPerReference; 1093 ELSE 1094 type := call. arguments[i]. type; 1095 isVarParam := FALSE; 1096 END; 1097 instr. AddTypedOpnd (args[i], Opnd.arg, type, isVarParam); 1098 END; 1099 RETURN instr 1100 END Call; 1101 1102 PROCEDURE PopExceptionContext(storeIn: SSA.Result; n: LONGINT): SSA.Result; 1103 VAR 1104 instr: SSA.Instr; 1105 BEGIN 1106 IF (n # 0) THEN 1107 instr := pb.AddInstr(Opcode.popExceptionContext, Opcode.scNone); 1108 instr.AddOpnd(storeIn, Opnd.store); 1109 instr.AddOpnd(pb.GetConstInt(n), Opnd.arg); 1110 RETURN instr.AddResult(Result.store); 1111 ELSE 1112 RETURN storeIn; 1113 END; 1114 END PopExceptionContext; 1115 1116 PROCEDURE Return (return: IR.Return); 1117 VAR 1118 instr: SSA.Instr; 1119 expr, store: SSA.Result; 1120 BEGIN 1121 IF (return. result # NIL) THEN 1122 expr := Expression (return. result); 1123 1124 instr := pb. AddInstr (Opcode.return, Opcode.scNone); 1125 instr. AddOpnd (PopExceptionContext(s, return.popExceptionContext), 1126 Opnd.store); 1127 instr. AddOpnd (expr, Opnd.functionResult); 1128 ELSE 1129 instr := pb. AddInstr (Opcode.return, Opcode.scNone); 1130 instr. AddOpnd (PopExceptionContext(s, return.popExceptionContext), 1131 Opnd.store); 1132 END; 1133 1134 store := instr. AddResult (Result.store); 1135 pb. selectReturn. AddOpnd (store, Opnd.storeExit); 1136 s := store 1137 END Return; 1138 1139 PROCEDURE IfStatm (ifStatm: IR.IfStatm); 1140 VAR 1141 select: SSA.Instr; 1142 storeAfterGuard: SSA.Result; 1143 BEGIN 1144 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1145 select. AddOpnd (Expression (ifStatm. guard), Opnd.arg); 1146 storeAfterGuard := s; 1147 1148 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1149 select. AddOpnd (StatmSeq (pb, storeAfterGuard, ifStatm. pathTrue), 1150 Opnd.arg); 1151 1152 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1153 IF (ifStatm. pathFalse # NIL) THEN 1154 select. AddOpnd (StatmSeq (pb, storeAfterGuard, ifStatm. pathFalse), 1155 Opnd.arg); 1156 ELSE 1157 select. AddOpnd (storeAfterGuard, Opnd.arg) 1158 END; 1159 1160 s := select. AddResult (Result.store) 1161 END IfStatm; 1162 1163 PROCEDURE WithStatm (withStatm: IR.WithStatm); 1164 VAR 1165 select, instr, typeTag: SSA.Instr; 1166 storeAfterGuard: SSA.Result; 1167 var: IR.Expression; 1168 BEGIN 1169 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1170 select. AddOpnd (Expression (withStatm. guard), Opnd.arg); 1171 storeAfterGuard := s; 1172 1173 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1174 select. AddOpnd (StatmSeq (pb, storeAfterGuard, withStatm. pathTrue), 1175 Opnd.arg); 1176 1177 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1178 IF (withStatm. pathFalse # NIL) THEN 1179 select. AddOpnd (StatmSeq (pb, storeAfterGuard, withStatm. pathFalse), 1180 Opnd.arg); 1181 1182 ELSIF withStatm. checkMatch THEN 1183 s := storeAfterGuard; 1184 var := withStatm. guard(IR.TypeTest). expr; 1185 typeTag := TypeTag (var, Expression (var), TRUE, withStatm. sym); 1186 instr := AddException (pb, withStatm. sym, 1187 Opcode.failedWith, Opcode.scNone); 1188 instr. AddOpnd (typeTag, Opnd.arg); 1189 select. AddOpnd (s, Opnd.arg); 1190 1191 ELSE 1192 select. AddOpnd (storeAfterGuard, Opnd.arg) 1193 END; 1194 1195 s := select. AddResult (Result.store) 1196 END WithStatm; 1197 1198 PROCEDURE CaseStatm (caseStatm: IR.CaseStatm); 1199 VAR 1200 select, instr: SSA.Instr; 1201 storeAfterSelect: SSA.Result; 1202 i: LONGINT; 1203 1204 PROCEDURE Labels (labels: IR.CaseLabels): SSA.Instr; 1205 VAR 1206 i: LONGINT; 1207 instr: SSA.Instr; 1208 value: SSA.Result; 1209 l: IR.Expression; 1210 BEGIN 1211 instr := pb. AddInstr (Opcode.labels, Opcode.scNone); 1212 FOR i := 0 TO LEN (labels^)-1 DO 1213 l := labels[i]; 1214 WITH l: IR.SetRange DO 1215 instr. AddOpnd (Expression (l. from), Opnd.arg); 1216 instr. AddOpnd (Expression (l. to), Opnd.arg); 1217 ELSE 1218 value := Expression (l); 1219 instr. AddOpnd (value, Opnd.arg); 1220 instr. AddOpnd (value, Opnd.arg); 1221 END; 1222 END; 1223 RETURN instr 1224 END Labels; 1225 1226 BEGIN 1227 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1228 select. AddOpnd (Expression (caseStatm. select), Opnd.arg); 1229 storeAfterSelect := s; 1230 1231 FOR i := 0 TO LEN (caseStatm. caseList^)-1 DO 1232 IF (LEN (caseStatm. caseList[i]. labels^) > 0) THEN 1233 select. AddOpnd (Labels (caseStatm. caseList[i]. labels), 1234 Opnd.labels); 1235 select. AddOpnd (StatmSeq (pb, storeAfterSelect, 1236 caseStatm. caseList[i]. statmSeq), 1237 Opnd.arg); 1238 END; 1239 END; 1240 1241 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.labels); 1242 IF (caseStatm. default # NIL) THEN 1243 select. AddOpnd (StatmSeq (pb, storeAfterSelect, caseStatm. default), 1244 Opnd.arg); 1245 1246 ELSIF caseStatm. checkMatch THEN 1247 s := storeAfterSelect; 1248 instr := AddException (pb, caseStatm. sym, 1249 Opcode.failedCase, Opcode.scNone); 1250 instr. AddOpnd (select. opndList. arg, Opnd.arg); 1251 select. AddOpnd (s, Opnd.arg); 1252 1253 ELSE 1254 select. AddOpnd (storeAfterSelect, Opnd.arg) 1255 END; 1256 1257 s := select. AddResult (Result.store) 1258 END CaseStatm; 1259 1260 PROCEDURE RepeatStatm (repeatStatm: IR.RepeatStatm); 1261 VAR 1262 start, end, exit, select: SSA.Instr; 1263 guard: SSA.Result; 1264 BEGIN 1265 start := pb. AddInstr (Opcode.loopStart, Opcode.scNone); 1266 start. AddOpnd (s, Opnd.store); 1267 s := start. AddResult (Result.store); 1268 1269 (* evaluate loop body, followed by the exit condition *) 1270 s := StatmSeq (pb, s, repeatStatm. body); 1271 guard := Expression (repeatStatm. exitCondition); 1272 1273 (* create "select" with "exit" *) 1274 exit := pb. AddInstr (Opcode.exit, Opcode.scNone); 1275 exit. AddOpnd (s, Opnd.store); 1276 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1277 select. AddOpnd (guard, Opnd.arg); 1278 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1279 select. AddOpnd (exit. AddResult (Result.store), Opnd.arg); 1280 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1281 select. AddOpnd (s, Opnd.arg); 1282 s := select. AddResult (Result.store); 1283 1284 (* create "loop-end" instruction *) 1285 end := pb. AddInstr (Opcode. loopEnd, Opcode.scNone); 1286 end. AddOpnd (start, Opnd.arg); 1287 (* add backward feed of `store' to "loop-end" *) 1288 AddStoreBackwardFeed (pb, end, s); 1289 (* link "exit" to "loop-end" *) 1290 end. AddOpnd (exit. nextResult, Opnd.storeExit); 1291 1292 s := end. AddResult (Result.store) 1293 END RepeatStatm; 1294 1295 PROCEDURE WhileStatm (whileStatm: IR.WhileStatm); 1296 VAR 1297 start, end, select, exit: SSA.Instr; 1298 guard1, guard2, storeAfterGuard1: SSA.Result; 1299 BEGIN 1300 (* WHILE e DO s END 1301 1302 is translated to 1303 1304 IF e THEN 1305 REPEAT 1306 s 1307 UNTIL ~e; 1308 END *) 1309 guard1 := Expression (whileStatm. guard); 1310 storeAfterGuard1 := s; 1311 1312 (* insert "loop-start" instruction *) 1313 start := pb. AddInstr (Opcode.loopStart, Opcode.scNone); 1314 start. AddOpnd (s, Opnd.store); 1315 s := start. AddResult (Result.store); 1316 1317 (* evaluate loop body, followed by the exit condition *) 1318 s := StatmSeq (pb, s, whileStatm. body); 1319 guard2 := Expression (whileStatm. guard); 1320 1321 (* create "select" with "exit" *) 1322 exit := pb. AddInstr (Opcode.exit, Opcode.scNone); 1323 exit. AddOpnd (s, Opnd.store); 1324 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1325 select. AddOpnd (guard2, Opnd.arg); 1326 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1327 select. AddOpnd (s, Opnd.arg); 1328 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1329 select. AddOpnd (exit. AddResult (Result.store), Opnd.arg); 1330 s := select. AddResult (Result.store); 1331 1332 (* create "loop-end" instruction *) 1333 end := pb. AddInstr (Opcode. loopEnd, Opcode.scNone); 1334 end. AddOpnd (start, Opnd.arg); 1335 (* add backward feed of `store' to "loop-end" *) 1336 AddStoreBackwardFeed (pb, end, s); 1337 (* link "exit" to "loop-end" *) 1338 end. AddOpnd (exit. nextResult, Opnd.storeExit); 1339 1340 (* create the "select" for the IF statement around the loop *) 1341 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1342 select. AddOpnd (guard1, Opnd.arg); 1343 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1344 select. AddOpnd (end. AddResult (Result.store), Opnd.arg); 1345 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1346 select. AddOpnd (storeAfterGuard1, Opnd.arg); 1347 1348 s := select. AddResult (Result.store) 1349 END WhileStatm; 1350 1351 PROCEDURE ForStatm (forStatm: IR.ForStatm); 1352 VAR 1353 start, end, select, exit, dummy: SSA.Instr; 1354 guard1, guard2, storeAfterGuard1, v, endValue, stepValue: SSA.Result; 1355 1356 PROCEDURE Guard (bound: SSA.Result): SSA.Instr; 1357 VAR 1358 instr: SSA.Instr; 1359 cmpClass: Opcode.Class; 1360 BEGIN 1361 IF forStatm.PositiveStep() THEN 1362 cmpClass := Opcode.leq; 1363 ELSE 1364 cmpClass := Opcode.geq; 1365 END; 1366 instr := pb. AddInstr (cmpClass, Opcode.scBoolean); 1367 instr. AddOpnd (Expression (forStatm. var), Opnd.arg); 1368 instr. AddOpnd (bound, Opnd.arg); 1369 RETURN instr 1370 END Guard; 1371 1372 BEGIN 1373 (* FOR v := beg TO end BY step DO s END; 1374 1375 is translated to 1376 1377 temp := end; v := beg; 1378 IF step>0 THEN 1379 IF v<=temp THEN 1380 REPEAT 1381 s; v := v+step 1382 UNTIL ~(v<=temp); 1383 END 1384 ELSE 1385 IF v>=temp THEN 1386 REPEAT 1387 s; v := v+step 1388 UNTIL ~(v>=temp); 1389 END 1390 END *) 1391 endValue := Expression (forStatm. end); 1392 stepValue := Expression (forStatm. step); 1393 v := Expression (forStatm. var); 1394 Chain (pb. AddSetInstr (v(SSA.Instr), Expression (forStatm. start))); 1395 1396 guard1 := Guard (endValue); 1397 storeAfterGuard1 := s; 1398 1399 (* insert "loop-start" instruction *) 1400 start := pb. AddInstr (Opcode.loopStart, Opcode.scNone); 1401 start. AddOpnd (s, Opnd.store); 1402 s := start. AddResult (Result.store); 1403 1404 (* evaluate loop body, followed by the exit condition *) 1405 s := StatmSeq (pb, s, forStatm. body); 1406 dummy := pb. AddInstr (Opcode.add, 1407 Opcode.TypeToSubclass (forStatm. var. type)); 1408 v := Expression (forStatm. var); 1409 dummy. AddOpnd (v, Opnd.arg); 1410 dummy. AddOpnd (stepValue, Opnd.arg); 1411 Chain (pb. AddSetInstr (v(SSA.Instr), dummy)); 1412 guard2 := Guard (endValue); 1413 1414 (* create "select" with "exit" *) 1415 exit := pb. AddInstr (Opcode.exit, Opcode.scNone); 1416 exit. AddOpnd (s, Opnd.store); 1417 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1418 select. AddOpnd (guard2, Opnd.arg); 1419 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1420 select. AddOpnd (s, Opnd.arg); 1421 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1422 select. AddOpnd (exit. AddResult (Result.store), Opnd.arg); 1423 s := select. AddResult (Result.store); 1424 1425 (* create "loop-end" instruction *) 1426 end := pb. AddInstr (Opcode. loopEnd, Opcode.scNone); 1427 end. AddOpnd (start, Opnd.arg); 1428 (* add backward feed of `store' to "loop-end" *) 1429 AddStoreBackwardFeed (pb, end, s); 1430 (* link "exit" to "loop-end" *) 1431 end. AddOpnd (exit. nextResult, Opnd.storeExit); 1432 1433 (* create the "select" for the IF statement around the loop *) 1434 select := pb. AddInstr (Opcode.select, Opcode.scNone); 1435 select. AddOpnd (guard1, Opnd.arg); 1436 select. AddOpnd (pb. GetConstBool (TRUE), Opnd.arg); 1437 select. AddOpnd (end. AddResult (Result.store), Opnd.arg); 1438 select. AddOpnd (pb. GetConstBool (FALSE), Opnd.arg); 1439 select. AddOpnd (storeAfterGuard1, Opnd.arg); 1440 1441 s := select. AddResult (Result.store); 1442 END ForStatm; 1443 1444 PROCEDURE IterateArrayStatm (iterStatm: IR.IterateArrayStatm); 1445 VAR 1446 curr2, collect: SSA.Instr; 1447 end, get, loopStart, loopEnd, select, exit: SSA.Instr; 1448 array, numElements, size, start, curr, 1449 guard1, guard2, storeAfterGuard1, v: SSA.Result; 1450 elementType: Sym.Type; 1451 opnd: SSA.Opnd; 1452 1453 PROCEDURE Guard (curr: SSA.Result): SSA.Instr; 1454 VAR 1455 instr: SSA.Instr; 1456 BEGIN 1457 instr := pb.AddInstr(Opcode.neq, Opcode.scBoolean); 1458 instr.AddOpnd(end, Opnd.arg); 1459 instr.AddOpnd(curr, Opnd.arg); 1460 RETURN instr 1461 END Guard; 1462 1463 BEGIN 1464 (* FOR v IN a DO s END; 1465 1466 is translated to 1467 1468 curr := adr(a); 1469 end := curr+sizeof(a); 1470 IF (curr # end) THEN 1471 esize := sizeof(a[0]); 1472 REPEAT 1473 v := get(start); 1474 s; 1475 curr := curr+esize; 1476 UNTIL (curr = end); 1477 END *) 1478 array := Expression(iterStatm.range); 1479 numElements := CalculateLength(pb, iterStatm.range, -1, array); 1480 size := CalculateSize(pb, iterStatm.range, numElements); 1481 1482 start := array.instr.GetArgClass(Opnd.readAdr); 1483 end := pb.AddInstr(Opcode.add, Opcode.scAddress); 1484 end.AddOpnd(start, Opnd.arg); 1485 end.AddOpnd(FixAddress(size), Opnd.arg); 1486 1487 (* only if the array is not empty we enter the loop *) 1488 guard1 := Guard(start); 1489 storeAfterGuard1 := s; 1490 1491 (* insert "loop-start" instruction *) 1492 collect := pb.AddInstr(Opcode.collect, Opcode.scNone); 1493 collect.AddOpnd(s, Opnd.store); 1494 collect.AddOpnd(start, Opnd.arg); 1495 loopStart := pb.AddInstr(Opcode.loopStart, Opcode.scNone); 1496 loopStart.AddOpnd(collect.AddResult(Result.store), Opnd.store); 1497 s := loopStart.AddResult(Result.store); 1498 curr := loopStart.AddResultSubclass(Result.selectValue, 1499 Opcode.scAddress); 1500 1501 (* retrieve current value *) 1502 elementType := TR.ArrayElementType(iterStatm.range.type); 1503 get := pb.AddInstr(Opcode.get, Opcode.TypeToSubclass(elementType)); 1504 get.AddOpnd(s, Opnd.store); 1505 get.AddOpnd(curr, Opnd.readAdr); 1506 opnd := array.instr.GetOpndClass(Opnd.readDesign); 1507 WHILE (opnd # NIL) & (opnd.class = Opnd.readDesign) DO 1508 get.AddOpnd(opnd.arg, Opnd.readDesign); 1509 opnd := opnd.nextOpnd; 1510 END; 1511 s := get.AddResult(Result.store); (* for the sake of Destore *) 1512 1513 (* set variable to the current value *) 1514 v := Expression(iterStatm. var); 1515 Chain(pb.AddSetInstr(v(SSA.Instr), get)); 1516 1517 (* evaluate loop body *) 1518 s := StatmSeq(pb, s, iterStatm.body); 1519 1520 (* increment pointer into array *) 1521 curr2 := pb.AddInstr(Opcode.add, Opcode.scAddress); 1522 curr2.AddOpnd (curr, Opnd.arg); 1523 curr2.AddOpnd (FixAddress(pb.GetConstInt(elementType.size)), Opnd.arg); 1524 1525 guard2 := Guard (curr2); 1526 1527 (* create "select" with "exit" *) 1528 exit := pb.AddInstr(Opcode.exit, Opcode.scNone); 1529 exit.AddOpnd(s, Opnd.store); 1530 select := pb.AddInstr(Opcode.select, Opcode.scNone); 1531 select.AddOpnd(guard2, Opnd.arg); 1532 select.AddOpnd(pb.GetConstBool(TRUE), Opnd.arg); 1533 select.AddOpnd(s, Opnd.arg); 1534 select.AddOpnd(pb.GetConstBool(FALSE), Opnd.arg); 1535 select.AddOpnd(exit.AddResult(Result.store), Opnd.arg); 1536 s := select.AddResult(Result.store); 1537 1538 (* create "loop-end" instruction *) 1539 loopEnd := pb.AddInstr(Opcode. loopEnd, Opcode.scNone); 1540 loopEnd.AddOpnd(loopStart, Opnd.arg); 1541 (* add backward feed of `store' to "loop-end" *) 1542 collect := pb.AddInstr(Opcode.collect, Opcode.scNone); 1543 collect.AddOpnd(s, Opnd.store); 1544 collect.AddOpnd(curr2, Opnd.arg); 1545 loopEnd.AddOpnd(collect.AddResult(Result.store), Opnd.backwardFeed); 1546 (* link "exit" to "loop-end" *) 1547 loopEnd.AddOpnd(exit.nextResult, Opnd.storeExit); 1548 1549 (* create the "select" for the IF statement around the loop *) 1550 select := pb.AddInstr(Opcode.select, Opcode.scNone); 1551 select.AddOpnd(guard1, Opnd.arg); 1552 select.AddOpnd(pb.GetConstBool(TRUE), Opnd.arg); 1553 select.AddOpnd(loopEnd.AddResult(Result.store), Opnd.arg); 1554 select.AddOpnd(pb.GetConstBool(FALSE), Opnd.arg); 1555 select.AddOpnd(storeAfterGuard1, Opnd.arg); 1556 1557 s := select.AddResult(Result.store); 1558 END IterateArrayStatm; 1559 1560 PROCEDURE IterateObjectStatm (iterStatm: IR.IterateObjectStatm); 1561 VAR 1562 loopStart, loopEnd, select, exit: SSA.Instr; 1563 iterator, guard1, guard2, storeAfterGuard1: SSA.Result; 1564 1565 PROCEDURE Guard(): SSA.Instr; 1566 VAR 1567 res: SSA.Result; 1568 instr, typeTag: SSA.Instr; 1569 BEGIN 1570 res := Expression(iterStatm.stepperCall); 1571 instr := res(SSA.Instr); 1572 typeTag := instr.opndList.arg(SSA.Instr).opndList.arg(SSA.Instr); 1573 typeTag.opndList.ReplaceArg(iterator); 1574 instr.opndList.nextOpnd.ReplaceArg(iterator); 1575 RETURN instr; 1576 END Guard; 1577 1578 BEGIN 1579 (* FOR v IN obj.Iterator() DO s END; 1580 1581 is translated to 1582 1583 temp := obj.Iterator(); 1584 IF temp.Next(v) THEN 1585 REPEAT 1586 s; 1587 UNTIL ~temp.Next(v); 1588 END *) 1589 iterator := Expression(iterStatm.iteratorFactory); 1590 1591 (* only if the first call to Next() is successful we enter the loop *) 1592 guard1 := Guard(); 1593 storeAfterGuard1 := s; 1594 1595 (* insert "loop-start" instruction *) 1596 loopStart := pb.AddInstr(Opcode.loopStart, Opcode.scNone); 1597 loopStart.AddOpnd(s, Opnd.store); 1598 s := loopStart.AddResult(Result.store); 1599 1600 (* evaluate loop body *) 1601 s := StatmSeq(pb, s, iterStatm.body); 1602 1603 (* next call to Next() *) 1604 guard2 := Guard(); 1605 1606 (* create "select" with "exit" *) 1607 exit := pb.AddInstr(Opcode.exit, Opcode.scNone); 1608 exit.AddOpnd(s, Opnd.store); 1609 select := pb.AddInstr(Opcode.select, Opcode.scNone); 1610 select.AddOpnd(guard2, Opnd.arg); 1611 select.AddOpnd(pb.GetConstBool(TRUE), Opnd.arg); 1612 select.AddOpnd(s, Opnd.arg); 1613 select.AddOpnd(pb.GetConstBool(FALSE), Opnd.arg); 1614 select.AddOpnd(exit.AddResult(Result.store), Opnd.arg); 1615 s := select.AddResult(Result.store); 1616 1617 (* create "loop-end" instruction *) 1618 loopEnd := pb.AddInstr(Opcode. loopEnd, Opcode.scNone); 1619 loopEnd.AddOpnd(loopStart, Opnd.arg); 1620 (* add backward feed of `store' to "loop-end" *) 1621 loopEnd.AddOpnd(s, Opnd.backwardFeed); 1622 (* link "exit" to "loop-end" *) 1623 loopEnd.AddOpnd(exit.nextResult, Opnd.storeExit); 1624 1625 (* create the "select" for the IF statement around the loop *) 1626 select := pb.AddInstr(Opcode.select, Opcode.scNone); 1627 select.AddOpnd(guard1, Opnd.arg); 1628 select.AddOpnd(pb.GetConstBool(TRUE), Opnd.arg); 1629 select.AddOpnd(loopEnd.AddResult(Result.store), Opnd.arg); 1630 select.AddOpnd(pb.GetConstBool(FALSE), Opnd.arg); 1631 select.AddOpnd(storeAfterGuard1, Opnd.arg); 1632 1633 s := select.AddResult(Result.store); 1634 END IterateObjectStatm; 1635 1636 PROCEDURE LoopStatm (loopStatm: IR.LoopStatm); 1637 VAR 1638 start, end, oldSelect: SSA.Instr; 1639 BEGIN 1640 start := pb. AddInstr (Opcode.loopStart, Opcode.scNone); 1641 start. AddOpnd (s, Opnd.store); 1642 s := start. AddResult (Result.store); 1643 1644 (* create "loop-end" instruction *) 1645 end := pb. AddInstr (Opcode. loopEnd, Opcode.scNone); 1646 end. AddOpnd (start, Opnd.arg); 1647 end. AddOpnd (start, Opnd.backwardFeed); (* placeholder *) 1648 oldSelect := pb. SetLoopContext (end); 1649 1650 (* evaluate loop body *) 1651 s := StatmSeq (pb, s, loopStatm. body); 1652 1653 (* add backward feed of `store' to "loop-end" *) 1654 AddStoreBackwardFeed (pb, end, s); 1655 1656 (* note: any EXIT instructions in the loop body have added themself 1657 to the "loop-end" instruction *) 1658 1659 s := end. AddResult (Result.store); 1660 end := pb. SetLoopContext (oldSelect); 1661 END LoopStatm; 1662 1663 PROCEDURE Exit (exit: IR.Exit); 1664 VAR 1665 instr: SSA.Instr; 1666 store: SSA.Result; 1667 BEGIN 1668 s := PopExceptionContext(s, exit.popExceptionContext); 1669 instr := pb. AddInstr (Opcode.exit, Opcode.scNone); 1670 instr. AddOpnd (s, Opnd.store); 1671 1672 store := instr. AddResult (Result.store); 1673 pb. loopContext. AddOpnd (store, Opnd.storeExit); 1674 s := store 1675 END Exit; 1676 1677 PROCEDURE TryStatm(try: IR.TryStatm); 1678 VAR 1679 start, instr, e, end, typeTag, typeTest, 1680 pushExceptionContext, oldPushContext: SSA.Instr; 1681 sDefault, sCatch, catchClause: SSA.Result; 1682 i: LONGINT; 1683 BEGIN 1684 start := pb.AddInstr(Opcode.tryStart, Opcode.scBoolean); 1685 start.AddOpnd(s, Opnd.store); 1686 s := start.AddResult(Result.store); 1687 1688 (* evaluate TRY body *) 1689 instr := pb.AddInstr(Opcode.pushExceptionContext, Opcode.scNone); 1690 instr.AddOpnd(s, Opnd.store); 1691 oldPushContext := pb.SetTryContext(instr); 1692 s := StatmSeq(pb, instr.AddResult(Result.store), try.statmSeq); 1693 sDefault := PopExceptionContext(s, 1); 1694 pushExceptionContext := instr; 1695 1696 (* prepare CATCH block *) 1697 s := PopExceptionContext(start.AddResult(Result.store), 1); 1698 1699 (* get type tag of current exception *) 1700 e := pb.AddInstr(Opcode.currentException, Opcode.scAddress); 1701 e.AddOpnd(pb.tryContext, Opnd.arg); 1702 e.AddOpnd(s, Opnd.store); 1703 instr := pb.SetTryContext(e); (* set `tryContext' to current exception *) 1704 typeTag := pb.AddInstr(Opcode.typeTag, Opcode.scAddress); 1705 typeTag.AddOpnd(e, Opnd.arg); 1706 sCatch := s; 1707 1708 (* prepare fall through path *) 1709 instr := pb.AddInstr(Opcode.activateContext, Opcode.scNone); 1710 instr.AddOpnd(s, Opnd.store); 1711 s := instr.AddResult(Result.store); 1712 1713 FOR i := LEN(try.catchList^)-1 TO 0 BY -1 DO 1714 typeTest := pb.AddInstr(Opcode.typeTest, Opcode.scBoolean); 1715 typeTest.AddOpnd(typeTag, Opnd.arg); 1716 typeTest.AddOpnd(pb.GetTypeRef(try.catchList[i].exceptionType(Sym.Pointer).baseType), Opnd.type); 1717 1718 catchClause := StatmSeq(pb, sCatch, try.catchList[i].statmSeq); 1719 instr := pb.AddInstr(Opcode.select, Opcode.scNone); 1720 instr.AddOpnd(typeTest, Opnd.arg); 1721 instr.AddOpnd(pb.GetConstBool(TRUE), Opnd.arg); 1722 instr.AddOpnd(catchClause, Opnd.arg); 1723 instr.AddOpnd(pb.GetConstBool(FALSE), Opnd.arg); 1724 instr.AddOpnd(s, Opnd.arg); 1725 s := instr.AddResult(Result.store); 1726 END; 1727 instr := pb.AddInstr(Opcode.clearException, Opcode.scNone); 1728 instr.AddOpnd(pushExceptionContext, Opnd.arg); 1729 instr.AddOpnd(s, Opnd.store); 1730 s := instr.AddResult(Result.store); 1731 1732 (* merge paths through body and CATCH block *) 1733 instr := pb.AddInstr(Opcode.select, Opcode.scNone); 1734 instr.AddOpnd(start, Opnd.arg); 1735 instr.AddOpnd(pb.GetConstBool(FALSE), Opnd.arg); 1736 instr.AddOpnd(sDefault, Opnd.arg); 1737 instr.AddOpnd(pb.GetConstBool(TRUE), Opnd.arg); 1738 instr.AddOpnd(s, Opnd.arg); 1739 1740 (* create instruction marking the end of the block *) 1741 end := pb.AddInstr(Opcode.tryEnd, Opcode.scNone); 1742 end.AddOpnd(instr.AddResult(Result.store), Opnd.store); 1743 s := end.AddResult(Result.store); 1744 1745 instr := pb.SetTryContext(oldPushContext); 1746 END TryStatm; 1747 1748 PROCEDURE CopyParameter (cp: IR.CopyParameter); 1749 VAR 1750 instr: SSA.Instr; 1751 len: SSA.Result; 1752 BEGIN 1753 len := CalculateLength(pb, cp.param, -1, Expression (cp.param)); 1754 instr := pb. AddCopyParameter(cp. param. decl(Sym.VarDecl), s, len, 1755 CalculateSize(pb, cp.param, len)); 1756 s := instr. AddResult (Result.store); 1757 END CopyParameter; 1758 1759 PROCEDURE MoveBlock (move: IR.MoveBlock): SSA.Instr; 1760 VAR 1761 instr: SSA.Instr; 1762 source, dest, size: SSA.Result; 1763 BEGIN 1764 source := Expression (move. source); 1765 dest := Expression (move. dest); 1766 size := Expression (move. size); 1767 1768 instr := pb. AddInstr (Opcode.moveBlock, Opcode.scNone); 1769 instr. AddOpnd (s, Opnd.store); 1770 instr. AddOpnd (source, Opnd.readAdr); 1771 instr. AddOpnd (dest, Opnd.writeAdr); 1772 instr. AddOpnd (size, Opnd.arg); 1773 1774 RETURN instr; 1775 END MoveBlock; 1776 1777 PROCEDURE Raise (raise: IR.Raise): SSA.Instr; 1778 VAR 1779 instr: SSA.Instr; 1780 exception: SSA.Result; 1781 BEGIN 1782 exception := Expression (raise. exception); 1783 instr := pb. AddInstr (Opcode.raiseException, Opcode.scNone); 1784 instr. AddOpnd (s, Opnd.store); 1785 instr. AddOpnd (exception, Opnd.arg); 1786 RETURN instr; 1787 END Raise; 1788 1789 BEGIN 1790 FOR i := 0 TO LEN (statmSeq^)-1 DO 1791 statm := statmSeq[i]; 1792 WITH statm: IR.Assert DO 1793 Assert (statm); 1794 1795 | statm: IR.Assignment DO 1796 Chain (Assignment (statm)); 1797 1798 | statm: IR.Call DO 1799 Chain (Call (statm)); 1800 1801 | statm: IR.Return DO 1802 Return (statm); 1803 1804 | statm: IR.IfStatm DO 1805 IfStatm (statm); 1806 1807 | statm: IR.WithStatm DO 1808 WithStatm (statm); 1809 1810 | statm: IR.CaseStatm DO 1811 CaseStatm (statm); 1812 1813 | statm: IR.RepeatStatm DO 1814 RepeatStatm (statm); 1815 1816 | statm: IR.WhileStatm DO 1817 WhileStatm (statm); 1818 1819 | statm: IR.ForStatm DO 1820 ForStatm (statm); 1821 1822 | statm: IR.IterateArrayStatm DO 1823 IterateArrayStatm (statm); 1824 1825 | statm: IR.IterateObjectStatm DO 1826 IterateObjectStatm (statm); 1827 1828 | statm: IR.LoopStatm DO 1829 LoopStatm (statm); 1830 1831 | statm: IR.Exit DO 1832 Exit (statm); 1833 1834 | statm: IR.TryStatm DO 1835 TryStatm (statm); 1836 1837 | statm: IR.Copy DO 1838 Chain (Copy (statm)); 1839 1840 | statm: IR.CopyParameter DO 1841 CopyParameter (statm); 1842 1843 | statm: IR.CopyString DO 1844 Chain (CopyString (statm)); 1845 1846 | statm: IR.MoveBlock DO 1847 Chain (MoveBlock (statm)); 1848 1849 | statm: IR.Raise DO 1850 Chain (Raise (statm)); 1851 ELSE 1852 Log.Type("++ Unknown statement class in StatmSeq", statm); 1853 ASSERT (FALSE) 1854 END; 1855 END; 1856 RETURN s 1857 END StatmSeq; 1858 1859PROCEDURE DiscardGets* (pb: SSA.ProcBlock); 1860 VAR 1861 instr, next: SSA.Instr; 1862 storeOut: SSA.Result; 1863 BEGIN 1864 instr := pb. instrList; 1865 WHILE (instr # NIL) DO 1866 next := instr. nextInstr; 1867 IF (instr. opcode = Opcode.get) & (instr. useList = NIL) THEN 1868 storeOut := instr. GetResultStore(); 1869 storeOut. ReplaceUses (instr. opndList. arg); 1870 pb. DeleteInstr (instr); 1871 END; 1872 instr := next; 1873 END; 1874 END DiscardGets; 1875 1876END OOC:SSA:IRtoSSA. 1877