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

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

BEGIN OPEN RoseWireTypes;

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

VblSeqClass: TYPE = REF VblSeqClassRec;
VblSeqClassRec: TYPE = RECORD [
rwc: RoseWireClass,
name: ROPE,
repAux: Mesa _ [],
ewc: RoseWireClass,
ewt: RoseWireType,
eltBitSize, stepBits, eltPad: NAT,
eltDefaultFormat: Format
];

VblSeqType: TYPE = REF VblSeqTypeRec;
VblSeqTypeRec: TYPE = RECORD [
vsc: VblSeqClass,
rwt: RoseWireType,
length: NAT,
equivWords: NAT,
vanillaMaxWidth: INT _ 0,
vanillaMaxWidthFont: ImagerFont.Font _ NIL
];

uz: UNCOUNTED ZONE;

GetVariableSequence: PUBLIC PROC [prototype: Wire, flavor: WireFlavor] RETURNS [rwc: RoseWireClass] = {
name: ROPE = RoseWiring.WireName[prototype];
rwtUser: RoseWireTypeUse.RoseWireTypeUser = RoseWireTypeUse.CreateUser[];
moduleRefs: ARRAY RoseWireTypeUse.ModuleRefType OF LOR;
cedarTypeName: ROPE = name.Cat[WireFlavorName[flavor]];
ewc: RoseWireClass = RoseWiring.GetWiring[prototype.elements[0], flavor];
ewt: RoseWireType = ewc.super.GetType[ewc, prototype.elements[0]];
eltBitSize: NAT = ewt.class.super.Bits[ewt];
stepBits: NAT = SELECT TRUE FROM
eltBitSize < 1 => ERROR,
eltBitSize <= 2 => eltBitSize,
eltBitSize <= 4 => 4,
eltBitSize <= 8 => 8,
eltBitSize <= Basics.bitsPerWord => Basics.bitsPerWord,
eltBitSize MOD Basics.bitsPerWord = 0 => eltBitSize,
ENDCASE => ERROR;
vsc: VblSeqClass _ NEW [VblSeqClassRec _ [
rwc: NIL,
name: cedarTypeName,
ewc: ewc,
ewt: ewt,
eltBitSize: eltBitSize,
stepBits: stepBits,
eltPad: stepBits - eltBitSize,
eltDefaultFormat: ewc.super.GetFormat[ewt, NIL]
]];
em: Mesa = ewc.super.MesaRepresentation[ewc];
bitBucket: ROPE;
IF prototype.structure # sequence THEN ERROR;
rwtUser.NoteMesa[em];
[bitBucket, moduleRefs] _ rwtUser.DestroyUser[];
IF bitBucket.Length[] # 0 THEN ERROR;
vsc.repAux.directory _ moduleRefs[Directory];
vsc.repAux.imports _ moduleRefs[Import];
IF moduleRefs[Export] # NIL OR moduleRefs[Open] # NIL THEN ERROR;
vsc.repAux.mesa _ IO.PutFR[
"%g: TYPE = REF %gSeq;
%gSeq: TYPE = RECORD [elts: PACKED SEQUENCE length: NAT OF %g]",
[rope[vsc.name]],
[rope[vsc.name]],
[rope[vsc.name]],
[rope[em.mesa]]
];
vsc.rwc _ rwc _ NEW[RoseWireClassRec _ [
structure: sequence,
dereference: TRUE,
addressContaining: ewc.dereference OR ewc.addressContaining,
classData: vsc,
super: vblSeqSuperClasses[flavor]]];
};

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

VblSeqGetType: PROC [rwc: RoseWireClass, wire: Wire] RETURNS [rwt: RoseWireType] = {
vsc: VblSeqClass = NARROW[rwc.classData];
length: NAT = wire.elements.size;
eltsPerWord: NAT = Basics.bitsPerWord / vsc.stepBits;
equivWords: NAT = (length + eltsPerWord-1) / eltsPerWord;
vst: VblSeqType = NEW [VblSeqTypeRec _ [
vsc: vsc,
rwt: NIL,
length: length,
equivWords: equivWords
]];
IF wire.structure # sequence THEN ERROR;
vst.rwt _ rwt _ NEW[RoseWireTypeRec _ [
class: rwc,
typeData: vst,
length: length,
other: NIL]];
};

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

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

VblSeqSelectorOffset: PROC [rwt: RoseWireType, sel: Selector] RETURNS [dBits: NAT] = {
vst: VblSeqType = NARROW[rwt.typeData];
WITH sel SELECT FROM
whole => RETURN [0];
field => ERROR;
subscript => RETURN [SuboffI[vst, index]];
ENDCASE => ERROR;
};

Suboff: PROC [vst: VblSeqType, i: NAT] RETURNS [dBits: NAT] =
{dBits _ SuboffI[vst, i]};

SuboffI: PROC [vst: VblSeqType, i: NAT] RETURNS [dBits: NAT] = INLINE {
dBits _ tagBits + vst.vsc.stepBits * i + vst.vsc.eltPad;
};

tagBits: INTEGER _ ComputeTagBits[];

ComputeTagBits: PROC RETURNS [delta: INTEGER] = {
WordSR: TYPE = REF WordSeq;
x: WordSR = NEW [WordSeq[3]];
TRUSTED {delta _ LOOPHOLE[@x[0], INT] - LOOPHOLE[x, INT]};
};

WordSP: TYPE = LONG POINTER TO WordSeq;
WordSeq: TYPE = RECORD [elts: SEQUENCE length: NAT OF WORD];

VblSeqSubType: PROC [rwt: RoseWireType, sel: Selector] RETURNS [RoseWireType] = {
vst: VblSeqType = NARROW[rwt.typeData];
WITH sel SELECT FROM
whole => RETURN [rwt];
field => ERROR;
subscript => RETURN [vst.vsc.ewt];
ENDCASE => ERROR;
};

VblSeqSubClass: PROC [rwc: RoseWireClass, sel: Selector] RETURNS [RoseWireClass] = {
vsc: VblSeqClass = NARROW[rwc.classData];
WITH sel SELECT FROM
whole => RETURN [rwc];
field => ERROR;
subscript => RETURN [vsc.ewc];
ENDCASE => ERROR;
};

VblSeqBits: PROC [rwt: RoseWireType] RETURNS [n: INT] = {
vst: VblSeqType = NARROW[rwt.typeData];
n _ Basics.bitsPerWord * SIZE[LONG POINTER];
};

VblSeqMesaRepresentation: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
vsc: VblSeqClass = NARROW[rwc.classData];
mesa _ [mesa: vsc.name];
};

VblSeqMesaRepAux: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
vsc: VblSeqClass = NARROW[rwc.classData];
mesa _ vsc.repAux;
};

VblSeqReferentRep: PROC [rwc: RoseWireClass, wireExpr: ROPE] RETURNS [mesa: ROPE] = {
vsc: VblSeqClass = NARROW[rwc.classData];
mesa _ IO.PutFR["%gSeq[%g.elements.size]",
[rope[vsc.name]],
[rope[wireExpr]]
];
};

VblSeqCreateReferent: PROC [rwt: RoseWireType] RETURNS [lp: LONG POINTER] = TRUSTED {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
wsp: WordSP = uz.NEW[WordSeq[vst.equivWords]];
lp _ wsp;
FOR i: NAT IN [0 .. wsp.length) DO wsp[i] _ 0 ENDLOOP;
rwt _ rwt;
};

VblSeqInitialize: PROC [rwt: RoseWireType, p: Ptr, steady: BOOL] = {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
p _ BitTwiddling.DeReferencePtr[p];
FOR i: NAT IN [0 .. vst.length) DO
vsc.ewc.super.Initialize[
vsc.ewt,
BitTwiddling.OffsetPtr[p, SuboffI[vst, i]],
steady
];
ENDLOOP;
steady _ steady;
};

VblSeqTransduce: PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = {
vst: VblSeqType = NARROW[fromT.typeData];
vsc: VblSeqClass = vst.vsc;
IF fromT.class.structure # sequence THEN ERROR;
IF toT.class.structure # sequence THEN ERROR;
IF fromT.length # toT.length THEN ERROR;
fromP _ BitTwiddling.DeReferencePtr[fromP];
IF toT.class.dereference THEN toP _ BitTwiddling.DeReferencePtr[toP];
FOR i: NAT IN [0 .. vst.length) DO
subFrom: Ptr = BitTwiddling.OffsetPtr[fromP, SuboffI[vst, i]];
sel: Selector = [subscript[i]];
subTo: Ptr = BitTwiddling.OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]];
vsc.ewc.super.Transduce[
fromS: fromS,
fromT: vsc.ewt,
toT: toT.class.super.SubType[toT, sel],
fromP: subFrom,
toP: subTo];
toT _ toT;
ENDLOOP;
toT _ toT;
};

VblSeqInitQ: PROC [rwt: RoseWireType, p: Ptr, cap: Strength] = TRUSTED {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
p _ BitTwiddling.DeReferencePtr[p];
FOR i: NAT IN [0 .. vst.length) DO
subType: RoseWireType = vsc.ewt;
subType.class.super.InitQ[
subType,
BitTwiddling.OffsetPtr[p, SuboffI[vst, i]],
cap];
cap _ cap;
ENDLOOP;
cap _ cap;
};

VblSeqInitUD: PROC [rwt: RoseWireType, p: Ptr, cap: Strength] RETURNS [isInput: BOOL] = TRUSTED {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
isInput _ TRUE;
p _ BitTwiddling.DeReferencePtr[p];
FOR i: NAT IN [0 .. vst.length) DO
subType: RoseWireType = vsc.ewt;
subInput: BOOL _ subType.class.super.InitUD[
subType,
BitTwiddling.OffsetPtr[p, SuboffI[vst, i]],
cap];
isInput _ isInput AND subInput;
ENDLOOP;
cap _ cap;
};

VblSeqComputeLevel: PROC [rwt: RoseWireType, p: Ptr, xPhobic: BOOL] RETURNS [delay: BOOL] = TRUSTED {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
delay _ FALSE;
p _ BitTwiddling.DeReferencePtr[p];
FOR i: NAT IN [0 .. vst.length) DO
subType: RoseWireType = vsc.ewt;
subDelay: BOOL _ subType.class.super.ComputeLevel[
subType,
BitTwiddling.OffsetPtr[p, SuboffI[vst, i]],
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] = {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
to: STREAM = IO.ROS[];
p _ BitTwiddling.DeReferencePtr[p];
to.PutRope["["];
FOR i: NAT IN [0 .. vst.length) DO
sf: Format = vsc.eltDefaultFormat;
IF i # 0 THEN to.PutRope[" "];
to.PutRope[sf.FormatValue[
vsc.ewt,
sf,
BitTwiddling.OffsetPtr[p, SuboffI[vst, i]]
]];
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};
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
Consume: PROC [goal: ROPE] = {
toke: ROPE = s.GetTokenRope[WireValBreak].token;
IF NOT toke.Equal[goal] THEN IO.Error[SyntaxError, s];
};
p _ BitTwiddling.DeReferencePtr[p];
ok _ TRUE;
Consume["["];
FOR i: NAT IN [0 .. vst.length) DO
sf: Format = vsc.eltDefaultFormat;
IF i # 0 THEN [] _ s.SkipWhitespace[];
IF
NOT sf.ParseValue[
vsc.ewt,
sf,
BitTwiddling.OffsetPtr[p, SuboffI[vst, i]],
s
]
THEN RETURN [FALSE];
ENDLOOP;
Consume["]"];
};

RecursivelyMaxWidth: PROC [rwt: RoseWireType, fmt: Format, font: VFonts.Font] RETURNS [max: INT] = {
vst: VblSeqType = NARROW[rwt.typeData];
vsc: VblSeqClass = vst.vsc;
AddRope: PROC [r: ROPE, times: NAT _ 1] = {
max _ max + Real.Round[times * ImagerFont.RopeWidth[font, r].x];
};
IF vst.vanillaMaxWidthFont = font THEN RETURN [vst.vanillaMaxWidth];
vst.vanillaMaxWidthFont _ font;
max _ 0;
AddRope["[]", 1];
AddRope[" ", vst.length-1];
max _ max + vst.length * vsc.eltDefaultFormat.MaxWidth[
vsc.ewt,
vsc.eltDefaultFormat,
font
];
vst.vanillaMaxWidth _ max;
};

