!!  *** ZLIST ***
!!0.1 PMM
!!0.2 RWT: include edge in nets-by-position
!!0.3 RWT: fix pin mapping problem with in-outs
!!0.4 RWT: include chip type in sections 4 and 7
!!0.5 RWT: new section for spare gates, Notes section removed
%systemstring (8) %fnspec date
%systemstring (8) %fnspec time
%conststring(6) version = "0.5"

%begin

%conststring(20) defaults = ".BIC/%I1.LIS"
%externalintegerfnspec defStreams(%string(127) cli,defaults)

!! streams
%constinteger icode=1, report=0, results=1


!! machine dependent constants
%constinteger maxint = 20000000;        !! largest positive integer
%constinteger laupw=2;                  !! log addressing units per word
%constinteger cpw=4;                    !! characters per word
%constinteger lcpw=2;                   !! log characters per word
%constinteger sipw=2;                   !! shortintegers per word (1 or 2)


!! parameterisation
%constinteger stackLen = 50000;         !! length of stack (in words)


!! character interface
%constinteger ctrl=128,   cntrlchar='^',   end of file=-1
%constinteger end of string=-1


!! output interface
%constinteger lineLength=76;            !! length of output lines
%constinteger linesPerPage=66;          !! lines on a page
%integer col;                           !! current output column
%integer lineNumber;                    !! current line on page
%string(100) header1,header2;           !! title lines for page
%string(31) dateAndTime;                !! date and truncated time
%integer pageNumber,sectionNumber;      !! page numbering
%integer npages;                        !! pages output


!! I-code constants
%constinteger at=1,   on=2,   size=7,   place=8


!! recordformats and constants for data strucures
%recordformat npinf(%shortinteger subno,tno)
%recordformat netf(%record(netf)%name link,
                   %string(255)%name name,
                   %short number,nt,
                   %record(npinf)%array pin(1:1000))
%constinteger npinLen=2//sipw, netLen=2+2//sipw
%constinteger netNameOffset=1

%recordformat cpinf(%record(cpinf)%name link, %record(netf)%name net,
                    %integer x,y, %string(255)%name name)
%recordformat chipf(%record(chipf)%name link,
                    %string(255)%name name,slot,socket,
                    %integer x,y, %short nt,subno,
                    %record(cpinf)%name pinHead,
                    %record(cpinf)%array pin(1:1000))
%constinteger cpinLen=5, chipLen=7+2//sipw
%constinteger slotOffset=2, socketOffset=3, cpinNameOffset=4,
                    nameOffset=1

%recordformat chiplistf(%record(chipf)%namearray chip(0:1000))


!! work stack
%integerarray stack(0:stackLen)
%integer tos;                           !! increasing, used for records
%integer bos;                           !! decreasing, used for strings


!! I-code interface routines
%integer stringLen;                     !! length of current string
%integer ch;                            !! current i-code character
%integer pending;                       !! pending character


!! global values pertaining to the data structure
%integer boardnsubs;                    !! number of chips
%integer boardxdim,boardydim;           !! size of board (in grids)
%integer boardnt;                       !! number of edge connectors
%string(255)%name circuitName;          !! name of circuit
%string(255)%name boardName;            !! name of board
%record(chiplistf)%name chips;          !! root of chip data structure
!!%record(*)%name nil;                    !! end of lists
%record(netf)%name neth;                !! head of list of nets
%record(chipf)%name chiph;              !! head of list of sorted chips
%integer boardnnets;                    !! number of (ok) nets

!!*********************************!!
!! routines for managing the stack !!
!!*********************************!!

%routine claim(%integer nwords)
! take nwords off the top of the stack
   tos = tos+nwords<<laupw
%end

%routine check(%integer nwords)
! check that nwords of stackspace are remaining
   %if tos>>laupw+nwords>=bos %start
      printstring("* workspace of ");
      write(stackLen,0)
      printstring(" words exhausted")
      %stop
   %finish
%end

%record(*)%map getRecord(%integer nwords)
   %record(*)%name r
   check(nwords)
   r == record(tos)
   claim(nwords)
   %result == r
%end


!!*********************!!
!! diagnostic routines !!
!!*********************!!

