;********* ; * ; 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 ; ; MODIFIED TO USE FORTRAN FUNCTION MODULES 1-JUN-77 -- LARRY SIMPSON ; .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 ; ; GLOBALS--FORTRAN FUNCTION MODULE ENTRY POINTS ; .GLOBL SQRT SIN COS ATAN EXP ALOG ; ; ; 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 BASIC1,RW,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 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 SKIP ;GET A CHARACTER FROM THE INPUT STREAM BR 4$ ;AND BRANCH AROUND THE GET NEXT CHAR INST 2$: MOVB (R1)+,R2 ;GET NEXT CHAR (SPACE OR TAB WILL TERMINATE) 4$: TSTCH ;SEE IF IT IS IN RANGE FOR A DIGIT BNE 3$ ;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 BCC 2$ ;IF NO OVERFLOW, TRY AGAIN (UNSIGNED) 1$: LNNERR ;LINE NUMBER IS REALLY BAD 3$: 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 MOV R5,-(SP) ;SAVE R5 JSR PC,LOG00 ;GET IT MULF AC4,AC0 ;GET AC0*LOG(AC1) JSR PC,EXPF00 ;GET EXP(AC0*LOG(AC1)) MOV (SP)+,R5 ;RESTORE R5 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: MOV #ALOG,R0 ;ADDRESS OF FORTRAN NATURAL LOG ROUTINE -> R0 BR FNSTRT ;BRANCH TO COMMON FUNCTION PROCESSING .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: MOV #EXP,R0 ;ADDRESS OF FORTRAN EXPONENTIAL ROUTINE -> R0 BR FNSTRT ;BRANCH TO COMMON PROCESSING .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: MOV #SIN,R0 ;ADD OF FORTRAN SINE ROUTINE -> R0 BR FNSTRT .SBTTL COS00 - COSINE FUNCTION ; ; COS ROUTINE ; COS00: MOV #COS,R0 ;ADD OF FORTRAN COSINE ROUTINE -> R0 BR FNSTRT .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 ; ATN00: MOV #ATAN,R0 ;ADDRESS OF FORTRAN ARCTAN FUNCTION -> R0 BR FNSTRT .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. ; .BREAK ; ^EXAMPLE: ; .NOFILL ; ^^ ; 20 S=SQR(X) ; \\ ; .FILL ;- ; ; SQUARE ROOT FUNCTION ; SQRT00: MOV #SQRT,R0 ;ADDRESS OF FORTRAN SQUARE ROOT ROUTINE -> R0 ; ; START OF COMMON FORTRAN FUNCTION PROCESSING CODE ; FNSTRT: MOV R1,-(SP) ;SAVE TEXT POINTER CLRF -(SP) ;JUST IN CASE LOAD DOUBLE IS USED (SIN) STF AC0,-(SP) ;PUT ARG ON STACK MOV SP,R1 ;ADDRESS OF ARG -> R1 MOV R1,-(SP) ;SAVE IT IN ARG LIST FOR FORTRAN MOV #1,-(SP) ;FORM ARG LIST FOR FORTRAN MOV SP,R5 ;R5 IS ARG LIST POINTER JSR PC,(R0) ;GO TO CHOSEN ROUTINE MOV R1,-(SP) ;SAVE RESULT MOV R0,-(SP) ;ON STACK LDF (SP)+,AC0 ;SO WE CAN PUT IT BACK IN AC0 ADD #14,SP ;CLEAN STACK MOV (SP)+,R1 ;RESTORE TEXT POINTER RTS PC ;AND RETURN .END