Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-06-25 18:29:36 +00:00
Code Issues Projects Releases Wiki Activity
3bee887a66
A2osX/BIN/CSH.S.CORE.txt
Rémy GIBERT 3bee887a66 Kernel 0.93+
2019-09-02 08:09:28 +02:00

1185 lines
20 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
CSH.Run.1 cmp #'#'
bne .3 comments ...
.1 jsr CSH.GetNextChar
bcs .2
cmp #C.CR
bne .1
.2 jmp CSH.GetNextChar Skip CR and exit
.3 cmp #C.CR
beq .2
cmp #'}' End of block ?
bne .4
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)
.4 pha
jsr CSH.SavePtr Save Ptr, in case of while,for....
pla
jsr CSH.IsLetter
bcc .5
bra .99 error, todo : PREOPS ++ --.....
.5 >LDYA L.CSH.KW
jsr CSH.LookupID
bcs .6 not an internal CSH keyword....
jsr CSH.KW.JMP
bcs .9
bra .8
.6 jsr CSH.GetVar
bcs .7
jsr CSH.GetCharNB
bcs .9
cmp #'='
bne .99
jsr CSH.GetNextChar Skip =
bcs .99
lda #0 Any Type
jsr CSH.ExpEval
bcs .9
txa X = Exp Type
jsr CSH.SetVarValue
bcs .9
jsr CSH.GetChar
cmp #';'
bne .99
bra .8
.7 lda #0 no return value type check required
jsr CSH.fCall
bcs .9
.8 jsr CSH.GetNextCharNB Skip ;
bcs .9
cmp #C.CR
bne CSH.Run.1
jmp CSH.GetNextChar Skip CR
.99 lda #CSH.E.SYNTAX
sec
.9 rts
*--------------------------------------
* Built in Keywords
*--------------------------------------
CSH.KW.JMP txa
>STA.G CSH.CmdSave
jmp (J.CSH.KW,x)
CSH.WHILE
CSH.IF jsr CSH.GetCharNB
bcs .9
cmp #'('
bne .9
jsr CSH.GetNextCharNB
bcs .9
lda #0 Any var type
jsr CSH.ExpEval
bcs .99
jsr CSH.GetCharNB
bcs .99
cmp #')'
bne .9
jsr CSH.GetNextCharNB
bcs .99
cmp #'{'
bne .9
jsr CSH.IsValue0 X = var type from ExpEval
bcc .6 Value=0, skip {{....}}
jsr CSH.GetNextCharNB Skip '{'
bcs .99
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.GetNextCharNB
bcs .9
cmp #'{'
bne .71
inx
bra .7
.71 cmp #'}'
bne .7
txa
beq .9
dex
bne .7
jsr CSH.GetNextCharNB skip '}'
clc
rts
.9 lda #CSH.E.SYNTAX
sec
.99 rts
*--------------------------------------
CSH.Keyword.Start
>LDA.G CSH.CmdSave get back Token ("IF" or "WHILE")
tax
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 Skip =
bcs .9
lda ZPVarType
jsr CSH.ExpEval
bcs .99
txa
jsr CSH.SetVarValue Update value to this var
bcs .99
jsr CSH.GetChar
bcs .9
cmp #';'
bne .9
.8 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, Result on Stack, X = Type
*--------------------------------------
CSH.fCall ldx ZPPtr1
phx
ldx ZPPtr1+1
phx
ldx ZPPtr2 local : type
phx
ldx ZPPtr2+1 local : variadic size
phx
sta ZPPtr2 save Type
stz ZPPtr2+1 Reset VARIADIC byte count
>LDYA L.CSH.FN
jsr CSH.LookupFn
phx X = function index
bcs .10
>STYA ZPPtr1 f() definition, starting at returned type
jsr CSH.GetCharNB
bcs .10
cmp #'('
bne .90
jsr CSH.GetNextCharNB skip '('
.10 bcs .90
lda ZPPtr2
bne .11
lda (ZPPtr1)
sta ZPPtr2
bra .1 expected type is 0, no check
.11 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 first 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
eor #CSH.T.VARIADIC restore type...
.4 jsr CSH.ExpEval A=0 if VARIADIC
bcs .9 X = Var Type
lda (ZPPtr1) get current arg type
eor #CSH.T.VARIADIC
bne .5
jsr CSH.SIZEOF X = Var Type
* clc
adc ZPPtr2+1
sta ZPPtr2+1 Add to byte count
bra .51
.5 inc ZPPtr1
bne .51
inc ZPPtr1+1
.51 jsr CSH.GetCharNB
bcs .90
cmp #','
bne .6
jsr CSH.GetNextCharNB Skip ,
lda (ZPPtr1)
bne .3 Another ARG....
bra .90 extra args....error
.6 cmp #')'
bne .90
lda (ZPPtr1)
beq .8 no more arg after ')', exit
eor #CSH.T.VARIADIC
bne .90 missing arg
>PUSHB ZPPtr2+1 push VARIADIC byte count
bra .8
.7 jsr CSH.GetCharNB
bcs .90
cmp #')'
bne .90
.8 jsr CSH.GetNextCharNB Skip )
plx restore X = function index
pla
sta ZPPtr2+1
pla
sta ZPPtr2
pla
sta ZPPtr1+1
pla
sta ZPPtr1
jmp (J.CSH.EXEC,x)
.90 lda #CSH.E.SYNTAX
.HS 2C BIT ABS
.91 lda #CSH.E.TMISMATCH
sec
.9 plx Discard function index
plx
stx ZPPtr2+1
plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
.99 rts
*--------------------------------------
* Input:
* ZPFileBufPtr, A = Expected type
* Output:
* CS, A = EC
* CC, X = Var Type, Value on Stack
*--------------------------------------
CSH.ExpEval ldx ZPPtr1
phx
ldx ZPPtr1+1
phx
ldx ZPPtr2 local : VarType
phx
ldx ZPPtr2+1 local : BOP1
phx
sta ZPPtr2
.10 lda #$ff
sta ZPPtr2+1 Reset BOP1
jsr CSH.GetCharNB
bcs .33
.20 jsr CSH.IsLetter Fnc or Var ?
bcs .2
jsr CSH.GetVar
bcs .1
ldx ZPPtr2 var type (could be 0=any)
jsr CSH.GetVarValue Get value on stack
bcs .99
stx ZPPtr2 store real var type
bra .11
.1 lda ZPPtr2 var type
jsr CSH.fCall X = function index
bcs .99
stx ZPPtr2 store real var type
bra .11
.2 jsr CSH.IsDigit10 number ?
bcs .3
jsr CSH.GetNumOnStack
bcs .99
.11 jsr CSH.GetCharNB
bcs .90
cmp #','
beq .8
cmp #')'
beq .8
cmp #';'
beq .8
jsr CSH.IsOPChar
.33 bcs .90
>LDYA L.CSH.BOPS
jsr CSH.LookupOP
bcs .90
lda ZPPtr2+1 previous OP...
bpl .5 go check precedence
stx ZPPtr2+1
jsr CSH.PushValueOnStack
jsr CSH.GetCharNB
bcc .20 go check for an ARG
bra .90
.3 cmp #'"' String literal
bne .90
jsr CSH.AddContCharP
bcs .99
jmp .11
.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 .99
jsr CSH.GetCharNB
bcs .90
jmp .10
.8 lda ZPPtr2+1
bmi .80
jsr CSH.Compute
bcc .80
bcs .99
.90 lda #CSH.E.SYNTAX
.99 sec
.HS 90 BCC
.80 clc
ldx ZPPtr2 X = Var Type
pla
sta ZPPtr2+1
pla
sta ZPPtr2
pla
sta ZPPtr1+1
pla
sta ZPPtr1
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
>PUSHW ZPCSHConst Push PTR on stack
tya
sec
adc ZPCSHConst
sta ZPCSHConst
bcc .3
inc ZPCSHConst+1
.3 jsr CSH.GetNextChar 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.GetNumOnStack
lda ZPVarType
cmp #CSH.T.FLOAT
bcc .1
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
>SYSCALL StrToF
clc
rts
.1 >PUSHBI 10
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
>SYSCALL StrToL
.9 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
sta ZPVarData
and #CSH.Q.PPPOINTER
bne .2 Pointer, always 2 bytes
lda ZPVarType
and #$1f
tax
ldy CSH.TYPESIZE,x
.2 iny +1 for Type
lda #0
>PUSHYA DataLen
>PUSHWI ZPVarData
>PUSHW ZPVarID
>LDA.G CSH.hSymbols
>SYSCALL SListAddData
bcs .9
>LDYA ZPVarID
.9 rts
*--------------------------------------
CSH.GetVar >PUSHW ZPFileBufPtr
>LDA.G CSH.hSymbols
>SYSCALL SListLookup
bcs .9
>STYA ZPVarID
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+1
clc
.1
.9
CSH.GetVar.RTS rts
*--------------------------------------
* Input : ZPFileBufPtr, X = Var Type (or 0)
* Output : Value on Stack, X = Var Type
*--------------------------------------
CSH.GetVarValue stx ZPVarType
.1 >PUSHWI 0
>PUSHWI 6
>PUSHWI ZPVarData
>PUSHW ZPVarID
>LDA.G CSH.hSymbols
>SYSCALL SListGetData
bcs CSH.GetVar.RTS
CSH.PushValueOnStack
ldx ZPVarType
beq .1
cpx ZPVarData
bne .99
.1 ldx ZPVarData
ldy CSH.TYPESIZE,x
.2 lda ZPVarData,y
>PUSHA
dey
bne .2
clc X = Var Type
rts
.99 lda #CSH.E.TMISMATCH
sec
.9 rts
*--------------------------------------
CSH.SetVarValue cmp ZPVarType
bne .9
sta ZPVarData
tax
ldy CSH.TYPESIZE,x Byte count to transfer
ldx #1
.1 >PULLA
sta ZPVarData,x
inx
dey
bne .1
>PUSHBI 0
ldx ZPVarType
lda CSH.TYPESIZE,x
inc +1 including TYPE
>PUSHA
>PUSHWI ZPVarData
>PUSHW ZPVarID
>LDA.G CSH.hSymbols
>SYSCALL SListSetData
rts
.9 lda #CSH.E.TMISMATCH
sec
rts
*--------------------------------------
* Input : Value on Stack, X = Var Type
* Output : CC = true, CS = false
*--------------------------------------
CSH.IsValue0 cpx #CSH.T.FLOAT
bcc .1 char,int,long
ldy CSH.TYPESIZE,x
lda ZPVarData,y
bne .9
.8 clc
rts
.1 tax
lda CSH.TYPESIZE,x
tax
lda #0
ldy #1
.2 ora ZPVarData,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 ZPVarType
cmp #CSH.T.FLOAT
beq .8
clc
rts
.8 >FPU FSUB
bcs .9
.9 rts
CSH.BOPS.MUL
clc
rts
CSH.BOPS.DIV lda ZPVarType
cmp #CSH.T.FLOAT
beq .8
clc
rts
.8
>FPU FDIV
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.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
*--------------------------------------
CSH.SIZEOF txa
and #CSH.Q.PPPOINTER
bne .2
txa
and #$f
tay
lda CSH.TYPESIZE,y
rts
.2 lda #2
rts
*--------------------------------------
* EXEC
*--------------------------------------
CSH.EXEC jmp (J.CSH.EXEC,x)
*--------------------------------------
EXEC.printf >DEBUG
>SYSCALL printf2
rts
*--------------------------------------
EXEC.puts >PULLYA
>SYSCALL puts
rts
*--------------------------------------
EXEC.cos >FPU COS
rts
*--------------------------------------
EXEC.getchar >SYSCALL getchar
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