NumTypesImpl.Mesa, from [Indigo]<Rosemary>®>Rosemary.DF
Last Edited by: Spreitzer, May 1, 1985 8:36:39 pm PDT
DIRECTORY Atom, Basics, BitTwiddling, IO, NumTypes, Rope, RoseTranslateTypes, RoseTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypes, VFonts;
NumTypesImpl: CEDAR PROGRAM
IMPORTS Atom, Basics, BitTwiddling, IO, Rope, RoseTranslateTypes, SignalTypeRegistration, SwitchNumConvert, SwitchTypes, VFonts
EXPORTS NumTypes =
BEGIN OPEN BitTwiddling, RoseTypes, NumTypes;
boolProcs: NodeProcs ← NEW [NodeProcsRep ← [
UserDescription: BoolUserDescription,
ListFormats: BoolListFormats,
GetFormat: BoolGetFormat,
MesaForSelf: BoolMesaForSelf,
SelectorOffset: BoolSelectorOffset,
SubType: BoolSubType,
Bits: BoolBits,
MesaRepresentation: BoolMesaRepresentation,
Equivalent: BoolEquivalent,
SwitchEquivalent: BoolSwitchEquivalent,
Transduce: SwitchNumConvert.Transduce
]];
boolType: PUBLIC NodeType ← NEW [NodeTypeRep[atom] ← [
procs: boolProcs,
typeData: NIL,
simple: TRUE,
structure: atom[$DigitalWire]]];
normalBoolFormat: Format ← NEW [FormatRep ← [
FormatValue: BoolFormatValue,
ParseValue: BoolParseValue,
FormatTest: BoolFormatTest,
ParseTest: BoolParseTest,
MaxWidth: BoolMaxWidth,
key: "bool"]];
initBoolFormat: Format ← NEW [FormatRep ← [
ParseValue: BoolParseInitValue,
key: "init"]];
Int: TYPE = RoseTranslateTypes.Int;
one: Int ← NEW [RoseTranslateTypes.IntRep ← [RoseTranslateTypes.nullSR, 1]];
ConstructBoolType: PROC [parms: REF ANY --UNION [BindingList, Args]--] RETURNS [type: NodeType] --RoseTranslateTypes.NodeTypeConstructor-- =
{type ← boolType};
BoolUserDescription: PROC [NodeType] RETURNS [r: ROPE] = {r ← "BOOL"};
BoolListFormats: PROC [NodeType] RETURNS [l: RopeList] = {l ← LIST ["bool"]};
BoolGetFormat: PROC [nt: NodeType, f: ROPE] RETURNS [fmt: Format] = {fmt ← IF f.Equal["init"] THEN initBoolFormat ELSE normalBoolFormat};
BoolMesaForSelf: PROC [NodeType] RETURNS [m: Mesa] =
{m ← [mesa: "NumTypes.boolType", imports: LIST["NumTypes"]]};
BoolSelectorOffset: PROC [nt: NodeType, s: Selector] RETURNS [o: NAT] = {
o ← WITH s SELECT FROM
whole => 0,
number, range => ERROR,
ENDCASE => ERROR};
BoolSubType: PROC [nt: NodeType, s: Selector] RETURNS [snt: NodeType] = {
snt ← WITH s SELECT FROM
whole => nt,
number, range => ERROR,
ENDCASE => ERROR};
BoolBits: PROC [NodeType] RETURNS [container, data, leftPad: INT] = {RETURN [1, 1, 0]};
BoolMesaRepresentation: PROC [NodeType] RETURNS [m: Mesa] = {m ← ["BOOLEAN"]};
BoolEquivalent: PROC [self, other: NodeType] RETURNS [eqv: BOOL] = {
IF self # boolType THEN ERROR;
eqv ← other = boolType OR other = oneBitInt};
BoolSwitchEquivalent: PROC [NodeType] RETURNS [NodeType] =
{RETURN [SwitchTypes.bitType]};
BoolFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [r: ROPE] =
{r ← IF GetBit[p] THEN "TRUE" ELSE "FALSE"};
GetBit: PROC [p: Ptr] RETURNS [b: BOOL] = TRUSTED {
b ← Basics.BITAND[p.word^, TwoToThe[Basics.bitsPerWord-1-p.bit]] # 0};
SetBit: PROC [p: Ptr, b: BOOL] = TRUSTED {
theBit: CARDINAL ← TwoToThe[Basics.bitsPerWord-1-p.bit];
p.word^ ← Basics.BITOR[
Basics.BITAND[p.word^, Basics.BITNOT[theBit]],
IF b THEN theBit ELSE 0
]};
BoolParseInitValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = {
b: BOOLEAN;
atom: ATOM ← Atom.MakeAtom[s.GetID[]];
success ← TRUE;
SELECT atom FROM
$initial, $steady, $gnd => b ← FALSE;
$vdd => b ← TRUE;
ENDCASE => success ← FALSE;
IF NOT success THEN RETURN;
SetBit[p, b];
};
BoolParseValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = {
b: BOOLEAN;
success ← TRUE;
b ← s.GetBool[!IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
SetBit[p, b];
};
BoolFormatTest: PROC [nt: NodeType, fmt: Format, t: NodeTest] RETURNS [r: ROPE] =
BEGIN
r ← SELECT t.data FROM $True => "TRUE", $False => "FALSE", ENDCASE => "??";
END;
BoolParseTest: PROC [nt: NodeType, fmt: Format, s: STREAM] RETURNS [success: BOOLEAN, t: NodeTest] =
BEGIN
b: BOOLEAN;
success ← TRUE;
b ← s.GetBool[!IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN RETURN;
t ← [BoolTest, IF b THEN $True ELSE $False];
END;
BoolTest: PROC [where: Ptr, testData: REF ANY, nodeType: NodeType] RETURNS [passes: BOOLEAN]--NodeTestProc-- =
BEGIN
it: ATOMIF GetBit[where] 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};
NodeTypeList: TYPE = LIST OF ArrayNodeType;
numTypes: NodeTypeList ← NIL;
NumType: PUBLIC PROC [bits: CARDINAL] RETURNS [nt: NodeType] =
BEGIN
FOR it: NodeTypeList ← numTypes, it.rest WHILE it # NIL DO
IF it.first.length = bits THEN RETURN [it.first];
ENDLOOP;
numTypes ← CONS[nt ← MakeNumOfIndices[bits], numTypes];
END;
MakeNumOfIndices: PROC [bitCount: NAT] RETURNS [nt: ArrayNodeType] =
BEGIN
nt ← NEW [NodeTypeRep[array] ← [
procs: numProcs,
typeData: NIL,
simple: TRUE,
structure: array[bitCount, NARROW[boolType]]]];
END;
numProcs: NodeProcs ← NEW [NodeProcsRep ← [
UserDescription: NumUserDescription,
ListFormats: NumListFormats,
GetFormat: NumGetFormat,
MesaForSelf: NumMesaForSelf,
SelectorOffset: NumSelectorOffset,
SubType: NumSubType,
Bits: NumBits,
MesaRepresentation: NumMesaRepresentation,
Equivalent: NumEquivalent,
SwitchEquivalent: NumSwitchEquivalent,
Transduce: SwitchNumConvert.Transduce
]];
ConstructNumType: PROC [parms: REF ANY --UNION [BindingList, Args]--] RETURNS [type: NodeType] --RoseTranslateTypes.NodeTypeConstructor-- =
BEGIN
bits: Int ← NARROW[RoseTranslateTypes.GetParm[n: 1, name: "bits", parms: parms, default: one]];
type ← NumType[bits.i];
END;
NumUserDescription: PROC [nt: NodeType] RETURNS [ud: ROPE] = {
ant: ArrayNodeType ← NARROW[nt];
ud ← IO.PutFR["INT[%g]", IO.int[ant.length]]};
NumMesaForSelf: PROC [nt: NodeType] RETURNS [m: Mesa] = {
ant: ArrayNodeType ← NARROW[nt];
m ← [
mesa: IO.PutFR["NumTypes.NumType[%g]", IO.int[ant.length]],
imports: LIST["NumTypes"]]};
NumSelectorOffset: PROC [nt: NodeType, s: Selector] RETURNS [o: NAT] = {
WITH s SELECT FROM
whole => o ← 0;
number => o ← index;
range => o ← IF up THEN first ELSE first+1-count;
ENDCASE => ERROR;
};
NumSubType: PROC [nt: NodeType, s: Selector] RETURNS [st: NodeType] = {
st ← WITH s SELECT FROM
whole => nt,
number => boolType,
range => NumType[count],
ENDCASE => ERROR;
};
NumBits: PROC [nt: NodeType] RETURNS [container, data, leftPad: INT] = {
ant: ArrayNodeType ← NARROW[nt];
data ← ant.length;
container ← SELECT data FROM
<= 16 => data,
> 16 => 16 * CeilDiv[data, 16],
ENDCASE => ERROR;
leftPad ← container - data};
NumMesaRepresentation: PROC [nt: NodeType] RETURNS [m: Mesa] = {
ant: ArrayNodeType ← NARROW[nt];
bits: INTEGER ← ant.length;
m ← [SELECT bits FROM
< 16 => IO.PutFR["[0..%g]", IO.card[TwoToThe[bits]-1]],
= 16 => "CARDINAL",
> 16 => IO.PutFR["ARRAY [0..%g) OF CARDINAL", IO.card[CeilDiv[bits, 16]]],
ENDCASE => ERROR]};
NumEquivalent: PROC [self, other: NodeType] RETURNS [eqv: BOOL] = {
selfa: ArrayNodeType ← NARROW[self];
IF selfa.element # boolType THEN ERROR;
eqv ← other = self OR (self = oneBitInt AND other = boolType);
};
NumSwitchEquivalent: PROC [nt: NodeType] RETURNS [snt: NodeType] = {
ant: ArrayNodeType ← NARROW[nt];
snt ← SwitchTypes.Bundle[ant.length];
};
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"];
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};
Bits: TYPE = LONG POINTER TO PACKED ARRAY CARDINAL OF BOOLEAN;
bpw: INTEGER = Basics.bitsPerWord;
NumParseInitValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = {
ant: ArrayNodeType ← NARROW[node.type];
atom: ATOM ← Atom.MakeAtom[s.GetID[]];
b: BOOL;
success ← TRUE;
SELECT atom FROM
$initial, $steady, $gnd => b ← FALSE;
$vdd => b ← TRUE;
ENDCASE => success ← FALSE;
IF NOT success THEN RETURN;
TRUSTED {
bp: Bits ← LOOPHOLE[p.word];
o: CARDINAL ← p.bit;
FOR i: NAT IN [0 .. ant.length) DO
bp[o+i] ← b;
ENDLOOP;
};
};
NumFormatValue: PROC [node: Node, fmt: Format, p: Ptr] RETURNS [rope: ROPE] = {
ant: ArrayNodeType ← NARROW[node.type];
bits: CARDINAL ← ant.length;
base: CARDINALNARROW[fmt.formatData, REF CARDINAL]^;
bitsPerDigitTimes10: CARDINAL ← bitsPerBaseTimes10[base];
digits: CARDINAL ← (bits*10 + bitsPerDigitTimes10 - 1) / bitsPerDigitTimes10;
v: Value ← ValueFromPtr[p, bits];
rope ← baseKeys[base];
FOR i: CARDINAL IN [1 .. digits] DO
rem: CARDINAL;
[v, rem] ← DivMod[v, base];
rope ← encode[rem].Concat[rope];
ENDLOOP;
};
NumParseValue: PROC [node: Node, fmt: Format, p: Ptr, s: STREAM] RETURNS [success: BOOLEAN] = {
ant: ArrayNodeType ← NARROW[node.type];
bits: CARDINAL ← ant.length;
wordWidth: CARDINAL ← (bits + bpw-1)/bpw;
rope: ROPE ← s.GetTokenRope[IO.IDProc].token;
fb: REF CARDINALNARROW[fmt.formatData];
base: 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];
IF BitSignificance[v] > bits THEN RETURN [FALSE];
ValueToPtr[v, p, bits];
success ← TRUE;
};
MaskedValue: TYPE = REF MaskedValueRep;
MaskedValueRep: TYPE = RECORD [m, v: Value, vp: Ptr, emptyMask: BOOL];
NumFormatTest: PROC [nt: NodeType, fmt: Format, t: NodeTest] RETURNS [rope: ROPE] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: CARDINAL ← ant.length;
mv: MaskedValue ← NARROW[t.data];
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, t: NodeTest] =
BEGIN
ant: ArrayNodeType ← NARROW[nt];
bits: CARDINAL ← ant.length;
wordWidth: CARDINAL ← (bits + bpw-1)/bpw;
leftPad: CARDINAL ← bpw - (bits MOD bpw);
base: CARDINAL;
dl, sign: INTEGER ← 1;
v: Value ← NEW [ValueRec[0]];
m: Value ← NEW [ValueRec[0]];
rope: ROPE ← s.GetTokenRope[IO.IDProc].token;
emptyMask: BOOLTRUE;
success ← FALSE;
t.proc ← TestInt;
IF leftPad = bpw THEN leftPad ← 0;
IF rope.Length[] < 1 THEN RETURN
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];
emptyMask ← FALSE;
END
ELSE BEGIN
d: [0..16] ← decode[c];
IF d > base THEN RETURN;
v ← Add[v, d];
END;
ENDLOOP;
END;
IF BitSignificance[v] > bits THEN RETURN;
IF BitSignificance[m] > bits THEN RETURN;
IF wordWidth < 1 THEN RETURN;
v ← Truncate[v, wordWidth];
m ← Truncate[m, wordWidth];
TRUSTED {t.data ← NEW [MaskedValueRep ← [
m: m,
v: v,
vp: [word: @v[0], bit: leftPad],
emptyMask: emptyMask]]};
success ← TRUE;
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.length)*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: PROC [where: Ptr, testData: REF ANY, nodeType: NodeType] RETURNS [passes: BOOLEAN]--NodeTestProc-- = TRUSTED
BEGIN
ant: ArrayNodeType ← NARROW[nodeType];
bits: CARDINAL ← ant.length;
mv: MaskedValue ← NARROW[testData];
IF mv.emptyMask THEN {
passes ← Equal[where, mv.vp, bits]
}
ELSE {
w: Value ← ValueFromPtr[where, bits];
other: CARDINAL ← verboten[bits MOD 16];
wordCount: CARDINAL ← (bits+bpw-1)/bpw;
IF wordCount < 1 THEN ERROR;
IF wordCount # mv.v.length THEN RETURN [FALSE];
IF wordCount # mv.m.length THEN RETURN [FALSE];
IF wordCount # w.length THEN RETURN [FALSE];
FOR i: CARDINAL IN [0..wordCount) DO
diff: CARDINAL ← Basics.BITXOR[mv.v[i], w[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 = [
00000H, 0FFFEH, 0FFFCH, 0FFF8H,
0FFF0H, 0FFE0H, 0FFC0H, 0FF80H,
0FF00H, 0FE00H, 0FC00H, 0F800H,
0F000H, 0E000H, 0C000H, 08000H];
ValueToPtr: PROC [v: Value, p: Ptr, bits: CARDINAL] = TRUSTED
BEGIN
words: CARDINAL ← (bits-1 + p.bit)/bpw + 1;
rightPad: CARDINAL ← (bpw-1) - ((bits-1 + p.bit) MOD bpw);
mask: CARDINAL ← zeroFirst[p.bit];
lastMask: CARDINAL ← zeroLast[rightPad];
wp: WordPtr ← p.word;
IF words < 1 THEN ERROR;
IF rightPad > 0 THEN v ← Multiply[v, TwoToThe[rightPad]];
IF WordSignificance[v] > words THEN ERROR;
v ← Truncate[v, words];
FOR i: CARDINAL IN [0..words) DO
keep: CARDINAL;
IF i+1 = words THEN mask ← Basics.BITAND[mask, lastMask];
keep ← Basics.BITNOT[mask];
(wp+i)^ ← Basics.BITOR[
Basics.BITAND[keep, (wp+i)^],
Basics.BITAND[mask, v[i]]
];
mask ← LAST[CARDINAL];
ENDLOOP;
END;
ValueFromPtr: PROC [p: Ptr, bits: CARDINAL] RETURNS [v: Value] = TRUSTED
BEGIN
words: CARDINAL ← (bits-1 + p.bit)/bpw + 1;
rightPad: CARDINAL ← (bpw-1) - ((bits-1 + p.bit) MOD bpw);
mask: CARDINAL ← zeroFirst[p.bit];
wp: WordPtr ← p.word;
IF words < 1 THEN ERROR;
v ← NEW [ValueRec[words]];
v[0] ← Basics.BITAND[mask, wp^];
FOR i: CARDINAL IN (0..words) DO v[i] ← (wp+i)^ ENDLOOP;
IF rightPad > 0 THEN [v, ] ← DivMod[v, TwoToThe[rightPad]];
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, WordSignificance[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, WordSignificance[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, WordSignificance[w]];
END;
WordSignificance: PROC [v: Value] RETURNS [ws: CARDINAL] =
BEGIN
FOR ws IN [0..v.length) DO
IF v[ws] # 0 THEN RETURN [v.length - ws];
ENDLOOP;
ws ← 0;
END;
BitSignificance: PROC [v: Value] RETURNS [bs: CARDINAL] =
BEGIN
FOR w: NAT IN [0..v.length) DO
IF v[w] # 0 THEN {
FOR b: NAT DECREASING IN (0 .. Basics.bitsPerWord] DO
IF v[w] >= TwoToThe[b-1] THEN RETURN [w*Basics.bitsPerWord + b];
ENDLOOP;
RETURN [w*Basics.bitsPerWord];
};
ENDLOOP;
bs ← 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;
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;
oneBitInt: ArrayNodeType ← NARROW[NumType[1]];
initNumFormat: Format ← NEW [FormatRep ← [
ParseValue: NumParseInitValue,
key: "init"]];
Setup: PROC =
BEGIN
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];
Atom.PutProp[atom: $init, prop: numFmtKey, val: initNumFormat];
SignalTypeRegistration.RegisterNodeTypeConstructor["INT", ConstructNumType];
SignalTypeRegistration.RegisterNodeTypeConstructor["BOOL", ConstructBoolType];
SignalTypeRegistration.SetDefaultNodeType["BOOL"];
END;
Setup[];
END.