RoseWireFormatsImpl.Mesa
Spreitzer, October 22, 1985 6:13:31 pm PDT
DIRECTORY BitTwiddling, ImagerFont, IO, PrincOpsUtils, Real, RealFns, Rope, RoseBehavior, RoseControl, RoseWireFormats, RoseWireTypes, VFonts;
RoseWireFormatsImpl:
CEDAR
PROGRAM
IMPORTS BitTwiddling, ImagerFont, IO, PrincOpsUtils, Real, RealFns, Rope, RoseControl
EXPORTS RoseWireFormats
=
BEGIN OPEN RoseWireTypes;
RN: PROC [n: NAT] RETURNS [REF ANY] = {RETURN [NEW [NAT ← n]]};
numericBasicSwitchSequence:
PUBLIC
ARRAY
--Lg[base]-- [1 .. 4]
OF Format ← [
NEW [FormatRep ← [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[1], "2"]],
NEW [FormatRep ← [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[2], "4"]],
NEW [FormatRep ← [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[3], "8"]],
NEW [FormatRep ← [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[4], "16"]]
];
FormatSwitchNum:
PROC [rwt: RoseWireType, f: Format, p: Ptr]
RETURNS [r:
ROPE] = {
refLgBase: REF NAT = NARROW[f.formatData];
lgBase: INTEGER[1 .. 4] = refLgBase^;
base: NAT = BitTwiddling.TwoToThe[lgBase];
sig: NAT ← 1;
acc: NAT ← 0;
state: NAT ← 0;
XIt: BOOL ← FALSE;
IF rwt.class.dereference THEN p ← BitTwiddling.DeReferencePtr[p];
r ← BaseSuffix[lgBase];
FOR i:
NAT
DECREASING
IN [0 .. rwt.length)
DO
bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[i]]];
sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
l: RoseBehavior.Level = RoseControl.ReadSwitch[sp].val;
b: [0 .. 1] = IF l # L THEN sig ELSE 0;
IF l = X THEN XIt ← TRUE;
acc ← acc + b;
state ← state + 1;
IF state = lgBase
OR i = 0
THEN {
r ← (IF NOT XIt THEN Digit[acc] ELSE "X").Concat[r];
state ← 0;
XIt ← FALSE;
acc ← 0;
sig ← 1;
}
ELSE {
sig ← sig + sig;
};
ENDLOOP;
r ← r;
};
ParseSwitchNum:
PROC [rwt: RoseWireType, f: Format, p: Ptr, s:
STREAM]
RETURNS [ok:
BOOL] =
TRUSTED {
ENABLE IO.Error, IO.EndOfStream => {ok ← FALSE; CONTINUE};
toke: ROPE ← s.GetTokenRope[WireValBreak].token;
lm1: NAT = toke.Length[]-1;
lgBase:
INTEGER[1 .. 4] =
SELECT toke.Fetch[lm1]
FROM
'B => 1,
'Q => 2,
'O => 3,
'H => 4,
ENDCASE => ERROR;
base: NAT = BitTwiddling.TwoToThe[lgBase];
digits: NAT = (rwt.length + lgBase - 1)/lgBase;
bi: INTEGER ← rwt.length;
ci: INTEGER ← lm1;
IF rwt.class.dereference THEN p ← BitTwiddling.DeReferencePtr[p];
FOR di:
NAT
IN [0 .. digits)
DO
d: NAT ← 0;
XIt: BOOL ← FALSE;
ci ← ci - 1;
IF ci >= 0
THEN {
c: CHAR = toke.Fetch[ci];
IF c = 'X
THEN XIt ← TRUE
ELSE d ←
SELECT c
FROM
IN ['0 .. '9] => c - '0,
IN ['A .. 'F] => c - 'A + 10,
ENDCASE => base;
};
FOR si:
NAT
IN [0 .. lgBase]
DO
bi ← bi - 1;
IF bi >= 0
THEN {
bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[bi]]];
sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
b: BOOL = PrincOpsUtils.BITAND[d, 1] # 0;
RoseControl.WriteSwitch[sp, [s: [none, none, none], val: IF XIt THEN X ELSE IF b THEN H ELSE L]];
d ← PrincOpsUtils.BITSHIFT[d, -1];
}
ELSE IF d # 0 THEN RETURN [FALSE];
ENDLOOP;
IF d # 0 THEN RETURN [FALSE];
ENDLOOP;
IF ci > 0 THEN RETURN [FALSE];
};
MaxNumWidth:
PROC [rwt: RoseWireType, f: Format, font: VFonts.Font]
RETURNS [max:
INT] = {
refLgBase: REF NAT = NARROW[f.formatData];
lgBase: INTEGER[1 .. 4] = refLgBase^;
base: NAT = BitTwiddling.TwoToThe[lgBase];
digits: NAT = (rwt.length + lgBase - 1)/lgBase;
AddRope:
PROC [r:
ROPE, times:
NAT ← 1] = {
max ← max + Real.Round[times * ImagerFont.RopeWidth[font, r].x];
};
max ← 0;
AddRope[BaseSuffix[lgBase], 1];
AddRope["X", digits];
};
numericBasicSimpleSequence:
PUBLIC
ARRAY
--Lg[base]-- [1 .. 4]
OF Format ← [
NEW [FormatRep ← [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[1], "2"]],
NEW [FormatRep ← [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[2], "4"]],
NEW [FormatRep ← [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[3], "8"]],
NEW [FormatRep ← [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[4], "16"]]
];
FormatSimpleNum:
PROC [rwt: RoseWireType, f: Format, p: Ptr]
RETURNS [r:
ROPE] = {
refLgBase: REF NAT = NARROW[f.formatData];
lgBase: INTEGER[1 .. 4] = refLgBase^;
base: NAT = BitTwiddling.TwoToThe[lgBase];
sig: NAT ← 1;
acc: NAT ← 0;
state: NAT ← 0;
IF rwt.class.dereference THEN p ← BitTwiddling.DeReferencePtr[p];
r ← BaseSuffix[lgBase];
FOR i:
NAT
DECREASING
IN [0 .. rwt.length)
DO
bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[i]]];
sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
b: NAT = IF RoseControl.ReadBool[sp] THEN sig ELSE 0;
acc ← acc + b;
state ← state + 1;
IF state = lgBase
OR i = 0
THEN {
r ← Digit[acc].Concat[r];
state ← 0;
acc ← 0;
sig ← 1;
}
ELSE {
sig ← sig + sig;
};
ENDLOOP;
r ← r;
};
BaseSuffix: ARRAY [1 .. 4] OF ROPE = ["B", "Q", "O", "H"];
ParseSimpleNum:
PROC [rwt: RoseWireType, f: Format, p: Ptr, s:
STREAM]
RETURNS [ok:
BOOL] =
TRUSTED {
ENABLE IO.Error, IO.EndOfStream => {ok ← FALSE; CONTINUE};
toke: ROPE ← s.GetTokenRope[WireValBreak].token;
lm1: NAT = toke.Length[]-1;
lgBase:
INTEGER[1 .. 4] =
SELECT toke.Fetch[lm1]
FROM
'B => 1,
'Q => 2,
'O => 3,
'H => 4,
ENDCASE => ERROR;
base: NAT = BitTwiddling.TwoToThe[lgBase];
digits: NAT = (rwt.length + lgBase - 1)/lgBase;
bi: INTEGER ← rwt.length;
ci: INTEGER ← lm1;
IF rwt.class.dereference THEN p ← BitTwiddling.DeReferencePtr[p];
FOR di:
NAT
IN [0 .. digits)
DO
d: NAT ← 0;
ci ← ci - 1;
IF ci >= 0
THEN {
c: CHAR = toke.Fetch[ci];
d ←
SELECT c
FROM
IN ['0 .. '9] => c - '0,
IN ['A .. 'F] => c - 'A + 10,
ENDCASE => ERROR;
};
FOR si:
NAT
IN [0 .. lgBase]
DO
bi ← bi - 1;
IF bi >= 0
THEN {
bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[bi]]];
sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
b: BOOL = PrincOpsUtils.BITAND[d, 1] # 0;
RoseControl.WriteBool[sp, b];
d ← PrincOpsUtils.BITSHIFT[d, -1];
}
ELSE IF d # 0 THEN RETURN [FALSE];
ENDLOOP;
IF d # 0 THEN RETURN [FALSE];
ENDLOOP;
IF ci > 0 THEN RETURN [FALSE];
};
MaxSimpleNumWidth:
PROC [rwt: RoseWireType, f: Format, font: VFonts.Font]
RETURNS [max:
INT] = {
refLgBase: REF NAT = NARROW[f.formatData];
lgBase: INTEGER[1 .. 4] = refLgBase^;
base: NAT = BitTwiddling.TwoToThe[lgBase];
digits: NAT = (rwt.length + lgBase - 1)/lgBase;
AddRope:
PROC [r:
ROPE, times:
NAT ← 1] = {
max ← max + Real.Round[times * ImagerFont.RopeWidth[font, r].x];
};
max ← 0;
AddRope[BaseSuffix[lgBase], 1];
AddRope["E", digits];
};
constructNumericSequence:
PUBLIC
ARRAY
--Lg[base]-- [1 .. 4]
OF Format ← [
NEW [FormatRep ← [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "2"]],
NEW [FormatRep ← [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "4"]],
NEW [FormatRep ← [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "8"]],
NEW [FormatRep ← [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "16"]]
];
constructNumericRecord:
PUBLIC
ARRAY
--Lg[base]-- [1 .. 4]
OF Format ← [
NEW [FormatRep ← [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "2"]],
NEW [FormatRep ← [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "4"]],
NEW [FormatRep ← [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "8"]],
NEW [FormatRep ← [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "16"]]
];
constructIdiosyncraticSequence: PUBLIC Format ← NEW [FormatRep ← [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "idiosyncratic"]];
FormatSeqCons:
PROC [rwt: RoseWireType, f: Format, p: Ptr]
RETURNS [r:
ROPE] = {
to: STREAM = IO.ROS[];
digits: NAT = DecimalDigits[rwt.length-1];
formatString: ROPE = IO.PutFR["%%%gg: %%g", [cardinal[digits]]];
to.PutRope["["];
FOR i:
NAT
IN [0 .. rwt.length)
DO
subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
subFormat: Format = subType.class.super.GetFormat[subType, f.key];
subPtr: Ptr = BitTwiddling.OffsetPtr[p, rwt.class.super.SelectorOffset[rwt, [field[i]]]];
IF i # 0 THEN to.PutRope[", "];
to.PutF[
formatString,
[cardinal[i]],
[rope[subFormat.FormatValue[subType, subFormat, subPtr]]]
];
ENDLOOP;
to.PutRope["]"];
r ← to.RopeFromROS[];
};
ParseSeqCons:
PROC [rwt: RoseWireType, f: Format, p: Ptr, s:
STREAM]
RETURNS [ok:
BOOL] = {
ENABLE IO.Error, IO.EndOfStream => {ok ← FALSE; CONTINUE};
Consume:
PROC [goal:
ROPE] = {
toke: ROPE = s.GetTokenRope[WireValBreak].token;
IF NOT toke.Equal[goal] THEN IO.Error[SyntaxError, s];
};
first: BOOL ← TRUE;
ok ← TRUE;
Consume["["];
FOR discard:
INT ← s.SkipWhitespace[], s.SkipWhitespace[]
WHILE s.PeekChar # ']
DO
i: INT;
IF first THEN first ← FALSE ELSE Consume[", "];
i ← s.GetInt[];
IF NOT i IN [0 .. rwt.length) THEN RETURN [FALSE];
{
subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
subFormat: Format = subType.class.super.GetFormat[subType, f.key];
bitOffset: INT = rwt.class.super.SelectorOffset[rwt, [field[i]]];
subPtr: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
Consume[":"];
IF
NOT subFormat.ParseValue[
subType,
subFormat,
subPtr,
s
]
THEN RETURN [FALSE];
};
ENDLOOP;
Consume["]"];
};
MaxSeqConsWidth:
PROC [rwt: RoseWireType, f: Format, font: VFonts.Font]
RETURNS [max:
INT] = {
AddRope:
PROC [r:
ROPE, count:
INT ← 1] = {
max ← max + Real.Round[ImagerFont.RopeWidth[font, r].x * count];
};
digits: NAT = DecimalDigits[rwt.length-1];
formatString: ROPE = IO.PutFR["%%%gg: ", [cardinal[digits]]];
intro: ROPE = IO.PutFR[formatString, [cardinal[0]]];
max ← 0;
AddRope["[]"];
AddRope[intro, rwt.length];
FOR i:
NAT
IN [0 .. rwt.length)
DO
subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
subFormat: Format = subType.class.super.GetFormat[subType, f.key];
IF i # 0 THEN AddRope[", "];
max ← max + subFormat.MaxWidth[
subType,
subFormat,
font
];
ENDLOOP;
max ← max;
};
constructIdiosyncraticRecord: PUBLIC Format ← NEW [FormatRep ← [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "idiosyncratic"]];
FormatRecCons:
PROC [rwt: RoseWireType, f: Format, p: Ptr]
RETURNS [r:
ROPE] = {
to: STREAM = IO.ROS[];
to.PutRope["["];
FOR i:
NAT
IN [0 .. rwt.length)
DO
subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
subFormat: Format = subType.class.super.GetFormat[subType, f.key];
fieldName: ROPE = rwt.class.super.FieldName[rwt.class, i];
subPtr: Ptr = BitTwiddling.OffsetPtr[p, rwt.class.super.SelectorOffset[rwt, [field[i]]]];
IF i # 0 THEN to.PutRope[", "];
to.PutF[
"%g: %g",
[rope[fieldName]],
[rope[subFormat.FormatValue[subType, subFormat, subPtr]]]
];
ENDLOOP;
to.PutRope["]"];
r ← to.RopeFromROS[];
};
ParseRecCons:
PROC [rwt: RoseWireType, f: Format, p: Ptr, s:
STREAM]
RETURNS [ok:
BOOL] = {
ENABLE IO.Error, IO.EndOfStream => {ok ← FALSE; CONTINUE};
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 .. rwt.length)
DO
subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
subFormat: Format = subType.class.super.GetFormat[subType, f.key];
fieldName: ROPE = rwt.class.super.FieldName[rwt.class, i];
bitOffset: INT = rwt.class.super.SelectorOffset[rwt, [field[i]]];
subPtr: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
toke: ROPE;
IF i # 0 THEN Consume[", "];
toke ← s.GetTokenRope[WireValBreak].token;
IF NOT toke.Equal[fieldName] THEN RETURN [FALSE] --lazy implementor--;
Consume[":"];
IF
NOT subFormat.ParseValue[
subType,
subFormat,
subPtr,
s
]
THEN RETURN [FALSE];
ENDLOOP;
Consume["]"];
};
WireValBreak:
PUBLIC
PROC [char:
CHAR]
RETURNS [
IO.CharClass]
--IO.BreakProc-- = {
RETURN [
SELECT char
FROM
IN [IO.NUL .. IO.SP] => sepr,
',, ':, '[, '] => break,
ENDCASE => other
];
};
MaxRecConsWidth:
PROC [rwt: RoseWireType, f: Format, font: VFonts.Font]
RETURNS [max:
INT] = {
AddRope:
PROC [r:
ROPE] = {
max ← max + Real.Round[ImagerFont.RopeWidth[font, r].x];
};
max ← 0;
AddRope["[]"];
FOR i:
NAT
IN [0 .. rwt.length)
DO
subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
subFormat: Format = subType.class.super.GetFormat[subType, f.key];
fieldName: ROPE = rwt.class.super.FieldName[rwt.class, i];
IF i # 0 THEN AddRope[", "];
AddRope[fieldName];
AddRope[": "];
max ← max + subFormat.MaxWidth[
subType,
subFormat,
font
];
ENDLOOP;
max ← max;
};
DecimalDigits:
PROC [n:
NAT]
RETURNS [digits:
NAT] = {
digits ← Real.Fix[RealFns.Log[base: 10.0, arg: n+0.5]] + 1;
};
Digit:
ARRAY [0 .. 16)
OF
ROPE = [
"0", "1", "2", "3",
"4", "5", "6", "7",
"8", "9", "A", "B",
"C", "D", "E", "F"];
END.