renumber

.PAG 'RENUMBER'
;********************************************
;*                                          *
;* RENUMBER                                 *
;*                                          *
;* SYNTAX:                                  *
;*   RENUMBER [N1[,N2[,N3]]]                *
;*    N1 =NEW START LINE NUMBER, DEFAULT 10 *
;*    N2 =LINE INCREMENT, DEFAULT 10        *
;*    N3 =START LINE, DEFAULT FIRST         *
;*                                          *
;* SYNTAX ERROR MAY OCCUR FOR MISSING COMMAS*
;*   OR BAD LINE NUMBERS                    *
;* ILLEGAL QUANTITY ERROR FOR LINE INCREMENT*
;*   ZERO AND BAD RENUMBER RANGE            *
;* OVERFLOW ERROR IF INCREMENT WRAPS LINE   *
;*   NUMBER DURING RENUMBER                 *
;*                                          *
;* RETURNS TO READY MODE ON COMPLETION OF   *
;*   RENUMBER                               *
;*                                          *
;********************************************
.SKI 3
;  THE RENUMBER ALGORITHMN EXAMINES THE ENTIRE STATEMENT
;  TABLE FIRST FOR EMBEDDED LINE NUMBERS (BRANCHES) TO
;  FIX.  THIS IS DONE BY LOOKING FOR KEYWORDS (GOTO, GOSUB,
;  THEN, RUN) WHICH ARE USUALLY FOLLOWED BY LINE NUMBERS.
;
;  THE OLD LINE NUMBER IS MAPPED TO A NEW VALUE AND THE
;  STRING REPRESENTING THE NEW BRANCH LABEL REPLACES THE
;  ORIGINAL TEXT.  AFTER COMPLETING THIS FIRST PASS OVER THE
;  TABLE, A SECOND PASS IS MADE TO REPLACE THE STATEMENT
;  NUMBER BYTES BY THEIR FINAL VALUES.  LASTLY, THE TABLE
;  IS RELINKED.
;
.SKI 4
TESTWD	.BYT 0,TKGOTO,TKRUN,TKGOSU,TKTHEN,TKREST,TKRESU,TKTRAP
RENUM	LDA #0          ;LINE #10...
	LDX #10
	STX FRESPC      ;DEFAULT RENUM ORIGIN...
	STA FRESPC+1
	STX FRETOP      ;DEFAULT INCREMENT...
	STA FRETOP+1
	STA HIGHTR      ;DEFAULT START LINE#
	STA HIGHTR+1
	JSR CHRGOT      ;ANY PARMS?
	BEQ REN010      ;NO...
	JSR LINGET      ;YES...GET NEW ORIGIN
	LDA LINNUM
	LDX LINNUM+1
	STA FRESPC
	STX FRESPC+1
	JSR CHRGOT      ;ANY MORE PARMS?
	BEQ REN010      ;NO...DEFAULT REST...
	JSR CHKCOM      ;MUST BE COMMA
	JSR LINGET      ;GET NEW INCREMENT
	LDA LINNUM
	LDX LINNUM+1
	STA FRETOP
	STX FRETOP+1
	BNE REN005      ;INCREMENT IS O.K.
	TAX             ;TEST LO BYTE
	BNE REN005      ;INCREMENT IS NON-ZERO...
REN004	JMP FCERR       ;ILLEGAL QUANTITY ERROR...
REN005	JSR CHRGOT      ;MORE PARMS?
	BEQ REN010      ;NO...
	JSR CHKCOM      ;YES...MUST BE COMMA
	JSR LINGET      ;GET START LINE
	LDA LINNUM
	LDX LINNUM+1
	STA HIGHTR
	STX HIGHTR+1
	JSR FNDLIN      ; TEST FOR ILLEGAL RENUM RANGE
	LDA LOWTR       ;^1ST STMT TO RENUMBER
	LDX LOWTR+1
	STA HIGHDS
	STX HIGHDS+1
	LDA FRESPC
	LDX FRESPC+1
	STA LINNUM
	STX LINNUM+1
	JSR FNDLIN      ;LOWTR := ^1ST STMT TO BE OVERLAPPED
	LDA LOWTR+1     ;CAN'T BE SMALLER
	SEC
	SBC HIGHDS+1
	BCC REN004      ;BAD...
	BNE REN010      ;OK, DO RENUMBER
	LDA LOWTR
	SBC HIGHDS
	BCC REN004      ;BAD...
REN010	JSR STXTPT      ;START AT FIRST LINE
;
AD7640	JSR CHARGT      ;SKIP LINKS
	BNE AD7668
	JSR CHARGT
	BNE AD7669      ;NOT LAST (NULL) LINK
	JSR AD7730      ;PUT CURRENT LIN # IN FAC
