
 1000  *SAVE S.LCR
 1010  *--------------------------------
 1020  *    LINE NUMBER CROSS REFERENCE
 1030  *       FOR APPLESOFT PROGRAMS
 1040  *
 1050  *       Based on Variable Cross Reference
 1060  *       Original by Bob S-C 11/80
 1070  *       Modified by Louis Pitz 8/83
 1080  *       Adapted by Bill Morgan 8/84
 1090  *--------------------------------
 1100         .OR $6000
 1110  *      .TF B.LCR
 1120  *--------------------------------
 1130         LDA #$4C     set & vector
 1140         STA $3F5
 1150         LDA #LCR
 1160         STA $3F6
 1170         LDA /LCR
 1180         STA $3F7
 1190         RTS
 1200  *--------------------------------
 1210  TEMP    .EQ $15
 1220  COUNTER .EQ $16
 1230  ONFLAG  .EQ $17           ON ... GO flag
 1240  DEFFLAG .EQ $17
 1250  PNTR    .EQ $18,19        pointer into program
 1260  LZFLAG  .EQ $1A           leading zero flag
 1270  DATA    .EQ $1A thru $1D
 1280  NEXTLN  .EQ $1A,1B        address of next line
 1290  LINNUM  .EQ $1C,1D        current line number
 1300  STPNTR  .EQ $1E,1F        pointer into call table
 1310  TPTR    .EQ $9B,9C        temp pointer
 1320  ENTRY   .EQ $9D thru $A4  8 bytes
 1330  CALL    .EQ ENTRY+2
 1340  SIZE    .EQ $A5,A6
 1350  HSHTBL  .EQ $280
 1360  *--------------------------------
 1370  PRGBOT  .EQ $67,68        beginning of program
 1380  LOMEM   .EQ $69,6A        beginning of variable space
 1390  EOT     .EQ $6B,6C        end of variable table
 1400  *--------------------------------
 1410  COMMA      .EQ ',
 1420  CR         .EQ $8D
 1430  TKN.GOTO   .EQ $AB
 1440  TKN.GOSUB  .EQ $B0
 1450  TKN.ON     .EQ $B4
 1460  TKN.THEN   .EQ $C4
 1470  *--------------------------------
 1480  MON.CH     .EQ $24
 1490  KEYBOARD   .EQ $C000
 1500  STROBE     .EQ $C010
 1510  AS.MEMFULL .EQ $D410
 1520  MON.PRBL2  .EQ $F94A
 1530  MON.CROUT  .EQ $FD8E
 1540  MON.COUT   .EQ $FDED
 1550  MON.COUT1  .EQ $FDF0
 1560  *--------------------------------
 1570  LCR    JSR INITIALIZATION
 1580  .1     JSR PROCESS.LINE
 1590         BNE .1            until end of program
 1600         JSR PRINT.REPORT
 1610         JSR INITIALIZATION  erase call table
 1620         LDA #0            clear $A4 so Applesoft
 1630         STA $A4           will work correctly
 1640         RTS
 1650  *--------------------------------
 1660  INITIALIZATION
 1670         LDA LOMEM         start call table
 1680         STA EOT           after program
 1690         LDA LOMEM+1
 1700         STA EOT+1
 1710         LDX #$80          # of bytes for hash pointers
 1720         LDA #0
 1730  .1     STA HSHTBL-1,X
 1740         DEX
 1750         BNE .1
 1760         LDA PRGBOT        start pointer at
 1770         STA PNTR          beginning of program
 1780         LDA PRGBOT+1
 1790         STA PNTR+1
 1800         RTS
 1810  *--------------------------------
 1820  PROCESS.LINE
 1830         LDY #3            capture pointer and line #
 1840  .1     LDA (PNTR),Y
 1850         STA DATA,Y
 1860         DEY
 1870         BPL .1
 1880         LDA DATA+1        check if end
 1890         BEQ .3            yes, return .EQ.
 1900         CLC
 1910         LDA PNTR          adjust pointer to
 1920         ADC #4            skip over data
 1930         STA PNTR
 1940         BCC .2
 1950         INC PNTR+1
 1960  .2     JSR SCAN.FOR.CALLS
 1970         LDA DATA          point to next line
 1980         STA PNTR
 1990         LDA DATA+1        and return .NE.
 2000         STA PNTR+1
 2010  .3     RTS
 2020  *--------------------------------
 2030  SCAN.FOR.CALLS
 2040         LDA #$FF
 2050         STA ONFLAG
 2060  .1     JSR NEXT.CHAR
 2070         BEQ .4
 2080         CMP #TKN.THEN     scan for call token
 2090         BEQ .2
 2100         CMP #TKN.GOTO
 2110         BEQ .3
 2120         CMP #TKN.GOSUB
 2130         BEQ .3
 2140         CMP #TKN.ON
 2150         BNE .1            no match, keep going
 2160         LSR ONFLAG        set flag for ON token
 2170         BPL .1         ...always
 2180  
 2190  .2     LDY #0            after THEN, check
 2200         LDA (PNTR),Y      for line number
 2210         CMP #'0
 2220         BCC .1            <0 isn't
 2230         CMP #'9+1
 2240         BCS .1            neither is >9
 2250  
 2260  .3     JSR PROCESS.CALL  handle this call
 2270         LDA ONFLAG        are we in ON?
 2280         BMI SCAN.FOR.CALLS no, go on
 2290         JSR NEXT.CHAR     yes, look for comma
 2300         BEQ .4            EOL
 2310         CMP #COMMA
 2320         BEQ .3            comma, get another call
 2330         BNE SCAN.FOR.CALLS ...always
 2340  
 2350  .4     RTS
 2360  *--------------------------------
 2370  PROCESS.CALL
 2380         JSR CONVERT.LINE.NUMBER
 2390         JSR SEARCH.CALL.TABLE
 2400         BCC .2            found same call
 2410         LDA #0
 2420         STA ENTRY+4       start of line number chain
 2430         STA ENTRY+5
 2440         LDA LINNUM+1      MSB first
 2450         STA ENTRY+6
 2460         LDA LINNUM
 2470         STA ENTRY+7
 2480         LDA #8            add 8 byte entry
 2490  .1     JMP ADD.NEW.ENTRY
 2500  
 2510  .2     JSR SEARCH.LINE.CHAIN
 2520         BCC .3            found same line number
 2530         LDA #4            add 4 byte entry
 2540         BNE .1         ...always
 2550   
 2560  .3     RTS
 2570  *--------------------------------
 2580  CONVERT.LINE.NUMBER
 2590         LDA #0
 2600         STA CALL+1
 2610         STA CALL
 2620  .1     JSR NEXT.CHAR
 2630         BEQ .2            EOL
 2640         SEC
 2650         SBC #'0           make value
 2660         BCC .2            <0 isn't number
 2670         CMP #9+1
 2680         BCS .2            >9 isn't number
 2690         PHA               save value
 2700         LDA CALL
 2710         STA TEMP
 2720         LDA CALL+1        multiply CALL * 10
 2730         ASL
 2740         ROL TEMP
 2750         ASL
 2760         ROL TEMP
 2770         ADC CALL+1
 2780         STA CALL+1
 2790         LDA TEMP
 2800         ADC CALL
 2810         STA CALL
 2820         ASL CALL+1
 2830         ROL CALL
 2840         PLA               get value this digit
 2850         ADC CALL+1        and add it in
 2860         STA CALL+1
 2870         BCC .1
 2880         INC CALL
 2890         BCS .1         ...always
 2900  
 2910  .2     LDA PNTR          back up PNTR
 2920         BNE .3
 2930         DEC PNTR+1
 2940  .3     DEC PNTR
 2950         RTS
 2960  *--------------------------------
 2970  NEXT.CHAR
 2980         LDY #0
 2990         LDA (PNTR),Y
 3000         BEQ .1            EOL
 3010         INC PNTR          bump pointer
 3020         BNE .1
 3030         INC PNTR+1
 3040  .1     RTS
 3050  *--------------------------------
 3060  SEARCH.CALL.TABLE
 3070         LDA CALL          hi-byte of called line
 3080         AND #$FC          hi 6 bits
 3090         LSR               make 0-126
 3100         ADC #HSHTBL       carry is clear
 3110         STA STPNTR
 3120         LDA /HSHTBL
 3130         ADC #0
 3140         STA STPNTR+1
 3150  *--- fall into CHAIN.SEARCH routine
 3160  *--------------------------------
 3170  CHAIN.SEARCH
 3180  .1     LDY #0            point at pointer in entry
 3190         LDA (STPNTR),Y
 3200         STA TPTR
 3210         INY
 3220         LDA (STPNTR),Y
 3230         BEQ .4            end of chain, not in table
 3240         STA TPTR+1
 3250         LDX #2            2 bytes in number
 3260         LDY #2            point at line number in entry
 3270  .2     LDA (TPTR),Y      compare numbers
 3280         CMP ENTRY,Y
 3290         BCC .3            not this one, but keep looking
 3300         BNE .4            not in this chain
 3310         DEX
 3320         BEQ .5            same number
 3330         INY               next byte pair
 3340         BNE .2         ...always
 3350  
 3360  .3     JSR .5            update pointer, clear carry
 3370         BCC .1         ...always
 3380  
 3390  .4     SEC               did not find
 3400         RTS
 3410  
 3420  .5     LDA TPTR          point to matching entry
 3430         STA STPNTR
 3440         LDA TPTR+1
 3450         STA STPNTR+1
 3460         CLC
 3470         RTS
 3480  *--------------------------------
 3490  SEARCH.LINE.CHAIN
 3500         CLC               adjust pointer to start
 3510         LDA STPNTR        of line # chain
 3520         ADC #4
 3530         STA ENTRY
 3540         LDA STPNTR+1
 3550         ADC #0
 3560         STA ENTRY+1
 3570         LDA #ENTRY
 3580         STA STPNTR
 3590         LDA /ENTRY
 3600         STA STPNTR+1
 3610         LDA LINNUM        put line number into symbol
 3620         STA ENTRY+3
 3630         LDA LINNUM+1
 3640         STA ENTRY+2
 3650         JMP CHAIN.SEARCH
 3660  *--------------------------------
 3670  ADD.NEW.ENTRY
 3680         STA SIZE
 3690         CLC               see if room
 3700         LDX #1
 3710         LDY #0
 3720         STY SIZE+1
 3730  .1     LDA (STPNTR),Y    get current pointer
 3740         STA ENTRY,Y       into new entry
 3750         LDA EOT,Y         point old entry
 3760         STA (STPNTR),Y    to this one
 3770         STA TPTR,Y
 3780         ADC SIZE,Y        and adjust end-of-table
 3790         STA EOT,Y
 3800         INY
 3810         DEX
 3820         BPL .1            now do low-bytes
 3830  *--- see if there's going to be enough room
 3840         LDA EOT
 3850         CMP #LCR
 3860         LDA EOT+1
 3870         SBC /LCR
 3880         BCS .3            MEM FULL error
 3890  *--- move entry into call table
 3900         LDY SIZE
 3910         DEY
 3920  .2     LDA ENTRY,Y
 3930         STA (TPTR),Y
 3940         DEY
 3950         BPL .2
 3960         LDA TPTR
 3970         STA STPNTR
 3980         LDA TPTR+1
 3990         STA STPNTR+1
 4000         RTS
 4010  
 4020  .3     JMP AS.MEMFULL    abort with error message
 4030  *--------------------------------
 4040  PRINT.REPORT
 4050         LDA PRGBOT
 4060         STA PNTR          start defined line search
 4070         LDA PRGBOT+1      at beginning of program
 4080         STA PNTR+1
 4090         LDA #0            start at chain 0
 4100  .1     STA TEMP
 4110         ASL
 4120         TAY
 4130         LDA HSHTBL+1,Y
 4140         BEQ .2            no entries for this chain
 4150         STA STPNTR+1
 4160         LDA HSHTBL,Y
 4170         STA STPNTR
 4180         JSR PRINT.CHAIN
 4190  .2     INC TEMP
 4200         LDA TEMP
 4210         CMP #$40
 4220         BCC .1            still more chains
 4230         RTS               finished
 4240  *--------------------------------
 4250  PRINT.CHAIN
 4260         JSR CHECK.FOR.PAUSE
 4270         BEQ .1            <CR> abort
 4280         LDY #2
 4290         LDA (STPNTR),Y
 4300         STA LINNUM+1
 4310         INY
 4320         LDA (STPNTR),Y
 4330         STA LINNUM
 4340         JSR CHECK.DEFINITION
 4350         JSR PRINT.LINE.NUMBER
 4360         LDA DEFFLAG       "*" or " "
 4370         JSR MON.COUT
 4380         CLC
 4390         LDA STPNTR
 4400         ADC #4            point at line # chain
 4410         STA TPTR
 4420         LDA STPNTR+1
 4430         ADC #0
 4440         STA TPTR+1
 4450         JSR PRINT.LINNUM.CHAIN
 4460         JSR MON.CROUT
 4470         LDY #1
 4480         LDA (STPNTR),Y    pointer to next call
 4490         BEQ .2            no more
 4500         PHA
 4510         DEY
 4520         LDA (STPNTR),Y
 4530         STA STPNTR
 4540         PLA
 4550         STA STPNTR+1
 4560         BNE PRINT.CHAIN  ...always
 4570  
 4580  .1     PLA               return to top level
 4590         PLA               if <CR> abort
 4600  .2     RTS
 4610  *--------------------------------
 4620  CHECK.DEFINITION
 4630         LDY #3
 4640         LDX #1
 4650  .1     LDA (PNTR),Y      look at next line in program
 4660         CMP LINNUM,X
 4670         BCC .4            < our number, get new line
 4680         BNE .2            >  "    "   , not defined
 4690         DEY               =  "    "   , go on
 4700         DEX               now do low order bytes
 4710         BPL .1
 4720         LDA #" "          found it!
 4730         BNE .3         ...always
 4740  
 4750  .2     LDA #"*"          flag undefined line
 4760  .3     STA DEFFLAG
 4770         RTS
 4780  
 4790  .4     LDY #1
 4800         LDA (PNTR),Y      hi-byte of next line address
 4805         BEQ .2
 4810         PHA
 4820         DEY
 4830         LDA (PNTR),Y      and lo-byte
 4840         STA PNTR
 4850         PLA
 4860         STA PNTR+1
 4870         JMP CHECK.DEFINITION
 4880  *--------------------------------
 4890  PRINT.LINNUM.CHAIN
 4900         LDA #0            reset counter to 0
 4910         STA COUNTER       for each call
 4920  .1     JSR TAB.NEXT.COLUMN
 4930         LDY #2            point at line #
 4940         LDA (TPTR),Y
 4950         STA LINNUM+1
 4960         INY
 4970         LDA (TPTR),Y
 4980         STA LINNUM
 4990         JSR PRINT.LINE.NUMBER
 5000         LDY #1            set up next pointer
 5010         LDA (TPTR),Y
 5020         BEQ .2            end of chain
 5030         PHA
 5040         DEY
 5050         LDA (TPTR),Y
 5060         STA TPTR
 5070         PLA
 5080         STA TPTR+1
 5090         BNE .1         ...always
 5100  
 5110  .2     RTS
 5120  *--------------------------------
 5130  TAB.NEW.LINE
 5140         JSR MON.CROUT
 5150  
 5160  TAB.NEXT.COLUMN
 5170  .1     LDA #7            first tab stop
 5180  .2     CMP MON.CH        cursor position
 5190         BCS .3            perform tab
 5200         ADC #6            next tab stop
 5210         CMP #33           end of line?
 5220         BCC .2
 5230         INC COUNTER       count the screen line
 5240         LDA COUNTER
 5250         AND #1            look at odd-even bit
 5260         BEQ TAB.NEW.LINE  both scrn and printer
 5270         LDA #CR
 5280         JSR MON.COUT1     <CR> to screen only
 5290         JMP .1         ...always
 5300   
 5310  .3     BEQ .4            already there
 5320         SBC MON.CH        calculate # of blanks
 5330         TAX
 5340         JSR MON.PRBL2
 5350  .4     RTS
 5360  *--------------------------------
 5370  PRINT.LINE.NUMBER
 5380         LDX #4            print 5 digits
 5390         STX LZFLAG        turn on leading zero flag
 5400  .1     LDA #'0           digit=0
 5410  .2     PHA
 5420         SEC
 5430         LDA LINNUM
 5440         SBC PLNTBL,X
 5450         PHA
 5460         LDA LINNUM+1
 5470         SBC PLNTBH,X
 5480         BCC .3            less than divisor
 5490         STA LINNUM+1
 5500         PLA
 5510         STA LINNUM
 5520         PLA
 5530         ADC #0            increment digit
 5540         BNE .2         ...always
 5550  
 5560  .3     PLA
 5570         PLA
 5580         CMP #'0
 5590         BEQ .5            zero, might be leading
 5600         SEC               turn off LZFLAG
 5610         ROR LZFLAG
 5620  .4     ORA #$80
 5630         JSR MON.COUT
 5640         DEX
 5650         BPL .1
 5660         RTS
 5670  .5     BIT LZFLAG        leading zero flag
 5680         BMI .4            no
 5690         CPX #0            if all zeroes, print one
 5700         BEQ .4
 5710         LDA #'            blank
 5720         BNE .4         ...always
 5730  
 5740  PLNTBL .DA #1
 5750         .DA #10
 5760         .DA #100
 5770         .DA #1000
 5780         .DA #10000
 5790  PLNTBH .DA /1
 5800         .DA /10
 5810         .DA /100
 5820         .DA /1000
 5830         .DA /10000
 5840  *--------------------------------
 5850  CHECK.FOR.PAUSE
 5860         LDA KEYBOARD      keypress?
 5870         BPL .2            no, go on
 5880         STA STROBE
 5890         CMP #CR           RETURN?
 5900         BEQ .2            yes
 5910  .1     LDA KEYBOARD      no, wait for
 5920         BPL .1            another stroke
 5930         STA STROBE
 5940         CMP #CR           return .EQ. if RETURN
 5950  .2     RTS
 5960  *--------------------------------

