DIRECTORY Basics, BitTwiddling, Convert, ImagerFont, IO, PrincOpsUtils, Real, Rope, RoseBehavior, RoseWireClasses, RoseWireTypes, RoseWireTypeUse, RoseWiring, VFonts;

RoseRecordImpl: CEDAR PROGRAM
IMPORTS BitTwiddling, ImagerFont, IO, Real, Rope, RoseWireTypeUse, RoseWireTypes, RoseWiring
EXPORTS RoseWireClasses, RoseWireTypes =

BEGIN OPEN RoseWireTypes;

SwitchVal: TYPE = RoseBehavior.SwitchVal;
Level: TYPE = RoseBehavior.Level;

RecordRep: TYPE = REF RecordRec;
RecordRec: TYPE = RECORD [
rwt: RoseWireType,
name: ROPE,
bitSize, wordSize: NAT,
repAux: Mesa _ [],
kwdMaxWidth: INT _ 0,
kwdMaxWidthFont: ImagerFont.Font _ NIL,
fields: SEQUENCE length: NAT OF RecordField];

RecordField: TYPE = RECORD [
name: ROPE,
rwc: RoseWireClass,
rwt: RoseWireType,
bitOffset, bitCount: NAT,
defaultFormat: Format
];

GetRecord: PUBLIC PROC [prototype: Wire, flavor: WireFlavor] RETURNS [rwc: RoseWireClass] = {
name: ROPE = RoseWiring.WireName[prototype];
rr: RecordRep _ NEW [RecordRec[prototype.elements.size]];
rwtUser: RoseWireTypeUse.RoseWireTypeUser = RoseWireTypeUse.CreateUser[];
bitOffset: NAT _ 0;
afterPrev: NAT _ 0;
ComputeOffset: PROC [index, bitCount: NAT] = {
w0: NAT _ bitOffset / Basics.bitsPerWord;
w1: NAT _ (bitOffset + bitCount - 1) / Basics.bitsPerWord;
om: NAT  _ bitOffset MOD Basics.bitsPerWord;
IF bitCount > Basics.bitsPerWord AND bitCount MOD Basics.bitsPerWord # 0 THEN ERROR;
IF w1 > w0 AND om # 0 THEN {
delta: NAT _ Basics.bitsPerWord - om;
bitOffset _ bitOffset + delta;
IF index > 0 THEN rr.fields[index - 1].bitOffset _ rr.fields[index - 1].bitOffset + delta;
};
};
def: IO.STREAM _ IO.ROS[];
firstDefdField: BOOL _ TRUE;
addressContaining: BOOL _ FALSE;
AddField: PROC [fmt: ROPE, v1, v2, v3, v4, v5: IO.Value _ [null[]] ] = {
IF firstDefdField THEN firstDefdField _ FALSE ELSE def.PutRope[","];
def.PutRope["\n\t"];
def.PutF[fmt, v1, v2, v3, v4, v5];
};
fillCount: NAT _ 0;
moduleRefs: ARRAY RoseWireTypeUse.ModuleRefType OF LOR;
bitBucket: ROPE;
IF prototype.structure # record THEN ERROR;
rr.name _ name.Cat[WireFlavorName[flavor]];
def.PutF["%g: TYPE = MACHINE DEPENDENT RECORD [", [rope[rr.name]]];
FOR i: NAT IN [0 .. rr.length) DO
ew: Wire = prototype.elements[i];
ewc: RoseWireClass = RoseWiring.GetWiring[ew, flavor];
ewt: RoseWireType = ewc.super.GetType[ewc, ew];
bitCount: NAT = ewc.super.Bits[ewt];
IF bitCount < 1 THEN ERROR;
ComputeOffset[i, bitCount];
IF ew.name.Length[] = 0 THEN ERROR;
rr.fields[i] _ [
name: ew.name,
rwc: ewc,
rwt: ewt,
bitOffset: bitOffset,
bitCount: bitCount,
defaultFormat: IF flavor # drive THEN ewt.class.super.GetFormat[ewt, NIL] ELSE NIL
];
addressContaining _ addressContaining OR ewc.dereference OR ewc.addressContaining;
bitOffset _ bitOffset + bitCount;
ENDLOOP;
IF bitOffset > Basics.bitsPerWord AND bitOffset MOD Basics.bitsPerWord # 0 THEN {
delta: NAT _ Basics.bitsPerWord - (bitOffset MOD Basics.bitsPerWord);
bitOffset _ bitOffset + delta;
rr.fields[rr.length-1].bitOffset _ rr.fields[rr.length-1].bitOffset + delta;
};
rr.bitSize _ bitOffset;
rr.wordSize _ (bitOffset + Basics.bitsPerWord - 1)/Basics.bitsPerWord;
FOR i: NAT IN [0 .. rr.length) DO
bitOffset: NAT = rr.fields[i].bitOffset;
swt: RoseWireType = rr.fields[i].rwt;
sm: Mesa = swt.class.super.MesaRepresentation[swt.class];
rwtUser.NoteMesa[sm];
IF afterPrev # bitOffset THEN AddField[
"fill%g(%g:%g..%g): [0 .. %g]",
[integer[fillCount _ fillCount + 1]],
[integer[afterPrev/Basics.bitsPerWord]],
[integer[afterPrev MOD Basics.bitsPerWord]],
[integer[(bitOffset-1) MOD Basics.bitsPerWord]],
[cardinal[BitTwiddling.oneLessThanTwoToThe[bitOffset-afterPrev]]]
];
afterPrev _ bitOffset + rr.fields[i].bitCount;
AddField[
"%g(%g:%g..%g): %g",
[rope[rr.fields[i].name]],
[integer[bitOffset/Basics.bitsPerWord]],
[integer[bitOffset MOD Basics.bitsPerWord]],
[integer[(afterPrev-1) MOD Basics.bitsPerWord]],
[rope[sm.mesa]]
];
ENDLOOP;
def.PutRope["]"];
[bitBucket, moduleRefs] _ rwtUser.DestroyUser[];
IF bitBucket.Length[] # 0 THEN ERROR;
rr.repAux.directory _ moduleRefs[Directory];
rr.repAux.imports _ moduleRefs[Import];
IF moduleRefs[Export] # NIL OR moduleRefs[Open] # NIL THEN ERROR;
rr.repAux.mesa _ def.RopeFromROS[];
rwc _ NEW[RoseWireClassRec _ [
structure: record,
dereference: FALSE,
addressContaining: addressContaining,
length: rr.length,
classData: rr,
super: recordSuperClasses[flavor]]];
rr.rwt _ NEW[RoseWireTypeRec _ [
class: rwc,
typeData: NIL,
length: rr.length,
other: NIL]];
};

