🚀 go-pugleaf

>+How about:
>+
>+flonums           87-10-27
>+     W. Rupprecht, <wolfgang@mgm.mit.edu>
>+     mgm.mit.edu:/pub/WOLFGANG/float-emacs.diff
>+     True floating point data type for Lisp.

>This appears to be a non-anonymous-able ftp site. Do you have
>another site which allows for anonymous ftp access?

Back when mgm.mit.edu was still a Vax-750 running 4.x we did have
anon-ftp.  Unfortunately the current 386 PC-clone running Mach has
some (ahem) problems with anon ftp.  (I can't enable anon-ftp until
these problems are fixed.)

Perhaps some kind archiver will put this patch in an a directory that
is internet accessible.

-wolfgang
---
Wolfgang Rupprecht    wolfgang@wsrcc.com (or) uunet!wsrcc!wolfgang
Snail Mail Address:   Box 6524, Alexandria, VA 22306-0524



Here is the patch.  It is essentially unchanged from the version 17.xx
implementation.  Some patch offsets have changed, but not much else.
It is known to work on a Vax/BSD4.3, sun3/SunOS-3.2, Sparc/SunOS-4.1.
This patch will apply to 18.57, which is what I am running right now.

Bootstrapping is somewhat challenging, since you will need to have a
floating-pt savvy emacs to byte-compile the patched *.el files.  I
normally just raise the PURESIZE to something 3 times bigger and just
load the patched *.el files in the initial load/dump of temacs.  The
simplest trick is just to copy the patched *.el files to the *.elc
file, and then touch the *.el files so that byte-recompile-directory
will find that the *.elc files need to be recompiled.  Just compile
and dump temacs normally.  Byte-recompile the lisp directory.  Reset
PURESIZE and compile and dump again.

You can also avoid this whole mess by just grabbing a copy of the 
byte compiled *.elc files from some other site.

-------------

This is a complete diff -c for making a version of gnuemacs18.52
with lisp flonums. 

***** start of diff (on Thu Apr 20 11:52:50 EST 1989) *****

