
    <<PortsImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Barth, December 19, 1985 1:43:30 pm PST>>
        <<Last Edited by: Gasbarro December 19, 1985 5:59:44 pm PST>>
        <<>>
    DIRECTORY Core, CoreOps, CoreProperties, RefTab, Ports;

    PortsImpl: CEDAR PROGRAM
        IMPORTS CoreOps, CoreProperties, RefTab
        EXPORTS Ports
        = BEGIN OPEN Ports;

    portDataAtom: ATOM _ $PortData;
    PortData: TYPE = REF PortDataRec;
    PortDataRec: TYPE = RECORD [
        type: PortType,
        drive: Drive];

    CreatePort: PUBLIC PROC [wire: Core.Wire] 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;
                    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] = {
        CoreProperties.PutWireProp[on: wire, prop: portDataAtom, value:
            NEW[PortDataRec _ [
                type: initType,
                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];
        };

    PrintPort: PUBLIC PROC [wire: Core.Wire, port: Port, out: Core.STREAM] = {
        ERROR; -- not yet implemented
        };

    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 [truth: Port, question: Port] = {

        CheckBits: EachPortPairProc = {
            IF onePort.type#composite AND (onePort.d=expect OR onePort.d=force) THEN {
                SELECT onePort.type FROM
                    l => IF anotherPort.l#onePort.l THEN SIGNAL CheckError[];
                    ls => FOR bit: NAT IN [0..onePort.ls.size) DO
                        IF anotherPort.ls[bit]#onePort.ls[bit] THEN SIGNAL CheckError[];
                        ENDLOOP;
                    b => IF anotherPort.b#onePort.b THEN SIGNAL CheckError[];
                    bs => FOR bit: NAT IN [0..onePort.bs.size) DO
                        IF anotherPort.bs[bit]#onePort.bs[bit] THEN SIGNAL CheckError[];
                        ENDLOOP;
                    c => IF anotherPort.c#onePort.c THEN SIGNAL CheckError[];
                    lc => IF anotherPort.lc#onePort.lc THEN SIGNAL CheckError[];
                    ENDCASE => ERROR;
                };
            };

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

    CheckError: PUBLIC SIGNAL = 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.