
    <<SoftHdwAssemblyImpl.mesa>>
        <<Copyright Ó 1988 by Xerox Corporation.  All rights reserved.>>
        <<Barth, September 7, 1989 4:50:39 pm PDT>>
        <<>>
    DIRECTORY CD, CDBasics, CDCells, CDDirectory, CDImports, CDInstances, CDOps, CDProperties, CDRects, CDTexts, DABasics, ExtractOps, 
    FS, IO, PW, RefTab, Rope, SoftHdwAssembly, SoftHdwBasics, SymTab, TerminalIO, ViewerClasses;

    SoftHdwAssemblyImpl: CEDAR PROGRAM
        IMPORTS CD, CDBasics, CDCells, CDDirectory, CDImports, CDInstances, CDOps,  CDProperties, CDRects, CDTexts, ExtractOps, FS, IO, PW, 
        RefTab, Rope, SoftHdwBasics, SymTab, TerminalIO
        EXPORTS SoftHdwAssembly
        = BEGIN OPEN SoftHdwAssembly;
<<Program Creation>>
    Create: PUBLIC PROC [instances: ProgramInstances _ NIL, tiles: ArrayPositions _ NIL, coordinates: Coordinates _ MinorArray, object: 
    CD.Object _ NIL] RETURNS [program: Program] = {
        program _ NEW[ProgramRec _ [
            tiles: tiles,
            instances: instances,
            coordinates: coordinates,
            object: object]];
        };

    Instance: PUBLIC PROC [program: Program, minorArray: Position _ [0, 0], chip: Position _ [0, 0], rotation: Rotation _ None] RETURNS 
    [instance: ProgramInstance]= {
        instance _ NEW[ProgramInstanceRec _ [
            program: program,
            rotation: rotation,
            chip: chip,
            minorArray: minorArray]];
        };

    CPI: PUBLIC PROC [old: ProgramInstances, program: Program, minorArray: Position _ [0, 0], chip: Position _ [0, 0], rotation: 
    Rotation _ None] RETURNS [new: ProgramInstances] = {
        new _ CONS[Instance[program, minorArray, chip, rotation], old];
        };

    CTI: PUBLIC PROC [old: ArrayPositions, type: TileType, orientation: Orientation, grain: Position, minorArray: Position _ [0, 0], 
    chip: Position _ [0, 0]] RETURNS [new: ArrayPositions] = {
        tile: ArrayPosition _ SoftHdwBasics.CreateArrayPosition[type, orientation, grain, minorArray, chip];
        IF NOT (type IN TileType) THEN ERROR;
        new _ CONS[tile, old];
        };

AbutX: PUBLIC PROC [t1, t2, t3, t4, t5, t6: Program _ NIL] RETURNS [program: Program] = {
subPrograms: Programs _ NIL;
IF t6#NIL THEN subPrograms _ CONS[t6, subPrograms];
IF t5#NIL THEN subPrograms _ CONS[t5, subPrograms];
IF t4#NIL THEN subPrograms _ CONS[t4, subPrograms];
IF t3#NIL THEN subPrograms _ CONS[t3, subPrograms];
IF t2#NIL THEN subPrograms _ CONS[t2, subPrograms];
IF t1#NIL THEN subPrograms _ CONS[t1, subPrograms];
program _ AbutXList[subPrograms];
};
<<>>
AbutXList: PUBLIC PROC [subPrograms: Programs] RETURNS [program: Program] = {
instances: ProgramInstances _ NIL;
position: Position _ [0, 0];
coordinates: Coordinates _ IF subPrograms=NIL THEN Grain ELSE subPrograms.first.coordinates;
FOR sp: Programs _ subPrograms, sp.rest UNTIL sp=NIL DO
IF coordinates#sp.first.coordinates THEN ERROR;
instances _ ConsByCoordinate[instances, sp.first, position];
position.x _ position.x + Size[sp.first].x;
ENDLOOP;
program _ Create[instances: instances, coordinates: coordinates];
};
<<>>
AbutY: PUBLIC PROC [t1, t2, t3, t4, t5, t6: Program _ NIL] RETURNS [program: Program] = {
subPrograms: Programs _ NIL;
IF t6#NIL THEN subPrograms _ CONS[t6, subPrograms];
IF t5#NIL THEN subPrograms _ CONS[t5, subPrograms];
IF t4#NIL THEN subPrograms _ CONS[t4, subPrograms];
IF t3#NIL THEN subPrograms _ CONS[t3, subPrograms];
IF t2#NIL THEN subPrograms _ CONS[t2, subPrograms];
IF t1#NIL THEN subPrograms _ CONS[t1, subPrograms];
program _ AbutYList[subPrograms];
};
<<>>
AbutYList: PUBLIC PROC [subPrograms: Programs] RETURNS [program: Program] = {
instances: ProgramInstances _ NIL;
position: Position _ [0, 0];
coordinates: Coordinates _ IF subPrograms=NIL THEN Grain ELSE subPrograms.first.coordinates;
FOR sp: Programs _ subPrograms, sp.rest UNTIL sp=NIL DO
IF coordinates#sp.first.coordinates THEN ERROR;
instances _ ConsByCoordinate[instances, sp.first, position];
position.y _ position.y + Size[sp.first].y;
ENDLOOP;
program _ Create[instances: instances, coordinates: coordinates];
};
<<>>
ArrayX: PUBLIC PROC [program: Program, nx: INT] RETURNS [array: Program] = {
instances: ProgramInstances _ NIL;
position: Position _ [0, 0];
xSize: INT _ Size[program].x;
FOR count: INT IN [0..nx) DO
instances _ ConsByCoordinate[instances, program, position];
position.x _ position.x + xSize;
ENDLOOP;
array _ Create[instances: instances, coordinates: program.coordinates];
};
<<>>
ArrayY: PUBLIC PROC [program: Program, ny: INT] RETURNS [array: Program] = {
instances: ProgramInstances _ NIL;
position: Position _ [0, 0];
ySize: INT _ Size[program].y;
FOR count: INT IN [0..ny) DO
instances _ ConsByCoordinate[instances, program, position];
position.y _ position.y + ySize;
ENDLOOP;
array _ Create[instances: instances, coordinates: program.coordinates];
};
<<>>
ConsByCoordinate: PROC [old: ProgramInstances, program: Program, position: Position] RETURNS [new: ProgramInstances] = {
new _ SELECT program.coordinates FROM
Grain => ERROR,
MinorArray => CPI[old: old, program: program, minorArray: position],
Chip => CPI[old: old, program: program, chip: position],
ENDCASE => ERROR;
};

