!***********************************************************************
! specs for externalroutines in this file
%routine %spec tpla ( %string (31) symbol name, %string (127) file,
          %integer %name phi1y, phi2y, %integer %array %name inx, outx )
%routine %spec epla ( %string(31) symbol name, %string(127) file,
          %integer %name phi1y, phi2y, %integer %array %name inx, outx )
%routine %spec rom ( %string(31) symbol name,  %string(127) file, 
          %integer %name phi1y, phi2y, %integer %array %name inx, outx )
!***********************************************************************
%external %routine %spec fault %alias "ILAPDISASTER" (%string (255) mess)
%externalroutinespec prompt(%string(63) s)
!*******************************************************************************
! specs for external routines in file IMPIOCPI
%externalroutinespec openinput(%integer stream,%string(100) filename)
%externalintegerfnspec instream
%externalstring(100)%fnspec infilename(%integer stream)
%externalroutinespec closeinput(%integer stream)
%externalroutinespec openoutput(%integer stream,%string(100) filename)
%externalintegerfnspec outstream
%externalstring(100)%fnspec outfilename(%integer stream)
%externalroutinespec closeoutput(%integer stream)
!*******************************************************************************

!-------------------------------------------------------------------!
!                                                                   !
!   PLAUTILS : a set of utilities shared by the ILAP PLA interface  !
! routines and programs .                                           !
!                                                                   !
! George A. McCaskill             20th August 1982                  !
!                                                                   !
!-------------------------------------------------------------------!

%external %routine  parse filespec ( %string(255) c, ext1, ext2 ,
                 %string(*)%name fin, fout,%integer %name inn, outn )
  %integer oldin, oldout

  %on 9 %start
    fault ("parse: end of input")
  %finish

  %routine oread string ( %string(*)%name s )
    %integer ch
    s = ""
    read symbol(ch) %until ch # ' '
    %while ch # nl %cycle
      s = s.to string (ch)
      read symbol(ch)
    %repeat
  %end

  old in = in stream
  old out = out stream
  %if c="" %start
      select input(0)
      prompt("file: ")
      oread string(c)
  %finish
  %for inn = 15, -1, 0 %cycle
    %if outfilename(inn) = "" %then %exit
  %repeat
  %if inn = 0 %then fault("output streams are all used")
  %for outn = 15, -1, 0 %cycle
    %if infilename(outn) = "" %then %exit
  %repeat
  %if outn = 0 %then fault("input streams are all used")
  !
  ! do quick and dirty parse
  !
  %if ext2="" %then fin=c %and fout="" %else %start
    fin=c ; fout=c
    %if c -> fin.("/").fout %then %start ; %finish
    %if c -> fin.(" ").fout %then %start ; %finish
    %if c -> fin.(",").fout %then %start ; %finish
  %finish

  %if fin # "" %start
    %unless fin->(".") %then fin=fin.ext1
    open input( inn, fin )
    select input(inn)
  %finish %else %start
    fin = "console:"
    inn = 0
  %finish

  %if fout # "" %start
    %unless fout->(".") %then fout=fout.ext2
    open output( outn, fout)
    select output(outn)
  %finish %else %start
    fout = "console:"
    outn = 0
  %finish

  select input(oldin)
  select output(oldout)
%end

%external %routine read to terminator( %string(*)%name s , %integer %name last )
   %integer ch
   read symbol(ch) %until ch > ' '
   s = ""
   %while ch # ' ' %and ch # ',' %and ch # nl %cycle
      ch = ch + 'a' - 'A' %if 'A' <= ch <= 'Z'
      s = s.to string (ch)
      read symbol(ch)
   %repeat
   last = ch
%end

!---------------------------------------------------------------------!
!  TABUTIL: (Table utilities)                                         !
!                                                                     !
!  ORDER TAB - routine to order a table                               !
!                                                                     !
!  GET ILAP TABLE  - routine to read a table                          !
!                                                                     !
!  TABMIN : a routine to ensure that MINIMO will accept an ILAP table !
!  i.e. appends "mode tabin" to the start of the file, if not already !
!  there.                                                             !
!                                                                     !
!  MINTAB : an ILAP external routine which converts a MINIMO          !
!  output file ( .RCD ) into an ILAP table file ( .TBL ) .            !
!                                                                     !
! George A. McCaskill  22nd August 1982                               !
! J. Gordon Hughes     27th Sept.  1982  revised MINTAB               !
!---------------------------------------------------------------------!
%const %integer true=0, false=1

