; > 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 ; NumberToString does hex and integer decimal ; 04-Sep-2008: STRING$, STR$, LEFT$, RIGHT$, VAL, EVAL, LineNum, USR, CALL ; 12-Sep-2008: NumberToString does octal and binary conversions. ; 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=function token for unary operators ; r2/r3/r4=current value for binary operators ; Binary operators have sp=> retaddr, previous value r2,r3,r4 ; Unary functions 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 ; ; flags must be set from r2 on exit ; .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/EDIT 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 ; 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 .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 .fnConversion sec ; Preset 'conversion flag found' mov r1,-(sp) ; Save current flag bis #&8400,r1 ; Set flag to hex cmp r0,#ASC"~" beq fnConvGo ; Convert to hex string sub #&0100,r1 ; Set flag to octal cmp r0,#ASC"#" beq fnConvGo ; Convert to oct string sub #&0200,r1 ; Set flag to binary cmp r0,#ASC"/" beq fnConvGo ; Convert to binary string bic #&FF00,r1 ; Set flag to decimal dec r5 ; Balance following inc mov (sp),r1 ; Get saved flag clc ; Set 'no conversion flag' .fnConvGo tst (sp)+ ; Drop saved flag inc r5 ; Step past conversion flag rts pc .fnSTRs clr r1 ; Set to decimal jsr pc,fnConversion ; Check for ~/# character and set r1 to conversion flag mov r1,-(sp) ; Save dec/hex flag jsr pc,EvalNumVal mov (sp)+,r1 ; Get dec/hex flag back ; Fall through into number conversion ; Convert a number to a string ; ---------------------------- ; On entry: r1=hex/oct/bin flag in b15-b8 ; r2=exponent ; r3,r4=integer/mantissa ; On exit: r5 preserved ; r4=>string ; r3=length ; r2='string' type, flags set ; r1 preserved ; r0 corrupted .NumberToString mov r1,-(sp) ; Save field width/base flag and check b15 bpl DecimalToString ; b15 clear, convert to decimal jsr pc,EnsureInteger ; If float, convert to integer clr -(sp) ; 4(sp)=leading zero flag swab r1 ; Get base to bottom byte bic #&FFF0,r1 ; Reduce to 1,3,4 mov r1,-(sp) ; 2(sp)=bits per digit mov #31,-(sp) ; (sp)=number of bits-1 mov r1,r2 ; r2=bits for this digit adr SV_STRING,r1 ; Point to string buffer bit #2,r2 beq NumToStrLp1 ; Not octal, go ahead dec r2 ; Only two bits in first octal digit .NumToStrLp1 clr r0 ; Clear digit accumulator .NumToStrLp2 rol r4 ; Rotate bits into r0 rol r3 rol r0 dec (sp) ; Dec bit counter dec r2 ; Dec bits for this digit bne NumToStrLp2 tst r0 bne NumToStrDigit ; Not zero, output digit mov 4(sp),r0 ; Check leading zero flag beq NumToStrNxt ; Nothing output yet .NumToStrDigit bis #ASC"0",r0 ; Convert to digit cmp r0,#ASC"9"+1 bcs NumToStrOut add #7,r0 ; Convert hex digit .NumToStrOut movb r0,(r1)+ ; Put character in string buffer mov #ASC"0",4(sp) ; Output zeros from now on .NumToStrNxt mov 2(sp),r2 ; Set number of bits for next digit tst (sp) ; All digits done yet? bpl NumToStrLp1 ; Loop back for more tst (sp)+ ; Pop bit count tst (sp)+ ; Pop bits per digit tst (sp)+ ; Still no leading zeros? bne NumToStrDone movb #ASC"0",(r1)+ ; Output '0' for &0 .NumToStrDone adr SV_STRING,r4 ; r4=>string sub r4,r1 mov r1,r3 ; r3=length mov (sp)+,r1 ; r1=field width+hex flag mov #&8000,r2 ; r2='string', flags set rts pc ; r0 corrupted ;adr SV_STRING,r1 ; Point to string buffer ;clr r2 ; No leading zeros ;mov #8,-(sp) ; Count eight hex digits ;.HexToStrLp1 ;mov #4,-(sp) ; Rotate 4 bits ;.HexToStrLp2 ;rol r4 ; Move top nybble into r0 ;rol r3 ;rol r0 ;dec (sp) ;bne HexToStrLp2 ;clr (sp)+ ; Pop count from stack ;bic #&FFF0,r0 ; Keep bottom nybble ;bne HexToStrDigit ; Non-zero, output a digit ;mov r2,r0 ;beq HexToStrNxt ; No leading zeros ;.HexToStrDigit ;bis #ASC"0",r0 ; Convert to digit ;cmp r0,#ASC"9"+1 ;bcs HexToStrOut ;add #7,r0 ;.HexToStrOut ;movb r0,(r1)+ ; Put character in string buffer ;mov #ASC"0",r2 ; Output zeros from now on ;.HexToStrNxt ;dec (sp) ;bne HexToStrLp1 ; Loop for 8 digits ;clr (sp)+ ; Pop count ;tst r2 ; Still no leading zeros? ;bne HexToStrDone ;movb #ASC"0",(r1)+ ; Output '0' for &0 ;.HexToStrDone ;adr SV_STRING,r4 ; r4=>string ;sub r4,r1 ;mov r1,r3 ; r3=length ;mov (sp)+,r1 ; r1=field width+hex flag ;mov #&8000,r2 ; r2='string', flags set ;rts pc ; r0 corrupted ; r5 preserved ; .DecimalToString jsr pc,EnsureInteger ; Force float to integer .IntegerToString adr SV_STRING,r1 ; Point to string buffer tst r3 ; Check sign bit bpl DecimalNotNeg movb #ASC"-",(r1)+ ; Put '-' sign in string buffer mov r1,-(sp) jsr pc,NegateNumber mov (sp)+,r1 .DecimalNotNeg movb #0,(r1) ; Flag 'no digits yet' adr DecimalUnits,r2 ; Point to divisors .DecimalNextDigit clr r0 ; Set digit to zero .DecimalLoop cmp 2(r2),r3 bcs DecimalSub ; eg, r3/r4 > &3B9Axxxx, must be &3B9B or higher beq DecCheckLow ; eg, r3/r4 = &3B9Axxxx, check low word bcc DecimalDigit ; eg, r3/r4 =< &3B9Axxxx, must be < &3B9A0000 .DecCheckLow cmp (r2),r4 bcs DecimalSub ; eg, r3/r4 > &3B9ACA00 beq DecimalSub ; eg, r3/r4 = &3B9ACA00 bcc DecimalDigit ; eg, r3/r4 =< &3B9ACA00, must be <&3B9ACA00 .DecimalSub sub (r2),r4 sbc r3 sub 2(r2),r3 ; r3/r4=r3/r4-divisor inc r0 ; Increment digit br DecimalLoop .DecimalDigit tst r0 ; r0=digit bne DecimalNotZero tstb (r1) ; Any digits yet? beq DecimalLeadingZero .DecimalNotZero add #ASC"0",r0 movb r0,(r1)+ ; Store digit movb #13,(r1) ; Flag 'some digits done' .DecimalLeadingZero add #4,r2 ; Point to next divisor tst (r2) ; End of divisor table? bne DecimalNextDigit ; Do more units add #ASC"0",r4 movb r4,(r1)+ ; Store final digit br NumToStrDone .DecimalUnits equd 1000000000 equd 100000000 equd 10000000 equd 1000000 equd 100000 equd 10000 equd 1000 equd 100 equd 10 equw 0 .fnLEFTs .fnRIGHTs mov r2,-(sp) ; Save LEFT$/RIGHT$ token jsr pc,EvalString mov (sp)+,r0 jsr pc,StackStringAndOp mov r0,-(sp) jsr pc,EvalComma jsr pc,CheckClose mov (sp)+,r0 mov r4,r1 jsr pc,UnstackStringDropOp ; r0=LEFT$/RIGHT$ token ; r1=wanted length ; r2=x ; r3=length ; r4=start mov r3,r2 cmp r1,r3 bcc fnLEFTall cmp r0,#tknLEFTs beq fnLEFTdo add r3,r4 sub r1,r4 .fnLEFTdo mov r1,r2 .fnLEFTall mov r2,r3 mov #&8000,r2 rts pc .fnSTRINGs jsr pc,EvalInteger mov r4,-(sp) jsr pc,CheckComma jsr pc,EvalString jsr pc,CheckClose ;jsr pc,EnsureString ; Ensure string is at start of string buffer mov r3,r0 ; r0=source length mov (sp)+,r4 ; r4=multiplier clr r3 ; r3=dest length tst r4 beq fnSTRINGzero ; zero length adr SV_STRING,r2 mov r2,r1 ; r0=source length ; r1=source string ; r2=dest string ; r3=new length ; r4=multiplier mov r1,-(sp) mov r0,-(sp) .fnSTRINGlp1 mov (sp),r0 mov 2(sp),r1 .fnSTRINGlp2 movb (r1)+,(r2)+ inc r3 bit #&FF00,r3 bne errStringTooLong dec r0 bne fnSTRINGlp2 dec r4 bne fnSTRINGlp1 tst (sp)+ tst (sp)+ .fnSTRINGzero adr SV_STRING,r4 mov #&8000,r2 rts pc .fnINSTR jmp fnFALSE .fnMIDs adr SV_STRING,r4 clr r3 clr #&8000 rts pc .errStringTooLong jsr pc,Error equb 19 equs "String too long",0 align ; Numeric operations ; ================== ; 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 .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 .fnMOD .fnPower 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 ; 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 .fnVAL jsr pc,EvalStrValCR mov r5,-(sp) ; Save program pointer mov r4,r5 jsr pc,EvalDecimal mov (sp)+,r5 ; Restore program pointer tst r2 ; Set flags rts pc .fnEVAL jsr pc,EvalStrValCR mov r5,-(sp) ; Save program pointer mov r4,r5 ; src=dst=string jsr pc,Tokenise adr SV_STRING,r5 ; Point to resultant string jsr pc,Evaluate ; Call full evaluator mov (sp)+,r5 ; Restore program pointer tst r2 ; Set flags rts pc ; Trigonometrical functions ; ========================= .fnACS .fnASN .fnATN .fnCOS .fnDEG .fnRAD .fnSIN .fnTAN ; Logarithmic functions ; ===================== .fnEXP .fnLN .fnLOG .fnFN .fnSQR jsr pc,EvalNumVal ; Array function ; ============== .fnDIM tst r2 rts pc ; Program environment functions ; ============================= .fnLineNum movb (r5)+,r0 asl r0 asl r0 mov r0,r3 bic #&3F,r3 movb (r5)+,r1 xor r1,r3 asl r0 asl r0 bic #&3F,r0 movb (r5)+,r4 xor r0,r4 swab r4 bic #&FF00,r3 bic #&00FF,r4 bis r3,r4 clr r3 clr r2 rts pc .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 movb 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 ; These are here to be near their branch destinations ; --------------------------------------------------- .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 ; 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 ; Random Number functions ; ======================= ; =RND - return random integer 0..FFFFFFFF ; =RND(<0) - initialise seed, return n ; =RND(0) - return last RND(1) value ; =RND(1) - real random 0..1 ; =RND(>1) - integer random 1..n .fnRND cmp r0,#ASC"(" beq fnRNDnum ; ; =RND - update seed, return 32-bit seed .fnRNDupdate mov #&20,r2 .fnRNDlp movb SV_RAND+2,r0 asrb r0 asrb r0 asrb r0 movb SV_RAND+4,r1 xor r1,r0 rorb r0 rol SV_RAND+0 rol SV_RAND+2 rolb SV_RAND+4 dec r2 bne fnRNDlp ; ; =RND(0) - return last seed as 32-bit integer .fnRNDzero clr r2 .fnRNDreturn mov SV_RAND+0,r4 mov SV_RAND+2,r3 tst r2 rts pc ; ; =RND(n) .fnRNDnum jsr pc,EvalInteger mov r3,r0 bmi fnRNDminus ; ; =RND(>-1) bis r4,r0 beq fnRNDzero ; ; =RND(>0) .fnRNDnonzero tst r3 bne fnRNDplus cmp r4,#1 bne fnRNDplus ; ; =RND(1) - update seed, return seed as 40-bit real jsr pc,fnRNDupdate mov #&0080,r2 ; real, exponent=&80 br fnRNDreturn ; ; =RND(>1) - update seed, use as real, multiply by n, return n as 32-bitint .fnRNDplus mov r3,-(sp) mov r4,-(sp) clr -(sp) ; stack n jsr pc,fnRNDupdate mov #&0080,r2 ; real, exponent=&80 jsr pc,fnMultiply jmp EnsureInteger ; ; =RND(<0) - set seed, return n .fnRNDminus mov r4,SV_RAND+0 mov r3,SV_RAND+2 clr SV_RAND+4 clr r2 rts pc ; Calling machine code ; ==================== .cmdCALL jsr pc,EvalInteger br fnUSRgo .fnUSR jsr pc,EvalIntVal .fnUSRgo mov r5,-(sp) jsr pc,CallCode mov (sp)+,r5 clr r2 rts pc .CallCode mov SV_VARS+4,r0 ; r0=A% tst r3 bne CallCodeRaw ; dest>&FFFF cmp r4,#&FF00 bcc CallCodeMOS ; dest>&FF00, dest<&10000 .CallCodeRaw mov r4,-(sp) ; Stack destination address mov SV_VARS+8,r1 ; r1=B% mov SV_VARS+12,r2 ; r2=C% mov SV_VARS+16,r3 ; r3=D% mov SV_VARS+20,r4 ; r4=E% mov SV_VARS+24,r5 ; r5=F% rts pc ; Jump to destination .CallCodeMOS jsr pc,CallMOS mov r2,r3 ; b16-b31=returned r2 mov r0,r4 ; b0-b7=returned r0 swab r1 bic #&00FF,r1 bis r1,r4 ; b8-b15=returned r1 rts pc .CallMOS mov SV_VARS+96,r1 ; r1=X% mov SV_VARS+100,r2 ; r2=Y% cmp r1,#256 bcc CallMOS2 ; X%>255, use as is swab r2 bis r2,r1 ; r1=X%+256*Y% swab r2 .CallMOS2 sub #&FFCE,r4 ; R4=offset from MOS jump block bic #1,r4 ; Force to even address adr MOSJumpBlock,r3 ; Point to MOS jump block add r3,r4 ; Point to emulated entry point jmp (r4) ; Jump to entry point .MOSJumpBlock br _ffce br _ffd1 nop br _ffd4 br _ffd7 nop br _ffda br _ffdd nop br _ffe0 br _ffe3 nop br _ffe7 nop br _ffea br _ffec br _ffee br _fff1 nop br _fff4 br _fff7 nop ._ffce JMP IO_FIND ; r0=A%, r1=X%+256*Y%=>string ._ffd1 JMP IO_GBPB ; r0=A%, r1=X%+256*Y%=>block ._ffd4 MOV R2,R1 ; r1=Y%=handle JMP IO_BPUT ; r0=A%, r1=handle ._ffd7 MOV R2,R1 ; r1=Y%=handle JMP IO_BGET ; r0=A%, r1=handle ._ffda mov r1,r2 mov SV_VARS+100,r1 JMP IO_ARGS ; r0=A%, r1=Y%, r2=X%+256*Y% ._ffdd JMP IO_FILE ; r0=A%, r1=X%+256*Y%=>block ._ffe0 JMP IO_RDCH ; entry values ignored ._ffe3 JMP IO_ASCI ; r0=A% ._ffe7 JMP IO_NEWL ; entry values ignored ._ffea JMP IO_NEWL ; entry values ignored ._ffec JMP IO_WRCR ; entry values ignored ._ffee JMP IO_WRCH ; r0=A% ._fff1 JMP IO_WORD ; r0=A%, r1=X%+256*Y%=>block ._fff4 JMP IO_BYTE ; r0=A%, r1=X%, r2=Y% ._fff7 MOV R1,R0 ; r0=X%+256*Y%=>string JMP IO_CLI ; r0=>string