!!*****************!!
!! useful routines !!
!!*****************!!

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

%routine swop(%integername x,y)
   %integer t
   t = x; x = y; y = t
%end

%integerfn min(%integer x,y)
   %result = x %if x<=y
   %result = y
%end

%integerfn max(%integer x,y)
   %result = x %if x>=y
   %result = y
%end

%integerfn pos(%integer n)
   n = 0 %if n<0
   %result = n
%end

%routine order(%integername l,h)
   swop(l,h) %if l>h
%end


!!**********************************!!
!! routines for handling the i-code !!
!!**********************************!!

%routine rsym(%integername ch)
   %if pending#0 %start
      ch = pending; pending = 0; %return
   %finish
   readsymbol(ch)
%end

%routinespec rdec(%integername n)

%routine rch
! put next input character into ch, ignoring comments and
! reconstucting control characters
   %integer i,   len
   %on 3,9 %start
      selectoutput(0)
      printstring("I-code ends prematurely"); newline
      %stop
   %finish
   %cycle
      rsym(ch) %until ch#nl
      %if ch=cntrlchar %start
         rsym(ch);   ch=ch+ctrl
         %exit %if ch#ctrl+'k'
         ! discard comment
         rdec(len);   rch
         rch %for i=1,1,len
      %finish %else %exit
   %repeat
%end

%routine rdec(%integername n)
   %integer ch,s
   s = 1
   rsym(ch) %until ch#nl %and ch#' '
   %if ch='-' %then s = -1 %and rsym(ch)
   n = 0
   %cycle
      %exit %unless '0'<=ch<='9'
      n = n*10+ch-'0'
      rsym(ch)
   %repeat
   n = n*s
   pending = ch
%end

%routine initialise
   selectinput(icode)
   selectoutput(results)
   pending = 0
   stringLen = -1
   rch
%end

%routine getch
! read next (or perhaps first) character from an i-code string
   rdec(stringLen) %and rch %if stringLen<0
   ch=end of string %and %return %if stringLen=0
   rch
   stringLen=stringLen-1
%end

%routine flush
! discard remainder of an i-code string
   getch %while stringLen>0
   stringLen=-1
%end

%routine rnum(%integername result)
! read a signed decimal integer from within an i-code string
   %integer sign,   n
   getch
   %if ch='-' %then sign=-1 %and getch %else sign=1
   n=0
   %while '0'<=ch<='9' %cycle
      n=n*10+ch-'0'
      getch
   %repeat
   n=-n %if sign<0
   result=n
%end

%string(255)%map stackString(%string(255) s)
! stack a string and map it
   %integer i,l
   %string(255)%name sn
   l = length(s)
   check((l+cpw)>>lcpw)
   bos = bos-(l+cpw)>>lcpw
   sn == string(bos<<laupw)
   sn = s
   %result == sn
%end

%string(255)%fn readString
! read an i-code string but do not stack it
   %string(255) s
   %integer i
   rdec(stringLen) %and rch %if stringLen<0
   length(s) = stringLen
   %for i = 1,1,stringLen %cycle
      rch; charno(s,i) = ch
   %repeat
   stringLen = -1
   %result = s
%end

%string(255)%map storeString
   %result == stackString(readString)
%end

%routine skipNum
! discard an i-code number
   %integer discard
   rdec(discard)
%end

%routine skipString
! discard an i-code string
   getch; flush
%end


!!*****************************************!!
!! read in i-code and build data structure !!
!!*****************************************!!

%routine readIcode
   ! read in all the i-code for the board and build a data
   ! structure.  the data structure consists of a vector
   ! chips which locates each chip on the board, and a list
   ! of nets headed by neth which enumerates all the nets.
   ! many of the global variables such as boardnsubs or
   ! groundNet are also given their values
   %integer nt,f,pno,subno,tno,n,x,y,g
   %integer flags,ni,no,nio,pins
   %record(cpinf)%name cpin,cpin2
   %record(chipf)%name chip,edges
   %record(netf)%name net,ntail
   %record(npinf)%name npin
   %string(255)%name null
   %string(255) netName,netPartname

   initialise

   rch %while ch#ctrl+'H';              ! flags, type etc
   rdec(boardnt) %for f = 1,1,5;        ! opt,nin,nout,nio,nt
   circuitName == storeString
   boardName == storeString

   edges == getRecord(chipLen)
   edges_subno = 0
   edges_name == stackString("Edge")
   edges_slot == edges_name
   edges_socket == stackString("Edge connector")
   edges_nt = boardnt
   edges_pinHead == nil
   %for tno = 1,1,boardnt %cycle
      rch; skipNum;                     ! ^T info
      cpin == getRecord(cpinLen)
      cpin_link == edges_pinHead; edges_pinHead == cpin
      cpin_net == nil
      rnum(cpin_x); rnum(cpin_y)
      %if ch='+' %start
         selectoutput(report)
         printstring("Multiple occurrence of signal on edge ignored")
         printsymbol(nl)
         selectoutput(results)
      %finish
      cpin_name == storeString;         ! pin name
      skipString;                       ! signal name
   %repeat
   
   boardxdim = 0; boardydim = 0
   rch
   %while ch=ctrl+'P' %cycle
      rdec(pno)
      skipString
      rch
   %repeat

   rch;                                 ! ^J
   rdec(boardnsubs)
   chips == getRecord(boardnsubs+1)
   chips_chip(0) == edges
   chiph == nil
   null == stackString("Unknown")
   %for subno = 1,1,boardnsubs %cycle
      chip == getRecord(chipLen)
      chip_link == chiph; chiph == chip
      chip_subno = subno
      chips_chip(subno) == chip
      rch;                              ! ^H
      rdec(flags); rdec(ni); rdec(no); rdec(nio); rdec(nt)
      pins=ni+no; %signal 15 %unless pins+nio=nt
      skipString;                       ! internal name
      chip_name == storeString;         ! type (eg 7400)
      chip_nt = pins
      check(pins*cpinLen); claim(pins*cpinLen)
      chip_pinHead == chip_pin(1);      ! link them all up
      %for tno = 1,1,pins %cycle
        cpin == chip_pin(tno)
        cpin_link == chip_pin(tno+1);   ! even last one (corrected below)
        cpin_net == nil; cpin_name == null; ! safety
        cpin_x = 0; cpin_y = 0;             ! safety
      %repeat
      cpin_link == nil;                 ! correct last one
      %for tno = 1,1,nt %cycle
         rch; rdec(flags);              ! ^T,pin,flags
         cpin == chip_pin(flags>>2);    ! map to real terminal
!        cpin_net == nil
         rnum(cpin_x); rnum(cpin_y)
         cpin_name == storeString
         skipString;                    ! signal name
      %repeat
      %cycle
         rch
         %exit %unless ch=ctrl+'P'
         rdec(pno)
         %if pno=at %start
            chip_slot == storeString;    ! name of slot on board
         %finish %else %if pno=place %start
            rnum(chip_x); rnum(chip_y);  ! coordinates on board
            flush
         %finish %else %if pno=on %start
            chip_socket == storeString;  ! socket type (eg DIL14)
         %else
            skipString
         %finish
      %repeat
   %repeat

   neth == nil; boardnnets = 0; ntail == nil
   rch
   %while ch=ctrl+'N' %cycle
      net == getRecord(netLen)
      net_nt = 0
      netName = ""
      rch
      %while ch=ctrl+'A' %cycle
         netPartName = readString
         %if netName="" %then netName = netPartName %c
                        %else netName = netName."_&_".netPartName
         rdec(nt)
         %for f = 1,1,nt %cycle
            rdec(subno); rdec(tno)
            cpin == chips_chip(subno)_pin(tno)
            x = cpin_x; y = cpin_y
            %for g = 1,1,net_nt %cycle
               npin == net_pin(g)
               cpin2 == chips_chip(npin_subno)_pin(npin_tno)
               -> omit %if cpin2_x=x %and cpin2_y=y
            %repeat
            net_nt = net_nt+1
            npin == getRecord(npinLen)
            npin_subno = subno; npin_tno = tno
