libm.il

操作系统SunOS 4.1.3版本的源码

/*	@(#)libm.il 1.1 92/07/30 SMI	*/

/*
 * Copyright (c) 1989 by Sun Microsystems, Inc.
 */

|   @(#)RELEASE libm.il, 4.1 alpha 9 

#ifdef FSWITCH
#define PREFIX V
#define PLIBM(f,g) ; \
	.inline	_F/**/g,4 ; \
	movl	sp@+,d0 ; \
	movl	d0,sp@- ; \
	lea	sp@,a0 ; \
	movl	a0,sp@- ; \
	jsr	_r_/**/g/**/_ ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end ; \
	.inline	V/**/f/**/d,0 ; \
	movl	d1,sp@- ; \
	movl	d0,sp@- ; \
	jsr	_/**/g ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end ; \
	.inline	V/**/f/**/s,0 ; \
	movl	d0,sp@- ; \
	lea	sp@,a0 ; \
	movl	a0,sp@- ; \
	jsr	_r_/**/g/**/_ ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end
#endif
#ifdef FSOFT
#define PREFIX F
#define PLIBM(f,g) ; \
	.inline	_F/**/g,4 ; \
	movl	sp@+,d0 ; \
	movl	d0,sp@- ; \
	lea	sp@,a0 ; \
	movl	a0,sp@- ; \
	jsr	_r_/**/g/**/_ ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end ; \
	.inline	F/**/f/**/d,0 ; \
	movl	d1,sp@- ; \
	movl	d0,sp@- ; \
	jsr	_/**/g ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end ; \
	.inline	F/**/f/**/s,0 ; \
	movl	d0,sp@- ; \
	lea	sp@,a0 ; \
	movl	a0,sp@- ; \
	jsr	_r_/**/g/**/_ ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end
#endif
#ifdef FSKY
#define PREFIX S
#define PLIBM(f,g) ; \
	.inline	_F/**/g,4 ; \
	movl	sp@+,d0 ; \
	movl	d0,sp@- ; \
	lea	sp@,a0 ; \
	movl	a0,sp@- ; \
	jsr	_r_/**/g/**/_ ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end ; \
	.inline	S/**/f/**/d,0 ; \
	movl	d1,sp@- ; \
	movl	d0,sp@- ; \
	jsr	_/**/g ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end ; \
	.inline	S/**/f/**/s,0 ; \
	movl	d0,sp@- ; \
	lea	sp@,a0 ; \
	movl	a0,sp@- ; \
	jsr	_r_/**/g/**/_ ; \
	movl	sp@+,a0 ; \
	movl	sp@+,a0 ; \
	.end
#endif
#ifdef F68881
#define PREFIX M
#define PLIBM(f,g)
#endif
#ifdef FFPA
#define PREFIX W
#define PLIBM(f,g)
#endif

/*	Templates for [VFSMW]f[sd] libm functions.	*/

	PLIBM(sin,sin)
	PLIBM(cos,cos)
	PLIBM(tan,tan)
	PLIBM(acos,acos)
	PLIBM(asin,asin)
	PLIBM(atan,atan)
	PLIBM(cosh,cosh)
	PLIBM(sinh,sinh)
	PLIBM(tanh,tanh)
	PLIBM(exp,exp)
	PLIBM(pow10,exp10)
	PLIBM(pow2,exp2)
	PLIBM(log,log)
	PLIBM(log10,log10)
	PLIBM(log2,log2)

	.inline	_pow_ri,8
	movl	sp@+,a0
	movl	a0@,d0
	movl	sp@+,a0
	movl	a0@,d1
	jsr	PREFIX/**/powis
	.end

	.inline	_pow_di,8
	movl	sp@+,a0
	movl	a0@+,d0
	movl	a0@,d1
	movl	sp@+,a0
	jsr	PREFIX/**/powid
	.end

/*	templates for documented libm routines. */

	.inline	_abs,4			/* int abs(x) int x . */
        movl   sp@+,d0
        jpl     1f
        negl    d0
1:
        .end

	.inline	_fp_class,8	/* enum fp_class_type fp_class(x) double x . */
	movl	sp@+,a0		| a0 gets upperx
	movl	sp@+,a1		| a1 gets lowerx
	moveq	#2,d0		| d0 gets 2 - normal case
	movl	a0,d1		| d1 gets upperx
	andl	#0x7ff00000,d1
	jne	5f
	cmpl	#0,a1
	jne	2f		| Branch if subnormal.
	moveq	#0,d0		| d0 gets 0 - zero
	movl	a0,d1		| d1 gets upperx
	andl	#0x7fffffff,d1	| d1 gets abs(upperx)
	jeq	1f
2:
	moveq	#1,d0		| d0 gets 1 - subnormal
	jra	1f
5:
	cmpl	#0x7ff00000,d1  | compare upperx exponent to max
	jne	1f
4:
	cmpl	#0,a1
	jne	3f		| Branch if nan.
	movl	a0,d1		| d1 gets upperx
	andl	#0xfffff,d1
	jne	3f
	movl	#3,d0
	jra	1f
3:
	moveq	#4,d0		| d0 gets 4 - quiet nan
	movl	a0,d1		| d1 gets upperx
	btst	#19,d1
	jne	1f
	moveq	#5,d0		| d0 gets 5 - signaling nan
1:
	.end

	.inline	_copysign,16		/* double copysign(x,y) double x,y. */
	movl	sp@+,d0
	movl	sp@+,d1
	andl	#0x7fffffff,d0
       	tstl    sp@+
        jpl     1f
        orl    	#0x80000000,d0
1:
	movl	sp@+,a0
	.end

	.inline	_d_copysign_,8		/* double copysign(x,y) double x,y. */
	movl	sp@+,a0
	movl	sp@+,a1
	movl	a0@+,d0
	movl	a0@,d1
	andl	#0x7fffffff,d0
       	tstb    a1@
        jpl     1f
        orl    	#0x80000000,d0
1:
	.end

	.inline	_r_copysign_,8		/* double copysign(x,y) double x,y. */
	movl	sp@+,a0
	movl	sp@+,a1
	movl	a0@,d0
	andl	#0x7fffffff,d0
       	tstb    a1@
        jpl     1f
        orl    	#0x80000000,d0
1:
	.end

	.inline	_fabs,8			/* double fabs(x) double x . */
	movl	sp@+,d0
	movl	sp@+,d1
	andl	#0x7fffffff,d0
	.end

	.inline	_r_fabs_,4
	movl	sp@+,a0
	movl	a0@,d0
	andl	#0x7fffffff,d0
	.end

	.inline	_finite,8		/* int finite(x) double x . */
	movl	sp@+,d1
	movl	sp@+,d0
	andl	#0x7fffffff,d1
	cmpl	#0x7ff00000,d1
	slt	d0
	andl	#1,d0
	.end

	.inline	_id_finite_,4		/* int finite(x) double x . */
	movl	sp@+,a0
	movl	a0@,d1
	andl	#0x7fffffff,d1
	cmpl	#0x7ff00000,d1
	slt	d0
	andl	#1,d0
	.end

	.inline	_ir_finite_,4		/* int finite(x) double x . */
	movl	sp@+,a0
	movl	a0@,d1
	andl	#0x7fffffff,d1
	cmpl	#0x7f800000,d1
	slt	d0
	andl	#1,d0
	.end

	.inline	_isnormal,8
	movl	sp@+,d1
	movl	sp@+,d0			| Throw this away!
	clrl	d0			| Return zero for not normal.
	andl	#0x7ff00000,d1
	jeq	1f			| Branch if zero/subnormal.
	cmpl	#0x7ff00000,d1
	jeq	1f			| Branch if inf/nan.
	moveq	#1,d0			| Return one for normal.
1:
	.end

	.inline	_id_isnormal_,4
	movl	sp@+,a0
	movl	a0@,d1			| Throw this away!
	clrl	d0			| Return zero for not normal.
	andl	#0x7ff00000,d1
	jeq	1f			| Branch if zero/subnormal.
	cmpl	#0x7ff00000,d1
	jeq	1f			| Branch if inf/nan.
	moveq	#1,d0			| Return one for normal.
1:
	.end

	.inline	_ir_isnormal_,4
	movl	sp@+,a0
	movl	a0@,d1			| Throw this away!
	clrl	d0			| Return zero for not normal.
	andl	#0x7f800000,d1
	jeq	1f			| Branch if zero/subnormal.
	cmpl	#0x7f800000,d1
	jeq	1f			| Branch if inf/nan.
	moveq	#1,d0			| Return one for normal.
1:
	.end


	.inline	_iszero,8		/* int iszero(x) double x . */
	movl	sp@+,d1
	clrl	d0			| Assume x is nonzero.
	tstl	sp@+
	jne	1f			| Branch if not zero.
	andl	#0x7fffffff,d1
	jne	1f
	moveq	#1,d0			| Return 1 for zero.
1:
	.end

	.inline	_id_iszero_,4		/* int iszero(x) double x . */
	movl	sp@+,a0
	movl	a0@+,d1
	clrl	d0			| Return 0 for non-zero.
	tstl	a0@
	jne	1f			| Branch if not zero.
	andl	#0x7fffffff,d1
	jne	1f
	moveq	#1,d0			| Return 1 for zero.
1:
	.end

	.inline	_ir_iszero_,4		/* int iszero(x) double x . */
	movl	sp@+,a0
	movl	a0@,d1
	andl	#0x7fffffff,d1
	seq	d0
	andl	#1,d0
	.end

	.inline	_isinf,8		/* int isinf(x) double x . */
	movl	sp@+,d1
	clrl	d0			| Assume not inf.
	tstl	sp@+
	jne	1f			| Branch if not inf.
	andl	#0x7fffffff,d1
	cmpl	#0x7ff00000,d1
	jne	1f
	moveq	#1,d0
1:
	.end

	.inline	_id_isinf_,4		/* int isinf(x) double x . */
	movl	sp@+,a0
	clrl	d0
	movl	a0@+,d1
	tstl	a0@
	jne	1f			| Branch if not inf.
	andl	#0x7fffffff,d1
	cmpl	#0x7ff00000,d1
	jne	1f
	moveq	#1,d0
1:
	.end

	.inline	_ir_isinf_,4		/* int isinf(x) double x . */
	movl	sp@+,a0
	movl	a0@,d0
	andl	#0x7fffffff,d0
	cmpl	#0x7f800000,d0
	seq	d0
	andl	#1,d0
	.end

	.inline	_isnan,8		/* int isnan(x) double x . */
	movl	sp@+,a0
	movl	sp@+,a1
	clrl	d0
	movl	a0,d1
	andl	#0x7fffffff,d1
	cmpl	#0x7ff00000,d1
	jlt	1f
	jgt	2f
	movl	a0,d1
	andl	#0xfffff,d1
	movl	a1,d0
	orl	d0,d1
2:
	sne	d0
	andl	#1,d0
1:
	.end
	
	.inline	_id_isnan_,4		/* int isnan(x) double x . */
	movl	sp@+,a0
	clrl	d0
	movl	a0@,d1
	andl	#0x7fffffff,d1
	cmpl	#0x7ff00000,d1
	jlt	1f
	jgt	2f
	movl	a0@+,d1
	andl	#0xfffff,d1
	movl	a0@,d0
	orl	d0,d1
2:
	sne	d0
	andl	#1,d0
1:
	.end
	
	.inline	_ir_isnan_,4		/* int isnan(x) double x . */
	movl	sp@+,a0
	movl	a0@,d0
	andl	#0x7fffffff,d0
	cmpl	#0x7f800000,d0
	sgt	d0
	andl	#1,d0
1:
	.end
	
	.inline	_issubnormal,8		/* int issubnormal(x) double x . */
	movl	sp@+,a0
	movl	sp@+,a1
	clrl	d0			| Assume not subnormal - return 0.
	movl	a0,d1
	andl	#0x7ff00000,d1
	jne	1f			| Branch if not minimum exponent.
	movl	a0,d1
	andl	#0xfffff,d1
	movl	a1,d0
	orl	d0,d1
	sne	d0
	andl	#1,d0
1:
	.end
	
	.inline	_id_issubnormal_,4	/* int issubnormal(x) double x . */
	movl	sp@+,a0
	clrl	d0			| Assume not subnormal - return 0.
	movl	a0@,d1
	andl	#0x7ff00000,d1
	jne	1f			| Branch if not minimum exponent.
	movl	a0@+,d1
	andl	#0xfffff,d1
	movl	a0@,d0
	orl	d0,d1
	sne	d0
	andl	#1,d0
1:
	.end

	.inline	_ir_issubnormal_,4	/* int issubnormal(x) double x . */
	movl	sp@+,a0
	clrl	d0			| Assume not subnormal - return 0.
	movl	a0@,d1
	andl	#0x7fffffff,d1
	jeq	1f			| Branch if zero.
	cmpl	#0x00800000,d1
	slt	d0
	andl	#1,d0
1:
	.end
	
	.inline	_signbit,8		/* int signbit(x) double x . */
	movl	sp@+,d0
	movl	sp@+,d1
	roll	#1,d0
	andl	#1,d0			| Return one for negative, zero for positive.
	.end

	.inline	_id_signbit_,4		/* int signbit(x) double x . */
	movl	sp@+,a0
	movw	a0@,d0
	rolw	#1,d0
	andl	#1,d0			| Return one for negative, zero for positive.
	.end

	.inline	_ir_signbit_,4
	movl	sp@+,a0
	movw	a0@,d0
	rolw	#1,d0
	andl	#1,d0			| Return one for negative, zero for positive.
	.end	

	.inline	_min_subnormal,0
	movl	#0x0,d0
	movl	#0x1,d1
	.end

	.inline	_d_min_subnormal_,0
	movl	#0x0,d0
	movl	#0x1,d1
	.end

	.inline	_r_min_subnormal_,0
	movl	#0x1,d0
	.end

	.inline	_max_subnormal,0
	movl	#0x000fffff,d0
	movl	#0xffffffff,d1
	.end

	.inline	_d_max_subnormal_,0
	movl	#0x000fffff,d0
	movl	#0xffffffff,d1
	.end

	.inline	_r_max_subnormal_,0
	movl	#0x007fffff,d0
	.end

	.inline	_min_normal,0
	movl	#0x00100000,d0
	movl	#0x0,d1
	.end

	.inline	_d_min_normal_,0
	movl	#0x00100000,d0
	movl	#0x0,d1
	.end

	.inline	_r_min_normal_,0
	movl	#0x00800000,d0
	.end

	.inline	_max_normal,0
	movl	#0x7fefffff,d0
	movl	#0xffffffff,d1
	.end

	.inline	_d_max_normal_,0
	movl	#0x7fefffff,d0
	movl	#0xffffffff,d1
	.end

	.inline	_r_max_normal_,0
	movl	#0x7f7fffff,d0
	.end

	.inline	_infinity,0
	movl	#0x7ff00000,d0
	movl	#0x0,d1
	.end

                        /* POSIX defines HUGE_VAL in math.h as __infinity() */
        .inline ___infinity,0
        movl    #0x7ff00000,d0
        movl    #0x0,d1
        .end

	.inline	_d_infinity_,0
	movl	#0x7ff00000,d0
	movl	#0x0,d1
	.end

	.inline	_r_infinity_,0
	movl	#0x7f800000,d0
	.end

	.inline	_signaling_nan,0
	movl	#0x7ff00000,d0
	movl	#0x1,d1
	.end

	.inline	_d_signaling_nan_,0
	movl	#0x7ff00000,d0
	movl	#0x1,d1
	.end

	.inline	_r_signaling_nan_,0
	movl	#0x7f800001,d0
	.end

	.inline	_quiet_nan,0
	movl	#0x7fffffff,d0
	movl	#0xffffffff,d1
	.end

	.inline	_d_quiet_nan_,0
	movl	#0x7fffffff,d0
	movl	#0xffffffff,d1
	.end

	.inline	_r_quiet_nan_,0
	movl	#0x7fffffff,d0
	.end

	.inline	_ilogb,8	| int ilogb ( double x ) ;
	movl	sp@+,d0
	movl	sp@+,d1
	movl	d0,a0		| a0 preserves d0 in case call is necessary
	clrw	d0
	swap	d0
	lsrw	#4,d0		| biased exponent is now right-aligned
	andw	#0x7ff,d0	| garbage cleared.
	jeq	1f		| Branch if zero or subnormal.
	subl	#0x3ff,d0	| d0 gets unbiased exponent.
	cmpw	#0x400,d0
	jne	2f		| Jump if not inf or nan - d0 contains result.
1:
	movl	d1,sp@-
	movl	a0,sp@-		| Restore stack.
	jsr	_ilogb		| Function to handle hard cases.
2:
	.end

	.inline	_id_ilogb_,4	| int id_ilogb_ ( double *x ) ;
	movl	sp@+,a0
	clrl	d0
	movw	a0@,d0
	lsrw	#4,d0		| biased exponent is now right-aligned
	andw	#0x7ff,d0	| garbage cleared.
	jeq	1f		| Branch if zero or subnormal.
	subl	#0x3ff,d0	| d0 gets unbiased exponent.
	cmpw	#0x400,d0
	jne	2f		| Jump if not inf or nan - d0 contains result.
1:
	movl	a0@(4),sp@-
	movl	a0@,sp@-	| Restore stack.
	jsr	_ilogb		| Function to handle hard cases.
2:
	.end

	.inline	_ir_ilogb_,4	| int ir_ilogb_ ( float *x ) ;
	movl	sp@+,a0
	clrl	d0
	movw	a0@,d0
	lsrw	#7,d0		| biased exponent is now right-aligned
	andw	#0xff,d0	| garbage cleared.
	jeq	1f		| Branch if zero or subnormal.
	subl	#0x7f,d0	| d0 gets unbiased exponent.
	cmpw	#0x80,d0
	jne	2f		| Jump if not inf or nan - d0 contains result.
1:
	movl	a0,sp@-		| Restore stack.
	jsr	_ir_ilogb_	| Function to handle hard cases.
2:
	.end

/*	templates for undocumented libF77 routines	*/

/*****	begin from 3.2 fsoft.il *****/

|
| i_conv_c(cp,len,ip)
|       char *cp;
|       int len;
|       int *ip;
|
        .inline _i_conv_c,12
        movl    sp@+,a0
        movl    sp@+,d0
        movl    sp@+,a1
        movb    a1@(3),a0@
        .end
 
|
| c_conv_i(cp)
|       char *cp;
|
        .inline _c_conv_i,4
        movl    sp@+,a0
        movb    a0@,d0
#ifdef FFPA
        extbl   d0		| Only works on 68020!
#else
        extw    d0
        extl    d0
#endif
        .end

	.inline	_c_abs,4
	movl	sp@+,a0
	movl	a0@+,d0
	movl	a0@,d1
	jsr	PREFIX/**/length2s
	.end

        .inline	__Fc_conv_f,8 	| convert complex  to float
        movl    sp@+,d0         | pick up argument
        movl    sp@+,d1         | ignore this
        .end

	.inline	__Fc_neg,8
	movl	sp@+,d0		| pick up real part of argument
	movl	sp@+,d1		| pick up imag part of argument
	eorl	#0x80000000,d0	| change sign
	eorl	#0x80000000,d1	| change sign
	.end

        .inline __Fc_add,16
        movl    sp@(4),d0       | pick up imaginary part of 1st argument
        movl    sp@(12),d1      | pick up imaginary part of 2nd argument
        jsr     PREFIX/**/adds  | add them and
        movl    d0,sp@(12)      | save result
        movl    sp@+,d0         | pick up real part of 1st argument
        movl    sp@+,d1         | Skip arg.
        movl    sp@+,d1         | pick up real part of 2nd argument
        jsr     PREFIX/**/adds   | add them
        movl    sp@+,d1         | load imag result in return register
        .end

        .inline __Fc_minus,16
        movl    sp@(4),d0       | pick up imaginary part of 1st argument
        movl    sp@(12),d1      | pick up imaginary part of 2nd argument
        jsr     PREFIX/**/subs  | add them and
        movl    d0,sp@(12)      | save result
        movl    sp@+,d0         | pick up real part of 1st argument
        movl    sp@+,d1         | Skip arg.
        movl    sp@+,d1         | pick up real part of 2nd argument
        jsr     PREFIX/**/subs  | add them
        movl    sp@+,d1         | load imag result in return register
        .end

|/* Convert float to complex */
|
|void
|_Ff_conv_c(c, x)
|        complex        *c;
|        FLOATPARAMETER  x;
|{
|        c->real = FLOATPARAMETERVALUE(x);
|        c->imag = 0.0;
|}

	.inline	__Ff_conv_c,4
	movl	sp@+,d0		| pick up argument
	movl	sp@+,a0		| a0 points to result c.
	movl	d0,a0@+		| Rc gets x.
	clrl	a0@		| Ic gets 0.
	.end

|/* Convert int to complex */
| 
|void
|_Fi_conv_c(c, i)
|        complex        *c;
|        int             i;
|{
|        c->real = (float) i;
|        c->imag = 0.0;
|}

	.inline	__Fi_conv_c,4
	movl	sp@+,d0		| pick up argument
	jsr     PREFIX/**/flts
	movl	sp@+,a0         | a0 points to result c.
	movl	d0,a0@+		| Rc gets x.
	clrl	a0@		| Ic gets 0.
	.end

		| 	convert complex  to int
	.inline	__Fc_conv_i,8
	movl	sp@+,d0		| pick up argument
	movl	sp@+,d1		| ignore this
	jsr     PREFIX/**/ints
	.end

		|	convert complex  to double
	.inline	__Fc_conv_d,8
	movl    sp@+,d0   	| pick up argument
	movl	sp@+,d1		| ignore this
	jsr     PREFIX/**/stod