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