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
3efa6a91d2
A2osX/BIN/CSH.S.CORE.txt
burniouf 3d241a05d8 KERNEL:changes for most compilers
2022-11-02 07:54:30 +01:00

1192 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 lda #SL._
>SYSCALL SListNew
bcs .99
>STA.G CSH.hDefines
lda #SL._
>SYSCALL SListNew
bcs .99
>STA.G CSH.hTags
lda #SL._
>SYSCALL SListNew
bcs .9
>STA.G CSH.hSymbols
>LDYAI 256
>SYSCALL GetMem
.99 bcs .9
>STYA ZPCSHCode
txa
>STA.G CSH.hCode
>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
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPCSHfDecl
txa
>STA.G CSH.hfDecl
lda #0
>STA.G CSH.ConstPtr
>STA.G CSH.StackPtr
* clc
.9 rts
*--------------------------------------
CSH.Quit >LDA.G CSH.hSymbols
beq .1
>SYSCALL SListFree
.1 >LDA.G CSH.hTags
beq .2
>SYSCALL SListFree
.2 >LDA.G CSH.hDefines
beq .3
>SYSCALL SListFree
.3 lda hInclude
beq .4
>SYSCALL FClose
.4 lda hDefine
jsr .7
>LDA.G hFileBuf
jsr .7
>LDA.G CSH.hfDecl
jsr .7
>LDA.G CSH.hStack
jsr .7
>LDA.G CSH.hData
jsr .7
>LDA.G CSH.hConst
jsr .7
>LDA.G CSH.hCode
.7 beq CSH.Quit.RTS
>SYSCALL FreeMem
CSH.Quit.RTS rts
*--------------------------------------
CSH.Run jsr CSH.GetCharNB
bcs CSH.Quit.RTS
CSH.Run.1 cmp #C.CR empty line....
beq .2
cmp #'/'
bne .3 comments ...
jmp CSH.COMMENTS
.2 jmp CSH.GetNextChar Skip CR and exit
.3 cmp #'#' directive ?
bne .4
jmp CSH.DIR
.4 cmp #'}' End of block ?
bne .10
jsr CSH.CheckStack must be something on stack....
bcs CSH.Quit.RTS
jsr CSH.GetNextCharNB Skip '}'
jsr CSH.Pop was expected....
jsr CSH.Pop get stacked Cmd...
tax
jmp (J.CSH.KW.END,x)
*--------------------------------------
.10 jsr CSH.IsLetter
bcc .20
* TODO: PREOPS ++ --.....
bcs .29
*--------------------------------------
.20 >LDYA L.CSH.TMODS
jsr CSH.LookupID
bcs .50
jsr CSH.tDecl
bcs .59
>STYA ZPVarType Type/Qual
jsr CSH.AddSymbol add with undef value...
bcs .29 OOM or DUP
lda ZPVarQual
bit #CSH.Q.FUNC
bne .21
jsr CSH.GetCharNB
bcs .99
cmp #';'
beq .69
cmp #'='
bne .99
jsr CSH.GetNextCharNB skip '='
bcs .99
>LDYA ZPVarType T/Q
jsr CSH.ExpEval
bcs .9
jsr CSH.SetVarValue Y,A Type/qual, Set value to this var
.29 bcs .9
bra .68
.21 jsr CSH.fDecl
bcs .9
bra .68
*--------------------------------------
.50 jsr CSH.SavePtr Save Ptr, in case of while,for....
>LDYA L.CSH.KW
jsr CSH.LookupID
bcs .6 not an internal CSH keyword....
jsr CSH.KW.JMP
.59 bcs .9
bra .8
*--------------------------------------
.6 jsr CSH.GetVar I = ?
bcs .7
>STYA ZPVarID
jsr CSH.GetVarDef Get Type & ptr...
bcs .9
lda ZPVarQual
bit #CSH.Q.FUNC
beq .60
ldy #0 func( ?
lda #0
jsr CSH.fExec
bcs .9
bra .8
*--------------------------------------
.60 jsr CSH.GetCharNB
bcs .9
cmp #'=' TODO: all AOPS
bne .99
jsr CSH.GetNextChar Skip =
bcs .99
>LDYA ZPVarType T/Q
jsr CSH.ExpEval
bcs .9
jsr CSH.SetVarValue
bcs .9
.68 jsr CSH.GetCharNB
cmp #';'
.69 beq .8
.99 lda #E.CSYN
sec
.9 rts
*--------------------------------------
.7 ldy #0 no return value type check required
lda #0
jsr CSH.fCall Y,A = Type/Qual
bcs .9
jsr CSH.GetVarSize Y,A = returned value type
clc A = Sizeof, CC to ignore Pointer hMem
adc pStack
sta pStack Discard value on stack
.8 jsr CSH.GetNextCharNB Skip ;
bcs .9
cmp #C.CR
beq .80
jmp CSH.Run.1
.80 jmp CSH.GetNextChar Skip CR
*--------------------------------------
CSH.COMMENTS jsr CSH.GetNextChar
cmp #'/'
bne .90
jmp CSH.SkipLine skip line.....
.90 lda #E.CSYN
sec
rts
*--------------------------------------
CSH.SkipLine jsr CSH.GetNextChar
bcs .9
cmp #C.CR
bne CSH.SkipLine
jmp CSH.GetNextChar Skip CR
.9 rts
*--------------------------------------
CSH.SavePtr >LDYA ZPInputBufPtr
>STYA.G CSH.BufPtrSave
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 (ZPInputBufPtr),y
bne .4
tya
bne .2
pla Found keyword...
clc
adc ZPInputBufPtr ..advance Ptr to char after it..
sta ZPInputBufPtr
bcc .31
inc ZPInputBufPtr+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 #$0 Start at Y=2 for VOID func()
.6 iny
iny
lda (ZPPtr1),y
bne .6
tya
jsr CSH.ZPPtr1AddAp1
bra .1
.9 pla
sec
rts
*--------------------------------------
CSH.MainExec lda #0
>PUSHA
ldy #S.PS.ARGC
lda (pPS),y
>PUSHA push int ARGC
>PUSHW ZPCSHConst push int ARGV
stz ArgIndex
.1 lda ArgIndex
>SYSCALL ArgV
bcs .2
inc ArgIndex
pha
tya
sta (ZPCSHConst)
pla
ldy #1
sta (ZPCSHConst),y
lda ZPCSHConst
* clc
adc #2
sta ZPCSHConst
bcc .1
inc ZPCSHConst+1
bra .1
.2
*--------------------------------------
CSH.ZPPtr1GetNextW
jsr CSH.ZPPtr1NextW
*--------------------------------------
CSH.ZPPtr1GetW lda (ZPPtr1)
beq .8
pha
ldy #1
lda (ZPPtr1),y
ply
.8 rts
*--------------------------------------
CSH.ZPPtr1NextW jsr .1
.1 inc ZPPtr1
bne .8
inc ZPPtr1+1
.8 rts
*--------------------------------------
CSH.ZPPtr1AddAp1
sec
adc ZPPtr1
sta ZPPtr1
bcc .1
inc ZPPtr1+1
.1 rts
*--------------------------------------
* Input : ZPInputBufPtr
* Output : Y,A = VarID
*--------------------------------------
CSH.AddSymbol >LDA.G CSH.hSymbols
jsr CSH.NewKey
bcs .9
>STYA ZPVarID
>LDYA ZPVarType
jsr CSH.GetVarSize CS if pointer
sta ZPVarSizeOf
* clc / sec
lda ZPCSHData
sta ZPVarDataPtr
adc ZPVarSizeOf
sta ZPCSHData
lda ZPCSHData+1
sta ZPVarDataPtr+1
adc ZPVarSizeOf+1
sta ZPCSHData+1
>LDA.G CSH.DataPtr
clc
adc ZPVarSizeOf
sta (pData),y
bcs .99
jsr CSH.GetCharNB
bcs .8
cmp #'('
beq .7
lda ZPVarQual
and #CSH.Q.FUNC
beq .8
lda #E.CSYN
sec
rts
.7 lda #CSH.Q.FUNC
tsb ZPVarQual
lda ZPCSHfDecl
sta ZPVarDefPtr
lda ZPCSHfDecl+1
sta ZPVarDefPtr+1
.8 >PUSHB.G CSH.hSymbols
>PUSHW ZPVarID
>PUSHWI ZPVarDef
>PUSHWI 8
>SYSCALL SListAddData
.9 rts
.99 lda #E.OOM
* sec
rts
*--------------------------------------
* ZPVarDataPtr = fDef
*--------------------------------------
CSH.fExec ldx ZPPtr1
phx
ldx ZPPtr1+1 local : fdef Ptr
phx
ldx ZPPtr2 local : type
phx
ldx ZPPtr2+1 local : qual
phx
ldx ZPPtr3 local : variadic size
phx
ldx ZPPtr3+1 local : f
phx
>STYA ZPPtr2 save Type/qual
>LDYA ZPVarDefPtr
>STYA ZPPtr1
stz ZPPtr3 Reset VARIADIC byte count
jsr CSH.GetNextCharNB skip '('
bcs .10
jsr CSH.ZPPtr1GetW Y,A = Return value Type/Qual
ldx ZPPtr2
beq .1 no check required
cpy ZPPtr2
bne .91
cmp ZPPtr2+1
bne .91
.1 eor #CSH.Q.FUNC
>STYA ZPPtr2 this will be the returned type/qual
jsr CSH.ZPPtr1GetNextW advance to arg list type
beq .7 end of list, go check ending ')'
*--------------------------------------
.3 cpy #CSH.T.VARIADIC if VARIADIC, don't advance to next arg and assume type = 0
bne .4
ldy #0
lda #0
.4 jsr CSH.ExpEval Y,A = 0 if VARIADIC
bcs .93
jsr CSH.GetVarSize Y,A = Var Type/Qual
tax
lda (ZPPtr1)
eor #CSH.T.VARIADIC
bne .5
txa
clc make sure pointer only 2 bytes
adc ZPPtr3
sta ZPPtr3 Add to byte count
bra .51 stay on VARIADIC tag
.5 jsr CSH.ZPPtr1NextW
.51 jsr CSH.GetCharNB
.10 bcs .90
cmp #','
bne .6
jsr CSH.GetNextCharNB Skip ','
jsr CSH.ZPPtr1GetW
bne .3 Another ARG....
.52 bra .90 extra args....error
.6 cmp #')'
bne .90
jsr CSH.ZPPtr1GetW
beq .8 no more arg after ')', exit
cpy #CSH.T.VARIADIC
bne .90 missing arg
>PUSHB ZPPtr3 push VARIADIC byte count
.7 jsr CSH.GetCharNB
bcs .90
cmp #')'
bne .90
.8 jsr CSH.GetNextCharNB Skip )
* ldx ZPPtr3+1
* jsr CSH.Exec
* bcs .93
>LDYA ZPPtr2 type/qual
bra .93
.90 lda #E.CSYN
bra .92
.91 lda #E.TMISMATCH
.92 sec
.93 plx
stx ZPPtr3+1
plx
stx ZPPtr3
plx
stx ZPPtr2+1
plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
.99 rts
*--------------------------------------
CSH.fDecl >ENTER 2
lda #0
sta (pStack) hLocal
lda ZPVarType
jsr CSH.fDeclAddA
lda ZPVarQual
jsr CSH.fDeclAddA
jsr CSH.GetNextCharNB Skip (
bcs .9
.1 cmp #')'
beq .6
.2 jsr CSH.fDeclGetArg
bcs .99
pha
tya
jsr CSH.fDeclAddA
pla
jsr CSH.fDeclAddA
jsr CSH.GetCharNB
bcs .9
jsr CSH.IsLetter
bcs .5
* TODO: AddLocal
.3 jsr CSH.GetNextCharNB
bcs .9
jsr CSH.IsLetterOrDigit
bcc .3
.5 cmp #')'
beq .6
cmp #','
bne .9
jsr CSH.GetNextCharNB Skip ,
bcs .9
bra .2
.6 jsr CSH.GetNextCharNB Skip )
bcs .9
cmp #';'
beq .7
* TODO: f() body
bra .9
*--------------------------------------
.7 lda #0
* sta ZPVarDataPtr
* sta ZPVarDataPtr+1
.8 lda #0
jsr CSH.fDeclAddA
clc
bra .99
.9 lda #E.CSYN
sec
.99 >LEAVE
rts
*--------------------------------------
CSH.fDeclGetArg lda (ZPInputBufPtr)
cmp #'.'
bne .5
ldx #2
.1 jsr CSH.GetNextChar
bcs .9
cmp #'.'
bne .9
dex
bne .1
jsr CSH.GetNextCharNB
bcs .9
eor #')'
bne .9
ldy #CSH.T.VARIADIC Type
* lda #0 Qual
* clc
rts
.5 >LDYA L.CSH.TMODS
jsr CSH.LookupID
bcs .9
jsr CSH.tDecl
bcs .9
* Y,A = Type/Qual
bra .8
.9 lda #E.CSYN
sec
.8 rts
*--------------------------------------
CSH.fDeclAddA sta (ZPCSHfDecl)
inc ZPCSHfDecl
bne .8
inc ZPCSHfDecl+1
.8 rts
*--------------------------------------
CSH.tDecl >ENTER 2
lda #0
sta (pStack) Type
ldy #1
sta (pStack),y Qual
jsr .7
bcs .99
ldy #1
lda (pStack),y
pha
lda (pStack)
tay Y = Type
pla A = Qual
clc
.99 >LEAVE
rts
.7 jmp (J.CSH.TMODS,x)
*--------------------------------------
CSH.NewKey >PUSHA
>PUSHW ZPInputBufPtr
>PUSHWI 0 ScopeID
>SYSCALL SListNewKey
bcs .9
pha
phy
txa
* clc
adc ZPInputBufPtr
sta ZPInputBufPtr
bcc .1
inc ZPInputBufPtr+1
.1 clc
ply
pla
.9 rts
*--------------------------------------
* Y,A = Type/Qual
*--------------------------------------
CSH.SetVarValue cpy ZPVarType
bne .99
cmp ZPVarQual
bne .99
ldy #0
.1 lda (pStack)
sta (ZPVarDataPtr),y
inc pStack
iny
cpy ZPVarSizeOf
bne .1
clc
rts
.99 lda #E.TMISMATCH
sec
rts
*--------------------------------------
CSH.GetDefine >PUSHB.G CSH.hDefines
jsr CSH.Get
bcs .9
pha
phy
>PUSHB.G CSH.hDefines
ply
pla
>PUSHYA KeyID
>PUSHWZ Allocate..
>PUSHWZ len = 0 (string mode)
>PUSHWZ From Start
>SYSCALL SListGetData
bcs .9
stx hDefine
>LDYA ZPInputBufPtr
>STYA.G CSH.SaveDefine
txa
>SYSCALL GetMemPtr
>STYA ZPInputBufPtr
.9 rts
*--------------------------------------
CSH.GetVar >PUSHB.G CSH.hSymbols
CSH.Get >PUSHW ZPInputBufPtr
>PUSHWI 0 ScopeID
>SYSCALL SListLookup
bcs .9
pha
txa
* clc
adc ZPInputBufPtr
sta ZPInputBufPtr
bcc .1
inc ZPInputBufPtr+1
clc
.1 pla Y,A = VarID
.9 rts
*--------------------------------------
CSH.GetVarDef phy
pha
>PUSHB.G CSH.hSymbols
pla
>PUSHA
pla
>PUSHA KeyID
>PUSHWI ZPVarDef
>PUSHWI 8 8 bytes
>PUSHWZ From Start
>SYSCALL SListGetData
rts
*--------------------------------------
* Input : Value on Stack, Y,A = Type/Qual
* Output : CC = true, CS = false
*--------------------------------------
CSH.IsValue0 cpy #CSH.T.FLOAT
bcc .1 char,int,long
lda CSH.TYPESIZE-1,y
lda (ZPVarDataPtr),y
bne .9
.8 clc
rts
.1 jsr CSH.GetVarSize
tax
lda #0
.2 ora (pStack)
inc pStack
dex
bne .2
tax
beq .8
.9 sec
rts
*--------------------------------------
* Stack
*--------------------------------------
CSH.CheckStack tax
>LDA.G CSH.StackPtr
beq .9
tay
txa
cmp (ZPCSHStack),y
bne .9
clc
rts
.9 lda #E.CSYN
sec
rts
*--------------------------------------
CSH.Push pha
>LDA.G CSH.StackPtr
dec
beq .9
sta (pData),y
tay
pla
sta (ZPCSHStack),y
clc
rts
.9 pla
lda #E.STKOVERFLOW
sec
rts
*--------------------------------------
CSH.Pop >LDA.G CSH.StackPtr
beq .9
pha
inc
sta (pData),y
ply
lda (ZPCSHStack),y
clc
rts
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
* CHAR related Subs.....
*--------------------------------------
CSH.GetOPLen ldy #0
.1 iny
lda (ZPInputBufPtr),y
beq .8
jsr CSH.IsOPChar
bcc .1
.8 tya
rts
*--------------------------------------
CSH.GetIDLen ldy #0
.1 iny
lda (ZPInputBufPtr),y
beq .8
jsr CSH.IsLetterOrDigit
bcc .1
.8 tya
rts
*--------------------------------------
CSH.SkipStatement
clc
rts
*--------------------------------------
CSH.SkipBlock ldy #0 not in "", TOTO:skip comments
ldx #1 starting with 1 '{' for now....
.1 jsr CSH.GetNextCharNB
bcs .9
cmp #'{'
bne .2
tya
bmi .1
inx
bra .1
.2 cmp #'}'
bne .3
tya
bmi .1
dex
bne .1
clc
rts
.3 cmp #'"'
bne .1
tya
eor #$ff
tay
bra .1
.9 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.CheckSpace jsr CSH.GetChar
bcs .90
cmp #C.SPACE
bne .90
jsr CSH.GetNextCharNB
bcc .99
.90 lda #E.CSYN
sec
.99 rts
*--------------------------------------
CSH.CheckCharNB cmp #C.SPACE
beq .9
cmp #C.LF
beq .9
cmp #C.TAB
beq .9
clc
.9 rts
*--------------------------------------
CSH.GetNextChar inc ZPInputBufPtr
bne CSH.GetChar
inc ZPInputBufPtr+1
*--------------------------------------
CSH.GetChar lda (ZPInputBufPtr)
bne .8
lda hDefine
beq .1
stz hDefine
phx
phy
>SYSCALL FreeMem
>LDYA.G CSH.SaveDefine
>STYA ZPInputBufPtr
ply
plx
bra CSH.GetChar
.1 lda hInclude
beq .9
stz hInclude
phx
phy
>SYSCALL FreeMem
>LDYA.G CSH.SaveInclude
>STYA ZPInputBufPtr
ply
plx
bra CSH.GetChar
.8 clc
rts
.9 lda #MLI.E.EOF
sec
rts
*---------------------------------------
CSH.IsEndArg
*---------------------------------------
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
*--------------------------------------
* in : Y,A = type/qual
* out : A = size
*--------------------------------------
CSH.GetVarSize and #CSH.Q.PPPOINTER
bne .2
lda CSH.TYPESIZE-1,y
clc
rts
.2 lda #2 pointer
sec +1 for hMem Storage
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