[comp.sources.atari.st] v01i095: passm -- Logic circuit assembler part02/02

koreth@ssyx.ucsc.edu (Steven Grimm) (01/19/89)

Submitted-by: sun.com!skywest!BRENES (Erasmo Brenes)
Posting-number: Volume 1, Issue 95
Archive-name: passm/part02

#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file PASSM.PAS continued
#
CurArch=2
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> PASSM.PAS
X                               gettoken; {find out next step}
X                               if sym <> ends then getmatrix
X                              end
X                         else error (9)
X                       end;
X                      otherwise:  error (5)
X                     end
X                    end
X             end
X        else error (3)
X      end;
X     otherwise: error (6) {fatal error, not a valid equation}
X   end {case of sym}
X  end; {getmatrix}
X
X procedure convrt (var numbr1 : Long_Integer; var ihex : string2);
X  var
X   i : integer;
X   res,zero,a : Long_Integer;
X   vel : Long_Integer;
X  begin
X   zero := ord ('0');
X   a := ord ('A');
X   i := 0;
X   ihex [1]:= '0';     ihex [2]:= '0';
X   ihex [3]:= '0';     ihex [4]:= '0';
X   vel := numbr1 & $0000ffff;
X   repeat
X    res := vel mod 16;
X    vel := vel div 16;
X    if res < 10
X      then  ihex [4-i]:= chr(res + zero)
X      else  ihex [4-i]:= chr(res + a - 10);
X    i:= i + 1
X   until (vel = 0)
X  end; {convrt}
X
X procedure dojedec;
X{This procedure generates the jedec file based on information from getmatrix}
X  var
X   stx,etx : char;
X   i,j,k : integer;
X   totalcol,totalfuse,nouts,firstp : integer;
X   outn,bitn, n : integer;
X   checksum : Long_Integer;
X   power2 : array [1..8] of integer;
X   scksum : string2;
X   finish : boolean;
X  begin
X   i:= 2;       stx:= chr(i);   i:= 3;  etx := chr(i);
X   power2[1]:= 1;
X   for i:=2 to 8 do power2[i]:= 2*power2[i-1];
X   pal16 := false;
X   case palkind of
X    p10l8: begin
X            pal16 := true;      totalcol := 20;
X            totalfuse := 320;   nouts := 8;     firstp := 19;
X           end;
X    p12l6: begin
X            pal16 := true;      totalcol := 24;
X            totalfuse := 384;   nouts := 6;     firstp := 18;
X           end;
X    p14l4: begin
X            pal16 := true;      totalcol := 28;
X            totalfuse := 448;   nouts := 4;     firstp := 17;
X           end;
X    p16l2: begin
X            pal16 := true;      totalcol := 32;
X            totalfuse := 512;   nouts := 2;     firstp := 16;
X           end;
X    p16l8,p16rx:
X           begin
X            pal16 := true;      totalcol := 32;
X            totalfuse := 2048;  nouts := 8;     firstp := 19;
X           end;
X    p12l10:begin
X            totalcol := 24;     totalfuse := 480;
X            nouts := 10;        firstp := 23;
X           end;
X    p14l8: begin
X            totalcol := 28;     totalfuse := 560;
X            nouts := 8;         firstp := 22;
X           end;
X    p16l6: begin
X            totalcol := 32;     totalfuse := 640;
X            nouts := 6;         firstp := 21;
X           end;
X    p18l4: begin
X            totalcol := 36;     totalfuse := 720;
X            nouts := 4;         firstp := 20;
X           end;
X    p20l2: begin
X            totalcol := 40;     totalfuse := 640;
X            nouts := 2;         firstp := 19;
X           end;
X    p20l10:begin
X            totalcol := 40;     totalfuse := 1600;
X            nouts := 10;        firstp := 23;
X           end;
X    p20l8,p20rx:
X           begin
X            totalcol := 40;     totalfuse := 2560;
X            nouts := 8;         firstp := 22;
X           end;
X    p22vx: begin
X            totalcol := 44;     totalfuse := 5828;
X            nouts := 10;        firstp := 23;
X           end
X   end; {case of ptype}
X   write (source,stx);     {write start of text}
X   write (source,'Portable Pal Assembler Jedec Output for device :');
X   writeln (source,pdevice,'*');
X   if pal16 then  write (source,'QP20* ')
X            else  write (source,'QP24* ');
X   writeln (source,'QF',totalfuse:4,'*');
X   write (source,'L0000');
X   {at this point in time, it is assumed that every output signal has a valid
X    output pin }
X   checksum := 0;    bitn:= 0;    {initialize checksum variables}
X   if palkind = p22vx
X    then {let us take care of special nodes}
X     begin
X      writeln(source);
X      if ar[1] = 'L'
X       then begin
X              for k:=1 to totalcol do
X               write (source,'0');    {unblown fuse}
X              bitn := bitn + totalcol   {increment fuse count}
X            end
X       else begin
X             for k:=1 to totalcol do
X              if ar[k] = '1' then begin
X                                   write (source,'0');
X                                   bitn := bitn + 1
X                                  end
X                             else begin
X                                   write (source,'1');
X                                   n := (bitn mod 8) + 1;
X                                   checksum := checksum + power2[n];
X                                   bitn := bitn + 1
X                                  end
X            end
X     end;
X   for i:= 1 to nouts do
X    begin
X    {first find out if there is an output with such pin}
X     outn := 0;    {default to no output defined for current pin}
X     pointer := firstp;
X     getterms;   {find out how many or-terms for this output}
X     for j:=1 to nexout do
X      with outtable[j] do
X       if outnumb = firstp   then outn := j;
X     if outn = 0
X      then begin  {no output defined for this output pin}
X            for j:=1 to totalterms do
X             begin
X              writeln (source);
X              for k:=1 to totalcol do
X               write (source,'0');    {unblown fuse}
X              bitn := bitn + totalcol   {increment fuse count}
X             end
X           end
X      else begin  {there is an output definition for this output pin}
X            finish := false;
X            for j:=1 to totalterms do
X             begin
X              writeln (source);     {terminate previous line}
X              with outtable[outn] do
X               if (matrix[j,1] <> 'X') and not finish
X                then
X                 for k:=1 to totalcol do
X                  if matrix[j,k] = '1' then begin
X                                             write (source,'0');
X                                             bitn := bitn + 1
X                                            end
X                                       else begin
X                                             write (source,'1');
X                                             n := (bitn mod 8) + 1;
X                                             checksum := checksum + power2[n];
X                                             bitn := bitn + 1
X                                            end
X                else begin
X                      for k:=1 to totalcol do write (source,'0');
X                      bitn := bitn + totalcol;
X                      finish := true     {note that this method is redundant}
X                     end
X             end
X           end;
X     firstp := firstp - 1         {step to next valid output}
X    end;
X   if palkind = p22vx
X    then {let us take care of special nodes}
X     begin
X      writeln(source);
X      if sp[1] = 'L'
X       then begin
X              for k:=1 to totalcol do
X               write (source,'0');    {unblown fuse}
X              bitn := bitn + totalcol   {increment fuse count}
X            end
X       else begin
X             for k:=1 to totalcol do
X              if sp[k] = '1' then begin
X                                   write (source,'0');
X                                   bitn := bitn + 1
X                                  end
X                             else begin
X                                   write (source,'1');
X                                   n := (bitn mod 8) + 1;
X                                   checksum := checksum + power2[n];
X                                   bitn := bitn + 1
X                                  end
X            end;
X      writeln (source,'*');  {terminate main fuse body}
X      {now let's take care of output macro cells}
X      write (source,'L5808 '); {it must be 5808 }
X      firstp := 23;
X      for i:=1 to nouts do
X       begin
X        outn := 0;
X        for j:=1 to nexout do
X         with outtable[j] do
X          if outnumb = firstp then outn := j;
X        if outn <> 0
X         then begin
X               if outtable[outn].form = high
X                then begin
X                      write (source,'1');
X                      n := (bitn mod 8) + 1;
X                      checksum := checksum + power2[n];
X                      bitn := bitn + 1
X                     end
X                else begin write(source,'0'); bitn := bitn + 1 end;
X               if outtable[outn].outkind = reg
X                then begin write(source,'0'); bitn := bitn + 1 end
X                else begin
X                      write (source,'1');
X                      n := (bitn mod 8) + 1;
X                      checksum := checksum + power2[n];
X                      bitn := bitn + 1
X                     end
X              end
X         else begin
X               write (source,'00');     bitn := bitn + 2
X              end;
X        firstp := firstp - 1   {get next valid output}
X       end;
X      writeln (source,'*')
X     end
X    else writeln (source,'*');  {terminate fuse list}
X   convrt (checksum,scksum);
X   writeln (source,'C',scksum,'*');
X   writeln (source,etx,'0000');     {write end of transmission}
X  end; {dojedec}
X
X begin { plassm }
X  nexout := 0;
X  reserved[1]:= 'device         ';     reserved[2]:= 'pin            ';
X  reserved[3]:= 'equations      ';     reserved[4]:= 'module         ';
X  reserved[5]:= 'flag           ';     reserved[6]:= 'title          ';
X  reserved[7]:= 'node           ';     reserved[8]:= 'istype         ';
X  reserved[9]:= 'macro          ';     reserved[10]:='ENABLE         ';
X  reserved[11]:='RESET          ';     reserved[12]:='PRESET         ';
X  reserved[13]:='end            ';
X  wsym [1]:= device;    wsym[2]:= pin;  wsym[3]:= equations;
X  wsym [4]:= module;    wsym[5]:= flag; wsym[6]:= title;
X  wsym [7]:= node;      wsym[8]:= stype; wsym[9]:= macro;
X  wsym [10]:= enable;   wsym[11]:= clear; wsym[12]:= preset;
X  wsym [13]:= ends;
X  palknds[1]:= '1';     pals[1]:= 'p10l8          ';
X  paltyp [1]:= p10l8;
X  palknds[2]:= '1';     pals[2]:= 'p12l6          ';
X  paltyp [2]:= p12l6;
X  palknds[3]:= '1';     pals[3]:= 'p14l4          ';
X  paltyp [3]:= p14l4;
X  palknds[4]:= '1';     pals[4]:= 'p16l2          ';
X  paltyp [4]:= p16l2;
X  palknds[5]:= '2';     pals[5]:= 'p10h8          ';
X  paltyp [5]:= p10l8;
X  palknds[6]:= '2';     pals[6]:= 'p12h6          ';
X  paltyp [6]:= p12l6;
X  palknds[7]:= '2';     pals[7]:= 'p14h4          ';
X  paltyp [7]:= p14l4;
X  palknds[8]:= '2';     pals[8]:= 'p16h2          ';
X  paltyp [8]:= p16l2;
X  palknds[9]:= '3';     pals[9]:= 'p16l8          ';
X  paltyp [9]:= p16l8;
X  palknds[10]:= '4';    pals[10]:= 'p16r8          ';
X  paltyp [10]:= p16rx;
X  palknds[11]:= '5';    pals[11]:= 'p16r6          ';
X  paltyp [11]:= p16rx;
X  palknds[12]:= '6';    pals[12]:= 'p16r4          ';
X  paltyp [12]:= p16rx;
X  palknds[13]:= '7';    pals[13]:= 'p12l10         ';
X  paltyp [13]:= p12l10;
X  palknds[14]:= '7';    pals[14]:= 'p14l8          ';
X  paltyp [14]:= p14l8;
X  palknds[15]:= '7';    pals[15]:= 'p16l6          ';
X  paltyp [15]:= p16l6;
X  palknds[16]:= '7';    pals[16]:= 'p18l4          ';
X  paltyp [16]:= p18l4;
X  palknds[17]:= '7';    pals[17]:= 'p20l2          ';
X  paltyp [17]:= p20l2;
X  palknds[18]:= '8';    pals[18]:= 'p20l10         ';
X  paltyp [18]:= p20l10;
X  palknds[19]:= '9';    pals[19]:= 'p20l8          ';
X  paltyp [19]:= p20l8;
X  palknds[20]:= 'A';    pals[20]:= 'p20r8          ';
X  paltyp [20]:= p20rx;
X  palknds[21]:= 'B';    pals[21]:= 'p20r6          ';
X  paltyp [21]:= p20rx;
X  palknds[22]:= 'C';    pals[22]:= 'p20r4          ';
X  paltyp [22]:= p20rx;
X  palknds[23]:= 'D';    pals[23]:= 'p22v10         ';
X  paltyp [23]:= p22vx;
X  { pin number to fuse column transform }
X  with fusetoinp [p10l8] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 7;    transfer[5]:= 9;        transfer[6]:= 11;
X    transfer[7]:= 13;   transfer[8]:= 15;       transfer[9]:= 17;
X    transfer[11]:= 19
X   end;
X  with fusetoinp [p12l6] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 11;       transfer[6]:= 13;
X    transfer[7]:= 15;   transfer[8]:= 17;       transfer[9]:= 21;
X    transfer[11]:= 23;  transfer[12]:= 19;      transfer[19]:= 7
X   end;
X  with fusetoinp [p14l4] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 15;
X    transfer[7]:= 17;   transfer[8]:= 21;       transfer[9]:= 25;
X    transfer[11]:= 27;  transfer[12]:= 23;      transfer[13]:= 19;
X    transfer[18]:= 11;  transfer[19]:= 7
X   end;
X  with fusetoinp [p16l2] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 21;   transfer[8]:= 25;       transfer[9]:= 29;
X    transfer[11]:= 31;  transfer[12]:= 27;      transfer[13]:= 23;
X    transfer[14]:= 19;  transfer[17]:= 15;      transfer[18]:= 11;
X    transfer[19]:= 7
X   end;
X  with fusetoinp [p16l8] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 21;   transfer[8]:= 25;       transfer[9]:= 29;
X    transfer[11]:= 31;  transfer[13]:= 27;      transfer[14]:= 23;
X    transfer[15]:= 19;  transfer[16]:= 15;      transfer[17]:= 11;
X    transfer[18]:= 7
X   end;
X  with fusetoinp [p16rx] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X                         transfer[2]:= 1;       transfer[3]:= 5;
X    transfer[4]:= 9;     transfer[5]:= 13;      transfer[6]:= 17;
X    transfer[7]:= 21;    transfer[8]:= 25;      transfer[9]:= 29;
X                         transfer[12]:= 31;     transfer[13]:= 27;
X    transfer[14]:= 23;   transfer[15]:= 19;     transfer[16]:= 15;
X    transfer[17]:= 11;   transfer[18]:= 7;      transfer[19]:= 3
X   end;
X  with fusetoinp [p12l10] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 7;    transfer[5]:= 9;        transfer[6]:= 11;
X    transfer[7]:= 13;   transfer[8]:= 15;       transfer[9]:= 17;
X    transfer[10]:= 19;  transfer[11]:= 21;      transfer[13]:= 23
X   end;
X  with fusetoinp [p14l8] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 11;       transfer[6]:= 13;
X    transfer[7]:= 15;   transfer[8]:= 17;       transfer[9]:= 19;
X    transfer[10]:= 21;  transfer[11]:= 25;
X    transfer[13]:= 27;  transfer[14]:= 23;      transfer[23]:= 7
X   end;
X  with fusetoinp [p16l6] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 15;
X    transfer[7]:= 17;   transfer[8]:= 19;       transfer[9]:= 21;
X    transfer[10]:= 25;  transfer[11]:= 29;
X    transfer[13]:= 31;  transfer[14]:= 27;      transfer[15]:= 23;
X    transfer[22]:= 11;  transfer[23]:= 7
X   end;
X  with fusetoinp [p18l4] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 19;   transfer[8]:= 21;       transfer[9]:= 25;
X    transfer[10]:= 29;  transfer[11]:= 33;
X    transfer[13]:= 35;  transfer[14]:= 31;     transfer[15]:= 27;
X    transfer[16]:= 23;  transfer[21]:= 15;     transfer[22]:= 11;
X    transfer[23]:= 7
X   end;
X  with fusetoinp [p20l2] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 21;   transfer[8]:= 25;       transfer[9]:= 29;
X    transfer[10]:= 33;  transfer[11]:= 37;
X    transfer[13]:= 39;  transfer[14]:= 35;      transfer[15]:= 31;
X    transfer[16]:= 27;  transfer[17]:= 23;
X    transfer[20]:= 19;  transfer[21]:= 15;      transfer[22]:= 11;
X    transfer[23]:= 7
X   end;
X  with fusetoinp [p20l10] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 21;   transfer[8]:= 25;       transfer[9]:= 29;
X    transfer[10]:= 33;  transfer[11]:= 37;
X    transfer[13]:= 39;  transfer[15]:= 35;      transfer[16]:= 31;
X    transfer[17]:= 27;  transfer[18]:= 23;      transfer[19]:= 19;
X    transfer[20]:= 15;  transfer[21]:= 11;      transfer[22]:= 7
X   end;
X  with fusetoinp [p20l8] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 3;    transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 21;   transfer[8]:= 25;       transfer[9]:= 29;
X    transfer[10]:= 33;  transfer[11]:= 37;
X    transfer[13]:= 39;  transfer[14]:= 35;
X    transfer[16]:= 31;  transfer[17]:= 27;      transfer[18]:= 23;
X    transfer[19]:= 19;  transfer[20]:= 15;      transfer[21]:= 11;
X    transfer[23]:= 7
X   end;
X  with fusetoinp [p20rx] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X                        transfer[2]:= 1;        transfer[3]:= 5;
X    transfer[4]:= 9;    transfer[5]:= 13;       transfer[6]:= 17;
X    transfer[7]:= 21;   transfer[8]:= 25;       transfer[9]:= 29;
X    transfer[10]:= 33;  transfer[11]:= 37;
X                        transfer[14]:= 39;      transfer[15]:= 35;
X    transfer[16]:= 31;  transfer[17]:= 27;      transfer[18]:= 23;
X    transfer[19]:= 19;  transfer[20]:= 15;      transfer[21]:= 11;
X    transfer[22]:= 7;   transfer[23]:= 3
X   end;
X  with fusetoinp [p22vx] do
X   begin
X    for i:=1 to maxpins do transfer[i]:= -1;
X    transfer[1]:= 1;    transfer[2]:= 5;        transfer[3]:= 9;
X    transfer[4]:= 13;   transfer[5]:= 17;       transfer[6]:= 21;
X    transfer[7]:= 25;   transfer[8]:= 29;       transfer[9]:= 33;
X    transfer[10]:= 37;  transfer[11]:= 41;
X    transfer[13]:= 43;  transfer[14]:= 39;      transfer[15]:= 35;
X    transfer[16]:= 31;  transfer[17]:= 27;      transfer[18]:= 23;
X    transfer[19]:= 19;  transfer[20]:= 15;      transfer[21]:= 11;
X    transfer[22]:= 7;   transfer[23]:= 3
X   end;
X  tab := chr(9);        nexin := 0;     Abort := false;    ch:= blank;
X  writeln;
X  writeln ('  Portable Pal Assembler');
X  writeln ('  Rev.1  Sep 1988');
X  writeln ('  By: Erasmo Brenes ');
X  writeln ('  (c) Copyright 1987,1988');
X  writeln;
X  for i:=1 to 80 do filspc[i]:= blank;
X  for i:=1 to maxcols do begin ar[i]:= '0'; sp[i]:= '0'  end;
X  { Default to inactive for ar and sp}
X  ar[1]:= 'L';  sp[1]:= 'L';
X  write ('Enter source filename_');
X  readln (filspc);
X  reset(source,filspc);
X  getnames;
X{*** diag print ***}
X for i:= 1 to nexin do
X  with symtable[i] do
X   writeln ('pin name= ',name,' pin#=',pinn:3);
X i:= 1;
X if not Abort
X  then begin
X        gettoken;    {get first token before calling getmatrix}
X        getmatrix;
X        close (source);   {release previous handle}
X        while (filspc[i] <> '.') do i:= i + 1;
X        i:= i + 1;    j:= i;
X        filspc[i]:= 'j';      i:= i + 1;
X        filspc[i]:= 'e';      i:= i + 1;
X        filspc[i]:= 'd';
X        rewrite (source,filspc);
X        if not Abort then dojedec;
X        writeln ('Press any key to return');
X        while (not Keypress) do begin end    {ie do nothing}
X       end
X end.
SHAR_EOF
chmod 0600 PASSM.PAS || echo "restore of PASSM.PAS fails"
rm -f s2_seq_.tmp
echo "You have unpacked the last part"
exit 0