PortsImpl.mesa
Copyright © 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
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;
};
Logical Operations and Conversions
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.