*** FLONUM.orig	Thu Apr 20 11:51:11 1989
--- FLONUM	Wed Apr 19 11:57:18 1989
***************
*** 0 ****
--- 1,263 ----
+ ###############################################################################
+ ##									     ##
+ ##	File:     FLONUMS						     ##
+ ##	Author:   Wolfgang S. Rupprecht <wolfgang@wsrcc.com>                 ##
+ ##	Created:  Tue Oct 27 15:58:53 EST 1987				     ##
+ ##	Contents: Documentation File for GnuEmacs with floats		     ##
+ ##									     ##
+ ##	Copyright (c) 1987 Wolfgang Rupprecht.				     ##
+ ##	All rights reserved.						     ##
+ ##									     ##
+ ##	$Log$								     ##
+ ###############################################################################
+ 
+ INTRO
+ 
+ I have added a true floating point data type (flonum in lisp jargon)
+ to the lisp interpreter of GnuEmacs.  This allows one to do emacs-lisp
+ calculations using floating point numbers as well as integers.  In
+ addition, GnuEmacs now has hooks to call all of the common
+ trigonometric functions from lisp.  One may now, for example, use the
+ *scratch* buffer as a real scientific calculator (programmable even!!).
+ It is not that hard to write a super spreadsheet calculator in elisp,
+ using this package.
+ 
+ NEW FEATURES
+ 
+ The basic features features provided are:
+ 
+ *	a lisp float data type, that uses the C type "double" for it's
+ 	basic storage
+ *	upgrading of the built-in math subroutines to allow manipulation
+ 	of floats
+ *	conversion routines to convert to and from floats and ints
+ *	predicates for testing if a number is a float, float-or-int,
+ 	or float-or-int-or-marker
+ *	trig math routines. (sin, cos, tan, exponentials, logs, bessels, etc.)
+ *	upgrading of int-to-string, string-to-int, and the basic printing
+ 	and reading routines to allow float reading/printing.
+ *	changes to garbage-collect to also collect old floats.
+ 
+ The lisp reader will interpret strings of one of the following three
+ forms as a float:
+ 
+ 	 <number>.<number>
+ 	 <number>e<number>
+ 	 <number>.<number>e<number>
+ 
+ The mantissa and the exponent may both have a single + or - sign
+ prefixed.  All other strings are treated as symbols.  This is
+ intentional, and meant to prevent numbers and dotted pairs of 
+ ints from looking too much like one another. 
+ 
+      legal numbers:
+ 	  (0 . 1)  	a doted pair of integers 0 and 1
+ 	  (0.1)		a list of one float with value 1/10
+ 
+ 	  0.0		the floating pt. zero
+ 	  1.0		the floating point one
+ 	  1e0		also floating pt. one
+ 	  0e0		also floating pt. zero
+ 
+          (0. 1)		a list of symbol "0\." and integer 0
+ 	 (0 .1)		a list of integer 0 and symbol "\.1"
+           0.		symbol "0\."
+ 	  .1		symbol "\.1"
+ 
+ The built in math functions promote the type of the calculation from
+ integer to float at the first encounter with a float.
+ 
+ 	(+ 1 2 3 4 5 6.0 7 8 9)
+ 
+ The above expression will be done in integer math for the addition of
+ 1, 2, 3, 4 and 5.  The rest of the calculation is done in floating
+ point math with the result being a float.  This allows an integer 
+ calculation to still return an integer.  To force a floating point
+ calculation, convert the first argument to a float.
+ 
+ Ints can be converted to floats by using the function "float".
+ Floats can be converted to ints by one of several functions, 
+ depending on the type of rounding desired.
+ 
+        round		returns the closest integer
+        ceiling		returns the largest integer that is not larger 
+ 			than the arg (round towards -infinity)
+        floor		returns the smallest integer that is not smaller
+ 			than the arg (round towards +infinity)
+        truncate		returns the integer corresponding to the mantissa
+ 			of the float. (round towards zero)
+ 
+ On most machines that gnuemacs runs on, lisp integers are only 24 bits
+ long.  One must be careful when converting large floats to integers that
+ one doesn't exceed the storage capacity of integers.  Integers (of 24
+ bit size) can only have a range of slightly over +/- 8 million.  The
+ same caution applies when performing mathematical operations on
+ integers.  If you need to work with large numbers, it's safest to use 
+ floats.
+ 
+ The math trig functions sin/cos/tan all take their arguments in
+ radians.  Values can be converted to the desired radix with the
+ functions degrees-to-radians and radians-to-degrees.
+ 
+ Some of the new functions (or functions with new args/return values):
+ 
+ abs acosh asin asinh atan atanh ceiling cos cosh cube-root erf erfc
+ exp expm1 expt fceiling ffloor float floor fround ftruncate
+ garbage-collect int-to-string integer-or-float-or-marker-p
+ integer-or-floatp j0 j1 jn log log-gamma log10 log1p round sin sinh
+ sqrt tan tanh truncate y0 y1 yn
+ 
+ The full documentations for these functions is on-line under C-h f
+ <function-name> and at the end of this document. 
+ 
+ The lisp variable float-output-format controls the printed
+ representation of floats.  The available print formats are:
+ 
+        <number>.<number>	     with a 'd' specifier
+        <number>.<number>e<number>    with an 'e' specifier
+        (or data dependent switching 
+         between the above two)	     with no letter specifier
+ 
+ The field width may be controlled by an optional numeric field
+ preceding the above format specifier. 
+ 
+ 
+ MAKING FLOAT-EMACS:
+ 
+ To make emacs with flonums (ie. lisp floats) define LISP_FLOAT_TYPE in
+ your conf.h file.  The resultant emacs will be less than 6% larger.
+ This has been tested on a Vax-750 running BSD 4.3.
+ 
+ 	text	data	bss	dec	hex
+ 	369664	180224	0	549888	86400	emacs-18.49
+ 	391168	187392	0	578560	8d400	float-emacs-18.49
+ 
+ PORTING to other machines:
+ 
+ If you aren't running with a BSD/vax style printf, you may not be able
+ to use the optional runtime selectable floating point print-width stuff.
+ (I'll probably fix this soon.)
+ 
+ If you don't have some of the math-lib functions that emacs wants
+ linked in, don't worry.  These are all entirely optional.  Just #ifdef
+ the math routines out, stub them up, or find a copy of the 4.3 BSD
+ routines. (Check the 4.3 BSD math(3) man page for details on copying
+ the math-lib routines.)
+ 
+ Appendix A: floating pt. docstrings
+ 
+ abs
+    Function: Return the absolute value of ARG.
+ acosh
+    Function: Return the inverse hyperbolic cosine of ARG.
+ asin
+    Function: Return the inverse sine of ARG.
+ asinh
+    Function: Return the inverse hyperbolic sine of ARG.
+ atan
+    Function: Return the inverse tangent of ARG.
+ atanh
+    Function: Return the inverse hyperbolic tangent of ARG.
+ ceiling
+    Function: Return the smallest integer no less than ARG. (round toward +inf)
+ cos
+    Function: Return the cosine of ARG.
+ cosh
+    Function: Return the hyperbolic cosine of ARG.
+ cube-root
+    Function: Return the cube root of ARG.
+ erf
+    Function: Return the mathematical error function of ARG.
+ erfc
+    Function: Return the complementary error function of ARG.
+ exp
+    Function: Return the exponential base e of ARG.
+ expm1
+    Function: Return the exp(x)-1 of ARG.
+ expt
+    Function: Return the exponential x ** y.
+ fceiling
+    Function: Return the smallest integral floating pt. number no less than ARG.
+    (round towards +inf)
+ ffloor
+    Function: Return the largest floating pt number no greater than ARG.
+    (round towards -inf)
+ float
+    Function: Return the floating pt. number equal to ARG.
+ floatp
+    Function: T if OBJECT is a floating pt. number.
+ float-output-format
+    Variable: The format descriptor string (or nil) that lisp uses to print out
+    floats.  Nil means use built-in defaults.
+    The descriptor string consists of an optional field-width spec,
+    followed by an optional output-style descriptor.
+    
+    Valid field-widths specs are:
+    The empty string for default precision.
+    0-20 for exponential notation, or 1-20 for decimal point notation.  A 0
+    field spec causes the printing of the decimal point to be suppressed.
+    Using an out of bounds specs cause the closest valid spec to be used.
+    
+    Valid output-styles may be one of the following:
+    The letter 'e' for exponential notation "<number>.<number>e<number>"
+    The letter 'd' for decimal point notation "<number>.<number>".
+    The empty string, for the defaulted output style.  This may print in
+    either format in a data-dependent manner, choosing whatever produces
+    the shortest string.
+    
+ floor
+    Function: Return the largest integer no greater than ARG. (round towards -inf)
+ fround
+    Function: Return the nearest integral floating pt. number to ARG.
+ ftruncate
+    Function: Truncate a floating point number, returns a float.
+    (Truncates towards zero.) Will fail for floats > max integer.
+ garbage-collect
+    Function: Reclaim storage for Lisp objects no longer needed.
+    Returns info on amount of space in use:
+     ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
+      (USED-MARKERS . FREE-MARKERS) (USED-FLOATS . FREE-FLOATS) 
+      USED-STRING-CHARS USED-VECTOR-SLOTS)
+    Garbage collection happens automatically if you cons more than
+    gc-cons-threshold  bytes of Lisp data since previous garbage collection.
+ int-to-string
+    Function: Convert INT to a string by printing it in decimal, with minus sign if negative.
+ integer-or-float-or-marker-p
+    Function: T if OBJECT is a floating point, normal number, or marker.
+ integer-or-floatp
+    Function: T if OBJECT is a floating pt. or normal number.
+ j0
+    Function: Return the bessel function j0 of ARG.
+ j1
+    Function: Return the bessel function j1 of ARG.
+ jn
+    Function: Return the bessel function jN of ARG.
+ log
+    Function: Return the natural logarithm of ARG.
+ log-gamma
+    Function: Return the log gamma of ARG.
+ log10
+    Function: Return the logarithm base 10 of ARG.
+ log1p
+    Function: Return the log(1+x) of ARG.
+ round
+    Function: Return the nearest integer to ARG.
+ sin
+    Function: Return the sine of ARG.
+ sinh
+    Function: Return the hyperbolic sine of ARG.
+ sqrt
+    Function: Return the square root of ARG.
+ tan
+    Function: Return the tangent of ARG.
+ tanh
+    Function: Return the hyperbolic tangent of ARG.
+ truncate
+    Function: Truncate a floating point number to an int.
+    (Truncates toward zero.)
+ y0
+    Function: Return the bessel function y0 of ARG.
+ y1
+    Function: Return the bessel function y1 of ARG.
+ yn
+    Function: Return the bessel function yN of ARG.
*** src/alloc.c.orig	Thu Feb 11 02:09:48 1988
--- src/alloc.c	Fri Sep  2 23:01:22 1988
***************
*** 1,3 ****
--- 1,15 ----
+ /******************************************************************************
+ *									      *
+ *	File:     alloc.c						      *
+ *	Author:   Wolfgang S. Rupprecht <wolfgang@wsrcc.com>                 *
+ *	Created:  Mon Nov  2 15:20:48 EST 1987				      *
+ *	Contents: GNU alloc.c with my float code			      *
+ *									      *
+ *	Copyright (c) 1987 Wolfgang Rupprecht.				      *
+ *	All rights reserved.						      *
+ *									      *
+ *	$Log$								      *
+ ******************************************************************************/
  /* Storage allocation and gc for GNU Emacs Lisp interpreter.
     Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  
***************
*** 147,152 ****
--- 159,239 ----
    cons_free_list = ptr;
  }
  
+ #ifdef LISP_FLOAT_TYPE
+ 
+ /* Allocation of float cells, just like conses */
+ /* We store float cells inside of float_blocks, allocating a new
+  float_block with malloc whenever necessary.  Float cells reclaimed by
+  GC are put on a free list to be reallocated before allocating
+  any new float cells from the latest float_block.
+ 
+  Each float_block is just under 1020 bytes long,
+  since malloc really allocates in units of powers of two
+  and uses 4 bytes for its own overhead. */
+ 
+ #define FLOAT_BLOCK_SIZE \
+   ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float))
+ 
+ struct float_block
+   {
+     struct float_block *next;
+     struct Lisp_Float floats[FLOAT_BLOCK_SIZE];
+   };
+ 
+ struct float_block *float_block;
+ int float_block_index;
+ 
+ struct Lisp_Float *float_free_list;
+ 
+ void
+ init_float ()
+ {
+   float_block = (struct float_block *) malloc (sizeof (struct float_block));
+   float_block->next = 0;
+   bzero (float_block->floats, sizeof float_block->floats);
+   float_block_index = 0;
+   float_free_list = 0;
+ }
+ 
+ /* Explicitly free a float cell.  */
+ free_float (ptr)
+      struct Lisp_Float *ptr;
+ {
+   XFASTINT (ptr->type) = (int) float_free_list;
+   float_free_list = ptr;
+ }
+ 
+ Lisp_Object
+ make_float (float_value)
+      double float_value;
+ {
+   register Lisp_Object val;
+ 
+   if (float_free_list)
+     {
+       XSET (val, Lisp_Float, float_free_list);
+       float_free_list = (struct Lisp_Float *) XFASTINT (float_free_list->type);
+     }
+   else
+     {
+       if (float_block_index == FLOAT_BLOCK_SIZE)
+ 	{
+ 	  register struct float_block *new = (struct float_block *) malloc (sizeof (struct float_block));
+ 	  if (!new) memory_full ();
+ 	  new->next = float_block;
+ 	  float_block = new;
+ 	  float_block_index = 0;
+ 	}
+       XSET (val, Lisp_Float, &float_block->floats[float_block_index++]);
+     }
+   XFLOAT (val)->data = float_value;
+   XFLOAT (val)->type = 0;	/* bug chasing -wsr */
+   consing_since_gc += sizeof (struct Lisp_Float);
+   return val;
+ }
+ #endif LISP_FLOAT_TYPE
+ 
+ 
  DEFUN ("cons", Fcons, Scons, 2, 2, 0,
    "Create a new cons, give it CAR and CDR as components, and return it.")
    (car, cdr)
