Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2025-02-05 07:32:53 +00:00
Code Issues Projects Releases Wiki Activity
A2osX/BIN/CSH.S.CORE.txt
Rémy GIBERT 64e8b83244 Kernel 0.93+
2019-08-26 08:29:18 +02:00

1125 lines
18 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
.LIST OFF
*--------------------------------------
CSH.Init >SYSCALL SListNew
bcs .9
>STA.G CSH.hSymbols
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPCSHConst
txa
>STA.G CSH.hConst
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPCSHStack
txa
>STA.G CSH.hStack
lda #$0
>STA.G CSH.ConstPtr
>STA.G CSH.StackPtr
sta (ZPCSHConst)
sta (ZPCSHStack)
* clc
.9 rts
*--------------------------------------
CSH.Quit >LDA.G CSH.hSymbols
>SYSCALL SListFree
>LDA.G hFileBuf
jsr .7
>LDA.G CSH.hStack
jsr .7
>LDA.G CSH.hConst
jsr .7
.7 beq CSH.Quit.RTS
>SYSCALL FreeMem
CSH.Quit.RTS rts
*--------------------------------------
CSH.Run jsr CSH.GetCharNB
bcs CSH.Quit.RTS
cmp #'}' End of block ?
bne .1
jsr CSH.CheckStack must be something on stack....
bcs .9
jsr CSH.Pop was expected, get stacked Cmd...
tax
jmp (J.CSH.KW.END,x)
.1 cmp #C.CR
bne .2
jmp CSH.GetNextCharNB Skip CR and exit
.2 pha
jsr CSH.SavePtr Save Ptr, in case of while,for....
pla
jsr CSH.IsLetter
bcc .3
cmp #'#'
beq .80 comments ...
bra .9 error, todo : PREOPS ++ --.....
.3 >LDYA L.CSH.KW
jsr CSH.LookupID
bcs .4 not an internal CSH keyword....
txa
>STA.G CSH.CmdSave
jmp (J.CSH.KW,x)
.4 jsr CSH.GetVarValue
bcs .5
jsr CSH.GetCharNB
bcs .9
cmp #'='
bne .99
jsr CSH.GetNextCharNB Skip =
bcs .99
jsr CSH.ExpEval
bcs .9
jsr CSH.StoreACCToVar
bcs .9
jsr CSH.GetChar
cmp #';'
bne .99
jmp CSH.GetNextCharNB Skip ;
.5 lda #0 no return value type check required
jsr CSH.FnEval X = function index
bcs .9
jmp CSH.GetNextCharNB Skip ;
.99 lda #CSH.E.SYNTAX
sec
.9 rts
.80 jsr CSH.GetNextChar
bcs .9
cmp #C.CR
bne .80
clc
rts
*--------------------------------------
* Built in Keywords
*--------------------------------------
CSH.WHILE
CSH.IF jsr CSH.GetCharNB
bcs .9
cmp #'('
bne .9
jsr CSH.GetNextCharNB
bcs .9
jsr CSH.ExpEval
bcs .99
jsr CSH.GetCharNB
bcs .99
cmp #')'
bne .9
jsr CSH.GetNextCharNB
bcs .99
cmp #'{'
bne .9
jsr CSH.IsACC0
bcc .6 eval returned ACC=0, skip {{....}}
jsr CSH.GetNextCharNB Skip '{'
bcs .99
>LDA.G CSH.CmdSave get back Token ("IF" or "WHILE")
tax
jsr CSH.Keyword.start
bcs .99
lda #'}' Tell '}' is expected at the end of block
jsr CSH.Push
bcs .99
rts
.6 ldx #1 expecting 1 '}' for now....
.7 jsr CSH.GetNextChar
bcs .9
cmp #'{'
bne .71
inx
bra .7
.71 cmp #'}'
bne .7
txa
beq .9
dex
bne .7
jsr CSH.GetNextChar
clc
rts
.9 lda #CSH.E.SYNTAX
sec
.99 rts
CSH.Keyword.Start
jmp (J.CSH.KW.START,x)
*--------------------------------------
CSH.IF.START jmp CSH.Push Push "IF" Token
*--------------------------------------
CSH.WHILE.START pha
>LDA.G CSH.BufPtrSave+1 WHILE : push loop address...
jsr CSH.Push
>LDA.G CSH.BufPtrSave
jsr CSH.Push
pla
jmp CSH.Push Push "WHILE" Token
*--------------------------------------
CSH.IF.END jsr CSH.GetNextChar just skip ending '}'
clc
rts
*--------------------------------------
CSH.WHILE.END jsr CSH.Pop
sta ZPFileBufPtr
jsr CSH.Pop
sta ZPFileBufPtr+1
clc
rts
*--------------------------------------
CSH.ELSE
CSH.DO
CSH.FOR
CSH.SWITCH
CSH.CASE
CSH.BREAK
CSH.CONTINUE
lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
* Built in Types
*--------------------------------------
CSH.SIGNED jsr CSH.GetChar
bcs .9
cmp #C.SPACE
bne .9
jsr CSH.GetNextCharNB
bcs .9
>LDYA L.CSH.STYPES
jsr CSH.LookupID
bcs .9
jmp (J.CSH.STYPES,x)
.9 lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.UNSIGNED jsr CSH.GetChar
bcs .9
cmp #C.SPACE
bne .9
jsr CSH.GetNextCharNB
bcs .9
>LDYA L.CSH.STYPES
jsr CSH.LookupID
bcs .9
jmp (J.CSH.UTYPES,x)
.9 lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.CHAR ldx #CSH.T.CHAR
bra CSH.TYPE
CSH.UCHAR ldx #CSH.T.UCHAR
bra CSH.TYPE
CSH.INT ldx #CSH.T.INT
bra CSH.TYPE
CSH.UINT ldx #CSH.T.UINT
bra CSH.TYPE
CSH.LONG ldx #CSH.T.LONG
bra CSH.TYPE
CSH.ULONG ldx #CSH.T.ULONG
bra CSH.TYPE
CSH.FLOAT ldx #CSH.T.FLOAT
CSH.TYPE stx ZPVarType
jsr CSH.GetChar
bcs .9
cmp #C.SPACE
bne .9
jsr CSH.GetNextCharNB
bcs .9
jsr CSH.IsLetter
bcs .9
txa VAR TYPE
jsr CSH.AddVar add with undefined value...
bcs .99 OOM or DUP
>STYA ZPVarID
jsr CSH.GetCharNB
bcs .9
cmp #';'
beq .8 end of declaration, no value...
cmp #'='
bne .9
jsr CSH.GetNextCharNB
bcs .9
lda ZPVarType
jsr CSH.ExpEval
bcs .99
jsr CSH.StoreACCToVar Update value to this var
jsr CSH.GetChar
bcs .9
cmp #';'
bne .9
.8 jsr CSH.GetNextCharNB Skip ;
clc
rts
.90 lda #CSH.E.DUP
sec
rts
.9 lda #CSH.E.SYNTAX
sec
.99 rts
*--------------------------------------
* Input:
* ZPFileBufPtr, A = Expected type
* Output:
* CS, A = EC
* CC, A, Y,A or x bytes on Stack
*--------------------------------------
CSH.FnEval ldx ZPPtr1
phx
ldx ZPPtr1+1
phx
ldx ZPPtr2
phx
sta ZPPtr2 save Type
>LDYA L.CSH.FN
jsr CSH.LookupFn
phx X = function index
bcs .90
>STYA ZPPtr1 f() definition, starting at returned type
jsr CSH.GetCharNB
bcs .90
cmp #'('
bne .90
jsr CSH.GetNextCharNB skip '('
bcs .90
lda ZPPtr2 Expected type in 0, ignore
beq .1
cmp (ZPPtr1) Get Return value Type
bne .91
.1 inc ZPPtr1 advance to arg list type
bne .2
inc ZPPtr1+1
.2 lda (ZPPtr1) get type of next arg
beq .7 end of list, go check ending ')'
.3 eor #CSH.T.VARIADIC if VARIADIC, don't advance to next arg and assume type = 0
beq .4
lda (ZPPtr1) get type again...
inc ZPPtr1
bne .4
inc ZPPtr1+1
.4 jsr CSH.ExpEval
bcs .9
lda (ZPPtr1) no more arg in fn definition
beq .7
.5 jsr CSH.GetCharNB
bcs .9
cmp #','
bne .90
jsr CSH.GetNextCharNB Skip ,
lda (ZPPtr1)
bne .3 Another ARG....
bra .9
.7 jsr CSH.GetCharNB
bcs .90
cmp #')'
bne .90
jsr CSH.GetNextCharNB Skip )
jsr .9
jmp (J.CSH.EXEC,x)
.90 lda #CSH.E.SYNTAX
.HS 2C BIT ABS
.91 lda #CSH.E.TMISMATCH
sec
.9 plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
plx
.99 rts
*--------------------------------------
* Input:
* ZPFileBufPtr, A = Expected type
* Output:
* CS, A = EC
* CC, A, Y,A or x bytes on Stack
*--------------------------------------
CSH.ExpEval ldx ZPPtr2
phx
ldx ZPPtr2+1 One local : BOP1
phx
sta ZPPtr2 save Type
jsr CSH.ZeroACC
.10 lda #$ff
sta ZPPtr2+1 Reset BOP1
jsr CSH.GetCharNB
bcs .9
.20 jsr CSH.IsLetter Fnc or Var ?
bcs .2
jsr CSH.GetVarValue
bcs .1
bra .11
.1 jsr CSH.FnEval X = function index
bcs .99
bra .11
.2 jsr CSH.IsDigit10 number ?
bcs .3
jsr CSH.GetNumInACC
bcs .9
.11 jsr CSH.GetCharNB
bcs .9
cmp #','
beq .8
cmp #')'
beq .8
cmp #';'
beq .8
jsr CSH.IsOPChar
bcs .9
>LDYA L.CSH.BOPS
jsr CSH.LookupOP
bcs .9
lda ZPPtr2+1 previous OP...
bpl .5 go check precedence
stx ZPPtr2+1
jsr CSH.ACC2ARG
jsr CSH.GetCharNB
bcc .20 go check for an ARG
bra .9
.3 cmp #'"' String literal
bne .9
jsr CSH.AddContCharP
bcs .99
jmp .11
.9 plx
stx ZPPtr2+1
plx
stx ZPPtr2
lda #CSH.E.SYNTAX
sec
.99 rts
.5 cpx ZPPtr2+1
bcs .6
* new OP has precedence, stack ACC
jmp .10
* Old OP has precedence, compute ACC=ARG <BOP> ACC
.6 lda ZPPtr2+1
jsr CSH.Compute
bcs .9
jsr CSH.GetCharNB
bcs .9
jmp .10
.8 lda ZPPtr2+1
bmi .80
jmp CSH.Compute
.80 plx
stx ZPPtr2+1
plx
stx ZPPtr2
clc
rts
*--------------------------------------
CSH.AddContCharP
ldy #0
.1 jsr CSH.GetNextChar
bcs .9
cmp #C.CR
beq .9
cmp #'"'
beq .2
sta (ZPCSHConst),y
iny
bra .1
.2 lda #0
sta (ZPCSHConst),y
phy
lda #CSH.Q.CONST+CSH.Q.POINTER+CSH.T.CHAR
>STA.G CSH.ACCT
>LDYA ZPCSHConst
>STYA.G CSH.ACC
pla
sec
adc ZPCSHConst
sta ZPCSHConst
bcc .3
inc ZPCSHConst+1
.3 jsr CSH.GetNextCharNB Skip "
clc
rts
.9 lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.SavePtr >LDYA ZPFileBufPtr
>STYA.G CSH.BufPtrSave
rts
*--------------------------------------
CSH.RestorePtr >LDYA.G CSH.BufPtrSave
>STYA ZPFileBufPtr
rts
*--------------------------------------
CSH.LookupFN sec
.HS 90 BCC
CSH.LookupID clc
>STYA ZPPtr1
ror
>STA.G CSH.LookupOpt
jsr CSH.GetIDLen
bra CSH.Lookup
CSH.LookupOP >STYA ZPPtr1
>STZ.G CSH.LookupOpt
jsr CSH.GetOPLen
CSH.Lookup phy Y = len
ldx #0
.1 lda (ZPPtr1)
beq .9 Ending 0, not found....
pla
pha Get Back Len
cmp (ZPPtr1) Same Len ?
bne .4
tay
.2 lda (ZPPtr1),y
.3 dey
cmp (ZPFileBufPtr),y
bne .4
tya
bne .2
pla Found keyword...
clc
adc ZPFileBufPtr ..advance Ptr to char after it..
sta ZPFileBufPtr
bcc .31
inc ZPFileBufPtr+1
.31 lda ZPPtr1
sec
adc (ZPPtr1)
tay
lda ZPPtr1+1
adc #0
clc Y,A = F() def, X = F() index
.8 rts
.4 inx
inx
lda (ZPPtr1)
jsr CSH.ZPPtr1AddAp1
>LDA.G CSH.LookupOpt
bpl .1
ldy #$ff
.6 iny
lda (ZPPtr1),y
bne .6
tya
jsr CSH.ZPPtr1AddAp1
bra .1
.9 pla
sec
rts
*--------------------------------------
CSH.ZPPtr1AddAp1
sec
adc ZPPtr1
sta ZPPtr1
bcc .1
inc ZPPtr1+1
.1 rts
*--------------------------------------
CSH.GetNumInACC >LDA.G CSH.ACCT
cmp #CSH.T.FLOAT
bcc .1
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
>SYSCALL StrToF
* bcs .9
>PULLF.G CSH.ACC
clc
rts
.1 >PUSHBI 10
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
>SYSCALL StrToL
bcs .9
>PULLL.G CSH.ACC
clc
.9 rts
*--------------------------------------
CSH.ZeroACC lda #0
ldx #5
ldy #CSH.ACC
.1 sta (pData),y
iny
dex
bne .1
rts
*--------------------------------------
CSH.ACC2ARG >LEA.G CSH.ACCT
>STYA ZPPtr1
>LEA.G CSH.ARGT
>STYA ZPPtr2
ldy #5
.1 lda (ZPPtr1),y
sta (ZPPtr2),y
dey
bpl .1
rts
*--------------------------------------
* Input : ZPFileBufPtr, A = Var Type, Value on Stack
* Output : Y,A = ZPVarID
*--------------------------------------
CSH.AddVar sta ZPVarType
>PUSHW ZPFileBufPtr
>LDA.G CSH.hSymbols
>SYSCALL SListNewKey
bcs .9
>STYA ZPVarID
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+1
.1 ldy #2
lda ZPVarType
>PUSHA Push Var Type On stack...
and #CSH.Q.PPPOINTER
bne .2 Pointer, always 2 bytes
lda ZPVarType
and #$1f
tax
ldy CSH.TSIZE,x
.2 iny +1 for Type
lda #0
>PUSHYA DataLen
>PUSHW pStack
>PUSHW ZPVarID
>LDA.G CSH.hSymbols
>SYSCALL SListAddData
bcs .9
>LDYA ZPVarType
.9 rts
*--------------------------------------
* Input : ZPFileBufPtr, A = Var Type
* Output : Value on Stack
*--------------------------------------
CSH.GetVarValue
sta ZPVarType
>PUSHW ZPFileBufPtr
>LDA.G CSH.hSymbols
>SYSCALL SListLookup
bcs .9
>STYA ZPVarID
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+1
.1
.9 rts
*--------------------------------------
CSH.StoreACCToVar
>LDA.G CSH.ACCT
cmp (ZPCSHValue)
bne .9
tax
lda CSH.TSIZE,x
tax Byte count to transfer
>LEA.G CSH.ACC
>STYA ZPPtr1
ldy #1 do not trash TYPE byte
.1 lda (ZPPtr1)
inc ZPPtr1
bne .2
inc ZPPtr1+1
.2 sta (ZPCSHValue),y
iny
dex
bne .1
clc
rts
.9 lda #CSH.E.TMISMATCH
sec
rts
*--------------------------------------
CSH.IsACC0 >LDA.G CSH.ACCT
cmp #CSH.T.FLOAT
bne .1 char,int,long
>LDA.G CSH.ACC
bne .9
.8 clc
rts
.1 tax
lda CSH.TSIZE,x
tax
lda #0
ldy #CSH.ACC
.2 ora (pData),y
iny
dex
bne .2
tax
beq .8
.9 sec
rts
*--------------------------------------
CSH.Compute tax
jmp (J.CSH.BOPS,x)
*--------------------------------------
CSH.BOPS.ADD
clc
rts
CSH.BOPS.SUB >LDA.G CSH.ACCT
cmp #CSH.T.FLOAT
beq .8
clc
rts
.8 >PUSHF.G CSH.ACC
>PUSHF.G CSH.ARG
>FPU FSUB
bcs .9
>PULLF.G CSH.ACC
.9 rts
CSH.BOPS.MUL
clc
rts
CSH.BOPS.DIV >LDA.G CSH.ACCT
cmp #CSH.T.FLOAT
beq .8
clc
rts
.8 >PUSHF.G CSH.ACC
>PUSHF.G CSH.ARG
>FPU FDIV
>PULLF.G CSH.ACC
clc
rts
CSH.BOPS.MOD
CSH.BOPS.SHL
CSH.BOPS.SHR
CSH.BOPS.L
CSH.BOPS.G
CSH.BOPS.LE
CSH.BOPS.GE
CSH.BOPS.EQ
CSH.BOPS.NE
CSH.BOPS.AND
CSH.BOPS.OR
CSH.BOPS.EOR
CSH.BOPS.LAND
CSH.BOPS.LOR
clc
rts
*--------------------------------------
* Stack
*--------------------------------------
CSH.Push pha
>LDA.G CSH.StackPtr
inc
beq .9
sta (pData),y
dec
tay
pla
sta (ZPCSHStack),y
clc
rts
.9 pla
lda #CSH.E.SOVERFLW
sec
rts
*--------------------------------------
CSH.Pop >LDA.G CSH.StackPtr
beq .9
dec
sta (pData),y
tay
lda (ZPCSHStack),y
clc
rts
.9 lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.CheckStack tax
>LDA.G CSH.StackPtr
beq .9
dec
tay
txa
cmp (ZPCSHStack),y
bne .9
tya
>STA.G CSH.StackPtr
clc
rts
.9 lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
* CHAR related Subs.....
*--------------------------------------
CSH.GetOPLen ldy #0
.1 iny
lda (ZPFileBufPtr),y
beq .8
jsr CSH.IsOPChar
bcc .1
.8 tya
rts
*--------------------------------------
CSH.GetIDLen ldy #0
.1 iny
lda (ZPFileBufPtr),y
beq .8
jsr CSH.IsLetterOrDigit
bcc .1
.8 tya
rts
*--------------------------------------
CSH.GetCharNB jsr CSH.GetChar
bcs CSH.GetNextCharNB.RTS
jsr CSH.CheckCharNB
bcc CSH.GetNextCharNB.RTS
*--------------------------------------
CSH.GetNextCharNB
jsr CSH.GetNextChar
bcs CSH.GetNextCharNB.RTS
jsr CSH.CheckCharNB
bcs CSH.GetNextCharNB
CSH.GetNextCharNB.RTS
rts
*--------------------------------------
CSH.CheckCharNB cmp #C.SPACE
beq .9
cmp #C.CR
beq .9
cmp #C.LF
beq .9
cmp #C.TAB
beq .9
clc
.9 rts
*--------------------------------------
CSH.GetNextChar inc ZPFileBufPtr
bne CSH.GetChar
inc ZPFileBufPtr+1
*--------------------------------------
CSH.GetChar lda (ZPFileBufPtr)
beq .9
clc
rts
.9 lda #MLI.E.EOF
sec
rts
*---------------------------------------
CSH.IsOPChar ldx #CSH.OPChars.Cnt-1
.1 cmp CSH.OPChars,x
beq .8
dex
bpl .1
sec
rts
.8 clc
rts
*---------------------------------------
CSH.IsLetterOrDigit
jsr CSH.IsDigit10
bcc CSH.IsLetterRTS
*---------------------------------------
CSH.IsLetter cmp #'_'
bne .1
clc
rts
.1 cmp #'A'
bcc .9
cmp #'Z'+1
bcc CSH.IsLetterRTS
cmp #'a'
bcc .9
cmp #'z'+1
rts CC if lowercase
.9 sec
CSH.IsLetterRTS rts
*---------------------------------------
CSH.IsDigit10 cmp #'0'
bcc .9
cmp #'9'+1
rts cc if ok, cs if not
.9 sec
rts
*--------------------------------------
* EXEC
*--------------------------------------
EXEC.printf >LDYA.G CSH.ACC
>SYSCALL printf
bcs .9
>STYA.G CSH.ACC
.9 rts
*--------------------------------------
EXEC.puts >LDYA.G CSH.ACC
>SYSCALL puts
bcs .9
>STYA.G CSH.ACC
.9 rts
*--------------------------------------
EXEC.cos >FPU COS
>PULLF.G CSH.ACC
rts
*--------------------------------------
EXEC.getchar >SYSCALL getchar
>STA.G CSH.ACC
rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM
Reference in New Issue View Git Blame Copy Permalink