         Edinburgh IMP77 Compiler - Version 8.4

    1  !MINIMO: multiple output logic function minimiser
    2  !
    3  !        Hamish Dewar 1981
    4  !
    5  
    6  %external %integer %fn %spec CPUTIME
    7  
    8  %external %string(255) %fn %spec CLIPARAM
    9  
   10  %record %format PAMINFO(%byte groupsep,keyflag, %short allflags, %record(*)%name params)
   11  
   12  %external %record(paminfo) %map %spec PAM
   13  
   14  %constinteger PAM NEWGROUP=1, PAM NODEFAULT=2, PAM MAJOR=4, PAM KEEPCASE=8, PAM INFILE=16, PAM OUTFILE=32
   15  
   16  %external %routine %spec DEFINE PARAM          %alias "PAM_DEFSTRING" (%string(255) text, %string(*)%name variable, %integer flags)
   17  %external %routine %spec DEFINE INT PARAM      %alias "PAM_DEFINT"    (%string(255) text, %integername variable, %integer flags)
   18  %external %routine %spec DEFINE ENUM PARAM     %alias "PAM_DEFENUM"   (%string(255) text, %bytename variable, %integer flags)
   19  %external %routine %spec DEFINE BOOLEAN PARAMS %alias "PAM_DEFBOOL"   (%string(255) text, %integername variable, %integer flags)
   20  %external %routine %spec PROCESS PARAMETERS    %alias "PAM_PROCESS"   (%string(255) parm)
   21   
   22  %begin
   23  
   24  %constinteger outstream=1
   25  ! Codes for logical operators
   26  %constinteger not=-1, or=-2, and=-3;  !(OR-1=AND)
   27  ! Flag-bit
   28  %constinteger sign=16_80000000, forced=16_40000000
   29  
   30  ! Control parameters
   31  %owninteger min=4096
   32  %owninteger inc=4096
   33  %owninteger echo=0;             !copy input to output stream
   34  %owninteger squash=0;           !compress output tables
   35  %owninteger nin=0;              !negate input variables
   36  %owninteger nout=0;             !negate output variables
   37  %owninteger check=0;            !check completeness
   38  %owninteger mon=0;              !monitoring selector (bits)
   39  %owninteger single=0;           !apply single (rather than multiple) method
   40  %owninteger tabin=0;            !tabular input
   41  
   42  %owninteger instream=3
   43  
   44  %integer negin,ignorin,negout,ignorout
   45  %integer count,aim;             !current,target score
   46  %integer minsep;                !minimum free space in array W
   47  %integer sym
   48  %integer start
   49  
   50  %constinteger storebound=2000
   51  %integer dclim,esslim,sp1,sp,np,np1;      !index vars to array W
   52  %integer needsp
   53  %recordformat cell(%integer t,f,outs,flags)
   54  %record(cell) %array w(1:storebound);     !stack -> <- nest
   55  
   56  %constinteger namebound=256
   57  %integer inmax,outmin,namemax;            !index vars to NAME,EXP
   58  %string(7)%array name(1:namebound)
   59  %integerarray exp(1:namebound)
   60  
   61  %constinteger defbound=8192
   62  %integer dp
   63  %integerarray def(1:defbound)
   64  
   65  %integerfn bits(%integer v)
   66  %integer k
   67  k = 0
   68  k = 1 %and v = v<<1>>1 %if v < 0
   69  %while v # 0 %cycle
   70    k = k+1
   71    v = v&(v-1)
   72  %repeat
   73  %result = k
   74  %end
   75  
   76  %routine out(%integer v)
   77    out(v//10) %and v = v-v//10*10 %if v >= 10
   78    printsymbol(v+'0')
   79  %end
   80  
   81  %routine croak(%string(32) s)
   82    select output(0)
   83    newline
   84    printstring("*".s."  Abandoned")
   85    %if sym # nl %start
   86      printstring(" at: ")
   87      %cycle
   88        readsymbol(sym)
   89        printsymbol(sym)
   90      %repeat %until sym = nl
   91    %finish
   92    %stop
   93  %end
   94  
   95  %routine print time
   96  %integer t
   97    t = cputime
   98    print((t-start)/1000,5,3)
   99    start = t
  100  %end
  101  
  102  %routine push(%record(cell) v)
  103  ! Store V on (descending) nest
  104    np = np-1;  w(np) = v
  105    %return %if np-sp >= minsep
  106    minsep = np-sp
  107    %return %if minsep > 2
  108    croak("No space.")
  109  %end
  110  
  111  %routine stack(%record(cell) v)
  112  ! Store V on (ascending) stack
  113    w(sp) = v;  sp = sp+1
  114    %return %if np-sp > minsep
  115    minsep = np-sp
  116    %return %if minsep > 2
  117    croak("No space.")
  118  %end
  119  
  120  ! R e a d   a n d   c h e c k   d a t a
  121  !
  122  %routine readin
  123  %integer bit,pos,pos1,found,first,dp1,outmax
  124  %integer pend
  125  %string(7) curname
  126  
  127  %routine put(%integer v)
  128    croak(" Definitions too long") %if dp > defbound
  129    def(dp) = v;  dp = dp+1
  130  %end
  131  
  132  %routine read sym
  133    %on %event 9 %start
  134      sym = '*'
  135      instream = instream-1
  136      %return %if instream = 0
  137      %if instream < 0 %start
  138        sym = nl
  139        croak("Premature end of input.")
  140      %finish
  141      select input(instream)
  142    %finish
  143    sym = pend;  pend = 0
  144    %return %if sym # 0
  145    %cycle
  146      readsymbol(sym)
  147      printsymbol(sym) %if echo # 0
  148      %return %unless sym = '{'
  149      %cycle
  150        read symbol(sym)
  151        print symbol(sym) %if echo # 0
  152      %repeat %until sym = '}'
  153    %repeat
  154  %end
  155  
  156  %routine read name
  157  !Read name (possibly null) to CURNAME leaving terminator in SYM
  158  %integer k,l
  159    read sym %until sym > ' '
  160    l = 0
  161    k = sym;  k = k-'a'+'A' %if k >= 'a'
  162    %if 'A' <= k <= 'Z' %start
  163      %cycle
  164        %if l < 6 %start
  165          l = l+1;  charno(curname,l) = k
  166        %finish
  167        read sym
  168        k = sym;  k = k-'a'+'A' %if k >= 'a'
  169        %exit %unless '0' <= k <= '9' %c
  170+             %or (charno(curname,l) >= 'A' %and 'A' <= k <= 'Z')
  171      %repeat
  172      %if sym = '?' %start
  173        l = l+1;  charno(curname,l) = sym
  174        read sym
  175      %finish
  176    %finish
  177    length(curname) = l
  178    %if sym=' ' %start
  179      read sym %until sym#' '
  180      %if 'A'<=sym&95<='Z' %start
  181        pend = sym; sym = ' '
  182      %finish
  183    %finish
  184  %end
  185  
  186  %routine init(%integername v)
  187  ! Read asignment for mode variable V (default 1)
  188    found = 1
  189    v = 1
  190    read(v) %and out(v) %if sym = '='
  191  %end
  192  
  193  %routine lookup
  194    pos = namemax+1
  195    pos = pos-1 %until pos = 0  %or name(pos) = curname
  196  %end
  197  
  198  %routine queryname
  199    newline %if echo # 0
  200    printstring(curname." not known")
  201    newline
  202  %end
  203  
  204  %routine addname
  205    namemax = namemax+1
  206    name(namemax) = curname
  207  %end
  208  
  209  %routine newname
  210    croak("Duplicate: ".curname.". ") %if pos # 0
  211    addname
  212  %end
  213  
  214  %routine read exp
  215  ! Read logic expression: store as Polish
  216  !   operands represented as name index values (> 0)
  217  !   operators < 0
  218  !  eg A&B ! \A&\B  ==>  1 2 AND NOT 1 NOT NOT 2 NOT AND OR 0
  219  !                       A B  &   \  A  \   \  B  \   &   !
  220  !  note duplication of NOT before and after
  221  
  222  %routine read term
  223    read name
  224    %if curname # "" %start
  225      pend = sym %if sym >= 'A' %or sym = '('
  226      lookup
  227      queryname %and pos = 1 %if pos = 0
  228      put(pos)
  229    %finish %else %if sym = '\' %start
  230      put(not);                           !fore ..
  231      read term
  232      put(not);                           ! .. as well as aft
  233    %finish %else %start
  234      croak("Faulty format. ") %if sym # '('
  235      read exp
  236      croak("Missing ')'. ") %if sym # ')'
  237      read sym
  238    %finish
  239  %end
  240  
  241  %routine read exp1
  242    read term
  243    %while sym = '&' %or sym = '.' %or sym >= 'A' %or sym = '(' %cycle
  244      read term
  245      put(and)
  246    %repeat
  247  %end
  248  
  249    read exp1
  250    %while sym = '!' %or sym = '+' %cycle
  251      read exp1
  252      put(or)
  253    %repeat
  254  %end; !READ EXP
  255  
  256    namemax = 0;  dp = 1
  257    pend = 0
  258  ! MODE settings (if any)
  259    %cycle
  260      read name
  261      %stop %if sym = '*'
  262      %exit %unless curname = "MODE"
  263      printstring("MODE ") %and printsymbol(pend) %if echo=0
  264      echo = echo-2
  265      %cycle
  266        read name
  267        found = 0
  268        init(nin) %if curname = "NIN"
  269        init(nout) %if curname = "NOUT"
  270        init(min) %if curname = "MIN"
  271        init(inc) %if curname = "INC"
  272        init(echo) %if curname = "ECHO"
  273        init(squash) %if curname = "SQUASH"
  274        init(check) %if curname = "CHECK"
  275        init(mon) %if curname = "MON"
  276        init(single) %if curname = "SINGLE"
  277        init(tabin) %if curname = "TABIN"
  278        init(tabin) %and tabin = 1-tabin %if curname="EQUIN"
  279        printsymbol('?') %if found = 0
  280      %repeat %until sym # ','
  281      %if echo<0 %start
  282        echo = echo+2
  283        newline %if echo=0
  284      %finish
  285    %repeat
  286  ! INput list
  287    croak("Keyword ".curname."? ") %if curname # "IN"
  288    pend = sym %if pend=0
  289    bit = 1;  negin = 0;  ignorin = 0
  290    %cycle
  291      croak("Too many inputs.") %if bit = 0
  292      read sym %until sym>' ' %and sym#','
  293      %if sym = '-' %start
  294        ignorin = ignorin+bit
  295        curname = "-"
  296        read sym
  297      %finish %else %start
  298        %if sym = '\' %then negin = negin+bit %c
  299+       %else pend = sym
  300        read name
  301        lookup
  302      %finish
  303      newname
  304      exp(namemax) = bit
  305      bit = bit<<1
  306    %repeat %until sym # ','
  307    inmax = namemax
  308    negin = \negin %if nin # 0
  309  ! logic equations
  310  %if tabin = 0 %start
  311    %cycle
  312      read name
  313      %exit %if sym # '='
  314      lookup
  315      pos = 0 %if pos <= inmax
  316      newname
  317      exp(namemax) = dp;                  !start of Polish representation
  318      namemax = namemax-1;                !hide LH name to exclude self-ref
  319      read exp
  320      namemax = namemax+1;                !restore LH name
  321      put(0);                             !terminator
  322      croak("Faulty format. ") %if sym # nl
  323    %repeat
  324  %finish %else %start;                   !tabular input
  325    pos1 = namebound+1;  outmax = 0
  326    %cycle
  327      read sym %until sym > ' '
  328      pend=sym %and %exit %if sym&95 = 'O'
  329      pos1 = pos1-1
  330      croak("Too many table entries") %if pos1 = namemax
  331      exp(pos1) = 0
  332      first = 1
  333      %for pos = 1,1,inmax %cycle
  334        %if ignorin>>(pos-1)&1 = 0 %c
  335+       %and (sym = '0' %or sym = '1') %start
  336          %if sym = '1' %then put(pos) %c
  337+         %else put(not) %and put(pos) %and put(not)
  338          put(and) %if first = 0
  339          first = 0
  340        %finish
  341        read sym %until sym # ' '
  342      %repeat
  343      put(0)
  344      bit = 1;  namemax = inmax
  345      %while sym # nl %cycle
  346        croak("Faulty entry. ") %if (sym # '0' %and sym # '1') %c
  347+            %or namemax = outmax
  348        exp(pos1) = exp(pos1)!bit %if sym = '1'
  349        bit = bit<<1;  namemax = namemax+1
  350        read sym %until sym # ' '
  351      %repeat
  352      outmax = namemax %if outmax = 0
  353      croak("Faulty entry. ") %if outmax # namemax
  354    %repeat
  355    bit = 1
  356    bit = \0 %and namemax = inmax+1 %if check # 0
  357    %for pos = inmax+1,1,namemax %cycle
  358      exp(pos) = dp
  359      first = 1
  360      %integer first pos1 A = pos1 {workaround}
  361      %for pos1 = namebound,-1,first{workaround}pos1 A %cycle
  362        %if exp(pos1)&bit # 0 %start
  363          put(pos1)
  364          put(or) %if first = 0
  365          first = 0
  366        %finish
  367      %repeat
  368      put(0)
  369      bit = bit<<1
  370    %repeat
  371    dp1 = 1
  372    %integer first pos1 B = pos1 {workaround}
  373    %for pos1 = namebound,-1,first{workaround}pos1 B %cycle
  374      exp(pos1) = dp1
  375      dp1 = dp1+1 %until def(dp1-1) = 0
  376    %repeat
  377    read name
  378  %finish
  379  ! OUTput list
  380  !  note that OUTput names are added again 
  381  !      to simplify treatment of "Don't cares"
  382    croak("Keyword ".curname."? ") %if curname # "OUT"
  383    pend = sym %if pend=0
  384    outmin = namemax+1;  pos = inmax
  385    negout = 0;  ignorout = 0;  bit = 1
  386    %cycle
  387      croak("Too many outputs. ") %if namemax-outmin+2 > 32
  388      read sym %until sym>' ' %and sym#','
  389      %if sym = '-' %start
  390        ignorout = ignorout+bit
  391        curname = "-"
  392        read sym
  393      %finish %else %start
  394        %if sym = '\' %then negout = negout+bit %c
  395+       %else pend = sym
  396        read name
  397      %finish
  398      %if tabin = 0 %then lookup %else pos = pos+1
  399      %if pos # 0 %start;                 !should be there
  400        addname
  401        exp(namemax) = dp
  402        put(pos)
  403        %if tabin = 0 %start
  404          curname = curname."?";          !any "Don't cares" for this one?
  405          lookup
  406          %if pos # 0 %start;             !if so
  407            put(pos)
  408            put(or)
  409          %finish
  410        %finish
  411        put(0)
  412      %finish %else %start
  413        queryname
  414      %finish
  415      bit = bit<<1
  416    %repeat %until sym # ','
  417    %stop %if outmin > namemax;           !no (surviving) outputs
  418    croak("Faulty format. ") %if sym # nl
  419    negout = \negout %if nout # 0
  420  %end; !READIN
  421  
  422  %routine print term(%record(cell) v, %integer x)
  423  %integer i,l
  424    %for i = 1,1,inmax %cycle
  425      space %if squash = 0
  426      %if (v_t!v_f)&1 # 0 %start
  427        l = ' '
  428        l = '\' %if v_f&1 # 0
  429        printsymbol(l)
  430        print string(name(i))
  431      %finish %else %start
  432        l = length(name(i))
  433        spaces((l+1)//2)
  434        printsymbol('.')
  435        spaces(l//2)
  436      %finish
  437      v_t = v_t>>1;  v_f = v_f>>1
  438    %repeat
  439    space %if squash = 0
  440    printsymbol(':')
  441    %for i = outmin,1,namemax %cycle
  442      space
  443      %if v_outs&1 # 0 %start
  444        printstring(name(i))
  445      %finish %else %start
  446        l = length(name(i))
  447        spaces((l-1)//2)
  448        %if x&1 = 0 %then printsymbol('.') %c
  449+       %else printsymbol('?')
  450        spaces(l//2)
  451      %finish
  452      v_outs = v_outs>>1;  x = x>>1
  453    %repeat
  454    newline
  455  %end
  456  
  457  %routine monitor(%integer lim)
  458  %integer q
  459    newline
  460    q = 1
  461    %while q # lim %cycle
  462      write(q,2) %if mon&4 # 0
  463      print term(w(q),0)
  464      q = q+1
  465    %repeat
  466    newline
  467  %end
  468  
  469  %routine copydown
  470    np1 = np
  471    %while sp # sp1 %cycle
  472      sp = sp-1;  np = np-1
  473      w(np) = w(sp)
  474    %repeat
  475  %end
  476  
  477  %routine erase(%integer p)
  478    sp = sp-1
  479    %while p # sp %cycle
  480      w(p) = w(p+1)
  481      p = p+1
  482    %repeat
  483  %end
  484  
  485  %routine merge
  486  %integer p,k,same
  487  %ownrecord(cell) v,n=0
  488    %while np # np1 %cycle
  489      v = w(np);  np = np+1
  490      p = sp1;  same = 0
  491      %while p # sp %cycle
  492        %if w(p)_t!v_t = v_t %and w(p)_f!v_f = v_f %start; !V -> @P
  493          v_outs = v_outs&(\w(p)_outs)
  494          %exit %if v_outs = 0
  495          same = p %if w(p)_t = v_t %and w(p)_f = v_f
  496        %finish
  497        p = p+1
  498      %repeat
  499      %if v_outs # 0 %start
  500        %while p # sp1 %cycle
  501          p = p-1
  502          n_outs = w(p)_outs&v_outs
  503          %if n_outs # 0 %start
  504            n_t = w(p)_t!v_t;  n_f = w(p)_f!v_f
  505            k = (n_t)&n_f
  506            %if k # 0 %and (k-1)&k = 0 %start; !singleton
  507              n_t = n_t!!k;  n_f = n_f!!k
  508              push(n)
  509              v_outs = v_outs!!n_outs %if n_t!v_t = v_t %and n_f!v_f = v_f; !V -> N
  510              n_t = n_t!w(p)_t;  n_f = n_f!w(p)_f
  511            %finish
  512            %if n_t = w(p)_t %and n_f = w(p)_f %start;  !@P -> N
  513              w(p)_outs = w(p)_outs!!n_outs
  514              %if w(p)_outs = 0 %start
  515                erase(p)
  516                same = same-1 %if same > p
  517              %finish
  518            %finish
  519            %exit %if v_outs = 0
  520          %finish
  521        %repeat
  522        %if v_outs # 0 %start
  523          %if same = 0 %start
  524            w(sp) = v;  sp = sp+1
  525          %finish %else %start
  526            w(same)_outs = w(same)_outs+v_outs
  527          %finish
  528        %finish
  529      %finish
  530    %repeat
  531  %end
  532  
  533  ! C o n v e r t   f r o m   P o l i s h   t o   i n t e r n a l 
  534  !
  535  %routine convert
  536  %integer outbit,oldsp,i,j,k,p,q,hp,inv
  537  %ownrecord(cell) v=0
  538  %integerarray hold(1:20)
  539  
  540  %routine convert(%integer j)
  541  %integer defp
  542    defp = exp(j)
  543    %cycle
  544      j = def(defp);  defp = defp+1;      !get next item
  545      %return %if j = 0;                  !terminator
  546      %if j > 0 %start;                   !operand
  547        %if j > inmax %start;             !start of sub-def
  548          convert(j)
  549        %finish %else %start
  550          hp = hp+1;  hold(hp) = sp1
  551          sp1 = sp
  552          v_t = exp(j);  v_f = 0
  553          v_f = v_t %and v_t = 0 %if inv!!(negin>>(j-1)&1) # 0
  554          stack(v)
  555        %finish
  556      %finish %else %if j = not %start
  557        inv = inv!!1
  558      %finish %else %if j-inv = and %start;  !'AND' or inverted 'OR'
  559        np1 = np;                         !Form pairwise intersection on nest
  560        %while sp # sp1 %cycle
  561          sp = sp-1
  562          p = sp1
  563          %while p # hold(hp) %cycle
  564            p = p-1
  565            v_t = w(sp)_t!w(p)_t;  v_f = w(sp)_f!w(p)_f
  566            push(v) %if v_t&v_f = 0; !intersection ok
  567          %repeat
  568        %repeat
  569        sp1 = hold(hp);  hp = hp-1
  570        sp = sp1;                         !start with stack empty
  571        merge
  572      %finish %else %start;               !'OR' or inverted 'AND'
  573        copydown;                         !one operand to nest
  574        sp1 = hold(hp);  hp = hp-1
  575        merge
  576      %finish
  577    %repeat
  578  %end
  579  
  580  sp = 1;  np = storebound;  minsep = np-sp
  581  v_flags = 0
  582  outbit = 1
  583  %for i = outmin,1,namemax %cycle
  584  %if ignorout&outbit = 0 %start
  585    k = def(exp(i)+1);                    !2nd element of def
  586    %if k # 0 %start;                     !"Don't cares" present
  587      sp1 = 1;  hp = 0;  inv = 0
  588      v_outs = outbit
  589      convert(k)
  590      copydown
  591      sp1 = 1
  592      merge
  593    %finish
  594  %finish
  595  outbit = outbit<<1
  596  %repeat
  597  dclim = sp
  598  outbit = 1
  599  %for i = outmin,1,namemax %cycle
  600  %if ignorout&outbit = 0 %start
  601    sp1 = 1;  hp = 0;  inv = negout>>(i-outmin)&1
  602    v_outs = outbit
  603    convert(i)
  604    copydown
  605    sp1 = dclim
  606    %if single # 0 %then merge %else %start
  607      oldsp = sp
  608      %while np # np1 %cycle;             !each element against rest
  609        q = sp1-1;                        ! and null (ie straight)
  610        v = 0
  611        %cycle
  612          v_t = v_t!w(np)_t;  v_f = v_f!w(np)_f
  613          %if v_t&v_f = 0 %start
  614            v_outs = v_outs!outbit
  615            p = sp
  616            %while p # sp1 %cycle
  617              p = p-1
  618              v_outs = v_outs!w(p)_outs %if w(p)_t = v_t %and w(p)_f = v_f
  619              j = w(p)_t!v_t;  k = w(p)_f!v_f
  620             %exit %if j = v_t %and k = v_f %and w(p)_outs&v_outs = v_outs; !V -> @P
  621   %if j = w(p)_t %and k = w(p)_f %and w(p)_outs&v_outs = w(p)_outs %start
  622                oldsp = oldsp-1 %if p < oldsp
  623                q = q-1 %if p <= q
  624                erase(p)
  625              %finish
  626            %repeat
  627            stack(v) %if p = sp1
  628          %finish
  629          q = q+1
  630          %exit %if q = oldsp
  631          v = w(q)
  632        %repeat
  633        np = np+1
  634      %repeat
  635    %finish
  636  %finish
  637  outbit = outbit<<1
  638  %repeat
  639  %end; !convert
  640  
  641  %integerfn needed(%integer q,testlim)
  642  %integer p
  643  %ownrecord(cell) v,n=0
  644    sp1 = sp;  np1 = np
  645    v = w(q)
  646    w(sp1)_t = v_t;  w(sp1)_f = v_f
  647    w(sp1)_outs = 0
  648    sp = sp+1
  649    p = 1
  650    %while p # testlim %cycle
  651      %if w(p)_flags >= 0 %start
  652        n_outs = w(p)_outs&v_outs
  653        %if n_outs # 0 %and p # q %start
  654          n_t = w(p)_t!v_t;  n_f = w(p)_f!v_f
  655          %if n_t&n_f = 0 %start
  656            np = np-1;  w(np) = n
  657            merge
  658            %exit %if w(sp1)_outs = v_outs
  659          %finish
  660        %finish
  661      %finish
  662      p = p+1
  663    %repeat
  664    needsp = sp
  665    sp = sp1
  666    %result = p
  667  %end
  668  
  669  %routine print all
  670  %integer p,q
  671    newlines(2)
  672    q = dclim;  q = esslim %if mon&2 # 0
  673    %while q # sp %cycle
  674      %if w(q)_flags >= 0 %start
  675        p = needed(q,sp)
  676        write(q,2) %if mon&4 # 0
  677        w(sp1)_outs = w(q)_outs-w(sp1)_outs
  678        print term(w(sp1),w(q)_outs)
  679      %finish
  680      q = q+1
  681    %repeat
  682    newline
  683  %end
  684  
  685  %routine pcount
  686    write(count>>12,1)
  687    printsymbol('/')
  688    out(count&4095)
  689  %end
  690  
  691  %routine promote(%integer q,past)
  692  %record(cell) v
  693    v = w(q)
  694    %if past = 0 %start
  695      count = count+bits(v_t!v_f)+4096
  696      past = esslim
  697      esslim = esslim+1
  698    %finish
  699    %while past # esslim %and past # dclim %cycle
  700      %exit %if w(past-1)_flags <= v_flags
  701      past = past-1
  702    %repeat
  703    %while q # past %cycle
  704      q = q-1
  705      w(q+1) = w(q)
  706    %repeat
  707    w(q) = v
  708  %end
  709  
  710  ! R e d u c e   n u m b e r   o f   i m p l i c a n t s
  711  !
  712  %routine reduce1
  713  ! Find first essentials and redundants
  714  !   order by weight
  715  %integer p,q
  716    q = dclim;  esslim = q
  717    %while q # sp %cycle
  718      w(q)_flags = bits(w(q)_t!w(q)_f)<<5+31-bits(w(q)_outs)
  719      p = needed(q,sp)
  720      %if p = sp %start;                  !essential
  721        promote(q,0)
  722      %finish %else %if p >= esslim %start; !optional
  723        promote(q,q)
  724      %finish %else %start;  !redundant
  725        erase(q)
  726        q = q-1
  727      %finish
  728      q = q+1
  729    %repeat
  730  %end; !reduce1
  731  
  732  %routine reduce2
  733  ! Find secondary essentials & redundants
  734  %integer p,q,bq,sphold,done
  735  %record(cell) v
  736  %cycle
  737    done = 1
  738    q = sp
  739    %while q # esslim %cycle
  740      q = q-1
  741      p = needed(q,esslim)
  742      %if p = esslim %start;              !not (simply) redundant
  743        w(q)_outs = w(q)_outs-w(sp1)_outs
  744        w(sp1)_outs = 0
  745        bq = w(q)_flags>>5
  746        sphold = sp
  747        %while p # sp %cycle
  748          %if w(p)_flags>>5-min < bq %and p # q %start
  749            v_outs = w(p)_outs&w(q)_outs
  750            %if v_outs # 0 %start
  751              v_t = w(p)_t!w(q)_t;  v_f = w(p)_f!w(q)_f
  752              %if v_t&v_f = 0 %start
  753                sp1 = sp;  sp = needsp
  754                %while sp1 # needsp %cycle
  755                  w(sp) = w(sp1)
  756                  sp = sp+1;  sp1 = sp1+1
  757                %repeat
  758                push(v)
  759                merge
  760                sp = sphold
  761                %exit %if w(sp1)_outs = w(q)_outs
  762              %finish
  763            %finish
  764          %finish
  765          p = p+1
  766        %repeat
  767      %finish
  768      %if p # sp %start;                  !redundant
  769        erase(q)
  770        p = p-1 %if p > q
  771        %if p >= esslim %start;           !P may now be essential
  772          %if needed(p,sp) = sp %start
  773            q = q+1 %if p >= q
  774            promote(p,0)
  775            done = 0
  776          %finish
  777        %finish
  778      %finish
  779    %repeat
  780  %repeat %until done # 0
  781  %end; !reduce2
  782  
  783  %routine order
  784  %integer j,k,p,q,r,poss,last
  785  %integerarray link(1:sp)
  786  %record(cell) v
  787    q = sp;  poss = 0;  last = sp
  788    %while q # esslim %cycle
  789      q = q-1
  790      p = needed(q,sp)
  791      link(q) = p
  792      %if p > q %and link(p) > p %start
  793        poss = poss+1
  794        poss = poss+99 %if q # last
  795        v = w(p);  !promote P before Q
  796        r = sp
  797        %cycle
  798          r = r-1
  799          j = link(r)
  800          %if j = p %then j = q %else %if q <= j < p %then j = j+1
  801          %if r >= p %then %start
  802            link(r) = j
  803          %finish %else %start
  804            link(r+1) = j
  805            w(r+1) = w(r)
  806          %finish
  807        %repeat %until r = q
  808        w(r) = v
  809        q = q+2;  last = q-1;  !try Q again
  810      %finish
  811    %repeat
  812    write(poss,1)
  813  !First pass
  814    %cycle
  815      v = w(q)
  816      v_flags = v_flags>>5
  817      p = needed(q,sp)
  818      %if p > q %start
  819        count = count+v_flags+4096
  820        w(q)_flags = v_flags+count<<5
  821      %finish %else %start
  822        %cycle
  823          p = p+1
  824        %repeat %until w(p)_flags >= 0
  825        r = q
  826        %while r # p %cycle
  827          r = r-1
  828          w(r+1) = w(r)
  829        %repeat
  830        v_flags = w(r-1)_flags&16_0FFFFFE0+v_flags+sign
  831        w(r) = v
  832      %finish
  833      q = q+1
  834    %repeat %until q = sp
  835  %end;
?K unused
  836       ; !order
  836  
  837  ! F i n d   m i n i m a l   s e l e c t i o n
  838  !
  839  %routine minimise
  840  ! Find minimal selection
  841  %integer k,p,q,m
  842    q = sp
  843    %cycle
  844      %while q # sp %cycle
  845        m = w(q)_flags
  846        p = needed(q,sp)
  847        %if p = sp %start;                !mandatory
  848          m = m+forced
  849        %finish %else %start;             !optional or redundant
  850          m = m+(sign+forced) %if p < q;  !redundant
  851        %finish
  852        %if m >= 0 %start;            !selected
  853          k = m&31+count+4096
  854          %exit %if k+inc > aim
  855          %exit %if k+inc > m>>5&16_7FFFFF
  856          count = k
  857        %finish
  858        w(q)_flags = m
  859        q = q+1
  860      %repeat
  861      %if q = sp %start;                  !scan completed successfully
  862        pcount
  863        printall %if inc = 0 %or mon&1 # 0
  864        aim = count
  865        q = esslim
  866        %while q # sp %cycle;             !save marker bits
  867          k = w(q)_flags&16_cfffffff
  868          w(q)_flags = (k&16_c0000000)>>2+k
  869          q = q+1
  870        %repeat
  871      %finish
  872      %cycle;                             !scan backward to de-select
  873        %if q = esslim %start;            !scan completed
  874          %while q # sp %cycle;           !restore marker bits
  875            k = w(q)_flags&16_3fffffff
  876            w(q)_flags = (k&16_30000000)<<2+k
  877            q = q+1
  878          %repeat
  879          %return %if inc <= min;         !all done
  880          count = aim;                    !restore count
  881          inc = inc>>1
  882          print all %if inc = 0
  883        %finish
  884        q = q-1
  885        m = w(q)_flags
  886        w(q)_flags = m&16_3fffffff
  887        %if m >= 0 %start
  888          k = m&31+4096
  889          count = count-k
  890          %exit %if m&forced = 0
  891        %finish
  892      %repeat
  893      w(q)_flags = w(q)_flags+sign
  894      q = q+1
  895    %repeat
  896  %end; !minimise
  897  
  898  %begin {initialise}
  899  %string(255)in1=":N",in2=":N",in3,out=":T"
  900  %integer bools=16_05000000{single,equin}
  901  
  902    %routine init(%integername n)
  903      n = 1 %if bools<0; bools = bools<<1
  904    %end
  905  
  906    defineparam("Input file",in3,pamnodefault)
  907    defineparam("Input 2",in2,0)
  908    defineparam("Input 3",in1,0)
  909    defineparam("Output file",out,pamnewgroup)
  910    defineintparam("MIN",min,0)
  911    defineintparam("INC",inc,0)
  912    defineintparam("MON",mon,0)
  913    definebooleanparams("ECho,SQuash,NIn,NOut,Check,SIngle,Tabin,EQuin",bools,0)
  914    processparameters(cliparam)
  915    init(echo)
  916    init(squash)
  917    init(nin)
  918    init(nout)
  919    init(check)
  920    init(single)
  921    init(tabin)
  922    tabin = 0 %if bools<0 {equin}
  923    openinput(instream-2,in3)
  924    openinput(instream-1,in2)
  925    openinput(instream,in1)
  926    openoutput(outstream,out)
  927  %end
  928  
  929  select output(outstream)
  930  select input(instream)
  931  %cycle
  932    start = cputime
  933    readin
  934    printstring("Read in:")
  935    print time
  936    newline
  937    convert
  938    aim = 999999;  count = 0
  939    printstring("Implicants:")
  940    write(sp-dclim,3)
  941    print time
  942    newline
  943    print all %if inc#0 %and mon&16#0
  944    reduce1
  945    printstring("Reduced(1):")
  946    write(sp-dclim,3)
  947    printstring(" (nucleus")
  948    pcount
  949    printsymbol(')')
  950    print time
  951    newline
  952    print all %if inc # 0 %and mon&16#0
  953    %if sp # esslim %start
  954      reduce2
  955      printstring("Reduced(2):")
  956      write(sp-dclim,3)
  957      printstring(" (nucleus")
  958      pcount
  959      printsymbol(')')
  960      order %if sp # esslim
  961      print time
  962      newline
  963      print all %if inc # 0 %and mon&16#0
  964    %finish
  965    monitor(esslim) %if mon&2 # 0
  966    %if sp # esslim %start
  967      monitor(sp) %if mon&8 # 0
  968      printstring("Minimised:")
  969      minimise
  970    %finish
  971    print all %if inc # 0 %and mon&1 = 0
  972    printstring("  Cells used:")
  973    write(storebound-1-minsep,1)
  974    print time
  975    newline
  976  %repeat
  977  
  978  %endofprogram

  935 Statements compiled
