%begin; !PRESKETCH
!Partitions nets into groups of colours which SKETCH associates with them
!(to prevent the frequent pen changes)

%externalintegerfnspec def streams(%string(127) parm, defaults)
%ownstring(31) defaults=".BIC/%I1.BIC"

!ESDL -> ^S num[0:eic,1:fic,2:cic,3:bic] UNIT*
!UNIT -> ^U type[1:spec,2:unit,3:chip,4:board,5:pack,+8:generic]
!        HEAD UNIT* ^J num[num of subinstances] (HEAD)num of sub
!        (^N (^A netname num[of fans] (instnum termnum)fan)+)*
!        ^E
!HEAD -> ^H opt[0] in out inout terms string1 string2
!        (^T termno<<2+in<<1+out pinstring namestring)terms
!        (^P parmnum[1:at,2:on,3:pack,4:subpack,5:delay,6:value,7:size,
!                    8:place] parmstring)*
!        ^G

%integer sym
%string(255)s

%routinespec read string

%routine readsym
  readsymbol(sym) %until sym#nl
  %if sym='^' %start
    readsym; sym=sym+128
    %if sym=128+'K' %start
      read string; readsym
    %finish
  %finish
%end

%routine read string
%integer len,pos,i
  read(len); readsym
  length(s)=len; %returnif len=0
  pos=0
  %for i=1,1,len %cycle
    pos=pos+1; readsym
    charno(s,pos)=sym
  %repeat
%end

%integer outpos=0

%routine printsym(%integer x)
  printsymbol('^') %if x&128#0
  printsymbol(x&127)
  outpos = outpos+1; outpos = 0 %if x=nl
%end

%constinteger max=50000
%shortarray a(1:max)
%integer global=0,external=0,internal=0,free=0

%routine add(%integer x)
  free = free+1; a(free) = x
%end

%routine addstring
%integer size = (length(s)+2)>>1
  string(addr(a(free+1))) = s; free = free+size
%end

%integer this=0

%routine note
  add(0); this = free
%end

%routine chain(%integername which)
  a(this) = which; which = this
%end

%routine wr(%integer n)
  %if n//10#0 %then wr(n//10) %elsestart
    %if outpos>70 %then printsym(nl) %else printsym(' ')
  %finish
  printsym(rem(n,10)+'0')
%end

%routine printstr(%string(255)s)
%integer i
{}printsym(nl) %if length(s)+outpos+5>70
  wr(length(s)); printsym(':')
  printsym(charno(s,i)) %for i=1,1,length(s)
%end

%routine spit(%integer pos)
%integer tail = 0, head, size
  %cycle; !Reverse links
    head = a(pos); a(pos) = tail; tail = pos; pos = head
  %repeatuntil pos=0
  pos = tail
  %cycle
    printsym('N'+128) %if head=0; head = 1
    tail = a(pos); pos = pos+1
    size = a(pos); pos = pos+1
    size = \size %and head = 0 %if size<0
    printsym('A'+128)
    printstr(string(addr(a(pos+size+size))))
    wr(size)
    %while size>0 %cycle
      size = size-1; wr(a(pos)); wr(a(pos+1)); pos = pos+2
    %repeat
    pos = tail
  %repeatuntil pos=0
%end

%integer pairs,sub,term,extflag

  selectoutput(0)
  sym = defstreams(cliparam,defaults)
  %stopunless sym=1
  selectinput(1)

! Skip to nets

  selectoutput(1)
  %cycle
    %cycle
      readsymbol(sym); %exitif sym='^'
      printsym{bol}(sym)
    %repeat
    readsymbol(sym); %exitif sym='N'
    printsym{bol}('^'); printsym{bol}(sym)
  %repeat
  printsym(nl)

! Suck in

  readsym %until sym='A'+128
  %cycle
    readstring
    extflag = 0; note
    read(pairs); add(pairs)
    %while pairs>0 %cycle
      pairs = pairs-1; read(sub); read(term)
      add(sub); add(term)
      extflag = 1 %if sub=0
    %repeat
    addstring
    %if charno(s,1)='.' %then chain(global) %elsestart
      %if extflag#0 %then chain(external) %else chain(internal)
    %finish
    readsym
    %if sym='N'+128 %start
      a(this+1) = \a(this+1)
      readsym
    %finish
  %repeatuntil sym#'A'+128

! Spit out

  spit(global); spit(external); spit(internal)

! Copy rest

  printsym(nl); printsym(sym)
  %unless sym='E'+128 %start
    %cycle
      %cycle
        readsymbol(sym); printsym{bol}(sym)
      %repeatuntil sym='^'
      readsymbol(sym); printsym{bol}(sym)
    %repeatuntil sym='E'
  %finish
  printsym(nl)

%endofprogram