***************
*** 596,602 ****
--- 683,707 ----
    return new;
  }
  
+ #ifdef LISP_FLOAT_TYPE
  Lisp_Object
+ pure_float (num)
+      double num;
+ {
+   register Lisp_Object new;
+ 
+   if (pureptr + sizeof (struct Lisp_Float) > PURESIZE)
+     error ("Pure Lisp storage exhausted");
+   XSET (new, Lisp_Float, PUREBEG + pureptr);
+   pureptr += sizeof (struct Lisp_Float);
+   XFLOAT (new)->data = num;
+   XFLOAT (new)->type = 0;	/* bug chasing -wsr */
+   return new;
+ }
+ 
+ #endif LISP_FLOAT_TYPE
+ 
+ Lisp_Object
  make_pure_vector (len)
       int len;
  {
***************
*** 641,646 ****
--- 746,756 ----
      case Lisp_Cons:
        return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr);
  
+ #ifdef LISP_FLOAT_TYPE
+     case Lisp_Float:
+       return pure_float (XFLOAT (obj)->data);
+ #endif LISP_FLOAT_TYPE
+ 
      case Lisp_String:
        return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size);
  
***************
*** 727,737 ****
--- 837,852 ----
  
  int total_conses, total_markers, total_symbols, total_string_size, total_vector_size;
  int total_free_conses, total_free_markers, total_free_symbols;
+ #ifdef LISP_FLOAT_TYPE
+ int total_free_floats, total_floats;
+ #endif LISP_FLOAT_TYPE
  
  static void mark_object (), mark_buffer ();
  static void clear_marks (), gc_sweep ();
  static void compact_strings ();
  
+ #ifndef LISP_FLOAT_TYPE
+ 
  DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
    "Reclaim storage for Lisp objects no longer needed.\n\
  Returns info on amount of space in use:\n\
***************
*** 738,745 ****
   ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\
    (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS)\n\
  Garbage collection happens automatically if you cons more than\n\
! gc-cons-threshold  bytes of Lisp data since previous garbage collection.")
    ()
  {
    register struct gcpro *tail;
    register struct specbinding *bind;
--- 853,873 ----
   ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\
    (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS)\n\
  Garbage collection happens automatically if you cons more than\n\
! gc-cons-threshold  bytes of Lisp data since previous garbage collection."
!        )
    ()
+ #else LISP_FLOAT_TYPE
+ 
+ DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",  "Reclaim storage for Lisp objects no longer needed.\n\
+ Returns info on amount of space in use:\n\
+  ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\
+   (USED-MARKERS . FREE-MARKERS) (USED-FLOATS . FREE-FLOATS) \n\
+   USED-STRING-CHARS USED-VECTOR-SLOTS)\n\
+ Garbage collection happens automatically if you cons more than\n\
+ gc-cons-threshold  bytes of Lisp data since previous garbage collection."
+        )
+   ()
+ #endif LISP_FLOAT_TYPE
  {
    register struct gcpro *tail;
    register struct specbinding *bind;
***************
*** 859,867 ****
--- 987,1004 ----
  			      make_number (total_free_symbols)),
  		       Fcons (Fcons (make_number (total_markers),
  				     make_number (total_free_markers)),
+ #ifdef LISP_FLOAT_TYPE
+ 			      Fcons (Fcons (make_number (total_floats),
+ 					    make_number (total_free_floats)),
+ 				     Fcons (make_number (total_string_size),
+ 					    Fcons (make_number (total_vector_size),
+ 						   Qnil))))));
+ #else not LISP_FLOAT_TYPE
  			      Fcons (make_number (total_string_size),
  				     Fcons (make_number (total_vector_size),
  					    Qnil)))));
