        title   "WRAP-- 68xx Wirewrap program (C) Copyright 1985 Ira D. Baxter"
*       Wire Wrap automatic wiring program
*       Copyright (C) 1985 Ira D. Baxter
*       8192 Regency Street
*       La Palma, California 90623
*       All Rights Reserved
*
*       Update History:
*          1973 original design implemented by Ira Baxter
*               This was originally done for the Jupiter II of Dennis Brown
*               design.
*          5/84 V1.0 RAG Converted from JII source to 6800 source
*               Re-code is basically a brute force conversion
*               with lots of optimization for 6800.  Many
*               of the original registers used in JII are inplemented
*               in 6800 page zero locations. Other program
*               variables (called "cells" in the original code)
*               are also put in 6800 page zero locations.
*               The order of allocation of cell variables
*               in the page zero is based upon first use.
*
*          11/6/84 V1.0a IDB Modified trivially to run on 6809
*               Inserted Copyright messages.
*               Fixed bug in FXGRID that caused program to hang
*               Redesigned SQUARX; faster by 2x on 6800, 5x on 6809
*               Redesigned SQRT; faster by factor 2x on 6800/6809
*
*          3/10/86 V1.0b IDB Integrated changes from Rick and V1.0a
*               Converted to 680c format to allow efficient operation on 6809.
*
*       WireWrap program function:
*       accepts circuit description, dies checking
*       outputs cross reference list
*       and finally assists circuit wiring
*       (see manual)
*       program consists of 6 phases
*       each label for a phase is form pnxxx
*       where p is literal, n is phase number
*       xxx is anything
*
         page
syscall  equ   $fb
err:activationnotinbuffer equ 1907

         ifund m6800
m6800    equ   1
m6801    equ   0
m6809    equ   0
m6811    equ   0
         fin

         ifund m6811
m6811    equ   0
         fin

inch            equ     1000                   thousand steps/inch
wirestepsize    equ     inch/2                 wire size step
maxwiresize     equ     -1/wirestepsize*wirestepsize max wire size
minwiresize     equ     1*inch-1               min wire size
fudgesize       equ     367                    wire fudge size (0.367 inch)
pinheigth       equ     inch/1000*625          heigth of wirewrap pins
*
*       template definitions
*
                org     0
tmp:value       rmb     2              pointer to template name
tmp:filler      rmb     1              filler to make even pointer addresses
tmp:pincount    rmb     1              number of pins
tmp:x           rmb     2              x offset
tmp:y           rmb     2              y offset
tmp:pinnameptr  rmb     2              pointer to pin name
tmp:initialwiringptr    rmb   2        pointer to template pin
*
*       structure definitions
*
                        org  0
strt:value              rmb  2         pointer to structure name
strt:x                  rmb  2         x origin
strt:y                  rmb  2         y origin
strt:templateptr        rmb  2         pointer to originating template
strt:wirelistptr        rmb  2         wirelist pointer
*
ff      equ     $0c                    form feed
cr      equ     $0d                    carriage return
space   equ     $20
*
*       symbol type definitions
*
                   org     0
symt:udfsymbol     rmb 1   address of undefined symbol
symt:boardname     rmb 1   pointer to board name
symt:templatename  rmb 1   pointer to template
symt:pinname       rmb 1   pointer to template internal reference list
symt:structurename rmb 1   pointer to structure
symt:wirelistname  rmb 1   pointer to lowest address pin in a wirelist
symt:xcoordinate   rmb 1   x coordinate value (.001 inch)
symt:ycoordinate   rmb 1   y coordinate value (.001 inch)
symt:integer       rmb 1   integer value
symt:fraction      rmb 1   fraction value in units of .001 inch
symt:terminator    rmb 1   terminator character
*
*       symbol table entry definitions
*
                org     0
ste:len         rmb     1              symbol length + $80
ste:type        rmb     1              symbol type (symt:xxx)
ste:alphaptr    rmb     2              alphabetical pointer
ste:value       rmb     2              symbol value
ste:string      rmb     0              symbol characters & $7f
         page
*       working storage for 6800
*
                org     $18
ptr1            rmb     2       temp pointer
ptr2            rmb     2       temp pointer
tempa           rmb     1
tempb           rmb     1
tempx           rmb     2       temp pointer
tempy           rmb     2
*
*       working storage for wrap
*
linewidth       rmb     1       how wide the line
pagedepth       rmb     1       how deep the page
pagenumber      rmb     1       how many pages
linecount       rmb     1       counts lines per page (for eject)
columncount     rmb     1
rejectchar      rmb     1
dpflag          rmb     1       counts numer of fraction digits
sign            rmb     1       remembers '-' seen for gtsfr
phase           rmb     1       current program phase
*               warning! step must be located immediately following phase
step            rmb     1       current step within a phase
bcdbuf          rmb     5       holds result of bin to bcd conversion
product32       rmb     4       used by squarx
rem             rmb     2       sqrt remainder
root            rmb     2       sqrt root (answer, result)
pinheigth2      rmb     4       pin heigth squared
xasize          rmb     2       x axis size
yasize          rmb     2       y axis size
xsquared        rmb     4       a temporary
xcoordinate     rmb     2
symxdelta       rmb     2       difference from x coord to nearest symbolic x
symxptr         rmb     2       pointer to best symbolic x in symbol table
ycoordinate     rmb     2
symydelta       rmb     2       difference from y coord to nearest symbolic y
symyptr         rmb     2       pointer to best symbolic y in symbol table
lowptr          rmb     2       pointer to lower bound of bin srch region
midptr          rmb     2       pointer to middle of bin srch region
highptr         rmb     2       pointer past upper bound of bin srch region
symbolptr       rmb     2       pointer to symbol in symbol table
templateptr     rmb     2       pointer to template in template table
structureptr    rmb     2       pointer to structure in structure table
structurenameptr rmb    2       pointer to structure name before str allocated
chainptr1       rmb     2       pointer to a wirelist
chainptr2       rmb     2       pointer to a wirelist
wirelistptr1    rmb     2       pointer to a wirelist
wirelistptr2    rmb     2       pointer to a wirelist
wirelistnameptr rmb     2       pointer to wirelist name ste
pincount        rmb     1       number of pins this template
pinptr          rmb     2       templateptr + 4*(pin number)
thispin         rmb     2       pointer to pin
nextpin         rmb     2       pointer to pin
lastpin         rmb     2       pointer to pin
firstpin        rmb     2       pointer to pin
bestpin         rmb     2       pointer to pin
pinnameptr      rmb     2       pointer to pin name
boardnameptr    rmb     2       pointer to board name
inputbufferptr  rmb     2
outputbufferptr rmb     2
symboltableptr  rmb     2       points to first ste
symboltableend  rmb     2       points to (end of symboltable) + 1
templatetableptr rmb    2       template table pointer
structuretableptr rmb   2       structure table pointer
structuretableend rmb   2       pointer past structure table
otsymx          rmb     2       a temp
otpinx          rmb     2       a temp
fdclnx          rmb     2       a temp
ftpx            rmb     2       a temp
wwex            rmb     2       a temp
distance        rmb     2       between pins
wirenumber      rmb     2
level           rmb     1       wirewrap level 1=level1, 0=level2
binsize         rmb     2       multiple of wirestepsize
nextbinsize     rmb     2       size needed for next pass

*
*       new symbol
*
ns.rejected     rmb     1       rejected flag
ns.type         rmb     1       see symt:xxx
ns.value        rmb     2       value
ns.len          rmb     1       string length
ns.string       rmb     1       string body
        page    phase I, step 1 (input wiring area specifications)
