Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-11-28 10:52:33 +00:00
Code Issues Projects Releases Wiki Activity
0.95
A2osX/BIN/ACOS.S.KW.txt
burniouf a417f7aba6 Kernel 0.94.3b (kernel migration step b)
2023-07-14 12:24:49 +02:00

563 lines
8.5 KiB
Plaintext
Raw Permalink 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
.LIST OFF
*--------------------------------------
KW.ADDINT
KW.APPEND
KW.BYTE
KW.CLEAR
KW.CLOCK
KW.CLOSE
KW.COPY
KW.CREATE
KW.ECHO
KW.EDIT
lda #E.CSYN
sec
rts
*--------------------------------------
KW.FILL
KW.FLAG
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
rts
*--------------------------------------
KW.GET jsr CORE.GetNextCharNB
bcs .9
jsr CORE.CreateOrGetVar
bcs .99
ldx #RT.GET.ID
jsr CODE.JSRRT
jsr CODE.LDVARDDRI
ldx #RT.StrSet.ID
clc
jmp CODE.JSRRT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.GOSUB lda #$20 JSR abs
bra KW.GOTO1
*--------------------------------------
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 VAR.ADDR
jsr CODE.EmitByte
lda VAR.ADDR+1
clc
jmp CODE.EmitByte
.90 lda #E.CSYN
.99 rts
*--------------------------------------
KW.HOME ldx #8 CLRSCR
jsr CODE.LDXI
ldx #RT.OUTX.ID
clc
jmp CODE.JSRRT
*--------------------------------------
* IF exp THEN st1 ELSE st2
*--------------------------------------
KW.IF jsr EXP.Eval
bcs .99
lda EXP.TYPE
bne .98
jsr CODE.TESTTRUE
jsr KW.FalseJMP2CCS
lda #KWID.IF
clc
jmp KW.PushA2CCS
.98 lda #E.TMISMATCH
sec
.99 rts
*--------------------------------------
KW.ENDIF sec
.HS 90 BCC
*--------------------------------------
KW.ELSE clc
ldy pCCS
bmi .9
lda (pData),y
eor #KWID.IF
bne .9
iny
lda (pData),y
sta ZPPtr1
iny
lda (pData),y
sta ZPPtr1+1 ZPPtr1 = JMP if FALSE
bcs .5 ENDIF
lda #$4C JMP abs
jsr CODE.EmitByte
ldy pCCS
iny
lda ZPCodeBufPtr
sta (pData),y
iny
lda ZPCodeBufPtr+1
sta (pData),y
lda ZPCodeBufPtr
clc
adc #2
sta ZPCodeBufPtr
bcc .1
inc ZPCodeBufPtr+1
.1 lda ZPCodeBufPtr
sta (ZPPtr1)
lda ZPCodeBufPtr+1
ldy #1
sta (ZPPtr1),y
clc
rts
.5 lda ZPCodeBufPtr
sta (ZPPtr1)
ldy #1
lda ZPCodeBufPtr+1
sta (ZPPtr1),y
lda pCCS
clc
adc #3
sta pCCS
clc
rts
.9 lda #E.NOIF
sec
rts
*--------------------------------------
KW.INFO
lda #E.CSYN
sec
rts
*--------------------------------------
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
jsr CODE.LDVARDDRI
ldx #RT.StrSet.ID
clc
jmp CODE.JSRRT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.KILL
KW.LINK
KW.LOG
KW.MARK
KW.MODEM
KW.MOVE
KW.MSG
lda #E.CSYN
sec
rts
*--------------------------------------
KW.NIBBLE
KW.NOT
KW.ON
KW.NOCAR lda #E.CSYN
sec
rts
*--------------------------------------
KW.OPEN
lda #E.CSYN
sec
rts
*--------------------------------------
KW.POKE
KW.POP
KW.POSITION
lda #E.CSYN
sec
rts
*--------------------------------------
KW.PRINT stz ZPPtr2 put ending CR
stz hOut Default to screen
jsr CORE.GetCharNB
bcs .8
.11 cmp #'\'
bne .13
.12 ldx #RT.OUTCRLF.ID
jsr CODE.JSRRT
bra .72
.13 jsr CORE.IsEndInst
bcs .8
jsr CORE.IsKW
bcc .8
stz ZPPtr2 put ending CR
jsr EXP.Eval
bcs .99
lda EXP.TYPE
beq .6
ldx #RT.StrOut.ID
bra .7
.6 ldx #RT.IntOut.ID
.7 jsr CODE.JSRRT
*--------------------------------------
jsr CORE.GetCharNB
bcs .8
.70 cmp #'\'
beq .12
jsr CORE.IsEndInst
bcs .8
jsr CORE.IsKW
bcc .8
lda (ZPInputBufPtr)
cmp #','
bne .71
tax
jsr CODE.PutChar
bra .72 go skip
.71 cmp #';'
bne .90
ror ZPPtr2 suppress ending CR
.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
*--------------------------------------
KW.PUBLIC
KW.PUSH
KW.RAM
KW.RAM2
KW.READ
KW.READY
lda #E.CSYN
sec
rts
*--------------------------------------
KW.RETURN
* TODO : check context
KW.END lda #$60 RTS
clc
jmp CODE.EmitByte
*--------------------------------------
KW.REWIND
KW.RIPCO
KW.SET
KW.SETINT
KW.TEXT
lda #E.CSYN
sec
rts
*--------------------------------------
KW.THEN ldy pCCS
lda (pData),y
eor #KWID.IF
bne .9
clc
rts
.9 lda #E.NOIF
sec
rts
*--------------------------------------
KW.TONE
KW.UPDATE
KW.USE
KW.WHENd
KW.WRITE
lda #E.CSYN
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
ASM
Reference in New Issue View Git Blame Copy Permalink