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: ATOM _ IF 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 ROPE _ NEW [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: CARDINAL _ NARROW[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 CARDINAL _ NARROW[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};
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: BOOL _ TRUE;
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: CARDINAL _ NARROW[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];

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.
ΨNumTypesImpl.Mesa, from [Indigo]<Rosemary>r>Rosemary.DF
Last Edited by: Spreitzer, May 1, 1985 8:36:39 pm PDT
'a, 'A, 'c, 'C, 'e, 'E, 'f, 'F => {base _ 16; dl _ 0};
increasing index <=> decreasing significance
ΚΧ˜Jšœ*Οm
œ™7J™5Icode˜KšΟk	œŽ
˜—
K˜šΠbxœžœ
ž˜Kšžœx˜Kšžœ˜—K˜Kšžœ
žœ#˜-K˜šœžœ˜,Kš
œ%˜%K˜Kš
œ˜Kš
œ˜Kš
œ#˜#Kš
œ˜K˜Kš
œ+˜+K˜Kš
œ'˜'Kš
œ%˜%Kš
œ˜—K˜šœ
žœžœ˜6K˜Kšœ
žœ
˜Kšœžœ
˜
K˜ —K˜šœžœ˜-Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜šœžœ˜+Kš
œ˜Kš
œ˜—K˜Kšœžœ˜#K˜Kšœžœ>˜LK˜šΟnœžœ	žœ
žœ
Οcœžœ‘*œ˜Œ
Kš
œ˜—K˜Kš œžœžœžœ˜FKš œžœžœžœ˜MKš 
œžœžœžœžœžœžœ˜‰
š œžœžœ˜4Kšœ*žœ˜=—š œžœžœžœ˜Išœžœžœ
ž˜K˜Kšœžœ
˜Kšžœžœ˜——š œžœžœ˜Išœžœžœ
ž˜K˜Kšœžœ
˜Kšžœžœ˜——Kš
 œžœžœžœžœ˜WKš œžœžœ˜Nš œžœžœžœ˜DKšžœžœ
žœ
˜Kšœžœ˜-—š œžœžœ
˜:Kšœ
žœ˜—K˜š œžœ#žœžœ˜KKšœžœžœžœ
˜,—K˜š
 œžœ
žœžœžœ˜3Kšœžœ5˜F—K˜š œžœ
žœžœ˜*Kšœžœ(˜8šœžœ
˜Kšœžœžœ
˜.Kšžœžœžœ˜K˜——K˜š
 œžœ&žœžœžœ˜dKšœžœ
˜Kšœžœ˜&Kšœ
žœ
˜šžœž˜Kšœžœ
˜%Kšœžœ
˜Kšžœžœ
˜—Kšžœ
žœ	žœ
žœ
˜K˜
Kš
œ˜—K˜š
 œžœ&žœžœžœ˜`Kšœžœ
˜Kšœ
žœ
˜Kš	œžœžœžœžœ˜HKšžœ
žœ	žœ
žœ
˜K˜
Kš
œ˜—K˜š œžœ*žœžœ˜QKš
ž˜Kšœžœžœ%žœ	˜KKšžœ
˜—K˜š
 
œžœ žœžœžœ˜dKš
ž˜Kšœžœ
˜Kšœ
žœ
˜Kš	œžœžœžœžœ˜HKšžœ
žœ	žœ
žœ
˜Kšœžœžœžœ	˜,Kšžœ
˜—K˜š œžœžœ
žœžœ
žœ
‘œ˜nKš
ž˜Kš	œžœžœžœžœ˜3K˜Kšžœ
˜—K˜š œžœ0žœžœ˜QKšœ
žœ&˜-—K˜š
 œžœžœžœžœ˜=Kšžœ
žœ
žœ
˜šžœž˜K˜K˜K˜"Kšžœžœ˜——K˜š
 œžœžœžœžœ˜>Kšžœ
žœ
žœ
˜šžœž˜K˜K˜K˜"Kšžœžœ˜——K˜Kšœžœžœ
žœ˜+K˜Kšœžœ
˜K˜š
 œžœ
žœžœžœ˜>Kš
ž˜šžœ&žœžœ
ž˜:Kšžœžœ
žœ˜1Kšžœ
˜—Kšœžœ(˜7Kšžœ
˜—K˜š œžœžœžœ˜DKš
ž˜šœžœ˜ K˜Kšœ
žœ
˜Kšœžœ
˜
Kšœžœ˜/—Kšžœ
˜—K˜šœžœ˜+Kš
œ$˜$K˜Kš
œ˜Kš
œ˜Kš
œ"˜"Kš
œ˜Kš
œ˜Kš
œ*˜*Kš
œ˜Kš
œ&˜&Kš
œ%˜%Kš
œ˜—K˜š œžœ	žœ
žœ
‘œžœ‘*œ˜‹
Kš
ž˜KšœžœM˜_K˜Kšžœ
˜—K˜š œžœžœžœ˜>Kšœžœ˜ Kšœžœžœ˜.—K˜š œžœžœ˜9Kšœžœ˜ š
œ˜Kšœžœžœ˜;Kšœ	žœ˜——K˜š œžœžœžœ˜Hšžœžœ
ž˜K˜K˜Kšœ
žœžœžœ˜1Kšžœžœ
˜—K˜—K˜š 
œžœžœ˜Gšœžœžœ
ž˜K˜K˜K˜Kšžœžœ
˜—Kš
œ˜—K˜š œžœžœžœ˜HKšœžœ˜ Kš
œ˜šœžœž˜Kš
œ˜Kš
œ ˜ Kšžœžœ
˜—Kš
œ˜—K˜š œžœžœ˜@Kšœžœ˜ Kšœžœ˜šœžœž˜Kšœžœžœ˜7K˜Kšœžœ$žœ˜JKšžœžœ˜——K˜š 
œžœžœžœ˜CKšœžœ˜$Kšžœžœ
žœ
˜'Kšœžœžœ˜>K˜—K˜š œžœžœ˜DKšœžœ˜ K˜%K˜—K˜š œžœžœ˜9Kšœžœ˜!—K˜š œžœžœžœ˜FKšœžœ˜ Kšœžœ,˜8K˜—K˜Kš	œžœ
žœžœžœ˜8K˜š
 œžœ
žœžœžœ˜Bšžœžœ
ž˜K˜5K˜.Kšžœžœ˜——K˜Kšœžœžœ
žœ
žœ
žœ
žœ
žœ
žœ
žœ
˜>K˜Kšœžœ˜"K˜š
 œžœ&žœžœžœ˜cKšœžœ˜'Kšœžœ˜&Kšœžœ
˜Kšœ
žœ
˜šžœž˜Kšœžœ
˜%Kšœžœ
˜Kšžœžœ
˜—Kšžœ
žœ	žœ
žœ
˜šžœ˜	Kšœžœ	˜Kšœžœ	˜šžœžœ
žœž˜"K˜Kšžœ
˜—K˜—K˜—K˜š œžœ#žœžœ˜OKšœžœ˜'Kšœžœ˜Kš	œžœžœžœ
žœ˜7Kšœžœ˜9Kšœžœ=˜MKš
œ!˜!K˜šžœžœ
žœž˜#Kšœžœ
˜Kš
œ˜K˜ Kšžœ
˜—Kš
œ˜—K˜š
 
œžœ&žœžœžœ˜_Kšœžœ˜'Kšœžœ˜Kšœžœ˜)Kšœžœžœ˜-Kšœžœ
žœžœ˜*Kšœžœ
˜Kšœ
žœ˜Kšœžœ˜Kšžœžœ
žœžœ
˜(šžœ
ž˜
šžœž˜)K˜K˜K˜K˜K™6Kšžœ˜ —šžœžœ
žœž˜*Kšœž	œ˜Kšžœžœ
˜šžœ
ž˜
K˜Kšžœ
žœ
žœžœ˜ Kš
œ˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—Kšžœžœ
žœžœ˜,Kšžœžœ
žœžœ˜$Kšžœžœ
žœžœ˜1Kš
œ˜Kšœ
žœ
˜Kš
œ˜—K˜Kšœ
žœžœ˜'Kšœžœžœ#žœ˜FK˜š 
œžœ*žœžœ˜SKš
ž˜Kšœžœ˜ Kšœžœ˜Kšœžœ	˜!Kšžœžœ
žœ˜Kšžœ\žœ˜kKš
œ˜Kšžœ
˜—K˜š
 œžœ žœžœžœ˜cKš
ž˜Kšœžœ˜ Kšœžœ˜Kšœžœ˜)Kšœ	žœžœ˜)Kšœžœ
˜Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kšœžœžœ˜-Kšœžœžœ
˜Kšœ
žœ
˜Kš
œ˜Kšžœžœ
˜"Kšžœžœ
ž˜ šžœ
ž˜
šžœž˜)K˜K˜K˜K˜K˜#K˜6Kšžœ˜—šžœžœ
žœž˜*Kšœž	œ˜K˜K˜šžœžœž˜Kš
ž˜K˜Kšœžœ
˜Kš
ž˜—šžœ
ž˜
K˜Kšžœ
žœ
žœ
˜Kš
œ˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—Kšžœžœ
žœ
˜)Kšžœžœ
žœ
˜)Kšžœžœ
žœ
˜Kš
œ˜K˜šžœžœ˜)Kš
œ˜Kš
œ˜Kš
œ ˜ Kš
œ˜—Kšœ
žœ
˜Kšžœ
˜—K˜š œžœ0žœžœ˜PKš
ž˜Kšœžœ˜ Kš	œžœžœžœ
žœ˜7Kšœžœ˜9KšœžœE˜UKšžœL˜RKšžœ
˜—K˜Kšœžœžœ
˜K˜š
 œžœ$žœžœžœ˜RKš
ž˜Kšœžœ˜*Kšœžœžœžœ
žœ
žœžœ
žœ
˜Bšžœžœ
žœž˜#Kšœžœ
˜Kš
œ˜Kš
œ˜Kšžœ
žœ!˜1Kšžœ
žœžœ˜8Kšžœ
žœ˜Kšžœ
˜—Kšžœ
˜—K˜š œžœžœ
žœžœ
žœ
‘œž˜uKš
ž˜Kšœžœ˜&Kšœžœ˜Kšœžœ˜#šžœžœ˜K˜"K˜
—šžœ˜K˜%Kšœžœžœ˜(Kšœžœ˜'Kšžœžœ
žœ
˜Kšžœžœ
žœžœ˜/Kšžœžœ
žœžœ˜/Kšžœžœ
žœžœ˜,šžœžœ
žœž˜$Kšœžœ
žœ˜.Kšœžœžœžœ˜HKšžœ
žœ
žœžœ˜ K˜
Kšžœ
˜—Kšœ	žœ
˜K˜—Kšžœ
˜—K˜Kšœ
žœžœ
žœ_˜€
K˜Kšœžœžœ
žœ@˜oK˜Kš	œžœ
ž	œ
žœžœ˜-K˜Kšœžœ	žœ
žœT˜qK˜šœ
žœ	žœ
žœ˜'Kš
Οf˜Kš
’˜Kš
’˜Kš’œ˜ —K˜š 
œžœžœž˜=Kš
ž˜Kšœžœ˜+Kšœ
žœžœ˜:Kšœžœ˜"Kšœ
žœ˜(K˜Kšžœžœ
žœ
˜Kšžœžœ%˜9Kšžœžœ
žœ
˜*K˜šžœžœ
žœž˜ Kšœžœ
˜Kšžœ
žœžœ˜9Kšœžœ˜šœžœ
˜Kšœžœ˜Kšœžœ˜K˜—Kšœžœ
žœ˜Kšžœ
˜—Kšžœ
˜—K˜š	 œžœžœžœž˜HKš
ž˜Kšœžœ˜+Kšœ
žœžœ˜:Kšœžœ˜"K˜Kšžœžœ
žœ
˜Kšœžœ˜Kšœžœ˜ Kš
žœžœ
žœžœžœ
˜8Kšžœžœ'˜;Kšžœ
˜—K˜Kšœžœžœ
˜š
œ
žœžœ
žœ	žœ
žœ
žœ˜HJ™,—K˜š œžœžœžœ
˜;Kš
ž˜Kšœžœ
žœ˜Kšœžœ˜!š	žœžœ
ž
œ
žœž˜.Kšžœžœžœ
˜-Kšœžœ˜K˜Kšžœ
˜—Kš
œ%˜%Kšžœ
˜—K˜š
 œžœžœžœžœ˜HKš
ž˜Kšœžœ
žœ˜Kšœžœ˜šžœžœ
žœž˜#Kšœžœ
žœ˜Kš
œ˜K˜Kš
œ˜Kšžœ
˜—K˜Kš
œ%˜%Kšžœ
˜—K˜š œžœžœžœ
˜6Kš
ž˜Kšœžœ
žœ˜Kšœžœ˜ š	žœžœ
ž
œ
žœž˜.Kšžœžœ˜%Kšœ
žœ˜K˜Kšžœ
˜—Kš
œ%˜%Kšžœ
˜—K˜š œžœžœžœ˜:Kš
ž˜šžœžœž˜Kšžœžœ
žœ˜)Kšžœ
˜—K˜Kšžœ
˜—K˜š œžœžœžœ˜9Kš
ž˜šžœžœ
žœž˜šžœ
žœ˜š	žœžœ
ž
œ
žœž˜5Kšžœžœ
žœ˜@Kšžœ
˜—Kšžœ˜K˜—Kšžœ
˜—Kš
œ˜Kšžœ
˜—K˜š œžœžœžœ
˜=Kš
ž˜Kšœžœ˜šžœžœ
žœ
ž˜Kšœ
žœžœžœ˜:Kšžœ
˜—Kšžœ
˜—K˜š 	œžœžœžœ˜-Kš
ž˜Kšœžœ˜ šœ/žœ˜AKš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœžœ	˜"Kš
œ˜—Kšžœ
˜—K˜Kšœžœ
˜.K˜šœžœ˜*Kš
œ˜K˜—K˜š œžœ˜
Kš
ž˜šžœžœ
žœž˜K˜Kšžœ
˜—šžœžœ
žœž˜K˜K˜Kšžœ
˜—K˜K˜K˜K˜K˜Kš
œ?˜?Kš
œL˜LKš
œN˜NKš
œ2˜2Kšžœ
˜—K˜K˜K˜Kšžœ
˜—…—G2aα