Article View: gnu.emacs.help
Article #188760Re: Floating point in Emacs Lisp (part 2 of 2)
From: Wolfgang S. Rupprecht
Date: Tue, 02 Jul 1991 16:36
Date: Tue, 02 Jul 1991 16:36
1008 lines
34745 bytes
34745 bytes
This is part 2 of 2 of the floating pt. emacs patches.
-wolfgang
*** src/lisp.h.orig Wed Mar 30 01:42:49 1988
--- src/lisp.h Fri Sep 2 23:01:44 1988
***************
*** 1,3 ****
--- 1,15 ----
+ /******************************************************************************
+ * *
+ * File: lisp.h *
+ * Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> *
+ * Created: Mon Nov 2 15:19:17 EST 1987 *
+ * Contents: gnuemacs lisp.h with float code *
+ * *
+ * Copyright (c) 1987 Wolfgang Rupprecht. *
+ * All rights reserved. *
+ * *
+ * $Log$ *
+ ******************************************************************************/
/* Fundamental definitions for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
***************
*** 150,157 ****
--- 162,175 ----
Data inside looks like a Lisp_Vector. */
Lisp_Window,
+ #ifdef LISP_FLOAT_TYPE
+ /* optional Lisp floating point data type -wolfgang 10/24/87 */
+ Lisp_Float,
+ #endif LISP_FLOAT_TYPE
+
/* Used by save,set,restore-window-configuration */
Lisp_Window_Configuration
+
};
#ifndef NO_UNION_TYPE
***************
*** 397,402 ****
--- 415,424 ----
#define XWINDOW(a) ((struct window *) XPNTR(a))
#define XPROCESS(a) ((struct Lisp_Process *) XPNTR(a))
+ #ifdef LISP_FLOAT_TYPE
+ # define XFLOAT(a) ((struct Lisp_Float *) XPNTR(a))
+ #endif LISP_FLOAT_TYPE
+
#define XSETCONS(a, b) XSETPNTR(a, (int) (b))
#define XSETBUFFER(a, b) XSETPNTR(a, (int) (b))
#define XSETVECTOR(a, b) XSETPNTR(a, (int) (b))
***************
*** 409,414 ****
--- 431,439 ----
#define XSETINTPTR(a, b) XSETPNTR(a, (int) (b))
#define XSETWINDOW(a, b) XSETPNTR(a, (int) (b))
#define XSETPROCESS(a, b) XSETPNTR(a, (int) (b))
+ #ifdef LISP_FLOAT_TYPE
+ # define XSETFLOAT(a, b) XSETPNTR(a, (int) (b))
+ #endif LISP_FLOAT_TYPE
/* In a cons, the markbit of the car is the gc mark bit */
***************
*** 471,476 ****
--- 496,511 ----
int bufpos;
int modified;
};
+
+ #ifdef LISP_FLOAT_TYPE
+ /* optional Lisp floating point type */
+ struct Lisp_Float
+ {
+ Lisp_Object type; /* essentially used for mark-bit
+ and chaining when on free-list */
+ double data;
+ };
+ #endif LISP_FLOAT_TYPE
/* Data type checking */
***************
*** 513,518 ****
--- 548,565 ----
{ if (XTYPE ((x)) == Lisp_Marker) XFASTINT (x) = marker_position (x); \
else if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qinteger_or_marker_p, (x)); }
+ #ifdef LISP_FLOAT_TYPE
+ #define CHECK_FLOAT(x, i) \
+ { if (XTYPE ((x)) != Lisp_Float) x = wrong_type_argument (Qfloatp, (x)); }
+ #define CHECK_NUMBER_OR_FLOAT(x, i) \
+ { if ((XTYPE ((x)) != Lisp_Float) && (XTYPE ((x)) != Lisp_Int))\
+ x = wrong_type_argument (Qinteger_or_floatp, (x)); }
+ #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x, i) \
+ { if (XTYPE ((x)) == Lisp_Marker) XFASTINT (x) = marker_position (x); \
+ else if ((XTYPE ((x)) != Lisp_Int) && (XTYPE ((x)) != Lisp_Float)) \
+ x = wrong_type_argument (Qinteger_or_float_or_marker_p, (x)); }
+ #endif LISP_FLOAT_TYPE
+
#ifdef VIRT_ADDR_VARIES
/* For machines like APOLLO where text and data can go anywhere
***************
*** 760,770 ****
--- 807,825 ----
extern Lisp_Object Qinteger_or_marker_p, Qboundp, Qfboundp;
extern Lisp_Object Qcdr;
+ #ifdef LISP_FLOAT_TYPE
+ extern Lisp_Object Qfloatp, Qinteger_or_floatp, Qinteger_or_float_or_marker_p;
+ #endif LISP_FLOAT_TYPE
+
extern Lisp_Object Feq (), Fnull (), Flistp (), Fconsp (), Fatom (), Fnlistp ();
extern Lisp_Object Fintegerp (), Fnatnump (), Fsymbolp ();
extern Lisp_Object Fvectorp (), Fstringp (), Farrayp (), Fsequencep ();
extern Lisp_Object Fbufferp (), Fmarkerp (), Fsubrp (), Fchar_or_string_p ();
extern Lisp_Object Finteger_or_marker_p ();
+ #ifdef LISP_FLOAT_TYPE
+ extern Lisp_Object Ffloatp(), Finteger_or_floatp(),
+ Finteger_or_float_or_marker_p(), Ftruncate();
+ #endif LISP_FLOAT_TYPE
extern Lisp_Object Fcar (), Fcar_safe(), Fcdr (), Fcdr_safe();
extern Lisp_Object Fsetcar (), Fsetcdr ();
***************
*** 786,791 ****
--- 841,850 ----
extern void args_out_of_range ();
extern void args_out_of_range_3 ();
extern Lisp_Object wrong_type_argument ();
+ #ifdef LISP_FLOAT_TYPE
+ extern Lisp_Object Ffloat_to_int(), Fint_to_float();
+ #endif LISP_FLOAT_TYPE
+
/* Defined in fns.c */
extern Lisp_Object Qstring_lessp;
*** src/lread.c.orig Mon Aug 1 21:43:43 1988
--- src/lread.c Fri Sep 2 23:01:47 1988
***************
*** 1,3 ****
--- 1,15 ----
+ /******************************************************************************
+ * *
+ * File: lread.c *
+ * Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> *
+ * Created: Mon Nov 2 15:23:48 EST 1987 *
+ * Contents: GNU lread.c with my float code *
+ * *
+ * Copyright (c) 1987 Wolfgang Rupprecht. *
+ * All rights reserved. *
+ * *
+ * $Log$ *
+ ******************************************************************************/
/* Lisp parsing and input streams.
Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
***************
*** 40,45 ****
--- 52,61 ----
#define X_OK 01
#endif
+ #ifdef LISP_FLOAT_TYPE
+ #include <math.h>
+ #endif LISP_FLOAT_TYPE
+
Lisp_Object Qread_char, Qget_file_char, Qstandard_input;
Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input;
***************
*** 667,676 ****
while (c > 040 &&
!(c == '\"' || c == '\'' || c == ';' || c == '?'
! || c == '(' || c == ')' || c =='.'
|| c == '[' || c == ']' || c == '#'
))
{
if (p == end)
{
register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
--- 683,705 ----
while (c > 040 &&
!(c == '\"' || c == '\'' || c == ';' || c == '?'
! || c == '(' || c == ')'
! #ifndef LISP_FLOAT_TYPE /* we need to see <number><dot><number> */
! || c =='.'
! #endif not LISP_FLOAT_TYPE
|| c == '[' || c == ']' || c == '#'
))
{
+ #ifdef LISP_FLOAT_TYPE_nuked /* for added robustness */
+ if (c == '.')
+ { /* fix up dotted pair stuff */
+ if (((p - 1) < read_buffer) ||
+ ((*(p-1)) < '0') ||
+ ((*(p-1)) > '9'))
+ break; /* wasn't <numeric-string><dot> */
+ }
+ #endif LISP_FLOAT_TYPE
+
if (p == end)
{
register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
***************
*** 711,722 ****
return val;
}
}
}
-
return intern (read_buffer);
}
}
}
static Lisp_Object
read_vector (readcharfun)
--- 740,807 ----
return val;
}
}
+ if (isfloat_string (read_buffer))
+ return make_float (atof(read_buffer));
}
return intern (read_buffer);
}
}
}
+
+ #ifdef LISP_FLOAT_TYPE
+ #include <ctype.h>
+ #define LEAD_INT 1
+ #define DOT_CHAR 2
+ #define TRAIL_INT 4
+ #define E_CHAR 8
+ #define EXP_INT 16
+
+ isfloat_string(cp)
+ register char *cp;
+ {
+ register state;
+
+ state = 0;
+ if ((*cp == '+') || (*cp == '-'))
+ cp++;
+ if (isdigit(*cp))
+ {
+ state |= LEAD_INT;
+ while (isdigit (*cp))
+ cp ++;
+ }
+ if (*cp == '.')
+ {
+ state |= DOT_CHAR;
+ cp++;
+ }
+ if (isdigit(*cp))
+ {
+ state |= TRAIL_INT;
+ while (isdigit (*cp))
+ cp++;
+ }
+ if (*cp == 'e')
+ {
+ state |= E_CHAR;
+ cp++;
+ }
+ if ((*cp == '+') || (*cp == '-'))
+ {
+ cp++;
+ }
+ if (isdigit(*cp))
+ {
+ state |= EXP_INT;
+ while (isdigit (*cp))
+ cp++;
+ }
+ return ((*cp == 0) &&
+ ((state == (LEAD_INT|DOT_CHAR|TRAIL_INT)) ||
+ (state == (LEAD_INT|E_CHAR|EXP_INT)) ||
+ (state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT))));
+ }
+ #endif LISP_FLOAT_TYPE
static Lisp_Object
read_vector (readcharfun)
*** src/m-sun3.h.orig Sat May 14 01:23:22 1988
--- src/m-sun3.h Thu Apr 20 10:53:36 1989
***************
*** 12,14 ****
--- 12,17 ----
and is counted in hdr.a_text. */
#define A_TEXT_OFFSET(HDR) sizeof (HDR)
+
+ /* In case we are using floating point, work together with crt0.c. */
+ #define C_SWITCH_MACHINE -fsoft
*** src/print.c.orig Thu Jul 28 11:12:41 1988
--- src/print.c Fri Sep 2 23:01:51 1988
***************
*** 1,3 ****
--- 1,15 ----
+ /******************************************************************************
+ * *
+ * File: print.c *
+ * Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> *
+ * Created: Mon Nov 2 15:24:52 EST 1987 *
+ * Contents: GNU print.c with my float code *
+ * *
+ * Copyright (c) 1987 Wolfgang Rupprecht. *
+ * All rights reserved. *
+ * *
+ * $Log$ *
+ ******************************************************************************/
/* Lisp object printing and output streams.
Copyright (C) 1985, 1986 Free Software Foundation, Inc.
***************
*** 32,37 ****
--- 44,54 ----
Lisp_Object Vstandard_output, Qstandard_output;
+ #ifdef LISP_FLOAT_TYPE
+ Lisp_Object Vfloat_output_format,Qfloat_output_format;
+ #endif LISP_FLOAT_TYPE
+
+
/* Avoid actual stack overflow in print. */
int print_depth;
***************
*** 434,439 ****
--- 451,534 ----
return obj;
}
+ #ifdef LISP_FLOAT_TYPE
+
+ #define WFLAG 0x80
+ #define FIXBOUNDS(x,l,u) { if (x < l) {x = l;} else if (x > u) {x = u;}}
+
+ void
+ float_to_string (buf, data)
+ char * buf;
+ /*
+ * This buffer should be at least as large as the max string size of the
+ * largest float, printed in the biggest notation. This is undoubtably
+ * 20d float_output_format, with the negative of the C-constant "HUGE"
+ * from <math.h>.
+ *
+ * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
+ *
+ * I assume that IEEE-754 format numbers can take 329 bytes for the worst
+ * case of -1e307 in 20d float_output_format. What is one to do (short of
+ * re-writing _doprnt to be more sane)?
+ * -wsr
+ */
+ double data;
+ {
+ register unsigned char *cp, c, *endp;
+ register int width;
+ unsigned int state;
+
+ if (NULL (Vfloat_output_format) ||
+ (XTYPE(Vfloat_output_format) != Lisp_String))
+ sprintf (buf, "%.2e", data);
+ else /* oink oink */
+ {
+ cp = XSTRING(Vfloat_output_format)->data;
+ endp = XSTRING(Vfloat_output_format)->size + cp;
+ state = 0;
+
+ for (width = 0;
+ ((cp < endp) && ((c = *cp) >= '0') && (c <= '9'));
+ cp++)
+ {
+ state = WFLAG;
+ width *= 10;
+ width += c - '0';
+ }
+
+ if ((cp < endp) &&
+ ((c = *cp) == 'e') || (c == 'd'))
+ state |= c;
+
+ switch (state)
+ {
+ default: /* never happen ... */
+ case 0:
+ sprintf (buf, "%.3g", data);
+ break;
+ case WFLAG:
+ FIXBOUNDS(width, 1, 20);
+ sprintf (buf, "%.*g", width, data);
+ break;
+ case 'e':
+ sprintf (buf, "%.2e", data);
+ break;
+ case 'e'|WFLAG:
+ FIXBOUNDS(width, 0, 20);
+ sprintf (buf, "%.*e", width, data);
+ break;
+ case 'd':
+ sprintf (buf, "%.3f", data);
+ break;
+ case 'd'|WFLAG:
+ FIXBOUNDS(width, 1, 20);
+ sprintf (buf, "%.*f", width, data);
+ break;
+ }
+ }
+ }
+ #endif LISP_FLOAT_TYPE
+
static void
print (obj, printcharfun, escapeflag)
#ifndef RTPC_REGISTER_BUG
***************
*** 475,480 ****
--- 570,586 ----
-1, printcharfun);
break;
+ #ifdef LISP_FLOAT_TYPE
+ case Lisp_Float:
+ {
+ char pigbuf[350]; /* see comments in float_to_string */
+
+ float_to_string (pigbuf, XFLOAT(obj)->data);
+ strout (pigbuf, -1, printcharfun);
+ }
+ break;
+ #endif LISP_FLOAT_TYPE
+
case Lisp_Int:
sprintf (buf, "%d", XINT (obj));
strout (buf, -1, printcharfun);
***************
*** 667,672 ****
--- 773,803 ----
Vstandard_output = Qt;
Qstandard_output = intern ("standard-output");
staticpro (&Qstandard_output);
+
+ #ifdef LISP_FLOAT_TYPE
+ DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
+ "The format descriptor string (or nil) that lisp uses to print out\n\
+ floats. Nil means use built-in defaults.\n\
+ The descriptor string consists of an optional field-width spec,\n\
+ followed by an optional output-style descriptor.\n\
+ \n\
+ Valid field-widths specs are:\n\
+ The empty string for default precision.\n\
+ 0-20 for exponential notation, or 1-20 for decimal point notation. A 0\n\
+ field spec causes the printing of the decimal point to be supressed.\n\
+ Using an out of bounds specs cause the closest valid spec to be used.\n\
+ \n\
+ Valid ouput-styles may be one of the following:\n\
+ The letter 'e' for exponential notation \"<number>.<number>e<number>\"\n\
+ The letter 'd' for decimal point notation \"<number>.<number>\".\n\
+ The empty string, for the defaulted output style. This may print in\n\
+ either format in a data-dependent manner, choosing whatever produces\n\
+ the shortest string.\n\
+ ");
+ Vfloat_output_format = Qnil;
+ Qfloat_output_format = intern ("float-output-format");
+ staticpro (&Qfloat_output_format);
+ #endif LISP_FLOAT_TYPE
DEFVAR_LISP ("print-length", &Vprint_length,
"Maximum length of list to print before abbreviating.\
*** src/ymakefile.orig Mon Aug 15 23:03:31 1988
--- src/ymakefile Thu Sep 15 17:32:28 1988
***************
*** 1,3 ****
--- 1,15 ----
+ /******************************************************************************
+ * *
+ * File: ymakefile *
+ * Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> *
+ * Created: Mon Nov 2 15:27:47 EST 1987 *
+ * Contents: GNU ymakefile with my float code *
+ * *
+ * Copyright (c) 1987 Wolfgang Rupprecht. *
+ * All rights reserved. *
+ * *
+ * $Log$ *
+ ******************************************************************************/
/* Makefile for GNU Emacs.
Copyright (C) 1985, 1987, 1988 Free Software Foundation, Inc.
***************
*** 18,23 ****
--- 30,37 ----
file named COPYING. Among other things, the copyright notice
and this notice must be preserved on all copies. */
+ /* undefine this to use normal /bin/cc */
+ CC=gcc -traditional
dot = .
/* on Xenix, replace double-dot below with $(dot)$(dot) */
***************
*** 53,58 ****
--- 67,81 ----
#define LIBS_MACHINE
#endif
+
+ #ifndef LIB_MATH
+ # ifdef LISP_FLOAT_TYPE
+ # define LIB_MATH -lm -lc
+ # else
+ # define LIB_MATH
+ # endif
+ #endif
+
/* Some s- files define this to request special switches in ld. */
#ifndef LD_SWITCH_SYSTEM
#if defined (BSD) && !defined (COFF)
***************
*** 132,138 ****
SHORT= shortnames
#endif /* SHORTNAMES */
! CFLAGS= C_DEBUG_SWITCH -Demacs $(MYCPPFLAG) C_SWITCH_MACHINE C_SWITCH_SYSTEM
/* DO NOT use -R. There is a special hack described in lastfile.c
which is used instead. Some initialized data areas are modified
at initial startup, then labeled as part of the text area when
--- 155,161 ----
SHORT= shortnames
#endif /* SHORTNAMES */
! CFLAGS= C_OPTIMIZE_SWITCH C_DEBUG_SWITCH -Demacs $(MYCPPFLAG) C_SWITCH_MACHINE C_SWITCH_SYSTEM
/* DO NOT use -R. There is a special hack described in lastfile.c
which is used instead. Some initialized data areas are modified
at initial startup, then labeled as part of the text area when
***************
*** 164,170 ****
#ifdef X11
#ifdef HAVE_X_MENU
XOBJ = x11term.o x11fns.o xmenu.o
! LIBX = -lXMenu -loldX -lX11 LIBX11_MACHINE LIBX11_SYSTEM
#else
XOBJ = x11term.o x11fns.o
LIBX = -lX11 LIBX11_MACHINE LIBX11_SYSTEM
--- 187,194 ----
#ifdef X11
#ifdef HAVE_X_MENU
XOBJ = x11term.o x11fns.o xmenu.o
! /* LIBX = -lXMenu -loldX -lX11 LIBX11_MACHINE LIBX11_SYSTEM */
! LIBX = -lXMenu11 -lX11 LIBX11_MACHINE LIBX11_SYSTEM -loldX
#else
XOBJ = x11term.o x11fns.o
LIBX = -lX11 LIBX11_MACHINE LIBX11_SYSTEM
***************
*** 241,246 ****
--- 265,273 ----
${lispdir}text-mode.elc ${lispdir}fill.elc \
${lispdir}c-mode.elc ${lispdir}isearch.elc \
${lispdir}replace.elc ${lispdir}abbrev.elc \
+ #ifdef LISP_FLOAT_TYPE
+ ${lispdir}float-sup.elc \
+ #endif LISP_FLOAT_TYPE
${lispdir}buff-menu.elc ${lispdir}subr.elc
/* just to be sure the sh is used */
***************
*** 247,253 ****
SHELL=/bin/sh
/* Construct full set of libraries to be linked. */
! LIBES = LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP $(LIBX) LIBS_DEBUG LIB_STANDARD
/* Enable recompilation of certain other files depending on system type. */
--- 274,281 ----
SHELL=/bin/sh
/* Construct full set of libraries to be linked. */
! LIBES = LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP $(LIBX) LIBS_DEBUG LIB_STANDARD\
! LIB_MATH
/* Enable recompilation of certain other files depending on system type. */
***************
*** 287,293 ****
#endif
temacs: MAKE_PARALLEL $(LOCALCPP) $(SHORT) $(STARTFILES) ${obj} ${otherobj} OBJECTS_SYSTEM OBJECTS_MACHINE
! $(LD) ${STARTFLAGS} ${LDFLAGS} -o temacs ${STARTFILES} ${obj} ${otherobj} OBJECTS_SYSTEM OBJECTS_MACHINE ${LIBES}
/* These are needed for C compilation, on the systems that need them */
#ifdef NEED_CPP
--- 315,322 ----
#endif
temacs: MAKE_PARALLEL $(LOCALCPP) $(SHORT) $(STARTFILES) ${obj} ${otherobj} OBJECTS_SYSTEM OBJECTS_MACHINE
! $(LD) ${STARTFLAGS} ${LDFLAGS} -o temacs~ ${STARTFILES} ${obj} ${otherobj} OBJECTS_SYSTEM OBJECTS_MACHINE ${LIBES}
! mv -f temacs~ temacs
/* These are needed for C compilation, on the systems that need them */
#ifdef NEED_CPP
*** lisp/bytecomp.el.orig Sat Mar 19 20:29:42 1988
--- lisp/bytecomp.el Fri Sep 2 23:01:59 1988
***************
*** 1,3 ****
--- 1,15 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: bytecomp.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Thu Nov 5 15:06:50 EST 1987 ;;
+ ;; Contents: Gnu bytecomp file, with changes for lisp floats ;;
+ ;; ;;
+ ;; Copyright (c) 1987 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compilation of Lisp code into byte code.
;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
***************
*** 221,234 ****
(set-buffer outbuffer)
(emacs-lisp-mode)
(erase-buffer)
! (while (save-excursion
! (set-buffer inbuffer)
! (while (progn (skip-chars-forward " \t\n\^l")
! (looking-at ";"))
! (forward-line 1))
! (not (eobp)))
! (setq sexp (read inbuffer))
! (print (byte-compile-file-form sexp) outbuffer))
(set-buffer outbuffer)
(goto-char 1)
;; In each defun or autoload, if there is a doc string,
--- 233,248 ----
(set-buffer outbuffer)
(emacs-lisp-mode)
(erase-buffer)
! ;; don't let floats get truncated in the process of printing them.
! (let ((float-output-format "20e"))
! (while (save-excursion
! (set-buffer inbuffer)
! (while (progn (skip-chars-forward " \t\n\^l")
! (looking-at ";"))
! (forward-line 1))
! (not (eobp)))
! (setq sexp (read inbuffer))
! (print (byte-compile-file-form sexp) outbuffer)))
(set-buffer outbuffer)
(goto-char 1)
;; In each defun or autoload, if there is a doc string,
*** lisp/float-sup.el.orig Thu Apr 20 11:52:19 1989
--- lisp/float-sup.el Fri Sep 2 23:03:21 1988
***************
*** 0 ****
--- 1,81 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: float-sup.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Mon Oct 26 09:12:18 EST 1987 ;;
+ ;; Contents: Flonum support routines and useful constants. ;;
+ ;; This file is just the tip of the of the iceberg, as ;;
+ ;; most of the flonum stuff is in the C code. ;;
+ ;; ;;
+ ;; Copyright (c) 1987 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;; GNU Emacs and this file "float-sup.el", is distributed in the hope
+ ;; that it will be useful, but WITHOUT ANY WARRANTY. No author or
+ ;; distributor accepts responsibility to anyone for the consequences of
+ ;; using it or for whether it serves any particular purpose or works at
+ ;; all, unless he says so in writing. Refer to the GNU Emacs General
+ ;; Public License for full details.
+
+ ;; Everyone is granted permission to copy, modify and redistribute GNU
+ ;; Emacs and float-sup.el, but only under the conditions described in the
+ ;; GNU Emacs General Public License. A copy of this license is supposed
+ ;; to have been given to you along with GNU Emacs so you can know your
+ ;; rights and responsibilities. It should be in a file named COPYING.
+ ;; Among other things, the copyright notice and this notice must be
+ ;; preserved on all copies.
+
+ ;; If you like my floating point hack, and would like other custom
+ ;; (non-proprietary) GnuEmacs extensions, let me know. I may be
+ ;; interested in doing it for you on a contract basis. -wsr
+
+ ;; Provide a meaningful error message if we are running on
+ ;; bare (non-float) emacs.
+ ;; Can't test for 'floatp since that may be defined by float-imitation
+ ;; packages like float.el in this very directory.
+
+ (if (fboundp 'integer-or-floatp)
+ nil
+ (error
+ "Can't load float-sup. You aren't running GnuEmacs with the Lisp_Float data type."))
+
+ ;; provide an easy hook to tell if we are running with floats or not.
+ (provide 'lisp-float-type)
+
+ ;; define pi and e via math-lib calls. (much less prone to killer typos.)
+ (defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...)")
+ (defconst e (exp 1) "The value of e (2.7182818...)")
+
+ ;; Careful when editing this file ... typos here will be hard to spot.
+ ;; (defconst pi 3.14159265358979323846264338327
+ ;; "The value of Pi (3.14159265358979323846264338327...)")
+
+ (defconst degrees-to-radians (/ pi 180.0)
+ "Degrees to radian conversion constant")
+ (defconst radians-to-degrees (/ 180.0 pi)
+ "Radian to degree conversion constant")
+
+ ;; these expand to a single multiply by a float
+ ;; when byte compiled
+
+ (defmacro degrees-to-radians (x)
+ "Convert ARG from degrees to radians."
+ (list '* (/ pi 180.0) x))
+ (defmacro radians-to-degrees (x)
+ "Convert ARG from radians to degrees."
+ (list '* (/ 180.0 pi) x))
+
+ ;; some readability macros.
+ ;; will eval arg several times,
+ ;; but is that a problem?
+
+ (defmacro squared (x)
+ "Return the square of ARG."
+ (list '* x x))
+ (defmacro cubed (x)
+ "Return the cube of ARG."
+ (list '* x x x))
+
*** lisp/lisp-mode.el.orig Sat Apr 9 02:20:12 1988
--- lisp/lisp-mode.el Fri Sep 2 23:02:09 1988
***************
*** 1,3 ****
--- 1,15 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: lisp-mode.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Thu Nov 5 23:36:37 EST 1987 ;;
+ ;; Contents: GNU lisp-mode file, with my changes for float support ;;
+ ;; ;;
+ ;; Copyright (c) 1987 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lisp mode, and its idiosyncratic commands.
;; Copyright (C) 1985 Free Software Foundation, Inc.
***************
*** 49,55 ****
(modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table)
! (modify-syntax-entry ?. "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?# "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\" "\" " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\\ "\\ " emacs-lisp-mode-syntax-table)
--- 61,73 ----
(modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table)
!
! ;; This needs to be changed for the float stuff.
! ;; I don't want to conditionalize this since it should
! ;; work the same way if floats are present or not. -wsr
! ;; (modify-syntax-entry ?. "' " lisp-mode-syntax-table)
! (modify-syntax-entry ?. "_ " lisp-mode-syntax-table)
!
(modify-syntax-entry ?# "' " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\" "\" " emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\\ "\\ " emacs-lisp-mode-syntax-table)
*** lisp/loadup.el.orig Tue Jul 5 14:00:45 1988
--- lisp/loadup.el Fri Sep 2 23:02:13 1988
***************
*** 1,3 ****
--- 1,15 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: loadup.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Thu Nov 5 11:44:26 EST 1987 ;;
+ ;; Contents: GNU loadup file, with my float code ;;
+ ;; ;;
+ ;; Copyright (c) 1987 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Load up standardly loaded Lisp files for Emacs.
;; This is loaded into a bare Emacs to make a dumpable one.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
***************
*** 63,68 ****
--- 75,85 ----
(progn
(garbage-collect)
(load "vms-patch")))
+ (if (fboundp 'integer-or-floatp) ; preload some constants and
+ (progn ; floating pt. functions if
+ (garbage-collect) ; we have float support.
+ (load "float-sup")))
+
;If you want additional libraries to be preloaded and their
;doc strings kept in the DOC file rather than in core,
*** lisp/sort.el.orig Mon May 30 17:53:34 1988
--- lisp/sort.el Fri Sep 2 23:02:17 1988
***************
*** 1,3 ****
--- 1,16 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: sort.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Wed May 18 12:48:23 EDT 1988 ;;
+ ;; Contents: Gnu emacs code, with patches to make it work with floats ;;
+ ;; ;;
+ ;; Copyright (c) 1988 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
;; Commands to sort text in an Emacs buffer.
;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
***************
*** 199,204 ****
--- 212,218 ----
(modify-syntax-entry ?\ " " table)
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\n " " table)
+ (modify-syntax-entry ?\. "_" table) ; for floating pt. numbers. -wsr
(setq sort-fields-syntax-table table)))
(defun sort-numeric-fields (field beg end)
***************
*** 216,222 ****
(buffer-substring
(point)
(save-excursion
! (skip-chars-forward "[0-9]")
(point))))))
nil))
--- 230,238 ----
(buffer-substring
(point)
(save-excursion
! ;; This is just wrong! Even without floats...
! ;; (skip-chars-forward "[0-9]")
! (forward-sexp 1)
(point))))))
nil))
*** lisp/startup.el.orig Sun Jul 10 14:43:37 1988
--- lisp/startup.el Fri Sep 2 23:02:20 1988
***************
*** 1,3 ****
--- 1,15 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: startup.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Thu Nov 5 16:58:42 EST 1987 ;;
+ ;; Contents: GNU startup file with floating point support ;;
+ ;; ;;
+ ;; Copyright (c) 1987 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Process Emacs shell arguments
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
***************
*** 163,168 ****
--- 175,185 ----
(unwind-protect
(progn
(insert (emacs-version)
+ ;; this next sexp can get nuked once FSF
+ ;; owns this code. -wsr
+ (if (featurep 'lisp-float-type)
+ "\nCopyright (C) 1987 Wolfgang Rupprecht."
+ "")
"
Copyright (C) 1988 Free Software Foundation, Inc.\n")
;; If keys have their default meanings,
***************
*** 187,192 ****
--- 204,218 ----
You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
Type \\[describe-distribution] for information on getting the latest version.
Type \\[help-with-tutorial] for a tutorial on using Emacs.")))
+ ;;;
+ ;;; And now a message for the lawyer-slimes of this world. -wsr
+ ;;;
+ (if (featurep 'lisp-float-type)
+ (insert "\n
+ This version of emacs contains a floating point data type allowing you
+ do calculations with real numbers, just like a calculator. This code
+ may not always yield the correct answers under all conditions.
+ YOU ARE RESPONSIBLE FOR CHECKING THE ANSWERS!\n"))
(set-buffer-modified-p nil)
(sit-for 120))
(erase-buffer)
*** lisp/subr.el.orig Sat May 16 02:16:25 1987
--- lisp/subr.el Fri Sep 2 23:02:22 1988
***************
*** 1,3 ****
--- 1,15 ----
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; ;;
+ ;; File: subr.el ;;
+ ;; Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> ;;
+ ;; Created: Thu Dec 31 14:01:32 EST 1987 ;;
+ ;; Contents: The Gnu subr.el file, with my float stuff ;;
+ ;; ;;
+ ;; Copyright (c) 1987 Wolfgang Rupprecht. ;;
+ ;; All rights reserved. ;;
+ ;; ;;
+ ;; $Log$ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
***************
*** 151,157 ****
(fset 'move-marker 'set-marker)
(fset 'eql 'eq)
(fset 'not 'null)
! (fset 'numberp 'integerp)
(fset 'rplaca 'setcar)
(fset 'rplacd 'setcdr)
(fset 'beep 'ding) ;preserve lingual purtity
--- 163,171 ----
(fset 'move-marker 'set-marker)
(fset 'eql 'eq)
(fset 'not 'null)
! (if (fboundp 'integer-or-floatp)
! (fset 'numberp 'integer-or-floatp)
! (fset 'numberp 'integerp))
(fset 'rplaca 'setcar)
(fset 'rplacd 'setcdr)
(fset 'beep 'ding) ;preserve lingual purtity
*** src/fns.c.orig Sat Feb 2 18:41:23 1991
--- src/fns.c Thu Apr 6 22:25:38 1989
***************
*** 1,15 ****
- /******************************************************************************
- * *
- * File: fns.c *
- * Author: Wolfgang S. Rupprecht <wolfgang@wsrcc.com> *
- * Created: Sat Feb 2 18:40:56 EST 1991 *
- * Contents: Gnu fns.c with my floating pt additions *
- * *
- * Copyright (c) 1991 Wolfgang S. Rupprecht. *
- * All rights reserved. *
- * *
- * $Header$ *
- ******************************************************************************/
/* Random utility Lisp functions.
Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
--- 1,3 ----
***************
*** 842,854 ****
return Qnil;
return Qt;
}
- #ifdef LISP_FLOAT_TYPE
- if (XTYPE(o1) == Lisp_Float)
- {
- if (XFLOAT(o1)->data == XFLOAT(o2)->data)
- return Qt;
- }
- #endif LISP_FLOAT_TYPE
return Qnil;
}
--- 830,835 ----
--
Wolfgang Rupprecht wolfgang@wsrcc.com (or) uunet!wsrcc!wolfgang
Snail Mail Address: Box 6524, Alexandria, VA 22306-0524
Technical Details
Message-ID:
<1991Jul2.163607.11200@wsrcc.com>Path:
arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!wsrcc.com!wolfgangReferences:
<21029@sdcc6.ucsd.edu> <1991Jun28.132256.7090@cs.utk.edu> <21065@sdcc6.ucsd.edu>Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103b8b,523e632609471bec X-Google-Attributes: gid103b8b,public X-Google-ArrivalTime: 1991-07-02 11:33:21 PST Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!wsrcc.com!wolfgang From: wolfgang@wsrcc.com (Wolfgang S. Rupprecht) Newsgroups: gnu.emacs.help Subject: Re: Floating point in Emacs Lisp (part 2 of 2) Keywords: FLOAT EMACS LISP Message-ID: <1991Jul2.163607.11200@wsrcc.com> Date: 2 Jul 91 16:36:07 GMT References: <21029@sdcc6.ucsd.edu> <1991Jun28.132256.7090@cs.utk.edu> <21065@sdcc6.ucsd.edu> Organization: Wolfgang S Rupprecht Computer Consulting, Washington DC. Lines: 1008