A2osX/BIN/CC.S.CORE.txt

1288 lines
19 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.Init >SYSCALL SListNew
bcs .99
>STA.G CC.hDefines
>SYSCALL SListNew
bcs .99
>STA.G CC.hTags
>SYSCALL SListNew
bcs .9
>STA.G CC.hSymbols
>LDYAI 4096
>SYSCALL GetMem
.99 bcs .9
>STYA ZPCCCode
txa
>STA.G CC.hCode
>LDYAI 1024
>SYSCALL GetMem
bcs .9
>STYA ZPCCConst
txa
>STA.G CC.hConst
>LDYAI 1024
>SYSCALL GetMem
bcs .9
>STYA ZPCCData
txa
>STA.G CC.hData
>LDYAI 1024
>SYSCALL GetMem
bcs .9
>STYA ZPCCStack
txa
>STA.G CC.hStack
>LDYAI 1024
>SYSCALL GetMem
bcs .9
>STYA ZPCCfDecl
txa
>STA.G CC.hfDecl
* clc
.9 rts
*--------------------------------------
CC.Quit >LDA.G CC.hSymbols
beq .1
>SYSCALL SListFree
.1 >LDA.G CC.hTags
beq .2
>SYSCALL SListFree
.2 >LDA.G CC.hDefines
beq .4
>SYSCALL SListFree
.4 lda hDefine
jsr .7
.5 jsr CS.RUN.FClose
bne .5
>LDA.G CC.hfDecl
jsr .7
>LDA.G CC.hStack
jsr .7
>LDA.G CC.hData
jsr .7
>LDA.G CC.hConst
jsr .7
>LDA.G CC.hCode
.7 beq CC.Quit.RTS
>SYSCALL FreeMem
CC.Quit.RTS rts
*--------------------------------------
CC.Run jsr CC.GetCharNB
bcs CC.Quit.RTS
CC.Run.1 cmp #C.CR empty line....
beq .2
cmp #'/'
bne .3 comments ...
jmp CC.comments
.2 clc
rts
.3 cmp #'#' directive ?
bne .4
jmp CC.DIR
.4 cmp #'}' End of block ?
bne .10
jsr CC.CheckStack must be something on stack....
bcs CC.Quit.RTS
jsr CC.GetNextCharNB Skip '}'
jsr CC.Pop was expected....
jsr CC.Pop get stacked Cmd...
tax
jmp (J.CC.KW.END,x)
*--------------------------------------
.10 jsr CC.IsLetter
bcc .20
* TODO: PREOPS ++ --.....
bcs .29
*--------------------------------------
.20 >LDYA L.CC.TMODS
jsr CC.LookupID
bcs .50
jsr CC.tDecl
bcs .59
>STYA ZPSymType Type/Qual
jsr CC.AddSymbol add with undef value...
bcs .29 OOM or DUP
lda ZPSymQual
bit #CC.Q.FUNC
bne .21
jsr CC.GetCharNB
bcs .27
cmp #';'
beq .69
cmp #'='
bne .99
jsr CC.GetNextCharNB skip '='
.27 bcs .99
>LDYA ZPSymType expected T/Q
jsr CC.ExpEval
bcs .9
jsr CC.SetValue Y,A = T/Q, Set value to this var
.29 bcs .9
bra .68
.21 jsr CC.fDecl
bcs .9
bra .68
*--------------------------------------
.50 >LDYA L.CC.KW
jsr CC.LookupID
bcs .6 not an internal CC keyword....
jsr CC.KW.JMP
.59 bcs .9
bra .8
*--------------------------------------
.6 jsr CC.GetVar var= or func() ?
bcs .99
>STYA ZPSymID
jsr CC.GetSymDef Get Type & qual...
bcs .9
lda ZPSymQual
bit #CC.Q.FUNC
beq .60
ldy #0 func( ... );
lda #0
jsr CC.fExecNoRetV
bcs .9
bra .8
*--------------------------------------
.60 jsr CC.GetCharNB
bcs .9
cmp #'=' TODO: all AOPS
bne .99
jsr CC.GetNextChar Skip =
bcs .99
>LDYA ZPSymType T/Q
jsr CC.ExpEval
bcs .9
jsr CC.SetValue
bcs .9
.68 jsr CC.GetCharNB
cmp #';'
.69 beq .8
.99 lda #E.CSYN
sec
.9 rts
*--------------------------------------
.8 jsr CC.GetNextCharNB Skip ;
bcs .9
cmp #C.CR
beq .80
jmp CC.Run.1
.80 clc
rts
*--------------------------------------
CC.comments jsr CC.GetNextChar
cmp #'/'
bne .90
jmp CC.SkipLine skip line.....
.90 lda #E.CSYN
sec
rts
*--------------------------------------
CC.SkipLine jsr CC.GetNextChar
bcs .9
cmp #C.CR
bne CC.SkipLine
clc
.9 rts
*--------------------------------------
CC.LookupID >STYA ZPPtr1
jsr CC.GetIDLen
bra CC.Lookup
CC.LookupOP >STYA ZPPtr1
jsr CC.GetOPLen
CC.Lookup phy Y = len
ldx #0
.1 lda (ZPPtr1)
beq .9 Ending 0, not found....
pla
pha Get Back Len
cmp (ZPPtr1) Same Len ?
bne .4
tay
.2 lda (ZPPtr1),y
.3 dey
cmp (ZPLineBufPtr),y
bne .4
tya
bne .2
pla Found keyword...
clc
adc ZPLineBufPtr ..advance Ptr to char after it..
sta ZPLineBufPtr
bcc .31
inc ZPLineBufPtr+1
.31 lda ZPPtr1
sec
adc (ZPPtr1)
tay
lda ZPPtr1+1
adc #0
clc Y,A = F() def, X = F() index
.8 rts
.4 inx
inx
lda (ZPPtr1)
jsr CC.ZPPtr1AddAp1
bra .1
.9 pla
sec
rts
*--------------------------------------
* int main(int argc, char *argv[]) ;
*--------------------------------------
CC.MainExec lda #0
>PUSHA
ldy #S.PS.ARGC
lda (pPS),y
>PUSHA push int ARGC
>PUSHW ZPCCConst push int ARGV
stz ArgIndex
.1 lda ArgIndex
>SYSCALL ArgV
bcs .2
inc ArgIndex
pha
tya
sta (ZPCCConst)
pla
ldy #1
sta (ZPCCConst),y
lda ZPCCConst
* clc
adc #2
sta ZPCCConst
bcc .1
inc ZPCCConst+1
bra .1
.2
clc
rts
*--------------------------------------
CC.ZPPtr1GetNextW
jsr CC.ZPPtr1NextW
*--------------------------------------
CC.ZPPtr1GetW lda (ZPPtr1)
beq .8
pha
ldy #1
lda (ZPPtr1),y
ply
.8 rts
*--------------------------------------
CC.ZPPtr1NextW jsr .1
.1 inc ZPPtr1
bne .8
inc ZPPtr1+1
.8 rts
*--------------------------------------
CC.ZPPtr1AddAp1
sec
adc ZPPtr1
sta ZPPtr1
bcc .1
inc ZPPtr1+1
.1 rts
*--------------------------------------
* Input : ZPLineBufPtr
* Output : Y,A = VarID
*--------------------------------------
CC.AddSymbol >PUSHB.G CC.hSymbols
>PUSHW ZPLineBufPtr
>SYSCALL SListNewKey
bcs .9
>STYA ZPSymID Y,A = KeyID, X = KeyLen
stx ZPPtr2
lda ZPLineBufPtr
sta ZPPtr1
* clc
adc ZPPtr2
sta ZPLineBufPtr
lda ZPLineBufPtr+1
sta ZPPtr1+1
adc #0
sta ZPLineBufPtr+1
jsr CC.GetCharNB
bcs .6
cmp #'('
bne .6
.7 lda #CC.Q.FUNC
tsb ZPSymQual
lda ZPCCfDecl
sta ZPSymDefPtr
lda ZPCCfDecl+1
sta ZPSymDefPtr+1
>LDYA ZPPtr1
jsr CC.Link
bra .8
* lda #E.FUNDEF
* sec
.9 rts
*--------------------------------------
.6 >LDYA ZPSymType
jsr CC.GetVarSize CS if pointer
stx ZPSymSizeOf
* clc / sec
lda ZPCCData
sta ZPSymDataPtr
adc ZPSymSizeOf
sta ZPCCData
lda ZPCCData+1
sta ZPSymDataPtr+1
adc ZPSymSizeOf+1
sta ZPCCData+1
>LDA.G CC.DataSize
clc
adc ZPSymSizeOf
sta (pData),y
bcs .99
lda ZPSymQual
and #CC.Q.FUNC
bne .98
.8 >PUSHB.G CC.hSymbols
>PUSHW ZPSymID
>PUSHWI ZPSymDef
>PUSHWI SYMDEFSIZE
>SYSCALL SListAddData
rts
.98 lda #E.CSYN
sec
rts
.99 lda #E.OOM
* sec
rts
*--------------------------------------
* ZPSymDataPtr = fDef
*--------------------------------------
CC.fExecNoRetV clc
.HS B0 BCS
CC.fExecRetV sec
ldx ZPPtr1
phx
ldx ZPPtr1+1 local : fdef Ptr
phx
ldx ZPPtr2 local : type
phx
ldx ZPPtr2+1 local : qual
phx
ldx ZPPtr3 local : variadic size
phx
ldx ZPPtr3+1 local : bRetV
phx
>STYA ZPPtr2 save expected Type/qual
>LDYA ZPSymDefPtr
bcc .11
>LDYA.G CC.VarDefPtr
.11 >STYA ZPPtr1
ror ZPPtr3+1 bRetV
stz ZPPtr3 Reset VARIADIC byte count
jsr CC.GetNextCharNB skip '('
bcs .10
jsr CC.ZPPtr1GetW 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 CC.Q.FUNC,CC.Q.FASTCALL
cmp ZPPtr2+1
bne .91
txa
.1 >STYA ZPPtr2 save full T/Q for later
jsr CC.ZPPtr1GetNextW advance to arg list type
beq .7 end of list, go check ending ')'
*--------------------------------------
.3 cpy #CC.T.VARIADIC if VARIADIC, don't advance to next arg and assume type = 0
bne .4
ldy #0
lda #0
.4 jsr CC.ExpEval Y,A = 0 if VARIADIC
bcs .93
jsr CC.GetVarSize Y,A = Var Type/Qual
lda (ZPPtr1)
cmp #CC.T.VARIADIC
bne .50
txa X=VarSize
clc make sure pointer only 2 bytes
adc ZPPtr3
sta ZPPtr3 Add to byte count
bra .5
.50 jsr CC.ZPPtr1NextW
.5 jsr CC.GetCharNB
.10 bcs .90
cmp #','
bne .6
jsr CC.GetNextCharNB Skip ','
jsr CC.ZPPtr1GetW
bne .3 Another ARG....
bra .90 extra args....error
.6 cmp #')'
bne .90
jsr CC.ZPPtr1GetW
beq .8 no more arg after ')', exit
cpy #CC.T.VARIADIC
bne .90 missing arg
lda ZPPtr3 push VARIADIC byte count
jsr CODE.PUSHI
.7 jsr CC.GetCharNB
bcs .90
cmp #')'
bne .90
.8 jsr CC.GetNextCharNB Skip )
jsr CC.fExec2 X = LASTVAR sizeof (fastcall)
bra .93
.90 lda #E.CSYN
bra .92
.91 lda #E.TMISMATCH
.92 sec
.93 plx
stx ZPPtr3+1
plx
stx ZPPtr3
plx
stx ZPPtr2+1
plx
stx ZPPtr2
plx
stx ZPPtr1+1
plx
stx ZPPtr1
.99 rts
*--------------------------------------
* X = last var size
*--------------------------------------
CC.fExec2
* >LDYA ZPPtr2 function T/Q
* jsr CC.GetVarSize
* stx ZPPtr1 last var size
bit ZPPtr3+1 bRetV
bmi .5
* NO Return Value : call & discard stack if not in Y,A
lda ZPPtr2+1
bit #CC.Q.FASTCALL
beq .1
* ldx ZPPtr1 var size
dex
bne .19
jsr CODE.PULLA
bra .1
.19 jsr CODE.PULLYA
.1 lda ZPSymDataPtr+1
beq .9
ldy ZPSymDataPtr
>STYA ZPPtr3
jsr CC.fExec3
>LDYA ZPPtr2 function T/Q
jsr CC.GetVarSize
txa
beq .11 void
cpx #3 A or Y,A
bcc .11
.10 jsr CODE.INCPSTACK
dex
bne .10
.11 clc
rts
.9 lda #E.FUNDEF
sec
rts
* Return Value : call & put result on stack if in Y,A
.5 lda ZPPtr2+1
bit #CC.Q.FASTCALL
beq .6
* ldx ZPPtr1
dex
bne .64
jsr CODE.PULLA
bra .6
.64 jsr CODE.PULLYA
.6 >LDA.G CC.VarDataPtr+1
beq .9
sta ZPPtr3+1
dey
lda (pData),y
sta ZPPtr3
jsr CC.fExec3
>LDYA ZPPtr2 function T/Q
jsr CC.GetVarSize
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 CC.Q.FUNC+CC.Q.FASTCALL
clc
rts
*--------------------------------------
CC.fExec3 lda (ZPPtr3)
bne .1
ldy #1
lda (ZPPtr3),y
tax
* cpx #SYS.FClose
* bne .57
* >DEBUG
* ldy #0
*.56 lda PCC.DEBUG,y
* jsr CODE.EmitByte
* iny
* cpy #PCC.DEBUG.L
* bne .56
*.57
jsr CODE.SYSCALL
rts
.1 ldy #1
lda (ZPPtr3),y
tax
jsr CODE.FPUCALL
rts
*--------------------------------------
CC.fDecl >ENTER 2
lda #0
sta (pStack) hLocal
lda ZPSymType
jsr CC.fDeclAddA
lda ZPSymQual
jsr CC.fDeclAddA
jsr CC.GetNextCharNB Skip (
bcs .9
.1 cmp #')'
beq .6
.2 jsr CC.fDeclGetArg
bcs .99
pha
tya
jsr CC.fDeclAddA
pla
jsr CC.fDeclAddA
jsr CC.GetCharNB
bcs .9
jsr CC.IsLetter
bcs .5
* TODO: AddLocal
.3 jsr CC.GetNextCharNB
bcs .9
jsr CC.IsLetterOrDigit
bcc .3
.5 cmp #')'
beq .6
cmp #','
bne .9
jsr CC.GetNextCharNB Skip ,
bcs .9
bra .2
.6 jsr CC.GetNextCharNB Skip )
bcs .9
cmp #';'
beq .7
* TODO: f() body
bra .9
*--------------------------------------
.7
.8 lda #0
jsr CC.fDeclAddA
>LDYA ZPSymType T/Q
clc
bra .99
.9 lda #E.CSYN
sec
.99 >LEAVE
rts
*--------------------------------------
CC.fDeclGetArg 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 #CC.T.VARIADIC Type
* lda #0 Qual
* clc
rts
.5 >LDYA L.CC.TMODS
jsr CC.LookupID
bcs .9
jsr CC.tDecl
bcs .9
* Y,A = Type/Qual
bra .8
.9 lda #E.CSYN
sec
.8 rts
*--------------------------------------
CC.fDeclAddA sta (ZPCCfDecl)
inc ZPCCfDecl
bne .8
inc ZPCCfDecl+1
.8 rts
*--------------------------------------
CC.Link >STYA ZPPtr2
>LDYA L.CC.LIBC
>STYA ZPPtr1
stz ZPSymDataPtr
stz ZPSymDataPtr+1
ldy #0
.11 iny
lda (ZPPtr2),y
beq .12
jsr CC.IsLetterOrDigit
bcc .11
.12 phy Y = len
ldx #0
.1 lda (ZPPtr1)
beq .9 Ending 0, not found....
pla
pha Get Back Len
cmp (ZPPtr1) Same Len ?
bne .4
tay
.2 lda (ZPPtr1),y
dey
cmp (ZPPtr2),y
bne .4
tya
bne .2
pla Found keyword...
lda (ZPPtr1)
jsr CC.ZPPtr1AddAp1 Skip LEN\Symbol
>LDYA ZPPtr1
iny
bne .5
inc Skip LEN
.5 >STYA ZPSymDataPtr
clc
rts
.4 inx
inx
lda (ZPPtr1)
jsr CC.ZPPtr1AddAp1 Skip LEN\Symbol
lda (ZPPtr1)
jsr CC.ZPPtr1AddAp1 Skip LEN\definition
bra .1
.9 pla
sec
rts
*--------------------------------------
CC.tDecl >ENTER 2
lda #0
sta (pStack) Type
ldy #1
sta (pStack),y Qual
jsr .7
bcs .99
ldy #1
lda (pStack),y
pha
lda (pStack)
tay Y = Type
pla A = Qual
clc
.99 >LEAVE
rts
.7 jmp (J.CC.TMODS,x)
*--------------------------------------
CC.NewKey >PUSHA
>PUSHW ZPLineBufPtr
>SYSCALL SListNewKey
bcs .9
pha
txa
* clc
adc ZPLineBufPtr
sta ZPLineBufPtr
bcc .8
inc ZPLineBufPtr+1
clc
.8 pla Y,A = KeyID, X = KeyLen
.9 rts
*--------------------------------------
* Y,A = Type/Qual
*--------------------------------------
CC.SetValue cpy ZPSymType
bne .99
cmp ZPSymQual
bne .99
ldx ZPSymSizeOf
>LDYA ZPSymDataPtr
jsr CODE.PopXToYA
clc
rts
.99 lda #E.TMISMATCH
sec
rts
*--------------------------------------
CC.GetDefine >PUSHB.G CC.hDefines
jsr CC.Get
bcs .9
pha
phy
>PUSHB.G CC.hDefines
ply
pla
>PUSHYA KeyID
>PUSHWZ Allocate..
>PUSHWZ len = 0 (string mode)
>PUSHWZ From Start
>SYSCALL SListGetData
bcs .9
stx hDefine
>LDYA ZPLineBufPtr
>STYA.G CC.SaveDefine
txa
>SYSCALL GetMemPtr
>STYA ZPLineBufPtr
.9 rts
*--------------------------------------
CC.GetVar >PUSHB.G CC.hSymbols
CC.Get >PUSHW ZPLineBufPtr
>SYSCALL SListLookup
bcs .9
pha
txa
* clc
adc ZPLineBufPtr
sta ZPLineBufPtr
bcc .1
inc ZPLineBufPtr+1
clc
.1 pla Y,A = VarID
.9 rts
*--------------------------------------
CC.GetSymDef phy
pha
>PUSHB.G CC.hSymbols
pla
>PUSHA
pla
>PUSHA KeyID
>PUSHWI ZPSymDef
>PUSHWI 8 8 bytes
>PUSHWZ From Start
>SYSCALL SListGetData
rts
*--------------------------------------
* Stack
*--------------------------------------
CC.CheckStack ldy StackPtr
beq .9
cmp (ZPCCStack),y
bne .9
clc
rts
.9 lda #E.CSYN
sec
rts
*--------------------------------------
CC.PushCS lda ZPCCCode+1
jsr CC.Push
bcs CC.Push.RTS
lda ZPCCCode
*--------------------------------------
CC.Push ldy StackPtr
dey
beq .9
sty StackPtr
sta (ZPCCStack),y
clc
rts
.9 lda #E.STKOVERFLOW
sec
CC.Push.RTS rts
*--------------------------------------
CC.Pop ldy StackPtr
beq .9
lda (ZPCCStack),y
inc StackPtr
clc
rts
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
* CHAR related Subs.....
*--------------------------------------
CC.GetOPLen ldy #0
.1 iny
lda (ZPLineBufPtr),y
beq .8
jsr CC.IsOPChar
bcc .1
.8 tya
rts
*--------------------------------------
CC.GetIDLen ldy #0
.1 iny
lda (ZPLineBufPtr),y
beq .8
jsr CC.IsLetterOrDigit
bcc .1
.8 tya
rts
*--------------------------------------
CC.GetCharNB jsr CC.GetChar
bcs CC.GetNextCharNB.RTS
jsr CC.CheckCharNB
bcc CC.GetNextCharNB.RTS
*--------------------------------------
CC.GetNextCharNB
jsr CC.GetNextChar
bcs CC.GetNextCharNB.RTS
jsr CC.CheckCharNB
bcs CC.GetNextCharNB
CC.GetNextCharNB.RTS
rts
*--------------------------------------
CC.CheckSpace jsr CC.GetChar
bcs .90
cmp #C.SPACE
bne .90
jsr CC.GetNextCharNB
bcc .99
.90 lda #E.CSYN
sec
.99 rts
*--------------------------------------
CC.CheckCharNB cmp #C.SPACE
beq .9
cmp #C.TAB
beq .9
clc
.9 rts
*--------------------------------------
CC.GetNextChar inc ZPLineBufPtr
bne CC.GetChar
inc ZPLineBufPtr+1
*--------------------------------------
CC.GetChar lda (ZPLineBufPtr)
bne .8
lda hDefine
beq .1
stz hDefine
phx
phy
>SYSCALL FreeMem
>LDYA.G CC.SaveDefine
>STYA ZPLineBufPtr
ply
plx
bra CC.GetChar
.1 lda #C.CR
.8 clc
rts
.9 lda #MLI.E.EOF
sec
.99 rts
*---------------------------------------
CC.IsEndArg
*---------------------------------------
CC.IsOPChar ldx #CC.OPChars.Cnt-1
.1 cmp CC.OPChars,x
beq .8
dex
bpl .1
sec
rts
.8 clc
rts
*---------------------------------------
CC.IsLetterOrDigit
jsr CC.IsDigit10
bcc CC.IsLetterRTS
*---------------------------------------
CC.IsLetter cmp #'_'
bne .1
clc
rts
.1 cmp #'A'
bcc .9
cmp #'Z'+1
bcc CC.IsLetterRTS
cmp #'a'
bcc .9
cmp #'z'+1
rts CC if lowercase
.9 sec
CC.IsLetterRTS rts
*---------------------------------------
CC.IsDigit10 cmp #'0'
bcc .9
cmp #'9'+1
rts cc if ok, cs if not
.9 sec
rts
*--------------------------------------
* in : Y,A = type/qual
* out : X = size
*--------------------------------------
CC.GetVarSize and #CC.Q.PPPOINTER
bne .2
ldx CC.TYPESIZE-1,y
clc
rts
.2 ldx #2 pointer
sec +1 for hMem Storage
rts
*--------------------------------------
MAN
SAVE usr/src/bin/cc.s.core
LOAD usr/src/bin/cc.s
ASM