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 CSH.Run.1 cmp #'#' bne .3 comments ... .1 jsr CSH.GetNextChar bcs .2 cmp #C.CR bne .1 .2 jmp CSH.GetNextChar Skip CR and exit .3 cmp #C.CR beq .2 cmp #'}' End of block ? bne .4 jsr CSH.CheckStack must be something on stack.... bcs .9 jsr CSH.GetNextCharNB Skip '}' jsr CSH.Pop was expected.... jsr CSH.Pop get stacked Cmd... tax jmp (J.CSH.KW.END,x) .4 jsr CSH.IsLetter bcc .5 bra .99 error, todo : PREOPS ++ --..... .5 jsr CSH.SavePtr Save Ptr, in case of while,for.... >LDYA L.CSH.KW jsr CSH.LookupID bcs .6 not an internal CSH keyword.... jsr CSH.KW.JMP bcs .9 bra .8 .6 jsr CSH.GetVar bcs .7 >STYA ZPVarID jsr CSH.GetCharNB bcs .9 cmp #'=' TODO: all AOPS bne .99 jsr CSH.GetNextChar Skip = bcs .99 lda #0 Any Type jsr CSH.ExpEval bcs .9 >LDYA ZPVarID X = Exp Type jsr CSH.SetVarValueFromStack bcs .9 jsr CSH.GetChar cmp #';' bne .99 bra .8 .7 lda #0 no return value type check required jsr CSH.fCall bcs .9 .8 jsr CSH.GetNextCharNB Skip ; bcs .9 cmp #C.CR beq .80 jmp CSH.Run.1 .80 jmp CSH.GetNextChar Skip CR .99 lda #CSH.E.SYNTAX sec .9 rts *-------------------------------------- * Built in Keywords *-------------------------------------- CSH.KW.JMP txa >STA.G CSH.CmdSave jmp (J.CSH.KW,x) *-------------------------------------- CSH.WHILE CSH.IF jsr CSH.GetCharNB bcs .9 cmp #'(' bne .9 jsr CSH.GetNextCharNB bcs .9 lda #0 Any var type jsr CSH.ExpEval bcs .99 jsr CSH.GetCharNB bcs .99 cmp #')' bne .9 jsr CSH.GetNextCharNB skip ')' bcs .99 cmp #'{' bne .9 jsr CSH.GetNextCharNB Skip '{' bcs .99 jsr CSH.IsValue0 X = var type from ExpEval bcc .6 Value=0, skip {{....}} >LDA.G CSH.CmdSave beq .1 IF pha >LDA.G CSH.BufPtrSave+1 WHILE : push loop address... jsr CSH.Push >LDA.G CSH.BufPtrSave jsr CSH.Push pla .1 jsr CSH.Push bcs .99 lda #'}' Tell '}' is expected at the end of block jsr CSH.Push bcs .99 rts .6 jsr CSH.SkipBlock bcc .99 .9 lda #CSH.E.SYNTAX sec .99 rts *-------------------------------------- *CSH.Keyword.Start * >LDA.G CSH.CmdSave get back Token ("IF" or "WHILE") * tax * 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 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 jsr CSH.AddVar add with no value... bcs .99 OOM or DUP >STYA ZPVarID jsr CSH.GetCharNB bcs .9 cmp #';' bne .2 ldx ZPVarType jsr CSH.SIZEOF .1 dec pStack dec bne .1 ldx ZPVarType bra .7 .2 cmp #'=' bne .9 jsr CSH.GetNextCharNB Skip = bcs .9 lda ZPVarType jsr CSH.ExpEval bcs .99 .7 >LDYA ZPVarID jsr CSH.AddVarValueFromStack X= Type, Add value to this var bcs .99 jsr CSH.GetChar bcs .9 cmp #';' bne .9 .8 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, Result on Stack, X = Type *-------------------------------------- CSH.fCall ldx ZPPtr1 phx ldx ZPPtr1+1 phx ldx ZPPtr2 local : type phx ldx ZPPtr2+1 local : variadic size phx sta ZPPtr2 save Type stz ZPPtr2+1 Reset VARIADIC byte count >LDYA L.CSH.FN jsr CSH.LookupFn phx X = function index bcs .10 >STYA ZPPtr1 f() definition, starting at returned type jsr CSH.GetCharNB bcs .10 cmp #'(' bne .52 jsr CSH.GetNextCharNB skip '(' .10 bcs .90 lda ZPPtr2 bne .11 lda (ZPPtr1) sta ZPPtr2 bra .1 expected type is 0, no check .11 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 first 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 eor #CSH.T.VARIADIC restore type... .4 jsr CSH.ExpEval A=0 if VARIADIC bcs .9 X = Var Type lda (ZPPtr1) get current arg type eor #CSH.T.VARIADIC bne .5 jsr CSH.SIZEOF X = Var Type * clc adc ZPPtr2+1 sta ZPPtr2+1 Add to byte count bra .51 .5 inc ZPPtr1 bne .51 inc ZPPtr1+1 .51 jsr CSH.GetCharNB bcs .90 cmp #',' bne .6 jsr CSH.GetNextCharNB Skip , lda (ZPPtr1) bne .3 Another ARG.... .52 bra .90 extra args....error .6 cmp #')' bne .90 lda (ZPPtr1) beq .8 no more arg after ')', exit eor #CSH.T.VARIADIC bne .90 missing arg >PUSHB ZPPtr2+1 push VARIADIC byte count bra .8 .7 jsr CSH.GetCharNB bcs .90 cmp #')' bne .90 .8 jsr CSH.GetNextCharNB Skip ) plx restore X = function index ldy ZPPtr2 get type in Y pla sta ZPPtr2+1 pla sta ZPPtr2 pla sta ZPPtr1+1 pla sta ZPPtr1 phy jsr .80 plx rts .90 lda #CSH.E.SYNTAX .HS 2C BIT ABS .91 lda #CSH.E.TMISMATCH sec .9 plx Discard function index plx stx ZPPtr2+1 plx stx ZPPtr2 plx stx ZPPtr1+1 plx stx ZPPtr1 .99 rts .80 jmp (J.CSH.EXEC,x) *-------------------------------------- * Input: * ZPFileBufPtr, A = Expected type * Output: * CS, A = EC * CC, X = Var Type, Value on Stack *-------------------------------------- CSH.ExpEval ldx ZPPtr1 phx ldx ZPPtr1+1 phx ldx ZPPtr2 local : VarType phx ldx ZPPtr2+1 local : BOP1 phx sta ZPPtr2 .10 lda #$ff sta ZPPtr2+1 Reset BOP1 jsr CSH.GetCharNB bcs .33 .20 jsr CSH.IsLetter Fnc or Var ? bcs .2 jsr CSH.GetVar bcs .1 ldx ZPPtr2 var type (could be 0=any) jsr CSH.GetVarValueOnStack Y,A = VarID, Get value on stack bcs .29 stx ZPPtr2 store real var type bra .11 .1 lda ZPPtr2 var type jsr CSH.fCall X = function index bcs .99 stx ZPPtr2 store real var type bra .11 .2 jsr CSH.IsDigit10 number ? bcs .3 ldx ZPPtr2 bne .22 ldx #CSH.T.INT stx ZPPtr2 .22 jsr CSH.GetNumOnStack .29 bcs .99 .11 jsr CSH.GetCharNB bcs .90 cmp #',' beq .8 cmp #')' beq .8 cmp #';' beq .8 jsr CSH.IsOPChar .33 bcs .90 >LDYA L.CSH.BOPS jsr CSH.LookupOP bcs .90 lda ZPPtr2+1 previous OP... bpl .5 go check precedence stx ZPPtr2+1 jsr CSH.GetCharNB bcc .20 go check for an ARG bra .90 .3 cmp #'"' String literal bne .90 jsr CSH.AddContCharP bcs .99 jmp .11 .5 cpx ZPPtr2+1 bcs .6 * new OP has precedence, stack ACC jmp .10 * Old OP has precedence, compute ACC=ARG ACC .6 lda ZPPtr2 Var Type ldx ZPPtr2+1 BOP jsr CSH.BOPExec bcs .99 jsr CSH.GetCharNB bcs .90 jmp .10 .8 ldx ZPPtr2+1 bmi .80 lda ZPPtr2 Var Type jsr CSH.BOPExec bcc .80 bcs .99 .90 lda #CSH.E.SYNTAX .99 sec .HS 90 BCC .80 clc ldx ZPPtr2 X = Var Type ply sty ZPPtr2+1 ply sty ZPPtr2 ply sty ZPPtr1+1 ply sty ZPPtr1 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 >PUSHW ZPCSHConst Push PTR on stack tya sec adc ZPCSHConst sta ZPCSHConst bcc .3 inc ZPCSHConst+1 .3 jsr CSH.GetNextChar 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 txa beq .99 .10 cpx #CSH.T.FLOAT bcc .1 bne .99 >PUSHWI ZPFileBufPtr >LDYA ZPFileBufPtr >SYSCALL StrToF clc rts .1 >PUSHBI 10 >PUSHWI ZPFileBufPtr >LDYA ZPFileBufPtr phx cpx #CSH.T.UCHAR bcc .2 >SYSCALL StrToUL bra .3 .2 >SYSCALL StrToL .3 plx bcs .9 lda CSH.TYPESIZE,x cmp #4 beq .8 cmp #2 bne .4 ldy #1 >PULLA sta (pStack),y >PULLA sta (pStack),y clc rts .4 >PULLA inc pStack inc pStack sta (pStack) .8 clc .9 rts .99 lda #CSH.E.TMISMATCH sec rts *-------------------------------------- * Input : ZPFileBufPtr * Output : Y,A = ZPVarID *-------------------------------------- CSH.AddVar >PUSHW ZPFileBufPtr >LDA.G CSH.hSymbols >SYSCALL SListNewKey bcs .9 pha txa * clc adc ZPFileBufPtr sta ZPFileBufPtr bcc .1 inc ZPFileBufPtr+1 clc .1 pla .9 rts *-------------------------------------- * Y,A = VarID, X=Type *-------------------------------------- CSH.AddVarValueFromStack sec .HS 90 BCC *-------------------------------------- * Y,A = VarID, X=Type *-------------------------------------- CSH.SetVarValueFromStack clc php pha phy stx ZPVarData X = type jsr CSH.SIZEOF pha Size.... tax ldy #1 .1 >PULLA sta ZPVarData,y iny dex bne .1 >PUSHBI 0 Datalen HI pla inc >PUSHA Datalen LO >PUSHWI ZPVarData DataPtr ply pla >PUSHYA Y,A = VarID >LDA.G CSH.hSymbols plp bcc .2 >SYSCALL SListAddData rts .2 >SYSCALL SListSetData rts *-------------------------------------- CSH.GetVar >PUSHW ZPFileBufPtr >LDA.G CSH.hSymbols >SYSCALL SListLookup bcs .9 pha txa * clc adc ZPFileBufPtr sta ZPFileBufPtr bcc .1 inc ZPFileBufPtr+1 clc .1 pla Y,A = VarID .9 rts *-------------------------------------- * Input : Y,A = VarID, X = Var Type (or 0) * Output : Value on Stack, X = Var Type *-------------------------------------- CSH.GetVarValueOnStack stx ZPVarType pha >PUSHWI 0 From Start >PUSHWI 6 6 bytes >PUSHWI ZPVarData pla >PUSHYA KeyID >LDA.G CSH.hSymbols >SYSCALL SListGetData bcs .9 ldx ZPVarType beq .1 cpx ZPVarData bne .99 .1 ldx ZPVarData beq * jsr CSH.SIZEOF tay .2 lda ZPVarData,y >PUSHA dey bne .2 clc X = Var Type .9 rts .99 *-------------------------------------- CSH.TMISSMATCH lda #CSH.E.TMISMATCH sec rts *-------------------------------------- * Input : Value on Stack, X = Var Type * Output : CC = true, CS = false *-------------------------------------- CSH.IsValue0 cpx #CSH.T.FLOAT bcc .1 char,int,long ldy CSH.TYPESIZE,x lda ZPVarData,y bne .9 .8 clc rts .1 jsr CSH.SIZEOF tax lda #0 .2 ora (pStack) inc pStack dex bne .2 tax beq .8 .9 sec rts *-------------------------------------- * A = Type, X = OP *-------------------------------------- CSH.BOPExec jmp (J.CSH.BOPS,x) *-------------------------------------- CSH.BOPS.ADD asl tax jmp (J.CSH.BOPS.ADDt,x) CSH.BOPS.ADDi8 CSH.BOPS.ADDu8 clc >PULLA adc (pStack) sta (pStack) clc rts CSH.BOPS.ADDi16 CSH.BOPS.ADDu16 clc ldy #1 >PULLA adc (pStack),y sta (pStack),y >PULLA adc (pStack),y sta (pStack),y clc rts CSH.BOPS.ADDi32 CSH.BOPS.ADDu32 >FPU ADD32 clc rts CSH.BOPS.ADDf >FPU FADD clc rts *-------------------------------------- CSH.BOPS.SUB asl tax jmp (J.CSH.BOPS.SUBt,x) CSH.BOPS.SUBi8 CSH.BOPS.SUBu8 sec ldy #1 lda (pStack),y sbc (pStack) sta (pStack),y inc pStack clc rts CSH.BOPS.SUBi16 CSH.BOPS.SUBu16 sec ldy #2 lda (pStack),y sbc (pStack) sta (pStack),y iny lda (pStack),y ldy #1 sbc (pStack),y inc pStack inc pStack sta (pStack),y clc rts CSH.BOPS.SUBi32 CSH.BOPS.SUBu32 >FPU SUB32 clc rts CSH.BOPS.SUBf >FPU FSUB clc rts *-------------------------------------- CSH.BOPS.MUL cmp #CSH.T.FLOAT beq .8 clc rts .8 >FPU FMULT clc rts *-------------------------------------- CSH.BOPS.DIV 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.CheckStack tax >LDA.G CSH.StackPtr beq .9 dec tay txa cmp (ZPCSHStack),y bne .9 clc rts .9 lda #CSH.E.SYNTAX sec rts *-------------------------------------- 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 *-------------------------------------- * 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.SkipStatement clc rts *-------------------------------------- CSH.SkipBlock ldy #0 not in "", TOTO:skip comments ldx #1 starting with 1 '{' for now.... .1 jsr CSH.GetNextCharNB bcs .9 cmp #'{' bne .2 tya bmi .1 inx bra .1 .2 cmp #'}' bne .3 tya bmi .1 dex bne .1 clc rts .3 cmp #'"' bne .1 tya eor #$ff tay bra .1 jmp CSH.GetNextCharNB skip '}' .9 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.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 *-------------------------------------- * in : X = type, out : X = type, A = size *-------------------------------------- CSH.SIZEOF txa and #CSH.Q.PPPOINTER bne .2 txa and #$f phx tax lda CSH.TYPESIZE,x plx rts .2 lda #2 rts *-------------------------------------- * EXEC *-------------------------------------- EXEC.printf >SYSCALL printf2 rts *-------------------------------------- EXEC.puts >PULLYA >SYSCALL puts rts *-------------------------------------- EXEC.cos >FPU COS clc rts *-------------------------------------- EXEC.getchar >SYSCALL getchar >PUSHA rts *-------------------------------------- MAN SAVE USR/SRC/BIN/CSH.S.CORE LOAD USR/SRC/BIN/CSH.S ASM