DIRECTORY Basics, BitOps, Convert, Core, CoreCreate, CoreIO, CoreOps, CoreProperties, HashTable, IO, RefText, Rope, Ports;

PortsImpl: CEDAR PROGRAM
IMPORTS Basics, BitOps, Convert, CoreIO, CoreOps, CoreProperties, HashTable, 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 _ [
"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]];
};
seperate => 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];
CoreIO.WriteID[h, levelTypeNames[portData.levelType]];
CoreIO.WriteID[h, driveTypeNames[portData.driveType]];
CoreIO.WriteID[h, driveNames[portData.drive]];
IF portData.drives=NIL THEN CoreIO.WriteInt[h, 0]
ELSE {
CoreIO.WriteInt[h, portData.drives.size];
FOR i: NAT IN [0..portData.drives.size) DO
CoreIO.WriteID[h, driveNames[portData.drives[i]]];
ENDLOOP;
};
};

PortDataRead: CoreIO.PropReadProc = {
portData: PortData _ NEW[PortDataRec];
size: NAT;
portData.levelType _ FindLevelType[CoreIO.ReadID[h]];
portData.driveType _ FindDriveType[CoreIO.ReadID[h]];
portData.drive _ FindDrive[CoreIO.ReadID[h]];
size _ CoreIO.ReadInt[h];
IF size>0 THEN {
portData.drives _ NEW[DriveSequenceRec[size]];
FOR i: NAT IN [0..size) DO
portData.drives[i] _ FindDrive[CoreIO.ReadID[h]];
ENDLOOP;
};
value _ portData;
};

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: HashTable.Table _ HashTable.Create[];  -- wire to port
portAssignment: HashTable.Table _ HashTable.Create[];  -- wire to port
MakePort: PUBLIC PROC [wire: Core.Wire] RETURNS [port: Port] = {
IF (port _ NARROW[HashTable.Fetch[table: wireTab, key: wire].value])=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;
seperate => {
port.driveType _ seperate;
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 HashTable.Insert[table: wireTab, key: wire, value: port] THEN ERROR;
};
};
AssignPort: PROC [wire: Core.Wire, port: Port] = {
assigned: Port _ NARROW[HashTable.Fetch[table: portAssignment, key: wire].value];
IF assigned=NIL THEN {IF NOT HashTable.Insert[table: portAssignment, key: wire, value: 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;
};
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;
seperate => 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];
};

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];
};
};

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;
};

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 seperate, 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;
};

WirePortType: PUBLIC PROC [cellType: Core.CellType, wire: Core.Wire] RETURNS [levelType: LevelType, driveType: DriveType] = {
data: PortData _ 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: HashTable.Table _ HashTable.Create[];
CountLeaves: PROC [port: Port] RETURNS [leaves: CARDINAL _ 0] = {
IF NOT HashTable.Fetch[table: visited, key: port].found THEN {
IF NOT HashTable.Insert[table: visited, key: port, value: $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] = {
index _ CoreOps.GetWireIndex[wire, name];
IF index=-1 THEN ERROR;	-- not found
};

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;
};

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 => IF onePort.d=expect OR onePort.d=force THEN {
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;
};
seperate => FOR i: NAT IN [0..onePort.ds.size) DO
IF onePort.ds[i]=expect OR onePort.ds[i]=force THEN 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;
ENDLOOP;
ENDCASE => ERROR;
};

IF VisitPortPair[truth, question, CheckBits] THEN ERROR;
};

CheckError: PUBLIC SIGNAL [msg: Core.ROPE] = CODE;

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;
};

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
};
};

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;
};

ConversionError: PUBLIC SIGNAL = CODE;

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: Level] RETURNS [carry, s: Level] = {
IF a=X OR b=X OR c=X THEN RETURN[X, X];
carry _ IF (a=H AND b=H) OR (b=H AND c=H) OR (c=H AND a=H) THEN H ELSE L;
s _ IF (a=H AND b=H AND c=L) OR (b=H AND c=H AND a=L) OR (c=H AND a=H AND b=L) OR (a=L AND b=L AND c=L) THEN L ELSE H;
};

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;
};

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];
};