AD764B	JSR CHARGT      ;SKIP LINK
	BNE AD7655
	JSR CHARGT
	BNE AD7656      ;NOT NULL LINK
	JMP SUBCLR      ;LAST ONE...DONE
;
AD7655	JSR CHARGT
AD7656	JSR CHARGT
	STA LINNUM      ;IF LINE# >= START#, REPLACE WITH FACHO
	INY
	LDA (TXTPTR)Y
	SEC
	SBC HIGHTR+1
	BCC AD7658      ;NO, LET ALONE
	BNE AD7657      ;YES, REPLACE
	LDA LINNUM
	SBC HIGHTR
	BCC AD7658      ;NO, LET ALONE
AD7657	LDA FACHO
	STA (TXTPTR)Y   ;HI
	DEY
	LDA FACHO+1
	STA (TXTPTR)Y   ;LO
	JSR CHARGT      ;SKIP PAST 2ND BYTE OF LINE#
	JSR AD773B      ;INCR LINE# AND SCAN TO EOL
	BEQ AD764B      ;ALWAYS...
AD7658	JSR CHARGT      ;SKIP PAST LINE#
	JSR AD774A      ;SCAN TO EOL
	BEQ AD764B      ;ALWAYS...
;
AD7668	JSR CHARGT
AD7669	JSR CHARGT      ;MOVE ON
	JSR CHARGT
AD766F	JSR CHARGT      ;ONE MORE
AD7672	CMP #$22        ;OPENING DOUBLE QUOTE?
	BNE AD7681      ;NO...
AD7676	JSR CHARGT      ;SCAN LINE
	BEQ AD7640      ;END...
	CMP #$22        ;CLOSE DOUBLE QUOTE
	BNE AD7676      ;NO... CONTINUE
	BEQ AD766F      ;YES... RESUME RENUMBER
AD7681	TAX             ;END OF LINE?
	BEQ AD7640      ;YES...
	BPL AD766F      ;NOT A TOKEN...
	LDX #$07        ;CHECK SPECIAL TOKEN LIST
AD7688	CMP TESTWD,X
	BEQ AD7692      ;A MATCH...
	DEX
	BNE AD7688      ;CONTINUE UNTIL ZERO
	BEQ AD766F      ;NOT SPECIAL...CONTINUE
AD7692	LDA TXTPTR      ;SAVE CURRENT TXTPTR
	STA OLDLIN
	LDA TXTPTR+1
	STA OLDLIN+1
	JSR CHRGET
AD769D	BCS AD7672      ;NOT A #...
	JSR LINGET      ;GET LINE # FROM TEXT
	JSR AD76DA      ;TEST FOR 'ON'
	LDA OLDLIN      ;RESTORE OLD TXTPTR
	STA TXTPTR
	LDA OLDLIN+1
	STA TXTPTR+1
	LDY #0
	LDX #0
AD76B1	LDA FBUFFR+1,X  ;GET CHARACTER FROM NUMBER
	BEQ AD76C7      ;END OF NUMBER
	PHA             ;SAVE DIGIT FROM NEW NUMBER
	JSR CHRGET      ;GET DIGIT FROM OLD NUMBER
AD76BA	BCC AD76BF      ;DIGIT...MOVE ON
	JSR AD7706      ;OTHER CHAR...MOVE UP
AD76BF	PLA
	LDY #0
	STA (TXTPTR)Y   ;PUT NEW DIGIT IN NEW NUMBER
	INX
	BNE AD76B1      ;BRANCH ALWAYS
;
AD76C7	JSR CHRGET
AD76CA	BCS AD76D4      ;OLD STUFF AFTER # IS OTHER CHAR
AD76CC	JSR AD7715      ;DIGIT...MOVE DOWN
	JSR CHRGOT
	BCC AD76CC      ;STILL DIGITS...
AD76D4	CMP #$2C        ;COMMA FROM 'ON'?
	BEQ AD7692      ;IT IS...
	BNE AD7672      ;NO...
;
AD76DA	JSR AD7730
AD76DD	JSR CHARGT      ;NEW LINE, SKIP OVER LINK
	BNE AD76EC
	JSR CHARGT
	BNE AD76ED
	LDA #$FF        ;END-OF-TABLE, USE FFFF FOR LINE#
	STA FACHO
	STA FACHO+1
	BMI AD76FB      ;ALWAYS
