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

RoseBasicSequenceImpl: CEDAR PROGRAM
IMPORTS BigCardinals, BitTwiddling, ImagerFont, IO, PrincOpsUtils, Real, Rope, RoseTransduce, RoseWireTypes, RoseWiring
EXPORTS RoseWireClasses =

BEGIN OPEN RoseWireTypes;

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

BasicSeqType: TYPE = REF BasicSeqTypeRec;
BasicSeqTypeRec: TYPE = RECORD [
rwc: RoseWireClass,
name: ROPE,
repAux: Mesa _ [],
ewc: RoseWireClass,
ewt: RoseWireType,
eltDefaultFormat: Format,
rwt: RoseWireType,
length: NAT,
leftPad, wordLength: NAT,
maxes: ARRAY Base OF MaxNote _ ALL[[]]
];

MaxNote: TYPE = RECORD [
maxWidth: INT _ 0,
maxWidthFont: ImagerFont.Font _ NIL
];

Base: TYPE = {R2, R8, R16};
BaseBase: ARRAY Base OF NAT = [R2: 2, R8: 8, R16: 16];
LgBase: ARRAY Base OF NAT = [R2: 1, R8: 3, R16: 4];
BaseSuffix: ARRAY Base OF ROPE = [R2: "B", R8: "O", R16: "H"];
Digits: ARRAY [0 .. 16) OF ROPE = [
"0",	"1",	"2",	"3",
"4",	"5",	"6",	"7",
"8",	"9",	"A",	"B",
"C",	"D",	"E",	"F"];

GetBasicSequence: PUBLIC PROC [prototype: Wire] RETURNS [rwc: RoseWireClass] = {
name: ROPE = RoseWiring.WireName[prototype];
flavor: WireFlavor = simple;
length: NAT = prototype.elements.size;
cedarTypeName: ROPE = name.Cat[WireFlavorName[flavor]];
ewc: RoseWireClass = RoseWiring.GetWiring[prototype.elements[0], flavor];
ewt: RoseWireType = ewc.super.GetType[ewc, prototype.elements[0]];
eltsPerWord: NAT = Basics.bitsPerWord;
wordLength: NAT = (length + eltsPerWord-1)/eltsPerWord;
bst: BasicSeqType _ NEW [BasicSeqTypeRec _ [
rwc: NIL,
name: cedarTypeName,
ewc: ewc,
ewt: ewt,
eltDefaultFormat: ewc.super.GetFormat[ewt, NIL],
rwt: NIL,
length: length,
leftPad: wordLength*Basics.bitsPerWord - length,
wordLength: wordLength
]];
IF prototype.structure # sequence THEN ERROR;
IF ewt # RoseTransduce.boolType THEN ERROR;
bst.repAux _ [mesa: NIL];
bst.rwc _ rwc _ NEW [RoseWireClassRec _ [
structure: sequence,
dereference: TRUE,
addressContaining: ewc.dereference OR ewc.addressContaining,
classData: bst,
super: basicSeqSuperClass]];
bst.rwt _ NEW [RoseWireTypeRec _ [
class: rwc,
typeData: bst,
length: length
]];
};

basicSeqSuperClass: RoseWireSuperClass _ NEW[RoseWireSuperClassRec _ [
GetType: BasicSeqGetType,
ListFormats: BasicSeqListFormats,
GetFormat: BasicSeqGetFormat,
SelectorOffset: BasicSeqSelectorOffset,
SubType: BasicSeqSubType,
SubClass: BasicSeqSubClass,
Bits: BasicSeqBits,
MesaRepresentation: BasicSeqMesaRepresentation,
MesaRepAux: BasicSeqMesaRepAux,
flavor: simple,
Initialize: BasicSeqInitialize,
Transduce: BasicSeqTransduce
]];

BasicSeqGetType: PROC [rwc: RoseWireClass, wire: Wire] RETURNS [rwt: RoseWireType] = {
bst: BasicSeqType = NARROW[rwc.classData];
rwt _ bst.rwt;
};

BasicSeqListFormats: PROC [rwt: RoseWireType] RETURNS [lor: LOR] = {
lor _ LIST["2", "8", "16"];
};

BasicSeqGetFormat: PROC [rwt: RoseWireType, formatName: ROPE] RETURNS [format: Format] = {
format _ SELECT TRUE FROM
formatName.Equal["2"] => base2,
formatName.Equal["8"] => base8,
formatName.Equal["16"] => base16,
formatName=NIL => base16,
ENDCASE => ERROR;
};

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

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