%constant %integer max names = 100
%constant %integer max prods = 400
%constant %integer diags = false

!**************************************************************************

%external %routine order table ( %byte %array %name table,
      %string(*)%array %name names, %integer %array %name feedback,
      %integer ins, outs, feeds, prods )
   %integer i,n

   %routine swop ( %byte %name a , b )
     %byte c
     c = a ; a = b ; b = c
   %end

   %routine swop col( %integer col1 , col2 )
     %integer i
     %string(8) t
     swop( table(col1,i) , table(col2,i) ) %for i = 1,1,prods
     t = names(col1) ; names(col1) = names(col2) ; names(col2) = t
     i = feedback(col1) ; feedback(col1) = feedback(col2)
     feedback(col2) = i
   %end

   %integer %function less ( %string(6) a, b )
     %integer i
     %for i = ins+1,1,ins+feeds %cycle
        %if names(i) = a = b %or names(i) = b %start
           %result = false
        %finish %else %if names(i) = a %start
           %result = true
        %finish
     %repeat
     %result = false
   %end

   %if ins + feeds > 1 %start
     %for n = ins+feeds,-1,2 %cycle
       %for i = 1,1,n-1 %cycle
         swop col( i,i+1 ) %if feedback(i+1) = false %and feedback(i) = true
       %repeat 
     %repeat
   %finish
   %if outs + feeds > 1 %start
     %for n = ins+feeds+feeds+outs,-1,ins+feeds+2 %cycle
       %for i = ins+feeds+1,1,n-1 %cycle
         swop col( i,i+1 ) %if feedback(i) = false %and feedback(i+1) = true
         fault("feedback order incorrect") %if feedback(i) = true %and %c
                 feedback(i+1) = true %and less( names(i), names(i+1) ) = true
       %repeat
     %repeat
   %finish
%end

!**************************************************************************

%external %routine get ilap table ( %byte %array %name table,
                                    %string(*)%array %name names,
                                    %integer %array %name feedback,
                                    %integer %name ins, outs, feeds, prods,
                                    %string(15) error id )
  %integer np { name pointer }

  %routine get inputs
    %string(255) name
    %integer term
    read to terminator(name,term) %until name = "in" { skip past IN }
    %while term # nl %cycle
      ins = ins + 1
      np = np + 1
      feed back(np) = false
      read to terminator(name,term)
      names(np) <- name
      ins = ins -1 %and np = np - 1 %if names(np) = ""
    %repeat
  %end

  %routine get table
    %integer ch, y, x, length
    y = 0;   length = -1
    %cycle
      y = y + 1
      fault(error id.": table too long") %if y > max prods
      x = 0
      %cycle
        x = x + 1
        fault(error id.": table too wide") %if x > max names
        read symbol(ch) %until ch # ' '
        %if ch = '{' %start
            read symbol (ch) %until ch='}'
            x = x - 1
            %continue
        %finish
        %if ch = '0' %start
          table(x,y) = 0
        %finish %else %if ch = 'x' %or ch = 'X' %start
          table(x,y) = 1
        %finish %else %if ch = '1' %start
          table(x,y) = 2
        %finish %else %if ch = nl %start
          %exit %if x=1 { Only a comment on the line }
          fault(error id.": line length inconsistency") %if length # -1 %and x # length
          length = x
          %exit
        %finish %else %if ch = 'O' %or ch = 'o' %start
          read symbol(ch) %until ch = ' '
          prods = y - 1
          %return
        %finish %else %start
          fault(error id.": illegal symbol < ".to string(ch)." >")
        %finish
      %repeat
    %repeat                    
  %end

  %integer %function found ( %string(6) name )
    %integer i
    %for i = 1,1,np-1 %cycle
       feed back(i) = true %and %result = true %if name = names(i)
    %repeat
    %result = false
  %end

  %routine get outputs
    %integer term
    %string(255) name
    %cycle
      np = np + 1
      outs = outs + 1
      read to terminator(name,term)
      names(np) <- name
      %if names(np) = "" %start
        outs = outs -1 ; np = np - 1
        %continue
      %finish %else %if found(names(np)) = true %start
        ins = ins - 1
        feed back(np) = true
        feeds = feeds + 1
        outs = outs - 1
      %finish %else %start
        feed back(np) = false
      %finish
    %repeat %until term = nl
  %end

  np = 0
  get inputs
  get table
  get outputs

%end

!**************************************************************************

