! SDA: a Simple Design Aid for the BEPI Solderwrap Machine
! (also suitable for wire-wrap)
! RWT Sept 1988, revised March 1990

%begin
%integer bepi=-1 {-1:bepi, 0:wire-wrap, 1:bepi-error}
%externalintegerfnspec heapget(%integer n)
%externalintegerfnspec stoi(%string(255)s)
%externalstring(255)%fnspec itos(%integer n,p)

! Simple list and stack processing

%recordformat cellfm(%record(cellfm)%name next,%integer item)
%recordformat stackfm(%record(cellfm)%name head,%integer size)

%predicate empty(%record(stackfm)%name stack)
  %trueif stack_head==nil; %false
%end

%routine push(%integer item,%record(stackfm)%name stack)
%record(cellfm)%name cell
  cell == new(cell)
  cell_next == stack_head
  cell_item = item
  stack_head == cell
  stack_size = stack_size+1
%end

%integerfn pop(%record(stackfm)%name stack)
%record(cellfm)%name cell
%integer item
  cell == stack_head
  item = cell_item
  stack_head == cell_next
  stack_size = stack_size-1
  dispose(cell)
  %result = item
%end

%record(*)%map reverse(%record(*)%name list)

! Reverse an arbitrary list, assuming its links are in the first field.

%recordformat f(%record(f)%name next)
%record(f)%name h == list, t == nil, c
  %while h##nil %cycle
    c == h; h == c_next; c_next == t; t == c
  %repeat
  %result == t
%end

%routine invert(%record(stackfm)%name stack)

! Invert a stack (i.e. reverse its list)

  stack_head == reverse(stack_head)
%end

%routine lengthen(%record(stackfm)%name stack,%integer size)

! Replicate the top of STACK until SIZE items are on it.

  push(stack_head_item,stack) %while stack_size<size
%end

! Error reporting

%owninteger lineno = 1

%routine line
  write(lineno,3); space; space
%end

%routine error
  line; printsymbol('*'); space
%end

%integerfn number(%string(255)%name s)
%integer n = 0
  %on 4 %start
    error; printstring(s); printstring(" is not a number"); newline
    %result = n
  %finish
  n = stoi(s)
  %signal 4 %unless itos(n,0)=s
  %result = n
%end

! 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

%routine increment(%string(255)%name item, %string(255)from,to,%integer by)

! ITEM is incremented by the amount specified in BY (usually 1).
! The increment is either added or subtracted depending on the
! values in the starting and ending items FROM and TO.  This
! proceeds by "field", starting from the end of the string.  Fields
! are either numeric or not.  It is assumed that corresponding fields
! in FROM, ITEM, and TO are compatible, but should ITEM or TO be
! incomplete (fields missing on the left), they will inherit the
! appropriate fields from FROM.
! Calling this with BY=0 may therefore be used to "complete" a string.
! Whenever a field "wraps round", a carry is made to the next
! (preceeding) field.  Non-numeric fields are incremented a character
! at a time, numeric fields are always taken as a whole (and are assumed
! to be in decimal).  Fields which are the same in FROM and TO are
! skipped, e.g. with FROM="ABACD" and TO="ABZCD", "ABPCD"+1 would be
! "ABQCD".  The direction (add/subtract) of incrementation is field
! specific, and it is quite possible for one field to count up and
! another to count down.

%string(255)tail=""
%bytename i==length(item),f==length(from),t==length(to)
%integer ni,nf,nt,wi,wf,wt

  %routine strip off(%string(*)%name s,%integername n,w)

! S is a string which ends in a numeric field.
! Extract that field into N and note its width in W.  The string
! is shortened by W, i.e. the field is stripped off.

  %integer k,r=1
    w = 0; n = 0
    %while length(s)>0 %cycle
      k = charno(s,length(s))-'0'
      %exitif k<0 %or k>9
      n = k*r+n; r = r*10; w = w+1
      length(s) = length(s)-1
    %repeat
  %end

  %while f>0 %cycle
    to = from %if to=""      {inherit}
    item = from %if item=""  {inherit}
    ni = charno(item,i)      {inspect last character in each}
    nf = charno(from,f)
    nt = charno(to,t)
    %if nf<'0' %or nf>'9' %start     {non-numeric}
      i = i-1; f = f-1; t = t-1      {strip off}
      %unless by=0 %start
        %if nf<nt %start     {add}
          ni = ni+by; by = 0
          ni = ni-nt+nf-1 %and by = by+1 %while ni>nt
        %elseif nf>nt        {subtract}
          ni = ni-by; by = 0
          ni = ni-nt+nf+1 %and by = by+1 %while ni<nt
        %finish
      %finish
      tail = tostring(ni).tail
    %else
      strip off(item,ni,wi)
      strip off(from,nf,wf)
      strip off(to,nt,wt)
      %unless by=0 %start
        %if nf<nt %start
          ni = ni+by; by = 0
          ni = ni-nt+nf-1 %and by = by+1 %while ni>nt
        %else
          ni = ni-by; by = 0
          ni = ni-nt+nf+1 %and by = by+1 %while ni<nt
        %finish
      %finish
      wi = length(tail)
      tail = itos(ni,0).tail
      wi = length(tail)-wi   {i.e. width of NI}
      %while wi<wf %and wi<wt %cycle  {add leading zeroes if appropriate}
        wi = wi+1; tail = "0".tail
      %repeat
    %finish
  %repeat
  item = tail
