PortsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, March 4, 1986 5:14:37 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];
PortData: TYPE = REF PortDataRec;
PortDataRec:
TYPE =
RECORD [
type: PortType,
drive: Drive];
CreatePort:
PUBLIC
PROC [wire: Core.Wire, testerPort:
BOOL ←
FALSE]
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];
};
PortRope:
PROC [port: Port]
RETURNS [value: Core.
ROPE ←
NIL] = {
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, base:
NAT ← 16]
RETURNS [val: Core.
ROPE ←
NIL] = {
bitsPerDigit: NAT ← BitHacks.NBits[base];
scratch: REF TEXT ← RefText.New[(size/bitsPerDigit)+1];
bitsInDigit: NAT ← IF size MOD bitsPerDigit = 0 THEN bitsPerDigit ELSE size MOD bitsPerDigit;
digitBitCount: NAT ← 0;
allX: BOOL ← TRUE;
someX: BOOL ← FALSE;
digitVal: CARDINAL ← 0;
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.