ACOS:Strings & FOR/NEXT

This commit is contained in:
burniouf 2021-08-05 13:35:37 +02:00
parent 3007637129
commit a38a84fc1e
15 changed files with 631 additions and 361 deletions

View File

@ -1334,8 +1334,11 @@ CS : A = Error Code
`>SYSCALL expand`
## RETURN VALUE
Y,A = PTR to Expanded String
X = hMem to Expanded String (C-String)
if expanded == null
Y,A = PTR to Expanded String
X = hMem to Expanded String
if expanded = null
Y,A = strlen
# StrLen
Returns Length of C-String

Binary file not shown.

Binary file not shown.

View File

@ -2,6 +2,26 @@ NEW
AUTO 3,1
.LIST OFF
*--------------------------------------
CODE.PUSHYA ldx #0
.1 lda CCODE.PUSHYA,x
jsr CODE.EmitByte
inx
cpx #CCODE.PUSHYA.LEN
bne .1
rts
*--------------------------------------
CODE.TESTTRUE ldx #0
.1 lda CCODE.TESTTRUE,x
jsr CODE.EmitByte
inx
cpx #CCODE.TESTTRUE.LEN
bne .1
rts
*--------------------------------------
CODE.PUSHYXI lda #$A9 LDA #imm
jsr CODE.EmitByte
txa
@ -13,15 +33,15 @@ CODE.PUSHYXI lda #$A9 LDA #imm
tya
jsr CODE.EmitByte
*--------------------------------------
CODE.PUSHA ldx #0
.1 lda CCODE.PUSHA,x
CODE.PUSHA lda #$C6 DEC zp
jsr CODE.EmitByte
inx
cpx #CCODE.PUSHA.LEN
bne .1
rts
lda #pStack
jsr CODE.EmitByte
lda #$92 STA (zp)
jsr CODE.EmitByte
lda #pStack
jmp CODE.EmitByte
*--------------------------------------
CODE.PUSHINT16 ldy #1
@ -37,6 +57,27 @@ CODE.PUSHINT16 ldy #1
rts
*--------------------------------------
CODE.PULLYX jsr CODE.PULLA
lda #$A8 TAY
jsr CODE.EmitByte
jsr CODE.PULLA
lda #$AA TAX
bra CODE.EmitByte
*--------------------------------------
CODE.PULLA lda #$B2 LDA (zp)
jsr CODE.EmitByte
lda #pStack
jsr CODE.EmitByte
lda #$E6 INC zp
jsr CODE.EmitByte
lda #pStack
bra CODE.EmitByte
*--------------------------------------
CODE.LDVARDDRI ldy VAR.ADDR
ldx VAR.ADDR+1
*--------------------------------------
CODE.LDYXI lda #$A0 LDY #imm
jsr CODE.EmitByte
tya

View File

