perm filename ARITH.MAC[RUT,LSP] blob sn#343717 filedate 1978-03-22 generic text, type T, neo UTF8
00100	        TITLE ARITH - FORTRAN INTERFACE (ONE ARGUMENT FUNCTIONS)
00200	;
00300	;
00400	        STKSIZ==10              ;TEMPROARY STACK FOR F10 ROUTINES
00500	;
00600	        ENTRY LSQRT,LOG,LOG10,LSIN,LCOS,LACOS,LASIN,LATAN
00700	        ENTRY LSINH,LCOSH,LTANH,LEXP,LFLOAT,RANDOM,LSIND,LCOSD
00800	        ENTRY FORER.
00900	        OPDEF CALL[34B8]
01000	        OPDEF JCALL[35B8]
01100	        S=11    ;## MAKE THE DAMN THING RELOCATABLE
01200	        P=14
01300	        A=1
01400	        B=2
01500	        EXTERN MAKNUM,NUMVAL,FLONUM,SQRT,SIN,COS,ATAN,ACOS,ASIN
01600	        EXTERN ALOG,ALOG10,SINH,COSH,TANH,EXP,FLOAT,RAN,SIND,COSD
01700	;
01800	FORER.: PUSHJ   17,FORPT        ;PRINT ERROR MESSAGE
01900	;
02000	FORPT:  PUSH    17,A            ;SAVE A REGISTER
02100	        MOVE    A,-1(17)                ;LOAD OLD PC
02200	        LDB     A,[POINT 4,-1(A),12] ;LOAD AC FIELD
02300	        CAIN    A,10            ;STRING TO OUTPUT?
02400	        SKIPA   A,@-1(17)       ;LOAD ADDRESS OF STRING
02500	        MOVEI   A,[ASCIZ /OVERFLOW/]; DEFAULT STRING
02600	        OUTSTR  [ASCIZ / 
02700	? /];                           ;START OF STRING
02800	        OUTSTR  (A)             ;BALANCE
02900	        OUTSTR  [ASCIZ /
03000	/]                              ;TERMINAL CR/LF
03100	        POP     17,A            ;RESTORE REGISTER
03200	        AOS     (17)            ;
03300	        POPJ    17,             ;RETURN
03400	;
03500	;
03600	COMP:   HRRM B,JMP
03700	        CALL 1,NUMVAL
03800	        CAIE B,FLONUM(S)
03900	        JRST ,FLT
04000	SFLTE:  MOVEM A,AR1
04100	        MOVE A,[XWD 0,BLT1 ]
04200	        BLT A,BLT1+17
04300	        MOVE    17,[IOWD STKSIZ,STKBLK]
04400	JMP:    JSA 16,.-.
04500	        JUMP 2,AR1
04600	        MOVEM 0,AR1
04700	        MOVE A,[XWD BLT1,0]
04800	        BLT A,17
04900	        MOVE A,AR1
05000	        MOVEI B,FLONUM(S)
05100	        JCALL 2,MAKNUM
05200	LSQRT:  MOVEI B,SQRT
05300	        JRST ,COMP
05400	LOG:    MOVEI B,ALOG
05500	        JRST ,COMP
05600	LOG10:  MOVEI B,ALOG10
05700	        JRST ,COMP
05800	LSIN:   MOVEI B,SIN
05900	        JRST ,COMP
06000	LCOS:   MOVEI B,COS
06100	        JRST ,COMP
06200	LSIND:  MOVEI B,SIND
06300	        JRST ,COMP
06400	LCOSD:  MOVEI B,COSD
06500	        JRST ,COMP
06600	LACOS:  MOVEI B,ACOS
06700	        JRST B,COMP
06800	LASIN:  MOVEI B,ASIN
06900	        JRST ,COMP
07000	LATAN:  MOVEI B,ATAN
07100	        JRST ,COMP
07200	LSINH:  MOVEI B,SINH
07300	        JRST ,COMP
07400	LCOSH:  MOVEI B,COSH
07500	        JRST ,COMP
07600	LTANH:  MOVEI B,TANH
07700	        JRST ,COMP
07800	LEXP:   MOVEI B,EXP
07900	        JRST ,COMP
08000	LFLOAT: CALL 1,NUMVAL
08100	        CAIN B,FLONUM(S)
08200	        JCALL 2,MAKNUM
08300	FLT1:   MOVEI B,FLOAT
08400	        HRRM B,JMP
08500	        JRST ,SFLTE
08600	FLT:    HRR B,JMP
08700	        HRRM B,AR2
08800	        PUSHJ P,FLT1
08900	        HRR B,AR2
09000	        JRST ,COMP
09100	RANDOM: MOVEI B,RAN
09200	        JRST ,FLT1+1
09300	AR2:    0
09400	AR1:    0
09500	BLT1:   BLOCK 20
09600	;
09700	STKBLK: BLOCK   STKSIZ
09800	;
09900	        END