recordSuperClasses: ARRAY WireFlavor OF RoseWireSuperClass _ ALL[NIL];

RecordGetType: PROC [rwc: RoseWireClass, wire: Wire] RETURNS [rwt: RoseWireType] = {
rr: RecordRep = NARROW[rwc.classData];
IF wire.structure # record THEN ERROR;
rwt _ rr.rwt;
};

RecordListFormats: PROC [rwt: RoseWireType] RETURNS [lor: LOR] = {
lor _ LIST["vanilla"];
};

RecordGetFormat: PROC [rwt: RoseWireType, formatName: ROPE] RETURNS [format: Format] = {
format _ SELECT TRUE FROM
formatName.Equal["vanilla"], formatName=NIL => vanillaFormat,
ENDCASE => ERROR;
};

RecordSelectorOffset: PROC [rwt: RoseWireType, sel: Selector] RETURNS [dBits: NAT] = {
rr: RecordRep = NARROW[rwt.class.classData];
WITH sel SELECT FROM
whole => RETURN [0];
field => RETURN [rr.fields[index].bitOffset];
subscript => ERROR
ENDCASE => ERROR;
};

RecordFieldName: PROC [rwc: RoseWireClass, index: INT] RETURNS [ROPE] = {
rr: RecordRep = NARROW[rwc.classData];
RETURN [rr.fields[index].name];
};

