A2osX/BIN/CSH.S.CORE.txt

NEW
PREFIX
AUTO 4,1
				.LIST OFF	
*--------------------------------------
CSH.Init		lda #$0
				>STA.G CSH.SymbolsPtr
				>STA.G CSH.DataPtr
				>STA.G CSH.StackPtr
				
				>LDYAI 256
				>SYSCALL GetMem0
				bcs .9
				txa
				>STA.G CSH.hSymbols
				>SYSCALL GetMemPtr
				>STYA ZPCSHSymbols
				
				>LDYAI 256
				>SYSCALL GetMem
				bcs .9
				txa
				>STA.G CSH.hData
				>SYSCALL GetMemPtr
				>STYA ZPCSHData
				
				>LDYAI 256
				>SYSCALL GetMem
				bcs .9
				txa
				>STA.G CSH.hStack
				>SYSCALL GetMemPtr
				>STYA ZPCSHStack
				
*				clc
.9				rts
*--------------------------------------
CSH.Quit		>LDA.G hFileBuf
				beq .1
				>SYSCALL FreeMem

.1				>LDA.G CSH.hStack
				beq .2
				>SYSCALL FreeMem
				
.2				>LDA.G CSH.hData
				beq .3
				>SYSCALL FreeMem
				
.3				>LDA.G CSH.hSymbols
				beq .8
				>SYSCALL FreeMem
				
.8				rts
*--------------------------------------
CSH.Run			jsr CSH.GetCharNB
				bcs .9
								
				cmp #'}'				End of block ?
				bne .1

				jsr CSH.CheckStack		must be something on stack....
				bcs .9
				
				jsr CSH.Pop				was expected, get stacked Cmd...
				tax
				jmp (J.CSH.KW.END,x) 
				
.1				cmp #$0D
				bne .2
				
				jmp CSH.GetNextCharNB	Skip CR and exit
				
.2				pha
				jsr CSH.SavePtr			Save Ptr, in case of while,for....
				pla
				jsr CSH.IsLetter
				bcc .3
				
				cmp #'#'
				beq .80					comments ...
				
				bra .9					error, todo : PREOPS ++ --.....
				
.3				>LDYA L.CSH.KW
				jsr CSH.LookupID

				bcs .4					not an internal CSH keyword....
				
				txa	
				>STA.G CSH.CmdSave
				
				jmp (J.CSH.KW,x)

.4				jsr CSH.GetVar
				bcs .9
				
				
				jsr CSH.GetCharNB
				bcs .9
				cmp #'='
				bne .99
				
				jsr CSH.GetNextCharNB	Skip =
				bcs .99
				
				jsr CSH.ExpEval
				bcs .9
				
				jsr CSH.StoreACCToVar
				bcs .9
				
				jsr CSH.GetChar
				cmp #';'
				bne .99
				
				jmp CSH.GetNextCharNB	Skip ;
				
.99				lda #CSH.E.SYNTAX
				sec
.9				rts

				
				
.80				jsr CSH.GetNextChar
				bcs .9
				cmp #C.CR
				bne .80
				
				clc
				rts
*--------------------------------------
CSH.WHILE
CSH.IF			jsr CSH.GetCharNB
				bcs .9
				cmp #'('
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9

				jsr CSH.ExpEval
				bcs .99
				
				jsr CSH.GetCharNB
				bcs .99
				cmp #')'
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .99
				cmp #'{'
				bne .9
				
				jsr CSH.IsACC0
				bcc .6					eval returned ACC=0, skip {{....}}
				
				jsr CSH.GetNextCharNB	Skip '{'
				bcs .99
				
				>LDA.G CSH.CmdSave		get back Token ("IF" or "WHILE")
				tax
				jsr CSH.Keyword.start 
				bcs .99
				
				lda #'}'				Tell '}' is expected at the end of block
				jsr CSH.Push
				bcs .99
	
				rts
				
.6				ldx #1					expecting 1 '}' for now....