@ -13,14 +13,6 @@ CORE.Init ldy #CCS.MAX
txa
>STA.G hCodeBuf
>LDYAI CONSTSEG
>SYSCALL GetMem
bcs .9
>STYA ZPConstBufPtr
txa
>STA.G hConstBuf
>LDYAI DATASEG
>SYSCALL GetMem
bcs .9
@ -49,9 +41,17 @@ CORE.Init ldy #CCS.MAX
>SYSCALL GetMem
bcs .9
>STYA ZPStrBuf
>STYA ZPStrBuf1
txa
>STA.G hStrBuf
>STA.G hStrBuf1
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPStrBuf2
txa
>STA.G hStrBuf2
>LDYAI FWREF
>SYSCALL GetMem
@ -71,15 +71,15 @@ CORE.Quit lda hStrings
>SYSCALL StrVFree
.1 ldy #hStrBuf
.1 ldy #hStrBuf2
jsr CORE.Quit.Freemem
ldy #hStrBuf1
jsr CORE.Quit.Freemem
ldy #hDataBuf
jsr CORE.Quit.Freemem
ldy #hConstBuf
jsr CORE.Quit.Freemem
ldy #hCodeBuf
jsr CORE.Quit.Freemem
*--------------------------------------
@ -134,7 +134,7 @@ CORE.Compile jsr CORE.GetChar
bcs .2 CS=SPACE -> go check VAR or KW
jsr CORE.IsLetter LABEL must start with a letter
bcs .99
bcs .39
jsr CORE.CreateLabel
bcs .99
@ -160,7 +160,7 @@ CORE.Compile jsr CORE.GetChar
bra .8
*--------------------------------------
.3 jsr CORE.CreateOrGetVar
bcs .99
.39 bcs .99
jsr CORE.GetCharNB
bcs .90
@ -171,27 +171,23 @@ CORE.Compile jsr CORE.GetChar
jsr CORE.GetNextCharNB skip '='
bcs .90
jsr EXP.Eval ZPTYPE set by CreateOrGetVar
jsr EXP.Eval VAR.TYPE set by CreateOrGetVar
bcs .99
lda ZPTYPE
lda VAR.TYPE
cmp EXP.TYPE
bne .91
tax
beq .4
ldy ZPADDR
ldx ZPADDR+1
jsr CODE.LDYXI
jsr CODE.LDVARDDRI
ldx #RT.StrSet.ID
jsr CODE.JSRRT Store String in hSTRV
bra .8
.4 ldy ZPADDR
ldx ZPADDR+1
jsr CODE.LDYXI
.4 jsr CODE.LDVARDDRI
ldx #RT.IntSet.ID
jsr CODE.JSRRT Store Int16 result in DATASEG
@ -207,6 +203,10 @@ CORE.Compile jsr CORE.GetChar
.88 ldy pCCS
bmi .89
lda (pData),y
cmp #KWID.IF
bne .89
jsr KW.ENDIF
bcs .99
@ -244,10 +244,10 @@ CORE.FWREF >LDYA L.MSG.FWREF
jsr CORE.GetLabel
bcs .9
lda ZPADDR
lda VAR.ADDR
sta (ZPPtr1)
ldy #1
lda ZPADDR+1
lda VAR.ADDR+1
sta (ZPPtr1),y
jsr CORE.GetNextChar skip \0
@ -481,10 +481,10 @@ CORE.CreateLabel
jsr CORE.NewKey
bcs .9
>STYA ZPSID
>STYA VAR.ID
>PUSHB.G hLabels
>PUSHW ZPSID
>PUSHW VAR.ID
>PUSHWI ZPCodeBufPtr
>PUSHWI 2 2 bytes : ADDR
>SYSCALL SListAddData
@ -495,14 +495,14 @@ CORE.GetLabel >PUSHB.G hLabels
>SYSCALL SListLookup
bcs .9
>STYA ZPSID
>STYA VAR.ID
txa
jsr CORE.SkipA
>PUSHB.G hLabels
>PUSHW ZPSID
>PUSHWI ZPADDR
>PUSHW VAR.ID
>PUSHWI VAR.ADDR
>PUSHWI 2 2 bytes : ADDR
>PUSHWZ From Start
>SYSCALL SListGetData
@ -546,43 +546,43 @@ CORE.2FWRefBuf sta (ZPFWRefBufPtr)
CORE.CreateOrGetVar
>LDA.G hVars
jsr CORE.GetAddr
bcc .2
bcc .7
jsr CORE.NewVarKey
bcs .99
bcs .9
>STYA ZPSID
>STYA VAR.ID
jsr CORE.GetVarType
stx ZPTYPE
stx VAR.TYPE
beq .1
jsr CORE.GetStr
bra .10
jsr CORE.GetStrID
bra .2
.1 jsr CORE.GetWord
.10 >STYA ZPADDR
.2 >STYA VAR.ADDR
>PUSHB.G hVars
>PUSHW ZPSID
>PUSHWI ZPADDR
>PUSHW VAR.ID
>PUSHWI VAR.ADDR
>PUSHWI 3 3 bytes : ADDR + TYPE
>SYSCALL SListAddData
rts
*--------------------------------------
.2 jsr CORE.GetVarType
.7 jsr CORE.GetVarType
cpx ZPTYPE
bne .90
cpx VAR.TYPE
beq .8
clc
rts
.90 lda #E.TMISMATCH
lda #E.TMISMATCH
sec
.99 rts
rts
.8 clc
.9 rts
*--------------------------------------
CORE.NewVarKey >LDA.G hVars
@ -608,13 +608,13 @@ CORE.GetAddr >PUSHA
>SYSCALL SListLookup
bcs .9
>STYA ZPSID
>STYA VAR.ID
txa
jsr CORE.SkipA
.1 >PUSHW ZPSID
>PUSHWI ZPADDR
.1 >PUSHW VAR.ID
>PUSHWI VAR.ADDR
>PUSHWI 3 3 bytes : ADDR + TYPE
>PUSHWZ From Start
>SYSCALL SListGetData
@ -658,13 +658,13 @@ CORE.GetWord lda ZPDataBufPtr
.8 rts
*--------------------------------------
CORE.GetStr >LDYA STRID
inc STRID
CORE.GetStrID inc STRID
bne .8
inc STRID+1
.8 clc
.8 >LDYA STRID
clc
rts
*--------------------------------------
CORE.ToUpperCase

View File