RecordSubType: PROC [rwt: RoseWireType, sel: Selector] RETURNS [RoseWireType] = {
rr: RecordRep = NARROW[rwt.class.classData];
WITH sel SELECT FROM
whole => RETURN [rwt];
field => RETURN [rr.fields[index].rwt];
subscript => ERROR
ENDCASE => ERROR;
};

RecordSubClass: PROC [rwc: RoseWireClass, sel: Selector] RETURNS [RoseWireClass] = {
rr: RecordRep = NARROW[rwc.classData];
WITH sel SELECT FROM
whole => RETURN [rwc];
field => RETURN [rr.fields[index].rwc];
subscript => ERROR
ENDCASE => ERROR;
};

RecordBits: PROC [rwt: RoseWireType] RETURNS [n: INT] = {
rr: RecordRep = NARROW[rwt.class.classData];
n _ rr.bitSize;
};

RecordMesaRepresentation: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
rr: RecordRep = NARROW[rwc.classData];
mesa _ [mesa: rr.name];
};

RecordMesaRepAux: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
rr: RecordRep = NARROW[rwc.classData];
mesa _ rr.repAux;
};

RecordInitialize: PROC [rwt: RoseWireType, p: Ptr, steady: BOOL] = {
rr: RecordRep = NARROW[rwt.class.classData];
FOR i: NAT IN [0 .. rr.length) DO
rr.fields[i].rwt.class.super.Initialize[
rr.fields[i].rwt,
BitTwiddling.OffsetPtr[p, rr.fields[i].bitOffset],
steady
];
ENDLOOP;
steady _ steady;
};

RecordTransduce: PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = {
rr: RecordRep = NARROW[fromT.class.classData];
IF fromT.class.structure # record THEN ERROR;
IF toT.class.structure # record THEN ERROR;
IF fromT.length # toT.length THEN ERROR;
IF toT.class.dereference THEN toP _ BitTwiddling.DeReferencePtr[toP];
FOR i: NAT IN [0 .. rr.length) DO
subFrom: Ptr = BitTwiddling.OffsetPtr[fromP, rr.fields[i].bitOffset];
sel: Selector = [field[i]];
subTo: Ptr = BitTwiddling.OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]];
rr.fields[i].rwt.class.super.Transduce[
fromS: fromS,
fromT: rr.fields[i].rwt,
toT: toT.class.super.SubType[toT, sel],
fromP: subFrom,
toP: subTo];
toT _ toT;
ENDLOOP;
toT _ toT;
};

RecordInitQ: PROC [rwt: RoseWireType, p: Ptr, cap: Strength] = TRUSTED {
rr: RecordRep = NARROW[rwt.class.classData];
FOR i: NAT IN [0 .. rr.length) DO
subType: RoseWireType = rr.fields[i].rwt;
subType.class.super.InitQ[
subType,
BitTwiddling.OffsetPtr[p, rr.fields[i].bitOffset],
cap];
cap _ cap;
ENDLOOP;
cap _ cap;
};

RecordInitUD: PROC [rwt: RoseWireType, p: Ptr, cap: Strength] RETURNS [isInput: BOOL] = TRUSTED {
rr: RecordRep = NARROW[rwt.class.classData];
isInput _ TRUE;
FOR i: NAT IN [0 .. rr.length) DO
subType: RoseWireType = rr.fields[i].rwt;
subInput: BOOL _ subType.class.super.InitUD[
subType,
BitTwiddling.OffsetPtr[p, rr.fields[i].bitOffset],
cap];
isInput _ isInput AND subInput;
ENDLOOP;
cap _ cap;
};

RecordComputeLevel: PROC [rwt: RoseWireType, p: Ptr, xPhobic: BOOL] RETURNS [delay: BOOL] = TRUSTED {
rr: RecordRep = NARROW[rwt.class.classData];
delay _ FALSE;
FOR i: NAT IN [0 .. rr.length) DO
subType: RoseWireType = rr.fields[i].rwt;
subDelay: BOOL _ subType.class.super.ComputeLevel[
subType,
BitTwiddling.OffsetPtr[p, rr.fields[i].bitOffset],
xPhobic];
delay _ delay OR subDelay;
ENDLOOP;
xPhobic _ xPhobic;
};

