%externalroutinespec phex2(%integer x)
%externalintegerfnspec heapget(%integer size)
%externalstring(255)%fnspec itos(%integer n,p)
%begin

%recordformat hashcellf(%record(*)%name next,%string(*)%name s)
%ownrecord(hashcellf)%namearray hashtable(0:127)==nil(*)

%recordformatspec compf
%recordformatspec pinf
%recordformatspec netf
%recordformat probef(%record(probef)%name next,%string(*)%name name,
                     %record(compf)%name components,%integer size)
%recordformat compf(%record(compf)%name next,%string(*)%name name,
                    %record(probef)%name probe,%record(pinf)%name pins)
%recordformat pinf(%record(pinf)%name cnext,nnext,%string(*)%name name,
                   %record(compf)%name comp,%record(netf)%name net,%integer num)
%recordformat netf(%record(netf)%name next,%string(*)%name name,
                   %record(pinf)%name pins)
%record(probef)%name probes==nil
%record(netf)%name netlist==nil
%integer warn=1,size,nets=0,pins=0,ones=0

%string(255)%map readname
%ownstring(255)s
%integer k
  %on 9 %start
    closeinput; %result == s
  %finish
  s = ""
  readsymbol(k) %until k>' '
  %cycle
    s = s.tostring(k) %unless length(s)=255
    readsymbol(k)
  %repeatuntil k='-' %or k<=' '
  %result == s
%end

%string(*)%map storename(%string(255)%name s)
%record(hashcellf)%name c
%integer i,h=0
  %result == nil %if s=""
  h = h<<1+charno(s,i)!32 %for i = 1,1,length(s)
  h = h&127
  c == hashtable(h)
  %while c##nil %cycle
    %result == c_s %if c_s=s; c == c_next
  %repeat
  c == new(c); c_next == hashtable(h); hashtable(h) == c
  c_s == string(heapget(length(s)+1)); c_s = s
  %result == c_s
%end

%record(probef)%map findprobe(%string(*)%name name)
%record(probef)%name probe == probes
  %while probe##nil %cycle
    %if probe_name==name %start
      probe_size = size %if size>probe_size
      %result == probe
    %finish
    probe == probe_next
  %repeat
  probe == new(probe); probe_next == probes; probes == probe
  probe_size = size
  probe_name == name; probe_components == nil; %result == probe
%end

%record(compf)%map findcomponent(%string(*)%name compname,probename)
%record(probef)%name probe
%record(compf)%name comp
  %if probename==nil %start
    probe == probes
    %while probe##nil %cycle
      comp == probe_components
      %while comp##nil %cycle
        %result == comp %if comp_name==compname
        comp == comp_next
      %repeat
      probe == probe_next
    %repeat
    %result == nil
  %finish
  probe == findprobe(probename)
  comp == probe_components
  %while comp##nil %cycle
    %result == comp %if comp_name==compname
    comp == comp_next
  %repeat
  comp == new(comp); comp_next == probe_components; probe_components == comp
  comp_probe == probe; comp_name == compname; comp_pins == nil
  %result == comp
%end

%routine connectpin(%string(*)%name pinname,compname,probename,
                    %record(netf)%name net)
%record(compf)%name comp == findcomponent(compname,probename)
%record(pinf)%name pin
  %if comp==nil %start
    %unless warn=0 %start
      printstring("Warning: cannot connect "); printstring(net_name)
      printstring(" to "); printstring(compname); printsymbol('-')
      printstring(pinname); printstring(" - component not found")
      newline
    %finish
    %return
  %finish
  pin == comp_pins
  %while pin##nil %cycle
    %if pin_name==pinname %start
      %unless pin_net==nil %start
        printstring("Error: cannot connect "); printstring(net_name)
        printstring(" to "); printstring(compname); printsymbol('-')
        printstring(pinname); printstring(" - already connected to ")
        printstring(pin_net_name); newline
      %finish
      pin_nnext == net_pins; net_pins == pin
      pin_net == net; pins = pins+1
      %return
    %finish
    pin == pin_cnext
  %repeat
  pin == new(pin); pin_cnext == comp_pins; comp_pins == pin; pin_comp == comp
  pin_nnext == nil; pin_name == pinname; pin_net == net; pins = pins+1
  %unless net==nil %start
    pin_nnext == net_pins; net_pins == pin
  %finish
%end

%routine readcomponentlist(%string(255)file)
%constinteger minint=\maxint
%recordformat f(%record(f)%name next,%string(*)%name name,%integer x,y)
%record(f)%name pinlist,thispin
%string(*)%name thisprobe,thiscomponent,nextcomponent
%string(255)probename
%constinteger limit=140
%integerarray widths,heights(1:limit)
%integer wp,hp
%integer igcomps=0,igpins=0,comps=0,pins=0,x,y,minx,maxx,miny,maxy,n,i
  openinput(1,file); selectinput(1)
  printstring("Reading "); printstring(file); newline
  nextcomponent == storename(readname); pinlist == nil
  %cycle
    thiscomponent == nextcomponent
    minx = maxint; miny = maxint; maxx = minint; maxy = minint; n = 0
    %while nextcomponent==thiscomponent %cycle
      n = n+1
      thispin == new(thispin)
      thispin_name == storename(readname)
      read(x); read(y); x = x//100; y = y//100
      thispin_x = x; thispin_y = y
      thispin_next == pinlist; pinlist == thispin
      minx = x %if x<minx; maxx = x %if x>maxx
      miny = y %if y<miny; maxy = y %if y>maxy
      nextcomponent == storename(readname)
    %repeat
    %if (maxx=minx %and maxy-miny<7) %or maxy=miny %start

! Ignore all components with zero height (usually decouplers), but also
! those with zero width (i.e. SILs) that do not have at least 8 pins.

!     %if n>2 %start
!       write(n,0); printstring("-pin component "); printstring(thiscomponent)
!       printstring(" ignored"); newline
!     %finish
      igcomps = igcomps+1; igpins = igpins+n
      probename = ""
    %else
      comps = comps+1; pins = pins+n

! Count the number of different widths within the component, i.e. the
! number of pin columns.  For BEPI, the number of rows is just the
! maximum height difference plus one, for other techniques, we would
! need to count the number of different heights, and perhaps rotate
! things round to match a "standard" probe.
! Then use this information to construct a probe name of the form SILn or
! DILn (for standard DILs) or DILn/w (for DILs with nonstandard width) or
! GRIDcxhxw for components with more than 2 columns, where:
!   n is the number of pins,
!   m is the component width in tenths of an inch,
!   c is the number of columns,
!   h is the height (number of rows).
! The treatment of gridded components is not foolproof, but adequate.

      wp = 0
      thispin == pinlist
      %while thispin##nil %cycle
        x = thispin_x-minx; widths(wp+1) = x
        %for i = 1,1,wp+1 %cycle
          %exitif widths(i)=x
        %repeat
        wp = i %if i>wp
        thispin == thispin_next
      %repeat
      i = maxy-miny+1   {height: number of rows}
      size = wp*i       {number of grid points}
      %if wp=1 %start
        probename = "SIL".itos(i,0)
      %elseif wp=2
        n = i<<1; i = maxx-minx
        probename = "DIL".itos(n,0)
        %if i=3 %start
          n = 0 %if n<=20
        %elseif i=4
          n = 0 %if n=22
        %elseif i=6
          n = 0 %if n=28 %or n=40 %or n=48
        %elseif i=9
          n = 0 %if n=52 %or n=64
        %finish
        probename = probename."/".itos(i,0) %unless n=0
      %else
        probename = "GRID".itos(wp,0)
        probename = probename."x".itos(i,0)
        probename = probename."x".itos(maxx-minx,0)
      %finish
      %unless probename="" %start
        thisprobe == storename(probename)
        thispin == pinlist
        %while thispin##nil %cycle
          connectpin(thispin_name,thiscomponent,thisprobe,nil)
          thispin == thispin_next
        %repeat
      %finish
    %finish
    %cycle
      thispin == pinlist; %exitif thispin==nil
      pinlist == pinlist_next
      dispose(thispin)
    %repeat
  %repeatuntil nextcomponent==nil
  write(igcomps,0); printstring(" components with"); write(igpins,1)
  printstring(" pins ignored"); newline
  write(comps,0); printstring(" components with"); write(pins,1)
  printstring(" pins noted"); newline
%end