@ -55,8 +55,8 @@ EXP.Eval.R lda EXP.AOPS
bcs .21
jsr EXP.FNjmpX
bcs .99
bra .40
.21 jsr EXP.VARLookup
@ -64,23 +64,20 @@ EXP.Eval.R lda EXP.AOPS
ldy EXP.ADDR
ldx EXP.ADDR+1
jsr CODE.LDYXI
ldx EXP.TYPE
lda EXP.TYPE
bne .22
ldx #RT.IntGet.ID
bra .23
.22 ldx #RT.StrGet.ID
jsr CODE.LDYXI
.23 jsr CODE.JSRRT
ldx #RT.IntGet.ID
jsr CODE.JSRRT
bra .40
.22 jsr CODE.PUSHYXI
bra .40
*--------------------------------------
.30 jsr CORE.IsDigit10
.39 bcs .90
jsr EXP.Int16
.30 jsr EXP.Int16
.37 bcs .99
*--------------------------------------
.40 jsr CORE.GetCharNB
@ -93,17 +90,20 @@ EXP.Eval.R lda EXP.AOPS
bcc .80
jsr CORE.LookupOPS
bcs .90
.39 bcs .90
stx EXP.AOPS
lda (pStack) get op context
bmi .60 no prev op, go get arg2
ldy EXP.TYPE
bne .51 no precedence for strings
cmp EXP.AOPS we have arg1 A=op1 arg2 X=op2
bcc .60
inc pStack prev op has precedence
.51 inc pStack prev op has precedence
tay
jsr EXP.ComputeY go compute (arg1 op1 arg2)
@ -151,53 +151,58 @@ EXP.CreateStrConst
ldy #0
.1 jsr CORE.GetNextChar
bcs .91
bcs .9
cmp #'"'
beq .2
sta (ZPConstBufPtr),y
sta (ZPStrBuf1),y
iny
bne .1
.9 lda #E.ESYN
* sec
.99 rts
.2 lda #0
sta (ZPConstBufPtr),y
sta (ZPStrBuf1),y
phy
ldy ZPConstBufPtr
ldx ZPConstBufPtr+1
jsr CODE.PUSHYXI
jsr CORE.GetNextCharNB skip "
pla
sec for \0
adc ZPConstBufPtr
sta ZPConstBufPtr
bcc .3
inc ZPConstBufPtr+1
.3 jsr CORE.GetNextCharNB skip "
>PUSHB hStrings
jsr CORE.GetStrID
>PUSHYA
>PUSHW ZPStrBuf1
>SYSCALL StrVSet
bcs .99
ldy STRID
ldx STRID+1
clc
rts
.91 lda #E.ESYN
* sec
rts
jmp CODE.PUSHYXI push StrID on stack
*--------------------------------------
EXP.Int16 >PUSHW ZPInputBufPtr
EXP.Int16 jsr CORE.IsDigit10
bcc .1
cmp #'-'
bne .90
.1 >PUSHW ZPInputBufPtr
>PUSHWI ZPInputBufPtr
>PUSHBI 10
>SYSCALL StrToL
bcs .9
bcs .99
jsr CODE.PUSHINT16
>POP 4
>POP 4 Discard long on stack
clc
.9 rts
rts
.90 lda #E.ESYN
sec
.99 rts
*--------------------------------------
EXP.VARLookup >LDA.G hVars
@ -234,14 +239,13 @@ EXP.VARLookup >LDA.G hVars
.3 jsr CORE.NewVarKey
bcs .9
>PUSHYA SID
>PUSHYA SID
jsr CORE.GetVarType
stx EXP.TYPE
beq .4
jsr CORE.GetStr
jsr CORE.GetStrID
bra .5
.4 jsr CORE.GetWord
@ -250,7 +254,6 @@ EXP.VARLookup >LDA.G hVars
>PUSHWI EXP.ADDR
>PUSHWI 3 3 bytes : ADDR + TYPE
>SYSCALL SListAddData
rts
.9 inc pStack discard extra hVars
@ -278,18 +281,22 @@ EXP.ComputeY lda EXP.TYPE
bne .3
ldx #SYS.StrCmp
jsr CODE.SYSCALL
jsr CODE.PUSHYA
clc
jmp CODE.SYSCALL
rts
.3 cpy #13 =
bne .9
ldx #SYS.StrCmp
jsr CODE.SYSCALL
jsr CODE.PUSHYA
ldx #RT.NOT.ID
jsr CODE.JSRRT
clc
jmp CODE.JSRRT
rts
.9 sec
rts

View File

