PortsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, April 4, 1986 5:23:22 pm PST
Last Edited by: Gasbarro January 23, 1986 11:40:29 am PST
Bertrand Serlet January 27, 1986 4:02:52 pm PST
DIRECTORY BitHacks, Convert, Core, CoreOps, CoreProperties, IO, RefTab, RefText, Rope, Ports;
PortsImpl: CEDAR PROGRAM
IMPORTS BitHacks, Convert, CoreOps, CoreProperties, IO, RefTab, RefText, Rope
EXPORTS Ports
= BEGIN OPEN Ports;
portDataAtom: ATOM ← CoreProperties.RegisterProperty[prop: $PortData];
portTesterDriveAtom: ATOM ← CoreProperties.RegisterProperty[prop: $PortTesterDrive];
CreatePort: PUBLIC PROC [wire: Core.Wire, testerPort: BOOLFALSE] RETURNS [port: Port] = {
wireTab: 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.GetWireProp[from: wire, prop: portDataAtom]];
type: PortType ← IF data=NIL THEN IF wire.size=0 THEN b ELSE composite ELSE data.type;
IF type=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.type ← type;
IF testerPort THEN {
testerDrive: REF Drive ← NARROW[CoreProperties.GetWireProp[from: wire, prop: portTesterDriveAtom]];
port.d ← IF testerDrive=NIL THEN none ELSE testerDrive^;
}
ELSE port.d ← IF data=NIL THEN none ELSE data.drive;
SELECT type 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];
ENDCASE;
};
IF NOT RefTab.Insert[x: wireTab, key: wire, val: port] THEN ERROR;
};
};
port ← MakePort[wire];
};
InitPort: PUBLIC PROC [wire: Core.Wire, initType: PortType ← b, initDrive: Drive ← none] RETURNS [sameWire: Core.Wire] = {
CoreProperties.PutWireProp[on: wire, prop: portDataAtom, value:
NEW[PortDataRec ← [
type: initType,
drive: initDrive]]];
sameWire ← wire;
};
InitTesterDrive: PUBLIC PROC [wire: Core.Wire, initDrive: Drive ← none] = {
CoreProperties.PutWireProp[on: wire, prop: portTesterDriveAtom, value:
NEW[Drive ← initDrive]];
};
WirePortType: PUBLIC PROC [wire: Core.Wire] RETURNS [type: PortType] = {
data: PortData ← NARROW[CoreProperties.GetWireProp[from: wire, prop: portDataAtom]];
type ← IF data=NIL THEN IF wire.size=0 THEN b ELSE composite ELSE data.type;
};
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] = {
index ← CoreOps.GetWireIndex[wire, name];
IF index=-1 THEN ERROR; -- not found
};
PortRope: PROC [port: Port] RETURNS [value: Core.ROPENIL] = {
SELECT port.type 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];
ENDCASE => ERROR;
};
LevelSequenceToRope: PUBLIC PROC [container: LevelSequence, size: NAT ← 0, base: NAT ← 16] RETURNS [val: Core.ROPENIL] = {
bitsPerDigit: NAT ← BitHacks.NBits[base];
scratch: REF TEXT;
bitsInDigit: NAT;
digitBitCount: NAT ← 0;
allX: BOOLTRUE;
someX: BOOLFALSE;
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];
};
CopyPortValue: PUBLIC PROC [from: Port, to: Port] = {
CopyBits: EachPortPairProc = {
IF onePort.type#composite THEN {
anotherPort.d ← onePort.d;
SELECT onePort.type 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;
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.GetFullWireNames[root, wire].first], IO.rope[PortRope[onePort]], IO.rope[PortRope[anotherPort]]];
};
};
msg: Core.ROPE;
IF NOT VisitBinding[root, truth, SetErrorMessage] THEN ERROR;
SIGNAL CheckError[msg];
};
IF onePort.type#composite AND (onePort.d=expect OR onePort.d=force) THEN {
SELECT onePort.type 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[];
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.type#anotherPort.type OR (onePort.type=ls AND anotherPort.ls.size#onePort.ls.size) OR (onePort.type=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.type#composite THEN NIL ELSE port[i],
eachWirePortPair] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
END.