.7				jsr CSH.GetNextChar
				bcs .9
				cmp #'{'
				bne .71
				inx
				bra .7
				
.71				cmp #'}'
				bne .7
				txa
				beq .9
				dex
				bne .7
				
				jsr CSH.GetNextChar
				
				clc
				rts
				
.9				lda #CSH.E.SYNTAX
				sec
.99				rts

CSH.Keyword.Start
				jmp (J.CSH.KW.START,x)
*--------------------------------------
CSH.IF.START	jmp CSH.Push			Push "IF" Token
*--------------------------------------
CSH.WHILE.START pha
				>LDA.G CSH.BufPtrSave+1	WHILE : push loop address...
				jsr CSH.Push
				>LDA.G CSH.BufPtrSave
				jsr CSH.Push		
				pla
				jmp CSH.Push			Push "WHILE" Token
*--------------------------------------
CSH.IF.END		jsr CSH.GetNextChar		just skip ending '}'
				clc
				rts
*--------------------------------------
CSH.WHILE.END	jsr CSH.Pop
				sta ZPFileBufPtr
				jsr CSH.Pop
				sta ZPFileBufPtr+1
				clc
				rts
*--------------------------------------
CSH.ELSE
CSH.DO
CSH.FOR
CSH.SWITCH
CSH.CASE
CSH.BREAK
CSH.CONTINUE

				lda #CSH.E.SYNTAX
				sec
				rts
*--------------------------------------
CSH.SIGNED		jsr CSH.GetChar
				bcs .9
				cmp #' '
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9
				
				>LDYA L.CSH.STYPES
				jsr CSH.LookupID

				bcs .9
				
				jmp (J.CSH.STYPES,x)
				
.9				lda #CSH.E.SYNTAX
				sec
				rts				
*--------------------------------------
CSH.UNSIGNED	jsr CSH.GetChar
				bcs .9
				cmp #' '
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9
				
				>LDYA L.CSH.STYPES
				jsr CSH.LookupID

				bcs .9
				
				jmp (J.CSH.UTYPES,x)
				
.9				lda #CSH.E.SYNTAX
				sec
				rts	
*--------------------------------------
CSH.CHAR		lda #CSH.T.CHAR
				bra CSH.TYPE
CSH.UCHAR		lda #CSH.T.UCHAR
				bra CSH.TYPE
CSH.INT			lda #CSH.T.INT
				bra CSH.TYPE
CSH.UINT		lda #CSH.T.UINT
				bra CSH.TYPE
CSH.LONG		lda #CSH.T.LONG
				bra CSH.TYPE
CSH.ULONG		lda #CSH.T.ULONG
				bra CSH.TYPE

CSH.FLOAT		lda #CSH.T.FLOAT

CSH.TYPE		>STA.G CSH.ACCT
				jsr CSH.GetChar
				bcs .9
				cmp #' '
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9

				jsr CSH.IsLetter
				bcs .9

				jsr CSH.GetVar			Already exists ?
				bcc .90
				
				jsr CSH.AddVar			No, add with undefined value...
				bcs .99
				
				jsr CSH.GetCharNB
				bcs .9
				cmp #';'
				beq .8					end of declaration, no value...
				
				cmp #'='
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9
				
				jsr CSH.ExpEval
				
				bcs .99
				
				jsr CSH.StoreACCToVar	Update value to this var
				
				jsr CSH.GetChar
				bcs .9
				cmp #';'
				bne .9
				
.8				jsr CSH.GetNextCharNB	Skip ;
				clc
				rts

.90				lda #CSH.E.DUP
				sec
				rts
							
.9				lda #CSH.E.SYNTAX
				sec
.99				rts
*--------------------------------------
CSH.FnEval		jsr CSH.GetCharNB

				bcs .9
				cmp #'('
				bne .9
				
				lda (ZPPtr1)			Get Return value Type
				>CMP.G CSH.ACCT			Match with ACC ?
				bne .99

				jsr CSH.PushACCT		Save Acc & T on stack
				
				
