NumTypesImpl.Mesa, from [Indigo]<Rosemary>®>Rosemary.DF
Last Edited by: Spreitzer, December 12, 1985 12:45:33 pm PST
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"]];
hexBoolFormat: Format ←
NEW [FormatRep ← [
FormatValue: BoolFormatHexValue,
key: "16"]];
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 IF f.Equal["16"] THEN hexBoolFormat
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"};
BoolFormatHexValue:
PROC [node: Node, fmt: Format, p: Ptr]
RETURNS [r:
ROPE] =
{r ← IF GetBit[p] THEN "1H" ELSE "0H"};
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};
'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: 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];
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.