RoseVariableSequenceImpl.mesa
Copyright © 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
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.