%end

%predicate compatible(%string(*)%name s,t)
%integer ps=length(s),pt=length(t)
  %cycle
    %trueif pt=0; %falseif ps=0
    %if '0'<=charno(s,ps)<='9' %start
      %falseunless '0'<=charno(t,pt)<='9'
      ps = ps-1 %until ps=0 %ornot '0'<=charno(s,ps)<='9'
      pt = pt-1 %until pt=0 %ornot '0'<=charno(t,pt)<='9'
    %else
      %falseif '0'<=charno(t,pt)<='9'
      ps = ps-1; pt = pt-1
    %finish
  %repeat
%end

%routine process name list(%string(255)si,%record(stackfm)%name stack)

! SI contains a list of items of the form  X{/X}* where X is of
! the form NAME{{:NUMBER}:NAME}.  Expand this by pushing all the
! represented names onto the specified stack.

%string(255)sf,st
%constinteger max=256
%integer by,limit=max
  %while si -> sf.("/").st %cycle
    process name list(sf,stack); si = st
  %repeat
  %if si -> sf.(":").st %start
    si = "1" %unless st -> si.(":").st
    %if compatible(sf,st) %start
      by = number(si)
      %if by=0 %start
        push(encode(sf),stack)
        push(encode(st),stack)
      %else
        si = sf
        increment(st,sf,st,0)
        push(encode(sf),stack)
        %unless sf=st %start
          %cycle
            increment(si,sf,st,by)
            push(encode(si),stack); limit = limit-1
          %repeatuntil limit<0 %or si=st
          %if limit<=0 %start
            error; printstring("Sequence "); printstring(sf); printsymbol(':')
            printstring(st); printstring(" is excessively long")
            newline
            by = pop(stack) %for limit = 1,1,max
            push(encode(st),stack)
            %return
          %finish
        %finish
      %finish
    %else
      error; printstring(sf); printstring(" and ")
      printstring(st); printstring(" are not compatible "); newline
      push(encode(sf),stack)
      push(encode(st),stack)
    %finish
  %else
    push(encode(si),stack)
  %finish
%end

%routine process number list(%string(255)si,%record(stackfm)%name stack)

! Similar to above but with numbers instead of names

%string(255)sf,st
%constinteger max=256
%integer f,i,t,by,limit=max
  %while si -> sf.("/").st %cycle
    process number list(sf,stack); si = st
  %repeat
  %if si -> sf.(":").st %start
    si = "1" %unless st -> si.(":").st
    f = number(sf)
    t = number(st)
    by = number(si)
    %if by=0 %start
      push(f,stack)
      push(t,stack) %unless f=t
    %else
      i = f
      push(f,stack)
      %unless f=t %start
        %cycle
          %if f<t %then i = i+by %else i = i-by
          push(i,stack); limit = limit-1
        %repeatuntil limit<0 %or i=t
        %if limit<=0 %start
          error; printstring("Sequence "); printstring(sf); printsymbol(':')
          printstring(st); printstring(" is excessively long")
          newline
          by = pop(stack) %for limit = 1,1,max
          push(t,stack)
          %return
        %finish
      %finish
    %finish
  %else
    push(number(si),stack)
  %finish
%end

! Input handling

%routine readitem(%string(*)%name s)

! Read an "item", which is any group of characters not separated by blanks.
! In addition the special characters are treated as delimiters and are
! returned at the next call as single-character items.

  %routine readsym(%integername k)