.1				inc ZPPtr1				advance to arg list type
				bne .2
				inc ZPPtr1+1

.2				lda (ZPPtr1)
				beq .7					end of list, go check no more

				jsr CSH.GetNextCharNB	skip '('
				bcs .9
				
.20				jsr CSH.ExpEval
				bcs .90

				lda (ZPPtr1)
				cmp #CSH.T.VARIADIC
				bne .3
				
				bra *
				
.3				>CMP.G CSH.ACCT			Match with ACC ?
				bne .99				
				
				inc ZPPtr1				advance to next arg
				beq .7
				inc ZPPtr1+1
				lda (ZPPtr1)
				beq .7 
				
.4				jsr CSH.GetNextCharNB
				bcs .9
				
				cmp #','
				bne .9
				jsr CSH.GetNextCharNB
				bra .20

.7				jsr CSH.GetNextCharNB
				bcs .9
				cmp #')'
				bne .9

				* TO DO : Execute
				
				jsr CSH.GetNextCharNB	Skip )
				
				clc
				rts
				
.9				lda #CSH.E.SYNTAX
				sec
.90				rts
				
.99				lda #CSH.E.TMISMATCH				
				sec
				rts
*--------------------------------------
CSH.ExpEval		jsr CSH.ZeroACC
				dec						A=0
				>STA.G CSH.EXPBOP1
			
				jsr CSH.GetCharNB
				bcs .9
				
.10				jsr CSH.IsLetter		Fnc or Var ?
				bcs .2

				jsr CSH.GetVar
				bcs .1
				
				jsr CSH.LoadACCFromVar
				bcs .9
				bra .11				
				
.1				>LDYA L.CSH.FN
				jsr CSH.LookupFn
				bcs .9
				jsr CSH.FnEval
				bcs .99
				bra .11
				
.2				jsr CSH.IsDigit10		number ?
				bcs .9
				
				jsr CSH.GetNumInACC
				bcs .9
				
.11				jsr CSH.GetCharNB
				bcs .9
				
				cmp #')'
				beq .8
				cmp #';'
				beq .8
				
				jsr CSH.IsOPChar
				bcs .9

				>LDYA L.CSH.BOPS
				jsr CSH.LookupOP
				bcs .9
				
				>LDA.G CSH.EXPBOP1		previous OP...
				bpl .5					go check precedence
				
				txa
				>STA.G CSH.EXPBOP1
				jsr CSH.ACC2ARG
				jsr CSH.GetCharNB
				bcc .10					go check for an ARG		
				
.9				lda #CSH.E.SYNTAX
				sec
.99				rts	
				
.5				txa
				>STA.G CSH.EXPBOP2
				>CMP.G CSH.EXPBOP1		
				bcs .3					
				
* new OP has precedence, stack ACC
				
				

				bra .10
				
* Old OP has precedence, compute ACC=ARG <BOP> ACC					
.3				>LDA.G CSH.EXPBOP1
				jsr CSA.Compute
				bcs .9				
				jsr CSH.GetCharNB
				bcc .10				
				bra .9
				
.8				>LDA.G CSH.EXPBOP1
				bmi .80
				
				jmp CSA.Compute
				
.80				clc
				rts
*--------------------------------------
CSH.SavePtr		>LDYA ZPFileBufPtr
				>STYA.G CSH.BufPtrSave
				rts
*--------------------------------------
CSH.RestorePtr	>LDYA.G CSH.BufPtrSave
				>STYA ZPFileBufPtr
				rts
*--------------------------------------
CSH.LookupFN	sec
				.HS 90					BCC
CSH.LookupID	clc
				>STYA ZPPtr1
				ror
				>STA.G CSH.LookupOpt
				
				jsr CSH.GetIDLen
				bra CSH.Lookup