+ #endif LISP_FLOAT_TYPE
+ 
  }
  
  #if 0
***************
*** 1053,1058 ****
--- 1190,1201 ----
  	goto loop;
        }
  
+ #ifdef LISP_FLOAT_TYPE
+  case Lisp_Float:
+       XMARK (XFLOAT (obj)->type);
+       break;
+ #endif LISP_FLOAT_TYPE
+ 
      case Lisp_Buffer:
        if (!XMARKBIT (XBUFFER (obj)->name))
  	mark_buffer (obj);
***************
*** 1137,1143 ****
--- 1280,1316 ----
      total_conses = num_used;
      total_free_conses = num_free;
    }
+ #ifdef LISP_FLOAT_TYPE
+   /* Put all unmarked floats on free list */
+   {
+     register struct float_block *fblk;
+     register int lim = float_block_index;
+     register int num_free = 0, num_used = 0;
  
+     float_free_list = 0;
+   
+     for (fblk = float_block; fblk; fblk = fblk->next)
+       {
+ 	register int i;
+ 	for (i = 0; i < lim; i++)
+ 	  if (!XMARKBIT (fblk->floats[i].type))
+ 	    {
+ 	      XFASTINT (fblk->floats[i].type) = (int) float_free_list;
+ 	      num_free++;
+ 	      float_free_list = &fblk->floats[i];
+ 	    }
+ 	  else
+ 	    {
+ 	      num_used++;
+ 	      XUNMARK (fblk->floats[i].type);
+ 	    }
+ 	lim = FLOAT_BLOCK_SIZE;
+       }
+     total_floats = num_used;
+     total_free_floats = num_free;
+   }
+ #endif LISP_FLOAT_TYPE
+ 
    /* Put all unmarked symbols on free list */
    {
      register struct symbol_block *sblk;
***************
*** 1412,1417 ****
--- 1585,1593 ----
    all_vectors = 0;
    init_strings ();
    init_cons ();
+ #ifdef LISP_FLOAT_TYPE
+   init_float ();
+ #endif LISP_FLOAT_TYPE
    init_symbol ();
    init_marker ();
    gcprolist = 0;
*** src/callint.c.orig	Tue Jun 28 19:57:24 1988
--- src/callint.c	Fri Sep  2 23:01:26 1988
***************
*** 353,359 ****
--- 353,364 ----
  	case 'n':		/* Read number from minibuffer.  */
  	  do
  	    args[i] = Fread_minibuffer (build_string (prompt), Qnil);
+ #ifdef LISP_FLOAT_TYPE
+ 	  while ((XTYPE (args[i]) != Lisp_Int) &&
+ 		 (XTYPE (args[i]) != Lisp_Float));
+ #else
  	  while (XTYPE (args[i]) != Lisp_Int);
+ #endif
  	  visargs[i] = last_minibuf_string;
  	  break;
  
*** src/config.h-dist.orig	Thu Apr 21 03:18:33 1988
--- src/config.h-dist	Fri Sep  2 23:01:27 1988
***************
*** 18,24 ****
--- 18,29 ----
  file named COPYING.  Among other things, the copyright notice
  and this notice must be preserved on all copies.  */
  
+ /* This is a hack feature added by me.
+  * It probably won't break anything too badly, but it may not do
+  * much for you either. -Wolfgang Rupprecht 10/25/87
+  */
  
+ /* #define LISP_FLOAT_TYPE		/* define this for floating pt. numbers */
  
  /* Include here a s- file that describes the system type you are using.
     See the file ../etc/MACHINES for a list of systems and
***************
*** 100,110 ****
     Note that s-vms.h and m-sun2.h may override this default.  */
  
  #ifndef PURESIZE
! #ifdef HAVE_X_WINDOWS
! #define PURESIZE 122000
! #else
! #define PURESIZE 118000
! #endif
  #endif
  
  /* Define HIGHPRI as a negative number
--- 105,119 ----
     Note that s-vms.h and m-sun2.h may override this default.  */
  
  #ifndef PURESIZE
! # ifdef HAVE_X_WINDOWS
! #  define PURESIZE 122000
! # else
! #  ifdef LISP_FLOAT_TYPE		/* oink oink */
! #   define PURESIZE 122000
! #  else
! #   define PURESIZE 118000
! #  endif
! # endif
  #endif
  
  /* Define HIGHPRI as a negative number
*** src/crt0.c.orig	Wed Aug 31 02:48:46 1988
--- src/crt0.c	Thu Apr 20 10:57:02 1989
***************
*** 369,374 ****
--- 369,379 ----
  
  _start ()
  {
+ #ifdef LISP_FLOAT_TYPE
+ # ifdef sun3
+   finitfp_();
+ # endif
+ #endif
  /* On 68000, _start pushes a6 onto stack  */
    start1 ();
  }
*** src/data.c.orig	Fri Aug 26 20:36:23 1988
--- src/data.c	Fri Sep  2 23:01:39 1988
***************
*** 1,3 ****
--- 1,15 ----
+ /******************************************************************************
+ *									      *
+ *	File:     data.c						      *
+ *	Author:   Wolfgang S. Rupprecht <wolfgang@wsrcc.com>                 *
+ *	Created:  Mon Nov  2 15:22:23 EST 1987				      *
+ *	Contents: GNU data.c with my float code				      *
+ *									      *
+ *	Copyright (c) 1987 Wolfgang Rupprecht.				      *
+ *	All rights reserved.						      *
+ *									      *
+ *	$Log$								      *
+ ******************************************************************************/
  /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
     Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  
***************
*** 28,33 ****
--- 40,49 ----
  #include "buffer.h"
  #endif
  
+ #ifdef LISP_FLOAT_TYPE
+ #include <math.h>
+ #endif LISP_FLOAT_TYPE
+ 
  Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
  Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
  Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
***************
*** 41,47 ****
--- 57,68 ----
  Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
  Lisp_Object Qboundp, Qfboundp;
  Lisp_Object Qcdr;
