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: 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];
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];
};

}.
ฆRoseWireTwiddlingImpl.Mesa
Last Edited by: Spreitzer, September 24, 1985 3:54:57 pm PDT
480 is LCM [Floor[32/1], Floor[32/2], Floor[32/3], ... Floor[32/32]].

ส
ุ–

"cedar" style˜Icode™J™<K˜Kšฯk	œn˜wK˜šะbxœœ
˜$Kšœ+˜2Kšœ˜K˜Kšœœ!˜)K˜Kšœ
œ˜(K˜Kšœ
œœ
˜Kšœ	œ
œ
˜K˜š
ฯnœœ
œ	œ
œ˜(Kšœœ#˜2—K˜šŸœœ
œœ
œœ
˜TKšœœ/˜8˜K˜Kšœ"œ˜:K˜
—K˜—K˜šŸœœ
œR˜fKš	œœœœ
œ ˜^Kšœ-œ
œ
˜:Kšœœ˜>Kšœœ˜8šœœ
œ˜Kšœ
œ˜*Kš	œœœœ
œ˜CKšœ+œ
œ
˜8˜Kš
œ	˜	Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜
K˜—Kšœ
œ
œœ
˜6Kš
œ
˜
K˜
—šœ˜Kšœœ
œ
˜(šœœ
œ˜"šœœ˜1Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—˜K˜-K˜'Kš
œF˜FKš
œ>˜>Kš
œ˜—Kšœ
˜—K˜
K˜—K˜—K˜šŸœœ
œ6˜TKšœœ˜)Kšœœ˜=Kšœœ˜9šœœ˜Kš
œ˜Kšœœ˜ K˜K˜
—šœ˜K˜šœœ
œ˜#šœœ˜0Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—Kšœœ.˜=š
œ˜Kš
œ*˜*Kš
œ ˜ Kš
œ˜Kš
œ
˜
—Kšœ
˜—K˜
K˜—K˜—K˜šŸœœ
œ0˜BKšœœ˜(Kšœ-œ
œ
˜:šœœ˜Kšœ
œ
œ
˜K˜'K˜
—šœ˜Kšœœ˜>Kšœœ˜8Kšœœ
œ
˜(šœœ
œ˜"šœœ˜1Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—š
œ˜K˜-K˜'Kš
œF˜FKš
œ=˜=Kš
œ˜—Kšœ
˜—K˜
K˜—K˜—K˜šŸœœ
œ0˜CKšœœ˜(Kšœ-œ
œ
˜:šœœ˜Kšœ
œ
œ
˜K˜(K˜
—šœ˜Kšœœ˜>Kšœœ˜8Kšœœ
œ
˜(šœœ
œ˜"šœœ˜1Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—š
œ˜K˜-K˜'Kš
œF˜FKš
œ=˜=Kš
œ˜—Kšœ
˜—K˜
K˜—K˜—K˜šŸ	œœ
œ0˜FKšœœ˜(Kšœ-œ
œ
˜:šœœ˜Kšœ
œ
œ
˜K˜+K˜
—šœ˜Kšœœ˜>Kšœœ˜8Kšœœ
œ
˜(šœœ
œ˜"šœœ˜1Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—š
œ
˜
K˜-K˜'Kš
œF˜FKš
œ=˜=Kš
œ˜—Kšœ
˜—K˜
K˜—K˜—K˜š
Ÿœœ
œ%œ	œ˜SKš	œœœ
œ
œ˜XKšœ)œ
œ
˜6Kšœœ˜5Kšœœ˜5šœœ˜Kšœ
œ˜(Kšœ%œ
œ
˜2K˜ K˜
—šœ˜Kšœœ
œ
˜$šœœ
œ˜!šœœ˜.Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—šœ
œ
˜K˜$K˜$Kš
œ:˜:Kš
œ9˜9Kš
œ
˜
—Kšœ
œœ˜Kšœ
˜—Kšœœ
˜
K˜—K˜—K˜š
Ÿœœ
œ%œ	œ˜RKšœœ˜'Kšœ)œ
œ
˜6šœœ˜Kšœ
œ
œ
˜K˜+K˜
—šœ˜Kšœœ˜5Kšœœ˜5Kšœœ
œ
˜$šœœ
œ˜!šœœ˜.Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—šœ
œ	˜K˜$K˜$Kš
œ:˜:Kš
œ9˜9Kš
œ
˜
—Kšœ
œœ˜Kšœ
˜—Kšœœ
˜
K˜—K˜—K˜š
ะbnœœ
œ-œœ˜\Kšœœ˜(Kšœ-œ
œ
˜:šœœ˜Kšœ
œ
œ
˜Kš
œ3˜3K˜
—šœ˜Kšœœ˜>Kšœœ˜8Kšœœ
œ
˜(Kšœœ
˜šœœ
œ˜"šœœ˜1Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—šœ˜
K˜-K˜'Kš
œF˜FKš
œ=˜=Kš
œ
˜
—Kšœœ
˜Kšœ
˜—K˜
K˜—K˜—K˜š
 œœ
œ-œœ˜]Kšœœ˜(Kšœ-œ
œ
˜:šœœ˜Kšœ
œ
œ
˜Kš
œ4˜4K˜
—šœ˜Kšœœ˜>Kšœœ˜8Kšœœ
œ
˜(Kšœœ
˜šœœ
œ˜"šœœ˜1Kšœœ
˜K˜Kš
œ˜Kšœœ
˜—šœ	˜K˜-K˜'Kš
œF˜FKš
œ=˜=Kš
œ
˜
—Kšœœ
˜Kšœ
˜—K˜
K˜—K˜—K˜Kšœœœ
œ
œœœ
œ
œœ
œ˜_šœœœ
œ
œœ˜@K™E—K™š
Ÿ	œœ
œ
œœ˜>Kšœœ˜Kšœœ
œ
œ
œ
œœ	œ	˜RKšœœ
œ
˜&K˜K˜—K˜šŸ
œœ
œœ˜6Kšœœ˜Kšœœ
œ
œ
œ
œœ	œ	˜RKšœœ
œ
˜&K˜K˜—K˜šŸœœ
œœ
˜KšŸœœ#œœ˜>Kš
œ-˜-Kš
œ2˜2K˜šœœ˜Kš
œœ
œ
œ
œ
œœ	˜6Kšœœ
œ
˜Kšœœ
œ
œœ
œ
˜=˜Kš
œ˜K˜—K˜K˜—šœœ˜Kš
œ
˜
šœœ
œ˜"šœœ˜)K˜K˜Kšœœ
˜—K˜*Kš
œB˜BKš
œ*˜*Kšœ
˜—Kš
œ
˜
K˜—Kš
œ
˜
K˜—Kšœœ˜&Kšœœ6˜@šœ˜	˜Kš
œ*˜*Kšœ!œœ˜PK˜—Kš
œ&˜&K˜—K˜K˜—K˜K˜——…—)า8P