DIRECTORY
ComString,
--ImageDefs,
InlineDefs,
IODefs,
KeyDefs,
SegmentDefs,
Space,
StreamDefs,
StringDefs;

PALAsmA: PROGRAM IMPORTS
ComString,
--ImageDefs,
InlineDefs,
IODefs,
Space,
StreamDefs,
StringDefs =

BEGIN OPEN
--ImageDefs,
InlineDefs,
IODefs,
SegmentDefs,
StreamDefs,
StringDefs;

PALType:TYPE = { PTUndefined,
PT10H8,PT10L8,PT12H6,PT12L6,PT14H4,PT14L4,PT16H2,PT16L2,
PT16C1,PT16L8,PT16R8,PT16R6,PT16R4,PT16X4,PT16A4};
Token:TYPE = {
or, and, eq, neqXor, not, left, right, gets, getsNext,
if, then, true, false,
paldef, pindefs, begin, end,
carry0, carry1, carry2, carry3,
iopin, unknown, space,
endOfLine, endOfFile};
PinArray:TYPE = ARRAY [1..20] OF pinDesc;
pinDesc:TYPE = RECORD[
type:pinType ← Input,
name:STRING,
nameinverted:BOOLEAN ← FALSE,
outinverted:BOOLEAN ← TRUE,
prodGrp:CARDINAL[0..7] ← 0,
nofProds:CARDINAL[2..8] ← 8,
in:CARDINAL[0..31] ← 0,
used:BOOLEAN ← FALSE ];
pinType:TYPE = {
Clock, FixedDisable, Power, Ground,
Input, BuiltIn,
Output, BuiltInClockedOut,
ClockedInOut,
EnabledOut, EnabledInOut};
FuseArray:TYPE = ARRAY [0..7] OF ProdGroup;
ProdGroup:TYPE = ARRAY [0..7] OF Product;
Product:TYPE = PACKED ARRAY [0..31] OF BOOLEAN
← ALL[FALSE]; -- FALSE => not blown

ptype:PALType ← PTUndefined;
pa:PinArray;
vfa, fa:FuseArray;
currentToken, lastToken:Token ← space;
currentPin,lastPin:CARDINAL;
nextChar, nextTokenChar:CHARACTER ← SP;
inStream, mbStream, listStream, originalOutStream
:StreamHandle ← NIL;
pinsDefined:BOOLEAN ← FALSE;
errorCalled:BOOLEAN ← FALSE;

palString:STRING ← [100];
argString:STRING ← [100];
subString:STRING ← [100];
tmpString:STRING ← [100];
currentStr:STRING ← [100];
lastStr:STRING ← [100];



NextToken:PROCEDURE RETURNS[Token] =
BEGIN -- Condenses strings - requires one char memory
tstr:STRING ←lastStr; lastStr ←currentStr; currentStr ←tstr;
lastToken ← currentToken;
lastPin ← currentPin;
DO
currentToken ← IdentifyTokenChar[nextTokenChar];
currentStr.length ← 0;
SELECT currentToken FROM
space => { nextTokenChar ← GetChar[]; LOOP };
unknown => DO
AppendChar[currentStr, nextTokenChar];
nextTokenChar ← GetChar[];
IF IdentifyTokenChar[nextTokenChar] # unknown THEN
BEGIN
currentToken ←IdentifyTokenStr[currentStr];
RETURN[currentToken]; END;
ENDLOOP;
ENDCASE => EXIT;
ENDLOOP;
nextTokenChar ← GetChar[];
RETURN[currentToken];
END;


IdentifyTokenChar:PROCEDURE
[ char:CHARACTER ] RETURNS[ name:Token ] =
BEGIN
SELECT char FROM
’+ =>name ← or;
’* =>name ← and;
’= =>name ← eq;-- equality test
’# =>name ← neqXor;-- not eq same as xor
’/ =>name ← not;
’[,’( =>name ← left;
’],’) =>name ← right;
’{ =>name ← begin;
’} =>name ← end;
’← =>name ← gets;
’↑ =>name ← getsNext;
’; =>name ← endOfLine;
NUL =>name ← endOfFile;
SP,’: =>name ← space;-- colen same as space
ENDCASE=>name ← unknown;
END;


