A2osX/BIN/CSH.S.KW.txt
2021-05-14 22:58:20 +02:00

424 lines
7.0 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
*--------------------------------------
* 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 #E.CSYN
sec
.99 rts
*--------------------------------------
CSH.IF.END clc
rts
*--------------------------------------
CSH.WHILE.END jsr CSH.Pop
sta ZPInputBufPtr
jsr CSH.Pop
sta ZPInputBufPtr+1
clc
rts
*--------------------------------------
CSH.ELSE
*--------------------------------------
CSH.DO
CSH.FOR
CSH.SWITCH
CSH.CASE
CSH.BREAK
CSH.CONTINUE
CSH.SIZEOF
*--------------------------------------
CSH.TYPEDEF lda #E.CSYN
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
*--------------------------------------
CSH.CONST lda ZPVarQual
bit #CSH.Q.PPPOINTER
bne .1
lda #CSH.Q.CONST
bra .2
.1 lda #CSH.Q.PCONST
.2 bit ZPVarQual
bne .9
tsb ZPVarQual
clc
rts
.9 lda #E.CSYN
sec
rts
*--------------------------------------
CSH.SIGNED sec
.HS 90 BCC
*--------------------------------------
CSH.UNSIGNED clc
php
jsr CSH.CheckSpace
bcs .9
>LDYA L.CSH.TYPES
jsr CSH.LookupID
bcs .9
cpx #2
bcc .9
cpx #8 only char int long allowed
bcs .9
plp
bcs .8
jmp (J.CSH.UTYPES-2,x)
.8 jmp (J.CSH.STYPES-2,x)
.9 plp
lda #E.CSYN
sec
rts
*--------------------------------------
CSH.SHORT jsr CSH.CheckSpace
bcs .9
>LDYA L.CSH.TYPES
jsr CSH.LookupID
bcs CSH.UCHAR
cpx #4 only int allowed
beq CSH.SCHAR
.9 lda #E.CSYN
sec
rts
*--------------------------------------
CSH.VOID ldx #CSH.T.VOID
bra CSH.TYPE
CSH.SCHAR ldx #CSH.T.SCHAR
bra CSH.TYPE
CSH.CHAR
CSH.UCHAR ldx #CSH.T.UCHAR
bra CSH.TYPE
CSH.INT
CSH.SINT ldx #CSH.T.SINT
bra CSH.TYPE
CSH.UINT ldx #CSH.T.UINT
bra CSH.TYPE
CSH.LONG
CSH.SLONG ldx #CSH.T.SLONG
bra CSH.TYPE
CSH.ULONG ldx #CSH.T.ULONG
bra CSH.TYPE
CSH.FLOAT ldx #CSH.T.FLOAT
CSH.TYPE stx ZPVarType
.11 jsr CSH.GetNextCharNB
bcs .9
cmp #'*'
bne .10
lda ZPVarType
clc
adc #CSH.Q.POINTER
sta ZPVarType
bcc .11
bra .9 more than ***
.10 jsr CSH.IsLetter
bcs .9
>LDYA L.CSH.FTYPES
jsr CSH.LookupID
bcs .12
sec
ror bFastCall
jsr CSH.GetNextCharNB
bcs .9
jsr CSH.AddSymbol
bcs .99
jsr CSH.GetCharNB
bcs .9
bra .13
.12 jsr CSH.AddSymbol add with undef value...
bcs .99 OOM or DUP
jsr CSH.GetCharNB
bcs .9
cmp #';'
beq .8
cmp #'='
beq .2
.13 cmp #'('
bne .9
jmp CSH.fDeclaration
.2 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 #E.CSYN
sec
.99 rts
*--------------------------------------
* Input:
* ZPInputBufPtr, 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 make sure pointer only 2 bytes
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 CSH.fCall.Exec
plx restore returned type
rts
.90 lda #E.CSYN
.HS 2C BIT ABS
.91 lda #E.TMISMATCH
sec
.9 plx Discard function index
plx
stx ZPPtr2+1
plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
.99 rts
*--------------------------------------
CSH.fCall.Exec jmp (J.CSH.EXEC,x)
*--------------------------------------
MAN
SAVE usr/src/bin/csh.s.kw
LOAD usr/src/bin/csh.s
ASM