! Read one character, ignoring comments,
! and standardising letters to upper case.

    %cycle
      readsymbol(k)
      %exitunless k='{'
      %cycle
        readsymbol(k); lineno = lineno+1 %if k=nl
      %repeatuntil k='}'
    %repeat
    k = k-'a'+'A' %if 'a'<=k<='z'
    lineno = lineno+1 %if k=nl
  %end

  %predicate special(%integer k)
  %constinteger mask32 = 1<<('('&31) ! 1<<(')'&31) ! 1<<(','&31) ! 1<<(';'&31),
                mask64 = 1<<('['&31) ! 1<<(']'&31)
    %if k&(\31)=32 %start
      %trueif 1<<(k&31)&mask32#0
    %elseif k&(\31)=64
      %trueif 1<<(k&31)&mask64#0
    %finish
    %false
  %end

%owninteger pendsym = -1

  %unless pendsym<0 %start
    s = tostring(pendsym); pendsym = -1
  %else
    s = ""
    readsym(pendsym) %until pendsym>' '
    s = tostring(pendsym)
    %if special(pendsym) %then pendsym = -1 %elsestart
      %cycle
        readsym(pendsym)
        %exitif pendsym<=' ' %or special(pendsym)
        s = s.tostring(pendsym)
      %repeat
      pendsym = -1 %if pendsym<=' '
    %finish
  %finish
%end

! Main program variables

%constinteger collim=200,rowlim=200
%integerarray colpos(1:collim),rowpos(1:rowlim)
%integer maxcol=0,maxrow=0
%string(255)item

%constinteger implicit=0,in=1,inout=2,out=3  {pin types}
%conststring(8)%array pin type(0:3)=-
"implicit","input","in/out","output"

%recordformat packpinfm (%record(packpinfm)%name next,
                         %integer name,x,y)
%recordformat chippinfm (%record(chippinfm)%name next,
                         %integer signal,type,
                         %record(packpinfm)%name pin)
%recordformatspec netfm
%recordformat comppinfm (%record(comppinfm)%name next,
                         %record(chippinfm)%name pin,
                         %record(netfm)%name net)
%recordformatspec compfm
%recordformat netpinfm  (%record(netpinfm)%name next,
                         %record(compfm)%name comp,
                         %record(comppinfm)%name pin)
%recordformat packfm    (%record(packfm)%name next,
                         %integer name,
                         %record(packpinfm)%name pins)
%recordformat chipfm    (%record(chipfm)%name next,
                         %integer name,
                         %record(packfm)%name pack,
                         %record(chippinfm)%name pins)
%recordformat compfm    (%record(compfm)%name next,
                         %integer name,x,y,angle,
                         %record(chipfm)%name chip,
                         %record(comppinfm)%name pins)
%recordformat netfm     (%record(netfm)%name next,
                         %integer name,
                         %record(netpinfm)%name pins)

%record(packfm)%name packs==nil
%record(chipfm)%name chips==nil
%record(compfm)%name comps==nil
%record(netfm)%name nets==nil,netnets==nil,pagnets==nil

%routine position(%record(compfm)%name c,%record(packpinfm)%name p,
                  %integername x,y)

! Set X,Y to the position of pin P of component C taking
! into account the rotation specified for the component.

%integer s
%switch sw(0:3)   
  ->sw(c_angle)
sw(0): x = c_x+p_x; y = c_y+p_y; ->check
sw(1): x = c_x-p_y; y = c_y+p_x; ->check
sw(2): x = c_x-p_x; y = c_y-p_y; ->check
sw(3): x = c_x+p_y; y = c_y-p_x
check: %unless 0<x<=colpos(maxcol) %and 0<y<=rowpos(maxrow) %start
       %if c_x#0 %and c_y#0 %start
         s = outstream; selectoutput(0)
         error; printstring("Pin "); printstring(decode(p_name))
         printstring(" ("); write(x,0); space; write(y,0)
         printstring(") of component "); printstring(decode(c_name))
         printstring(" ("); write(c_angle,0)
         printstring(") is outside wiring area"); newline
         x = 0; y = 0; selectoutput(s)
       %finish
       %finish
%end
 
%routine read column and row data

! Note that we pre-read into global string ITEM the first thing
! which the next phase (read pack data) needs.

%record(stackfm)stack
%integer last,this
  colpos(this) = 0 %for this = 1,1,collim
  rowpos(this) = 0 %for this = 1,1,rowlim
  readitem(item); %returnunless item="["

! Read column data

  stack = 0
  %cycle
    readitem(item)
    %if item="]" %start
      error; printstring("',' expected"); newline
      this = pop(stack) %while stack_size>0
      %return
    %finish
    %exitif item=","
    process number list(item,stack)
  %repeat
  invert(stack)
  %whilenot empty(stack) %cycle
    last = -1; last = colpos(maxcol) %unless maxcol=0
    maxcol = maxcol+1
    this = pop(stack)
    colpos(maxcol) = this
    %if maxcol=1 %and this<=0 %start
      error; printstring("Column coordinates must be positive"); newline
    %elseif bepi<=0 %and this-last=1
      %if bepi<0 %start
