Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50322/arith.mac
Click 43,50322/arith.mac to see without markup as text/plain
There are 20 other files named arith.mac in the archive. Click here to see a list.
	TITLE ARITH - FORTRAN INTERFACE (ONE ARGUMENT FUNCTIONS)
;
;
	STKSIZ==10		;TEMPORARY STACK FOR F10 ROUTINES
;
	ENTRY LSQRT,LOG,LOG10,LSIN,LCOS,LACOS,LASIN,LATAN
	ENTRY LSINH,LCOSH,LTANH,LEXP,LFLOAT,RANDOM,LSIND,LCOSD
	ENTRY FORER.
	OPDEF CALL[34B8]
	OPDEF JCALL[35B8]
	S=11	;## MAKE THE DAMN THING RELOCATABLE
	P=14
	A=1
	B=2
	EXTERN MAKNUM,NUMVAL,FLONUM,SQRT,SIN,COS,ATAN,ACOS,ASIN
	EXTERN ALOG,ALOG10,SINH,COSH,TANH,EXP,FLOAT,RAN,SIND,COSD
;
FORER.:	PUSHJ	17,FORPT	;PRINT ERROR MESSAGE
;
FORPT:	PUSH	17,A		;SAVE A REGISTER
	MOVE	A,-1(17)		;LOAD OLD PC
	LDB	A,[POINT 4,-1(A),12] ;LOAD AC FIELD
	CAIN	A,10		;STRING TO OUTPUT?
	SKIPA	A,@-1(17)	;LOAD ADDRESS OF STRING
	MOVEI	A,[ASCIZ /OVERFLOW/]; DEFAULT STRING
	OUTSTR	[ASCIZ /
? /];				;START OF STRING
	OUTSTR	(A)		;BALANCE
	OUTSTR	[ASCIZ /
/]				;TERMINAL CR/LF
	POP	17,A		;RESTORE REGISTER
	AOS	(17)		;
	POPJ	17,		;RETURN
;
;
COMP:	HRRM B,JMP
	CALL 1,NUMVAL
	CAIE B,FLONUM(S)
	JRST ,FLT
SFLTE:	MOVEM A,AR1
	MOVE A,[XWD 0,BLT1]
	BLT A,BLT1+17
	MOVE	17,[IOWD STKSIZ,STKBLK]
JMP:	JSA 16,.-.
	JUMP 2,AR1
	MOVEM 0,AR1
	MOVE A,[XWD BLT1,0]
	BLT A,17
	MOVE A,AR1
	MOVEI B,FLONUM(S)
	JCALL 2,MAKNUM
LSQRT:	MOVEI B,SQRT
	JRST ,COMP
LOG:	MOVEI B,ALOG
	JRST ,COMP
LOG10:	MOVEI B,ALOG10
	JRST ,COMP
LSIN:	MOVEI B,SIN
	JRST ,COMP
LCOS:	MOVEI B,COS
	JRST ,COMP
LSIND:	MOVEI B,SIND
	JRST ,COMP
LCOSD:	MOVEI B,COSD
	JRST ,COMP
LACOS:	MOVEI B,ACOS
	JRST B,COMP
LASIN:	MOVEI B,ASIN
	JRST ,COMP
LATAN:	MOVEI B,ATAN
	JRST ,COMP
LSINH:	MOVEI B,SINH
	JRST ,COMP
LCOSH:	MOVEI B,COSH
	JRST ,COMP
LTANH:	MOVEI B,TANH
	JRST ,COMP
LEXP:	MOVEI B,EXP
	JRST ,COMP
LFLOAT:	CALL 1,NUMVAL
	CAIN B,FLONUM(S)
	JCALL 2,MAKNUM
FLT1:	MOVEI B,FLOAT
	HRRM B,JMP
	JRST ,SFLTE
FLT:	HRR B,JMP
	HRRM B,AR2
	PUSHJ P,FLT1
	HRR B,AR2
	JRST ,COMP
RANDOM:	MOVEI B,RAN
	JRST ,FLT1+1
AR2:	0
AR1:	0
BLT1:	BLOCK 20
;
STKBLK:	BLOCK	STKSIZ
;
	END