NumTypesImpl.Mesa, from [Indigo]<Rosemary>2.6>Rosemary.DF
Last Edited by: Spreitzer, September 2, 1984 6:42:33 pm PDT
DIRECTORY Atom, Basics, IO, NumTypes, Rope, RoseCreate, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, VFonts;
NumTypesImpl: CEDAR PROGRAM
IMPORTS Atom, Basics, IO, Rope, RoseCreate, RoseTranslateTypes, SignalTypeRegistration, SwitchNumConvert, VFonts
EXPORTS NumTypes =
BEGIN OPEN RoseTypes, NumTypes;
boolProcs: NodeProcs ← NEW [NodeProcsRep ← [
Bits: BoolBits,
MesaUse: BoolMesaUse,
UserDescription: BoolUserDescription,
MesaDescription: BoolMesaDescription,
ListFormats: BoolListFormats,
GetFormat: BoolGetFormat,
MakeTransducer: MakeNumSwitchTransducer]];
boolType: PUBLIC NodeType ← NEW [NodeTypeRep[atom] ← [
procs: boolProcs,
typeData: NIL,
simple: TRUE,
structure: atom[]]];
onlyBoolFormat: Format ← NEW [FormatRep ← [
FormatValue: BoolFormatValue,
ParseValue: BoolParseValue,
FormatTest: BoolFormatTest,
ParseTest: BoolParseTest,
MaxWidth: BoolMaxWidth,
key: "bool"]];
Int: TYPE = RoseTranslateTypes.Int;
one: Int ← NEW [RoseTranslateTypes.IntRep ← [RoseTranslateTypes.nullSR, 1]];
ConstructBitType: RoseTranslateTypes.NodeTypeConstructor--PROC [parms: REF ANY - -UNION [BindingList, Args]- -] RETURNS [type: NodeType]-- =
BEGIN
type ← boolType;
END;
BoolBits: PROC [NodeType] RETURNS [INTEGER] = {RETURN [1]};
BoolMesaUse: PROC [NodeType] RETURNS [m: Mesa] = {m ← ["BOOLEAN"]};
BoolUserDescription: PROC [NodeType] RETURNS [r: ROPE] = {r ← "BOOL"};
BoolMesaDescription: PROC [NodeType] RETURNS [m: Mesa] =
{m ← [mesa: "NumTypes.boolType", imports: LIST["NumTypes"]]};
BoolListFormats: PROC [NodeType] RETURNS [l: RopeList] = {l ← LIST ["bool"]};
BoolGetFormat: PROC [NodeType, ROPE] RETURNS [f: Format] =
{f ← onlyBoolFormat};
BoolFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [r: ROPE] =
TRUSTED {r ← IF wp^ MOD 2 > 0 THEN "TRUE" ELSE "FALSE"};
BoolParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] = {
b: BOOLEAN;
success ← TRUE;
b ← s.GetBool[!IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
TRUSTED {wp^ ← IF b THEN LAST[CARDINAL] ELSE 0};
};
BoolFormatTest: PROC [nt: NodeType, fmt: Format, tp: NodeTestProc, td: NodeTestData] RETURNS [r: ROPE] =
BEGIN
r ← SELECT td FROM $True => "TRUE", $False => "FALSE", ENDCASE => "??";
END;
BoolParseTest: PROC [nt: NodeType, fmt: Format, s: STREAM] RETURNS [success: BOOLEAN, tp: NodeTestProc, td: NodeTestData] =
BEGIN
b: BOOLEAN;
success ← TRUE;
b ← s.GetBool[!IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
tp ← BoolTest;
td ← IF b THEN $True ELSE $False;
END;
BoolTest: NodeTestProc--PROC [where: WordPtr, testData: NodeTestData, nodeType: NodeType] RETURNS [passes: BOOLEAN]-- =
BEGIN
it: ATOM;
TRUSTED {it ← IF where^ MOD 2 > 0 THEN $True ELSE $False};
passes ← it = testData;
END;
BoolMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
{RETURN [VFonts.StringWidth["FALSE", font]]};
CeilDiv: PROC [num, den: INTEGER] RETURNS [quot: INTEGER] = {
IF den <= 0 THEN ERROR;
SELECT num FROM
= 0 => quot ← 0;
< 0 => quot ← num/den;
> 0 => quot ← (num + (den-1))/den;
ENDCASE => ERROR};
FloorDiv: PROC [num, den: INTEGER] RETURNS [quot: INTEGER] = {
IF den <= 0 THEN ERROR;
SELECT num FROM
= 0 => quot ← 0;
> 0 => quot ← num/den;
< 0 => quot ← (num - (den-1))/den;
ENDCASE => ERROR};
MakeNumSwitchTransducer: PROC [myKind, otherKind: Node, within: Cell, writeMine, writeOther: BOOLEAN, for: ExpansionReceiver] RETURNS [t: Cell] =
{t ← SwitchNumConvert.MakeTransducer[switchy: otherKind, nummy: myKind, within: within, writeSwitchy: writeOther, writeNummy: writeMine, to: for]};
NodeTypeList: TYPE = LIST OF ArrayNodeType;
numTypes: NodeTypeList ← NIL;
NumType: PUBLIC PROC [bits: CARDINAL] RETURNS [nt: NodeType] =
BEGIN
last: INTEGER ← bits-1;
FOR it: NodeTypeList ← numTypes, it.rest WHILE it # NIL DO
IF (it.first.first = 0) AND (it.first.last = last) THEN RETURN [it.first];
ENDLOOP;
numTypes ← CONS[nt ← MakeNumOfIndices[0, last], numTypes];
END;
BitArray: PUBLIC PROC [firstIndex, lastIndex: INTEGER] RETURNS [nt: NodeType] =
BEGIN
FOR it: NodeTypeList ← numTypes, it.rest WHILE it # NIL DO
IF (it.first.first = firstIndex) AND (it.first.last = lastIndex) THEN RETURN [it.first];
ENDLOOP;
numTypes ← CONS[nt ← MakeNumOfIndices[firstIndex, lastIndex], numTypes];
END;
MakeNumOfIndices: PROC [firstIndex, lastIndex: INTEGER] RETURNS [nt: ArrayNodeType] =
BEGIN
nt ← NEW [NodeTypeRep[array] ← [
procs: numProcs,
typeData: NIL,
simple: TRUE,
structure: array[firstIndex, lastIndex, boolType]]];
END;
numProcs: NodeProcs ← NEW [NodeProcsRep ← [
Bits: NumBits,
MesaUse: NumMesaUse,
UserDescription: NumUserDescription,
MesaDescription: NumMesaDescription,
ListFormats: NumListFormats,
GetFormat: NumGetFormat,
MakeSubarrayType: NumMakeSubarrayType,
MakeSplitJoin: NumMakeSplitJoin,
MakeTransducer: MakeNumSwitchTransducer]];
ConstructNumType: RoseTranslateTypes.NodeTypeConstructor--PROC [parms: REF ANY - -UNION [BindingList, Args]- -] RETURNS [type: NodeType]-- =
BEGIN
bits: Int ← NARROW[RoseTranslateTypes.GetParm[n: 1, name: "bits", parms: parms, default: one]];
type ← NumType[bits.i];
END;
NumBits: PROC [nt: NodeType] RETURNS [bits: INTEGER] = {
ant: ArrayNodeType ← NARROW[nt];
bits ← 1 + ant.last - ant.first;
bits ← SELECT bits FROM
<= 16 => bits,
> 16 => 16 * CeilDiv[1 + ant.last - ant.first, 16],
ENDCASE => ERROR};
NumMesaUse: PROC [nt: NodeType] RETURNS [m: Mesa] = {
ant: ArrayNodeType ← NARROW[nt];
bits: INTEGER ← 1 + ant.last - ant.first;
m ← [SELECT bits FROM
< 16 => IO.PutFR["[0..%g]", IO.card[uppers[bits]]],
= 16 => "CARDINAL",
> 16 => IO.PutFR["ARRAY [0..%g) OF CARDINAL", IO.card[CeilDiv[bits, 16]]],
ENDCASE => ERROR]};
uppers: ARRAY [1..16] OF CARDINAL = [1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767, 65535];
NumUserDescription: PROC [nt: NodeType] RETURNS [ud: ROPE] = {
ant: ArrayNodeType ← NARROW[nt];
ud ← IF ant.first = 0
THEN IO.PutFR["INT[%g]", IO.int[ant.last+1]]
ELSE IO.PutFR["Num[%g .. %g]", IO.card[ant.first], IO.card[ant.last]]};
NumMesaDescription: PROC [nt: NodeType] RETURNS [m: Mesa] = {
ant: ArrayNodeType ← NARROW[nt];
m ← [
mesa: IF ant.first = 0
THEN IO.PutFR["NumTypes.NumType[%g]", IO.int[ant.last+1]]
ELSE IO.PutFR["NumTypes.BitArray[%g, %g]", IO.int[ant.first], IO.int[ant.last]],
imports: LIST["NumTypes"]]};
NumListFormats: PROC [NodeType] RETURNS [l: RopeList] = {
l ← LIST ["2", "8", "10", "16"]};
NumGetFormat: PROC [nt: NodeType, key: ROPE] RETURNS [fmt: Format] = {
atom: ATOM ← Atom.MakeAtom[key];
fmt ← NARROW[Atom.GetProp[atom: atom, prop: numFmtKey]];
};
numFmtKey: REF ROPENEW [ROPE ← "Numeric Format Key"];
NumMakeSubarrayType: PROC [nt: NodeType, first, last: INTEGER] RETURNS [st: NodeType] =
BEGIN
st ← BitArray[first, last];
END;
Numeric: PUBLIC PROC [nt: NodeType] RETURNS [numeric: BOOLEAN] = {
WITH nt SELECT FROM
ant: ArrayNodeType => numeric ← Numeric[ant.element];
ant: AtomNodeType => numeric ← ant = boolType;
ENDCASE => ERROR};
Side: TYPE = {A, B};
NumMakeSplitJoin: PROC [within: Cell, a, b: StretchList, writeA, writeB: BOOLEAN, for: ExpansionReceiver] RETURNS [cell: Cell] =
BEGIN
Add: PROC [old, sep, nu1, nu2, nu3: ROPENIL] RETURNS [new: ROPE] =
BEGIN
new ← old.Cat[IF old.Length[] > 0 THEN sep ELSE "", nu1, nu2, nu3];
END;
Hello: PROC [stretch: Stretch, side: Side] RETURNS [length: INTEGER] =
{oside: Side ← IF side = A THEN B ELSE A;
bits: INTEGER ← stretch.node.type.procs.Bits[stretch.node.type];
words: INTEGER ← (bits + 15)/16;
portName: ROPEIO.PutFR["%g%g",
IO.rope[SELECT side FROM A => "A", B => "B", ENDCASE => ERROR],
IO.int[portCount[side] ← portCount[side]+1]];
bitOff: INTEGER ← 0;
IF NOT Numeric[stretch.node.type] THEN ERROR;
WITH stretch SELECT FROM
ss: SubStretch => BEGIN
WITH stretch.node.type SELECT FROM
ant: ArrayNodeType => BEGIN
goodBits: INTEGER = 1 + ant.last - ant.first;
inRepFiller: INTEGER ← (16 - (goodBits MOD 16)) MOD 16;
IF ant.element # boolType THEN ERROR;
IF ss.first < ant.first OR ss.last > ant.last THEN ERROR;
bitOff ← inRepFiller + ss.first - ant.first;
END;
ant: AtomNodeType => ERROR;
ENDCASE => ERROR;
length ← 1 + ss.last - ss.first;
END;
ss: SingleStretch => WITH stretch.node.type SELECT FROM
ant: ArrayNodeType => ERROR;
ant: AtomNodeType => length ← 1;
ENDCASE => ERROR;
ENDCASE => ERROR;
connections ← Add[connections, ", ", portName, ":", stretch.node.name];
instanceNames[side] ← Add[instanceNames[side], ",", stretch.node.name];
typeNames[side] ← Add[typeNames[side], ",", stretch.node.type.procs.UserDescription[stretch.node.type]];
wordOffset[side] ← nextWordOffset;
nextWordOffset ← nextWordOffset + words;
portList ← CONS[
[wordOffset[side], words, portName, stretch.node.type, write[oside], write[side]],
portList];
bitOffset[side] ← ((16 - (bits MOD 16)) MOD 16) + bitOff;
};
sjd: SplitJoinData ← NEW [SplitJoinDataRep ← []];
connections: ROPE;
instanceNames, typeNames: ARRAY Side OF ROPEALL[NIL];
wordOffset, bitOffset, portCount: ARRAY Side OF INTEGERALL[0];
nextWordOffset: INTEGER ← 1;
write: ARRAY Side OF BOOLEAN = [writeA, writeB];
portList: LIST OF Port;
aList, bList: StretchList;
aLength, bLength: INTEGER;
exhausted: BOOLEANFALSE;
sjd.direction ← IF writeA
THEN (IF writeB THEN ERROR ELSE toA)
ELSE (IF writeB THEN toB ELSE ERROR);
aLength ← Hello[(aList ← a).first, A];
bLength← Hello[(bList ← b).first, B];
WHILE NOT exhausted DO
length: INTEGERMIN[aLength, bLength];
sjd.parts ← CONS[
[
aWordOffset: wordOffset[A], aBitOffset: bitOffset[A],
bWordOffset: wordOffset[B], bBitOffset: bitOffset[B],
length: length],
sjd.parts];
bitOffset[A] ← bitOffset[A] + length;
bitOffset[B] ← bitOffset[B] + length;
aLength ← aLength - length;
bLength ← bLength - length;
IF aLength = 0 THEN
BEGIN
aList ← aList.rest;
IF aList = NIL THEN exhausted ← TRUE ELSE aLength ← Hello[aList.first, A];
END;
IF bLength = 0 THEN
BEGIN
bList ← bList.rest;
IF bList = NIL THEN exhausted ← TRUE ELSE bLength ← Hello[bList.first, B];
END;
ENDLOOP;
IF aLength # 0 OR aList # NIL OR bLength # 0 OR bList # NIL THEN ERROR;
sjd.words ← nextWordOffset - 1;
cell ← for.class.CellInstance[
erInstance: for.instance,
instanceName: IO.PutFR[
"[%g]-[%g]",
IO.rope[instanceNames[A]],
IO.rope[instanceNames[B]]],
typeName: EnsureSplitJoin[
portList,
portCount[A]+portCount[B],
sjd,
IO.PutFR["NumSplitter[%g]%g-%g[%g]",
IO.rope[typeNames[A]],
IO.rope[IF writeA THEN "<" ELSE ""],
IO.rope[IF writeB THEN ">" ELSE ""],
IO.rope[typeNames[B]]]].name,
interfaceNodes: connections];
END;
SplitJoinDataList: TYPE = LIST OF SplitJoinDataRep;
SplitJoinData: TYPE = REF SplitJoinDataRep;
SplitJoinDataRep: TYPE = RECORD [
parts: PartList ← NIL,
words: INTEGER ← 0,
direction: Direction ← toB];
Direction: TYPE = {toA, toB};
PartList: TYPE = LIST OF Part;
Part: TYPE = RECORD [
aWordOffset, bWordOffset, aBitOffset, bBitOffset, length: INTEGER
];
splitters: LIST OF CellType ← NIL;
EnsureSplitJoin: PROC [portList: LIST OF Port, portCount: CARDINAL, sjd: SplitJoinData, typeName: ROPE] RETURNS [type: CellType] =
BEGIN
ports: Ports;
pl: LIST OF Port;
FOR cl: LIST OF CellType ← splitters, cl.rest WHILE cl # NIL DO
i: CARDINAL;
type ← cl.first;
IF type.ports.length # portCount THEN LOOP;
pl ← portList;
FOR i IN [0 .. portCount) DO
IF pl.first # type.ports[i] THEN EXIT;
pl ← pl.rest;
ENDLOOP;
IF i < portCount THEN LOOP;
IF pl # NIL THEN ERROR;
RETURN;
ENDLOOP;
ports ← NEW [PortsRep[portCount]];
pl ← portList;
FOR i: CARDINAL IN [0 .. portCount) DO
ports[i] ← pl.first;
pl ← pl.rest;
ENDLOOP;
type ← RoseCreate.RegisterCellType[name: typeName, ioCreator: CreateSplitterIO, initializer: InitializeSplitter, evals: [EvalSimple: EvalSplitter], ports: ports, typeData: sjd];
splitters ← CONS[type, splitters];
END;
Words: TYPE = REF WordsRep;
WordsRep: TYPE = RECORD [words: SEQUENCE length: CARDINAL OF CARDINAL];
Bits: TYPE = LONG POINTER TO PACKED ARRAY CARDINAL OF BOOLEAN;
CreateSplitterIO: PROC [cell: Cell] --IOCreator-- =
BEGIN
sjd: SplitJoinData ← NARROW[cell.type.typeData];
cell.realCellStuff.newIO ← NEW [WordsRep[sjd.words]];
cell.realCellStuff.oldIO ← NEW [WordsRep[sjd.words]];
END;
InitializeSplitter: PROCEDURE [cell: Cell, leafily: BOOLEAN] --Initializer-- = {cell.realCellStuff.state ← cell.type.typeData};
EvalSplitter: CellProc--PROC [cell: Cell]-- = TRUSTED
BEGIN
sjd: SplitJoinData ← NARROW[cell.realCellStuff.state];
new: Words ← NARROW[cell.realCellStuff.newIO];
old: Words ← NARROW[cell.realCellStuff.oldIO];
a, b: Bits;
FOR pl: PartList ← sjd.parts, pl.rest WHILE pl # NIL DO
p: Part ← pl.first;
a ← LOOPHOLE[cell.realCellStuff.newIOAsWP + p.aWordOffset];
b ← LOOPHOLE[cell.realCellStuff.newIOAsWP + p.bWordOffset];
SELECT sjd.direction FROM
toA => FOR i: INTEGER IN [0 .. p.length) DO
a[p.aBitOffset+i] ← b[p.bBitOffset+i] ENDLOOP;
toB => FOR i: INTEGER IN [0 .. p.length) DO
b[p.bBitOffset+i] ← a[p.aBitOffset+i] ENDLOOP;
ENDCASE => ERROR;
ENDLOOP;
END;
NumFormatValue: PROC [node: Node, fmt: Format, wp: WordPtr] RETURNS [rope: ROPE] =
BEGIN
ant: ArrayNodeType ← NARROW[node.type];
wordWidth: CARDINAL ← (ant.last - ant.first + 16)/16;
base: CARDINALNARROW[fmt.formatData, REF CARDINAL]^;
bitsPerDigitTimes10: CARDINAL ← bitsPerBaseTimes10[base];
digits: CARDINAL ← ((ant.last + 1 - ant.first)*10 + bitsPerDigitTimes10 - 1) / bitsPerDigitTimes10;
v: Value ← ValueFromWP[wp, wordWidth];
rope ← baseKeys[base];
FOR i: CARDINAL IN [1 .. digits] DO
rem: CARDINAL;
[v, rem] ← DivMod[v, base];
rope ← encode[rem].Concat[rope];
ENDLOOP;
END;
NumParseValue: PROC [node: Node, fmt: Format, wp: WordPtr, s: STREAM] RETURNS [success: BOOLEAN] =
BEGIN
ant: ArrayNodeType ← NARROW[node.type];
bits: CARDINAL ← ant.last - ant.first + 1;
wordWidth: CARDINAL ← (bits + 15)/16;
rope: ROPE ← s.GetTokenRope[IO.IDProc].token;
fb: REF CARDINALNARROW[fmt.formatData];
base, test: CARDINAL;
dl, sign: INTEGER ← 1;
v: Value ← NEW [ValueRec[0]];
IF rope.Length[] < 1 THEN RETURN [FALSE]
ELSE BEGIN
SELECT rope.Fetch[rope.Length[] - 1] FROM
'b, 'B => {base ← 2; dl ← 1};
'o, 'O => {base ← 8; dl ← 1};
'd, 'D => {base ← 10; dl ← 1};
'h, 'H => {base ← 16; dl ← 1};
'a, 'A, 'c, 'C, 'e, 'E, 'f, 'F => {base ← 16; dl ← 0};
ENDCASE => {base ← fb^; dl ← 0};
FOR i: INT IN [0 .. rope.Length[] - dl) DO
c: CHARACTER ← rope.Fetch[i];
IF c = '- THEN sign ← -sign
ELSE BEGIN
d: [0..16] ← decode[c];
IF d > base THEN RETURN [FALSE];
v ← Add[Multiply[v, base], d];
END;
ENDLOOP;
END;
IF v.length > wordWidth THEN RETURN [FALSE];
IF wordWidth < 1 THEN RETURN [TRUE];
v ← Truncate[v, wordWidth];
test ← Basics.BITAND[v[0], verboten[bits MOD 16]];
IF 0 # test THEN RETURN [FALSE];
ValueToWP[v, wp, wordWidth];
success ← TRUE;
END;
MaskedValue: TYPE = REF MaskedValueRep;
MaskedValueRep: TYPE = RECORD [m, v: Value];
NumFormatTest: PROC [nt: NodeType, fmt: Format, tp: NodeTestProc, td: NodeTestData] RETURNS [rope: ROPE] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: CARDINAL ← ant.last - ant.first + 1;
mv: MaskedValue ← NARROW[td];
IF mv = NIL THEN rope ← "??"
ELSE rope ← EncodeMV[mv.m, mv.v, 16, bits !CantEncode => {rope ← EncodeMV[mv.m, mv.v, 2, bits]; CONTINUE}];
rope ← Rope.Cat["=", rope];
END;
NumParseTest: PROC [nt: NodeType, fmt: Format, s: STREAM] RETURNS [success: BOOLEAN, tp: NodeTestProc, td: NodeTestData] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: CARDINAL ← ant.last - ant.first + 1;
wordWidth: CARDINAL ← (bits + 15)/16;
base, test: CARDINAL;
dl, sign: INTEGER ← 1;
v: Value ← NEW [ValueRec[0]];
m: Value ← NEW [ValueRec[0]];
rope: ROPE ← s.GetTokenRope[IO.IDProc].token;
IF rope.Length[] < 1 THEN RETURN [FALSE, NIL, NIL]
ELSE BEGIN
SELECT rope.Fetch[rope.Length[] - 1] FROM
'b, 'B => {base ← 2; dl ← 1};
'o, 'O => {base ← 8; dl ← 1};
'd, 'D => {base ← 10; dl ← 1};
'h, 'H => {base ← 16; dl ← 1};
IN ['2..'9] => {base ← 10; dl ← 0};
'a, 'A, 'c, 'C, 'e, 'E, 'f, 'F => {base ← 16; dl ← 0};
ENDCASE => {base ← 2; dl ← 0};
FOR i: INT IN [0 .. rope.Length[] - dl) DO
c: CHARACTER ← rope.Fetch[i];
v ← Multiply[v, base];
m ← Multiply[m, base];
IF c = 'x OR c = 'X THEN
BEGIN
m ← Add[m, base-1];
END
ELSE BEGIN
d: [0..16] ← decode[c];
IF d > base THEN RETURN [FALSE, NIL, NIL];
v ← Add[v, d];
END;
ENDLOOP;
END;
IF MAX[v.length, m.length] > wordWidth THEN RETURN [FALSE, NIL, NIL];
IF wordWidth < 1 THEN RETURN [FALSE, NIL, NIL];
v ← Truncate[v, wordWidth];
m ← Truncate[m, wordWidth];
test ← Basics.BITAND[v[0], verboten[bits MOD 16]];
IF 0 # test THEN RETURN [FALSE, NIL, NIL];
test ← Basics.BITAND[m[0], verboten[bits MOD 16]];
IF 0 # test THEN RETURN [FALSE, NIL, NIL];
td ← NEW [MaskedValueRep ← [m: m, v: v]];
success ← TRUE;
tp ← TestInt;
END;
NumMaxWidth: PROC [nt: NodeType, fmt: Format, font: VFonts.Font] RETURNS [INT] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
base: CARDINALNARROW[fmt.formatData, REF CARDINAL]^;
bitsPerDigitTimes10: CARDINAL ← bitsPerBaseTimes10[base];
digits: CARDINAL ← ((ant.last + 1 - ant.first)*10 + bitsPerDigitTimes10 - 1) / bitsPerDigitTimes10;
RETURN [VFonts.StringWidth["X", font]*digits + VFonts.StringWidth[baseKeys[base]]]
END;
CantEncode: ERROR = CODE;
EncodeMV: PROC [m, v: Value, base: [2..16], bits: CARDINAL] RETURNS [rope: ROPE] =
BEGIN
digits: CARDINAL ← (bits + base - 1)/base;
rope ← IF base = 16 THEN "H" ELSE IF base = 2 THEN "B" ELSE ERROR;
FOR i: CARDINAL IN [1 .. digits] DO
vRem, mRem: CARDINAL;
[v, vRem] ← DivMod[v, base];
[m, mRem] ← DivMod[m, base];
IF mRem = 0 THEN rope ← encode[vRem].Concat[rope]
ELSE IF mRem+1 = base THEN rope ← Rope.Concat["X", rope]
ELSE ERROR CantEncode[];
ENDLOOP;
END;
TestInt: NodeTestProc--PROC [where: WordPtr, testData: NodeTestData, nodeType: NodeType] RETURNS [passes: BOOLEAN]-- = TRUSTED
BEGIN
ant: ArrayNodeType ← NARROW[nodeType];
bits: CARDINAL ← ant.last - ant.first + 1;
mv: MaskedValue ← NARROW[testData];
other: CARDINAL ← verboten[bits MOD 16];
wordCount: CARDINAL ← (bits+15)/16;
wmo: CARDINAL ← wordCount - 1;
IF wordCount < 1 THEN ERROR;
IF wordCount # mv.v.length THEN RETURN [FALSE];
IF wordCount # mv.m.length THEN RETURN [FALSE];
FOR i: CARDINAL IN [0..wordCount) DO
diff: CARDINAL ← Basics.BITXOR[mv.v[i], (where+i)^];
diff ← Basics.BITAND[diff, Basics.BITNOT[Basics.BITOR[other, mv.m[i]]]];
IF diff # 0 THEN RETURN [FALSE];
other ← 0;
ENDLOOP;
passes ← TRUE;
END;
baseKeys: ARRAY [2 .. 16] OF ROPE = ["B", "R3", "R4", "R5", "R6", "R7", "O", "R9", "D", "R11", "R12", "R13", "R14", "R15", "H"];
bitsPerBaseTimes10: ARRAY [2 .. 16] OF CARDINAL = [10, 15, 20, 23, 25, 28, 30, 31, 32, 34, 35, 37, 38, 39, 40];
decode: ARRAY CHARACTER OF [0..16] ← ALL[16];
encode: ARRAY [0..16) OF ROPE = ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"];
verboten: ARRAY [0..16) OF CARDINAL ← [65535-65535, 65535-1, 65535-3, 65535-7, 65535-15, 65535-31, 65535-63, 65535-127, 65535-255, 65535-511, 65535-1023, 65535-2047, 65535-4095, 65535-8191, 65535-16383, 65535-32767];
ValueToWP: PROC [v: Value, wp: WordPtr, words: CARDINAL] = TRUSTED
BEGIN
IF words < 1 THEN ERROR;
FOR i: CARDINAL IN [0..words) DO (wp+i)^ ← v[i] ENDLOOP;
END;
ValueFromWP: PROC [wp: WordPtr, words: CARDINAL] RETURNS [v: Value] = TRUSTED
BEGIN
IF words < 1 THEN ERROR;
v ← NEW [ValueRec[words]];
FOR i: CARDINAL IN [0..words) DO v[i] ← (wp+i)^ ENDLOOP;
END;
Value: TYPE = REF ValueRec;
ValueRec: TYPE = RECORD [chunks: SEQUENCE length: CARDINAL OF CARDINAL];
increasing index <=> decreasing significance
Multiply: PROC [v: Value, f: CARDINAL] RETURNS [p: Value] =
BEGIN
prod: LONG CARDINAL ← 0;
p ← NEW [ValueRec[v.length + 1]];
FOR i: CARDINAL DECREASING IN [0..p.length) DO
IF i > 0 THEN prod ← prod + LONG[v[i-1]] * f;
p[i] ← prod MOD 65536;
prod ← prod / 65536;
ENDLOOP;
p ← Truncate[p, Significance[p]];
END;
DivMod: PROC [v: Value, d: CARDINAL] RETURNS [q: Value, rem: CARDINAL] =
BEGIN
r: LONG CARDINAL ← 0;
q ← NEW[ValueRec[v.length]];
FOR i: CARDINAL IN [0..v.length) DO
prod: LONG CARDINAL ← d;
r ← r * 65536 + v[i];
q[i] ← r/d;
r ← r - prod * q[i];
ENDLOOP;
rem ← r;
q ← Truncate[q, Significance[q]];
END;
Add: PROC [v: Value, s: CARDINAL] RETURNS [w: Value] =
BEGIN
carry: LONG CARDINAL ← s;
w ← NEW[ValueRec[v.length + 1]];
FOR i: CARDINAL DECREASING IN [0..w.length) DO
IF i > 0 THEN carry ← carry + v[i-1];
w[i] ← carry MOD 65536;
carry ← carry / 65536;
ENDLOOP;
w ← Truncate[w, Significance[w]];
END;
Significance: PROC [v: Value] RETURNS [s: CARDINAL] =
BEGIN
FOR s IN [0..v.length) DO
IF v[s] # 0 THEN RETURN [v.length - s];
ENDLOOP;
s ← 0;
END;
Truncate: PROC [v: Value, len: CARDINAL] RETURNS [w: Value] =
BEGIN
w ← NEW [ValueRec[len]];
FOR i: CARDINAL IN (0..len] DO
w[len - i] ← IF i <= v.length THEN v[v.length - i] ELSE 0;
ENDLOOP;
END;
lowMask: ARRAY [1..16] OF CARDINAL;
IntNot: PUBLIC PROC [bitWidth: [1..16], bits: CARDINAL] RETURNS [inverted: CARDINAL] =
BEGIN
inverted ← Basics.BITAND[Basics.BITNOT[bits], lowMask[bitWidth]];
END;
AddFormat: PROC [key: ROPE, base: CARDINAL] =
BEGIN
atom: ATOM ← Atom.MakeAtom[key];
Atom.PutProp[atom: atom, prop: numFmtKey, val: NEW [FormatRep ← [
FormatValue: NumFormatValue,
ParseValue: NumParseValue,
FormatTest: NumFormatTest,
ParseTest: NumParseTest,
MaxWidth: NumMaxWidth,
formatData: NEW [CARDINAL ← base],
key: key]]];
END;
Setup: PROC =
BEGIN
n: CARDINAL ← 0;
FOR i: CARDINAL IN [1 .. 16] DO
lowMask[i] ← n ← n + n + 1;
ENDLOOP;
FOR c: CARDINAL IN [0..9] DO
decode['0 + c] ← c;
ENDLOOP;
FOR c: CARDINAL IN [0..5] DO
decode['A + c] ← 10 + c;
decode['a + c] ← 10 + c;
ENDLOOP;
AddFormat["2", 2];
AddFormat["8", 8];
AddFormat["10", 10];
AddFormat["16", 16];
AddFormat["", 16];
SignalTypeRegistration.RegisterNodeTypeConstructor["INT", ConstructNumType];
SignalTypeRegistration.RegisterNodeTypeConstructor["BOOL", ConstructBitType];
SignalTypeRegistration.SetDefaultNodeType["BOOL"];
END;
Setup[];
END.