!       printstring("Warning - non-standard column spacing of 1"); newline
        bepi = 0
      %finish
    %elseif maxcol&1=0 %and this-last#3
      bepi = 1
      error; printstring("Odd/Even column spacing must be 3, not ")
      write(this-last,0); printstring(" as between ")
      write(maxcol-1,0); printstring(" and "); write(maxcol,0); newline
    %elseif maxcol&1#0 %and this-last<2
      bepi = 1
      error; printstring("Even/odd column spacing must be at least 2, not ")
      write(this-last,0); printstring(" as between ")
      write(maxcol-1,0); printstring(" and "); write(maxcol,0); newline
    %finish
  %repeat

! Read row data

  stack = 0
  %cycle
    readitem(item) %until item#","
    %exitif item="]"
    process number list(item,stack)
  %repeat
  invert(stack)
  %whilenot empty(stack) %cycle
    last = 0; last = rowpos(maxrow) %unless maxrow=0
    maxrow = maxrow+1
    this = pop(stack)
    rowpos(maxrow) = this
    %if maxrow=1 %and this<=0 %start
      error; printstring("Row coordinates must be positive"); newline
    %elseif maxrow>1 %and this-last#1
      error; printstring("Row spacing must be 1, not ")
      write(this-last,0); printstring(" as at "); write(maxrow-1,0)
      printstring(" and "); write(maxrow,0); newline
    %finish
  %repeat
  readitem(item)
%end

%routine read package data

! Note that the first item has already been read.

%string(255)packname,pinname,xname,yname
%record(stackfm)pin,x,y
%record(packfm)%name pack
%record(packpinfm)%name packpin

  %predicate duplicated
  %record(packpinfm)%name duppin
  %string(255)s,t
    duppin == pack_pins
    %cycle
      %falseif duppin==nil
      %if packpin_name=duppin_name %start
        s = decode(packpin_name)
        error; printstring("Duplicate pin "); printstring(s); newline
        %true
      %finish
      %if packpin_x=duppin_x %and packpin_y=duppin_y %start
        s = decode(packpin_name)
        t = decode(duppin_name)
        error; printstring("Coincident pins ")
        printstring(s); printstring(" and "); printstring(t); newline
        %true
      %finish
      duppin == duppin_next
    %repeat
  %end

  packname = item
  %while packname#";" %cycle
    readitem(item) %until item="("
    line; printstring(packname); newline
    pack == new(pack); pack_pins == nil; pack_name = encode(packname)
    pack_next == packs; packs == pack
    pin = 0; x = 0; y = 0
    %cycle
      readitem(pinname) %until pinname#","
      %exitif pinname=")"
      process name list(pinname,pin)
      readitem(item); xname = item
      %if item=")" %or item="," %start
        error; printstring("No XY for "); printstring(pinname); newline
        %exitif item=")"
      %finishelse process number list(xname,x)
      lengthen(x,pin_size)
      readitem(item); yname = item
      %if item=")" %or item="," %start
        error; printstring("No Y for "); printstring(pinname); newline
        %exitif item=")"
      %finishelse process number list(yname,y)
      lengthen(y,pin_size)
      %while x_size>pin_size %cycle
        error; printstring("Spurious X offset "); write(pop(x),0)
        printstring(" in package "); printstring(packname); newline
      %repeat
      %while y_size>pin_size %cycle
        error; printstring("Spurious Y offset "); write(pop(y),0)
        printstring(" in package "); printstring(packname); newline
      %repeat
    %repeat
    invert(pin); invert(x); invert(y)
    %whilenot empty(pin) %cycle
      packpin == new(packpin)
      packpin_name = pop(pin)
      packpin_x = pop(x)
      packpin_y = pop(y)
      %unless duplicated %start
        packpin_next == pack_pins; pack_pins == packpin
      %finish
    %repeat
    readitem(packname)
  %repeat
  newline
%end

