;********* ; * ; BASIC1 * ; * ;********* .TITLE BASFPP ; ; FPP OBJECT MODULE FOR BASIC 1 JUNE 72 ; ; DOS VERSION FROM WHICH THE RSX VERSION EVOLVED WAS ORIGIANLLY A DECUS ; LIBRARY PROGRAM MODIFIED BY FRANK KORZENIEWSKI OF RPSLMC. ; ; MODIFIED FOR OPERATION UNDER RSX BY LARRY SIMPSON & FRANK BORGER ; SEP-75 .SBTTL JSR MACRO DEFINITIONS ;CODE TO CONVERT TRAP SUBROUTINE CALLS TO NORMAL JSR'S ;FOR OPERATION UNDER RSX. ; ;DEFINE A GENERAL MACRO TO GENERATE A SECOND MACRO WHICH ;CONVERTS A TRAP NAME OF XXXXXX TO A ; JSR PC,XXXXXX ; .MACRO TRPSUB A,B .MACRO A JSR PC,B .ENDM .ENDM ; ; NOW ALL THE ONE-TIME TRAPS THAT BASIC USES ; TRPSUB ARYLG,ARYL00 ;COMPUTE ARRAY LENGTH TRPSUB ATOF,ATOF00 ;ASCII TO FLOATING TRPSUB ATOI,ATOI00 ;ASCII TO INTEGER TRPSUB CLOSEF,CLOS00 ;CLOSE ANY OPEN FILES TRPSUB CLRUSR,CLRU00 ;CLOSE TEMP USER SPACE (IF ANY) TRPSUB CRLF,CRLF00 ;DO [CR,LF] TRPSUB DIMCHK,DIMC00 ;CHECK LEGALITY OF DIMENSIONS TRPSUB EVAL,EVAL00 ;EVALUATE ARITHMETIC EXPRESSION TRPSUB EVALS,EVLS00 ;EVALUATE STRING EXPRESSION TRPSUB FINDLN,FIND00 ;FIND LINE NUMBER (IN R0) TRPSUB GETADR,GTDR00 ;GET ADDRESS OF A VARIABLE TRPSUB GETNUM,GET00 ;GET COMMAND PARAMETER TRPSUB GETSAD,GTSD00 ;GET ADDRESS OF STRING TRPSUB GETVAR,GETV00 ;GET TRUNCATED VARIABLE TRPSUB ITOA,ITOA00 ;CONVERT INTEGER TO ASCII TRPSUB JUNKIT,JUNK00 ;SKIP OVER TRASH TO END OF LINE TRPSUB PACK,PCK00 ;PACK LINE INTO WORKING STORAGE TRPSUB PRINTC,PRNT00 ;PRINT CHARACTER TRPSUB PRINTL,PRN00 ;PRINT LINE, R0=FBA,R1=LBA TRPSUB PRNTLN,PRLN00 ;PRINT LINE NUMBER TRPSUB PSHNAM,PSH00 ;PUSH NAMED VARIABLE ONTO LIST TRPSUB PSHSTR,PSHS00 ;PUSH STRING DESCRIPTOR ONTO LIST TRPSUB PUSH,PUSH00 ;PUSH ONE WORD INTO USER LIST TRPSUB SCRNCH,SCR00 ;DELETE N BYTES FROM USER SPACE TRPSUB SKIP,SKIP00 ;SKIP OVER SPACES IN INPUT TEXT TRPSUB SQUISH,SQU00 ;DELETE TEXT TO TERMINATOR AND PACK TRPSUB SRCHLF,SRCH00 ;SEARCH FOR LINE FEED USING R1 AS POINTER TRPSUB SRLST,SRL00 ;SEARCH FOR ITEM IN USER STORAGE TRPSUB STRLEN,STRL00 ;COMPUTE STRING LENGTH TRPSUB SUBSCR,SUBS00 ;COMPUTE A SUBSCRIPT EXPRESSION TRPSUB TSTCH,TST00 ;TEST CHAR (IN R2) ALPHA VS NUMERIC TRPSUB TSTOK,TSTU00 ;CHECK, IS THERE ENOUGH USER SPACE TRPSUB TWOCHR,TWO00 ;PACK TWO CHARACTERS IN R4 TRPSUB FNMBR,FNMB00 ;GET FILE NUMBER AND SET UP FILE .SBTTL GLOBAL DEFINITIONS ; GLOBALS--ERROR CALLS ; .GLOBL LNNERR, DVFERR, FIXERR, LOGERR, SQRERR ; ; GLOBALS--ENTRY POINTS ; .GLOBL ATOF00, ATOI00, ITOA00 ; .GLOBL SINE00, COS00, ATN00, EXPF00, LOG00 .GLOBL ABS00, SQRT00, INT00, RND00, SGN00 .GLOBL PWRF00, RND01, M.I, FTOA00 TIMBUF ; ; GLOBALS--RETURNS TO MAIN--AND SYSTEM VARIABLES ; .GLOBL INIT02, RNDM ; ; ; REGISTER ASSIGNMENTS ; R0 = %0 ;TEMPORARY AND PARAMETER TRANSFER R1 = %1 ;TEMPORARY AND PARAMETER TRANSFER R2 = %2 ;SCRATCH R3 = %3 ;SCRATCH R4 = %4 ;SCRATCH R5 = %5 ;USER LIST POINTER SP = %6 ;BASIC STACK POINTER PC = %7 ;PROGRAM COUNTER ; AC0 = %0 ;F.P. REGISTER 0 AC1 = %1 ;F.P. REGISTER 1 AC2 = %2 ;F.P. REGISTER 2 AC3 = %3 ;F.P. REGISTER 3 AC4 = %4 ;F.P. REGISTER 4 ; ;RSX MACRO CALLS ; .MCALL GTIM$S ; ;PDP-11 FLOATING POINT PACKAGE ; .SBTTL RND00 - RANDOM NUMBER GENERATOR .PSECT IMPUR1,RW,CON M.I: .WORD 13507 ;THIS WORD GETS MODIFIED .PSECT BASIC1,RO,I,LCL,REL,CON ;+4 ; .SL ; .X ;SKIP THE NEXT INSTRUCTION M.AFMI: BIS #400,@SP; I ;SET THE M SWITCH BIT #4,@SP ;<- ;TEST THE E SWITCH BNE M.AFSE ;BRANCH IF SIGN OF THE EXPONENT BIT #1,@SP BNE M.AFTX BIT #30,@SP ;TEST THE A, D, AND S SWITCHES BNE M.AFVS ;IF EITHER IS SET AN ERROR IS HERE BIS #20,@SP ;SET THE A SWITCH BIT #400,@SP ;TEST IF A MINUS SIGN BEQ M.AFXN ;RETURN IF PLUS SIGN BIS #100,@SP ;SET MINUS SIGN BR M.AFXN ;GET THE NEXT CHARACTER M.AFSE: BIT #01,@SP ;TEST B AND S SWITCHES BNE M.AFTX ;ERROR IF EITHER IS SET BIT @SP,#40 BNE M.AFVS BIS #40,@SP ;SET THE B SWITCH BIT #400,@SP ;TEST FOR A MINUS SIGN BEQ M.AFXN ;EXIT IF A PLUS BIS #200,@SP ;SET MINUS EXPONENT BR M.AFXN ;GET NEXT CHARACTER M.AFVS: BIS #2,@SP ;SET V SWITCH BR M.AFTX M.AFTX: BIT #100,@SP ;SEE IF IT SHOULD BE NEGATIVE BEQ M.AFX2 ;BRANCH OF NO CONVERSION NEGF AC0 ;NEGATE THE NUMBER M.AFX2: BIT #200,@SP ;SEE IF A NEGATIVE EXPONENT BEQ M.AFX3 ;BRANCH IF NO NEGATION NEG 4(SP) ;NEGATE THE EXPONENT BVC M.AFX3 ;TEST FOR VALID EXPONENT BIS #2,@SP ;SET THE V BIT BR M.AFX5 ;EXIT WITH ERROR M.AFX3: ADD 2(SP),4(SP) ;REMEMBER ANY DECIMAL PLACES BEQ M.AFX5 ;BRANCH IF NO CONVERSION BLT M.AFDV ;IF LESS THEN ZERO DIVIDE M.AFX4: MOV 4(SP),R3 ;CALC SHIFT CONSTANT LDCIF #10.,AC1 ;FLOAT SHIFT CONSTANT 1$: MULF AC1,AC0 ;ADJUST NUMBER SOB R3,1$ ;REDUCE BY EXPON BR M.AFX5 ;BYPASS DIVIDE SECTION M.AFDV: MOV 4(SP),R3 ;CALC SHIFT CONSTANT NEG R3 ;MAKE IT POSITIVE LDCIF #10.,AC1 ;FLOAT IT 1$: DIVF AC1,AC0 ;SHIFT DIGITS OVER SOB R3,1$ ;LOOP ON EXPON M.AFX5: DEC R1 ;POINT TO DELIMITER MOV (SP)+,R4 ;SAVE THE SWITCHES CMP (SP)+,(SP)+ ;REMOVE EXP2+EXP1 FROM STACK MOV (SP)+,R0 ;RESTORE R0 MOV (SP)+,R5 ;RESTORE R5 BIT #2,R4 ;TEST FOR V SETTING BEQ 1$ ;-> SEV ;ASCII ERROR 1$: RTS PC M.TEN: .FLT2 10. ;FLOATING POINT 10. M.ONE: .FLT2 1. ;FLOATING POINT 1. M.TEN6: .FLT2 10.E+6 ;FLOATING POINT 10.^6 M.TEN7: .FLT2 10.E+7 ;FLOATING POINT 10.^7 M.FIVE: .FLT2 .5 ;FLOATING POINT .5 .SBTTL FTOA00 - FLOATING POINT TO ASCII ROUTINE ; ; FTOA - FLOATING POINT TO ASCII ROUTINE ; FTOA00: CLR -(SP) ;CONVERT FROM CLR -(SP) ;2 WORD FLOATING STF AC0,-(SP) ;POINT TO 4 WORD SETD ;FLOATING LDD (SP)+,AC0 ;POINT MOV #12,R0 ;PUT SOME WORDS ON THE STACK CLR -(SP) ;CLEAR A WORD OF STACK DEC R0 ;DECREMENT THE COUNTER BGT .-4 ;LOOP IF MORE TO DO MOV #030040,2(SP) ;MOVE A SP 0 TO THE OUTPUT MOV #40,4(SP) ;FOLLOW WITH A SPACE AND NULL TSTD AC0 ;TEST THE SIGN OF THE NUMBER CFCC ;GET CONCODES BEQ M.XAXT ;IF 0 WE'RE DONE ALREADY BGT M.XA1 ;IF NEGATIVE MAKE POSITIVE NEGD AC0 ;MAKE IT PLUS MOVB #55,2(SP) ;MOVE IN A - SIGN M.XA1: CMPD M.ONED,AC0 ;START RANGING - COMPARE 1:# CFCC BLE M.XA3 ;BRANCH IF TOO SMALL M.XA2: CMPD M.PT1,AC0 ;CHECK .1:# CFCC BLE M.XA4 ;BRANCH IF RANGING IS DONE MULD M.TEND,AC0 ;JACK IT UP DEC @SP ;MAKE THE EXPONENT SMALLER BR M.XA2 ;SEE IF IT'S BIG ENOUGH M.XA3: DIVD M.TEND,AC0 ;PULL IT DOWN A BIT INC @SP ;MAKE THE EXPONENT LARGER BR M.XA1 ;SEE IF IT'S IN RANGE YET M.XA4: ADDD M.FIVD,AC0 ;ROUND IT UP ;HERE MAKE SURE RANGING WAS DONE PROPER STD AC0,AC2 ;COPY IT MODD M.TEND,AC2 ;DO TRIAL DIGIT STRIP STCDI AC3,-(SP) ;INTEGER IT CMP (SP)+,#9. ;A SCREW UP????? BLE M.XA13 ;JUMP IF ALL OK DIVD M.TEND,AC0 ;ADJUST INC @SP M.XA13: MOV @SP,R0 ;CHECK MAGNITUDE OF EXPONENT BPL .+4 ;-> ;SKIP IF POSITIVE NEG R0 ; I ;ELSE MAKE POSITIVE CMP R0,#99. ;<- ;IS EXPON TOO LARGE BGT M.XAXT ;EXIT IF SO MOV SP,R0 ;POINT TO OUTPUT AREA ADD #3,R0 ;HERE CALC NUMBER OF SIGNIFICANT DIGITS IN NUMBER STD AC0,AC2 ;USE AC2-AC3 MOV #7,R3 ;MAX SIGNIF DIGITS CLR R2 ;SLOT FOR TRAIL ZERO COUNT M.XA5: MODD M.TEND,AC2 ;STRIP A DIGIT DEC R2 ;ZERO'D IF NOT A ZERO DIGIT TSTF AC3 ;CHECK FOR ZERO DIGIT CFCC BEQ .+4 ;-> ;COUNT IT IF NOT ZERO CLR R2 ; I ;ELSE RESET COUNT SOB R3,M.XA5;<- ;LOOP FOR 7 DIGITS ;NOW CHECK FOR F OR E FORMAT REQUIRED CMP @SP,#8. ;IF NUM>10^7 BGE M.ZEA0 ;JUMP IF E FOR SURE CMP @SP,#-6. ;IF NUM<10^-7 BLT M.ZEA0 ;JUMP IF E FOR SURE TST @SP ;IF 10^0 THRU 10^7 BPL .+6 ;-> ;ITS F FOR SURE TST R2 ; I ;BUT NUM<10^0 AND 7 SIGNIF DIGITS BEQ M.ZEA0 ; I ;ITS E FOR SURE ADD #7,R2 ;<- ;MAKE TRAIL BLANK COUNT TO SIGNIF COUNT MOV (SP)+,R3 ;GET 10^X POWER MOV #M.XA9,-(SP) ;SET RETURN ADDRESS NEG R3 ;CHECK FOR DIGITS TO LEFT OF D.P. BGT M.XA11 ;JUMP IF NO INTEGER DIGITS BEQ M.XA12 ;BR IF NO ZERO PADD NEG R3 ;MAKE POSITIVE AGAIN ;SUBROUTINE TO CONVERT FLOATING DIGITS TO ASCII M.XA6: MODD M.TEND,AC0 ;STRIP A DIGIT (LOVE THAT INSTRUCTION) STCDI AC1,-(SP) ;MAKE INTEGER (THIS ONE TOO) ADD #60,@SP ;NOW MAKE ASCII MOVB (SP)+,(R0)+ ;PUT IN OUTPUT AREA DEC R2 ;ACCOUNT FOR SIGNIF DIGIT SOB R3,M.XA6 ;LOOP ON DIGITS WANTED COUNT M.XA12: MOV R2,R3 ;MORE SIGNIF DIGITS LEFT BLE M.XA8 ;EXIT IF NONE LEFT M.XA7: MOVB #56,(R0)+ ;MOVE IN DEC. PT. CLR R2 ;ZAP FLAG TO FORCE EXIT NEXT TIME BR M.XA6 ;REDO SUBROUTINE M.XA8: RTS PC ;THIS EXITS INTERNAL SUB (STILL IN FTOA) M.XA11: MOVB #56,(R0)+ ;D.P. THEN ZERO PADD MOVB #60,(R0)+ ;PADD SOB R3,.-4 ;LOOP ON EXPON MOV R2,R3 ;SET ALL SIGNIF DIGITS WANTED CLR R2 ;ZAP TWO PASS FLAG BR M.XA6 ;DO INTERNAL SUB ;EXITING FTOA ROUTINE M.XA9: MOVB #40,(R0)+ ;BLANK AT END CLRB @R0 ;FOLLOWED BY ZERO BYTE M.XA10: SETF ;RESTORE 2 WORD MODE MOV 22(SP),PC ;AND EXIT FTOA M.XAXT: TST (SP)+ ;POP GARBAGE BR M.XA10 ;AND EXIT ;HERE WE COME IF E FORMAT REQUIRED M.ZEA0: MOV R2,R3 ;SET CHAR REQUIRED COUNT ADD #7,R3 ;ADJUST IT JSR PC,M.XA7 ;OUTPUT D.P. AND DIGITS MOVB #105,(R0)+ ;OUTPUT 'E' MOV R1,R4 ;SAVE TEXT POINTER MOV (SP)+,R1 ;GET EXPONENT ITOA ;INTO OUTPUT AREA MOV R4,R1 ;RESTORE TEXT POINTER BR M.XA9 ;AND DO EXIT STUFF M.ONED: .FLT4 1. ;FLOATING POINT 1. M.PT1: .FLT4 .1 ;FLOATING POINT .1 M.TEND: .FLT4 10. ;FLOATING POINT 10. M.FIVD: .FLT4 .00000005 ;FLOATING POINT .5 .SBTTL ITOA00 - INTEGER TO ASCII CONVERSION ; ; ITOA - INTEGER TO ASCII ROUTINE ; ON ENTRY: ; R0 CONTAINS ADDRESS OF OUTPUT STRING ; R1 CONTAINS NUMBER TO CONVERT ; ITOA00: TST R1 ;SEE IF NUM IS NEG BMI 1$ ;IF SO, SKIP LEADING SPACE MOVB #40,(R0)+ ;PUT IN SPACE 1$: CLR R2 ;INDICATE NO LEADING ZEROES JSR PC,$CBDSG ;USE LIBRARY CONVERSION ROUTINE CLRB (R0) ;SET ZERO FLAG AT END RTS PC .SBTTL ATOI00 - ASCII TO INTEGER CONVERSION ; ; ASCII TO INTEGER ROUTINE ; USED FOR LINE NUMBER CONVERSION ; ATOI00: MOV R3,-(SP) ;SAVE CLR R3 ;COLLECT INTO R3 RETURN IN R0 M.AINX: SKIP ;GET A CHARACTER FROM THE INPUT STREAM TSTCH ;SEE IF IT IS IN RANGE FOR A DIGIT BNE M.AIXT ;ALL DONE IF NON-NUMERIC SUB #60,R2 ;REDUCE TO A BINARY VALUE MUL #10.,R3 ;SHIFT OVER PREVIOUS DIGITS BCS 1$ ;IF OVERFLOW, ERROR ADD R2,R3 ;LET HIM JOIN COMRADES BVC M.AINX ;IF NO OVERFLOW, TRY AGAIN 1$: LNNERR ;LINE NUMBER IS REALLY BAD M.AIXT: DEC R1 ;RESET POINTER BACK ONE CHAR. MOV R3,R0 ;IT'S EXPECTED IN R0 NOT R3 MOV (SP)+,R3 ;RESTORE REAL R3 RTS PC ;AND RETURN .SBTTL ABS00 - ABSOLUTE VALUE FUNCTION ;+4 ; .SKIP ; .X ^^ABS\\ ; .X ^ABSOLUTE VALUE FUNCTION ; .INDENT -5 ; ^^ ; ABS ; \\ ; .BREAK ; ^THIS FUNCTION RETURNS THE ABSOLUTE VALUE OF THE NUMERIC ; EXPRESSION ARGUMENT. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 10 A=ABS(A1+5) ; \\ ; .FILL ;- ABS00: ABSF AC0 ;TAKE ABS RTS PC ;AND RETURN .SBTTL SGN00 - GET SIGN OF OPERAND ;+4 ; .SKIP ; .X ^^SGN\\ ; .X ^SIGN FUNCTION ; .INDENT -5 ; ^^ ; SGN ; \\ ; .BREAK ; +1 RETURNED IF ARGUMENT > 0; -1 IF ARGUMENT < 0; ; 0 RETURNED IF ARGUMENT = 0. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 10 A=SGN(A1) ; \\ ; .FILL ;- SGN00: TSTF AC0 ;CHECK IT FOR SIGN CFCC BGT SGN01 ;+1 FOR >0 BEQ SGN02 ;IF ZERO PASS 0 BACK LDCIF #-1,AC0 ;PASS -1 FOR <0 RTS PC ;AND RETURN SGN01: LDCIF #1,AC0 ;PASS +1 FOR >0 SGN02: RTS PC ;AND RETURN .SBTTL EVALP - SUBROUTINE TO EVALUATE POLYNOMIAL ; ; SUBROUTINE TO EVALUATE A POLYNOMIAL ; WITH X IN AC1 ; JSR R0,EVALP ; .WORD # OF COEFICIENTS ; .FLT2 COEFICIENT ; . ; . ; . ; EVALP: CLRF AC0 ;SLOT FOR RESULT MOV (R0)+,-(SP) ;GET COUNT EVALP1: MULF AC1,AC0 ;TIMES X ADDF (R0)+,AC0 ;PLUS A SUB I DEC @SP ;MORE?? BNE EVALP1 ;LOOP IF SO TST (SP)+ ;CLEAN IT UP RTS R0 ;AND RETURN .SBTTL INT00 - GET INTEGER PART OF NUMBER ;+4 ; .SKIP ; .X ^^INT\\ ; .X ^INTEGER FUNCTION ; .INDENT -5 ; ^^ ; INT ; \\ ; .BREAK ; ^RETURNS GREATEST INTEGER IN THE ARGUMENT. ; ^NOTE: ^^INT(-1.5)=-2\\ ETC. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 10 A=INT(X) ; \\ ; .FILL ;- INT00: MODF M.ONE,AC0 ;GET INT IN AC1, FRAC IN AC0 TSTF AC0 ;WAS THERE NEG FRACTION LEFT CFCC BGE 1$ ;IF NOT, SKIP SUBF M.ONE,AC1 ;IF SO, CORRECT RESULT FOR GREATEST INTEGER 1$: LDF AC1,AC0 ;PASS BACK INTEGER PART RTS PC ;AND RETURN .SBTTL PWRF00 - POWER FUNCTION ; ; POWER FUNCTION ; PWRF00: STF AC1,AC4 ;SAVE NUMBER STF AC1,AC2 ;CHECK FOR INTEGER MODF M.ONE,AC2 ;INT -> AC3, FRAC -> AC2 TSTF AC2 ;ANY FRACTION? CFCC BEQ 1$ ;IF NO FRACTION, DO DIFFERENT ROUTINE JSR PC,LOG00 ;GET IT MULF AC4,AC0 ;GET AC0*LOG(AC1) JSR PC,EXPF00 ;GET EXP(AC0*LOG(AC1)) RTS PC ;AND RETURN 1$: STCFI AC3,R0 ;STORE INTEGER POWER IN R0 LDF AC0,AC1 ;REPEAT NUMBER DEC R0 ;DEC POWER (ALREADY HAVE FIRST) BEQ 2$ ;IF NOW 0 (WAS 1), RETURN BLT 3$ ;IF NEG, DO DIVIDE ROUTINE 4$: MULF AC1,AC0 ;DO IT SOB R0,4$ ;R0 TIMES BR 2$ 3$: NEG R0 ;GET # OF TIMES TO DIVIDE 5$: DIVF AC1,AC0 ;DO IT SOB R0,5$ ;R0 TIMES 2$: RTS PC .SBTTL LOG00 - FLOATING POINT NATURAL LOG ROUTINE ;+4 ; .SKIP ; .X ^^LOG\\ ; .X ^LOGARITHM - NATURAL ; .INDENT -5 ; ^^ ; LOG ; \\ ; .BREAK ; ^RETURNS THE NATURAL LOG OF THE VALUE OF THE ARGUMENT EXPRESSION. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 30 A=LOG(X) ; \\ ; .FILL ;- ; ; FLOATING POINT NATURAL LOG ROUTINE ; ; LN(Y) ; LET Y=X*2^N 1/2<=X<=1 ; ; LET U=(X-SQR(2)/2)/(X+SQR(2)/2) ; EVAL POLINOMIAL IN U^2 ; ; LET LOG(Y)=-1/2*LN(2)+P(U)+N*LN(2) ; I HOPE IT WORKS!!! ; LOG00: TSTF AC0 ;Y MUST BE >0 CFCC BGT M.XY ;JUMP IF OK M.YY: LOGERR M.ZZ: CLRF AC0 ;RETURN A ZERO RTS PC M.XY: CMPF M.ONE,AC0 ;LOG(1)=0 CFCC BEQ M.ZZ ;PASS 0 IF NEEDED STEXP AC0,R0 ;GET N LDEXP #0,AC0 ;GET X LDF AC0,AC1 ;CALC NUM+DENOM OF U SUBF M.R2B2,AC1 ;GET X-SQR(2)/2 ADDF M.R2B2,AC0 ;GET X+SQR(2)/2 DIVF AC0,AC1 ;GET U LDF AC1,AC2 ;SAVE U IN AC2 MULF AC1,AC1 ;GET U^2 JSR R0,EVALP ;DO POLINOMIAL IN U^2 .WORD 4 ;NUMBER OF COEFICIENTS .FLT2 .300974506336 ;A SUB 7 .FLT2 .399659100019 ;A SUB 5 .FLT2 .666669470507 ;A SUB 3 .FLT2 1.999999993788 ;A SUB 1 MULF AC2,AC0 ;GET P(U) SUBF M.HL2,AC0 ;GET P(U)-1/2*LN(2) LDF M.L2,AC1 ;GET LN(2) LDCIF R0,AC2 ;FLOAT N MULF AC2,AC1 ;GET N*LN(2) ADDF AC1,AC0 ;GET LOG(Y) RTS PC ;AND RETURN IT M.HL2: .FLT2 .3465736 ;1/2*LN(2) M.L2: .FLT2 .6931472 ;LN(2) M.R2B2: .FLT2 .7071068 ;SQR(2)/2 .SBTTL EXPF00 - FLOATING POINT EXPONENTIAL ROUTINE ;+4 ; .SKIP ; .X ^^EXP\\ ; .X ^EXPONENTIAL FUNCTION ; .INDENT -5 ; ^^ ; EXP ; \\ ; .BREAK ; ^RETURNS THE BASE E EXPONENTIAL OF THE ARGUMENT VALUE. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 10 A=EXP(X) ; \\ ; .FILL ;- ; ; FLOATING POINT EXPONENTIAL ROUTINE ; ; EXP(Y) ; LET N=INT(Y*LOG2(E)), R=FRAC(Y*LOG2(E)) ; LET Q=R*LOG(2)/2 ; LET Z=1+2*Q/(A0-Q+A1/(B1+Q^2)) ; SO EXP(Y)=2^N*Z^2 ; EXPF00: MULF M.LB2E,AC0 ;GET Y*LOG2(E) MODF M.ONE,AC0 ;AC0=FRAC(Y), AC1=INT(Y) MULF M.HL2,AC0 ;GET Q STF AC0,AC2 ;SAVE Q IN AC2 MULF AC2,AC2 ;GET Q^2 ADDF M.EB1,AC2 ;GET B1+Q^2 LDF M.EA1,AC3 ;GET A1 DIVF AC2,AC3 ;GET A1/(B1+Q^2) LDF M.EA0,AC2 ;GET A0 SUBF AC0,AC2 ;GET A0-Q ADDF AC3,AC2 ;GET A0-Q+A1/(B1+Q^2) ADDF AC0,AC0 ;GET 2*Q DIVF AC2,AC0 ;GET 2*Q/(A0-Q+A1/(B1+Q^2)) ADDF M.ONE,AC0 ;GET Z MULF AC0,AC0 ;GET Z^2 STCFI AC1,R0 ;GET N INC R0 ;GET N+1 CLRF AC1 ;GET 0 LDEXP R0,AC1 ;GET 2^N MULF AC1,AC0 ;GET EXP(Y) RTS PC M.EA0: .FLT2 12.015016753875 ;A SUB 0 M.EA1: .FLT2 -601.8042666979565 ;A SUB 1 M.EB1: .FLT2 60.090190073192600 ;B SUB 1 M.LB2E: .FLT2 1.442695 ;LOG2(E) IN OCTAL .SBTTL SIN00 - SINE FUNCTION ;+4 ; .SKIP ; .X ^^SIN\\ ; .X ^^COS\\ ; .X ^SINE FUNCTION ; .X ^COSINE FUNCTION ; .INDENT -5 ; ^^ ; SIN ; .INDENT -5 ; COS ; \\ ; .BREAK ; ^THESE FUNCTIONS RETURN THE SINE AND COSINE FUNCTIONS OF THE ; ARGUMENT VALUES. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 20 S=SIN(X) ; 30 C=COS(Y) ; \\ ; .FILL ;- ; ; SIN AND COS FUNCTIONS ; ; SIN::= ; REDUCE Y TO [-PI/2,PI/2] BY- ; TWO LOW ORDER BITS OF N=INT(2*Y/PI) ; 00=QUAD 1 =>F=FRAC(2*Y/PI) ; 01=QUAD 2 =>F=1-FRAC(2*Y/PI) ; 10=QUAD 3 =>F=-FRAC(2*Y/PI) ; 11=QUAD 4 =>F=FRAC(2*Y/PI)-1 ; EVALUATE A POLINOMIAL IN F -> P(F) ; COS::= ; COS(X)=SIN(PI/2-X) ; SINE00: CLR -(SP) ;FLAG IF NEGATION DONE TSTF AC0 ;IS Y<0 CFCC BEQ M.EXIZ ;SIN(0)=0 BPL SINE01 ;JUMP IF NOT<0 INC @SP ;SET NFLAG NEGF AC0 ;AND MAKE POSITIVE SINE01: MODF M.2OPI,AC0 ;GET INT(2*Y/PI), FRAC(2*Y/PI) SETL STCFL AC1,-(SP) ;TO GET LOW TWO BITS OF INT(2*Y/PI) SETI ;RESET MODE TST (SP)+ ;IGNORE HIGH WORD BIC #177774,@SP ;ISOLATE 2 BITS ASL @SP ;WORD OFFSET ADD #M.TAB,@SP ;BR TABLE ADDRESS MOV @(SP)+,PC ;GO TO APPRO CASE M.TAB: .WORD M.EVAL .WORD M.Q2, M.Q3, M.Q4 M.Q2: SUBF M.ONE,AC0 ;F=FRAC-1 (REALLY 1-FRAC) M.Q3: NEGF AC0 ;F=-FRAC BR M.EVAL M.Q4: SUBF M.ONE,AC0 ;F=FRAC-1 M.EVAL: LDF AC0,AC2 ;SAVE F MULF AC0,AC0 ;POLINOMIAL IN F^2 LDF AC0,AC1 ;SET X FOR EVALP JSR R0,EVALP ;EVALUATE P(F) .WORD 6 ;NUMBER OF COEFICIENTS .FLT2 -.00000341817225 ;A SUB 11 .FLT2 .00016021713430 ;A SUB 9 .FLT2 -.00468162023910 ;A SUB 7 .FLT2 .07969958728630 ;A SUB 5 .FLT2 -.64596409264401 ;A SUB 3 .FLT2 1.57079632662143 ;A SUB 1 MULF AC2,AC0 TST (SP)+ ;CHECK NFLAG BEQ M.EXIT ;RETURN IF NO NEGATION NEGF AC0 ;ELSE SIN(-X)=-SIN(X) M.EXIT: RTS PC ;RETURN M.EXIZ: TST (SP)+ ;CLEAN BR M.EXIT .SBTTL COS00 - COSINE FUNCTION ; ; COS ROUTINE ; COS00: ADDF M.PIO2,AC0 ;X=X+PI/2 BR SINE00 ;DO SIN(X+PI/2) M.PIO2: .FLT2 1.5707963267 ;PI/2 M.2OPI: .FLT2 .6366197722 ;2/PI .SBTTL ATN00 - ARC-TANGENT FUNCTION ;+4 ; .SKIP ; .X ^^ATN\\ ; .X ^ARCTANGENT FUNCTION ; .INDENT -5 ; ^^ ; ATN ; \\ ; .BREAK ; ^RETURNS THE ARCTANGENT FUNCTION OF THE ARGUMENT VALUE. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 10 A=ATN(X) ; \\ ; .FILL ;- ; ; ARC-TANGENT FUNCTION ; ; MODIFIED BY F. BORGER 9/75 ; CHANGED TO A 7TH DEGREE POLYNOMIAL ; AND ORIGINAL PATCH FOR ANGLES < 15 DEG. REMOVED ATN00: CLR R0 ;INIT FLAG WORD TSTF AC0 ;IS IT POSITIVE CFCC BEQ M.TT9 ;ATN(0)=0 SO EXIT BPL ATN01 ;JUMP IF SO BIS #2,R0 ;SET NFLAG NEGF AC0 ;AND NEGATE IT ATN01: CMPF M.004,AC0 ;IS X VERY SMALL ? CFCC BGT M.P5 ;IF SO ATN(X)=X SO NO NEED TO CALC CMPF M.ONE,AC0 ;X MUST BE <1 CFCC BGE M.P ;BR IF X<1 INC R0 ;SET AFLAG LDF AC0,AC1 ;SAVE X LDF M.ONE,AC0 ;GET A ONE DIVF AC1,AC0 ;GET X=1/X M.P: LDF AC0,AC1 ;SET Z=X JSR R0,EVALP ;EVALUATE POLYNOMIAL OF AC1 .WORD 8. ;8 TERMS TOTAL .FLT2 .05335974707 ;A 7 .FLT2 -.22536119330 ;A 6 .FLT2 .32006815998 ;A 5 .FLT2 -.03387604410 ;A 4 .FLT2 -.32851964986 ;A 3 .FLT2 -.00027503627 ;A 2 .FLT2 1.0000021834 ;A 1 .FLT2 .00000001628 ;A 0 M.P5: ROR R0 ;CHECK AFLAG BCC M.P6 ;JUMP IF CLEAR NEGF AC0 ;SUB PI/2 ADDF M.PIO2,AC0 M.P6: ROR R0 ;CHECK NFLAG BCC M.TT9 ;SKIP IF NO NEGATE NEGF AC0 M.TT9: CLV RTS PC ;AND RETURN M.PIO6: .FLT2 .523598775598298 ;PI/6 M.004: .FLT2 .004 ;POINT WHERE ATN(X)=X .SBTTL SQRT00 - SQUARE ROOT FUNCTION ;+4 ; .SKIP ; .X ^^SQR\\ ; .X ^SQUARE ROOT FUNCTION ; .INDENT -5 ; ^^ ; SQR ; \\ ; .BREAK ; ^RETURNS THE SQUARE ROOT OF THE ARGUMENT VALUE. ; ^IF THE ARGUMENT VALUE IS NEGATIVE, AN ERROR IS GIVEN AND ; MINUS THE SQUARE ROOT OF THE ABSOLUTE VALUE IS RETURNED. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 20 S=SQR(X) ; \\ ; .FILL ;- ; ; SQUARE ROOT FUNCTION ; SQRT00: CLR R0 ;CLEAR NFLAG TSTF AC0 ;IS X<0 CFCC BEQ M.BR3 ;IF X=0 THEN SQR(X)=0 BGE M.BR1 ;BR IF X>0 INC R0 ;SET NFLAG NEGF AC0 ;DO SQR(-X) M.BR1: STEXP AC0,R2 ;GET EXPON(X) ROR R2 ;HALVE IT ROL R0 ;SAVE EVEN/ODD INDICATOR ROL R2 ;DO THIS IN CASE EXP. ASR R2 ;IS NEGATIVE. LDEXP #0,AC0 ;MAKE IT A FRACTION LDF AC0,AC1 ;SAVE X MULF M.BB,AC0 ;LET X=B*X ADDF M.AA,AC0 ;LET X=B*X+A .REPT 3 ;DO 3 ITERATIONS LDF AC1,AC2 ;GET X DIVF AC0,AC2 ADDF AC2,AC0 MULF M.FIVE,AC0 .ENDR STEXP AC0,R3 ;ADJUST EXPONENT ADD R2,R3 LDEXP R3,AC0 ROR R0 ;GET EVEN ODD FLAG BCC M.BR2 ;SKIP IF ODD MULF M.R2,AC0 ;TIMES SQR(2) M.BR2: TST R0 ;NFLAG SET BEQ M.BR3 ;JUMP IF NOT SQRERR NEGF AC0 ;SQR(-X)=-SQR(X) M.BR3: CLV RTS PC ;AND RETURN M.AA: .FLT2 .41730760 M.BB: .FLT2 .59016207 M.R2: .FLT2 1.414213562373095 ;SQR(2) .END