IdentifyTokenStr:PROCEDURE
[ str:STRING ] RETURNS[ name:Token ] =
BEGIN
i:CARDINAL;
IF EqualString[str, "IF"] THEN RETURN[if];
IF EqualString[str, "THEN"] THEN RETURN[then];
IF EqualString[str, "XOR"] THEN RETURN[neqXor];
IF EqualString[str, "TRUE"] THEN RETURN[true];
IF EqualString[str, "FALSE"] THEN RETURN[false];
IF EqualString[str, "CARRY0"] THEN RETURN[carry0];
IF EqualString[str, "CARRY1"] THEN RETURN[carry1];
IF EqualString[str, "CARRY2"] THEN RETURN[carry2];
IF EqualString[str, "CARRY3"] THEN RETURN[carry3];
IF EqualString[str, "PinDefs"] THEN RETURN[pindefs];
IF EqualString[str, "PALType"] THEN RETURN[paldef];
IF EqualString[str, "BEGIN"] THEN RETURN[begin];
IF EqualString[str, "END"] THEN RETURN[end];
IF pinsDefined THEN FOR i IN [1..20] DO
IF NOT EqualString[str, pa[i].name] THEN LOOP;
currentPin ← i; RETURN[iopin]; ENDLOOP;
RETURN[unknown];
END;


FindToken:PROCEDURE[token:Token] RETURNS[success:BOOLEAN] =
BEGIN
DO
IF currentToken = token THEN RETURN[TRUE];
IF currentToken = endOfFile THEN RETURN[FALSE];
[] ← NextToken[];
ENDLOOP; END;



GetChar:PROCEDURE RETURNS[ char:CHARACTER ]=
BEGIN -- Condenses spaces - requires one char memory
BasicGetChar:PROCEDURE RETURNS[ CHARACTER ]=
BEGIN -- Removes ↑z’s, echos, < SP => SP
ptrchar, rtnchar:CHARACTER;
IF inStream.endof[inStream] THEN RETURN[NUL];
ptrchar ← rtnchar ← inStream.get[inStream];
SELECT rtnchar FROM
LF, CR, ’,, SP, TAB => rtnchar ← SP;
< SP => BEGIN -- control z caught here
ptrchar ← CR;
rtnchar ← SP;
WHILE NOT inStream.endof[inStream]
DO IF inStream.get[inStream]=CR THEN EXIT ENDLOOP;
END;
ENDCASE;
WriteChar[ptrchar];
RETURN[rtnchar];
END;
-- GetChar body
char ← nextChar;
nextChar ← BasicGetChar[];
IF char = SP THEN WHILE nextChar = SP DO
nextChar ← BasicGetChar[]; ENDLOOP;
END;



ReadEquations:PROCEDURE RETURNS[success:BOOLEAN] =
BEGIN
IF NOT FindToken[begin] THEN RETURN[FALSE];
DO
[] ← NextToken[];
ReadEquation[];
SELECT currentToken FROM end, endOfFile =>
RETURN[NOT errorCalled]; ENDCASE;
ENDLOOP;
END;


Error:PROCEDURE[str:STRING] =
BEGIN
errorCalled ← TRUE;
WriteChar[CR];
WriteString["<<"]; WriteString[str]; WriteString[">>"];
WriteChar[CR];
DO SELECT currentToken FROM
endOfLine, endOfFile, end => RETURN;
ENDCASE => {[] ← NextToken[]; LOOP};ENDLOOP;
END;


ReadEquation:PROCEDURE =
BEGIN
conditional:BOOLEAN ← FALSE;
xorfound:BOOLEAN ← FALSE;
condProd:Product ← ALL[TRUE];
pin:CARDINAL [1..20];
p,pmax,pg:CARDINAL;