SuboffI: PROC [bst: BasicSeqType, i: NAT] RETURNS [dBits: NAT] = INLINE {
dBits _ bst.leftPad + i;
};

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

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

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

BasicSeqBits: PROC [rwt: RoseWireType] RETURNS [n: INT] = {
bst: BasicSeqType = NARROW[rwt.typeData];
n _ Basics.bitsPerWord * bst.wordLength;
};

BasicSeqMesaRepresentation: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
bst: BasicSeqType = NARROW[rwc.classData];
mesa _ SELECT bst.wordLength FROM
=1 => [mesa: "BitOps.BitWord", directory: LIST["BitOps"]],
=2 => [mesa: "BitOps.BitDWord", directory: LIST["BitOps"]],
>2 => [
mesa: IO.PutFR[
"ARRAY [0 .. %g) OF CARDINAL",
[integer[bst.wordLength]]
]
],
ENDCASE => ERROR;
};

BasicSeqMesaRepAux: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
bst: BasicSeqType = NARROW[rwc.classData];
mesa _ bst.repAux;
};

BasicSeqInitialize: PROC [rwt: RoseWireType, p: Ptr, steady: BOOL] = TRUSTED {
bst: BasicSeqType = NARROW[rwt.typeData];
ap: ArrPtr = ToArrPtr[p];
PrincOpsUtils.LongZero[LOOPHOLE[ap], bst.wordLength];
steady _ steady;
};

ArrPtr: TYPE = LONG POINTER TO ARRAY NAT OF CARDINAL;

ToArrPtr: PROC [p: Ptr] RETURNS [ap: ArrPtr] = TRUSTED {
ap _ p.word;
IF p.bit # 0 THEN ERROR;
};

BasicSeqTransduce: PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = {
bst: BasicSeqType = NARROW[fromT.typeData];
IF fromT.class.structure # sequence THEN ERROR;
IF toT.class.structure # sequence THEN ERROR;
IF fromT.length # toT.length THEN ERROR;
IF toT.class.super.flavor # switch THEN ERROR;
IF toT.class.dereference THEN toP _ BitTwiddling.DeReferencePtr[toP];
FOR i: NAT IN [0 .. bst.length) DO
subFrom: Ptr = BitTwiddling.OffsetPtr[fromP, SuboffI[bst, i]];
sel: Selector = [subscript[i]];
subTo: Ptr = BitTwiddling.OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]];
RoseTransduce.WriteSwitch[
subTo,
SELECT RoseTransduce.ReadBool[subFrom] FROM
FALSE => [s: [q: fromS, u: none, d: fromS], val: L],
TRUE => [s: [q: fromS, u: fromS, d: none], val: H],
ENDCASE => ERROR
];
ENDLOOP;
toT _ toT;
};

base2: Format _ NEW [FormatRep _ [
FormatValue: NumericFormatValue,
ParseValue: NumericParseValue,
MaxWidth: NumericMaxWidth,
formatData: NEW [Base _ R2],
key: "2"]];

base8: Format _ NEW [FormatRep _ [
FormatValue: NumericFormatValue,
ParseValue: NumericParseValue,
MaxWidth: NumericMaxWidth,
formatData: NEW [Base _ R8],
key: "8"]];

base16: Format _ NEW [FormatRep _ [
FormatValue: NumericFormatValue,
ParseValue: NumericParseValue,
MaxWidth: NumericMaxWidth,
formatData: NEW [Base _ R16],
key: "16"]];

NumericFormatValue: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
bst: BasicSeqType = NARROW[rwt.typeData];
base: REF Base = NARROW[f.formatData];
lgBase: NAT = LgBase[base^];
acc: NAT _ 0;
state: NAT _ 0;
Emit: PROC = {
r _ Digits[acc].Concat[r];
state _ 0;
};
r _ BaseSuffix[base^];
FOR i: NAT DECREASING IN [0 .. bst.length) DO
sp: Ptr = BitTwiddling.OffsetPtr[p, SuboffI[bst, i]];
b: [0 .. 1] = IF RoseTransduce.ReadBool[sp] THEN 1 ELSE 0;
acc _ acc*2 + b;
state _ state + 1;
IF state = lgBase OR i = 0 THEN Emit[];
ENDLOOP;
r _ r;
};

