6502basiccompiler/arch/6502/__sandbox__/library-asm/_2_converting/letsubstr.asm

; Substring assigment eg. LET a$(p0 TO p1) = "xxxx"
; HL = Start of string
; TOP of the stack -> p1 (16 bit, unsigned)
; TOP -1 of the stack -> p0 register
; TOP -2 Flag (popped out in A register)
; 		A Register	=> 0 if HL is not freed from memory
;					=> Not 0 if HL must be freed from memory on exit
; TOP -3 B$ address
;
#include once <free.asm>
;
__LETSUBSTR:
                     ;- PROC
                     ;- LOCAL __CONT0
                     ;- LOCAL __CONT1
                     ;- LOCAL __CONT2
                     ;- LOCAL __FREE_STR
                     ;- LOCAL __FREE_STR0
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
pla                  ;- pop hl ; Return address
sta z80_h
pla
sta z80_l
pla                  ;- pop de ; p1
sta z80_d
pla
sta z80_e
pla                  ;- pop bc ; p0
sta z80_b
pla
sta z80_c
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
plp                  ;- pop af ; Flag
pha
ldx z80_ap           ;- ex af, af'	; Save it for later
sta z80_ap
txa
pla                  ;- pop de ; B$
sta z80_d
pla
sta z80_e
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
lda z80_l            ;- push hl ; push ret addr back
pha
lda z80_h
pha
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
lda z80_h            ;- ld a,h
sta z80_a
ora z80_l            ;- or l
jeq __FREE_STR0      ;- jp z, __FREE_STR0 ; Return if null
ldy #$00             ;- ld c,(hl)
lda (z80_hl),y
sta z80_c
inc z80_l            ;- inc hl
bne *+4
inc z80_h
ldy #$00             ;- ld b,(hl) ; BC = Str length
lda (z80_hl),y
sta z80_b
inc z80_l            ;- inc hl	; HL = String start
bne *+4
inc z80_h
lda z80_c            ;- push bc
pha
lda z80_b
pha
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
lda z80_e            ;- ex de,hl
ldx z80_l
stx z80_e
sta z80_l
lda z80_d
ldx z80_h
stx z80_d
sta z80_h
ora z80_a            ;- or a
                     ;- sbc hl, bc ; HL = Length of string requester by user
inc z80_l            ;- inc hl	   ; len (a$(p0 TO p1)) = p1 - p0 + 1
bne *+4
inc z80_h
lda z80_e            ;- ex de, hl  ; Saves it in DE
ldx z80_l
stx z80_e
sta z80_l
lda z80_d
ldx z80_h
stx z80_d
sta z80_h
pla                  ;- pop hl	   ; HL = String length
sta z80_h
pla
sta z80_l
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
jcc __FREE_STR0      ;- jp c, __FREE_STR0	   ; Return if greather
lda z80_c            ;- exx		   ; Return if p0 > p1
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
ora z80_a            ;- or a
                     ;- sbc hl, bc ; P0 >= String length?
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
jeq __FREE_STR0      ;- jp z, __FREE_STR0	   ; Return if equal
jcc __FREE_STR0      ;- jp c, __FREE_STR0	   ; Return if greather
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
lda z80_l            ;- add hl,bc ; Add it back
clc
adc z80_c
sta z80_l
lda z80_h
adc z80_b
sta z80_h
lda z80_l            ;- sbc hl,de ; Length of substring > string => Truncate it
sbc z80_e
sta z80_l
lda z80_h
sbc z80_d
sta z80_h
clc                  ;- add hl,de ; add it back
lda z80_l
adc z80_e
sta z80_l
lda z80_h
adc z80_d
sta z80_h
jcs __CONT0          ;- jr nc, __CONT0 ; Length of substring within a$
lda z80_h            ;- ld d,h
sta z80_d
lda z80_l            ;- ld e,l	   ; Truncate length of substring to fit within the strlen
sta z80_e

