A2osX/BIN/CC.S.F.txt
burniouf 1e404b5bcf KERNEL:IRQ mode for IIgs (not yet preemptive)
CC:most of it working, many bugs remain
DAN2ETH.DRV:broken, lot of debug code included
2023-01-11 19:34:34 +01:00

500 lines
7.8 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 jsr SCOPE.New
bcs .99
lda (ZPSymBufPtr) #SYM.T
pha
ldy #SYM.Q
lda (ZPSymBufPtr),y
and #SYM.Q.PPPOINTER+SYM.Q.AAARRAY
ply
cpy #SYM.T.VOID
bne .10
tax
beq .11 function is void
.10 lda #'R'
jsr SYM.NewLabelA
bcs .99
.11 jsr CORE.GetNCharNBNL Skip (
bcs .9
cmp #')' func()
beq .6
*--------------------------------------
.1 jsr F.DeclGetTQ
bcs .99
>STYA ZPPtr2 Save T/Q
jsr SYM.AddWord
bcs .99
cpy #SYM.T.VARIADIC
beq .5
jsr CC.GetCharNB
bcs .9
jsr CC.IsLetter
bcs .2
jsr F.NewArg will update LocalPtr,FrameSize
bcs .99
.2 jsr CC.GetCharNB
bcs .9
cmp #')'
beq .6
cmp #','
bne .9
jsr CORE.GetNCharNB Skip ,
bcc .1
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
.5 jsr CC.GetCharNB
bcs .9
cmp #')'
bne .9
.6 jsr SYM.Add0000 definition End
bcs .99
jsr CORE.GetNCharNBNL Skip ')'
bcs .9
cmp #';'
bne .7
jsr SCOPE.Close discard local scope
bcs .99
jsr SYM.Update Store this declaration & exit
bcs .99
jsr CORE.GetNCharNBNL Skip ';'
clc no error even if EOF
rts
*--------------------------------------
.7 cmp #'{'
bne .9
*--------------------------------------
F.Def >LDA.G CC.bInitCode
bmi .1
lda #$60 RTS
jsr CODE.EmitByte Close INIT code
bcs .99
lda #$FF
>STA.G CC.bInitCode
.1 jsr SYM.SetAddrCCode f() Code starts HERE
jsr SYM.Update Store f() Declaration
bcs .99
ldy #SYM.SizeOf
lda (ZPSymBufPtr),y
beq .2 void f()
.2 ldy ScopePtr
iny
iny
iny
lda (ScopeStk),y #SCOPE.FrameSize
jsr CODE.LDAI A = f() ARGS size
bcs .99
>LDYA L.PCC.ENTER
jsr CODE.EmitPCC Start Definition
bcs .99
lda #$ff
>STA.G CC.CmdSave
jsr STMT.New00
bcs .99
jsr STMT.SetTypeCP
bcs .99
.99 rts
*--------------------------------------
F.Def.END lda #'X' define EXIT Label
jsr SYM.NewLabelA
bcs .9
jsr STMT.Close
bcs .9
>LDYA L.PCC.LEAVE
jsr CODE.EmitPCC
bcs .9
jsr SCOPE.Close
bcs .9
.9 rts
*--------------------------------------
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.Store
bcs .9
>LDA.G CC.hSymBuf
>SYSCALL GetMemPtr
>STYA ZPSymBufPtr
>LDYA.G CC.SymIDSave
>STYA.G CC.SymID
.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 .1
jsr EXP.GetYASizeOfInAX
txa
jsr CODE.AddLocal
bcc .1
rts
.1 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.GetYASizeOfInAX
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