A2osX/BIN/CSH.S.CORE.txt
2020-02-23 21:01:48 +01:00

1432 lines
24 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 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
* sta (ZPCSHConst)
* sta (ZPCSHStack)
* >DEC.G bTrace
* >DEC.G bDebug
* clc
.9 rts
*--------------------------------------
CSH.Quit >LDA.G CSH.hSymbols
beq .1
>PUSHA
>SYSCALL SListFree
.1 >LDA.G CSH.hTags
beq .2
>PUSHA
>SYSCALL SListFree
.2 >LDA.G CSH.hDefines
beq .3
>PUSHA
>SYSCALL SListFree
.3 lda ZPhMacro
jsr .7
>LDA.G hFileBuf
jsr .7
>LDA.G CSH.hStack
jsr .7
>LDA.G CSH.hData
jsr .7
>LDA.G CSH.hConst
.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 #CSH.E.SYNTAX
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
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 #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.DIR jsr CSH.GetNextCharNB
bcs .99
cmp #'!' #!/bin/csh
bne .1
bra CSH.SkipLine
.1 >LDYA L.CSH.DIRS
jsr CSH.LookupID
bcs .91
jmp (J.CSH.DIRS,x)
.91 lda #CSH.E.INVDIR
sec
.99 rts
*--------------------------------------
CSH.DIR.DEFINE jsr CSH.CheckSpace
bcs .99
jsr CSH.IsLetter
bcs .90
>LDA.G CSH.hDefines
jsr CSH.NewKey
bcs .99
>STYA ZPVarID
jsr CSH.CheckSpace
bcs .99
ldy #$ff
.1 iny
lda (ZPFileBufPtr),y
beq .2
cmp #C.CR
bne .1
dey
.2 iny
lda #0
pha
phy
>PUSHB.G CSH.hDefines
>PUSHW ZPVarID
>PUSHW ZPFileBufPtr
ply
pla
>PUSHYA DataLen
>SYSCALL SListAddData
bcs .99
bra CSH.SkipLine
.90 lda #CSH.E.SYNTAX
sec
.99 rts
*--------------------------------------
CSH.SkipLine jsr CSH.GetNextChar
bcs .9
cmp #C.CR
bne CSH.SkipLine
clc
.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 skip ')'
bcs .99
cmp #'{'
bne .9
jsr CSH.GetNextCharNB Skip '{'
bcs .99
jsr CSH.IsValue0 X = var type from ExpEval
bcc .6 Value=0, skip {{....}}
>LDA.G CSH.CmdSave
beq .1 IF
pha
>LDA.G CSH.BufPtrSave+1 WHILE : push loop address...
jsr CSH.Push
>LDA.G CSH.BufPtrSave
jsr CSH.Push
pla
.1 jsr CSH.Push
bcs .99
lda #'}' Tell '}' is expected at the end of block
jsr CSH.Push
bcs .99
rts
.6 jsr CSH.SkipBlock
bcc .99
.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 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
CSH.TYPEDEF
CSH.SIZEOF
lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.STRUCT >ENTER 4
jsr CSH.GetCharNB
bcs .99
>LDA.G CSH.hTags
jsr CSH.NewKey
bcs .99
sta (pStack)
jsr CSH.GetNextCharNB
bcs .99
cmp #'{'
bne .99
.1 jsr CSH.GetNextCharNB
bcs .99
cmp #'}'
bne .1
jsr CSH.GetNextCharNB skip }
clc
.99 >LEAVE
rts
*--------------------------------------
* Built in Types
*--------------------------------------
CSH.SIGNED sec
.HS 90 BCC
*--------------------------------------
CSH.UNSIGNED clc
php
jsr CSH.CheckSpace
bcs .9
>LDYA L.CSH.STYPES
jsr CSH.LookupID
bcs .9
plp
bcs .8
jmp (J.CSH.UTYPES,x)
.8 jmp (J.CSH.STYPES,x)
.9 plp
lda #CSH.E.SYNTAX
sec
rts
*--------------------------------------
CSH.VOID ldx #CSH.T.VOID
bra CSH.TYPE
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.CheckSpace
bcs .9
.11 cmp #'*'
bne .10
lda #CSH.Q.POINTER
tsb ZPVarType
jsr CSH.GetNextCharNB Skip *
bra .11
.10 jsr CSH.IsLetter
bcs .9
jsr CSH.AddVar add with undef value...
bcs .99 OOM or DUP
jsr CSH.GetCharNB
bcs .9
cmp #';'
beq .8
.2 cmp #'='
bne .9
jsr CSH.GetNextCharNB Skip =
bcs .9
lda ZPVarType
jsr CSH.ExpEval
bcs .99
.7 jsr CSH.SetVarValueFromStack X= Type, Set value to this var
bcs .99
jsr CSH.GetChar
bcs .9
cmp #';'
bne .9
.8 clc
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 local : fdef
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 .52
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 jsr CSH.ZPPtr1Next advance to arg list type
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.GetVarSize X = Var Type
* clc
adc ZPPtr2+1
sta ZPPtr2+1 Add to byte count
bra .51
.5 jsr CSH.ZPPtr1Next
.51 jsr CSH.GetCharNB
bcs .90
cmp #','
bne .6
jsr CSH.GetNextCharNB Skip ,
lda (ZPPtr1)
bne .3 Another ARG....
.52 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
ldy ZPPtr2 get type in Y
pla
sta ZPPtr2+1
pla
sta ZPPtr2
pla
sta ZPPtr1+1
pla
sta ZPPtr1
phy
jsr .80
plx
rts
.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
.80 jmp (J.CSH.EXEC,x)
*--------------------------------------
* Input:
* ZPFileBufPtr, A = Expected type
* Output:
* CS, A = EC
* CC, X = Var Type, Value on Stack
*--------------------------------------
CSH.ExpEval ldx ZPPtr1
phx
ldx ZPPtr1+1 local : used by lookup
phx
ldx ZPPtr2 local : VarType
phx
ldx ZPPtr2+1 local : BOP
phx
sta ZPPtr2 local : expected type
lda #$ff
pha
*--------------------------------------
.10 jsr CSH.GetCharNB
bcs .19
.11 cmp #'('
bne .20
jsr CSH.GetNextCharNB skip (
bcs .19
lda ZPPtr2
jsr CSH.ExpEval
bcs .19
stx ZPPtr2
jsr CSH.GetCharNB
bcs .19
cmp #')'
bne .19
jsr CSH.GetNextCharNB skip )
bcc .31
.19 jmp .90
*--------------------------------------
.20 jsr CSH.IsLetter define, Fnc or Var ?
bcs .22
jsr CSH.GetDefine
bcc .10
jsr CSH.GetVar
bcs .21
ldx ZPPtr2 YA=VarID, X=expected var type (or 0=any)
jsr CSH.GetVarValueOnStack Y,A = VarID, Get value on stack
bcs .29
stx ZPPtr2 store real var type
bra .30
.21 lda ZPPtr2 var type
jsr CSH.fCall X = function index
bcs .29
stx ZPPtr2 store real var type
bra .30
.22 jsr CSH.IsDigit10 number ?
bcs .24
ldx ZPPtr2
bne .23
ldx #CSH.T.INT
stx ZPPtr2
.23 jsr CSH.GetNumOnStack
bcs .29
bra .30
.24 cmp #'"' String literal
bne .90
jsr CSH.AddContCharP
.29 bcs .99
*--------------------------------------
.30 jsr CSH.GetCharNB
bcs .90
.31 cmp #','
beq .80
cmp #')'
beq .80
cmp #';'
beq .80
jsr CSH.IsOPChar
bcs .90
>LDYA L.CSH.BOPS we are at V1 op1 V2 op2...
jsr CSH.LookupOP
bcs .90
stx ZPPtr2+1 save OP(n)
.32 pla get OP(n-1)
bmi .33 $ff....
cmp ZPPtr2+1
bcc .33 OP(n) has precedence, on stack : V1,V2
tax OP(n-1) has precedence...
lda ZPPtr2 Var Type
jsr CSH.BOP.EXEC compute V(n-1) <OP(n-1)> V(n)
bcc .32
bcs .99
.33 pha push back OP(n-1)
lda ZPPtr2+1 get OP(n)
pha push OP(n) on stack
jmp .10 go check for next token
*--------------------------------------
.80 plx any OP on stack ?
bmi .88
lda ZPPtr2 Var Type
jsr CSH.BOP.EXEC
bcc .80
bcs .99
.90 lda #CSH.E.SYNTAX
.99 plx
bpl .99
sec
.HS 90 BCC
.88 clc
ldx ZPPtr2 X = Var Type
ply
sty ZPPtr2+1
ply
sty ZPPtr2
ply
sty ZPPtr1+1
ply
sty 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.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 #$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
*--------------------------------------
CSH.GetNumOnStack
txa
beq .99
.10 cpx #CSH.T.FLOAT
bcc .1
bne .99
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
>SYSCALL StrToF
clc
rts
.1 >PUSHW ZPFileBufPtr
>PUSHWI ZPFileBufPtr
>PUSHBI 10
phx
cpx #CSH.T.UCHAR
bcc .2
>SYSCALL StrToUL
bra .3
.2 >SYSCALL StrToL
.3 plx
bcs .9
lda CSH.TYPESIZE,x
cmp #4
beq .8
cmp #2
bne .4
ldy #1
>PULLA
sta (pStack),y
>PULLA
sta (pStack),y
clc
rts
.4 >PULLA
inc pStack
inc pStack
sta (pStack)
.8 clc
.9 rts
.99 lda #CSH.E.TMISMATCH
sec
rts
*--------------------------------------
* Input : ZPFileBufPtr
* Output : Y,A = VarID
*--------------------------------------
CSH.AddVar >LDA.G CSH.hSymbols
jsr CSH.NewKey
bcs .9
>STYA ZPVarID
ldx ZPVarType
jsr CSH.GetVarSize
sta ZPVarSizeOf
lda ZPCSHData
sta ZPVarDataPtr
clc
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
* bcs .9
* lda #'*'
* jsr DEBUG.VAR
.9 rts
.99 lda #CSH.E.OOM
.HS 2C BIT ABS
CSH.TMISMATCH lda #CSH.E.TMISMATCH
sec
rts
*--------------------------------------
CSH.NewKey >PUSHA
>PUSHW ZPFileBufPtr
>SYSCALL SListNewKey
bcs .9
pha
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+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
* lda #'>'
* jsr DEBUG.VAR
clc
rts
.99 lda #CSH.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 ZPhMacro
lda ZPFileBufPtr
sta ZPFileBufPtrBak
lda ZPFileBufPtr+1
sta ZPFileBufPtrBak+1
txa
>SYSCALL getmemptr
>STYA ZPFileBufPtr
.9 rts
*--------------------------------------
CSH.GetVar >PUSHB.G CSH.hSymbols
CSH.Get >PUSHW ZPFileBufPtr
>SYSCALL SListLookup
bcs .9
pha
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+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 #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 (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 #CSH.E.SYNTAX
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 #CSH.E.SOVERFLW
sec
rts
*--------------------------------------
CSH.Pop >LDA.G CSH.StackPtr
beq .9
pha
inc
sta (pData),y
ply
lda (ZPCSHStack),y
clc
rts
.9 lda #CSH.E.STACKERR
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.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 #CSH.E.SYNTAX
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 ZPFileBufPtr
bne CSH.GetChar
inc ZPFileBufPtr+1
*--------------------------------------
CSH.GetChar lda (ZPFileBufPtr)
bne .8
lda ZPhMacro
beq .9
stz ZPhMacro
phx
phy
>SYSCALL freemem
ply
plx
lda ZPFileBufPtrBak
sta ZPFileBufPtr
lda ZPFileBufPtrBak+1
sta ZPFileBufPtr+1
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
rts
.2 lda #2
rts
*--------------------------------------
DEBUG.VAR >SYSCALL putchar
>PUSHW L.MSG.DBGVAR
>PUSHW ZPVarID
>PUSHW ZPVarType
>PUSHW ZPVarSizeOf
>PUSHW ZPVarDataPtr
ldy #3
.1 >PUSHB (ZPVarDataPtr),y
dey
bpl .1
>PUSHBI 12
>SYSCALL printf
rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM