A2osX/BIN/CSH.S.CORE.txt

833 lines
13 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.hDefines
>SYSCALL SListNew
bcs .9
>STA.G CSH.hTags
>SYSCALL SListNew
bcs .9
>STA.G CSH.hSymbols
>LDYAI 256
>SYSCALL GetMem
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
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.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 .40
jsr CSH.CheckStack must be something on stack....
bcs .9
jsr CSH.GetNextCharNB Skip '}'
jsr CSH.Pop was expected....
jsr CSH.Pop get stacked Cmd...
tax
jmp (J.CSH.KW.END,x)
.40 jsr CSH.IsLetter
bcc .5
bra .99 error, todo : PREOPS ++ --.....
.5 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
bcs .9
bra .8
.6 jsr CSH.GetVar
bcs .7
>STYA ZPVarID
jsr CSH.GetVarDef Get Type & ptr...
bcs .9
jsr CSH.GetCharNB
bcs .9
cmp #'=' TODO: all AOPS
bne .99
jsr CSH.GetNextChar Skip =
bcs .99
lda ZPVarType
jsr CSH.ExpEval
bcs .9
jsr CSH.SetVarValueFromStack X = Exp Type
bcs .9
jsr CSH.GetChar
cmp #';'
beq .8
.99 lda #E.CSYN
sec
.9 rts
.7 lda #0 no return value type check required
jsr CSH.fCall
bcs .9
jsr CSH.GetVarSize X = 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
clc
.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=1 for VOID func()
.6 iny
lda (ZPPtr1),y
bne .6
tya
jsr CSH.ZPPtr1AddAp1
bra .1
.9 pla
sec
rts
*--------------------------------------
CSH.ZPPtr1Next 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
ldx 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
>PUSHB.G CSH.hSymbols
>PUSHW ZPVarID
>PUSHWI ZPVarDef
>PUSHWI 6
>SYSCALL SListAddData
.9 rts
.99 lda #E.OOM
.HS 2C BIT ABS
CSH.TMISMATCH lda #E.TMISMATCH
sec
rts
*--------------------------------------
CSH.fDeclaration
lda #CSH.Q.FUNC
tsb ZPVarType
jsr CSH.GetNextCharNB Skip (
bcs .9
.1 cmp #')'
beq .5
jsr CSH.GetDeclaration
bcs .99
.5 jsr CSH.GetNextCharNB Skip )
jsr CSH.SkipLine
clc
rts
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
CSH.GetDeclaration
>ENTER 4
>LDYA L.CSH.MTYPES
jsr CSH.LookupID
bcs .9
bra .8
.9 lda #E.CSYN
sec
.8 >LEAVE
rts
*--------------------------------------
CSH.NewKey >PUSHA
>PUSHW ZPInputBufPtr
>SYSCALL SListNewKey
bcs .9
pha
txa
* clc
adc ZPInputBufPtr
sta ZPInputBufPtr
bcc .1
inc ZPInputBufPtr+1
.1 clc
pla
.9 rts
*--------------------------------------
* X=Type
*--------------------------------------
CSH.SetVarValueFromStack
cpx ZPVarType X = type
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
>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 6 6 bytes
>PUSHWI 0 From Start
>SYSCALL SListGetData
rts
*--------------------------------------
* Input :
* X=Var Type (or 0)
* YA=VarID
* Output : Stack, X = Var Type
*--------------------------------------
CSH.GetVarValueOnStack
phx
phy
pha
>PUSHB.G CSH.hSymbols
pla
>PUSHA
pla
>PUSHA KeyID
>PUSHEA.G CSH.VarDef
>PUSHWI 6 6 bytes
>PUSHWI 0 From Start
>SYSCALL SListGetData
plx
bcs .9
txa
beq .1 any type
>CMP.G CSH.VarDef Type
beq .2
and #CSH.Q.PPPOINTER
beq .99 not pointer....mismatch
>EOR.G CSH.VarDef
and #CSH.Q.PPPOINTER
bne .99 compare only pointer depth
.1 >LDA.G CSH.VarDef
beq *
.2 tax
jsr CSH.GetVarSize
pha
>LDA.G CSH.VarDef+4
sta ZPPtr3
iny
lda (pData),y
sta ZPPtr3+1
ply
.3 dey
lda (ZPPtr3),y
>PUSHA
tya
bne .3
>LDA.G CSH.VarDef
tax
clc X = Var Type
.9 rts
.99 lda #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 (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
jmp CSH.GetNextCharNB skip '}'
.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 CSH.GetNextCharNB.RTS
.90 lda #E.CSYN
sec
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.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 : X = type, out : X = type, A = size
*--------------------------------------
CSH.GetVarSize txa
and #CSH.Q.PPPOINTER
bne .2
txa
and #$f
phx
tax
lda CSH.TYPESIZE,x
plx
clc
rts
.2 sec +1 for hMem Storage
lda #2
rts
*--------------------------------------
MAN
SAVE usr/src/bin/csh.s.core
LOAD usr/src/bin/csh.s
ASM