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
9269809d3e
A2osX/BIN/CSH.S.CORE.txt
Rémy GIBERT 9269809d3e Kernel 0.93+
2019-08-26 17:27:28 +02:00

1117 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.GetVar
bcs .5
jsr CSH.GetCharNB
bcs .9
cmp #'='
bne .99
jsr CSH.GetNextCharNB Skip =
bcs .99
jsr CSH.ExpEval
bcs .9
jsr CSH.SetVarValue
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.IsValue0
bcc .6 Value=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.SetVarValue 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
.10 lda #$ff
sta ZPPtr2+1 Reset BOP1
jsr CSH.GetCharNB
bcs .9
.20 jsr CSH.IsLetter Fnc or Var ?
bcs .2
jsr CSH.GetVar
bcs .1
jsr CSH.GetVarValue Get value on stack
bra .11
.1 jsr CSH.FnEval X = function index
bcs .99
bra .11
.2 jsr CSH.IsDigit10 number ?
bcs .3
jsr CSH.GetNumOnStack
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.PushValueOnStack
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 ZPVarType
>LDYA ZPCSHConst
>STYA ZPVarData
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.GetNumOnStack
lda ZPVarType
cmp #CSH.T.FLOAT
bcc .1
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
>SYSCALL StrToF
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
>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
*--------------------------------------
CSH.GetVar 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 ldx ZPVarType
cpx ZPVarData
bne .99
clc
rts
.99 lda #CSH.E.TMISMATCH
sec
.9
CSH.GetVar.RTS rts
*--------------------------------------
* Input : ZPFileBufPtr, A = Var Type
* Output : Value on Stack
*--------------------------------------
CSH.GetVarValue sta ZPVarType
.1 >PUSHWI 0
>PUSHWI 6
>PUSHWI ZPVarData
>PUSHWI ZPVarID
>LDA.G CSH.hSymbols
>SYSCALL SListGetData
bcs CSH.GetVar.RTS
CSH.PushValueOnStack
ldx ZPVarType
cpx ZPVarData
bne .99
ldy CSH.TSIZE,x
.2 lda ZPVarData,y
>PUSHA
dey
bne .2
clc
rts
.99 lda #CSH.E.TMISMATCH
sec
.9 rts
*--------------------------------------
CSH.SetVarValue cmp ZPVarType
bne .9
tax
ldy CSH.TSIZE,x Byte count to transfer
ldx #1
.1 >PULLA
sta ZPVarData,x
inx
dey
bne .1
clc
rts
.9 lda #CSH.E.TMISMATCH
sec
rts
*--------------------------------------
CSH.IsValue0 ldx ZPVarType
cpx #CSH.T.FLOAT
bne .1 char,int,long
ldy CSH.TSIZE,x
lda ZPVarData,y
bne .9
.8 clc
rts
.1 tax
lda CSH.TSIZE,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.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 >PULLYA
>SYSCALL printf
bcs .9
.9 rts
*--------------------------------------
EXEC.puts >PULLYA
>SYSCALL puts
bcs .9
.9 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