!***************************************************************************
%routinespec stable(%string(255) filespec,%integer diags)
%routinespec table(%string(255) filespec)
%routinespec table with diags(%string(255) filespec)
!***************************************************************************
!--------------------------------------------------------------------------!
!  sTABLE: Routine to Convert Boolean Equations to TRUTH Table             !
!                                                                          !
!   This routine is called by two ILAP utilities : TABLE as ILAP routine,  !
! TABLE as a program. The program version gives more feedback to the user, !
! while the external routine only gives feedback on a fatal error.         !
!                                                                          !
! George A. McCaskill 20th August 1982                                     !
!--------------------------------------------------------------------------!
!%include "$ilap:.inc"
%constinteger true=0,false=1
!%include "plautils.inc"
%externalroutinespec fault %alias "ILAPDISASTER" (%string(255) 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)
!*******************************************************************************
%externalroutinespec prompt(%string(63) s)
%externalstring(63)%fnspec itos(%integer n,p)
%conststring(1) snl="
"
%external %routine %spec  parse filespec ( %string(255) c, ext1, ext2 ,
                                     %string(*)%name fin, fout,
                                     %integer %name inn, outn )

%external %routine sTABLE ( %string(255) filespec, %integer diags )
                                      
!  %record %format %spec prodlf
!  %record %format %spec productf
!  %record %format %spec termlf
!  %record %format %spec termf
!  %record %format %spec cell

  !-----------------------------------------!
  !    Grammar :-                           !
  !                                         !
  !    A  -> id = S nl | I | O              !
  !    S  -> P PL                           !
  !    PL -> + P PL | e                     !
  !    P  -> T TL                           !
  !    TL -> * T TL | e                     ! 
  !    T  -> \ id |  \ ( S ) | id | ( S )   !
  !    I  -> in id IL                       !
  !    O  -> out id IL                      !
  !    IL -> , id IL | e                    !
  !                                         !
  !-----------------------------------------!

  %record %format sumf     ( %record(productf)%name p ,
                             %record(prodlf)%name pl )

  %record %format prodlf   ( %record(productf)%name p ,
                             %record(prodlf)%name next )

  %record %format productf ( %record(termf)%name t , %record(termlf)%name tl )

  %record %format termlf   ( %record(termf)%name t , %record(termlf)%name next )

  %record %format termf   ( %byte type, inv,
                            ( %string(6) id %or %record(sumf)%name s    ))

  %record %format idlist   ( %string(6) id , %record(idlist)%name next )

  %record %format assf     ( %c
        ( %string(6) id, %record(sumf)%name s, %byte flattened, sorted %c
          %or  %record(idlist)%name il ),
        %byte mode, type                     )

  !--------------------------------------------------------!
  ! Heap
  !
  %record %format cell (( %record(sumf) s     %or %c
                          %record(prodlf) pl  %or %c
                          %record(productf) p %or %c
                          %record(termlf) tl  %or %c
                          %record(termf) t    %or %c
                          %record(idlist) i   %or %c
                          %record(assf) a        ),
                        %record(cell)%name next,
                        %byte type                  )
                              

  !--------------------------------------------------------!
  %integerfn size of (%record(cell) %name r)
    %result=10    { maximum in words (!) of all above formats! }
  %end

  %constant %integer max equations = 500
  %integer { %record(assf)%name } %array equations (1:max equations)
  %record(assf)%name equation
  %record(assf)%name ca
  %integer ep
  %record(idlist)%name ins,outs,il
  %record(cell) example                 { template for size of (free vec) }

