A2osX/BIN/CC.S.CORE.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

600 lines
9.3 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
*--------------------------------------
CORE.Init lda #SL._
>SYSCALL SListNew
bcs .9
>STA.G CC.hDefines
lda #SL._
>SYSCALL SListNew
bcs .9
>STA.G CC.hTags
lda #SL._
>SYSCALL SListNew
bcs .9
>STA.G CC.hSyms
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPSymBufPtr
txa
>STA.G CC.hSymBuf
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ScopeStk
txa
>STA.G CC.hScopeStk
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA StmtStk
txa
>STA.G CC.hStmtStk
lda #'_'
>STA.G CC.Label
lda #CC.LookupIdx
tay
sta (pData),y
* clc
.9 rts
*--------------------------------------
CORE.Quit jsr FIO.FClose
bne CORE.Quit
>LDA.G CC.hSyms
beq .1
>SYSCALL SListFree
.1 >LDA.G CC.hTags
beq .2
>SYSCALL SListFree
.2 >LDA.G CC.hDefines
beq .4
>SYSCALL SListFree
.4 >LDA.G CC.hDefineBuf
jsr .7
>LDA.G CC.hSymBuf
jsr .7
.5 jsr SYM.LookupFree
bcc .5
>LDA.G CC.hScopeStk
jsr .7
>LDA.G CC.hStmtStk
.7 beq .8
>SYSCALL FreeMem
.8 rts
*--------------------------------------
CORE.CompileFile
>SLEEP
ldy #S.PS.hStdIn
lda (pPS),y
>SYSCALL FEOF
bcs .9
tay
bne .1
>SYSCALL GetChar
bcs .9 I/O err
cmp #3 Ctrl-C
beq .9
.1 jsr FIO.FGetS
bcs .9
jsr CORE.CompileLine
bcc CORE.CompileFile
.9 rts
*--------------------------------------
CORE.CompileLine
jsr CC.GetCharNB
bcs .9
cmp #C.CR EOL....
beq .8
cmp #'#' directive ?
bne .1
jmp DIR
.1 cmp #'/'
bne .2 comments ...
jmp CORE.Comments
.2 cmp #'}' End of CPStmt ?
bne .3
jsr CORE.GetNCharNBNL Skip '}'
jsr STMT.CPStmt.END
bcs .9
jsr CORE.GetCharNBNL
bcc CORE.CompileLine
rts
*--------------------------------------
.3 cmp #';' End of Stmt ?
bne .4
jsr CORE.GetNCharNBNL Skip ';'
jsr STMT.Stmt.END
bcs .9
bra CORE.CompileLine
.4 jsr CORE.CompileStmt
bcs .9
bra CORE.CompileLine
.8 clc
.9 rts
*--------------------------------------
* keyword : for, while ....
*--------------------------------------
CORE.CompileStmt
>LDYA L.CC.KW
jsr CC.LookupID
bcs .1 not an internal CC keyword....
txa
>STA.G CC.CmdSave
jmp (J.CC.KW,x)
*--------------------------------------
* Declaration : typedef, type var or type func()
*--------------------------------------
.1 >LDYA L.CC.SCSPEC
jsr CC.LookupID
bcs .2
jmp (J.CC.SCSPEC,x)
.2 >LDYA L.CC.TYPEQUAL
jsr CC.LookupID
bcs .3
jmp DECL.X
*--------------------------------------
* Statement : ++var, var=, func();
*--------------------------------------
.3 jmp STMT.Get
*--------------------------------------
.99 lda #E.CSYN
sec
.9 rts
*--------------------------------------
CORE.Comments jsr CC.GetNextChar TODO : /* ... */
cmp #'/'
bne .90
jmp CORE.SkipLine skip line.....
.90 lda #E.CSYN
sec
rts
*--------------------------------------
CORE.SkipLine jsr CC.GetNextChar
bcs .9
cmp #C.CR
bne CORE.SkipLine
clc
.9 rts
*--------------------------------------
CC.LookupID >STYA ZPLookupPtr
jsr CC.GetIDLen
bra CC.Lookup
CC.LookupAOP >LDYA L.CC.AOPS
>STYA ZPLookupPtr
ldy #$ff
.1 iny
lda (ZPLineBufPtr),y
sec
beq .9
jsr CC.IsOPChar
bcs .9
cmp #'='
bne .1
iny
.8 tya
bra CC.Lookup
.9 rts
CC.LookupOP >STYA ZPLookupPtr
jsr CC.GetOPLen
CC.Lookup phy Y = len
ldx #0
.1 lda (ZPLookupPtr)
beq .9 Ending 0, not found....
pla
pha Get Back Len
cmp (ZPLookupPtr) Same Len ?
bne .4
tay
.2 lda (ZPLookupPtr),y
.3 dey
cmp (ZPLineBufPtr),y
bne .4
tya
bne .2
pla Found keyword...
jsr CC.SkipA ..advance Ptr to char after it..
lda ZPLookupPtr
sec
adc (ZPLookupPtr)
tay
lda ZPLookupPtr+1
adc #0
clc Y,A = F() def, X = F() index
rts
.4 inx
inx
lda (ZPLookupPtr)
jsr CC.ZPLookupPtrAddAp1
bra .1
.9 ldx #$FF
pla
sec
rts
*--------------------------------------
CC.ZPLookupPtrAddAp1
sec
adc ZPLookupPtr
sta ZPLookupPtr
bcc .1
inc ZPLookupPtr+1
.1 rts
*--------------------------------------
CC.GetDefine >LDA.G CC.hDefines
jsr CC.SListLookup
bcs .9
>LDYA ZPLineBufPtr
>STYA.G CC.SaveDefine
txa
>STA.G CC.hDefineBuf
>SYSCALL GetMemPtr
>STYA ZPLineBufPtr
.9 rts
*--------------------------------------
CC.SListLookup >PUSHA hSList
>PUSHA ...for SListGetData
>PUSHW ZPLineBufPtr
>PUSHWI 0 ScopeID
>SYSCALL SListLookup
bcs .99
>PUSHA KeyID.HI
tya
>PUSHA KeyID.LO
jsr CC.SkipX
>PUSHWZ allocate
>PUSHWI 65535 all
>PUSHWZ From Start
>SYSCALL SListGetData
.9 rts Y,A = SymSize, X = hSymBuf
.99 inc pStack discard extra hSList
rts
*--------------------------------------
* CT Stack
*--------------------------------------
CC.Push ldy StmtPtr
dey
beq .9
sty StmtPtr
sta (StmtStk),y
clc
rts
.9 lda #E.STKOVERFLOW
sec
rts
*--------------------------------------
* ZPLineBufPtr related Subs.....
*--------------------------------------
CC.SkipX txa
CC.SkipA clc
adc ZPLineBufPtr
sta ZPLineBufPtr
bcc .8
inc ZPLineBufPtr+1
.8 rts
*--------------------------------------
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 CORE.GetNCharNB.RTS
jsr CC.CheckCharNB
bcc CORE.GetNCharNB.RTS
*--------------------------------------
CORE.GetNCharNB jsr CC.GetNextChar
bcs CORE.GetNCharNB.RTS
jsr CC.CheckCharNB
bcs CORE.GetNCharNB
CORE.GetNCharNB.RTS
rts
*--------------------------------------
CORE.GetCharNBNL
jsr CC.GetChar
bcs CORE.GetNCharNB.RTS
jsr CC.CheckCharNB
bcs CORE.GetNCharNBNL
cmp #C.CR
clc
bne CORE.GetNCharNB.RTS
jsr FIO.FGetS
bcc CORE.GetCharNBNL
rts
*--------------------------------------
CORE.GetNCharNBNL
jsr CORE.GetNCharNB
bcs .9
cmp #C.CR
clc
bne .9
jsr FIO.FGetS
bcc CORE.GetCharNBNL
.9 rts
*--------------------------------------
CC.CheckSpace jsr CC.GetChar
bcs .90
cmp #C.SPACE
bne .90
jsr CORE.GetNCharNB
bcc .99
.90 lda #E.CSYN
sec
.99 rts
*--------------------------------------
CC.CheckCharNB cmp #C.SPACE
beq .9
cmp #C.TAB
beq .9
clc
.9 rts
*--------------------------------------
* https://riptutorial.com/c/example/16255/character-literals
* 'c', '\abefnrtv', '\123', '\xFF'
*--------------------------------------
CC.GetNextCharEsc
jsr CC.GetNextChar
bcs .9
cmp #'\'
bne .8
jsr CC.GetNextChar
bcs .8
ldx #CC.EscChars.Cnt-1
.1 cmp CC.EscChars,x
beq .6
dex
bpl .1
* TODO : \123, \xFF
sec
rts
.6 lda CC.EscCodes,x
bit .9
clc
rts
.8 clc
clv
.9 rts
*--------------------------------------
CC.GetNextChar inc ZPLineBufPtr
bne CC.GetChar
inc ZPLineBufPtr+1
*--------------------------------------
CC.GetChar lda (ZPLineBufPtr)
bne .8
phy
>LDA.G CC.hDefineBuf
beq .1
phx
>SYSCALL FreeMem
>STZ.G CC.hDefineBuf
>LDYA.G CC.SaveDefine
>STYA ZPLineBufPtr
plx
ply
bra CC.GetChar
.1 ply
lda #C.CR
.8 clc
rts
*---------------------------------------
CC.IsEndArg cmp #']'
beq .8
cmp #','
beq .8
cmp #';'
beq .8
cmp #':'
beq .8
cmp #')'
beq .8
sec
rts
.8 clc
rts
*---------------------------------------
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
*--------------------------------------
MAN
SAVE usr/src/bin/cc.s.core
LOAD usr/src/bin/cc.s
ASM