! WWRAP: Produce a wire-wrap list from CPL, NET, PAG files,
! which have been produced by SDA or some other source.
! The NET and PAG filess will already be in wiring order,
! so no sorting is needed here.
! A wrap-count check list is also generated.
! RWT March 1990

%begin

%externalintegerfnspec heapget(%integer n)
%externalintegerfnspec stoi(%string(255)s)
%externalstring(255)%fnspec itos(%integer n,p)

! String processing

%integerfn encode(%string(255)s)

! The string S is converted into a 32-bit number, which is
! used in subsequent processing instead of the string itself.
! The string is stored on the heap and accessed via a linear
! list hung off a hash table.  The value returned is the
! address of the string (this is assumed to be positive).
! Special cases:  The null string is encoded as the value 0;
! strings which are decimal representations of non-negative
! numbers are encoded as -N-1.

%constinteger hashmax=32
%recordformat hr(%record(hr)%name next,%string(*)%name s)
%ownrecord(hr)%namearray hashtable(0:hashmax-1)
%owninteger initialised=0
%integer h,n,i,num
%bytename k
%record(hr)%name rec

  %string(*)%map newstring(%string(255)s)
! Allocate just enough heap space to hold S, and copy it in.
  %string(*)%name n
  %ownstring(1)nil = ""
    %result == nil %if s=""
    n == string(heapget(length(s)+1))
    n = s
    %result == n
  %end

  %result = 0 %if s=""
  h = 0; n = 0; i = 1; num = 1
  %cycle
    k == charno(s,i)
    k = k-32 %if k>='a'
    h = h+h+k
    %if num#0 %start
      num = 0 %unless 0<=k-'0'<=9
      %if num#0 %start
        num = 0 %if n<=-3276 %or (n=-3276 %and k>'7')
        n = n*10-k+'0' %if num#0
      %finish
    %finish
    i = i+1
  %repeatuntil i>length(s)
  %result = n-1 %unless num=0
  %if initialised=0 %start
    initialised = 1
    hashtable(i) == nil %for i = 0,1,hashmax-1
  %finish
  h = h&(hashmax-1); n = 0; rec == hashtable(h)
  %while rec##nil %cycle
    %result = addr(rec_s) %if rec_s=s
    rec == rec_next
  %repeat
  rec == new(rec)
  rec_s == newstring(s)
  rec_next == hashtable(h); hashtable(h) == rec
  %result = addr(rec_s)
%end

%string(255)%fn decode(%integer n)

! Reconstitute a string from its encoded value.

%string(255)s
  s = ""
  %if n<0 %start
    s = itos(-1-n,0)
  %elseif n>0
    s = string(n)
  %finish
  %result = s
%end

%recordformat pinfm -
  (%record(pinfm)%name next,%integer name,%byte x,y)
%recordformat compfm -
  (%record(compfm)%name next,%integer name,%record(pinfm)%name pins)

%record(compfm)%name comps == nil
%integer minx=256,miny=256,maxx=0,maxy=0,xcols=0,ycols=0
%bytearray xflag,yflag(0:255)
%bytearray hole(0:255,0:255)
{HOLE array could be packed, only 2-bit values used:}
{0: no pin in hole, 1/2/3: no/one/two wraps on pin}

%on 3 %start
  selectoutput(0)
  printstring(event_message); newline
  %stop
%finish

%begin {set up hole matrix as blank, read CPL file}
%option "-nons" {array = 0}
%integer n=0,x,y,prev,this,pin
%record(compfm)%name c==nil
%record(pinfm)%name p
%string(255)s
  %on 9 %start
    %returnif prev=0
    printstring(" components"); newline
    %return
  %finish
  hole = 0; xflag = 0; yflag = 0
  prev = 0
  openinput(1,cliparam.".cpl")
  %cycle
    read(s); this = encode(s)   {component name}
    %unless this=prev %start
      prev = this; c == new(c)
      c_name = this; c_pins == nil; c_next == comps; comps == c
      n = n+1; printsymbol(13); write(n,0)
    %finish
    read(s); this = encode(s)   {pin name}
    read(x); read(y)            {pin coords}
    x = x//100; y = y//100
    hole(x,y) = 1
    xcols = xcols+1 %if xflag(x)=0; xflag(x) = 1
    minx = x %if x<minx; maxx = x %if x>maxx
    ycols = ycols+1 %if yflag(y)=0; yflag(y) = 1
    miny = y %if y<miny; maxy = y %if y>maxy
    p == new(p); p_name = this; p_x = x; p_y = y
    p_next == c_pins; c_pins == p
  %repeat
%end

%begin {process net lists}
%integer n=0