@ -16,10 +16,156 @@ KW.EDIT
sec
rts
*--------------------------------------
*KW.END
KW.FILL
KW.FLAG
KW.FOR
lda #E.CSYN
sec
rts
*--------------------------------------
* FOR var = exp1 TO exp2 STEP exp3 ... NEXT
*--------------------------------------
KW.FOR jsr CORE.GetNextCharNB
bcs .98
jsr CORE.CreateOrGetVar
bcs .99
lda VAR.TYPE
bne .97
jsr CORE.GetNextCharNB
bcs .98
cmp #'='
bne .98
jsr KW.GetIntExp
bcs .99
jsr CODE.LDVARDDRI
ldx #RT.IntSet.ID
jsr CODE.JSRRT set var = START value
>LDYA L.ACOS.KW
jsr CORE.LookupSkip
bcs .98
cpx #KWID.TO
bne .98
*--------------------------------------
jsr KW.PushCodePtr2CCS NEXT will JMP back here
*--------------------------------------
jsr CODE.LDVARDDRI
ldx #RT.IntGet.ID
jsr CODE.JSRRT get var value on stack
jsr KW.GetIntExp get exp2 on stack
bcs .99
ldx #FPU.iNE var value = exp 2 ?
jsr CODE.FPUCALL
jsr CODE.TESTTRUE
jsr KW.FalseJMP2CCS if false, exit after NEXT
>LDYA L.ACOS.KW
jsr CORE.Lookup
bcs .98
cpx #KWID.STEP
bne .1
lda #4
jsr CORE.SkipA skip "STEP"
jsr KW.GetIntExp get exp3 value on stack
bcs .99
bra .2
.1 ldy #1 push 1 on stack
ldx #0
jsr CODE.PUSHYXI
.2 ldy VAR.ADDR push Address to update by NEXT
ldx VAR.ADDR+1
jsr CODE.PUSHYXI
clc
lda #KWID.FOR
jmp KW.PushA2CCS
.97 lda #E.TMISMATCH
sec
rts
.98 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.NEXT ldy pCCS
bmi .98
lda (pdata),y
cmp #KWID.FOR
bne .98
jsr CODE.PULLYX pull var address from stack
ldx #RT.IntGet.ID will set VAR.ADDR
jsr CODE.JSRRT get var value on stack
ldx #FPU.iADD new value = value + STEP (on stack)
jsr CODE.FPUCALL
ldx #RT.IntUpd.ID
jsr CODE.JSRRT set var = new value
ldy pCCS
iny pull JMP FALSE address
lda (pData),y
sta ZPPtr1
iny
lda (pData),y
sta ZPPtr1+1
lda #$4C JMP abs ...
jsr CODE.EmitByte
iny ...to loop address
lda (pData),y
jsr CODE.EmitByte
iny
lda (pData),y
jsr CODE.EmitByte
lda ZPCodeBufPtr and finally update JMP FALSE
sta (ZPPtr1)
lda ZPCodeBufPtr+1
ldy #1
sta (ZPPtr1),y
lda pCCS
clc
adc #5
sta pCCS
clc
rts
.98
KW.TO
KW.STEP lda #E.NOFOR
sec
rts
*--------------------------------------
KW.FREE
lda #E.CSYN
sec
@ -30,21 +176,19 @@ KW.GET jsr CORE.GetNextCharNB
jsr CORE.CreateOrGetVar
bcs .99
ldx #RT.GET.ID
jsr CODE.JSRRT
ldy ZPADDR
ldx ZPADDR+1
jsr CODE.LDYXI
jsr CODE.LDVARDDRI
ldx #RT.StrSet.ID
clc
jmp CODE.JSRRT
jmp CODE.JSRRT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.GOSUB lda #$20 JSR abs
@ -55,16 +199,16 @@ KW.GOTO lda #$4C JMP abs
KW.GOTO1 jsr CODE.EmitByte
jsr CORE.GetNextCharNB
bcs .90
jsr CORE.GetLabel
bcc .1
jsr CORE.AddFWRef
bcs .99
.1 lda ZPADDR
.1 lda VAR.ADDR
jsr CODE.EmitByte
lda ZPADDR+1
lda VAR.ADDR+1
clc
jmp CODE.EmitByte
@ -74,62 +218,31 @@ KW.GOTO1 jsr CODE.EmitByte
*--------------------------------------
KW.HOME ldx #8 CLRSCR
jsr CODE.LDXI
ldx #RT.OUTX.ID
clc
jmp CODE.JSRRT
*--------------------------------------
* IP exp THEN st1 ELSE st2
* IF exp THEN st1 ELSE st2
*--------------------------------------
KW.IF jsr EXP.Eval
bcs .99
lda EXP.TYPE
bne .91
bne .98
ldx #0
jsr CODE.TESTTRUE
.1 lda CCODE.TESTTRUE,x
jsr CODE.EmitByte
inx
cpx #CCODE.TESTTRUE.LEN
bne .1
jsr KW.FalseJMP2CCS
ldy pCCS
dey
lda ZPCodeBufPtr+1
sta (pData),y
dey
lda ZPCodeBufPtr
sta (pData),y
dey
lda #KWID.IF
sta (pData),y
sty pCCS
lda ZPCodeBufPtr
clc
adc #2
sta ZPCodeBufPtr
bcc .8
inc ZPCodeBufPtr+1
jmp KW.PushA2CCS
.8 clc
rts
.90 lda #E.CSYN
.98 lda #E.TMISMATCH
sec
rts
.91 lda #E.TMISMATCH
sec
.99 rts
.99 rts
*--------------------------------------
KW.ENDIF sec
.HS 90 BCC
@ -137,6 +250,8 @@ KW.ENDIF sec
KW.ELSE clc
ldy pCCS
bmi .9
lda (pData),y
eor #KWID.IF
bne .9
@ -144,7 +259,7 @@ KW.ELSE clc
iny
lda (pData),y
sta ZPPtr1
iny
lda (pData),y
sta ZPPtr1+1 ZPPtr1 = JMP if FALSE
@ -153,22 +268,22 @@ KW.ELSE clc
lda #$4C JMP abs
jsr CODE.EmitByte
ldy pCCS
iny
lda ZPCodeBufPtr
sta (pData),y
iny
lda ZPCodeBufPtr+1
sta (pData),y
sta (pData),y
lda ZPCodeBufPtr
clc
adc #2
sta ZPCodeBufPtr
bcc .1
inc ZPCodeBufPtr+1
.1 lda ZPCodeBufPtr
@ -183,7 +298,7 @@ KW.ELSE clc
.5 lda ZPCodeBufPtr
sta (ZPPtr1)
ldy #1
lda ZPCodeBufPtr+1
sta (ZPPtr1),y
@ -209,33 +324,31 @@ KW.INPUT stz hIn Defaut to Keyboard
jsr CORE.GetNextCharNB
bcs .9
cmp #'"'
bne .5
jsr EXP.CreateStrConst
bcs .99
ldx #RT.StrOut.ID
jsr CODE.JSRRT
.5 jsr CORE.CreateOrGetVar
bcs .99
ldx #RT.INPUT.ID
jsr CODE.JSRRT
ldy ZPADDR
ldx ZPADDR+1
jsr CODE.LDYXI
jsr CODE.LDVARDDRI
ldx #RT.StrSet.ID
clc
jmp CODE.JSRRT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.KILL
@ -245,12 +358,15 @@ KW.MARK
KW.MODEM
KW.MOVE
KW.MSG
KW.NEXT
lda #E.CSYN
sec
rts
*--------------------------------------
KW.NIBBLE
KW.NOT
KW.ON
KW.NOCAR >DEBUG
lda #E.CSYN
KW.NOCAR lda #E.CSYN
sec
rts
*--------------------------------------
@ -266,33 +382,33 @@ KW.POSITION
sec
rts
*--------------------------------------
KW.PRINT stz ZPPtr2 put ending CR
KW.PRINT stz ZPPtr2 put ending CR
stz hOut Default to screen
.10 jsr CORE.GetNextCharNB
jsr CORE.GetCharNB
bcs .8
.11 cmp #'\'
bne .13
.12 ldx #RT.OUTCRLF.ID
jsr CODE.JSRRT
bra .10
bra .72
.13 jsr CORE.IsEndInst
bcs .8
jsr CORE.IsKW
bcc .8
stz ZPPtr2 put ending CR
stz ZPPtr2 put ending CR
jsr EXP.Eval
bcs .99
lda EXP.TYPE
beq .6
ldx #RT.StrOut.ID
bra .7
@ -304,7 +420,7 @@ KW.PRINT stz ZPPtr2 put ending CR
.70 cmp #'\'
beq .12
jsr CORE.IsEndInst
bcs .8
@ -317,26 +433,26 @@ KW.PRINT stz ZPPtr2 put ending CR
tax
jsr CODE.PutChar
bra .10 go skip
bra .72 go skip
.71 cmp #';'
bne .90
ror ZPPtr2 suppress ending CR
jsr CORE.GetNextCharNB skip ;
.72 jsr CORE.GetNextCharNB skip "/", ";" or ","
bcc .11
.8 bit ZPPtr2
bmi .80
ldx #RT.OUTCRLF.ID
jsr CODE.JSRRT
.80 clc
rts
.90 lda #E.CSYN
sec
.99 rts
@ -355,7 +471,7 @@ KW.RETURN
* TODO : check context
KW.END lda #$60 RTS
clc
jmp CODE.EmitByte
*--------------------------------------
@ -372,10 +488,10 @@ KW.THEN ldy pCCS
lda (pData),y
eor #KWID.IF
bne .9
clc
rts
.9 lda #E.NOIF
sec
rts
@ -389,6 +505,57 @@ KW.WRITE
sec
rts
*--------------------------------------
KW.GetIntExp jsr CORE.GetNextCharNB
bcs .98
jsr EXP.Eval
bcs .99
lda EXP.TYPE
beq .99
lda #E.TMISMATCH
sec
rts
.98 lda #E.CSYN
* sec
.99 rts
*--------------------------------------
KW.PushA2CCS ldy pCCS
dey
sta (pData),y
sty pCCS
rts
*--------------------------------------
KW.FalseJMP2CCS jsr KW.PushCodePtr2CCS
lda ZPCodeBufPtr
clc
adc #2
sta ZPCodeBufPtr
bcc .8
inc ZPCodeBufPtr+1
.8 rts
*--------------------------------------
KW.PushCodePtr2CCS
ldy pCCS
dey
lda ZPCodeBufPtr+1
sta (pData),y
dey
lda ZPCodeBufPtr
sta (pData),y
sty pCCS
rts
*--------------------------------------
MAN
SAVE usr/src/bin/acos.s.kw
LOAD usr/src/bin/acos.s

