File: SubrangeType.m3 Last modified on Tue May 23 15:28:34 PDT 1995 by kalsow modified on Thu Jan 31 23:22:08 1991 by muller
MODULE; IMPORT M3, CG, Type, TypeRep, Int, LInt, Expr, Token, Card, M3Buf; IMPORT Error, IntegerExpr, EnumExpr, Word, TipeMap, TipeDesc; IMPORT Target, TInt, TWord, TargetMap, LCard; FROM Scanner IMPORT Match; TYPE P = Type.T BRANDED "SubrangeType.T" OBJECT baseType : Type.T; minE, maxE : Expr.T; min, max : Target.Int; rep : CG.Type; builtin : BOOLEAN; (* => CARDINAL *) sealed : BOOLEAN; OVERRIDES check := Check; check_align:= CheckAlign; isEqual := EqualChk; isSubtype := Subtyper; compile := Compiler; initCost := InitCoster; initValue := GenInit; mapper := GenMap; gen_desc := GenDesc; fprint := FPrinter; END; PROCEDURE SubrangeType Parse (): Type.T = TYPE TK = Token.T; VAR p: P := New (TInt.Zero, TInt.MOne, NIL, FALSE); BEGIN Match (TK.tLBRACKET); p.minE := Expr.Parse (); Match (TK.tDOTDOT); p.maxE := Expr.Parse (); Match (TK.tRBRACKET); RETURN p; END Parse; PROCEDURENew (READONLY min, max: Target.Int; base: Type.T; builtin: BOOLEAN): Type.T = VAR p: P; BEGIN p := NEW (P); TypeRep.Init (p, Type.Class.Subrange); p.baseType := base; p.min := min; p.max := max; p.builtin := builtin; RETURN p; END New; PROCEDUREReduce (t: Type.T): P = BEGIN IF (t = NIL) THEN RETURN NIL END; IF (t.info.class = Type.Class.Named) THEN t := Type.Strip (t) END; IF (t.info.class # Type.Class.Subrange) THEN RETURN NIL END; RETURN t; END Reduce; PROCEDURESplit (t: Type.T; VAR min, max: Target.Int): BOOLEAN = VAR p := Reduce (t); BEGIN IF (p = NIL) THEN RETURN FALSE END; min := p.min; max := p.max; RETURN TRUE; END Split; PROCEDURESetRep (p: P) = BEGIN IF Type.IsSubtype (p.baseType, LInt.T) THEN p.rep := Target.Longint.cg_type; ELSE p.rep := Target.Integer.cg_type; END; IF TInt.LT (p.max, p.min) THEN p.min := TInt.Zero; p.max := TInt.MOne; RETURN; END; IF TInt.LE (TInt.Zero, p.min) THEN (* look for an unsigned type *) FOR i := FIRST (TargetMap.Word_types) TO LAST (TargetMap.Word_types) DO WITH z = TargetMap.Word_types[i] DO IF TWord.LE (p.max, z.max) THEN p.rep := z.cg_type; RETURN; END; END; END; ELSE (* look for a signed type *) FOR i := FIRST (TargetMap.Integer_types) TO LAST (TargetMap.Integer_types) DO WITH z = TargetMap.Integer_types[i] DO IF TInt.LE (z.min, p.min) AND TInt.LE (p.max, z.max) THEN p.rep := z.cg_type; RETURN; END; END; END; END; END SetRep; PROCEDURESeal (p: P) = VAR emin, emax: Expr.T; tmin, tmax: Type.T; BEGIN IF (p.sealed) THEN RETURN END; IF (p.minE # NIL) THEN emin := Expr.ConstValue (p.minE); IF (emin = NIL) THEN Error.Msg ("subrange lower bound is not constant"); p.min := TInt.Zero; tmin := Int.T; ELSIF IntegerExpr.Split (emin, p.min, tmin) THEN (* ok *) ELSIF EnumExpr.Split (emin, p.min, tmin) THEN (* ok *) ELSE Error.Msg ("subrange lower bound is not an ordinal value"); p.min := TInt.Zero; tmin := Int.T; END; emax := Expr.ConstValue (p.maxE); IF (emax = NIL) THEN Error.Msg ("subrange upper bound is not constant"); p.max := p.min; tmax := tmin; ELSIF IntegerExpr.Split (emax, p.max, tmax) THEN (* ok *) ELSIF EnumExpr.Split (emax, p.max, tmax) THEN (* ok *) ELSE Error.Msg ("subrange upper bound is not an ordinal value"); p.max := p.min; tmax := tmin; END; p.baseType := tmin; IF NOT Type.IsEqual (tmin, tmax, NIL) THEN Error.Msg ("subrange endpoints must be of same type"); END; END; SetRep (p); p.sealed := TRUE; END Seal; PROCEDURECheck (p: P) = VAR hash: INTEGER; cs := M3.OuterCheckState; i: INTEGER; info: Type.Info; BEGIN Seal (p); Expr.TypeCheck (p.minE, cs); Expr.TypeCheck (p.maxE, cs); p.baseType := Type.CheckInfo (p.baseType, info); hash := info.hash; IF NOT TInt.ToInt (p.min, i) THEN i := 19 END; hash := Word.Plus (Word.Times (hash, 487), i); IF NOT TInt.ToInt (p.max, i) THEN i := 23 END; hash := Word.Plus (Word.Times (hash, 487), i); p.info.size := TargetMap.CG_Size[p.rep]; p.info.min_size := MinSize (p); p.info.alignment := TargetMap.CG_Align[p.rep]; p.info.mem_type := p.rep; IF Type.IsSubtype (p.baseType, LInt.T) THEN IF Target.SignedType [p.rep] THEN p.info.stk_type := Target.Longint.cg_type; ELSE p.info.stk_type := Target.Long.cg_type; END; ELSE IF Target.SignedType [p.rep] THEN p.info.stk_type := Target.Integer.cg_type; ELSE p.info.stk_type := Target.Word.cg_type; END; END; p.info.class := Type.Class.Subrange; p.info.isTraced := FALSE; p.info.isSolid := TRUE; p.info.isEmpty := TInt.LT (p.max, p.min); p.info.hash := hash; END Check; PROCEDURECheckAlign (p: P; offset: INTEGER): BOOLEAN = VAR sz := TargetMap.CG_Size[p.rep]; z0: INTEGER; BEGIN IF p.info.lazyAligned THEN z0 := offset DIV 8 * 8; ELSE z0 := offset DIV Target.Integer.align * Target.Integer.align; END; RETURN (offset + sz) <= (z0 + Target.Integer.size); END CheckAlign; PROCEDURECompiler (p: P) = BEGIN Type.Compile (p.baseType); CG.Declare_subrange (Type.GlobalUID (p), Type.GlobalUID (p.baseType), p.min, p.max, TargetMap.CG_Size[p.rep]); END Compiler; PROCEDUREBase (t: Type.T): Type.T = VAR p: P := t; BEGIN Seal (p); t := p.baseType; IF (t = NIL) THEN t := Expr.TypeOf (p.minE) END; RETURN t END Base; PROCEDUREEqualChk (a: P; t: Type.T; x: Type.Assumption): BOOLEAN = VAR b: P := t; BEGIN Seal (a); Seal (b); RETURN (a.builtin = b.builtin) AND TInt.EQ (a.min, b.min) AND TInt.EQ (a.max, b.max) AND Type.IsEqual (a.baseType, b.baseType, x); END EqualChk; PROCEDURESubtyper (a: P; t: Type.T): BOOLEAN = VAR b: P; BEGIN Seal (a); IF NOT Type.IsEqual (Type.Base (a.baseType), Type.Base (t), NIL) THEN RETURN FALSE END; IF (t.info.class # Type.Class.Subrange) THEN RETURN TRUE END; IF TInt.LT (a.max, a.min) THEN (* a is empty *) RETURN TRUE END; b := t; RETURN TInt.LE (b.min, a.min) AND TInt.LE (a.max, b.max); END Subtyper; PROCEDUREMinSize (p: P): INTEGER = VAR z1, z2: INTEGER; n1, n2: BOOLEAN; BEGIN (* compute the minimum size of these elements *) IF TInt.LT (p.max, p.min) THEN RETURN 0 END; BitWidth (p.min, z1, n1); BitWidth (p.max, z2, n2); z1 := MAX (z1, z2); IF (n1 OR n2) THEN INC (z1); END; IF Type.IsSubtype (p.baseType, LInt.T) THEN RETURN MIN (z1, Target.Longint.size); ELSE RETURN MIN (z1, Target.Integer.size); END; END MinSize; PROCEDUREBitWidth (n: Target.Int; VAR width: INTEGER; VAR neg: BOOLEAN) = (*** valid for Target.Longint.min <= n <= Target.Longint.max ***) VAR tmp: Target.Int; BEGIN neg := TInt.LT (n, TInt.Zero); IF (neg) THEN IF NOT TInt.Add (n, TInt.One, tmp) OR NOT TInt.Subtract (TInt.Zero, tmp, n) THEN (* value too large??? *) width := Target.Longint.size; RETURN; END; END; IF NOT powers_done THEN BuildPowerTables () END; width := Target.Longint.size; FOR i := 0 TO LAST (power) DO IF TInt.LE (n, power[i]) THEN width := i; EXIT END; END; END BitWidth; VAR (*CONST*) power : ARRAY [0..BITSIZE (Target.Int)] OF Target.Int; powers_done := FALSE; PROCEDUREBuildPowerTables () = BEGIN power [0] := TInt.One; FOR i := 1 TO LAST (power) DO IF NOT TInt.Add (power[i-1], power[i-1], power[i]) THEN power[i] := Target.Longint.max; END; END; powers_done := TRUE; END BuildPowerTables; PROCEDUREInitCoster (p: P; zeroed: BOOLEAN): INTEGER = VAR rep_min, rep_max: Target.Int; size: INTEGER; BEGIN Seal (p); IF Type.IsSubtype (p.baseType, LInt.T) THEN size := Target.Longint.size; rep_min := Target.Longint.min; rep_max := Target.Longint.max; ELSE size := Target.Integer.size; rep_min := Target.Integer.min; rep_max := Target.Integer.max; END; IF zeroed AND TInt.LE (p.min, TInt.Zero) AND TInt.LE (TInt.Zero, p.max) THEN RETURN 0; END; IF (TargetMap.CG_Size[p.rep] = size) AND NOT (TInt.EQ (p.min, rep_min) AND TInt.EQ (p.max, rep_max)) THEN (* this rep uses a full integer word, but doesn't actually use all possible bit patterns => unsigned word => CARDINAL *) RETURN 1; END; CASE p.rep OF | CG.Type.Word8 => rep_min := Target.Word8.min; rep_max := Target.Word8.max; | CG.Type.Word16 => rep_min := Target.Word16.min; rep_max := Target.Word16.max; | CG.Type.Word32 => rep_min := Target.Word32.min; rep_max := Target.Word32.max; | CG.Type.Word64 => rep_min := Target.Word64.min; rep_max := Target.Word64.max; | CG.Type.Int8 => rep_min := Target.Int8.min; rep_max := Target.Int8.max; | CG.Type.Int16 => rep_min := Target.Int16.min; rep_max := Target.Int16.max; | CG.Type.Int32 => rep_min := Target.Int32.min; rep_max := Target.Int32.max; | CG.Type.Int64 => rep_min := Target.Int64.min; rep_max := Target.Int64.max; ELSE rep_min := TInt.Zero; rep_max := TInt.MOne; END; IF TInt.EQ (p.min, rep_min) AND TInt.EQ (p.max, rep_max) THEN RETURN 0; ELSE RETURN 1; END; END InitCoster; PROCEDUREGenInit (p: P; zeroed: BOOLEAN) = VAR info: Type.Info; BEGIN EVAL Type.CheckInfo (p, info); IF TInt.LT (TInt.Zero, p.min) OR TInt.LT (p.max, TInt.Zero) THEN CG.Load_integer (info.stk_type, p.min); CG.Store_indirect (info.stk_type, 0, info.size); ELSIF zeroed THEN CG.Discard (CG.Type.Addr); ELSE CG.Load_integer (info.stk_type, TInt.Zero); CG.Store_indirect (info.stk_type, 0, info.size); END; END GenInit; PROCEDUREGenMap (p: P; offset, size: INTEGER; refs_only: BOOLEAN) = VAR bit_offset := offset MOD Target.Byte; op: TipeMap.Op; BEGIN IF refs_only THEN RETURN END; IF TInt.LT (p.min, TInt.Zero) OR TInt.LT (p.max, TInt.Zero) THEN (* value is signed *) IF (bit_offset # 0) THEN op := TipeMap.Op.Int_Field; ELSIF (size = 1 * Target.Byte) THEN op := TipeMap.Op.Int_1; ELSIF (size = 2 * Target.Byte) THEN op := TipeMap.Op.Int_2; ELSIF (size = 4 * Target.Byte) THEN op := TipeMap.Op.Int_4; ELSIF (size = 8 * Target.Byte) THEN op := TipeMap.Op.Int_8; ELSE (* weird size *) op := TipeMap.Op.Int_Field; END; ELSE (* value is unsigned *) IF (bit_offset # 0) THEN op := TipeMap.Op.Word_Field; ELSIF (size = 1 * Target.Byte) THEN op := TipeMap.Op.Word_1; ELSIF (size = 2 * Target.Byte) THEN op := TipeMap.Op.Word_2; ELSIF (size = 4 * Target.Byte) THEN op := TipeMap.Op.Word_4; ELSIF (size = 8 * Target.Byte) THEN op := TipeMap.Op.Word_8; ELSE (* weird size *) op := TipeMap.Op.Word_Field; END; END; TipeMap.Add (offset, op, bit_offset + 256 * size); END GenMap; PROCEDUREGenDesc (p: P) = BEGIN IF Type.IsEqual (p, Card.T, NIL) THEN EVAL TipeDesc.AddO (TipeDesc.Op.Cardinal, p); ELSIF Type.IsEqual (p, LCard.T, NIL) THEN EVAL TipeDesc.AddO (TipeDesc.Op.Longcard, p); ELSIF TipeDesc.AddO (TipeDesc.Op.Subrange, p) THEN TipeDesc.AddX (p.min); TipeDesc.AddX (p.max); END; END GenDesc; PROCEDUREFPrinter (p: P; VAR x: M3.FPInfo) = BEGIN IF Type.IsEqual (p, Card.T, NIL) THEN x.tag := "$cardinal"; x.n_nodes := 0; ELSIF Type.IsEqual (p, LCard.T, NIL) THEN x.tag := "$longcard"; x.n_nodes := 0; ELSE M3Buf.PutText (x.buf, "SUBRANGE "); M3Buf.PutIntt (x.buf, p.min); M3Buf.PutChar (x.buf, ' '); M3Buf.PutIntt (x.buf, p.max); IF (p.baseType = Int.T) OR (Type.Base (p.baseType) = Int.T) THEN x.n_nodes := 0; ELSE x.n_nodes := 1; x.nodes[0] := p.baseType; END; END; END FPrinter; BEGIN END SubrangeType.