DataMuseum.dk

Presents historical artifacts from the history of:

DKUUG/EUUG Conference tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DKUUG/EUUG Conference tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ T f

⟦5beeae446⟧ TextFile

    Length: 5582 (0x15ce)
    Types: TextFile
    Names: »flonum.h«

Derivation

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/microcode/flonum.h« 

TextFile

/*          Hey EMACS, this is -*- C -*- code!                 */

/****************************************************************
*                                                               *
*                         Copyright (c) 1984                    *
*               Massachusetts Institute of Technology           *
*                                                               *
* This material was developed by the Scheme project at the      *
* Massachusetts Institute of Technology, Department of          *
* Electrical Engineering and Computer Science.  Permission to   *
* copy this software, to redistribute it, and to use it for any *
* purpose is granted, subject to the following restrictions and *
* understandings.                                               *
*                                                               *
* 1. Any copy made of this software must include this copyright *
* notice in full.                                               *
*                                                               *
* 2. Users of this software agree to make their best efforts (a)*
* to return to the MIT Scheme project any improvements or       *
* extensions that they make, so that these may be included in   *
* future releases; and (b) to inform MIT of noteworthy uses of  *
* this software.                                                *
*                                                               *
* 3.  All materials developed as a consequence of the use of    *
* this software shall duly acknowledge such use, in accordance  *
* with the usual standards of acknowledging credit in academic  *
* research.                                                     *
*                                                               *
* 4. MIT has made no warrantee or representation that the       *
* operation of this software will be error-free, and MIT is     *
* under no obligation to provide any services, by way of        *
* maintenance, update, or otherwise.                            *
*                                                               *
* 5.  In conjunction with products arising from the use of this *
* material, there shall be no use of the name of the            *
* Massachusetts Institute of Technology nor of any adaptation   *
* thereof in any advertising, promotional, or sales literature  *
* without prior written consent from MIT in each case.          *
*                                                               *
****************************************************************/
\f


/* File: FLONUM.H
 *
 * Header file for flonums. Shared by various arithmetic primitive
 * files.  Some additional (configuration dependent) information
 * defined in CONFIG.H
 */

#define FLONUM_SIZE		((sizeof(Pointer)+sizeof(double)-1)/ \
                                 sizeof(Pointer))
				 
/* Flonum_Result is a macro used at the end of the operations which
   return floating point results.  It checks that there is sufficient
   space in the heap for the result, creates the appropriate header,
   and returns the result. Store_Flonum_Result is similar but stores
   the result instead of returning.  Both are implemented in terms
   of Generic_Flonum_Result.
*/

#define Generic_Flonum_Result(Ans, How_To_Return, Value_Cell) 		\
  Primitive_GC_If_Needed(Free + FLONUM_SIZE + 1);			\
  *Free = Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, FLONUM_SIZE);		\
  Get_Float(C_To_Scheme(Free)) = (Ans);					\
  Free += FLONUM_SIZE+1;						\
  How_To_Return(Make_Pointer(TC_BIG_FLONUM, Free-(1+FLONUM_SIZE)),      \
		Value_Cell);

#define Flonum_Result(Ans)		                              \
Generic_Flonum_Result(Ans, Return_Coerced_Value, Null_Value_Cell);

#define Store_Flonum_Result(Ans, Value_Cell)            		\
Generic_Flonum_Result(Ans, Store_Coerced_Value, Value_Cell);

/* Reduced_Flonum_Result is same as Flonum_Result except that it
   tries to coerce down, if possible.  Store_Reduced_Flonum_Result
   likewise is the same as Store_Flonum_Result except that it
   tries to coerce down.  Both are implemented in terms of 
   Generic_Reduced_Flonum_Result.
*/
\f


#define Generic_Reduced_Flonum_Result(Ans, How_To_Return, Value_Cell)	\
  { double Number = (Ans);						\
    double floor();							\
    Pointer result;							\
    if (floor(Number) != Number)					\
    { Generic_Flonum_Result(Number, How_To_Return, Value_Cell);		\
    }									\
    if (Number == 0) How_To_Return(FIXNUM_0, Value_Cell);		\
    { int exponent;							\
      double frexp();							\
      frexp(Number, &exponent);						\
      if (exponent <= FIXNUM_LENGTH)					\
      { double_into_fixnum(Number, result);				\
	How_To_Return(result, Value_Cell);                              \
      }									\
      /* Since the float has no fraction, we will not gain		\
	 precision if its mantissa has enough bits to support		\
	 the exponent. */						\
      if (exponent <= FLONUM_MANTISSA_BITS)		 		\
      {	result = Float_To_Big(Number);					\
	How_To_Return(result, Value_Cell);                              \
      }									\
      Generic_Flonum_Result(Number, How_To_Return, Value_Cell);		\
    }									\
  }

#define Store_Reduced_Flonum_Result(Ans, Value_Cell)		\
Generic_Reduced_Flonum_Result(Ans, Store_Coerced_Value, Value_Cell);

#define Reduced_Flonum_Result(Ans)				\
Generic_Reduced_Flonum_Result(Ans, Return_Coerced_Value, Null_Value_Cell);

#define Store_Coerced_Value(Answer, Value_Cell) Value_Cell = Answer;

#define Return_Coerced_Value(Answer, Value_Cell) return Answer;

#define Null_Value_Cell