%external %routine tabmin ( %string(255) filespec )
  
  %string(255) word
  %string(127) fin, fout
  %integer in, out, oldin, oldout

  %on 9 %start
    close input(instream)
    close output(outstream)
    select input(oldin)
    select output(oldout)
    %return
  %finish

  %routine read string( %string(*)%name s )
    %integer ch
    s = ""
    read symbol(ch) %until ch > ' '
    %while ch # nl %cycle
      ch = ch - 'A'+'a' %if 'A' <= ch <= 'Z'
      s = s.to string (ch)
      read symbol(ch)
    %repeat
  %end

  old in = in stream;   old out = out stream
  parse filespec ( filespec, ".tbl", ".mtb", fin, fout, in, out )

  %if diags = true %start
    %if fin # "" %start
      print string("reading from < ".fin." >");newline
    %finish
    %if fout # "" %start
      print string("writing to   < ".fout." >");newline
    %finish
  %finish

  select input(in)
  select output(out)

  print string("MODE tabin");newline

  %cycle
    read string(word)
    print string(word) %and newline %unless word -> ("mode").word %and word -> ("tabin").word
  %repeat

%end

!*****************************************************************************

%external %routine mintab ( %string(255) filespec )
! I/O
!
  %integer in, out, old in, old out
  %string(127) fin,fout

