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.GetVarValue
				bcs .5

				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 ;
				
.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.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
*--------------------------------------
* 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.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
*--------------------------------------
* 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
				
				jsr CSH.ZeroACC
			
.10				lda #$ff
				sta ZPPtr2+1			Reset BOP1

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

				jsr CSH.GetVarValue
				bcs .1
				
				bra .11				
				
.1				jsr CSH.FnEval			X = function index
				bcs .99
				bra .11
				
.2				jsr CSH.IsDigit10		number ?
				bcs .3
				
				jsr CSH.GetNumInACC
				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.ACC2ARG
				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.G CSH.ACCT

				>LDYA ZPCSHConst
				>STYA.G CSH.ACC

				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.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
*--------------------------------------
* 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
*--------------------------------------
* Input : ZPFileBufPtr, A = Var Type
* Output : Value on Stack
*--------------------------------------
CSH.GetVarValue
				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
				
.9				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
*--------------------------------------
CSH.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
				>FPU 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				>PUSHF.G CSH.ACC
				>PUSHF.G CSH.ARG
				>FPU FDIV
				>PULLF.G CSH.ACC
				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		>LDYA.G CSH.ACC
				>SYSCALL printf
				bcs .9
				
				>STYA.G CSH.ACC
.9				rts				
*--------------------------------------
EXEC.puts		>LDYA.G CSH.ACC
				>SYSCALL puts
				bcs .9
				
				>STYA.G CSH.ACC
.9				rts				
*--------------------------------------
EXEC.cos		>FPU COS

				>PULLF.G CSH.ACC
				rts
*--------------------------------------
EXEC.getchar	>SYSCALL getchar

				>STA.G CSH.ACC
				rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/CSH.S.CORE
LOAD USR/SRC/BIN/CSH.S
ASM