NumericParseValue: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = TRUSTED {
ENABLE IO.Error, IO.EndOfStream => {ok _ FALSE; CONTINUE};
bst: BasicSeqType = NARROW[rwt.typeData];
toke: ROPE _ s.GetTokenRope[WireValBreak].token;
lm1: NAT = toke.Length[]-1;
base: Base = SELECT toke.Fetch[lm1] FROM
'B => R2,
'O => R8,
'H => R16,
ENDCASE => ERROR;
bb: NAT = BaseBase[base];
mult: BigCARD = BigCardinals.BigFromSmall[bb];
acc: BigCARD _ BigCardinals.Zero;
ap: ArrPtr = ToArrPtr[p];
FOR i: NAT IN [0 .. lm1) DO
c: CHAR = toke.Fetch[i];
d: NAT = SELECT c FROM
IN ['0 .. '9] => c - '0,
IN ['A .. 'F] => c - 'A + 10,
ENDCASE => ERROR;
IF d >= bb THEN RETURN [FALSE];
acc _ acc.BigMultiply[mult];
acc _ acc.BigAdd[BigCardinals.BigFromSmall[d]];
ENDLOOP;
IF acc.size > bst.wordLength THEN RETURN [FALSE];
FOR i: NAT IN [0 .. acc.size) DO
IF INT[i+1] = acc.size AND acc.contents[i] >= BitTwiddling.TwoToThe[bst.length MOD Basics.bitsPerWord] THEN RETURN [FALSE];
ap[bst.wordLength - 1 - i] _ acc.contents[i];
ENDLOOP;
f _ f;
FOR i: NAT IN [acc.size .. bst.wordLength) DO
ap[bst.wordLength - 1 - i] _ 0;
ENDLOOP;
f _ f;
};

NumericMaxWidth: PROC [rwt: RoseWireType, fmt: Format, font: VFonts.Font] RETURNS [max: INT] = {
bst: BasicSeqType = NARROW[rwt.typeData];
base: REF Base = NARROW[fmt.formatData];
bitsPerDigit: NAT = LgBase[base^];
AddRope: PROC [r: ROPE, times: NAT _ 1] = {
max _ max + Real.Round[times * ImagerFont.RopeWidth[font, r].x];
};
IF bst.maxes[base^].maxWidthFont = font THEN RETURN [bst.maxes[base^].maxWidth];
bst.maxes[base^].maxWidthFont _ font;
max _ 0;
AddRope[BaseSuffix[base^], 1];
AddRope["X", (bst.length + bitsPerDigit-1)/bitsPerDigit];
bst.maxes[base^].maxWidth _ max;
};

END.
°RoseBasicSequenceImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Barth, September 5, 1985 6:37:22 pm PDT
Spreitzer, October 1, 1985 6:32:08 pm PDT
Κ¦–

"cedar" style˜
codeš
œ™Kšœ
Οm
œ1™<K™'K™)—K˜KšΟk	œ:žœ~˜Γ
K˜šΠbxœžœ
ž˜$Kšžœ)žœE˜wKšžœ˜—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šœ
žœžœ
žœ˜6Kšœžœžœ
žœ˜3Kšœžœžœ
žœ ˜>šœžœžœ
žœ˜#K˜K˜K˜K˜—K˜šΟnœžœ
žœžœ˜PKšœžœ"˜,Kš
œ˜Kšœžœ˜&Kšœžœ$˜7K˜IK˜BKšœ
žœ˜&Kšœžœ(˜7šœžœ˜,Kšœžœ
˜	Kš
œ˜K˜	K˜	Kšœ+žœ˜0Kšœžœ
˜	K˜Kš
œ0˜0Kš
œ˜K˜—Kšžœ žœ
žœ
˜-Kšžœžœ
žœ
˜+Kšœžœ˜šœžœ˜)Kš
œ˜Kšœ
žœ
˜Kšœ#žœ˜<Kš
œ˜Kš
œ˜—šœ
žœ˜"K˜K˜K˜K˜—Kš
œ˜K˜—šœ)žœ˜FKš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ'˜'Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ/˜/Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—š œžœ"žœ˜VKšœžœ˜*K˜Kš
œ˜K˜—š œžœžœžœ˜DKšœžœ˜Kš
œ˜K˜—š œžœ!žœžœ˜Zšœ	žœ
žœ
ž˜Kš
œ˜Kš
œ˜Kš
œ!˜!Kšœžœ˜Kšžœžœ
˜—Kš
œ˜K˜—š œžœ$žœ	žœ˜XKšœžœ˜)šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ
˜Kšœ
žœ˜*Kšžœžœ
˜—Kš
œ˜K˜—š
 œžœžœžœ	žœ˜?Kš
