A2osX/BIN/ACOS.S.CORE.txt
2021-08-06 19:58:04 +02:00

871 lines
14 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 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 ZPStrBuf1
txa
>STA.G hStrBuf1
>LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPStrBuf2
txa
>STA.G hStrBuf2
>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 #hStrBuf2
jsr CORE.Quit.Freemem
ldy #hStrBuf1
jsr CORE.Quit.Freemem
ldy #hDataBuf
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 .39
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
.39 bcs .99
jsr CORE.GetCharNB
bcs .90
cmp #'='
bne .90
jsr CORE.GetNextCharNB skip '='
bcs .90
jsr EXP.Eval VAR.TYPE set by CreateOrGetVar
bcs .99
lda VAR.TYPE
cmp EXP.TYPE
bne .91
tax
beq .4
jsr CODE.LDVARDDRI
ldx #RT.StrSet.ID
jsr CODE.JSRRT Store String in hSTRV
bra .8
.4 jsr CODE.LDVARDDRI
ldx #RT.IntSet.ID
jsr CODE.JSRRT 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
lda (pData),y
cmp #KWID.IF
bne .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 >LDYA L.MSG.FWREF
>SYSCALL PutS
>LDA.G hFWRefBuf
>SYSCALL GetMemPtr
>STYA ZPInputBufPtr
.1 lda (ZPInputBufPtr)
beq .8
.2 sta ZPPtr1+1
jsr CORE.GetNextChar
sta ZPPtr1
jsr CORE.GetNextChar
jsr CORE.GetLabel
bcs .9
lda VAR.ADDR
sta (ZPPtr1)
ldy #1
lda VAR.ADDR+1
sta (ZPPtr1),y
jsr CORE.GetNextChar skip \0
bcc .2
.8 clc
rts
.9 >PUSHW L.MSG.FWREFERR
>PUSHW ZPInputBufPtr
>PUSHBI 2
>SYSCALL PrintF
lda #E.CSYN
sec
rts
*--------------------------------------
CORE.Run jsr CORE.Cleanup
>PUSHW L.MSG.RUN
lda ZPCodeBufPtr
sta ZPPtr1
lda ZPCodeBufPtr+1
sta ZPPtr1+1
>LDA.G hCodeBuf
>SYSCALL GetMemPtr
>STYA ZPCodeBufPtr
lda ZPPtr1
sec
sbc ZPCodeBufPtr
pha
lda ZPPtr1+1
sbc ZPCodeBufPtr+1
>PUSHA
pla
>PUSHA Code Size
lda ZPDataBufPtr
sta ZPPtr1
lda ZPDataBufPtr+1
sta ZPPtr1+1
>LDA.G hDataBuf
>SYSCALL GetMemPtr
>STYA ZPDataBufPtr
lda ZPPtr1
sec
sbc ZPDataBufPtr
pha
eor #$ff
sta ZPPtr2
lda ZPPtr1+1
sbc ZPDataBufPtr+1
>PUSHA
eor #$ff
sta ZPPtr2+1
pla
>PUSHA Data Size
>PUSHBI 4
>SYSCALL PrintF
lda #0
tay
.1 inc ZPPtr2
bne .2
inc ZPPtr2+1
beq .8
.2 sta (ZPDataBufPtr),y
iny
bne .1
inc ZPDataBufPtr+1
bra .1
.8 jmp (ZPCodeBufPtr)
*--------------------------------------
CORE.LookupAOPS lda (ZPInputBufPtr)
jsr CORE.IsOPSChar
bcc .55
jsr CORE.IsLetter
bcs .99
sec
.55 ror bFlag
>LDYA L.ACOS.AOPS
>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 .6 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.LookupLOPS >LDYA L.ACOS.LOPS
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 .6 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 VAR.ID
>PUSHB.G hLabels
>PUSHW VAR.ID
>PUSHWI ZPCodeBufPtr
>PUSHWI 2 2 bytes : ADDR
>SYSCALL SListAddData
.9 rts
*--------------------------------------
CORE.GetLabel >PUSHB.G hLabels
>PUSHW ZPInputBufPtr
>SYSCALL SListLookup
bcs .9
>STYA VAR.ID
txa
jsr CORE.SkipA
>PUSHB.G hLabels
>PUSHW VAR.ID
>PUSHWI VAR.ADDR
>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 .7
jsr CORE.NewVarKey
bcs .9
>STYA VAR.ID
jsr CORE.GetVarType
stx VAR.TYPE
beq .1
jsr CORE.GetStrID
bra .2
.1 jsr CORE.GetWord
.2 >STYA VAR.ADDR
>PUSHB.G hVars
>PUSHW VAR.ID
>PUSHWI VAR.ADDR
>PUSHWI 3 3 bytes : ADDR + TYPE
>SYSCALL SListAddData
rts
*--------------------------------------
.7 jsr CORE.GetVarType
cpx VAR.TYPE
beq .8
lda #E.TMISMATCH
sec
rts
.8 clc
.9 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 VAR.ID
txa
jsr CORE.SkipA
.1 >PUSHW VAR.ID
>PUSHWI VAR.ADDR
>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.GetWord lda ZPDataBufPtr
tay
clc
adc #2 Word
sta ZPDataBufPtr
lda ZPDataBufPtr+1
bcc .8
inc ZPDataBufPtr+1
clc
.8 rts
*--------------------------------------
CORE.GetStrID inc STRID
bne .8
inc STRID+1
.8 >LDYA STRID
clc
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
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