! SWRAP:
! This program replaces programs ONE to FIVE of the BEPI-supplied suite.
! It takes as input the ".CPL", ".NET", ".PAG", and ".CRD" files relating
! to a design, and produces as output the ".DAT" file required by BEPI's
! programs SIX to EIGHT.
! In addition, this program produces documentation files similar to those
! generated by BEPI programs STRING, SIGNAL, and FROMTO.
! RWT August 1986, revised February 1989.

%include "inc:util.imp"
%begin

! Internal data structures

%recordformatspec compf
%recordformatspec netf
%recordformat pinf -
  (%record(pinf)%name next,prev,      {double links for pins within net}
                      nextofcomp,     {single link for pins within component}
   %record(netf)%name net,            {the net involving this pin}
   %record(compf)%name comp,          {the component containing this pin}
   %string(*)%name pinname,           {pin's textual name}
   %integer row,col,colpair)          {board position of pin}

%recordformat compf -
  (%record(compf)%name next,          {next component in circuit}
   %record(pinf)%name pins,           {head of list of pins}
   %string(*)%name compname)          {component's name}

%recordformat netf -
  (%record(netf)%name next,           {next net in circuit}
   %record(pinf)%name beg,end,        {head and tail of pin list}
   %integer netnumber,                {for stringlist/signal list cross ref
   %string(*)%name netname)           {net's signal name}

! Program parameters

%string(255)filename=""
%string(255)title
%integer maxcol=60,maxrow=150
%constinteger -
  nsortflag=1<<31,
  psortflag=1<<30,
  dsortflag=1<<29,
  documflag=1<<28
%integer bools=nsortflag+psortflag+dsortflag+documflag

%routine acquire parameters
  defineparam("Filename",filename,pammajor+pamnodefault)
  defineintparam("COLumns",maxcol,0)
  defineintparam("ROWs",maxrow,0)
  definebooleanparams("NETsort,PAGsort,DEADsort,DOC",bools,0)
  processparameters(cliparam)
%end

%routine reading(%string(5)ext)
  printstring("Reading ".filename.ext)
  openinput(1,filename.ext); selectinput(1)
%end

%routine writing(%string(5)ext)
  selectoutput(0); printstring("Writing ".filename.ext)
  openoutput(1,filename.ext); selectoutput(1)
%end

! String dictionary
! This consists of a primary hash table with simple
! unsorted linked lists hanging off each entry.

%constinteger hashmask=63
%recordformat hashf(%record(hashf)%name next,%string(255)s)
%record(hashf)%namearray hashtab(0:hashmask)

%string(*)%map storestring(%string(255)%name s)
! Stores string S in the dictionary, if not already there.
! Returns a reference to where it is stored.
%record(hashf)%name h
%integer value=0,i
  %for i = 1,1,length(s) %cycle
    value = value<<1+(charno(s,i)!32)
  %repeat
  value = value&hashmask
  h == hashtab(value)
  %cycle
    %if h==nil %start
      h == record(heapget(sizeof(h)-255+length(s)))
      h_s = s; h_next == hashtab(value)
      hashtab(value) == h
      %result == h_s
    %finish
    %result == h_s %if h_s=s
    h == h_next
  %repeat
%end

%routine setup hash table
%integer i
  hashtab(i) == nil %for i = 0,1,hashmask
%end

! The Array of column X-coordinates

%integerarray colpos(1:maxcol)

%routine read crd file   {fill COLPOS array and reduce MAXCOL}
%integer i
  %routine check
  %integer d,i
    newline
    closeinput
    printstring("Number of columns is odd") %and newline %if maxcol&1#0
    i = 2
    %while i<=maxcol %cycle
      d = colpos(i)-colpos(i-1)
      %if (i&1=0 %and d#3) %or (i&1#0 %and d<2) %start
        printstring("Columns"); write(i-1,1)
        printstring(" and"); write(i,1); printstring(" are spaced")
        write(d,1); printstring(" units"); newline
      %finish
      i = i+1
    %repeat
  %end
  %onevent 9 %start
    maxcol = i-1
    check
    %return
  %finish
  reading(".crd")
  %for i = 1,1,maxcol %cycle
    read(colpos(i)); skipsymbol
  %repeat
  check
%end

! Reverse arbitrary singly-linked list

%record(*)%map reverse(%record(*)%name list)
%recordformat f(%record(f)%name next)
%record(f)%name head,tail,temp
  head == list; tail == nil; %result == nil %if list==nil
  %cycle
    temp==head; head==temp_next; temp_next==tail; tail==temp
  %repeatuntil head==nil
  %result==tail
%end

! Convert between column number and X coordinate
! BTW, the coordinate system unit is the tenth of an inch.
! This makes the Y coordinates the same as the row numbers.

%integerfn column(%integer x)
! Result negative if "extended", zero if invalid.
%integer i
  %for i = 1,1,maxcol %cycle
    %result = i %if colpos(i)=x
    %if i&1=0 %start
      %result = -i %if colpos(i)+1=x
    %else
      %result = -i %if colpos(i)-1=x
    %finish
  %repeat
  %result = 0
%end

%integerfn xpos(%integer c)
  %if c<0 %start
    c = -c
    %result = colpos(c)+1 %if c&1=0
    %result = colpos(c)-1
  %finish
  %result = colpos(c)
%end

! MAIN PROGRAM starts here

  setup hash table
  acquire parameters
  toupper(filename)
  title = "BEPI Solderwrap design '".filename."' processed ".datetime
  read crd file
  
%begin    {nested block for dynamic array}
%record(pinf)%array pin(1:maxrow,1:maxcol)
%record(compf)%name complist==nil
%record(netf)%name netlist==nil,paglist==nil
%integer c,r

%routine read cpl file     {and reduce MAXROW}
%string(255)s
%record(compf)%name c
%record(pinf)%name p
%integer x,y,col,toprow=0
%string(*)%name compname,pinname
  %onevent 9 %start
    newline
    closeinput
    complist == reverse(complist)
    maxrow = toprow
    %return
  %finish
  reading(".cpl")
  %cycle
    read(s); compname == storestring(s)
    read(s); pinname == storestring(s)
    read(x); x = x//100    {convert .CPL standard unit (thousandths)}
    read(y); y = y//100    {to internal standard units (tenths)}
    col = column(x)
    %if col=0 %start
      printstring("Bad X value"); write(x,1); printstring("00 for ")
      printstring(compname); space
      printstring(pinname); newline
    %finish
    %unless 1<=y<=maxrow %start
      printstring("Bad Y value"); write(y,1); printstring("00 for ")
      printstring(compname); space
      printstring(pinname); newline
    %finish
    toprow = y %if y>toprow
    c == complist
    c == c_next %while c##nil %and c_compname##compname
    %if c==nil %start
      c == new(c); c_next == complist; complist == c
      c_compname == compname; c_pins == nil
    %finish
    p == pin(y,|col|)
    %if p_comp==nil %start
      p_net == nil; p_next == nil; p_prev == nil
      p_comp == c; p_nextofcomp == c_pins; c_pins == p
      p_pinname == pinname; p_row = y; p_col = col
      p_colpair = (|col|+1)>>1<<1
    %else
      printstring("Duplicate pin at col"); write(|col|,1)
      printstring(" row"); write(y,1); printstring(" for ")
      printstring(compname); space
      printstring(pinname); newline
    %finish
  %repeat
%end

%routine generate backlinks(%record(netf)%name n)
%record(pinf)%name p
  p == n_beg
  %while p_next##nil %cycle
    p_next_prev == p
    p == p_next
  %repeat
  n_end == p
%end

%routine generate all backlinks(%record(netf)%name n)
  %while n##nil %cycle
    generate backlinks(n)
    n == n_next
  %repeat
%end

%record(netf)%map read netlist
%string(*)%name netname,compname,pinname
%string(255)s,t
%record(compf)%name c
%record(pinf)%name p
%record(netf)%name nets==nil,n

  %record(netf)%map purge(%record(netf)%name n)
  ! Remove from the list nets involving only one point
  %record(netf)%name prev==nil,this==n
    %cycle
      %if this==nil %start
        %result == nil %if prev==nil
        prev_next == nil
        %result == n
      %finish
      %if this_beg==this_end %start
        printstring("Degenerate net ".this_netname." ignored"); newline
      %else
        %if prev==nil %then n == this %else prev_next == this
        prev == this
      %finish
      this == this_next
    %repeat
  %end

  %on 9 %start
    newline
    closeinput
    generate all backlinks(nets)
    %result == purge(nets)
  %finish
  %cycle
    read(s); netname == storestring(s)
    n == nets
    n == n_next %while n##nil %and n_netname##netname
    %if n==nil %start
      n == new(n); n_next == nets; nets == n
      n_beg == nil; n_end == nil; n_netname == netname
    %finish
    %cycle
      read(s)
      read(t) %unless s -> s.("-").t
      compname == storestring(s)
      pinname == storestring(t)
      c == complist
      c == c_next %while c##nil %and c_compname##compname
      %if c==nil %start
        printstring("Unknown component ".compname); newline
      %else
        p == c_pins
        p == p_nextofcomp %while p##nil %and p_pinname##pinname
        %if p==nil %start
          printstring("Unknown pin ".pinname)
          printstring(" on ".compname); newline
        %else
        p_next == n_beg; n_beg == p
        p_net == n
        %finish
      %finish
      skipsymbol %while nextsymbol=' '
    %repeatuntil nextsymbol=nl
  %repeat
%end

%routine scansort(%record(netf)%name n)

! Sort every net in list N into a simple path in which each
! column pair is scanned either top to bottom or bottom to top.

%record(netf)m
%record(pinf)%name from,lowest,highest
%integer thresh

%routine goto(%record(pinf)%name p)
! Route to pin P by transferring it from net N to net M.
! Output appropriate line to .NET/.PAG file.

  %predicate head
    %if p_prev==nil %or n_beg==p %start
      %trueif p_prev==nil %and n_beg==p
      printstring("Inconsistent head"); newline
      %true
    %finish
    %false
  %end

  %predicate tail
    %if p_next==nil %or n_end==p %start
      %trueif p_next==nil %and n_end==p
      printstring("Inconsistent tail"); newline
      %true
    %finish
    %false
  %end

  %if head %start
    %if tail %start
      n_beg == nil; n_end == nil
    %else
      p_next_prev == nil; n_beg == p_next
    %finish
  %elseif tail
    p_prev_next == nil; n_end == p_prev
  %else
    p_next_prev == p_prev; p_prev_next == p_next
  %finish
  p_next == nil
  %if m_end==nil %or m_beg==nil %start
    %unless m_end==nil %and m_beg==nil %start
      printstring("Inconsistent empty list"); newline
    %finish
    m_end == p; m_beg == p
    p_prev == nil
  %else
    p_prev == m_end; m_end_next == p; m_end == p
  %finish
  from == p
%end

%record(pinf)%map lowest col (%integer thresh)
! Return the pin with the lowest column pair number in net N
! which exceeds THRESH, NIL if none.
%record(pinf)%name lowest==nil, p == n_beg
%integer lowestcol=maxint
  %cycle
    %result == lowest %if p==nil
    %if thresh<p_colpair<lowestcol %start
      lowestcol = p_colpair; lowest == p
    %finish
    p == p_next
  %repeat
%end

%record(pinf)%map lowest row(%integer colpair)
! Return the pin with the lowest row number in the specified column pair.
%record(pinf)%name lowest==nil, p == n_beg
%integer lowestrow=maxint
  %cycle
    %result == lowest %if p==nil
    %if p_colpair=colpair %start
      %if p_row<lowestrow %start
        lowestrow = p_row; lowest == p
      %elseif p_row=lowestrow
        lowest == p %if |p_col|<|lowest_col|
      %finish
    %finish
    p == p_next
  %repeat
%end

%record(pinf)%map highest row(%integer colpair)
%record(pinf)%name highest==nil, p == n_beg
%integer highestrow=0
  %cycle
    %result == highest %if p==nil
    %if p_colpair=colpair %start
      %if p_row>highestrow %start
        highestrow = p_row; highest == p
      %elseif p_row=highestrow
        highest == p %if |p_col|>|highest_col|
      %finish
    %finish
    p == p_next
  %repeat
%end

%integerfn distance(%record(pinf)%name p1,p2)
! Manhattan distance in tenths, biased for inter-col penalties
%constinteger penalty=3
%integer c1,c2
  %result = 0 %if p1==nil %or p2==nil
  c1 = p1_colpair; c2 = p2_colpair
  %result = (|c2-c1|)>>1*penalty + |colpos(c1)-colpos(c2)| + |p1_row-p2_row|
%end

%record(pinf)%map prox(%record(pinf)%name p)
! Return whichever of the lowest or highest pin in the NEXT
! column pair is closest to P.
%record(pinf)%name l,h
  l == lowestcol(thresh); %result == nil %if l==nil
  h == highestrow(l_colpair)
  l == lowestrow(l_colpair)
  %result == l %if distance(l,p)<=distance(h,p)
  %result == h
%end

! Main part of SCANSORT

  %while n##nil %cycle
    m = 0; from == nil
    %if n_beg==n_end %or n_beg_next==n_end %start {1 or 2 point net}
      goto(n_beg); goto(n_beg) %unless n_beg==nil
    %else
      thresh = 0
      %cycle
        lowest == lowestcol(thresh); %exitif lowest==nil
        thresh = lowest_colpair
        lowest == lowest row(thresh)
        highest == highest row(thresh)
        %if (from==nil %and -
             distance(lowest,prox(lowest)) < distance(highest,prox(highest))) -
        %or (from##nil %and -
             distance(from,highest) < distance(from,lowest)) %start
          %cycle
            goto(highest); %exitif lowest==highest
            highest == highestrow(thresh)
          %repeat
        %else
          %cycle
            goto(lowest); %exitif lowest==highest
            lowest == lowestrow(thresh)
          %repeat
        %finish
      %repeat
    %finish
    n_beg == m_beg; n_end == m_end
    n == n_next; %exitif n==nil
  %repeat
%end

%routine deadsort

! Re-order complete nets such as to minimise the length of
! "dead" wire between nets.

%record(netf)%map sort(%record(netf)%name nets)
%integer x=0,y=0
%record(netf)%name sorted==nil

  %routine find nearest
  ! Locate net whose beginning or end is nearest point (X,Y).
  ! Reverse that net if necessary to that its beginning is nearest.
  ! Remove the net from NETS and add it to SORTED.
  ! Update global X and Y.
  %record(netf)%name this==nets,prev==nil,best,pred
  %integer atend=0,bestdif=maxint,thisdif

    %integerfn dif(%record(pinf)%name p)
    ! Manhattan distance between pin P and point (X,Y)
    %integer px,py
      py = p_row
      px = xpos(p_col)
      %result = |py-y|+|px-x|
    %end

    %while this##nil %cycle
      thisdif = dif(this_beg)
      %if thisdif<=bestdif %start
        bestdif = thisdif; atend = 0; best == this; pred == prev
      %finish
      thisdif = dif(this_end)
      %if thisdif<bestdif %start
        bestdif = thisdif; atend = 1; best == this; pred == prev
      %finish
      prev == this
      this == this_next
    %repeat
    %if pred==nil %then nets == best_next %else pred_next == best_next
    %unless atend=0 %start
      best_beg == reverse(best_beg)
      generate backlinks(best)
    %finish
    x = xpos(best_end_col); y = best_end_row
    best_next == sorted; sorted == best
  %end

  find nearest %while nets##nil
  %result == reverse(sorted)
%end

  netlist == sort(netlist)
  paglist == sort(paglist)
%end

%routine write dat file
%conststring(3)%array flags(0:3)=""," $"," !"," #"
%constinteger normal=0,extcode=1,stopcode=2
  %routine go(%record(netf)%name n,%integer code)
  %record(pinf)%name p
  %owninteger num=0
  %integer col
    %while n##nil %cycle
      p == n_beg
      num = num+1; n_netnumber = num
      %while p##nil %cycle
        col = p_col; code = code!extcode %and col = -col %if col<0
        %if p==n_beg %or p==n_end %then write(-num,4) %else write(num,4)
        write(col,4); write(p_row,4); printstring(flags(code))
        newline
        code = normal
        p == p_next
      %repeat
      n == n_next
    %repeat
  %end
  writing(".dat")
  printstring(title); newline
  go(netlist,normal)
  go(paglist,stopcode)
  printstring("    0    0    0"); newline
  printstring("    0    0    0"); newline
  closeoutput; selectoutput(0); newline
%end

%routine put(%string(*)%name s,%integer field)
  printstring(s); spaces(field-length(s))
%end

%routine write stl file   {and join nets together for from to list}
%record(netf)%name n

  %routine print pin(%record(netf)%name n,%record(pinf)%name p)
  %constinteger ff=12,lpp=64
  %owninteger lines=0,pageno=0
    %if lines=0 %start
      printsymbol(ff) %unless pageno=0; pageno = pageno+1
      newline; printstring("                  String list - page")
      write(pageno,1); newlines(2)
      printstring(title); newlines(2)
      printstring("Number  Signal              Device")
      printstring("   Pin      Column Row"); newlines(2)
      lines = lpp-7
    %finish
    write(n_netnumber,4); spaces(3); put(n_netname,20)
    put(p_comp_compname,11); put(p_pinname,9)
    write(p_col,3); write(p_row,3); newline; lines = lines-1
    %if p==n_end %start
      newline; lines = lines-1
      lines = 0 %if lines<3
    %finish
  %end

  %routine print nets(%record(netf)%name n)
  %record(pinf)%name p
    %while n##nil %cycle
      p == n_beg
      %cycle
        print pin(n,p)
        %exitif p==n_end
        p == p_next
      %repeat
      n == n_next
      %unless n==nil %start
        p_next == n_beg
        n_beg_prev == p
      %finish
    %repeat
  %end

  writing(".stl")
  print nets(netlist)
  print nets(paglist)
  closeoutput; selectoutput(0); newline
%end

%routine write sgl file

%routine sort and print(%record(netf)%name n)
%recordformat tf(%record(tf)%name l,r,%record(netf)%name n)
%record(tf)%name tree==nil,leaf,cell
%record(netf)%name sorted==nil

  %integerfn dif(%string(*)%name a,b)
  ! Returns -1/0/1 if a<b/a=b/a>b
  %integer pa=1,pb=1,na,nb
    %cycle
      %if pa>length(a) %start
        %result = 0 %if pb>length(b)
        %result = -1
      %finish
      %result = 1 %if pb>length(b)
      na = charno(a,pa)-'0'; pa = pa+1
      nb = charno(b,pb)-'0'; pb = pb+1
      %if 0<=na<=9 %and 0<=nb<=9 %start
        na = na*10+charno(a,pa)-'0' %and pa = pa+1 -
          %while pa<=length(a) %and '0'<=charno(a,pa)<='9'
        nb = nb*10+charno(b,pb)-'0' %and pb = pb+1 -
          %while pb<=length(b) %and '0'<=charno(b,pb)<='9'
      %finish
      %result = na-nb %unless na=nb
    %repeat
  %end

  %routine print pin(%record(netf)%name n,%record(pinf)%name p)
  %constinteger ff=12,lpp=64
  %owninteger lines=0,pageno=0
    %if lines=0 %start
      printsymbol(ff) %unless pageno=0; pageno = pageno+1
      newline; printstring("                  Signal list - page")
      write(pageno,1); newlines(2)
      printstring(title); newlines(2)
      printstring("Number  Signal              Device")
      printstring("   Pin      Column Row"); newlines(2)
      lines = lpp-7
    %finish
    write(n_netnumber,4); spaces(3); put(n_netname,20)
    put(p_comp_compname,11); put(p_pinname,9)
    write(p_col,3); write(p_row,3); newline; lines = lines-1
    %if p==n_end %start
      newline; lines = lines-1
      lines = 0 %if lines<3
    %finish
  %end

  %routine print net(%record(netf)%name n)
  %record(pinf)%name p
    p == n_beg
    %cycle
      print pin(n,p)
      %exitif p==n_end
      p == p_next
    %repeat
  %end

  %routine print(%record(tf)%name t)
    %returnif t==nil
    print(t_l)
    printnet(t_n)
    print(t_r)
  %end

  %while n##nil %cycle
    leaf == new(leaf); leaf_l == nil; leaf_r == nil; leaf_n == n
    %if tree==nil %then tree==leaf %elsestart
      cell == tree
      %cycle
        %if dif(n_netname,cell_n_netname)<0 %start
          cell_l == leaf %andexitif cell_l==nil
          cell == cell_l
        %else
          cell_r == leaf %andexitif cell_r==nil
          cell == cell_r
        %finish
      %repeat
    %finish
    n == n_next
  %repeat
  print(tree)
%end

  writing(".sgl")
  sort and print(netlist)
  sort and print(paglist)
  closeoutput; selectoutput(0); newline
%end

%routine write ftl file
%record(pinf)%name p
%integer r,c

  %routine start line
  %constinteger ff=12,lpp=64
  %owninteger lines=0,pageno=0
    %if lines=0 %start
      printsymbol(ff) %unless pageno=0; pageno = pageno+1
      newline; printstring("                  From To list - page")
      write(pageno,1); newlines(2)
      printstring(title); newlines(2)
      printstring("     From       Connection     To      ")
      printstring(" String   Signal     Device   Pin"); newlines(2)
      lines = lpp-7
    %finish
    lines = lines-1
  %end

  %routine show(%record(pinf)%name p)
  %record(netf)%name n
    %if p==nil %start
      printstring(" * WIRE END *")
    %else
      write(p_col,3); printsymbol('-')
      write(p_row,3); printstring(" (")
      n == p_net
      %if n==nil %or n_beg==n_end %then printsymbol('*') -
      %elseif p==n_beg %then printsymbol('B') -
      %elseif p==n_end %then printsymbol('E') -
      %else printsymbol('M')
      printstring(")")
    %finish
  %end

  writing(".ftl")
  %for c = 1,1,maxcol %cycle
    %for r = 1,1,maxrow %cycle
      p == pin(r,c); %continueif p_comp==nil
      start line
      %if p_net==nil %start
        printstring(" unconnected ")
        show(p)
        printstring(" unconnected           --unused-- ")
      %elseif p_prev==nil %and p_next==nil
        printstring(" unconnected ")
        show(p)
        printstring(" unconnected ")
        spaces(10); put(p_net_netname,11)
      %else
        show(p_prev); show(p); show(p_next)
        write(p_net_netnumber,4)
        spaces(5); put(p_net_netname,11)
      %finish
      put(p_comp_compname,9); printstring(p_pinname); newline
    %repeat
  %repeat
  closeoutput; selectoutput(0); newline
%end

! MAIN PROGRAM nested block starts here

  %for c = 1,1,maxcol %cycle
    pin(r,c)_comp == nil %for r = 1,1,maxrow
  %repeat
  read cpl file
  reading(".net"); netlist == read netlist
  reading(".pag"); paglist == read netlist
  %unless bools&nsortflag=0 %start
    printstring("Sorting signal nets")
    scansort(netlist)
    newline
  %finish
  %unless bools&psortflag=0 %start
    printstring("Sorting power nets")
    scansort(paglist)
    newline
  %finish
  %unless bools&dsortflag=0 %start
    printstring("Sorting between nets")
    deadsort
    newline
  %finish
  write dat file
  %returnif bools&documflag=0
  write stl file    {side-effect of joining nets for FTL}
  write ftl file
  write sgl file
%end

%endofprogram