ToBool: PROC [level: Level] RETURNS [new: BOOL] = {
new _ SELECT level FROM
L => FALSE,
X => ERROR ConversionError,
H => TRUE,
ENDCASE => ERROR;
};

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];
IF ls.size>16 THEN ERROR;
FOR bit: NAT IN [0..ls.size) DO
asBits[bit+16-ls.size] _ ToBool[ls[bit]];
ENDLOOP;
c _ LOOPHOLE[asBits];
};
LSToLC: PUBLIC PROC [ls: LevelSequence] RETURNS [lc: LONG CARDINAL] = {
asBits: DWordAsBits _ ALL[FALSE];
IF ls.size>32 THEN ERROR;
FOR bit: NAT IN [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] = {
FOR bit: NAT IN [0..ls.size) DO
thisBit: NAT _ bit+32-ls.size;
ls[bit] _  IF (IF thisBit < 16 THEN LOOPHOLE[Basics.HighHalf[lc], WordAsBits][thisBit] ELSE LOOPHOLE[Basics.LowHalf[lc], WordAsBits][thisBit - 16]) THEN H ELSE L;
ENDLOOP;
};

END.


PortsImpl.mesa
Copyright c 1985, 1986 by Xerox Corporation.  All rights reserved.
Barth, March 12, 1987 11:53:52 am PST
Gasbarro, January 23, 1986 11:40:29 am PST
Bertrand Serlet, August 12, 1986 3:43:57 pm PDT

Logical Operations and Conversions



ΚΊ–

"cedar" style˜
codeš
œ™Kšœ
Οm
œ7™BK™%K™*K™/K™—KšΟk	œXžœ˜zK˜•StartOfExpansion[]šΟb	œžœ
ž˜KšžœFžœ˜^Kšžœ˜
Kšœžœ
žœ˜—K˜š	œžœ
žœžœžœ˜7Kš
œ3˜3—Kšœžœžœžœ˜>Kš	œžœ
žœžœžœ˜Eš	œžœ
žœžœžœ˜/Kš
œR˜RK˜—šœžœ•
žœ]˜ŽK˜—šœžœŽ
žœ]˜€K˜šΟn
œ"˜/Kšœžœ˜!Jš
œ ˜ Kšžœžœ
˜#šžœžœ˜Kšžœ1˜3Kšžœ˜K˜—Kšžœ1˜3šžœž˜š
œ˜Kšžœ˜Kšžœ)˜+K˜—šœžœžœ
žœ
žœžœ
žœž˜RKšžœ˜Kšžœ-˜/Kšžœ
˜—Kšžœžœ
˜—K˜K˜—š 
œ˜'Kšœžœ˜#Kš
œ6˜6Kš
œ6˜6Kš
œ.˜.Kšžœžœ
žœ˜1šžœ˜Kš
œ)˜)šžœžœ
žœž˜*Kš
œ2˜2Kšžœ
˜—K˜—K˜K˜—š œ˜%Kšœžœ˜&Kšœžœ
˜
Kš
œ5˜5Kš
œ5˜5Kš
œ-˜-Kš
œ˜šžœžœ˜Kšœžœ˜.šžœžœ
žœž˜Kš
œ1˜1Kšžœ
˜—K˜—Kš
œ˜K˜K˜——š
 
œžœ
žœžœžœ˜Všžœžœž˜"Kšžœ.žœžœ˜MKšžœ
žœžœ
˜Kšžœ
˜—K˜K˜—š
 	œžœ
žœžœžœ˜Fšžœžœž˜Kšžœ&žœžœ˜AKšžœ
žœžœ
˜Kšžœ
˜—K˜K˜—š
 
œžœ
žœžœžœ˜Všžœžœž˜"Kšžœ.žœžœ˜MKšžœ
žœžœ
˜Kšžœ
˜—K˜K˜—š
 	œžœ
