A2osX/BIN/ACOS.S.CORE.txt

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

				ldy ZPADDR
				ldx ZPADDR+1
				jsr CODE.LDYXI
				
				ldx #RT.StrSet.ID
				jsr CODE.JSRRT			Store String in hSTRV
				bra .8

.4				ldy ZPADDR
				ldx ZPADDR+1
				jsr CODE.LDYXI
				
				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

				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 ZPADDR
				sta (ZPPtr1)
				ldy #1
				lda ZPADDR+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.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 .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.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 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

				jsr CORE.GetStr
				bra .10

.1				jsr CORE.GetWord
.10				>STYA ZPADDR

				>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.GetWord	lda ZPDataBufPtr
				tay
				clc
				adc #2					Word
				sta ZPDataBufPtr

				lda ZPDataBufPtr+1
				bcc .8
				
				inc ZPDataBufPtr+1

				clc
				
.8				rts
*--------------------------------------
CORE.GetStr		>LDYA STRID
				inc STRID
				bne .8

				inc STRID+1

.8				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