Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
A2osX/BIN/CSH.S.CORE.txt

1177 lines
19 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
PREFIX
AUTO 4,1
.LIST OFF
*--------------------------------------
CSH.Q.CONST .EQ %10000000
CSH.Q.POINTER .EQ %10000001
CSH.T.CHAR .EQ 1
CSH.T.INT .EQ 2
CSH.T.LONG .EQ 3
CSH.T.UCHAR .EQ 4
CSH.T.UINT .EQ 5
CSH.T.ULONG .EQ 6
CSH.T.FLOAT .EQ 7
CSH.T.VARIADIC .EQ $F
*--------------------------------------
CSH.Init >LDYAI 256
>SYSCALL GetMem0
bcs .9
>STYA ZPCSHSymbols
txa
>STA.G CSH.hSymbols
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPCSHConst
txa
>STA.G CSH.hConst
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPCSHData
txa
>STA.G CSH.hData
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPCSHStack
txa
>STA.G CSH.hStack
lda #$0
>STA.G CSH.SymbolsPtr
>STA.G CSH.ConstPtr
>STA.G CSH.DataPtr
>STA.G CSH.StackPtr
sta (ZPCSHSymbols)
sta (ZPCSHConst)
sta (ZPCSHData)
sta (ZPCSHStack)
* clc
.9 rts
*--------------------------------------
CSH.Quit >LDA.G hFileBuf
beq .1
>SYSCALL FreeMem
.1 >LDA.G CSH.hStack
beq .2
>SYSCALL FreeMem
.2 >LDA.G CSH.hData
beq .3
>SYSCALL FreeMem
.3 >LDA.G CSH.hSymbols
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 #$0D
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.StoreACCToVar
bcs .9
jsr CSH.GetChar
cmp #';'
bne .99
jmp CSH.GetNextCharNB Skip ;
.5 >LDYA L.CSH.FN
jsr CSH.LookupFn
bcs .99
>STZ.G CSH.ACCT no retrun value type check required
jsr CSH.FnEval
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
*--------------------------------------
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
*--------------------------------------
CSH.SIGNED jsr CSH.GetChar
bcs .9
cmp #' '
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 #' '
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 lda #CSH.T.CHAR
bra CSH.TYPE
CSH.UCHAR lda #CSH.T.UCHAR
bra CSH.TYPE
CSH.INT lda #CSH.T.INT
bra CSH.TYPE
CSH.UINT lda #CSH.T.UINT
bra CSH.TYPE
CSH.LONG lda #CSH.T.LONG
bra CSH.TYPE
CSH.ULONG lda #CSH.T.ULONG
bra CSH.TYPE
CSH.FLOAT lda #CSH.T.FLOAT
CSH.TYPE >STA.G CSH.ACCT
jsr CSH.GetChar
bcs .9
cmp #' '
bne .9
jsr CSH.GetNextCharNB
bcs .9
jsr CSH.IsLetter
bcs .9
jsr CSH.GetVar Already exists ?
bcc .90
jsr CSH.AddVar No, add with undefined value...
bcs .99
jsr CSH.GetCharNB
bcs .9
cmp #';'
beq .8 end of declaration, no value...
cmp #'='
bne .9
jsr CSH.GetNextCharNB
bcs .9
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
*--------------------------------------
CSH.ExpEval jsr CSH.ZeroACC
.10 lda #$ff
>STA.G CSH.EXPBOP1 Reset BOP1
jsr CSH.GetCharNB
bcs .9
jsr CSH.IsLetter Fnc or Var ?
bcs .2
jsr CSH.GetVar
bcs .1
jsr CSH.LoadACCFromVar
bcs .9
bra .11
.1 >LDYA L.CSH.FN
jsr CSH.LookupFn
bcs .9
jsr CSH.FnEval
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
jsr CSH.IsOPChar
bcs .9
>LDYA L.CSH.BOPS
jsr CSH.LookupOP
bcs .9
>LDA.G CSH.EXPBOP1 previous OP...
bpl .5 go check precedence
txa
>STA.G CSH.EXPBOP1
jsr CSH.ACC2ARG
jsr CSH.GetCharNB
bcc .10 go check for an ARG
bra .9
.3 >DEBUG
cmp #'"' String litteral
bne .9
jsr CSH.AddContCharP
bcs .99
jmp .11
.9 lda #CSH.E.SYNTAX
sec
.99 rts
.5 txa
>STA.G CSH.EXPBOP2
>CMP.G CSH.EXPBOP1
bcs .6
* new OP has precedence, stack ACC
jmp .10
* Old OP has precedence, compute ACC=ARG <BOP> ACC
.6 >LDA.G CSH.EXPBOP1
jsr CSH.Compute
bcs .9
jsr CSH.GetCharNB
bcs .9
jmp .10
.8 >LDA.G CSH.EXPBOP1
bmi .80
jmp CSH.Compute
.80 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
lda ZPCSHConst
pha
lda ZPCSHConst+1
pha
tya
sec
adc ZPCSHConst
sta ZPCSHConst
bcc .3
inc ZPCSHConst+1
.3 pla
ply
clc
rts
.9 lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.FnEval jsr CSH.GetCharNB
bcs .9
cmp #'('
bne .9
>LDA.G CSH.ACCT Match with ACC ?
beq .10 ACC is VOID
cmp (ZPFnDefPtr) Get Return value Type
bne .99
.10 jsr CSH.GetNextCharNB skip '('
bcs .9
jsr CSH.PushACCT Save Acc & T on stack
.1 inc ZPFnDefPtr advance to arg list type
bne .2
inc ZPFnDefPtr+1
.2 lda (ZPFnDefPtr)
beq .7 end of list, go check no more
.20 jsr CSH.ExpEval
bcs .90
lda (ZPFnDefPtr)
cmp #CSH.T.VARIADIC
bne .3
bra *
.3 >CMP.G CSH.ACCT Match with ACC ?
bne .99
inc ZPFnDefPtr advance to next arg
bne .4
inc ZPFnDefPtr+1
.4 lda (ZPFnDefPtr) no more arg in fn definition
beq .7
jsr CSH.GetNextCharNB
bcs .9
cmp #','
bne .9
jsr CSH.GetNextCharNB
bra .20
.7 jsr CSH.GetCharNB
bcs .9
cmp #')'
bne .9
jsr CSH.GetNextCharNB Skip )
* TO DO : Execute
clc
rts
.9 lda #CSH.E.SYNTAX
sec
.90 rts
.99 lda #CSH.E.TMISMATCH
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)
sta ZPFnDefPtr
lda ZPPtr1+1
adc #0
inc ZPFnDefPtr+1
clc
.8 rts
.4 inx
inx
lda ZPPtr1
sec
adc (ZPPtr1)
sta ZPPtr1
bcc .5
inc ZPPtr1+1
.5 >LDA.G CSH.LookupOpt
bpl .1
ldy #$ff
.6 iny
lda (ZPPtr1),y
bne .6
tya
sec
adc ZPPtr1
sta ZPPtr1
bcc .1
inc ZPPtr1+1
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
*--------------------------------------
* Vars...
*--------------------------------------
CSH.AddVar jsr CSH.GetIDLen
sec
>ADC.G CSH.SymbolsPtr Enough room to store this symbol ?
bcs .99
adc #1 Add One Byte for storing Ptr to DATA
bcs .99 Out of Symbols space
>LDA.G CSH.DataPtr
pha
>LDA.G CSH.ACCT
tax
sec +1 for Type
adc CSH.TSIZE,x
bcs .98 Out of Data Space
>LDA.G CSH.SymbolsPtr
pha
jsr CSH.GetIDLen
ply
sta (ZPCSHSymbols),y
iny
jsr CSH.GetChar
.1 sta (ZPCSHSymbols),y Store this symbol....
iny
jsr CSH.GetNextChar
jsr CSH.IsLetterOrDigit
bcc .1
pla Get Back Data Ptr
pha
sta (ZPCSHSymbols),y
iny
tya
>STA.G CSH.SymbolsPtr Mark new end of Symbols
pla Get again Data Ptr
clc
adc ZPCSHData
sta ZPCSHValue
lda #0
adc ZPCSHData+1
sta ZPCSHValue+1
>LDA.G CSH.ACCT
sta (ZPCSHValue)
* clc
rts
.98 pla
.99 lda #CSH.E.OOM
sec
rts
*--------------------------------------
CSH.GetVar >LDYA ZPCSHSymbols
>STYA ZPPtr1
jsr CSH.GetIDLen
tax Save len
.1 lda (ZPPtr1)
beq .9
txa Get back len
cmp (ZPPtr1)
bne .3
tay
.2 lda (ZPPtr1),y
dey
cmp (ZPFileBufPtr),y
bne .3
tya
bne .2
lda (ZPPtr1)
inc
tay
lda (ZPPtr1),y Get Ptr to DATA
clc
adc ZPCSHData
sta ZPCSHValue
lda #0
adc ZPCSHData+1
sta ZPCSHValue+1
txa Get back len
clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .8
inc ZPFileBufPtr+1
clc
.8 rts
.3 lda (ZPPtr1)
sec
adc ZPPtr1
sta ZPPtr1
bcc .4
inc ZPPtr1+1
.4 inc ZPPtr1 Skip Pointer to TYPE/DATA
bne .1
inc ZPPtr1+1
bra .1
.9 sec
rts
*--------------------------------------
CSH.LoadACCFromVar
>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
.1 lda (ZPCSHValue),y
sta (ZPPtr1)
inc ZPPtr1
bne .2
inc ZPPtr1+1
.2 iny
dex
bne .1
clc
rts
.9 lda #CSH.E.TMISMATCH
sec
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
>SYSCALL 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 >PUSHEA.G CSH.ACC
>PUSHEA.G CSH.ARG
>LEA.G CSH.ACC
>SYSCALL FDIV
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.PushACCT
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
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM
Reference in New Issue View Git Blame Copy Permalink