%routine readnetlist(%string(255)file,type)
%string(*)%name thisnet,nextnet,compname,pinname
%integer oldones=ones,oldpins=pins
%integer n=0,p=0
%record(netf)%name net
%record(pinf)%name pin
  openinput(1,file); selectinput(1)
  printstring("Reading "); printstring(file); newline
  nextnet == storename(readname)
  %cycle
    thisnet == nextnet; %exitif thisnet==nil
    net == new(net); net_next == netlist; netlist == net
    net_name == thisnet; net_pins == nil
    n = n+1; p = pins
    %while thisnet==nextnet %cycle
      compname == storename(readname); pinname == storename(readname)
      connectpin(pinname,compname,nil,net)
      nextnet == storename(readname)
    %repeat
    p = pins-p
    ones = ones+((p-1)*p)>>1
  %repeat
  write(n,0); space; printstring(type); printstring(" nets noted,")
  oldpins = pins-oldpins; oldones = ones-oldones
  write(oldpins,1); printstring(" pins,"); newline
  oldpins = ((oldpins-1)*oldpins)>>1
  write(oldpins,0); printstring(" pin pairs,")
  write(oldones,1); printstring(" pairwise connections, density:")
  print(100*oldones/oldpins,1,2)
  printsymbol('%'); newline
%end

%routine scanprobelist(%record(probef)%name probe)
%integer pinno=0,n=0,c,pcmin,pcrec,tpcmin=0,tpcrec=0
  %integerfn scancomplist(%record(compf)%name comp)
  %record(pinf)%name p
  %integer n=0
    %while comp##nil %cycle
      p == comp_pins
      %while p##nil %cycle
        %if p_net==nil %start
          p_num = -1
        %else
          p_num = pinno; pinno = pinno+1
        %finish
        p == p_cnext
      %repeat
      comp == comp_next; n = n+1
    %repeat
    %result = n
  %end
  %while probe##nil %cycle
    n = n+1; c = scancomplist(probe_components)
    pcmin = probe_size; pcmin = pcmin*2 %if c>1
    pcrec = pcmin; pcrec = pcrec*2 %if c>=8
    pcrec = pcrec+pcmin %if c>=16
    tpcmin = tpcmin+pcmin
    tpcrec = tpcrec+pcrec
    printstring("Probe type "); printstring(probe_name)
    printstring(" occurs")
    %if c=1 %then printstring(" once") %elsestart
      write(c,1); printstring(" times")
    %finish
    newline
    probe == probe_next
  %repeat
  write(pinno,0); printstring(" pins counted"); newline
  write(n,0); printstring(" probe types require a pin count of")
  write(tpcmin,1); printsymbol(':'); write(tpcrec,0); newline
%end

  %on 2 %start
    %return
  %finish

readcomponentlist(cliparam.".cpl"); pins = 0
warn = 0; readnetlist(cliparam.".net","signal")
warn = 0; readnetlist(cliparam.".pag","power")
scan probelist(probes)
size = ((pins-1)*pins)>>1
write(ones,0); printstring(" pairwise connections out of")
write(size,1); printstring(" point pairs, density:")
print(100*ones/size,1,2); printsymbol('%'); newline
size = size>>2-1
printstring("Allocating"); write(size>>10,1)
printstring(" kbytes for matrix"); newline

%begin
%bytearray matrix(0:size)
%record(netf)%name n
%record(pinf)%name p,q
%integer i

%routine clear(%bytename z,%integer bytes)
%option "-low"
  d0 = d0>>2<<2; bytes = bytes-d0
  d0 = d0>>2-1; d1 = 0
  %if d0>=0 %start
    *swap d0
l0: *swap d0
l1: *move.l d1,(a0)+; *dbra d0,l1
    *swap d0; *dbra d0,l0
    *swap d0
  %finish
  %while bytes>0 %cycle
    bytes = bytes-1; *move.b #0,(a0)+
  %repeat
%end

%integerfn get(%integer x,y)
%integer z
  %result = 3 %if x=y
  %if x>y %start
    z = (x-1)*x+y+y
  %else
    z = (y-1)*y+x+x
  %finish
  %result = matrix(z>>3)>>(z&7)&3
%end

%routine set(%integer x,y,v)
%integer z
%bytename b
  %returnif x=y
  %if x>y %start
    z = (x-1)*x+y+y
  %else
    z = (y-1)*y+x+x
  %finish
  b == matrix(z&3); z = z&7
  b = b&(255!!(3<<z))!v<<z
%end

  printstring("Clearing matrix"); newline
  clear(matrix(0),size+1)
  printstring("Filling matrix"); newline
  n == netlist
  %while n##nil %cycle
    p == n_pins
    %while p##nil %cycle
      q == p_nnext
      %while q##nil %cycle
        set(p_num,q_num,1); ones = ones-1
        q == q_nnext
      %repeat
      p == p_nnext
    %repeat
    n == n_next
  %repeat

%end
%end