+ #ifdef LISP_FLOAT_TYPE
+ Lisp_Object Qfloatp, Qinteger_or_floatp, Qinteger_or_float_or_marker_p;
+ #endif LISP_FLOAT_TYPE
  
+ 
+ 
  Lisp_Object
  wrong_type_argument (predicate, value)
       register Lisp_Object predicate, value;
***************
*** 177,182 ****
--- 198,238 ----
    return Qnil;
  }
  
+ #ifdef LISP_FLOAT_TYPE
+ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
+        "T if OBJECT is a floating pt. number.")
+   (obj)
+      Lisp_Object obj;
+ {
+   if (XTYPE (obj) == Lisp_Float)
+     return Qt;
+   return Qnil;
+ }
+ 
+ DEFUN ("integer-or-floatp", Finteger_or_floatp, Sinteger_or_floatp,
+        1, 1, 0, "T if OBJECT is a floating pt. or normal number.")
+   (obj)
+      Lisp_Object obj;
+ {
+   if ((XTYPE (obj) == Lisp_Float) || (XTYPE (obj) == Lisp_Int))
+     return Qt;
+   return Qnil;
+ }
+ 
+ DEFUN ("integer-or-float-or-marker-p", Finteger_or_float_or_marker_p,
+        Sinteger_or_float_or_marker_p, 1, 1, 0,
+        "T if OBJECT is a floating pointt, normal number, or marker.")
+   (obj)
+      Lisp_Object obj;
+ {
+   if ((XTYPE (obj) == Lisp_Float) ||
+       (XTYPE (obj) == Lisp_Int) ||
+       (XTYPE (obj) == Lisp_Marker))
+     return Qt;
+   return Qnil;
+ }
+ #endif LISP_FLOAT_TYPE
+ 
  DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, "T if OBJECT is a nonnegative number.")
    (obj)
       Lisp_Object obj;
***************
*** 961,968 ****
--- 1017,1041 ----
    (num1, num2)
       register Lisp_Object num1, num2;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ 
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       if (f1 == f2)
+ 	return Qt;
+       return Qnil;
+     }
+ 
+ #else
    CHECK_NUMBER_COERCE_MARKER (num1, 0);
    CHECK_NUMBER_COERCE_MARKER (num2, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (XINT (num1) == XINT (num2))
      return Qt;
***************
*** 974,981 ****
--- 1047,1070 ----
    (num1, num2)
       register Lisp_Object num1, num2;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ 
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       if (f1 < f2)
+ 	return Qt;
+       return Qnil;
+     }
+ #else
    CHECK_NUMBER_COERCE_MARKER (num1, 0);
    CHECK_NUMBER_COERCE_MARKER (num2, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (XINT (num1) < XINT (num2))
      return Qt;
***************
*** 987,994 ****
--- 1076,1099 ----
    (num1, num2)
       register Lisp_Object num1, num2;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ 
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       if (f1 > f2)
+ 	return Qt;
+       return Qnil;
+     }
+ #else
    CHECK_NUMBER_COERCE_MARKER (num1, 0);
    CHECK_NUMBER_COERCE_MARKER (num2, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (XINT (num1) > XINT (num2))
      return Qt;
***************
*** 1000,1007 ****
--- 1105,1128 ----
    (num1, num2)
       register Lisp_Object num1, num2;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ 
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       if (f1 <= f2)
+ 	return Qt;
+       return Qnil;
+     }
+ #else
    CHECK_NUMBER_COERCE_MARKER (num1, 0);
    CHECK_NUMBER_COERCE_MARKER (num2, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (XINT (num1) <= XINT (num2))
      return Qt;
***************
*** 1013,1020 ****
--- 1134,1157 ----
    (num1, num2)
       register Lisp_Object num1, num2;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ 
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       if (f1 >= f2)
+ 	return Qt;
+       return Qnil;
+     }
+ #else
    CHECK_NUMBER_COERCE_MARKER (num1, 0);
    CHECK_NUMBER_COERCE_MARKER (num2, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (XINT (num1) >= XINT (num2))
      return Qt;
***************
*** 1026,1033 ****
--- 1163,1186 ----
    (num1, num2)
       register Lisp_Object num1, num2;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ 
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       if (f1 != f2)
+ 	return Qt;
+       return Qnil;
+     }
+ #else
    CHECK_NUMBER_COERCE_MARKER (num1, 0);
    CHECK_NUMBER_COERCE_MARKER (num2, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (XINT (num1) != XINT (num2))
      return Qt;
***************
*** 1038,1044 ****
--- 1191,1208 ----
    (num)
       register Lisp_Object num;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     {
+       if (XFLOAT(num)->data == 0.0)
+ 	return Qt;
+       return Qnil;
+     }
+ #else
    CHECK_NUMBER (num, 0);
+ #endif LISP_FLOAT_TYPE
  
    if (!XINT (num))
      return Qt;
***************
*** 1052,1058 ****
--- 1216,1236 ----
  {
    char buffer[20];
  
+ #ifndef LISP_FLOAT_TYPE
+ 
    CHECK_NUMBER (num, 0);
+ #else
+ 
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     {
+       char pigbuf[350];	/* see comments in float_to_string */
+ 
+       float_to_string (pigbuf, XFLOAT(num)->data);
+       return build_string (pigbuf);      
+     }
+ #endif LISP_FLOAT_TYPE
    sprintf (buffer, "%d", XINT (num));
    return build_string (buffer);
  }
***************
*** 1068,1073 ****
--- 1246,1255 ----
      return make_number (1);
    if (!NULL (flag) && !strcmp (XSTRING (str)->data, "no"))
      return make_number (0);
+ #ifdef LISP_FLOAT_TYPE
+   if (isfloat_string (XSTRING (str)->data))
+     return make_float (atof(XSTRING (str)->data));
+ #endif LISP_FLOAT_TYPE
    return make_number (atoi (XSTRING (str)->data));
  }
    
***************
*** 1106,1112 ****
--- 1288,1302 ----
    for (argnum = 0; argnum < nargs; argnum++)
      {
        val = args[argnum];    /* using args[argnum] as argument to CHECK_NUMBER_... */
+ #ifdef LISP_FLOAT_TYPE
+       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
+ 
+       if (XTYPE(val) == Lisp_Float) /* time to do serious math */
+ 	return (float_arith_driver((double) accum, argnum, code,
+ 				   nargs, args));
+ #else
        CHECK_NUMBER_COERCE_MARKER (val, argnum);
+ #endif LISP_FLOAT_TYPE
        args[argnum] = val;    /* runs into a compiler bug. */
        next = XINT (args[argnum]);
  #ifdef SWITCH_ENUM_BUG
***************
*** 1138,1143 ****
--- 1328,1413 ----
    return val;
  }
  