žœžœžœ˜Fšžœžœž˜Kšžœ&žœžœ˜AKšžœ
žœžœ
˜Kšžœ
˜—K˜K˜—š 
œžœ
žœ'žœžœžœ˜dKšœ0Οc˜?Kšœ7‘˜Fš œžœ
žœžœ˜@šžœ	žœ4žœ
žœ˜OKšœžœW˜nKš
œ>˜>šžœžœ˜Kšœžœ˜šžœžœ
žœž˜!Kš
œ&˜&Kšžœ
˜—K˜
—šžœ˜Kšœžœ
˜Kš
œ˜šžœž˜šœžœ˜Kšœ
žœ+˜8šžœžœ
žœž˜$K˜Kšžœ
˜—K˜—šœžœ˜Kšœ
žœ*˜7šžœžœ
žœž˜$Kšœžœ
˜Kšžœ
˜—K˜—Kš
œ3˜3Kš
œ4˜4Kš
œ3˜3Kšžœ
˜—Kšžœžœžœ^˜~š	žœžœ
žœ
žœž˜+Kš
œ!˜!š
œ
˜
Kš
œ˜šžœ
žœ
žœ˜Kšœ
žœ+˜8šžœžœ
žœž˜"Kš
œ˜Kšžœ
˜—Kš
œ
˜
—Kšžœ#˜'šžœž˜Kšœžœžœ
žœ
˜.Kš	œžœ
žœžœ
žœ
˜.Kšœžœ#žœ
žœ
˜5Kšœžœ#žœ
žœ
˜6Kšœžœ#žœ
žœ
˜5Kšžœ
˜—K˜
—Kšžœžœ
˜—K˜K˜—Kšžœ
žœ:žœ
žœ
˜KK˜—Kš
œ˜—š 
œžœ"˜2Kšœžœ:˜QKšžœ
žœ
žœžœ
žœAžœ
žœ
˜hKš	žœ
žœžœ
žœ‘$˜Gšžœžœ
žœž˜$K˜Kšžœ
˜—K˜—Kš
œ!˜!˜K˜——š
 	œžœ
žœ3žœžœ˜ZK˜š 	œ˜#Kš	œžœHžœžœžœ˜š
Kšžœžœ
žœ
žœ
˜K˜š	žœžœ
žœ
žœž˜+Kš
œ!˜!šœžœ
žœ
ž˜#šžœžœ
žœž˜"Kš
œ˜Kš
ž˜—š	žœ
žœžœ
žœž˜'Kš
œ˜Kšžœ
˜——Kšžœžœ
˜—K˜Kšœ	žœ
˜š
žœ	žœ
žœ
žœžœ
žœž˜6K˜Kšžœ
˜—š
žœ	žœ
žœ
žœžœ
žœž˜6Kšœ
žœ
˜Kšžœ
˜—Kš
œ˜Kš
œ˜Kš
œ˜K˜K˜—Kš
œ4˜4Kš
œ˜K˜—š
 œžœ*žœžœžœ˜cKšœžœ
˜Kšžœ
žœžœžœ˜7šžœ˜KšœC‘˜ZKš
œ˜K˜—K˜K˜—š
 œžœ
žœ„
žœžœ˜Ώ
Kš
Ϡ
˜†
K˜Kš
œ˜K˜—š
 	œžœ
žœžœžœ˜’
Kš	œžœ
žœžœžœ
˜#Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ
˜)K˜-K˜K˜—š œžœ
žœNžœ
žœžœ˜
š œžœžœ˜Kšœ*ž
˜+Kš
œE˜EK˜—š
žœžœ
žœžœžœžœ
ž˜;K˜Kšžœ
˜—K˜K˜—š œžœ
žœHžœ˜lKš	œ>žœžœ
žœžœ8˜›
Kš
œ˜K˜—š
 œžœ
žœfžœžœ˜
Kš	œžœ
žœžœžœ
˜#Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ˜'Kšžœžœ
žœ	žœ
˜)K˜*K˜K˜—š œžœ
žœ5žœ
žœžœ˜oš œžœžœ˜Kš
œ+˜+Kš
œ7˜7K˜—š
žœžœ
žœžœžœžœ
ž˜;K˜Kšžœ
˜—K˜K˜—š
 œžœ
žœžœ„
žœ˜°
š
œ7˜7šžœ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ"˜"——Kš
œ˜K˜—šΠbnœžœ
žœžœ
žœ
žœ˜Uš
žœžœ
žœ
žœžœžœ
ž˜4Kš
œB˜BKšžœ
˜—K˜K˜—š’œžœ
žœžœ
žœ
žœ4˜qš
žœžœ
žœ
žœžœžœ
ž˜4Kš
œQ˜QKšžœ
˜—K˜K˜—š œžœ
žœ,žœ1˜}KšœžœW˜nKšœžœžœ
žœ
žœ
žœžœžœ˜VKš	œžœžœ
žœžœ˜;Kš
œ˜K˜—š
 