View File

@ -14,83 +14,108 @@ RT.NOT lda (pStack)
>PUSHA
rts
*--------------------------------------
RT.StrAdd >DEBUG
RT.StrAdd ldx #2
jsr RT.StrPullX
jsr RT.StrPull
>PUSHW ZPStrBuf1
>PUSHW ZPStrBuf2
>SYSCALL strcat
>PUSHWZ RVALUE in buffer
inc pStack
inc pStack
clc
rts
*--------------------------------------
RT.StrSet >PUSHB hStrings
txa
>PUSHA
tya
>PUSHA
ldy #4
lda (pStack),y
>PUSHA
lda (pStack),y
>PUSHA
>SYSCALL StrVSet
inc pStack
inc pStack
rts
* on stack : Src StrID
* Y,X : Dst StrID
*--------------------------------------
RT.StrGet lda #0
sta (ZPStrBuf)
RT.StrSet sty STRID
stx STRID+1
ldy #1
lda (pStack),y
ora (pStack)
beq .1
>PUSHB hStrings
txa
>PUSHA
tya
>PUSHA
>PUSHW ZPStrBuf
>SYSCALL StrVGet
>PUSHW ZPStrBuf
rts
*--------------------------------------
RT.StrOut ldy #S.PS.hStdOut
lda (pPS),y
>PUSHA
ldy #2
lda (pStack),y
>PUSHA
lda (pStack),y
>PUSHA
>PUSHW ZPStrBuf1
>SYSCALL StrVGet
.1 >PUSHB hStrings
>PUSHW STRID
>PUSHW ZPStrBuf1
>SYSCALL StrVSet
inc pStack
inc pStack
rts
*--------------------------------------
RT.StrOut jsr RT.StrPull
ldy #S.PS.hStdOut
lda (pPS),y
>PUSHA
>PUSHW ZPStrBuf1
>PUSHBI 0
>SYSCALL fprintf
inc pStack
inc pStack
rts
*--------------------------------------
RT.IntSet sty ZPADDR
stx ZPADDR+1
RT.StrPull ldx #0
RT.StrPullX >PULLW STRID
ora STRID
beq .8
lda #0
sta (ZPStrBuf1,x)
>PUSHB hStrings
>PUSHW STRID
>PUSHW ZPStrBuf1,x
>SYSCALL StrVGet
.8 rts
*--------------------------------------
RT.IntSet sty VAR.ADDR
stx VAR.ADDR+1
>PULLA
sta (ZPADDR)
RT.IntUpd >PULLA
sta (VAR.ADDR)
>PULLA
ldy #1
sta (ZPADDR),y
sta (VAR.ADDR),y
rts
*--------------------------------------
RT.IntGet sty ZPADDR
stx ZPADDR+1
RT.IntGet sty VAR.ADDR
stx VAR.ADDR+1
ldy #1
lda (ZPADDR),y
lda (VAR.ADDR),y
>PUSHA
lda (ZPADDR)
lda (VAR.ADDR)
>PUSHA
rts
*--------------------------------------
RT.IntOut >PUSHW L.MSG.INT16
ldy #3
lda (pStack),y
>PUSHA
lda (pStack),y
>PUSHA
>PUSHBI 2
>SYSCALL PrintF
inc pStack
@ -102,7 +127,7 @@ RT.DATEd ldx #0
RT.TIMEd ldx #2
RT.TIMEd.1 >PUSHW ZPStrBuf
RT.TIMEd.1 >PUSHW ZPStrBuf1
>PUSHW L.FMT.DATE,x
>PUSHEA.G TimeBuf
@ -110,21 +135,25 @@ RT.TIMEd.1 >PUSHW ZPStrBuf
>SYSCALL Time
>SYSCALL StrFTime
>PUSHW ZPStrBuf
>PUSHWZ RVALUE in buffer
rts
*--------------------------------------
RT.GET jsr RT.GetChar
sta (ZPStrBuf)
sta (ZPStrBuf1)
ldy #1
lda #0
sta (ZPStrBuf),y
sta (ZPStrBuf1),y
bra RT.INPUT.8
>PUSHWZ RVALUE in buffer
clc
rts
*--------------------------------------
RT.INPUT lda #0
sta (ZPStrBuf)
sta (ZPStrBuf1)
stz ZPPtr1
@ -132,7 +161,7 @@ RT.INPUT lda #0
jsr RT.OUTX
.1 jsr RT.GetChar
bcs RT.INPUT.9
bcs .9
ldy ZPPtr1
@ -143,12 +172,12 @@ RT.INPUT lda #0
bne .2
lda #0
sta (ZPStrBuf),y
sta (ZPStrBuf1),y
ldx #4 OUT.CRLF
jsr RT.OUTX
bra RT.INPUT.8
bra .8
.2 cmp #C.BS
bne .1
@ -165,99 +194,94 @@ RT.INPUT lda #0
.7 cpy #255
bcs .1
sta (ZPStrBuf),y
sta (ZPStrBuf1),y
>SYSCALL PutChar
inc ZPPtr1
bra .1
RT.INPUT.8 ldx #2 OUT.DLW
.8 ldx #2 OUT.DLW
jsr RT.OUTX
>PUSHW ZPStrBuf
>PUSHWZ RVALUE in buffer
clc
RT.INPUT.9 rts
.9 rts
*--------------------------------------
RT.LEFTd >PULLB ZPPtr2 cnt
inc pStack
>PULLW ZPPtr1 src str
ldy #0
.1 lda (ZPPtr1),y
sta (ZPStrBuf),y
beq .8
iny
cpy ZPPtr2
bne .1
jsr RT.StrPull
ldy ZPPtr2
lda #0
sta (ZPStrBuf),y
sta (ZPStrBuf1),y
.8 >PUSHW ZPStrBuf
.8 >PUSHWZ RVALUE in buffer
clc
rts
*--------------------------------------
RT.LEN >PULLYA str
>SYSCALL strlen
RT.LEN jsr RT.StrPull
ldy #$ff
.1 iny
lda (ZPStrBuf1),y
bne .1
>PUSHYA
rts
*--------------------------------------
RT.MIDd >PULLA len
tax
RT.MIDd >PULLB ZPPtr2+1 len
inc pStack
>PULLB ZPPtr2 start
inc pStack
>PULLW ZPPtr1 src str
jsr RT.StrPull
ldy #0
.1 lda (ZPPtr1),y
.1 lda (ZPStrBuf1),y
beq .8
iny
cpy ZPPtr2
cpy ZPPtr2 start
bne .1
tya
clc
adc ZPPtr1
adc ZPStrBuf1
sta ZPPtr1
bcc .2
inc ZPPtr1+1
lda ZPStrBuf1+1
adc #0
sta ZPPtr1+1
.2 ldy #0
ldy #$ff
.3 txa
.3 iny
cpy ZPPtr2+1 len
beq .8
lda (ZPPtr1),y
sta (ZPStrBuf),y
beq .80
iny
dex
sta (ZPStrBuf1),y
bne .3
txa
.8 sta (ZPStrBuf),y
.8 lda #0
sta (ZPStrBuf1),y
.80 >PUSHW ZPStrBuf
.80 >PUSHWZ RVALUE in buffer
clc
rts
*--------------------------------------
RT.RIGHTd >PULLB ZPPtr2 cnt
inc pStack
>PULLW ZPPtr1 src str
jsr RT.StrPull
ldy #$ff
.1 iny
lda (ZPPtr1),y
lda (ZPStrBuf1),y
bne .1
tya
@ -267,32 +291,35 @@ RT.RIGHTd >PULLB ZPPtr2 cnt
beq .8
clc
adc ZPPtr1
adc ZPStrBuf1
sta ZPPtr1
bcc .2
inc ZPPtr1+1
.2 ldy #$ff
lda ZPStrBuf1+1
adc #0
sta ZPPtr1+1
ldy #$ff
.3 iny
lda (ZPPtr1),y
sta (ZPStrBuf),y
sta (ZPStrBuf1),y
bne .3
.8 >PUSHW ZPStrBuf
.8 >PUSHWZ RVALUE in buffer
clc
rts
*--------------------------------------
RT.STRd >PULLYA int
pha
>PUSHW ZPStrBuf
>PUSHW ZPStrBuf1
>PUSHW L.MSG.INT16
pla
>PUSHYA
>PUSHBI 2
>SYSCALL sprintf
>PUSHW ZPStrBuf
>PUSHWZ RVALUE in buffer
rts
*--------------------------------------
RT.VAL >PULLYA str
@ -301,6 +328,7 @@ RT.VAL >PULLYA str
rts
*--------------------------------------
RT.OUTCRLF ldx #4 CRLF
RT.OUTX ldy #S.PS.hStdOut
lda (pPS),y
>PUSHA

