Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-11-08 14:07:34 +00:00
Code Issues Projects Releases Wiki Activity
d573012ecb
A2osX/BASIC.FX/BASIC.S.B.txt
burniouf d573012ecb BASIC:More code moved to AUXLC
2022-04-03 13:55:03 +02:00

1176 lines
17 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
BS.GETBUFR jsr LA1FB
bcs LA304
pha
sbc #$03
sta XBBB8
pla
LA2C5 sta GP.SBUFADR+1
ldx GP.OPENCNT
beq LA2EE
lda XBBB7
clc
adc #$04
sta XBBB7
LA2D6 cmp BS.BUFPAGEs,x
bne LA2EB
lda GP.SBUFADR+1
jsr LA356
jsr BS.SetFileBuf
lda GP.SBUFADR+1
adc #$04
bcc LA2C5
LA2EB dex
bne LA2D6
LA2EE lda GP.SBUFADR+1
bit GP.EXECACTV
bpl LA303
LA2F6 ldx #$08
jsr LA356
jsr BS.SetFileBuf
lda GP.SBUFADR+1
adc #$04
LA303 clc
LA304 rts
*--------------------------------------
BS.FREEBUFR lda GP.OPENCNT
asl
asl
adc AS.HIMEM+1
sta XBBB7
lda AS.HIMEM+1
sta XBBB8
lda GP.RSHIMEM
cmp AS.HIMEM+1
beq LA354
sta AS.HIMEM+1
bit GP.EXECACTV
bpl LA327
jsr LA2F6
bcc LA345
LA327 lda XBBB7
ldx GP.OPENCNT
beq LA351
LA32F cmp BS.BUFPAGEs,x
bne LA34E
lda AS.HIMEM+1
jsr LA356
jsr BS.SetFileBuf
sec
lda XBBB7
sbc #$04
sta XBBB7
LA345 lda AS.HIMEM+1
sec
sbc #$04
sta AS.HIMEM+1
bcs LA327
LA34E dex
bne LA32F
LA351 jsr BS.KW.FRE
LA354 clc
rts
LA356 pha
lda XBBB8
jsr BS.SetFileBuf
pla
rts
*--------------------------------------
BS.MoveMemUp ldy #$00
cpy BS.BUFPAGEs
beq .2
.1 lda (ZP.PCL),y
sta (ZP.A1L),y
iny
bne .1
inc ZP.PCH
inc ZP.A1H
dec BS.BUFPAGEs
bne .1
.2 cpy XBBED
beq .8
lda (ZP.PCL),y
sta (ZP.A1L),y
iny
bne .2
.8 rts
*--------------------------------------
BS.MoveMemDown ldy XBBED
XA386 beq LA38F SELF MODIFIED
LA388 jsr LA39A
dec ZP.A1H
dec ZP.PCH
LA38F cpy BS.BUFPAGEs
beq LA3A2
dec BS.BUFPAGEs
bra LA388
*--------------------------------------
LA39A dey
lda (ZP.PCL),y
sta (ZP.A1L),y
tya
bne LA39A
LA3A2 rts
*--------------------------------------
LA3A3 lda AS.VARSTART+1
sta ZP.A2H
lda AS.VARSTART
ldx AS.ARRAYSTART+1
clc
bcc LA3B3
LA3AE clc
lda ZP.A2L
adc #$07
LA3B3 sta ZP.A2L
bcc LA3B9
inc ZP.A2H
LA3B9 eor AS.ARRAYSTART
bne LA3BF
cpx ZP.A2H
LA3BF clc
beq LA3D6
ldy #$00
lda (ZP.A2L),y
iny
eor (ZP.A2L),y
bpl LA3AE
lda (ZP.A2L),y
bpl LA3AE
iny
jsr LA3FD
bra LA3AE
LA3D6 lda ZP.A2L
sta XBBDC
LA3DB clc
jsr LA160
bcs LA410
LA3E1 ldy #$00
clc
jsr LA3FD
clc
lda #$03
adc ZP.A2L
sta ZP.A2L
bcc LA3F2
inc ZP.A2H
LA3F2 cmp XBBDC
bne LA3E1
cpx ZP.A2H
bne LA3E1
beq LA3DB
LA3FD lda (ZP.A2L),y
beq LA410
iny
iny
lda AS.VARSTART+1
cmp (ZP.A2L),y
bcs LA410
lda (ZP.A2L),y
adc XBBE2
sta (ZP.A2L),y
LA410 rts
*--------------------------------------
LA411 jsr LA021
bcs LA47F
lda AS.ARRAYEND
sec
sbc AS.VARSTART
sta BS.BAS.HDR
sta XBBED
lda AS.ARRAYEND+1
sbc AS.VARSTART+1
sta BS.BAS.HDR+1
sta BS.BUFPAGEs
lda AS.ARRAYSTART
sbc AS.VARSTART
sta BS.BAS.HDR+2
lda AS.ARRAYSTART+1
sbc AS.VARSTART+1
sta BS.BAS.HDR+3
lda AS.STRINGSTART
sbc XBBED
sta ZP.A1L
lda AS.STRINGSTART+1
sbc #$00
sta ZP.A1H
lda AS.ARRAYEND
sbc XBBED
sta ZP.PCL
lda AS.ARRAYEND+1
sbc #$00
sta ZP.PCH
lda #$03
sta XA386+1
jsr BS.MoveMemDown
lda #$07
sta XA386+1
lda ZP.A1L
sta XBBE9
inc ZP.A1H
lda ZP.A1H
sta XBBEA
lda AS.HIMEM
sec
sbc ZP.A1L
sta XBBEB
lda AS.HIMEM+1
sta BS.BAS.HDR+4
sbc ZP.A1H
sta XBBEC
clc
LA47F rts
*--------------------------------------
LA480 lda BS.BAS.HDR
sta XBBED
clc
adc AS.VARSTART
sta AS.ARRAYEND
lda BS.BAS.HDR+1
sta BS.BUFPAGEs
adc AS.VARSTART+1
sta AS.ARRAYEND+1
lda AS.VARSTART
sta ZP.A1L
adc BS.BAS.HDR+2
sta AS.ARRAYSTART
lda AS.VARSTART+1
sta ZP.A1H
adc BS.BAS.HDR+3
sta AS.ARRAYSTART+1
lda XBBE9
sta ZP.PCL
lda XBBEA
sta ZP.PCH
jsr BS.MoveMemUp
lda XBBED
clc
adc ZP.PCL
sta AS.STRINGSTART
lda ZP.PCH
adc #$00
sta AS.STRINGSTART+1
sec
lda AS.HIMEM+1
sbc BS.BAS.HDR+4
beq LA4D0
sta XBBE2
jsr LA3A3
LA4D0 clc
rts
*--------------------------------------
BS.LINEBUFCLR80 lda #$A0
ldx #$4F
LA67E sta IO.LINEBUF+1,x
dex
bpl LA67E
rts
*--------------------------------------
BS.DOSCMD lda #$FF
sta GP.XCNUM
lda #$20
sta BS.GetCharSep
lda #$08
sta BS.GetCharMax
jsr BS.GetKWInCmdBuf
lda BS.CMDBUF
cmp #'A'
bcs LA6A5
eor #'-'
beq LA6A5
LA6A2 jmp BS.SYNERR
LA6A5 jsr BS.IsIntCmd
bcs LA6A2
lda GP.STATE
bne LA6BA
lda GP.EXECACTV
bne LA6BA
jsr MON.CLREOL
jsr MON.CROUT
LA6BA stz GP.FoundBITS
stz GP.FoundBITS+1
stz BS.CMDBUF
stz MLI.PATHBUF
lda GP.VDEFSLT
sta GP.ParamS
lda GP.VDEFDRV
sta GP.ParamD
lda AS.HIMEM+1
sta XBBE3
ldx GP.XLEN
inx
inx
stx BS.GetCharMax
lda GP.AllowedBITS
beq LA744
asl
bmi LA747
jsr BS.GetKWInCmdBuf
php
pha
lda GP.AllowedBITS
bpl LA6F8
lda #MLI.C.GETPREFIX
jsr GP.GOSYSTEM
LA6F8 pla
plp
beq LA744
cmp #','
bne LA703
jmp LA795
LA703 cmp #'/'
beq LA70B
cmp #'.' .. or ../
beq LA70B
cmp #'A'
bcc LA73D
LA70B dex
lda #$82
sta BS.GetCharSep
lsr
sta BS.GetCharMax
* ldy #$00
jsr BS.GetKWInCmdBufAtX
dey
sty BS.CMDBUF.LEN
lda #CMDBITS0.FN1
sta GP.FoundBITS
phx
jsr BS.Expand2PATHBUF
plx
bcs LA73A
dex
jsr BS.GetCharSpaceSep
bne LA73A
bcc LA7A6
lda GP.AllowedBITS
lsr
bcs LA770
LA73A jmp BS.SYNERR
LA73D lda GP.XCNUM
cmp #$06 RUN ????
bne LA73A
LA744 bra LA7A6
LA747 jsr BS.GetKWInCmdBuf
beq LA73A
cmp #$41
beq LA79A
jsr BS.TMPBUF3Reset
stz XBC08
ldy #$13
sty XBC09
ldy #$40
sty GP.FoundBITS
stx BS.ToAUXSaveX
ldx #BSX.GetDecNum.X
jsr BS.ToAUX
bcs LA76F
lda GP.ParamINPR
cmp #$08
bcc LA79F
LA76C lda #BS.E.RANGE
sec
LA76F rts
LA770 lsr
bcc LA795
jsr BS.GetCharSpaceSep
beq LA73A
dex
lda #$82
sta BS.GetCharSep
ldy #$01
jsr BS.GetPathInPathBuf
dey
dey
sty MLI.PATHBUF
lda #$03
sta GP.FoundBITS
dex
jsr BS.GetCharSpaceSep
bne LA73A
bcc LA7A6
*--------------------------------------
LA795 jsr BS.GetCharSpaceSep
beq LA73A
LA79A stx BS.ToAUXSaveX
ldx #BSX.CheckOpt.X
jsr BS.ToAUX
bcs LA76F
LA79F jsr BS.GetCharSpaceSep
bne LA73A
bcs LA795
LA7A6 lda GP.ParamS
beq LA76C
cmp #$08
bcs LA76C
lda GP.ParamD
beq LA76C
cmp #$03
bcs LA76C
lda GP.AllowedBITS
and #$21
lsr
beq LA7C9
lda GP.STATE
bne LA7C9
lda #BS.E.NODIRECT
sec
rts
LA7C9 bcc LA80B
lda GP.AllowedBITS+1
and #$04
beq LA80B
lda GP.FoundBITS
lsr
bcs LA7E1
lda GP.AllowedBITS
and #$90
beq BS.SYNERR
bpl LA80B
LA7E1 lda BS.CMDBUF
eor #'/'
beq LA7ED
lda MLI.PFIXPTR
beq LA806
LA7ED lda GP.FoundBITS+1
and #$04
beq LA80B
bcs LA806
stz BS.CMDBUF.LEN
stz BS.CMDBUF
lda #$01
tsb GP.FoundBITS
LA806 jsr BS.GetVolAtSxDy
bcs LA849
LA80B lda GP.XCNUM
beq .8
cmp #25 PREFIX
beq .8
cmp #34 CD
beq .8
lda GP.AllowedBITS+1
and #$04
beq .8
lda GP.FoundBITS
lsr
bcc LA844
jsr BS.GetFileInfo
bcc LA844
cmp #$07
bne LA849
lda GP.AllowedBITS
and #$08
bne LA844
lda #BS.E.PATHNFND6
rts
.8 clc
LA844 jmp (BS.KW.JMPADDR)
BS.SYNERR lda #BS.E.SYNTAX
LA849 sec
rts
*--------------------------------------
BS.GetVolAtSxDy lda GP.ParamS
asl
asl
asl
asl
asl
pha
lda GP.ParamD
eor #$01
lsr
pla
ror
sta GP.MLIMRKEOFBUF.REFNUM
ldx #$01
ldy #$02
jsr BS.SetSBUFADRXY
lda #MLI.C.ONLINE
jsr GP.GOSYSTEM
bcs LA849
lda GP.ParamD
sta GP.VDEFDRV
lda GP.ParamS
sta GP.VDEFSLT
lda BS.CMDBUF
eor #'/'
beq LA8F4
lda IO.LINEBUF+1
and #$0F
adc #$02
sta IO.LINEBUF+1
adc BS.CMDBUF.LEN
cmp #$40
tax
lda #$10
bcs LA8F5
ldy BS.CMDBUF.LEN
stx BS.CMDBUF.LEN
LA89D dex
dey
bmi LA8AA
lda BS.CMDBUF,y
sta BS.CMDBUF,x
bra LA89D
LA8AA lda #'/'
sta BS.CMDBUF
LA8AF sta BS.CMDBUF,x
lda IO.LINEBUF,x
dex
bne LA8AF
lda GP.XCNUM
cmp #$0B
beq LA8F4
cmp #$16
beq LA8F4
cmp #$08
beq LA8F4
lda MLI.PATHBUF
tay
clc
adc IO.LINEBUF+1
cmp #$40
tax
lda #$10
bcs LA8F5
stx MLI.PATHBUF
LA8D9 dex
dey
bmi LA8E6
lda MLI.PATHBUF+1,y
sta MLI.PATHBUF+1,x
bra LA8D9
LA8E6 lda #'/'
sta MLI.PATHBUF+1
LA8EB sta MLI.PATHBUF+1,x
lda IO.LINEBUF,x
dex
bne LA8EB
LA8F4 clc
LA8F5 rts
*--------------------------------------
BS.GetPathInPathBuf
jsr BS.GetChar UC
sta MLI.PATHBUF,y
iny
cmp #','
beq LAA45
cmp #$20
beq LAA45
cmp #$0D
beq LAA56
cpy BS.GetCharMax
bcc BS.GetPathInPathBuf
ora #$00
rts
*--------------------------------------
BS.GetKWInCmdBuf
ldx #$00
BS.GetKWInCmdBufAtX
ldy #$00
LAA2D jsr BS.GetChar UC
sta BS.CMDBUF,y
iny
cmp #','
beq LAA45
cmp #$20
beq LAA45
cmp #$0D
beq LAA56
cpy BS.GetCharMax
bcc LAA2D
LAA45 ora #$00
rts
*--------------------------------------
BS.GetCharSpaceSep
lda #$20
sta BS.GetCharSep
jsr BS.GetChar UC
cmp #','
beq LAA57
cmp #$0D
LAA56 clc
LAA57 rts
*--------------------------------------
BS.GetChar lda IO.LINEBUF,x
and #$7F
inx
cmp BS.GetCharSep
beq BS.GetChar
rts
*--------------------------------------
BS.TMPBUF3x2 asl BS.TMPBUF4
rol BS.TMPBUF4+1
rol BS.TMPBUF4+2
rts
*--------------------------------------
BS.IsIntCmd ldx #BSX.IsIntCmd.X
jsr BS.ToAUX
bcc .8
dec GP.XCNUM $ff
sec
jmp GP.EXTRNCMD
.8 rts
*--------------------------------------
BS.TMPBUF3Reset stz BS.TMPBUF4
stz BS.TMPBUF4+1
stz BS.TMPBUF4+2
rts
*--------------------------------------
BS.KW.DASH lda GP.FITYPE
cmp #$FC
beq BS.KW.RUN
cmp #$06
beq LABA3
cmp #$04
bne LAB63
jmp BS.KW.EXEC
LAB63 cmp #$FF
beq LAB6F
cmp #$B3
beq LAB6F
lda #BS.E.MISMATCH
sec
rts
LAB6F pha
jsr LB562
jsr LB36B
stz GP.ParamA
stz MLI.MEMTABL+19
stz MLI.MEMTABL+20
stz MLI.MEMTABL+21
stz MLI.MEMTABL+22
lda #$01
sta MLI.MEMTABL+23
lda #$20
sta GP.ParamA+1
pla
cmp #$FF
bne LABA6
sta GP.ParamT
lda #$80
sta GP.FoundBITS+1
lda #$05
sta GP.FoundBITS
LABA3 jmp BS.KW.BRUN
LABA6 sec
jsr MON.IIGSID
bcs LABA3
jmp BS.QUIT.IIgs
*--------------------------------------
BS.KW.CHAIN jsr LA411
lda AS.HIMEM+1
sta BS.AS.HIMEMSave
ldx XBBEA
dex
stx AS.HIMEM+1
jsr LAC22
ldx BS.AS.HIMEMSave
stx AS.HIMEM+1
bcs LAC33
jsr AS.CLEAR1
jsr LA480
lda #$00
beq LABE6
*--------------------------------------
BS.KW.RUN stz GP.IFILACTV
stz AS.ERRNUM
lda GP.FoundBITS
lsr
bcc LABF4
jsr LAC1D
bcs LAC33
jsr AS.CLEAR1
LABE6 sta AS.ERRFLG
jsr LACB6
jsr BS.SaveCSWKSW
jsr LABF4
jmp AS.NEXTSTMT
LABF4 jsr AS.NORMAL
lda #$A3
sta X9F65
lda #$FF
sta GP.XCNUM
sta ZP.PROMPT
ldx #$04
jsr BS.SetState
jmp BS.SYNERR
*--------------------------------------
BS.KW.LOAD jsr LAC1D
bcs LAC33
BS.ENTRY jsr AS.CLEAR1
jsr BS.SetState0
stz ZP.CH
jmp AS.RESTART1
LAC1D jsr LB562
bcs LAC33
LAC22 jsr LAC34
bcs LAC33
sty AS.ARRAYSTART
sty AS.VARSTART
sty AS.ARRAYEND
stx AS.ARRAYSTART+1
stx AS.VARSTART+1
stx AS.ARRAYEND+1
LAC33 rts
LAC34 lda #$01
ldx #$FC
jsr BS.CheckFTypeXAccessA
bcs LAC33
jsr BS.MLIGetEOF
bcs LAC33
lda AS.PGRMSTART
sta GP.MLIRW.DATAPTR
adc GP.SBUFADR
sta GP.ParamA
lda AS.PGRMSTART+1
sta GP.MLIRW.DATAPTR+1
adc GP.SBUFADR+1
sta GP.ParamA+1
bcs LAC5E
cmp AS.HIMEM+1
LAC5E lda #BS.E.TOOLARGE
bcs LAC33
ldx GP.SBUFADR
ldy GP.SBUFADR+1
jsr BS.ReadXYBytes
bcs LAC33
jsr BS.MLIClose
bcs LAC33
jsr LAC80
ldx GP.ParamA+1
ldy GP.ParamA
stx AS.PGRMEND+1
sty AS.PGRMEND
rts
LAC80 sec
lda AS.PGRMSTART
sbc GP.FIAUXTYPE
sta ZP.A1L
lda AS.PGRMSTART+1
sbc GP.FIAUXTYPE+1
sta ZP.A1H
ora ZP.A1L
clc
beq LACD9
ldx AS.PGRMSTART
lda AS.PGRMSTART+1
LAC98 stx ZP.PCL
sta ZP.PCH
ldy #$01
lda (ZP.PCL),y
dey
ora (ZP.PCL),y
beq LACD9
lda (ZP.PCL),y
adc ZP.A1L
tax
sta (ZP.PCL),y
iny
lda (ZP.PCL),y
adc ZP.A1H
sta (ZP.PCL),y
clc
bcc LAC98
LACB6 lda GP.FoundBITS+1
and #$08
clc
beq LACD9
lda GP.ParamAT
sta AS.LINNUM
lda GP.ParamAT+1
sta AS.LINNUM+1
jsr AS.FINDLINE
clc
lda AS.LOWTR
adc #$FF
sta AS.TXTPTR
lda AS.LOWTR+1
adc #$FF
sta AS.TXTPTR+1
clc
LACD9 rts
*--------------------------------------
BS.KW.SAVE bcc LACFE
lda #$FC
sta GP.ParamT
sta GP.FITYPE
lda #$C3
sta GP.FIACCESS
lda AS.PGRMSTART
sta GP.CRAUXTYPE
sta GP.FIAUXTYPE
lda AS.PGRMSTART+1
sta GP.CRAUXTYPE+1
sta GP.FIAUXTYPE+1
jsr BS.CreateFileOrDir
bcs LAD47
LACFE lda #$02
ldx #$FC
jsr BS.CheckFTypeXAccessA
bcs LAD47
lda AS.PGRMEND
sec
sbc AS.PGRMSTART
tax
* sta GP.SBUFADR
lda AS.PGRMEND+1
sbc AS.PGRMSTART+1
tay
* sta GP.SBUFADR+1
* lda #$00
* sta GP.SBUFADR+2
jsr BS.SetSBUFADRXY0
lda AS.PGRMSTART
sta GP.MLIRW.DATAPTR
lda AS.PGRMSTART+1
sta GP.MLIRW.DATAPTR+1
jsr BS.WriteXYBytes
bcs LAD47
jsr BS.MLISetEOF
bcs LAD47
jsr BS.MLIClose
bcs LAD47
lda AS.PGRMSTART+1
ldx AS.PGRMSTART
cmp GP.FIAUXTYPE+1
bne LAD48
cpx GP.FIAUXTYPE
clc
bne LAD48
LAD47 rts
LAD48 stx GP.FIAUXTYPE
sta GP.FIAUXTYPE+1
jmp BS.SetFileInfoNoDate
*--------------------------------------
BS.KW.CREATE stz GP.CRAUXTYPE
stz GP.CRAUXTYPE+1
lda GP.FoundBITS
and #CMDBITS0.T
bne BS.CreateFileOrDir
lda #$0F
sta GP.ParamT
BS.CreateFileOrDir
lda GP.EXECACTV
asl
lda #$00
adc GP.OPENCNT
cmp #$08
bcs LAD8D
lda GP.ParamT
sta GP.CRTYPE
ldx #$C3
ldy #$01
cmp #$0F
bne LAD82
ldy #$0D
LAD82 stx GP.CRACCESS
sty GP.CRSTTYPE
lda #MLI.C.CREATE
jmp GP.GOSYSTEM
LAD8D lda #BS.E.NOBUFFER
rts
*--------------------------------------
BS.KW.RENAME lda GP.FoundBITS
lsr
lsr
lda #MLI.C.RENAME
bcs LAD9E
jmp BS.SYNERR
*--------------------------------------
BS.KW.DELETE lda #MLI.C.DESTROY
.HS 2C BIT ABS
BS.SETPREFIX lda #MLI.C.SETPREFIX
LAD9E jmp GP.GOSYSTEM
*--------------------------------------
BS.KW.LOCK jsr BS.GetFileInfo
lda GP.FIACCESS
and #$3C
ora #$01
bra BS.KW.UNLOCK1
*--------------------------------------
BS.KW.UNLOCK jsr BS.GetFileInfo
lda #$C3
ora GP.FIACCESS
BS.KW.UNLOCK1 sta GP.FIACCESS
jmp BS.SetFileInfo
*--------------------------------------
BS.KW.PREFIX lda GP.FoundBITS+1
and #CMDBITS1.SD
bne BS.SETPREFIX
lda GP.FoundBITS
lsr
bcs BS.SETPREFIX
BS.GETPREFIX lda ZP.PROMPT
beq LADF0
jsr MON.CROUT
ldx #$00
LADD8 cpx BS.CMDBUF.LEN
beq LADE8
lda BS.CMDBUF,x
ora #$80
jsr MON.COUT
inx
bne LADD8
LADE8 jsr MON.CROUT
jsr MON.CROUT
clc
rts
LADF0 sec
ror GP.PFXACTV
clc
rts
*--------------------------------------
MAN
SAVE usr/src/basic.fx/basic.s.b
LOAD usr/src/basic.fx/basic.s
ASM
Reference in New Issue View Git Blame Copy Permalink