(* Copyright (C) 1992, Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: SubscriptExpr.m3 *) (* Last modified on Tue Nov 3 16:41:04 PST 1992 by kalsow *) (* modified on Thu Mar 7 01:44:07 1991 by muller *) MODULE SubscriptExpr; IMPORT Expr, ExprRep, ArrayType, Error, Type, Int, Emit; IMPORT ArrayExpr, OpenArrayType, Host, Frame; IMPORT CheckExpr, SubtractExpr, IntegerExpr, Fault; IMPORT RefType, DerefExpr, Temp, MBuf, Addr; TYPE P = ExprRep.Tab BRANDED "SubscriptExpr.P" OBJECT biased_b : Expr.T; OVERRIDES typeOf := TypeOf; check := Check; compile := Compile; evaluate := Fold; fprint := FPrinter; write := Writer; isEqual := ExprRep.EqCheckAB; getBounds := ExprRep.NoBounds; isWritable := IsWritable; isDesignator := IsDesignator; isZeroes := ExprRep.IsNever; note_write := NoteWrites; genLiteral := ExprRep.NoLiteral; END; PROCEDURE New (a, b: Expr.T): Expr.T = VAR p: P; BEGIN p := NEW (P); ExprRep.Init (p); p.a := a; p.b := b; p.biased_b := NIL; RETURN p; END New; PROCEDURE TypeOf (p: P): Type.T = VAR ta, ti, te: Type.T; BEGIN ta := Type.Base (Expr.TypeOf (p.a)); IF RefType.Is (ta) THEN (* auto-magic dereference *) p.a := DerefExpr.New (p.a); ta := Type.Base (Expr.TypeOf (p.a)); END; IF ArrayType.Split (ta, ti, te) THEN RETURN te; ELSE RETURN ta; END; END TypeOf; PROCEDURE Check (p: P; VAR cs: Expr.CheckState) = VAR ta, tb, ti, te: Type.T; mini, maxi, minb, maxb: INTEGER; BEGIN Expr.TypeCheck (p.a, cs); Expr.TypeCheck (p.b, cs); ta := Type.Base (Expr.TypeOf (p.a)); tb := Expr.TypeOf (p.b); IF RefType.Is (ta) THEN (* auto-magic dereference *) p.a := DerefExpr.New (p.a); Expr.TypeCheck (p.a, cs); ta := Type.Base (Expr.TypeOf (p.a)); END; IF NOT ArrayType.Split (ta, ti, te) THEN Error.Msg ("subscripted expression is not an array"); RETURN ; END; p.type := te; EVAL Type.GetBounds (ti, mini, maxi); Expr.GetBounds (p.b, minb, maxb); p.biased_b := p.b; IF (ti = NIL) THEN (* a is an open array *) IF Type.IsSubtype (tb, Int.T) THEN (************* we use an unsigned check below ************** IF (minb < 0) THEN p.biased_b := CheckExpr.NewLower (p.b, 0); Expr.TypeCheck (p.biased_b, cs); END; *********************************************************) ELSE Error.Msg ("open arrays must be indexed by integer expressions"); END; ELSIF Type.IsSubtype (tb, Type.Base (ti)) THEN (* the index value's type has a common base type with the index type *) IF (mini # 0) THEN p.biased_b := SubtractExpr.New (p.b, IntegerExpr.New (mini), TRUE); Expr.TypeCheck (p.biased_b, cs); END; IF (minb < mini) AND (maxb > maxi) THEN p.biased_b := CheckExpr.New (p.biased_b, 0, maxi - mini); Expr.TypeCheck (p.biased_b, cs); ELSIF (minb < mini) THEN p.biased_b := CheckExpr.NewLower (p.biased_b, 0); Expr.TypeCheck (p.biased_b, cs); ELSIF (maxb > maxi) THEN p.biased_b := CheckExpr.NewUpper (p.biased_b, maxi - mini); Expr.TypeCheck (p.biased_b, cs); END; ELSE Error.Msg ("incompatible array index"); END; END Check; PROCEDURE Compile (p: P): Temp.T = VAR ta, ti, te: Type.T; depth, block: INTEGER; t1, t2, t3, t4, t5: Temp.T; BEGIN ta := Type.Base (Expr.TypeOf (p.a)); depth := OpenArrayType.OpenDepth (ta); t2 := Expr.Compile (p.a); t3 := Expr.Compile (p.biased_b); IF (depth = 0) THEN (* a is a fixed array *) t1 := Temp.AllocMacro (p, TRUE); Temp.Depend (t1, t2); Temp.Depend (t1, t3); RETURN t1; ELSIF (depth = 1) THEN (* a is a single dimension open array *) VAR b: BOOLEAN := ArrayType.Split (ta, ti, te); BEGIN <* ASSERT b *> END; t5 := Temp.AllocEmpty (Addr.T); t4 := Temp.Alloc (p.b); Frame.PushBlock (block, 1); Emit.OpF ("@* _array", ta); Emit.OpT (" = & @;\n", t2); Emit.OpTT ("@ = @;\n", t4, t3); IF Host.doRangeChk THEN Emit.OpT ("if ((unsigned)@ >= (unsigned)(_array->size[0])) ", t4); Fault.Range (); END; Emit.OpTT ("@ = (_ADDRESS) (_array->elts + @);\n", t5, t4); Frame.PopBlock (block); Temp.Free (t2); Temp.Free (t3); Temp.Free (t4); t1 := Temp.AllocMacro (p, TRUE); Temp.Depend (t1, t5); RETURN t1; ELSE (* a is a multi-dimensional open array *) VAR b: BOOLEAN := ArrayType.Split (ta, ti, te); BEGIN <* ASSERT b *> END; t1 := Temp.AllocEmpty (te, TRUE); t4 := Temp.Alloc (p.b); Frame.PushBlock (block, 1); Emit.OpF ("@* _array", ta); Emit.OpT (" = & @;\n", t2); Emit.OpTT ("@ = @;\n", t4, t3); IF Host.doRangeChk THEN Emit.OpT ("if ((unsigned)@ >= (unsigned)(_array->size[0])) ", t4); Fault.Range (); END; FOR i := 1 TO depth - 1 DO Emit.OpTI ("@.size[@] = ", t1, i - 1); Emit.OpI ("_array->size[@];\n", i); END; Emit.OpTT ("@.elts = _array->elts + @", t1, t4); FOR i := 1 TO depth - 1 DO Emit.OpI (" * _array->size[@]", i) END; Emit.Op (";\n"); Frame.PopBlock (block); Temp.Free (t2); Temp.Free (t3); Temp.Free (t4); RETURN t1; END; END Compile; PROCEDURE Writer (p: P; t1, t2: Temp.T) = VAR ta: Type.T; depth: INTEGER; BEGIN ta := Type.Base (Expr.TypeOf (p.a)); depth := OpenArrayType.OpenDepth (ta); IF (depth = 0) THEN Emit.OpTT ("(@.elts[@])", t1, t2); ELSIF (depth = 1) THEN Emit.OpFT ("(*(@*)@)", p.type, t1); ELSE <* ASSERT FALSE *> END; END Writer; PROCEDURE IsDesignator (p: P): BOOLEAN = BEGIN RETURN Expr.IsDesignator (p.a); END IsDesignator; PROCEDURE IsWritable (p: P): BOOLEAN = BEGIN RETURN Expr.IsWritable (p.a); END IsWritable; PROCEDURE NoteWrites (p: P) = BEGIN Expr.NoteWrite (p.a); END NoteWrites; PROCEDURE Fold (p: P): Expr.T = VAR e1, e2, e3: Expr.T; BEGIN e1 := Expr.ConstValue (p.a); e2 := Expr.ConstValue (p.b); e3 := NIL; IF e1 = NIL OR e2 = NIL THEN RETURN NIL ELSIF ArrayExpr.Subscript (e1, e2, e3) THEN RETURN e3 ELSE RETURN NIL; END; END Fold; PROCEDURE FPrinter (p: P; map: Type.FPMap; wr: MBuf.T) = BEGIN MBuf.PutText (wr, "[] "); Expr.Fingerprint (p.a, map, wr); Expr.Fingerprint (p.b, map, wr); END FPrinter; BEGIN END SubscriptExpr.