strng2

.PAG 'STRING FUNCTIONS'
; CONCATENATE TWO STRINGS
;
CAT
	LDA FACMO+2     ;PUSH DESCR PTR (BANK#)
	PHA
	LDA FACMO+1     ;(PTR)
	PHA
	LDA FACMO
	PHA
	JSR EVAL        ;DO 2ND OPERAND
	JSR CHKSTR      ;MUST BE STRING VALUE
	PLA
	STA STRNG1      ;STRNG1 <- DESCR PTR FOR 1ST OPND
	PLA
	STA STRNG1+1
	PLA
	STA STRNG1+2
	STA I6509 
	LDY #0
	LDA (STRNG1),Y  ;LEN1+LEN2<256 ?
	STA TTTEMP
	LDA FACMO+2 
	STA I6509 
	LDA (FACMO),Y
	JSR MAPTXT 
	CLC
	ADC TTTEMP
	BCC SIZEOK
	JMP ERRLEN
;
SIZEOK	JSR STRINI      ;ALLOCATE FOR RESULT
	JSR MOVINS      ;COPY 1ST OPERAND
	JSR SAV47
	JSR MOVDO       ;APPEND 2ND STRING
	LDA STRNG1      ;DESCRIPTOR PTR FOR RESULT
	LDY STRNG1+1
	LDX STRNG1+2
	JSR FRETMP
	JSR PUTNEW
	JMP TSTOP
SAV47	LDA DSCPNT      ;DESCR PTR 2ND OPND
	LDY DSCPNT+1
	LDX DSCPNT+2
	JMP FRETMP      ;SETS UP INDEX1!
.SKI 3
;
; CHR$ FUNCTION
;
CHRD	JSR CONINT
	TXA             ;.A <- PARAMETER VALUE
	PHA
	LDA #1
	JSR STRSPA      ;SPACE FOR 1 CHAR
	JSR MAPDST      ;BANK:=DSCTMP+3
	PLA
	LDY #0
	STA (DSCTMP+1),Y ;STORE THE CHAR
CHRD2	JSR MAPTXT
	PLA
	PLA
	JMP PUTNEW      ;ANOTHER TMP DESCR...
.SKI 3
;
; LEFT$, RIGHT$, MID$ FUNCTIONS
;
LEFTD	JSR PREAM
	PHA
	JSR MAPDSP      ;SET BANK
	LDA (DSCPNT),Y
	STA TTTEMP
	PLA
	CMP TTTEMP
	TYA
; IF 2ND PARAM>LENGTH, USE LENGTH INSTEAD
RLEFT	BCC RLEFT1
	LDA (DSCPNT),Y
	TAX
	TYA
RLEFT1	JSR MAPTXT 
	PHA             ;STARTING OFFSET
RLEFT2	TXA             ;LENGTH
RLEFT3	PHA
	JSR STRSPA      ;GET SPACE FOR RESULT
	JSR SAV47
	PLA
	TAY
	PLA
; ADD OFFSET. INDEX WILL POINT TO 1ST DESIRED CHAR.
	JSR SAV15
PULMOR	TYA
	JMP GLGR        ;MOVDO FOLLOWED BY PUTNEW
SAV15	CLC
SAV14	ADC INDEX
	STA INDEX
	BCC SAV16
	INC INDEX+1
SAV16	RTS
;
RIGHTD	JSR PREAM
	PHA
	JSR MAPDSP      ;SET BANK
	LDA (DSCPNT),Y
	STA TTTEMP
	PLA
	CLC
	SBC TTTEMP      ;PLACES-LENGTH
	EOR #$FF        ;IF CY, THEN LENGTH WILL BE USED
	JMP RLEFT
;
SAV17	JSR CHRGOT
	CMP #')'
	BEQ SAV18
	JMP COMBYT      ;CHECK FOR COMMA AND GET A BYTE
MIDD	LDA #$FF
	STA FACLO
	JSR SAV17
;
MID2	JSR PREAM
	BEQ GOFUC
	DEX
	TXA             ;1ST POS = 1ST OPND - 1
	PHA
	PHA
	CLC
	LDX #0
	JSR MAPDSP 
	LDA (DSCPNT),Y
	JSR MAPTXT 
	STA TTTEMP
	PLA
	SBC TTTEMP
; LENGTH OF RESULT = 0, IF 1ST POS > LEN STR OPND
; = MIN(LEN STR OPND - 1ST POS, 3RD OPND)
	BCS RLEFT2
	EOR #$FF
	CMP FACLO
	BCC RLEFT3
	LDA FACLO
	BCS RLEFT3
; EXIT PREAM: .X=.A=2ND PARAM VAL
; .Y=0
; DSCPNT SET UP FOR 1ST OPND
;
PREAM	JSR CHKCLS      ;')'?
	PLA
	TAY
	PLA
	STA JMPER+1     ;POP RETURN
;
; POP OFF: RETURN FROM CALLER OF PREAM (SEE ISFUN
; SHOULD GO BACK TO EVAL INSTEAD.)
; .X<-STACK (2ND PARAM, BYTE VAL)
; DSCPNT<-STACK (DESCRP PTR 1ST OPND)
; PUSH BACK RETURN TO CALLER OF PREAM.
	PLA
	PLA
	PLA
	TAX
	PLA
	STA DSCPNT
	PLA
	STA DSCPNT+1
	PLA
	STA DSCPNT+2
	LDA JMPER+1
;
	PHA
	TYA
	PHA
	LDY #0
	TXA
SAV18	RTS
;
LEN	JSR LEN1
	JMP SNGFLT
;
LEN1	JSR FRESTR
	LDX #0
	STX VALTYP
	TAY
	RTS
;
ASC	JSR LEN1
	BEQ GOFUC
	LDY #0
	JSR SAV12
	TAY
	JMP SNGFLT
;
GOFUC	JMP FCERR
;
VAL	JSR LEN1
	BNE VAL1
	JMP ZEROFC
;
VAL1	LDX #2          ;STRNG2 := TXTPTR
TRUG
	LDY TXTPTR,X
	STY STRNG2,X
	DEX
	BPL TRUG
	LDX INDEX1+2 
	STX TXTPTR+2    ;TXTPTR := INDEX1 (START OF STR)
	STX I6509 
	LDX INDEX1
	STX TXTPTR
	CLC
	ADC INDEX1
	STA INDEX2      ;INDEX2 := OFFSET TO END OF STR
	LDX INDEX1+1
	STX TXTPTR+1
	BCC VAL2
	INX
VAL2	STX INDEX2+1
	LDY #0
	LDA (INDEX2),Y
	PHA
	TYA
	STA (INDEX2),Y
	JSR MAPTXT 
	JSR CHRGOT
	JSR FIN
	JSR MAPSTR      ;RESTORE BYTE AT END OF STR (ALWAYS IN STR BANK)
	PLA
	LDY #0
	STA (INDEX2),Y
	JSR MAPTXT 
ST2TXT	LDX STRNG2      ;RESTORE TEXT POINTER
	LDY STRNG2+1
	LDA STRNG2+2 
	STX TXTPTR
	STY TXTPTR+1
	STA TXTPTR+2 
	RTS
.SKI 4
ERRD	PLA             ;TRASH OLD TOKEN FROM ISFUN
	JSR PARCHK
	JSR CHKNUM      ;CHECK FOR NUMERIC ARGUMENT
	JSR CONINT      ;GET INTEGER ARG. IN X
	TXA
	ASL A
	CMP #ERRBLN     ;CHECK VALUE AGAINST LENGTH OF ERROR POINTER LIST
	BCS GOFUC
	TAY
	LDA EBASE,Y     ;GET ADDRESS OF MESSAGE
	STA INDEX2      ;AND CREATE A TEMP DESCRIPTOR POINTING TO IT
	LDA EBASE+1,Y
	STA INDEX2+1
	JSR MAPSYS
	LDY #$FF
	LDX #0
ERFLP1	INY             ;COUNT # OF CHARACTERS IN MESSAGE
	LDA (INDEX2),Y
	BEQ ERRD1       ;QUIT WHEN THE END IS FOUND
	CMP #$20        ;DON'T COUNT NON-PRINTERS
	BCC ERFLP1
	INX             ;IT'S A PRINTER, SO COUNT IT!
	BNE ERFLP1      ;ALWAYS
ERRD1	TXA
	JSR STRSPA      ;RESERVE A STRING
	LDY #$FF
	LDX #0
ERFLP2	INY
	JSR MAPSYS
	LDA (INDEX2),Y
	BEQ ERRD2       ;DONE IF NULL
	CMP #$20
	BCC ERFLP2
	STY TTTEMP      ;SAVE .Y
	PHA
	TXA             ;MOVE .X TO .Y
	TAY
	PLA
	JSR MAPDST
	STA (DSCTMP+1),Y
	TYA             ;MOVE .Y BACK TO .X
	TAX
	LDY TTTEMP      ;RESTORE .Y
	INX
	BNE ERFLP2      ;ALWAYS
ERRD2	JSR MAPTXT
	JMP PUTNEW
.SKI 5
; TIME IS PASSED TO AND FROM THE SYSTEM IN ALL THREE
; REGISTERS IN THE FOLLOWING WAY:
;
; .A (TENTH BIT 0) (SECONDS)
; .X (TENTH BIT 1) (MINUTES)
; .Y (AM/PM BIT) (TENTH BITS 3,2) (HOURS)
;
; THE HOURS, MINUTES, AND SECONDS ARE BCD DIGITS AND
; THE TENTHS DIGIT IS STORED IN THE UNUSED BITS OF THEM.
;
; GETTIM: GET THE TIME IN THE REGISTERS AND UNPACK
; INTO TMHOUR,TMMIN,TMSEC,TMTEN
;
; PUTS UNPACKED TIME INTO A STRING.
;
GETTIM	JSR RDTIM
	PHA             ;SAVE 10TH BIT 0
	AND #$7F        ;GET SECONDS
	STA TMSEC
	TYA             ;GET HOURS
	AND #$9F
	PHP             ;SAVE PLUS STATUS
	AND #$1F        ;GET RID OF PM BIT, IF SET
	CMP #$12        ;TREAT 12 AS 0
	BNE *+4
	LDA #0
	PLP             ;TEST FOR PM
	BPL LKT50
	SEI             ;PM BIT SET, ADJUST HOURS
	SED
	CLC
	ADC #$12
	CLD
	CLI
LKT50	STA TMHOUR
	LDA #0          ;DO 10THS
	STA TMTEN
	TYA
	ROL A           ;PM BIT
	ROL A           ;10TH BIT 3
	ROL TMTEN
	ROL A           ;10TH BIT 2
	ROL TMTEN
	TXA
	ROL A           ;10TH BIT 1
	ROL TMTEN
	LSR A           ;MINUTES
	STA TMMIN
	PLA
	ROL A           ;10TH BIT 0
	ROL TMTEN
.SKI 2
	LDA #8          ;STRING SPACE FOR 7 CHARS & 1 NULL
	JSR GETSPA
	STX INDEX1      ;INDEX1<- POINTER TO STR SPACE
	STY INDEX1+1
	LDY #STRBNK     ;BANK FOR RECENT ALLOCATION
	STY INDEX1+2
	STY I6509 
	TAY             ;.Y = 8
; PUT IN THE NULL TERMINATOR
	DEY
	LDA #0
	STA (INDEX1),Y
	DEY
; DO TENTHS, CONVERT TO ASCII
	LDA TMTEN
	CLC
	ADC #'0'
	STA (INDEX1),Y
	DEY
; .Y INDEX TO PLACE FOR NEXT DIGIT
; .X INDEX TO NEXT BYTE CONTAINING 2 PACKED
; BCD DIGITS(REL TO TMHOUR)
	LDX #2
GTI70
	LDA TMHOUR,X    ;DO LOW DIGIT FIRST
	PHA
	AND #$0F
	CLC
	ADC #'0'
	STA (INDEX1),Y
	DEY             ;NOW DO HIGH DIGIT
	PLA
	AND #$70
	LSR A
	LSR A
	LSR A
	LSR A
	ADC #'0'
	STA (INDEX1),Y
	DEY
	DEX
	BPL GTI70
	LDA INDEX1
	LDY INDEX1+1
	LDX INDEX1+2
	JMP STRLIT
.PAG 'TI$ ROUTINES'
; TI$ IS ASSIGNED A VALUE FROM A STRING WHOSE DESCRIPTOR
; IS STORED IN FAC.
;
MKTIME
	JSR FREFAC
	PHA
	CMP #6
	BEQ MKTMB
	CMP #7          ;MUST RECEIVE 7 DIGITS
	BNE FCERR2
MKTMB
	LDY #0          ;INX REG FOR PACKED DIGITS
	STY FBUFPT      ;INX FOR UNPACKED CHARS
;
; LOOP AROUND HERE THREE TIMES TO GET HOURS, MINUTES,
; AND SECONDS. TWO BCD DIGITS ARE PACKED INTO EACH BYTE
; INDEXED BY "INDEX2" AND .Y. EXPECTS TMHOUR, TMMIN,
; TMSEC TO BE STORED CONSECUTIVELY.
;
MKTI10
	JSR TIMNUM      ;GET DIGIT
	ASL A           ;MOVE DIGIT INTO HIGH NIBBLE
	ASL A
	ASL A
	ASL A
	STA TMHOUR,Y
	JSR TIMNUM      ;GET AND PACK 2ND DIGIT
	ORA TMHOUR,Y
	STA TMHOUR,Y
	INY
	CPY #3
	BNE MKTI10
	PLA
	CMP #6
	BEQ MKTMC
	JSR TIMNUM      ;GET TENTHS
	BNE MKTMD       ;ALWAYS
MKTMC
	LDA #0
MKTMD
	STA TMTEN
; ADJUST 24 HR CLOCK, SETTING P.M. IF NEEDED
	LDA TMHOUR
	CMP #$12        ;HR >= 12?
	BCC MKTI50
	SEI
	SED             ;DECIMAL MATH
	SBC #$12
	CLD
	CLI
	ORA #$80        ;P.M. BIT
	STA TMHOUR
MKTI50
	LDA #0          ;PACK 10TH BIT 0
	ROR TMTEN
	ROR A
	ORA TMSEC
	PHA
	LDA #0          ;PACK 10TH BIT 1
	ROR TMTEN
	ROR A
	ORA TMMIN
	TAX
	LDA #0          ;PACK 10TH BITS 2,3
	ROR TMTEN
	ROR A
	ROR TMTEN
	ROR A
	LSR A
	ORA TMHOUR
	TAY
	PLA
	CLC             ;C-CLR => SET TIME-OF-DAY
	JMP SETTIM      ;SET TIME AS SPECIFIED
.SKI 5
; TIMNUM GETS NEXT DIGIT
; USES INDEX2 AS BASE PTR, .Y<=FBUFPT TO GET ASCII DIGIT
; USES FBUFPT+1 AS TEMP FOR PRESERVING .Y
; EXIT: .Y UNCHANGED
; .A = UNASCIIED DIGIT VALUE
; FBUFPT=FBUFPT+1
;
TIMNUM
	STY FBUFPT+1
	LDY FBUFPT
	INC FBUFPT
	JSR SAV12
	JSR QNUM
	BCS FCERR2
	SBC #$2F
	LDY FBUFPT+1
	RTS
FCERR2	JMP FCERR
.PAG 'GARBAGE COLLECTION'
; GET SPACE FOR CHAR STRING.
; NOTE MAY FORCE GARBAGE COLLECTION
;
; ENTRY AC = # OF CHARS
; EXIT PTR IN Y,X OTHERWISE
; BLOWS OFF TO 'OUT OF STRING SPACE' ERROR
; ALSO PRESERVES AC AND SETS FRESPC=
; Y,X= ->AT SPACE.
GETSPA
	LSR GARBFL
TRYAG2	TAX             ;SAVE IN X ALSO
	BEQ GETRTS      ;LENGTH OF 0 NO GO...
	PHA             ;SAVE A (LENGTH) ON STACK
	LDA FRETOP      ;LO BYTE
	SEC             ;FOR SUBTRACT
	SBC #PTRSIZ     ;MINUS 3 (LINK BYTES)
	LDY FRETOP+1
	BCS TRYAG3
	BEQ GARBAG      ;MAKE SURE NO WRAPAROUND TO $FF PAGE
	DEY
TRYAG3	STA INDEX1      ;SAVE FOR LATER
	STY INDEX1+1
	TXA
	EOR #$FF
	SEC
	ADC INDEX1
	BCS TRYAG4
	STA TTTEMP      ;PREVENT WRAPAROUND TO $FF PAGE
	TYA
	BEQ GARBAG
	LDA TTTEMP
	DEY
TRYAG4	CPY STREND+1
	BCC GARBAG
	BNE STRFRE
	CMP STREND
	BCC GARBAG
STRFRE	STA FRESPC
	STY FRESPC+1
	JSR MAPSTR 
	LDY #$02        ;FLAG STRING AS GARB.
	LDA #$FF        ;GARBAGE FLAG
	STA (INDEX1),Y
	DEY
	STA (INDEX1),Y  ;FLAG
	DEY
	PLA             ;LENGTH
	STA (INDEX1),Y
	JSR MAPTXT 
	LDX FRESPC
	LDY FRESPC+1
	STX FRETOP
	STY FRETOP+1
GETRTS
	RTS
;
GARBAG
	LDA GARBFL
	BMI GRBG99      ;IF OUT OF MEMORY
	JSR GARBA2
	SEC
	ROR GARBFL
	PLA
	BNE TRYAG2      ;ALWAYS
;
GRBG99
	JMP OMERR       ;OUT OF MEMORY
.PAG
; ROUTINE LOOKS FOR AND SQUASHES OUT ANY UNUSED STRING
; SPACE IT FINDS. THUS RETURNING THE SPACE FOR FUTURE 
; USE BY THE STRING ROUTINES.
; GARBA2 IS CALLED ONLY WHEN BASIC NEEDS SPACE OR A FRE
; INSTRUCTION IS USED.
;
GARBA2
	LDA #STRBNK     ;SET INDIRECTION TO STRING BANK
	STA $1
	LDA TEMPPT      ;GET # OF TEMPORARY STRINGS
	BEQ NAA         ;SKIP IF NONE
LA	;CREATE A BACK POINTER ON CURRENT TEMPORARY STRINGS
	PHA             ;SAVE # OF TEMPS
	JMP PSLRA       ;29SEPT83 PATCH ******************
LA0	TYA             ;.Y NOW POINTS TO WHICH TEMPORARY DESCRIPTOR
	CLC
	ADC TEMPST      ;GET LOCATION OF TEMP DESCRIPTOR
	LDY #0
	STA (TEMPF2),Y  ;AND CREATE A BACK POINTER TO IT
	LDA TEMPST+1
	INY
	STA (TEMPF2),Y
	LDA #STRBNK
	INY
	STA (TEMPF2),Y
.SKI
LA1	PLA
	SEC
	SBC #4
	BNE LA          ;REPEAT IF THIS WAS NOT LAST TEMPORARY
NAA	;MAIN BODY OF GARBAGE COLLECT
	LDY #$00        ;SET UP FLAG
	STY HIGHDS
	LDA MEMTOP      ;GET TOP OF MEMORY
	LDY MEMTOP+1
	STA GRBTOP      ;SET BOTH POINTERS
	STA GRBPNT
	STA FRESPC
	STY GRBTOP+1
	STY GRBPNT+1
	STY FRESPC+1
;
; DO WHILE (GRBPNT <= FRETOP)
;
GLOOP
	JSR CHKGRB      ;CHECK GARBAGE STRING
	BNE COL01       ;IF NOT GARBAGE STRING
COL00A	LDY #0          ;GET LENGTH
	JSR MAPSTR 
	LDA (GRBPNT),Y
	JSR MOVPNT      ;MOVE GRBPNT TO NEXT
	SEC
	ROR HIGHDS      ;INDICATE GARBAGE STRING FOUND
	BNE GLOOP       ;ALWAYS
;
COL01
	BIT HIGHDS
	BPL COL03       ;IF GARBAGE STRING NOT FOUND
	LDX #$00
	STX HIGHDS      ;CLEAR INDICATOR
;
; MOVE A STRING OVER GARBAGE
;
COL02	LDY #$02        ;MOVE THE LINK BYTES
	JSR MAPSTR 
COL02A
	LDA (GRBPNT),Y
	STA (GRBTOP),Y
	DEY
	BPL COL02A
;
	JSR SAV7
	TXA             ;PUT LENGTH-1 IN .Y
	TAY
	JSR MAPSTR 
;
GLOP1	DEY
	LDA (GRBPNT),Y
	STA (GRBTOP),Y
	DEX
	BNE GLOP1
;
	JSR MAPINX 
	LDY #$02        ;FIX THE DESCRIPTOR
COL02B	LDA GRBTOP-1,Y
	STA (INDEX1),Y
	DEY
	BNE COL02B
	.IFN GDEBUG <
	JSR GRBPRI      ;GARBAGE DEBUG
>
	LDA GRBPNT      ;CHECK POINTER
	LDY GRBPNT+1
	JSR CHKGRB      ;CHECK GARBAGE STRING
	BEQ COL00A      ;IF GARBAGE STRING FOUND
	BNE COL02       ;ALWAYS
;
COL03
	JSR SAV7
	JMP GLOOP
;
SAV7	LDY #0          ;SKIP OVER STRING BODY
	JSR MAPINX
	LDA (INDEX1),Y
	TAX
	JSR MOVTOP
	STA FRESPC
	STY FRESPC+1
	TXA
	JMP MOVPNT
	.IFN GDEBUG <
	JSR GRBPRI      ;GARBAGE DEBUG
>
.SKI 4
; SUBROUTINES USED FOR GARBAGE COLLECTION
; COMPARE FOR Y,A = FRETOP.
; ENTRY Y,A = ADDRESS OF CURRENT STRING DESCRIPTOR.
; EXIT EXIT TO CALLER IF Y,A = FRETOP.
; ELSE Z FLAG SET IF GARBAGE STRING.
; Z FLAG CLEAR IF NOT GARBAGE STRING.
; IN EITHER CASE POINTERS ARE SETUP FOR NEXT LOOP
; AND STRING MOVEMENT.
; EXIT TO CFRE4.
; CARRY CLEAR Y,A <= FRETOP.
CHKGRB
	CPY FRETOP+1    ;END OF STRINGS ?
	BCC CFRE4
	BNE CFRE1       ;IF NOT EQUAL
	CMP FRETOP
	BEQ CFRE4
	BCC CFRE4
;
CFRE1
	BIT HIGHDS      ;CHECK FLAG
	BMI CFRE2       ;IF EMPTY STRING FOUND
	LDA #PTRSIZ     ;SKIP POINTERS PAST
	JSR MOVTOP      ;MOVE TOP POINTER
CFRE2	LDA #PTRSIZ     ;SKIP POINTERS PAST
	JSR MOVPNT      ;MOVE POINTERS
	LDY #$02
	JSR MAPSTR 
	LDA (GRBPNT),Y  ;GARBAGE ?
	CMP #$FF
	BNE CFRE3       ;IF NOT GARBAGE STRING
	RTS
;
CFRE3
	LDA (GRBPNT),Y  ;TO LINK BYTES
	STA INDEX1,Y
	DEY
	BPL CFRE3       ;IF THREE BYTES NOT MOVED
	RTS
;
CFRE4	;MARK TEMPORARY STRINGS AS GARBAGE AND EXIT
	LDA TEMPPT      ;GET # OF TEMPORARY STRINGS
	BEQ NAA2        ;SKIP IF NONE
FA	;MARK CURRENT TEMPORARY STRINGS AS GARBAGE
	PHA             ;SAVE # OF TEMPS
	JMP PSLRB       ;29SEPT83 PATCH **********************
FA0	LDA (TEMPST),Y  ;GET STRING LENGTH
	LDY #0          ;SET UP INDEX
	STA (TEMPF2),Y  ;REPLACE BACK POINTER
	INY
	LDA #$FF
	STA (TEMPF2),Y
	INY
	STA (TEMPF2),Y
.SKI
FA1	PLA
	SEC
	SBC #4
	BNE FA          ;REPEAT IF THIS WAS NOT LAST TEMPORARY
NAA2
	JSR MAPTXT      ;RESTORE I6509
	PLA             ;THROW AWAY RETURN ADDRESS
	PLA
	LDA FRESPC      ;FIX FRETOP AND FRESPC
	LDY FRESPC+1
	STA FRETOP
	STY FRETOP+1
	RTS
.SKI 2
SLR1
	TAY
	DEY
	DEY
	LDA (TEMPST),Y  ;GET HIGH BYTE OF ADDRESS
	STA TEMPF2+1    ;AND SAVE IT
	DEY
	LDA (TEMPST),Y  ;GET LOW BYTE OF ADDRESS
	STA TEMPF2      ;AND SAVE IT
	DEY
	LDA (TEMPST),Y  ;GET LENGTH OF STRING
	JMP PSLR1       ;29SEPT83 PATCH ************************
	STA TEMPF2      ;DEAD CODE FOLLOWS!
	BCC SLR2
	INC TEMPF2+1
SLR2
	RTS
.SKI 4
MOVPNT	EOR #$FF        ;COMP AND ADD
	SEC
	ADC GRBPNT
	LDY GRBPNT+1
	BCS MOV00
	DEY
MOV00	STA GRBPNT
	STY GRBPNT+1
	RTS
.SKI 4
MOVTOP	EOR #$FF        ;COMP AND ADD
	SEC
	ADC GRBTOP
	LDY GRBTOP+1
	BCS MOV01
	DEY
MOV01	STA GRBTOP
	STY GRBTOP+1
	RTS
	.IFN GDEBUG <
.SKI 3
PUTSPC
	LDA #' '
	JMP BSOUT
.SKI 4
;
; PRINT A BYTE OUT IN HEX
; ENTER: .A = BYTE VALUE
; EXIT : .A UNCHANGED
;
HXOUT	PHA
	PHA             ;DO HIGH ORDER NIBBLE
	LSR A
	LSR A
	LSR A
	LSR A
	JSR HXNB
	PLA             ;DO LOW ORDER NIBBLE
	AND #$0F
	JSR HXNB
	PLA
	RTS
HXNB	CMP #$0A
	BCC HXN10
	CLC
	ADC #55
	JMP HXN20
HXN10	ADC #$30
HXN20	JMP BSOUT
.SKI 4
;
; PRINT STRING POINTED TO BY GRBTOP. THIS IS A
; NON-GARBAGE STRING, WHOSE DESCRIPTOR IS POINTED
; TO BY INDEX. STRING BYTES ARE PRINTED IN HEX,
; IN CASE NON-PRINTABLE CHARS APPEAR. DUMPS:
;
; (STR ADDRESS) (STRING) (LINK)
;
GRBPRI
	LDA GRBTOP+1    ;PRINT ADDR OF STR
	JSR HXOUT
	LDA GRBTOP
	JSR HXOUT
	JSR PUTSPC
; PRINT STRING BODY
	LDY #0
	LDA (INDEX1),Y  ;LENGTH
	TAX
	CMP #0
	BEQ GPR10
GPR20
	LDA (GRBTOP),Y
	STY RESLO       ;RESLO, RESMO USED AS TEMPS
	STX RESMO
	JSR HXOUT
	JSR PUTSPC
	LDY RESLO
	LDX RESMO
	INY
	DEX
	BNE GPR20
GPR10
; PRINT OUT LINK BYTES, DESCR ADDRESS
	JSR PUTSPC
	LDA (GRBTOP),Y
	PHA
	INY
	LDA (GRBTOP),Y
	JSR HXOUT
	PLA
	JSR HXOUT
	JSR PUTSPC
	INY
	LDA (GRBTOP),Y
	JSR HXOUT
	JSR PUTSPC
	LDA INDEX1+1
	JSR HXOUT
	LDA INDEX1
	JSR HXOUT
	JSR PUTSPC
	LDA INDEX1+1
	JSR HXOUT
	JSR OCRLF
	.BYTE 0,0
	RTS
>
.PAG 'INSTRING'
INFCER	JMP FCERR
INSTRG	LDX #2
INCOP1	LDA FACMO,X     ;SAVE POINTER TO TEMPORARY DESCRIPTOR
	STA TMPDES,X
	DEX
	BPL INCOP1
	JSR FRMEVL      ;GET NEXT ARG.
	JSR CHKSTR      ;MUST BE STRING
	LDX #2
INCOP2	LDA FACMO,X     ;AND SAVE IT, TOO
	STA TMPDES+3,X
	DEX
	BPL INCOP2
;
	LDX #1
	STX FACLO       ;IF NO STARTING POSITION IS GIVEN, 1 IS ASSUMED
	JSR SAV17
INST1	JSR CHKCLS
	LDX FACLO
	BEQ INFCER      ;S.A. OF 0 IS AN ERROR
	DEX
	STX POSITN
;
	LDX #5          ;MOVE POINTERS TO TEMP DESCRIPTORS TO ZERO PAGE
INST2	LDA TMPDES,X
	STA PTARG1,X
	DEX
	BPL INST2
;
	LDA PTARG1+2    ;NOW MOVE IN THE DESCRIPTORS
	STA I6509
	LDY #3
INST3	LDA (PTARG1),Y
	STA STR1,Y
	DEY
	BPL INST3
;
	LDA PTARG2+2
	STA I6509
	LDY #3
INST4	LDA (PTARG2),Y
	STA STR2,Y
	DEY
	BPL INST4
;
	LDA STR2        ;CHECK IF STRING 2 IS NULL
	BEQ INSTNF      ;IF SO, RETURN ZERO
;
	LDA STR1+3
	STA I6509
INST5	LDA #0
	STA MATCH
	CLC
	LDA STR2        ;LENGTH OF STRING 2
	ADC POSITN
	BCS INSTNF      ;TOO LONG, NOT FOUND
	CMP STR1        ;SEE IF > LENGTH OF STRING 1
	BCC INST6       ;< LEN. STRING 1
	BNE INSTNF      ;MUST BE >, NOT FOUND
INST6	LDY MATCH
	CPY STR2        ;IF MATCH LEN. = STR. LEN, THEN FOUND
	BEQ INSTFD
	TYA
	CLC
	ADC POSITN      ;COMPARE STRING1(S+P+M) WITH STRING2(M)
	TAY
	LDA (STR1+1),Y
	STA TMPPOS
	LDY MATCH
	LDA (STR2+1),Y
	CMP TMPPOS
	BEQ INST7
	INC POSITN      ;NOT THE SAME, START OVER FROM NEXT POSITION
	BNE INST5       ;ALWAYS
INST7	INC MATCH       ;COUNT CHARACTERS THAT MATCH
	BNE INST6       ;ALWAYS
;
INSTFD	INC POSITN
	LDA POSITN
	.BYT $2C
INSTNF	LDA #0
	PHA
	LDA TMPDES+3    ;FREE TEMP DESCRIPTORS
	LDY TMPDES+4
	LDX TMPDES+5
	JSR FRETMP
	LDA TMPDES
	LDY TMPDES+1
	LDX TMPDES+2
	JSR FRETMP
	JSR MAPTXT
	PLA             ;SEND RESULT BACK AS AN INTEGER
	TAY
	JMP SNGFLT
.END