+ #ifdef LISP_FLOAT_TYPE
+ Lisp_Object
+ float_arith_driver
+   (accum, argnum, code, nargs, args)
+      double accum;
+      register int argnum;
+      enum arithop code;
+      int nargs;
+      register Lisp_Object *args;
+ {
+   register Lisp_Object val;
+   double next;
+   
+   for (; argnum < nargs; argnum++)
+     {
+       val = args[argnum];    /* using args[argnum] as argument to CHECK_NUMBER_... */
+       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
+ 
+       if (XTYPE(val) == Lisp_Float)
+ 	{
+ 	  next = XFLOAT(val)->data;
+ 	}
+       else
+ 	{
+ 	  args[argnum] = val;    /* runs into a compiler bug. */
+ 	  next = XINT (args[argnum]);
+ 	}
+ #ifdef SWITCH_ENUM_BUG
+       switch ((int) code)
+ #else
+       switch (code)
+ #endif
+ 	{
+ 	case Aadd: accum += next; break;
+ 	case Asub:
+ 	  if (!argnum && nargs != 1)
+ 	    next = - next;
+ 	  accum -= next;
+ 	  break;
+ 	case Amult: accum *= next; break;
+ 	case Adiv:
+ 	  if (!argnum) accum = next;
+ 	  else accum /= next;
+ 	  break;
+ #ifdef pigs_had_wings
+ 	case Alogand: accum &= next; break;
+ 	case Alogior: accum |= next; break;
+ 	case Alogxor: accum ^= next; break;
+ #else
+ 	case Alogand:
+ 	case Alogior:
+ 	case Alogxor:
+ 	  return (wrong_type_argument (Qinteger_or_marker_p, val));
+ 	  break;
+ #endif
+ 	case Amax: if (!argnum || next > accum) accum = next; break;
+ 	case Amin: if (!argnum || next < accum) accum = next; break;
+ 	}
+     }
+ 
+   return make_float(accum);
+ }
+ 
+ DEFUN ("logb", Flogb, Slogb, 1, 1, 0,
+  "Returns the integer that is the base 2 log of ARG.\n\
+ This is the same as the exponent of a float.")
+      (num)
+ Lisp_Object num;
+ {
+   Lisp_Object val;
+   double f;
+ 
+   CHECK_NUMBER_OR_FLOAT(num, 0);
+   f = (XTYPE(num) == Lisp_Float) ? XFLOAT(num)->data : XINT(num);
+   val = logb(f);
+   XSET(val, Lisp_Int, val);
+   return val;
+ }
+ #endif LISP_FLOAT_TYPE
+ 
  DEFUN ("+", Fplus, Splus, 0, MANY, 0,
    "Return sum of any number of numbers.")
    (nargs, args)
***************
*** 1182,1190 ****
--- 1452,1473 ----
       register Lisp_Object num1, num2;
  {
    Lisp_Object val;
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT (num1, 0);
+   CHECK_NUMBER_OR_FLOAT (num2, 0);
  
+   if ((XTYPE(num1) == Lisp_Float) || (XTYPE(num2) == Lisp_Float))
+     {
+       double f1, f2;
+ 
+       f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+       f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+       return (make_float(drem(f1,f2)));
+     }
+ #else
    CHECK_NUMBER (num1, 0);
    CHECK_NUMBER (num2, 1);
+ #endif LISP_FLOAT_TYPE
  
    XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
    return val;
***************
*** 1278,1284 ****
--- 1561,1574 ----
    (num)
       register Lisp_Object num;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float((1.0) + XFLOAT(num)->data));
+ #else
    CHECK_NUMBER_COERCE_MARKER (num, 0);
+ #endif LISP_FLOAT_TYPE
    XSETINT (num, XFASTINT (num) + 1);
    return num;
  }
***************
*** 1288,1294 ****
--- 1578,1591 ----
    (num)
       register Lisp_Object num;
  {
+ #ifdef LISP_FLOAT_TYPE
+   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float((-1.0) + XFLOAT(num)->data));
+ #else
    CHECK_NUMBER_COERCE_MARKER (num, 0);
+ #endif LISP_FLOAT_TYPE
    XSETINT (num, XFASTINT (num) - 1);
    return num;
  }
***************
*** 1302,1307 ****
--- 1599,2155 ----
    XSETINT (num, ~XFASTINT (num));
    return num;
  }