{  %constant %record(*) %name nil == record(0)  }

  %constant %integer idt  = 1       { type of record element }
  %constant %integer sumt = 2
  %constant %integer equationt = 3
  %constant %integer int = 4
  %constant %integer outt = 5

  %constant %integer sum     = 1    { type of record }
  %constant %integer prodl   = 2  
  %constant %integer product = 3
  %constant %integer terml   = 4
  %constant %integer term    = 5
  %constant %integer ass     = 6
  %constant %integer idl     = 7

  %constant %integer in = 1            { type of identifier }
  %constant %integer out = 2
  %constant %integer feed = in!out

  %integer echo ; echo = true       { whether we need to echo incorrect input }
  %integer input             { current input character }
  %integer len               { length of most recent identifier }
  %integer error ; error = false     { error flag }
  %integer products          { number of product terms }
  %string(6) name                    { most recent identifier }
  %string(128) fin ; fin = ""
  %string(128) fout ; fout = ""  { file names }
  %string(255) line                  { text buffer }
  %integer tp                        { text pointer }
  %integer i                         { counter }
  %integer inn                       { stream number }
  %integer outn                      {     ""        }
  %integer oldin                     { old stream number }
  %integer oldout                    {    ""             }
  %integer minterm error ; minterm error = false    { \a and a appear in term }

  !---------------------------------------------------------!
  ! Heap Utilities

  %externalintegerfnspec  GET  VM  (%integername size, addr)
  %externalintegerfnspec  FREE VM  (%integername size, addr)

  %integerfn { %record(*) %map }  GET VEC (%integer size)
     %integer  adr, status, rsize, k
     rsize = size + 2    {words!}                   {Allow for size field}
     status = get vm (rsize, adr)                   {attempt to grab}
     %if status & 1 = 0 %start                      {Failed?}
        k = free vm (rsize, adr)                    {Release what we got}
        %signal  14, 1 { , status }
     %finish
     integer (adr) = rsize                          {Fill in size}
     %result = adr+2    {words!}                    {Pass to user}
  %end

!  %routine  FREE VEC (%record(*) %name  r)
!     %integer  status, rsize, adr
!     adr = addr(r) - 2    {words!}                  {Locate size field}
!     rsize = integer(adr)                           {Pick up total size}
!     status = free vm (rsize, adr)                  {Hand space back}
!     %signal  14, 1 { , status } %if status & 1 = 0
!  %end
   
  %routine serror ( %string(80) m )
    %integer i
    %if echo = false %start
      space %for i = 1,1,tp+6
    %finish %else %start
      print string(line);newline
      %if tp > 1 %start
        space %for i = 1,1,tp-1
      %finish
    %finish
    print symbol('^');newline
    print string("TABLE - syntax error : ".m)
    %if input # nl %start
      read symbol ( input ) %until input = nl
    %finish
    error = true
    prompt("]      ")
    newline
    %stop %if echo = true %or diags = false
  %end

  %integer %function id ( %integer i )
    %result = true %if  'A' <= i&95 <= 'Z'
    %result = false
  %end

  %integer %function alpha numeric ( %integer i )
    %result = true %if id(i) = true %or '0' <= i <= '9'
    %result = false
  %end

  %integer %function disj ( %integer s )
    %result = true %if s = '+' %or s = '!'
    %result = false
  %end

  %integer %function conj ( %integer s )
    %result = true %if s = '*' %or s = '.' %or s = '&'
    %result = false
  %end

  %routine read name ( %string(*)%name s, %integer %name ch )
    !
    ! chop off identifier after 6 characters
    !
    s = ""
    %cycle
      ch = ch&95 - 'A' + 'a' %if id(ch) = true
      s = s.tostring(ch) %if length(s)<7
      %exit %if alpha numeric( next symbol ) = false
      read symbol(ch)
      line = line.to string(ch) %if echo = true
    %repeat
    len = length(s)
  %end

  %routine advance
    %integer sym
    prompt("_      ")
    !
    ! Skip spaces, comments
    ! Skip newlines after disjunction and conjunction symbols, and commas
    !
    ! Current input line is buffered on 'line'
    !
    %while next symbol = nl %or next symbol = ' ' %or next symbol = '{' %cycle
      %if next symbol = ' ' %start
        tp = tp + 1
        line = line." " %if echo = true
        skip symbol
      %finish %else %if next symbol = '{' %start
        read symbol (sym) %until sym='}'
      %finish %else %if conj(input)=true %or disj(input)=true %or input=',' %start
        tp = 0
        line = line.snl %if echo = true
        skip symbol
      %finish %else %start
        %exit
      %finish
    %repeat
    read symbol(input)
    tp = tp + 1
    line = line.to string(input) %if echo = true
    read name ( name , input ) %and tp = tp + len-1 %if id ( input ) = true
  %end

  %integerfn { %record(*)%map } new ( %integer type )
    %record(cell)%name free ; free == example
    free == record(get vec( size of(free) ))
    %result = addr(free)
  %end