%routine read chip data
%string(255)chipname,packname,signalname,pinname
%record(stackfm)signal,pin
%record(chipfm)%name chip
%record(chippinfm)%name chippin
%integer type

  %record(packfm)%map findpack(%integer name)
  %record(packfm)%name pack == packs
    %cycle
      %if pack==nil %start
        error; printstring("Unknown package ")
        printstring(decode(name)); newline
        %result == nil
      %finish
      %result == pack %if pack_name=name
      pack == pack_next
    %repeat
  %end

  %record(packpinfm)%map findpin(%integer name,%record(packfm)%name pack)
  %record(packpinfm)%name pin
    %result == nil %if pack==nil
    pin == pack_pins
    %cycle
      %if pin==nil %start
        error; printstring("Unknown pin ")
        printstring(decode(name)); newline
        %result == nil
      %finish
      %result == pin %if pin_name=name
      pin == pin_next
    %repeat
  %end

  %predicate duplicated
  %record(chippinfm)%name duppin
  %string(255)s
    duppin == chip_pins
    %cycle
      %falseif duppin==nil
      %if chippin_signal=duppin_signal %start
        %falseif chippin_type=implicit {allow multiple power/ground}
        s = decode(chippin_signal)
        error; printstring("Duplicate signal "); printstring(s); newline
        %true
      %finish
      %trueif duppin_pin==nil
      %if chippin_pin==duppin_pin %start
         s = decode(chippin_pin_name)
         error; printstring("Duplicate pin "); printstring(s); newline
        %true
      %finish
      duppin == duppin_next
    %repeat
  %end

  %cycle
    readitem(chipname); %exitif chipname=";"
    readitem(packname)
    readitem(item) %until item="("
    line; printstring(chipname); space; printstring(packname); newline
    chip == new(chip)
    chip_name = encode(chipname)
    chip_pack == findpack(encode(packname))
    chip_pins == nil
    chip_next == chips; chips == chip
    type = implicit
    %cycle
      signal = 0; pin = 0
      %cycle
        readitem(item) %until item#","
        %exitif item=";" %or item=")"
        signalname = item
        process name list(signalname,signal)
        readitem(item)
        pinname = item
        pinname = signalname %if item="," %or item=";" %or item=")"
        process name list(pinname,pin)
        lengthen(signal,pin_size)
        %while signal_size>pin_size %cycle
          signalname = decode(pop(signal))
          error; printstring("Spurious signal name ")
          printstring(signalname); newline
        %repeat
        %exitif item=";" %or item=")"
      %repeat
      invert(signal); invert(pin)
      %whilenot empty(signal) %cycle
        chippin == new(chippin)
        chippin_signal = pop(signal)
        chippin_type = type
        chippin_pin == findpin(pop(pin),chip_pack)
        %unless duplicated %start
          chippin_next == chip_pins; chip_pins == chippin
        %finish
      %repeat
      %exitif item=")"
      %if type=out %start
        error; printstring("Too many ';'s"); newline
        readitem(item) %until item=")"
        %exit
      %finish
      type = type+1
    %repeat
    %unless type=out %start
      error; printstring("Not enough ';'s"); newline
    %finish
    chip_pins == reverse(chip_pins)
  %repeat
  newline
%end

