A2osX/BIN/CC.S.F.txt
burniouf 04a83f00f3 SH:new ALIAS cmd, new && operator
MKDIR:completely implemented
LS/RM/MV/CP: combined switches
KERNEL:SList API now handle options to handle several languages/parsers
2022-10-07 21:21:37 +02:00

448 lines
7.2 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
*--------------------------------------
F.Decl stz LocalPtr
jsr CC.PushTQ push T/Q for RETURN
bcs .99
ldx #$80 CPStmt.fDef state
jsr CC.STMT.CPStmt.NEW
bcs .99
jsr SYM.NewScope
bcs .99
jsr CORE.GetNCharNB Skip (
bcs .9
cmp #')' func()
beq .6
*--------------------------------------
.1 jsr F.DeclGetTQ
bcs .99
>STYA ZPPtr2 Save T/Q
jsr SYM.AddWord
bcs .99
jsr CC.GetCharNB
bcs .9
jsr CC.IsLetter
bcs .2
jsr F.NewArg
bcs .99
jsr CC.GetCharNB
bcs .9
.2 cmp #')'
beq .6
cmp #','
bne .9
jsr CORE.GetNCharNB Skip ,
bcc .1
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
.6 jsr SYM.Add0000 definition End
bcs .99
jsr CORE.GetNCharNBNL Skip ')'
bcs .9
cmp #';'
bne .7
jsr SYM.FreeScope discard local scope
lda CStackPtr
clc
adc #8
sta CStackPtr discard this CPStmt + T/Q
stz LocalPtr reset for DEBUG Message
clc
rts
*--------------------------------------
.7 cmp #'{'
bne .9
bit bInitCode
bmi .8
dec bInitCode
lda #$60 RTS
jsr CODE.EmitByte Close INIT code
bcs .99
.8 >LDYA ZPCCCode f() Code starts HERE
jsr SYM.SetAddrYA
lda LocalPtr
jsr CODE.LDAI A = f() ARGS size
bcs .99
>LDYA L.PCC.ENTER
jmp CODE.EmitPCC Store f() Declaration / Start Definition
*--------------------------------------
F.DeclGetTQ lda (ZPLineBufPtr)
cmp #'.'
bne .5
ldx #2
.1 jsr CC.GetNextChar
bcs .9
cmp #'.'
bne .9
dex
bne .1
jsr CORE.GetNCharNB
bcs .9
eor #')'
bne .9
ldy #SYM.T.VARIADIC Type
* lda #0 Qual
* clc
rts
*--------------------------------------
.5 jsr SYM.Lookup var or func() ?
bcs .6
ldy #SYM.SC
lda (ZPLookupSymPtr),y
cmp #SYM.SC.TYPEDEF
bne .9
jmp TYPE.GetTQInYA2
.6 >LDYA L.CC.TYPEQUAL
jsr CC.LookupID
bcs .9
jmp TYPE.GetTQInYA
.9 lda #E.CSYN
sec
rts
*--------------------------------------
F.NewArg >LDYA.G CC.SymID
>STYA.G CC.SymIDSave
>LEA.G CC.ArgBuf
>STYA ZPSymBufPtr
>LDYA ZPPtr2
ldx #SYM.SC.AUTO
sec Reset Buffer
jsr SYM.New
bcs .9
jsr SYM.StoreL Store f() Args in Local scope
bcs .9
>LDA.G CC.hSymBuf
>SYSCALL GetMemPtr
>STYA ZPSymBufPtr
>LDYA.G CC.SymIDSave
>STYA.G CC.SymID
.9 rts
*--------------------------------------
F.Def.END >LDYA L.PCC.LEAVE
jsr CODE.EmitPCC
bcs .9
jsr SYM.FreeScope
stz LocalPtr back to global
clv pop context
clc
.9 rts
*--------------------------------------
* in : ZPSymPtr
* Y,A = Expected T/Q
*--------------------------------------
F.CallNoRetV ldy #0 no expected T/Q
tya
clc
.HS B0 BCS
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 (ZPLookupSymPtr),y
* beq .20 SYS/LIB/FPU call, no ret value space
jsr EXP.GetSymSizeOfInAXC
jsr CODE.nAddLocal
* >DEBUG
.20 jsr CORE.GetNCharNB skip '('
bcs .90
jsr SYM.LookupCheckTQ
bcs .93
*--------------------------------------
stz ZPPtr1 Reset VARIADIC byte count
lda #SYM.Def
>STA.G CC.LookupSymPtr
jsr 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 and #$F0 CONST+VOLATILE+FUNC+FASTCALL
jsr EXP.Eval
bcs .93
jsr EXP.GetYASizeOfInAXC
tax save Sizeof in X
jsr 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 >LDA.G CC.LookupSymPtr
clc
adc #2
sta (pData),y
.5 jsr CC.GetCharNB
bcs .90
cmp #','
bne .6
jsr CORE.GetNCharNBNL Skip ','
jsr F.GetTQ
bne .3 Another ARG....
bra .90 extra args....error
.6 cmp #')'
bne .90
jsr 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 CORE.GetNCharNB Skip )
jsr F.Call2
bra .93
.90 lda #E.CSYN
.92 sec
.93 plx
stx ZPPtr2+1
plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
.99 rts
*--------------------------------------
* X = last var size
*--------------------------------------
F.Call2 ldy #SYM.Q
lda (ZPLookupSymPtr),y
and #SYM.Q.FASTCALL
beq .1
ldy #SYM.Def Get first (only) argument
jsr F.GetTQAtY
jsr TYPE.SizeOf
dex
bne .19
jsr CODE.PULLA
bra .1
.19 jsr CODE.PULLYA
.1 jsr 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 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 (ZPLookupSymPtr),y
cmp #3+LIBS.MAX
bcs .8 not a SYS/FPU/LIB call...Ret value on stack
>LDYA ZPPtr2 function T/Q
jsr TYPE.SizeOf
cpx #3
bcs .8 leave on stack
dex
bne .60
jsr CODE.PUSHA push ONE byte on stack
bra .8
.60 jsr CODE.PUSHYA push TWO bytes on stack
.8 >LDYA ZPPtr2 T/Q
clc
rts
*--------------------------------------
F.Call3 ldy #SYM.Addr+1
lda (ZPLookupSymPtr),y
beq .9
pha
dey
lda (ZPLookupSymPtr),y
tax
ply Y=HI,X=LO
cpy #1
bne .1
jmp CODE.SYSCALL
.1 cpy #2
bne .2
jmp CODE.FPUCALL
.2 cpy #3+LIBS.MAX
bcs .3
jmp CODE.LIBCALL
.3 lda #$EA NOP
jsr CODE.EmitByte
bcs .99
lda #$EA NOP
jsr CODE.EmitByte
bcs .99
lda #$20 JSR abs
jmp CODE.TOABSYX
.9 bit bPass2
bmi .91
lda #5 leave room for LDX #imm, JSR abs
clc
adc ZPCCCode
sta ZPCCCode
bcc .90
inc ZPCCCode+1
.90 clc
rts
.91 lda #E.FUNDEF
sec
.99 rts
*--------------------------------------
F.GetTQ >LDA.G CC.LookupSymPtr
tay
F.GetTQAtY lda (ZPLookupSymPtr),y
pha
iny
lda (ZPLookupSymPtr),y
ply
rts
*--------------------------------------
MAN
SAVE usr/src/bin/cc.s.f
LOAD usr/src/bin/cc.s
ASM