œžœ
žœžœ
žœ˜CKš
œ.˜.š œžœžœ
žœ	˜Ašžœ
žœ2žœ˜>Kšžœ
žœ>žœ
žœ
˜OKšžœ
žœ˜š	žœ
žœžœ
žœž˜&Kš
œ)˜)Kšžœ
˜—K˜—K˜—Kš
œ˜Kš
œ˜K˜—š 	œžœ
žœžœžœ	žœ˜RKš
œ)˜)Kšžœ
žœ
žœ‘˜$K˜K˜—š œžœ
žœJžœžœžœ4žœžœ
žœ˜½
Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜(Kšžœžœ
žœ˜+Kšžœžœ
žœ˜+K˜K˜—š 
œžœ
žœ˜5K˜š œ˜Kšžœ)žœ)žœ
žœ
˜ašžœžœ˜%Kš
œ˜š
žœžœ
žœ
žœžœ
žœž˜<K˜"Kšžœ
˜—šžœž˜Kš
œ˜š
œ˜Kšžœ%žœ
žœ
˜2šžœžœ
žœž˜'Kš
œ&˜&Kšžœ
˜—K˜—Kš
œ˜š
œ˜Kšžœ%žœ
žœ
˜2šžœžœ
žœž˜'Kš
œ&˜&Kšžœ
˜—K˜—Kš
œ˜Kš
œ"˜"Kš
œ˜Kšžœžœ
˜—K˜—K˜K˜—Jšžœ#žœ
žœ
˜0Kš
œ˜K˜—š œžœ
žœ3˜NK˜š 	œ˜K˜š œžœ˜K˜š œ˜)šžœžœ˜Kšœžœ
˜Kš	œžœ)žœ,žœžœ˜›
šžœžœ
žœ˜Kš
œ+˜+šžœžœ
žœž˜%Kš
œ/˜/Kšžœ
˜—K˜—K˜—K˜K˜—Kšœ
žœ
˜Kšžœ
žœ,žœ
žœ
˜=Kšžœ˜K˜—K˜šžœžœ
žœž˜Ašœ
žœžœžœ˜:šžœž˜Kšœžœžœ˜0šœžœžœ
žœž˜-Kšžœ%žœ˜7Kšžœ
˜—Kšœžœžœ˜0šœžœžœ
žœž˜-Kšžœ%žœ˜7Kšžœ
˜—Kšœžœžœ˜0Kšœžœžœ˜3Kšœžœžœ˜0Kšžœžœ
˜—K˜—šœžœžœ
žœž˜1š	žœžœžœ
žœž˜QKšœžœ!žœžœ˜AKšœžœ!žœžœ˜AKšœžœžœ5žœ&žœžœ˜Š
Kšœžœžœ6žœ'žœžœ˜
Kšœžœžœ5žœ&žœžœ˜Š
Kšžœžœ
˜—Kšžœ
˜—Kšžœžœ
˜—K˜K˜—Jšžœ+žœ
žœ
˜8Kš
œ˜K˜—š
 
œžœ
žœžœžœ
˜2K˜—š
 
œžœ
žœDžœžœ˜vJšœ
žœ
˜Jšžœžœ)žœžœ&žœžœ&žœ
žœžœ‘˜ϋ
Jš
œ9˜9Jšžœžœžœ
žœ
˜$šžœžœ
žœž˜"Jšžœ9žœ
žœžœ˜NJšžœ
˜—Jšœžœ
˜
K˜K˜—š
 œžœ
žœGžœžœ˜xJšœ
žœ
˜Jš
œ3˜3Jšžœžœžœ
žœ
˜$šžœžœ
žœž˜šžœ˜Jš
œ	˜	Jšžœžœ
žœ
žœ
žœ
žœžœ
žœ
žœ
˜OJšœžœ
žœžœ˜%—Jšžœ
˜—Jšœžœ
˜
K˜K˜—š 
œžœžœžœ˜Lšžœžœ
žœ˜Kšœžœ˜&šžœžœ
žœž˜Kš
œ˜Kš
ž˜—K˜—K˜K˜—š
 œžœžœžœžœ˜@šžœž˜šœ