+ 
+ #ifdef LISP_FLOAT_TYPE
+ 
+ DEFUN ("acos", Facos, Sacos, 1, 1, 0,
+   "Return the inverse cosine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (acos(XFLOAT(num)->data)));
+   return (make_float (acos((double) XINT(num))));
+ }
+ 
+ 
+ DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0,
+   "Return the inverse hyperbolic cosine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (acosh(XFLOAT(num)->data)));
+   return (make_float (acosh((double) XINT(num))));
+ }
+ 
+ DEFUN ("asin", Fasin, Sasin, 1, 1, 0,
+   "Return the inverse sine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (asin(XFLOAT(num)->data)));
+   return (make_float (asin((double) XINT(num))));
+ }
+ 
+ DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0,
+   "Return the inverse hyperbolic sine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (asinh(XFLOAT(num)->data)));
+   return (make_float (asinh((double) XINT(num))));
+ }
+ 
+ DEFUN ("atan", Fatan, Satan, 1, 1, 0,
+   "Return the inverse tangent of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (atan(XFLOAT(num)->data)));
+   return (make_float (atan((double) XINT(num))));
+ }
+ 
+ DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0,
+   "Return the inverse hyperbolic tangent of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (atanh(XFLOAT(num)->data)));
+   return (make_float (atanh((double) XINT(num))));
+ }
+ 
+ 
+ DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0,
+   "Return the cube root of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (cbrt(XFLOAT(num)->data)));
+   return (make_float (cbrt((double) XINT(num))));
+ }
+ DEFUN ("cos", Fcos, Scos, 1, 1, 0,
+   "Return the cosine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (cos(XFLOAT(num)->data)));
+   return (make_float (cos((double) XINT(num))));
+ }
+ 
+ DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0,
+   "Return the hyperbolic cosine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (cosh(XFLOAT(num)->data)));
+   return (make_float (cosh((double) XINT(num))));
+ }
+ 
+ DEFUN ("erf", Ferf, Serf, 1, 1, 0,
+   "Return the mathematical error function of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (erf(XFLOAT(num)->data)));
+   return (make_float (erf((double) XINT(num))));
+ }
+ 
+ DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0,
+   "Return the complementary error function of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (erfc(XFLOAT(num)->data)));
+   return (make_float (erfc((double) XINT(num))));
+ }
+ 
+ DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
+   "Return the exponential base e of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (exp(XFLOAT(num)->data)));
+   return (make_float (exp((double) XINT(num))));
+ }
+ 
+ DEFUN ("expm1", Fexpm1, Sexpm1, 1, 1, 0,
+   "Return the exp(x)-1 of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (expm1(XFLOAT(num)->data)));
+   return (make_float (expm1((double) XINT(num))));
+ }
+ 
+ DEFUN ("j0", Fj0, Sj0, 1, 1, 0,
+   "Return the bessel function j0 of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (j0(XFLOAT(num)->data)));
+   return (make_float (j0((double) XINT(num))));
+ }
+ 
+ DEFUN ("j1", Fj1, Sj1, 1, 1, 0,
+   "Return the bessel function j1 of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (j1(XFLOAT(num)->data)));
+   return (make_float (j1((double) XINT(num))));
+ }
+ 
+ DEFUN ("jn", Fjn, Sjn, 2, 2, 0,
+ "Return the nth ORDER bessel function output jn of ARG.  First arg is\n\
+ the ORDER of the bessel, and is truncated to an integer.")
+   (num1, num2)
+      register Lisp_Object num1, num2;
+ {
+   int i1;
+   double f2;
+ 
+   CHECK_NUMBER_OR_FLOAT (num1, 0);
+   CHECK_NUMBER_OR_FLOAT (num2, 0);
+   i1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+   f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+ 
+   return (make_float (jn(i1, f2)));
+ }
+ 
+ DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0,
+   "Return the log gamma of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (lgamma(XFLOAT(num)->data)));
+   return (make_float (lgamma((double) XINT(num))));
+ }
+ 
+ DEFUN ("log", Flog, Slog, 1, 1, 0,
+   "Return the natural logarithm of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (log(XFLOAT(num)->data)));
+   return (make_float (log((double) XINT(num))));
+ }
+ 
+ DEFUN ("log10", Flog10, Slog10, 1, 1, 0,
+   "Return the logarithm base 10 of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (log10(XFLOAT(num)->data)));
+   return (make_float (log10((double) XINT(num))));
+ }
+ 
+ DEFUN ("log1p", Flog1p, Slog1p, 1, 1, 0,
+   "Return the log(1+x) of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (log1p(XFLOAT(num)->data)));
+   return (make_float (log1p((double) XINT(num))));
+ }
+ 
+ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
+   "Return the exponential x ** y.")
+   (num1, num2)
+      register Lisp_Object num1, num2;
+ {
+   double f1, f2;
+ 
+   CHECK_NUMBER_OR_FLOAT (num1, 0);
+   CHECK_NUMBER_OR_FLOAT (num2, 0);
+   if ((XTYPE(num1) == Lisp_Int) && /* common lisp spec */
+       (XTYPE(num2) == Lisp_Int)) /* don't promote, if both are ints */
+     {				/* this can be improved by pre-calculating */
+       int acc, x, y;		/* some binary powers of x then acumulating */
+ 				/* these, therby saving some time. -wsr */
+       x = XINT(num1);
+       y = XINT(num2);
+       acc = 1;
+       
+       if (y < 0)
+ 	{
+ 	  for (; y < 0; y++)
+ 	      acc /= x;
+ 	}
+       else
+ 	{
+ 	  for (; y > 0; y--)
+ 	      acc *= x;
+ 	}
+       return (XSET(x , Lisp_Int, acc));
+     }
+   f1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+   f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+   return (make_float (pow(f1, f2)));
+ }
+ 
+ DEFUN ("sin", Fsin, Ssin, 1, 1, 0,
+   "Return the sine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (sin(XFLOAT(num)->data)));
+   return (make_float (sin((double) XINT(num))));
+ }
+ 
+ DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0,
+   "Return the hyperbolic sine of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (sinh(XFLOAT(num)->data)));
+   return (make_float (sinh((double) XINT(num))));
+ }
+ 
+ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
+   "Return the square root of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (sqrt(XFLOAT(num)->data)));
+   return (make_float (sqrt((double) XINT(num))));
+ }
+ 
+ DEFUN ("tan", Ftan, Stan, 1, 1, 0,
+   "Return the tangent of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (tan(XFLOAT(num)->data)));
+   return (make_float (tan((double) XINT(num))));
+ }
+ 
+ DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0,
+   "Return the hyperbolic tangent of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (tanh(XFLOAT(num)->data)));
+   return (make_float (tanh((double) XINT(num))));
+ }
+ 
+ DEFUN ("y0", Fy0, Sy0, 1, 1, 0,
+   "Return the bessel function y0 of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (y0(XFLOAT(num)->data)));
+   return (make_float (y0((double) XINT(num))));
+ }
+ 
+ DEFUN ("y1", Fy1, Sy1, 1, 1, 0,
+   "Return the bessel function y1 of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (y1(XFLOAT(num)->data)));
+   return (make_float (y1((double) XINT(num))));
+ }
+ 
+ DEFUN ("yn", Fyn, Syn, 2, 2, 0,
+ "Return the nth ORDER bessel function output yn of ARG.  First arg is\n\
+ the order of the bessel, and is truncated to an integer.")
+   (num1, num2)
+      register Lisp_Object num1, num2;
+ {
+   int i1;
+   double f2;
+ 
+   CHECK_NUMBER_OR_FLOAT (num1, 0);
+   CHECK_NUMBER_OR_FLOAT (num2, 0);
+   i1 = (XTYPE(num1) == Lisp_Float) ? XFLOAT(num1)->data : XINT(num1);
+   f2 = (XTYPE(num2) == Lisp_Float) ? XFLOAT(num2)->data : XINT(num2);
+ 
+   return (make_float (yn(i1, f2)));
+ }
+ /* the rounding functions  */
+ 
+ DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0,
+   "Return the smallest integer no less than ARG. (round toward +inf)")
+   (num)
+      register Lisp_Object num;
+ {
+   Lisp_Object val = num;
+      
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+        XSET (val, Lisp_Int, ceil(XFLOAT(num)->data));
+   return (val);
+ }
+ 
+ DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0,
+        "Return the smallest integral floating pt. number no less than ARG.\n\
+ (round towards +inf)")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (ceil(XFLOAT(num)->data)));
+   return (make_float ((double) XINT(num)));
+ }
+ 
+ 
+ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
+   "Return the absolute value of ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (fabs(XFLOAT(num)->data)));
+   if (XINT(num) < 0)
+     XSETINT (num, - XFASTINT (num));
+   return (num);
+ }
+ 
+ 
+ DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0,
+        "Return the largest floating pt number no greater than ARG.\n\
+ (round towards -inf)")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (floor(XFLOAT(num)->data)));
+   return (make_float (floor((double) XINT(num))));
+ }
+ 
+ DEFUN ("floor", Ffloor, Sfloor, 1, 1, 0,
+   "Return the largest integer no greater than ARG. (round towards -inf)")
+   (num)
+      register Lisp_Object num;
+ {
+   Lisp_Object val = num; 
+ 
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     XSET (val, Lisp_Int, floor(XFLOAT(num)->data));
+   return (val);
+ }
+ 
+ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
+   "Return the floating pt. number equal to ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   Lisp_Object val; 
+ 
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Int)
+     val = make_float ((double) XINT(num));
+   else				/* give 'em the same float back */
+     val = num;
+   
+   return (val);
+ }
+ 
+ 
+ DEFUN ("fround", Ffround, Sfround, 1, 1, 0,
+   "Return the nearest integral floating pt. number to ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   CHECK_NUMBER_OR_FLOAT(num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     return (make_float (rint(XFLOAT(num)->data)));
+   return (make_float (rint((double) XINT(num))));
+ }
+ 
+ DEFUN ("round", Fround, Sround, 1, 1, 0,
+   "Return the nearest integer to ARG.")
+   (num)
+      register Lisp_Object num;
+ {
+   Lisp_Object val = num; 
+ 
+   CHECK_NUMBER_OR_FLOAT (num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+     XSET (val, Lisp_Int, rint(XFLOAT(num)->data));
+   return (val);
+ }
+ 
+ DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0,
+        "Truncate a floating point number to an int.\n\
+ (Truncates toward zero.)")
+   (num)
+      register Lisp_Object num;
+ {
+   Lisp_Object val = num;
+ 
+   CHECK_NUMBER_OR_FLOAT(num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+       XSET (val, Lisp_Int, XFLOAT(num)->data);
+   return val;
+ }
+ 
+ DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0,
+        "Truncate a floating point number, returns a float.\n\
+ (Truncates towards zero.) Will fail for floats > max integer.")
+   (num)
+      register Lisp_Object num;
+ {
+   int val;
+ 
+   CHECK_NUMBER_OR_FLOAT(num, 0);
+ 
+   if (XTYPE(num) == Lisp_Float)
+        val = XFLOAT(num)->data;
+   else 
+        val = XINT (num);
+   return (make_float((double) val));
+ }
+ 
+ # ifdef vax
+ /*
+  * Replacement infnan for 4.3 (vax) math lib.  The original 4.3BSD
+  * infnan() causes an intentional illegal-instruction and core dump.
+  * 
+  * This one is more benign and only signals an error.
+  */
+ 
+ double 
+ infnan(iarg)
+ 	int             iarg;
+ {
+         Fsignal (Qarith_error, Qnil);
+ 	/* NOTREACHED */
+ 	return (0.0);
+ }
+ # endif vax
+ #endif LISP_FLOAT_TYPE
+ 
  
  void
  syms_of_data ()