<<Parse And Print>>
<<Geometric Constants and Utilities>>
    Number: TYPE = DABasics.Number;
    lambda: Number _ 8;
    grainSize: Number _ 24*lambda;
    longIndent: Number _ 16*lambda;
    minorArraySpacing: Number _ 2*longIndent;
    interChipSize: Number _ 32*lambda;
    chipSpacing: Number _ 2*interChipSize;
    chipMinorArrayOffset: Position _ [16*lambda, 16*lambda];
    minorArrayGrainOffset: Position _ [minorArraySpacing, minorArraySpacing];
    rotationToCDOrientation: ARRAY Rotation OF CD.Orientation _ [original, rotate90X];
    orientationToCDOrientation: ARRAY Orientation OF CD.Orientation _ [rotate90X, original];

    MinorArrayChipSize: PROC [sizes: ArrayPosition] RETURNS [minorArraySize: Position, chipSize: Position] = {
        minorArraySize _ [sizes.grain.x*grainSize+minorArraySpacing, sizes.grain.y*grainSize+minorArraySpacing];
        chipSize _ [sizes.minorArray.x*minorArraySize.x+chipSpacing, sizes.minorArray.y*minorArraySize.y+chipSpacing];
        };
<<Parse>>
    Parse: PUBLIC PROC [object: CD.Object] RETURNS [program: Program] = {
        ParseRecursive: PROC [object: CD.Object] RETURNS [program: Program _ NIL, tileType: TileType _ InputEnabled] = {
            program _ NARROW[RefTab.Fetch[map, object].val];
            IF program=NIL THEN {
                instances: ProgramInstances _ NIL;
                tiles: ArrayPositions _ NIL;
                base: Position _ CD.InterestBase[object];
                One: CDCells.InstEnumerator = {
                    subProgram: Program;
                    subTileType: TileType;
                    trans: CD.Transformation _ [CDBasics.SubPoints[CDBasics.MapPoint[CD.InterestBase[inst.ob], inst.trans], base], inst.trans.orient];
                    IF CDTexts.IsText[inst.ob] THEN RETURN;
                    [subProgram, subTileType] _ ParseRecursive[inst.ob];
                    IF subProgram=NIL THEN {
                        p: ArrayPositionRec _ TransformationToTile[minorArraySize, chipSize, trans, subTileType];
                        tiles _ CTI[tiles, p.type, p.orientation, p.grain, p.minorArray, p.chip];
                        }
                    ELSE {
                        rotation: Rotation _ SELECT trans.orient FROM
                            original => None,
                            rotate90X => Rotate90FlipX,
                            ENDCASE => ERROR;
                        chip, minorArray: Position;
                        [chip, minorArray] _ OffsetToProgram[minorArraySize, chipSize, trans.off];
                        instances _ CPI[instances, subProgram, minorArray, chip, rotation];
                        };
                    };
                leafName: Rope.ROPE;
                UNTIL CDCells.IsCell[object] DO
                    object _ CDDirectory.Expand1[object].new;
                    ENDLOOP;
                leafName _ NARROW[CDProperties.GetObjectProp[object, $SoftHdwLeaf]];
                IF leafName#NIL THEN {
                    FOR index: TileType IN TileType DO
                        IF Rope.Equal[leafName, tileNames[index]] THEN {
                            tileType _ index;
                            RETURN;
                            };
                        ENDLOOP;
                    ERROR;
                    };
                [] _ CDCells.EnumerateInstances[object, One];
                program _ Create[instances, tiles, MinorArray, object];
                IF NOT RefTab.Store[map, object, program] THEN ERROR;
                };
            };
        map: RefTab.Ref _ RefTab.Create[];
        minorArraySize, chipSize: Position;
        sizes: ArrayPosition _ NEW[ArrayPositionRec];
        sizes.chip _ [1, 1];
        sizes.minorArray _ [LAST[Number], LAST[Number]];
        sizes.grain _ [4, 4];
        [minorArraySize, chipSize] _ MinorArrayChipSize[sizes];
        program _ ParseRecursive[object].program;
        IF program=NIL THEN ERROR;  -- an isolated tile is not a program
        };

    OffsetToProgram: PROC [minorArraySize, chipSize: Position, offset: Position] RETURNS [chip, minorArray, remainder: Position] = {
        chip _ [0,0];  -- hack, only parse MinorArray coordinate system for now
        minorArray.x _ offset.x/minorArraySize.x;
        minorArray.y _ offset.y/minorArraySize.y;
        offset.x _ offset.x - minorArray.x*minorArraySize.x;
        offset.y _ offset.y - minorArray.y*minorArraySize.y;
        remainder _ offset;
        };

    TransformationToTile: PROC [minorArraySize, chipSize: Position, trans: CD.Transformation, type: TileType] RETURNS [tile: 
    ArrayPositionRec] = {
        tile.type _ type;
        tile.orientation _ SELECT trans.orient FROM
            original => Horizontal,
            rotate90X => Vertical,
            ENDCASE => ERROR;
        [tile.chip, tile.minorArray, trans.off] _ OffsetToProgram[minorArraySize, chipSize, trans.off];
        SELECT type FROM
            OToP, RUToP, LDToP, LToP, PToI, PToRU, PToLD, PToL => ERROR;
            ORUToI, LDToLD, OLDToI, ORUToL, Tristate, RUToRU, ORUToLD, LDToI, OLDToRU, LToI, RUToI, Inverter, FlipFlop, ParallelInput, 
            InputEnabled => {
                trans.off _ CDBasics.SubPoints[trans.off, minorArrayGrainOffset];
                tile.grain.x _ trans.off.x/grainSize;
                tile.grain.y _ trans.off.y/grainSize;
                trans.off _ CDBasics.SubPoints[trans.off, [tile.grain.x*grainSize, tile.grain.y*grainSize]];
                SELECT TRUE FROM
                    tile.grain.x>=0 AND tile.grain.y>=0 => {
                        tile.type _ InputEnabled;
                        tile.orientation _ SELECT trans.off FROM
                            [16*lambda, 12*lambda] => Vertical,
                            [12*lambda, 16*lambda] => Horizontal,
                            ENDCASE => ERROR;
                        };
                    tile.type=ParallelInput => {
                        SELECT TRUE FROM
                            tile.grain.x<0 => {
                                tile.orientation _ Horizontal;
                                tile.grain.x _ 0;
                                };
                            tile.grain.y<0 => {
                                tile.orientation _ Vertical;
                                tile.grain.y _ 0;
                                };
                            ENDCASE => ERROR;
                        }
                    ENDCASE => SELECT tile.orientation FROM
                        Horizontal => tile.grain.x _ 0;
                        Vertical => tile.grain.y _ 0;
                        ENDCASE => ERROR;
                };
            RAMEven, RAMOdd => IF trans.off#[0,0] OR tile.orientation#Horizontal THEN ERROR;
            ENDCASE => ERROR;
        };

    CDToArrayPosition: PUBLIC PROC [sizes: ArrayPosition, coordinates: Coordinates, mouse: Position] RETURNS [ambiguous: BOOL _ FALSE, 
    position: ArrayPosition _ NIL] = {
        ProbeNodeType: TYPE = {pLong, pInput, pOutput, pLeftDown, pRightUp, pInputEnabled};
        probeNodeTypeToNodeType: ARRAY ProbeNodeType OF NodeType = [Long, Input, Output, LeftDown, RightUp, InputEnabled];
        probePositions: ARRAY Orientation OF ARRAY ProbeNodeType OF Position = [
            [[4*lambda, 0*lambda],  -- Vertical Long
            [16*lambda, 0*lambda],  -- Vertical Input
            [20*lambda, 0*lambda],  -- Vertical Output
            [8*lambda, 0*lambda],  -- Vertical LeftDown
            [12*lambda, 0*lambda],  -- Vertical RightUp
            [20*lambda, 16*lambda]],  -- Vertical InputEnabled
            [[0*lambda, 4*lambda],  -- Horizontal Long
            [0*lambda, 16*lambda],  -- Horizontal Input
            [0*lambda, 20*lambda],  -- Horizontal Output
            [0*lambda, 8*lambda],  -- Horizontal LeftUp
            [0*lambda, 12*lambda],  -- Horizontal RightDown
            [16*lambda, 20*lambda]]];  -- Horizontal InputEnabled
        minorArraySize, chipSize: Position;
        minorMouse: Position;
        [minorArraySize, chipSize] _ MinorArrayChipSize[sizes];
        IF coordinates#MinorArray THEN ERROR;  -- nyi
        position _ NEW[ArrayPositionRec];
        [position.chip, position.minorArray, mouse] _ OffsetToProgram[minorArraySize, chipSize, mouse];
        minorMouse _ mouse;
        mouse _ CDBasics.SubPoints[mouse, minorArrayGrainOffset];
        position.grain _ [mouse.x/grainSize, mouse.y/grainSize];
        mouse _ CDBasics.SubPoints[mouse, [position.grain.x*grainSize, position.grain.y*grainSize]];
        SELECT TRUE FROM
            minorMouse.x<minorArraySpacing AND mouse.y=probePositions[Horizontal][pLong].y => {
                position.type _ Long;
                position.orientation _ Horizontal;
                };
            minorMouse.x=minorArraySize.x => FOR pnt: ProbeNodeType IN ProbeNodeType DO
                IF mouse.y=probePositions[Horizontal][pnt].y THEN {
                    position.type _ probeNodeTypeToNodeType[pnt];
                    position.orientation _ Horizontal;
                    EXIT;
                    };
                REPEAT FINISHED => RETURN[TRUE, NIL]
                ENDLOOP;
            minorMouse.y<minorArraySpacing AND mouse.x=probePositions[Vertical][pLong].x => {
                position.type _ Long;
                position.orientation _ Vertical;
                };
            minorMouse.y=(minorArraySize.y-minorArraySpacing) => FOR pnt: ProbeNodeType IN ProbeNodeType DO
                IF mouse.x=probePositions[Horizontal][pnt].x THEN {
                    position.type _ probeNodeTypeToNodeType[pnt];
                    position.orientation _ Vertical;
                    EXIT;
                    };
                REPEAT FINISHED => RETURN[TRUE, NIL]
                ENDLOOP;
            ENDCASE => {
                FOR orient: Orientation IN Orientation DO
                    FOR pnt: ProbeNodeType IN ProbeNodeType DO
                        IF probePositions[orient][pnt]=mouse THEN {
                            position.type _ probeNodeTypeToNodeType[pnt];
                            position.orientation _ orient;
                            GOTO found;
                            };
                        ENDLOOP;
                    REPEAT
                        found => NULL;
                        FINISHED => RETURN[TRUE, NIL];
                    ENDLOOP;
                };
        SELECT position.type FROM
            InputEnabled => NULL;
            Long => SELECT position.orientation FROM
                Vertical => {
                    position.minorArray.y _ 0;
                    position.grain.y _ 0;
                    };
                Horizontal => {
                    position.minorArray.x _ 0;
                    position.grain.x _ 0;
                    };
                ENDCASE;
            Input, Output, LeftDown, RightUp => SELECT position.orientation FROM
                Vertical => position.grain.y _ 0;
                Horizontal => position.grain.x _ 0;
                ENDCASE;
            ENDCASE => ERROR;
        };