View File

@ -25,12 +25,25 @@ CCS.MAX .EQ 128
ZS.START
ZPInputBufPtr .BS 2
ZPSID .BS 2
ZPADDR .BS 2
ZPTYPE .BS 1
ZPCodeBufPtr .BS 2
ZPDataBufPtr .BS 2
ZPFWRefBufPtr .BS 2
STRID .BS 2
VAR.ID .BS 2
VAR.ADDR .BS 2
VAR.TYPE .BS 1
hStrings .BS 1
ZPStrBuf .BS 2
EXP.ADDR .BS 2
EXP.TYPE .BS 1
EXP.AOPS .BS 1
ZPStrBuf1 .BS 2
ZPStrBuf2 .BS 2
hIn .BS 1
hOut .BS 1
ZPPtr1 .BS 2
ZPPtr2 .BS 2
@ -38,19 +51,6 @@ ArgIndex .EQ *
pCCS .BS 1
bFlag .BS 1
ZPCodeBufPtr .BS 2
ZPConstBufPtr .BS 2
ZPDataBufPtr .BS 2
ZPFWRefBufPtr .BS 2
EXP.ADDR .BS 2
EXP.TYPE .BS 1
EXP.AOPS .BS 1
STRID .BS 2
hIn .BS 1
hOut .BS 1
ZS.END .ED
*--------------------------------------
* File Header (16 Bytes)
@ -109,6 +109,7 @@ J.ACOS.KW .DA KW.ADDINT
.DA KW.END
.DA KW.FILL
.DA KW.FLAG
KWID.FOR .EQ *-J.ACOS.KW
.DA KW.FOR
.DA KW.FREE
.DA KW.GET
@ -147,8 +148,12 @@ KWID.IF .EQ *-J.ACOS.KW
.DA KW.RIPCO
.DA KW.SET
.DA KW.SETINT
KWID.STEP .EQ *-J.ACOS.KW
.DA KW.STEP
.DA KW.TEXT
.DA KW.THEN
KWID.TO .EQ *-J.ACOS.KW
.DA KW.TO
.DA KW.TONE
.DA KW.UPDATE
.DA KW.USE
@ -207,12 +212,12 @@ RT.StrAdd.ID .EQ *-J.RT
.DA RT.StrAdd
RT.StrSet.ID .EQ *-J.RT
.DA RT.StrSet
RT.StrGet.ID .EQ *-J.RT
.DA RT.StrGet
RT.StrOut.ID .EQ *-J.RT
.DA RT.StrOut
RT.IntSet.ID .EQ *-J.RT
.DA RT.IntSet
RT.IntUpd.ID .EQ *-J.RT
.DA RT.IntUpd
RT.IntGet.ID .EQ *-J.RT
.DA RT.IntGet
RT.IntOut.ID .EQ *-J.RT
@ -403,16 +408,22 @@ CS.FClose >LDA.G hFile
* clc
rts
*--------------------------------------
PrintDebugMsg >LDYA pStack
>STYA ZPPtr2
>PUSHW L.MSG.DEBUG
PrintDebugMsg >PUSHW L.MSG.DEBUG
>PUSHW ZPCodeBufPtr
>PUSHW ZPConstBufPtr
>PUSHW ZPDataBufPtr
>PUSHW ZPPtr2
>PUSHBI 8
lda pStack
clc
adc #6
pha
lda pStack+1
adc #0
>PUSHA
pla
>PUSHA
>PUSHBI 6
>SYSCALL PrintF
rts
*--------------------------------------
@ -477,8 +488,8 @@ CS.END
*--------------------------------------
* Pre-compiled code
*--------------------------------------
CCODE.PUSHA >PUSHA
CCODE.PUSHA.LEN .EQ *-CCODE.PUSHA
CCODE.PUSHYA >PUSHYA
CCODE.PUSHYA.LEN .EQ *-CCODE.PUSHYA
*--------------------------------------
CCODE.TESTTRUE lda (pStack)
inc pStack
@ -499,7 +510,7 @@ MSG.USAGE .AS "Usage : ACOS <option> file\r\n"
.AZ "\r\n"
*--------------------------------------
MSG.COMPILING .AZ "***Compiling : %s...\r\n"
MSG.DEBUG .AZ "***CodePtr=%H ConstPtr=%H DataPtr=%H StackPtr=%H\r\n"
MSG.DEBUG .AZ "***CodePtr=%H DataPtr=%H StackPtr=%H\r\n"
MSG.TRACE .AZ "%05D>%s\r\n"
MSG.ERROR .AZ " %s^\r\n"
MSG.FWREF .AZ "***Resolving FWRefs..."
@ -605,8 +616,10 @@ ACOS.KW .AT "ADDINT"
.AT "RIPCO"
.AT "SET"
.AT "SETINT"
.AT "STEP"
.AT "TEXT"
.AT "THEN"
.AT "TO"
.AT "TONE"
.AT "UPDATE"
.AT "USE"
@ -648,11 +661,11 @@ hFile .BS 1
hInputBuf .BS 1
InputBufPtr .BS 2
hCodeBuf .BS 1
hConstBuf .BS 1
hDataBuf .BS 1
hLabels .BS 1
hVars .BS 1
hStrBuf .BS 1
hStrBuf1 .BS 1
hStrBuf2 .BS 1
hFWRefBuf .BS 1
TimeBuf .BS S.TIME
DS.END .ED

