RoseFixedSequenceImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, September 5, 1985 6:37:22 pm PDT
Spreitzer, November 18, 1985 10:35:26 pm PST
DIRECTORY Basics, BitTwiddling, Convert, ImagerFont, IO, Real, Rope, RoseBehavior, RoseWireClasses, RoseWireFormats, RoseWireTypes, RoseWireTypeUse, RoseWiring, VFonts;
RoseFixedSequenceImpl:
CEDAR
PROGRAM
IMPORTS BitTwiddling, IO, Rope, RoseWireFormats, RoseWireTypeUse, RoseWireTypes, RoseWiring
EXPORTS RoseWireClasses, RoseWireTypes =
BEGIN OPEN RoseWireTypes;
SwitchVal: TYPE = RoseBehavior.SwitchVal;
Level: TYPE = RoseBehavior.Level;
FixSeqClass: TYPE = REF FixSeqClassPrivate;
FixSeqClassPrivate:
TYPE =
RECORD [
name: ROPE,
bitSize, wordSize: NAT,
repAux: Mesa ← [],
vanillaMaxWidth: INT ← 0,
vanillaMaxWidthFont: ImagerFont.Font ← NIL,
ewc: RoseWireClass,
eltBitSize, stepBits, eltPad: NAT,
length: NAT
];
FixSeqType: TYPE = REF FixSeqTypePrivate;
FixSeqTypePrivate:
TYPE =
RECORD [
rwt: RoseWireType,
ewt: RoseWireType
];
WireFlavorName:
PUBLIC
ARRAY WireFlavor
OF
ROPE ← [
simple: "Simple",
switch: "Switch",
drive: "Drive"
];
GetFixedSequence:
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;
length: NAT = prototype.elements.size;
cedarTypeName: ROPE = name.Cat[WireFlavorName[flavor]];
ewc: RoseWireClass = RoseWiring.GetWiring[prototype.elements[0], flavor];
eltBitSize: NAT = ewc.super.Bits[ewc];
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;
eltsPerWord: NAT = Basics.bitsPerWord / stepBits;
bitSize:
NAT =
IF length <= eltsPerWord
THEN length*stepBits
ELSE ((length + eltsPerWord-1) / eltsPerWord) * eltsPerWord * stepBits;
wordSize: NAT = (bitSize + Basics.bitsPerWord-1) / Basics.bitsPerWord;
fsc: FixSeqClass ←
NEW [FixSeqClassPrivate ← [
name: cedarTypeName,
bitSize: bitSize,
wordSize: wordSize,
ewc: ewc,
eltBitSize: eltBitSize,
stepBits: stepBits,
eltPad: stepBits - eltBitSize,
length: length]];
em: Mesa = ewc.super.MesaRepresentation[ewc];
bitBucket: ROPE;
IF StructureOfWire[prototype] # sequence THEN ERROR;
rwtUser.NoteMesa[em];
[bitBucket, moduleRefs] ← rwtUser.DestroyUser[];
IF bitBucket.Length[] # 0 THEN ERROR;
fsc.repAux.directory ← moduleRefs[Directory];
fsc.repAux.imports ← moduleRefs[Import];
IF moduleRefs[Export] # NIL OR moduleRefs[Open] # NIL THEN ERROR;
fsc.repAux.mesa ←
IO.PutFR[
"%g: TYPE = PACKED ARRAY [0 .. %g) OF %g",
[rope[fsc.name]],
[integer[fsc.length]],
[rope[em.mesa]]
];
rwc ←
NEW[RoseWireClassRec ← [
structure: sequence,
dereference: FALSE,
addressContaining: ewc.dereference OR ewc.addressContaining,
classData: fsc,
super: fixSeqSuperClasses[flavor]]];
};
fixSeqSuperClasses:
ARRAY WireFlavor
OF RoseWireSuperClass ←
ALL[
NIL];
FixSeqGetType:
PROC [rwc: RoseWireClass, wire: Wire]
RETURNS [rwt: RoseWireType] = {
fsc: FixSeqClass = NARROW[rwc.classData];
fst: FixSeqType =
NEW [FixSeqTypePrivate ← [
rwt: rwt ←
NEW[RoseWireTypeRec ← [
class: rwc,
typeData: NIL,
length: fsc.length,
other: NIL]],
ewt: fsc.ewc.super.GetType[fsc.ewc, wire.elements[0]]
]];
IF StructureOfWire[wire] # sequence THEN ERROR;
rwt.typeData ← fst;
};
FixSeqListFormats:
PROC [rwt: RoseWireType]
RETURNS [lor:
LOR] = {
lor ← LIST["2", "4", "8", "16", "idiosyncratic"];
};
FixSeqGetFormat:
PROC [rwt: RoseWireType, formatName:
ROPE]
RETURNS [format: Format] = {
basic: BOOL = rwt.class.super.SubClass[rwt.class, [subscript[0]]].structure = atom;
switch: BOOL = rwt.class.super.flavor = switch;
Do:
PROC [lgBase:
NAT]
RETURNS [format: Format] = {
format ←
(
IF NOT basic THEN RoseWireFormats.constructNumericSequence
ELSE IF switch THEN RoseWireFormats.numericBasicSwitchSequence
ELSE RoseWireFormats.numericBasicSimpleSequence)
[lgBase];
};
format ←
SELECT
TRUE
FROM
formatName.Equal["idiosyncratic"] => RoseWireFormats.constructIdiosyncraticSequence,
formatName.Equal["2"] => Do[1],
formatName.Equal["2"] => Do[2],
formatName.Equal["8"] => Do[3],
formatName.Equal["16"], formatName=NIL => Do[4],
ENDCASE => ERROR;
};
FixSeqSelectorOffset:
PROC [rwt: RoseWireType, sel: Selector]
RETURNS [dBits:
NAT] = {
fsc: FixSeqClass = NARROW[rwt.class.classData];
WITH sel
SELECT
FROM
whole => RETURN [0];
field => ERROR;
subscript => RETURN [Suboff[fsc, index]];
ENDCASE => ERROR;
};
Suboff:
PROC [fsc: FixSeqClass, i:
NAT]
RETURNS [dBits:
NAT] = {
dBits ← fsc.stepBits * i + fsc.eltPad;
};
FixSeqSubType:
PROC [rwt: RoseWireType, sel: Selector]
RETURNS [RoseWireType] = {
fst: FixSeqType = NARROW[rwt.typeData];
WITH sel
SELECT
FROM
whole => RETURN [rwt];
field => ERROR;
subscript => RETURN [fst.ewt];
ENDCASE => ERROR;
};
FixSeqSubClass:
PROC [rwc: RoseWireClass, sel: Selector]
RETURNS [RoseWireClass] = {
fsc: FixSeqClass = NARROW[rwc.classData];
WITH sel
SELECT
FROM
whole => RETURN [rwc];
field => ERROR;
subscript => RETURN [fsc.ewc];
ENDCASE => ERROR;
};
FixSeqBits:
PROC [rwc: RoseWireClass]
RETURNS [n:
INT] = {
fsc: FixSeqClass = NARROW[rwc.classData];
n ← fsc.bitSize;
};
FixSeqMesaRepresentation:
PROC [rwc: RoseWireClass]
RETURNS [mesa: Mesa] = {
fsc: FixSeqClass = NARROW[rwc.classData];
mesa ← [mesa: fsc.name];
};
FixSeqMesaRepAux:
PROC [rwc: RoseWireClass]
RETURNS [mesa: Mesa] = {
fsc: FixSeqClass = NARROW[rwc.classData];
mesa ← fsc.repAux;
};
FixSeqInitialize:
PROC [rwt: RoseWireType, p: Ptr, steady:
BOOL] = {
fsc: FixSeqClass = NARROW[rwt.class.classData];
fst: FixSeqType = NARROW[rwt.typeData];
FOR i:
NAT
IN [0 .. fsc.length)
DO
fsc.ewc.super.Initialize[
fst.ewt,
BitTwiddling.OffsetPtr[p, Suboff[fsc, i]],
steady
];
ENDLOOP;
steady ← steady;
};
FixSeqTransduce:
PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = {
fsc: FixSeqClass = NARROW[fromT.class.classData];
fst: FixSeqType = 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.dereference THEN toP ← BitTwiddling.DeReferencePtr[toP];
FOR i:
NAT
IN [0 .. fsc.length)
DO
subFrom: Ptr = BitTwiddling.OffsetPtr[fromP, Suboff[fsc, i]];
sel: Selector = [subscript[i]];
subTo: Ptr = BitTwiddling.OffsetPtr[toP, toT.class.super.SelectorOffset[toT, sel]];
fsc.ewc.super.Transduce[
fromS: fromS,
fromT: fst.ewt,
toT: toT.class.super.SubType[toT, sel],
fromP: subFrom,
toP: subTo];
toT ← toT;
ENDLOOP;
toT ← toT;
};
FixSeqInitQ:
PROC [rwt: RoseWireType, p: Ptr, cap: Strength] =
TRUSTED {
fsc: FixSeqClass = NARROW[rwt.class.classData];
fst: FixSeqType = NARROW[rwt.typeData];
FOR i:
NAT
IN [0 .. fsc.length)
DO
subType: RoseWireType = fst.ewt;
subType.class.super.InitQ[
subType,
BitTwiddling.OffsetPtr[p, Suboff[fsc, i]],
cap];
cap ← cap;
ENDLOOP;
cap ← cap;
};
FixSeqInitUD:
PROC [rwt: RoseWireType, p: Ptr, cap: Strength]
RETURNS [isInput:
BOOL] =
TRUSTED {
fsc: FixSeqClass = NARROW[rwt.class.classData];
fst: FixSeqType = NARROW[rwt.typeData];
isInput ← TRUE;
FOR i:
NAT
IN [0 .. fsc.length)
DO
subType: RoseWireType = fst.ewt;
subInput:
BOOL ← subType.class.super.InitUD[
subType,
BitTwiddling.OffsetPtr[p, Suboff[fsc, i]],
cap];
isInput ← isInput AND subInput;
ENDLOOP;
cap ← cap;
};
FixSeqComputeLevel:
PROC [rwt: RoseWireType, p: Ptr, xPhobic:
BOOL]
RETURNS [delay:
BOOL] =
TRUSTED {
fsc: FixSeqClass = NARROW[rwt.class.classData];
fst: FixSeqType = NARROW[rwt.typeData];
delay ← FALSE;
FOR i:
NAT
IN [0 .. fsc.length)
DO
subType: RoseWireType = fst.ewt;
subDelay:
BOOL ← subType.class.super.ComputeLevel[
subType,
BitTwiddling.OffsetPtr[p, Suboff[fsc, i]],
xPhobic];
delay ← delay OR subDelay;
ENDLOOP;
xPhobic ← xPhobic;
};
Start:
PROC = {
FOR wf: WireFlavor
IN WireFlavor
DO
fixSeqSuperClasses[wf] ←
NEW[RoseWireSuperClassRec ← [
GetType: FixSeqGetType,
ListFormats: FixSeqListFormats,
GetFormat: FixSeqGetFormat,
SelectorOffset: FixSeqSelectorOffset,
SubType: FixSeqSubType,
SubClass: FixSeqSubClass,
Bits: FixSeqBits,
MesaRepresentation: FixSeqMesaRepresentation,
MesaRepAux: FixSeqMesaRepAux,
flavor: wf,
Initialize: FixSeqInitialize,
Transduce: FixSeqTransduce,
InitQ: FixSeqInitQ,
InitUD: FixSeqInitUD,
ComputeLevel: FixSeqComputeLevel
]];
ENDLOOP;
};
Start[];
END.