__CONT0:	   ; At this point DE = Length of subtring to copy
;- 		   ; BC = start of char to copy
lda z80_e            ;- push de
pha
lda z80_d
pha
lda z80_c            ;- push bc
pha
lda z80_b
pha
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
pla                  ;- pop bc
sta z80_b
pla
sta z80_c
lda z80_l            ;- add hl,bc ; Start address (within a$) so copy from b$ (in DE)
clc
adc z80_c
sta z80_l
lda z80_h
adc z80_b
sta z80_h
lda z80_l            ;- push hl
pha
lda z80_h
pha
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
pla                  ;- pop hl	   ; Start address (within a$) so copy from b$ (in DE)
sta z80_h
pla
sta z80_l
lda z80_d            ;- ld b,d	   ; Length of string
sta z80_b
lda z80_e            ;- ld c,e
sta z80_c
lda #$20             ;- ld (hl), ' '
ldy #$00
sta (z80_hl),y
lda z80_h            ;- ld d,h
sta z80_d
lda z80_l            ;- ld e,l
sta z80_e
inc z80_e            ;- inc de
bne *+4
inc z80_d
                     ;- dec bc
lda z80_b            ;- ld a,b
sta z80_a
ora z80_c            ;- or c
jeq __CONT2          ;- jr z, __CONT2
;- ; At this point HL = DE = Start of Write zone in a$
;- ; BC = Number of chars to write
                     ;- ldir

__CONT2:
pla                  ;- pop bc	; Recovers Length of string to copy
sta z80_b
pla
sta z80_c
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
lda z80_e            ;- ex de, hl  ; HL = Source, DE = Target
ldx z80_l
stx z80_e
sta z80_l
lda z80_d
ldx z80_h
stx z80_d
sta z80_h
lda z80_h            ;- ld a,h
sta z80_a
ora z80_l            ;- or l
jeq __FREE_STR       ;- jp z, __FREE_STR ; Return if B$ is NULL
ldy #$00             ;- ld c,(hl)
lda (z80_hl),y
sta z80_c
inc z80_l            ;- inc hl
bne *+4
inc z80_h
ldy #$00             ;- ld b,(hl)
lda (z80_hl),y
sta z80_b
inc z80_l            ;- inc hl
bne *+4
inc z80_h
lda z80_b            ;- ld a,b
sta z80_a
ora z80_c            ;- or c
jeq __FREE_STR       ;- jp z, __FREE_STR ; Return if len(b$) = 0
;- ; Now if len(b$) < len(char to copy), copy only len(b$) chars
lda z80_e            ;- push de
pha
lda z80_d
pha
lda z80_l            ;- push hl
pha
lda z80_h
pha
lda z80_c            ;- push bc
pha
lda z80_b
pha
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
pla                  ;- pop hl	; LEN (b$)
sta z80_h
pla
sta z80_l
ora z80_a            ;- or a
                     ;- sbc hl, bc
                     ;- add hl, bc
jcs __CONT1          ;- jr nc, __CONT1
;- ; If len(b$) < len(to copy)
lda z80_h            ;- ld b,h ; BC = len(to copy)
sta z80_b
lda z80_l            ;- ld c,l
sta z80_c

__CONT1:
pla                  ;- pop hl
sta z80_h
pla
sta z80_l
pla                  ;- pop de
sta z80_d
pla
sta z80_e
                     ;- ldir	; Copy b$ into a$(x to y)
lda z80_c            ;- exx
ldx z80_cp
stx z80_c
sta z80_cp
lda z80_b
ldx z80_bp
stx z80_b
sta z80_bp
lda z80_e
ldx z80_ep
stx z80_e
sta z80_ep
lda z80_d
ldx z80_dp
stx z80_d
sta z80_dp
lda z80_l
ldx z80_lp
stx z80_l
sta z80_lp
lda z80_h
ldx z80_hp
stx z80_h
sta z80_hp
lda z80_e            ;- ex de,hl
ldx z80_l
stx z80_e
sta z80_l
lda z80_d
ldx z80_h
stx z80_d
sta z80_h

__FREE_STR0:
lda z80_e            ;- ex de,hl
ldx z80_l
stx z80_e
sta z80_l
lda z80_d
ldx z80_h
stx z80_d
sta z80_h

__FREE_STR:
ldx z80_ap           ;- ex af,af'
sta z80_ap
txa
ora z80_a            ;- or a		; If not 0, free
jne __MEM_FREE       ;- jp nz, __MEM_FREE
rts                  ;- ret
                     ;- ENDP