;
AD76EC	JSR CHARGT
AD76ED	JSR CHARGT
	STA HIGHDS      ;HIGHDS := CURRENT LINE# IN LOOP
	CMP LINNUM
	BNE AD76FE
	JSR CHARGT
	STA HIGHDS+1
	CMP LINNUM+1
	BNE AD7701
	SEC             ;IF LINNUM < START#, NO REMAPPING
	SBC HIGHTR+1
	BCC AD76F0
	BNE AD76FB
	LDA LINNUM
	SBC HIGHTR
	BCS AD76FB
AD76F0	LDA LINNUM      ;USE SAME LINE#
	STA FACHO+1
	LDA LINNUM+1
	STA FACHO
AD76FB	LDX #$90        ;MAKE REPLACEMENT STRING
	SEC
	JSR FLOATC
	JMP FOUT
AD76FE	JSR CHARGT
AD7701	JSR AD773A      ;SCAN TO END OF LINE
	BEQ AD76DD      ;ALWAYS
AD7702	RTS
;
AD7706	JSR AD7726
	INC ARGMO
	JSR AD755D
	.IFN CC1 <
	INC VARTAB
>
	.IFE CC1 <
	INC TXTEND
>
	BNE AD7714
	.IFN CC1 <
	INC VARTAB+1
>
	.IFE CC1 <
	INC TXTEND+1
>
AD7714	RTS
.SKI 4
AD7715	JSR AD7726
	DEC ARGMO
	JSR AD7545
	.IFN CC1 <
	LDA VARTAB
>
	.IFE CC1 <
	LDA TXTEND
>
	BNE AD7723
	.IFN CC1 <
	DEC VARTAB+1
>
	.IFE CC1 <
	DEC TXTEND+1
>
AD7723
	.IFN CC1 <
	DEC VARTAB
>
	.IFE CC1 <
	DEC TXTEND
>
	RTS
.SKI 4
AD7726	JSR AD7529
	LDY #0
	STY COUNT
	STY ARGMO
	RTS
.SKI 4
AD7730	LDA FRESPC
	STA FACHO+1
	LDA FRESPC+1
	STA FACHO
	JMP STXTPT
.SKI 4
AD773A	LDA HIGHDS+1    ;IF LINE# >= START#, INCR NEW#
	SEC
	SBC HIGHTR+1
	BCC AD774A      ;NOPE, JUST SCAN TO EOL
	BNE AD773B
	LDA HIGHDS
	SBC HIGHTR
	BCC AD774A
AD773B	LDA FACHO+1     ;INCREMENT NEW LINE#
	CLC
	ADC FRETOP
	STA FACHO+1
	LDA FACHO
	ADC FRETOP+1
	STA FACHO
AD774A	JSR CHARGT      ;SCAN TO END OF LINE
	BNE AD774A
	RTS
.SKI 4
CHARGT	LDY #0
	INC TXTPTR
	BNE AD7758
	INC TXTPTR+1
AD7758	LDA (TXTPTR)Y
	RTS
.SKI 4
AD7529	LDA TXTPTR
	STA INDEX1
	LDA TXTPTR+1
	STA INDEX1+1
	.IFN CC1 <
	LDA VARTAB
>
	.IFE CC1 <
	LDA TXTEND
>
	STA INDEX2
	.IFN CC1 <
	LDA VARTAB+1
>
	.IFE CC1 <
	LDA TXTEND+1
>
	STA INDEX2+1
	RTS
.SKI 4
AD753A	LDA INDEX1
	CMP INDEX2
	BNE AD7544
	LDA INDEX1+1
	CMP INDEX2+1
AD7544	RTS
.SKI 4
AD7545	LDY COUNT
	INY
	LDA (INDEX1)Y
	LDY ARGMO
	INY
	STA (INDEX1)Y
	JSR AD753A
	BNE AD7555
	RTS
AD7555	INC INDEX1
	BNE AD7545
	INC INDEX1+1
	BNE AD7545
.SKI 4
AD755D	LDY COUNT
	LDA (INDEX2)Y
	LDY ARGMO
	STA (INDEX2)Y
	JSR AD753A
	BNE AD756B
	RTS
AD756B	LDA INDEX2
	BNE AD7571
	DEC INDEX2+1
AD7571	DEC INDEX2
	JMP AD755D
.SKI 4
SUBCLR	JSR LNKPRG
	LDA INDEX1
	LDX INDEX1+1
	CLC
	ADC #$02
	.IFN CC1 <
	STA VARTAB
>
	.IFE CC1 <
	STA TXTEND
>
	BCC AD72B6
	INX
AD72B6
	.IFN CC1 <
	STX VARTAB+1
>
	.IFE CC1 <
	STX TXTEND+1
>
	JSR RUNC
	JMP READY
.END