--Conditional Enable
DO SELECT currentToken FROM
end, endOfFile, endOfLine => RETURN;
if => BEGIN
[] ← NextToken[];
IF conditional THEN {Error["Two ’IFs’"]; RETURN};
conditional ← TRUE;
condProd ← ReadProduct[condProd];
IF currentToken = then
THEN [] ← NextToken[]
ELSE WriteString["<<THEN>>"];
EXIT; END;
not, iopin => EXIT;
ENDCASE => {Error["Bad 1st term"]; RETURN};
ENDLOOP;

-- Output pin check
IF currentToken = not THEN []←NextToken[];
pin ← currentPin;
IF currentToken # iopin OR pa[pin].type < Output THEN
{Error["Bad output pin specification"]; RETURN};
IF pa[pin].outinverted #
(pa[pin].nameinverted # (lastToken = not)) THEN
{Error["Bad output pin polarity"]; RETURN};
IF conditional AND pa[pin].type < EnabledOut THEN
{Error["Output is not 3-State"]; RETURN};
IF pa[pin].used THEN
{Error["Output already used"]; RETURN};
pa[pin].used ← TRUE;
pg ← pa[pin].prodGrp;
p ← 0;
IF pa[pin].type >= EnabledOut THEN
{fa[pg][0] ← condProd; p ← 1};
pmax ← pa[pin].nofProds-1;

-- Check assignment symbol
[]← NextToken[];
SELECT currentToken FROM
gets => IF pa[pin].type
IN[BuiltInClockedOut..ClockedInOut]
THEN WriteString["<<↑>>"];
getsNext => IF pa[pin].type
NOT IN[BuiltInClockedOut..ClockedInOut]
THEN WriteString["<<←>>"];
eq => IF pa[pin].type IN[BuiltInClockedOut..ClockedInOut]
THEN WriteString["<<↑>>"]
ELSE WriteString["<<←>>"];
ENDCASE => {Error["Strange token"]; RETURN};

-- Get Sum
[]← NextToken[];
DO SELECT currentToken FROM
end, endOfLine, endOfFile => RETURN;
left, not, iopin => BEGIN
IF p > pmax THEN
{ Error["Product index too large"]; RETURN };
fa[pg][p] ← ReadProduct[ALL[TRUE]];
SELECT currentToken FROM
or => IF pa[pin].type = BuiltInClockedOut
AND p >= 3 AND NOT xorfound THEN
{ Error["Missing XOR"]; RETURN };
neqXor => BEGIN
IF pa[pin].type # BuiltInClockedOut THEN
{ Error["No Xor’s builtin"]; RETURN };
IFp >= 4 THEN
{ Error["Product index too large"]; RETURN };
xorfound ← TRUE;
p ← 3; END;
end, endOfLine, endOfFile => RETURN;
ENDCASE =>
{ Error["Strange delimiter token"]; RETURN };
[]←NextToken[];
p ← p + 1;
END;
IN [carry0..carry3] => BEGIN
IF ptype # PT16A4
OR NOT (pa[pin].type = BuiltInClockedOut) THEN
{ Error["No builtin carrys"]; RETURN };
IF SELECT currentToken FROM
carry0 => pin # 17, carry1 => pin # 16,
carry2 => pin # 15, carry3 => pin # 14,
ENDCASE => TRUE THEN
{ Error["Wrong carry"]; RETURN };
IF p < 4 THEN
{ Error["Missing XOR"]; RETURN };
[] ← NextToken[];
IF currentToken # endOfLine OR currentToken # end THEN{ Error["Missing ;"]; RETURN }; END;
ENDCASE =>
{ Error["Illegal term"]; RETURN };
ENDLOOP;
END;


ReadProduct:PROCEDURE[prod:Product] RETURNS[Product] =
BEGIN
DO
IF currentToken = not THEN []←NextToken[];
SELECT currentToken FROM
true => { prod ← ALL[TRUE]; [] ← NextToken[] };
false => { prod ← ALL[FALSE]; [] ← NextToken[] };
left => prod ← ReadBuiltin[prod];
iopin => prod ← ReadTerm[prod];
ENDCASE => { Error["Illegal term"]; RETURN[prod] };
SELECT currentToken FROM
then, end, endOfLine, endOfFile, neqXor, or => EXIT;
and => []←NextToken[];
left, not, iopin => LOOP;
ENDCASE => { Error["Illegal term"]; RETURN[prod] };
ENDLOOP;
RETURN[prod];
END;


ReadTerm:PROCEDURE[prod:Product] RETURNS[Product] =
BEGIN
same:BOOLEAN;
SELECT pa[currentPin].type FROM
Input, ClockedInOut, EnabledInOut => NULL;
ENDCASE => { Error["Not an input"]; RETURN[prod] };
same ← pa[currentPin].nameinverted = (lastToken = not);
prod[pa[currentPin].in] ← NOT same;
prod[pa[currentPin].in+1] ← same;
[] ← NextToken[];
RETURN[prod];
END;


ReadBuiltin:PROCEDURE[prod:Product] RETURNS[Product] =
BEGIN
ipin, opin:CARDINAL ← 0;
iinv, oinv, flip:BOOLEAN ← FALSE;
ftoken:Token ← unknown;
DO
IF NextToken[] = not THEN []←NextToken[];
SELECT currentToken FROM
iopin => BEGIN SELECT pa[currentPin].type FROM
BuiltIn => BEGIN
IF ftoken = unknown AND opin # 0 THEN
{ Error["Missing function"]; RETURN[prod] };
IF ipin # 0 THEN
{ Error["Not builtin output"]; RETURN[prod] };
ipin ← currentPin;
iinv ← (lastToken = not) # pa[ipin].nameinverted;
END;
BuiltInClockedOut => BEGIN
IF ftoken = unknown AND ipin # 0 THEN
{ Error["Missing function"]; RETURN[prod] };
IF opin # 0 THEN
{ Error["Not builtin input"]; RETURN[prod] };
opin ← currentPin;
oinv ← (lastToken = not) # pa[opin].nameinverted;
END;
ENDCASE =>
{ Error["Not builtin i/o pin"]; RETURN[prod] };
END;
true, false => BEGIN
IF (opin # 0) OR (ipin # 0)
OR ftoken # unknown
OR lastToken # left
OR NextToken[] # right THEN
{ Error["Bad fixed builtin"]; RETURN[prod] };
IF lastToken = true
THEN { []←NextToken[]; RETURN[ALL[TRUE]] }
ELSE { []←NextToken[]; RETURN[ALL[FALSE]] }; END;
or, and, eq, neqXor => BEGIN
IF lastToken = not THEN
{ Error["Negation of function"]; RETURN[prod] };
IF ftoken # unknown THEN
{ Error["Two functions"]; RETURN[prod] };
IF (opin = 0) = (ipin = 0) THEN
{ Error["Function out of place"]; RETURN[prod] };
ftoken ← currentToken; END;
right => BEGIN
IF lastToken = not THEN
{ Error["Bad negation"]; RETURN[prod] };
IF (opin = 0) # (ipin = 0) THEN
IF ftoken # unknown THEN
{ Error["Missing argument"]; RETURN[prod] };
[] ← NextToken[];
EXIT; END;
ENDCASE => { Error["Strange builtin"]; RETURN[prod] };
ENDLOOP;
IF (ftoken # unknown) AND (ipin + opin # 21) THEN
{ Error["Builtin’s do not match"]; RETURN[prod] };
flip ← (ftoken = and) OR (ftoken = eq);
iinv ← iinv # flip;
oinv ← oinv # flip;
SELECT ftoken FROM
and, or => BEGIN
prod[pa[ipin].in +0] ← ( iinv OR NOT oinv) # flip;
prod[pa[ipin].in +1] ← (NOT iinv OR NOT oinv) # flip;
prod[pa[ipin].in +2] ← ( iinv OR oinv) # flip;
prod[pa[ipin].in +3] ← (NOT iinv OR oinv) # flip;
END;
eq, neqXor => BEGIN
prod[pa[ipin].in +0] ← prod[pa[ipin].in +3]
← (iinv = oinv) # flip;
prod[pa[ipin].in +1] ← prod[pa[ipin].in +2]
← (iinv # oinv) # flip;
END;
unknown => -- one argument
BEGIN
IF ipin # 0 THEN BEGIN
prod[pa[ipin].in+0]←prod[pa[ipin].in+2] ← iinv;
prod[pa[ipin].in+1]←prod[pa[ipin].in+3] ←NOT iinv;
END;
IF opin # 0 THEN BEGIN
prod[pa[opin].in-2]←prod[pa[opin].in-1] ←NOT oinv;
prod[pa[opin].in+0]←prod[pa[opin].in+1] ← oinv;
END;
END;
ENDCASE;
RETURN[prod];
END;



ReadPALType:PROCEDURE RETURNS[success:BOOLEAN] =
BEGIN
IF NOT FindToken[paldef] THEN RETURN[FALSE];
IF NextToken[] # unknown THEN RETURN[FALSE];
ptype ← PTUndefined;
IF EquivalentString[currentStr, "10H8"] THEN ptype ← PT10H8;
IF EquivalentString[currentStr, "10L8"] THEN ptype ← PT10L8;
IF EquivalentString[currentStr, "12H6"] THEN ptype ← PT12H6;
IF EquivalentString[currentStr, "12L6"] THEN ptype ← PT12L6;
IF EquivalentString[currentStr, "14H4"] THEN ptype ← PT14H4;
IF EquivalentString[currentStr, "14L4"] THEN ptype ← PT14L4;
IF EquivalentString[currentStr, "16H2"] THEN ptype ← PT16H2;
IF EquivalentString[currentStr, "16L2"] THEN ptype ← PT16L2;
IF EquivalentString[currentStr, "16C1"] THEN ptype ← PT16C1;
IF EquivalentString[currentStr, "16L8"] THEN ptype ← PT16L8;
IF EquivalentString[currentStr, "16R8"] THEN ptype ← PT16R8;
IF EquivalentString[currentStr, "16R6"] THEN ptype ← PT16R6;
IF EquivalentString[currentStr, "16R4"] THEN ptype ← PT16R4;
IF EquivalentString[currentStr, "16X4"] THEN ptype ← PT16X4;
IF EquivalentString[currentStr, "16A4"] THEN ptype ← PT16A4;
AppendString[palString, currentStr];
success ← ptype # PTUndefined;
IF NOT success THEN BEGIN
WriteChar[CR];
WriteString["<<Unknown PAL type - "];
WriteString[currentStr];
WriteLine[" >>"] END;
END;


InitFuseArray:PROCEDURE RETURNS[FuseArray] =
BEGIN
fuses:FuseArray; -- not blown
i:CARDINAL;
RemoveNonExistantInFuses:PROCEDURE[first, last:CARDINAL] =
BEGIN
pg, p:CARDINAL;
FOR pg IN [0..7] DO
FOR p IN [0..7] DO
FOR i ← first, i+4 WHILE i <= last DO
fuses[pg][p][i] ← fuses[pg][p][i+1] ← TRUE;
ENDLOOP; ENDLOOP; ENDLOOP; END;

SetPGroup:PROCEDURE[pg:CARDINAL, fuseblown:BOOLEAN] =
BEGIN
i,p:CARDINAL;
FOR p IN [0..7] DO
FOR i IN [0..31] DO
fuses[pg][p][i] ← fuseblown;
ENDLOOP; ENDLOOP; END;

SELECT ptype FROM
IN [PT10H8..PT10L8] => RemoveNonExistantInFuses[ 6, 26];
IN [PT12H6..PT12L6] => RemoveNonExistantInFuses[10, 22];
IN [PT14H4..PT14L4] => RemoveNonExistantInFuses[14, 18];
ENDCASE;
SELECT ptype FROM
PT12H6 => BEGIN
SetPGroup[0,TRUE ];SetPGroup[7,TRUE ] END;
PT12H6 => BEGIN
SetPGroup[0,FALSE];SetPGroup[7,FALSE] END;
PT14H4 => FOR i IN [0..1] DO
SetPGroup[i,TRUE ];SetPGroup[7-i,TRUE ] ENDLOOP;
PT14L4 => FOR i IN [0..1] DO
SetPGroup[i,FALSE];SetPGroup[7-i,FALSE] ENDLOOP;
PT16H2 => FOR i IN [0..2] DO
SetPGroup[i,TRUE ];SetPGroup[7-i,TRUE ] ENDLOOP;
PT16C1 => FOR i IN [0..2] DO
SetPGroup[i,TRUE ];ENDLOOP;
ENDCASE;
RETURN[fuses];
END;



OutputFuseArray:PROCEDURE[fuses:FuseArray] =
BEGIN
pg,p,i,j:CARDINAL;
char:CHARACTER;
FOR pg IN [0..7] DO
FOR p IN [0..7] DO
FOR i ← 0, i+4 WHILE i < 32 DO
FOR j IN [i..i+3] DO
IF fuses[pg][p][j] THEN char ← ’- ELSE char ← ’X;
WriteChar[char];
ENDLOOP;
WriteChar[SP];
ENDLOOP;
WriteChar[CR];
ENDLOOP;
WriteChar[CR];
ENDLOOP;
END;



ReadPinDefs:PROCEDURE RETURNS[success:BOOLEAN] =
BEGIN
i:CARDINAL;
IF NOT FindToken[pindefs] THEN RETURN[FALSE];
FOR i IN [1..20] DO
inverted:BOOLEAN ← FALSE;
IF NextToken[] = not THEN
{inverted ← TRUE; [] ← NextToken[]};
IF currentToken # unknown THEN RETURN[FALSE];
AppendString[pa[i].name, currentStr];
pa[i].nameinverted ← inverted;
ENDLOOP;
pinsDefined ← TRUE;
RETURN[TRUE];
END;



InitPinArray:PROCEDURE =
BEGIN
pg,i:CARDINAL;

-- type and nofProds - default input and 8
pa[10].type ← Ground;
pa[20].type ← Power;
IF ptype IN [PT16R8..PT16A4] THEN
{ pa[1].type ← Clock; pa[11].type ← FixedDisable };
SELECT ptype FROM
IN [PT10H8.. PT10L8] =>
FOR i IN [12..19] DO
pa[i].type ← Output; pa[i].nofProds ← 2; ENDLOOP;
IN [PT12H6.. PT12L6] => BEGIN
pa[13].type ← pa[18].type ← Output;
pa[13].nofProds ← pa[18].nofProds ← 4;
FOR i IN [14..17] DO
pa[i].type ← Output; pa[i].nofProds ← 2 ENDLOOP; END;
IN [PT14H4.. PT14L4] =>
FOR i IN [14..17] DO
pa[i].type ← Output; pa[i].nofProds ← 4 ENDLOOP;
IN [PT16H2.. PT16C1] =>
FOR i IN [15..16] DO
pa[i].type ← Output; ENDLOOP;
PT16L8 => BEGIN
pa[12].type ← pa[19].type ← EnabledOut;
FOR i IN [13..18] DO
pa[i].type ← EnabledInOut; ENDLOOP; END;
PT16R8 =>
FOR i IN [12..19] DO
pa[i].type ← ClockedInOut; ENDLOOP;
PT16R6 => BEGIN
pa[12].type ← pa[19].type ← EnabledInOut;
FOR i IN [13..18] DO
pa[i].type ← ClockedInOut; ENDLOOP; END;
PT16R4 => BEGIN
FOR i IN [12..19] DO
pa[i].type ← EnabledInOut; ENDLOOP;
FOR i IN [14..17] DO
pa[i].type ← ClockedInOut ENDLOOP; END;
IN [PT16X4.. PT16A4] => BEGIN
FOR i IN [ 4.. 7] DO
pa[i].type ← BuiltIn; ENDLOOP;
FOR i IN [12..19] DO
pa[i].type ← EnabledInOut; ENDLOOP;
FOR i IN [14..17] DO
pa[i].type ← BuiltInClockedOut; ENDLOOP; END;
ENDCASE => ERROR;

-- prodGrp - only used when pin is an output
FOR pg IN [0..7]
DO pa[19-pg].prodGrp ← pg; ENDLOOP;
IF ptype = PT16C1 THEN pa[15].prodGrp ← 3;

-- name
FOR i IN [1..20] DO
pa[i].name ← Space.GetString[25];
pa[i].name.length ← 0; ENDLOOP;

-- outinverted - default TRUE;
SELECT ptype FROM
PT10H8,PT12H6,PT14H4,PT16H2 =>
FOR i IN [12..19] DO
pa[i].outinverted ← FALSE; ENDLOOP;
PT16C1 => pa[16].outinverted ← FALSE;
ENDCASE;

-- in - used only on inputs and inouts
FOR i IN [2..9] DO pa[i].in ← i*4-8 ENDLOOP;
pa[1].in ← 2;
FOR i IN [11..14] DO pa[i].in ← (14-i)*4+18 ENDLOOP;
FOR i IN [17..19] DO pa[i].in ← (19-i)*4+ 6 ENDLOOP;
IF ptype > PT16C1 THEN
FOR i IN [12..19] DO pa[i].in ← (19-i)*4+ 2 ENDLOOP;
END;



ListPinDefs:PROCEDURE =
BEGIN
tstr:STRING;
i,pin,max:CARDINAL ← pa[1].name.length;
decimal2:NumberFormat ← [10, FALSE, TRUE,2];
WriteLine[" "]; WriteLine[" "];
WriteString["Pin Definitions for PAL type: "];
WriteLine[palString];
max ← pa[1].name.length; FOR pin IN [2..20]
DO max ← MAX[max, pa[pin].name.length]; ENDLOOP;
FOR pin IN [1..20] DO
WriteNumber[pin, decimal2 ];
IF pa[pin].nameinverted
THEN WriteString[" /"]
ELSE WriteString[" "];
WriteString[pa[pin].name];
FOR i IN [pa[pin].name.length..max+1]
DO WriteString[" "]; ENDLOOP;
tstr ←SELECT pa[pin].type FROM
Clock=> "Clock ",
FixedDisable=> "FixedDisable ",
Power=> "Power ",
Ground=> "Ground ",
Input=> "Input ",
BuiltIn=> "BuiltIn ",
Output=> "Output ",
BuiltInClockedOut=> "BuiltInClockedOut ",
ClockedInOut=> "ClockedInOut ",
EnabledOut=> "EnabledOut ",
EnabledInOut=> "EnabledInOut ",
ENDCASE=> "???? " ;
WriteString[ tstr ];
SELECT pa[pin].type FROM
Output, EnabledOut => WriteString[" "];
IN [Input..EnabledInOut] => BEGIN
WriteString[" index = "];
WriteNumber[pa[pin].in, decimal2];
END;
ENDCASE;
IF pa[pin].type IN [Output..EnabledInOut] THEN BEGIN
IF pa[pin].outinverted
THEN WriteString[" /"]
ELSE WriteString[" "];
WriteString["out gp = "];
WriteNumber[pa[pin].prodGrp, decimal2];
WriteString[" Nof prods = "];
WriteNumber[pa[pin].nofProds, decimal2]; END;
WriteChar[CR];
ENDLOOP;
END;



WriteMBFuseArray:PROCEDURE
[f:FuseArray,memstr:STRING,memindex:CARDINAL] =
BEGIN OPEN InlineDefs;
WriteMBWord:PROCEDURE[item:WORD] =
{ mbStream.put[mbStream, item] };
strout:PROCEDURE[index:CARDINAL] RETURNS[CHARACTER] =
{ IF index >= memstr.length THEN RETURN[NUL]
ELSE RETURN[memstr[index]] };
i,pgi,p:CARDINAL;
word:WORD;
WriteLine["define memory"];
WriteMBWord[4];-- Define memory
WriteMBWord[memindex];-- Memory index
WriteMBWord[4];-- word width
FOR i IN [0..(memstr.length+2)/2-1] DO
word ← BITOR[ BITSHIFT[strout[2*i],8], strout[2*i+1]];
WriteMBWord[word]; ENDLOOP;
WriteMBWord[2];-- Set Location
WriteMBWord[memindex];-- Memory index
WriteMBWord[0];-- Start location
FOR pgi IN[0..1] DO FOR p IN[0..7] DO FOR i IN[0..31] DO
word ← 0;
IF f[pgi*4 + 0][p][i] THEN word ← BITOR[word, 1B4];
IF f[pgi*4 + 1][p][i] THEN word ← BITOR[word, 2B4];
IF f[pgi*4 + 2][p][i] THEN word ← BITOR[word, 4B4];
IF f[pgi*4 + 3][p][i] THEN word ← BITOR[word,10B4];
WriteMBWord[1]; -- Define data word
WriteMBWord[0]; -- Source line
WriteMBWord[word]; ENDLOOP; ENDLOOP; ENDLOOP; END;



InitFiles:PROCEDURE RETURNS[success:BOOLEAN] =
BEGIN
comCMStream:StreamHandle ← NIL;
argStr:STRING ← [100];
subStr:STRING ← [100];
comCMStream ← ComString.OpenCommandLine[];
[] ← ComString.GetStreamArg[comCMStream, argStr, subStr];
ComString.CloseCommandLine[comCMStream];
DO ENABLE FileNameError => {
WriteString["Bad File Name:"];
WriteLine[name];
argStr.length←0;
LOOP};
IF argStr.length = 0 THEN
{WriteString["File Name: "]; ReadLine[argStr]};
inStream ← NewByteStream[argStr, Read];
EXIT;
ENDLOOP;
subStr.length ← 0; AppendString[subStr, argStr];
FOR i:CARDINAL IN [0..argStr.length) DO
IF subStr[i] # ’. THEN LOOP;
subStr.length ← i+1;
EXIT; REPEAT
FINISHED => AppendChar[subStr, ’.]; ENDLOOP;

AppendString[subStr,"MB"];
mbStream ← NewWordStream[subStr, WriteAppend];
subStr.length ← subStr.length-2; AppendString[subStr,"List"];
listStream ← NewByteStream[subStr, WriteAppend ];
originalOutStream ← GetOutputStream[];
SetOutputStream[listStream];
RETURN[TRUE];
END;



CloseFiles:PROCEDURE[str:STRING] =
BEGIN
i:CARDINAL;
WHILE GetChar[] # NUL DO LOOP ENDLOOP;
WriteChar[CR]; WriteChar[CR]; WriteLine[str];
SetOutputStream[originalOutStream];
inStream.destroy[inStream];
mbStream.put[mbStream,0];mbStream.put[mbStream,0];
TruncateDiskStream[mbStream];
TruncateDiskStream[listStream];
WriteChar[CR]; WriteChar[CR]; WriteLine[str];
FOR i IN [1..20000] DO LOOP ENDLOOP;
END;


-- Begin Execution

--MakeImage["PAL.image"];
WriteLine["PAL Assembler of May 14, 1981"];
-- WriteString["Ready?"]; [] ← ReadChar[];
DO
IF NOTInitFiles[] THEN GOTOInitFilesFailed;
IF NOTReadPALType[] THEN GOTOReadPALTypeFailed;
InitPinArray[];
vfa ← fa ← InitFuseArray[];
IF NOTReadPinDefs[] THEN GOTOReadPinDefsFailed;
IF NOTReadEquations[] THEN GOTOReadEquationsFailed;

WHILE GetChar[] # NUL DO LOOP ENDLOOP;

ListPinDefs[];

WriteChar[CR];WriteChar[CR];
WriteLine["Virgin fuses"];
OutputFuseArray[vfa];
WriteMBFuseArray[vfa, "VirginPALFuses", 0];

WriteChar[CR];WriteChar[CR];
WriteLine["Programmed fuses"];
OutputFuseArray[fa];
WriteMBFuseArray[fa, "PALFuses", 1];

CloseFiles["<<No Errors>>"];
EXIT;
REPEAT
InitFilesFailed =>CloseFiles["<<InitFiles Failed>>"];
ReadPALTypeFailed =>CloseFiles["<<ReadPALType Failed>>"];
ReadPinDefsFailed =>CloseFiles["<<ReadPinDefs Failed>>"];
ReadEquationsFailed =>CloseFiles["<<ReadEquations Failed>>"];
ENDLOOP;
END.