omit:
         %repeat
         rch
      %repeat
      %if net_nt<=1 %start
         selectoutput(report)
         printstring(netName); printstring(" degenerate"); printsymbol(nl)
         selectoutput(results)
      %else
         %if ntail==nil %then neth == net %else ntail_link == net
         net_link == nil; ntail == net
         boardnnets = boardnnets+1
         net_number = boardnnets
         net_name == stackString(netName)
      %finish
   %repeat
   net == neth
   %while net##nil %cycle
      %for f = 1,1,net_nt %cycle
         npin == net_pin(f)
         chip == chips_chip(npin_subno)
         chip_pin(npin_tno)_net == net
      %repeat
      net == net_link
   %repeat
   %if ch#ctrl+'E' %start
      selectoutput(report)
      printstring("Broken i-code"); printsymbol(nl)
      %stop
   %finish
%end

%routine pch(%integer ch)
   %if ch=nl %then col = 0 %else col = col+1
   printsymbol(ch)
%end

%routine pstring(%string(255) what)
   %integer f
   %for f = 1,1,length(what) %cycle
      pch(charno(what,f))
   %repeat
%end

%routine ptruncString(%string(255) what, %integer l)
   length(what) = l %if length(what)>l
   pstring(what)
%end

%string(100)%fn fixedString(%string(255) what, %integer l)
   %if length(what)>l %then length(what) = l
   what = what." " %while length(what)<l
   %result = what
%end

%string(20)%fn dec(%integer n)
   %integer sign
   %string(20) s
   s = ""; sign = 0
   %if n<0 %then n = -n %and sign = 1
   %cycle
      s = tostring(rem(n,10)+'0').s
      n = n//10
   %repeat %until n=0
   s = "-".s %if sign#0
   %result = s
%end

%string(30)%fn coord(%integer x,y)
   %result = "[".dec(x).",".dec(y)."]"
%end

%routine pdec(%integer n)
   pstring(dec(n))
%end

%routine newline
   pch(nl)
%end

%routine newlines(%integer n)
   newline %and n = n-1 %while n>0
%end

%routine space
   pch(' ')
%end

%routine tab(%integer n)
   pch(' ') %while col<n
%end

%routine rightJustify(%string(255) what)
   %integer n
   n = lineLength-length(what)
   tab(n)
   pstring(what)
%end

%routine initialiseOutput
   lineNumber = -1
   col = 0
   selectoutput(results)
   sectionNumber = -1; pageNumber = 0
   npages = 0
   dateAndTime = time
   dateAndTime = "ZLIST V".version." ".date." ".substring(dateAndTime,1,5)
%end

%routine printHeader
   pageNumber = pageNumber+1
   npages = npages+1
   pstring(header1)
   rightJustify("Page ".dec(sectionNumber)."-".dec(pageNumber))
   newline
   rightJustify(dateAndTime)
   newline
   lineNumber = 4
   %if header2#"" %start
      pstring(header2); newline
      lineNumber = 5
   %finish
   newline
%end

%routine printTrailer
   newlines(linesPerPage-2-lineNumber)
   pstring(header1)
   rightJustify(dec(sectionNumber)."-".dec(pageNumber))
   newline
   printsymbol(12); !formfeed - not pch to avoid confusion
%end

%routine newSection(%string(100) h1,h2)
   printTrailer %unless lineNumber<0
   sectionNumber = sectionNumber+1; pageNumber = 0
   h1 = h1." for ".circuitName." on ".boardName
   header1 = h1; header2 = h2
   printHeader
%end

%routine terminateOutput
   printTrailer %unless lineNumber<0
%end

%routine skip(%integer lines,blanks)
   %if lineNumber+lines+blanks>linesPerPage-3 %start
      printTrailer
      printHeader
      lineNumber = lineNumber+lines
   %else
      newlines(blanks)
      lineNumber = lineNumber+lines+blanks
   %finish
%end

%routine verify(%integer n)
   %if lineNumber+n>linesPerPage-3 %start
      printTrailer
      printHeader
   %finish
%end

%predicate precedes(%string(255)%name s1,s2)
   %integerfn char(%string(255)%name s, %integer n)
      %result = 0 %if n>length(s)
      %result = charno(s,n)
   %end
   %predicate digit(%integer c)
      %true %if '0'<=c<='9'
      %false
   %end
   %integer l,f,c1,c2,p1,p2,d1,d2
   l = max(length(s1),length(s2))
   p1 = 1; p2 = 1
   %while (p1<=l) %or (p2<=l) %cycle
      c1 = char(s1,p1); c2 = char(s2,p2)
      %if digit(c1) %and digit(c2) %start
         d1 = p1; d2 = p2
         p1 = p1+1 %until %not digit(char(s1,p1))
         p2 = p2+1 %until %not digit(char(s2,p2))
         %if (p2-d2)#(p1-d1) %start
            %true %if (p1-d1)<(p2-d2)
            %false
         %finish
         %while d1#p1 %cycle
            %if c1#c2 %start
               %true %if c1<c2
               %false
            %finish
            d1 = d1+1; d2 = d2+1
            c1 = char(s1,d1); c2 = char(s2,d2)
         %repeat
      %else
         %if c1#c2 %start
            %true %if c1<c2
            %false
         %finish
         p1 = p1+1; p2 = p2+1
      %finish
   %repeat
   %false
%end

%record(*)%map sort(%record(*)%name head, %integer offset)
! sort any list by string keys.  the list must be ordered on the
! first field in the list, and the keys must be stringnames at
! offset in the record
   %recordformat templatef(%record(templatef)%name link)
   %recordformat bitf(%record(templatef)%name head,tail)
   %record(bitf) data
   %record(templatef)%name stick,st

   %routine stickSubSort(%record(bitf)%name data)
      %record(templatef)%name this,next
      %record(bitf) less,equal,greater
      %string(255)%name median,v

      %routine move(%record(templatef)%name stick, %record(bitf)%name bit)
         stick_link == nil
         %if bit_head==nil %then bit_head == stick %c
                            %else bit_tail_link == stick
         bit_tail == stick
      %end

      %routine join(%record(bitf)%name first,second)
         %if first_head==nil %then first_head == second_head %c
                              %else first_tail_link == second_head
         first_tail == second_tail %unless second_head==nil
      %end

      %string(255)%map val(%record(templatef)%name t)
         ! point to the string with name at the offset
         %result == string(integer(addr(t)+offset))
      %end

      less_head == nil; equal_head == nil; greater_head == nil
      this == data_head; next == this_link
      median == val(this)
      move(this,equal)
      %while next##nil %cycle
         this == next; next == next_link
         v == val(this)
         %if v=median %then move(this,equal) %c
         %else %if precedes(v,median) %then move(this,less) %c
         %else move(this,greater)
      %repeat
      %if less_head##nil %then stickSubSort(less)
      %if greater_head##nil %then stickSubSort(greater)
      data_head == nil
      join(data,less); join(data,equal); join(data,greater)
   %end

   offset = offset<<laupw
   data_head == head
   stickSubSort(data) %unless head==nil
   %result == data_head
%end

%routine orderPins
   %integer f
   %record(chipf)%name chip
   %for f = 0,1,boardnsubs %cycle
      chip == chips_chip(f)
      chip_pinHead == sort(chip_pinHead,cpinNameOffset)
   %repeat
%end

%routine printSockets
!! print out each socket type with the positions of any global
!! signals
   %integer f,g,h,count
   %string(100) s,ss
   %record(chipf)%name chip,vanguard
   %record(npinf)%name pin
   %record(cpinf)%name cpin
   %constinteger maxGlobal=6
   %record(netf)%namearray globals(1:maxGlobal)
   %integer globalNumber = 0
   %record(netf)%name net
   ! sort the chips by position and then again by socket type
   chiph == sort(chiph,slotOffset)
   chiph == sort(chiph,socketOffset)
   ! find all the global signals
   net == neth
   %while net##nil %cycle
      %if charno(net_name,1)='.' %start
         globalNumber = globalNumber+1 %if globalNumber#maxGlobal
         globals(globalNumber) == net
      %finish
      net == net_link
   %repeat
   s = fixedString("  Socket",11)
   %for f = 1,1,globalNumber %cycle
      s = s." ".fixedString(globals(f)_name,11)
   %repeat
   ! output the information
   newSection("Socket inventory",s)
   chip == chiph
   %while chip##nil %cycle
      vanguard == chip_link; count = 1
      %while vanguard##nil %and vanguard_socket=chip_socket %cycle
         count = count+1
         vanguard == vanguard_link
      %repeat
      skip(0,1) %unless chip==chiph
      verify(count+1)
      skip(1,0)
      pstring(chip_socket)
      pstring(" - "); pdec(count); pstring(" required"); newline
      %while chip##vanguard %cycle
         skip(1,0)
         pstring("  ")
         ptruncstring(chip_slot,8)
         %for g = 1,1,globalNumber %cycle
            net == globals(g)
            s = ""
            cpin == chip_pinHead
            %while cpin##nil %cycle
               %if cpin_net==net %start
                  ss = cpin_name
                  %if s="" %then s = ss %else s = s.",".ss
               %finish
               cpin == cpin_link
            %repeat
            %if s#"" %start
               tab(-2+g*12)
               pstring(s)
            %finish
         %repeat
         newline
         chip == chip_link
      %repeat
   %repeat