***************
*** 1348,1353 ****
--- 2196,2206 ----
    Qfboundp = intern ("fboundp");
  
    Qcdr = intern ("cdr");
+ #ifdef LISP_FLOAT_TYPE
+   Qfloatp = intern ("floatp");
+   Qinteger_or_floatp = intern ("integer-or-floatp");
+   Qinteger_or_float_or_marker_p = intern ("integer-or-float-or-marker-p");
+ #endif LISP_FLOAT_TYPE
  
    /* ERROR is used as a signaler for random errors for which nothing else is right */
  
***************
*** 1471,1476 ****
--- 2324,2334 ----
    staticpro (&Qchar_or_string_p);
    staticpro (&Qmarkerp);
    staticpro (&Qinteger_or_marker_p);
+ #ifdef LISP_FLOAT_TYPE
+   staticpro (&Qfloatp);
+   staticpro (&Qinteger_or_floatp);
+   staticpro (&Qinteger_or_float_or_marker_p);
+ #endif LISP_FLOAT_TYPE
    staticpro (&Qboundp);
    staticpro (&Qfboundp);
    staticpro (&Qcdr);
***************
*** 1542,1547 ****
--- 2400,2450 ----
    defsubr (&Sadd1);
    defsubr (&Ssub1);
    defsubr (&Slognot);
+ #ifdef LISP_FLOAT_TYPE
+   defsubr (&Sfloatp);
+   defsubr (&Sinteger_or_floatp);
+   defsubr (&Sinteger_or_float_or_marker_p);
+   defsubr (&Sacos);
+   defsubr (&Sacosh);
+   defsubr (&Sasin);
+   defsubr (&Sasinh);
+   defsubr (&Satan);
+   defsubr (&Satanh);
+   defsubr (&Scube_root);
+   defsubr (&Scos);
+   defsubr (&Scosh);
+   defsubr (&Serf);
+   defsubr (&Serfc);
+   defsubr (&Sexp);
+   defsubr (&Sexpm1);
+   defsubr (&Sj0);
+   defsubr (&Sj1);
+   defsubr (&Sjn);
+   defsubr (&Slog_gamma);
+   defsubr (&Slog);
+   defsubr (&Slog10);
+   defsubr (&Slog1p);
+   defsubr (&Sexpt);
+   defsubr (&Ssin);
+   defsubr (&Ssinh);
+   defsubr (&Ssqrt);
+   defsubr (&Stan);
+   defsubr (&Stanh);
+   defsubr (&Sy0);
+   defsubr (&Sy1);
+   defsubr (&Syn);
+   defsubr (&Sceiling);
+   defsubr (&Sabs);
+   defsubr (&Sfloor);
+   defsubr (&Sfloat);
+   defsubr (&Sround);
+   defsubr (&Struncate);
+   defsubr (&Sfceiling);
+   defsubr (&Sffloor);
+   defsubr (&Sfround);
+   defsubr (&Sftruncate);
+   defsubr (&Slogb);
+ #endif LISP_FLOAT_TYPE
  }
  
  arith_error (signo)
-- 
Wolfgang Rupprecht    wolfgang@wsrcc.com (or) uunet!wsrcc!wolfgang
Snail Mail Address:   Box 6524, Alexandria, VA 22306-0524