View File

@ -424,7 +424,7 @@ CS.RUN.PrintF >SYSCALL PrintF
inc LINE.COUNT
lda LINE.COUNT
cmp #23
cmp #22
bcc .8
dec bSTOP

View File

@ -31,8 +31,8 @@ L91C96.1.BAR .EQ $C082
L91C96.1.IAR .EQ $C084
L91C96.1.GPR .EQ $C08A
L91C96.1.CTR .EQ $C08C
L91C96.1.CTR.DEFAULT .EQ %00000000.00000001
L91C96.1.CTR.AUTOREL .EQ %00000000.00001000
L91C96.1.CTR.DEFAULT .EQ %00000001.00000000
L91C96.1.CTR.AUTOREL .EQ %00001000.00000000
L91C96.2.MMUCR .EQ $C080
L91C96.2.MMUCR.ALLOC .EQ %00100000

View File

@ -330,9 +330,7 @@ LDR.ReadRoot lda LDR.MLIOL.P+1 place boot devnum in globals
bcc .1 if ok, read next block.
.FIN
.8
* >DEBUG
jmp $800 jmp to "load interpreter" code
.8 jmp $800 jmp to "load interpreter" code
.9 ldx #LDR.MSG.ROOTERR
jsr LDR.PrintX
@ -364,27 +362,25 @@ LDR.ClkDevDCLK php
lda $CFFF
lda $C400
ldy #8
ldx #8
stz $C0C0
stz $C0C1
sty $C0C2
stx $C0C2
lda $C0C3
pha
.1 lda DS121x.SIG-1,y
.1 lda DS121x.SIG-1,x
ldx #8
ldy #8
.2 stz $C0C0
sta $C0C3
.2 sta $C0C3
stz $C0C0
lsr
dex
dey
bne .2
dey
dex
bne .1
ldx #8
@ -408,6 +404,7 @@ LDR.ClkDevDCLK php
sta $C0C3
plp
sed
ldx #DS121x.ValidHI-DS121x.ValidLO