vanillaFormat: Format _ NEW [FormatRep _ [
FormatValue: RecursivelyFormatValue,
ParseValue: RecursivelyParseValue,
MaxWidth: RecursivelyMaxWidth,
key: "vanilla"]];

RecursivelyFormatValue: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
rr: RecordRep = NARROW[rwt.class.classData];
to: STREAM = IO.ROS[];
to.PutRope["["];
FOR i: NAT IN [0 .. rr.length) DO
sf: Format = rr.fields[i].defaultFormat;
IF i # 0 THEN to.PutRope[", "];
to.PutF[
"%g: %g",
[rope[rr.fields[i].name]],
[rope[sf.FormatValue[
rr.fields[i].rwt,
sf,
BitTwiddling.OffsetPtr[p, rr.fields[i].bitOffset]
]]]
];
ENDLOOP;
to.PutRope["]"];
r _ to.RopeFromROS[];
};

RecursivelyParseValue: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = {
ENABLE IO.Error, IO.EndOfStream => {ok _ FALSE; CONTINUE};
rr: RecordRep = NARROW[rwt.class.classData];
Consume: PROC [goal: ROPE] = {
toke: ROPE = s.GetTokenRope[WireValBreak].token;
IF NOT toke.Equal[goal] THEN IO.Error[SyntaxError, s];
};
ok _ TRUE;
Consume["["];
FOR i: NAT IN [0 .. rr.length) DO
sf: Format = rr.fields[i].defaultFormat;
fieldName: ROPE;
IF i # 0 THEN Consume[", "];
fieldName _ s.GetTokenRope[WireValBreak].token;
IF NOT fieldName.Equal[rr.fields[i].name] THEN ERROR --lazy implementor--;
Consume[":"];
IF
NOT sf.ParseValue[
rr.fields[i].rwt,
sf,
BitTwiddling.OffsetPtr[p, rr.fields[i].bitOffset],
s
]
THEN RETURN [FALSE];
ENDLOOP;
Consume["]"];
};

RecursivelyMaxWidth: PROC [rwt: RoseWireType, fmt: Format, font: VFonts.Font] RETURNS [max: INT] = {
rr: RecordRep = NARROW[rwt.class.classData];
AddRope: PROC [r: ROPE] = {
max _ max + Real.Round[ImagerFont.RopeWidth[font, r].x];
};
IF rr.kwdMaxWidthFont = font THEN RETURN [rr.kwdMaxWidth];
rr.kwdMaxWidthFont _ font;
max _ 0;
AddRope["[]"];
FOR i: NAT IN [0 .. rr.length) DO
IF i # 0 THEN AddRope[", "];
AddRope[rr.fields[i].name];
AddRope[": "];
max _ max + rr.fields[i].defaultFormat.MaxWidth[
rr.fields[i].rwt,
rr.fields[i].defaultFormat,
font
];
ENDLOOP;
rr.kwdMaxWidth _ max;
};

WireValBreak: PUBLIC PROC [char: CHAR] RETURNS [IO.CharClass] --IO.BreakProc-- = {
RETURN [SELECT char FROM
IN [IO.NUL .. IO.SP] => sepr,
',, ':, '[, '] => break,
ENDCASE => other
];
};

Start: PROC = {
FOR wf: WireFlavor IN WireFlavor DO
recordSuperClasses[wf] _ NEW[RoseWireSuperClassRec _ [
GetType: RecordGetType,
ListFormats: RecordListFormats,
GetFormat: RecordGetFormat,
SelectorOffset: RecordSelectorOffset,
FieldName: RecordFieldName,
SubType: RecordSubType,
SubClass: RecordSubClass,
Bits: RecordBits,
MesaRepresentation: RecordMesaRepresentation,
MesaRepAux: RecordMesaRepAux,
flavor: wf,
Initialize: RecordInitialize,
Transduce: RecordTransduce,
InitQ: RecordInitQ,
InitUD: RecordInitUD,
ComputeLevel: RecordComputeLevel
]];
ENDLOOP;
};

Start[];

END.
ͺRoseRecordImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Barth, September 5, 1985 6:37:22 pm PDT
Spreitzer, October 1, 1985 6:31:13 pm PDT
Κ
ρ–

"cedar" style˜
codeš
œ™Kšœ
Οm
œ1™<K™'K™)—K˜KšΟk	œ,žœo˜¦
K˜šΠbxœžœ
ž˜Kšžœžœ8˜\Kšžœ!˜(—K˜Kšžœ
žœ˜K˜Kšœžœ˜)Kšœžœ˜!K˜Kšœžœžœ˜ šœžœžœ˜K˜Kšœžœ
˜Kšœžœ
˜K˜Kšœ
žœ˜Kšœ#žœ
˜'Kšœžœ	žœ
žœ˜-—K˜šœ
žœžœ˜Kšœžœ
˜K˜K˜Kšœžœ
˜K˜K˜—K˜šΟn	œžœ
žœ'žœ˜]Kšœžœ"˜,Kšœžœ&˜9Kš
œI˜IKšœžœ˜Kšœžœ˜š 
œžœžœ˜.Kšœžœ"˜)Kšœžœ3˜:Kšœžœžœ˜,Kš
žœžœ
žœžœ
žœ
˜Tšžœ	žœžœ˜Kšœžœ˜%Kš
œ˜KšžœžœI˜ZK˜—K˜—Kš	œžœ
žœžœ
žœ˜Kšœžœžœ
˜Kšœžœžœ
˜ š œžœžœžœ˜HKšžœžœžœ
žœ˜DKš
œ˜K˜"K˜—Kšœžœ˜Kšœžœžœ
žœ
˜7Kšœžœ
˜Kšžœžœ
žœ
˜+Kš
œ+˜+K˜Cšžœžœ
žœž˜!Kš
œ!˜!K˜6K˜/Kšœ
žœ˜$Kšžœžœ
žœ
˜Kš
œ˜Kšžœžœ
žœ
˜#˜Kš
œ˜K˜	K˜	Kš
œ˜Kš
œ˜Kš
œžœžœ žœžœ
ž˜RK˜—Kšœ&žœžœ˜RKš
œ!˜!Kšžœ
˜—šžœ žœžœžœ˜QKšœžœ#žœ˜EKš
œ˜K˜LK˜—K˜K˜Fšžœžœ
žœž˜!Kšœžœ˜(K˜%Kš
œ9˜9Kš
œ˜šžœžœ
˜'K˜K˜%K˜(Kšœžœ˜,Kšœžœ˜0Kš
œA˜AK˜—Kš
œ.˜.˜	K˜K˜Kš
œ(˜(Kšœžœ˜,Kšœžœ˜0Kš
œ˜K˜—Kšžœ
˜—K˜Kš
œ0˜0Kšžœžœ
žœ
˜%Kš
œ,˜,Kš
œ'˜'Kšžœžœ
žœžœ
žœ
žœ
˜AK˜#šœžœ˜Kš
œ˜Kšœ
žœ
˜Kš
œ%˜%K˜Kš
œ˜Kš
œ$˜$—šœ	žœ˜ Kš
œ˜Kšœ
žœ
˜Kš
œ˜Kšœžœ˜
—Kš
œ˜K˜—š	œžœžœžœ
žœ˜FK˜—š 
œžœ"žœ˜TKšœžœ˜&Kšžœžœ
žœ
˜&Kš
œ
˜
Kš
œ˜K˜—š œžœžœžœ˜BKšœžœ˜Kš
œ˜K˜—š œžœ!žœžœ˜Xšœ	žœ
žœ
ž˜Kšœ(žœ˜=Kšžœžœ
˜—Kš
œ˜K˜—š œžœ$žœ	žœ˜VKšœžœ˜,šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ˜-Kšœ
ž˜Kšžœžœ
˜—Kš
œ˜K˜—š
 œžœžœžœžœ˜IKšœžœ˜&Kšžœ˜Kš
œ˜K˜—š 
œžœ$žœ˜QKšœžœ˜,šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ˜'Kšœ
ž˜Kšžœžœ
˜—Kš
œ˜K˜—š œžœ%žœ˜TKšœžœ˜&šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ˜'Kšœ
ž˜Kšžœžœ
˜—Kš
œ˜K˜—š 
œžœžœžœ˜9Kšœžœ˜,K˜Kš
œ˜K˜—š œžœžœ˜LKšœžœ˜&Kš
œ˜Kš
œ˜K˜—š œžœžœ˜DKšœžœ˜&Kš
œ˜Kš
œ˜K˜—š œžœ%žœ˜DKšœžœ˜,šžœžœ
žœž˜!š
œ(˜(K˜Kš
œ2˜2Kš
œ˜K˜—Kšžœ
˜—Kš
œ˜K˜K˜—š œžœA˜VKšœžœ˜.Kšžœ žœ
žœ
˜-Kšžœžœ
žœ
˜+Kšžœžœ
žœ
˜(Kšžœžœ(˜Ešžœžœ
žœž˜!K˜EKš
œ˜Kš
œS˜S˜'K˜
K˜Kš
œ'˜'K˜Kš
œ˜—Kš
œ
˜
Kšžœ
˜—Kš
œ
˜
K˜K˜—šΠbnœžœ.žœ˜HKšœžœ˜,šžœžœ
žœž˜!K˜)˜K˜Kš
œ2˜2K˜—Kš
œ
˜
Kšžœ
˜—Kš
œ
˜
K˜K˜—š
‘œžœ,žœžœžœ˜aKšœžœ˜,Kšœ
žœ
˜šžœžœ
žœž˜!K˜)šœ
žœ˜,K˜Kš
œ2˜2K˜—Kšœžœ
˜Kšžœ
˜—Kš
œ
˜
K˜K˜—š
‘ œžœ&žœžœ	žœžœ˜eKšœžœ˜,Kšœžœ
˜šžœžœ
žœž˜!K˜)šœ
žœ$˜2K˜Kš
œ2˜2Kš
œ	˜	—Kšœžœ
˜Kšžœ
˜—Kš
œ˜K˜K˜—šœžœ˜*Kš
œ$˜$K˜"Kš
œ˜Kš
œ˜K˜—š œžœ(žœžœ˜YKšœžœ˜,Kšœžœžœ
žœ˜K˜šžœžœ
žœž˜!Kš
œ(˜(Kšžœžœ˜˜K˜	K˜˜K˜K˜Kš
œ1˜1K˜—K˜—Kšžœ
˜—K˜K˜K˜K˜—š
 œžœ+žœžœžœ˜dKš
žœ
žœžœžœžœ˜:Kšœžœ˜,š œžœžœ˜Kšœžœ&˜0Kšžœ
žœžœ
žœ˜6K˜—Kšœžœ
˜
K˜
šžœžœ
žœž˜!Kš
œ(˜(Kšœžœ
˜Kšžœžœ˜Kš
œ/˜/Kš
žœ
žœ$žœ
žœ
Οcœ
˜JK˜
š
ž˜šžœ˜K˜K˜Kš
œ2˜2K˜
K˜
—Kšžœ
žœžœ˜—Kšžœ
˜—K˜
K˜K˜—š œžœ5žœžœ˜dKšœžœ˜,š œžœžœ˜Kš
œ8˜8K˜—Kšžœžœ
žœ˜:Kš
œ˜K˜K˜šžœžœ
žœž˜!Kšžœžœ˜K˜K˜˜0K˜K˜K˜K˜—Kšžœ
˜—Kš
œ˜K˜K˜—š œžœ
žœžœžœžœ’œ˜Ršžœžœž˜Kšžœžœžœ
˜Kš
œ˜Kšžœ	˜K˜—K˜K˜—š œžœ˜šžœžœž˜#šœžœ˜6Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ%˜%Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ-˜-Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜K˜K˜ Kš
œ˜—Kšžœ
˜—K˜—K˜K˜K˜Kšžœ
˜—…—+μ:‡