! table declarations
!
  %byte %array table (1:max names, 1:max prods)
  %string(6)%array names (1:max names)
  %integer %array feed back (1:max names)

  %integer ins, outs, feeds, prods
  %string(255) dump
  %string(255) name                         { truncated to 6 for names }

  %on 9 %start
    fault("MINTAB: unexpected end of input. Empty file ?")
  %finish

  %routine mget table
    %integer x , y
    %integer i
    %integer output
    %integer length
    %integer term
    %integer tok

    %routine min read ( %string(*)%name s , %integer %name term )
       %integer new
       new = false
       read to terminator(s,term)
       new = true %if term = nl
       %while next symbol <= ' ' %cycle
          read symbol(term)
          new = true %if term = nl
       %repeat
       term = nl %if new = true
    %end

    %integer %function found ( %string(6) name )
      %integer i
      %for i = 1,1,output %cycle
        %result = true %if names(i) = name
      %repeat
      %result = false
    %end

    y = 0;   length = -1;   tok = false
    names(i) = "" %for i = 1,1,100
    feedback(i) = false %for i = 1,1,100

    min read(name,term) %until name -> ("reduced").dump
    read symbol(term) %until term = nl

    %cycle
      min read(name,term)
      %exit %unless name -> ("reduced").dump %or name ->("minimised").dump
      read symbol(term) %until term = nl
    %repeat

    %cycle
      %if name = "cells" %start
        prods = y
        %exit
      %finish
      y = y + 1
      fault("MINTAB: table too long") %if y > max prods
      x = 0
      %cycle
        x = x + 1
        fault("MINTAB: table too wide") %if x > max names
        %if name = "." %or name = "?" %start
          table(x,y) = 1
        %finish %else %if name -> ("\").name %start
          table(x,y) = 0
          tok = true
        %finish %else %if name = ":" %start
          x = x - 1
          output = x
        %finish %else %start
          table(x,y) = 2
          tok = true
        %finish
        %if tok = true %start
          fault("MINTAB: name inconsistency < ".name." >") %if names(x) # "" %and names(x) # name
          names(x) <- name
          tok = false
        %finish
        %if term = nl %start
          fault("MINTAB: length inconsistency < ".name." >") %if length # -1 %and length # x
          length = x
          min read(name,term)
          %exit
        %finish
        min read(name,term)
      %repeat
    %repeat

    %for i = output + 1,1,length %cycle
      %if found( names(i) ) = true %start
        feedback(i) = true
        feeds = feeds + 1
      %finish
    %repeat

    ins = output - feeds
    outs = length - 2*feeds - ins

  %end

  %routine print table
    %integer i,j,k,l
    %return %if ins + feeds < 1 %or outs + feeds < 1

    l = 1
    print string("IN  ")
    %if ins + feeds > 1 %start
        I = 1
        I = I + 1 %while names(i)=""
        print string (names(i))
        I = I + 1
        L = length(names(i)) + 1
        %for i = i,1,ins+feeds %cycle
             %if names (i)#"" %start
                 l = l + 1 + length(names(i))
                 print symbol (',')
                 print string (names(i))
             %finish
       %repeat
    %finish
    newline

    %for i = 1,1,prods %cycle
         spaces (3)
         %for j = 1,1,ins+feeds %cycle
              %if names(j)#"" %start
                  space %for k = 1,1,length(names(j))
                  %if table(j,i) = 0 %start
                      print symbol('0')
                  %finish %else %if table(j,i) = 1 %start
                      print symbol('x')
                  %finish %else %start
                      print symbol('1')
                  %finish
              %finish
         %repeat
         space
         %for j = ins+feeds+1,1,ins+feeds*2+outs %cycle
              %if names(j)#"" %start
                  space %for k = 1,1,length(names(j))
                  %if table(j,i) = 2 %start
                      print symbol('1')
                  %finish %else %start
                      print symbol('0')
                  %finish
              %finish
         %repeat
         newline
    %repeat

    print string("OUT ")
    space %for k = 0,1,l
    %if outs + feeds > 1 %start
        I = ins + feeds + 1
        I = I + 1 %while names(i)=""
        print string (names(i))
        I = I + 1
        %for i = i,1,ins+feeds+feeds+outs %cycle
            print symbol (',') %and print string (names(i)) %if names(i)#""
        %repeat
    %finish
    newline

  %end

  old in = in stream;   old out = out stream

  parse filespec ( filespec, ".rcd", ".tbl", fin, fout, in, out )

  %if diags = true %start
    %if fin # "" %start
      print string("reading from < ".fin." >");newline
    %finish
    %if fout # "" %start
      print string("writing to   < ".fout." >");newline
    %finish
  %finish

  select input( in )
  select output( out )

  mget table
  order table( table, names, feedback, ins, outs, feeds, prods )
  print table

  close input(instream)
  close output(outstream)
  select input (  oldin )
  select output( oldout )

%end


!---------------------------------------------------------------------!
!    TPLA :  a routine to generate an ILAP PLA from a table.          !
!                                                                     !
!  George A. McCaskill                        16th August 1982        !
!---------------------------------------------------------------------!


%external %routine %spec pla ( %string(31) symbol, %integer ins, outs, %c
     feeds, prods, %integer %array %name and, or, %integer %name phi1y, phi2y,
     %integer %array %name inx, outx )
%external %routine %spec sTABLE ( %string(255) spec , %integer diags )


!****************************************************************************

%external %routine tpla    ( %string (31) symbol name, %string (127) file,
         %integer %name phi1y, phi2y, %integer %array %name inx, outx )
  
  %byte %array table ( 1:maxnames, 1 : max prods )
  %string(6)%array names (1:maxnames)
  %integer %array feed back (1:maxnames)

  %integer oldin, oldout
  %integer ins, outs, feeds, prods
  %string(127) fin,fout
  %integer inn,outn

  %on 9 %start
      fault("TPLA: unexpected end of input")
  %finish
  
  ins = 0;   outs = 0;   feeds = 0

  oldin = in stream
  oldout = out stream
 
  select output(0)
 
  print string("TPLA: Version 3.01") %and newline %if diags = true

  parse filespec( file, ".tbl" , "", fin, fout, inn, outn )

  select input(inn)

  get ilap table( table, names, feedback, ins, outs, feeds, prods, "TPLA" )
  order table( table, names, feedback, ins, outs, feeds, prods )

  %begin
    %integer %array and  (1:prods*(ins+feeds))
    %integer %array or   (1:(feeds+outs)*prods)
    %integer i,j,k,p
    k = 0
    print string("and array :=") %and newline %if diags = true
    %for j = 1,1,prods %cycle
      %for i = 1,1,ins+feeds %cycle
        k = k + 1
        write(table(i,j)-1,3) %if diags = true
        and(k) = table(i,j)-1
      %repeat
      newline %if diags = true
    %repeat
    k = 0

    print string("or array :=") %and newline %if diags = true
    %for i = ins+feeds+1,1,ins+feeds+feeds+outs %cycle
      %for j = 1,1,prods %cycle
        k = k + 1
        table(i,j) = table(i,j)-1 %if table(i,j)#0
        write(table(i,j),3) %if diags = true
        or(k)=table(i,j)
      %repeat
      newline %if diags = true
    %repeat

    PLA ( symbol name, ins, outs, feeds, prods, and, or, phi1y, phi2y, inx, outx )
  %end

  close input(outstream)
  close output(instream)
  select output( oldout )
  select input( oldin )

%end
!-----------------------------------------------------------------------------!
!                                                                             !
!  EPLA  : an ILAP routine which will generate a PLA from an equation file    !
! via a table file, generated by sTABLE. This table is then passed to TPLA    !
! which generates the required ILAP pla. The table file is then deleted.      !
!                                                                             !
! George A. McCaskill     20th August 1982                                    !
!-----------------------------------------------------------------------------!

!******************************************************************************

%external %routine epla ( %string(31) symbol name, %string(127) file,
                          %integer %name phi1y, phi2y,
                          %integer %array %name inx, outx )

   sTABLE( file."/temp" , false )
   tpla ( symbol name , "temp", phi1y, phi2y, inx, outx )

%end

!---------------------------------------------------------------------!
!  ROM:  a routine to generate an ILAP PLA from a ROM description .   !
!                                                                     !
!  update:        George A. McCaskill         16th August 1982        !
!  original ROM : DJR                                                 !
!---------------------------------------------------------------------!
%external %integer %fn %spec REM (%integer a, b)

!*******************************************************************************

%external %routine rom ( %string(31) symbol name,  %string(127) file, 
     %integer %name phi1y, phi2y, %integer %array %name inx, outx )

  %byte %array table ( 1:100, 1:500 )
  %integer oldin
  %integer oldout
  %string(127) fin,fout
  %integer inn, outn
  %integer length, depth

!  next bit is the original ROM routine
!

%routine orom(%integer ins,outs, %integerarray %name data )

  %integer ins2,dr,dc,t,andp,orp,prods,b

  ins2=2\\ins
  %integerarray z(0:ins2-1),and(1:ins*ins2),or(1:outs*ins2)

  prods=0
  %for dr=0,1,ins2-1 %cycle
    t=0
    t=t!data(dr,dc) %for dc=1,1,outs
    z(dr)=t
    %if t#0 %then prods=prods+1
  %repeat

  ! fill in and-plane
  andp=1
  %for dr=0,1,ins2-1 %cycle
    %if z(dr)#0 %then %start
      %for b=0,1,ins-1 %cycle
        %if (dr>>b)&1=0 %then and(andp)=-1 %else and(andp)=1
        andp=andp+1
      %repeat
    %finish
  %repeat

  ! fill in or-plane
  orp=1
  %for dc=1,1,outs %cycle
    %for dr=0,1,ins2-1 %cycle
      %if z(dr)#0 %then or(orp)=data(dr,dc) %and orp=orp+1
    %repeat
  %repeat

  ! call the PLA generator to get the ROM
  !
  PLA( symbol name, ins, outs, 0, prods, and, or, phi1y, phi2y, inx, outx )

%end
!
! end of original ROM


  %integer %function logb2 ( %integer i )
    fault("taking log of zero") %if i <= 0
    %result = 0 %if i = 1
    %result = 1 + logb2( i//2 + rem(i,2))
  %end

  %routine read table
    %integer x,y
    %integer ch
    %integer power of 2

    %on 9 %start

      depth = y - 1
      power of 2 = 2\\(logb2(depth)) 

      %for y = depth+1, 1, power of 2 %cycle
        %for x = 1,1,length %cycle
          table(x,y) = 0
        %repeat
      %repeat           

      depth = power of 2
      %return
    %finish

    y = 0
    %cycle
      y = y + 1
      x = 0
      %cycle
        read symbol(ch)
        x = x + 1
        %if ch = '0' %start
          table(x,y) = 0
        %finish %else %if ch = '1' %start
          table(x,y) = 1
        %finish %else %if ch = ' ' %or ch = ',' %start
          x = x - 1
        %finish %else %if ch = nl %start
          fault("ROM: inconsistant line length") %if length#-1 %and length#x-1
          length = x - 1
          %exit
        %finish
      %repeat
    %repeat
  %end

  oldin = in stream
  oldout = out stream

  print string("ROM: Version 2.01") %and newline %if diags = true

  parse filespec ( file, ".rom", "", fin, fout, inn, outn )

  select input( inn )

  length = -1
  read table

  %begin
    %integer %array data ( 0:depth-1,1:length )
    %integer i,j
      %for i = 0,1,depth-1 %cycle
       %for j = 1,1,length %cycle
         data(i,j) = table(j,i+1)
         write(data(i,j),0) %and space %if diags = true
      %repeat
      newline %if diags = true
    %repeat
    orom ( logb2( depth ), length, data )
  %end

  close input(instream)
  close output(outstream)
  select input( oldin )
  select output( oldout )

%end

%end %of %file