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