File: PackedType.m3 Last modified on Tue May 23 15:25:39 PDT 1995 by kalsow modified on Fri Dec 21 01:25:20 1990 by muller
MODULE; IMPORT M3, CG, Word, Type, TypeRep, Error, Expr, Target; IMPORT M3Buf, Token, IntegerExpr, Scanner, TipeDesc; CONST NO_SIZE = -1; TYPE P = Type.T OBJECT sizeE : Expr.T; newSize : INTEGER; baseType : Type.T; 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 PackedType Parse (): Type.T = TYPE TK = Token.T; VAR p: P := New (NO_SIZE, NIL); BEGIN Scanner.Match (TK.tBITS); p.sizeE := Expr.Parse (); Scanner.Match (TK.tFOR); p.baseType := Type.Parse (); RETURN p; END Parse; PROCEDURENew (size: INTEGER; base: Type.T): Type.T = VAR p: P; BEGIN p := NEW (P); TypeRep.Init (p, Type.Class.Packed); p.sizeE := NIL; p.newSize := size; p.baseType := base; 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.Packed) THEN RETURN NIL END; RETURN t; END Reduce; PROCEDUREGetSize (p: P): INTEGER = VAR newSize: INTEGER; e: Expr.T; BEGIN IF (p.newSize = NO_SIZE) AND (p.sizeE # NIL) THEN e := Expr.ConstValue (p.sizeE); IF (e = NIL) OR NOT IntegerExpr.ToInt (e, newSize) THEN Error.Msg ("BITS FOR size must be a constant integer"); ELSE p.sizeE := e; p.newSize := newSize; END; END; RETURN p.newSize; END GetSize; PROCEDURESplit (t: Type.T; VAR size: INTEGER; VAR base: Type.T) = VAR p := Reduce (t); BEGIN size := GetSize (p); base := p.baseType; END Split; PROCEDUREBase (t: Type.T): Type.T = VAR p: P := t; BEGIN RETURN p.baseType; END Base; PROCEDURECheck (p: P) = VAR new_sz, old_min: INTEGER; cs := M3.OuterCheckState; info: Type.Info; BEGIN p.baseType := Type.CheckInfo (p.baseType, info); old_min := info.min_size; new_sz := info.size; IF (p.sizeE # NIL) THEN Expr.TypeCheck (p.sizeE, cs); new_sz := GetSize (p); IF (new_sz = NO_SIZE) THEN new_sz := info.size; END; END; IF (new_sz < old_min) THEN Error.Int (old_min, "BITS FOR size too small, must be at least"); END; p.info.size := new_sz; p.info.min_size := new_sz; p.info.alignment := info.alignment; p.info.mem_type := info.mem_type; p.info.stk_type := info.stk_type; p.info.class := Type.Class.Packed; p.info.isTraced := info.isTraced; p.info.isEmpty := info.isEmpty; p.info.isSolid := info.isSolid; p.info.hash := Word.Plus (Word.Times (61, info.hash), new_sz); END Check; PROCEDURECheckAlign (p: P; offset: INTEGER): BOOLEAN = VAR z0: INTEGER; info: Type.Info; sz: INTEGER; BEGIN EVAL Type.CheckInfo (p.baseType, info); sz := GetSize (p); IF (info.size = sz) THEN RETURN Type.IsAlignedOk (p.baseType, offset); ELSIF Type.IsStructured (p.baseType) THEN (* the scalar crossing can't be any worse than in the full structure *) RETURN Type.IsAlignedOk (p.baseType, offset); ELSE 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; END CheckAlign; PROCEDURECompiler (p: P) = BEGIN Type.Compile (p.baseType); CG.Declare_packed (Type.GlobalUID (p), p.newSize, Type.GlobalUID (p.baseType)); END Compiler; PROCEDUREEqualChk (a: P; t: Type.T; x: Type.Assumption): BOOLEAN = VAR b: P := t; BEGIN RETURN GetSize (a) = GetSize (b) AND Type.IsEqual (a.baseType, b.baseType, x); END EqualChk; PROCEDURESubtyper (a: P; b: Type.T): BOOLEAN = BEGIN RETURN Type.IsEqual (b, a.baseType, NIL); END Subtyper; PROCEDUREInitCoster (p: P; zeroed: BOOLEAN): INTEGER = BEGIN RETURN Type.InitCost (p.baseType, zeroed); END InitCoster; PROCEDUREGenInit (p: P; zeroed: BOOLEAN) = BEGIN Type.InitValue (p.baseType, zeroed); (* BUG!! *) END GenInit; PROCEDUREGenMap (p: P; offset, size: INTEGER; refs_only: BOOLEAN) = BEGIN <*ASSERT size <= p.newSize*> Type.GenMap (p.baseType, offset, size, refs_only); END GenMap; PROCEDUREGenDesc (p: P) = BEGIN IF TipeDesc.AddO (TipeDesc.Op.Packed, p) THEN TipeDesc.AddI (p.newSize); Type.GenDesc (p.baseType); END; END GenDesc; PROCEDUREFPrinter (p: P; VAR x: M3.FPInfo) = BEGIN M3Buf.PutText (x.buf, "BITS-FOR "); M3Buf.PutInt (x.buf, p.newSize); x.n_nodes := 1; x.nodes[0] := p.baseType; END FPrinter; BEGIN END PackedType.