
<<Palasm.mesa>>
<<Last Edited by: Gasbarro, August 13, 1985 4:02:38 pm PDT>>
<<>>
<<REMEMBER TO CHANGE HERALD IN ConvertPALToMB>>
<<>>

DIRECTORY
Basics,
Buttons,
Commander, 
Containers,
FS,
IO, 
Rope,
Rules,
VFonts,
ViewerClasses,
ViewerIO,
ViewerOps,
ViewerTools;

Palasm:  CEDAR PROGRAM 
IMPORTS Basics, Buttons, Commander, Containers, FS, IO, Rope, Rules, VFonts, ViewerIO, ViewerOps, ViewerTools

= BEGIN

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: Rope.ROPE,
nameinverted: BOOLEAN _ FALSE,
outinverted: BOOLEAN _ TRUE,
prodGrp: NAT[0..7] _ 0,
nofProds: NAT[2..8] _ 8,
in: NAT[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;
PinArrayRef: TYPE = REF PinArray;
pa: PinArrayRef;

vfa, fa: FuseArray;
currentToken, lastToken: Token _ space;
currentPin,lastPin: NAT;
nextChar, nextTokenChar: CHARACTER _ IO.SP;
inStream, listStream, mbStream: IO.STREAM _ NIL;
pinsDefined: BOOLEAN _ FALSE; 
errorCalled: BOOLEAN _ FALSE;

palString: Rope.ROPE;
currentStr: Rope.ROPE;
lastStr: Rope.ROPE;

viewerout: IO.STREAM;
rootFileName: Rope.ROPE;

entryHeight: CARDINAL = 15;    -- how tall to make each line of items
entryVSpace: CARDINAL = 8;     -- vertical leading space between lines
entryHSpace: CARDINAL = 10;     -- horizontal space between items in a line

Handle: TYPE = REF PALToolRec;
PALToolRec: TYPE = RECORD [    -- the data for a particular tool instance
outer: Containers.Container _ NIL,    -- handle for the enclosing container
height: CARDINAL _ 0,        -- height measured from the top of the container
pal: PALViewer];        -- the PAL viewer's state
PALViewer: TYPE = RECORD [
input: ViewerClasses.Viewer _ NIL,
output: IO.STREAM];    

MakePALTool: Commander.CommandProc = BEGIN
my: Handle _ NEW[PALToolRec];

my.outer _ Containers.Create[[-- construct the outer container        
name: "PAL Tool",
iconic: TRUE,
column: left,
scrollable: FALSE ]];
MakePAL[my];
ViewerOps.SetOpenHeight[my.outer, my.height];
ViewerOps.PaintViewer[my.outer, all];
END;

MakePAL: PROC [handle: Handle] = BEGIN
promptButton, computeButton: Buttons.Button;
rule: Rules.Rule;
handle.height _ handle.height + entryVSpace;
promptButton _ Buttons.Create[
info: [
name: "Filename:", 
wy: handle.height,
wh: entryHeight,
parent: handle.outer,
border: FALSE ],
proc: Prompt,
clientData: handle];
handle.pal.input _ ViewerTools.MakeNewTextViewer[ [
parent: handle.outer,
wx: promptButton.wx + promptButton.ww + entryHSpace,
wy: handle.height+2,
ww: 40*VFonts.CharWidth['0],
wh: entryHeight,
scrollable: FALSE,
border: FALSE]];
computeButton _ Buttons.Create[
info: [
name: "Convert PAL To MB",
wx: handle.pal.input.wx + handle.pal.input.ww + entryHSpace,
wy: handle.height,
ww:,
wh: entryHeight,
parent: handle.outer,
border: TRUE],
clientData: handle,
proc: ConvertPALToMB];

handle.height _ handle.height + entryHeight + entryVSpace;

rule _ Rules.Create[ [    -- create a bar to separate sections 1 and 2
parent: handle.outer,
wy: handle.height,
ww: handle.outer.cw,
wh: 2]];
Containers.ChildXBound[handle.outer, rule];    -- constrain rule to be width of parent
[ , viewerout] _ ViewerIO.CreateViewerStreams[name:"Fred", viewer:ViewerOps.CreateViewer[flavor: $TypeScript, info:[parent: 
handle.outer,
wy: handle.height+2,
ww: 100*VFonts.CharWidth['0],
wh: 56 * entryHeight,
scrollable: TRUE,
border: FALSE]]];
handle.height _ handle.height + 10 * entryHeight;
END;
Prompt: Buttons.ButtonProc = BEGIN
<<force the selection into the user input field>>
handle: Handle _ NARROW[clientData];    -- get our data
ViewerTools.SetSelection[handle.pal.input];        -- force the selection
END;


NextToken: PROCEDURE RETURNS[Token] =
BEGIN -- Condenses strings - requires one char memory
tstr: Rope.ROPE _ lastStr; lastStr _ currentStr; currentStr _ tstr;
lastToken _ currentToken;
lastPin _ currentPin;
DO
currentToken _ IdentifyTokenChar[nextTokenChar];
currentStr _ NIL;
SELECT currentToken FROM
space => {nextTokenChar _ GetChar[]; LOOP};
unknown => DO
currentStr _ Rope.Concat[currentStr, Rope.FromChar[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;
IO.NUL =>    name _ endOfFile;
IO.SP,':  =>    name _ space;            -- colon same as space
ENDCASE=>    name _ unknown;
END;

IdentifyTokenStr: PROCEDURE
[ str: Rope.ROPE ] RETURNS[ name: Token ] =
BEGIN
i: NAT;
IF Rope.Equal[str, "IF", FALSE] THEN RETURN[if];
IF Rope.Equal[str, "THEN", FALSE] THEN RETURN[then];
IF Rope.Equal[str, "XOR", FALSE] THEN RETURN[neqXor];
IF Rope.Equal[str, "TRUE", FALSE] THEN RETURN[true];
IF Rope.Equal[str, "FALSE", FALSE] THEN RETURN[false];
IF Rope.Equal[str, "CARRY0", FALSE] THEN RETURN[carry0];
IF Rope.Equal[str, "CARRY1", FALSE] THEN RETURN[carry1];
IF Rope.Equal[str, "CARRY2", FALSE] THEN RETURN[carry2];
IF Rope.Equal[str, "CARRY3", FALSE] THEN RETURN[carry3];
IF Rope.Equal[str, "PinDefs", FALSE] THEN RETURN[pindefs];
IF Rope.Equal[str, "PALType", FALSE] THEN RETURN[paldef];
IF Rope.Equal[str, "BEGIN", FALSE] THEN RETURN[begin];
IF Rope.Equal[str, "END", FALSE] THEN RETURN[end];
IF pinsDefined THEN FOR i IN [1..20] DO 
IF NOT Rope.Equal[str, pa[i].name, FALSE] 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 IO.EndOf[inStream] THEN RETURN[IO.NUL];
ptrchar _ rtnchar _ IO.GetChar[inStream];
SELECT rtnchar FROM
IO.LF, IO.CR, ',, IO.SP, IO.TAB => rtnchar _ IO.SP;
< IO.SP => BEGIN -- control z caught here
ptrchar _ IO.CR;
rtnchar _ IO.SP;
WHILE NOT IO.EndOf[inStream]
DO IF IO.GetChar[inStream]=IO.CR THEN EXIT ENDLOOP;
END;
ENDCASE;
PutF[v1: IO.char[ptrchar]];
RETURN[rtnchar];
END;
<<GetChar body>>
char _ nextChar;
nextChar _ BasicGetChar[];
IF char = IO.SP THEN WHILE nextChar = IO.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: Rope.ROPE] =
BEGIN
errorCalled _ TRUE;
PutF["\n<<%g>>\n", IO.rope[str]];
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: NAT [1..20];
p,pmax,pg: NAT;

<<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 PutF["<<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 PutF["<<^>>"];
getsNext => IF pa[pin].type
NOT IN[BuiltInClockedOut..ClockedInOut]
THEN PutF["<<_>>"];
eq => IF pa[pin].type IN[BuiltInClockedOut..ClockedInOut]
THEN PutF["<<^>>"]
ELSE PutF["<<_>>"];
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: NAT _ 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 Rope.Equal[currentStr, "10H8", FALSE] THEN ptype _ PT10H8;
IF Rope.Equal[currentStr, "10L8", FALSE] THEN ptype _ PT10L8;
IF Rope.Equal[currentStr, "12H6", FALSE] THEN ptype _ PT12H6;
IF Rope.Equal[currentStr, "12L6", FALSE] THEN ptype _ PT12L6;
IF Rope.Equal[currentStr, "14H4", FALSE] THEN ptype _ PT14H4;
IF Rope.Equal[currentStr, "14L4", FALSE] THEN ptype _ PT14L4;
IF Rope.Equal[currentStr, "16H2", FALSE] THEN ptype _ PT16H2;
IF Rope.Equal[currentStr, "16L2", FALSE] THEN ptype _ PT16L2;
IF Rope.Equal[currentStr, "16C1", FALSE] THEN ptype _ PT16C1;
IF Rope.Equal[currentStr, "16L8", FALSE] THEN ptype _ PT16L8;
IF Rope.Equal[currentStr, "16R8", FALSE] THEN ptype _ PT16R8;
IF Rope.Equal[currentStr, "16R6", FALSE] THEN ptype _ PT16R6;
IF Rope.Equal[currentStr, "16R4", FALSE] THEN ptype _ PT16R4;
IF Rope.Equal[currentStr, "16X4", FALSE] THEN ptype _ PT16X4;
IF Rope.Equal[currentStr, "16A4", FALSE] THEN ptype _ PT16A4;
palString _ Rope.Concat[palString, currentStr];
success _ ptype # PTUndefined;
IF NOT success THEN BEGIN
PutF["\n<<Unknown PAL type - %g>>\n", IO.rope[currentStr]];
END;
END;

InitFuseArray: PROCEDURE RETURNS[FuseArray] =
BEGIN
fuses: FuseArray; -- not blown
i: NAT;
RemoveNonExistantInFuses: PROCEDURE[first, last: NAT] =
BEGIN
pg, p: NAT;
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: NAT, fuseblown: BOOLEAN] =
BEGIN
i,p: NAT;
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: NAT;
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;
PutF[v1: IO.char[char]];
ENDLOOP;
PutF[" "];
ENDLOOP;
PutF["\n"];
ENDLOOP;
PutF["\n"];
ENDLOOP;
END;

ReadPinDefs: PROCEDURE RETURNS[success: BOOLEAN] =
BEGIN
i: NAT;
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];
pa[i].name _ Rope.Concat[pa[i].name, currentStr];
pa[i].nameinverted _ inverted;
ENDLOOP;
pinsDefined _ TRUE;
RETURN[TRUE];
END;

InitPinArray: PROCEDURE =
BEGIN
pg,i: NAT;

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

<<Deleted space allocation for pa[].name here.  JAG>>

<<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: Rope.ROPE;
i,pin,max: INT _ Rope.Length[pa[1].name];
PutF["\n\n"];
PutF["Pin Definitions for PAL type:  %g\n", IO.rope[palString]];
max _ Rope.Length[pa[1].name];
FOR pin IN [2..20] DO max _ MAX[max, Rope.Length[pa[pin].name]]; ENDLOOP;
FOR pin IN [1..20] DO
PutF[v1: IO.int[pin]];
IF pa[pin].nameinverted THEN PutF["  /"] ELSE PutF["   "];
PutF[pa[pin].name];
FOR i IN [Rope.Length[pa[pin].name]..max+1] DO PutF[" "]; 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                    => "????              " ;
PutF[v1: IO.rope[tstr]];
SELECT pa[pin].type FROM
Output, EnabledOut =>     PutF["            "];
IN [Input..EnabledInOut] => BEGIN
PutF["  index = "];
PutF[v1: IO.int[pa[pin].in]];
END;
ENDCASE;
IF pa[pin].type IN [Output..EnabledInOut] THEN BEGIN
IF pa[pin].outinverted THEN PutF["  /"] ELSE PutF["   "];
PutF["out gp = "];
PutF[v1: IO.int[pa[pin].prodGrp]];
PutF["  Nof prods = "];
PutF[v1: IO.int[pa[pin].nofProds]]; END;
PutF["\n"];
ENDLOOP;
END;

PutF: PROCEDURE [format: Rope.ROPE _ NIL, v1, v2, v3, v4, v5: IO.Value _ [null[]]] =
BEGIN
IO.PutF[stream: viewerout, format: format, v1: v1, v2: v2, v3: v3, v4: v4, v5: v5];
IO.PutF[stream: listStream, format: format, v1: v1, v2: v2, v3: v3, v4: v4, v5: v5];
END;

WriteMBWord: PROCEDURE[item: WORD] = TRUSTED
BEGIN
base: LONG POINTER = @item;
IO.UnsafePutBlock[self: mbStream, block: [base: base, startIndex: 0, count: 2]];
END;

WriteMBFuseArray: PROCEDURE [f: FuseArray, memstr: Rope.ROPE, memindex: NAT] =
BEGIN
StrOut: PROCEDURE[index: NAT] RETURNS[CHARACTER] =
{IF index >= Rope.Length[memstr] THEN RETURN[IO.NUL] 
ELSE RETURN[Rope.Fetch[memstr, index]]};
i,pgi,p: INT;
word: CARDINAL;
PutF["define memory\n"];
WriteMBWord[4];                -- Define memory
WriteMBWord[memindex];    -- Memory index
WriteMBWord[4];                -- word width
FOR i IN [0..(Rope.Length[memstr]+2)/2-1] DO
word _ Basics.BITOR[Basics.BITSHIFT[LOOPHOLE[StrOut[2*i]],8], LOOPHOLE[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 _ Basics.BITOR[word, 1000H];
IF f[pgi*4 + 1][p][i] THEN word _ Basics.BITOR[word, 2000H];
IF f[pgi*4 + 2][p][i] THEN word _ Basics.BITOR[word, 4000H];
IF f[pgi*4 + 3][p][i] THEN word _ Basics.BITOR[word, 8000H];
WriteMBWord[1]; -- Define data word
WriteMBWord[0]; -- Source line
WriteMBWord[word];
ENDLOOP; 
ENDLOOP; 
ENDLOOP; 
END;
<<>>
Init: PROCEDURE RETURNS[success: BOOLEAN] = 
BEGIN
mbStream _ FS.StreamOpen[Rope.Concat[rootFileName, ".MB"], $create];
listStream _ FS.StreamOpen[Rope.Concat[rootFileName, ".List"], $create];
inStream _ FS.StreamOpen[Rope.Concat[rootFileName, ".pal"]];
ptype _ PTUndefined;
pa _ NEW[PinArray];
currentToken _ space;
lastToken _ space;
nextChar _ IO.SP;
nextTokenChar _ IO.SP;
pinsDefined _ FALSE;
errorCalled _ FALSE;
RETURN[TRUE];
END;
<<>>
CloseFiles: PROCEDURE[str: Rope.ROPE] =
BEGIN
PutF["\n\n%g\n", IO.rope[str]]; 
IO.Close[inStream];
IO.Close[listStream];
WriteMBWord[0]; 
WriteMBWord[0];
IO.Close[mbStream];
END;

ConvertPALToMB: Buttons.ButtonProc = BEGIN
handle: Handle _ NARROW[clientData];
IO.PutF[viewerout, " -- PAL Assembler of August 1, 1985\n"];
rootFileName _ ViewerTools.GetContents[handle.pal.input];
DO
IF NOT Init[] THEN GOTO InitFilesFailed;
PutF[Rope.Cat["\n-- File: ", rootFileName, ".list\n-- Created by Palasm %g\n"], IO.time[]];
IF NOT ReadPALType[] THEN GOTO ReadPALTypeFailed; 
InitPinArray[];
vfa _ fa _ InitFuseArray[];
IF NOT ReadPinDefs[] THEN GOTO ReadPinDefsFailed; 
IF NOT ReadEquations[] THEN GOTO ReadEquationsFailed; 

WHILE GetChar[] # IO.NUL DO LOOP ENDLOOP;

ListPinDefs[];

PutF["\n\nVirgin fuses\n"];
OutputFuseArray[vfa];
WriteMBFuseArray[vfa, "VirginPALFuses", 0];

PutF["\n\nProgrammed fuses\n"];
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;

Commander.Register[key: "///Commands/PALTool", proc: MakePALTool,
doc: "Create a PAL tool" ];

[ ] _ MakePALTool[NIL];    -- and create an instance
END.