RoseWireTwiddlingImpl:
CEDAR
PROGRAM
IMPORTS BitTwiddling, PrincOpsUtils, UnsafeStorage
EXPORTS RoseWireTwiddling
= {OPEN BitTwiddling, RoseWireTwiddling;
Selector: TYPE = RoseWireTypes.Selector;
disableCopy: BOOL ← FALSE;
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];
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];
lineWidth: NAT ← PrincOpsUtils.BITAND[(bitCount+31), WORD.LAST-31];
IF bitCount # fromT.class.super.Bits[fromT] 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];
IF bitCount # t1.class.super.Bits[t1] 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]];
ENDLOOP;
rwt ← rwt;
};
rwt ← rwt;
};
bits: NAT = rwt.class.super.Bits[rwt];
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];
};
}.