A2osX/BIN/CC.S.F.txt
2022-01-30 22:47:08 +01:00

436 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
*--------------------------------------
CC.F.Decl stz LocalPtr
jsr CC.PushTQ push T/Q for RETURN
bcs .99
ldy #SYM.Q
lda #SYM.Q.FUNC
ora (ZPSymBufPtr),y
sta (ZPSymBufPtr),y
ldx #$80 CPStmt.fDef state
jsr CC.STMT.CPStmt
bcs .99
jsr CC.SYM.NewScope
bcs .99
jsr CC.GetNextCharNB Skip (
bcs .9
cmp #')' func()
beq .6
*--------------------------------------
.1 jsr CC.F.DeclGetTQ
bcs .99
>STYA ZPPtr2 Save T/Q
jsr CC.F.AddTQ
jsr CC.GetCharNB
bcs .9
jsr CC.IsLetter
bcs .2
jsr CC.SYM.Push
bcs .99
>LDYA ZPPtr2
ldx #SYM.SC.AUTO
jsr CC.SYM.New
bcs .99
jsr CC.SYM.Store Store f() Args in Local scope
bcs .99
jsr CC.SYM.FreeBufPop
bcs .99
jsr CC.GetCharNB
bcs .9
.2 cmp #')'
beq .6
cmp #','
bne .9
jsr CC.GetNextCharNB Skip ,
bcc .1
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
.6 ldy #0
lda #0
jsr CC.F.AddTQ
jsr CC.GetNextCharNB Skip )
bcs .9
cmp #';'
bne .7
jsr CC.SYM.FreeScope discard local scope
lda CStackPtr
clc
adc #6
sta CStackPtr discard this CPStmt
stz LocalPtr reset for DEBUG Message
clc
rts
*--------------------------------------
.7 cmp #'{'
bne .9
ldy #SYM.Addr+1
lda (ZPSymBufPtr),y
dey
ora (ZPSymBufPtr),y
bne .90 Already populated by LINK
>LDYA ZPCCCode f() Code starts HERE
jsr CC.SYM.SetAddrYA
lda LocalPtr
jsr CODE.LDAI A = f() ARGS size
jsr CODE.Enter
clc Store f() Declaration / Start Definition
rts
.90 lda #E.REDEF
sec
rts
*--------------------------------------
CC.F.DeclGetTQ lda (ZPLineBufPtr)
cmp #'.'
bne .5
ldx #2
.1 jsr CC.GetNextChar
bcs .9
cmp #'.'
bne .9
dex
bne .1
jsr CC.GetNextCharNB
bcs .9
eor #')'
bne .9
ldy #SYM.T.VARIADIC Type
* lda #0 Qual
* clc
rts
*--------------------------------------
.5 >LDYA L.CC.TYPEQUAL
jsr CC.LookupID
bcs .9
jsr CC.TYPE.Decl
bcs .9
* Y,A = Type/Qual
bra .8
.9 lda #E.CSYN
sec
.8 rts
*--------------------------------------
CC.F.Def.END jsr CODE.Leave
jsr CC.Pop T
jsr CC.Pop Q
jsr CC.SYM.FreeScope
stz LocalPtr back to global
clc
rts
*--------------------------------------
* in : ZPSymPtr
* Y,A = Expected T/Q
*--------------------------------------
CC.F.CallNoRetV clc
.HS B0 BCS
CC.F.CallRetV sec
ldx ZPPtr1 local : variadic size
phx
ldx ZPPtr1+1 local : bRetV
phx
ldx ZPPtr2 local : expected T
phx
ldx ZPPtr2+1 local : expected Q
phx
>STYA ZPPtr2
ror ZPPtr1+1 bRetV
bpl .20 no return value on stack
ldy #SYM.Addr+1
lda (ZPSymBufPtr),y
cmp #2
bcc .20 SYS/FPU call, no ret value space
jsr CC.SYM.GetSymSizeOfInAXC
jsr CODE.nAddLocal
.20 stz ZPPtr1 Reset VARIADIC byte count
jsr CC.GetNextCharNB skip '('
bcs .10
jsr CC.SYM.GetTypeInYA Y,A = f() Return value T/Q
ldx ZPPtr2 expected T
beq .1 no check required
cpy ZPPtr2
bne .91
tax save full Q
and #$fC ignore SYM.Q.FUNC,SYM.Q.FASTCALL
cmp ZPPtr2+1
bne .91
txa
.1 >STYA ZPPtr2 save full T/Q for later
lda #SYM.Def
sta ZPSymSize
jsr CC.F.GetTQ get First Arg T/Q
beq .7 end of list, go check ending ')'
*--------------------------------------
.3 cpy #SYM.T.VARIADIC
bne .4
lda #0 Expected T/Q = 0 if VARIADIC
tay
.4 jsr CC.EXP.Eval
bcs .93
jsr CC.SYM.GetYASizeOfInAXC
tax save Sizeof in X
jsr CC.F.GetTQ
cpy #SYM.T.VARIADIC
bne .50 if VARIADIC, don't advance to next arg
txa
clc make sure pointer only 2 bytes
adc ZPPtr1
sta ZPPtr1 Add to byte count
bra .5
.50 inc ZPSymSize
inc ZPSymSize
.5 jsr CC.GetCharNB
.10 bcs .90
cmp #','
bne .6
jsr CC.GetNextCharNB Skip ','
jsr CC.F.GetTQ
bne .3 Another ARG....
bra .90 extra args....error
.6 cmp #')'
bne .90
jsr CC.F.GetTQ
beq .8 no more arg after ')', exit
cpy #SYM.T.VARIADIC
bne .90 missing arg
lda ZPPtr1 push VARIADIC byte count
jsr CODE.PUSHI
.7 jsr CC.GetCharNB
bcs .90
cmp #')'
bne .90
.8 jsr CC.GetNextCharNB Skip )
jsr CC.F.Call2
bra .93
.90 lda #E.CSYN
bra .92
.91 lda #E.TMISMATCH
.92 sec
.93 plx
stx ZPPtr2+1
plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
.99 rts
*--------------------------------------
* X = last var size
*--------------------------------------
CC.F.Call2 lda ZPPtr2+1
bit #SYM.Q.FASTCALL
beq .1
ldy #SYM.Def Get first (only) argument
jsr CC.F.GetTQAtY
jsr CC.TYPE.SizeOf
dex
bne .19
jsr CODE.PULLA
bra .1
.19 jsr CODE.PULLYA
.1 jsr CC.F.Call3
bcs .9
bit ZPPtr1+1 bRetV
bmi .5
* NO Return Value : call & discard stack if not in Y,A
>LDYA ZPPtr2 function T/Q
jsr CC.TYPE.SizeOf
txa
beq .11 void
cpx #3 A or Y,A
bcc .11
.10 jsr CODE.INCPSTACK
dex
bne .10
.11 clc
.9 rts
* Return Value : call & put result on stack if in Y,A
.5 ldy #SYM.Addr+1
lda (ZPSymBufPtr),y
cmp #2
bcs .8 not a SYS/FPU call...Ret value on stack
>LDYA ZPPtr2 function T/Q
jsr CC.TYPE.SizeOf
cpx #3
bcs .8 leave on stack
dex
bne .60
jsr CODE.PUSHA push ONE byte one stack
bra .8
.60 jsr CODE.PUSHYA push TWO bytes one stack
.8 >LDYA ZPPtr2 T/Q
and #$FC ignore SYM.Q.FUNC+SYM.Q.FASTCALL
clc
rts
*--------------------------------------
CC.F.Call3 ldy #SYM.Addr+1
lda (ZPSymBufPtr),y
beq .9
pha
dey
lda (ZPSymBufPtr),y
tax
ply
cpy #1
bne .1
jsr CODE.SYSCALL
clc
rts
.1 cpy #2
bne .2
jsr CODE.FPUCALL
clc
rts
.2 lda #$20 JSR abs
jsr CODE.TOABSYX Y=HI,X=LO
clc
rts
.9 lda #E.FUNDEF
sec
rts
*--------------------------------------
CC.F.AddTQ pha
tya
ldy ZPSymSize
sta (ZPSymBufPtr),y
iny
pla
sta (ZPSymBufPtr),y
iny
sty ZPSymSize
rts
*--------------------------------------
CC.F.GetTQ ldy ZPSymSize
CC.F.GetTQAtY lda (ZPSymBufPtr),y
pha
iny
lda (ZPSymBufPtr),y
ply
rts
*--------------------------------------
MAN
SAVE usr/src/bin/cc.s.f
LOAD usr/src/bin/cc.s
ASM