žœž˜Kš
œ	˜	Kš
œ	˜	Kš
œ˜Kšžœžœ
˜—Kš
œJ˜JKšœ
žœžœžœ˜)š
œ˜šžœžœ
žœž˜$Kšœžœžœžœ˜>Kšžœ
˜—K˜—Kš
œ:˜:Kš
œ<˜<š
œ˜Kšœžœ'˜>šžœžœ
žœž˜Kš	œžœžœžœžœ˜9Kšžœ
˜—Kš
œ:˜:K˜—Kšžœžœ
˜—Kš
œ˜K˜—
head™"š œžœ
žœžœ
˜&K˜—š œžœ
žœžœ˜3Kšœžœžœžœ˜0K˜—š œžœ
žœžœ˜6š	œžœžœ
žœžœ˜)K˜K˜
K˜—Kš
œ
˜
Kš
œ˜K˜—š œžœ
žœžœ˜5š	œžœžœ
žœžœ˜)K˜K˜
K˜—Kš
œ
˜
K˜K˜—š œžœ
žœžœ˜6š	œžœžœ
žœžœ˜)K˜K˜
K˜—Kš
œ
˜
Kš
œ˜K˜—š œžœ
žœžœ˜@Kš
žœžœžœžœ
žœ˜'Kšœžœžœžœžœžœžœžœžœ˜IKšœžœžœžœžœžœžœžœžœžœžœžœžœžœžœ˜vK˜K˜—š œžœ
žœ˜,Kš
žœžœ
žœ
žœžœ
˜8K˜K˜—š œžœ
žœ˜1Kš
žœžœ
žœžœžœ
˜9K˜K˜—š œžœ
žœ'˜9Kš
žœžœ
žœžœžœ
˜7K˜K˜—š œ œžœ
žœ"žœžœžœžœžœ˜‡
Kšœžœ˜'Kšœ	žœ
žœ
˜Kšœžœ
˜Kšœžœ˜Kšœžœžœ
˜Kšœžœžœ
˜Kšœ
žœ˜Kšžœžœ˜%Kš
œ-˜-Kšœžœžœžœžœžœ˜Xšžœžœ
žœž˜Kš
œ˜Kš
œ˜Kšžœ
žœ	ž˜šžœ˜Kšœžœ
˜
Kšžœ
žœ˜)K˜—Kš
œ"˜"šžœžœ
ž
˜#šžœ
žœ
ž˜Kš
œ8˜8˜
Kš
œ0˜0š	žœ	žœ
ž
œ
žœž˜1šœ,žœž˜MKš
œ˜Kš
œ˜Kš
œ˜Kšžœžœ˜—Kšžœ
˜—Kš
œ0˜0K˜—KšžœUžœ˜c—Kš
œ˜Kš
œ˜Kšœžœ
˜Kšœžœ
˜Kš
œ
˜
K˜—Kšžœ
˜—Kš
œ ˜ K˜K˜—š œžœžœžœ˜3šœžœž˜Kšœžœ
˜Kšœžœ˜Kšœžœ
˜
Kšžœžœ
˜—K˜K˜—Kšœžœžœ
žœ	žœ
žœ
˜0šœ
žœžœ
žœ	žœ
žœ
˜1K˜—š
 œžœ
žœžœžœ˜@Kšœžœ
žœ˜ Kšžœžœ
žœ
˜šžœžœ
žœž˜Kš
œ)˜)Kšžœ
˜—Kšœžœ	˜Kš
œ˜K™—š œžœ
žœžœžœ
žœ˜GKšœžœ
žœ˜!Kšžœžœ
žœ
˜šžœžœ
žœž˜Kš
œ)˜)Kšžœ
˜—Kšœžœžœ˜3Kš
œ˜K™K˜—š
 œžœ
žœžœ
žœ˜>šžœžœ
žœž˜Kšœ	žœ˜Kšœžœžœ
žœ+žœ
žœ0žœžœ˜’
Kšžœ
˜—Kš
œ˜K™K˜——Kšžœ
˜K˜—…—SqΊ