%routine read component data
%string(255)compname,chipname,signalname,netname
%integer col,row,x,y,angle,nc = encode("nc")
%record(stackfm)signal,net
%record(compfm)%name comp

  %record(netfm)%map findnet(%integer name)
  %record(netfm)%name n == nets
    %cycle
      %if n==nil %start
        n == new(n); n_name = name; n_pins == nil
        n_next == nets; nets == n
        %result == n
      %finish
      %result == n %if n_name=name
      n == n_next
    %repeat
  %end

  %routine findpin(%integer signal,%record(netfm)%name net)
  %record(chippinfm)%name chippin
  %record(comppinfm)%name comppin
  %record(netpinfm)%name netpin
  %string(255)s
    comppin == comp_pins
    %while comppin##nil %cycle
      %if comppin_pin_signal=signal %start
        s = decode(signal)
        error; printstring("Duplicate connection for ")
        printstring(s); newline
        %return
      %finish
      comppin == comppin_next
    %repeat
    chippin == comp_chip_pins
    %cycle
      %if chippin==nil %start
        s = decode(signal)
        error; printstring("Unknown pin "); printstring(s); newline
        %return
      %finish
      %exitif chippin_signal=signal
      chippin == chippin_next
    %repeat
    comppin == new(comppin)
    comppin_pin == chippin
    comppin_net == net
    comppin_next == comp_pins; comp_pins == comppin
    netpin == new(netpin)
    netpin_comp == comp
    netpin_pin == comppin
    netpin_next == net_pins; net_pins == netpin
  %end

  %routine findchip
  %integer name = encode(chipname)
  %record(chipfm)%name chip == chips
  %record(netpinfm)%name netpin
  %record(chippinfm)%name chippin
  %record(comppinfm)%name comppin
    comp == nil
    %cycle
      %if chip==nil %start
        error; printstring("Unknown chip "); printstring(chipname); newline
        %return
      %finish
      %exitif chip_name=name
      chip == chip_next
    %repeat
    comp == new(comp)
    comp_chip == chip
    comp_pins == nil
    comp_next == comps
    comps == comp
    chippin == chip_pins
    %while chippin##nil %cycle
      %if chippin_type=implicit %start
        comppin == new(comppin)
        comppin_pin == chippin
        comppin_net == findnet(chippin_signal)
        comppin_next == comp_pins; comp_pins == comppin
        netpin == new(netpin)
        netpin_comp == comp
        netpin_pin == comppin
        netpin_next == comppin_net_pins
        comppin_net_pins == netpin
      %finish
      chippin == chippin_next
    %repeat
  %end

  %routine check used
  %record(chippinfm)%name chippin == comp_chip_pins
  %record(comppinfm)%name comppin
  %string(255)s
    %while chippin##nil %cycle
      %unless chippin_type=implicit %start
        comppin == comp_pins
        %cycle
          %if comppin==nil %start
            s = decode(chippin_signal)
            error; printstring("Unused ")
            printstring(pintype(chippin_type))
            printstring(" pin "); printstring(s)
            newline; %exit
          %finish
          %exitif comppin_pin==chippin
          comppin == comppin_next
        %repeat
      %finish
      chippin == chippin_next
    %repeat
    comppin == comp_pins
    %while comppin##nil %cycle
      comppin_net == nil %if comppin_net_name=nc
      comppin == comppin_next
    %repeat
  %end

  %cycle
    readitem(item)
    %exitif item=";"
    x = 0; y = 0; angle = 0
    %if item="[" %start
      readitem(item)
      col = number(item)
      x = colpos(col) %unless col=0
      readitem(item) %until ","#item#";"
      row = number(item)
      y = rowpos(row) %unless row=0
      readitem(item)
      %if item="," %start
        readitem(item); angle = number(item); readitem(item)
        angle = angle//90 %if angle>3  {0/90/180/270 -> 0/1/2/3}
        angle = angle&3
      %finish
      readitem(item) %while item#"]"
      readitem(item)
    %finish
    compname = item
    readitem(chipname)
    readitem(item) %until item="("
    line; printstring(compname); space; printstring(chipname); newline
    findchip
    %if comp==nil %start
      readitem(item) %until item=")"
      %continue
    %finish
    comp_name = encode(compname)
    comp_x = x; comp_y = y; comp_angle = angle
    signal = 0; net = 0
    %cycle
      readitem(item) %until item#","
      %exitif item=")"
      signalname = item
      process name list(signalname,signal)
      readitem(netname)
      item = netname
      netname = signalname %if item="," %or item=")"
      process name list(netname,net)
      lengthen(net,signal_size)
      %while net_size>signal_size %cycle
        netname = decode(pop(net))
        error; printstring("Spurious net "); printstring(netname); newline
      %repeat
      %exitif item=")"
    %repeat
    invert(signal); invert(net)
    %whilenot empty(signal) %cycle
      findpin(pop(signal),findnet(pop(net)))
    %repeat
    check used
  %repeat
  comps == reverse(comps)
%end

%routine write lis file(%string(255)file)

! This also has the side-effect of splitting the single list NETS
! into the two lists NETNETS and PAGNETS.  A net is put into the
! latter category if any of the pins it visits is implicit.
! Single-pin nets are eliminated and I/O checks are made.

  %integerfn dif(%string(*)%name a,b)
  ! Returns -1/0/1 if a<b/a=b/a>b
  %integer pa=1,pb=1,na,nb
    %cycle
      %if pa>length(a) %start
        %result = 0 %if pb>length(b)
        %result = -1
      %finish
      %result = 1 %if pb>length(b)
      na = charno(a,pa)-'0'; pa = pa+1
      nb = charno(b,pb)-'0'; pb = pb+1
      %if 0<=na<=9 %and 0<=nb<=9 %start
        na = na*10+charno(a,pa)-'0' %and pa = pa+1 -
          %while pa<=length(a) %and '0'<=charno(a,pa)<='9'
        nb = nb*10+charno(b,pb)-'0' %and pb = pb+1 -
          %while pb<=length(b) %and '0'<=charno(b,pb)<='9'
      %finish
      %result = na-nb %unless na=nb
    %repeat
  %end

  %predicate netleq(%record(*)%name c,d)
  %record(netfm)%name a == c, b == d
  %string(255)na = decode(a_name),
              nb = decode(b_name)
    %trueif dif(na,nb)<=0; %false
  %end

  %predicate compleq(%record(*)%name c,d)
  %record(compfm)%name a == c, b == d
  %string(255)na = decode(a_name),
              nb = decode(b_name)
    %trueif dif(na,nb)<=0; %false
  %end

  %predicate npleq(%record(*)%name c,d)
  %record(netpinfm)%name a == c, b == d
  %string(255)na = decode(a_pin_pin_signal),
              nb = decode(b_pin_pin_signal)
    %trueif dif(na,nb)<=0; %false
  %end

  %predicate npcleq(%record(*)%name c,d)
  %record(netpinfm)%name a == c, b == d
  %string(255)na = decode(a_comp_name),
              nb = decode(b_comp_name)
    %trueif dif(na,nb)<=0; %false
  %end

  %predicate cpleq(%record(*)%name c,d)
  %record(comppinfm)%name a == c, b == d
  %string(255)na = decode(a_pin_signal),
              nb = decode(b_pin_signal)
    %trueif dif(na,nb)<=0; %false
  %end

  %record(*)%map sort(%record(*)%name list,%predicate leq(%record(*)%name a,b))

