A2osX/BIN/CSH.S.KW.txt
2020-08-02 14:19:43 +02:00

356 lines
6.6 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 #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.AddSymbol add with undef value...
bcs .99 OOM or DUP
jsr CSH.GetCharNB
bcs .9
cmp #';'
beq .8
cmp #'='
beq .2
cmp #'('
bne .9
jmp CSH.AddFunction
.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 #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 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 #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
*--------------------------------------
CSH.fCall.Exec jmp (J.CSH.EXEC,x)
*--------------------------------------
MAN
SAVE usr/src/bin/csh.s.kw
LOAD usr/src/bin/csh.s
ASM