CSH.LookupOP	>STYA ZPPtr1
				>STZ.G CSH.LookupOpt
				jsr CSH.GetOPLen

CSH.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 (ZPFileBufPtr),y
				bne .4
				tya

				bne .2
				
				pla						Found keyword...
				clc
				adc ZPFileBufPtr			..advance Ptr to char after it..
				sta ZPFileBufPtr
				bcc .31
				inc ZPFileBufPtr+1

.31				lda ZPPtr1
				sec
				adc (ZPPtr1)
				sta ZPPtr1
				bcc .8
				inc ZPPtr1+1
				
				clc						
.8				rts

.4				inx
				inx
				
				lda ZPPtr1
				sec
				adc (ZPPtr1)
				sta ZPPtr1
				bcc .5
				inc ZPPtr1+1
				
.5				>LDA.G CSH.LookupOpt			
				bpl .1
				
				ldy #$ff
.6				iny
				lda (ZPPtr1),y
				bne .6
				
				tya
				sec
				adc ZPPtr1 
				sta ZPPtr1
				bcc .1
				inc ZPPtr1+1
				bra .1
				
.9				pla
				sec
				rts
*--------------------------------------
CSH.GetNumInACC	>LDA.G CSH.ACCT
				cmp #CSH.T.FLOAT
				bcc .1
				
				>PUSHWI ZPFileBufPtr
				>LDYA ZPFileBufPtr

				>SYSCALL StrToF
				bcs .9
				>PULLF.G CSH.ACC
				clc
				rts
				
.1				>PUSHBI 10

				>PUSHWI ZPFileBufPtr
				>LDYA ZPFileBufPtr
				
				>SYSCALL StrToL
				bcs .9
				>PULLL.G CSH.ACC
				clc
.9				rts	
*--------------------------------------
CSH.ZeroACC		lda #0
				ldx #5
				ldy #CSH.ACC
				
.1				sta (pData),y
				iny
				dex
				bne .1
				
				rts
*--------------------------------------
CSH.ACC2ARG		>LEA.G CSH.ACCT
				>STYA ZPPtr1

				>LEA.G CSH.ARGT
				>STYA ZPPtr2
				
				ldy #5
				
.1				lda (ZPPtr1),y
				sta (ZPPtr2),y
				dey
				bpl .1

				rts
*--------------------------------------
* Vars...
*--------------------------------------
CSH.AddVar		jsr CSH.GetIDLen
				
				sec
				>ADC.G CSH.SymbolsPtr	Enough room to store this symbol ?
				
				bcs .99
				
				adc #1					Add One Byte for storing Ptr to DATA
				bcs .99					Out of Symbols space
				
				>LDA.G CSH.DataPtr
				pha
				
				>LDA.G CSH.ACCT
				tax
				sec						+1 for Type
				adc CSH.TSIZE,x
				bcs .98					Out of Data Space

				>LDA.G CSH.SymbolsPtr
				pha

				jsr CSH.GetIDLen
				
				ply
				sta (ZPCSHSymbols),y
				iny
				
				jsr CSH.GetChar
				
.1				sta (ZPCSHSymbols),y	Store this symbol....
				iny
				jsr CSH.GetNextChar
				
				jsr CSH.IsLetterOrDigit
				bcc .1
				
				pla						Get Back Data Ptr				
				pha
				
				sta (ZPCSHSymbols),y
				iny
				
				tya
				>STA.G CSH.SymbolsPtr	Mark new end of Symbols
				
				pla						Get again Data Ptr
				clc
				adc ZPCSHData
				sta ZPCSHValue
				lda #0
				adc ZPCSHData+1
				sta ZPCSHValue+1

				>LDA.G CSH.ACCT
				sta (ZPCSHValue)
*				clc
				rts
							
.98				pla
.99				lda #CSH.E.OOM
				sec
				rts
*--------------------------------------
CSH.GetVar		>LDYA ZPCSHSymbols
				>STYA ZPPtr1
				
				jsr CSH.GetIDLen
				tax						Save len

