A2osX/BIN/CSH.S.CORE.txt

NEW
  AUTO 3,1
				.LIST OFF	
*--------------------------------------
CSH.Init		>SYSCALL SListNew
				bcs .9
				>STA.G CSH.hSymbols
				
				>LDYAI 256
				>SYSCALL GetMem
				bcs .9
				>STYA ZPCSHConst
				txa
				>STA.G CSH.hConst

				>LDYAI 256
				>SYSCALL GetMem
				bcs .9
				>STYA ZPCSHStack
				txa
				>STA.G CSH.hStack
				
				lda #$0
				>STA.G CSH.ConstPtr
				>STA.G CSH.StackPtr
				
				sta (ZPCSHConst)
				sta (ZPCSHStack)
				
*				clc
.9				rts
*--------------------------------------
CSH.Quit		>LDA.G CSH.hSymbols
				>SYSCALL SListFree

				>LDA.G hFileBuf
				jsr .7

				>LDA.G CSH.hStack
				jsr .7
				
				>LDA.G CSH.hConst
				jsr .7
				
.7				beq CSH.Quit.RTS
				>SYSCALL FreeMem
				
CSH.Quit.RTS	rts
*--------------------------------------
CSH.Run			jsr CSH.GetCharNB
				bcs CSH.Quit.RTS
								
				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 #C.CR
				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 .5

				jsr CSH.GetCharNB
				bcs .9
				cmp #'='
				bne .99
				
				jsr CSH.GetNextCharNB	Skip =
				bcs .99
				
				jsr CSH.ExpEval
				bcs .9
				
				jsr CSH.SetVarValue
				bcs .9
				
				jsr CSH.GetChar
				cmp #';'
				bne .99
				
				jmp CSH.GetNextCharNB	Skip ;
				
.5				lda #0					no return value type check required
				jsr CSH.FnEval			X = function index
				bcs .9

				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
*--------------------------------------
* Built in Keywords
*--------------------------------------
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.IsValue0
				bcc .6					Value=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
*--------------------------------------
* Built in Types
*--------------------------------------
CSH.SIGNED		jsr CSH.GetChar
				bcs .9
				cmp #C.SPACE
				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 #C.SPACE
				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		ldx #CSH.T.CHAR
				bra CSH.TYPE
CSH.UCHAR		ldx #CSH.T.UCHAR
				bra CSH.TYPE
CSH.INT			ldx #CSH.T.INT
				bra CSH.TYPE
CSH.UINT		ldx #CSH.T.UINT
				bra CSH.TYPE
CSH.LONG		ldx #CSH.T.LONG
				bra CSH.TYPE
CSH.ULONG		ldx #CSH.T.ULONG
				bra CSH.TYPE

CSH.FLOAT		ldx #CSH.T.FLOAT

CSH.TYPE		stx ZPVarType
				
				jsr CSH.GetChar
				bcs .9
				
				cmp #C.SPACE
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9

				jsr CSH.IsLetter
				bcs .9

				txa						VAR TYPE
				jsr CSH.AddVar			add with undefined value...
				bcs .99					OOM or DUP
				
				>STYA ZPVarID
				
				jsr CSH.GetCharNB
				bcs .9
				cmp #';'
				beq .8					end of declaration, no value...
				
				cmp #'='
				bne .9
				
				jsr CSH.GetNextCharNB
				bcs .9
				
				lda ZPVarType
				jsr CSH.ExpEval
				
				bcs .99
				
				jsr CSH.SetVarValue		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
*--------------------------------------
* Input: 
*   ZPFileBufPtr, A = Expected type
* Output:
*   CS, A = EC
*   CC, A, Y,A or x bytes on Stack
*--------------------------------------
CSH.FnEval		ldx ZPPtr1
				phx
				ldx ZPPtr1+1
				phx
				ldx ZPPtr2
				phx
				
				sta ZPPtr2				save Type
				
				>LDYA L.CSH.FN
				jsr CSH.LookupFn
				phx						X = function index
				bcs .90

				>STYA ZPPtr1			f() definition, starting at returned type

				jsr CSH.GetCharNB
				bcs .90

				cmp #'('
				bne .90

				jsr CSH.GetNextCharNB	skip '('
				bcs .90

				lda ZPPtr2				Expected type in 0, ignore
				beq .1
				
				cmp (ZPPtr1)			Get Return value Type
				bne .91
				
.1				inc ZPPtr1				advance to arg list type
				bne .2
				inc ZPPtr1+1

.2				lda (ZPPtr1)			get type of next arg
				beq .7					end of list, go check ending ')'

.3				eor #CSH.T.VARIADIC		if VARIADIC, don't advance to next arg and assume type = 0
				beq .4
				
				lda (ZPPtr1)			get type again...
				
				inc ZPPtr1
				bne .4
				inc ZPPtr1+1
				
.4				jsr CSH.ExpEval
				bcs .9

				lda (ZPPtr1)			no more arg in fn definition
				beq .7 
				
.5				jsr CSH.GetCharNB
				bcs .9
				
				cmp #','
				bne .90

				jsr CSH.GetNextCharNB	Skip ,
				
				lda (ZPPtr1)
				bne .3					Another ARG....

				bra .9

.7				jsr CSH.GetCharNB
				bcs .90
				cmp #')'
				bne .90

				jsr CSH.GetNextCharNB	Skip )

				jsr .9
				
				jmp (J.CSH.EXEC,x)

.90				lda #CSH.E.SYNTAX
				.HS 2C					BIT ABS
				
.91				lda #CSH.E.TMISMATCH
				sec

.9				plx
				stx ZPPtr2
				plx
				stx ZPPtr1+1
				plx
				stx ZPPtr1
				plx
.99				rts
*--------------------------------------
* Input: 
*   ZPFileBufPtr, A = Expected type
* Output:
*   CS, A = EC
*   CC, A, Y,A or x bytes on Stack
*--------------------------------------
CSH.ExpEval		ldx ZPPtr2
				phx
				ldx ZPPtr2+1			One local : BOP1
				phx
				
				sta ZPPtr2				save Type
							
.10				lda #$ff
				sta ZPPtr2+1			Reset BOP1

				jsr CSH.GetCharNB
				bcs .9
				
.20				jsr CSH.IsLetter		Fnc or Var ?
				bcs .2

				jsr CSH.GetVar
				bcs .1
				
				jsr CSH.GetVarValue		Get value on stack
				bra .11				
				
.1				jsr CSH.FnEval			X = function index
				bcs .99
				bra .11
				
.2				jsr CSH.IsDigit10		number ?
				bcs .3
				
				jsr CSH.GetNumOnStack
				bcs .9
				
.11				jsr CSH.GetCharNB
				bcs .9
				
				cmp #','
				beq .8
				cmp #')'
				beq .8
				cmp #';'
				beq .8
				
				jsr CSH.IsOPChar
				bcs .9

				>LDYA L.CSH.BOPS
				jsr CSH.LookupOP
				bcs .9
				
				lda ZPPtr2+1			previous OP...
				bpl .5					go check precedence
				
				stx ZPPtr2+1

				jsr CSH.PushValueOnStack
				
				jsr CSH.GetCharNB
				bcc .20					go check for an ARG		
				bra .9
				
.3				cmp #'"'				String literal
				bne .9
				
				

				jsr CSH.AddContCharP
				bcs	.99

				jmp .11

				
.9				plx
				stx ZPPtr2+1
				plx
				stx ZPPtr2
				
				lda #CSH.E.SYNTAX
				sec
.99				rts	
				
.5				cpx ZPPtr2+1
				bcs .6					
				
* new OP has precedence, stack ACC
				
				

				jmp .10
				
* Old OP has precedence, compute ACC=ARG <BOP> ACC					
.6				lda ZPPtr2+1
				jsr CSH.Compute
				bcs .9
				
				jsr CSH.GetCharNB
				bcs .9		
				jmp .10
				
.8				lda ZPPtr2+1
				bmi .80
				
				jmp CSH.Compute
				
.80				plx
				stx ZPPtr2+1
				plx
				stx ZPPtr2
				
				clc
				rts
*--------------------------------------
CSH.AddContCharP
				ldy #0
				
.1				jsr CSH.GetNextChar
				bcs .9
				cmp #C.CR
				beq .9
				
				cmp #'"'
				beq .2
				sta (ZPCSHConst),y
				iny 
				bra .1
				
.2				lda #0				
				sta (ZPCSHConst),y
				
				phy
				
				lda #CSH.Q.CONST+CSH.Q.POINTER+CSH.T.CHAR
				sta ZPVarType

				>LDYA ZPCSHConst
				>STYA ZPVarData

				pla
				sec
				adc ZPCSHConst
				sta ZPCSHConst
				bcc .3
				
				inc ZPCSHConst+1
				
.3				jsr CSH.GetNextCharNB	Skip "

				clc
				rts
				
.9				lda #CSH.E.SYNTAX
				sec
				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)
				tay
				lda ZPPtr1+1
				adc #0
				
				clc						Y,A = F() def, X = F() index
.8				rts

.4				inx
				inx
				
				lda (ZPPtr1)
				jsr CSH.ZPPtr1AddAp1
				
				>LDA.G CSH.LookupOpt
				bpl .1
				
				ldy #$ff
.6				iny
				lda (ZPPtr1),y
				bne .6
				
				tya
				jsr CSH.ZPPtr1AddAp1
				bra .1
				
.9				pla
				sec
				rts
*--------------------------------------
CSH.ZPPtr1AddAp1
				sec
				adc ZPPtr1 
				sta ZPPtr1
				bcc .1
				inc ZPPtr1+1
