2008-10-13 01:43:59 +00:00
|
|
|
.segment "CODE"
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "STR$" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
STR:
|
|
|
|
|
jsr CHKNUM
|
|
|
|
|
ldy #$00
|
|
|
|
|
jsr FOUT1
|
|
|
|
|
pla
|
|
|
|
|
pla
|
|
|
|
|
LD353:
|
|
|
|
|
lda #$FF
|
|
|
|
|
ldy #$00
|
|
|
|
|
beq STRLIT
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
|
|
|
|
|
; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
STRINI:
|
|
|
|
|
ldx FAC_LAST-1
|
|
|
|
|
ldy FAC_LAST
|
|
|
|
|
stx DSCPTR
|
|
|
|
|
sty DSCPTR+1
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
|
|
|
|
|
; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
STRSPA:
|
|
|
|
|
jsr GETSPA
|
|
|
|
|
stx FAC+1
|
|
|
|
|
sty FAC+2
|
|
|
|
|
sta FAC
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
|
|
|
|
|
; AND TERMINATED BY $00 OR QUOTATION MARK
|
|
|
|
|
; RETURN WITH DESCRIPTOR IN A TEMPORARY
|
|
|
|
|
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
STRLIT:
|
|
|
|
|
ldx #$22
|
|
|
|
|
stx CHARAC
|
|
|
|
|
stx ENDCHR
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
|
|
|
|
|
; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
|
|
|
|
|
;
|
|
|
|
|
; RETURN WITH DESCRIPTOR IN A TEMPORARY
|
|
|
|
|
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
STRLT2:
|
|
|
|
|
sta STRNG1
|
|
|
|
|
sty STRNG1+1
|
|
|
|
|
sta FAC+1
|
|
|
|
|
sty FAC+2
|
|
|
|
|
ldy #$FF
|
|
|
|
|
L3298:
|
|
|
|
|
iny
|
|
|
|
|
lda (STRNG1),y
|
|
|
|
|
beq L32A9
|
|
|
|
|
cmp CHARAC
|
|
|
|
|
beq L32A5
|
|
|
|
|
cmp ENDCHR
|
|
|
|
|
bne L3298
|
|
|
|
|
L32A5:
|
|
|
|
|
cmp #$22
|
|
|
|
|
beq L32AA
|
|
|
|
|
L32A9:
|
|
|
|
|
clc
|
|
|
|
|
L32AA:
|
|
|
|
|
sty FAC
|
|
|
|
|
tya
|
|
|
|
|
adc STRNG1
|
|
|
|
|
sta STRNG2
|
|
|
|
|
ldx STRNG1+1
|
|
|
|
|
bcc L32B6
|
|
|
|
|
inx
|
|
|
|
|
L32B6:
|
|
|
|
|
stx STRNG2+1
|
|
|
|
|
lda STRNG1+1
|
|
|
|
|
.if INPUTBUFFER >= $0100
|
|
|
|
|
beq LD399
|
|
|
|
|
cmp #>INPUTBUFFER
|
|
|
|
|
.endif
|
|
|
|
|
bne PUTNEW
|
|
|
|
|
LD399:
|
|
|
|
|
tya
|
|
|
|
|
jsr STRINI
|
|
|
|
|
ldx STRNG1
|
|
|
|
|
ldy STRNG1+1
|
|
|
|
|
jsr MOVSTR
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
|
|
|
|
|
;
|
|
|
|
|
; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
|
|
|
|
|
; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
PUTNEW:
|
|
|
|
|
ldx TEMPPT
|
|
|
|
|
cpx #TEMPST+9
|
|
|
|
|
bne PUTEMP
|
|
|
|
|
ldx #ERR_FRMCPX
|
|
|
|
|
JERR:
|
|
|
|
|
jmp ERROR
|
|
|
|
|
PUTEMP:
|
|
|
|
|
lda FAC
|
|
|
|
|
sta 0,x
|
|
|
|
|
lda FAC+1
|
|
|
|
|
sta 1,x
|
|
|
|
|
lda FAC+2
|
|
|
|
|
sta 2,x
|
|
|
|
|
ldy #$00
|
|
|
|
|
stx FAC_LAST-1
|
|
|
|
|
sty FAC_LAST
|
2008-10-13 20:26:42 +00:00
|
|
|
.ifdef CONFIG_2
|
2008-10-13 01:43:59 +00:00
|
|
|
sty FACEXTENSION
|
|
|
|
|
.endif
|
|
|
|
|
dey
|
|
|
|
|
sty VALTYP
|
|
|
|
|
stx LASTPT
|
|
|
|
|
inx
|
|
|
|
|
inx
|
|
|
|
|
inx
|
|
|
|
|
stx TEMPPT
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
|
|
|
|
|
; (A)=# BYTES SPACE TO MAKE
|
|
|
|
|
;
|
|
|
|
|
; RETURN WITH (A) SAME,
|
|
|
|
|
; AND Y,X = ADDRESS OF SPACE ALLOCATED
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
GETSPA:
|
|
|
|
|
lsr DATAFLG
|
|
|
|
|
L32F1:
|
|
|
|
|
pha
|
|
|
|
|
eor #$FF
|
|
|
|
|
sec
|
|
|
|
|
adc FRETOP
|
|
|
|
|
ldy FRETOP+1
|
|
|
|
|
bcs L32FC
|
|
|
|
|
dey
|
|
|
|
|
L32FC:
|
|
|
|
|
cpy STREND+1
|
|
|
|
|
bcc L3311
|
|
|
|
|
bne L3306
|
|
|
|
|
cmp STREND
|
|
|
|
|
bcc L3311
|
|
|
|
|
L3306:
|
|
|
|
|
sta FRETOP
|
|
|
|
|
sty FRETOP+1
|
|
|
|
|
sta FRESPC
|
|
|
|
|
sty FRESPC+1
|
|
|
|
|
tax
|
|
|
|
|
pla
|
|
|
|
|
rts
|
|
|
|
|
L3311:
|
|
|
|
|
ldx #ERR_MEMFULL
|
|
|
|
|
lda DATAFLG
|
|
|
|
|
bmi JERR
|
|
|
|
|
jsr GARBAG
|
|
|
|
|
lda #$80
|
|
|
|
|
sta DATAFLG
|
|
|
|
|
pla
|
|
|
|
|
bne L32F1
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
|
|
|
|
|
; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
|
|
|
|
|
; BELOW STRING AREA DOWN TO STREND.
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
GARBAG:
|
|
|
|
|
|
2008-10-17 07:04:05 +00:00
|
|
|
.ifdef CONST_MEMSIZ
|
2008-10-13 01:43:59 +00:00
|
|
|
ldx #<CONST_MEMSIZ
|
|
|
|
|
lda #>CONST_MEMSIZ
|
|
|
|
|
.else
|
|
|
|
|
ldx MEMSIZ
|
|
|
|
|
lda MEMSIZ+1
|
|
|
|
|
.endif
|
|
|
|
|
FINDHIGHESTSTRING:
|
|
|
|
|
stx FRETOP
|
|
|
|
|
sta FRETOP+1
|
|
|
|
|
ldy #$00
|
|
|
|
|
sty FNCNAM+1
|
2008-10-13 20:26:42 +00:00
|
|
|
.ifdef CONFIG_2
|
2008-10-13 01:43:59 +00:00
|
|
|
sty FNCNAM
|
|
|
|
|
.endif
|
|
|
|
|
lda STREND
|
|
|
|
|
ldx STREND+1
|
|
|
|
|
sta LOWTR
|
|
|
|
|
stx LOWTR+1
|
|
|
|
|
lda #TEMPST
|
|
|
|
|
ldx #$00
|
|
|
|
|
sta INDEX
|
|
|
|
|
stx INDEX+1
|
|
|
|
|
L333D:
|
|
|
|
|
cmp TEMPPT
|
|
|
|
|
beq L3346
|
|
|
|
|
jsr CHECK_VARIABLE
|
|
|
|
|
beq L333D
|
|
|
|
|
L3346:
|
|
|
|
|
lda #BYTES_PER_VARIABLE
|
|
|
|
|
sta DSCLEN
|
|
|
|
|
lda VARTAB
|
|
|
|
|
ldx VARTAB+1
|
|
|
|
|
sta INDEX
|
|
|
|
|
stx INDEX+1
|
|
|
|
|
L3352:
|
|
|
|
|
cpx ARYTAB+1
|
|
|
|
|
bne L335A
|
|
|
|
|
cmp ARYTAB
|
|
|
|
|
beq L335F
|
|
|
|
|
L335A:
|
|
|
|
|
jsr CHECK_SIMPLE_VARIABLE
|
|
|
|
|
beq L3352
|
|
|
|
|
L335F:
|
|
|
|
|
sta HIGHDS
|
|
|
|
|
stx HIGHDS+1
|
|
|
|
|
lda #$03
|
|
|
|
|
sta DSCLEN
|
|
|
|
|
L3367:
|
|
|
|
|
lda HIGHDS
|
|
|
|
|
ldx HIGHDS+1
|
|
|
|
|
L336B:
|
|
|
|
|
cpx STREND+1
|
|
|
|
|
bne L3376
|
|
|
|
|
cmp STREND
|
|
|
|
|
bne L3376
|
|
|
|
|
jmp MOVE_HIGHEST_STRING_TO_TOP
|
|
|
|
|
L3376:
|
|
|
|
|
sta INDEX
|
|
|
|
|
stx INDEX+1
|
|
|
|
|
.ifdef CONFIG_SMALL
|
|
|
|
|
ldy #$01
|
|
|
|
|
.else
|
|
|
|
|
ldy #$00
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
tax
|
|
|
|
|
iny
|
|
|
|
|
.endif
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
php
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
adc HIGHDS
|
|
|
|
|
sta HIGHDS
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
adc HIGHDS+1
|
|
|
|
|
sta HIGHDS+1
|
|
|
|
|
plp
|
|
|
|
|
bpl L3367
|
|
|
|
|
.ifndef CONFIG_SMALL
|
|
|
|
|
txa
|
|
|
|
|
bmi L3367
|
|
|
|
|
.endif
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
.ifdef CBM1
|
|
|
|
|
jsr LE7F3
|
|
|
|
|
.else
|
2008-10-17 07:04:05 +00:00
|
|
|
.ifdef CONFIG_11
|
2008-10-13 01:43:59 +00:00
|
|
|
ldy #$00
|
2008-10-17 06:53:38 +00:00
|
|
|
.endif
|
2008-10-13 01:43:59 +00:00
|
|
|
asl a
|
|
|
|
|
adc #$05
|
|
|
|
|
.endif
|
|
|
|
|
adc INDEX
|
|
|
|
|
sta INDEX
|
|
|
|
|
bcc L33A7
|
|
|
|
|
inc INDEX+1
|
|
|
|
|
L33A7:
|
|
|
|
|
ldx INDEX+1
|
|
|
|
|
L33A9:
|
|
|
|
|
cpx HIGHDS+1
|
|
|
|
|
bne L33B1
|
|
|
|
|
cmp HIGHDS
|
|
|
|
|
beq L336B
|
|
|
|
|
L33B1:
|
|
|
|
|
jsr CHECK_VARIABLE
|
|
|
|
|
beq L33A9
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; PROCESS A SIMPLE VARIABLE
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
CHECK_SIMPLE_VARIABLE:
|
|
|
|
|
.ifndef CONFIG_SMALL
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
bmi CHECK_BUMP
|
|
|
|
|
.endif
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
bpl CHECK_BUMP
|
|
|
|
|
iny
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
CHECK_VARIABLE:
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
beq CHECK_BUMP
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
tax
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
cmp FRETOP+1
|
|
|
|
|
bcc L33D5
|
|
|
|
|
bne CHECK_BUMP
|
|
|
|
|
cpx FRETOP
|
|
|
|
|
bcs CHECK_BUMP
|
|
|
|
|
L33D5:
|
|
|
|
|
cmp LOWTR+1
|
|
|
|
|
bcc CHECK_BUMP
|
|
|
|
|
bne L33DF
|
|
|
|
|
cpx LOWTR
|
|
|
|
|
bcc CHECK_BUMP
|
|
|
|
|
L33DF:
|
|
|
|
|
stx LOWTR
|
|
|
|
|
sta LOWTR+1
|
|
|
|
|
lda INDEX
|
|
|
|
|
ldx INDEX+1
|
|
|
|
|
sta FNCNAM
|
|
|
|
|
stx FNCNAM+1
|
|
|
|
|
lda DSCLEN
|
|
|
|
|
sta Z52
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; ADD (DSCLEN) TO PNTR IN INDEX
|
|
|
|
|
; RETURN WITH Y=0, PNTR ALSO IN X,A
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
CHECK_BUMP:
|
|
|
|
|
lda DSCLEN
|
|
|
|
|
clc
|
|
|
|
|
adc INDEX
|
|
|
|
|
sta INDEX
|
|
|
|
|
bcc L33FA
|
|
|
|
|
inc INDEX+1
|
|
|
|
|
L33FA:
|
|
|
|
|
ldx INDEX+1
|
|
|
|
|
ldy #$00
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
|
|
|
|
|
; TO TOP AND GO BACK FOR ANOTHER
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
MOVE_HIGHEST_STRING_TO_TOP:
|
2008-10-13 20:26:42 +00:00
|
|
|
.ifdef CONFIG_2
|
2008-10-13 01:43:59 +00:00
|
|
|
lda FNCNAM+1
|
|
|
|
|
ora FNCNAM
|
|
|
|
|
.else
|
|
|
|
|
ldx FNCNAM+1
|
|
|
|
|
.endif
|
|
|
|
|
beq L33FA
|
|
|
|
|
lda Z52
|
|
|
|
|
.ifdef CBM1
|
|
|
|
|
sbc #$03
|
|
|
|
|
.else
|
|
|
|
|
and #$04
|
|
|
|
|
.endif
|
|
|
|
|
lsr a
|
|
|
|
|
tay
|
|
|
|
|
sta Z52
|
|
|
|
|
lda (FNCNAM),y
|
|
|
|
|
adc LOWTR
|
|
|
|
|
sta HIGHTR
|
|
|
|
|
lda LOWTR+1
|
|
|
|
|
adc #$00
|
|
|
|
|
sta HIGHTR+1
|
|
|
|
|
lda FRETOP
|
|
|
|
|
ldx FRETOP+1
|
|
|
|
|
sta HIGHDS
|
|
|
|
|
stx HIGHDS+1
|
|
|
|
|
jsr BLTU2
|
|
|
|
|
ldy Z52
|
|
|
|
|
iny
|
|
|
|
|
lda HIGHDS
|
|
|
|
|
sta (FNCNAM),y
|
|
|
|
|
tax
|
|
|
|
|
inc HIGHDS+1
|
|
|
|
|
lda HIGHDS+1
|
|
|
|
|
iny
|
|
|
|
|
sta (FNCNAM),y
|
|
|
|
|
jmp FINDHIGHESTSTRING
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; CONCATENATE TWO STRINGS
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
CAT:
|
|
|
|
|
lda FAC_LAST
|
|
|
|
|
pha
|
|
|
|
|
lda FAC_LAST-1
|
|
|
|
|
pha
|
|
|
|
|
jsr FRM_ELEMENT
|
|
|
|
|
jsr CHKSTR
|
|
|
|
|
pla
|
|
|
|
|
sta STRNG1
|
|
|
|
|
pla
|
|
|
|
|
sta STRNG1+1
|
|
|
|
|
ldy #$00
|
|
|
|
|
lda (STRNG1),y
|
|
|
|
|
clc
|
|
|
|
|
adc (FAC_LAST-1),y
|
|
|
|
|
bcc L3454
|
|
|
|
|
ldx #ERR_STRLONG
|
|
|
|
|
jmp ERROR
|
|
|
|
|
L3454:
|
|
|
|
|
jsr STRINI
|
|
|
|
|
jsr MOVINS
|
|
|
|
|
lda DSCPTR
|
|
|
|
|
ldy DSCPTR+1
|
|
|
|
|
jsr FRETMP
|
|
|
|
|
jsr MOVSTR1
|
|
|
|
|
lda STRNG1
|
|
|
|
|
ldy STRNG1+1
|
|
|
|
|
jsr FRETMP
|
|
|
|
|
jsr PUTNEW
|
|
|
|
|
jmp FRMEVL2
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
|
|
|
|
|
; AND MOVE DESCRIBED STRING TO (FRESPC)
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
MOVINS:
|
|
|
|
|
ldy #$00
|
|
|
|
|
lda (STRNG1),y
|
|
|
|
|
pha
|
|
|
|
|
iny
|
|
|
|
|
lda (STRNG1),y
|
|
|
|
|
tax
|
|
|
|
|
iny
|
|
|
|
|
lda (STRNG1),y
|
|
|
|
|
tay
|
|
|
|
|
pla
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; MOVE STRING AT (Y,X) WITH LENGTH (A)
|
|
|
|
|
; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
MOVSTR:
|
|
|
|
|
stx INDEX
|
|
|
|
|
sty INDEX+1
|
|
|
|
|
MOVSTR1:
|
|
|
|
|
tay
|
|
|
|
|
beq L3490
|
|
|
|
|
pha
|
|
|
|
|
L3487:
|
|
|
|
|
dey
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
sta (FRESPC),y
|
|
|
|
|
tya
|
|
|
|
|
bne L3487
|
|
|
|
|
pla
|
|
|
|
|
L3490:
|
|
|
|
|
clc
|
|
|
|
|
adc FRESPC
|
|
|
|
|
sta FRESPC
|
|
|
|
|
bcc L3499
|
|
|
|
|
inc FRESPC+1
|
|
|
|
|
L3499:
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
FRESTR:
|
|
|
|
|
jsr CHKSTR
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
|
|
|
|
|
; A TEMPORARY STRING, RELEASE IT.
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
FREFAC:
|
|
|
|
|
lda FAC_LAST-1
|
|
|
|
|
ldy FAC_LAST
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
|
|
|
|
|
; A TEMPORARY STRING, RELEASE IT.
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
FRETMP:
|
|
|
|
|
sta INDEX
|
|
|
|
|
sty INDEX+1
|
|
|
|
|
jsr FRETMS
|
|
|
|
|
php
|
|
|
|
|
ldy #$00
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
pha
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
tax
|
|
|
|
|
iny
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
tay
|
|
|
|
|
pla
|
|
|
|
|
plp
|
|
|
|
|
bne L34CD
|
|
|
|
|
cpy FRETOP+1
|
|
|
|
|
bne L34CD
|
|
|
|
|
cpx FRETOP
|
|
|
|
|
bne L34CD
|
|
|
|
|
pha
|
|
|
|
|
clc
|
|
|
|
|
adc FRETOP
|
|
|
|
|
sta FRETOP
|
|
|
|
|
bcc L34CC
|
|
|
|
|
inc FRETOP+1
|
|
|
|
|
L34CC:
|
|
|
|
|
pla
|
|
|
|
|
L34CD:
|
|
|
|
|
stx INDEX
|
|
|
|
|
sty INDEX+1
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
FRETMS:
|
|
|
|
|
.ifdef KBD
|
|
|
|
|
cpy #$00
|
|
|
|
|
.else
|
|
|
|
|
cpy LASTPT+1
|
|
|
|
|
.endif
|
|
|
|
|
bne L34E2
|
|
|
|
|
cmp LASTPT
|
|
|
|
|
bne L34E2
|
|
|
|
|
sta TEMPPT
|
|
|
|
|
sbc #$03
|
|
|
|
|
sta LASTPT
|
|
|
|
|
ldy #$00
|
|
|
|
|
L34E2:
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "CHR$" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
CHRSTR:
|
|
|
|
|
jsr CONINT
|
|
|
|
|
txa
|
|
|
|
|
pha
|
|
|
|
|
lda #$01
|
|
|
|
|
jsr STRSPA
|
|
|
|
|
pla
|
|
|
|
|
ldy #$00
|
|
|
|
|
sta (FAC+1),y
|
|
|
|
|
pla
|
|
|
|
|
pla
|
|
|
|
|
jmp PUTNEW
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "LEFT$" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
LEFTSTR:
|
|
|
|
|
jsr SUBSTRING_SETUP
|
|
|
|
|
cmp (DSCPTR),y
|
|
|
|
|
tya
|
|
|
|
|
SUBSTRING1:
|
|
|
|
|
bcc L3503
|
|
|
|
|
lda (DSCPTR),y
|
|
|
|
|
tax
|
|
|
|
|
tya
|
|
|
|
|
L3503:
|
|
|
|
|
pha
|
|
|
|
|
SUBSTRING2:
|
|
|
|
|
txa
|
|
|
|
|
SUBSTRING3:
|
|
|
|
|
pha
|
|
|
|
|
jsr STRSPA
|
|
|
|
|
lda DSCPTR
|
|
|
|
|
ldy DSCPTR+1
|
|
|
|
|
jsr FRETMP
|
|
|
|
|
pla
|
|
|
|
|
tay
|
|
|
|
|
pla
|
|
|
|
|
clc
|
|
|
|
|
adc INDEX
|
|
|
|
|
sta INDEX
|
|
|
|
|
bcc L351C
|
|
|
|
|
inc INDEX+1
|
|
|
|
|
L351C:
|
|
|
|
|
tya
|
|
|
|
|
jsr MOVSTR1
|
|
|
|
|
jmp PUTNEW
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "RIGHT$" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
RIGHTSTR:
|
|
|
|
|
jsr SUBSTRING_SETUP
|
|
|
|
|
clc
|
|
|
|
|
sbc (DSCPTR),y
|
|
|
|
|
eor #$FF
|
|
|
|
|
jmp SUBSTRING1
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "MID$" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
MIDSTR:
|
|
|
|
|
lda #$FF
|
|
|
|
|
sta FAC_LAST
|
|
|
|
|
jsr CHRGOT
|
|
|
|
|
cmp #$29
|
|
|
|
|
beq L353F
|
|
|
|
|
jsr CHKCOM
|
|
|
|
|
jsr GETBYT
|
|
|
|
|
L353F:
|
|
|
|
|
jsr SUBSTRING_SETUP
|
2008-10-13 20:26:42 +00:00
|
|
|
.ifdef CONFIG_2
|
2008-10-13 01:43:59 +00:00
|
|
|
beq GOIQ
|
|
|
|
|
.endif
|
|
|
|
|
dex
|
|
|
|
|
txa
|
|
|
|
|
pha
|
|
|
|
|
clc
|
|
|
|
|
ldx #$00
|
|
|
|
|
sbc (DSCPTR),y
|
|
|
|
|
bcs SUBSTRING2
|
|
|
|
|
eor #$FF
|
|
|
|
|
cmp FAC_LAST
|
|
|
|
|
bcc SUBSTRING3
|
|
|
|
|
lda FAC_LAST
|
|
|
|
|
bcs SUBSTRING3
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$:
|
|
|
|
|
; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
|
|
|
|
|
; ADDRESS, GET 1ST PARAMETER OF COMMAND
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
SUBSTRING_SETUP:
|
|
|
|
|
jsr CHKCLS
|
|
|
|
|
pla
|
|
|
|
|
.ifndef CONFIG_11
|
|
|
|
|
sta JMPADRS+1
|
|
|
|
|
pla
|
|
|
|
|
sta JMPADRS+2
|
|
|
|
|
.else
|
|
|
|
|
tay
|
|
|
|
|
pla
|
|
|
|
|
sta Z52
|
|
|
|
|
.endif
|
|
|
|
|
pla
|
|
|
|
|
pla
|
|
|
|
|
pla
|
|
|
|
|
tax
|
|
|
|
|
pla
|
|
|
|
|
sta DSCPTR
|
|
|
|
|
pla
|
|
|
|
|
sta DSCPTR+1
|
|
|
|
|
.ifdef CONFIG_11
|
|
|
|
|
lda Z52
|
|
|
|
|
pha
|
|
|
|
|
tya
|
|
|
|
|
pha
|
|
|
|
|
.endif
|
|
|
|
|
ldy #$00
|
|
|
|
|
txa
|
2008-10-13 20:26:42 +00:00
|
|
|
.ifndef CONFIG_2
|
2008-10-13 01:43:59 +00:00
|
|
|
beq GOIQ
|
|
|
|
|
.endif
|
|
|
|
|
.ifndef CONFIG_11
|
|
|
|
|
inc JMPADRS+1
|
|
|
|
|
jmp (JMPADRS+1)
|
|
|
|
|
.else
|
|
|
|
|
rts
|
|
|
|
|
.endif
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "LEN" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
LEN:
|
|
|
|
|
jsr GETSTR
|
|
|
|
|
SNGFLT1:
|
|
|
|
|
jmp SNGFLT
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; IF LAST RESULT IS A TEMPORARY STRING, FREE IT
|
|
|
|
|
; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
GETSTR:
|
|
|
|
|
jsr FRESTR
|
|
|
|
|
ldx #$00
|
|
|
|
|
stx VALTYP
|
|
|
|
|
tay
|
|
|
|
|
rts
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "ASC" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
ASC:
|
|
|
|
|
jsr GETSTR
|
|
|
|
|
beq GOIQ
|
|
|
|
|
ldy #$00
|
|
|
|
|
lda (INDEX),y
|
|
|
|
|
tay
|
2008-10-13 09:34:49 +00:00
|
|
|
.ifndef CONFIG_11A
|
2008-10-13 01:43:59 +00:00
|
|
|
jmp SNGFLT1
|
|
|
|
|
.else
|
|
|
|
|
jmp SNGFLT
|
|
|
|
|
.endif
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
GOIQ:
|
|
|
|
|
jmp IQERR
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
|
|
|
|
|
; TO SINGLE BYTE IN X-REG
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
GTBYTC:
|
|
|
|
|
jsr CHRGET
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; EVALUATE EXPRESSION AT TXTPTR, AND
|
|
|
|
|
; CONVERT IT TO SINGLE BYTE IN X-REG
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
GETBYT:
|
|
|
|
|
jsr FRMNUM
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
CONINT:
|
|
|
|
|
jsr MKINT
|
|
|
|
|
ldx FAC_LAST-1
|
|
|
|
|
bne GOIQ
|
|
|
|
|
ldx FAC_LAST
|
|
|
|
|
jmp CHRGOT
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; "VAL" FUNCTION
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
VAL:
|
|
|
|
|
jsr GETSTR
|
|
|
|
|
bne L35AC
|
|
|
|
|
jmp ZERO_FAC
|
|
|
|
|
L35AC:
|
|
|
|
|
ldx TXTPTR
|
|
|
|
|
ldy TXTPTR+1
|
|
|
|
|
stx STRNG2
|
|
|
|
|
sty STRNG2+1
|
|
|
|
|
ldx INDEX
|
|
|
|
|
stx TXTPTR
|
|
|
|
|
clc
|
|
|
|
|
adc INDEX
|
|
|
|
|
sta DEST
|
|
|
|
|
ldx INDEX+1
|
|
|
|
|
stx TXTPTR+1
|
|
|
|
|
bcc L35C4
|
|
|
|
|
inx
|
|
|
|
|
L35C4:
|
|
|
|
|
stx DEST+1
|
|
|
|
|
ldy #$00
|
|
|
|
|
lda (DEST),y
|
|
|
|
|
pha
|
|
|
|
|
lda #$00
|
|
|
|
|
sta (DEST),y
|
|
|
|
|
jsr CHRGOT
|
|
|
|
|
jsr FIN
|
|
|
|
|
pla
|
|
|
|
|
ldy #$00
|
|
|
|
|
sta (DEST),y
|
|
|
|
|
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
; COPY STRNG2 INTO TXTPTR
|
|
|
|
|
; ----------------------------------------------------------------------------
|
|
|
|
|
POINT:
|
|
|
|
|
ldx STRNG2
|
|
|
|
|
ldy STRNG2+1
|
|
|
|
|
stx TXTPTR
|
|
|
|
|
sty TXTPTR+1
|
|
|
|
|
rts
|
|
|
|
|
|