.1				lda (ZPPtr1)
				beq .9
				
				txa						Get back len
				cmp (ZPPtr1)
				bne .3
				
				tay
				
.2				lda (ZPPtr1),y
				dey
				cmp (ZPFileBufPtr),y
				bne .3
				
				tya
				bne .2
				
				lda (ZPPtr1)
				inc
				tay
				lda (ZPPtr1),y			Get Ptr to DATA
				clc
				adc ZPCSHData
				sta ZPCSHValue
				lda #0
				adc ZPCSHData+1
				sta ZPCSHValue+1
				
				txa						Get back len

				clc
				adc ZPFileBufPtr
				sta ZPFileBufPtr
				bcc .8
				inc ZPFileBufPtr+1

				clc
.8				rts
							
.3				lda (ZPPtr1)
				sec
				adc ZPPtr1
				sta ZPPtr1
				bcc .4
				inc ZPPtr1+1
				
.4				inc ZPPtr1				Skip Pointer to TYPE/DATA
				bne .1
				inc ZPPtr1+1
				bra .1
				
.9				sec
				rts
*--------------------------------------
CSH.LoadACCFromVar
				>LDA.G CSH.ACCT
				cmp (ZPCSHValue)
				bne .9
				
				tax
				lda CSH.TSIZE,x
				tax						Byte count to transfer
								
				>LEA.G CSH.ACC
				>STYA ZPPtr1
				
				ldy #1

.1				lda (ZPCSHValue),y
				sta (ZPPtr1)
				inc ZPPtr1
				bne .2
				inc ZPPtr1+1
				
.2				iny
				dex
				bne .1
				
				clc
				rts
				
.9				lda #CSH.E.TMISMATCH
				sec
				rts
*--------------------------------------
CSH.StoreACCToVar
				>LDA.G CSH.ACCT
				cmp (ZPCSHValue)
				bne .9
				
				tax
				lda CSH.TSIZE,x
				tax						Byte count to transfer
				
				>LEA.G CSH.ACC
				>STYA ZPPtr1

				ldy #1					do not trash TYPE byte
				
.1				lda (ZPPtr1)
				inc ZPPtr1
				bne .2
				inc ZPPtr1+1
				
.2				sta (ZPCSHValue),y
				iny
				dex
				bne .1
				clc
				rts
				
.9				lda #CSH.E.TMISMATCH
				sec
				rts
*--------------------------------------
CSH.IsACC0		>LDA.G CSH.ACCT
				cmp #CSH.T.FLOAT
				bne .1					char,int,long
				
				>LDA.G CSH.ACC
				bne .9
				
.8				clc
				rts
				
.1				tax
				lda CSH.TSIZE,x
				tax
				
				lda #0
				ldy #CSH.ACC

.2				ora (pData),y
				iny
				dex
				bne .2
				
				tax
				beq .8
				
.9				sec
				rts
*--------------------------------------
CSA.Compute		tax
				jmp (J.CSH.BOPS,x)
*--------------------------------------
CSH.BOPS.ADD	
				clc
				rts


CSH.BOPS.SUB	>LDA.G CSH.ACCT
				cmp #CSH.T.FLOAT
				beq .8
				

				
				
				clc
				rts

.8				>PUSHF.G CSH.ACC
				>PUSHF.G CSH.ARG
				>SYSCALL FSUB
				bcs .9
				
				>PULLF.G CSH.ACC
.9				rts
CSH.BOPS.MUL
				clc
				rts
				
CSH.BOPS.DIV	>LDA.G CSH.ACCT
				cmp #CSH.T.FLOAT
				beq .8
				

				
				
				clc
				rts

.8				>PUSHEA.G CSH.ACC
				>PUSHEA.G CSH.ARG
				>LEA.G CSH.ACC
				>SYSCALL FDIV
				
				rts
