! ROUTE:
! Take as input an ESDL ".BIC" file that has preferably been through
! the VZAP interactive route vetting program.
! Partition net segments into layer groups and examine conflicts.
! RWT September 1986

%begin
%include "inc:util.imp"
%include "inc:maths.imp"

!Reminder of ESDL data format:

!ESDL -> ^S [0:eic,1:fic,2:cic,3:bic] UNIT*
!UNIT -> ^U [1:spec,2:unit,3:chip,4:board,5:pack] HEAD UNIT*
!        ^J nsubs HEAD* {^N{^A netname nfans {subno tno}*}+}*
!        ^E
!HEAD -> ^H0 nin nout nio nt label name
!        {^T tno<<2+[0:dup,1:out,2:in,3:inout] pinname signalname}*
!        {^P [1:at,2:on,3:pack,4:subpack,5:delay,6:value,7:size,8:place] parm}*
!        ^G

!In particular for .BIC files we have:

! ^S3^U4 HEAD(label=circuitname,name=boardname,p7(size)) ^Jn
! {HEAD(label=uselessPACKnumber,name=chipname,p1(ATslotname),
!       p2(ONpackname),p7(size),p8(place(x:y)))}n
! {^N{^A ...}+}* ^E
! pinnames in ^T lists take the form  x:y/pinname

%recordformatspec pinf
%recordformatspec netf

%recordformat chipf(%record(chipf)%name next,%record(pinf)%name pins,
                    %integer label,name,on,at,wide,high,x,y)
%recordformat pinf(%record(pinf)%name nextinchip,nextinnet,
                   %record(chipf)%name chip,%record(netf)%name net,
                   %integer tno,flags,pin,signal,index,x,y)
%recordformat netf(%record(netf)%name nextnet,nextsubnet,net,
                   %record(pinf)%name pins, %integer signal,index)

%constinteger pat=1,pon=2,psize=7,pplace=8

%integer sym;          !Current I-code symbol
%string(255)s;         !Current I-code string
%integer si;           !Signal name index, normally -1, but for
                       !a signal A<17>, si would be 17 and s A

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

%record(netf)%name nets;   !List of nets in main circuit
%record(chipf)%name chips; !List of chips in main circuit, of which
                           !the first is the main circuit itself.

%integer width,height,power,ground
%string(255)file=""
%integer layers=4

%integerfn codestring
! Returns a code value which uniquely identifies
! global string S, which is entered in a dictionary.
! This consists of a primary hash table with simple
! unsorted linked lists hanging off each entry.
! The actual number returned is the address of the string.
%record(hashf)%name h
%integer value=0,i
  %result = 0 %if length(s)=0
  %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; !Tag new entry onto (end of) list
      h == record(heapget(5+length(s)))
      h_s = s; h_next == hashtab(value)
      hashtab(value) == h
      %result = addr(h_s)
    %finish
    %result = addr(h_s) %if h_s=s
    h == h_next
  %repeat
%end

%string(255)%fn hashstring(%integer tag)
! Re-constitutes a hash-coded string
  %result = "" %if tag=0
  %result = string(tag)
%end

%string(255)%fn indexstring(%integer i)
! Re-constitutes index part of a signal name
%string(255)s
  %result = "" %if i<0
  s = itos(i,0)
  %result = "<".s.">"
%end

%record(*)%map reverse(%record(*)%name list)
! Reverses an arbitrary singly linked list, provided
! the first field in the record is used for linking.
%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

!  ESDL I-code input procedures

%routine readsym
! Read significant character and store in global SYM.
! NB newlines are not significant but spaces are.
  readsymbol(sym) %until sym#nl
  %returnunless sym='^'
  readsymbol(sym); sym=sym+'^'<<8
%end

%routine verify(%integer want)
! Ensure global SYM corresponds to WANT
  %routine p(%integer x)
    printsymbol(x>>8) %unless x>>8=0
    printsymbol(x)
  %end
  %returnif sym=want
  printstring("Got "); p(sym)
  printstring(" when expecting "); p(want)
  newline; %stop
%end

%routine readstring
! Read string and store in global S and SI (if of form signal<num>)
%owninteger dotted=0
%integer indexed=0
%integer len,i
  si = -1
  read(len); readsym; verify(':')
  length(s) = len
  %for i=1,1,len %cycle
    readsym
    indexed = i %if indexed=0 %and sym='<'
    charno(s,i) = sym
  %repeat
  %if indexed#0 %start
    length(s) = indexed-1
    si = 0
    %cycle
      indexed = indexed+1; i = charno(s,indexed)-'0'
      %exitunless 0<=i<=9
      si = si*10+i
    %repeat
  %finish
%end

%integerfn getnum
! Extract a possibly signed decimal number off the front of global
! string S, which is shortened by the number plus its terminator.
%integer n=0,sign=0,pos=1
  %while pos<=length(s) %cycle
    sym = charno(s,pos); pos = pos+1
    %if sym='-' %start
      sign = 1
    %finishelseif '0'<=sym<='9' %start
      n = n*10-'0'+sym
    %finishelseexit
  %repeat
  s = substring(s,pos,length(s))
  %result = n %if sign=0
  %result=-n
%end

%predicate contains(%string(*)%name s,%integer k)
! Does string S contain character K?
%integer i
  %for i = 1,1,length(s) %cycle
    %trueif charno(s,i)=k
  %repeat
  %false
%end

%record(chipf)%map readchips
! Read {^H0 ... ^G}*
%integer i
%record(chipf)%name chead,ctail
%record(pinf)%name phead,ptail

  ctail == nil
  readsym
  %while sym='^H' %cycle
    readsym; verify('0')
    chead == new(chead); chead = 0
    chead_next == ctail; ctail == chead
    read(i); read(i); read(i); read(i)  {ni,no,nio,nt}
    readstring; chead_label = codestring
    readstring; chead_name = codestring
    ptail == nil; readsym
    %while sym='^T' %cycle
      read(i)
      %if i&3#0 %start; !In,Out,or InOut
        phead == new(phead); phead = 0; phead_chip == chead
        phead_nextinchip == ptail; ptail == phead
        phead_tno = i>>2; phead_flags = i&3
        readstring
        %if contains(s,':') %start
          phead_x = getnum; verify(':'); phead_y = getnum
        %finish
        phead_pin = codestring
        readstring; phead_signal = codestring; phead_index = si
      %else; !Dummy pin
        readstring; readstring
      %finish
      readsym
    %repeat
    chead_pins == reverse(phead)
    %while sym='^P' %cycle
      read(i); readstring
      %if i=pon %start
        chead_on = codestring
      %finishelseif i=pat %start
        chead_at = codestring
      %finishelseif i=psize %start
        chead_wide = getnum; verify(':')
        chead_high = getnum
      %finishelseif i=pplace %start
        chead_x = getnum; verify(':')
        chead_y = getnum
      %finish
      readsym
    %repeat
    verify('^G')
    readsym
  %repeat
  %result == chead
%end

%record(netf)%map readnets
! Read {^N {subnet}*}*
%record(netf)%name head,tail

  %record(netf)%map readsubnets
  ! Read {^A subnetname pairs {chip pin}*}*
  %record(netf)%name head,tail
  %record(pinf)%name p,term
  %record(chipf)%name sub
  %integer nfans,subno,tno
    tail == nil
    %while sym='^A' %cycle
      head == new(head); head = 0
      head_nextsubnet == tail; tail == head
      readstring; head_signal = codestring; head_index = si
      read(nfans); p == nil
      %while nfans>0 %cycle
        nfans = nfans-1; read(subno); read(tno)
        sub == chips
! Scan component list (by position)
        sub == sub_next %and subno = subno-1 %while subno>0
        term == sub_pins
! Scan component's pin list (by pin number value)
        term == term_nextinchip %while term##nil %and term_tno#tno
        %if term==nil %start
          printstring("Terminal "); write(tno,0)
          printstring(" not found in component ")
          printstring(hashstring(sub_name))
          printstring(" at "); printstring(hashstring(sub_at)); newline
        %elseif term_flags&4=0; !All is well: not been here before
          term_flags = term_flags!4; term_net == head
          term_nextinnet == p; p == term
{} term_signal = head_signal; term_index = head_index
        %finishelseunless term_net==head %start; !Confusion
          printstring("Terminal"); write(term_tno,1)
          printstring(", pin ".hashstring(term_pin))
          space; printstring(hashstring(term_signal))
          printstring(" of ".hashstring(term_chip_label)); space
          printstring(hashstring(term_chip_name)." at ")
          printstring(hashstring(term_chip_at)); newline
          printstring("is already connected to ")
          printstring(hashstring(term_net_signal))
          printstring(indexstring(term_net_index))
          printstring(", cannot also connect to ".s)
          printstring(indexstring(si)); newline
        %finish
      %repeat
      head_pins == p
      readsym
    %repeat
    head == tail
    %cycle
      tail_net == head; tail == tail_nextsubnet
    %repeatuntil tail==nil
    %result == head
  %end

  tail == nil
  %while sym='^N' %cycle
    readsym; head == readsubnets
    head_nextnet == tail; tail == head
  %repeat
  %result == head
%end

! End of ESDL input stuff

%routine generate segment lists
%recordformat vf(%short x,y)
%recordformat sf(%record(sf)%name f,r,%record(vf)a,b,ab,%short angle,net,flags)
%record(sf)%namearray list(1:layers)
%record(sf)%name slist,s
%integer netno=0,segcount=0,x,y,i
%record(netf)%name m,n
%record(pinf)%name p

%record(sf)%map newseg
%record(sf)%name s
  s == new(s); s = 0
  s_f == s; s_r == s
  %result == s
%end

%routine add by position(%record(sf)%name i,list)
%record(sf)%name l,r
  r == list
  r == r_f %until r==list %or r_a_x>=i_a_x %or (r_a_x=i_a_x %and r_a_y>=i_a_y)
  l == r_r
  l_f == i; r_r == i
  i_r == l; i_f == r
%end

%routine check list(%record(sf)%name slist)
%integer checked=0,conflicts=0,overlaps=0,tees=0,crosses=0,count=0,time
%record(sf)%name a,b

  %routine check(%record(sf)%name ab,cd)
  %record(vf)ac,ad,ca,cb
  %integer a,b,c,d

    %routine fromto(%record(vf)%name f,t,ft)
      ft_x = t_x-f_x
      ft_y = t_y-f_y
    %end

    %integerfn s(%integer x)
      %result = -1 %if x<0
      %result = 0 %if x=0
      %result = 1
    %end

    %integerfn vp (%register(a0)%record(vf)%name a,b)
    ! %result = a_x*b_y-a_y*b_x
      *move.w a_x,d0; *muls b_y,d0
      *move.w a_y,d1; *muls b_x,d1
      %result = d0-d1
    %end

    %integerfn lengthsquared(%register(a0)%record(vf)%name z)
    ! %result = z_x\\2+z_y\\2
      *move.w z_x,d0; *muls d0,d0
      *move.w z_y,d1; *muls d1,d1
      %result = d0+d1
    %end

    checked = checked+1
    %returnif ab_net=cd_net
    fromto(ab_a,cd_a,ac)
    fromto(ab_a,cd_b,ad)
    fromto(cd_a,ab_a,ca)
    fromto(cd_a,ab_b,cb)
    c = s(vp(ab_ab,ac))
    d = s(vp(ab_ab,ad))
    %returnif c=d#0
    a = s(vp(cd_ab,ca))
    b = s(vp(cd_ab,cb))
    %returnif a=b#0
    %if a=b %or c=d %start
      overlaps = overlaps+1
    %elseif a=-b
      %if c=-d %then crosses = crosses+1 %else tees = tees+1
    %elseif c=-d
      tees = tees+1
    %else
      %signal 14
    %finish
    conflicts = conflicts+1
    ab_flags = ab_flags+1
    cd_flags = cd_flags+1
  %end

  time = cputime
  a == slist_f
  %cycle
    count = count+1
    b == a_f
    %while b##slist %and b_a_x<=a_b_x %cycle
      check(a,b); b == b_f
    %repeat
    a == a_f
  %repeatuntil a==slist
  time = cputime-time
  write(count,4; checked,8; conflicts,10; crosses,8; tees,5; overlaps,9; time,5); newline
%end

%routine add by angle(%record(sf)%name i,list)
%record(sf)%name l,r
  r == list
  r == r_f %until r==list %or r_a_x>=i_a_x %or (r_a_x=i_a_x %and r_a_y>=i_a_y)
  l == r_r
  l_f == i; r_r == i
  i_r == l; i_f == r
%end

%routine segment to(%short newx,newy)
%record(sf)%name s
  %if x=-1 %and y=-1 %start
    x = newx; y = newy; %return
  %finish
  segcount = segcount+1
  s == newseg
  s_net = netno
  s_a_x = x; s_a_y = y
  s_b_x = newx; s_b_y = newy
  s_ab_x = newx-x; s_ab_y = newy-y
  %if s_ab_x<0 %or (s_ab_x=0 %and s_ab_y<0) %start
    s_a = s_b; s_b_x = x; s_b_y = y
    s_ab_x = -s_ab_x; s_ab_y = -s_ab_y
  %finish
  x = newx; y = newy
  %if s_ab_y=0 %then s_angle = 0 -
  %elseif s_ab_x=0 %then s_angle = 90 -
  %else s_angle = int(180*arctan(s_ab_x,s_ab_y)/pi)
  add by angle(s,slist)
%end

%routine pins(%record(chipf)%name c)
%record(pinf)%name p
  %while c##nil %cycle
    newline
    p == c_pins
    %while p##nil %cycle
      write(p_x,0); write(p_y,1)
      %if p_signal=power %then printsymbol('P') -
      %elseif p_signal=ground %then printsymbol('G') -
      %elseif p_signal=0 %then printsymbol('B') -
      %elseif charno(hashstring(p_signal),1)='.' -
        %then printstring(hashstring(p_signal)) -
      %else printsymbol('S')
      newline
      p == p_nextinchip
    %repeat
    c == c_next
  %repeat
  newline; printstring("-1"); newline
%end

%routine output list(%integer k)
%record(sf)%name l,i
  write(k,0); newline
  l == list(k); i == l_f
  %while i##l %cycle
    write(i_flags,0; i_a_x,1; i_a_y,1; i_b_x,1; i_b_y,1); newline
    i == i_f
  %repeat
  printstring("-1"); newline
%end

  printstring("Writing part one")
  openoutput(1,file.".seg"); selectoutput(1)
  write(width,0; height,1); newline
  pins(chips)
  selectoutput(0); newline; printstring("Generating segment list")
  slist == newseg
  list(i) == newseg %for i = 1,1,layers
  m == nets
  %while m##nil %cycle
    n == m; m == m_nextnet
    %if power#n_signal#ground %start
      netno = netno+1; x = -1; y = -1
      %cycle
        p == n_pins
        %while p##nil %cycle
          segment to(p_x,p_y)
          p == p_nextinnet
        %repeat
        n == n_nextsubnet
      %repeatuntil n==nil
    %finish
  %repeat
  newline; printstring("Partitioning")
  s == slist_f
  i = 0
  %cycle
    s == s_f; add by position(s_r,list((i*layers)//segcount+1))
    i = i+1
  %repeatuntil i=segcount
  newline
  printstring("Count  checked  Conflicts  Crosses  Tees  Overlaps  Time"); newline
  checklist(list(i)) %for i = 1,1,layers
  printstring("Writing part two")
  selectoutput(1)
  output list(i) %for i = 1,1,layers
  printstring("-1"); newline
  closeoutput
  selectoutput(0); newline
%end

!  Acquire Parameters

  define param("Filename",file,pamnodefault)
  define int param("Layers",layers,0)
  processparameters(cliparam)

  toupper(file)

!  Initialise, Read BIC file

  hashtab(sym) == nil %for sym = 0,1,hashmask
  printstring("Reading .BIC file")
  openinput(1,file.".BIC"); selectinput(1)
  readsym; verify('^S'); readsym; verify('3')
  readsym; verify('^U'); readsym; verify('4')
  chips == readchips
  width = chips_wide; height = chips_high
  verify('^J'); read(sym)
  chips_next == reverse(readchips)
  nets == readnets
  verify('^E')
  closeinput; newline
  s = ".GND"; ground = codestring
  s = ".5V";  power = codestring

  generate segment lists

%endofprogram