RoseWireTwiddlingImpl.Mesa
Last Edited by: Spreitzer, October 22, 1985 4:43:50 pm PDT
DIRECTORY Basics, BitTwiddling, PrincOps, PrincOpsUtils, RoseBehavior, RoseWireTwiddling, RoseWireTypes, UnsafeStorage;
RoseWireTwiddlingImpl: CEDAR PROGRAM
IMPORTS BitTwiddling, PrincOpsUtils, UnsafeStorage
EXPORTS RoseWireTwiddling
= {OPEN BitTwiddling, RoseWireTwiddling;
Selector: TYPE = RoseWireTypes.Selector;
disableCopy: BOOLFALSE;
uz: UNCOUNTED ZONE ← GetZone[];
GetZone: PROC RETURNS [UNCOUNTED ZONE] =
TRUSTED {RETURN [UnsafeStorage.GetSystemUZone[]]};
RefToPtr: PUBLIC PROC [ra: REF ANY, referentType: RoseWireType] RETURNS [p: Ptr] = {
bits: NAT = referentType.class.super.Bits[referentType.class];
p ← OffsetPtr[
PtrFromRef[ra],
altRem[Basics.bitsPerWord - (bits MOD Basics.bitsPerWord)]
]
};
CopyVal: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr, bbTable: PrincOps.BitBltTablePtr] = {
blt: BOOL ← toT.class.structure = atom OR (fromT = toT AND NOT fromT.class.addressContaining);
IF fromT.class.structure # toT.class.structure THEN ERROR;
IF fromT.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF toT.class.dereference THEN toP ← DeReferencePtr[toP];
IF blt THEN TRUSTED {
bitCount: NAT = toT.class.super.Bits[toT.class];
lineWidth: NAT ← PrincOpsUtils.BITAND[(bitCount+31), WORD.LAST-31];
IF bitCount # fromT.class.super.Bits[fromT.class] THEN ERROR;
bbTable^ ← [
dst: toP,
dstBpl: lineWidth,
src: fromP,
srcDesc: [srcBpl[lineWidth]],
width: bitCount,
height: 1,
flags: []];
IF NOT disableCopy THEN PrincOpsUtils.BITBLT[bbTable];
blt ← blt;
}
ELSE {
IF fromT.length # toT.length THEN ERROR;
FOR i: NAT IN [0 .. toT.length) DO
sel: Selector = SELECT fromT.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
CopyVal[
fromT: fromT.class.super.SubType[fromT, sel],
toT: toT.class.super.SubType[toT, sel],
fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]],
bbTable: bbTable];
ENDLOOP;
toP ← toP;
};
};
CopyAndLimitDrive: PUBLIC PROC [type: RoseWireType, fromP, toP: Ptr, min: Drive] = {
base: BOOL ← type.class.structure = atom;
IF type.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF type.class.dereference THEN toP ← DeReferencePtr[toP];
IF base THEN {
read: Drive ← ReadDrive[fromP];
limited: Drive ← MAX[read, min];
WriteDrive[toP, limited];
}
ELSE {
fromP ← fromP;
FOR i: NAT IN [0 .. type.length) DO
sel: Selector = SELECT type.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
offset: INTEGER = type.class.super.SelectorOffset[type, sel];
CopyAndLimitDrive[
type: type.class.super.SubType[type, sel],
fromP: OffsetPtr[fromP, offset],
toP: OffsetPtr[toP, offset],
min: min];
ENDLOOP;
toP ← toP;
};
};
CopyQ: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] = {
base: BOOL ← toT.class.structure = atom;
IF fromT.class.structure # toT.class.structure THEN ERROR;
IF base THEN {
IF fromT # toT THEN ERROR;
toT.class.super.CopyQ[toT, fromP, toP];
}
ELSE {
IF fromT.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF toT.class.dereference THEN toP ← DeReferencePtr[toP];
IF fromT.length # toT.length THEN ERROR;
FOR i: NAT IN [0 .. toT.length) DO
sel: Selector = SELECT fromT.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
CopyQ[
fromT: fromT.class.super.SubType[fromT, sel],
toT: toT.class.super.SubType[toT, sel],
fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
];
ENDLOOP;
toP ← toP;
};
};
CopyUD: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] = {
base: BOOL ← toT.class.structure = atom;
IF fromT.class.structure # toT.class.structure THEN ERROR;
IF base THEN {
IF fromT # toT THEN ERROR;
toT.class.super.CopyUD[toT, fromP, toP];
}
ELSE {
IF fromT.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF toT.class.dereference THEN toP ← DeReferencePtr[toP];
IF fromT.length # toT.length THEN ERROR;
FOR i: NAT IN [0 .. toT.length) DO
sel: Selector = SELECT fromT.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
CopyUD[
fromT: fromT.class.super.SubType[fromT, sel],
toT: toT.class.super.SubType[toT, sel],
fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
];
ENDLOOP;
toP ← toP;
};
};
CopyLevel: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] = {
base: BOOL ← toT.class.structure = atom;
IF fromT.class.structure # toT.class.structure THEN ERROR;
IF base THEN {
IF fromT # toT THEN ERROR;
toT.class.super.CopyLevel[toT, fromP, toP];
}
ELSE {
IF fromT.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF toT.class.dereference THEN toP ← DeReferencePtr[toP];
IF fromT.length # toT.length THEN ERROR;
FOR i: NAT IN [0 .. toT.length) DO
sel: Selector = SELECT fromT.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
CopyLevel[
fromT: fromT.class.super.SubType[fromT, sel],
toT: toT.class.super.SubType[toT, sel],
fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
];
ENDLOOP;
toP ← toP;
};
};
EqualVal: PUBLIC PROC [t1, t2: RoseWireType, p1, p2: Ptr] RETURNS [equal: BOOL] = {
block: BOOL ← t2.class.structure = atom OR (t1 = t2 AND NOT t1.class.addressContaining);
IF t1.class.structure # t2.class.structure THEN ERROR;
IF t1.class.dereference THEN p1 ← DeReferencePtr[p1];
IF t2.class.dereference THEN p2 ← DeReferencePtr[p2];
IF block THEN {
bitCount: NAT = t2.class.super.Bits[t2.class];
IF bitCount # t1.class.super.Bits[t1.class] THEN ERROR;
equal ← Equal[p1, p2, bitCount];
}
ELSE {
IF t1.length # t2.length THEN ERROR;
FOR i: NAT IN [0 .. t2.length) DO
sel: Selector = SELECT t1.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
IF NOT EqualVal[
t1: t1.class.super.SubType[t1, sel],
t2: t2.class.super.SubType[t2, sel],
p1: OffsetPtr[p1, t1.class.super.SelectorOffset[t1, sel]],
p2: OffsetPtr[p2, t2.class.super.SelectorOffset[t2, sel]]
]
THEN RETURN [FALSE];
ENDLOOP;
equal ← TRUE;
};
};
EqualUD: PUBLIC PROC [t1, t2: RoseWireType, p1, p2: Ptr] RETURNS [equal: BOOL] = {
base: BOOL ← t2.class.structure = atom;
IF t1.class.structure # t2.class.structure THEN ERROR;
IF base THEN {
IF t1 # t2 THEN ERROR;
equal ← t1.class.super.EqualUD[t1, p1, p2];
}
ELSE {
IF t1.class.dereference THEN p1 ← DeReferencePtr[p1];
IF t2.class.dereference THEN p2 ← DeReferencePtr[p2];
IF t1.length # t2.length THEN ERROR;
FOR i: NAT IN [0 .. t2.length) DO
sel: Selector = SELECT t1.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
IF NOT EqualUD[
t1: t1.class.super.SubType[t1, sel],
t2: t2.class.super.SubType[t2, sel],
p1: OffsetPtr[p1, t1.class.super.SelectorOffset[t1, sel]],
p2: OffsetPtr[p2, t2.class.super.SelectorOffset[t2, sel]]
]
THEN RETURN [FALSE];
ENDLOOP;
equal ← TRUE;
};
};
MaxinQ: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] RETURNS [increase: BOOL] = {
base: BOOL ← toT.class.structure = atom;
IF fromT.class.structure # toT.class.structure THEN ERROR;
IF base THEN {
IF fromT # toT THEN ERROR;
increase ← toT.class.super.MaxinQ[toT, fromP, toP];
}
ELSE {
IF fromT.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF toT.class.dereference THEN toP ← DeReferencePtr[toP];
IF fromT.length # toT.length THEN ERROR;
increase ← FALSE;
FOR i: NAT IN [0 .. toT.length) DO
sel: Selector = SELECT fromT.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
IF MaxinQ[
fromT: fromT.class.super.SubType[fromT, sel],
toT: toT.class.super.SubType[toT, sel],
fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
]
THEN increase ← TRUE;
ENDLOOP;
toP ← toP;
};
};
MaxinUD: PUBLIC PROC [fromT, toT: RoseWireType, fromP, toP: Ptr] RETURNS [increase: BOOL] = {
base: BOOL ← toT.class.structure = atom;
IF fromT.class.structure # toT.class.structure THEN ERROR;
IF base THEN {
IF fromT # toT THEN ERROR;
increase ← toT.class.super.MaxinUD[toT, fromP, toP];
}
ELSE {
IF fromT.class.dereference THEN fromP ← DeReferencePtr[fromP];
IF toT.class.dereference THEN toP ← DeReferencePtr[toP];
IF fromT.length # toT.length THEN ERROR;
increase ← FALSE;
FOR i: NAT IN [0 .. toT.length) DO
sel: Selector = SELECT fromT.class.structure FROM
atom => ERROR,
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
IF MaxinUD[
fromT: fromT.class.super.SubType[fromT, sel],
toT: toT.class.super.SubType[toT, sel],
fromP: OffsetPtr[fromP, fromT.class.super.SelectorOffset[fromT, sel]],
toP: OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]]
]
THEN increase ← TRUE;
ENDLOOP;
toP ← toP;
};
};
bitsPerDrive: NAT = SIZE[PACKED ARRAY [0 .. 32) OF Drive]/SIZE[PACKED ARRAY [0 .. 32) OF BOOL];
drivesPerWord: NAT = 480/SIZE[PACKED ARRAY [0 .. 480) OF Drive];
480 is LCM [Floor[32/1], Floor[32/2], Floor[32/3], ... Floor[32/32]].
ReadDrive: PUBLIC PROC [p: Ptr] RETURNS [d: Drive] = TRUSTED {
di: NAT = p.bit/bitsPerDrive;
ap: LONG POINTER TO PACKED ARRAY [0 .. drivesPerWord) OF Drive = LOOPHOLE[p.word];
IF di*bitsPerDrive # p.bit THEN ERROR;
d ← ap[di];
};
WriteDrive: PUBLIC PROC [p: Ptr, d: Drive] = TRUSTED {
di: NAT = p.bit/bitsPerDrive;
ap: LONG POINTER TO PACKED ARRAY [0 .. drivesPerWord) OF Drive = LOOPHOLE[p.word];
IF di*bitsPerDrive # p.bit THEN ERROR;
ap[di] ← d;
};
CreateUntypedInstance: PUBLIC PROC [rwt: RoseWireType] RETURNS [p: Ptr] = {
Setup: PROC [rwt: RoseWireType, p: Ptr, bits: INT] = TRUSTED {
rwc: RoseWireTypes.RoseWireClass = rwt.class;
rws: RoseWireTypes.RoseWireSuperClass = rwc.super;
q: Ptr ← p;
IF rwc.dereference THEN {
lplp: LONG POINTER TO LONG POINTER = LOOPHOLE[p.word];
IF p.bit # 0 THEN ERROR;
IF bits # SIZE[LONG POINTER] * Basics.bitsPerWord THEN ERROR;
q ← [
word: rws.CreateReferent[rwt],
bit: 0];
lplp^ ← q.word;
};
IF rwc.addressContaining THEN {
rwt ← rwt;
FOR i: NAT IN [0 .. rwt.length) DO
sel: Selector = SELECT rwc.structure FROM
sequence => [subscript[i]],
record => [field[i]],
ENDCASE => ERROR;
swt: RoseWireType = rws.SubType[rwt, sel];
sp: Ptr = BitTwiddling.OffsetPtr[q, rws.SelectorOffset[rwt, sel]];
Setup[swt, sp, swt.class.super.Bits[swt.class]];
ENDLOOP;
rwt ← rwt;
};
rwt ← rwt;
};
bits: NAT = rwt.class.super.Bits[rwt.class];
words: NAT = (bits + Basics.bitsPerWord-1) / Basics.bitsPerWord;
TRUSTED {
p ← [
word: UnsafeStorage.NewUObject[words, uz],
bit: (Basics.bitsPerWord - (bits MOD Basics.bitsPerWord)) MOD Basics.bitsPerWord
];
PrincOpsUtils.LongZero[p.word, words];
};
Setup[rwt, p, bits];
};
SubPtr: PUBLIC PROC [rwt: RoseWireType, p: Ptr, i: INT, driveHack: BOOLFALSE] RETURNS [q: Ptr] = {
IF driveHack AND rwt.class.structure = atom AND rwt.class.super.flavor = drive
THEN q ← p
ELSE {
sel: Selector = SELECT rwt.class.structure FROM
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
IF rwt.class.dereference THEN p ← DeReferencePtr[p];
q ← OffsetPtr[p, rwt.class.super.SelectorOffset[rwt, sel]];
};
};
SubType: PUBLIC PROC [rwt: RoseWireType, i: INT, driveHack: BOOLFALSE] RETURNS [swt: RoseWireType] = {
IF driveHack AND rwt.class.structure = atom AND rwt.class.super.flavor = drive
THEN swt ← rwt
ELSE {
sel: Selector = SELECT rwt.class.structure FROM
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
swt ← rwt.class.super.SubType[rwt, sel];
};
};
}.