<<Print>>
    Print: PUBLIC PROC [sizes: ArrayPosition, program: Program] RETURNS [object: CD.Object] = {
        PrintRecursive: PROC [program: Program] RETURNS [object: CD.Object] = {
            object _ NARROW[RefTab.Fetch[map, program].val];
            IF object=NIL THEN {
                ConsInstance: PROC [object: CD.Object, trans: CD.Transformation] = {
                    trans.off _ CDBasics.SubPoints[trans.off, CDBasics.OrientedSize[CD.InterestBase[object], trans.orient]];
                    il _ CONS[CDInstances.NewInst[object, trans], il];
                    };
                il: CD.InstanceList _ NIL;
                size: Position _ Size[program];
                multiplier: Position _ SELECT program.coordinates FROM
                    Grain => ERROR,
                    MinorArray => minorArraySize,
                    Chip => chipSize,
                    ENDCASE => ERROR;
                upperRight: Position _ [size.x*multiplier.x, size.y*multiplier.y];
                FOR tiles: ArrayPositions _ program.tiles, tiles.rest UNTIL tiles=NIL DO
                    tile: ArrayPosition _ tiles.first;
                    subObject: CD.Object _ tileObjects[tile.type];
                    subTrans: CD.Transformation _ TileToTransformation[minorArraySize, chipSize, tile];
                    ConsInstance[subObject, subTrans];
                    ENDLOOP;
                FOR instances: ProgramInstances _ program.instances, instances.rest UNTIL instances=NIL DO
                    instance: ProgramInstance _ instances.first;
                    subObject: CD.Object _ PrintRecursive[instance.program];
                    subTrans: CD.Transformation _ ProgramToTransformation[minorArraySize, chipSize, instance.chip, instance.minorArray];
                    subTrans.orient _ rotationToCDOrientation[instance.rotation];
                    IF instance.program.coordinates=MinorArray AND program.coordinates=Chip THEN subTrans.off _ CDBasics.AddPoints[subTrans.off, 
                    chipMinorArrayOffset];
                    <<Really need to adjust for any shift in coordinate systems.>>
                    ConsInstance[subObject, subTrans];
                    ENDLOOP;
                IF program.coordinates=MinorArray THEN upperRight _ CDBasics.AddPoints[upperRight, [minorArraySpacing, minorArraySpacing]];
                object _ PW.CreateCell[il, [0, 0, upperRight.x, upperRight.y]];
                IF NOT RefTab.Store[map, program, object] THEN ERROR;
                };
            };
        map: RefTab.Ref _ RefTab.Create[];
        minorArraySize, chipSize: Position;
        [minorArraySize, chipSize] _ MinorArrayChipSize[sizes];
        IF sizes.grain # [4,4] THEN ERROR;
        object _ PrintRecursive[program];
        };

    PrintAndDraw: PUBLIC PROC [sizes: ArrayPosition, program: Program] RETURNS [design: CD.Design] = {
        il: CD.InstanceList _ NIL;
        programObject: CD.Object _ Print[sizes, program];
        arrayObject: CD.Object _ CreateArray[sizes, program];
        programInterestBase: Position _ CD.InterestBase[programObject];
        arrayInterestBase: Position _ CD.InterestBase[arrayObject];
        il _ CONS[CDInstances.NewInst[programObject, [[-programInterestBase.x, -programInterestBase.y], original]], il];
        il _ CONS[CDInstances.NewInst[arrayObject, [[-arrayInterestBase.x, -arrayInterestBase.y], original]], il];
        design _ PW.Draw[PW.CreateCell[il]];
        };

    ProgramToTransformation: PROC [minorArraySize, chipSize: Position, chip: Position, minorArray: Position] RETURNS [trans: 
    CD.Transformation _ [[0, 0], original]] = {
        trans.off.x _ chip.x*chipSize.x;
        trans.off.y _ chip.y*chipSize.y;
        trans.off.x _ trans.off.x + minorArray.x*minorArraySize.x;
        trans.off.y _ trans.off.y + minorArray.y*minorArraySize.y;
        };

    TileToTransformation : PROC [minorArraySize, chipSize: Position, tile: ArrayPosition] RETURNS [trans: CD.Transformation _ [[0, 0], 
    original]] = {
        typeOffset: Position _ SELECT tile.type FROM
            OToP, RUToP, LDToP, LToP, PToI, PToRU, PToLD, PToL => ERROR,
            ORUToI, LDToLD, OLDToI, ORUToL, Tristate, RUToRU, ORUToLD, LDToI, OLDToRU, LToI, RUToI, Inverter, FlipFlop, Master => [0, 32],
            ParallelInput => [28, 48],
            InputEnabled => [44, 48],
            RAMEven, RAMOdd => [0, 0],
            Input => [30, 48],
            Output => [30, 52],
            LeftDown => [32, 40],
            RightUp => [32, 44],
            Long => [16, 36],
            ENDCASE => ERROR;
        typeOffset _ [typeOffset.x*lambda, typeOffset.y*lambda];
        trans _ ProgramToTransformation[minorArraySize, chipSize, tile.chip, tile.minorArray];
        trans.orient _ orientationToCDOrientation[tile.orientation];
        trans.off.x _ trans.off.x + tile.grain.x*grainSize;
        trans.off.y _ trans.off.y + tile.grain.y*grainSize;
        trans.off _ CDBasics.AddPoints[trans.off, SELECT tile.orientation FROM
            Vertical => [typeOffset.y, typeOffset.x],
            Horizontal => [typeOffset.x, typeOffset.y],
            ENDCASE => ERROR];
        };

    CreateArray: PROC [sizes: ArrayPosition, program: Program] RETURNS [object: CD.Object] = {
        minorArray: CD.Object _ baseObjects[MinorArray];
        size: Position _ Size[program];
        SELECT program.coordinates FROM
            Grain => ERROR;  -- should paint inside of minor array
            MinorArray => {
                <<should construct minor array from more primitive components>>
                inner: CD.Object _ PW.Array[minorArray, size.x, size.y];
                ir: CD.Rect _ CDBasics.Extend[CD.InterestRect[inner], 16*8];
                object _ PW.CreateCell[LIST[CDInstances.NewInst[inner, [[0,0],original]]], ir];
                };
            Chip => {
                inner: CD.Object _ PW.Array[minorArray, sizes.minorArray.x, sizes.minorArray.y];
                boardTraces: CD.Object _ baseObjects[BoardTraces];
                boardTracesSize: DABasics.Position _ CD.InterestSize[boardTraces];
                corner: CD.Object _ baseObjects[Corner];
                side: CD.Object _ PW.ArrayY[boardTraces, sizes.minorArray.y];
                middle: CD.Object _ PW.AbutX[PW.FlipX[side], inner, side];
                top: CD.Object _ PW.AbutX[corner, PW.ArrayX[PW.FlipX[PW.Rot90[boardTraces]], sizes.minorArray.x], corner];
                bottom: CD.Object _ PW.AbutX[corner, PW.ArrayX[PW.FlipY[PW.FlipX[PW.Rot90[boardTraces]]], sizes.minorArray.x], corner];
                chip: CD.Object _ PW.AbutY[bottom, middle, top];
                object _ PW.Array[chip, size.x, size.y]
                };
            ENDCASE => ERROR;
        };

    Stats: PUBLIC PROC [program: Program] = {
        RecursiveStats: PROC [program: Program] = {
            FOR instances: ProgramInstances _ program.instances, instances.rest UNTIL instances=NIL DO
                instance: ProgramInstance _ instances.first;
                RecursiveStats[instance.program];
                ENDLOOP;
            FOR tiles: ArrayPositions _ program.tiles, tiles.rest UNTIL tiles=NIL DO
                tile: ArrayPosition _ tiles.first;
                IF tile.type=FlipFlop THEN {
                    TerminalIO.PutRope["\n"];
                    TerminalIO.PutRope[SoftHdwBasics.ArrayPositionToRope[tile]];
                    };
                ENDLOOP;
            };
        RecursiveStats[program];
        };

    Pickle: PUBLIC PROC [program: Program, fileName: Rope.ROPE] = {
        RecursivePickle: PROC [program: Program] = {
            id: Rope.ROPE _ NARROW[RefTab.Fetch[map, program].val];
            IF id=NIL THEN {
                size: INT _ 0;
                id _ IO.PutFR["P%g", IO.int[nextID]];
                nextID _ nextID + 1;
                IF NOT RefTab.Insert[map, program, id] THEN ERROR;
                IO.PutF[stream,"%g ", IO.rope[id]];
                FOR instances: ProgramInstances _ program.instances, instances.rest UNTIL instances=NIL DO
                    size _ size + 1;
                    ENDLOOP;
                IO.PutF[stream, "%g ", IO.int[size]];
                FOR instances: ProgramInstances _ program.instances, instances.rest UNTIL instances=NIL DO
                    instance: ProgramInstance _ instances.first;
                    RecursivePickle[instance.program];
                    IO.PutF[stream, "%g ", IO.rope[SELECT instance.rotation FROM
                        None => "N",
                        Rotate90FlipX => "R",
                        ENDCASE => ERROR]];
                    PutPosition[instance.chip];
                    PutPosition[instance.minorArray];
                    ENDLOOP;
                size _ 0;
                FOR tiles: ArrayPositions _ program.tiles, tiles.rest UNTIL tiles=NIL DO
                    size _ size + 1;
                    ENDLOOP;
                IO.PutF[stream, "%g ", IO.int[size]];
                FOR tiles: ArrayPositions _ program.tiles, tiles.rest UNTIL tiles=NIL DO
                    tile: ArrayPosition _ tiles.first;
                    IO.PutF[stream, """%g"" ", IO.rope[SoftHdwBasics.ArrayPositionToRope[tile]]]
                    ENDLOOP;
                IO.PutF[stream, "%g ", IO.rope[SELECT program.coordinates FROM
                    Grain => "G",
                    MinorArray => "M",
                    Chip => "C",
                    ENDCASE => ERROR]];
                }
            ELSE IO.PutF[stream,"%g ", IO.rope[id]];
            };
        PutPosition: PROC [position: Position] = {
            IO.PutF[stream, "%g %g ", IO.int[position.x], IO.int[position.y]];
            };
        stream: IO.STREAM _ FS.StreamOpen[fileName, $create];
        map: RefTab.Ref _ RefTab.Create[];
        nextID: INT _ 0;
        RecursivePickle[program];
        IO.Close[stream];
        };

    Unpickle: PUBLIC PROC [fileName: Rope.ROPE] RETURNS [program: Program] = {
        RecursiveUnpickle: PROC RETURNS [program: Program] = {
            id: Rope.ROPE _ IO.GetID[stream];
            IF (program _ NARROW[SymTab.Fetch[map, id].val])=NIL THEN {
                size: INT _ 0;
                program _ NEW[ProgramRec];
                IF NOT SymTab.Insert[map, id, program] THEN ERROR;
                size _ IO.GetInt[stream];
                THROUGH [0..size) DO
                    instance: ProgramInstance _ NEW[ProgramInstanceRec];
                    instance.program _ RecursiveUnpickle[];
                    id _ IO.GetID[stream];
                    instance.rotation _ SELECT TRUE FROM
                        Rope.Equal[id, "N"] => None,
                        Rope.Equal[id, "R"] => Rotate90FlipX,
                        ENDCASE => ERROR;
                    instance.chip _ GetPosition[];
                    instance.minorArray _ GetPosition[];
                    program.instances _ CONS[instance, program.instances];
                    ENDLOOP;
                size _ IO.GetInt[stream];
                THROUGH [0..size) DO
                    program.tiles _ CONS[SoftHdwBasics.RopeToArrayPosition[ IO.GetRopeLiteral[stream]], program.tiles];
                    ENDLOOP;
                id _ IO.GetID[stream];
                program.coordinates _ SELECT TRUE FROM
                    Rope.Equal[id, "G"] => Grain,
                    Rope.Equal[id, "M"] => MinorArray,
                    Rope.Equal[id, "C"] => Chip,
                    ENDCASE => ERROR;
                };
            };
        GetPosition: PROC RETURNS[position: Position] = {
            position _ [IO.GetInt[stream], IO.GetInt[stream]];
            };
        stream: IO.STREAM _ FS.StreamOpen[fileName, $read];
        map: SymTab.Ref _ SymTab.Create[];
        program _ RecursiveUnpickle[];
        IO.Close[stream];
        };

<<Utilities>>
    Size: PUBLIC PROC [program: Program] RETURNS [size: Position] = {
        <<Should check for overflow, requires sizes parameter.>>
        <<Also should check for tile type and coordinate system compatibility.>>
        min: Position _ [LAST[DABasics.Number], LAST[DABasics.Number]];
        max: Position _ [0, 0];
        FOR tiles: ArrayPositions _ program.tiles, tiles.rest UNTIL tiles=NIL DO
            tile: ArrayPosition _ tiles.first;
            position: Position _ SELECT program.coordinates FROM
                Grain => (IF tile.minorArray#[0,0] OR tile.chip#[0,0] THEN ERROR ELSE tile.grain),
                MinorArray => (IF tile.chip#[0,0] THEN ERROR ELSE tile.minorArray),
                Chip => tile.chip,
                ENDCASE => ERROR;
            min.x _ MIN[position.x, min.x];
            min.y _ MIN[position.y, min.y];
            max.x _ MAX[position.x, max.x];
            max.y _ MAX[position.y, max.y];
            ENDLOOP;
        FOR instances: ProgramInstances _ program.instances, instances.rest UNTIL instances=NIL DO
            instance: ProgramInstance _ instances.first;
            position: Position _ SELECT program.coordinates FROM
                Grain => ERROR,
                MinorArray => (IF instance.chip#[0,0] THEN ERROR ELSE instance.minorArray),
                Chip => instance.chip,
                ENDCASE => ERROR;
            IF ORD[instance.program.coordinates]>ORD[program.coordinates] THEN ERROR;  -- trying to embed a higher level construct inside a 
            lower level construct
            IF instance.rotation=None THEN {
                min.x _ MIN[position.x, min.x];
                min.y _ MIN[position.y, min.y];
                IF ORD[instance.program.coordinates]=ORD[program.coordinates] THEN {
                    subSize: Position _ Size[instance.program];
                    max.x _ MAX[position.x+subSize.x-1, max.x];
                    max.y _ MAX[position.y+subSize.y-1, max.y];
                    };
                }
            ELSE {
                min.x _ MIN[position.y, min.x];
                min.y _ MIN[position.x, min.y];
                IF ORD[instance.program.coordinates]=ORD[program.coordinates] THEN {
                    subSize: Position _ Size[instance.program];
                    max.x _ MAX[position.y+subSize.y-1, max.x];
                    max.y _ MAX[position.x+subSize.x-1, max.y];
                    };
                };
            ENDLOOP;
        <<size.x _ max.x - min.x + 1;>>
        <<size.y _ max.y - min.y + 1;>>
        size.x _ max.x + 1;
        size.y _ max.y + 1;
    };

    EnumerateTiles: PUBLIC PROC [program: Program, eachTile: EachTileProc] = {
        EnumerateTilesRecursive: PROC [program: Program, chip: Position, minorArray: Position] = {
            FOR tiles: ArrayPositions _ program.tiles, tiles.rest UNTIL tiles=NIL DO
                position^ _ tiles.first^;
                position.chip _ CDBasics.AddPoints[chip, position.chip];
                position.minorArray _ CDBasics.AddPoints[minorArray, position.minorArray];
                eachTile[position];
                ENDLOOP;
            FOR instances: ProgramInstances _ program.instances, instances.rest UNTIL instances=NIL DO
                instance: ProgramInstance _ instances.first;
                IF instance.rotation#None THEN ERROR;
                EnumerateTilesRecursive[instance.program, CDBasics.AddPoints[chip, instance.chip], CDBasics.AddPoints[minorArray, 
                instance.minorArray]];
                ENDLOOP;
            };
        position: ArrayPosition _ NEW[ArrayPositionRec];
        EnumerateTilesRecursive[program, [0,0], [0,0]];
        };

    OpenDesign: PUBLIC PROC [designName: Rope.ROPE] RETURNS [design: CD.Design] = {
        design _ PW.OpenDesign[designName];
        CDOps.SetMutability[design, readonly];
        IF NOT CDImports.LoadAndBindAll[design, false] THEN ERROR;
        };

    highlightRectangleWidth: Number = 3*lambda;
    HighlightDesign: PUBLIC PROC [design: CD.Design, sizes: ArrayPosition, positions: ColoredArrayPositions _ NIL, viewer: 
    ViewerClasses.Viewer _ NIL, label: Rope.ROPE _ NIL] = {
        instances: CD.InstanceList _ NIL;
        minorArraySize, chipSize: Position;
        [minorArraySize, chipSize] _ MinorArrayChipSize[sizes];
        FOR pl: ColoredArrayPositions _ positions, pl.rest UNTIL pl=NIL DO
            position: ArrayPosition _ pl.first.position;
            object: CD.Object _ IF position.type=Long THEN CDRects.CreateRect[[(IF position.orientation=Vertical THEN 
            sizes.minorArray.y*minorArraySize.y ELSE sizes.minorArray.x*minorArraySize.x), highlightRectangleWidth], 
            colorToLayer[pl.first.color]] ELSE nodeHighlightObjects[position.type][pl.first.color];
            transform: CD.Transformation _ TileToTransformation[minorArraySize, chipSize, position];
            instance: CD.Instance;
            transform.off _ CDBasics.SubPoints[transform.off, CDBasics.OrientedSize[CD.InterestBase[object], transform.orient]];
            instance _ NEW[CD.InstanceRep _ [
                ob: object,
                trans: transform]];
            instances _ CONS[instance, instances];
            ENDLOOP;
        ExtractOps.HighlightDesignList[design: design, highlight: instances, viewer: viewer, label: label];
        };

    LoadTile: PUBLIC PROC [design: CD.Design, tileName: Rope.ROPE] RETURNS [program: Program] = {
        object: CD.Object _ PW.Get[design, tileName];
        program _ Parse[object];
        };

<<Tile Loading>>
    tileNames: ARRAY TileType OF Rope.ROPE _ ["OToP", "RUToP", "LDToP", "LToP", "PToI", "PToRU", "PToLD", "PToL", "ORUToI", "LDToLD", 
    "OLDToI", "ORUToL", "Tristate", "RUToRU", "ORUToLD", "LDToI", "OLDToRU", "LToI", "RUToI", "Inverter", "FlipFlop", "Program", 
    "Program", "RAMEven", "RAMOdd"];
    tileObjects: ARRAY TileType OF CD.Object _ ALL[NIL];

    nodeHighlightObjects: ARRAY NodeType OF ARRAY HighlightColor OF CD.Object;
    colorToLayer: ARRAY HighlightColor OF CD.Layer _ [CD.FetchLayer[NIL, $red], CD.FetchLayer[NIL, $green], CD.FetchLayer[NIL, $blue], 
    CD.FetchLayer[NIL, $yellow], CD.FetchLayer[NIL, $black]];

    BaseType: TYPE =  {MinorArray, BoardTraces, Corner};
    baseNames: ARRAY BaseType OF Rope.ROPE _ ["MinorArray", "BoardTraces", "Corner"];
    baseObjects: ARRAY BaseType OF CD.Object _ ALL[NIL];

    LoadTiles: PROC = {
        design: CD.Design _ PW.OpenDesign["SoftHdw.dale"];
        CDOps.SetMutability[design, readonly];
        FOR index: NodeType IN NodeType DO
            FOR currentColor: HighlightColor IN HighlightColor DO
                nodeHighlightObjects[index][currentColor] _ NIL;
                ENDLOOP;
            ENDLOOP;
        FOR index: TileType IN TileType DO
            tileObjects[index] _ PW.Get[design, tileNames[index]];
            FOR currentColor: HighlightColor IN HighlightColor DO
                instances: CD.InstanceList _ NIL;
                One: CDCells.InstEnumerator = {
                    IF CDRects.IsSimpleRect[inst.ob] THEN {
                        size: Position _ CD.InterestSize[inst.ob];
                        instance: CD.Instance;
                        IF size.x>size.y THEN size.y _ highlightRectangleWidth ELSE size.x _ highlightRectangleWidth;
                        instance _ CDInstances.NewInst[
                            CDRects.CreateRect[size, colorToLayer[currentColor]],
                            inst.trans];
                        instances _ CONS[instance, instances];
                        };
                    };
                [] _ CDCells.EnumerateInstances[tileObjects[index], One];
                IF instances=NIL THEN nodeHighlightObjects[index][currentColor] _ CDRects.CreateRect[CD.InterestSize[tileObjects[index]], 
                CD.shadeLayer]
                ELSE {
                    nodeHighlightObjects[index][currentColor] _ CDCells.CreateCell[il: instances, ir: CD.InterestRect[tileObjects[index]]];
                    CDCells.SetSimplificationTreshhold[nodeHighlightObjects[index][currentColor], 1.0];
                    };
                ENDLOOP;
            ENDLOOP;
        FOR index: BaseType IN BaseType DO
            baseObjects[index] _ PW.Get[design, baseNames[index]];
            ENDLOOP;
        FOR node: NodeType IN [Master..RightUp] DO
            length: INT _ SELECT node FROM
                Input, Output => 98, 
                LeftDown, RightUp => 96,
                Long => 1,  -- hack, really must create these dynamically
                Master => 8,
                Interchip => 8,  -- hack, don't really know what it is yet
                ENDCASE => ERROR;
            FOR currentColor: HighlightColor IN HighlightColor DO
                nodeHighlightObjects[node][currentColor] _ CDRects.CreateRect[[length*lambda, highlightRectangleWidth], colorToLayer[currentColor]];
                ENDLOOP;
            ENDLOOP;
        nodeHighlightObjects[Master] _ nodeHighlightObjects[FlipFlop];
        };

    LoadTiles[];

    END.