; > Functions ; BASIC functions ; 30-Jan-2008: Program functions done: PAGE, TOP, LOMEM, END, HIMEM ; ERL, ERR, COUNT, WIDTH, FALSE, TRUE, REPORT ; 10-Feb-2008: Done simple functions, ASC, LEN, CHR$, PI, NOT, SGN, ABS ; 30-Aug-2008: Added binary functions to dispatch table ; OR, EOR, AND, +, -, *, /, DIV ; Function address table ; ====================== ; On entry to function subroutines, ; r5=>first non-space after command token ; r0=first non-space character after command token - (r5) ; r2/r3/r4=current value ; Binary operators have sp=> retaddr, previous value r2,r3,r4 ; Unary function have sp=> retaddr ; ; On exit from function subroutines, ; r4=b0-b15 or string start ; r3=b16-b31 or string length ; r2=type and real exponent ; b15=0 - numeric ; 0000 - integer ; 00xx - real, xx=exponent ; b15=1 - string ; 8000 - normal string ; ; r2 must be last register set, to set flags ; .FunctionTable EQUW fnAND-$ ; &80 - AND EQUW fnDIV-$ ; &81 - DIV EQUW fnEOR-$ ; &82 - EOR EQUW fnMOD-$ ; &83 - MOD EQUW fnOR-$ ; &84 - OR EQUW errNoSuchVar-$ ; &28 - ( EQUW errNoSuchVar-$ ; &29 - ) EQUW fnMultiply-$ ; &2A - * EQUW fnAdd-$ ; &2B - + EQUW errNoSuchVar-$ ; &2C - , EQUW fnSubtract-$ ; &2D - - EQUW fnPower-$ ; &5E - ^ EQUW fnDivide -$ ; &2F - / EQUW fnLineNum-$ ; &8D - linenum EQUW fnOPENIN-$ ; &8E - OPENIN EQUW fnPTR-$ ; &8F - PTR EQUW fnPAGE-$ ; &90 - PAGE EQUW fnTIME-$ ; &91 - TIME EQUW fnLOMEM-$ ; &92 - LOMEM EQUW fnHIMEM-$ ; &93 - HIMEM EQUW fnABS-$ ; &94 - ABS EQUW fnACS-$ ; &95 - ACS EQUW fnADVAL-$ ; &96 - ADVAL EQUW fnASC-$ ; &97 - ASC EQUW fnASN-$ ; &98 - ASN EQUW fnATN-$ ; &99 - ATN EQUW fnBGET-$ ; &9A - BGET EQUW fnCOS-$ ; &9B - COS EQUW fnCOUNT-$ ; &9C - COUNT EQUW fnDEG-$ ; &9D - DEG EQUW fnERL-$ ; &9E - ERL EQUW fnERR-$ ; &9F - ERR EQUW fnEVAL-$ ; &A0 - EVAL EQUW fnEXP-$ ; &A1 - EXP EQUW fnEXT-$ ; &A2 - EXT EQUW fnFALSE-$ ; &A3 - FALSE EQUW fnFN-$ ; &A4 - FN EQUW fnGET-$ ; &A5 - GET EQUW fnINKEY-$ ; &A6 - INKEY EQUW fnINSTR-$ ; &A7 - INSTR( EQUW fnINT-$ ; &A8 - INT EQUW fnLEN-$ ; &A9 - LEN EQUW fnLN-$ ; &AA - LN EQUW fnLOG-$ ; &AB - LOG EQUW fnNOT-$ ; &AC - NOT EQUW fnOPENUP-$ ; &AD - OPENUP EQUW fnOPENOUT-$ ; &AE - OPENOUT EQUW fnPI-$ ; &AF - PI EQUW fnPOINT-$ ; &B0 - POINT( EQUW fnPOS-$ ; &B1 - POS EQUW fnRAD-$ ; &B2 - RAD EQUW fnRND-$ ; &B3 - RND EQUW fnSGN-$ ; &B4 - SGN EQUW fnSIN-$ ; &B5 - SIN EQUW fnSQR-$ ; &B6 - SQR EQUW fnTAN-$ ; &B7 - TAN EQUW fnTO-$ ; &B8 - TO EQUW fnTRUE-$ ; &B9 - TRUE EQUW fnUSR-$ ; &BA - USR EQUW fnVAL-$ ; &BB - VAL EQUW fnVPOS-$ ; &BC - VPOS EQUW fnCHRs-$ ; &BD - CHR$ EQUW fnGETs-$ ; &BE - GET$ EQUW fnINKEYs-$ ; &BF - INKEY$ EQUW fnLEFTs-$ ; &C0 - LEFT$( EQUW fnMIDs-$ ; &C1 - MID$( EQUW fnRIGHTs-$ ; &C2 - RIGHT$( EQUW fnSTRs-$ ; &C3 - STR$( EQUW fnSTRINGs-$ ; &C4 - STRING$( EQUW fnEOF-$ ; &C5 - EOF EQUW errNoSuchVar-$ ; &C6 - AUTO EQUW errNoSuchVar-$ ; &C7 - DELETE EQUW errNoSuchVar-$ ; &C8 - LOAD EQUW errNoSuchVar-$ ; &C9 - LIST EQUW errNoSuchVar-$ ; &CA - NEW EQUW errNoSuchVar-$ ; &CB - OLD EQUW errNoSuchVar-$ ; &CC - RENUMBER EQUW errNoSuchVar-$ ; &CD - SAVE EQUW errNoSuchVar-$ ; &CE - PUT EQUW fnPTR-$ ; &CF - PTR EQUW fnPAGE-$ ; &D0 - PAGE EQUW fnTIME-$ ; &D1 - TIME EQUW fnLOMEM-$ ; &D2 - LOMEM EQUW fnHIMEM-$ ; &D3 - HIMEM EQUW errNoSuchVar-$ ; &D4 - SOUND EQUW errNoSuchVar-$ ; &D5 - BPUT EQUW errNoSuchVar-$ ; &D6 - CALL EQUW errNoSuchVar-$ ; &D7 - CHAIN EQUW errNoSuchVar-$ ; &D8 - CLEAR EQUW errNoSuchVar-$ ; &D9 - CLOSE EQUW errNoSuchVar-$ ; &DA - CLG EQUW errNoSuchVar-$ ; &DB - CLS EQUW errNoSuchVar-$ ; &DC - DATA EQUW errNoSuchVar-$ ; &DD - DEF EQUW fnDIM-$ ; &DE - DIM EQUW errNoSuchVar-$ ; &DF - DRAW EQUW fnEND-$ ; &E0 - END EQUW errNoSuchVar-$ ; &E1 - ENDPROC EQUW errNoSuchVar-$ ; &E2 - ENVELOPE EQUW errNoSuchVar-$ ; &E3 - FOR EQUW errNoSuchVar-$ ; &E4 - GOSUB EQUW errNoSuchVar-$ ; &E5 - GOTO EQUW errNoSuchVar-$ ; &E6 - GCOL EQUW errNoSuchVar-$ ; &E7 - IF EQUW errNoSuchVar-$ ; &E8 - INPUT EQUW errNoSuchVar-$ ; &E9 - LET EQUW errNoSuchVar-$ ; &EA - LOCAL EQUW fnMODE-$ ; &EB - MODE EQUW errNoSuchVar-$ ; &EC - MOVE EQUW errNoSuchVar-$ ; &ED - NEXT EQUW errNoSuchVar-$ ; &EE - ON EQUW fnVDU-$ ; &EF - VDU EQUW errNoSuchVar-$ ; &F0 - PLOT EQUW errNoSuchVar-$ ; &F1 - PRINT EQUW errNoSuchVar-$ ; &F2 - PROC EQUW errNoSuchVar-$ ; &F3 - READ EQUW errNoSuchVar-$ ; &F4 - REM EQUW errNoSuchVar-$ ; &F5 - REPEAT EQUW fnREPORT-$ ; &F6 - REPORT EQUW errNoSuchVar-$ ; &F7 - RESTORE EQUW errNoSuchVar-$ ; &F8 - RETURN EQUW errNoSuchVar-$ ; &F9 - RUN EQUW errNoSuchVar-$ ; &FA - STOP EQUW errNoSuchVar-$ ; &FB - COLOUR EQUW errNoSuchVar-$ ; &FC - TRACE EQUW errNoSuchVar-$ ; &FD - UNTIL EQUW fnWIDTH-$ ; &FE - WIDTH EQUW fnOSCLI-$ ; &FF - OSCLI .errNoSuchVar jsr pc,Error equb 26,"No such variable",0 align ; Program environment functions ; ============================= .fnPAGE mov SV_PAGE,r4 br fn16bit .fnTO movb (r5)+,r0 cmpb r0,#ASC"P" beq fnTOP jmp errNoSuchVar .fnTOP jsr pc,FindTOP ; Check program for consistancy mov SV_TOP,r4 br fn16bit .fnLOMEM mov SV_LOMEM,r4 br fn16bit .fnEND mov SV_VAREND,r4 br fn16bit .fnHIMEM mov SV_HIMEM,r4 br fn16bit .fnERL mov SV_ERL,r4 br fn16bit .fnERR mov SV_ERR,r4 br fn8bit .fnCOUNT movb SV_COUNT,r4 br fn8bit .fnWIDTH movb SV_WIDTH,r4 .fn8bit bic #&FF00,r4 br fn16bit .fnFALSE clr r4 .fn16bit clr r3 clr r2 ; Set type=integer and set flags rts pc .fnTRUE mov #&FFFF,r4 mov r4,r3 clr r2 rts pc ; String functions ; ================ .fnREPORT cmpb r0,#ASC"$" ; Check for '$' beq fnREPORTs jmp errNoSuchVar .fnREPORTs inc r5 ; Step past '$' mov SV_FAULT,r4 inc r4 ; r4=>error string mov r4,r3 .fnREPORTlp tstb (r3)+ ; Look for zero terminator bne fnREPORTlp sub r4,r3 dec r3 ; r3=string length mov #&8000,r2 ; r2=type=string rts pc .fnASC jsr pc,EvalStrVal tst r3 ; Null string? beq fnTRUE ; Null string, return -1 movb (r4),r4 ; Get first byte br fn8bit .fnLEN jsr pc,EvalStrVal mov r3,r4 ; Move length to value br fn16bit .fnCHRs jsr pc,EvalIntVal movb r4,SV_STRING ; Put char in string buffer adr SV_STRING,r4 ; Point to string mov #1,r3 ; Length=1 mov #&8000,r2 ; Type=String rts pc ; Logical/bitwise operations ; ========================== .fnOR mov (sp)+,r1 ; Pop return address tst (sp)+ ; Drop exponent bis (sp)+,r4 bis (sp)+,r3 tst r2 jmp (r1) ; Return via r1 .fnEOR mov (sp)+,r1 ; Pop return address tst (sp)+ ; Drop exponent xor r3,(sp) xor r4,2(sp) mov (sp)+,r4 mov (sp)+,r3 tst r2 jmp (r1) ; Return via r1 .fnAND mov (sp)+,r1 ; Pop return address tst (sp)+ ; Drop exponent com (sp) com 2(sp) bic (sp)+,r4 bic (sp)+,r3 tst r2 jmp (r1) ; Return via r1 ; Numeric functions ; ================= .fnABS jsr pc,EvalNumVal beq fnABSint ; Jump if integer bic #&80,r3 ; Ensure float sign bit=0 tst r2 ; Set flags rts pc .fnABSint tst r3 ; Check integer b31 bmi fnNOT1 ; Complement if negative tst r2 ; Set flags rts pc .fnNOT jsr pc,EvalIntVal .fnNOT1 com r4 com r3 tst r2 ; Set flags rts pc .fnSGN jsr pc,EvalNumVal bne fnSGN1 ; Jump if float tst r3 bne fnSGN1 ; Integer<>&00xx, test sign tst r4 beq fnFALSE ; Integer=0, jump to return 0 .fnSGN1 tst r3 ; b15=integer b31 or float sign bit bmi fnTRUE ; <0 - return -1 mov #1,r4 ; >0 - return 1 br fn16bit .fnPI mov #&DAA2,r4 ; mantissa=&xxxxDAA2 mov #&490F,r3 ; mantissa=&490Fxxxx mov #&0082,r2 ; real exponent=&82 rts pc ; Subtraction - - ; ================================= ; On entry, r2/r3/r4 = RHS value ; sp=>retaddr, r2/r4/r3 = LHS value .fnSubtract jsr pc,NegateNumber ; Change to + - ; Fall through into Addition ; Addition - + ; ============================ ; On entry, r2/r3/r4 = RHS value ; sp=>retaddr, r2/r4/r3 = LHS value .fnAdd tst r2 bmi fnAddString ; + bne fnAddFloat ; + ; + tst 2(sp) bmi errTypeMis ; + bne fnAddFloat1 ; + ; + mov (sp)+,r1 ; Pop return address tst (sp)+ ; Drop exponent add (sp)+,r4 ; Add b0-b15 adc r3 ; Add carry from b0-b15 add (sp)+,r3 ; Add b16-b31 tst r2 ; Set flags jmp (r1) ; Return via r1 .fnAddFloat ; + tst 2(sp) bmi errTypeMis ; + ; + or .fnAddFloat1 ; + ; ** unfinished ** mov (sp)+,r1 ; Pop return address mov (sp)+,r2 ; Pop previous value from stack mov (sp)+,r4 mov (sp)+,r3 tst r2 jmp (r1) ; Return via r1 ;jsr pc,EnsureFloat ; Ensure current value is a float ;jsr pc,EnsureFloatStack ; Ensure stacked value is a float .fnAddString ; + tst 2(sp) bpl errTypeMis ; + ; sp=> retaddr, type, length, string mov r3,r0 add 4(sp),r0 ; Find combined length cmp r0,#256 ; String too long? bcc errStringTooLong adr SV_STRING,r1 ; Point to string buffer add r0,r1 ; Add length of joined string tst r3 beq fnAddStr1 ; Current string is zero length add r3,r4 ; Point to end of current string .fnAddStrLp1 movb -(r4),-(r1) ; Copy character to end of string buffer dec r3 bne fnAddStrLp1 ; Loop to copy current string .fnAddStr1 mov (sp)+,r1 ; Pop return address jsr pc,UnstackString ; Pop string from stack to start of string buffer mov r0,r3 ; r3=combined string length tst r2 ; r4=string start, set flags jmp (r1) ; Return via r1 .errStringTooLong jsr pc,Error equb 19 equs "String too long",0 align .errTypeMis jmp errTypeMismatch ; Multiplication - * ; ================================= ; On entry, r2/r3/r4 = RHS value ; sp=>retaddr, r2/r4/r3 = LHS value .fnMultiply mov r3,r1 mov r4,r0 clr r3 clr r4 tst 4(sp) bne fnMultiplyLp tst 6(sp) bne fnMultiplyLp beq fnMultiplyZero ; 0*num = 0 .fnMultiplyLp add r0,r4 adc r3 add r1,r3 tst 4(sp) bne fnMultiply1 dec 6(sp) .fnMultiply1 dec 4(sp) bne fnMultiplyLp tst 6(sp) bne fnMultiplyLp .fnMultiplyZero mov (sp)+,r1 ; Pop return address add #6,sp ; Pop LHS from stack clr r2 ; Type=integer jmp (r1) ; Return via r1 ; Division - / ; ============================== ; On entry, r2/r3/r4 = RHS value ; sp=>retaddr, r2/r4/r3 = LHS value .fnDIV .fnDivide jsr pc,NegateNumber tst r4 bne fnDivideNotZero tst r3 bne fnDivideNotZero jsr pc,Error equb 18,"Divide by zero",0 align .fnDivideNotZero mov 4(sp),r1 ; Swap LHS and RHS mov 6(sp),r2 mov r3,6(sp) mov r4,4(sp) mov #&FFFF,r3 mov r3,r4 tst r1 bne fnDivideLp tst r2 bne fnDivideLp jmp fnFALSE ; 0/num = 0 .fnDivideLp inc r4 bne fnDivideLp2 inc r3 .fnDivideLp2 add 4(sp),r1 adc r2 add 6(sp),r2 bcs fnDivideLp mov (sp)+,r1 ; Pop return address add #6,sp ; Pop LHS from stack clr r2 ; Type=integer jmp (r1) ; Return via r1 ; UNIMPLEMENTED FUNCTIONS ; ======================= .fnMOD .fnPower mov (sp)+,r1 ; Pop return address mov (sp)+,r2 ; Pop previous value from stack mov (sp)+,r4 mov (sp)+,r3 tst r2 rts pc .fnLEFTs .fnMIDs .fnRIGHTs .fnSTRs .fnSTRINGs .fnINSTR .fnLineNum .fnACS .fnASN .fnATN .fnCOS .fnDEG .fnEVAL .fnEXP .fnFN .fnLN .fnLOG .fnRAD .fnRND .fnSIN .fnSQR .fnTAN .fnUSR .fnVAL .fnDIM jsr pc,PrintInline equs "Unimplemented function",13,0 align clr r4 clr r3 clr r2 rts pc