NumTypesImpl.Mesa, from [Indigo]<Rosemary>2.3>Rosemary2.DF
Last Edited by: Spreitzer, April 18, 1984 11:03:05 am PST
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 = REF INT;
one: Int ← NEW [INT ← 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]
RETURNS [t: Cell] =
{t ← SwitchNumConvert.MakeTransducer[switchy: otherKind, nummy: myKind, within: within, writeSwitchy: writeOther, writeNummy: writeMine]};
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^];
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 ROPE ← NEW [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]
RETURNS [cell: Cell] =
BEGIN
Add:
PROC [old, sep, nu1, nu2, nu3:
ROPE ←
NIL]
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:
ROPE ←
IO.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];
classNames[side] ← Add[classNames[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, classNames: ARRAY Side OF ROPE ← ALL[NIL];
wordOffset, bitOffset, portCount: ARRAY Side OF INTEGER ← ALL[0];
nextWordOffset: INTEGER ← 1;
write: ARRAY Side OF BOOLEAN = [writeA, writeB];
portList: LIST OF Port;
aList, bList: StretchList;
aLength, bLength: INTEGER;
exhausted: BOOLEAN ← FALSE;
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: INTEGER ← MIN[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 ← RoseCreate.CreateCell[
within: within,
instanceName:
IO.PutFR[
"[%g]-[%g]",
IO.rope[instanceNames[A]],
IO.rope[instanceNames[B]]],
className: EnsureSplitJoin[
portList,
portCount[A]+portCount[B],
IO.PutFR["NumSplitter[%g]%g-%g[%g]",
IO.rope[classNames[A]],
IO.rope[IF writeA THEN "<" ELSE ""],
IO.rope[IF writeB THEN ">" ELSE ""],
IO.rope[classNames[B]]]].name,
interfaceNodes: connections,
initData: sjd];
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 CellClass ← NIL;
EnsureSplitJoin:
PROC [portList:
LIST
OF Port, portCount:
CARDINAL, className:
ROPE]
RETURNS [class: CellClass] =
BEGIN
ports: Ports;
pl: LIST OF Port;
FOR cl:
LIST
OF CellClass ← splitters, cl.rest
WHILE cl #
NIL
DO
i: CARDINAL;
class ← cl.first;
IF class.ports.length # portCount THEN LOOP;
pl ← portList;
FOR i
IN [0 .. portCount)
DO
IF pl.first # class.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;
class ← RoseCreate.RegisterCellClass[className: className, ioCreator: CreateSplitterIO, initializer: InitializeSplitter, evals: [EvalSimple: EvalSplitter], ports: ports];
splitters ← CONS[class, 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: IOCreator
--PROC [cell: Cell, initData: REF ANY]-- =
BEGIN
sjd: SplitJoinData ← NARROW[initData];
cell.realCellStuff.newIO ← NEW [WordsRep[sjd.words]];
cell.realCellStuff.oldIO ← NEW [WordsRep[sjd.words]];
END;
InitializeSplitter: Initializer--PROCEDURE [cell: Cell, initData: REF ANY, leafily: BOOLEAN]-- = {cell.realCellStuff.state ← initData};
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: CARDINAL ← NARROW[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 CARDINAL ← NARROW[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: CARDINAL ← NARROW[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.