.1				rts
*--------------------------------------
CSH.GetNumOnStack
				lda ZPVarType
				cmp #CSH.T.FLOAT
				bcc .1

				>PUSHWI ZPFileBufPtr
				>LDYA ZPFileBufPtr

				>SYSCALL StrToF
				rts
				
.1				>PUSHBI 10

				>PUSHWI ZPFileBufPtr
				>LDYA ZPFileBufPtr
				
				>SYSCALL StrToL

.9				rts	
*--------------------------------------
* Input : ZPFileBufPtr, A = Var Type, Value on Stack
* Output : Y,A = ZPVarID
*--------------------------------------
CSH.AddVar		sta ZPVarType

				>PUSHW ZPFileBufPtr
				>LDA.G CSH.hSymbols
				>SYSCALL SListNewKey
				bcs .9
				
				>STYA ZPVarID
				txa
*				clc
				adc ZPFileBufPtr
				sta ZPFileBufPtr
				bcc .1
				
				inc ZPFileBufPtr+1
				
.1				ldy #2

				lda ZPVarType
				>PUSHA					Push Var Type On stack...
				
				and #CSH.Q.PPPOINTER
				bne .2					Pointer, always 2 bytes

				lda ZPVarType
				and #$1f
				tax
				ldy	CSH.TSIZE,x

.2				iny						+1 for Type
				lda #0
				
				>PUSHYA					DataLen
				>PUSHW pStack
				>PUSHW ZPVarID
				>LDA.G CSH.hSymbols
				>SYSCALL SListAddData
				bcs .9
				
				>LDYA ZPVarType
				
.9				rts
*--------------------------------------
CSH.GetVar		sta ZPVarType

				>PUSHW ZPFileBufPtr
				>LDA.G CSH.hSymbols
				>SYSCALL SListLookup
				bcs .9

				>STYA ZPVarID

				txa
*				clc
				adc ZPFileBufPtr
				sta ZPFileBufPtr
				bcc .1
				
				inc ZPFileBufPtr+1
				
.1				ldx ZPVarType
				cpx ZPVarData
				bne .99
				
				clc
				rts

.99				lda #CSH.E.TMISMATCH
				sec
.9				
CSH.GetVar.RTS	rts
*--------------------------------------
* Input : ZPFileBufPtr, A = Var Type
* Output : Value on Stack
*--------------------------------------
CSH.GetVarValue	sta ZPVarType

.1				>PUSHWI 0
				>PUSHWI 6
				>PUSHWI ZPVarData
				>PUSHWI ZPVarID
				>LDA.G CSH.hSymbols
				>SYSCALL SListGetData
				bcs CSH.GetVar.RTS
				
CSH.PushValueOnStack
				ldx ZPVarType
				cpx ZPVarData
				bne .99
				
				ldy CSH.TSIZE,x
				
.2				lda ZPVarData,y
				>PUSHA
				dey
				bne .2
				
				clc
				rts
				
				
.99				lda #CSH.E.TMISMATCH
				sec
.9				rts
*--------------------------------------
CSH.SetVarValue	cmp ZPVarType
				bne .9
				
				tax
				ldy CSH.TSIZE,x			Byte count to transfer
				
				ldx #1

.1				>PULLA
				sta ZPVarData,x
				inx
				dey
				bne .1

				clc
				rts
				
.9				lda #CSH.E.TMISMATCH
				sec
				rts
*--------------------------------------
CSH.IsValue0	ldx ZPVarType
				cpx #CSH.T.FLOAT
				bne .1					char,int,long
				
				ldy CSH.TSIZE,x
				
				lda ZPVarData,y
				bne .9
				
.8				clc
				rts
				
.1				tax
				lda CSH.TSIZE,x
				tax
				
				lda #0
				ldy #1

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


CSH.BOPS.SUB	lda ZPVarType
				cmp #CSH.T.FLOAT
				beq .8
				

				
				
				clc
				rts

.8				>FPU FSUB
				bcs .9
				
.9				rts
CSH.BOPS.MUL
				clc
				rts
				
CSH.BOPS.DIV	lda ZPVarType
				cmp #CSH.T.FLOAT
				beq .8
				

				
				
				clc
				rts

.8				
				>FPU FDIV
				
				clc
				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.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 #CSH.OPChars.Cnt-1

.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
*--------------------------------------
* EXEC
*--------------------------------------
EXEC.printf		>PULLYA
				>SYSCALL printf
				bcs .9

.9				rts				
*--------------------------------------
EXEC.puts		>PULLYA
				>SYSCALL puts
				bcs .9
				
.9				rts				
*--------------------------------------
EXEC.cos		>FPU COS

				rts
*--------------------------------------
EXEC.getchar	>SYSCALL getchar

				rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM