A2osX/BIN/CSH.S.CORE.txt
2020-01-25 19:56:36 +01:00

1333 lines
23 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
>SYSCALL SListNew
bcs .9
>STA.G CSH.hDefines
>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
beq .1
>SYSCALL SListFree
.1 >LDA.G CSH.hDefines
beq .2
>SYSCALL SListFree
.2 >LDA.G hFileBuf
jsr .7
>LDA.G CSH.hStack
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.DIRECTIVES
.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.GetCharNB
bcs .9
cmp #'=' TODO: all AOPS
bne .99
jsr CSH.GetNextChar Skip =
bcs .99
lda #0 Any Type
jsr CSH.ExpEval
bcs .9
>LDYA ZPVarID X = Exp Type
jsr CSH.SetVarValueFromStack
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.SIZEOF 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.DIRECTIVES 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
jsr CSH.AddDefine
bcs .99
>STYA ZPVarID
jsr CSH.CheckSpace
bcs .99
>PUSHWI 0
>PUSHW ZPFileBufPtr
>PUSHW ZPVarID
>LDA.G CSH.hSymbols
>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
lda #CSH.E.SYNTAX
sec
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 no value...
bcs .99 OOM or DUP
>STYA ZPVarID
jsr CSH.GetCharNB
bcs .9
cmp #';'
bne .2
ldx ZPVarType
jsr CSH.SIZEOF
.1 dec pStack
dec
bne .1
ldx ZPVarType
bra .7
.2 cmp #'='
bne .9
jsr CSH.GetNextCharNB Skip =
bcs .9
lda ZPVarType
jsr CSH.ExpEval
bcs .99
.7 >LDYA ZPVarID
jsr CSH.AddVarValueFromStack X= Type, Add value to this var
bcs .99
jsr CSH.GetChar
bcs .9
cmp #';'
bne .9
.8 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, Result on Stack, X = Type
*--------------------------------------
CSH.fCall ldx ZPPtr1
phx
ldx ZPPtr1+1
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.SIZEOF 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
phx
ldx ZPPtr2 local : VarType
phx
ldx ZPPtr2+1 local : BOP1
phx
sta ZPPtr2 local : expected type
.13 sec
ror ZPPtr2+1 Reset BOP1
.10 jsr CSH.GetCharNB
bcs .19
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 )
* >DEBUG
bcs .19
jmp .12
.19 jmp .90
.20 jsr CSH.IsLetter define, Fnc or Var ?
bcs .2
jsr CSH.GetVar
bcs .1
ldx ZPPtr2 expected var type (could be 0=any)
jsr CSH.GetVarValueOnStack Y,A = VarID, Get value on stack
bcs .29
stx ZPPtr2 store real var type
bra .11
.1 lda ZPPtr2 var type
jsr CSH.fCall X = function index
bcs .99
stx ZPPtr2 store real var type
bra .11
.2 jsr CSH.IsDigit10 number ?
bcs .3
ldx ZPPtr2
bne .22
ldx #CSH.T.INT
stx ZPPtr2
.22 jsr CSH.GetNumOnStack
.29 bcs .99
.11 jsr CSH.GetCharNB
bcs .90
.12 cmp #','
beq .8
cmp #')'
beq .8
cmp #';'
beq .8
jsr CSH.IsOPChar
bcs .90
>LDYA L.CSH.BOPS
jsr CSH.LookupOP
bcs .90
lda ZPPtr2+1 previous OP...
bpl .5 go check precedence
stx ZPPtr2+1
jsr CSH.GetCharNB
bcc .20 go check for an ARG
bra .90
.3 cmp #'"' String literal
bne .90
jsr CSH.AddContCharP
bcs .99
jmp .11
.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 Var Type
ldx ZPPtr2+1 BOP
jsr CSH.BOPExec
bcs .99
jsr CSH.GetCharNB
bcs .90
jmp .13 reset BOP & loop
.8 ldx ZPPtr2+1
bmi .80
lda ZPPtr2 Var Type
jsr CSH.BOPExec
bcc .80
bcs .99
.90 lda #CSH.E.SYNTAX
.99 sec
.HS 90 BCC
.80 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.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 #$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 >PUSHBI 10
>PUSHWI ZPFileBufPtr
>LDYA ZPFileBufPtr
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 = ZPVarID
*--------------------------------------
CSH.AddDefine >LDA.G CSH.hDefines
bra CSH.Add
CSH.AddVar >LDA.G CSH.hSymbols
CSH.Add pha
>PUSHW ZPFileBufPtr
pla
>SYSCALL SListNewKey
bcs .9
pha
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+1
clc
.1 pla
.9 rts
*--------------------------------------
* Y,A = VarID, X=Type
*--------------------------------------
CSH.AddVarValueFromStack
sec
.HS 90 BCC
*--------------------------------------
CSH.SetVarValueFromStack
clc
php
pha
phy
stx ZPVarData X = type
jsr CSH.SIZEOF
pha Size....
tax
ldy #1
.1 >PULLA
sta ZPVarData,y
iny
dex
bne .1
>PUSHBI 0 Datalen HI
pla
inc
>PUSHA Datalen LO
>PUSHWI ZPVarData DataPtr
ply
pla
>PUSHYA Y,A = VarID
>LDA.G CSH.hSymbols
plp
bcc .2
>SYSCALL SListAddData
rts
.2 >SYSCALL SListSetData
rts
*--------------------------------------
CSH.GetVar >PUSHW ZPFileBufPtr
>LDA.G CSH.hSymbols
>SYSCALL SListLookup
bcs .9
pha
txa
* clc
adc ZPFileBufPtr
sta ZPFileBufPtr
bcc .1
inc ZPFileBufPtr+1
clc
.1 pla Y,A = VarID
.9 rts
*--------------------------------------
* Input : Y,A = VarID, X = Var Type (or 0)
* Output : Value on Stack, X = Var Type
*--------------------------------------
CSH.GetVarValueOnStack
stx ZPVarType
pha
>PUSHWI 0 From Start
>PUSHWI 6 6 bytes
>PUSHWI ZPVarData
pla
>PUSHYA KeyID
>LDA.G CSH.hSymbols
>SYSCALL SListGetData
bcs .9
ldx ZPVarType
beq .1 any type
cpx ZPVarData
beq .2
txa
and #CSH.Q.PPPOINTER
beq .99 not pointer....mismatch
eor ZPVarData
and #CSH.Q.PPPOINTER
bne .99 compare only pointer depth
.1 ldx ZPVarData
beq *
.2 jsr CSH.SIZEOF
tay
.3 lda ZPVarData,y
>PUSHA
dey
bne .3
clc X = Var Type
.9 rts
.99
CSH.TMISMATCH 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 ZPVarData,y
bne .9
.8 clc
rts
.1 jsr CSH.SIZEOF
tax
lda #0
.2 ora (pStack)
inc pStack
dex
bne .2
tax
beq .8
.9 sec
rts
*--------------------------------------
* A = Type, X = OP
*--------------------------------------
CSH.BOPExec jmp (J.CSH.BOPS,x)
*--------------------------------------
CSH.BOPS.ADD asl
tax
jmp (J.CSH.BOPS.ADDt,x)
CSH.BOPS.ADDi8
CSH.BOPS.ADDu8 clc
>PULLA
adc (pStack)
sta (pStack)
clc
rts
CSH.BOPS.ADDi16
CSH.BOPS.ADDu16 clc
ldy #1
>PULLA
adc (pStack),y
sta (pStack),y
>PULLA
adc (pStack),y
sta (pStack),y
clc
rts
CSH.BOPS.ADDi32
CSH.BOPS.ADDu32 >FPU ADD32
clc
rts
CSH.BOPS.ADDf >FPU FADD
clc
rts
*--------------------------------------
CSH.BOPS.SUB asl
tax
jmp (J.CSH.BOPS.SUBt,x)
CSH.BOPS.SUBi8
CSH.BOPS.SUBu8 sec
ldy #1
lda (pStack),y
sbc (pStack)
sta (pStack),y
inc pStack
clc
rts
CSH.BOPS.SUBi16
CSH.BOPS.SUBu16 sec
ldy #2
lda (pStack),y
sbc (pStack)
sta (pStack),y
iny
lda (pStack),y
ldy #1
sbc (pStack),y
inc pStack
inc pStack
sta (pStack),y
clc
rts
CSH.BOPS.SUBi32
CSH.BOPS.SUBu32 >FPU SUB32
clc
rts
CSH.BOPS.SUBf >FPU FSUB
clc
rts
*--------------------------------------
CSH.BOPS.MUL cmp #CSH.T.FLOAT
beq .8
clc
rts
.8 >FPU FMULT
clc
rts
*--------------------------------------
CSH.BOPS.DIV 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.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)
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
*--------------------------------------
* in : X = type, out : X = type, A = size
*--------------------------------------
CSH.SIZEOF txa
and #CSH.Q.PPPOINTER
bne .2
txa
and #$f
phx
tax
lda CSH.TYPESIZE,x
plx
rts
.2 lda #2
rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM