A2osX/BIN/ACOS.S.CORE.txt
2021-06-22 20:59:02 +02:00

803 lines
13 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
*--------------------------------------
CORE.Init ldy #CCS.MAX
sty pCCS
>LDYAI CODESEG
>SYSCALL GetMem
bcs .9
>STYA ZPCodeBufPtr
txa
>STA.G hCodeBuf
>LDYAI CONSTSEG
>SYSCALL GetMem
bcs .9
>STYA ZPConstBufPtr
txa
>STA.G hConstBuf
>LDYAI DATASEG
>SYSCALL GetMem
bcs .9
>STYA ZPDataBufPtr
txa
>STA.G hDataBuf
>SYSCALL SListNew
bcs .9
>STA.G hLabels
>SYSCALL SListNew
bcs .9
>STA.G hVars
>LDYAI STRVSEG
>SYSCALL StrVNew
bcs .9
sta hStrings
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPStrBuf
txa
>STA.G hStrBuf
>LDYAI FWREF
>SYSCALL GetMem
>STYA ZPFWRefBufPtr
txa
>STA.G hFWRefBuf
lda #0
sta (ZPFWRefBufPtr)
clc
.9 rts
*--------------------------------------
CORE.Quit lda hStrings
beq .1
>SYSCALL StrVFree
.1 ldy #hStrBuf
jsr CORE.Quit.Freemem
ldy #hDataBuf
jsr CORE.Quit.Freemem
ldy #hConstBuf
jsr CORE.Quit.Freemem
ldy #hCodeBuf
jsr CORE.Quit.Freemem
*--------------------------------------
CORE.Cleanup ldy #hFWRefBuf
jsr CORE.Quit.Freemem
>LDA.G hVars
beq .1
>SYSCALL SListFree
>STZ.G hVars
.1 >LDA.G hLabels
beq .8
>SYSCALL SListFree
>STZ.G hLabels
.8 clc
CORE.Quit.RTS rts
*--------------------------------------
CORE.Quit.Freemem
lda (pData),y
beq .8
pha
lda #0
sta (pData),y
pla
>SYSCALL FreeMem
.8 rts
*--------------------------------------
CORE.Compile jsr CORE.GetChar
bcs CORE.Quit.RTS
cmp #'#'
beq .80 #/bin/acos....
cmp #';'
bne .1
.80 jmp CORE.SkipLine Comment: skip line...
.1 cmp #C.CR
beq .88 EOL
jsr CORE.CheckCharNB
bcs .2 CS=SPACE -> go check VAR or KW
jsr CORE.IsLetter LABEL must start with a letter
bcs .99
jsr CORE.CreateLabel
bcs .99
bra .8
*--------------------------------------
.2 jsr CORE.GetNextCharNB skip SPACE(s) or ":"
bcs .99
.21 cmp #C.CR
beq .88 EOL
jsr CORE.IsLetter
bcs .90
>LDYA L.ACOS.KW
jsr CORE.LookupSkip
bcs .3
jsr CORE.KW.JMP
bcs .99
bra .8
*--------------------------------------
.3 jsr CORE.CreateOrGetVar
bcs .99
jsr CORE.GetCharNB
bcs .90
cmp #'='
bne .90
jsr CORE.GetNextCharNB skip '='
bcs .90
jsr EXP.Eval ZPTYPE set by CreateOrGetVar
bcs .99
lda ZPTYPE
cmp EXP.TYPE
bne .91
tax
beq .4
jsr CODE.STRSET Store String in hSTRV
bra .8
.4 jsr CODE.INTSET Store Int16 result in DATASEG
*--------------------------------------
.8 jsr CORE.GetCharNB
bcs .88
cmp #':'
beq .2 go skip : and continue
bra .21
.88 ldy pCCS
bmi .89
jsr KW.ENDIF
bcs .99
.89 clc
jmp CORE.GetNextChar skip char
.90 lda #E.CSYN
sec
.99 rts
.91 lda #E.TMISMATCH
sec
rts
*--------------------------------------
CORE.KW.JMP jmp (J.ACOS.KW,x)
*--------------------------------------
CORE.FWREF >LDA.G hFWRefBuf
>SYSCALL GetMemPtr
>STYA ZPInputBufPtr
.1 lda (ZPInputBufPtr)
beq .8
sta ZPPtr1+1
jsr CORE.GetNextChar
sta ZPPtr1
jsr CORE.GetNextChar
jsr CORE.GetLabel
bcs .9
lda ZPADDR
sta (ZPPtr1)
ldy #1
lda ZPADDR+1
sta (ZPPtr1),y
bra .1
.8 clc
rts
.9 >PUSHW L.MSG.FWREFERR
>PUSHW ZPInputBufPtr
>PUSHBI 2
>SYSCALL PrintF
sec
rts
*--------------------------------------
CORE.Run lda #$60 RTS
sta (ZPCodeBufPtr)
jsr CORE.Cleanup
lda ZPCodeBufPtr
sta ZPPtr1
lda ZPCodeBufPtr+1
sta ZPPtr1+1
>LDA.G hCodeBuf
>SYSCALL GetMemPtr
>STYA ZPCodeBufPtr
lda ZPPtr1
sec
sbc ZPCodeBufPtr
sta ZPPtr2
lda ZPPtr1+1
sbc ZPCodeBufPtr+1
sta ZPPtr2+1
>PUSHW L.MSG.RUN
>PUSHW ZPPtr2
>PUSHBI 2
>SYSCALL PrintF
jmp (ZPCodeBufPtr)
*--------------------------------------
CORE.LookupOPS lda (ZPInputBufPtr)
jsr CORE.IsOPSChar
bcc .55
jsr CORE.IsLetter
bcs .99
sec
.55 ror bFlag
>LDYA L.ACOS.OPS
>STYA ZPPtr1
ldx #0
.1 ldy #$ff
.2 jsr .10 get next valid char in src text
bcs .4
jsr CORE.ToUpperCase
eor (ZPPtr1),y match table char ?
asl compare only 7 bits
bne .6 no match...get next table keyword
bcc .2 not last char in this keyword
jsr .10 next char in text...
bcc .4 valid....failed
.3 tya Keyword Len
jmp CORE.SkipA
.4 dey
lda (ZPPtr1),y was last char in this keyword ?
bmi .3
iny
.5 jsr CORE.IncPtr1 skip chars to next keyword
.6 lda (ZPPtr1)
bpl .5
jsr CORE.IncPtr1
inx
lda (ZPPtr1) Array Ending 0, lookup failed
bne .1
.9 sec
rts
*--------------------------------------
.10 iny
lda (ZPInputBufPtr),y Get Src text char...
beq .19 end of text
bit bFlag
bmi .11 Letter expected
jmp CORE.IsOPSChar
.11 jmp CORE.IsLetter
.19 sec
.99 rts
*--------------------------------------
CORE.LookupSkip sec
.HS 90 BCC
CORE.Lookup clc
php
>STYA ZPPtr1
ldx #0
.1 ldy #$ff
.2 jsr .10 get next valid char in src text
bcs .4
jsr CORE.ToUpperCase
eor (ZPPtr1),y match table char ?
asl compare only 7 bits
bne .6 no match...get next table keyword
bcc .2 not last char in this keyword
jsr .10 next char in text...
bcc .4 valid....failed
.3 plp
bcc .8
tya Keyword Len
jmp CORE.SkipA
.4 dey
lda (ZPPtr1),y was last char in this keyword ?
bmi .3
iny
.5 jsr CORE.IncPtr1 skip chars to next keyword
.6 lda (ZPPtr1)
bpl .5
jsr CORE.IncPtr1
inx
inx
lda (ZPPtr1) Array Ending 0, lookup failed
bne .1
plp
.9 sec
.8 rts
*--------------------------------------
.10 iny
lda (ZPInputBufPtr),y Get Src text char...
beq .9 end of text
cmp #'$'
bne .11
clc
rts
.11 jmp CORE.IsLetterOrDigit CS=end of valid chars
*--------------------------------------
CORE.IncPtr1 inc ZPPtr1
bne .8
inc ZPPtr1+1
.8 rts
*--------------------------------------
CORE.CreateLabel
>LDA.G hLabels
jsr CORE.NewKey
bcs .9
>STYA ZPSID
>PUSHB.G hLabels
>PUSHW ZPSID
>PUSHWI ZPCodeBufPtr
>PUSHWI 2 2 bytes : ADDR
>SYSCALL SListAddData
.9 rts
*--------------------------------------
CORE.GetLabel >PUSHB.G hLabels
>PUSHW ZPInputBufPtr
>SYSCALL SListLookup
bcs .9
>STYA ZPSID
txa
jsr CORE.SkipA
>PUSHB.G hLabels
>PUSHW ZPSID
>PUSHWI ZPADDR
>PUSHWI 2 2 bytes : ADDR
>PUSHWZ From Start
>SYSCALL SListGetData
.9 rts
*--------------------------------------
CORE.AddFWRef lda ZPCodeBufPtr+1
jsr CORE.2FWRefBuf
lda ZPCodeBufPtr
jsr CORE.2FWRefBuf
ldy #$ff
.1 iny
lda (ZPInputBufPtr),y
beq .8
jsr CORE.IsIDValid
bcs .8
jsr CORE.2FWRefBuf
bra .1
.8 tya
jsr CORE.SkipA
lda #0
clc
*--------------------------------------
CORE.2FWRefBuf sta (ZPFWRefBufPtr)
inc ZPFWRefBufPtr
bne .8
inc ZPFWRefBufPtr+1
.8 rts
*--------------------------------------
CORE.CreateOrGetVar
>LDA.G hVars
jsr CORE.GetAddr
bcc .2
jsr CORE.NewVarKey
bcs .99
>STYA ZPSID
jsr CORE.GetVarType
stx ZPTYPE
beq .1
lda STRID
sta ZPADDR
lda STRID+1
sta ZPADDR+1
inc STRID
bne .10
inc STRID+1
bra .10
.1 lda ZPDataBufPtr
sta ZPADDR
clc
adc #2 Word
sta ZPDataBufPtr
lda ZPDataBufPtr+1
sta ZPADDR+1
adc #0
sta ZPDataBufPtr+1
.10 >PUSHB.G hVars
>PUSHW ZPSID
>PUSHWI ZPADDR
>PUSHWI 3 3 bytes : ADDR + TYPE
>SYSCALL SListAddData
rts
*--------------------------------------
.2 jsr CORE.GetVarType
cpx ZPTYPE
bne .90
clc
rts
.90 lda #E.TMISMATCH
sec
.99 rts
*--------------------------------------
CORE.NewVarKey >LDA.G hVars
CORE.NewKey >PUSHA
>PUSHW ZPInputBufPtr
>SYSCALL SListNewKey
bcs .9
pha
txa
jsr CORE.SkipA
pla Y,A = KeyID
clc
.9 rts
*--------------------------------------
CORE.GetAddr >PUSHA
>PUSHA for SListGetData
>PUSHW ZPInputBufPtr
>SYSCALL SListLookup
bcs .9
>STYA ZPSID
txa
jsr CORE.SkipA
.1 >PUSHW ZPSID
>PUSHWI ZPADDR
>PUSHWI 3 3 bytes : ADDR + TYPE
>PUSHWZ From Start
>SYSCALL SListGetData
rts
.9 >POP 1
rts
*--------------------------------------
CORE.GetVarType jsr CORE.GetChar
bcs .9
cmp #'$'
bne .9
inc ZPInputBufPtr
bne .1
inc ZPInputBufPtr+1 skip $
.1 tax NZ
rts
.9 ldx #0 Z
rts
*--------------------------------------
CORE.ToUpperCase
cmp #'a'
bcc .8
cmp #'z'+1
bcs .8
eor #$20
.8
CORE.ToUpperCase.RTS
rts
*--------------------------------------
CORE.IsOPSChar phx
ldx #ACOS.OPSChars.Cnt-1
.1 cmp ACOS.OPSChars,x
beq .8
dex
bpl .1
plx
sec
rts
.8 plx
clc
rts
*--------------------------------------
CORE.IsKW jsr CORE.IsLetter
bcs .9
>LDYA L.ACOS.KW
jmp CORE.Lookup
.9 rts
*--------------------------------------
CORE.IsEndExp cmp #')' CS = true
beq CORE.ToUpperCase.RTS
cmp #','
beq CORE.ToUpperCase.RTS
cmp #';'
beq CORE.ToUpperCase.RTS
CORE.IsEndInst cmp #':' CS = true
beq .8
cmp #C.CR
beq .8
clc
.8 rts
*---------------------------------------
CORE.IsIDValid cmp #'.'
clc
beq CORE.IsLetterRTS
*---------------------------------------
CORE.IsLetterOrDigit
jsr CORE.IsDigit10
bcc CORE.IsLetterRTS
*---------------------------------------
CORE.IsLetter cmp #'_' CC = true
bne .1
clc
rts
.1 cmp #'A'
bcc .9
cmp #'Z'+1
bcc CORE.IsLetterRTS
cmp #'a'
bcc .9
cmp #'z'+1
rts CC if lowercase
.9 sec
CORE.IsLetterRTS
rts
*---------------------------------------
CORE.IsDigit10 cmp #'0'
bcc .9
cmp #'9'+1
rts cc if ok, cs if not
.9 sec
rts
*--------------------------------------
CORE.CheckOP jsr CORE.GetCharNB
bcs CORE.CheckCP.CSYN
cmp #'('
bne CORE.CheckCP.CSYN
jsr CORE.GetNextCharNB skip (
clc
rts
*--------------------------------------
CORE.CheckComma jsr CORE.GetCharNB
bcs CORE.CheckCP.CSYN
cmp #','
bne CORE.CheckCP.CSYN
jsr CORE.GetNextCharNB skip ,
clc
rts
*--------------------------------------
CORE.CheckCP jsr CORE.GetCharNB
bcs CORE.CheckCP.CSYN
cmp #')'
bne CORE.CheckCP.CSYN
jsr CORE.GetNextCharNB skip )
clc
rts
CORE.CheckCP.CSYN
lda #E.CSYN
sec
rts
*--------------------------------------
CORE.CheckCharNB
cmp #C.SPACE
beq .9
cmp #C.LF
beq .9
cmp #C.TAB
beq .9
clc
.9 rts
*--------------------------------------
CORE.GetCharNB jsr CORE.GetChar
bcs CORE.GetNextCharNB.RTS
jsr CORE.CheckCharNB
bcc CORE.GetNextCharNB.RTS
*--------------------------------------
CORE.GetNextCharNB
jsr CORE.GetNextChar
bcs CORE.GetNextCharNB.RTS
jsr CORE.CheckCharNB
bcs CORE.GetNextCharNB
CORE.GetNextCharNB.RTS
rts
*--------------------------------------
CORE.SkipA clc
adc ZPInputBufPtr
sta ZPInputBufPtr
bcc .1
clc
inc ZPInputBufPtr+1
.1 rts Exit with CC for JMP to
*--------------------------------------
CORE.SkipLine jsr CORE.GetNextChar
bcs CORE.GetNextCharNB.RTS
cmp #C.CR
bne CORE.SkipLine
*--------------------------------------
CORE.GetNextChar
inc ZPInputBufPtr
bne CORE.GetChar
inc ZPInputBufPtr+1
*--------------------------------------
CORE.GetChar lda (ZPInputBufPtr)
bne .8
lda #MLI.E.EOF
sec
rts
.8 clc
rts
*--------------------------------------
MAN
SAVE usr/src/bin/acos.s.core
LOAD usr/src/bin/acos.s
ASM