code6

.PAG 'CODE6'
TIMELP	STY FBUFPT
	JSR TIMNUM
	JSR MUL10
	INC FBUFPT
	LDY FBUFPT
	JSR TIMNUM
	JSR MOVAF
	TAX
	BEQ NOML6
	INX
	TXA
	JSR FINML6
NOML6	LDY FBUFPT
	INY
	CPY #6
	BNE TIMELP
	JSR MUL10
	JSR QINT
	LDX #2
	SEI
TIMEST	LDA FACMOH,X
	STA CTIMR,X
	DEX
	BPL TIMEST
	CLI
	RTS
TIMNUM	LDA (INDEX)Y
	JSR QNUM
	BCC GOTNUM
FCERR2	JMP FCERR
GOTNUM	SBC #$2F
	JMP FINLOG
GETSPT	LDY #2
	LDA (FACMO)Y
	CMP DSDESC+2
	BNE DSKX2
	PHA
	DEY
	LDA DSDESC
	BEQ DSKX1
	LDA (FACMO),Y
	CMP DSDESC+1
	BNE DSKX1
	PLA
	JMP COPY
DSKX1	PLA
	INY
DSKX2	CMP FRETOP+1
	BCC DNTCPY
	BNE QVARIA
	DEY
	LDA (FACMO)Y
	CMP FRETOP
	BCC DNTCPY
QVARIA	LDY FACLO
	CPY VARTAB+1
	BCC DNTCPY
	BNE COPY
	LDA FACMO
	CMP VARTAB
	BCS COPY
DNTCPY	LDA FACMO
	LDY FACMO+1
	JMP COPYC
COPY	LDY #0
	LDA (FACMO)Y
	JSR STRINI
	LDA DSCPNT
	LDY DSCPNT+1
	STA STRNG1
	STY STRNG1+1
	JSR MOVINS
	LDA STRNG1
	LDY STRNG1+1
	JSR FRETMS
	LDA #<DSCTMP
	LDY #>DSCTMP
COPYC	STA DSCPNT
	STY DSCPNT+1
	STA INDEX       ;INDEX ... TO NEW
	STY INDEX+1     ;DESCRIPT ...
	JSR FRETMS
;
; FIX THE STRINGS BY FLAGGING THE
;OLD STRING AS GARBAGE AND THE NEW
;STRING BY FOINTING IT TO ITS
;NEW DESCRIPTOR
;
	JSR STRADJ      ;SET UP ... STRING
	BCC COPY00      ;LEAVE ...
	LDY #$00
	LDA FORPNT      ;PUT IN ... WARDS LINK
	STA (INDEX),Y
	INY
	LDA FORPNT+1
	STA (INDEX),Y
;
COPY00	LDA FORPNT      ;FIX OLD ... RING
	STA INDEX
	LDA FORPNT+1
	STA INDEX+1
	JSR STRADJ      ;POINT TO ... STRING
	BCC COPY01      ;IN TEXT ... NOT FIX
	DEY             ;RESTORE ...
	LDA #$FF        ;GARBAGE ...
	STA (INDEX),Y
	DEY
	TXA
	STA (INDEX),Y   ;STORE L ...
;
COPY01	LDY #$02
COPY02	LDA (DSCPNT),Y  ;SET THE ... DESCRIPTOR
	STA (FORPNT),Y
	DEY
	BPL COPY02
	RTS
.SKI 5
;
;SUBROUTINE STRADJ TAKES THE POINTER
;INDEX WHICH FOINTS TO A DESCRIPTOR
;AND INDEXES TO THE DESCIPTORS
;5TRING DATA.
; IF THE STRING IS FELON FRETOP
; (NO ACTIOH TO TAKE) WE RETURN
;WITH THE CARRY CLEAR,
; ELSE WE RETURN MITH THE POINTER
;SET TO THE LINK BYTES IH THE STRING
;THE LENGTH IN ACC AND THE CARRY SET
;
STRADJ	LDY #$00
	LDA (INDEX),Y   ;PUSH LENGTH ON STACR
	PHA
	BEQ ADJ01       ;LENGTH 0 DO NOTHING
	INY
	LDA (INDEX),Y   ;LO BYTE TO X
	TAX
	INY
	LDA (INDEX)Y    ;HI BYTE IN A
	BMI ADJ01       ;FREVENTS WRITING ABOVE $8000
	CMP #>ROMLOC
	BCS ADJ01
	CMP FRETOP+1    ;IF BELOW FRETOP
	BCC ADJ01       ;THEN RETURN TO CALLER
	BNE ADJ
	CPX FRETOP
	BCC ADJ01
ADJ	CMP DSDESC+2
	BNE LBA74
	CPX DSDESC+1
	BEQ ADJ01
LBA74	STX INDEX       ;OK: SET POINTER
	STA INDEX+1
	PLA             ;GET BACK LEHGTH
	TAX             ;INTO X ALSO
	CLC
	ADC INDEX
	STA INDEX
	BCC ADJ00
	INC INDEX+1
ADJ00	SEC             ;CARRY SET
	RTS
ADJ01	PLA             ;CLEAN UP STACK
	CLC
	RTS
.SKI 5
PRINTN	JSR CMD
	JMP IODONE
CMD	JSR GETBYT
	BEQ SAVEIT
	LDA #44
	JSR SYNCHR
SAVEIT	PHP
	JSR COOUT
	STX CHANNL
	PLP
	JMP PRINT
STRDON	JSR STRPRT
NEWCHR	JSR CHRGOT
PRINT	BEQ CRDO
PRINTC	BEQ PRTRTS
	CMP #TABTK
	BEQ TABER
	CMP #SPCTK
	CLC
	BEQ TABER
	CMP #44
	BEQ COMPRT
	CMP #59
	BEQ NOTABR
	JSR FRMEVL
	BIT VALTYP
	BMI STRDON
	JSR FOUT
	JSR STRLIT
	JSR STRPRT
	JSR OUTSPC
	BNE NEWCHR
FININL	LDA #0
	STA BUF,X
ZZ5=BUF-1
	LDX #<ZZ5
	LDY #>ZZ5
	LDA CHANNL
	BNE PRTRTS
CRDO	LDA #13
	JSR OUTDO
	LDA CHANNL
	BPL CRFIN
	LDA #$0A        ;LINE FEED
	JSR OUTDO
CRFIN	EOR #255
PRTRTS	RTS
COMPRT	LDA TRMPOS
NCMPOS	=@36
	SEC
MORCO1	SBC #CLMWID
	BCS MORCO1
	EOR #255
	ADC #1
	BNE ASPAC
TABER	PHP
	JSR GTBYTC
	CMP #41
	BNE SNERR4
	PLP
	BCC XSPAC
	TXA
	SBC TRMPOS
	BCC NOTABR
ASPAC	TAX
XSPAC	INX
XSPAC2	DEX
	BNE XSPAC1
NOTABR	JSR CHRGET
	JMP PRINTC
.FIL CODE7