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 };
				IF	p >= 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;(635)\b9B108f9b7f8B189b8B139b5B201b8B34b7B222b7B136b9B35b9B33b7B80b6B24b2B11b7B12b24B15b18B11b23B17b49B23b11B19b11B17b11B17b9B17b9B17b9B17b10B17b7B20b1B2f9b9f8B668b19B492b18B858b11B188b2f9 7f8B92b12B489b15B131f9b13f8B224b5B267b12B1644b25B13b16B146b2B123b6B209b25B15b7B93b19B475b7B57b11B125b4B46b5B47b4B32b5B29b7B73b43B12b3B19b19B12b7B76b8B358b11B207b5B670b11B298b19B286b5B1288f9b11f8B1275f9b13f8B1175f9b15f8B348f9b11f8B387f9b12f8B2131f9b14f8B1604b3f9 16f8B1090f9b9f8B
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 NOT		InitFiles[] THEN GOTO		InitFilesFailed;
	IF NOT		ReadPALType[] THEN GOTO		ReadPALTypeFailed; 
	InitPinArray[];
	vfa _ fa _ InitFuseArray[];
	IF NOT		ReadPinDefs[] THEN GOTO		ReadPinDefsFailed; 
	IF NOT		ReadEquations[] THEN GOTO	ReadEquationsFailed; 

	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.
\276f9b10f8B395b19B