-- 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