%end

%routine printChips
!! print out a list of chips by chip type and then a list of
!! chips by board position
   %integer f,count
   %record(chipf)%name chip,vanguard
   ! sort the chips by position and then again by chip type
   chiph == sort(chiph,slotOffset)
   chiph == sort(chiph,nameOffset)
   ! output the information
   newSection("Chip inventory","")
   chip == chiph
   %while chip##nil %cycle
      vanguard == chip_link; count = 1
      %while vanguard##nil %and vanguard_name=chip_name %cycle
         count = count+1
         vanguard == vanguard_link
      %repeat
      skip(0,1) %unless chip==chiph
      verify(count+1)
      skip(1,0)
      pstring(chip_name)
      pstring(" - "); pdec(count); pstring(" required"); newline
      %while chip##vanguard %cycle
         skip(1,0)
         pstring("  ")
         ptruncstring(chip_slot,8)
         newline
         chip == chip_link
      %repeat
   %repeat
   ! resort the chips by position
   chiph == sort(chiph,slotOffset)
   newSection("Chips by position",
   "  Position         Type             Socket           Coordinates")
   chip == chiph
   f = 0
   %while chip##nil %cycle
      %if rem(f,5)=0 %and f#0 %then skip(0,1)
      skip(1,0)
      pstring("  ")
      ptruncstring(chip_slot,15)
      tab(19)
      ptruncstring(chip_name,15)
      tab(36)
      ptruncstring(chip_socket,15)
      tab(53)
      pstring(coord(chip_x,chip_y))
      newline
      f = f+1
      chip == chip_link
   %repeat
%end

