!--------------------------------------------------------------------------!
!  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                                     !
!                                                                          !
! Fix added by IMN for %continue ambiguity in APM IMP... 19/11/85          !
! Unstiffened 27/10/86 by DJR                                              !
!--------------------------------------------------------------------------!

%include "nmos.inc"
%include "plautils.inc"
%include "inc:util.imp"
%const %string (1) SNL = "
"

{#########################################################################}
{#                                                                       #}
{#      This program is part of the ILAP library, and was written in     #}
{#   The Department of Computer Science at the University of Edinburgh   #}
{#       (James Clerk Maxwell Building, Kings Buildings, Edinburgh)      #}
{#                                                                       #}
{#   This software is available free to other educational establisments  #}
{#   but the University of Edinburgh, retains all commercial rights.     #}
{#   It is a condition of having this software is that the sources are   #}
{#   not passed on to any other site, and that Edinburgh University is   #}
{#   given credit in any re-implementations of any of the algorithms     #}
{#   used, or articles published which refer to the software.            #}
{#                                                                       #}
{#   There is no formal support for this software, but any bugs should   #}
{#   be reported to Gordon Hughes or David Rees at the above address,    #}
{#   and these are likely to be fixed in a future release.               #}
{#                                                                       #}
{#########################################################################}

%external %routine sTABLE %alias "ILAP_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                  )
  %own %record (cell) %name FREE

  !--------------------------------------------------------!

  %record %format termlfa (%record (termlfa) %name N)

  %constant %integer max equations = 500
  %record(assf)%name %array equations (1:max equations)
  %record(assf)%name ca
  %integer ep
  %record(idlist)%name ins,outs,il

  %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              { whether we need to echo incorrect input }
  %integer input             { current input character }
  %integer len               { length of most recent identifier }
  %integer error             { error flag }
  %integer products          { number of product terms }
  %string(6) name            { most recent identifier }
  %string(127) fin, 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     { \a and a appear in term }

  !---------------------------------------------------------!

  %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

  %routine pdebug (%String(255) line)
     %return %if diags # true
     printstring(line);newline
  %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

  %record(productf)%map %spec P
  %record(prodlf)%map %spec PL

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

  %record(termf)%map %spec T
  %record(termlf)%map %spec TL

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

  %record(prodlf)%map PL
    %record(prodlf)%name plx
    %if disj( input ) = true %start
      advance
      plx == nil
      plx == new(plx)
      plx_p == P
      plx_next == PL
      %result == plx
    %finish %else %start
      %result == nil
    %finish
  %end

  %record(termlf)%map TL
    %record(termlf)%name tlx
    %if conj( input ) = true %start
      advance
      tlx == nil
      tlx == new(tlx)
      tlx_t == T
      tlx_next == TL
      %result == tlx
    %finish %else %start
      %result == nil
    %finish
  %end

  %record(termf)%map T
    %record(termf)%name tx
    tx == nil
    tx == new (tx)
    %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 == tx
    %finish %else %if input = '(' %start
      advance
      tx_type = sumt
      tx_s == S
      %if input = ')' %start
        advance
        %if input = '''' %start
          tx_inv = true
          advance
        %finish
        %result == tx
      %finish %else %start
        serror("missing ')'")
        %result == nil
      %finish
    %finish %else %start
      serror("unexpected symbol : looking for identifier or '(' ")
      %result == nil
    %finish
  %end
 
  %record(idlist)%map get idlist
    %record(idlist)%name il,start

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

  %record(idlist)%map endof ( %record(idlist)%name r )
    %if r == nil %start
      %result == nil
    %finish %else %if r_next == nil %start
      %result == r
    %finish %else %start
      %result == endof(r_next)
    %finish
  %end

  %record(assf)%map A
    ! IMN's fix put in here...
    %record(assf)%name ax
    %on 9 %start
      %result == nil
    %finish
    ax == nil
    ax == new(ax)
    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 == get idlist
 ! Spot the frig..
          %exit %if error = false
          %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 == 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 == ax
  %end

  %record(sumf)%map lookup ( %string(6) id , %byte input )
    %integer i
    %for i = 1,1,ep %cycle
      %result == equations(i)_s %if ( input = true %or equations(i)_mode&in # in ) %and equations(i)_id = id
    %repeat
    %result == nil
  %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 ## nil %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 ## nil %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
    %record(termlf)%name tl
    pl == s_pl
    %while pl ## nil %cycle
      tl == pl_p_tl
      spaces (8) %if diags=true
      %while tl ## nil %cycle
        print id(tl_t) %if diags=true
        tl == tl_next
        print symbol('.') %if diags=true %and tl ## nil
      %repeat
      pl == pl_next
      space %and print symbol('+') %and newline %if diags=true %and pl ## nil
      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 ## nil %and b_next ## nil %start
      %if same id( a , b ) = true %then %result = same( a_next, b_next) %c
                                  %else %result = false
    %finish %else %if a_next == nil %and b_next == nil %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 == nil
    pl == s_pl
    %while pl ## nil %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 == nil
    %result = false %if tl1 == nil
    %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 == nil
    pl == s_pl
    %while pl ## nil %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 ( %record(termlf)%name %array %name a , %integer n )

    %integer %function less than ( %string(6) a, b )    { order of inputs }
      %record(idlist)%name il
      il == ins
      %while il ## nil %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
      disaster ("TABLE: input not declared, or equation undefined in pair < ".%c
             a.", ".b." >")
      %result=0
    %end

    %routine sort ( %integer l, r)
      %integer i,j
      %record(termlf) x,w
      i = l
      j = r
      x = a( (l+r)//2 )
      %cycle                              
        i = i + 1 %while less than ( a(i)_t_id, x_t_id ) = true   { quicksort }
        j = j - 1 %while less than ( x_t_id, a(j)_t_id ) = true
        %if i <= j %start
          w = a(i) ; a(i) = a(j) ; a(j) = w
          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
    %integer i
    tl == p_tl
    i = 0
    i = i + 1 %and tl == tl_next %while tl ## nil
    %return %if i < 2
    %begin
      %integer j
      %record(termlf)%name %array terms (1:i)
      tl == p_tl
      terms(j) == tl %and tl == tl_next %for j = 1,1,i
      sort ( terms , i )
      terms(j)_next == terms(j+1) %for j = 1,1,i-1
      terms(i)_next == nil
      p_tl == 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 ## nil %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 == nil
    pl1 == s_pl
    %while pl1 ## nil %cycle
      tl1 == pl1_p_tl
      tl2 == pl1_p_tl_next
      reject term = false
      %while tl2 ## nil %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 == nil %start
          s_pl == pl1_next
        %finish %else %start
          pl0_next == pl1_next
        %finish
      %finish %else %start
        pl0 == pl1
      %finish
      pl1 == pl1_next
    %repeat
  %end

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

    %record(sumf)%map new sum of ( %record(termlf)%name tl,
                                   %integer inv )
      %record(sumf)%name s
      %record(prodlf)%name pl
      %record(productf)%name p
      %record(termlf)%name tlx
      %record(termf)%name t
      s == nil
      s == new (s)
      pl == nil
      pl == new ( pl)
      p == nil
      p == new ( p)
      tlx == nil
      tlx == new (tlx)
      t == nil
      t == new (t)
      s_pl == pl
      s_pl_next == nil
      s_pl_p == p
      s_pl_p_tl == tlx
      t = tl_t
      s_pl_p_tl_t == t
      s_pl_p_tl_next == nil
      s_pl_p_tl_t_inv = inv
      %result == s
    %end

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

    %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 == flatten( tl_t_s, i ) 
        %result == s
      %finish %else %start
        s == lookup( tl_t_id, false )
        %if s ## nil %then %result == flatten(s,i) %c
                     %else %result == new sum of ( tl, i )
      %finish
    %end

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

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

    %record(sumf)%map do product ( %record(sumf)%name s1 , s2 )
      %record(prodlf)%name p1, p2, p3, tpl
      %record(sumf)%name s,sn
      %result == s2 %if s1 == nil

      s == nil
      s == new(s)
      s_pl == nil

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

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

    %result == nil %if s == nil
    y == nil
    pl == s_pl

    %if inv = false %start          { sum of products }
      %while pl ## nil %cycle
        x == sop( pl_p, false )
        y == make sum( y , x )
        pl == pl_next
      %repeat
    %finish %else %start                    { product of sums }
      %while pl ## nil %cycle
        x == sop( pl_p, true )
        y == do product( y, x )
        pl == pl_next
      %repeat
    %finish
    %result == y
  %end
    
  %routine smooth ( %record(assf)%name a )
    %record(sumf)%name s
    %if a_flattened = false %start
      s == 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
    %record(termlf)%name tl
    pl == a_s_pl
    %while pl ## nil %cycle
      tl == pl_p_tl
      %while tl ## nil %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 

    %record(assf)%map find ( %string(6) id )
      %integer i
      %for i = 1,1,ep %cycle
        %result == equations(i) %if equations(i)_id = id
      %repeat
      %result == nil
    %end

    pdebug ("Mark mode")
    il == ins
    %while il ## nil %cycle
      a == find( il_id )
      a_mode = in %if a ## nil
      il == il_next
    %repeat

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

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

    pdebug ("Find transitive closure")
    n = 0
    %for i = 1,1,ep %cycle
      n = n + 1 %if equations(i)_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
         j = j + 1 %while equations(j)_mode&in # 0
         who(i) = j
         j = j + 1
       %repeat
       %for i = 1,1,n %cycle
         %for j = 1,1,n %cycle
           %if appears( equations(who(i))_id,equations(who(j))) = 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
           disaster ("TABLE: infinite loop detected on equation ".equations(who(i))_id)
         %finish
       %repeat
    %end
  %end

  %routine make matrix
    %record(termlf)%name %array p (1:products )
    %integer pp, i, l
    %integer in already
    %record(idlist)%name il

    %routine print outs(%record(termlf)%name tl )
      %record(idlist)%name il
      %integer i
      il == outs
      space
      %while il ## nil %cycle
        space %for i = 1,1,length(il_id)
        %if product in sum( tl, 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 ## nil %cycle
          in already = false
          %for i = 1,1,pp %cycle
            in already = true %if same( pl_p_tl , p(i) ) = true
          %repeat
          %if in already = false %start
            pp = pp + 1
            p(pp) == pl_p_tl
            tl == pl_p_tl
            ilx == ins
            spaces(3)
            %while ilx ## nil %cycle
              %if tl == nil %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
            print outs(p(pp))
          %finish
          pl == pl_next
        %repeat
      %finish
    %end

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

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

  echo = true
  error = false
  fin = ""
  fout = ""
  min term error = false
  free == nil
  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 == nil ; outs == nil
  ep = 0
  products = 0

  select input(inn)
  select output(0)

  %cycle
!    print string ("Starting....".snl)
    ca == A
    %exit %if ca == nil
    %if ca_type = equationt %start
      ep = ep + 1
      disaster ("TABLE: too many equations < ".itos(ep,0)." >") %c
        %if ep > max equations
      equations(ep) ==  ca
    %finish %else %if ca_type = int %start
      il == endof(ins)
      %if il == nil %start
        ins == ca_il
      %finish %else %start
        il_next == ca_il
      %finish
    %finish %else %start
      il == endof(outs)
      %if il == nil %start
        outs == ca_il
      %finish %else %start
        il_next == ca_il
      %finish
    %finish
  %repeat

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

  %if ins == nil %and outs == nil %start
    disaster ("TABLE: inputs and outputs are not specified")
  %finish %else %if ins == nil %start
    disaster ("TABLE: inputs are not specified")
  %finish %else %if outs == nil %start
    disaster ("TABLE: outputs are not specified")
  %finish

  select output(outn)
  make matrix

  close input
  close output

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

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

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

%end %of %file