!  %routine dispose ( %record(*)%name s )
!    Free Vec(s)
!  %end

  %integerfn {%record(productf)%map } %spec P
  %integerfn { %record(prodlf)%map } %spec PL

  %integerfn {%record(sumf)%map } S
    %record(sumf)%name sx
    %record(prodlf)%name link
    sx == record(new( sum ))
    sx_p == record(P)
    sx_pl == record(PL)
    link == record(new ( prodl ))      { Link all products together }
    link_p == sx_p
    link_next == sx_pl
    sx_pl == link
    %result = addr(sx)
  %end

  %integerfn { %record(termf)%map } %spec T
  %integerfn { %record(termlf)%map } %spec TL

  %integerfn { %record(productf)%map } P
    %record(productf)%name px
    %record(termlf)%name link
    px == record(new( product ))
    px_t == record(T)
    px_tl == record(TL)
    link == record(new ( terml ))         { link all Terms together }
    link_t == px_t
    link_next == px_tl
    px_tl == link
    %result = addr(px)
  %end

  %integerfn { %record(prodlf)%map } PL
    %record(prodlf)%name plx
    %if disj( input ) = true %start
      advance
      plx == record(new( prodl ))
      plx_p == record(P)
      plx_next == record(PL)
      %result = addr(plx)
    %finish %else %start
      %result = 0
    %finish
  %end

  %integerfn { %record(termlf)%map } TL
    %record(termlf)%name tlx
    %if conj( input ) = true %start
      advance
      tlx == record(new( terml ))
      tlx_t == record(T)
      tlx_next == record(TL)
      %result = addr(tlx)
    %finish %else %start
      %result = 0
    %finish
  %end

  %integerfn { %record(termf)%map } T
    %record(termf)%name tx ; tx == record(new( term ))
    %if input = '\' %or input = '~' %start
      advance
      tx_inv = true
    %finish %else %start
      tx_inv = false
    %finish
    %if alpha numeric( input ) = true %start
      tx_id = name
      tx_type = idt
      advance
      %if input = '''' %start
        tx_inv = true
        advance
      %finish
      %result = addr(tx)
    %finish %else %if input = '(' %start
      advance
      tx_type = sumt
      tx_s == record(S)
      %if input = ')' %start
        advance
        %if input = '''' %start
          tx_inv = true
          advance
        %finish
        %result = addr(tx)
      %finish %else %start
        serror("missing ')'")
        %result = 0
      %finish
    %finish %else %start
      serror("unexpected symbol : looking for identifier or '(' ")
      %result = 0
    %finish
  %end
 
  %integerfn { %record(idlist)%map } get idlist
    %record(idlist)%name il,start

    %unless alpha numeric( input) = true %start
      serror("unexpected symbol : looking for identifier list")
      %result = 0
    %finish %else %start
      il == record(new( idl ))
      il_id = name
    %finish
    start == il
    advance
    %while input = ',' %cycle
      advance
      %unless alpha numeric( input ) = true %start
        serror("unexpected symbol : looking for identifier")
        %result = 0
      %finish        
      il_next == record(new( idl ))
      il == il_next
      il_id = name
      advance
    %repeat
    %if input # nl %start
      serror("unexpected symbol : looking for newline or ','")
      %result = 0
    %finish
    il_next == record(0)
    %result = addr(start)
  %end 

  %integerfn { %record(idlist)%map } endof ( %record(idlist)%name r )
    %if r == record(0) %start
      %result = 0
    %finish %else %if r_next == record(0) %start
      %result = addr(r)
    %finish %else %start
      %result = endof(r_next)
    %finish
  %end

  %integerfn { %record(assf)%map } A
    %record(assf)%name ax { ; ax == record(new( ass )) }
    %on 9 %start
      %result = 0
    %finish
    ax == record(new( ass ))
    prompt("]      ")
    %cycle
      tp = 0;   line = ""
      error = false
      skip symbol %while next symbol = nl
      advance
      error = true %and %continue %if input = nl
      %if alpha numeric( input ) = true %start
        %if name = "in" %or name = "out" %start
          %if name = "in" %then ax_type = int %c
                          %else ax_type = outt
          advance
          ax_il == record(get idlist)
          %continue
        %finish %else %start
          ax_type = equationt
          ax_id = name
          advance
        %finish
      %finish %else %start
        serror("unexpected symbol : looking for assignment or I/O statement")
        %continue
      %finish
      %if input = '=' %and error = false %start
        advance
      %finish %else %if error = false %start
        serror("unexpected symbol : looking for '='")
        %continue
      %finish
      ax_s == record(S)
      ax_flattened = false
      ax_sorted = false
      ax_mode = 0
      %if input # nl %and error = false %start
        serror("unexpected symbol : looking for newline")
      %finish
    %repeat %until error = false
    %result = addr(ax)
  %end

  %integerfn { %record(sumf)%map } lookup ( %string(6) id , %byte input )
    %integer i
    %for i = 1,1,ep %cycle
      equation==record(equations(i))
      %result = addr(equation_s) %if ( input = true %or %c
         equation_mode&in # in ) %and equation_id = id
    %repeat
    %result = 0
  %end

  %routine print id ( %record(termf)%name t )
    print symbol('\') %if t_inv = true
    print string( t_id )
  %end

  %routine %spec collapse tree ( %record(sumf)%name s )

  %routine collapse term ( %record(termf)%name t )
    collapse tree(t_s) %if t_type = sumt    
!    dispose(t)
  %end

  %routine collapse product ( %record(productf)%name p )
    %record(termlf)%name tl, dt ; tl == p_tl
    %while tl ## record(0) %cycle
      dt == tl
      tl == tl_next
      collapse term(dt_t)
!      dispose(dt)
    %repeat
  %end

  %routine collapse tree ( %record(sumf)%name s )
    %record(prodlf)%name pl, dp
    pl == s_pl
    %while pl ## record(0) %cycle
      dp == pl
      pl == pl_next
      collapse product(dp_p)
!      dispose(dp)
    %repeat
  %end

  %routine print sum ( %record(sumf)%name s )
    %record(prodlf)%name pl ; pl == s_pl
    %record(termlf)%name tl
    pl == s_pl
    %while pl ## record(0) %cycle
      tl == pl_p_tl
      spaces (8) %if diags=true
      %while tl ## record(0) %cycle
        print id(tl_t) %if diags=true
        tl == tl_next
        print symbol('.') %if diags=true %and tl ## record(0)
      %repeat
      pl == pl_next
      space %and print symbol('+') %and newline %if diags=true %and %c
            pl ## record(0)
      products = products + 1
    %repeat
    newline %if diags=true
  %end

  %integer %function same id ( %record(termlf)%name a,b )
    %result = true %if a_t_inv = b_t_inv %and a_t_id = b_t_id
    %result = false
  %end

  %integer %function same ( %record(termlf)%name a,b )
    %if a_next ## record(0) %and b_next ## record(0) %start
      %if same id( a , b ) = true %then %result = same( a_next, b_next) %c
                                  %else %result = false
    %finish %else %if a_next == record(0) %and %c
       b_next == record(0) %start
       %result = same id( a, b)
    %finish %else %start
       %result = false
    %finish
  %end

  %integer %function product in sum ( %record(termlf)%name tl, 
                                      %record(sumf)%name s )
    %record(prodlf)%name pl 
    %result = false %if s == record(0)
    pl == s_pl
    %while pl ## record(0) %cycle
      %result = true %if same(pl_p_tl, tl ) = true
      pl == pl_next
    %repeat
    %result = false
  %end

  %integer %function  includes ( %record(termlf)%name tl1, tl2 )
    %result = true  %if tl2 == record(0)
    %result = false %if tl1 == record(0)
    %if same id( tl1, tl2 ) = true %start
      %result = includes( tl1_next, tl2_next )
    %finish %else %start
      %result = includes( tl1_next, tl2 )
    %finish
  %end

  %integer %function term includes term ( %record(termlf)%name tl,
                                          %record(sumf)%name s )
    %record(prodlf)%name pl,tp
    %result = false %if s == record(0)
    pl == s_pl
    %while pl ## record(0) %cycle
      %if includes( pl_p_tl, tl ) = true %start
        %if s_pl == pl %start
          s_pl == pl_next
        %finish %else %start
          tp == s_pl
          tp == tp_next %while tp_next ## pl
          tp_next == pl_next
        %finish
        pl == pl_next
        %continue
      %finish
      %result = true %if includes( tl, pl_p_tl) = true
      pl == pl_next
    %repeat
    %result = false
  %end

  %routine sort ( %integer { %record(termlf)%name } %arrayname a , %integer n )
    %integer i,j

    %integer %function less than ( %string(6) a, b )    { order of inputs }
      %record(idlist)%name il ; il == ins
      %while il ## record(0) %cycle
        %if ( il_id = a %and il_id = b ) %or il_id = b %start
          %result = false
        %finish %else %if il_id = a %start
          %result = true
        %finish
        il == il_next
      %repeat
      fault("TABLE: input not declared, or equation undefined in pair < ".%c
             a.", ".b." >")
      %result=0
    %end

    %routine sort ( %integer l, r)
      %integer i,j,k ; i = l ; j = r
      %record(termlf)%name x,w
      x == record(a( (l+r)//2 ))
      %cycle                              
        w==record(a(i))
        i=i+1 %and w==record(a(i)) %while less than ( w_t_id, x_t_id ) = true   { quicksort }
        w==record(a(j))
        j=j-1 %and w==record(a(j)) %while less than ( x_t_id, w_t_id ) = true
        %if i <= j %start
          k = a(i) ; a(i) = a(j) ; a(j) = k
          i = i + 1 ; j = j - 1
        %finish
      %repeat %until i > j
      sort ( l,j ) %if l < j
      sort ( i,r ) %if i < r
    %end
    sort(1,n)

  %end

  %routine sort product ( %record(productf)%name p )
    %record(termlf)%name tl ; tl == p_tl
    %integer i ; i = 0
    i = i + 1 %and tl == tl_next %while tl ## record(0)
    %return %if i < 2
    %begin
      %integer j
      %integer { %record(termlf)%name } %array terms (1:i)
      %record(termlf)%name w
      tl == p_tl
      terms(j) = addr(tl) %and tl == tl_next %for j = 1,1,i
      sort ( terms , i )
      %for j=1,1,i-1 %cycle
        w==record(terms(j))
        w_next == record(terms(j+1))
      %repeat
      w==record(terms(i))
      w_next == record(0)
      p_tl == record(terms(1))
    %end
  %end

  %routine order terms ( %record(assf)%name a )
    %record(prodlf)%name pl
    %if a_sorted = false %start
      pl == a_s_pl
      %while pl ## record(0) %cycle
        sort product( pl_p )
        pl == pl_next
      %repeat
      a_sorted = true
    %finish
  %end

  %routine throw out useless terms ( %record(sumf)%name s )
    %record(prodlf)%name pl0, pl1
    %record(termlf)%name tl1, tl2
    %integer reject term
    pl0 == record(0)
    pl1 == s_pl
    %while pl1 ## record(0) %cycle
      tl1 == pl1_p_tl
      tl2 == pl1_p_tl_next
      reject term = false
      %while tl2 ## record(0) %cycle
        %if tl1_t_id = tl2_t_id %start
          %if tl1_t_inv = tl2_t_inv %start   { both the same, miss one out }
            tl1_next == tl2_next
          %finish %else %start
            reject term = true           { i.e. 1&0 = 0, hence not needed }
            %exit
          %finish
        %finish %else %start
          tl1 == tl2
        %finish
        tl2 == tl2_next
      %repeat
      %if reject term = true %start  { miss out term completely }
        %if pl0 == record(0) %start
          s_pl == pl1_next
        %finish %else %start
          pl0_next == pl1_next
        %finish
      %finish %else %start
        pl0 == pl1
      %finish
      pl1 == pl1_next
    %repeat
  %end

  %integerfn { %record(sumf)%map } flatten ( %record(sumf)%name s , %integer inv )
    %record(sumf)%name x, y
             %record(prodlf)%name pl

    %integerfn { %record(sumf)%map } new sum of ( %record(termlf)%name tl,
                                   %integer inv )
      %record(sumf)%name s ; s == record(new ( sum ))
      %record(prodlf)%name pl ; pl == record(new ( prodl ))
      %record(productf)%name p ; p == record(new ( product ))
      %record(termlf)%name tlx ; tlx == record(new ( terml ))
      %record(termf)%name t ; t == record(new( term ))
      s_pl == pl
      s_pl_next == record(0)
      s_pl_p == p
      s_pl_p_tl == tlx
      t = tl_t
{        t_type=tl_t_type }
{        t_inv=tl_t_inv }
{        %if tl_t_type=idt %then t_id=tl_t_id %else t_s==tl_t_s }
      s_pl_p_tl_t == t
      s_pl_p_tl_next == record(0)
      s_pl_p_tl_t_inv = inv
      %result = addr(s)
    %end

    %integer %function not ( %integer bool )
       %result = true %if bool = false
       %result = false
    %end

    %integerfn { %record(sumf)%map } sum of ( %record(termlf)%name tl, %integer inv )
      %record(sumf)%name s
      %integer i ; i = tl_t_inv
      i = not(i) %if inv = true
      %if tl_t_type = sumt %start
        s == record(flatten( tl_t_s, i ) )
        %result = addr(s)
      %finish %else %start
        s == record(lookup( tl_t_id, false ))
        %if s ## record(0) %then %result = flatten(s,i) %c
                     %else %result = new sum of ( tl, i )
      %finish
    %end

    %integerfn { %record(sumf)%map } make sum ( %record(sumf)%name s1,s2 )
       %record(prodlf)%name p
       %result = addr(s2) %if s1 == record(0)  %or s1_pl == record(0) 
       p == s1_pl
       p == p_next %while p_next ## record(0)
       p_next == s2_pl
       %result = addr(s1)
    %end

    %integerfn { %record(productf)%map } join ( %record(productf)%name p1, p2 )
      %record(termlf)%name tl ; tl == p1_tl
      %record(termlf)%name x ; x == record(new( terml ))
      %record(productf)%name p ; p == record(new( product ))
      p_tl == x
      %while tl ## record(0) %cycle
        x_next == record(new( terml ))
        x == x_next
        x_t == tl_t
        tl == tl_next
      %repeat
      tl == p2_tl
      %while tl ## record(0) %cycle
        x_next == record(new( terml ))
        x == x_next
        x_t == tl_t
        tl == tl_next
      %repeat
      x_next == record(0)
      p_tl == p_tl_next
      sort product(p)
      %result = addr(p)
    %end

    %integerfn { %record(sumf)%map } do product ( %record(sumf)%name s1 , s2 )
      %record(prodlf)%name p1, p2, p3, tpl
      %record(sumf)%name s,sn
      %result = addr(s2) %if s1 == record(0)

      s == record(new( sum ))
      s_pl == record(0)

      p1 == s1_pl
      %while p1 ## record(0) %cycle
        p2 == s2_pl
        %while p2 ## record(0) %cycle
          p3 == record(new( prodl ))
          p3_p == record(join( p1_p, p2_p ))
          p3_next == record(0)
          sn == record(new( sum ))
          sn_pl == p3
          throw out useless terms(sn)
          %if sn_pl ## record(0) %and %c
              term includes term( sn_pl_p_tl, s ) = false %start
            %if s_pl == record(0) %start
              s_pl == sn_pl
            %finish %else %start
              tpl == s_pl
              tpl == tpl_next %while tpl_next ## record(0)
              tpl_next == sn_pl
            %finish
          %finish
          p2 == p2_next
        %repeat
        p1 == p1_next
      %repeat
      %result = addr(s)   
    %end

    %integerfn {%record(sumf)%map } sop ( %record(productf)%name p , %integer inv )
      %record(sumf)%name x,y ; x == record(0) ; y == record(0)
      %record(termlf)%name tl ; tl == p_tl
      %if inv = false %start
        %while tl ## record(0) %cycle
          x == record(sum of ( tl, false ))
          y == record(do product( y , x ))
          tl == tl_next
        %repeat
      %finish %else %start
        %while tl ## record(0) %cycle
          x == record(sum of ( tl, true ))
          y == record(make sum( y, x ))
          tl == tl_next
        %repeat
      %finish
      %result = addr(y)
    %end

    %result = 0 %if s == record(0)
    y == record(0)
    pl == s_pl

    %if inv = false %start          { sum of products }
      %while pl ## record(0) %cycle
        x == record(sop( pl_p, false ))
        y == record(make sum( y , x ))
        pl == pl_next
      %repeat
    %finish %else %start                    { product of sums }
      %while pl ## record(0) %cycle
        x == record(sop( pl_p, true ))
        y == record(do product( y, x ))
        pl == pl_next
      %repeat
    %finish
    %result = addr(y)
  %end
    
  %routine smooth ( %record(assf)%name a )
    %record(sumf)%name s
    %if a_flattened = false %start
      s == record(flatten( a_s, false ))
      collapse tree ( a_s )
      a_s == s
      a_flattened = true
    %finish
    order terms ( a )
    throw out useless terms ( a_s )
    print string(a_id." = ") %and newline %if diags = true
    print sum ( a_s )
  %end

  %integer %function appears ( %string(6) id, %record(assf)%name a )
    %record(prodlf)%name pl ; pl == a_s_pl
    %record(termlf)%name tl
    %while pl ## record(0) %cycle
      tl == pl_p_tl
      %while tl ## record(0) %cycle
        %result = true %if tl_t_id = id
        tl == tl_next
      %repeat
      pl == pl_next
    %repeat
    %result = false
  %end

  %routine mark mode
    %record(assf)%name a
    %record(idlist)%name il 

    %integerfn { %record(assf)%map } find ( %string(6) id )
      %integer i
      %for i = 1,1,ep %cycle
        equation==record(equations(i))
        %result = addr(equation) %if equation_id = id
      %repeat
      %result = 0
    %end

    il == ins
    %while il ## record(0) %cycle
      a == record(find( il_id ))
      a_mode = in %if a ## record(0)
      il == il_next
    %repeat

    il == outs
    %while il ## record(0) %cycle
      a == record(find( il_id ))
      %if a == record(0) %start
        fault("TABLE: undefined output < ".il_id." >");newline
      %finish
      a_mode = a_mode!out   
      il == il_next
    %repeat
  %end

  %routine find transitive closure
    %integer n ; n = 0           { number of non inputs }
    %integer i

    %for i = 1,1,ep %cycle
      equation==record(equations(i))
      n = n + 1 %if equation_mode&in = 0     { count non inputs }
    %repeat

    %begin
       %integer i,j,k
       %byte %array B ( 1:n, 1:n )   { find transitive closure }
                                     { Warshall's Algorithm }        
       %integer %array who ( 1:n )   { pointer to equation }
       j = 1
       %for i = 1,1,n %cycle
         equation==record(equations(j))
         j=j+1 %and equation==record(equations(j)) %while equation_mode&in # 0
         who(i) = j
         j = j + 1
       %repeat
       %for i = 1,1,n %cycle
         equation==record(equations(who(i)))
         %for j = 1,1,n %cycle
           %if appears( equation_id,equation) = true %then %c
               b(j,i) = true %else b(j,i) = false
         %repeat
       %repeat
       %for i = 1,1,n %cycle                { n*n*n algorithm }
         %for j = 1,1,n %cycle
           %for k = 1,1,n %cycle
              %if b(j,i) = true %start
                b(j,k) = b(j,k)!b(i,k)
              %finish
           %repeat
         %repeat
       %repeat
       %for i = 1,1,n %cycle
         %if b(i,i) = true %start
           equation==record(equations(who(i)))
           fault("TABLE: infinite loop detected on equation ".equation_id)
         %finish
       %repeat
    %end
  %end

  %routine make matrix
    %integer { %record(termlf)%name } %array p (1:products )
    %record(termlf)%name pn
    %integer pp ; pp = 0
    %integer i,l
    %integer in already
    %record(idlist)%name il

    %routine print outs(%record(termlf)%name tl )
      %record(idlist)%name il ; il == outs
      %integer i
      space
      %while il ## record(0) %cycle
        space %for i = 1,1,length(il_id)
        %if product in sum( tl, record(lookup( il_id, true ))) = true %start
          print symbol('1')
        %finish %else %start
          print symbol('0')
        %finish
        il == il_next
      %repeat
      newline
    %end

    %routine add on ( %record(assf)%name a )
      %record(prodlf)%name pl
      %record(termlf)%name tl
      %record(idlist)%name ilx
      %integer i
      %if a_mode&out = out %start
        pl == a_s_pl
        %while pl ## record(0) %cycle
          in already = false
          %for i = 1,1,pp %cycle
            pn==record(p(i))
            in already = true %if same( pl_p_tl , pn ) = true
          %repeat
          %if in already = false %start
            pp = pp + 1
            p(pp) = addr(pl_p_tl)
            tl == pl_p_tl
            ilx == ins
            spaces(3)
            %while ilx ## record(0) %cycle
              %if tl == record(0) %or tl_t_id # ilx_id %start
                space %for i = 1,1,length(ilx_id)
                print symbol('x')
                ilx == ilx_next
              %finish %else %start
                space %for i = 1,1,length(ilx_id)
                %if tl_t_inv = true %start
                  print symbol('0')
                %finish %else %start
                  print symbol('1')
                %finish
                tl == tl_next
                ilx == ilx_next
              %finish
            %repeat
            pn==record(p(pp))
            print outs(pn)
          %finish
          pl == pl_next
        %repeat
      %finish
    %end

    l = 1
    print string("IN  ")
    il == ins
    %while il ## record(0) %cycle
      printstring(il_id)
      print symbol(',') %if il_next ## record(0) 
      l = l + length(il_id) + 1
      il == il_next
    %repeat
    newline    
    equation==record(equations(i)) %and add on ( equation ) %for i = 1,1,ep
    il == outs
    print string("OUT")
    space %for i = 1,1,l+1
    %while il ## record(0) %cycle
      print string(il_id)
      print symbol(',') %if il_next ## record(0)
      il == il_next
    %repeat
    newline

  %end
    
  !---------------------------------------------------------------!
  ! Main Program                                                  !
  !---------------------------------------------------------------!

  oldin = in stream
  oldout = out stream

  parse filespec ( filespec, "eqn", "tbl", fin, fout, inn, outn )

  %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
  echo = false %if fin = ""
  ins == record(0) ; outs == record(0)
  ep = 0
  products = 0

  select input(inn)
  select output(0)

  %cycle
    ca == record(A)
    %exit %if ca == record(0)
    %if ca_type = equationt %start
      ep = ep + 1
      fault("TABLE: too many equations < ".itos(ep,0)." >") %c
        %if ep > max equations
      equations(ep) =  addr(ca)
    %finish %else %if ca_type = int %start
      il == record(endof(ins))
      %if il == record(0) %start
        ins == ca_il
      %finish %else %start
        il_next == ca_il
      %finish
    %finish %else %start
      il == record(endof(outs))
      %if il == record(0) %start
        outs == ca_il
      %finish %else %start
        il_next == ca_il
      %finish
    %finish
  %repeat

  mark mode %for i = 1,1,ep
  find transitive closure
  equation==record(equations(i)) %and smooth( equation ) %for i = 1,1,ep

  %if ins == record(0) %and outs == record(0) %start
    fault("TABLE: inputs and outputs are not specified")
  %finish %else %if ins == record(0) %start
    fault("TABLE: inputs are not specified")
  %finish %else %if outs == record(0) %start
    fault("TABLE: outputs are not specified")
  %finish

  select output(outn)
  make matrix

  close input(instream)
  close output(outstream)

  select output( oldout )
  select input ( oldin  )

%end

!------------------------------------------------------------------------------!
!                                                                              !
! TABLE : an ILAP routine which will generate a Table file from an Equation    !
! file . This routine calls sTABLE with monitoring turned off.                 !
!                                                                              !
! George A. McCaskill     20th August 1982                                     !
!------------------------------------------------------------------------------!

%external %routine table ( %string(255) filespec )
   sTABLE (filespec, false)
%end

%external %routine tablewithdiags (%string (255) filespec)
   sTABLE (filespec, true)
%end

%end %of %file