%routine process(%string(5)ext)
! Process either the .NET file or the .PAG file.
%recordformat qfm(%integer c,p,x,y)
%record(qfm)q1,q2,q3,null
%record(compfm)%name c
%record(pinfm)%name p
%string(255)s,t
%integer prev=0,this

  %routine add(%record(qfm)%name q3)
  ! Add a node to the current net.  Q3==NULL (actually Q3_C=0) is used
  ! to separate nets, and hence flush out pending wires.  A two-node
  ! buffer (P1 and P2) is used in conjunction with the incoming node P3
  ! to achieve the appropriate wiring order.
    %integerfn show(%record(qfm)%name q)
    ! Show coordinates, whether 1st or 2nd wrap, comp- and pin-name.
    ! Result depends on lengths of names, used for later formatting.
    %string(255)c,p
    %bytename b
      b == hole(q_x,q_y)
      write(q_x,4); write(q_y,3); write(b,2)
      %if b=1 %then printstring("st  ") %else-
      %if b=2 %then printstring("nd  ") %else-
      %if b=3 %then printstring("rd??") -
              %else printstring("th??")
      b = b+1
      c = decode(q_c); p = decode(q_p)
      spaces(4); printstring(c); printsymbol('-'); printstring(p)
      %result = length(c)+length(p)
    %end
    %routine do(%record(qfm)%name from,to)
    ! Wire from node FROM to TO (unless either of them has _C=0).
    ! Also show wire length (both Manhattan and semi-diagonal).
    %constinteger sizes=9
    %constrealarray size(1:sizes)=-
      1.0, 1.9, 3.1, 4.0, 4.9, 6.1, 7.0, 7.9, 9.1
    %integer dx,dy,min,max,i
    %real manhattan,diagonal,crow,next
      %returnif from_c=0 %or to_c=0
      dx = |from_x-to_x|
      dy = |from_y-to_y|
!     min = dx; min = dy %if dy<min; max = dx+dy-min
!     manhattan = (dx+dy)/10+0.1
!     diagonal = (min*1.4142+(max-min))/10+0.1
      crow = sqrt(dx*dx+dy*dy)/10
      next = 0
      %for i = 1,1,sizes %cycle
        next = size(i) %andexitif size(i)>=crow+0.4
      %repeat
      print(next,2,1); printstring("""    ")
      i = show(from); newline
      print(crow,2,2); printstring("""   ")
      i = show(to); newline
      newline
    %end
! For nets with an odd number of pins one end will always be BB and the
! other BT, so both methods do the same.  The two methods differ for nets
! with an even number of pins.  Method 1 will begin and end with BT, while
! method 2 will begin and end with BB.
! Method 1:
!   %if q1_c=0 %start
!     q1 = q2
!   %else
!     do(q3,q2); do(q2,q1)
!     q1 = null
!   %finish
!   q2 = q3
! Method 2:
    %if q3_c=0 %start
      do(q1,q2); q1 = null; q2 = null
    %elseif q1_c=0
      q2 = q3 %and q3 = null %if q2_c=0
      q1 = q2; q2 = q3
    %else
      do(q2,q3); do(q1,q2); do(q1,q3) %if q2_c=0
      q2 = q3; q1 = null
    %finish
  %end

  %on 9 %start
    add(null)
    %return
  %finish
  q1 = 0; q2 = 0; null = 0
  openinput(1,cliparam.ext)
  %cycle
    read(s); this = encode(s)
    %unless this=prev %start
      selectoutput(0); n = n+1; printsymbol(13); write(n,0)
      selectoutput(1)
      %unless prev=0 %start
        add(null)
      %finish
      printstring("        Net  "); printstring(s); newlines(2)
      prev = this
    %finish
    read(s); s -> s.("-").t
    q3_c = encode(s); q3_p = encode(t)
    c == comps
    %cycle
{}selectoutput(0) %and printstring(s;"-";t) %and newline %and-
      %signal 15,1,,"Component not found" %if c==nil
      %exitif c_name=q3_c
      c == c_next
    %repeat
    p == c_pins
    %cycle
{}selectoutput(0) %and printstring(s;"-";t) %and newline %and-
      %signal 15,2,,"Pin not found" %if p==nil
      %exitif p_name=q3_p
      p == p_next
    %repeat
    q3_x = p_x; q3_y = p_y
    add(q3)
  %repeat
%end
  openoutput(1,cliparam.".rap")
  printstring("Wire wrapping list for """.cliparam.""""); newlines(2)
  process(".net")
  process(".pag")
  closeoutput
  selectoutput(0); printstring(" nets"); newline
%end

%begin {generate checklist}
%integer batches,items,left,right,wraps=0
%ownintegerarray pins(0:3)=0(*)

  %routine scan(%integer min,max)
  %integer x,y,z
    printstring("   X"); write(min,6)
    printstring(" <= Y <= "); write(max,0); newline
    printstring("     +-"); printstring("--") %for y = min,1,max
    printsymbol('+'); newline
    %for x = maxx,-1,minx %cycle
!!!   %continueif xflag(x)=0
      write(x,3); printstring(" | ")
      %for y = min,1,max %cycle
        z = hole(x,y); pins(z) = pins(z)+1
        %if z=0 %then space %elsestart
          wraps = wraps+z-1
          printsymbol(z-1+'0')
        %finish
        space
      %repeat
      printsymbol('|'); newline
    %repeat
    printstring("     +-"); printstring("--") %for y = min,1,max
    printsymbol('+'); newline
  %end
  
  batches = (maxy-miny+36)//36
  items = (maxy-miny+batches)//batches
! write(miny,0); write(maxy,1); write(batches,1); write(items,1); newline
  openoutput(1,cliparam.".wcl"); selectoutput(1)
  printstring("Wrap count checklist for """.cliparam.""""); newlines(2)
  left = miny
  %cycle
    right = left+items-1; right = maxy %if right>maxy
    scan(left,right); left = left+items
    %exitif left>maxy; newline
  %repeat
  selectoutput(0)
  write(pins(0),0); printstring(" empty holes, ")
  write(pins(1),0); printstring(" empty pins,"); newline
  write(pins(2),0); printstring(" single wraps, ")
  write(pins(3),0); printstring(" double wraps,"); newline
  printstring("Total number of wire ends: ")
  write(wraps,0); newline
%end

%end