View File

@ -71,6 +71,12 @@ FS.OPEN.REG >MLICALL MLIGETFILEINFO
*--------------------------------------
FS.OPEN.ERR pha Save Error Code
jsr FS.CLOSE.REGDIR
ldx IO.hFILE Cleanup what MkFD did
lda hFDs-1,x
stz hFDs-1,x
jsr K.FreeMem
pla
sec
rts
@ -112,9 +118,10 @@ FS.CLOSE.REGDIR ldy #S.FD.REG.REF
lda (pFD),y
beq .8
jsr K.FreeMem
jmp K.FreeMem
.8 jmp DEV.hFDFree
.8 clc
rts
*--------------------------------------
FS.READ.REG ldx #MLIREAD
.HS 2C BIT ABS

View File

@ -31,7 +31,8 @@ PIPE.CLOSE ldy #S.FD.PIPE.S
>SYSCALL2 FreeStkObj
.2 jmp DEV.hFDFree
.2 clc
rts
*--------------------------------------
* (pStack)+2 buf
* (pStack)+0 count

View File

@ -159,11 +159,11 @@ K.FPutS lda (pStack)
>PUSHA push len LO
jsr STDIO.Write
bcs K.FPutS.RTS
bcs .9
.8 >POP 2
>POP 3
K.FPutS.RTS rts
.9 rts
*/--------------------------------------
* # fgets (BLOCKING)
* read bytes from stream into the array
@ -420,8 +420,14 @@ K.FClose jsr PFT.CheckNodeA
lda hFDs.hName-1,x its a DEV, don't clear FD
beq .8
stz hFDs-1,x
stz hFDs.hName-1,x
jsr K.FreeMem
ldx IO.hFILE
lda hFDs-1,x
stz hFDs-1,x
jmp K.FreeMem
.8 clc