CSH.BOPS.MOD
CSH.BOPS.SHL
CSH.BOPS.SHR
CSH.BOPS.L
CSH.BOPS.G
CSH.BOPS.LE
CSH.BOPS.GE
CSH.BOPS.EQ
CSH.BOPS.NE
CSH.BOPS.AND
CSH.BOPS.OR
CSH.BOPS.EOR
CSH.BOPS.LAND
CSH.BOPS.LOR


				clc
				rts
*--------------------------------------
* Stack
*--------------------------------------
CSH.PushACCT	


CSH.Push		pha
				>LDA.G CSH.StackPtr
				inc
				beq .9
				sta (pData),y
				dec
				tay
				pla
				sta (ZPCSHStack),y
				clc
				rts
	
.9				pla
				lda #CSH.E.SOVERFLW
				sec
				rts
*--------------------------------------
CSH.Pop			>LDA.G CSH.StackPtr
				beq .9
				dec
				sta (pData),y
				tay
				lda (ZPCSHStack),y
				clc
				rts

.9				lda #CSH.E.SYNTAX
				sec
				rts				
*--------------------------------------
CSH.CheckStack	tax
				>LDA.G CSH.StackPtr
				beq .9
				dec
				tay
				txa
				cmp (ZPCSHStack),y
				bne .9
				
				tya
				>STA.G CSH.StackPtr
				
				clc
				rts
				
.9				lda #CSH.E.SYNTAX
				sec
				rts						
*--------------------------------------
* CHAR related Subs.....
*--------------------------------------
CSH.GetOPLen	ldy #0
								
.1				iny
				lda (ZPFileBufPtr),y
				beq .8

				jsr CSH.IsOPChar
				bcc .1
				
.8				tya
				rts
*--------------------------------------
CSH.GetIDLen	ldy #0
								
.1				iny
				lda (ZPFileBufPtr),y
				beq .8

				jsr CSH.IsLetterOrDigit
				bcc .1
				
.8				tya
				rts
*--------------------------------------
CSH.GetCharNB	jsr CSH.GetChar
				bcs CSH.GetNextCharNB.RTS
				jsr CSH.CheckCharNB
				bcc CSH.GetNextCharNB.RTS		
*--------------------------------------
CSH.GetNextCharNB
				jsr CSH.GetNextChar
				bcs CSH.GetNextCharNB.RTS
				jsr CSH.CheckCharNB
				bcs CSH.GetNextCharNB
CSH.GetNextCharNB.RTS
				rts
*--------------------------------------
CSH.CheckCharNB	cmp #C.SPACE
				beq .9
				cmp #C.CR
				beq .9
				cmp #C.LF
				beq .9
				cmp #C.TAB
				beq .9
				clc
.9				rts				
*--------------------------------------
CSH.GetNextChar	inc ZPFileBufPtr
				bne CSH.GetChar
				inc ZPFileBufPtr+1
*--------------------------------------
CSH.GetChar		lda (ZPFileBufPtr)
				beq .9
				clc
				rts
				
.9				lda #MLI.E.EOF
				sec
				rts
*---------------------------------------
CSH.IsOPChar	ldx #13

.1				cmp CSH.OPChars,x
				beq .8
				dex
				bpl .1
				sec
				rts
				
.8				clc
				rts				
*---------------------------------------
CSH.IsLetterOrDigit
				jsr CSH.IsDigit10
				bcc CSH.IsLetterRTS
*---------------------------------------
CSH.IsLetter	cmp #'_'
				bne .1
				clc
				rts
				
.1				cmp #'A'
				bcc .9
				
				cmp #'Z'+1
				bcc CSH.IsLetterRTS

				cmp #'a'
				bcc .9
				cmp #'z'+1
				rts						CC if lowercase

.9				sec
				
CSH.IsLetterRTS	rts					
*---------------------------------------
CSH.IsDigit10	cmp #'0'
				bcc .9
				cmp #'9'+1
				rts						cc if ok, cs if not
					
.9				sec
				rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM