Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-11-22 00:32:44 +00:00
Code Issues Projects Releases Wiki Activity
8e2918de4d
A2osX/BASIC.15/BASIC.S.B.txt

1688 lines
23 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 XBBEE,x
bne LA2EB
lda GP.SBUFADR+1
jsr LA356
jsr LA29F
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 LA29F
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 XBBEE,x
bne LA34E
lda AS.HIMEM+1
jsr LA356
jsr LA29F
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.01
LA354 clc
rts
LA356 pha
lda XBBB8
jsr LA29F
pla
rts
LA35F ldy #$00
cpy XBBEE
beq LA376
LA366 lda (ZP.PCL),y
sta (ZP.A1L),y
iny
bne LA366
inc ZP.PCH
inc ZP.A1H
dec XBBEE
bne LA366
LA376 cpy XBBED
beq LA382
lda (ZP.PCL),y
sta (ZP.A1L),y
iny
bne LA376
LA382 rts
LA383 ldy XBBED
XA386 beq LA38F SELF MODIFIED
LA388 jsr LA39A
dec ZP.A1H
dec ZP.PCH
LA38F cpy XBBEE
beq LA3A2
dec XBBEE
jmp 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
jmp 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 XBBEE
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 LA383
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 XBBEE
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 LA35F
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
LA4D2 jsr BS.LINEBUFCLR80
lda #$A2
sta IO.LINEBUF
lda DIRENTBUF
and #$0F
tay
LA4E0 lda DIRENTBUF,y
ora #$80
sta IO.LINEBUF+1,y
dey
bne LA4E0
sty BS.TMPBUF4+2
lda DIRENTBUF.TYPE
ldx #$0E
LA4F3 iny
iny
cmp BS.PRODOSTYPES.H,x
beq LA505
iny
dex
bpl LA4F3
ldy #$13
jsr BS.AHEX2LINEBUFY
bne LA549
LA505 ldx #$02
pha
LA508 lda BS.PRODOSTYPES.ASC,y
sta $212,x
dey
dex
bpl LA508
pla
bit BS.CATWIDTH
bvc LA561
ldy #$4E
cmp #$06
beq LA533
cmp #$04
bne LA549
lda #$D2
sta $249
lda DIRENTBUF.AUXT
ldx DIRENTBUF.AUXT+1
jsr BS.AXDEC2LINEBUFY
jmp LA544
LA533 lda #$C1
sta $249
lda DIRENTBUF.AUXT
jsr BS.AHEX2LINEBUFY
lda DIRENTBUF.AUXT+1
jsr BS.AHEX2LINEBUFY
LA544 lda #$BD
sta $24A
LA549 lda DIRENTBUF.EOF+2
sta BS.TMPBUF4+2
lda DIRENTBUF.EOF
ldx DIRENTBUF.EOF+1
ldy #$46
jsr BS.AXDEC2LINEBUFY
ldx #$18
ldy #$3D
jsr LA57E
LA561 ldy #$1B
lda DIRENTBUF.UBLK
ldx DIRENTBUF.UBLK+1
jsr BS.AXDEC2LINEBUFY
lda DIRENTBUF.ACCESS
and #$C2
cmp #$C2
beq LA57A
lda #$AA
sta IO.LINEBUF+1
LA57A ldx #$21
ldy #$2C
LA57E lda $25A,x
lsr
sta XBC10
lda DIRENTBUF,x
pha
and #$1F
sta XBC0F
pla
rol
rol
rol
rol
and #$0F
beq LA5B1
cmp #$0D
bcs LA5B1
sta XBC0E
asl
adc XBC0E
sta XBC0E
lda XBC0F
beq LA5B1
lda XBC10
cmp #$64
bcc LA5C3
LA5B1 tya
sec
sbc #$06
tay
ldx #$08
LA5B8 lda BS.NODATE,x
sta IO.LINEBUF+1,y
dey
dex
bpl LA5B8
rts
LA5C3 lda $25C,x
pha
lda $25B,x
ldx #$00
cmp #$3C
bcc LA5D1
txa
LA5D1 jsr LA618
lda #$BA
sta IO.LINEBUF+1,y
dey
pla
ldx #$00
cmp #$18
bcc LA5E2
txa
LA5E2 cmp #$0A
php
jsr BS.AXDEC2LINEBUFY
plp
bcs LA5EC
dey
LA5EC dey
lda XBC10
jsr LA618
dey
ldx XBC0E
inx
inx
inx
LA5FA lda BS.MONTHS-4,x
sta IO.LINEBUF+1,y
dey
dex
cpx XBC0E
bne LA5FA
lda #$AD
sta IO.LINEBUF+1,y
sta $205,y
dey
lda XBC0F
ldx #$00
jmp BS.AXDEC2LINEBUFY
LA618 clc
adc #$64
jsr BS.AXDEC2LINEBUFY
iny
rts
BS.AHEX2LINEBUFY
pha
and #$0F
jsr LA62B
pla
lsr
lsr
lsr
lsr
LA62B ora #$B0
cmp #$BA
bcc LA633
adc #$06
LA633 sta IO.LINEBUF+1,y
dey
lda #$A4
sta IO.LINEBUF+1,y
rts
BS.AXDEC2LINEBUFY
stx BS.TMPBUF4+1
sta BS.TMPBUF4
LA643 jsr LA65B
lda BS.TMPBUF4+3
ora #$B0
sta IO.LINEBUF+1,y
dey
lda BS.TMPBUF4
ora BS.TMPBUF4+1
ora BS.TMPBUF4+2
bne LA643
rts
LA65B ldx #$18
lda #$00
sta BS.TMPBUF4+3
LA662 jsr BS.TMPBUF3x2
rol BS.TMPBUF4+3
sec
lda BS.TMPBUF4+3
sbc #$0A
bcc LA676
sta BS.TMPBUF4+3
inc BS.TMPBUF4
LA676 dex
bne LA662
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 #$41
bcs LA6A5
eor #$2D
beq LA6A5
LA6A2 jmp BS.ERR10
LA6A5 jsr BS.IsIntCmdMTR
bcs LA6A2
lda GP.STATE
bne LA6BA
lda GP.EXECACTV
bne LA6BA
jsr MON.CLREOL
jsr BS.CROUT
LA6BA lda #$00
sta GP.FoundBITS
sta GP.FoundBITS+1
sta BS.CMDBUF
sta 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 #$2C
bne LA703
jmp LA795
LA703 cmp #$2F
beq LA70B
cmp #$41
bcc LA73D
LA70B dex
lda #$82
sta BS.GetCharSep
lsr
sta BS.GetCharMax
ldy #$00
jsr LAA2D
dey
sty BS.CMDBUF.LEN
lda #$01
sta GP.FoundBITS
LA723 lda BS.CMDBUF.LEN,y
sta MLI.PATHBUF,y
dey
bpl LA723
dex
jsr BS.GetCharSpaceSep
bne LA73A
bcc LA7A6
lda GP.AllowedBITS
lsr
bcs LA770
LA73A jmp BS.ERR10
LA73D lda GP.XCNUM
cmp #$06
bne LA73A
LA744 jmp LA7A6
LA747 jsr BS.GetKWInCmdBuf
beq LA73A
cmp #$41
beq LA79A
jsr BS.TMPBUF3Reset
sty XBC08
ldy #$13
sty XBC09
ldy #$40
sty GP.FoundBITS
jsr LA96E
bcs LA76F
lda GP.ParamINPR
cmp #$08
bcc LA79F
LA76C lda #$02
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 jsr LA8F6
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 #$0F
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.ERR10
bpl LA80B
LA7E1 lda BS.CMDBUF
eor #$2F
beq LA7ED
lda MLI.PFIXPTR
beq LA806
LA7ED lda GP.FoundBITS+1
and #$04
beq LA80B
bcs LA806
lda #$00
sta BS.CMDBUF.LEN
sta BS.CMDBUF
lda #$01
ora GP.FoundBITS
sta GP.FoundBITS
LA806 jsr BS.GetVolAtSxDy
bcs LA849
LA80B lda GP.XCNUM
asl
tax
lda BS.KW.JMP,x
sta BS.KW.JMPADDR
lda BS.KW.JMP+1,x
sta BS.KW.JMPADDR+1
clc
txa
beq LA844
eor #$32
beq LA844
lda GP.AllowedBITS+1
and #$04
beq LA844
lda GP.FoundBITS
lsr
bcc LA844
jsr BS.GetFileInfo
bcc LA844
cmp #$07
bne LA849
lda GP.AllowedBITS
and #$08
bne LA844
lda #$06
rts
LA844 jmp (BS.KW.JMPADDR)
BS.ERR10 lda #$10
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
lda #$01
sta GP.SBUFADR
lda #$02
sta GP.SBUFADR+1
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 #$2F
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
jmp LA89D
LA8AA lda #$2F
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
jmp LA8D9
LA8E6 lda #$2F
sta MLI.PATHBUF+1
LA8EB sta MLI.PATHBUF+1,x
lda IO.LINEBUF,x
dex
bne LA8EB
LA8F4 clc
LA8F5 rts
LA8F6 jsr BS.TMPBUF3Reset
ldy #$09
LA8FB cmp BS.KW.OPT,y
beq LA935
dey
bpl LA8FB
cmp #$54
beq LA90A
LA907 jmp BS.ERR10
LA90A lda #$04
and GP.AllowedBITS
beq LA931
ora GP.FoundBITS
sta GP.FoundBITS
lda #$00
sta XBC08
lda #$12
sta XBC09
jsr BS.GetCharSpaceSep
beq LA907
cmp #$24
beq LA984
cmp #$41
bcc LA96E
jmp BS.GetFTypeASC
LA931 sec
lda #$0B
rts
LA935 lda BS.KW.OPT.PBITSLO,y
beq LA955
and GP.AllowedBITS+1
beq LA931
cmp #$04
bne LA94F
and GP.FoundBITS+1
bne LA955
lda #$01
sta GP.ParamD
lda #$04
LA94F ora GP.FoundBITS+1
sta GP.FoundBITS+1
LA955 lda BS.KW.OPT.PBITSHI,y
and #$03
sta XBC08
lda BS.KW.OPT.PBITSHI,y
lsr
lsr
sta XBC09
jsr BS.GetCharSpaceSep
beq LA9BE
cmp #$24
beq LA984
LA96E stx GP.INPTR
jsr LAA6A
bcc LA97A
bmi LA9C1
bcs LA9BE
LA97A ldx GP.INPTR
jsr BS.GetCharSpaceSep
bne LA96E
beq LA99D
LA984 jsr BS.GetCharSpaceSep
beq LA9BE
LA989 stx GP.INPTR
jsr LAABC
bcc LA995
bmi LA9C1
bcs LA9BE
LA995 ldx GP.INPTR
jsr BS.GetCharSpaceSep
bne LA989
LA99D ldx #$02
LA99F cpx XBC08
beq LA9AC
lda BS.TMPBUF4,x
bne LA9C1
dex
bne LA99F
LA9AC ldy XBC09
LA9AF lda BS.TMPBUF4,x
sta GP.ParamA,y
dey
dex
bpl LA9AF
ldx GP.INPTR
clc
rts
LA9BE jmp BS.ERR10
LA9C1 jmp LA76C
BS.GetFTypeASC ldy #$00
LA9C6 sta BS.TMPBUF4,y
iny
cpy #$03
beq LA9D5
jsr BS.GetCharSpaceSep
bne LA9C6
beq LA9BE
LA9D5 stx GP.INPTR
LA9D8 ldx #$00
lda XBC08
cmp #$0F
beq LA9BE
asl
adc XBC08
tay
LA9E6 lda BS.TMPBUF4,x
eor BS.PRODOSTYPES.ASC,y
asl
bne LA9F7
iny
inx
cpx #$03
bne LA9E6
beq LA9FC
LA9F7 inc XBC08
bne LA9D8
LA9FC lda #$0E
sec
sbc XBC08
tay
lda BS.PRODOSTYPES.H,y
sta GP.ParamT
ldx GP.INPTR
clc
rts
BS.GetPathInPathBuf
jsr BS.GetCharUC
sta MLI.PATHBUF,y
iny
cmp #$2C
beq LAA45
cmp #$20
beq LAA45
cmp #$0D
beq LAA56
cpy BS.GetCharMax
bcc BS.GetPathInPathBuf
ora #$00
rts
BS.GetKWInCmdBuf
ldx #$00
ldy #$00
LAA2D jsr BS.GetCharUC
sta BS.CMDBUF,y
iny
cmp #$2C
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.GetCharUC
cmp #$2C
beq LAA57
cmp #$0D
LAA56 clc
LAA57 rts
BS.GetCharUC lda IO.LINEBUF,x
and #$7F
cmp #$61
bcc LAA63
and #$5F
LAA63 inx
cmp BS.GetCharSep
beq BS.GetCharUC
rts
LAA6A cmp #$30
bcc LAA72
cmp #$3A
bcc LAA76
LAA72 sec
ora #$00
rts
LAA76 and #$0F
pha
lda BS.TMPBUF4+2
cmp #$1A
bcs LAAA2
ldx #$02
LAA82 lda BS.TMPBUF4,x
pha
dex
bpl LAA82
jsr BS.TMPBUF3x2
jsr BS.TMPBUF3x2
ldx #$00
clc
LAA92 pla
adc BS.TMPBUF4,x
sta BS.TMPBUF4,x
inx
txa
eor #$03
bne LAA92
jsr BS.TMPBUF3x2
LAAA2 pla
bcs LAAB8
adc BS.TMPBUF4
sta BS.TMPBUF4
bcc LAABB
clc
inc BS.TMPBUF4+1
bne LAABB
inc BS.TMPBUF4+2
bne LAABB
LAAB8 lda #$FF
sec
LAABB rts
LAABC cmp #$30
bcc LAACC
cmp #$3A
bcc LAAD2
cmp #$41
bcc LAACC
cmp #$47
bcc LAAD0
LAACC sec
ora #$00
rts
LAAD0 sbc #$06
LAAD2 and #$0F
ldx #$03
LAAD6 jsr BS.TMPBUF3x2
bcs LAAB8
dex
bpl LAAD6
ora BS.TMPBUF4
sta BS.TMPBUF4
rts
BS.TMPBUF3x2 asl BS.TMPBUF4
rol BS.TMPBUF4+1
rol BS.TMPBUF4+2
rts
BS.IsIntCmd ldx #$1F
stx GP.XCNUM
lda BS.CMDBUF
eor #$2D
bne LAB03
inc GP.XCNUM
sta GP.XLEN
bne LAB20
LAB03 ldy #$08
sty GP.XLEN
LAB08 lda BS.KW.LEN,x
bpl LAB13
and #$7F
dey
dec GP.XLEN
LAB13 tax
LAB14 lda BS.CMDBUF,y
cmp BS.KW.TABLE,x
bne LAB33
dex
dey
bpl LAB14
LAB20 lda GP.XCNUM
asl
tax
lda BS.KW.PBITS-1,x
sta GP.AllowedBITS+1
lda BS.KW.PBITS-2,x
sta GP.AllowedBITS
clc
rts
LAB33 ldy GP.XLEN
dec GP.XCNUM
ldx GP.XCNUM
bne LAB08
dec GP.XCNUM
sec
jmp GP.EXTRNCMD
BS.TMPBUF3Reset ldy #$00
sty BS.TMPBUF4
sty BS.TMPBUF4+1
sty BS.TMPBUF4+2
rts
BS.KW.APPEND lda GP.FITYPE
cmp #$FC
beq BS.KW.02
cmp #$06
beq LABA3
cmp #$04
bne LAB63
jmp BS.KW.EXEC
LAB63 cmp #$FF
beq LAB6F
cmp #$B3
beq LAB6F
lda #$0D
sec
rts
LAB6F pha
jsr LB562
jsr LB36B
lda #$00
sta GP.ParamA
sta MLI.MEMTABL+19
sta MLI.MEMTABL+20
sta MLI.MEMTABL+21
sta 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 LB099
BS.KW.X05 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.02 lda #$00
sta GP.IFILACTV
sta 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.ERR10
BS.KW.RESTORE jsr LAC1D
bcs LAC33
BS.ENTRY jsr AS.CLEAR1
jsr BS.SetState0
lda #$00
sta 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
lda #MLI.C.GETEOF
jsr GP.GOSYSTEM
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 #$0E
bcs LAC33
ldx GP.SBUFADR
ldy GP.SBUFADR+1
jsr BS.ReadXYBytes
bcs LAC33
jsr BS.FileClose
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.STORE 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
lda AS.PGRMSTART
sta GP.MLIRW.DATAPTR
lda AS.PGRMSTART+1
sta GP.MLIRW.DATAPTR+1
jsr BS.WriteXYBytes
bcs LAD47
lda #MLI.C.SETEOF
jsr GP.GOSYSTEM
bcs LAD47
jsr BS.FileClose
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 lda #$00
sta GP.CRAUXTYPE
sta GP.CRAUXTYPE+1
lda GP.FoundBITS
and #$04
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 #$0C
rts
BS.KW.RENAME lda GP.FoundBITS
lsr
lsr
lda #MLI.C.RENAME
bcs LAD9E
jmp BS.ERR10
BS.KW.DELETE lda #MLI.C.DESTROY
LAD9E jmp GP.GOSYSTEM
BS.KW.LOCK jsr BS.GetFileInfo
lda GP.FIACCESS
and #$3C
ora #$01
sta GP.FIACCESS
jmp BS.SetFileInfo
BS.KW.UNLOCK jsr BS.GetFileInfo
lda #$C3
ora GP.FIACCESS
sta GP.FIACCESS
jmp BS.SetFileInfo
BS.KW.PREFIX lda GP.FoundBITS+1
and #$04
sec
bne LADCB
lda GP.FoundBITS
lsr
LADCB lda #$C6
bcs LAD9E
lda ZP.PROMPT
beq LADF0
jsr BS.CROUT
ldx #$00
LADD8 cpx BS.CMDBUF.LEN
beq LADE8
lda BS.CMDBUF,x
ora #$80
jsr BS.COUT
inx
bne LADD8
LADE8 jsr BS.CROUT
jsr BS.CROUT
clc
rts
LADF0 lda #$FF
sta GP.PFXACTV
clc
rts
*--------------------------------------
MAN
SAVE usr/src/basic.15/basic.s.b
LOAD usr/src/basic.15/basic.s
ASM
Reference in New Issue View Git Blame Copy Permalink