<2.6>Rosemary.DF>> <> 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 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, for: ExpansionReceiver] 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]; 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 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 _ 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 [ct: CellType] RETURNS [ioAsAny: REF ANY] --IOCreator-- = BEGIN sjd: SplitJoinData _ NARROW[ct.typeData]; ioAsAny _ 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: 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]; < 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.