PortsImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Barth, January 5, 1988 12:21:56 pm PST
Gasbarro, January 23, 1986 11:40:29 am PST
Bertrand Serlet, May 5, 1988 10:56:21 pm PDT
Louis Monier September 25, 1987 6:40:15 pm PDT
Don Curry November 24, 1987 11:52:59 am PST
Jean-Marc Frailong February 3, 1988 12:01:41 pm PST
DIRECTORY
Basics, BitOps, BrineIO, Convert,
Core, CoreCreate, CoreIO, CoreOps, CoreProperties,
RefTab, IO, RefText, Rope, Ports;
PortsImpl: CEDAR PROGRAM
IMPORTS Basics, BitOps, BrineIO, Convert, CoreIO, CoreOps, CoreProperties, RefTab, IO, RefText, Rope
EXPORTS Ports
= BEGIN OPEN Ports;
levelTypeNames: PUBLIC ARRAY LevelType OF Core.ROPE ← [
"l", "ls", "b", "bs", "c", "lc", "q", "composite"];
levelNames: PUBLIC ARRAY Level OF Core.ROPE ← ["L", "H", "X"];
driveTypeNames: PUBLIC ARRAY DriveType OF Core.ROPE ← ["agg", "sep"];
driveNames: PUBLIC ARRAY Drive OF Core.ROPE ← [
"inspect", "e", "n", "cw", "cmw", "c", "cms", "cs", "f", "dw", "dmw", "d", "dms", "ds", "i"];
portTesterDriveAtom: ATOM ← CoreIO.RegisterProperty[prop: CoreProperties.RegisterProperty[prop: $PortTesterDrive, properties: CoreProperties.Props[[CoreProperties.propPrint, NEW[CoreProperties.PropPrintProc ← PortDataPrint]]]], write: PortDataWrite, read: PortDataRead];
portDataAtom: ATOM ← CoreIO.RegisterProperty[prop: CoreProperties.RegisterProperty[prop: $PortData, properties: CoreProperties.Props[[CoreProperties.propPrint, NEW[CoreProperties.PropPrintProc ← PortDataPrint]]]], write: PortDataWrite, read: PortDataRead];
PortDataPrint: CoreProperties.PropPrintProc = {
portData: PortData ← NARROW[val];
CoreOps.PrintIndent[indent, to];
IO.PutF[to, "%g: ", IO.atom[prop]];
IF prop=portDataAtom THEN {
IO.PutRope[to, levelTypeNames[portData.levelType]];
IO.PutRope[to, " "];
};
IO.PutRope[to, driveTypeNames[portData.driveType]];
SELECT portData.driveType FROM
aggregate => {
IO.PutRope[to, " "];
IO.PutRope[to, driveNames[portData.drive]];
};
separate => IF portData.drives#NIL THEN FOR i: NAT IN [0..portData.drives.size) DO
IO.PutRope[to, " "];
IO.PutRope[to, driveNames[portData.drives[i]]];
ENDLOOP;
ENDCASE => ERROR;
};
PortDataWrite: CoreIO.PropWriteProc = {
portData: PortData ← NARROW [value];
BrineIO.WriteID[stream, levelTypeNames[portData.levelType]];
BrineIO.WriteID[stream, driveTypeNames[portData.driveType]];
BrineIO.WriteID[stream, driveNames[portData.drive]];
IF portData.drives=NIL THEN BrineIO.WriteInt[stream, 0]
ELSE {
BrineIO.WriteInt[stream, portData.drives.size];
FOR i: NAT IN [0..portData.drives.size) DO
BrineIO.WriteID[stream, driveNames[portData.drives[i]]];
ENDLOOP;
};
};
PortDataRead: CoreIO.PropReadProc = {
portData: PortData ← NEW[PortDataRec];
size: NAT;
portData.levelType ← FindLevelType[BrineIO.ReadID[stream]];
portData.driveType ← FindDriveType[BrineIO.ReadID[stream]];
portData.drive ← FindDrive[BrineIO.ReadID[stream]];
size ← BrineIO.ReadInt[stream];
IF size>0 THEN {
portData.drives ← NEW[DriveSequenceRec[size]];
FOR i: NAT IN [0..size) DO
portData.drives[i] ← FindDrive[BrineIO.ReadID[stream]];
ENDLOOP;
};
value ← portData;
};
Operations
FindLevelType: PUBLIC PROC [levelTypeID: Core.ROPE] RETURNS [levelType: LevelType] = {
FOR lev: LevelType IN LevelType DO
IF Rope.Equal[levelTypeNames[lev], levelTypeID] THEN {levelType ← lev; EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP;
};
FindLevel: PUBLIC PROC [levelID: Core.ROPE] RETURNS [level: Level] = {
FOR lev: Level IN Level DO
IF Rope.Equal[levelNames[lev], levelID] THEN {level ← lev; EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP;
};
FindDriveType: PUBLIC PROC [driveTypeID: Core.ROPE] RETURNS [driveType: DriveType] = {
FOR drv: DriveType IN DriveType DO
IF Rope.Equal[driveTypeNames[drv], driveTypeID] THEN {driveType ← drv; EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP;
};
FindDrive: PUBLIC PROC [driveID: Core.ROPE] RETURNS [drive: Drive] = {
FOR drv: Drive IN Drive DO
IF Rope.Equal[driveNames[drv], driveID] THEN {drive ← drv; EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP;
};
CreatePort: PUBLIC PROC [cellType: Core.CellType, testerPort: BOOL ← FALSE] RETURNS [port: Port] = {
wireTab: RefTab.Ref ← RefTab.Create[]; -- wire to port
portAssignment: RefTab.Ref ← RefTab.Create[]; -- wire to port
MakePort: PUBLIC PROC [wire: Core.Wire] RETURNS [port: Port] = {
IF (port ← NARROW[RefTab.Fetch[x: wireTab, key: wire].val])=NIL THEN {
data: PortData ← NARROW[CoreProperties.InheritPublicProp[cellType: cellType, from: wire, prop: portDataAtom]];
levelType: LevelType ← WirePortType[cellType, wire].levelType;
IF levelType=composite THEN {
port ← NEW[PortRec[wire.size]];
FOR sub: NAT IN [0..wire.size) DO
port[sub] ← MakePort[wire: wire[sub]];
ENDLOOP;
}
ELSE {
port ← NEW[PortRec[0]];
port.levelType ← levelType;
SELECT levelType FROM
ls => {
port.ls ← NEW[LevelSequenceRec[CoreOps.WireBits[wire]]];
FOR bit: NAT IN [0..port.ls.size) DO
port.ls[bit] ← L;
ENDLOOP;
};
bs => {
port.bs ← NEW[BoolSequenceRec[CoreOps.WireBits[wire]]];
FOR bit: NAT IN [0..port.bs.size) DO
port.bs[bit] ← FALSE;
ENDLOOP;
};
c => port.fieldStart ← 16 - CoreOps.WireBits[wire];
lc => port.fieldStart ← 32 - CoreOps.WireBits[wire];
q => port.fieldStart ← 64 - CoreOps.WireBits[wire];
ENDCASE;
IF testerPort THEN data ← NARROW[CoreProperties.InheritPublicProp[cellType: cellType, from: wire, prop: portTesterDriveAtom]];
IF data#NIL THEN SELECT data.driveType FROM
aggregate => port.d ← data.drive;
separate => {
port.driveType ← separate;
IF data.drives=NIL THEN {
port.ds ← NEW[DriveSequenceRec[CoreOps.WireBits[wire]]];
FOR i: NAT IN [0..port.ds.size) DO
port.ds[i] ← data.drive;
ENDLOOP;
}
ELSE port.ds ← CopyDrives[data.drives];
SELECT levelType FROM
ls => IF port.ds.size#port.ls.size THEN ERROR;
bs => IF port.ds.size#port.bs.size THEN ERROR;
c => IF port.ds.size#16 - port.fieldStart THEN ERROR;
lc => IF port.ds.size#32 - port.fieldStart THEN ERROR;
q => IF port.ds.size#64 - port.fieldStart THEN ERROR;
ENDCASE;
}
ENDCASE => ERROR;
AssignPort[wire, port];
};
IF NOT RefTab.Insert[x: wireTab, key: wire, val: port] THEN ERROR;
};
};
AssignPort: PROC [wire: Core.Wire, port: Port] = {
assigned: Port ← NARROW[RefTab.Fetch[x: portAssignment, key: wire].val];
IF assigned=NIL THEN {IF NOT RefTab.Insert[x: portAssignment, key: wire, val: port] THEN ERROR}
ELSE IF assigned#port THEN ERROR; -- multiple ports represent one wire
FOR i: CARDINAL IN [0..wire.size) DO
AssignPort[wire[i], port];
ENDLOOP;
};
FixupNewToOld[cellType]; -- sb nop for old style specification
port ← MakePort[cellType.public];
};
RenewPort: PUBLIC PROC [cellType: Core.CellType, port: Port, testerPort: BOOL ← FALSE] = {
ResetPort: EachWirePortPairProc = {
data: PortData ← NARROW[CoreProperties.InheritPublicProp[cellType: cellType, from: wire, prop: IF testerPort THEN portTesterDriveAtom ELSE portDataAtom]];
IF port=NIL THEN RETURN;
port.d ← none;
IF data#NIL THEN SELECT data.driveType FROM
aggregate => port.d ← data.drive;
separate => IF data.drives=NIL THEN
FOR i: NAT IN [0..port.ds.size) DO
port.ds[i] ← data.drive;
ENDLOOP
ELSE FOR i: NAT IN [0..port.ds.size) DO
port.ds[i] ← data.drives[i];
ENDLOOP;
ENDCASE => ERROR;
port.l ← L;
port.b ← FALSE;
IF port.ls#NIL THEN FOR i: NAT IN [0..port.ls.size) DO
port.ls[i] ← L;
ENDLOOP;
IF port.bs#NIL THEN FOR i: NAT IN [0..port.bs.size) DO
port.bs[i] ← FALSE;
ENDLOOP;
port.c ← BitOps.BitWordZero;
port.lc ← BitOps.BitDWordZero;
port.q ← BitOps.BitQWordZero
};
[] ← VisitBinding[cellType.public, port, ResetPort];
};
WirePortType: PUBLIC PROC [cellType: Core.CellType, wire: Core.Wire] RETURNS [levelType: LevelType, driveType: DriveType] = {
data: PortData ← NIL;
FixupNewToOld[cellType]; -- sb nop for old style specification
data ← NARROW[CoreProperties.InheritPublicProp[cellType: cellType, from: wire, prop: portDataAtom]];
levelType ← IF data=NIL THEN IF wire.size=0 THEN b ELSE composite ELSE data.levelType;
driveType ← IF data=NIL THEN aggregate ELSE data.driveType;
};
PortLeaves: PUBLIC PROC [port: Port] RETURNS [leaves: CARDINAL] = {
visited: RefTab.Ref ← RefTab.Create[];
CountLeaves: PROC [port: Port] RETURNS [leaves: CARDINAL ← 0] = {
IF NOT RefTab.Fetch[x: visited, key: port].found THEN {
IF NOT RefTab.Insert[x: visited, key: port, val: $Visited] THEN ERROR;
IF port.size=0 THEN leaves ← 1
ELSE FOR sub: NAT IN [0..port.size) DO
leaves ← leaves + CountLeaves[port[sub]];
ENDLOOP;
};
};
leaves ← CountLeaves[port];
};
PortIndex: PUBLIC PROC [wire: Core.Wire, name: Core.ROPE] RETURNS [index: NAT] = {
foo: INT ← CoreOps.GetWireIndex[wire, name];
IF foo=-1 THEN ERROR; -- not found
index ← foo;
};
PortIndexes: PUBLIC PROC [wire: Core.Wire, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: Core.ROPE ← NIL] RETURNS [i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11: NAT ← LAST[NAT]] ~ {
IF n0#NIL THEN i0 ← PortIndex[wire, n0];
IF n1#NIL THEN i1 ← PortIndex[wire, n1];
IF n2#NIL THEN i2 ← PortIndex[wire, n2];
IF n3#NIL THEN i3 ← PortIndex[wire, n3];
IF n4#NIL THEN i4 ← PortIndex[wire, n4];
IF n5#NIL THEN i5 ← PortIndex[wire, n5];
IF n6#NIL THEN i6 ← PortIndex[wire, n6];
IF n7#NIL THEN i7 ← PortIndex[wire, n7];
IF n8#NIL THEN i8 ← PortIndex[wire, n8];
IF n9#NIL THEN i9 ← PortIndex[wire, n9];
IF n10#NIL THEN i10 ← PortIndex[wire, n10];
IF n11#NIL THEN i11 ← PortIndex[wire, n11];
};
CopyPortValue: PUBLIC PROC [from: Port, to: Port] = {
CopyBits: EachPortPairProc = {
IF onePort.levelType#anotherPort.levelType OR onePort.driveType#anotherPort.driveType THEN ERROR;
IF onePort.levelType#composite THEN {
anotherPort.d ← onePort.d;
IF onePort.ds#NIL THEN FOR i: NAT IN [0..onePort.ds.size) DO
anotherPort.ds[i] ← onePort.ds[i];
ENDLOOP;
SELECT onePort.levelType FROM
l => anotherPort.l ← onePort.l;
ls => {
IF anotherPort.ls.size#onePort.ls.size THEN ERROR;
FOR bit: NAT IN [0..onePort.ls.size) DO
anotherPort.ls[bit] ← onePort.ls[bit];
ENDLOOP;
};
b => anotherPort.b ← onePort.b;
bs => {
IF anotherPort.bs.size#onePort.bs.size THEN ERROR;
FOR bit: NAT IN [0..onePort.bs.size) DO
anotherPort.bs[bit] ← onePort.bs[bit];
ENDLOOP;
};
c => anotherPort.c ← onePort.c;
lc => anotherPort.lc ← onePort.lc;
q => anotherPort.q ← onePort.q;
ENDCASE => ERROR;
};
};
IF VisitPortPair[from, to, CopyBits] THEN ERROR;
};
CheckPortValueEqual: PUBLIC PROC[root: Core.Wire, truth: Port, question: Port] = {
Equal: EachPortPairProc = {
Complain: PROC = {
SetErrorMessage: EachWirePortPairProc = {
IF onePort=port THEN {
quit ← TRUE;
msg ← IO.PutFR["Port %g expected %g but has %g", IO.rope[CoreOps.GetFullWireName[root, wire]], IO.rope[PortRope[onePort]], IO.rope[PortRope[anotherPort]]];
IF onePort.ds#NIL THEN {
msg ← Rope.Cat[msg, " with expect mask ",];
FOR i: NAT IN [0..onePort.ds.size) DO
msg ← Rope.Cat[msg, driveNames[onePort.ds[i]]];
ENDLOOP;
};
};
};
msg: Core.ROPE;
IF NOT VisitBinding[root, truth, SetErrorMessage] THEN ERROR;
SIGNAL CheckError[msg];
};
IF onePort.levelType=composite THEN RETURN;
IF onePort.d#anotherPort.d THEN SIGNAL CheckError["Port drives do not match"];
SELECT onePort.levelType FROM
l => IF anotherPort.l#onePort.l THEN Complain[];
ls => FOR bit: NAT IN [0..onePort.ls.size) DO
IF anotherPort.ls[bit]#onePort.ls[bit] THEN Complain[];
ENDLOOP;
b => IF anotherPort.b#onePort.b THEN Complain[];
bs => FOR bit: NAT IN [0..onePort.bs.size) DO
IF anotherPort.bs[bit]#onePort.bs[bit] THEN Complain[];
ENDLOOP;
c => IF anotherPort.c#onePort.c THEN Complain[];
lc => IF anotherPort.lc#onePort.lc THEN Complain[];
q => IF anotherPort.q#onePort.q THEN Complain[];
ENDCASE => ERROR;
};
[] ← VisitPortPair[truth, question, Equal];
};
CheckPortValue: PUBLIC PROC [root: Core.Wire, truth: Port, question: Port] = {
CheckBits: EachPortPairProc = {
Complain: PROC = {
SetErrorMessage: EachWirePortPairProc = {
IF onePort=port THEN {
quit ← TRUE;
msg ← IO.PutFR["Port %g expected %g but has %g", IO.rope[CoreOps.GetFullWireName[root, wire]], IO.rope[PortRope[onePort]], IO.rope[PortRope[anotherPort]]];
IF onePort.ds#NIL THEN {
msg ← Rope.Cat[msg, " with expect mask ",];
FOR i: NAT IN [0..onePort.ds.size) DO
msg ← Rope.Cat[msg, driveNames[onePort.ds[i]]];
ENDLOOP;
};
};
};
msg: Core.ROPE;
IF NOT VisitBinding[root, truth, SetErrorMessage] THEN ERROR;
SIGNAL CheckError[msg];
};
IF onePort.levelType#composite THEN SELECT onePort.driveType FROM
aggregate => SELECT onePort.d FROM
expect, force => SELECT onePort.levelType FROM
l => IF anotherPort.l#onePort.l THEN Complain[];
ls => FOR bit: NAT IN [0..onePort.ls.size) DO
IF anotherPort.ls[bit]#onePort.ls[bit] THEN Complain[];
ENDLOOP;
b => IF anotherPort.b#onePort.b THEN Complain[];
bs => FOR bit: NAT IN [0..onePort.bs.size) DO
IF anotherPort.bs[bit]#onePort.bs[bit] THEN Complain[];
ENDLOOP;
c => IF anotherPort.c#onePort.c THEN Complain[];
lc => IF anotherPort.lc#onePort.lc THEN Complain[];
q => IF anotherPort.q#onePort.q THEN Complain[];
ENDCASE => ERROR;
inspect => SELECT onePort.levelType FROM
l => onePort.l ← anotherPort.l;
ls => FOR bit: NAT IN [0..onePort.ls.size) DO
onePort.ls[bit] ← anotherPort.ls[bit];
ENDLOOP;
b => onePort.b ← anotherPort.b;
bs => FOR bit: NAT IN [0..onePort.bs.size) DO
onePort.bs[bit] ← anotherPort.bs[bit];
ENDLOOP;
c => onePort.c ← anotherPort.c;
lc => onePort.lc ← anotherPort.lc;
q => onePort.q ← anotherPort.q;
ENDCASE => ERROR;
ENDCASE;
separate => FOR i: NAT IN [0..onePort.ds.size) DO
SELECT onePort.ds[i] FROM
expect, force => SELECT onePort.levelType FROM
ls => IF anotherPort.ls[i]#onePort.ls[i] THEN {Complain[]; EXIT};
bs => IF anotherPort.bs[i]#onePort.bs[i] THEN {Complain[]; EXIT};
c => IF BitOps.EBFW[anotherPort.c, i, 16-anotherPort.fieldStart]#BitOps.EBFW[onePort.c, i, 16-onePort.fieldStart] THEN {Complain[]; EXIT};
lc => IF BitOps.EBFD[anotherPort.lc, i, 32-anotherPort.fieldStart]#BitOps.EBFD[onePort.lc, i, 32-onePort.fieldStart] THEN {Complain[]; EXIT};
q => IF BitOps.EBFQ[anotherPort.q, i, 64-anotherPort.fieldStart]#BitOps.EBFQ[onePort.q, i, 64-onePort.fieldStart] THEN {Complain[]; EXIT};
ENDCASE => ERROR;
inspect => SELECT onePort.levelType FROM
ls => onePort.ls[i] ← anotherPort.ls[i];
bs => onePort.bs[i] ← anotherPort.bs[i];
c => onePort.c ← BitOps.IBIW[BitOps.EBFW[anotherPort.c, i, 16-anotherPort.fieldStart], onePort.c, i, 16-anotherPort.fieldStart];
lc => onePort.lc ← BitOps.IBID[BitOps.EBFD[anotherPort.lc, i, 32-anotherPort.fieldStart], onePort.lc, i, 32-anotherPort.fieldStart];
q => onePort.q ← BitOps.IBIQ[BitOps.EBFQ[anotherPort.q, i, 64-anotherPort.fieldStart], onePort.q, i, 64-anotherPort.fieldStart];
ENDCASE => ERROR;
ENDCASE;
ENDLOOP;
ENDCASE => ERROR;
};
IF VisitPortPair[truth, question, CheckBits] THEN ERROR;
};
PortRope: PROC [port: Port] RETURNS [value: Core.ROPE ← NIL] = {
SELECT port.levelType FROM
l => value ← SELECT port.l FROM
L => "0",
X => "X",
H => "1"
ENDCASE => ERROR;
ls => value ← LevelSequenceToRope[container: port.ls, size: port.ls.size];
b => value ← IF port.b THEN "1" ELSE "0";
bs => {
FOR bit: NAT IN [0..port.bs.size) DO
value ← Rope.Concat[value, IF port.bs[bit] THEN "1" ELSE "0"];
ENDLOOP;
};
c => value ← Convert.RopeFromCard[from: port.c, base: 16];
lc => value ← Convert.RopeFromCard[from: port.lc, base: 16];
q => {
ls: LevelSequence ← NEW[LevelSequenceRec[64-port.fieldStart]];
FOR i: NAT IN [0..ls.size) DO
ls[i] ← IF BitOps.EBFQ[port.q, i, ls.size] THEN H ELSE L;
ENDLOOP;
value ← LevelSequenceToRope[container: ls, size: ls.size];
};
ENDCASE => ERROR;
};
CheckError: PUBLIC SIGNAL [msg: Core.ROPE] = CODE;
CopyDrives: PROC [old: DriveSequence] RETURNS [new: DriveSequence ← NIL] = {
IF old#NIL THEN {
new ← NEW[DriveSequenceRec[old.size]];
FOR i: NAT IN [0..new.size) DO
new[i] ← old[i];
ENDLOOP
};
};
Old Port Initialization and Binding Procedures
InitPort: PUBLIC PROC [wire: Core.Wire, levelType: LevelType ← b, driveType: DriveType ← aggregate, initDrive: Drive ← none, initDrives: DriveSequence ← NIL] RETURNS [sameWire: Core.Wire] = {
PutPortData[prop: portDataAtom, wire: wire, levelType: levelType, driveType: driveType, initDrive: initDrive, initDrives: initDrives];
sameWire ← wire;
IF wire.size=0 AND (levelType#b AND levelType#l) THEN ERROR; -- atomic level type but wire not atomic
};
InitPorts: PUBLIC PROC [ct: Core.CellType, initType: LevelType ← l, initDrive: Drive ← none, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10: CoreCreate.WR ← NIL] = {
ports: LIST OF CoreCreate.WR ← NIL;
IF n0#NIL THEN ports ← CONS[n0, ports];
IF n1#NIL THEN ports ← CONS[n1, ports];
IF n2#NIL THEN ports ← CONS[n2, ports];
IF n3#NIL THEN ports ← CONS[n3, ports];
IF n4#NIL THEN ports ← CONS[n4, ports];
IF n5#NIL THEN ports ← CONS[n5, ports];
IF n6#NIL THEN ports ← CONS[n6, ports];
IF n7#NIL THEN ports ← CONS[n7, ports];
IF n8#NIL THEN ports ← CONS[n8, ports];
IF n9#NIL THEN ports ← CONS[n9, ports];
IF n10#NIL THEN ports ← CONS[n10, ports];
InitPortList[ct, initType, initDrive, ports];
};
InitPortList: PUBLIC PROC [ct: Core.CellType, initType: LevelType ← l, initDrive: Drive ← none, ports: LIST OF CoreCreate.WR] = {
InitP: PROC [ref: REF] = {
wire: Core.Wire ← FindWire[ct.public, ref];
[] ← InitPort[wire: wire, levelType: initType, initDrive: initDrive];
};
FOR p: LIST OF CoreCreate.WR ← ports, p.rest UNTIL p=NIL DO
InitP[p.first];
ENDLOOP;
};
InitTesterDrive: PUBLIC PROC [wire: Core.Wire, initDrive: Drive ← none, initDrives: DriveSequence ← NIL] = {
PutPortData[prop: portTesterDriveAtom, wire: wire, driveType: IF initDrives=NIL THEN aggregate ELSE separate, initDrive: initDrive, initDrives: initDrives]
};
InitTesterDrives: PUBLIC PROC [ct: Core.CellType, initDrive: Drive ← none, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10: CoreCreate.WR ← NIL] = {
ports: LIST OF CoreCreate.WR ← NIL;
IF n0#NIL THEN ports ← CONS[n0, ports];
IF n1#NIL THEN ports ← CONS[n1, ports];
IF n2#NIL THEN ports ← CONS[n2, ports];
IF n3#NIL THEN ports ← CONS[n3, ports];
IF n4#NIL THEN ports ← CONS[n4, ports];
IF n5#NIL THEN ports ← CONS[n5, ports];
IF n6#NIL THEN ports ← CONS[n6, ports];
IF n7#NIL THEN ports ← CONS[n7, ports];
IF n8#NIL THEN ports ← CONS[n8, ports];
IF n9#NIL THEN ports ← CONS[n9, ports];
IF n10#NIL THEN ports ← CONS[n10, ports];
InitTesterDriveList[ct, initDrive, ports];
};
InitTesterDriveList: PUBLIC PROC [ct: Core.CellType, initDrive: Drive ← none, ports: LIST OF CoreCreate.WR] = {
InitP: PROC [ref: REF] = {
wire: Core.Wire ← FindWire[ct.public, ref];
[] ← InitTesterDrive[wire: wire, initDrive: initDrive];
};
FOR p: LIST OF CoreCreate.WR ← ports, p.rest UNTIL p=NIL DO
InitP[p.first];
ENDLOOP;
};
PutPortData: PUBLIC PROC [prop: ATOM, wire: Core.Wire, levelType: LevelType ← b, driveType: DriveType ← aggregate, initDrive: Drive ← none, initDrives: DriveSequence ← NIL] = {
CoreProperties.PutWireProp[on: wire, prop: prop, value:
NEW[PortDataRec ← [
levelType: levelType,
driveType: driveType,
drive: initDrive,
drives: CopyDrives[initDrives]]]];
};
ITDList: PUBLIC PROC [public: Core.Wire, indicies: LIST OF NAT, initDrive: Drive] ~ {
FOR l: LIST OF NAT ← indicies, l.rest WHILE l#NIL DO
[] ← InitTesterDrive[wire: public[l.first], initDrive: initDrive];
ENDLOOP;
};
IPList: PUBLIC PROC [public: Core.Wire, indicies: LIST OF NAT, levelType: LevelType, initDrive: Drive ← none] ~ {
FOR l: LIST OF NAT ← indicies, l.rest WHILE l#NIL DO
[] ← InitPort[wire: public[l.first], levelType: levelType, initDrive: initDrive];
ENDLOOP;
};
FindWire: PROC [iconPublic: Core.Wire, name: CoreCreate.WR] RETURNS [iconWire: Core.Wire ← NIL] ~ {
n: NAT;
IF ISTYPE[name, Core.Wire] THEN iconWire ← NARROW[name]
ELSE {
n ← CoreOps.GetWireIndex[iconPublic, CoreOps.FixStupidRef[name]]; -- dies if -1 returned!
iconWire ← iconPublic[n];
};
};
New Port Initialization Procedures
$PortLevelType
portLevelTypeAtom: ATOM ← CoreIO.RegisterProperty[prop: $PortLevelType, write: PortLevelTypeWrite, read: PortLevelTypeRead];
SetPortLevelType: PUBLIC PROC [wire: Core.Wire, levelType: LevelType ← b] RETURNS [sameWire: Core.Wire] = {
CoreProperties.PutWireProp[wire, portLevelTypeAtom, NEW[LevelType ← levelType]];
sameWire ← wire;
};
PortLevelTypeWrite: CoreIO.PropWriteProc ~ {
levelType: REF LevelType = NARROW[value];
BrineIO.WriteID[stream, levelTypeNames[levelType^]];
};
PortLevelTypeRead: CoreIO.PropReadProc ~ {
value ← NEW [LevelType ← FindLevelType[BrineIO.ReadID[stream]]];
};
$PortDriveType, $PortTesterDriveType
portDriveTypeAtom: ATOM ← CoreIO.RegisterProperty[prop: $PortDriveType, write: PortDriveTypeWrite, read: PortDriveTypeRead];
portTesterDriveTypeAtom: ATOM ← CoreIO.RegisterProperty[prop: $PortTesterDriveType, write: PortDriveTypeWrite, read: PortDriveTypeRead];
SetPortDriveType: PUBLIC PROC [wire: Core.Wire, driveType: DriveType ← aggregate] RETURNS [sameWire: Core.Wire] = {
CoreProperties.PutWireProp[wire, portDriveTypeAtom, NEW[DriveType ← driveType]];
sameWire ← wire;
};
SetPortTesterDriveType: PUBLIC PROC [wire: Core.Wire, driveType: DriveType ← aggregate] RETURNS [sameWire: Core.Wire] = {
CoreProperties.PutWireProp[wire, portTesterDriveTypeAtom, NEW[DriveType ← driveType]];
sameWire ← wire;
};
PortDriveTypeWrite: CoreIO.PropWriteProc ~ {
driveType: REF DriveType ← NARROW[value];
BrineIO.WriteID[stream, driveTypeNames[driveType^]];
};
PortDriveTypeRead: CoreIO.PropReadProc ~ {
value ← NEW [DriveType ← FindDriveType[BrineIO.ReadID[stream]]];
};
$PortDrive, $PortNewTesterDrive
portDriveAtom: ATOM ← CoreIO.RegisterProperty[prop: $PortDrive, write: PortDriveWrite, read: PortDriveRead];
portNewTesterDriveAtom: ATOM ← CoreIO.RegisterProperty[prop: $PortNewTesterDrive, write: PortDriveWrite, read: PortDriveRead];
SetInitialPortDrive: PUBLIC PROC [wire: Core.Wire, initDrive: Drive ← none, initDrives: DriveSequence ← NIL] RETURNS [sameWire: Core.Wire] = {
CoreProperties.PutWireProp[wire, portDriveAtom, IF initDrives=NIL THEN NEW[Drive ← initDrive] ELSE CopyDrives[initDrives]];
sameWire ← wire;
};
SetInitialPortTesterDrive: PUBLIC PROC [wire: Core.Wire, initDrive: Drive ← none, initDrives: DriveSequence ← NIL] RETURNS [sameWire: Core.Wire] = {
CoreProperties.PutWireProp[wire, portNewTesterDriveAtom, IF initDrives=NIL THEN NEW[Drive ← initDrive] ELSE CopyDrives[initDrives]];
sameWire ← wire;
};
PortDriveWrite: CoreIO.PropWriteProc ~ {
WITH value SELECT FROM
drive: REF Drive => {
BrineIO.WriteInt[stream, -1]; -- to indicate not a sequence ...
BrineIO.WriteID[stream, driveNames[drive^]];
};
drives: REF DriveSequence => {
BrineIO.WriteInt[stream, drives.size];
FOR i: NAT IN [0..drives.size) DO
BrineIO.WriteID[stream, driveNames[drives[i]]];
ENDLOOP;
};
ENDCASE => ERROR; -- should never happen !!!
};
PortDriveRead: CoreIO.PropReadProc ~ {
size: NAT ← BrineIO.ReadInt[stream];
IF size<0 THEN value ← NEW [Drive ← FindDrive[BrineIO.ReadID[stream]]]
ELSE { -- drive sequence
drives: DriveSequence ← NEW[DriveSequenceRec[size]];
FOR i: NAT IN [0..size) DO
drives[i] ← FindDrive[BrineIO.ReadID[stream]];
ENDLOOP;
value ← drives
};
};
SetPorts: PUBLIC PROC [r: Core.Wire, n: LIST OF Rope.ROPE, lt: LevelType ← b, cdt: DriveType ← aggregate, cd: Drive ← none, cds: DriveSequence ← NIL, tdt: DriveType ← aggregate, td: Drive ← none, tds: DriveSequence ← NIL] = {
FOR nl: LIST OF Rope.ROPE ← n, nl.rest UNTIL nl=NIL DO
w: Core.Wire ← CoreOps.FindWire[r, nl.first];
IF lt#b THEN [] ← SetPortLevelType[w, lt];
IF cdt#aggregate THEN [] ← SetPortDriveType[w, cdt];
IF cd#none THEN [] ← SetInitialPortDrive[w, cd];
IF cds#NIL THEN [] ← SetInitialPortDrive[wire: w, initDrives: cds];
IF tdt#aggregate THEN [] ← SetPortTesterDriveType[w, tdt];
IF td#none THEN [] ← SetInitialPortTesterDrive[w, td];
IF tds#NIL THEN [] ← SetInitialPortTesterDrive[wire: w, initDrives: tds];
ENDLOOP;
};
CoerceNewToOld: PUBLIC PROC [rootWire: Core.WireSeq] = {
CallInitPort: CoreOps.EachWireProc = {
refLevelType: REF ANY ← CoreProperties.GetWireProp[wire, portLevelTypeAtom];
refDriveType: REF ANY ← CoreProperties.GetWireProp[wire, portDriveTypeAtom];
refInitDrive: REF ANY ← CoreProperties.GetWireProp[wire, portDriveAtom];
refTesterDriveType: REF ANY ← CoreProperties.GetWireProp[wire, portTesterDriveTypeAtom];
refInitTesterDrive: REF ANY ← CoreProperties.GetWireProp[wire, portNewTesterDriveAtom];
IF refLevelType#NIL OR refDriveType#NIL OR refInitDrive#NIL THEN {
levelType: LevelType ← IF refLevelType=NIL THEN b ELSE NARROW[refLevelType, REF LevelType]^;
driveType: DriveType ← IF refDriveType=NIL THEN aggregate ELSE NARROW[refDriveType, REF DriveType]^;
initDrive: Drive ← none;
initDrives: DriveSequence ← NIL;
IF refInitDrive#NIL THEN WITH refInitDrive SELECT FROM
rd: REF Drive => initDrive ← rd^;
rds: DriveSequence => initDrives ← rds;
ENDCASE => ERROR;
[] ← InitPort[wire, levelType, driveType, initDrive, initDrives];
};
IF refTesterDriveType#NIL OR refInitTesterDrive#NIL THEN {
initTesterDrive: Drive ← none;
initTesterDrives: DriveSequence ← NIL;
IF refInitTesterDrive#NIL THEN WITH refInitTesterDrive SELECT FROM
rd: REF Drive => initTesterDrive ← rd^;
rds: DriveSequence => initTesterDrives ← rds;
ENDCASE => ERROR;
PutPortData[prop: portTesterDriveAtom, wire: wire, driveType: IF refTesterDriveType=NIL THEN IF initTesterDrives=NIL THEN aggregate ELSE separate ELSE NARROW[refTesterDriveType, REF DriveType]^, initDrive: initTesterDrive, initDrives: initTesterDrives]
};
};
[] ← CoreOps.VisitWireSeq[rootWire, CallInitPort];
};
FixupNewToOld: PROC [cell: Core.CellType] ~ {
CoerceNewToOld on cell and its immediate recast chain
CoerceNewToOld[cell.public];
WHILE cell.class.layersProps AND cell.class.recast#NIL DO
cell ← CoreOps.Recast[cell];
CoerceNewToOld[cell.public];
ENDLOOP;
};
New Port Binding Procedures
BindPort: PUBLIC PROC [rootWire: Core.WireSeq, rootPort: Port, name: Rope.ROPE] RETURNS [p: Port] = {
FindMatchingPort: EachWirePortPairProc = {
IF findWire=wire THEN {p ← port; quit ← TRUE};
};
findWire: Core.Wire ← CoreOps.FindWire[rootWire, name];
IF NOT VisitBinding[rootWire, rootPort, FindMatchingPort] THEN ERROR;
};
BindPorts: PUBLIC PROC [rootWire: Core.WireSeq, rootPort: Port, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: Rope.ROPE ← NIL] RETURNS [p0, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11: Port ← NIL] = {
IF n0#NIL THEN p0 ← BindPort[rootWire, rootPort, n0];
IF n1#NIL THEN p1 ← BindPort[rootWire, rootPort, n1];
IF n2#NIL THEN p2 ← BindPort[rootWire, rootPort, n2];
IF n3#NIL THEN p3 ← BindPort[rootWire, rootPort, n3];
IF n4#NIL THEN p4 ← BindPort[rootWire, rootPort, n4];
IF n5#NIL THEN p5 ← BindPort[rootWire, rootPort, n5];
IF n6#NIL THEN p6 ← BindPort[rootWire, rootPort, n6];
IF n7#NIL THEN p7 ← BindPort[rootWire, rootPort, n7];
IF n8#NIL THEN p8 ← BindPort[rootWire, rootPort, n8];
IF n9#NIL THEN p9 ← BindPort[rootWire, rootPort, n9];
IF n10#NIL THEN p10 ← BindPort[rootWire, rootPort, n10];
IF n11#NIL THEN p11 ← BindPort[rootWire, rootPort, n11];
};
New Port Access Procedures
Drive
GetDrive, GD: PUBLIC PROC [p: Port] RETURNS [v: Drive] = {
IF (p.ds=NIL AND p.driveType#aggregate) OR (p.ds#NIL AND p.ds.size>1) THEN ERROR;
v ← IF p.ds=NIL THEN p.d ELSE p.ds[0];
};
PutDrive, PD: PUBLIC PROC [p: Port, v: Drive] = {
IF (p.ds=NIL AND p.driveType#aggregate) OR (p.ds#NIL AND p.ds.size>1) THEN ERROR;
IF p.ds=NIL THEN p.d ← v ELSE p.ds[0] ← v;
};
GetDriveSequence, GDS: PUBLIC PROC [p: Port, i: NAT] RETURNS [v: Drive] = {
IF p.driveType#separate THEN ERROR;
v ← p.ds[i];
};
PutDriveSequence, PDS: PUBLIC PROC [p: Port, i: NAT, v: Drive] = {
IF p.driveType#separate THEN ERROR;
p.ds[i] ← v;
};
SetDrive: PROC [p: Port, d: Drive] = {
IF p.ds=NIL THEN p.d ← d
ELSE FOR i: NAT IN [0..p.ds.size) DO
p.ds[i] ← d;
ENDLOOP;
};
Value
GetLevel, GL: PUBLIC PROC [p: Port] RETURNS [v: Level] = {
IF (p.ls=NIL AND p.levelType#l) OR (p.ls#NIL AND p.ls.size>1) THEN ERROR;
v ← IF p.ls=NIL THEN p.l ELSE p.ls[0];
};
PutLevel, PL: PUBLIC PROC [p: Port, v: Level, d: Drive ← drive] = {
IF (p.ls=NIL AND p.levelType#l) OR (p.ls#NIL AND p.ls.size>1) THEN ERROR;
IF p.ls=NIL THEN p.l ← v ELSE p.ls[0] ← v;
SetDrive[p, d];
};
GetLevelSequence, GLS: PUBLIC PROC [p: Port, i: NAT] RETURNS [v: Level] = {
IF p.levelType#ls THEN ERROR;
v ← p.ls[i];
};
PutLevelSequence, PLS: PUBLIC PROC [p: Port, i: NAT, v: Level, d: Drive ← drive] = {
IF p.levelType#ls THEN ERROR;
p.ls[i] ← v;
IF p.ds=NIL THEN SetDrive[p, d] ELSE p.ds[i] ← d;
};
GetBool, GB: PUBLIC PROC [p: Port] RETURNS [v: BOOL] = {
IF (p.ls=NIL AND p.levelType#b) OR (p.ls#NIL AND p.ls.size>1) THEN ERROR;
v ← IF p.ls=NIL THEN p.b ELSE ToBool[p.ls[0]];
};
PutBool, PB: PUBLIC PROC [p: Port, v: BOOL, d: Drive ← drive] = {
IF (p.ls=NIL AND p.levelType#b) OR (p.ls#NIL AND p.ls.size>1) THEN ERROR;
IF p.ls=NIL THEN p.b ← v ELSE p.ls[0] ← ToLevel[v];
SetDrive[p, d];
};
GetBoolSequence, GBS: PUBLIC PROC [p: Port, i: NAT] RETURNS [v: BOOL] = {
IF p.ls=NIL AND p.levelType#bs THEN ERROR;
v ← IF p.ls=NIL THEN p.bs[i] ELSE ToBool[p.ls[i]];
};
PutBoolSequence, PBS: PUBLIC PROC [p: Port, i: NAT, v: BOOL, d: Drive ← drive] = {
IF p.ls=NIL AND p.levelType#bs THEN ERROR;
IF p.ls=NIL THEN p.bs[i] ← v ELSE p.ls[i] ← ToLevel[v];
IF p.ds=NIL THEN SetDrive[p, d] ELSE p.ds[i] ← d;
};
GetWord, GW: PUBLIC PROC [p: Port] RETURNS [v: BitOps.BitWord] = {
IF p.ls=NIL AND p.levelType#c THEN ERROR;
v ← IF p.ls=NIL THEN p.c ELSE LSToC[p.ls];
};
PutWord, PW: PUBLIC PROC [p: Port, v: BitOps.BitWord, d: Drive ← drive] = {
IF p.ls=NIL AND p.levelType#c THEN ERROR;
IF p.ls=NIL THEN p.c ← v ELSE LCToLS[v, p.ls];
SetDrive[p, d];
};
GetDWord, GDW: PUBLIC PROC [p: Port] RETURNS [v: BitOps.BitDWord] = {
IF p.ls=NIL AND p.levelType#lc THEN ERROR;
v ← IF p.ls=NIL THEN p.lc ELSE LSToLC[p.ls];
};
PutDWord, PDW: PUBLIC PROC [p: Port, v: BitOps.BitDWord, d: Drive ← drive] = {
IF p.ls=NIL AND p.levelType#lc THEN ERROR;
IF p.ls=NIL THEN p.lc ← v ELSE LCToLS[v, p.ls];
SetDrive[p, d];
};
GetQWord, GQW: PUBLIC PROC [p: Port] RETURNS [v: BitOps.BitQWord] = {
IF p.ls=NIL AND p.levelType#q THEN ERROR;
v ← IF p.ls=NIL THEN p.q ELSE LSToQ[p.ls];
};
PutQWord, PQW: PUBLIC PROC [p: Port, v: BitOps.BitQWord, d: Drive ← drive] = {
IF p.ls=NIL AND p.levelType#q THEN ERROR;
IF p.ls=NIL THEN p.q ← v ELSE QToLS[v, p.ls];
SetDrive[p, d];
};
Utilities
Not: PUBLIC PROC [src, dst: Port] = {
IF src.ls=NIL OR dst.ls=NIL THEN ERROR;
NotLS[src.ls, dst.ls];
};
Copy: PUBLIC PROC [src, dst: Port] = {
IF src.ls=NIL OR dst.ls=NIL THEN ERROR;
CopyLS[src.ls, dst.ls];
};
Set: PUBLIC PROC [p: Port, v: Level] = {
IF p.ls=NIL THEN ERROR;
SetLS[p.ls, v];
};
AnyX: PUBLIC PROC [p: Port] RETURNS [BOOL] = {
IF p.ls=NIL THEN ERROR;
RETURN[HasX[p.ls]];
};
ToRope: PUBLIC PROC [p: Port, size: NAT ← 0, base: NAT ← 16] RETURNS [r: Rope.ROPE] = {
IF p.ls=NIL THEN ERROR;
r ← LSToRope[p.ls, size, base];
};
Size: PUBLIC PROC [p: Port] RETURNS [size: NAT] = {
IF p.ls=NIL THEN ERROR;
size ← p.ls.size;
};
Enumerating Pairs
VisitPortPair: PUBLIC PROC [onePort: Port, anotherPort: Port, eachPortPair: EachPortPairProc] RETURNS [quit: BOOL] = {
subElements: BOOL;
IF onePort.size#anotherPort.size OR onePort.levelType#anotherPort.levelType OR (onePort.levelType=ls AND anotherPort.ls.size#onePort.ls.size) OR (onePort.levelType=bs AND anotherPort.bs.size#onePort.bs.size) THEN RETURN [TRUE]; -- ports do not conform
[subElements, quit] ← eachPortPair[onePort, anotherPort];
IF quit OR ~subElements THEN RETURN;
FOR i: NAT IN [0..onePort.size) DO
IF VisitPortPair[onePort[i], anotherPort[i], eachPortPair] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
VisitBinding: PUBLIC PROC [wire: Core.Wire, port: Port, eachWirePortPair: EachWirePortPairProc] RETURNS [quit: BOOL] = {
subElements: BOOL;
[subElements, quit] ← eachWirePortPair[wire, port];
IF quit OR ~subElements THEN RETURN;
FOR i: NAT IN [0..wire.size) DO
IF VisitBinding[
wire[i],
IF port = NIL THEN NIL ELSE IF port.levelType#composite THEN NIL ELSE port[i],
eachWirePortPair] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
GetFullPortName: PUBLIC PROC [port: Port, rootPort: Port, rootWire: Core.Wire] RETURNS [name: Rope.ROPE ← NIL] ~ {
FInd the name of a specific port
EachWirePortPair: EachWirePortPairProc ~ {
quit ← port=subPort;
IF quit THEN name ← CoreOps.GetFullWireName[rootWire, wire];
};
subPort: Port = port; -- renaming
IF NOT VisitBinding[rootWire, rootPort, EachWirePortPair] THEN name ← NIL; -- no such subport
};
Logical Operations and Conversions
ConversionError: PUBLIC SIGNAL = CODE;
ToBool: PUBLIC PROC [a: Level] RETURNS [b: BOOL] = {
b ← SELECT a FROM
L => FALSE,
X => ERROR ConversionError,
H => TRUE,
ENDCASE => ERROR;
};
ToLevel: PUBLIC PROC [a: BOOL] RETURNS [b: Level] = {
b ← IF a THEN H ELSE L};
NotL: PUBLIC PROC [a: Level] RETURNS [b: Level] = {
b ← SELECT a FROM L => H, H => L, ENDCASE => X};
AndL: PUBLIC PROC [a, b: Level] RETURNS [c: Level] = {
tt: ARRAY Level OF ARRAY Level OF Level =
[[L, L, L],
[L, H, X],
[L, X, X]];
c ← tt[a][b];
};
OrL: PUBLIC PROC [a, b: Level] RETURNS [c: Level] = {
tt: ARRAY Level OF ARRAY Level OF Level =
[[L, H, X],
[H, H, X],
[X, X, X]];
c ← tt[a][b];
};
XorL: PUBLIC PROC [a, b: Level] RETURNS [c: Level] = {
tt: ARRAY Level OF ARRAY Level OF Level =
[[L, H, X],
[H, L, X],
[X, X, X]];
c ← tt[a][b];
};
SumL: PUBLIC PROC [a, b, c: Ports.Level] RETURNS [carry, s: Ports.Level] ~ {
v: ARRAY Ports.Level OF NAT ← [0, 1, 0]; -- value of the level
d: ARRAY Ports.Level OF NAT ← [0, 0, 1]; -- possible delta
lower, higher: NAT;
cl, ch, sl, sh: Ports.Level;
lower ← v[a]+v[b]+v[c]; -- lower sum
higher ← lower+d[a]+d[b]+d[c]; -- higher sum
[cl, sl] ← TwoBitsToLevels[lower];
[ch, sh] ← TwoBitsToLevels[higher];
carry ← MergeLevels[cl, ch];
s ← IF carry#X THEN MergeLevels[sl, sh] ELSE X;
};
TwoBitsToLevels: PROC [n: NAT] RETURNS [c, s: Ports.Level] ~ {
SELECT n FROM
0 => RETURN[L, L];
1 => RETURN[L, H];
2 => RETURN[H, L];
3 => RETURN[H, H];
ENDCASE => ERROR;
};
MergeLevels: PROC [b1, b2: Ports.Level] RETURNS [l: Ports.Level] ~ {
l ← IF b1=b2 THEN b1 ELSE X};
NotLS: PUBLIC PROC [a, b: LevelSequence] = {
FOR i: NAT IN [0..a.size) DO b[i] ← NotL[a[i]]; ENDLOOP;
};
CopyLS: PUBLIC PROC [from, to: LevelSequence] = {
FOR i: NAT IN [0..from.size) DO to[i] ← from[i]; ENDLOOP;
};
SetLS: PUBLIC PROC [seq: LevelSequence, level: Level] = {
FOR i: NAT IN [0..seq.size) DO seq[i] ← level; ENDLOOP;
};
HasX: PUBLIC PROC [ls: Ports.LevelSequence] RETURNS [BOOL ← FALSE] ~ {
FOR i: NAT IN [0..ls.size) DO IF ls[i]=X THEN RETURN[TRUE] ENDLOOP};
LSToRope, LevelSequenceToRope: PUBLIC PROC [container: LevelSequence, size: NAT ← 0, base: NAT ← 16] RETURNS [val: Core.ROPE ← NIL] = {
bitsPerDigit: NAT ← BitOps.NBits[base];
scratch: REF TEXT;
bitsInDigit: NAT;
digitBitCount: NAT ← 0;
allX: BOOL ← TRUE;
someX: BOOL ← FALSE;
digitVal: CARDINAL ← 0;
IF size=0 THEN size ← container.size;
scratch ← RefText.New[(size/bitsPerDigit)+1];
bitsInDigit ← IF size MOD bitsPerDigit = 0 THEN bitsPerDigit ELSE size MOD bitsPerDigit;
FOR bit: NAT IN [0..size) DO
bitVal: Level ← container[bit];
digitVal ← 2*digitVal;
IF bitVal=X THEN someX ← TRUE
ELSE {
allX ← FALSE;
IF bitVal=H THEN digitVal ← digitVal + 1;
};
digitBitCount ← digitBitCount + 1;
IF digitBitCount=bitsInDigit THEN {
SELECT TRUE FROM
allX => scratch ← RefText.InlineAppendChar[scratch, 'X];
someX => {
scratch ← RefText.InlineAppendChar[scratch, '(];
FOR rescan: NAT DECREASING IN [0..bitsInDigit) DO
scratch ← RefText.InlineAppendChar[scratch, SELECT container[bit-rescan] FROM
L => '0,
X => 'X,
H => '1,
ENDCASE => ERROR];
ENDLOOP;
scratch ← RefText.InlineAppendChar[scratch, ')];
};
ENDCASE => scratch ← Convert.AppendCard[to: scratch, from: digitVal, base: base, showRadix: FALSE];
bitsInDigit ← bitsPerDigit;
digitBitCount ← 0;
allX ← TRUE;
someX ← FALSE;
digitVal ← 0;
};
ENDLOOP;
val ← Rope.FromRefText[scratch];
};
WordAsBits: TYPE = PACKED ARRAY [0..16) OF BOOL;
DWordAsBits: TYPE = PACKED ARRAY [0..32) OF BOOL;
LSToC: PUBLIC PROC [ls: LevelSequence] RETURNS [c: CARDINAL] = {
asBits: WordAsBits ← ALL[FALSE];
FOR bit: INT IN [0..ls.size-16) DO
IF ls[bit]#L THEN ERROR ConversionError;
ENDLOOP;
FOR bit: INT IN [MAX[ls.size-16, 0]..ls.size) DO
asBits[bit+16-ls.size] ← ToBool[ls[bit]];
ENDLOOP;
c ← LOOPHOLE[asBits];
};
CToLS: PUBLIC PROC [c: CARDINAL, ls: LevelSequence] = {
asBits: WordAsBits ← LOOPHOLE[c];
FOR bit: INT IN [0..16-ls.size) DO
IF asBits[bit] THEN ERROR ConversionError;
ENDLOOP;
FOR bit: INT IN [0..ls.size) DO
ls[bit] ← IF bit<ls.size-16 THEN L ELSE ToLevel[asBits[bit+16-ls.size]];
ENDLOOP;
};
LSToLC: PUBLIC PROC [ls: LevelSequence] RETURNS [lc: LONG CARDINAL] = {
asBits: DWordAsBits ← ALL[FALSE];
FOR bit: INT IN [0..ls.size-32) DO
IF ls[bit]#L THEN ERROR ConversionError;
ENDLOOP;
FOR bit: INT IN [MAX[ls.size-32, 0]..ls.size) DO
asBits[bit+32-ls.size] ← ToBool[ls[bit]];
ENDLOOP;
lc ← LOOPHOLE[Basics.SwapHalves[LOOPHOLE[asBits]]];
};
LCToLS: PUBLIC PROC [lc: LONG CARDINAL, ls: LevelSequence] = {
asBits: DWordAsBits ← LOOPHOLE[Basics.SwapHalves[LOOPHOLE[lc]]];
FOR bit: INT IN [0..32-ls.size) DO
IF asBits[bit] THEN ERROR ConversionError;
ENDLOOP;
FOR bit: INT IN [0..ls.size) DO
ls[bit] ← IF bit<ls.size-32 THEN L ELSE ToLevel[asBits[bit+32-ls.size]];
ENDLOOP;
};
LSToQ: PUBLIC PROC [ls: LevelSequence] RETURNS [q: BitOps.BitQWord ← BitOps.BitQWordZero] = {
FOR bit: INT IN [0..ls.size-64) DO
IF ls[bit]#L THEN ERROR ConversionError;
ENDLOOP;
FOR i: NAT IN [MAX[ls.size-64, 0]..ls.size) DO
q ← BitOps.IBIQ[ToBool[ls[i]], q, i, ls.size];
ENDLOOP;
};
QToLS: PUBLIC PROC [q: BitOps.BitQWord, ls: LevelSequence] = {
FOR bit: INT IN [0..64-ls.size) DO
IF BitOps.EBFQ[q, bit] THEN ERROR ConversionError;
ENDLOOP;
FOR bit: INT IN [0..ls.size) DO
ls[bit] ← IF bit<ls.size-64 THEN L ELSE ToLevel[BitOps.EBFQ[q, bit+64-ls.size]];
ENDLOOP;
};
END.