Start: PROC = {
FOR wf: WireFlavor IN WireFlavor DO
vblSeqSuperClasses[wf] _ NEW[RoseWireSuperClassRec _ [
GetType: VblSeqGetType,
ListFormats: VblSeqListFormats,
GetFormat: VblSeqGetFormat,
SelectorOffset: VblSeqSelectorOffset,
SubType: VblSeqSubType,
SubClass: VblSeqSubClass,
Bits: VblSeqBits,
MesaRepresentation: VblSeqMesaRepresentation,
MesaRepAux: VblSeqMesaRepAux,
ReferentRep: VblSeqReferentRep,
CreateReferent: VblSeqCreateReferent,
flavor: wf,
Initialize: VblSeqInitialize,
Transduce: VblSeqTransduce,
InitQ: VblSeqInitQ,
InitUD: VblSeqInitUD,
ComputeLevel: VblSeqComputeLevel
]];
ENDLOOP;
TRUSTED {
uz _ UnsafeStorage.GetSystemUZone[];
};
};

Start[];

END.
ดRoseVariableSequenceImpl.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:52 pm PDT
ส
ึ–

"cedar" style˜
codeš
œ™Kšœ
ฯm
œ1™<K™'K™)—K˜Kšฯk	œ,žœ~˜ต
K˜šะbxœžœ
ž˜'KšžœžœG˜kKšžœ˜—K˜Kšžœ
žœ˜K˜Kšœžœ˜)Kšœžœ˜!K˜Kšœ
žœžœ˜'šœžœžœ˜K˜Kšœžœ
˜K˜K˜K˜Kšœžœ
˜"K˜K˜—K˜Kšœžœžœ˜%šœžœžœ˜K˜K˜Kšœžœ
˜Kšœžœ
˜Kšœžœ˜Kšœ'ž˜*Kš
œ˜—K˜Kšœž	œ
žœ
˜K˜šฯnœžœ
žœ'žœ˜gKšœžœ"˜,Kš
œI˜IKšœžœžœ
žœ
˜7Kšœžœ$˜7K˜IK˜BKšœžœ˜,šœ
žœžœ
žœ
ž˜ Kšœžœ
˜K˜K˜K˜K˜7Kšœžœ&˜4Kšžœžœ
˜—šœžœ˜*Kšœžœ
˜	Kš
œ˜K˜	K˜	K˜K˜K˜Kšœ+žœ
˜/K˜—Kš
œ-˜-Kšœžœ
˜Kšžœ žœ
žœ
˜-Kš
œ˜Kš
œ0˜0Kšžœžœ
žœ
˜%Kš
œ-˜-Kš
œ(˜(Kšžœžœ
žœžœ
žœ
žœ
˜Ašœžœ˜K˜Kš
œžœžœžœ
žœ	žœ
žœ˜@K˜K˜K˜Kš
œ˜K˜—šœžœ˜(Kš
œ˜Kšœ
žœ
˜Kšœ#žœ˜<Kš
œ˜Kš
œ$˜$—Kš
œ˜K˜—š	œžœžœžœ
žœ˜FK˜—š 
œžœ"žœ˜TKšœžœ˜)Kšœžœ˜!Kšœ
žœ%˜5Kšœžœ*˜9šœžœ˜(K˜	Kšœžœ
˜	K˜K˜K˜—Kšžœžœ
žœ
˜(šœžœ˜'Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ˜
—Kš
œ˜K˜—š œžœžœžœ˜BKšœžœ˜Kš
œ˜K˜—š œžœ!žœžœ˜Xšœ	žœ
žœ
ž˜Kšœ(žœ˜=Kšžœžœ
˜—Kš
œ˜K˜—š œžœ$žœ	žœ˜VKšœžœ˜'šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ
˜Kšœ
žœ˜*Kšžœžœ
˜—Kš
œ˜K˜—š
 œžœžœžœ	žœ˜=Kš
œ˜—K˜š œžœžœžœ	žœžœ˜GKš
œ8˜8K˜—K˜Kšœ	žœ˜$K˜š œžœ
žœ	žœ˜1Kšœžœžœ	˜Kšœžœ˜Kš
žœ
žœžœžœžœ˜:K˜K˜—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˜—š
 œžœ žœžœžœ˜UKšœžœ˜)šœžœ!˜*Kš
œ˜K˜Kš
œ˜—Kš
œ˜K˜—š œžœžœžœ
žœžœ˜UKšœžœ˜'Kš
œ˜Kšœžœ˜.Kš
œ	˜	Kš
žœžœ
žœžœžœ
˜6K˜
K˜K˜—š œžœ%žœ˜DKšœžœ˜'Kš
œ˜Kš
œ#˜#šžœžœ
žœž˜"š
œ˜Kš
œ˜Kš
œ+˜+Kš
œ˜K˜—Kšžœ
˜—Kš
œ˜K˜K˜—š œžœA˜VKšœžœ˜)Kš
œ˜Kšžœ"žœ
žœ
˜/Kšžœ žœ
žœ
˜-Kšžœžœ
žœ
˜(Kš
œ+˜+Kšžœžœ(˜Ešžœžœ
žœž˜"Kš
œ>˜>Kš
œ˜Kš
œS˜Sš
œ˜K˜
Kš
œ˜Kš
œ'˜'K˜Kš
œ˜—Kš
œ
˜
Kšžœ
˜—Kš
œ
˜
K˜K˜—šะbnœžœ.žœ˜HKšœžœ˜'Kš
œ˜Kš
œ#˜#šžœžœ
žœž˜"Kš
œ ˜ ˜K˜Kš
œ+˜+K˜—Kš
œ
˜
Kšžœ
˜—Kš
œ
˜
K˜K˜—š
กœžœ,žœžœžœ˜aKšœžœ˜'Kš
œ˜Kšœ
žœ
˜Kš
œ#˜#šžœžœ
žœž˜"Kš
œ ˜ šœ
žœ˜,K˜Kš
œ+˜+K˜—Kšœžœ
˜Kšžœ
˜—Kš
œ
˜
K˜K˜—š
ก œžœ&žœžœ	žœžœ˜eKšœžœ˜'Kš
œ˜Kšœžœ
˜Kš
œ#˜#šžœžœ
žœž˜"Kš
œ ˜ šœ
žœ$˜2K˜Kš
œ+˜+Kš
œ	˜	—Kšœžœ
˜Kšžœ
˜—Kš
œ˜K˜K˜—šœžœ˜*Kš
œ$˜$K˜"Kš
œ˜Kš
œ˜K˜—š œžœ(žœžœ˜YKšœžœ˜'Kš
œ˜Kšœžœžœ
žœ˜Kš
œ#˜#K˜šžœžœ
žœž˜"Kš
œ"˜"Kšžœžœ˜˜Kš
œ˜K˜Kš
œ*˜*K˜—Kšžœ
˜—K˜K˜K˜K˜—š
 œžœ+žœžœžœ˜dKš
žœ
žœžœžœžœ˜:Kšœžœ˜'Kš
œ˜š œžœžœ˜Kšœžœ&˜0Kšžœ
žœžœ
žœ˜6K˜—Kš
œ#˜#Kšœžœ
˜
K˜
šžœžœ
žœž˜"Kš
œ"˜"Kšžœžœ˜&š
ž˜šžœ˜Kš
œ˜K˜Kš
œ+˜+K˜
K˜
—Kšžœ
žœžœ˜—Kšžœ
˜—K˜
K˜K˜—š œžœ5žœžœ˜dKšœžœ˜'Kš
œ˜š œžœžœ	žœ	˜+Kš
œ@˜@K˜—Kšžœ žœ
žœ˜DKš
œ˜K˜K˜Kš
œ˜š
œ7˜7Kš
œ˜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˜K˜K˜Kšžœ
˜—…—)ฎ88