*
*       this code accepts input of the following format:
*
*       name '[ number ', number '] number ', number
*       '( number ', number ') ';
*
*       translation: the name of the board followed by the
*       x and y dimensions of the wiring area (resolution = .005")
*       followed by the coordinate step size in inches followed
*       by an offset to be added to all positioning data generated
*       by use of the grid system. for example, MEMBD[12,8]
*       describes a memory board of dimensions 12.0 x 8.0 inches.
*       the origin (0,0) is the lower left corner of the board.
*
        org     $100
p1s1i   jsr     gtuds                  go get undefined symbol
        stx     boardnameptr           save pointer to board name
        ldaa    #symt:boardname        set type to 'board name'
        staa    ste:type,x
        jsr     gttrm                  board name must be followed by '['
        fcb     '[
        jsr     gtfra                  ok, go get x dimension
        stx     xasize                 save x dimension
        bne     p1s1i.2                b/ non-zero, no error
p1s1i.1 jmp     wwe1e                  b/ err, board dimension not reasonable
p1s1i.2 jsr     squarx                 square x dimension
        ldx     product32              save x**2
        stx     xsquared
        ldx     product32+2
        stx     xsquared+2
        jsr     gttrm                  now look for a comma
        fcb     ',
        jsr     gtfra                  get y dimension
        stx     yasize                 save y dimension
        beq     p1s1i.1                b/ err, board dimension not reasonable
        jsr     squarx                 square y dimension
        ldd     product32+2            (x**2 + y**2)
        addd    xsquared+2
        std     product32+2
        ldd     product32
        addd    xsquared
        std     product32
        bcs     p1s1i.3                b/ wire length too long
        ldd     product32+2            (x**2 + y**2 + pinh**2)
        addd    pinheigth2+2
        std     product32+2
        ldd     product32
        addd    pinheigth2
        std     product32
        bcc     p1s1i.4                b/ wire length ok
p1s1i.3 jmp     wwe21                  b/ wire length too long
*
*       now all of this must not be greater than
*       (65535)**2 = fffe 0001
*
p1s1i.4 ldd     product32+2
        subd    #$0001
        ldd     product32
        sbcb    #$fe
        sbca    #$ff
        bcc     p1s1i.3                b/ wire length too long
        jsr     sqrt                   find sqrt(product32)
*
*       resulting length of insulation must not be greater than
*       max wire length - fudgesize
*       = (65535 - fudgesize)
*
        subd    #(65535-fudgesize)
        bcc     p1s1i.3                b/ wire length too long
*
        jsr     gttrm                  get matching ']'
        fcb     ']
        jsr     gttrm                  find the ;
        fcb     ';
        page    Input x,y symbolic fractions
*       now we look for symbolic x and y coordinates
*       of the form  symbol '( '= number
*       or           symbol ') '= number
*       the first notation describes a symbolic x coordinate
*       the second describes a symbolic y coordinate
*
p1s1    jsr     gtuds                  get an undefined symbol
        ldaa    #symt:xcoordinate      assume type = symbolic x coordinate
        staa    ste:type,x
        jsr     isobj                  followed by a '( ?
        fcb     '(
        fdb     p1s1.1                 b/ yes, must be symbolic x coordinate
        ldx     symbolptr
        ldaa    #symt:ycoordinate      assume type = symbolic y coordinate
        staa    ste:type,x
        jsr     isobj                  no, try ')
        fcb     ')
        fdb     p1s1.1                 b/ yes, symbolic y coordinate found
        inc     step                   neither, might be template defs
        bra     p1s2g
p1s1.1  jsr     gttrm                  check for trailing '=
        fcb     '=
        jsr     gtfra                  coordinate needs fraction value
        ldx     symbolptr              get address of symbol
        std     ste:value,x            remember the coordinate value
        jsr     gttrm
        fcb     ';
        bra     p1s1                   look for more coordinate positions
        page    phase 1, step 2 (input template descriptions)
*       read the template definitions
*       name ': number
*       $( number '( number ', number ') ) '/
*       $( name '= number ) '/
*       $( number '= ( name / number ) ) ';
*
p1s2    jsr     gtuds                  get the template name
p1s2g   jsr     isobj                  see if followed by a ':
        fcb     ':
        fdb     p1s2.1                 b/ it's a ':
        jmp     p1s3i                  b/ no, can't be a template def
p1s2.1  jsr     altmp                  go allocate the template
p1s2c   jsr     isint                  is next object a pin number?
        fdb     p1s2l                  b/ no, try for '/ or ';
        tsta                           is it too big?
        beq     p1s2c2                 b/ no
p1s2c1  jmp     wwe7                   b/ yes
p1s2c2  cmpb    pincount               ...?
        bhi     p1s2c1                 b/ yes
        tstb                           is it too small?
        bne     p1s2c3                 b/ no, it's just right?
        jmp     wwe24                  b/ yes
p1s2c3  decb                           origin 0
        asld                           compute pin entry offset
        asld
        asld
        addd    templateptr
        std     pinptr
        jsr     gttrm                  check for a '(
        fcb     '(
        jsr     gtsfr                  get signed fraction for x displacement
        ldx     pinptr
        tst     tmp:x,x                previously defined?
        beq     p1s2c4                 b/ no
        jmp     wwe8                   b/ yes
p1s2c4  std     tmp:x,x
        jsr     gttrm                  check for proper syntax
        fcb     ',
        jsr     gtsfr                  get signed fraction for y displacement
        ldx     pinptr                 and save it
        std     tmp:y,x
        jsr     gttrm                  check for ')
        fcb     ')
        bra     p1s2c                  go look for more pin displacements
        page
p1s2l   jsr     isobj                  no more pin displacement defs
        fcb     '/                     terminated properly?
        fdb     p1s2d                  yes, read pin name defs
        jsr     gttrm                  no, must be end of template def
        fcb     ';
        bra     p1s2                   go get next template def
*
p1s2d   jsr     isobj                  end of pin name defs?
        fcb     '/
        fdb     p1s2w                  yes, get initial wirelists
        jsr     isobj                  end of template def?
        fcb     ';
        fdb     p1s2                   yes, go read next template def
        jsr     issyt                  is list object an internal symbol?
        fcb     symt:pinname
        fdb     p1s2s                  b/ yes
        jsr     gtuds                  otherwise, it must not be defined at all
        ldaa    #symt:pinname          define it
        staa    ste:type,x
p1s2s   jsr     gttrm                  get the '=
        fcb     '=                     indicating name assignment
        jsr     gtpnn                  to this pin number
        asld                           *2
        asld                           *4
        asld                           *8
        addd    templateptr
        std     pinptr
        addd    #tmp:pinnameptr        address of pin name pointer used below
        std     tempx
        ldx     pinptr
        tst     tmp:pinnameptr,x       see if internal symbol already defined
        beq     p1s2s1                 b/ no
        jmp     wwe9                   b/ yes
p1s2s1  ldx     symbolptr              get pointer to ref list
        ldd     ste:value,x
        andb    #$fe                   mask 'first of list' tag bit
        ldx     pinptr                 get pointer to template pin
        std     tmp:pinnameptr,x       make pin name entry point to ref list
        ldx     symbolptr
        ldd     tempx                  make smbol point to pin name entry list
        std     ste:value,x
        bra     p1s2d                  go try for another pin name def
        page
p1s2w5  ldab    #$ff
        cmpa    #symt:integer
        beq     p1s21
        decb
        cmpa    #symt:pinname
        beq     p1s21
        cmpa    #symt:wirelistname
        beq     p1s21
        cmpa    #symt:udfsymbol
        bne     p1s2w4
*
p1s2u   ldx     ns.value
        ldaa    #symt:wirelistname
        staa    ste:type,x
*
p1s21   ldx     pinptr
        ldaa    ns.value
        andb    ns.value+1             note "ldab #$ff" above.
        std     tmp:initialwiringptr,x
*
p1s2w   jsr     isobj                  initial wirelist collection
        fcb     ';                     end of template def?
        fdb     p1s2                   yes, all done
        jsr     issyt                  is this a pin name?
        fcb     symt:pinname
        fdb     p1s2w1                 b/ yes
        jsr     gtpnn                  no, look for pin number
        bra     p1s2w2
p1s2w1  jsr     ftpin                  convert pin name to pin number
p1s2w2  asld                           *2
        asld                           *4
        asld                           *8
        addd    templateptr
        std     pinptr
        ldx     pinptr
        ldaa    tmp:initialwiringptr,x see if pin already wired
        beq     p1s2w3                 b/ no
        jmp     wwea                   b/ yes, error
p1s2w3  jsr     gttrm                  no, get '=
        fcb     '=
        jsr     gnobj                  get next object
        fdb     p1s2w5                 b/ symbol
        fdb     p1s2w5                 b/ number
p1s2w4  com     ns.rejected            terminator, reject and give error
        jmp     wweb
        page
*       altmp-- allocate template space
*       reads pin count from input stream, saves in pinc
*       sets symbol value to address of new template
*       computes space needed for template
*       allocates space (if full, gives tbfull error)
*       initializes template default values
*       (see template description)
*       and finally, defines the symbol
*
altmp   ldx     symboltableptr
        ldaa    #symt:templatename     define the symbol type
        staa    ste:type,x
        ldd     structuretableptr      make ste value point to this structure
        std     ste:value,x
        std     templateptr            make template pointer point here too
        jsr     gtint                  get number of pins
        tsta                           too many pins?
        beq     altmp1                 b/ no
        jmp     wwe22                  b/ yes, give up
altmp1  stab    pincount               save for later
*
*       allocate the new template
*       8 bytes per pin + 3 for back link an pin count
*
        asld                           *2
        asld                           *4
        asld                           *8
        addd    #tmp:x
        addd    structuretableptr
        std     structuretableptr
        std     structuretableend      gnobj checks this for new symbols
*
*       check to see that we don't clobber symbol table
*
        subd    symboltableptr
        bcs     altmp2                 b/ table not full
        jmp     wwed                   b/ table full
        page
*       start putting stuff into the template
*
altmp2  ldx     templateptr
        ldd     symboltableptr         point to symbol name
        std     tmp:value,x
        ldab    pincount               put pincount into structure
        stab    tmp:pincount,x
*
*       fill x,y displacements with illegal value
*       clear pin name entries
*       fill initial wiring with 'not initialized'
*
altmp3  clr     tmp:x,x                x displacement = illegal value
        clr     tmp:x+1,x
        clr     tmp:y,x                y displacement = illegal value
        clr     tmp:y+1,x
        clr     tmp:pinnameptr,x       pinnameptr = 0
        clr     tmp:pinnameptr+1,x
        clr     tmp:initialwiringptr,x initialwiringptr = 'not initialized'
        clr     tmp:initialwiringptr+1,x
        leax    8,x
        decb                           are we done?
        bne     altmp3                 b/ no, keep going
        rts
        page    phase 1, step 3 (structure definitions)
*       name '@ name
*       ! ( '( (grid coordinate / number ', number) ') ';
*
p1s3    jsr     isobj
        fcb     '$                     end of structure list?
        fdb     p1s4i                  b/ yes
        jsr     issyt                  is next object an udf symbol?
        fcb     symt:udfsymbol
        fdb     p1s31                  b/ yes, go handle
        jmp     wwe1                   b/ no, error (expected udf symbol here)
*
p1s3i   inc     step                   bump to step 3
        ldx     symbolptr
p1s31   stx     structurenameptr
        jsr     gttrm                  followed by a '@?
        fcb     '@
p1s3b   jsr     alstb                  go allocate the structure block
        jsr     isobj                  end of structure def?
        fcb     ';
        fdb     p1s3                   yes, get next structure def
        jsr     gttrm                  no, must be followed by coordinates
        fcb     '(
        jsr     issyt                  is next object an x coordinate sym?
        fcb     symt:xcoordinate
        fdb     p1s3b1                 b/ yes, go store value
        jsr     gtfra                  get structure's x position
p1s3b1  jsr     mdfyc                  modify the coordinate if needed
        std     strt:x,x               save x structure position
        jsr     gttrm                  ensure y coordinate...
        fcb     ',                     set off by comma
        jsr     issyt                  is next object a y coordinate sym?
        fcb     symt:ycoordinate
        fdb     p1s3b2                 b/ yes, go store y value
        jsr     gtfra
p1s3b2  jsr     mdfyc                  modify the coordinate if needed
        std     strt:y,x               store the y coordinate
        page
*       make sure all pins are in the wiring area
*
        ldx     templateptr
        stx     ptr1
        ldaa    tmp:pincount,x         setup loop count
        staa    pincount
p1s3t   bsr     ccoordx                check x displacement first
        bsr     ccoordy                check y displacement next
        ldx     ptr1                   advance template pointer
        leax    8,x
        stx     ptr1
        dec     pincount               done checking?
        bne     p1s3t                  b/ no
        jsr     gttrm                  now get matching ')
        fcb     ')
        jsr     gttrm                  and trailing ';
        fcb     ';
        jmp     p1s3                   go get next structure definition
        page
*       check x coordinate
*       ptr1 points to template
*       structureptr points to structure
*       xasize contains max bound
*
ccoordx ldx     ptr1                   get x displacement
        ldd     tmp:x,x
        ldx     structureptr
        eora    strt:x,x
        bpl     ccrdx1                 b/ same sign, can't overflow on addop
        eora    strt:x,x               restore the displacement
        addd    strt:x,x               add origin to displacement
        eora    strt:x,x               sign different from origin?
        bmi     ccrdx4                 b/ yes, overflow on add op
        eora    strt:x,x               restore the displacement
        bra     ccrdx2                 and go compare

ccrdx1  eora    strt:x,x               restore displacement
        addd    strt:x,x
ccrdx2  cmpa    xasize                 now check upper bound
        blo     ccrdx3                 b/ in range
        bhi     ccrdx4                 b/ out of range
        cmpb    xasize+1
        bhi     ccrdx4                 b/ out of range
ccrdx3  rts

ccrdx4  jmp     wwee                   b/ overflow on op
        page
*       check y coordinate
*       ptr1 points to template
*       structureptr points to structure
*       yasize contains max bound
*
ccoordy ldx     ptr1                   get y displacement
        ldd     tmp:y,x
        ldx     structureptr
        eora    strt:y,x
        bpl     ccrdy1                 b/ same sign, can't overflow on addop
        eora    strt:y,x               restore the displacement
        addd    strt:y,x              add origin to displacement
        eora    strt:y,x               sign different from origin?
        bmi     ccrdy4                 b/ yes, overflow on addop
        eora    strt:y,x               restore the displacement
        bra     ccrdy2                 and go compare

ccrdy1  eora    strt:y,x               restore displacement
        addd    strt:y,x
ccrdy2  cmpa    yasize                 now check upper bound
        blo     ccrdy3                 b/ in range
        bhi     ccrdy4                 b/ out of range
        cmpb    yasize+1
        bhi     ccrdy4                 b/ out of range
ccrdy3  rts

ccrdy4  jmp     wwee                   b/ overflow
        page
*       mdfyc modify (a,b) followed by '+ or '-
*
mdfyc   pshd                           save accumulated result
        jsr     isobj                  look for '+
        fcb     '+
        fdb     mdfyc1                 b/ yes
        jsr     isobj                  look for '-
        fcb     '-
        fdb     mdfyc3                 b/ yes
        puld                           none of the above
        bra     mdfyc2

mdfyc1  jsr     gtfra                  add op, get operand
        stx     tempx                  save operand
        puld
        addd    tempx
        bcs     mdfyc4                 b/ overflow
mdfyc2  ldx     structureptr
        rts

mdfyc3  jsr     gtfra                  add op, get operand
        stx     tempx                  save operand
        puld
        subd    tempx
        bcc     mdfyc2                 b/ no underflow
mdfyc4  jmp     wwe23
        page
*       alstb-- allocate structure block
*       defines structure name
*       reads template name from input stream
*       allocates structure according to template
*       performs initial structure wiring
*       leaves pointer to 1st word of structure in structureptr
*
alstb   jsr     issyt                  get a symbol
        fcb     symt:templatename      of type template
        fdb     alstb1                 b/ ok, go handle
        jmp     wwe12                  not a symbol or wrong type
alstb1  ldx     structuretableend      save pointer to new structure
        stx     structureptr
        ldx     symbolptr              save pointer to template
        ldx     ste:value,x
        stx     templateptr
*
*       allocate space for structure
*       (2 * number of pins)
*       + (2 for value) + (2 for x) + (2 for y) + (2 for ptr to template)
*
        clra
        ldab    tmp:pincount,x         find out how many pins
        stab    tempx
        stab    pincount
        asld
        addd    #strt:wirelistptr
        addd    structuretableend
        std     structuretableend
        subd    symboltableptr        see if we overrun symbol table
        bcs     alstb2                 b/ no error
        jmp     wwe13                  b/ out of storage error
        page
*       init each pin's wirelist pointer to point to self
*       an odd pointer indicates 'first pin of list'
*
alstb2  ldx     structureptr           get pointer to structure
        ldd     structureptr           compute address of first pin slot
        addd    #strt:wirelistptr+1    make pointer odd - 'first pin' in chain
alstb3  std     strt:wirelistptr,x     save pointer to self
        addd    #2                     bump self pointer for next slot
        leax    2,x                    bump store pointer for next slot
        dec     tempx                  done yet?
        bne     alstb3                 b/ no
*
*       save pointer to structure name
*
        ldx     structurenameptr       make structure name point to structure
        ldaa    #symt:structurename    define symbol as structure name
        staa    ste:type,x
        ldd     structureptr
        std     ste:value,x
        ldx     structureptr           make structure point to structure name
        ldd     structurenameptr       get address of name
        std     strt:value,x
*
*       set initial x and y to 'no position'
*
        ldd     #$ffff
        std     strt:x,x
        std     strt:y,x
*
*       save pointer to originating template
*
        ldd     templateptr
        std     strt:templateptr,x
        page
*       setup for initial wiring loop
*       wirelistptr2 points to template initial wiring list
*       wirelistptr1 points to structure wirelist pointers
*       pincount has number of pins to do
*
        addd    #tmp:initialwiringptr  compute pointer to template wirelists
        std     wirelistptr2
        ldd     structureptr           compute pointer to structure wirelists
        addd    #strt:wirelistptr
        std     wirelistptr1
*
*       wire up the initial wiring list
*
alstb4  ldx     wirelistptr2           get pointer to template
        ldd     0,x                    any initial wiring for this pin?
        ldx     0,x
        beq     alstb9                 b/ no, advance to next pin
        cmpa    symboltableptr         is it a symbol pointer?
        blo     alstb7                 b/ no, it's a pin number
        bhi     alstb5                 b/ yes
        cmpb    symboltableptr+1       ...?
        blo     alstb7                 b/ no, it's a pin number
*
*       it's a pointer into the symbol table
*
alstb5  ldaa    ste:type,x             is it a pin name?
        cmpa    #symt:pinname
        beq     alstb6                 b/ yes
        stx     tempx                  no, it must be a wirelist name
        ldd     tempx                  compute address of wirelist pointer
        addd    #ste:value
        bra     alstb8
*
*       it's a pin name
*       go find the address of the pin in this template
*
alstb6  bsr     ftpin                  x points to pin name ste, return pin #
*
*       it's a pin number
*       double it and compute address of structure pin
*       add to wirelist
*
alstb7  decb
        asld
        addd    structureptr
        addd    #strt:wirelistptr
alstb8  bsr     connect                wirelistptr1, (a,b) point to wirelists
*
*       advance to next (structure/template) pin
*       and check done
*
alstb9  ldd     #8                     advance template pointer by 8
        addd    wirelistptr2
        std     wirelistptr2
        ldd     #2                     advance structure pointer by 2
        addd    wirelistptr1
        std     wirelistptr1
        dec     pincount               done?
        bne     alstb4                 b/ no
        rts
        page
*       connect
*       wirelistptr1, (a,b) point to the two wire lists to combine
*       find the end of list for each chain
*       since there is only 1 end of list for a chain
*       and since a pin can only be on one chain,
*       if the list ends are identical, then the two lists
*       are the same list (and i don't mean a copy). in this
*       case, do nothing. otherwise, combine the two lists
*
connect std     tempx                  find base of (a,b) chain
        ldx     tempx
        bsr     ffpin
        stx     chainptr1              remember base
        ldx     wirelistptr1           find base of wirelistptr1 chain
        beq     conn2                  b/ wirelist1 empty
        bsr     ffpin
        stx     chainptr2              remember base
        cpx     chainptr1              same chain?
        beq     conn1                  b/ yes, do nothing
*       delete 1st pin indicator on wirelistptr1 chain
        dec     1,x
*
*       cross-connect the two chains
*
        ldd     0,x
        std     tempx
        ldx     chainptr1
        ldd     0,x
        ldx     chainptr2
        std     0,x
        ldx     chainptr1
        ldd     tempx
        std     0,x
conn1   rts

conn2   ldx     chainptr1
        stx     wirelistptr1
        rts
        page
*       ffpin   find first pin of wire chain
*       x points to any node in chain on entry
*       on exit, x points to base node
*
ffpin1  ldx     0,x
ffpin   ldaa    1,x                    is this an odd pointer?
        asra
        bcc     ffpin1
        rts
*
*       ftpin
*       find template pin address
*       x points to ste pin name
*       templateptr points to current template
*       return (a,b) pin number
*
ftpin   stx     tempx
        ldx     templateptr            compute address bounds
        clra
        ldab    tmp:pincount,x
        ldx     tempx
        asld                           *8
        asld
        asld
        addd    #tmp:x                 + 4 for pincount and ptr to tmp name
        addd    templateptr
        std     tempx                  this is the upper bound of template
*
*       get pointer to wirelist
*
        ldx     ste:value,x            get pointer to pin name chain
        stx     ftpx                   remember starting point
        bra     ftpin2

ftpin1  ldx     0,x                    advance to next pin name pointer
        cpx     ftpx                   once around yet?
        beq     ftpin6                 b/ yes
ftpin2  ldd     0,x                    does 0,x point to pin in this template?
        bitb    #1                     check for odd (first of chain) ptr
        beq     ftpin3                 b/ it's not an odd pointer
        decb                           it is, even up the pointer
        dex                            ...
ftpin3  cmpa    templateptr            check lower bound
        blo     ftpin1                 b/ not the one
        bhi     ftpin4                 b/ lower bound ok
        cmpb    templateptr+1
        blo     ftpin1                 b/ not the one
ftpin4  cmpa    tempx                  check upper bound
        blo     ftpin5                 b/ this is it
        bhi     ftpin1                 b/ not the one
        cmpb    tempx+1
        bhs     ftpin1                 b/ not the one
*
*       (a,b) has address of pin
*       convert to pin number
*
ftpin5  subd    #tmp:pinnameptr
        subd    templateptr
        lsrd                          divide by 8
        lsrd
        lsrd
        rts

ftpin6  jmp     wwe1f                  pin name not found for this socket
        page
*       fnnam
*       find name of wirelist chain
*       (a,b) points to wirelist chain
*       takes (exit) if wirelist not named
*       else exit+2 with symbol address in (x)
*
fnnam   staa    tempx
        andb    #$fe                   ensure pointer is even
        stab    tempx+1
        ldx     tempx
fnnam1  cmpa    symboltableptr         does it point to a symbol
        blo     fnnam2                 b/ no
        bhi     fnnam4                 b/ yes
        cmpb    symboltableptr+1
        bhs     fnnam4                 b/ yes
fnnam2  ldd     0,x                    get pointer to next node
        ldx     0,x                    
        bitb    #1                     check for odd (first of chain) ptr
        beq     fnnam3                 b/ it's not an odd pointer
        decb                           it is, even up the pointer
        dex                            ...
fnnam3  cpx     tempx                  gone once around yet?
        bne     fnnam1                 b/ no
        pulx                           yes, error return
        ldx     0,x
        jmp     0,x

fnnam4  subd    #ste:value             compute address of ste node
        std     tempx
        ldx     tempx
        puld                           and take skip exit
        addd    #2
        pshd
        rts
        page
*       fnsw-- find next structure wire
*       examines next pin of current structure
*       if no more pins, advances to next alpha structure
*       if no more structures, takes (exit)
*       if pin points to self, takes (exit+2) x points to pin
*       if pin is member of named wirelist, takes (exit+4), x points to ste
*       else takes exit+6, x points to pin
*
fnsw    dec     pincount               are we done with this structure?
        bpl     fnsw1                  b/ no, advance pin pointer
        jsr     fnsym                  yes, go get next symbol
        fcb     symt:structurename     of type structure
        fdb     fnsw4                  b/ no more structures, takes (exit)
        ldx     ste:value,x            get pointer to structure
        stx     pinptr                 save pointer to structure
        ldx     strt:templateptr,x     get pointer to template
        ldaa    tmp:pincount,x         get number of pins to do
        deca                           count the pin we are about to do
        staa    pincount               and remember the remaining pin count
        ldd     pinptr                 setup for loop
        addd    #strt:wirelistptr-2
        std     pinptr
fnsw1   ldx     pinptr                 get pointer to next pin
        leax    2,x
        stx     pinptr
        ldd     0,x                    and see if it points to self
        andb    #$fe                   ensure even pointer
        cmpd    pinptr
        bne     fnsw2                  b/ it doesn't
*
*       pin points to self, take (exit+2)
*
        pulx                           get return address
        ldd     2,x
        pshd
        ldx     pinptr
        rts
        page
fnsw2   jsr     fnnam                  see if this is part of a named wirelist
        fdb     fnsw3                  b/ no
*
*       pin is member of named wirelist, take (exit+4)
*
        stx     tempx                  save pointer to wirelist name
        pulx                           get return address
        ldd     4,x
        pshd
        ldx     tempx                  get back the pointer to wirelist name
        rts
*
*       pin is not member of named wirelist, take exit+6, x points to pin
*
fnsw3   puld
        addd    #6
        pshd
        ldx     pinptr
        rts
*
*       no more structures, take (exit)
*
fnsw4   pulx
        ldx     0,x
        jmp     0,x
        page
*       read wirelist input
*       this is the tough one (only because the syntax is so
*       complex).
*
*       wirelist = '!' / ( wirelistobject $wirelistobject ';' )
*       wirelistobject = udfsymbol / wirelistname / pinlist
*       pinlist = structurename '-' pinspec
*          (( '[' fraction ']' pinlist ) / $pinspec)
*       pinspec = integer / pinname
*
p1s4i   inc     step                   set 'step 4'
p1s4    ldx     #0                     init vars
        stx     wirelistnameptr        no wirelist name seen yet
        stx     wirelistptr1           current wirelist is empty
        jsr     isobj                  check for '!'
        fcb     '!
        fdb     p2s1i                  yes/ enter phase 2
        bsr     p14wirelistobject      go get a ...
        bcc     p1s41                  b/ found one
        jmp     wwe15   b/ failed, expected wirelist or structure name
p1s41   bsr     p14wirelistobject      go get a ...
        bcc     p1s41                  found one, try for more
        jsr     isobj                  check for a ';'
        fcb     ';
        fdb     p1s4                   b/ got it!
        jmp     wwe14                  b/ error
*
*       wirelistobject = udfsymbol / wirelistname / pinlist
*
p14wirelistobject
        bsr     p14udfsymbol           go get a ...
        bcc     p14wirelistobject1     b/ success
        bsr     p14wirelistname        go get a ...
        bcc     p14wirelistobject1     b/ success
        bsr     p14pinlist             go get a ...
p14wirelistobject1
        rts
        page
*       look for an undefined symbol
*       if we see one, it must be a wirelist name
*
p14udfsymbol
        jsr     issyt
        fcb     symt:udfsymbol
        fdb     p14udfsymbol1          b/ success
        coma                           not found, error exit
        rts
*
*       look for a wirelist name
*
p14wirelistname
        jsr     issyt
        fcb     symt:wirelistname
        fdb     p14wirelistname1       b/ success
        coma                           not found, error exit
        rts
*
p14udfsymbol1
        ldaa    #symt:wirelistname     define symbol as wirelist name
        staa    ste:type,x
p14wirelistname1
        ldaa    wirelistnameptr        is there already a wirelist name?
        beq     p14wirelistname2       b/ no
        cpx     wirelistnameptr        is it the same name?
        beq     p14wirelistname3       b/ yes, that's ok
        jmp     wwe16                  b/ yes, that's not allowed
p14wirelistname2
        stx     wirelistnameptr        remember the new wirelist name pointer
*       clra                           compute address of ste:value
        ldab    #ste:value
        addd    symbolptr
        jsr     connect                and hook it into current wirelist
p14wirelistname3
        clra                           success exit
        rts
        page
*       pinlist = structurename '-' pinspec
*          (( '[' fraction ']' pinlist ) / $pinspec)
*
p14pinlist4
        jsr     gtfra                  eat the wirelength
        jsr     gttrm                  must be followed by a ']'
        fcb     ']
*       bsr     p14pinlist             must be followed by a pinlist
*       rts
        page
p14pinlist
        jsr     issyt
        fcb     symt:structurename
        fdb     p14pinlist1            b/ success
        coma                           not found, error exit
        rts
p14pinlist1
        ldx     ste:value,x            get address of the structure
        stx     structureptr           and remember it
        ldx     strt:templateptr,x     get address of template
        stx     templateptr            and remember it
        ldaa    tmp:pincount,x         get pincount
        staa    pincount               and remember it
        jsr     gttrm                  must have a '-'
        fcb     '-
        bsr     p14pinspec             get a ...
        bcc     p14pinlist2            b/ no error
        jmp     wwe11                  b/ error, expected pin name or number
p14pinlist2
        jsr     isobj                  check for fraction
        fcb     '[
        fdb     p14pinlist4            b/ found it
p14pinlist3
        bsr     p14pinspec             0 or more pin specs allowed here
        bcc     p14pinlist3            found one, try for another
        clra                           failure is ok
        rts
        page
*       pinspec = integer / pinname
*
p14pinspec
        jsr     isint                  no, is it an integer?
        fdb     p14pinspec1            b/ no
        jsr     gtpnn0                 convert to pin number
        bra     p14pinspec3            go join the rest
p14pinspec1
        jsr     issyt                  is it a pin name?
        fcb     symt:pinname
        fdb     p14pinspec2            b/ yes
        coma                           no, fail exit
        rts

p14pinspec2
        jsr     ftpin                  convert to pin number
p14pinspec3
        asld                           compute address of pin in structure
        addd    #strt:wirelistptr
        addd    structureptr
        std     wirelistptr2           remember for later
        jsr     fnnam                  find name of this wirelist
        fdb     p14pinspec5            b/ not named, go link
        cpx     wirelistnameptr        is it the same name?
        beq     p14pinspec6            b/ yes, ignore redudant spec
        ldaa    wirelistnameptr        is current wirelist named?
        beq     p14pinspec4            b/ no
        jmp     wwe16                  b/ yes, cannot have 2 names!
p14pinspec4
        stx     wirelistnameptr        no, it is named now!
p14pinspec5
        ldd     wirelistptr2           get address of second wirelist
        jsr     connect                hook 'em together
p14pinspec6
        clra                           success exit
        rts
        page
*       fnsym-- find next symbol (to output)
*       ptr1 points to last symbol output
*       fnsym finds next symbol in alphabetical sequence
*       of type (rtn)
*       takes (exit+1) if no more symbols to output
*       else takes exit+3 with symbol value in (a,b)
*
fnsym   puld                           get return address
        std     tempx
        addd    #3
        pshd
        ldx     tempx
        ldaa    0,x                    get the symbol type
        staa    tempa
*       advance to next symbol
fnsym1  ldx     ptr1
        cpx     symboltableend         are we at the end of the list?
        beq     fnsym2                 b/ yes, no more symbols of this type
        clra                           get symbol length
        ldab    ste:len,x
        addb    #13+$80                $80 makes tag bit go away
        andb    #-8                    gives number of bytes for this ste
        addd    ptr1
        std     ptr1
        ldx     ste:alphaptr,x         get pointer to alphabatized symbol
        ldaa    ste:type,x             see if this is the right type
        cmpa    tempa
        bne     fnsym1                 b/ no, keep looking
*       success exit
        ldd     ste:value,x            return the symbol's value
        rts
*       fail exit, fix return address
fnsym2  ldx     symboltableptr         set up for next scan
        stx     ptr1
        puld
        ldx     tempx
        ldx     1,x                    get fail exit address
        jmp     0,x
        page
p2s1i   ldx     #$201                  phase 2 step 1
        stx     phase
        ldx     #done                  get message address
        stx     ptr1
p2s1i1  ldx     ptr1
        ldaa    0,x                    get char
        beq     p3s1i                  b/ done
        inx
        stx     ptr1
        jsr     outc                   output it
        bra     p2s1i1
done    fcb     cr
        fcc     /Input phase completed./
        fcb     cr,0
        page    Phase 3: optimize wire chains
*       optimize the wire chains
*       find the two pins that are the farthest apart
*       this becomes the new endpoint
*       (A) the next closest pin becomes the next point
*       repeat step (A) until the entire wire chain is
*       re-ordered
*
p3s1i   inc     phase                  phase number is 3
        ldx     structuretableptr      setup for fnlst
        dex
        dex
        stx     pinptr
        clr     pincount
p3s1l   jsr     fnlst                  get next wire chain to process
        bcc     p3s1.1                 b/ we have an unprocessed wire chain
        jmp     p4s1i                  fresh out of unprocessed wire chains
p3s1.1  stx     firstpin               this is the new first pin
p3s1.2  ldd     0,x                    does the pin point to self?
        ldx     0,x
        cpx     firstpin
        beq     p3s1.5                 b/ yes, only one pin, reinstall tag
        cmpa    symboltableptr         is this an ste?
        bhi     p3s1.2                 b/ yes, skip this entry
        blo     p3s1.3                 b/ no
        cmpb    symboltableptr+1
        bhs     p3s1.2                 b/ yes
p3s1.3  ldx     firstpin
        bsr     fdmdp                  no, find most distant pair
        stx     firstpin               remember new first pin
p3s1.4  stx     thispin                save pointer to current pin
        jsr     fdcln                  find closest neighbor
        stx     nextpin                and swap
        beq     p3s1.5                 b/ done
        ldd     0,x
        ldx     lastpin
        std     0,x
        ldx     thispin
        ldd     0,x
        ldx     nextpin
        std     0,x
        ldd     nextpin
        ldx     thispin
        std     0,x
*       as we rearrange this wire chain, an ste (if present)
*       will sift down to become the very last entry in the
*       wire chain. if the next entry is the first pin
*       or if the next entry is an ste and the next after
*       that is the first pin, then we are done
        ldx     0,x                    get pointer to next pin
        bra     p3s1.4
        page
p3s1.5  ldx     firstpin               yes, tag first pin
        inc     1,x
        bra     p3s1l                  b/ go process next wire chain
        page
*       fdmdp-- find most distant pair of pins
*       given pointer to wire chain in (x)
*       find the two pins that are farthest apart
*       or first pin that has a name
*       (x) is guaranteed to be a pointer to a pin,
*       not a pointer to a wirelist name ste
*       (although there may be an ste pointer somewhere
*       in the chain)
*
fdmdp   stx     firstpin               this marks a reference point
        stx     bestpin                assume this is the best pin so far
        clr     distance               distance between pins
        clr     distance+1
fdmdp1  stx     thispin                working pointer
        ldd     thispin                is this entry an ste?
        subd    symboltableptr
        bcs     fdmdp2                 b/ no
        ldx     0,x                    yes, skip it
        cpx     firstpin
        beq     fdmdp10                b/ done
        stx     thispin
fdmdp2  stx     nextpin                this pointer is advanced later
        ldab    #-1
fdmdp3  incb
        leax    -2,x                   backup one pointer
        ldaa    0,x                    get first byte of pointer
        cmpa    structuretableptr      does it point to a template
        bhi     fdmdp3                 b/ no
        blo     fdmdp4                 b/ yes
        ldaa    1,x
        cmpa    structuretableptr+1
        bhs     fdmdp3                 b/ no
fdmdp4  ldx     0,x                    get template pointer
        stx     tempx
        clra                           compute offset into template
        asld
        asld
        asld
        addd    tempx
        std     tempx
        ldx     tempx                  get template pointer
        ldx     tmp:pinnameptr,x       does this pin have a name?
        beq     fdmdp5                 b/ no
        ldx     thispin                a named pin becomes the new endpoint
        rts
        page
*       this pin does not have a name
*       thispin points to it
*       setup nextpin to point to the next pin, skipping any ste pointers
*       thispin remains fixed in this loop
*       nextpin is the advancing pointer in this loop
*       compute all distances between thispin and nextpin
*       bestpin records thispin whenever a computed distance
*       exceeds the max recorded distance so far
*       done when nextpin is advanced to firstpin
*
fdmdp5  ldx     nextpin
fdmdp6  ldd     0,x                    is this an ste?
        ldx     0,x
        cmpa    symboltableptr
        blo     fdmdp7                 b/ no
        bhi     fdmdp6                 b/ yes, skip this ste
        cmpb    symboltableptr+1
        bhs     fdmdp6                 b/ yes
fdmdp7  stx     nextpin
        cpx     firstpin               done with fdmdp?
        beq     fdmdp9                 b/ yes
        jsr     dist                   find distance between thispin & nextpin
        cmpa    distance               is it greater than max distance so far?
        blo     fdmdp5                 b/ no
        bhi     fdmdp8                 b/ yes
        cmpb    distance+1
        bls     fdmdp5                 b/ no
fdmdp8  std     distance
        ldx     thispin
        stx     bestpin
        bra     fdmdp5
fdmdp9  ldx     thispin
        ldx     0,x
        cpx     firstpin
        bne     fdmdp1
fdmdp10 ldx     bestpin
        rts
        page
*       fdcln-- find next closest neighbor
*       given pointer to wire chain in (x)
*       find the next closest pin
*       THIS IS THE MOST EXPENSIVE ROUTINE IN WRAP TO EXECUTE
*
fdcln   ldd     #$ffff
        std     distance               distance between pins
        ldd     #0
        std     bestpin                remember, "no bestpin" yet
*
*       setup nextpin to point to the next pin, skipping any ste pointers
*       thispin remains fixed in this loop
*       nextpin is the advancing pointer in this loop
*       compute all distances between thispin and nextpin
*       bestpin records thispin whenever a computed distance
*       is less than the min recorded distance so far
*       done when nextpin is advanced to firstpin
*
fdcln1  stx     fdclnx
        ldd     0,x                    is this an ste?
        ldx     0,x
        cmpa    symboltableptr
        blo     fdcln2                 b/ no
        bhi     fdcln1                 b/ yes, skip this ste
        cmpb    symboltableptr+1
        bhs     fdcln1                 b/ yes
fdcln2  stx     nextpin
        cpx     firstpin               done with fdcln?
        bne     fdcln3                 b/ no
        ldx     bestpin                yes, return best pin so far
        rts

fdcln3  jsr     dist                   find distance between thispin & nextpin
        ldx     nextpin
        cmpa    distance               is it less than min distance so far?
        blo     fdcln4                 b/ yes
        bhi     fdcln1                 b/ no
        cmpb    distance+1
        bhs     fdcln1                 b/ no
fdcln4  std     distance
        stx     bestpin
        ldx     fdclnx
        stx     lastpin
        bra     fdcln1
        page
*       fnlst-- find next wire list
*       allows wire lists to be processed sequentially
*       by performing linear scan from structuretableptr
*       to structuretableend. initialized by clearing pincount.
*       if all wirelists processed, return with carry set
*       else scans to next pin
*       if pin is previously processed wirelist,
*       scan to next pin until unprocessed list found
*       returns carry clear with pointer to pin in (x)
*
fnlst   ldx     #0
        stx     firstpin
        ldx     pinptr
        leax    2,x
        stx     pinptr
        dec     pincount               done with this structure?
        bpl     fnlst2                 b/ no
        cpx     structuretableend      last structure?
        bne     fnlst1                 b/ no
        coma                           yes, no more structures, error exit
        rts

fnlst1  ldx     strt:templateptr,x     get pointer to template
        ldaa    tmp:pincount,x         get pin count
        deca                           count the pin we are about to process
        staa    pincount
        ldd     pinptr                 compute address of next pin
        addd    #strt:wirelistptr
        std     pinptr
        page
        ldx     pinptr                 get pointer to next pin
*       go all the way around the chain
*       delete the first pin marker
*       if we get all the way around without encountering
*       a pin that has a lower address than pinptr then we
*       have an unprocessed wirelist and we can return (success)
*       if we encounter a pin that has a lower address than
*       pinptr, it means that this chain has already been processed
*
fnlst2  ldd     0,x                    watch out for first pin marker
        bitb    #1
        beq     fnlst3                 b/ even
        stx     firstpin
        decb
        stab    1,x                    delete the marker
fnlst3  ldx     0,x                    get pointer to next pin
        cpx     pinptr                 all the way around once?
        bne     fnlst4                 b/ no, check for already processed
        clra                           yes, success exit
        rts

fnlst4  subd    pinptr                 already processed pin?
        bcc     fnlst2                 no, continue following this chain
        ldx     firstpin               yes, need to reinstall the fist pin tag?
        beq     fnlst                  b/ no, go try the next one
        inc     1,x                    yes
        bra     fnlst                  go try the next one
        page    phase 4: print out input, neatly formatted
p4s1i   inc     phase                  phase number is 4
        clr     linecount              force new page
        ldx     boardnameptr           did user give us a board name?
        beq     p4s1i1                 b/ no
        jsr     otsym                  b/ yes, output it
p4s1i1  ldaa    #'[                    output left bracket
        jsr     outc
        ldd     xasize                 get x axis size
        jsr     otfra                  and output it
        ldaa    #',                    output separator
        jsr     outc
        ldd     yasize                 followed by y axis size
        jsr     otfra
        jsr     otlit
        fcb     '],';,cr,cr,0          terminate with matching right bracket
        page
*       output symbolic x,y coordinates
*
        ldx     symboltableptr         setup for new symbol table scan
        stx     ptr1
p4s1x   jsr     fnsym                  find next...
        fcb     symt:xcoordinate
        fdb     p4s1x1                 b/ no more, do y coordinates
        stx     ptr2                   remember address of current symbol
        pshd                           remember the symbol value
        jsr     symcol                 force next column boundary
        fcb     0,17                   columns are 17 wide
        ldx     ptr2                   get address of current symbol
        jsr     otsym                  and output the symbol name
        jsr     otlit                  indicate 'symbolic x coordinate'
        fcb     '(,'=,0
        puld                           restore symbol value
        jsr     otfra                  and output it
        ldaa    #';                    end definition with a ';'
        jsr     outc
        bra     p4s1x                  go output another if necessary

p4s1x1  ldaa    columncount            already at col 0?
        beq     p4s1x2                 b/ yes
        jsr     crlf                   no, output a crlf first
p4s1x2  jsr     crlf
p4s1y   jsr     fnsym                  find next...
        fcb     symt:ycoordinate
        fdb     p4s1y1                 b/ no more, do templates
        stx     ptr2                   remember address of current symbol
        pshd                           remember the symbol value
        jsr     symcol                 force next column boundary
        fcb     0,17                   columns are 17 wide
        ldx     ptr2                   get address of current symbol
        jsr     otsym                  and output the symbol name
        jsr     otlit                  indicate 'symbolic x coordinate'
        fcb     '),'=,0
        puld                           restore symbol value
        jsr     otfra                  and output it
        ldaa    #';                    end definition with a ';'
        jsr     outc
        bra     p4s1y                  go output another if necessary
p4s1y1  ldaa    columncount            already at col 0?
        beq     p4s1y2                 b/ yes
        jsr     crlf                   no, output a crlf first
p4s1y2  jsr     crlf
        page
*       output template definitions
*       list template defs in alpha order
*
p4s2i   inc     step                   new title line
        clr     linecount              force new page
p4s2    jsr     fnsym                  find next symbol in alpha order
        fcb     symt:templatename      of type template
        fdb     p4s3i                  b/ no more symbols of this type
        std     templateptr            save address of the template
        jsr     otsym                  output the template name
        jsr     otlit                  indicate template definition
        fcb     ':,' ,0                leave space after colon
        ldx     templateptr            get pointer to template
        stx     ptr2
        clra
        psha                           save first pin number to output
        ldab    tmp:pincount,x         get pin count
        stab    pincount               and save it
        jsr     otint                  output the pin count
        jsr     crlf                   force column alignment on new line
p4s2p   jsr     col                    output pin displacements
        fcb     5,21                   indent count, column width
        clra
        pulb                           get pin number
        incb
        pshb
        jsr     otint                  output the pin number
        ldaa    #'(                    output left paren
        jsr     outc
        ldx     ptr2                   restore the template pointer
        ldd     tmp:x,x                get x offset
        jsr     otsfr                  output the displacement
        ldaa    #',                    output a comma
        jsr     outc
        ldx     ptr2                   restore the template pointer
        ldd     tmp:y,x                get y offset
        jsr     otsfr
        ldaa    #')                    output the right paren
        jsr     outc
        ldd     #8                     bump the pointer
        addd    ptr2
        std     ptr2
        dec     pincount               done yet?
        bne     p4s2p                  b/ no
        pula
        ldaa    #'/                    yes, output a slash
        jsr     outc
        page
*       output pin names
*
        ldaa    #1
        psha                           save first pin number to output
        ldx     templateptr            restore template scanning pointer
        stx     ptr2                   ... for next pass
        ldaa    tmp:pincount,x         get the pincount again
        staa    pincount
        jsr     crlf                   force column alignment on next line
*
p4s2n   ldx     ptr2                   restore the template pointer
        ldaa    tmp:pinnameptr,x       is there a pin name pointer?
        beq     p4s2n1                 b/ no
        ldab    tmp:pinnameptr+1,x
        jsr     fnnam                  yes, find the pin name
        fdb     p4s2n1                 b/ chain not named
        stx     pinnameptr
        ldaa    ste:len,x
        adda    #$80+3+1+1             tag, num, =, /
        jsr     symcola                align to next column boundary
        fcb     5,16                   indent count, column width
        ldx     pinnameptr
        jsr     otsym                  output the pin name
        ldaa    #'=                    followed by a '='
        jsr     outc
        clra                           output the pin number
        pulb
        pshb
        jsr     otint
p4s2n1  pula                           increment the pin number
        inca
        psha
        ldd     ptr2                   bump the pointer
        addd    #8
        std     ptr2
        dec     pincount               done yet?
        bne     p4s2n                  b/ no
        pula
        ldaa    columncount
        bne     p4s2n2
        jsr     symcola
        fcb     5,16
p4s2n2  ldaa    #'/                    yes, output a slash
        jsr     outc
        page
*       output initial wiring
*
        ldaa    #1
        psha                           save first pin number to examine
        ldx     templateptr            restore template scanning pointer
        stx     ptr2                   ... for next pass
        ldaa    tmp:pincount,x         get the pincount again
        staa    pincount
        jsr     crlf                   force column alignment on next line
*
p4s2w   ldx     ptr2                   restore the template pointer
        ldd     tmp:initialwiringptr,x is there an initial wirelist?
        ldx     tmp:initialwiringptr,x
        beq     p4s2w6                 b/ no initial wiring at all
        cmpa    symboltableptr         is this a pointer to a wirelist name?
        blo     p4s2w3                 b/ no, wirelist name not used
*       wirelist name used
        ldx     ptr2                   does this pin have a name?
        ldx     tmp:pinnameptr,x
        stx     tempx
        beq     p4s2w1                 b/ no
*
*       this named pin points to wirelist name
*
        ldd     tmp:pinnameptr,x       find the wirelist name
        jsr     fnnam
        fdb     p4s2w9
        stx     pinnameptr
        ldaa    ste:len,x              yes, get name length
        ldx     ptr2
        ldx     tmp:initialwiringptr,x
        adda    ste:len,x              tag bit + tag bit = tag bit off
        adda    #1                     + 1 for the '='
        jsr     symcola                advance column counter
        fcb     5,16
        ldx     pinnameptr
        jsr     otsym
        bra     p4s2w2                 join the other
        page
*       this unnamed pin points to wirelist name
*
p4s2w1  ldx     ptr2
        ldx     tmp:initialwiringptr,x
        ldaa    ste:len,x
*       +$80 for tag bit, + 3 for the pin number, + 1 for the '='
        adda    #$84
        jsr     symcola                advance column counter
        fcb     5,16
        clra                           output the pin number
        pulb
        pshb
        jsr     otint
p4s2w2  ldaa    #'=
        jsr     outc
        ldx     ptr2
        ldx     tmp:initialwiringptr,x
        jsr     otsym
        bra     p4s2w6                 finish up loop
*       wirelist name not used
p4s2w3  ldx     ptr2                   does this pin have a name?
        ldx     tmp:pinnameptr,x
        stx     pinnameptr
        beq     p4s2w4                 b/ no
*
*       this named pin points to an unnamed pin
*
        ldaa    ste:len,x              yes, get name length
*       +$80 for tag big, + 5 for the pin number, + 1 for the '='
        adda    #$86
        jsr     symcola                advance column counter
        fcb     5,16
        ldx     pinnameptr
        jsr     otsym
        bra     p4s2w5                 b/ go join the others
        page
*       this unnamed pin points to an unnamed pin
*
p4s2w4  jsr     col                    advance column counter
        fcb     5,16
        clra                           output source pin number
        pulb
        pshb
        jsr     otint
p4s2w5  ldaa    #'=
        jsr     outc
        ldx     ptr2
        ldd     tmp:initialwiringptr,x get pin number
        jsr     otint                  output the pin number
p4s2w6  pula                           increment the pin number
        inca
        psha
        ldd     ptr2                   bump the pointer
        addd    #8
        std     ptr2
        dec     pincount               done yet?
        beq     p4s2w7                 b/ yes
        jmp     p4s2w                  b/ no
p4s2w7  pula
        ldaa    columncount
        bne     p4s2w8
        jsr     symcola
        fcb     5,16
p4s2w8  ldaa    #';                    yes, output end of template def mark
        jsr     outc
        jsr     crlf                   output double space
        jsr     crlf
        jmp     p4s2                   and go output the next template
p4s2w9  jmp     p4s2w9                 should not happen... ever!
        page
*       output structure def
*
p4s3i   inc     step
        clr     linecount              force new page
p4s3    jsr     fnsym                  find next symbol to output
        fcb     symt:structurename     of type structure name
        fdb     p4s4i                  go to next step if done
        ldx     ste:value,x            get pointer to structure
        stx     structureptr
        ldd     strt:x,x               get x coordinate
        bsr     fxgrid                 go find symbolic x coordinate
        ldx     structureptr
        ldd     strt:y,x               get y coordinate
        jsr     fygrid                 go find symbolic y coordinate
*
*       we've located all the symbolic pieces
*       now compute the length of the next structure def
*       we are about to print so we can do column
*       alignment and print it
*
        ldx     structureptr           get pointer to structure
        ldx     strt:value,x           get pointer to structure name
        ldaa    ste:len,x              get length of structure name
        ldx     structureptr           get pointer to structure
        ldx     strt:templateptr,x     get pointer to template name
        ldx     tmp:value,x            get pointer to tempalte name
        adda    ste:len,x              tag bits cancel
*       + 3 for <space>@<space>, + 2 for (), + 1 for <comma>, + 1 for ;
        adda    #7
        jsr     sizex                  + number of chars for symbolic x coord
        jsr     sizey                  + number of chars for symbolic y coord
        jsr     symcola                a has size of thing to print
        fcb     0,35                   left margin 0, columns are 20 wide
        ldx     structureptr           get pointer to structure
        ldx     strt:value,x           get pointer to structure name
        jsr     otsym                  and print it
        jsr     otlit                  and output the ' @ '
        fcb     ' ,'@,' ,0
        ldx     structureptr           get pointer to structure
        ldx     strt:templateptr,x     get pointer to template name
        ldx     tmp:value,x
        jsr     otsym                  and print it
        ldaa    #'(                    output a '('
        jsr     outc
        jsr     outx                   print x coordinate
        ldaa    #',                    output a comma
        jsr     outc
        jsr     outy                   print y coordinate
        jsr     otlit                  and finish with ');'
        fcb     '),';,0
        bra     p4s3                   go do another
        page
*       fxgrid-- find x grid name
*       given x position in (a,b)
*       finds symbolic x coordinate closest to, but less than x
*       returns ste pointer to symbolic coordinate in symxptr
*       = 0 if no symbol found
*       returns difference in symxdelta
*
fxgrid  std     symxdelta
        ldx     #0                     remember 'no symbol found yet'
        stx     symxptr
        ldx     symboltableptr         cruise through the symbol table
        stx     tempx
        bra     fxgrid4                get cracking

fxgrid1 ldaa    ste:type,x             is this a symbolic coordinate?
        cmpa    #symt:xcoordinate      we're looking for an x coordinate
        bne     fxgrid3                b/ no
        ldd     symxdelta              is this ste <= the coordinate?
        subd    ste:value,x
        bcs     fxgrid3                b/ no, skip this one
        ldd     ste:value,x            yes, check best selection so far
        ldx     symxptr
        beq     fxgrid2                b/ there is no selection yet
        subd    ste:value,x
        bcs     fxgrid3                b/ not better than previous selection
fxgrid2 ldx     tempx                  best so far, remember this entry
        stx     symxptr
fxgrid3 ldx     tempx
        clra                           advance pointer to next ste
        ldab    ste:len,x
        addb    #$80+13                $80 makes tag bit go away
        andb    #-8                    gives number of bytes for this ste
        addd    tempx
        std     tempx
        ldx     tempx
fxgrid4 cpx     symboltableend         are we done yet?
        bne     fxgrid1                b/ no
        ldx     symxptr                get pointer to best symbol
        beq     fxgrid5                b/ no symbol
        ldd     symxdelta
        subd    ste:value,x            find difference
        std     symxdelta
fxgrid5 rts
        page
*       fygrid-- find y grid name
*       given y position in (a,b)
*       finds symbolic y coordinate closest to, but less than y
*       returns ste pointer to symbolic coordinate in symyptr
*       = 0 if no symbol found
*       returns difference in symydelta
*
fygrid  std     symydelta
        ldx     #0                     remember 'no symbol found yet'
        stx     symyptr
        ldx     symboltableptr         cruise through the symbol table
        stx     tempx
        bra     fygrid4                get cracking

fygrid1 ldaa    ste:type,x             is this a symbolic coordinate?
        cmpa    #symt:ycoordinate      we're looking for an x coordinate
        bne     fygrid3                b/ no
        ldd     symydelta              is this ste <= the coordinate?
        subd    ste:value,x
        bcs     fygrid3                b/ no, skip this one
        ldd     ste:value,x            yes, check best selection so far
        ldx     symyptr
        beq     fygrid2                b/ there is no selection yet
        subd    ste:value,x
        bcs     fygrid3                b/ not better than previous selection
fygrid2 ldx     tempx                  best so far, remember this entry
        stx     symyptr
fygrid3 ldx     tempx
        clra                           advance pointer to next ste
        ldab    ste:len,x
        addb    #$80+13                $80 makes tag bit go away
        andb    #-8                    gives number of bytes for this ste
        addd    tempx
        std     tempx
        ldx     tempx
fygrid4 cpx     symboltableend         are we done yet?
        bne     fygrid1                b/ no
        ldx     symyptr                get pointer to best symbol
        beq     fygrid5                b/ no symbol
        ldd     symydelta
        subd    ste:value,x           find difference
        std     symydelta
fygrid5 rts
        page
*       sizex-- add to (a) the size of the symbolic coordinate
*       (if there is any) + the fraction (if there is any)
*       forms of output are:
*               <symbolic x coordinate>
*               <symbolic x coordinate> + <fraction>
*               <fraction>
*
sizex   ldx     symxptr                is there a symbolic x coordinate?
        beq     sizex1                 b/ no
        adda    ste:len,x              yes, add the length
        adda    #$80                   $80 cancels tag bit
        ldx     symxdelta              is there a '+ <fraction>' part?
        beq     sizex2                 b/ no
        inca                           + 1 for the '+'
sizex1  adda    #6                     xx.xxx
sizex2  rts                            don't bother with the .0xx part
*
sizey   ldx     symyptr                is there a symbolic y coordinate?
        beq     sizey1                 b/ no
        adda    ste:len,x              yes, add the length
        adda    #$80                   $80 cancels tag bit
        ldx     symydelta              is there a '+ <fraction>' part?
        beq     sizey2                 b/ no
        inca                           + 1 for the '+'
sizey1  adda    #6                     xx.xxx
sizey2  rts                            don't bother with the .0xx part
        page
*       outx-- print symbolic x coordinate
*
outx    ldx     symxptr                is there a symbolic x coordinate?
        beq     outx1                  b/ no
        jsr     otsym                  output the symbolic x name
        ldx     symxdelta              is there a '+ <fraction>' part?
        beq     outx2                  b/ no
        ldaa    #'+                    yes, output the '+'
        jsr     outc
outx1   ldd     symxdelta              output the fraction part
        jmp     otfra
outx2   rts                            don't bother with the .0xx part
*
outy    ldx     symyptr                is there a symbolic x coordinate?
        beq     outy1                  b/ no
        jsr     otsym                  output the symbolic x name
        ldx     symydelta              is there a '+ <fraction>' part?
        beq     outy2                  b/ no
        ldaa    #'+                    yes, output the '+'
        jsr     outc
outy1   ldd     symydelta              output the fraction part
        jmp     otfra
outy2   rts                            don't bother with the .0xx part
        page
*       phase 4 step 4
*       output wirelists and cross reference
*       first lists all named wirelists in alpha order
*       then lists unnamed wirelists in alpha order according to 1st pin
*       finally lists cross-reference of pins and wirelists
*
p4s4i   jsr     crlf                   finish off the structures
        inc     step                   mark the new step
        clr     linecount              and force new page
p4s4a   jsr     fnsym                  list all named wirelists
        fcb     symt:wirelistname
        fdb     p4s41                  b/ no more named wirelists
        stx     wirelistnameptr        remember the pointer
        jsr     otsym                  output the wirelist name
        ldaa    #$20
        jsr     outc
        ldd     wirelistnameptr
        addd    #ste:value
        std     tempx
        ldx     tempx
        jsr     otwls                  now, go output the wirelist
        bra     p4s4a                  b/ keep going
*
p4s41   clr     pincount               setup for fnsw
p4s4b   jsr     fnsw                   find next structure wire
        fdb     p4s42                  b/ no more, go do cross-reference
        fdb     p4s4b                  b/ wire points to self, ignore it
        fdb     p4s4b                  b/ wire part of named wirelist, ignore
        ldaa    1,x                    is this the first pin in wirelist?
        rora                           (is pointer odd?)
        bcc     p4s4b                  b/ no, not first pin in wirelist, ignore
        jsr     otwls                  yes, output the wirelist
        bra     p4s4b                  b/ keep going
        page
p4s42   jsr     otlit                  terminate with '!'
        fcb     '!,cr,0
        inc     step                   remember that this is step 5
        clr     linecount              force new page
        clr     pincount               setup for fnsw
p4s4c   jsr     fnsw                   find next structure wire
        fdb     p5s1i                  b/ no more, on to next phase
        fdb     p4s4c1                 b/ pin points to self, output it
        fdb     p4s4c3                 b/ pin is part of named wirelist
*                                      not part of named wirelist
*
*       reserve space for <pinname> ' ' <pinname> ';'
*       print <pinname> ' ' <pinname> ';'
*
        ldaa    #2                     + 2 for ' ' and ';'
        bsr     sizepinname            find out how many chars needed
        psha                           save size
        ldx     pinptr                 get pointer to wirelist
        jsr     ffpin                  and find first pin on unnamed wirelist
        stx     wirelistnameptr        remember pointer to second symbol
        pula                           get size back
        bsr     sizepinname            find out how many chars needed
        jsr     symcola                reserve the required space
        fcb     0,35                   left margin 0, 40 chars/col
        ldx     pinptr                 get pointer to pin
        jsr     otpin                  and output the pin
        ldaa    #'                     followed by a space
        jsr     outc
        ldx     wirelistnameptr        get pointer to second symbol
        bra     p4s4c2                 finish up
*
*       reserve space for <pinname> ';'
*       print <pinname> ';'
*
p4s4c1  ldaa    #1                     + 1 for ';'
        bsr     sizepinname            find out how many chars needed
        jsr     symcola                reserve the required space
        fcb     0,35                   left margin 0, 25 chars/col
        ldx     pinptr                 get pointer to pin
p4s4c2  jsr     otpin                  and output the pin
        bra     p4s4c4                 finish up
        page
*       reserve space for <pinname> ' ' <wirelistname> ';'
*       print <pinname> ' ' <wirelistname> ';'
*
p4s4c3  stx     wirelistnameptr        remember pointer to wirelist ste
        ldaa    ste:len,x              get wirelist name symbol length
        adda    #$80+2                 + $80 to cancel tag, + 2 for ' ' and ';'
        ldx     pinptr
        bsr     sizepinname            find out how many chars needed
        jsr     symcola                reserve the required space
        fcb     0,35                   left margin 0, 25 chars/col
        ldx     pinptr                 get pointer to pin
        jsr     otpin                  and output the pin
        ldaa    #'                     followed by a space
        jsr     outc
        ldx     wirelistnameptr        get pointer to second symbol
        jsr     otsym                  and output the pin
p4s4c4  ldaa    #';                    finish with a ';'
        jsr     outc
        bra     p4s4c                  and do some more
        page
*       sizepinname-- add size of pin name to (a)
*       x points to pin
*       pinnames are printed in the form:
*               <structurename> '-' <pinnumber> [ '(' <pinname> ')' ]
*       examples:
*               shf2-12(clk)
*               par-14
*
sizepinname
        staa    tempa                  this holds symbol size
        clrb                           this holds number of pins
*
*       scan backwards until we hit the template pointer
*       pointers to pins are >= structuretableptr and < symboltableptr
*       pointers to wirelistnames are >= symboltableptr
*       pointers to templates are < structuretableptr
*
spnn1   incb                           count 1 pin
        leax    -2,x                   backup and check for template ptr
        ldaa    0,x                    get first byte of pointer
        cmpa    structuretableptr      does it point to a template?
        bhi     spnn1                  b/ no, keep going
        blo     spnn2                  b/ yes, x points to strt:templateptr
        ldaa    1,x
        cmpa    structuretableptr+1
        bhs     spnn1                  b/ no, keep going
*
*       (b) has pin number
*       add up the number of digits required to print pin number
*
spnn2   stab    tempb
        inc     tempa                  1 digit, minimum
        cmpb    #10                    is there at least 2 digits?
        blo     spnn3                  b/ no, only 1
        inc     tempa                  yes, 2 digits minimum
        cmpb    #100                   is there 3 digits?
        blo     spnn3                  b/ no, only 2
        inc     tempa                  yes, 3 digits
spnn3   stx     tempx
        ldd     tempx                  compute pointer to structure
        subd    #strt:templateptr
        std     tempy
        ldx     tempy                  x now points to beginning of structure
        ldx     strt:templateptr,x     get pointer to template
        stx     tempx                  compute template offset for this pin
        clra
        ldab    tempb
        decb
        asld
        asld
        asld
        addd    tempx
        std     tempx
        ldaa    tempa                  get back the size subtotal
        ldx     tempx
        ldx     tmp:pinnameptr,x       get pointer to pin name
        beq     spnn5                  b/ pin not named
        stx     tempx                  named, remove offset to find ste start
        ldd     tempx
        jsr     fnnam
        fdb     spnn4
spnn4   ldaa    tempa                  get back the size subtotal
        adda    ste:len,x              add size of pin name
        adda    #$80+2                 + 2 for (), + $80 to remove tag bit
spnn5   ldx     tempy                  get pointer to structure
        ldx     strt:value,x           get pointer to structure name
        adda    ste:len,x              add size of structure name
        adda    #$80+1                 + 1 for the '-', + $80 to remove tag bit
        rts
        page
*       otpin-- output pin name
*       x points to pin
*       pinnames are printed in the form:
*               <structurename> '-' <pinnumber> [ '(' <pinname> ')' ]
*       examples:
*               shf2-12(clk)
*               par-14
*
otpin   clrb                           this holds number of pins
*
*       scan backwards until we hit the template pointer
*       pointers to pins are >= structuretableptr and < symboltableptr
*       pointers to wirelistnames are >= symboltableptr
*       pointers to templates are < structuretableptr
*
otpin1  incb                           count 1 pin
        dex                            backup and check for template ptr
        dex
        ldaa    0,x                    get first byte of pointer
        cmpa    structuretableptr      does it point to a template?
        bhi     otpin1                 b/ no, keep going
        blo     otpin2                 b/ yes, x points to strt:templateptr
        ldaa    1,x
        cmpa    structuretableptr+1
        bhs     otpin1                 b/ no, keep going
*
*       (b) has pin number
*       print the structure name
*
otpin2  pshb                           save the pin number on the stack
        stx     tempx                  compute pointer to structure
        ldd     tempx
        subd    #strt:templateptr
        std     otpinx                 save the structure pointer
        ldx     otpinx                 x now points to beginning of structure
        ldx     strt:value,x           get pointer to structure name
        jsr     otsym                  print the structure name
        ldaa    #'-                    output the '-'
        jsr     outc
        clra                           get the pin number
        pulb
        pshb
        jsr     otint                  print the pin number
        ldx     otpinx
        ldx     strt:templateptr,x     get pointer to template
        stx     tempy
        clra
        pulb
        decb
        asld
        asld
        asld
        addd    tempy
        std     tempy
        ldx     tempy
        ldx     tmp:pinnameptr,x       get pointer to pin name
        beq     otpin4                 b/ pin not named
        stx     otpinx                 pin has a name, save pointer to it
        ldaa    #'(
        jsr     outc
        ldd    otpinx
        jsr     fnnam
        fdb     otpin3
otpin3  jsr     otsym                  print the pin name
        ldaa    #')
        jmp     outc
otpin4  rts
        page
*       otwls-- output wirelist
*       using pointer to wirelist in (x)
*       prints wirelist in canonical form
*
otwls   stx     tempx                  is this a real wirelist?
        beq     otwls4                 b/ no, a dummy
        jsr     ffpin                  find first pin on chain
otwls1  stx     thispin                remember pointer to this pin
otwls2  ldd     0,x                    get pointer to next wirelist node
        andb    #$fe                   ensure even pointer
        std     nextpin
        ldx     nextpin                skip this node if ste
        cmpa    symboltableptr
        blo     otwls3                 b/ not an ste
        bhi     otwls2                 b/ ste, skip this one
        cmpb    symboltableptr+1
        bhs     otwls2                 b/ ste, skip this one
otwls3  ldaa    1,x                    (is next pin first of list?)
        anda    #1                     (is it odd?)
        ldx     thispin                is next pin 'first of list'?
*       + 1 for ';' if last pin, else + 0
        jsr     sizepinname            find out how many chars needed
        bsr     otwlscola              ensure enough room for output
        ldx     thispin                get the pointer to the pin
        jsr     otpin                  output the pin
        ldx     nextpin                follow pointer
        ldaa    1,x                    is this the first pin?
        rora
        bcs     otwls4                 b/ yes, done
        ldaa    #9                     output ' [xx.xxx]'
        bsr     otwlscolb              ensure enough room on this line
        jsr     otlit
        fcc     / [/
        fcb     0
        bsr     dist                   compute distance
        jsr     otfra                  output the distance
        jsr     otlit                  output the trailing ']'
        fcb     '],' ,0
        ldx     nextpin
        bra     otwls1
*
otwls4  jsr     otlit                  output the trailing ';
        fcb     ';,cr,cr,0
        rts                            done
        page
otwlscola
        adda    columncount            is there enough room on this line?
        cmpa    linewidth
        blo     otwlscola1             b/ yes
        jsr     otlit                  b/ no, output new line and 5 spaces
        fcb     cr
        fcc     /     /
        fcb     0
otwlscola1
        rts
*
otwlscolb
        adda    columncount            is there enough room on this line?
        cmpa    linewidth
        blo     otwlscola1             b/ yes
        jsr     otlit                  b/ no, output new line and 4 spaces
        fcb     cr
        fcc     /    /
        fcb     0
        rts
        page
*       dist-- find distance between two pins
*       thispin, nextpin point to pins
*       returns distance as fraction in (a,b)
*       HEAVILY EXECUTED, NEEDS TO BE FAST!
*
dist    ldx     thispin                get pointer to first pin
        bsr     fpinc                  get x,y coordinates
        stx     xcoordinate            save the coordinates
        std     ycoordinate
        ldx     nextpin                get pointer to the other pin
        bsr     fpinc                  get x,y coordinates
        subd    ycoordinate            compute delta-y
        bcc     dist1                  b/ number is positive
        negd                           take absolute value
dist1   std     ycoordinate
        stx     tempx
        ldd     tempx
        subd    xcoordinate
        bcc     dist2                  b/ number is positive
        negd
dist2   std     tempx
        ldx     tempx
        jsr     squarx                 square delta-x
        ldx     product32              save x squared
        stx     xsquared
        ldx     product32+2
        stx     xsquared+2
        ldx     ycoordinate            square delta-y
        jsr     squarx
        ldd     product32+2            add (delta-x)**2 to (delta-y)**2
        addd    xsquared+2
        std     product32+2
        ldd     product32
        adcb    xsquared+1
        adca    xsquared
        std     product32
        jmp     sqrt                   compute sqrt(deltax**2-deltay**2)
        page
*       fpinc-- find pin coordinates
*       x points to pin coordinates
*       returns (x,y) pin position in (x,a,b)
*
fpinc   clrb                           this holds the pin number
*
*       scan backwards until we hit the template pointer
*       pointers to pins are >= structuretableptr and < symboltableptr
*       pointers to wirelistnames are >= symboltableptr
*       pointers to templates are < structuretableptr
*
fpinc1  incb                           count 1 pin
        leax    -2,x                   backup and check for template ptr
        ldaa    0,x                    get first byte of pointer
        cmpa    structuretableptr      does it point to a template?
        bhi     fpinc1                 b/ no, keep going
        blo     fpinc2                 b/ yes, x points to strt:templateptr
        ldaa    1,x
        cmpa    structuretableptr+1
        bhs     fpinc1                 b/ no, keep going
*
*       (b) has pin number
*       compute starting address of structure and get (x,y) position
*
fpinc2  stab    tempb                  save the pin number
        stx     tempx                  compute pointer to structure
        ldd     tempx
        subd    #strt:templateptr
        std     tempx
        ldx     tempx                  x points to start of structure
        clra                           compute offset into template
        ldab    tempb
        decb
        asld                           * 2
        asld                           * 4
        asld                           * 8
        addd    strt:templateptr,x
        std     tempa
        ldd     strt:x,x               get x coordinate
        std     tempx
        ldd     strt:y,x               get y coordinate
        std     tempy
        ldx     tempa                  get pointer to structure
        ldd     tmp:x,x                get x offset
        addd    tempx
        std     tempx
        ldd     tmp:y,x                get y offset
        addd    tempy
        ldx     tempx                  (x) has x coordinate, (a,b) have y
        rts                            done
        page
*       sizeint-- compute number of digits required to print this integer
*       ab has integer to size, return number of digits in a
*
sizeint clr     tempa                  count number of digits required
        cmpa    #10000/256             at least 5 digits?
        bhi     sint5d                 b/yes
        blo     sint1                  b/ no
        cmpb    #10000&$ff
        bhs     sint5d                 b/ yes
sint1   cmpa    #1000/256              at least 4 digits?
        bhi     sint4d                 b/ yes
        blo     sint2                  b/ no
        cmpb    #1000&$ff
        bhs     sint4d                 b/ yes
sint2   tsta                           at least 3 digits? ( >100 ? )
        bne     sint3d                 b/ yes
        cmpb    #100&$ff
        bhs     sint3d                 b/ yes
sint3   cmpb    #10&$ff                at least 2 digits?
        bhs     sint2d                 b/ yes
sint1d  ldaa    #1                     at least 1 digit, always
        rts
sint2d  ldaa    #2
        rts
sint3d  ldaa    #3
        rts
sint4d  ldaa    #4
        rts
sint5d  ldaa    #5
        rts
        page
*       sizesfr-- compute number of digits required to print this
*       signed fraction.
*       ab has fraction to size, return number of digits in a
*
sizesfr tsta                           is it negative?
        bpl     sizefr                 b/ no, go size it
        nega                           yes, take abs
        negb
        sbca    #0
        bsr     sizefr                 size the fraction
        inca                           and add 1 for the '-'
        rts
*
*       sizefr-- compute number of digits required to print this fraction
*       ab has fraction to size, return number of digits in a
*
sizefr  jsr     bindec                 count number of digits required
        ldaa    #3                     x.x minimum number of digits
        ldab    bcdbuf                 is there a leading digit?
        beq     sizefr1                b/ no
        inca                           yes, count it
sizefr1 ldx     bcdbuf+3               are there trailing digits?
        beq     sizefr2                b/ no, done
        inca                           at least one more digit
        ldab    bcdbuf+4               another trailing digit?
        beq     sizefr2                b/ no, done
        inca
sizefr2 rts                            done
        page
*       got a wire
*       thispin, nextpin point to ends
*       binsize contains wire size to use
*       ensure enough space on line for wire output:
*               51 1: shf2-10 [4.0] par-2(q)
*
printwire
        ldd     wirenumber             size the wirenumber
        addd    #1
        std     wirenumber
        bsr     sizeint
        psha
        ldd     binsize                size the fraction part
        addd    #wirestepsize
        bsr     sizefr
        staa    tempa
        pula
        adda    tempa
        adda    #8                     ' 1: ', ' [', '] '
        ldx     thispin
        jsr     sizepinname            size the first pin name
        ldx     nextpin
        jsr     sizepinname            size the second pin name
        jsr     symcola                get the column position ready
        fcb     0,35                   columns are 35 chars wide
*
        ldd     wirenumber             output the wirenumber
        jsr     otint
        ldaa    #'                     followed by a ' '
        jsr     outc
        ldaa    #'1                    assume level 1
        ldab    level                  1=level1, 0=level2
        bne     printwire1
        inca
printwire1
        jsr     outc                   output the level number
        jsr     otlit                  followed by ': '
        fcb     ':,' ,0
        ldx     thispin                output the first pin name
        jsr     otpin
        jsr     otlit                  followed by ' ['
        fcb     ' ,'[,0
        ldd     binsize
        addd    #wirestepsize
        jsr     otfra                  output the fraction
        jsr     otlit                  followed by '] '
        fcb     '],' ,0
        ldx     nextpin                output the second pin name
        jmp     otpin
        page    phase 5: output wirelist by levels and size in sorted order
*       phase 5-- output wirelists by levels
*       sorts wires in wirelists first by level
*       then by size and outputs them
*       according to lowest level, longest size
*
p5s1i   jsr     crlf
        ldx     #$501
        stx     phase
        clr     linecount              force new page
*
*       sort wires by wiresize
*       for first pass, select maximum wiresize
*       during each pass, remember the wiresize needed for the next pass
*       just so we understand one another, level 1 wires are the ones
*       closest to the board, level 2 wires are on top
*       do level 1 wires first (but of course!)
*
        ldx     #0
        stx     wirenumber             wire number
        ldaa    #1                     start with level 1 wires first
        staa    level                  1=level1, 0=level2, -1=done
nextlevel
        ldx     #maxwiresize
        stx     binsize                wiresize we are working on
nextwirelength
        ldx     #0
        stx     nextbinsize            wiresize of next pass
        ldx     structuretableptr      setup for fnlst
        leax    -2,x
        stx     pinptr
        clr     pincount
nextwirechain
        jsr     fnlst                  get a wirelist chain
        bcs     nwcexit                b/ no more chains
        ldx     firstpin               
        stx     thispin
*
*       we just got a fresh wirelist chain
*       if this is level 2, skip the first pin
*
        ldaa    level                  1=level1, 0=level2
        beq     level2wire             b/ level 2
        page
nextwire
        ldd     0,x
        cmpa    symboltableptr         is this an ste?
        blo     nw2                    b/ no
        bhi     nw1                    b/ yes
        cmpb    symboltableptr+1
        blo     nw2                    b/ no
nw1     ldx     0,x                    skip the ste
nw2     ldx     0,x                    we still have to advance 1 node
        cpx     firstpin               all the way around once?
        beq     nwexit                 b/ yes
        stx     nextpin
        bsr     wlnth                  get length of wire between pair of pins
        cmpa    binsize                is this wire too small for this pass?
        bhi     nw5                    b/ no
        blo     nw3                    b/ yes
        cmpb    binsize+1
        bhs     nw5                    b/ no
nw3     cmpa    nextbinsize            bigger than proposed next pass wiresize?
        blo     nw7                    b/ no
        bhi     nw4                    b/ yes
        cmpb    nextbinsize+1
        bls     nw7                    b/ no
nw4     std     nextbinsize
        bra     nw7                    b/ still a reject
        page
*       we have a candidate wire
*       check to see that it is smaller than binsize + wirestepsize
*
nw5     subd    #wirestepsize
        cmpa    binsize
        blo     nw6                    b/ a winner!
        bhi     nw7                    b/ a reject! go examine next wire
        cmpb    binsize+1
        bhs     nw7                    b/ a reject! go examine next wire
nw6     jsr     printwire              print the winner
nw7     ldx     nextpin
level2wire
        ldd     0,x
        cmpa    symboltableptr         is this an ste?
        blo     nw9                    b/ no
        bhi     nw8                    b/ yes
        cmpb    symboltableptr+1
        blo     nw9                    b/ no
nw8     ldx     0,x                    skip the ste
nw9     ldx     0,x                    we still have to advance 1 node
        stx     thispin
        cpx     firstpin               done with wire chain?
        bne     nextwire               b/ no
nwexit  inc     1,x                    reinstall the first pin tag
        bra     nextwirechain          b/ go do next wire chain
        page
*       no more wirelists this pass
*       find out the new binsize by rounding down to
*       next multiple of stepsize
*
nwcexit ldd     binsize                start with current bin size
nwc1    subd    #wirestepsize          and back off until <= next bin size
        cmpa    nextbinsize            done?
        bhi     nwc1                   b/ no, still too big
        blo     nwc2                   b/ yes, (a,b) now have new bin size
        cmpb    nextbinsize+1
        bhi     nwc1                   b/ no
nwc2    std     binsize
        bne     nwc3                   b/ ok to go again
        tsta
        beq     nwc4                   b/ all wiresizes tried, done with level
nwc3    jmp     nextwirelength         b/ do another pass with new wiresize
nwc4    dec     level                  yes, try next level
        bmi     nwc5                   b/ done with all levels
        jmp     nextlevel              b/ go again for new level
nwc5    jsr     crlf                   finish up the line
        ldx     #exit                  b/ i'm done i think
        jsr     callsyscall
        swi
        page
*       wlnth-- compute wirelength between two pins
*       computes actual length of insulation required for a wire
*       rounding to next step size up is done by fnwww
*       thispin, nextpin point to pins
*       computes wlnth = fudgesize + sqrt(x**2 + y**2 + pinht**2)
*       returns distance as fraction in (a,b)
*
wlnth   ldx     thispin                get pointer to first pin
        jsr     fpinc                  get x,y coordinates
        stx     xcoordinate            save the coordinates
        std     ycoordinate
        ldx     nextpin                get pointer to the other pin
        jsr     fpinc                  get x,y coordinates
        subd    ycoordinate            compute delta-y
        bcc     wlnth1                 b/ number is positive
        negd
wlnth1  std     ycoordinate
        stx     tempx                  compute delta-x
        ldd     tempx
        subd    xcoordinate
        bcc     wlnth2                 b/ number is positive
        negd
wlnth2  std     tempx
        ldx     tempx
        jsr     squarx                 square delta-x
        ldx     product32              save x squared
        stx     xsquared
        ldx     product32+2
        stx     xsquared+2
        ldx     ycoordinate            square delta-y
        jsr     squarx
        ldd     product32+2            add (delta-x)**2 to (delta-y)**2
        addd    xsquared+2
        std     product32+2
        ldd     product32
        adcb    xsquared+1
        adca    xsquared
        std     product32
        ldd     product32+2            add (pinheigth)**2
        addd    pinheigth2+2
        std     product32+2
        ldd     product32
        adcb    pinheigth2+1
        adca    pinheigth2
        std     product32
        jsr     sqrt                   compute distance
        addd    #fudgesize             for insulation wrapped around post
        cmpa    #minwiresize/256       must be at least this big
        bhi     wlnth4                 b/ it is
        blo     wlnth3                 b/ it isn't
        cmpb    #minwiresize&$ff
        bhs     wlnth4                 b/ it is
wlnth3  ldd     #minwiresize           too small, force minimum wire size
wlnth4  rts
        page
wwe1    jsr     wwerr
        fcc     'New symbol required'
        fcb     0
wwe2    jsr     wwerr
        fcc     'Bad syntax (missing or wrong terminator)'
        fcb     0
wwe3    jsr     wwerr
        fcc     'Missing number (fraction)'
        fcb     0
wwe4    jsr     wwerr
        fcc     'Number too large'
        fcb     0
wwe5    jsr     wwerr
        fcc     'Missing integer'
        fcb     0
wwe6    jsr     wwerr
        fcc     'Signed fraction too large'
        fcb     0
wwe7    jsr     wwerr
        fcc     'Pin number too large for template'
        fcb     0
wwe8    jsr     wwerr
        fcc     'Pin already has displacement defined'
        fcb     0
wwe9    jsr     wwerr
        fcc     'Pin already named'
        fcb     0
wwea    jsr     wwerr
        fcc     'Initial wiring for pin already defined'
        fcb     0
wweb    jsr     wwerr
        fcc     'Initial wiring must be pin name, signal name, or pin number'
        fcb     0
wwec    jsr     wwerr
        fcc     'Symbol is not a signal name'
        fcb     0
wwed    jsr     wwerr
        fcc     'Template allocation exceeds available space'
        fcb     0
wwee    jsr     wwerr
        fcc     'Pin outside x bounds due to structure placement'
        fcb     0
wwef    jsr     wwerr
        fcc     'Pin outside y bounds due to structure placement'
        fcb     0
wwe10   bra     wwe10                  not used
wwe11   jsr     wwerr
        fcc     'Pin number or pin name expected'
        fcb     0
wwe12   jsr     wwerr
        fcc     "Expected template name isn't a name or isn't a template"
        fcb     0
wwe13   jsr     wwerr
        fcc     'Structure allocation exceeds available space'
        fcb     0
wwe14   jsr     wwerr
        fcc     'Terminator is illegal as signal name or structure name'
        fcb     0
wwe15   jsr     wwerr
        fcc     'Name is not a signal or structure'
        fcb     0
wwe16   jsr     wwerr
        fcc     'Wirelist already has name'
        fcb     0
wwe17   jsr     wwerr
        fcc     "Can't use template internal w/o structure specification"
        fcb     0
wwe18   jsr     wwerr
        fcc     "Can't use fraction as pin number"
        fcb     0
wwe19   jsr     wwerr
        fcc     'Program accurate to no more than .001 inch'
        fcb     0
wwe1a   jsr     wwerr
        fcc     'Symbol too long'
        fcb     0
wwe1b   jsr     wwerr
        fcc     'Symbol table full'
        fcb     0
wwe1c   jsr     wwerr
        fcc     'No such pin name'
        fcb     0
wwe1d   jsr     wwerr
        fcc     "Can't use pin number until structure specified"
        fcb     0
wwe1e   jsr     wwerr
        fcc     'Board dimensions must be > 0.0'
        fcb     0
wwe1f   jsr     wwerr
        fcc     'Pin name not defined for this socket'
        fcb     0
wwe20   bra     wwe20                  not used
wwe21   jsr     wwerr
        fcc     'Board is too big'
        fcb     0
wwe22   bsr     wwerr
        fcc     'Total number of pins in template must be <= 255'
        fcb     0
wwe23   bsr     wwerr
        fcc     'Sum too large or difference is negative'
        fcb     0
wwe24   bsr     wwerr
        fcc     'Pin number of zero is illegal'
        fcb     0
        page
wwerr   puld                           get address of error message
        std     wwex
*
*       output the error message
*
wwerr1  ldx     wwex                   get next byte
        ldaa    0,x                    done?
        beq     wwerr2                 b/ yes
        inx
        stx     wwex
        jsr     outc
        bra     wwerr1
wwerr2  jsr     crlf
*
*       output the error line
*
        clrb
        ldx     #inputbuffer           find end of input
wwerr3  incb
        ldaa    0,x
        inx
        cmpa    #cr
        bne     wwerr3
        ldx     #writeaerrorline
        stab    7,x
        jsr     callsyscall
        ldx     #exit
        jsr     callsyscall
        page
*       squarx-- square regx
*       leaves double precision result in product32
*       speed of this routine is very important during wire chain optimization phase
*       ?? perhaps choice of regx was wrong: should use (D)
*       !! closer inspection reveals not much gain doing that.
*
squarx  stx     tempx                 initialize

        ldaa    tempx                 form products of upper halves
        ldab    tempx
        mul
        std     product32

        ldaa    tempx+1               form products of lower halves
        ldab    tempx+1
        mul
        std     product32+2

        ldd     tempx                 form cross product upper*lower
        mul
        asld                          double to form 2*cross product
        bcc     square1               b/ no information lost
        inc     product32
square1
        addd    product32+1           add 2*crossproduct to middle part
        bcc     square2               b/ no carry
        inc     product32
square2
        std     product32+1
        rts
        page
        if      m6800!m6801!m6811
mul6809 ; compute product of (A)*(B), put product in (D)
        staa    tempa                 save multiplicand
        clra                          zero product
        rorb                          inspect 1st multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 2nd multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 3rd multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 4th multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 5th multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 6th multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 7th multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          inspect 8th multiplier bit
        bcc     *+4                   b/ multiplier bit is zero
        adda    tempa                 add multiplicand to product
        rora                          right shift partial product
        rorb                          finish placing final product
        rts
        fin
        page
*       sqrt-- takes square root of product32
*       leaves result in ROOT, (D)
*       destroys product32
*       computes sqrt via alg given in "computing the sqrt of bin #'s"
*       computer design, aug 8, 1972
*       if sqrt(product32) > 65535, will not work!
*       speed of this routine is very important during wire chain optimization phase
;       assert: since small square roots are more frequent than large
;       square roots, the number of "1" bits generated is small.
;       so we want to optimize the "0" generating path the most.

sqrt    ldx     #0                     clear the root
        stx     root
        stx     rem                    clear the remainder
        ldab    product32              set up initial loop condition
        clra                           put zero in lower 8 bits of remainder
;       bra     sqrtc1                 skip into loop

; *** Generate 1st square root bit
;sqrts1  ; (A) has lower 8 bits of REM in it
;       ; (B) has top 8 bits of product32 in it
;       asl     product32+1            (6~) shift left dividend 2 bits
;       rold                           (4~) save (r*4) - (q*4 + 1)
;       rol     rem                    (6~)
;       asl     product32+1            (6~)
;       rold                           (4~)
;       rol     rem                    (6~)
sqrtc1  cmpb    #$40                   (2~) see if (r*4) >= (q*4 + 1)
        psha                           (4~) save lower 8 bits of rem if we're wrong
        sbca    root+1                 (3~)
        ldaa    rem                    (3~)
        sbca    root                   (3~)
        bcs     sqrtz1                 (4~) b/ it isn't, go undo
        staa    rem                    (.5*4~)
        subb    #$40                   (.5*2~)
        pula                           (.5*4~)
        sbca    root+1                 (.5*3~)
        sec                            (.5*2~) set carry
        rol     root+1                 (.5*6~) and shift in a 1 bit
        bra     sqrtr1                 (.5*4~) merge with main flow

sqrtz1 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           (.5*4~) restore lower 8 bits of remainder
        asl     root+1                 (.5*6~) and shift in a 0 bit
sqrtr1  rol     root                   (6~)
;                                      ------
;                                      (72~) average
        page
; *** Generate 2nd square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+1            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+1
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz2                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr2                 merge with main flow

sqrtz2 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr2  rol     root
        page
; *** Generate 3rd square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+1            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+1
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz3                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr3                 merge with main flow

sqrtz3 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr3  rol     root
        page
; *** Generate 4th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+1            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+1
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz4                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr4                 merge with main flow

sqrtz4 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr4  rol     root
        page
; *** Generate 5th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+1            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+1
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz5                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr5                 merge with main flow

sqrtz5 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr5  rol     root
        page
; *** Generate 6th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+2            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+2
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz6                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr6                 merge with main flow

sqrtz6 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr6  rol     root
        page
; *** Generate 7th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+2            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+2
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz7                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr7                 merge with main flow

sqrtz7 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr7  rol     root
        page
; *** Generate 8th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+2            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+2
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz8                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr8                 merge with main flow

sqrtz8 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr8  rol     root
        page
; *** Generate 9th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+2            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+2
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz9                 b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr9                 merge with main flow

sqrtz9 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr9  rol     root
        page
; *** Generate 10th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+3            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+3
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz10                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr10                merge with main flow

sqrtz10 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr10 rol     root
        page
; *** Generate 11th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+3            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+3
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz11                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr11                merge with main flow

sqrtz11 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr11 rol     root
        page
; *** Generate 12th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+3            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+3
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz12                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr12                merge with main flow

sqrtz12 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr12 rol     root
        page
; *** Generate 13th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
        asl     product32+3            shift left dividend 2 bits
        rold                           save (r*4) - (q*4 + 1)
        rol     rem
        asl     product32+3
        rold
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz13                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr13                merge with main flow

sqrtz13 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr13 rol     root
        page
; *** Generate 14th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
;       asl     product32+4            shift left dividend 2 bits
        asld                           save (r*4) - (q*4 + 1)
        rol     rem
;       asl     product32+4
        asld                           NOTE MINOR SPEEDUP HERE
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz14                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr14                merge with main flow

sqrtz14 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr14 rol     root
        page
; *** Generate 15th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
;       asl     product32+4            shift left dividend 2 bits
        asld                           save (r*4) - (q*4 + 1)
        rol     rem
;       asl     product32+4
        asld
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz15                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr15                merge with main flow

sqrtz15 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr15 rol     root
        page
; *** Generate 16th square root bit
        ; (A) has lower 8 bits of REM in it
        ; (B) has top 8 bits of product32 in it
;       asl     product32+4            shift left dividend 2 bits
        asld                           save (r*4) - (q*4 + 1)
        rol     rem
;       asl     product32+4
        asld
        rol     rem
        cmpb    #$40                   see if (r*4) >= (q*4 + 1)
        psha                           save lower 8 bits of rem if we're wrong
        sbca    root+1
        ldaa    rem
        sbca    root
        bcs     sqrtz16                b/ it isn't, go undo
        staa    rem
        subb    #$40
        pula
        sbca    root+1
        sec                            set carry
        rol     root+1                 and shift in a 1 bit
        bra     sqrtr16                merge with main flow

sqrtz16 ; fast path, do as little as possible (0 bits more common than 1 bits)
        pula                           restore lower 8 bits of remainder
        asl     root+1                 and shift in a 0 bit
sqrtr16 rol     root

; **** Done generating quotient bits
        ldd     root                   return final result in (D) as promised
        rts                            yes
        page
*       issyt-- is symbol of type ...?
*       (exit+1) if next object is symbol of type (return)
*       else reject object, take exit+3
*
issyt   jsr     gnobj                  get next object
        fdb     issyt3                 b/ symbol, might be ok
        fdb     issyt1                 b/ number, fail
*                                      terminator, fail
issyt1  pulx                           get return address
issyt2  com     ns.rejected            reject the object
        jmp     3,x                    fail exit
*
issyt3  pulx                           symbol, check type
        cmpa    0,x                    is it the right type?
        bne     issyt2                 b/ no
        ldd     1,x                    get success return address
        pshd
        ldx     symbolptr              return the symbol value
        ldd     ste:value,x
        rts
        page
*       gtuds-- get undefined symbol
*       exit if next object is an undefined smbol
*       otherwise, object is rejected
*       gives double definition error if defined symbol
*       else gives syntax error
*
gtuds   jsr     gnobj                  get next object
        fdb     gtud2                  symbol, may be ok
        fdb     gtud1                  number, fail
        staa    rejectchar             reject possible '; for error scan
gtud1   inc     ns.rejected
        jmp     wwe1                   terminator, fail
*
gtud2   cmpa    #symt:udfsymbol        symbol, is it defined?
        bne     gtud1                  b/ yes, error
        ldx     ns.value               get address of ste for new symbol
        rts                            done
*
*       gttrm-- get terminator
*       (rtn) is terminator to be matched
*       exit+2 if match
*       else reject object, exit to syntax error routine
*
gttrm   jsr     gnobj                  get next object
        fdb     gtud1                  symbol, fail
        fdb     gtud1                  number, fail
        pulx                           get address of terminator
        cmpa    0,x
        bne     gtud1                  b/ no match
        jmp     1,x                    b/ match, return
        page
*       gtfra-- get fraction
*       exit with fraction value in x
*       else calls syntax
*       converts integers to fractional equivalents
*
gtfra   jsr     gnobj                  get next object
        fdb     gtfra1                 b/ symbol, give error
        fdb     gtfra2                 b/ number ok
gtfra1  inc     ns.rejected            terminator, reject it
        jmp     wwe3                   and give error

gtfra2  cmpa    #symt:integer          is it an integer?
        bne     gtfra3                 b/ no, must be fraction
        clra                           yes, convert to fraction
        bsr     mul10a0
        clra
        bsr     mul10a0
        clra
        bsr     mul10a0
        ldaa    #symt:fraction         set new fraction
        staa    ns.type
gtfra3  ldd     ns.value
        ldx     ns.value
        rts                            done
        page
*       multiply ns.value by 10 and add ascii digit in rega
*
mul10a  suba    #'0                    convert ascii digit to binary
mul10a0 staa    tempx
        asl     ns.value+1             *2
        rol     ns.value
        bcs     mul10a1                b/ significance lost
        ldd     ns.value
        asld                           *4
        bcs     mul10a1                b/ significance lost
        asld                           *8
        bcs     mul10a1                b/ significance lost
        addd    ns.value               *8 + *2 = *10
        bcs     mul10a1                b/ significance lost
        addb    tempx
        adca    #0
        bcs     mul10a1                b/ significance lost
        std     ns.value
        rts

mul10a1 jmp     wwe4                   b/ significance lost
        page
*       gtsfr-- get signed fraction
*       like gtfra, but allows preceeding '- sign
*       if '- sign given, returns 2's complement of result
*
gtsfr   ldaa    #1                     assume negative
        staa    sign
        bsr     isobj                  is next object a '-' sign?
        fcb     '-
        fdb     gtsfr1                 b/ yes, flag already set
        clr     sign                   no, clear flag
gtsfr1  bsr     gtfra                  get a fraction
        tsta                           is sisn bit set?
        bpl     gtsfr2                 b/ no
        jmp     wwe6                   b/ yes, give overflow error
gtsfr2  tst     sign                   is it negative?
        beq     gtsfr3                 b/ no, done
        negd                           yes, do 2's complement
        std     ns.value
gtsfr3  rts                            done
        page
*       isobj-- is next object a ...?
*       terminator to be matched is (return)
*       (exit+1) if yes
*       else exit+3, object is rejected
*
isobj   jsr     gnobj                  get next object
        fdb     isobj1                 symbol, fail
        fdb     isobj1                 number, fail
        pulx                           get return address
        cmpa    0,x                    is this the terminator he wants?
        bne     isobj2                 b/ no, fail
        ldx     1,x
        jmp     0,x
*
isobj1  pulx                           get return address
*
isobj2  com     ns.rejected            reject the object
        jmp     3,x                    fail
*
*       gtpnn-- get pin number
*       if next object is not an integer gives syntax error
*       takes exit if integer is less than pincount
*       pin numer - 1 is returned in (a,b)
*       else gives pin number error
*
gtpnn   bsr     gtint                  get an integer
gtpnn0  tsta                           is it a reasonable number?
        bne     gtpnn1                 b/ no, error
        cmpb    pincount               ...?
        bhi     gtpnn1                 b/ no, error
        tstb                           did he use pin number 0?
        beq     gtpnn2                 b/ yes, that's not nice
        decb                           make origin 0
        rts

gtpnn1  jmp     wwe7                   b/ unreasonable number

gtpnn2  jmp     wwe24                  b/ 0 was used as a pin number
        page
*       gtint-- get an integer
*       exit if integer encounered
*       else give syntax error
*
gtint   jsr     gnobj                  get next objtect
        fdb     wwe5                   b/ symbol, give error
        fdb     gtint1                 b/ number, go check type
gtint1  cmpa    #symt:integer          is it an integer?
        beq     gtint2                 b/ yes
        com     ns.rejected            reject the object
        jmp     wwe5                   b/ fail
gtint2  ldd     ns.value
        rts
*
*       isint- is next object an integer?
*       exit+2 if yes
*       (exit) if not after rejecting object
*
isint   jsr     gnobj                  get next object
        fdb     isint2                 b/ symbol, reject
        fdb     isint1                 b/ number, check for integer type
isint1  pulx
        cmpa    #symt:integer          is it an integer?
        bne     isint3                 b/ no, fail
        ldd     ns.value
        jmp     2,x
*
isint2  pulx                           get return address
*
isint3  com     ns.rejected            reject the object
        ldx     0,x                    get fail address
        jmp     0,x                    and go there
        page    gnobj
*       gnobj-- get next object
*       reads next object from input stream
*       allows object reject which forces later reread
*       three exits:
*       (exit)                         symbol seen
*       (exit+2)                       number seen
*       exit+4                         terminator seen
*       symbols are of the form abcdef
*       where a is '* or not there
*       and bcdef is 255 letters or digits
*       b may be digit iff '* is present
*       otherwise, b must be a letter
*       numbers are either unsigned decimal intergers 0 <= i <= 65535
*       or fractions of form ii.ddd...
*       where ii is an integer <= 65, d a digit
*       terminators are all characters...
*       not part of a symbol or number
*       on exit tmp holds type,
*       r2 the value of an object
*       type number and corresponding value of symbols:
*       symt:udfsymaddr    0       address of undefined symbol
*       symt:boardnameptr  1       pointer to board name
*       symt:templateptr   2       pointer to template
*       symt:pinnameptr    3       pointer to template internal reference list
*       symt:structureptr  4       pointer to structure
*       symt:wirelstlowptr 5       pointer to lowest address pin in a wirelist
*       symt:xcoordinate   6       x coordinate value (.001 inch)
*       symt:ycoordinate   7       y coordinate value (.001 inch)
*       type number and values of other objects:
*       symt:integer       8       integer value
*       symt:fraction      9       fraction value in units of .001 inch
*       symt:terminator    10-up   terminator character
*               (left in both tmp and r2)
*       new symbols are placed in table
*       and marked undefined
*       leaves a (last symbol referenced) in objsa
        page
gnoi    jsr     mul10a                 multiply old value by 10
        jsr     getch                  get the next character
        bsr     isdig                  is it a digit?
        fdb     gnoi                   yes, keep going
        cmpa    #'.                    is it a decimal point?
        beq     gnodp                  b/ yes, go do it
        staa    rejectchar             no, reject the character
        ldaa    #symt:integer          set object type to 'integer'
        bra     gnobx                  done
*
*       isdig-- is rega a digit?
*       (exit) if yes
*       exit+2 if not
*
isdig   pulx
        cmpa    #'0
        blo     isdig1                 b/ not a digit
        cmpa    #'9
        ble     islet2                 b/ a digit
isdig1  jmp     2,x                    fail exit
        page
*       islet-- is rega a letter
*       (exit) if yes
*       exit+2 if not
*
islet   pulx
        cmpa    #'_                    is it an underscore?
        beq     islet2                 b/ yes
        cmpa    #'A
        blo     islet1                 b/ not a letter
        cmpa    #'Z
        ble     islet2                 b/ a letter
        cmpa    #'A+32                 lower case letter ?
        blo     islet1                 b/ not a letter
        cmpa    #'Z+32                 ...?
        ble     islet2                 b/ a letter
islet1  jmp     2,x                    fail exit

islet2  ldx     0,x                    get sucess exit
        jmp     0,x                    sucess exit
*
gnodpl  dec     dpflag                 count the digit
        bpl     gnodpl1                b/ not too many digits
        jmp     wwe19                  b/ too many digits
gnodpl1 jsr     mul10a                 multiply old value by 10
gnodp   jsr     getch                  get the next character
        bsr     isdig                  is it a digit?
        fdb     gnodpl                 yes, keep going
        staa    rejectchar             no, reject the character
        bra     gnodp2                 no, finish up
gnodp1  clra
        jsr     mul10a0
gnodp2  dec     dpflag                 adjust for fewer than 3 fraction digits
        bpl     gnodp1                 b/ keep going
        ldaa    #symt:fraction         set symbol type
        bra     gnobx
        page
gnobj   ldaa    ns.rejected            was last object rejected?
        beq     gnogo                  b/ no, go get a new object
        clr     ns.rejected            make sure flag is reset
        ldaa    ns.type                get object type into a
gnobx   staa    ns.type                exit, save object type
        pulx
        cmpa    #symt:integer          is it a symbol?
        bge     gnobx1                 b/ no
        ldx     0,x                    yes, get address of return
        jmp     0,x                    go there

gnobx1  cmpa    #symt:terminator       is it a number?
        bge     gnobx2                 b/ no
        ldx     2,x                    yes, get address of return
        jmp     0,x                    go there

gnobx2  jmp     4,x                    it's a terminator
*
gnogo   jsr     getch                  get an object classifying character
        cmpa    #space                 is it a space (or less)?
        ble     gnogo                  yes, ignore
        ldx     #0                     assume it's an integer or fraction
        stx     ns.value               
        ldab    #3                     assume it's a fraction
        stab    dpflag                 count the digits right of dp
        jsr     isdig                  is it a digit?
        fdb     gnoi                   yes, look for an integer
        jsr     islet                  is it a letter?
        fdb     gnosl                  yes, look for a symbol
        cmpa    #'.                    is it a decimal point?
        beq     gnodp                  b/ yes, go handle fraction
        cmpa    #'*                    is it a symbol 'not' sign?
        bne     gnobx                  b/ no, its a terminator, quit
        page
*       it looks like a symbol
*
gnosl   clr     ns.len                 start with zero length string
        ldx     #ns.string
        stx     ptr2
gnosl1  inc     ns.len                 count the char
        bpl     gnosl2                 b/ symbol not too long
        jmp     wwe1a                  b/ symbol too long
gnosl2  ldx     ptr2                   get pointer to string body
        staa    0,x                    and store the character
        inx
        stx     ptr2
        jsr     getch                  get the next character
        jsr     isdig                  is it a digit?
        fdb     gnosl1                 b/ yes, accumulate it
        jsr     islet                  is it a letter?
        fdb     gnosl1                 b/ yes, accumulate it
        staa    rejectchar             no, reject it
*
*       we have accumulated a symbol, now do binary search
*
*       Some notes here about symbol table organization.
*       The symbol table must be on an 8 byte boundary.
*       Symbols are allocated in units of 8 bytes.
*       The first 8 bytes contains string length +$80,
*       symbol type, alphabetical pointer, symbol value,
*       and the first 2 bytes of the symbol. If the symbol
*       is longer than 2 bytes, as many 8 byte blocks as
*       required are used to hold the remaining characters.
*       Since the extension blocks only hold characters
*       and ascii chars are masked with $7f, the upper bit
*       of the first byte of a block is a 1 for the first block
*       or a zero for an extension. All the blocks for a symbol
*       are contiguous. The space for each new symbol is
*       allocated from the lower bound of the symbol table.
*       That is, the symbol table grows toward lower memory.
*       A symbol never moves, only the alphabetical pointers
*       are shuffled around.
*
*       Because symbols in the symbol table are linked with
*       pins in structures, and since an odd pointer is used
*       to mark first of list, ste:value must be at an even
*       address. this implies that the size of each symbol
*       table entry is also a multiple of 2, so that all
*       ste:value are at an even address.
        page
        ldx     symboltableptr         get pointer to top of symbol table
        stx     lowptr                 this marks the low addr of our search
        ldx     symboltableend 
        stx     highptr                this marks the high addr of our search
gnoss   ldd     highptr                divide the list in half
        subd    lowptr                 high-low
        bned    gnoss2                 b/ still some symbol table to search
        jmp     gnosi                  b/ zero, symbol not in table

gnoss2  lsrd                           (high-low)/2
        andb    #-8                    round down to multiple of block size
        addd    lowptr
gnoss3  std     midptr                 pointer to mid point
        ldx     midptr                 get pointer to a symbol block
        tst     ste:len,x              see if it is a symbol header
        bmi     gnoss4                 b/ it is, proceed with compare
        subd    #8                     no, retard to previous block
        bra     gnoss3

gnoss4  ldx     ste:alphaptr,x         get pointer to symbol
        ldaa    ste:string,x           compare with first byte of ste
        anda    #$df                   mask case (note this works because...
        staa    tempx                  only chars >= $60 allowed are lc chars)
        ldaa    ns.string              get first character of the new symbol
        anda    #$df                   mask case
        cmpa    tempx
        bne     gnoss8                 b/ no match on first char
        page
*       do full string compare
*
        ldab    ste:len,x              find min of two string lengths
        andb    #$7f                   mask the tag bit
        stab    tempx+1                save for later
        cmpb    ns.len                 is this the smaller count?
        bls     gnoss5                 b/ no, the one i aready picked is
        ldab    ns.len                 find min of two string lengths
gnoss5  inx                            save pointer to next char, target string
        stx     ptr2
        ldx     #ns.string+1           save pointer to next char, source string
        stx     ptr1                   
        bra     gnoss7                 count the first char we compared
gnoss6  ldx     ptr2                   get pointer to ste string
        ldaa    ste:string,x           get char from ste
        anda    #$bf                   mask case
        staa    tempx
        inx
        stx     ptr2
        ldx     ptr1                   get pointer to ste string
        ldaa    0,x                    get char from new symbol
        anda    #$bf                   mask case
        cmpa    tempx                  compare with ste char
        bne     gnoss8                 b/ no match on nth char
        inx
        stx     ptr1
gnoss7  decb                           done?
        bne     gnoss6                 b/ no, keep going
*
*       we compared min(count1,count2) bytes and found them to be equal
*       now compare the counts to see who really is the greater
*
        ldaa    ns.len                 get new symbol count
        cmpa    tempx+1                compare to ste count
*
*       this is where we decide match, left, or right
*
        bne     gnoss8                 b/ no match
        page
        ldx     midptr                 get address of ste
        ldx     ste:alphaptr,x
        stx     ns.value
        stx     symbolptr
        ldaa    ste:type,x             get ste type
        jmp     gnobx                  done
gnoss8  bhi     gnoss9                 b/ symbol > ste search 2nd half
        ldx     midptr                 search 1st half of table
        stx     highptr
        jmp     gnoss
gnoss9  clra                           search 2nd half of table
        ldx     midptr
        ldab    ste:len,x
        addb    #13+$80                $80 makes tag bit go away
        andb    #-8                    gives number of bytes for this ste
        addd    midptr                 skip this ste
        std     lowptr
        jmp     gnoss
        page
gnosi   ldx     symboltableptr         insert symbol in table
        stx     lowptr                 compute ste space required
        ldd     symboltableptr
        subd    #ste:string            - symbol block overhead
        subb    ns.len                 - symbol size
        sbca    #0
        andb    #-8                    round down to beginning of 8 byte block
        std     ptr2
        subd    structuretableend      see if overflow into structure table
        lbcs    wwe1b                  b/ symbol table full!
        ldx     ptr2                   no problem, save new sym tab ptr
        stx     symboltableptr
        ldaa    #symt:udfsymbol
        staa    ste:type,x
        ldaa    ns.len                 get length byte
        oraa    #$80                   set header tag
        staa    ste:len,x              and save it
*       leave alpha ptr undefined
        ldd     symboltableptr         make value point to self
        addd    #ste:value+1           make odd ptr 'first of list'
        std     ste:value,x
        ldx     #ns.string
        ldab    ns.len                 get loop count
gnosi1  ldaa    0,x                    fetch char from new symbol
        inx
        stx     ptr1
        ldx     ptr2
        staa    ste:string,x           save char in ste
        inx
        stx     ptr2
        ldx     ptr1
        decb
        bne     gnosi1
        page
*       now we get to shuffle the pointers
*
        ldx     symboltableptr
        stx     ns.value
        stx     symbolptr
        stx     ptr2
gnosi2  ldx     ptr2                   bump ptr 2 to next ste
        stx     ptr1                   ptr1 remembers last ste
gnosi3  ldd     ptr2
        addd    #8
        std     ptr2
        ldx     ptr2                   
        cpx     highptr                are we done shuffling?
        beq     gnosi4                 b/ yes
        ldaa    ste:len,x              header block?
        bpl     gnosi3                 b/ no, advance 8 more bytes
        ldd     ste:alphaptr,x         move down the alphabetical ptr
        ldx     ptr1                   get pointer to previous ste
        std     ste:alphaptr,x
        bra     gnosi2
*
*       now we get to link up the new symbol
*
gnosi4  ldd     symboltableptr
        ldx     ptr1
        std     ste:alphaptr,x
        ldaa    #symt:udfsymbol
        jmp     gnobx
        page
*       if rejectchar is non-zero, return it in rega
*       otherwise get a character from the input buffer
*       if the buffer is empty and the errorflag is set,
*       list the current input line before snatching the
*       next input line.
*
getch   ldaa    rejectchar             get last character
        bne     getch4                 b/ yes, exit, a has char
        ldx     inputbufferptr         no, get pointer to buffer
        bne     getch2                 b/ buffer non-empty, get next char
*
*       read the next input line
*
getch1  ldx     #readainputfile
        jsr     callsyscall
        ldx     #inputbuffer
*
*       finally ready to read a char
*
getch2  ldaa    0,x                    get a char
        inx
        cmpa    #cr                    is this a cr?
        bne     getch3                 b/ no, go save pointer
        ldx     #0                     yes, force new line on next call
getch3  stx     inputbufferptr         save updated pointer
getch4  clr     rejectchar             unreject the input char
        anda    #$7f                   mask parity
        rts                            done
        page
*       col-- force next output to column boundary
*       b(exit) contains indentation count
*       b(exit+1) contains column width
*       if enough space left on line for next column
*       then spaces out to next available column
*       otherwise goes to new line and indents left margin
*
col     puld                           get return address
        std     tempx
        addd    #2                     increment return address by 2
        pshd
        ldx     tempx
        ldaa    1,x                    get column size
        staa    tempa
        bra     symcol1                b/ reset is same
        page
*       symcol-- force next output to column boundary
*       b(exit) contains indentation count
*       b(exit+1) contains column width
*       if enough space left on line for symbol output
*       then spaces out to next available column
*       otherwise goes to new line and indents left margin
*       x points to ste
*
symcol  ldaa    ste:len,x              get width of ste
        anda    #$7f                   remove the tag bit
symcola staa    tempa
        puld                           get return address
        std     tempx
        addd    #2                     increment return address by 2
        pshd
        ldx     tempx
symcol1 ldaa    0,x                    get indentation count
        ldab    columncount            is line full?
        beq     symcol5                b/ no, line is empty
        cmpb    linewidth
        bhs     symcol3                b/ yes, force new line
        suba    1,x                    sub column width
symcol2 adda    1,x                    add column width
        cmpa    columncount            bigger than current position?
        bls     symcol2                b/ no
*
        adda    tempa                  add width of next column/ symbol
        cmpa    linewidth              will it fit?
        blo     symcol4                b/ yes, go output spaces
symcol3 ldaa    0,x
        psha
        jsr     crlf                   force new line
        pula
        bra     symcol5                then output left margin indentation
*
symcol4 suba    tempa                  find column start
        suba    columncount            # of spaces to output
symcol5 tsta
        beq     symcol7                b/ nothing to do
symcol6 psha                           there is at least 1 space to output
        ldaa    #$20                   output a space
        jsr     outc
        pula
        deca                           done?
        bne     symcol6                b/ no
symcol7 rts
        page
*       otsym-- output ste symbol
*       x contains pointer to ste
*
otsym   ldab    ste:len,x              get string length
        andb    #$7f                   mask tag bit
otsym1  pshb                           save the count
        ldaa    ste:string,x           get a character
        inx
        stx     otsymx
        jsr     outc
        ldx     otsymx
        pulb
        decb
        bne     otsym1
        rts
*
*       otint-- output integer
*       (a,b) has unsigned integer
*
otint   bsr     bindec                 convert to decimal
        ldaa    bcdbuf                 get leading digit
        bne     otint1                 b/ zero suppress lead digit
        ldaa    bcdbuf+1
        bne     otint2
        ldaa    bcdbuf+2
        bne     otint3
        ldaa    bcdbuf+3
        bne     otint4
        bra     otint5
*
otint1  bsr     otdigit                output a digit
        ldaa    bcdbuf+1
otint2  bsr     otdigit
        ldaa    bcdbuf+2
otint3  bsr     otdigit
        ldaa    bcdbuf+3
otint4  bsr     otdigit
otint5  ldaa    bcdbuf+4
        bra     otdigit
        page
*       otsfr-- output signed fraction
*       (a,b) has signed fraction scaled by 1000
*
otsfr   tsta                           is it a negative
        bpl     otfra                  b/ no, do same as with otfra
        negd                           yes, complement it
        bsr     bindec                 convert to decimal
        ldaa    #'-                    output a leading minus sign
        jsr     outc
        bra     otfra1                 b/ join the rest
*
*       otfra-- output fraction
*       (a,b) has unsigned fraction scaled by 1000
*
otfra   bsr     bindec                 convert to decimal
otfra1  ldaa    bcdbuf                 get leading digit
        beq     otfra2                 b/ zero suppress lead digit
        bsr     otdigit                output a digit
otfra2  ldaa    bcdbuf+1               get next digit
        bsr     otdigit                and output it
        ldaa    #'.                    output the decimal point
        bsr     outc
        ldaa    bcdbuf+2               get first fraction
        bsr     otdigit                and output it
        ldx     bcdbuf+3               trailing fraction digits = 0?
        beq     otfra3                 b/ yes, don't output them
        ldaa    bcdbuf+3
        bsr     otdigit
        ldaa    bcdbuf+4
        beq     otfra3                 b/ last fraction digit is zero
otdigit adda    #'0
        bra     outc
otfra3  rts
        page
*       bindec-- convert binary to decimal
*
bindec  ldx     #$ffff
        stx     bcdbuf
        stx     bcdbuf+2
bindec1 inc     bcdbuf
        subd    #10000
        bcc     bindec1
        addd    #10000
bindec2 inc     bcdbuf+1
        subd    #1000
        bcc     bindec2
        addd    #1000
bindec3 inc     bcdbuf+2
        subd    #100
        bcc     bindec3
        addd    #100
bindec4 inc     bcdbuf+3
        subb    #10
        bcc     bindec4
        addb    #10
        stab    bcdbuf+4
        rts
        page
outhex  anda    #$0f
        adda    #'0
        cmpa    #'9
        bls     outc
        adda    #7
        bra     outc
*
otlit   puld                           output literal string at return address
        std     tempx
        addd    #1
        pshd
        ldx     tempx                  get the string pointer
        ldaa    0,x                    done?
        beq     otlit1                 b/ yes
        bsr     outc
        bra     otlit

otlit1  rts
        page
crlf    ldaa    #cr
*
outc    ldab    linecount              is this page empty?
        bne     outc1                  b/ no
        psha                           yes, save output char
        ldaa    pagedepth              set line count
        suba    #6                     3 lines top, 3 lines bottom
        staa    linecount
        ldx     outputbufferptr        force new page
        ldaa    pagenumber             is this page zero?
        beq     outc0                  b/ yes, no ff on first page
        ldaa    #ff
        staa    0,x
        inx
        inc     columncount
outc0   ldaa    #cr
        staa    0,x
        inx
        staa    0,x
        inx
        staa    0,x
        inx
        stx     outputbufferptr
        ldaa    #3
        adda    columncount
        staa    columncount
        inc     pagenumber             count one page
        bsr     othdng                 output a heading
        pula                           restore the output char
outc1   ldx     outputbufferptr        stick the char in the output buffer
        staa    0,x
        inx
        cmpa    #ff                    is this a form feed?
        bne     outc2                  b/ no
        clr     linecount              yes, setup line count for new page
outc2   inc     columncount            count the char
        cmpa    #cr                    end of line?
        bne     outc3                  b/ no
        ldx     #writeaoutputfile      now we can output the line
        ldaa    columncount
        staa    7,x
        jsr     callsyscall
        clr     columncount            reset the column count
        dec     linecount              and count 1 line
        ldx     #outputbuffer
outc3   stx     outputbufferptr
outc4   rts
        page
othdng  ldx     #heading-4             output page heading
        ldaa    phase
        ldab    step
othdng1 leax    4,x
        cpx     #headingend            end of list?
        beq     outc4                  b/ yes, exit
        cmpa    0,x
        bne     othdng1                b/ no match
        cmpb    1,x
        bne     othdng1
        ldd     2,x                    get pointer
        pshd
        ldx     #inputfilename
othdng2 stx     tempx                  output the filename
        ldaa    0,x
        cmpa    #cr                    is this the end of the filename?
        beq     othdng3                b/ yes
        jsr     outc                   no, output the char
        ldx     tempx
        inx
        bra     othdng2
othdng3 jsr     otlit
        fcb     $20
date    fcc     'hh:mm:ss mo/dd/yy'
datelen equ     *-date
        fcc     " Wirewrap Documentation page "
        fcb     0
        ldaa    bcdbuf                 save buffer
        psha
        ldaa    bcdbuf+1
        psha
        ldaa    bcdbuf+2
        psha
        ldaa    bcdbuf+3
        psha
        ldaa    bcdbuf+4
        psha
        clra
        ldab    pagenumber
        jsr     otint
        pula
        staa    bcdbuf+4
        pula
        staa    bcdbuf+3
        pula
        staa    bcdbuf+2
        pula
        staa    bcdbuf+1
        pula
        staa    bcdbuf
        jsr     otlit
        fcb     cr
        fcc     'Wrap/ '
        fcb     0
        puld                           restore heading text pointer
        std     tempx
othdng4 ldx     tempx
        ldaa    0,x
        beq     othdng5                b/ done
        inx
        stx     tempx
        jsr     outc                   output the character
        bra     othdng4
othdng5 jsr     otlit
        fcb     cr,cr,0
        rts
        page
heading fcb     1,1                    phase 1, step 1
        fdb     hd0
        fcb     1,2                    phase 1, step 2
        fdb     hd0
        fcb     1,3                    phase 1, step 3
        fdb     hd0
        fcb     1,4                    phase 1, step 4
        fdb     hd0
        fcb     2,1                    phase 2, step 1
        fdb     hd0
        fcb     4,1                    phase 4, step 1
        fdb     hd1
        fcb     4,2                    phase 4, step 2
        fdb     hd2
        fcb     4,3                    phase 4, step 3
        fdb     hd3
        fcb     4,4                    phase 4, step 4
        fdb     hd4
        fcb     4,5                    phase 4, step 5
        fdb     hd5
        fcb     5,1                    phase 5, step 1
        fdb     hd6
headingend      equ     *
*
hd0     fcc     "Diagnostics"
        fcb     0
hd1     fcc     "Wiring area specs and grid line names"
        fcb     0
hd2     fcc     "Template definitions"
        fcb     0
hd3     fcc     "Socket placement"
        fcb     0
hd4     fcc     "Chain wirelists"
        fcb     0
hd5     fcc     "Pin to chain cross-reference"
        fcb     0
hd6     fcc     "Level wirelist"
        fcb     0
        page    syscall stuff
syscall:open    equ     0
syscall:create  equ     1
syscall:reada   equ     $a
syscall:writea  equ     $c
syscall:status  equ     $f
syscall:exit    equ     $11
syscall:errorexit       equ            $12
*
open:sclen      equ     $e
create:sclen    equ     $e
reada:sclen     equ     $e
writea:sclen    equ     $8
status:sclen    equ     $e
*
callsyscall
        jsr     $fb
        bcc     csys1                  b/ no error
exitwitherror ; error code in (X)
        stx     errorexit1
        ldx     #errorexit
        jmp     $fb
csys1   rts
*
exit    fcb     syscall:exit
        fcb     2
*
errorexit
        fcb     syscall:errorexit
        fcb     4
errorexit1
        fdb     0
        page
*       this is where the good stuff lives:
*
*       !----------------!
*       ! page zero vars !
*       !----------------!
*       ! code           !
*       !----------------!
*       ! templates      ! <---- templatetableptr
*       !----------------!
*       ! structures     ! <---- structuretableptr
*       !----------------!
*       ! unused         ! <---- structuretableend
*       !----------------!
*       ! symbol table   ! <---- symboltableptr
*       !----------------!
*       ! not available  ! <---- symboltableend
*       !----------------!
*
*
patch   rpt     300
        swi
*
readainputfile
        fcb     syscall:reada
        fcb     reada:sclen
        fcb     1,1
        fdb     0
        fdb     0
        fdb     0
        fdb     inputbuffer
        fdb     inputbufferlen
*
writeaoutputfile
        fcb     syscall:writea
        fcb     writea:sclen
        fcb     2,0
        fdb     outputbuffer
        fdb     0
*
writeaerrorline
        fcb     syscall:writea
        fcb     writea:sclen
        fcb     2,0
        fdb     inputbuffer
        fdb     0
        page
inputbuffer     rpt     255
        fcb     0
inputbufferlen  equ     *-inputbuffer
        fcb     cr                     ensure wwerr search always terminates
*
outputbuffer    rpt     256
        fcb     0
outputbufferlen equ     *-outputbuffer
*
inputfilename
        rpt     50
        fcb     cr
inputfilenamelen        equ            *-inputfilename
        fcb     cr                     othdng needs this here
        rpt     50
        fcb     0
stack   fcb     0
        page
*       ensure even boundary for templates and structures
*
        org     (*+1)/2*2
wiringarea
*
openinputfile
        fcb     syscall:open
        fcb     open:sclen
        fcb     1,0
        fdb     inputfilename
        fdb     inputfilenamelen
        fdb     0
        fdb     replybuffer
        fdb     2
*
replybuffer     fdb     0
*
openclock
        fcb     syscall:open
        fcb     open:sclen
        fcb     3,0
        fdb     clockname
        fdb     clocknamelen
        fdb     0
        fdb     replybuffer
        fdb     2
*
clockname
        fcc     "clock:"
clocknamelen        equ            *-clockname
*
readainputfilename
        fcb     syscall:reada
        fcb     reada:sclen
        fcb     0,1
        fdb     0
        fdb     0
        fdb     0
        fdb     inputfilename
        fdb     inputfilenamelen
*
readalinewidth
readapagedepth
readaoutputfilename
        fcb     syscall:reada
        fcb     reada:sclen
        fcb     0,1
        fdb     0
        fdb     0
        fdb     0
        fdb     outputfilename
        fdb     $100
        page
readaclock
        fcb     syscall:reada
        fcb     reada:sclen
        fcb     3,1
        fdb     0
        fdb     0
        fdb     0
        fdb     date
        fdb     datelen
*
createoutputfile
        fcb     syscall:create
        fcb     create:sclen
        fcb     2,0
        fdb     outputfilename
        fdb     $0000
        fdb     2
        fdb     replybuffer
        fdb     2
*
writeainputfileprompt
        fcb     syscall:writea
        fcb     writea:sclen
        fcb     0,0
        fdb     inputfileprompt
        fdb     inputfilepromptlen
*
inputfileprompt
        fcc     'Wrap V1.0b Copyright (C) 1984 Ira D. Baxter'
        fcb     cr
        fcc     'Circuit Interconnect Input file= '
inputfilepromptlen      equ            *-inputfileprompt
        page
writeaoutputfileprompt
        fcb     syscall:writea
        fcb     writea:sclen
        fcb     0,0
        fdb     outputfileprompt
        fdb     outputfilepromptlen
*
outputfileprompt
        fcc     'Output file (default CONSOLE:) = '
outputfilepromptlen      equ            *-outputfileprompt
*
writealinewidthprompt
        fcb     syscall:writea
        fcb     writea:sclen
        fcb     0,0
        fdb     linewidthprompt
        fdb     linewidthpromptlen
*
linewidthprompt
        fcc     'Page width (default 80) = '
linewidthpromptlen      equ            *-linewidthprompt
*
writeapagedepthprompt
        fcb     syscall:writea
        fcb     writea:sclen
        fcb     0,0
        fdb     pagedepthprompt
        fdb     pagedepthpromptlen
*
pagedepthprompt
        fcc     'Page depth (default 66) = '
pagedepthpromptlen      equ            *-pagedepthprompt
        page
getdevtype
        fcb     syscall:status
        fcb     status:sclen
        fcb     2                      output file
        fcb     4                      get device type
        fdb     0
        fdb     0
        fdb     0
        fdb     inputbuffer            put it here
        fdb     inputbufferlen
*
getdevparams
        fcb     syscall:status
        fcb     status:sclen
        fcb     2                      output file
        fcb     5                      get device params
        fdb     0
        fdb     0
        fdb     0
        fdb     inputbuffer            put it here
        fdb     inputbufferlen
        page
start   lds     #stack                 phase 1, reset all interesting vars
        ldx     #$0101                 remember current phase and step
        stx     phase
*
        ldx     #writeainputfileprompt ask for input filename
        jsr     callsyscall
        ldx     #readainputfilename    get input filename
        jsr     callsyscall
        ldx     #readainputfilename
        ldaa    9,x                    get length of filename
        ldx     #openinputfile         open input file
        staa    7,x                    store filename length
        jsr     callsyscall
*
        ldx     #writeaoutputfileprompt ask for output filename
        jsr     callsyscall
        ldx     #readaoutputfilename   get output filename
        jsr     callsyscall
        ldx     #readaoutputfilename
        ldaa    9,x                    get length of filename
        cmpa    #1                     filename entered?
        bne     start1                 b/ yes
        ldaa    #'c                    no, repair the first char
        staa    outputfilename
        ldaa    #defaultoflen          use console: as default
start1  ldx     #createoutputfile      create output file
        staa    7,x                    store filename length
        jsr     callsyscall
*
*       is the output file a console or printer?
*
        ldx     #getdevtype
        jsr     callsyscall
        ldaa    inputbuffer            get the device type byte
        cmpa    #4                     console?
        beq     start2                 b/ yes
        cmpa    #5                     printer?
        bne     start3                 b/ no
start2  ldx     #getdevparams          printer or console, get width and depth
        jsr     callsyscall
        ldaa    inputbuffer            get width
        ldab    inputbuffer+1          get depth
        suba    #10                    less margin size
        staa    linewidth
        stab    pagedepth
        bra     start4
        page
get3digits
        ldab    outputfilename         get first digit
        cmpb    #cr
        beq     ax10rts
        clra
        bsr     ax10
        ldab    outputfilename+1
        cmpb    #cr
        beq     ax10rts
        bsr     ax10
        ldab    outputfilename+2
        cmpb    #cr
        beq     ax10rts
ax10    asla                           *2
        staa    tempa
        asla                           *4
        asla                           *8
        adda    tempa                  *10
        subb    #'0
        stab    tempa
        adda    tempa
ax10rts rts
        page
*       it's not a printer or a console, ask the user
*       what the width and depth is
*
start3  ldx     #writealinewidthprompt ask for line width
        jsr     callsyscall
        ldx     #readalinewidth        get line width
        jsr     callsyscall
        ldaa    #80                    default line width
        bsr     get3digits
        suba    #10                    (less margin)
        staa    linewidth
        ldx     #writeapagedepthprompt ask for page depth
        jsr     callsyscall
        ldx     #readapagedepth        get page depth
        jsr     callsyscall
        ldaa    #66                    default page depth
        bsr     get3digits
        staa    pagedepth
start4  clr     pagenumber
*
        ldx     #openclock             get the date
        jsr     callsyscall
        ldx     #readaclock
        jsr     syscall
        bcc     start5
        cpx     #err:activationnotinbuffer this is ok, no space for <CR> in rdbuf
        lbne    exitwitherror
start5 ; current clock value has been read
        page
*       square pin heigth
*
        ldx     #pinheigth             get pin heigth
        jsr     squarx                 go square pin heigth
        ldx     product32
        stx     pinheigth2             save upper half
        ldx     product32+2            save lower half
        stx     pinheigth2+2
        clr     ns.rejected            reset 'object rejected' flag
        ldx     #0                     force new line input
        stx     inputbufferptr
        stx     boardnameptr           pointer to board name = 'none'
        clr     rejectchar             reset 'character rejected' flag
        ldd     $fc                    get pointer to (end of memory) + 1
        andb    #$f8                   ensure multiple of 8
        std     symboltableend         init symbol table
        std     symboltableptr
        ldx     #wiringarea            init template table
        stx     templatetableptr
        stx     structuretableptr      make template table empty
        stx     structuretableend      make structure table empty, too
        clr     linecount              force a new page if error occurs
        clr     columncount
        ldx     #outputbuffer
        stx     outputbufferptr
        jmp     p1s1i
*
outputfilename
        fcc     'console:'
defaultoflen    equ     *-outputfilename
        end     start