! General purpose list sort using balanced merging algorithm.
! It is assumed the list is singly linked by its first field.

  %recordformat f(%record(f)%name next)
  %record(f)%name l==list,a==nil,b==nil,c
    %record(f)%map merge(%record(f)%name a,b)
    %record(f)%name h==nil,t
      %routine add(%record(f)%name c)
        %if h==nil %then h == c %else t_next == c; t == c
      %end
      %cycle
        %if b==nil %start
          %exitif a==nil
          add(a); a == a_next; t_next == nil
        %elseif a==nil
          add(b); b == b_next; t_next == nil
        %elseif leq(a,b)
          add(a); a == a_next; t_next == nil
        %else
          add(b); b == b_next; t_next == nil
        %finish
      %repeat
      %result == h
    %end
    %result == l %if l==nil %or l_next==nil
    %cycle
      c == l; %exitif c==nil; l == c_next; c_next == a; a == c
      c == l; %exitif c==nil; l == c_next; c_next == b; b == c
    %repeat
    a == sort(a,leq)
    b == sort(b,leq)
    %result == merge(a,b)
  %end

  %string(255)%fn padleft(%string(255)s,%integer n)
    s = " ".s %until length(s)>=n
    %result = s
  %end

  %string(255)%fn padright(%string(255)s,%integer n)
    s = s." " %until length(s)>=n
    %result = s
  %end

  %integerfn row(%integer y)
  ! Convert Y coordinate to row number, result 0 for invalid Y.
  %integer row
    %result = 0 %unless rowpos(1)<=y<=rowpos(maxrow)
    row = y-rowpos(1)+1
    %result = row %if rowpos(row)=y
    %result = 0
  %end

  %integerfn column(%integer x)
  ! Convert X coordinate to column number, result 0 for invalid X.
  ! Result negative for "extended" pins.
  %integer col,dif
    %for col = 1,1,maxcol %cycle
      %result = col %if colpos(col)=x
    %repeat
    col = 1
    %cycle
      %result = 0 %if col>maxcol
      %result = -col %if colpos(col)+1=x
      col = col+1
      %result = 0 %if col>maxcol
      %result = -col %if colpos(col)-1=x
      col = col+1
    %repeat
  %end

  %routine netlist
  %string(255)netname
  %record(netfm)%name net
  %record(netpinfm)%name pin
  %integerarray n(implicit:out)
  %integername imps,ins,inouts,outs
  %integer x,y,pins,nc = encode("nc")
    imps   == n(implicit)
    ins    == n(in)
    inouts == n(inout)
    outs   == n(out)
    nets == sort(nets,netleq)
    %cycle
      net == nets; %exitif net==nil; nets == net_next
      %continueif net_name=nc
      imps = 0; ins = 0; inouts = 0; outs = 0
      pins = 0
      netname = decode(net_name)
      selectoutput(1)
      newline; printstring("           Net "); printstring(netname)
      newline; newline
      net_pins == sort(net_pins,npleq)
      net_pins == sort(net_pins,npcleq)
      pin == net_pins
      %while pin##nil %cycle
        pins = pins+1
        printstring(padleft(decode(pin_comp_chip_name),10)); space
        printstring(padright(decode(pin_pin_pin_signal),10))
        printstring(padleft(padright(pintype(pin_pin_pin_type),9),11))
        printstring(padleft(decode(pin_comp_name),11))
        write(pin_comp_x,3); write(pin_comp_y,3); spaces(2)
        printstring(padright(decode(pin_pin_pin_pin_name),5))
        printstring(padleft(decode(pin_comp_chip_pack_name),9))
        position(pin_comp,pin_pin_pin_pin,x,y)
        write(column(x),5); write(row(y),3); newline
        n(pin_pin_pin_type) = n(pin_pin_pin_type)+1
        pin == pin_next
      %repeat
      selectoutput(0)
      %if pins=1 %start
        printstring("Ignoring single-pin net "); printstring(netname); newline
        net_pins == nil
      %elseif imps#0
        net_next == pagnets; pagnets == net
        %if outs#0 {%or inouts#0} %start
          printstring("Outputs drive implicit net "); printstring(netname); newline
        %finish
      %else
        net_next == netnets; netnets == net
        %if outs>1 {%or (outs=1 %and inouts#0)} %start
          printstring("Multiple outputs drive net "); printstring(netname); newline
        %finish
        %if ins+inouts=0 %start
          printstring("No inputs driven from net "); printstring(netname); newline
        %finish
        %if outs+inouts=0 %start
          printstring("No outputs drive net "); printstring(netname); newline
        %finish
      %finish
    %repeat
  %end

  %routine complist
  %integer x,y
  %record(compfm)%name comp == comps
  %record(comppinfm)%name pin
    comp == sort(comp,compleq)
    %while comp##nil %cycle
      newline
      printstring("Component "); printstring(decode(comp_name))
      printstring(" (of type "); printstring(decode(comp_chip_name))
      printstring(" in package "); printstring(decode(comp_chip_pack_name))
      printstring(" at coords"); write(comp_x,1); write(comp_y,1)
      printsymbol(')'); newline; newline
      comp_pins == sort(comp_pins,cpleq); pin == comp_pins
      %while pin##nil %cycle
        printstring(padleft(decode(pin_pin_pin_name),6)); space
        printstring(padright(pintype(pin_pin_type),11))
        printstring(padleft(decode(pin_pin_signal),12)); space
        %if pin_net==nil %start
          printstring("Not connected")
        %else
          printstring(padright(decode(pin_net_name),12))
          position(comp,pin_pin_pin,x,y)
          write(column(x),5); write(row(y),3)
        %finish
        newline
        pin == pin_next
      %repeat
      comp == comp_next
    %repeat
  %end

  printstring("Writing "); printstring(file); newline
  openoutput(1,file); selectoutput(1)
  complist
  netlist
  selectoutput(1); closeoutput; selectoutput(0)
%end

%routine write crd file(%string(255)file)
%integer i
  printstring("Writing "); printstring(file); newline
  openoutput(1,file); selectoutput(1)
  %for i = 1,1,maxcol %cycle
    write(colpos(i),0); newline
  %repeat
  closeoutput; selectoutput(0)
%end

%routine write cpl file(%string(255)file)
%record(compfm)%name comp == comps
!record(comppinfm)%name cp
%record(packpinfm)%name pp
%integer x,y
%string(255)cn,pn
  %returnif maxcol=0 %or maxrow=0
  printstring("Writing "); printstring(file); newline
  openoutput(1,file); selectoutput(1)
  %while comp##nil %cycle
    cn = decode(comp_name)
    %if comp_x=0 %or comp_y=0 %start
      selectoutput(0)
      printstring("Unplaced component "); printstring(cn); newline
      selectoutput(1)
    %else
!     cp == comp_pins
!     %while cp##nil %cycle
!       pp == cp_pin_pin
      pp == comp_chip_pack_pins
      %while pp##nil %cycle
        pn = decode(pp_name)
        printstring(cn); space; printstring(pn); space
        position(comp,pp,x,y)
        write(x*100,5); write(y*100,5); newline
!       cp == cp_next
        pp == pp_next
      %repeat
    %finish
    comp == comp_next
    newline %unless comp==nil
  %repeat
  closeoutput; selectoutput(0)
%end

%routine write net file(%string(255)file)
%record(netpinfm)%name pin
%string(255)nn,cn,pn
  printstring("Writing "); printstring(file); newline
  openoutput(1,file); selectoutput(1)
  %while nets##nil %cycle
    nn = decode(nets_name)
    pin == nets_pins
    %while pin##nil %cycle
      cn = decode(pin_comp_name)
      pn = decode(pin_pin_pin_pin_name)
      printstring(nn); space; printstring(cn); printsymbol('-')
      printstring(pn); newline
      pin == pin_next
    %repeat
    nets == nets_next
    newline %unless nets==nil
  %repeat
  closeoutput; selectoutput(0)
%end

  openinput(1,cliparam.".sda")
  read column and row data
  read package data
  read chip data
  read component data
  write crd file(cliparam.".crd") %if bepi<0
  write cpl file(cliparam.".cpl")
  write lis file(cliparam.".lis")
  nets == reverse(netnets); write net file(cliparam.".net")
  nets == reverse(pagnets); write net file(cliparam.".pag")
%end