%routine printNets
!! print out all the nets in 3 forms
!! first, the nets in order
!! second, the nets by signal name
!! thirdly, the nets by pin position
   %record(netf)%name net
   %record(chipf)%name chip,edge
   %record(cpinf)%name cpin
   %record(npinf)%name npin
   %integer f,nt,l
   edge == chips_chip(0)
   newSection("Nets by number","")
   net == neth
   %while net##nil %cycle
      nt = net_nt
      %if nt<=15 %then skip(1+nt+(nt-1)//5,2) %else skip(6,2)
      pstring("Net "); pdec(net_number)
      pstring(":"); tab(10)
      pstring(net_name); tab(20)
      pstring("     ("); pdec(nt); pstring(" pads)")
      newline
      l = 0
      %for f = 1,1,nt %cycle
         %if rem(l,5)=0 %and l#0 %start
            %if nt>15 %start
               %if l+5>nt %then skip(nt-l,1) %else skip(5,1)
            %finish %else newline
         %finish
         l = l+1
         pstring("  ")
         npin == net_pin(f)
         chip == chips_chip(npin_subno)
         cpin == chip_pin(npin_tno)
         pstring(chip_slot); pch('.'); pstring(cpin_name)
         %unless chip==edge %start
            tab(20); pstring(chip_socket)
            tab(30); pstring(chip_name)
         %finish
         rightJustify(coord(cpin_x,cpin_y))
         newline
      %repeat
      net == net_link
   %repeat
   !! now the cross reference of signals to nets
   neth == sort(neth,netNameOffset)
   newSection("Net numbers by name","Net name       Number")
   net == neth
   f = 0
   %while net##nil %cycle
      %if rem(f,5)=0 %start
         l = 1; l = 0 %if f=0
         %if f+5>boardnnets %then skip(boardnnets-f,l) %else skip(5,l)
      %finish
      f = f+1
      pstring(net_name)
      tab(15)
      pdec(net_number)
      newline
      net == net_link
   %repeat
   !! finally, the nets by pin position (the chips are already sorted by slot)
   newSection("Nets by position","")
   !! add the edge connector to the chip list
   chip == chips_chip(0)
   chip_link == chiph; chiph == chip
   chip == chiph
   %while chip##nil %cycle
      nt = chip_nt
      skip(0,2) %and verify(nt+1) %unless chip==chiph
      skip(1,0)
      pstring(chip_slot)
      %unless chip==chiph %start
         tab(20); pch('('); pstring(chip_name)
         pstring(" in "); pstring(chip_socket); pch(')')
      %finish
      newline
      cpin == chip_pinHead
      %while cpin##nil %cycle
         skip(1,0)
         pstring("   ")
         pstring(cpin_name)
         tab(15)
         net == cpin_net
         %if net==nil %then pstring("empty") %else %start
            pstring(net_name)
            tab(30)
            pstring("Net "); pdec(net_number)
         %finish
         newline
         cpin == cpin_link
      %repeat
      chip == chip_link
   %repeat
%end

%routine printEmpty
%record(chipf)%name chip
%record(cpinf)%name cpin
%integer f,all,sindex
%string(100)%array ss(1:60)
%string(100)%name s
%string(31)secname
%integer sec
  sec=0; secname="Empty pins"
  %cycle
    newSection(secname,
       "Slot           Socket    Chip           Empty pins")
    chip == chiph
    %while chip##nil %cycle
       sindex = 1; s == ss(1)
       s = ""; all = 1
       cpin == chip_pinHead
       %while cpin##nil %cycle
          %if cpin_net##nil %then all = 0 %else %start
             %if s#"" %then s = s.","
             %if length(s)+length(cpin_name)>=lineLength-32 %start
                sindex = sindex+1; s == ss(sindex)
                s = ""
             %finish
             s = s." " %if s#""
             s = s.cpin_name
          %finish
          cpin == cpin_link
       %repeat
       skip(sindex,0)
       pstring(chip_slot)
       %unless chip==chiph %start
          tab(15); pstring(chip_socket)
          tab(25); pstring(chip_name)
       %finish
       %if sindex=1 %and s="" %start
          tab(40); pstring("Full"); newline
       %finish %else %if all#0 %start
          tab(40); pstring("Completely empty"); newline
       %else
          %for f = 1,1,sindex %cycle
             tab(40); pstring(ss(f)); newline
          %repeat
       %finish
       chip == chip_link
    %repeat
    %exitunless sec=0;   ! done both sections
    chiph == chiph_link; ! remove edge connector
    sec = 1; secname = "Spare gates"
    chiph == sort(chiph,nameOffset)
  %repeat
%end

%routine printContents
   %integer n=1
   %routine entry(%string(60) s)
      %if length(s)&1#0 %then s = s." "
      s = s." . . . . . . . . . . . . . . . . . . ."
      s = substring(s, 1, 28)
      skip(1,1)
      pstring("         ")
      pstring(s)
      pstring("section "); pdec(n)
      newline
      n = n+1
   %end
   newSection("Contents","")
   skip(0,4)
   entry("Socket inventory")
   entry("Chip inventory")
   entry("Chips by position")
   entry("Nets by number")
   entry("Nets by name")
   entry("Nets by position")
   entry("Empty pins")
   entry("Spare gates")
%end

selectoutput(report)
%if defstreams(cliParam,defaults)#1 %then %stop
!!nil == record(0)
tos = addr(stack(0))
bos = addr(stack(stackLen))>>laupw+1

readIcode
orderPins
initialiseOutput
printContents
printSockets
printChips
printNets
printEmpty
terminateOutput
selectoutput(report)
printstring("Output"); write(npages,1); printstring(" pages"); printsymbol(nl)

%endofprogram
