-- PlaMakerImpl.mesa
-- a program to run within Chipmonk

-- written by E. McCreight, August 7, 1981  3:52 PM
-- modified by Cary Kornfeld, October 1, 1981  10:11 AM
-- modified by E. McCreight, April 25, 1984 10:36:28 am PST

DIRECTORY
  IODefs,
  InlineDefs,
  ppddefs,
  ppdefs,
  ppdddefs,
  SegmentDefs,
  StreamDefs,
  StringDefs,
  SystemDefs,
  ZoneAllocDefs;

PlaMakerImpl: PROGRAM
  IMPORTS
    InlineDefs, ppdddefs, ppddefs, ppdefs, SegmentDefs, StreamDefs,
    IODefs, StringDefs, ZoneAllocDefs =
  BEGIN OPEN ppdddefs, ppddefs, ppdefs, io: IODefs;


  Z: UNCOUNTED ZONE ← ZoneAllocDefs.GetAnXMZone[];

  Punt: SIGNAL = CODE;


  -- All of the peripheral cells must contain an adjacent pair of bits, and
  -- all of the center cells must contain a rectangular quad of bits

  Cell: TYPE = LONG POINTER TO object ← NIL;
  DCell: TYPE = ARRAY BOOLEAN --data in cell-- OF Cell;
  DCellPr: TYPE = ARRAY BOOLEAN -- data in even cell -- OF DCell;

  MAXIDLENGTH: CARDINAL = 100;
  StopCODE: CHARACTER = '* ;
  HASHSIZE: CARDINAL = 29; --May be small for big PLA's

  nameIndex: TYPE = [0..MAXIDLENGTH);
  hashIndex: TYPE = [0..HASHSIZE);

  IOLink: TYPE = LONG POINTER TO IO;
  PTermLink: TYPE = LONG POINTER TO ProductTerm;
  IOTermLink: TYPE = LONG POINTER TO IOTerm;

  States: TYPE = {Absent, Assert, Invert};
  TBStates: TYPE = {bottom, top};
  Direction: TYPE = {vertical, horizontal, diagonal, up, down, left, right,
	upAndLeft, upAndRight, downAndLeft, downAndRight};

  IO: TYPE = RECORD[
	next: IOLink,
	TopBottom: TBStates,
	position: CARDINAL,
	name: SEQUENCE length: CARDINAL OF CHARACTER];

  ProductTerm: TYPE = RECORD[
	next: PTermLink,
	output: IOTermLink,
	input: IOTermLink];

  IOTerm: TYPE = RECORD[
	term: SEQUENCE tcount: CARDINAL OF States];

  IOLIST: TYPE = RECORD[node: SEQUENCE IOcount: CARDINAL OF IOLink];

  HashTable: TYPE = ARRAY hashIndex OF IOLink;
  hashPTerm: ARRAY hashIndex OF PTermLink;

  inputs, outputs: HashTable;
  inCount, outCount: CARDINAL;
  inputList, outputList: LONG POINTER TO IOLIST;
  Scount: INTEGER ← 0;
  PTermCount, boistCount, minBoistSpace: CARDINAL;


  --in: StreamDefs.StreamHandle;
  line: STRING ← [MAXIDLENGTH];
  lineIn: STRING ← [MAXIDLENGTH];
  eol: BOOLEAN;

  PLADecoder, PLAData: DCellPr;
  PLADecoderData, PLADecoderDataTop, PLADecoderDataBottom,
    PLADecoderTopLeftCorner, PLADecoderBottomLeftCorner,
    PLADecoderLeftGnd, PLADecoderGnd, PLADecoderDataGnd,
    PLADataHGnd, PLADataVGnd, PLADataGnd, PLADataTopGnd,
    PLADataBottomGnd, PLADataRightGnd,
    PLADataTopRightCorner, PLADataRight, PLADataBottomRightCorner: Cell;
  PLADecoderLeft, PLADataTop, PLADataBottom, PLADecoderTop, 
    PLADecoderBottom, PLAOutMux: DCell;
  -- column: FALSE => even column, TRUE => odd column
  decodeCell, dataCell: Cell;  -- samples for measurements


  RdID: PROCEDURE [id: STRING] =
    BEGIN
    inComment: BOOLEAN ← FALSE;
    i: nameIndex ← 0;
    prevChar: CHARACTER ← ' ;
    char: CHARACTER ← io.ReadChar[];
    WHILE char = io.SP OR char = io.TAB OR char = io.CR OR char = io.LF DO
      char ← io.ReadChar[];
      ENDLOOP;
    WHILE char # io.CR DO
      SELECT TRUE FROM
         inComment AND char = '- AND prevChar = '- =>
           {char ← ' ; inComment ← FALSE};
         inComment => NULL;
         char = io.SP OR char = io.LF OR char = io.TAB => EXIT;
         char = '- AND prevChar = '- =>
           {char ← ' ; inComment ← TRUE; i ← i-1};
         ENDCASE => {id[i] ← char; i ← i + 1};
      prevChar ← char;
      char ← io.ReadChar[];
      ENDLOOP;
    id↑.length ← i;
    eol ← (char = io.CR OR char = io.LF);
    END;

  ReadIO: PROCEDURE [StopCode: CHARACTER] RETURNS [count: CARDINAL ← 0,
						   hashTable: HashTable] =
    BEGIN
    Term: IOLink;
    id: STRING ← [MAXIDLENGTH];
    id2: STRING ← [MAXIDLENGTH];
    TB: TBStates;
    k, i, hash: CARDINAL;

    FOR i IN hashIndex DO hashTable[i] ← NIL ENDLOOP;

    DO

    -- get the name of the IO term and its position
    RdID[id];
    IF id[0] = StopCode THEN EXIT;
    hash ← hashCode[id];
    RdID[id2];
    IF id2[0] = 't OR id2[0] = 'T 
	THEN TB ← top
    	ELSE TB ← bottom;


    -- create an IO node
    Term ← Z.NEW[IO[id.length]];
    Scount ← Scount + 1;
    BEGIN OPEN Term;
	TopBottom ← TB;
	position ← count;
	count ← count + 1;
	FOR k IN [0..id.length) DO
	  name[k] ← id[k];
	ENDLOOP;
	next ← hashTable[hash];
	hashTable[hash] ← Term;
    END;

    ENDLOOP;

    RETURN[count, hashTable];

  END;


  ReadPTerms: PROCEDURE []  =
    BEGIN
    PTerm, PT: PTermLink ← NIL;
    id: STRING ← [MAXIDLENGTH];
    alloc: BOOLEAN ← TRUE;
    done, found: BOOLEAN ← FALSE;
    k, outID, hash: CARDINAL ← 0;

    PTermCount ← 0;

    DO

	-- allocate a new Product Term Node
	IF alloc THEN BEGIN
	   alloc ← FALSE;
	   PTerm ← Z.NEW[ProductTerm];
	   PTerm.input ← Z.NEW[IOTerm[inCount]];
	   PTerm.output ← Z.NEW[IOTerm[outCount]];
	   Scount ← Scount + 3;
	   PTermCount ← PTermCount + 1;
	  END;
	FOR k IN [0..inCount) DO
	    PTerm.input.term[k] ← Absent;
	  ENDLOOP;
	FOR k IN [0..outCount) DO
	    PTerm.output.term[k] ← Absent;
	  ENDLOOP;

	-- get the output term
	RdID[id];
	IF id[0] = '* THEN EXIT;
	outID ← lookUp[id, outputs];
	PTerm.output.term[outID] ← Assert;

	-- discard the syntactic separator '='
	RdID[id];

	-- get the input terms
	hash ← 0;
	done ← FALSE;
	WHILE NOT done DO
	  RdID[id];
	  k ← lookUp[id, inputs];
	  hash ← hash + k;
	  IF id[0] = '-
	    THEN PTerm.input.term[k] ← Invert
	    ELSE PTerm.input.term[k] ← Assert;

	  -- discard syntactic separator
	  RdID[id];
	  done ← id[0] = '; ;
	ENDLOOP;

	-- insert the Product Term into the PTerm matrix
	IF hash >= HASHSIZE THEN hash ← hash MOD HASHSIZE;
	PT ← hashPTerm[hash];
	found ← FALSE;
	DO
	  IF PT=NIL 
	     THEN EXIT 
	     ELSE found ← TRUE;
	  FOR k IN [0..inCount) UNTIL NOT found DO
	    found ← PT.input.term[k] = PTerm.input.term[k];
	   ENDLOOP;
	  IF found 
	     THEN EXIT
	     ELSE PT ← PT.next;
	  ENDLOOP;

	IF found THEN PT.output.term[outID] ← Assert
	    ELSE BEGIN
		PTerm.next ← hashPTerm[hash];
		hashPTerm[hash] ← PTerm;
		alloc ← TRUE;
	     END;

    ENDLOOP;

    -- release unused PTerm node space
    IF NOT alloc 
	THEN BEGIN
	   Z.FREE[@PTerm.input];
	   Z.FREE[@PTerm.output];
	   Z.FREE[@PTerm];
	   Scount ← Scount - 3;
	   PTermCount ← PTermCount - 1;
	  END;

  END;


  FreeBlocks: PROCEDURE[] =
    BEGIN
    IOPtr, IOTemp: IOLink;
    p, pTemp: PTermLink;
    i: hashIndex;

    -- release space for input and output node lists
    Z.FREE[@inputList];
    Z.FREE[@outputList];
    Scount ← Scount - 2;

    -- release node space for input terms
    FOR i IN hashIndex DO 
      FOR IOPtr←inputs[i], IOTemp UNTIL IOPtr=NIL DO
	IOTemp ← IOPtr.next;
	Z.FREE[@IOPtr];
	Scount ← Scount - 1;
      ENDLOOP;
    ENDLOOP;

    -- release node space for output terms
    FOR i IN hashIndex DO 
      FOR IOPtr←outputs[i], IOTemp UNTIL IOPtr=NIL DO
	IOTemp ← IOPtr.next;
	Z.FREE[@IOPtr];
	Scount ← Scount - 1;
      ENDLOOP;
    ENDLOOP;

    -- release node space for product terms
    FOR i IN hashIndex DO 
      FOR p ← hashPTerm[i], pTemp UNTIL p=NIL DO
	pTemp ← p.next;
	Z.FREE[@p.output];
	Z.FREE[@p.input];
	Z.FREE[@p];
	Scount ← Scount - 3;
      ENDLOOP;
    ENDLOOP;

  END;

  hashCode: PROCEDURE [name: STRING] RETURNS [hashIndex] =
    BEGIN
    j: nameIndex;
    i: INTEGER;
    Start: CARDINAL;

    Start ← i ← 0;
    IF name[0] = '- THEN Start ← 1;
    FOR j IN [Start..name↑.length) DO
      i ← i*10 + (name[j] - '0);
      IF name[j] >= 'a THEN i ← i - 32; --hash on upper case only
      ENDLOOP;
    i ← i MOD HASHSIZE;
    RETURN[IF i < 0 THEN i + HASHSIZE ELSE i];
    END;

  strcmp: PROCEDURE [s: STRING, n: IOLink] RETURNS [BOOLEAN] =
    BEGIN
    i: INTEGER;
    Off, j: nameIndex;

    Off ← 0;
    IF s[0] = '- THEN Off ← 1;
    FOR j ← 0, j + 1 UNTIL j = s.length-Off DO
      i ← n.name[j] - s[j+Off]; --check for equality regardless of case
      IF i = 0 THEN LOOP;
      IF i = 32 AND s[j] >= 'A THEN LOOP;
      IF i = -32 AND s[j] >= 'a THEN LOOP;
      RETURN[FALSE];
      REPEAT FINISHED => RETURN[TRUE]
      ENDLOOP;
    END;

  lookUp: PROCEDURE [s: STRING, hashTable: HashTable] RETURNS [CARDINAL] =
    BEGIN
    n: IOLink;
    h: hashIndex;

    h ← hashCode[s];
    FOR n ← hashTable[h], n↑.next UNTIL n = NIL DO
      IF strcmp[s, n] THEN RETURN[n.position] ENDLOOP;
    RETURN[0];
    END;

	  
  BuildProductTerms: PROCEDURE [si: StreamDefs.StreamHandle] =
    BEGIN -- called once in main
    line: STRING ← [MAXIDLENGTH];
    i: hashIndex;
    IOPtr: IOLink;
    echo: BOOLEAN;
    saveIn: StreamDefs.StreamHandle;

    FOR i IN hashIndex DO hashPTerm[i] ← NIL ENDLOOP;
    eol ← FALSE;
    saveIn ← io.GetInputStream[];
    io.SetInputStream[si];
    echo ← io.SetEcho[FALSE];

    -- read Input terms and build input term hash table
    [inCount, inputs] ← ReadIO[StopCODE];

    -- read output terms and build output term hash table
    [outCount, outputs] ← ReadIO[StopCODE];

    -- build IO List of IO descriptors arranged by position
    inputList ← Z.NEW[IOLIST[inCount]];
    outputList ← Z.NEW[IOLIST[outCount]];
    Scount ← Scount + 2;
    FOR i IN hashIndex DO 
      FOR IOPtr←inputs[i], IOPtr.next UNTIL IOPtr=NIL DO
	inputList[IOPtr.position] ← IOPtr;
      ENDLOOP;
    ENDLOOP;

    FOR i IN hashIndex DO 
      FOR IOPtr←outputs[i], IOPtr.next UNTIL IOPtr=NIL DO
	outputList[IOPtr.position] ← IOPtr;
      ENDLOOP;
    ENDLOOP;



    -- input the product terms and build the product term matrix
    ReadPTerms;

    io.SetInputStream[saveIn];
    [] ← io.SetEcho[echo];

    END;

  FindPLACells: PROCEDURE [cellFamily: STRING] =
    BEGIN
    PLADecoder ← FindDCellPr[cellFamily: cellFamily, required: TRUE,
      memberPrefix: "Decoder"L];
    decodeCell ← PLADecoder[TRUE][FALSE];
    PLADecoderTop ← FindDCell[
      cellFamily: cellFamily, memberPrefix: "DecoderTop"L];
    PLADecoderBottom ← FindDCell[
      cellFamily: cellFamily, memberPrefix: "DecoderBottom"L];
    PLADecoderLeft ← FindDCell[
      cellFamily: cellFamily, memberPrefix: "DecoderLeft"L, vCompat: decodeCell];
    PLADecoderTopLeftCorner ← FindCell[
      cellFamily: cellFamily, member: "DecoderTopLeftCorner"L];
    PLADecoderBottomLeftCorner ← FindCell[
      cellFamily: cellFamily, member: "DecoderBottomLeftCorner"L];
    PLAData ← FindDCellPr[cellFamily: cellFamily, required: TRUE,
      memberPrefix: "Data"L];
    dataCell ← PLAData[FALSE][FALSE];
    CheckPitchCompatability[decodeCell, dataCell, vertical, [1, 2], [1, 1]];
    PLADecoderData ← FindCell[
      cellFamily: cellFamily, member: "DecoderData"L, vCompat: dataCell];
    PLADecoderDataTop ← FindCell[
      cellFamily: cellFamily, member: "DecoderDataTop"L, hCompat: PLADecoderData];
    PLADecoderDataBottom ← FindCell[
      cellFamily: cellFamily, member: "DecoderDataBottom"L,
      hCompat: PLADecoderData];
    PLADataTop ← FindDCell[
      cellFamily: cellFamily, memberPrefix: "DataTop"L, hCompat: dataCell];
--    PLADataBottom ← FindDCell[
--      cellFamily: cellFamily, memberPrefix: "DataBottom"L];
    PLAOutMux ← FindDCell[cellFamily: cellFamily, memberPrefix: "OutMux"L];
    CheckPitchCompatability[dataCell, PLAOutMux[FALSE], horizontal, [1, 1], [1, 1]];
    PLADataRight ← FindCell[
      cellFamily: cellFamily, member: "DataRight"L, vCompat: dataCell];
    PLADataTopRightCorner ← FindCell[
      cellFamily: cellFamily, member: "DataTopRightCorner"L];
    PLADataBottomRightCorner ← FindCell[
      cellFamily: cellFamily, member: "DataBottomRightCorner"L];
    PLADecoderLeftGnd ← FindCell[
      cellFamily: cellFamily, member: "DecoderLeftGnd"L];
    PLADecoderGnd ← FindCell[
      cellFamily: cellFamily, member: "DecoderGnd"L, vCompat: PLADecoderLeftGnd, hCompat: decodeCell];
    PLADecoderDataGnd ← FindCell[
      cellFamily: cellFamily, member: "DecoderDataGnd"L, hCompat: PLADecoderData];
    PLADataHGnd ← FindCell[
      cellFamily: cellFamily, member: "DataHGnd"L, vCompat: PLADecoderGnd, hCompat: dataCell];
    PLADataGnd ← FindCell[
      cellFamily: cellFamily, member: "DataGnd"L, vCompat: PLADataHGnd];
    PLADataVGnd ← FindCell[
      cellFamily: cellFamily, member: "DataVGnd"L, vCompat: dataCell, hCompat: PLADataGnd];
    PLADataTopGnd ← FindCell[
      cellFamily: cellFamily, member: "DataTopGnd"L, hCompat: PLADataVGnd];
    PLADataBottomGnd ← FindCell[
      cellFamily: cellFamily, member: "DataBottomGnd"L, hCompat: PLADataVGnd];
    PLADataRightGnd ← FindCell[
      cellFamily: cellFamily, member: "DataRightGnd"L, vCompat: PLADataHGnd];
    END;

  FindCell: PROCEDURE [
    cellFamily: STRING, member: STRING, required: BOOLEAN ← FALSE,
    vCompat: Cell ← NIL, hCompat: Cell ← NIL] RETURNS [Cell] =
    BEGIN OPEN StringDefs;
    s: STRING ← [100];
    s.length ← 0;
    AppendString[to: s, from: cellFamily];
    AppendString[to: s, from: member];
    FOR cp: LONG POINTER TO cList ← cellList, cp.nxt WHILE cp # NIL DO
      IF StringDefs.EquivalentString[cp.name, s] THEN
        BEGIN
        c: Cell ← cp.ob;
        IF vCompat # NIL THEN CheckPitchCompatability[c, vCompat, vertical];
        IF hCompat # NIL THEN CheckPitchCompatability[c, hCompat, horizontal];
        RETURN[c];
        END;
      ENDLOOP;
    IF required THEN {Explain["Missing cell in family"L, s]; SIGNAL Punt};
    RETURN[NIL];
    END;

  FindDCell: PROCEDURE [
    cellFamily, memberPrefix: STRING, required: BOOLEAN ← FALSE,
    vCompat: Cell ← NIL, hCompat: Cell ← NIL] RETURNS [d: DCell] =
    BEGIN OPEN StringDefs;
    originalLength: CARDINAL ← memberPrefix.length;
    member: STRING ← [50];
    member.length ← 0;
    AppendString[to: member, from: memberPrefix];
    AppendString[to: member, from: "0"L];
    d[FALSE] ← FindCell[cellFamily, member, required, vCompat, hCompat];
    member.length ← originalLength;
    AppendString[to: member, from: "1"L];
    d[TRUE] ← FindCell[cellFamily, member, required, vCompat, hCompat];
    IF vCompat # NIL OR hCompat # NIL
	THEN CheckPitchCompatability[d[FALSE], d[TRUE], diagonal];
    END;  -- of FindDCell

  FindDCellPr: PROCEDURE [
    cellFamily, memberPrefix: STRING, required: BOOLEAN ← FALSE,
    vCompat: Cell ← NIL, hCompat: Cell ← NIL] RETURNS [p: DCellPr] =
    BEGIN OPEN StringDefs;
    originalLength: CARDINAL ← memberPrefix.length;
    member: STRING ← [50];
    member.length ← 0;
    AppendString[to: member, from: memberPrefix];
    AppendString[to: member, from: "0"L];
    p[FALSE] ← FindDCell[cellFamily, member, required, vCompat, hCompat];
    member.length ← originalLength;
    AppendString[to: member, from: "1"L];
    p[TRUE] ← FindDCell[cellFamily, member, required, vCompat, hCompat];
    IF vCompat # NIL OR hCompat # NIL
	THEN CheckPitchCompatability[p[FALSE][FALSE], p[TRUE][FALSE], diagonal];
    END;  -- of FindDCell

  CheckPitchCompatability: PROCEDURE [
    c1, c2: Cell, dir: Direction, rep1: Point ← [1, 1], rep2: Point ← [1, 1]] =
    BEGIN OPEN StringDefs;

    FindCellName: PROCEDURE [c: Cell] RETURNS [STRING] =
      BEGIN
      FOR cp: LONG POINTER TO cList ← cellList, cp.nxt WHILE cp # NIL DO
        IF c = cp.ob THEN RETURN[cp.name] ENDLOOP;
      RETURN[""];
      END;

    IF StepP[, c1, dir, rep1] # StepP[, c2, dir, rep2] THEN
      BEGIN
      cellNames: STRING ← [50];
      cellNames.length ← 0;
      AppendString[to: cellNames, from: FindCellName[c1]];
      AppendString[to: cellNames, from: " - "L];
      AppendString[to: cellNames, from: FindCellName[c2]];
      SELECT dir FROM
        vertical, up, down =>
          Explain["Incompatible cell vertical pitches"L, cellNames];
        horizontal, left, right =>
          Explain["Incompatible cell horizontal pitches"L, cellNames];
        ENDCASE => Explain["Incompatible cell sizes"L, cellNames];
      -- SIGNAL Punt;
      END;
    END;  -- of CheckPitchCompatability

  Replicate: PROCEDURE [c: Cell, p: Point, n: CARDINAL ← 1, dir: Direction ← down]
    RETURNS [Point] =
    BEGIN
    IF c = NIL THEN RETURN[p];  -- no cell
    FOR i: CARDINAL IN [0..n) DO
      SELECT dir FROM
        vertical, down, horizontal, right =>
          BEGIN
          lpp ← insertList[lpp, makeList[c.p.anotherme[c], p.x, p.y, 0, 0]];
          p ← StepP[p, c, dir];
          END;
        left, up =>
          BEGIN
          p ← StepP[p, c, dir];
          lpp ← insertList[lpp, makeList[c.p.anotherme[c], p.x, p.y, 0, 0]];
          END;
        ENDCASE => NULL;
      ENDLOOP;
    RETURN[p];
    END;

  ReplicateEvenOdd: PROCEDURE [d: DCell, p: Point, n: CARDINAL, dir: Direction]
    RETURNS [Point] =
    BEGIN
    IF d[FALSE] = NIL AND d[TRUE] = NIL THEN RETURN[p];  -- no cells
    FOR i: CARDINAL IN [0..n) DO
      IF d[i MOD 2 = 0]#NIL THEN SELECT dir FROM
        vertical, down, horizontal, right =>
          BEGIN
          lpp ← insertList[lpp, makeList[d[i MOD 2 = 0].p.anotherme[d[i MOD 2 = 0]], p.x, p.y, 0, 0]];
          p ← StepP[p, d[i MOD 2 = 0], dir];
          END;
        left, up =>
          BEGIN
          p ← StepP[p, d[i MOD 2 = 0], dir];
          lpp ← insertList[lpp, makeList[d[i MOD 2 = 0].p.anotherme[d[i MOD 2 = 0]], p.x, p.y, 0, 0]];
          END;
        ENDCASE => NULL
      ELSE p ← StepP[p, d[NOT(i MOD 2 = 0)], dir];
      ENDLOOP;
    RETURN[p];
    END;

  StepP: PROCEDURE [
    p: Point ← [0, 0], c: Cell, dir: Direction, rep: Point ← [1, 1]]
    RETURNS [Point] =
    BEGIN
    IF c = NIL THEN RETURN[p]
    ELSE
      SELECT dir FROM
        up => RETURN[[p.x, p.y - rep.y*c.size[1]]];
        vertical, down => RETURN[[p.x, p.y + rep.y*c.size[1]]];
        horizontal, right => RETURN[[p.x + rep.x*c.size[0], p.y]];
        left => RETURN[[p.x - rep.x*c.size[0], p.y]];
        upAndLeft => RETURN[[p.x - rep.x*c.size[0], p.y - rep.y*c.size[1]]];
        upAndRight => RETURN[[p.x - rep.x*c.size[0], p.y + rep.y*c.size[1]]];
        downAndLeft => RETURN[[p.x - rep.x*c.size[0], p.y + rep.y*c.size[1]]];
        ENDCASE -- downAndRight, diagonal -- =>
          RETURN[[p.x + rep.x*c.size[0], p.y + rep.y*c.size[1]]];
    END;

  Half: PROCEDURE [x: CARDINAL] RETURNS [CARDINAL] = INLINE {RETURN[(x + 1)/2]};

  MakeNewCell: PROCEDURE [name: STRING, lpp: LONG POINTER TO list]
    RETURNS [cp: LONG POINTER TO cList] =
    BEGIN
    min: Point ← [LAST[locNum], LAST[locNum]];
    max: Point ← [FIRST[locNum], FIRST[locNum]];
    FOR lp: LONG POINTER TO list ← lpp, lp.nxt WHILE lp # NIL DO
      ii: [0..1] ← IF InlineDefs.BITAND[lp.idx, 4] = 0 THEN 0 ELSE 1;
      min ← [MIN[min.x, lp.lx], MIN[min.y, lp.ly]];
      max ← [
        MAX[max.x, lp.lx + lp.ob.size[ii]], MAX[
        max.y, lp.ly + lp.ob.size[ii + 1]]];
      ENDLOOP;
    FOR lp: LONG POINTER TO list ← lpp, lp.nxt WHILE lp # NIL DO
      lp.lx ← lp.lx - min.x; lp.ly ← lp.ly - min.y; lp.selected ← FALSE; ENDLOOP;
    cp ← alocCList[];
    cp.nxt ← cellList;
    cellList ← cp;
    cp.ob ← makeCell[max.x - min.x, max.y - min.y, 0, lpp];
    cp.name ← name;
    END;  -- of MakeNewCell

  DrawCell: PROCEDURE [obp: LONG POINTER TO object] =
    BEGIN
    lp: LONG POINTER TO list ← makeList[obp.p.anotherme[obp], xx, yy, 0, 0];
    obp.returnable ← FALSE;
    masterList ← insertList[masterList, lp];
    anyChanges ← sinceIOchanges ← TRUE;
    selNewThing[masterList, lp, TRUE];
    putMark[xx, yy];
    reDrawRect[getRect[lp], 0, TRUE, TRUE, FALSE];
    END;  -- of DrawCell

  Explain: PROCEDURE [why, explanation: STRING] =
    BEGIN
    IF explanation = NIL THEN explanation ← ""L;
    [] ← typeInC["Can't run PLAmaker [Confirm]"L, why, explanation]
    END;

  FixExtension: PROCEDURE [s, ext: STRING] RETURNS [se: STRING] =
    BEGIN
    FOR i: CARDINAL IN [0..s.length) DO IF s[i] = '. THEN RETURN[s] ENDLOOP;
    se ← GetString[s.length + ext.length];
    StringDefs.AppendString[to: se, from: s];
    StringDefs.AppendString[to: se, from: ext];
    FreeString[s];
    END;

  RequestString: PROCEDURE[s1: STRING ← NIL, s2: STRING ← NIL, s3: STRING ← NIL]
    RETURNS[sResult: STRING] =
    BEGIN
    ok: BOOLEAN;
    [ok, sResult, ] ← typeIn[
      IF s1#NIL THEN s1 ELSE ""L,
      IF s2#NIL THEN s2 ELSE ""L,
      IF s3#NIL THEN s3 ELSE ""L];
    IF NOT ok THEN SIGNAL Punt;
    END;

  RequestInteger: PROCEDURE[s1: STRING ← NIL, s2: STRING ← NIL]
    RETURNS[INTEGER] =
    BEGIN
    DO
      s: STRING ← RequestString[s1, s2];
      n: INTEGER ← StringDefs.StringToDecimal[s: s
        ! StringDefs.InvalidNumber => {FreeString[s]; LOOP}];
      FreeString[s];
      RETURN[n];
      ENDLOOP;
    END;

  laydownTop: PROCEDURE [p: Point ← [0, 0]] RETURNS [hp: Point] =
    BEGIN
    OrB, k: CARDINAL;
    flag: BOOLEAN ← TRUE;

    -- place the top left corner cell, leave mark at bottom right corner
    hp ← StepP[StepP[p, PLADecoderDataTop, down], PLADecoderTopLeftCorner, up];
    hp ← Replicate[PLADecoderTopLeftCorner, hp, 1, right];
    hp ← StepP[hp, PLADecoderTopLeftCorner, down];

    -- place the decoder cells, leave mark at bottom right corner
    FOR k IN [0..inCount) DO
	flag ← inputList[k].TopBottom=bottom;
	hp ← StepP[hp, PLADecoderTop[flag], up];
	hp ← Replicate[PLADecoderTop[flag], hp, 1, right];
	hp ← StepP[hp, PLADecoderTop[flag], down];
      ENDLOOP;

    -- place the interface cell between the AND and OR planes
    hp ← StepP[hp, PLADecoderDataTop, up];
    hp ← Replicate[PLADecoderDataTop, hp, 1, right];
    hp ← StepP[hp, PLADecoderDataTop, down];

    -- place the data cells, leave mark at bottom right corner
    OrB ← 0;
    FOR k IN [0..outCount) DO
	flag ← outputList[k].TopBottom=bottom;
	hp ← StepP[hp, PLADataTop[flag], up];
	hp ← Replicate[PLADataTop[flag], hp, 1, right];
	hp ← StepP[hp, PLADataTop[flag], down];
	OrB ← OrB + 1;
	IF (OrB = boistCount) AND (outCount - k) > minBoistSpace
	   THEN BEGIN
		OrB ← 0;
		hp ← StepP[hp, PLADataTopGnd, up];
		hp ← Replicate[PLADataTopGnd, hp, 1, right];
		hp ← StepP[hp, PLADataTopGnd, down];
	      END;
      ENDLOOP;

    -- place top right corner cell, leave mark at left bottom of row
    hp ← StepP[hp, PLADataTopRightCorner, up];
    hp ← Replicate[PLADataTopRightCorner, hp, 1, right];
    hp ← StepP[p, PLADecoderDataTop, down];

    END;


  laydownBody: PROCEDURE [p: Point ← [0, 0]] RETURNS [hp: Point] =

    BEGIN
    i, j, k: CARDINAL ← 0;
    AndB, OrB: CARDINAL ← 0;
    PT, PT0, PT1: PTermLink;
    flag: BOOLEAN ← TRUE;

    FOR i IN hashIndex DO
      FOR PT ← hashPTerm[i], PT.next UNTIL PT=NIL DO

	hp ← p;
	j ← j + 1;

	-- laydown the Decoder Pullup
	hp ← Replicate[PLADecoderLeft[flag], hp, 1, right];

	-- laydown the product term inputs
	FOR k IN [0..inCount) DO
	  SELECT PT.input.term[k] FROM
	    Assert =>
		hp ← Replicate[PLADecoder[TRUE][FALSE], hp, 1, right];
	    Invert =>
		hp ← Replicate[PLADecoder[FALSE][TRUE], hp, 1, right];
	    Absent =>
		hp ← Replicate[PLADecoder[FALSE][FALSE], hp, 1, right];
	   ENDCASE;
	ENDLOOP;
	IF flag 
	   THEN PT0 ← PT 
	   ELSE PT1 ← PT;

	-- laydown the OR plane in pairs
	flag ← NOT flag;
	IF flag THEN BEGIN

	   -- laydown the interface block
	   hp ← StepP[hp, PLADecoder[FALSE][FALSE], up];
	   hp ← Replicate[PLADecoderData, hp, 1, right];

	   -- laydown the outputs that the product term drives
	   OrB ← 0;
	   FOR k IN [0..outCount) DO
	     hp ← Replicate[PLAData[PT1.output.term[k]=Assert]
	   		[PT0.output.term[k]=Assert], hp, 1, right];
	     OrB ← OrB + 1;
	     IF OrB = boistCount AND (outCount-k) > minBoistSpace
	       THEN BEGIN
		 hp ← Replicate[PLADataVGnd, hp, 1, right];
		 OrB ← 0;
		END;
	     ENDLOOP;

	   -- laydown the right end cell
	   hp ← Replicate[PLADataRight, hp, 1, right];

	 END;

	 -- Step down to the new layer
	 p ← StepP[p, PLADecoder[FALSE][FALSE], down];

	 -- laydown the boister strip every boistCount layers
	 AndB ← AndB + 1;
	 IF AndB = boistCount AND (PTermCount - j) > minBoistSpace
	    THEN BEGIN
		AndB ← 0;
		hp ← Replicate[PLADecoderLeftGnd, p, 1, right];
		FOR k IN [0 .. inCount) DO
		  hp ← Replicate[PLADecoderGnd, hp, 1, right];
		 ENDLOOP;
		hp ← Replicate[PLADecoderDataGnd, hp, 1, right];
		OrB ← 0;
		FOR k IN [0..outCount) DO
		   hp ← Replicate[PLADataHGnd, hp, 1, right];
		   OrB ← OrB + 1;
		   IF (OrB = boistCount) AND (outCount-k) > minBoistSpace
		     THEN BEGIN
			hp ← Replicate[PLADataGnd, hp, 1, right];
			OrB ← 0;
		      END;
		   ENDLOOP;
		hp ← Replicate[PLADataRightGnd, hp, 1, right];
		p ← StepP[p, PLADecoderLeftGnd, down];
	    END;

     ENDLOOP;
   ENDLOOP;

   -- check for odd number of product terms and finish layout 
   -- if necessary
   IF NOT flag THEN BEGIN

	-- laydown a NULL AND term row
	hp ← p;
	hp ← Replicate[PLADecoderLeft[flag], hp, 1, right];
	hp ← Replicate[PLADecoder[FALSE][FALSE], hp, inCount, right];

	-- laydown the interface block
	   hp ← StepP[hp, PLADecoder[FALSE][FALSE], up];
	   hp ← Replicate[PLADecoderData, hp, 1, right];

	   -- laydown the outputs that the product term drives
	   OrB ← 0;
	   FOR k IN [0..outCount) DO
	     hp ← Replicate[PLAData[FALSE]
	   		[PT0.output.term[k]=Assert], hp, 1, right];
	     OrB ← OrB + 1;
	     IF OrB = boistCount AND (outCount-k) > minBoistSpace
	       THEN BEGIN
		 hp ← Replicate[PLADataVGnd, hp, 1, right];
		 OrB ← 0;
		END;
	     ENDLOOP;

	   -- laydown the right end cell
	   hp ← Replicate[PLADataRight, hp, 1, right];

	   -- Step down to the new layer
	   p ← StepP[p, PLADecoder[FALSE][FALSE], down];

	END;

    hp ← p;

    END;

  laydownBottom: PROCEDURE [p: Point ← [0, 0]] RETURNS [hp: Point] =

    BEGIN
     OrB, k: CARDINAL ← 0;
     flag: BOOLEAN ← TRUE;

     hp ← p;
     hp ← Replicate[PLADecoderBottomLeftCorner, hp, 1, right];
     FOR k IN [0..inCount) DO
	flag ← inputList[k].TopBottom=bottom;
	hp ← Replicate[PLADecoderBottom[flag], hp, 1, right];
      ENDLOOP;
     hp ← Replicate[PLADecoderDataBottom, hp, 1, right];
     FOR k IN [0..outCount) DO
	flag ← outputList[k].TopBottom=bottom;
	hp ← Replicate[PLAOutMux[flag], hp, 1, right];
	OrB ← OrB + 1;
	IF OrB = boistCount AND (outCount-k) > minBoistSpace
	  THEN BEGIN
		 hp ← Replicate[PLADataBottomGnd, hp, 1, right];
		 OrB ← 0;
		END;
      ENDLOOP;
    hp ← Replicate[PLADataBottomRightCorner, hp, 1, right];
    END;


  ok: BOOLEAN;
  --bodyHeight, decoderDataX, dataX, dataRightX: locNum;
  --curPt: Point;
  --decoderWidth, wordsPerDataRow, wordCount, wordWidth: CARDINAL;
  --logWordsPerDataRow: INTEGER;
  fileName, memName, cellFamily, PLAName, wdPerRowStr: STRING ← NIL;
  s: StreamDefs.StreamHandle ← NIL;
  lpp: LONG POINTER TO list ← NIL;  -- list of cells already placed

  -- M a i n   B o d y

  BEGIN
  ENABLE Punt => GOTO Exit;  -- for exits
  [ok, fileName, ] ← typeIn[""L, "Data file:"L, ".slim format"L];
  IF NOT ok THEN GOTO Exit;
  fileName ← FixExtension[fileName, ".slim"L];
  s ← StreamDefs.NewByteStream[
    fileName, StreamDefs.Read !
    SegmentDefs.FileNameError => {
      Explain["Can't find .slim file"L, name]; GOTO Exit}];

  [ok, cellFamily, ] ← typeIn["Cell family:"L, ""L, ""L];
  IF NOT ok THEN GOTO Exit;
  [ok, PLAName, ] ← typeIn["Name of completed PLA cell:"L, ""L, ""L];
  IF NOT ok THEN GOTO Exit;
  FindPLACells[cellFamily];

  -- Build the PLA's Product Term Matrix
  BuildProductTerms[s];

  -- Construct the PLA symbol
  BEGIN
    flag: BOOLEAN ← TRUE;
    p, hp: Point;

    p ← hp ← [0, 0];
    boistCount ← RequestInteger["Number of Min Terms between GND Lines:"L];
    minBoistSpace ← RequestInteger["Minimum number of Min Terms between GND lines"L];

    -- laydown the top of the PLA
    p ← laydownTop[p];

    -- laydown the body of the PLA
    p ← laydownBody[p];

    -- laydown the bottom of the PLA
    p ← laydownBottom[p];

  END;

  DrawCell[MakeNewCell[PLAName, lpp].ob];
  PLAName ← NIL;  -- we gave the name to the cell




--wordsPerDataRow ← 1; logWordsPerDataRow ← 0;
--IF PLAOutMux[FALSE]#NIL THEN
--  BEGIN
--  t: CARDINAL;
--  [ok, wdPerRowStr, ] ← typeIn[""L, "Words per row:"L, "(power of 2)"L];
--  IF NOT ok THEN GOTO Exit;
--  t ← StringDefs.StringToNumber[s: wdPerRowStr, radix: 10];
--  FOR wordsPerDataRow ← 1, 2*wordsPerDataRow WHILE wordsPerDataRow<t DO
--    logWordsPerDataRow ← logWordsPerDataRow+1;
--    ENDLOOP;
--  END;

--MB.ReCast[mem: mbMem, newWordWidth: mbMem.width*wordsPerDataRow];
--MB.SuppressDefaultWords[mem: mbMem, default: FALSE];
--[decoderWidth, wordCount, wordWidth] ← MB.AnalyzeMemory[mbMem];

--decoderWidth ← decoderWidth+logWordsPerDataRow;
--wordCount ← wordCount + (wordCount MOD 2)+2*logWordsPerDataRow;

--bodyHeight ← StepP[, decodeCell, downAndRight, [x: 1, y: wordCount]].y;
--decoderDataX ← StepP[, decodeCell, downAndRight, [x: decoderWidth, y: 1]].x;
--dataX ← StepP[[decoderDataX, 0], PLADecoderData, right].x;
--dataRightX ← StepP[
--  [dataX, 0], PLAData[FALSE][FALSE], right, [x: wordWidth, y: 1]].x;

--[] ← ReplicateEvenOdd[
--  PLADecoderLeft, StepP[[0, 0], PLADecoderLeft[FALSE], left], wordCount, down];
--[] ← Replicate[
--  PLADecoderTopLeftCorner, StepP[[0, 0], PLADecoderTopLeftCorner, upAndLeft]];
--[] ← Replicate[
--  PLADecoderBottomLeftCorner, StepP[
--  [0, bodyHeight], PLADecoderBottomLeftCorner, left]];
--[] ← Replicate[
--  PLADecoderTop, StepP[[0, 0], PLADecoderTop, up], decoderWidth, right];
--[] ← Replicate[PLADecoderBottom, [0, bodyHeight], decoderWidth, right];
--[] ← Replicate[
--  PLADecoderDataTop, StepP[[decoderDataX, 0], PLADecoderDataTop, up]];
--curPt ← Replicate[PLADecoderData, [decoderDataX, 0], wordCount/2, down];
--[] ← Replicate[PLADecoderDataBottom, curPt];
--[] ← ReplicateEvenOdd[
--  PLADataTop, StepP[[dataX, 0], PLADataTop[FALSE], up],
--    wordWidth, right];
--[] ← Replicate[
--  PLADataTopRightCorner, StepP[[dataRightX, 0], PLADataTopRightCorner, up]];
--[] ← Replicate[PLADataRight, [dataRightX, 0], wordCount/2, down];
--[] ← Replicate[PLADataBottomRightCorner, [dataRightX, bodyHeight]];
--IF wordsPerDataRow=1 THEN
--  [] ← ReplicateEvenOdd[PLADataBottom, [dataX, bodyHeight], wordWidth, right]
--ELSE
--  BEGIN
--  curPt ← [dataX, bodyHeight];
--  FOR i: CARDINAL IN [0..wordWidth/wordsPerDataRow) DO
--    curPt ← Replicate[PLAOutMux[FALSE], curPt, 1, right];
--    curPt ← Replicate[PLAOutMux[TRUE], curPt, wordsPerDataRow/2-1, right];
--    ENDLOOP;
--  END;
--MakeDecoderBlock[PLADecoder, [0, 0], [decoderWidth, wordCount], mbMem];
--MakeDataBlock[PLAData, [dataX, 0], [wordWidth, wordCount/2], mbMem];

--DrawCell[MakeNewCell[PLAName, lpp].ob];
  EXITS Exit => NULL;
  END;

  -- give back all the storage we allocated

--FreeBlocks[];
  Z ← ZoneAllocDefs.DestroyAnXMZone[Z];
  IF fileName # NIL THEN FreeString[fileName];
  IF memName # NIL THEN FreeString[memName];
  IF cellFamily # NIL THEN FreeString[cellFamily];
  IF PLAName # NIL THEN FreeString[PLAName];
  IF wdPerRowStr # NIL THEN FreeString[wdPerRowStr];
  IF s # NIL THEN s.destroy[s];
  anyChanges ← sinceIOchanges ← TRUE;

  END. -- of PLAMakerImpl