œ˜—K˜š œžœžœžœ	žœžœ˜IKš
œ˜K˜—K˜Kš	œžœžœ
žœ
žœ	˜'Kš
œ	žœžœžœ	žœ
žœ
žœ˜<K˜š œžœ$žœ˜SKšœžœ˜)šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ
˜Kšœ
žœ˜Kšžœžœ
˜—Kš
œ˜K˜—š œžœ%žœ˜VKšœžœ˜*šžœžœ
ž˜Kšœ	žœ˜Kšœ	žœ
˜Kšœ
žœ˜Kšžœžœ
˜—Kš
œ˜K˜—š œžœžœžœ˜;Kšœžœ˜)Kš
œ(˜(Kš
œ˜K˜—š œžœžœ˜NKšœžœ˜*šœžœž˜!Kšœ*žœ˜:Kšœ+žœ˜;š
œ˜šœžœ˜Kš
œ˜Kš
œ˜Kš
œ
˜
—Kš
œ˜—Kšžœžœ
˜—Kš
œ˜K˜—š œžœžœ˜FKšœžœ˜*Kš
œ˜Kš
œ˜K˜—š œžœ%žœžœ˜NKšœžœ˜)K˜Kšœžœ˜5Kš
œ˜K˜K˜—Kšœžœžœ
žœ
žœ
žœ
žœ
žœ
žœ
˜5K˜š œžœ
žœžœ˜8K˜Kšžœžœ
žœ
˜K˜K˜—š œžœA˜XKšœžœ˜+Kšžœ"žœ
žœ
˜/Kšžœ žœ
žœ
˜-Kšžœžœ
žœ
˜(Kšžœ!žœ
žœ
˜.Kšžœžœ(˜Ešžœžœ
žœž˜"Kš
œ>˜>Kš
œ˜Kš
œS˜Sš
œ˜Kš
œ˜šžœ!ž˜+Kšžœ/˜4Kšžœ/˜3Kšžœž˜—K˜—Kšžœ
˜—Kš
œ
˜
K˜K˜—šœžœ˜"Kš
œ ˜ K˜Kš
œ˜Kšœžœ
˜Kš
œ˜K˜—šœžœ˜"Kš
œ ˜ K˜Kš
œ˜Kšœžœ
˜Kš
œ˜K˜—šœžœ˜#Kš
œ ˜ K˜Kš
œ˜Kšœžœ˜Kš
œ˜K˜—š œžœ(žœžœ˜UKšœžœ˜)Kšœžœžœ˜&Kšœžœ˜Kšœžœ˜
Kšœžœ˜š œžœ˜K˜K˜
K˜—K˜š	žœžœ
ž
œ
žœž˜-K˜5Kšœžœžœžœ˜:K˜K˜Kšžœžœžœ˜'Kšžœ
˜—K˜K˜K˜—š œžœ+žœžœžœžœ˜hKš
žœ
žœžœžœžœ˜:Kšœžœ˜)Kšœžœ&˜0Kšœžœ˜šœ
žœž˜(K˜	K˜	K˜
Kšžœžœ
˜—Kšœžœ˜Kš
œ.˜.K˜!K˜šžœžœ
žœž˜Kšœžœ˜šœžœžœž˜Kšžœ˜Kšžœ˜Kšžœžœ
˜—Kšžœ	žœ
žœžœ˜Kš
œ˜Kš
œ/˜/Kšžœ
˜—Kšžœžœ
žœžœ˜1šžœžœ
žœž˜ Kšžœ
žœžœ5žœžœ
žœžœ˜{K˜-Kšžœ
˜—K˜šžœžœ
žœž˜-K˜Kšžœ
˜—K˜K˜K˜—š œžœ5žœžœ˜`Kšœžœ˜)Kšœžœžœ˜(Kšœžœ˜"š œžœžœ	žœ	˜+Kš
œ@˜@K˜—Kšžœ&žœ
žœ˜PKš
œ%˜%K˜K˜Kš
œ9˜9Kš
œ ˜ K˜K˜—Kšžœ
˜—…—#/n