Description: <short summary of the patch>
 TODO: Put a short summary on the line above and replace this paragraph
 with a longer explanation of this change. Complete the meta-information
 with other relevant fields (see below for details). To make it easier, the
 information below has been extracted from the changelog. Adjust it or drop
 it.
 .
 gcl27 (2.7.0-21) unstable; urgency=high
 .
   * Version_2_7_0pre24
   * Bug fix: "recent libc6-dev change causes XDR support to be dropped",
     thanks to Aurelien Jarno (Closes: #1065207).
Author: Camm Maguire <camm@debian.org>
Bug-Debian: https://bugs.debian.org/1065207

---
The information above should follow the Patch Tagging Guidelines, please
checkout https://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: (upstream|backport|vendor|other), (<patch-url>|commit:<commit-id>)
Bug: <upstream-bugtracker-url>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: (no|not-needed|<patch-forwarded-url>)
Applied-Upstream: <version>, (<commit-url>|commit:<commid-id>)
Reviewed-By: <name and email of someone who approved/reviewed the patch>
Last-Update: 2024-03-16

--- gcl27-2.7.0.orig/cmpnew/gcl_cmpenv.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpenv.lsp
@@ -376,12 +376,11 @@
 	  (push (cons (cadr l) tp) cps)))))
 
   (let ((s (> (body-safety others) (if (top-level-src-p) 0 1))))
-    (when cps
-      (unless s
-;	  (setq body `((let ,(mapcar (lambda (x) (list (car x) (car x))) cps) ,@body)))
-	(setq ts (nconc cps ts))))
     (when ctps
-      (setq body (nconc (if s ctps (mapcan (lambda (x) (when (eq (car x) 'assert) (list (cadr x)))) ctps)) body))))
+      (setq body (nconc (if s ctps
+			    (nconc (mapcar (lambda (x) `(infer-tp ,(car x) ,(cdr x))) cps)
+				   (mapcan (lambda (x) (when (eq (car x) 'assert) (list (cadr x)))) ctps)))
+			body))))
   (values body ss ts is others (when doc-p doc) cps)))
 
 ;; (defun c1body (body doc-p &aux ss is ts others cps)
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpfun.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpfun.lsp
@@ -415,15 +415,15 @@
 	((and (consp x) (eq (car x) 'the)) (second x))
 	(t t)))
 
-(defun co1schar (f args)
-  (declare (ignore f))
-  (and (listp (car args)) (not *safe-compile*)
-	(cdr args)
-	(eq (caar args) 'symbol-name)
-	(c1expr `(aref (the string ,(second (car args)))
-			,(second args)))))
+;; (defun co1schar (f args)
+;;   (declare (ignore f))
+;;   (and (listp (car args)) (not *safe-compile*)
+;; 	(cdr args)
+;; 	(eq (caar args) 'symbol-name)
+;; 	(c1expr `(aref (the string ,(second (car args)))
+;; 			,(second args)))))
 
-(si::putprop 'schar 'co1schar 'co1)
+;; (si::putprop 'schar 'co1schar 'co1)
 
 (si::putprop 'cons 'co1cons 'co1)
 ;; turn repetitious cons's into a list*
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpinline.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpinline.lsp
@@ -990,6 +990,7 @@
 (si:putprop 'inline 'wt-inline 'wt-loc)
 (si:putprop 'inline-cond 'wt-inline-cond 'wt-loc)
 (si:putprop 'inline-fixnum 'wt-inline-fixnum 'wt-loc)
+(si:putprop 'inline-string 'wt-inline-string 'wt-loc)
 (si:putprop 'inline-integer 'wt-inline-integer 'wt-loc)
 (si:putprop 'inline-character 'wt-inline-character 'wt-loc)
 (si:putprop 'inline-char 'wt-inline-char 'wt-loc)
@@ -1076,6 +1077,11 @@
   (declare (ignore flags))
   (wt-inline-loc fun locs))
 
+(defun wt-inline-string (flags fun locs)
+  (declare (ignore flags))
+  (when (zerop *space*) (wt "CMP"))
+  (wt "make_simple_string(") (wt-inline-loc fun locs) (wt ")"))
+
 (defun wt-inline-cond (flags fun locs)
   (declare (ignore flags))
   (wt "(") (wt-inline-loc fun locs) (wt "?Ct:Cnil") (wt ")"))
--- gcl27-2.7.0.orig/cmpnew/gcl_cmploc.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmploc.lsp
@@ -90,8 +90,10 @@
 (si:putprop 'cadr 'wt-cadr 'wt-loc)
 (si:putprop 'vs-base 'wt-vs-base 'wt-loc)
 (si:putprop 'fixnum-value 'wt-fixnum-value 'wt-loc)
+(si:putprop 'string-value 'wt-string-value 'wt-loc)
 (si:putprop 'vs-address 'wt-vs-address 'wt-loc)
 (si:putprop 'fixnum-loc 'wt-fixnum-loc 'wt-loc)
+(si:putprop 'string-loc 'wt-string-loc 'wt-loc)
 (si:putprop 'integer-loc 'wt-integer-loc 'wt-loc)
 (si:putprop 'character-value 'wt-character-value 'wt-loc)
 (si:putprop 'character-loc 'wt-character-loc 'wt-loc)
@@ -322,7 +324,31 @@
 (defun wt-fixnum-value (vv fixnum-value)
   (if vv (wt (vv-str vv))
     (wt "make_fixnum(" fixnum-value ")")))
-        
+
+(let ((fk (kind-tp 'string)))
+  (defun wt-string-loc (loc)
+    (cond ((and (consp loc)
+		(eq (car loc) 'var)
+		(eq (var-kind (cadr loc)) fk))
+           (wt "V" (var-loc (cadr loc))))
+          ((and (consp loc) (eq (car loc) 'INLINE-STRING))
+           (wt-inline-loc (caddr loc) (cadddr loc)))
+          ((and (consp loc) (eq (car loc) 'string-value))
+           (wt (caddr loc)))
+          (t (wt "object_to_string(" loc ")")))))
+
+(let ((fk (kind-tp 'string)))
+  (defun string-loc-p (loc);FIXME check all these unneeded
+    (and (consp loc)
+	 (or (and (eq (car loc) 'var)
+                  (eq (var-kind (cadr loc)) fk))
+             (eq (car loc) 'INLINE-STRING)
+             (eq (car loc) 'string-value)))))
+
+(defun wt-string-value (vv string-value);FIXME check unneeded
+       (declare (ignore string-value))
+       (wt (vv-str vv)))
+
 (defun wt-vs-address (v i)
   (wt "(fixnum)(" v "+" i ")"))
 
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpopt.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpopt.lsp
@@ -968,8 +968,8 @@
    (get 'svref 'inline-unsafe))
 
 ;;SYMBOL-NAME
- (push '((t) string #.(flags ans rfa)"symbol_name(#0)")
-   (get 'symbol-name 'inline-always))
+ ;; (push '((t) string #.(flags ans rfa)"symbol_name(#0)")
+ ;;   (get 'symbol-name 'inline-always))
 
 ;;SYMBOL-VALUE
 (push '((t) t #.(flags) "((#0)->s.s_dbind)")
@@ -1286,4 +1286,4 @@
  (s :keyword)
  (let ((z (get s 'lisp-type :opaque)))
    (unless (eq z :opaque)
-     (setf (get s 'cmp-lisp-type) (cmp-norm-tp z)))))
+     (setf (get s 'cmp-lisp-type) (or (cadr (assoc (get s 'lisp-type) *c-types*)) (cmp-norm-tp z))))))
--- gcl27-2.7.0.orig/cmpnew/gcl_cmptop.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmptop.lsp
@@ -2176,13 +2176,12 @@
 (defvar *compiling-ordinary* nil)
 
 (defun compile-ordinary-p (form)
-  (when (consp form)
-    (or (eq (car form) 'fset)
-	(compile-ordinary-p (car form))
-	(compile-ordinary-p (cdr form)))))
+  (typecase form
+    ((cons (member lambda) (cons proper-list proper-list)) t)
+    (cons (or (compile-ordinary-p (car form)) (compile-ordinary-p (cdr form))))))
 
 (defun compile-ordinaryp (form)
-  (compile-ordinary-p (pd 'cmp-anon nil (list form))))
+  (compile-ordinary-p (cddr (pd 'cmp-anon nil (list form)))))
 
 (defun t1ordinary (form)
   (cond ((unless *compiling-ordinary*
@@ -2353,7 +2352,10 @@
 	 (m (if (symbolp m) (string-downcase m) m))
 	 (rt (intern (symbol-name (if cp (car c) lt)) 'keyword))
 	 (tps (mapcar (lambda (x) (intern (string (if (consp x) (car x) x)) 'keyword)) args))
-	 (decl (reduce (lambda (y x) (strcat y (if (> (length y) 0) "," "") x)) args :initial-value ""))
+	 (decl (reduce (lambda (y x)
+			 (strcat y (if (> (length y) 0) "," "")
+				 (cdr (assoc (get x 'cmp-lisp-type) +defentry-c-rep-alist+))))
+		       tps :initial-value ""))
 	 (decl (concatenate 'string (string-downcase rt) " " m "(" decl ");"))
 	 (decl (if st "" decl))
 	 (syms (mapcar (lambda (x) (declare (ignore x)) (pop tsyms)) args)))
--- gcl27-2.7.0.orig/cmpnew/gcl_cmptype.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmptype.lsp
@@ -115,31 +115,35 @@
 
 (defvar *c-types* (mapcar (lambda (x &aux (y (pop x)))
 			    (list* y (cmp-norm-tp y) x))
-`((nil                   nil                nil                nil                ""          ""                "object ")
-  (null                  nil                nil                inline-cond        ""          ""                "object ")
-  (true                  nil                nil                inline-cond        ""          ""                "object ")
-  (boolean               nil                nil                inline-cond        ""          ""                "object ")
-  (character             wt-character-loc   nil                inline-character   "char_code" "code_char"       "int8_t ")
-  (bit                   wt-char-loc        return-char        inline-char        "fix"       "make_fixnum"     "int8_t ")
-  (non-negative-char     wt-char-loc        return-char        inline-char        "fix"       "make_fixnum"     "int8_t ")
-  (unsigned-char         wt-char-loc        return-char        inline-char        "fix"       "make_fixnum"     "uint8_t ")
-  (signed-char           wt-char-loc        return-char        inline-char        "fix"       "make_fixnum"     "int8_t ")
-  (char                  wt-char-loc        return-char        inline-char        "fix"       "make_fixnum"     "int8_t ")
-  (non-negative-short    wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "int16_t ")
-  (unsigned-short        wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "int16_t ")
-  (signed-short          wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "uint16_t ")
-  (non-negative-int      wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "int32_t ")
-  (unsigned-int          wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "int32_t ")
-  (signed-int            wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "uint32_t ")
-  (non-negative-fixnum   wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "fixnum ")
-  (fixnum                wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"       "make_fixnum"     "fixnum ")
-  (short-float           wt-short-float-loc return-short-float inline-short-float "sf"        "make_shortfloat" "float ")
-  (long-float            wt-long-float-loc  return-long-float  inline-long-float  "lf"        "make_longfloat"  "double ") 
-  (creal                 nil                nil                nil                ""          ""                "")
-  (fcomplex              wt-fcomplex-loc    return-fcomplex    inline-fcomplex    "sfc"       "make_fcomplex"   "fcomplex ")
-  (dcomplex              wt-dcomplex-loc    return-dcomplex    inline-dcomplex    "lfc"       "make_dcomplex"   "dcomplex ")
-  (cnum                  nil                nil                nil                ""          ""                "")
-  (t                     wt-loc             return-object      inline             ""          ""                "object "))))
+`((nil                   nil                nil                nil                ""                 ""                   "object ")
+  (null                  nil                nil                inline-cond        ""                 ""                   "object ")
+  (true                  nil                nil                inline-cond        ""                 ""                   "object ")
+  (boolean               nil                nil                inline-cond        ""                 ""                   "object ")
+  (character             wt-character-loc   nil                inline-character   "char_code"        "code_char"          "int8_t ")
+  (bit                   wt-char-loc        return-char        inline-char        "fix"              "make_fixnum"        "int8_t ")
+  (non-negative-char     wt-char-loc        return-char        inline-char        "fix"              "make_fixnum"        "int8_t ")
+  (unsigned-char         wt-char-loc        return-char        inline-char        "fix"              "make_fixnum"        "uint8_t ")
+  (signed-char           wt-char-loc        return-char        inline-char        "fix"              "make_fixnum"        "int8_t ")
+  (char                  wt-char-loc        return-char        inline-char        "fix"              "make_fixnum"        "int8_t ")
+  (non-negative-short    wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "int16_t ")
+  (unsigned-short        wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "uint16_t ")
+  (signed-short          wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "int16_t ")
+  (short                 wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "int16_t ")
+  (non-negative-int      wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "int32_t ")
+  (unsigned-int          wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "uint32_t ")
+  (signed-int            wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "int32_t ")
+  (int                   wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "int32_t ")
+  (non-negative-fixnum   wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "fixnum ")
+  (fixnum                wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "fixnum ")
+  (long                  wt-fixnum-loc      return-fixnum      inline-fixnum      "fix"              "make_fixnum"        "fixnum ")
+  (short-float           wt-short-float-loc return-short-float inline-short-float "sf"               "make_shortfloat"    "float ")
+  (long-float            wt-long-float-loc  return-long-float  inline-long-float  "lf"               "make_longfloat"     "double ")
+  (creal                 nil                nil                nil                ""                 ""                   "")
+  (fcomplex              wt-fcomplex-loc    return-fcomplex    inline-fcomplex    "sfc"              "make_fcomplex"      "fcomplex ")
+  (dcomplex              wt-dcomplex-loc    return-dcomplex    inline-dcomplex    "lfc"              "make_dcomplex"      "dcomplex ")
+  (cnum                  nil                nil                nil                ""                 ""                   "")
+  (string                wt-string-loc      return-string      inline-string      "object_to_string" "make_simple_string" "char *")
+  (t                     wt-loc             return-object      inline             ""                 ""                   "object "))))
 
 
 (defconstant +c-global-arg-types-syms+   `(fixnum)) ;FIXME (long-float short-float) later
@@ -150,7 +154,7 @@
 (defvar +value-types+
   (mapcar (lambda (x)
 	    (cons (cadr (assoc x *c-types*)) (get-sym `(,x "-VALUE"))))
-	  (cons 'character +c-local-var-types-syms+)))
+	  (list* 'character +c-local-var-types-syms+)))
 
 
 (defconstant +return-alist+
@@ -164,7 +168,7 @@
     ,@(mapcar (lambda (x)
 		(cons (cadr (assoc x *c-types*))
 		      (get-sym `("WT-" ,x "-LOC"))))
-	      +c-local-var-types-syms+)))
+	      (cons 'string +c-local-var-types-syms+))))
 
 (defconstant +inline-types-alist+
   `(,@(mapcar (lambda (x)
@@ -173,7 +177,7 @@
 			    ((t) 'inline)
 			    (boolean 'inline-cond)
 			    (otherwise (get-sym `("INLINE-" ,x))))))
-	      (list* 'boolean t +c-local-var-types-syms+))))
+	      (list* 'boolean t 'string +c-local-var-types-syms+))))
 
 (defconstant +c-global-arg-types+
   (mapcar (lambda (x) (cadr (assoc x *c-types*))) +c-global-arg-types-syms+))
@@ -188,14 +192,14 @@
   (nconc
    (mapcar (lambda (x &aux (z (assoc x *c-types*)))
 	     (cons (cadr z) (seventh z)))
-	   '(char fixnum character short-float long-float fcomplex dcomplex))
+	   (list* 'character 'string +c-local-var-types-syms+))
    `((object . ""))))
 
 (defconstant +to-c-var-alist+
   (nconc
    (mapcar (lambda (x &aux (z (assoc x *c-types*)))
 	     (cons (cadr z) (sixth z)))
-	   '(char fixnum character short-float long-float fcomplex dcomplex))
+	   (list* 'character 'string +c-local-var-types-syms+))
    `((object . ""))))
 
 (defconstant +c-type-string-alist+
@@ -213,10 +217,13 @@
   (nconc
    (mapcar (lambda (x &aux (z (assoc x *c-types*)))
 	     (cons (cadr z) (eighth z)))
-	   `(nil char fixnum long-float short-float fcomplex dcomplex))
+	   (list* nil +c-local-var-types-syms+))
    `((object . "object "))))
 
-
+(defconstant +defentry-c-rep-alist+
+  (mapcar (lambda (x &aux (z (assoc x *c-types*)))
+	    (cons (cadr z) (eighth z)))
+	  '(char #+64bit signed-int fixnum short-float long-float string t)))
 
 (defconstant +cmp-type-alist+
   (mapcar (lambda (x) (cons (cmp-norm-tp (car x)) (cdr x))) +type-alist+))
@@ -1147,6 +1154,7 @@
     (when (constant-type-p b)
       (object-type (funcall f b)))))
 (dolist (l 'si::(expand-array-element-type
+		 cmp-norm-tp sequence-tp-nonsimple-p sequence-tp-lengths make-sequence-element-type
 		 expand-deftype sdata-includes
 		 lookup-simple-typep-fn lookup-typep-fn))
   (setf (get l 'compiler::c1no-side-effects) t)
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpvar.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpvar.lsp
@@ -369,9 +369,6 @@
 	     (set-var-reffed var)
 	     (keyed-cmpnote (list 'var-ref (var-name var))
 			    "Making variable ~s reference with barrier ~s" (var-name var) (if ccb 'cb (if clb 'lb)))
-	     (when (or ccb clb)
-	       (unless (eq (var-kind var) 'lexical)
-		 (cmpwarn "Cross closure reference to non-lexical variable ~s, which is likely not what you want" (var-name var))))
 	     (return-from c1vref (list* var (if (eq (var-kind var) 'lexical) (list ccb clb) '(nil nil))))))))
 
 ;; (defun c1vref (name &optional setq &aux ccb clb)
--- gcl27-2.7.0.orig/git.tag
+++ gcl27-2.7.0/git.tag
@@ -1,2 +1,2 @@
-"Version_2_7_0pre23"
+"Version_2_7_0pre24"
 
--- gcl27-2.7.0.orig/h/compdefs.h
+++ gcl27-2.7.0/h/compdefs.h
@@ -92,3 +92,4 @@ is_imm_fix(x)
 aref1
 OBJ_ALIGNED_STACK_ALLOC(x)
 NO_RETURN
+CHAR_SIZE
--- gcl27-2.7.0.orig/h/compprotos.h
+++ gcl27-2.7.0/h/compprotos.h
@@ -99,3 +99,4 @@ fixnum fixnum_expt(fixnum, fixnum);
 int gcl_puts(const char *);
 int setjmp();
 int _setjmp();
+char *object_to_string(object);
--- gcl27-2.7.0.orig/h/fixnum.h
+++ gcl27-2.7.0/h/fixnum.h
@@ -5,11 +5,11 @@
 
 #define      make_imm_fixnum(a_)        ((object)(fixnum)a_)
 #define       fix_imm_fixnum(a_)        ((fixnum)a_)
-#define      mark_imm_fixnum(a_)        ((a_)=((object)((fixnum)(a_)+(LOW_IM_FIX<<1))))
-#define    unmark_imm_fixnum(a_)        ((a_)=((object)((fixnum)(a_)-(LOW_IM_FIX<<1))))
-#define        is_imm_fixnum(a_)        ((fixnum)(a_)<(fixnum)OBJNULL)
-#define is_unmrkd_imm_fixnum(a_)        ((fixnum)(a_)<LOW_IM_FIX)
-#define is_marked_imm_fixnum(a_)        (is_imm_fixnum(a_)*!is_unmrkd_imm_fixnum(a_))
+#define      mark_imm_fixnum(a_)        ({if (is_unmrkd_imm_fixnum(a_)) (a_)=((object)((fixnum)(a_)+(LOW_IM_FIX<<1)));})
+#define    unmark_imm_fixnum(a_)        ({if (is_marked_imm_fixnum(a_)) (a_)=((object)((fixnum)(a_)-(LOW_IM_FIX<<1)));})
+#define        is_imm_fixnum(a_)        ((fixnum)(a_)>=-LOW_IM_FIX && ((fixnum)(a_)<(fixnum)OBJNULL))/* (labs((fixnum)(a_))<=(fixnum)OBJNULL) */
+#define is_unmrkd_imm_fixnum(a_)        is_imm_fix(a_)/* (labs((fixnum)(a_))<=LOW_IM_FIX) */
+#define is_marked_imm_fixnum(a_)        ((fixnum)(a_)>=LOW_IM_FIX && ((fixnum)(a_)<(fixnum)OBJNULL))/* (is_imm_fixnum(a_)&&!is_unmrkd_imm_fixnum(a_)) */
 #define           is_imm_fix(a_)        INT_IN_BITS(a_,LOW_SHFT-1)
 #elif defined (IM_FIX_BASE) && defined(IM_FIX_LIM)
 #define      make_imm_fixnum(a_)        ((object)((a_)+(IM_FIX_BASE+(IM_FIX_LIM>>1))))
--- gcl27-2.7.0.orig/h/lu.h
+++ gcl27-2.7.0/h/lu.h
@@ -9,22 +9,24 @@ typedef unsigned long   ufixnum;
 #ifndef WORDS_BIGENDIAN
 
 /* high bit must be clear to distinguish from high immediate fixnum*/
-#define FRSTWRD(t_,b_,a_...) ufixnum    e:1,m:1,f:1,    t_:5,t:5,st:3,a_,b_
-#define FIRSTWORD            ufixnum    e:1,m:1,f:1,    tt:5,t:5,st:3,w:LM(16)
-#define FSTPWORD             ufixnum  emf:3,            tp:10,   st:3,w:LM(16)
-#define MARKWORD             ufixnum    e:1,   mf:2,    tt:5,t:5,x:LM(13)
-#define SGCMWORD             ufixnum    e:1,mf:2,       tt:5,t:5,x:LM(13)
-#define TYPEWORD             ufixnum  emf:3,            tt:5,t:5,x:LM(13)
+#define FRSTWRD(t_,b_,a_...) ufixnum    e:1,m:1,f:1,    t_:5,t:5,st:3,a_,b_,h:1
+#define FRSTWRDF(t_,a_...)   ufixnum    e:1,m:1,f:1,    t_:5,t:5,st:3,a_,h:1
+#define FIRSTWORD            ufixnum    e:1,m:1,f:1,    tt:5,t:5,st:3,w:LM(17),h:1
+#define FSTPWORD             ufixnum  emf:3,            tp:10,   st:3,w:LM(17),h:1
+#define MARKWORD             ufixnum    e:1,   mf:2,    tt:5,t:5,xx:LM(14),h:1
+#define SGCMWORD             ufixnum    e:1,mf:2,       tt:5,t:5,xx:LM(14),h:1
+#define TYPEWORD             ufixnum  emf:3,            tt:5,t:5,xx:LM(14),h:1
 
 #else
 
 /* high bit must be clear to distinguish from high immediate fixnum*/
-#define FRSTWRD(t_,b_,a_...) ufixnum b_,a_,   st:3,t:5,t_:5,    f:1,m:1,e:1
-#define FIRSTWORD            ufixnum w:LM(16),st:3,t:5,tt:5,    f:1,m:1,e:1
-#define FSTPWORD             ufixnum w:LM(16),st:3,tp:10,             emf:3
-#define MARKWORD             ufixnum x:LM(13),     t:5,tt:5,       mf:2,e:1
-#define SGCMWORD             ufixnum x:LM(13),     t:5,tt:5,       mf:2,e:1
-#define TYPEWORD             ufixnum x:LM(13),     t:5,tt:5,          emf:3
+#define FRSTWRD(t_,b_,a_...) ufixnum h:1,b_,a_,   st:3,t:5,t_:5,    f:1,m:1,e:1
+#define FRSTWRDF(t_,a_...)   ufixnum h:1,a_,   st:3,t:5,t_:5,    f:1,m:1,e:1
+#define FIRSTWORD            ufixnum h:1,w:LM(17),st:3,t:5,tt:5,    f:1,m:1,e:1
+#define FSTPWORD             ufixnum h:1,w:LM(17),st:3,tp:10,             emf:3
+#define MARKWORD             ufixnum h:1,w:LM(14),     t:5,tt:5,       mf:2,e:1
+#define SGCMWORD             ufixnum h:1,w:LM(14),     t:5,tt:5,       mf:2,e:1
+#define TYPEWORD             ufixnum h:1,w:LM(14),     t:5,tt:5,          emf:3
 
 #endif
 
@@ -234,30 +236,28 @@ struct hashtable {           /*  hash ta
 #if SIZEOF_LONG == 8
 #ifdef WORDS_BIGENDIAN
 #define ARRAYWORD(b_,c_)						\
-  FRSTWRD(J(b_,J(c_,elttype)),						\
-	  pd2:LM(63),							\
-	  J(b_,J(c_,eltmode)):3,					\
-          J(b_,J(c_,dim)):ARRAY_DIMENSION_BITS,				\
-	  J(b_,J(c_,hasfillp)):1,					\
-	  J(b_,J(c_,writable)):1,					\
-	  J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
-	  pd1:1,							\
-	  J(b_,J(c_,adjustable)):1,					\
-	  J(b_,J(c_,offset)):3,						\
-	  J(b_,J(c_,eltsize)):3)
+  FRSTWRDF(J(b_,J(c_,elttype)),						\
+	   J(b_,J(c_,eltmode)):3,					\
+	   J(b_,J(c_,dim)):ARRAY_DIMENSION_BITS,			\
+	   J(b_,J(c_,hasfillp)):1,					\
+	   J(b_,J(c_,writable)):1,					\
+	   J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
+	   pd1:1,							\
+	   J(b_,J(c_,adjustable)):1,					\
+	   J(b_,J(c_,offset)):3,					\
+	   J(b_,J(c_,eltsize)):3)
 #else
 #define ARRAYWORD(b_,c_)						\
-  FRSTWRD(J(b_,J(c_,elttype)),						\
-	  pd2:LM(63),							\
-	  J(b_,J(c_,hasfillp)):1,					\
-	  J(b_,J(c_,writable)):1,					\
-	  J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
-	  pd1:1,							\
-	  J(b_,J(c_,adjustable)):1,					\
-	  J(b_,J(c_,offset)):3,						\
-	  J(b_,J(c_,eltsize)):3,					\
-	  J(b_,J(c_,eltmode)):3,					\
-	  J(b_,J(c_,dim)):ARRAY_DIMENSION_BITS)
+  FRSTWRDF(J(b_,J(c_,elttype)),						\
+	   J(b_,J(c_,hasfillp)):1,					\
+	   J(b_,J(c_,writable)):1,					\
+	   J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
+	   pd1:1,							\
+	   J(b_,J(c_,adjustable)):1,					\
+	   J(b_,J(c_,offset)):3,					\
+	   J(b_,J(c_,eltsize)):3,					\
+	   J(b_,J(c_,eltmode)):3,					\
+	   J(b_,J(c_,dim)):ARRAY_DIMENSION_BITS)
 #endif
 
 #define atem(a_,b_,c_)				\
@@ -267,14 +267,13 @@ struct hashtable {           /*  hash ta
 #else
 
 #define ARRAYWORD(b_,c_)						\
-  FRSTWRD(J(b_,J(c_,elttype)),						\
-	  pad:LM(31),							\
-	  J(b_,J(c_,hasfillp)):1,					\
-	  J(b_,J(c_,adjustable)):1,					\
-	  J(b_,J(c_,writable)):1,					\
-	  J(b_,J(c_,offset)):3,						\
-	  J(b_,J(c_,eltsize)):3,					\
-	  J(b_,J(c_,rank)):ARRAY_RANK_BITS)
+  FRSTWRDF(J(b_,J(c_,elttype)),						\
+	   J(b_,J(c_,hasfillp)):1,					\
+	   J(b_,J(c_,adjustable)):1,					\
+	   J(b_,J(c_,writable)):1,					\
+	   J(b_,J(c_,offset)):3,					\
+	   J(b_,J(c_,eltsize)):3,					\
+	   J(b_,J(c_,rank)):ARRAY_RANK_BITS)
 
 #define atem(a_,b_,c_)					\
   ARRAYWORD(b_,c_);					\
@@ -462,14 +461,14 @@ struct function {
 
   FRSTWRD(tt,
 #if SIZEOF_LONG == 8
-	  fw:LM(38),
+	  fw:LM(39),
 	  fun_minarg:6,    /* required arguments */
 	  fun_maxarg:6,    /* maximum arguments */
 	  pd:4,
 	  fun_neval:5,     /* maximum extra values set */
 	  fun_vv:1         /* variable number of values */
 #else
-	  fw:LM(28),
+	  fw:LM(29),
 	  fun_minarg:6,    /* required arguments */
 	  fun_maxarg:6     /* maximum arguments */
 #endif
@@ -492,7 +491,7 @@ struct function {
 struct cfdata {
 
   FRSTWRD(tt,
-	  cfw:LM(17),
+	  cfw:LM(18),
 	  cfd_prof:1       /* profiling */
 	  );
 
--- gcl27-2.7.0.orig/h/type.h
+++ gcl27-2.7.0/h/type.h
@@ -61,7 +61,7 @@ enum type {
 #define mark(a_)                 if (imcdr(a_)) mark_imm_fixnum(Zcdr(a_)); else (a_)->d.m=1
 #define unmark(a_)               if (imcdr(a_)) unmark_imm_fixnum(Zcdr(a_)); else (a_)->d.m=0
 #define is_free(a_)              (!is_imm_fixnum(a_) && !imcdr(a_) && (a_)->d.f)
-#define make_free(a_)            ({(a_)->fw=0;(a_)->d.f=1;(a_)->fw|=(fixnum)OBJNULL;})/*set_type_of(a_,t_other)*/
+#define make_free(a_)            ({(a_)->fw=0;(a_)->d.f=1;(a_)->d.h=(fixnum)OBJNULL ? 1 : 0;})
 #define make_unfree(a_)          {(a_)->d.f=0;}
 
 #ifdef WIDE_CONS
@@ -81,7 +81,7 @@ enum type {
 #endif
 
 #define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);_x->d.f=0;\
-    if (TYPEWORD_TYPE_P(_y)) {_x->d.e=1;_x->d.t=_y;_x->fw|=(fixnum)OBJNULL;}})
+      if (TYPEWORD_TYPE_P(_y)) {_x->d.e=1;_x->d.t=_y;_x->d.h=(fixnum)OBJNULL ? 1 : 0;}})
 
 #ifndef WIDE_CONS
 
--- gcl27-2.7.0.orig/lsp/gcl_cp.lsp
+++ gcl27-2.7.0/lsp/gcl_cp.lsp
@@ -195,7 +195,7 @@
 
 (defun funcallable-symbol-p (s)
   (and (symbolp s)
-       (/= (si::address (c-symbol-gfdef s)) 0)
+       (/= (si::address (c-symbol-gfdef s)) +objnull+)
        (= (c-symbol-mflag s) 0)
        (= (c-symbol-sfdef s) (si::address nil))))
 (setf (get 'funcallable-symbol-p 'cmp-inline) t)
--- gcl27-2.7.0.orig/lsp/gcl_iolib.lsp
+++ gcl27-2.7.0/lsp/gcl_iolib.lsp
@@ -97,6 +97,13 @@
 
 
 
+(defvar *sosm* (make-string-output-stream))
+
+(defun get-sosm nil
+  (when *sosm*
+    (setf (fill-pointer (c-stream-object0 *sosm*)) 0)
+    *sosm*))
+
 (defmacro with-output-to-string ((var &optional string &key element-type) . body)
   (declare (optimize (safety 2)))
   (let ((e (sgen "WITH-OUTPUT-TO-STRING")))
@@ -105,7 +112,8 @@
       `(let* ((,e ,element-type)
 	      (,var ,(if string
 			 `(make-string-output-stream-from-string ,string)
-			 `(make-string-output-stream :element-type ,e))))
+			 `(or (get-sosm) (make-string-output-stream :element-type ,e))))
+	      (*sosm* (unless (eq ,var *sosm*) *sosm*)))
 	 ,@decls
 	 ,@ctps
 	 ,@body
@@ -143,20 +151,17 @@
 		  ((:right-margin    *print-right-margin*)     *print-right-margin*))
   (write-int x stream))
 
-(defun write-to-string (x &rest r &aux (stream (make-string-output-stream)))
+(defun write-to-string (x &rest r &aux (stream (or (get-sosm) (make-string-output-stream)))(*sosm* nil))
   (declare (optimize (safety 1))(dynamic-extent r))
   (apply 'write x :stream stream r)
   (get-output-stream-string stream))
 
-(defun prin1-to-string (object
-                        &aux (stream (make-string-output-stream)))
+(defun prin1-to-string (object &aux (stream (or (get-sosm) (make-string-output-stream)))(*sosm* nil))
   (declare (optimize (safety 2)))
   (prin1 object stream)
   (get-output-stream-string stream))
 
-
-(defun princ-to-string (object
-                        &aux (stream (make-string-output-stream)))
+(defun princ-to-string (object &aux (stream (or (get-sosm) (make-string-output-stream)))(*sosm* nil))
   (declare (optimize (safety 2)))
   (princ object stream)
   (get-output-stream-string stream))
@@ -505,4 +510,3 @@
      (let ((n (get-byte-stream-nchars x))
 	   (p (case pos (:start 0) (:end (file-length x)) (otherwise pos))))
        (if pos-p (when (fseek x (* p n)) p) (/ (ftell x) n))))))
-
--- gcl27-2.7.0.orig/lsp/gcl_lr.lsp
+++ gcl27-2.7.0/lsp/gcl_lr.lsp
@@ -113,7 +113,7 @@
 
 (defbltin clzl)
 (defbltin ctzl)
-;(defbltin popcountl)
+(defbltin popcountl)
 (defbltin parityl)
 (defbltin ffsl)
 
@@ -146,10 +146,10 @@
       (mpz_sizeinbase (if (minusp x) (lognot x) x) 2)))
   
 (defun logcount (x)
-  (declare (optimize (safety 1)))
+  (declare (optimize (safety 1))(inline popcountl))
   (check-type x integer)
   (if (typep x 'fixnum)
-      (popcount (if (< x 0) (lognot x) x))
+      (popcountl (if (< x 0) (lognot x) x))
     (mpz_popcount  (if (< x 0) (lognot x) x))))
   
 (defun logbitp (y x)
--- gcl27-2.7.0.orig/lsp/gcl_numlib.lsp
+++ gcl27-2.7.0/lsp/gcl_numlib.lsp
@@ -187,3 +187,41 @@
 		  +make-complex-alist+)
 	  :initial-value nil))
 (setf (get 'make-complex 'type-propagator) 'make-complex-propagator)
+
+(defun float-digits (x)
+  (declare (optimize (safety 1)))
+  (check-type x float);FIXME etypecase
+  (typecase x
+    (short-float 24)
+    (t 53)))
+
+(defun float-precision (x)
+  (declare (optimize (safety 1)))
+  (check-type x float);FIXME etypecase
+  (typecase x
+    ((member 0.0 0.0s0) 0)
+    (short-float 24)
+    (t 53)))
+
+(defun float-sign (x &optional (y 1.0))
+  (declare (optimize (safety 1)))
+  (check-type x float)
+  (check-type y float)
+  (let ((y (float (abs y) x)))
+    (if (minusp x) (- y) y)))
+
+(defun float-radix (x)
+  (declare (optimize (safety 1)))
+  (check-type x float);FIXME etypecase
+  2)
+
+(defun atomic-tp-propagator (f &rest r);  tp &aux (atp (atomic-tp tp)))
+  (declare (dynamic-extenr t))
+  (unless (member-if-not 'atomic-tp r)
+    (let ((l (multiple-value-list (apply f (mapcar (lambda (x) (car (atomic-tp x))) r)))))
+      (if (cdr l)
+	  `(returns-exactly ,@(mapcar 'object-tp l))
+	  (object-tp (car l))))))
+
+(dolist (l '(integer-decode-float decode-float scale-float));float-radix float-digits float-precision float-sign
+  (setf (get l 'type-propagator) 'atomic-tp-propagator (get l 'compiler::c1no-side-effects) t))
--- gcl27-2.7.0.orig/lsp/gcl_predlib.lsp
+++ gcl27-2.7.0/lsp/gcl_predlib.lsp
@@ -90,7 +90,7 @@
 
 (defconstant +objnull+ (objnull))
 
-#.`(defun coerce (object type &aux ntype (atp (listp type)) (ctp (if atp (car type) type)) (tp (when atp (cdr type))))
+(defun coerce (object type &aux ntype (atp (listp type)) (ctp (if atp (car type) type)) (tp (when atp (cdr type))))
   (declare (optimize (safety 2))) ;(print (list 'coerce object type))
 ;  (check-type type (or (member function) type-spec));FIXME
   (case ctp
@@ -102,12 +102,12 @@
 	    (function object) 
 	    ((and symbol (not boolean)) 
 	     (let* ((f (c-symbol-gfdef object))(fi (address f))(m (c-symbol-mflag object)))
-	       (check-type fi (and fixnum (not (integer ,+objnull+ ,+objnull+))))
+	       (check-type fi (and fixnum (not (integer #.+objnull+ #.+objnull+))))
 	       (check-type m  (integer 0 0))
 	       f))
 	    (cons (the function (eval object))))))
 	;FIXME member
-	((list cons vector array member simple-array non-simple-array)
+	((list cons vector string array member simple-array non-simple-array)
 	 (if (typep object type) object (replace (make-sequence type (length object)) object)))
 	(character (character object))
 	(short-float (float object 0.0S0))
--- gcl27-2.7.0.orig/lsp/gcl_seq.lsp
+++ gcl27-2.7.0/lsp/gcl_seq.lsp
@@ -25,16 +25,14 @@
 
 (in-package :si)
 
-#.`(defun make-sequence-element-type (xx &aux (x (cmp-norm-tp xx)))
+#.`(defun make-sequence-element-type (x)
      (or
-      #+pre-gcl(when (eq xx 'string) 'character);accelerator
       (cdr (assoc x
 		 ',(mapcar (lambda (x) (cons (cmp-norm-tp (car x)) (cdr x)))
 			   `((null . null) (cons . cons) (list . list)
 			     ,@(mapcar (lambda (x) `((vector ,x) . ,x)) +array-types+)))
 		 :test 'tp<=))
       (equal #tvector (if (listp x) (car x) x))))
-(setf (get 'make-sequence-element-type 'type-propagator) 'compiler::expand-type-propagator)
 
 (defun ntp-cons-lengths (x)
   (labels ((g (x) (if (integerp x) (1+ x) x))
@@ -67,26 +65,24 @@
     (let ((x (lremove-duplicates (ntp-vector-lengths (caddr tp)))))
       (unless (member '* x) x))))
 
-(defun sequence-tp-lengths (type &aux (tp (cmp-norm-tp type)))
-  #+pre-gcl(when (eq type 'string) (return-from sequence-tp-lengths nil))
+(defun sequence-tp-lengths (tp)
   (if (tp<= tp #tlist)
       (cons-tp-lengths tp)
       (vector-tp-lengths tp)))
-(setf (get 'sequence-tp-lengths 'type-propagator) 'compiler::expand-type-propagator)
-					;type-lengths
 
-
-(defun sequence-tp-nonsimple-p (type)
-  #-pre-gcl(when (eq type 'string) (return-from sequence-tp-nonsimple-p nil))
-  (tp<= (cmp-norm-tp type) #tnon-simple-array))
-(setf (get 'sequence-tp-nonsimple-p 'type-propagator) 'compiler::expand-type-propagator)
+(defun sequence-tp-nonsimple-p (tp)
+  (tp<= tp #tnon-simple-array))
 
 #.`(defun make-sequence (type size &key initial-element)
      (declare (optimize (safety 1)))
      (check-type type type-spec)
      (check-type size seqbnd)
-     (let* ((st (make-sequence-element-type type));FIXME cmp-norm-tp once
-	    (lns (sequence-tp-lengths type)))
+     #+pre-gcl(when (eq type 'string);accelerator
+		(return-from make-sequence
+		  (make-vector 'character size nil nil nil 0 nil initial-element)))
+     (let* ((tp (cmp-norm-tp type))
+	    (st (make-sequence-element-type tp))
+	    (lns (sequence-tp-lengths tp)))
        (check-type st (not null))
        (when lns
 	 (assert (member size lns) (size) 'type-error :datum size :expected-type (cons 'member lns)))
@@ -95,7 +91,7 @@
 	 ((cons list)
 	  (when (eq st 'cons) (check-type size (integer 1)))
 	  (make-list size :initial-element initial-element))
-	 (otherwise (make-vector st size (sequence-tp-nonsimple-p type) nil nil 0 nil initial-element)))))
+	 (otherwise (make-vector st size (sequence-tp-nonsimple-p tp) nil nil 0 nil initial-element)))))
 
 
 (defun concatenate (rt &rest seqs)
--- gcl27-2.7.0.orig/lsp/gcl_serror.lsp
+++ gcl27-2.7.0/lsp/gcl_serror.lsp
@@ -154,6 +154,7 @@
      (muffle-warning nil :report "Skip warning."  (return-from warn nil)))
     (format *error-output* "~&Warning: ~a~%" c)
     nil))
+(putprop 'cerror t 'compiler::cmp-notinline)
 
 (dolist (l '(break cerror error universal-error-handler ihs-top get-sig-fn-name next-stack-frame check-type-symbol))
   (setf (get l 'dbl-invisible) t))
--- gcl27-2.7.0.orig/lsp/gcl_sym.lsp
+++ gcl27-2.7.0/lsp/gcl_sym.lsp
@@ -70,7 +70,7 @@
   (or (let ((x (c-symbol-sfdef s)))
 	(when (nani x) (cons 'special x)))
       (let ((x (c-symbol-gfdef s)))
-	(when (zerop (address x))
+	(when (eql (address x) +objnull+)
 	  (error 'undefined-function :name s))
 	(if (zerop (c-symbol-mflag s)) x (cons 'macro x)))))
 
@@ -82,7 +82,7 @@
 (defun makunbound (s)
   (declare (optimize (safety 1)))
   (check-type s symbol)
-  (c-set-symbol-dbind s (nani 0))
+  (c-set-symbol-dbind s (nani +objnull+))
   s)
 
 (defun set (s y)
--- gcl27-2.7.0.orig/lsp/gcl_type.lsp
+++ gcl27-2.7.0/lsp/gcl_type.lsp
@@ -532,7 +532,7 @@
 
 (defun hashable-typep (x)
   (or (when (symbolp x)
-	(unless (si-find-class x nil)
+	(unless (is-standard-class (si-find-class x nil))
 	  (let ((z (get x 's-data))) (if z (when (s-data-frozen z) x) x))))
       (when (listp x)
 	(when (eq (car x) 'member)
--- gcl27-2.7.0.orig/makefile
+++ gcl27-2.7.0/makefile
@@ -100,12 +100,12 @@ $(PORTDIR)/saved_pre_gcl: $(HDIR)cmpincl
 	touch $< $@
 
 $(PORTDIR)/saved_gcl0: $(PORTDIR)/saved_pre_gcl $(HDIR)cmpinclude.h
-#       This safety 3 image allocates a lot of relblock garbage for closures
-	cd $(@D) && echo '(time (load "boot.lisp"))' | GCL_GC_PAGE_MIN=0.25 GCL_GC_PAGE_MAX=0.5 ../$<
+	cd $(@D) && echo '(time (load "boot.lisp"))' | ../$<
 	cd $(@D) && $(MAKE) saved_gcl && mv saved_gcl $(@F)
 
 $(PORTDIR)/saved_gcl1: $(PORTDIR)/saved_gcl0 $(HDIR)cmpinclude.h
-	cd $(@D) && echo '(time (load "boot.lisp"))' | ./$(<F)
+#       This safety 3 image allocates a lot of relblock garbage for closures
+	cd $(@D) && echo '(time (load "boot.lisp"))' | GCL_GC_PAGE_MIN=0.25 GCL_GC_PAGE_MAX=0.5 ./$(<F)
 	cd $(@D) && $(MAKE) saved_gcl && mv saved_gcl $(@F)
 
 $(PORTDIR)/saved_gcl2: $(PORTDIR)/saved_gcl1 $(HDIR)cmpinclude.h
--- gcl27-2.7.0.orig/o/alloc.c
+++ gcl27-2.7.0/o/alloc.c
@@ -996,6 +996,10 @@ alloc_contblock_no_gc(size_t n,char *lim
   void *p;
   
   n=CEI(n,CPTR_SIZE);
+
+  /*This is called from GBC so we do not want to expand the contblock index*/
+  if (cbv->v.v_fillp+1==cbv->v.v_dim)
+    return NULL;
   
   if ((p=alloc_from_freelist(tm,n)))
     return p;
--- gcl27-2.7.0.orig/o/assignment.c
+++ gcl27-2.7.0/o/assignment.c
@@ -190,9 +190,10 @@ DEFUN("FSET",object,fSfset,SI,2,2,NONE,O
   }
   
   sym->s.s_sfdef=NOT_SPECIAL;/*FIXME?*/
-  if (function->fun.fun_plist!=Cnil)
+  if (function->fun.fun_plist!=Cnil) {
     function->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_cdr->c.c_cdr->c.c_cdr->c.c_car=sym;/*FIXME*/
-  
+    function->fun.fun_plist->c.c_cdr->c.c_cdr->c.c_cdr->c.c_car=sLAload_pathnameA->s.s_dbind;/*FIXME*/
+  }
   RETURN1(function);
 
 }
--- gcl27-2.7.0.orig/o/boot.c
+++ gcl27-2.7.0/o/boot.c
@@ -64,6 +64,9 @@ DEFUN("<<",object,fSlshft,SI,2,2,NONE,II
 DEFUN(">>",object,fSrshft,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
   RETURN1((object)(x>>y));
 }
+DEFUN("POPCOUNTL",object,fSpopcountl,SI,1,1,NONE,II,OO,OO,OO,(fixnum x),"") {
+  RETURN1((object)(fixnum)__builtin_popcountl(x));
+}
 
 static inline bool
 TESTA(object x_,object y_,object key,object test,object test_not) {
@@ -627,6 +630,75 @@ DEFUN("HASH-SET",object,fShash_set,SI,3,
 
 }
 
+DEFUN("COMPLEX",object,fLcomplex,LISP,1,2,NONE,OO,OO,OO,OO,(object r,...),"") {
+  fixnum nargs=INIT_NARGS(1);
+  object l=Cnil,f=OBJNULL,i;
+  va_list ap;
+
+  va_start(ap,r);
+  i=NEXT_ARG(nargs,ap,l,f,make_fixnum(0));
+  va_end(ap);
+
+  check_type_or_rational_float(&r);
+  check_type_or_rational_float(&i);
+
+  RETURN1(make_complex(r,i));
+
+}
+
+DEFUN("FLOAT",object,fLfloat,LISP,1,2,NONE,OO,OO,OO,OO,(object x,...),"") {
+
+  fixnum nargs=INIT_NARGS(1);
+  object l=Cnil,f=OBJNULL,y;
+  va_list ap;
+  double d;
+  enum type t;
+
+  va_start(ap,x);
+  y=NEXT_ARG(nargs,ap,l,f,(t=type_of(x))==t_shortfloat || t==t_longfloat ? x : make_longfloat(0.0));
+  va_end(ap);
+
+  /* check_type_float(&x); */
+  check_type_float(&y);
+
+  t=type_of(y);
+
+  switch (type_of(x)) {
+  case t_fixnum:
+    if (t == t_shortfloat)
+      x = make_shortfloat((shortfloat)(fix(x)));
+    else
+      x = make_longfloat((double)(fix(x)));
+    break;
+
+  case t_bignum:
+  case t_ratio:
+    d = number_to_double(x);
+    if (t == t_shortfloat)
+      x = make_shortfloat((shortfloat)d);
+    else
+      x = make_longfloat(d);
+    break;
+
+  case t_shortfloat:
+    if (t == t_longfloat)
+      x = make_longfloat((double)(sf(x)));
+    break;
+
+  case t_longfloat:
+    if (t == t_shortfloat)
+      x = make_shortfloat((shortfloat)(lf(x)));
+    break;
+
+  default:
+    FEwrong_type_argument(TSor_rational_float, x);
+  }
+
+  RETURN1(x);
+
+}
+
+
 #ifndef NO_BOOT_H
 #include "boot.h"
 #endif
--- gcl27-2.7.0.orig/o/cfun.c
+++ gcl27-2.7.0/o/cfun.c
@@ -158,75 +158,8 @@ DEFUN("DLLIST-PUSH",object,fSdllist_push
 
 }
 
-static object MFnew(object sym, void (*self)(), object data)
-{
-	object cf;
 
-	if (type_of(sym) != t_symbol)
-		not_a_symbol(sym);
-	if (sym->s.s_sfdef != NOT_SPECIAL && sym->s.s_mflag)
-		sym->s.s_sfdef = NOT_SPECIAL;
-	cf=make_cfun(self,sym,data,NULL,0);
-	/* cf = alloc_object(t_cfun); */
-	/* cf->cf.cf_self = self; */
-	/* cf->cf.cf_name = sym; */
-	/* cf->cf.cf_call = Cnil; */
-	/* cf->cf.cf_data = data; */
-	sym = clear_compiler_properties(sym,cf);
- 	sym->s.s_gfdef = cf;
-	sym->s.s_mflag = FALSE;
-	return sym;
-}
-
-DEFUN("MF",object,fSmf,SI
-   ,2,2,NONE,OO,OO,OO,OO,(object name,object addr),"")
-
-{ /* 2 args */
-  MFnew(name,PADDR(addr),sSPmemory->s.s_dbind);
-  RETURN1(name);
-}
-
-
-
-static object
-MM(object sym, void (*self)(), char *start, int size, object data)
-{
-	object cf;
-
-	if (type_of(sym) != t_symbol)
-		not_a_symbol(sym);
-	if (sym->s.s_sfdef != NOT_SPECIAL)
-	  if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
-	    sym->s.s_sfdef = NOT_SPECIAL;
-
-/*  && sym->s.s_mflag) */
 /* 		sym->s.s_sfdef = NOT_SPECIAL; */
-	cf=make_cfun(self,sym,data,start,size);
-	/* cf = alloc_object(t_cfun); */
-	/* cf->cf.cf_self = self; */
-	/* cf->cf.cf_name = sym; */
-	/* cf->cf.cf_call = Cnil; */
-	/* cf->cf.cf_data = data; */
-	/* data->cfd.cfd_start=start;  */
-	/* data->cfd.cfd_size=size; */
-	sym = 	clear_compiler_properties(sym,cf);
-	sym->s.s_gfdef = cf;
-	sym->s.s_sfdef = NOT_SPECIAL;
-	sym->s.s_mflag = TRUE;
-	return sym;
-}
-
-DEFUN("MM",object,fSmm,SI
-   ,2,2,NONE,OO,OO,OO,OO,(object name,object addr),"")
-
-{ /* 2 args */
-  MM(name,PADDR(addr),
-    /* bit wasteful to pass these in just to be reset to themselves..*/
-    sSPmemory->s.s_dbind->cfd.cfd_start,
-    sSPmemory->s.s_dbind->cfd.cfd_size,
-    sSPmemory->s.s_dbind
-     );RETURN1(name);
-}
 
   
 
--- gcl27-2.7.0.orig/o/file.d
+++ gcl27-2.7.0/o/file.d
@@ -1688,6 +1688,7 @@ const char *s;
 	if (user_match(s,strlen(s)))
 		return;
 	filename = make_simple_string(s);
+	bds_bind(sLAload_pathnameA,filename);
 	vs_push(filename);
 	strm = open_stream(filename, smm_input, Cnil, sKerror);
 	vs_push(strm);
@@ -1702,6 +1703,7 @@ const char *s;
 		vs_popp;
 	}
 	close_stream(strm);
+	bds_unwind1;
 	vs_reset;
 }
 
--- gcl27-2.7.0.orig/o/format.c
+++ gcl27-2.7.0/o/format.c
@@ -2694,7 +2694,7 @@ fmt_semicolon(bool colon, bool atsign)
 
 DEFVAR("*FORMAT-UNUSED-ARGS*",sSAformat_unused_argsA,SI,OBJNULL,"");
 
-static object justification_regexp,logical_block_regexp;
+static object justification_regexp=OBJNULL,logical_block_regexp=OBJNULL;
 
 static int
 fmt_pp_string(object control) {
--- gcl27-2.7.0.orig/o/num_co.c
+++ gcl27-2.7.0/o/num_co.c
@@ -297,78 +297,6 @@ num_remainder(object x, object y, object
 	return(z);
 }
 
-/* Coerce X to single-float if one arg,
-   otherwise coerce to same float type as second arg */
-
-LFD(Lfloat)(void)
-{
-	double	d;
-	int narg;
-	object	x;
-	enum type t=t_longfloat;
-
-	narg = vs_top - vs_base;
-	if (narg < 1)
-		too_few_arguments();
-	else if (narg > 2)
-		too_many_arguments();
-	if (narg == 2) {
-		check_type_float(&vs_base[1]);
-		t = type_of(vs_base[1]);
-	}
-	x = vs_base[0];
-	switch (type_of(x)) {
-	case t_fixnum:
-		if (narg > 1 && t == t_shortfloat)
-		  x = make_shortfloat((shortfloat)(fix(x)));
-		else
-		  x = make_longfloat((double)(fix(x)));
-		break;
-
-	case t_bignum:
-	case t_ratio:
-		d = number_to_double(x);
-		if (narg > 1 && t == t_shortfloat)
-		  x = make_shortfloat((shortfloat)d);
-		else
-		  x = make_longfloat(d);		
-		break;
-
-	case t_shortfloat:
-		if (narg > 1 && t == t_longfloat)
-		    x = make_longfloat((double)(sf(x)));
-		break;
-
-	case t_longfloat:
-		if (narg > 1 && t == t_shortfloat)
-			x = make_shortfloat((shortfloat)(lf(x)));
-		break;
-
-	default:
-		FEwrong_type_argument(TSor_rational_float, x);
-	}
-	vs_base = vs_top;
-	vs_push(x);
-}
-
-LFD(Lnumerator)(void)
-{
-	check_arg(1);
-	check_type_rational(&vs_base[0]);
-	if (type_of(vs_base[0]) == t_ratio)
-		vs_base[0] = vs_base[0]->rat.rat_num;
-}
-
-LFD(Ldenominator)(void)
-{
-	check_arg(1);
-	check_type_rational(&vs_base[0]);
-	if (type_of(vs_base[0]) == t_ratio)
-		vs_base[0] = vs_base[0]->rat.rat_den;
-	else
-		vs_base[0] = small_fixnum(1);
-}
-
 inline void
 intdivrem(object x,object y,fixnum d,object *q,object *r) {
 
@@ -513,136 +441,60 @@ DEFUNM("TRUNCATE",object,fLtruncate,LISP
 
 }
 
-LFD(Lround)(void)
-{
-	object x, y, q, q1, r;
-	double d;
-	int n, c;
-	object one_plus(object x), one_minus(object x);
-
-	n = vs_top - vs_base;
-	if (n == 0)
-		too_few_arguments();
-	if (n > 1)
-		goto TWO_ARG;
-	x = vs_base[0];
-	switch (type_of(x)) {
-
-	case t_fixnum:
-	case t_bignum:
-		vs_push(small_fixnum(0));
-		return;
-
-	case t_ratio:
-		q = x;
-		y = small_fixnum(1);
-		goto RATIO;
-
-	case t_shortfloat:
-		d = (double)(sf(x));
-		if (d >= 0.0)
-			q = double_to_integer(d + 0.5);
-		else
-			q = double_to_integer(d - 0.5);
-		d -= number_to_double(q);
-		if (d == 0.5 && number_oddp(q)) {
-			vs_push(q);
-			q = one_plus(q);
-			d = -0.5;
-		}
-		if (d == -0.5 && number_oddp(q)) {
-			vs_push(q);
-			q = one_minus(q);
-			d = 0.5;
-		}
-		vs_base = vs_top;
-		vs_push(q);
-		vs_push(make_shortfloat((shortfloat)d));
-		return;
-
-	case t_longfloat:
-		d = lf(x);
-		if (d >= 0.0)
-			q = double_to_integer(d + 0.5);
-		else
-			q = double_to_integer(d - 0.5);
-		d -= number_to_double(q);
-		if (d == 0.5 && number_oddp(q)) {
-			vs_push(q);
-			q = one_plus(q);
-			d = -0.5;
-		}
-		if (d == -0.5 && number_oddp(q)) {
-			vs_push(q);
-			q = one_minus(q);
-			d = 0.5;
-		}
-		vs_base = vs_top;
-		vs_push(q);
-		vs_push(make_longfloat(d));
-		return;
-
-	default:
-		FEwrong_type_argument(TSor_rational_float, x);
-	}
-
-TWO_ARG:
-	if (n > 2)
-		too_many_arguments();
-	x = vs_base[0];
-	y = vs_base[1];
-	check_type_or_rational_float(&vs_base[0]);
-	check_type_or_rational_float(&vs_base[1]);
-	q = number_divide(x, y);
-	vs_push(q);
-	switch (type_of(q)) {
-	case t_fixnum:
-	case t_bignum:
-		vs_base = vs_top;
-		vs_push(q);
-		vs_push(small_fixnum(0));
-		break;
-	
-	case t_ratio:
-	RATIO:
-	  q1 = integer_divide1(q->rat.rat_num, q->rat.rat_den,0);/*FIXME*/
-		vs_push(q1);
-		r = number_minus(q, q1);
-		vs_push(r);
-		if ((c = number_compare(r, plus_half)) > 0 ||
-		    (c == 0 && number_oddp(q1)))
-			q1 = one_plus(q1);
-		if ((c = number_compare(r, minus_half)) < 0 ||
-		    (c == 0 && number_oddp(q1)))
-			q1 = one_minus(q1);
-		vs_base = vs_top;
-		vs_push(q1);
-		vs_push(num_remainder(x, y, q1));
-		return;
-
-	case t_shortfloat:
-	case t_longfloat:
-		d = number_to_double(q);
-		if (d >= 0.0)
-			q1 = double_to_integer(d + 0.5);
-		else
-			q1 = double_to_integer(d - 0.5);
-		d -= number_to_double(q1);
-		if (d == 0.5 && number_oddp(q1)) {
-			vs_push(q1);
-			q1 = one_plus(q1);
-		}
-		if (d == -0.5 && number_oddp(q1)) {
-			vs_push(q1);
-			q1 = one_minus(q1);
-		}
-		vs_base = vs_top;
-		vs_push(q1);
-		vs_push(num_remainder(x, y, q1));
-		return;
-	default:
-	  break;
-	}
+DEFUNM("ROUND",object,fLround,LISP,1,2,NONE,OO,OO,OO,OO,(object x,...),"") {
+
+  fixnum nargs=INIT_NARGS(1);
+  object f=OBJNULL,l=Cnil,y,q,q1,r;
+  fixnum vals=(fixnum)fcall.valp;
+  object *base=vs_top;
+  double d;
+  int c;
+  enum type tp;
+  va_list ap;
+
+  va_start(ap,x);
+  y=NEXT_ARG(nargs,ap,l,f,make_fixnum(1));
+  va_end(ap);
+
+  check_type_or_rational_float(&x);
+  check_type_or_rational_float(&y);
+
+  q = eql(y,small_fixnum(1)) ? x : number_divide(x, y);
+
+  switch ((tp=type_of(q))) {
+
+  case t_fixnum:
+  case t_bignum:
+    RETURN2(q,small_fixnum(0));
+
+  case t_ratio:
+    q1 = integer_divide1(q->rat.rat_num, q->rat.rat_den,0);/*FIXME*/
+    r = number_minus(q, q1);
+    if ((c = number_compare(r, plus_half)) > 0 ||
+	(c == 0 && number_oddp(q1)))
+      q1 = one_plus(q1);
+    if ((c = number_compare(r, minus_half)) < 0 ||
+	(c == 0 && number_oddp(q1)))
+      q1 = one_minus(q1);
+    RETURN2(q1,num_remainder(x, y, q1));
+
+  case t_shortfloat:
+  case t_longfloat:
+    d = number_to_double(q);
+    q1 = double_to_integer(d + (d >= 0.0 ? 0.5 : -0.5));
+    d -= number_to_double(q1);
+    if (d == 0.5 && number_oddp(q1)) {
+      q1 = one_plus(q1);
+      d=-0.5;
+    }
+    if (d == -0.5 && number_oddp(q1)) {
+      q1 = one_minus(q1);
+      d=+0.5;
+    }
+    RETURN2(q1,tp==t_shortfloat ? make_shortfloat((shortfloat)d) : make_longfloat(d));
+  default:
+    TYPE_ERROR(q,sLreal);
+  }
 }
 
 DEFUN("MOD",object,fLmod,LISP,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
@@ -655,203 +507,70 @@ DEFUN("REM",object,fLrem,LISP,2,2,NONE,O
   RETURN1(y);
 }
 
-LFD(Ldecode_float)(void)
-{
-	object x;
-	double d;
-	int e, s;
-
-	check_arg(1);
-	check_type_float(&vs_base[0]);
-	x = vs_base[0];
-	if (type_of(x) == t_shortfloat)
-		d = sf(x);
-	else
-		d = lf(x);
-	if (d >= 0.0)
-		s = 1;
-	else {
-		d = -d;
-		s = -1;
-	}
-	e=0;
-	if (!ISNORMAL(d)) {
-	  int hp,lp,sp;
-
-	  integer_decode_double(d,&hp,&lp,&e,&sp);
-	  if (hp!=0 || lp<0)
-	    d=number_to_double(bignum2(hp, lp));
-	  else
-	    d=lp;
-	}
-	e += double_exponent(d);
-	d = set_exponent(d, 0);
-	vs_top = vs_base;
-	if (type_of(x) == t_shortfloat) {
-		vs_push(make_shortfloat((shortfloat)d));
-		vs_push(make_fixnum(e));
-		vs_push(make_shortfloat((shortfloat)s));
-	} else {
-		vs_push(make_longfloat(d));
-		vs_push(make_fixnum(e));
-		vs_push(make_longfloat((double)s));
-	}
-}
-
-LFD(Lscale_float)(void)
-{
-	object x;
-	double d;
-	int e, k=0;
-
-	check_arg(2);
-	check_type_float(&vs_base[0]);
-	x = vs_base[0];
-	if (type_of(vs_base[1]) == t_fixnum)
-		k = fix(vs_base[1]);
-	else
-		FEerror("~S is an illegal exponent.", 1, vs_base[1]);
-	if (type_of(x) == t_shortfloat)
-		d = sf(x);
-	else
-		d = lf(x);
-	e = double_exponent(d) + k;
-#ifdef VAX
-	if (e <= -128 || e >= 128)
-#endif
-#ifdef IBMRT
-
-#endif
-#ifdef IEEEFLOAT
-	  /* Upper bound not needed, handled by floating point overflow */
-	  /* this checks if we're in the denormalized range */
-	if (!ISNORMAL(d) || (type_of(x) == t_shortfloat && e <= -126/*  || e >= 130 */) ||
-	    (type_of(x) == t_longfloat && (e <= -1022 /* || e >= 1026 */)))
-#endif
-#ifdef MV
-
-#endif
-#ifdef S3000
-	if (e < -64 || e >= 64)
-#endif
-/* 		FEerror("~S is an illegal exponent.", 1, vs_base[1]); */
-	  {
-	    for (;k>0;d*=2.0,k--);
-	    for (;k<0;d*=0.5,k++);
-	  }
-	else
-	  d = set_exponent(d, e);
-	vs_popp;
-	if (type_of(x) == t_shortfloat)
-		vs_base[0] = make_shortfloat((shortfloat)d);
-	else
-		vs_base[0] = make_longfloat(d);
-}
-
-LFD(Lfloat_radix)(void)
-{
-	check_arg(1);
-	check_type_float(&vs_base[0]);
-#ifdef VAX
-	vs_base[0] = small_fixnum(2);
-#endif
-#ifdef IBMRT
-
-#endif
-#ifdef IEEEFLOAT
-	vs_base[0] = small_fixnum(2);
-#endif
-#ifdef MV
-
-#endif
-#ifdef S3000
-	vs_base[0] = small_fixnum(16);
-#endif
-}
-
-LFD(Lfloat_sign)(void)
-{
-	object x;
-	int narg;
-	double d, f;
-
-	narg = vs_top - vs_base;
-	if (narg < 1)
-		too_few_arguments();
-	else if (narg > 2)
-		too_many_arguments();
-	check_type_float(&vs_base[0]);
-	x = vs_base[0];
-	if (type_of(x) == t_shortfloat)
-		d = sf(x);
-	else
-		d = lf(x);
-	if (narg == 1)
-		f = 1.0;
-	else {
-		check_type_float(&vs_base[1]);
-		x = vs_base[1];
-		if (type_of(x) == t_shortfloat)
-			f = sf(x);
-		else
-			f = lf(x);
-		if (f < 0.0)
-			f = -f;
-	}
-	if (d < 0.0)
-		f = -f;
-	vs_top = vs_base;
-	if (type_of(x) == t_shortfloat)
-		vs_push(make_shortfloat((shortfloat)f));
-	else
-		vs_push(make_longfloat(f));
-}
-
-LFD(Lfloat_digits)(void)
-{
-	check_arg(1);
-	check_type_float(&vs_base[0]);
-	if (type_of(vs_base[0]) == t_shortfloat)
-		vs_base[0] = small_fixnum(24);
-	else
-		vs_base[0] = small_fixnum(53);
-}
-
-LFD(Lfloat_precision)(void)
-{
-	object x;
-
-	check_arg(1);
-	check_type_float(&vs_base[0]);
-	x = vs_base[0];
-	if (type_of(x) == t_shortfloat)
-		if (sf(x) == 0.0)
-			vs_base[0] = small_fixnum(0);
-		else
-			vs_base[0] = small_fixnum(24);
-	else
-		if (lf(x) == 0.0)
-			vs_base[0] = small_fixnum(0);
-		else
-#ifdef VAX
-			vs_base[0] = small_fixnum(53);
-#endif
-#ifdef IBMRT
-
-#endif
-#ifdef IEEEFLOAT
-			vs_base[0] = small_fixnum(53);
-#endif
-#ifdef MV
-
-#endif
-#ifdef S3000
-			vs_base[0] = small_fixnum(53);
-#endif
+DEFUNM("DECODE-FLOAT",object,fLdecode_float,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") {
+
+  int e,s;
+  fixnum vals=(fixnum)fcall.valp;
+  double d;
+  object *base=vs_top;
+
+  check_type_float(&x);
+
+  if (type_of(x) == t_shortfloat)
+    d = sf(x);
+  else
+    d = lf(x);
+  if (d >= 0.0)
+    s = 1;
+  else {
+    d = -d;
+    s = -1;
+  }
+  e=0;
+  if (!ISNORMAL(d)) {
+    int hp,lp,sp;
+
+    integer_decode_double(d,&hp,&lp,&e,&sp);
+    if (hp!=0 || lp<0)
+      d=number_to_double(bignum2(hp, lp));
+    else
+      d=lp;
+  }
+  e += double_exponent(d);
+  d = set_exponent(d, 0);
+
+  RETURN3(type_of(x) == t_shortfloat ? make_shortfloat((shortfloat)d) : make_longfloat(d),
+	  make_fixnum(e),
+	  type_of(x) == t_shortfloat ? make_shortfloat((shortfloat)s) : make_longfloat((double)s));
+
+}
+
+DEFUN("SCALE-FLOAT",object,fLscale_float,LISP,2,2,NONE,OO,IO,OO,OO,(object x,fixnum k),"") {
+
+  double d;
+  int e;
+
+  if (type_of(x) == t_shortfloat)
+    d = sf(x);
+  else
+    d = lf(x);
+
+  e = double_exponent(d) + k;
+
+  /* Upper bound not needed, handled by floating point overflow */
+  /* this checks if we're in the denormalized range */
+  if (!ISNORMAL(d) || (type_of(x) == t_shortfloat && e <= -126/*  || e >= 130 */) ||
+      (type_of(x) == t_longfloat && (e <= -1022 /* || e >= 1026 */))) {
+    for (;k>0;d*=2.0,k--);
+    for (;k<0;d*=0.5,k++);
+  } else
+    d = set_exponent(d, e);
+
+  RETURN1(type_of(x) == t_shortfloat ? make_shortfloat((shortfloat)d) : make_longfloat(d));
+
 }
 
-DEFUNM("INTEGER-DECODE-FLOAT",object,fLinteger_decode_float,LISP,1,1,NONE,OO,OO,OO,OO,
-	   (object x),"") {
+DEFUNM("INTEGER-DECODE-FLOAT",object,fLinteger_decode_float,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") {
 
   int h,l,e,s;
   fixnum vals=(fixnum)fcall.valp;
@@ -867,334 +586,152 @@ DEFUNM("INTEGER-DECODE-FLOAT",object,fLi
 
 }
 
-LFD(Lcomplex)(void)
-{
-	object	r, i;
-	int narg;
-
-	narg = vs_top - vs_base;
-	if (narg < 1)
-		too_few_arguments();
-	if (narg > 2)
-		too_many_arguments();
-	check_type_or_rational_float(&vs_base[0]);
-	r = vs_base[0];
-	if (narg == 1)
-		i = small_fixnum(0);
-	else {
-		check_type_or_rational_float(&vs_base[1]);
-		i = vs_base[1];
-	}
-	vs_top = vs_base;
-	vs_push(make_complex(r, i));
-}
-
-LFD(Lrealpart)(void)
-{
-	object	x;
-
-	check_arg(1);
-	check_type_number(&vs_base[0]);
-	x = vs_base[0];
-	if (type_of(x) == t_complex)
-		vs_base[0] = x->cmp.cmp_real;
-}
-
-LFD(Limagpart)(void)
-{
-	object x;
-
-	check_arg(1);
-	check_type_number(&vs_base[0]);
-	x = vs_base[0];
-	switch (type_of(x)) {
-	case t_fixnum:
-	case t_bignum:
-	case t_ratio:
-		vs_base[0] = small_fixnum(0);
-		break;
-	case t_shortfloat:
-		vs_base[0] = shortfloat_zero;
-		break;
-	case t_longfloat:
-		vs_base[0] = longfloat_zero;
-		break;
-	case t_complex:
-		vs_base[0] = x->cmp.cmp_imag;
-		break;
-	default:
-	  break;
-	}
-}
-
 void
-gcl_init_num_co(void)
-{
-	float smallest_float, smallest_norm_float, biggest_float;
-	double smallest_double, smallest_norm_double, biggest_double;
-	float float_epsilon, float_negative_epsilon;
-	double double_epsilon, double_negative_epsilon;
-	union {double d;int i[2];} u;
-	union {float f;int i;} uf;
-
-
-#ifdef VAX
-	l[0] = 0x80;
-	l[1] = 0;
-	smallest_float = *(float *)l;
-	smallest_double = *(double *)l;
-#endif
-
-#ifdef IEEEFLOAT
-#ifdef NS32K
-
+gcl_init_num_co(void) {
 
+  float smallest_float, smallest_norm_float, biggest_float;
+  double smallest_double, smallest_norm_double, biggest_double;
+  float float_epsilon, float_negative_epsilon;
+  double double_epsilon, double_negative_epsilon;
+  union {double d;int i[2];} u;
+  union {float f;int i;} uf;
+
+  uf.i=1;
+  u.i[HIND]=0;
+  u.i[LIND]=1;
+  smallest_float=uf.f;
+  smallest_double=u.d;
+
+  uf.i=0x7f7fffff;
+  u.i[HIND]=0x7fefffff;
+  u.i[LIND]=0xffffffff;
+  biggest_float=uf.f;
+  biggest_double=u.d;
+
+  biggest_double = DBL_MAX;
+  smallest_norm_double = DBL_MIN;
+  smallest_norm_float = FLT_MIN;
+  biggest_float = FLT_MAX;
+
+  {
+
+    volatile double rd,dd,td,td1;
+    volatile float  rf,df,tf,tf1;
+    int i,j;
+#define MAX 500
 
+    for (rf=1.0f,df=0.5f,i=j=0;i<MAX && j<MAX && df!=1.0f;i++,df=1.0f-(0.5f*(1.0f-df)))
+      for (tf=rf,tf1=tf+1.0f,j=0;j<MAX && tf1!=1.0f;j++,rf=tf,tf*=df,tf1=tf+1.0f);
+    if (i==MAX||j==MAX)
+      printf("WARNING, cannot calculate float_epsilon: %d %d %f   %f %f %f\n",i,j,rf,df,tf,tf1);
+    float_epsilon=rf;
+
+    for (rf=1.0f,df=0.5f,i=j=0;i<MAX && j<MAX && df!=1.0f;i++,df=1.0f-(0.5f*(1.0f-df)))
+      for (tf=rf,tf1=1.0f-tf,j=0;j<MAX && tf1!=1.0f;j++,rf=tf,tf*=df,tf1=1.0f-tf);
+    if (i==MAX||j==MAX)
+      printf("WARNING, cannot calculate float_negative_epsilon: %d %d %f   %f %f %f\n",i,j,rf,df,tf,tf1);
+    float_negative_epsilon=rf;
+
+    for (rd=1.0,dd=0.5,i=j=0;i<MAX && j<MAX && dd!=1.0;i++,dd=1.0-(0.5*(1.0-dd)))
+      for (td=rd,td1=td+1.0,j=0;j<MAX && td1!=1.0;j++,rd=td,td*=dd,td1=td+1.0);
+    if (i==MAX||j==MAX)
+      printf("WARNING, cannot calculate double_epsilon: %d %d %f   %f %f %f\n",i,j,rd,dd,td,td1);
+    double_epsilon=rd;
+
+    for (rd=1.0,dd=0.5,i=j=0;i<MAX && j<MAX && dd!=1.0;i++,dd=1.0-(0.5*(1.0-dd)))
+      for (td=rd,td1=1.0-td,j=0;j<MAX && td1!=1.0;j++,rd=td,td*=dd,td1=1.0-td);
+    if (i==MAX||j==MAX)
+      printf("WARNING, cannot calculate double_negative_epsilon: %d %d %f   %f %f %f\n",i,j,rd,dd,td,td1);
+    double_negative_epsilon=rd;
 
+  }
 
-#else
-	uf.i=1;
-	u.i[HIND]=0;
-	u.i[LIND]=1;
-	smallest_float=uf.f;
-	smallest_double=u.d;
-
-/* 	((int *) &smallest_float)[0]= 1; */
-/* 	((int *) &smallest_double)[HIND] = 0; */
-/* 	((int *) &smallest_double)[LIND] = 1; */
-
-#endif
-#endif
-
-#ifdef MV
-
-
-
-
-#endif
-
-#ifdef S3000
-	l[0] = 0x00100000;
-	l[1] = 0;
-	smallest_float = *(float *)l;
-	smallest_double = *(double *)l;
-#endif
-
-#ifdef VAX
-	l[0] = 0xffff7fff;
-	l[1] = 0xffffffff;
-	biggest_float = *(float *)l;
-	biggest_double = *(double *)l;
-#endif
-
-#ifdef IBMRT
-
-
-
-
-#endif
-
-#ifdef IEEEFLOAT
-#ifdef NS32K
 
 
+  make_si_constant("+INF",make_longfloat(INFINITY));
+  make_si_constant("-INF",make_longfloat(-INFINITY));
+  make_si_constant("NAN",make_longfloat(NAN));
+
+  make_si_constant("+SINF",make_shortfloat(INFINITY));
+  make_si_constant("-SINF",make_shortfloat(-INFINITY));
+  make_si_constant("SNAN",make_shortfloat(NAN));
+
+  make_constant("MOST-POSITIVE-SHORT-FLOAT",
+		make_shortfloat(biggest_float));
+  make_constant("LEAST-POSITIVE-SHORT-FLOAT",
+		make_shortfloat(smallest_float));
+  make_constant("LEAST-NEGATIVE-SHORT-FLOAT",
+		make_shortfloat(-smallest_float));
+  make_constant("MOST-NEGATIVE-SHORT-FLOAT",
+		make_shortfloat(-biggest_float));
+
+  make_constant("MOST-POSITIVE-SINGLE-FLOAT",
+		make_longfloat(biggest_double));
+  make_constant("LEAST-POSITIVE-SINGLE-FLOAT",
+		make_longfloat(smallest_double));
+  make_constant("LEAST-NEGATIVE-SINGLE-FLOAT",
+		make_longfloat(-smallest_double));
+  make_constant("MOST-NEGATIVE-SINGLE-FLOAT",
+		make_longfloat(-biggest_double));
+
+  make_constant("MOST-POSITIVE-DOUBLE-FLOAT",
+		make_longfloat(biggest_double));
+  make_constant("LEAST-POSITIVE-DOUBLE-FLOAT",
+		make_longfloat(smallest_double));
+  make_constant("LEAST-NEGATIVE-DOUBLE-FLOAT",
+		make_longfloat(-smallest_double));
+  make_constant("MOST-NEGATIVE-DOUBLE-FLOAT",
+		make_longfloat(-biggest_double));
+
+  make_constant("MOST-POSITIVE-LONG-FLOAT",
+		make_longfloat(biggest_double));
+  make_constant("LEAST-POSITIVE-LONG-FLOAT",
+		make_longfloat(smallest_double));
+  make_constant("LEAST-NEGATIVE-LONG-FLOAT",
+		make_longfloat(-smallest_double));
+  make_constant("MOST-NEGATIVE-LONG-FLOAT",
+		make_longfloat(-biggest_double));
+
+  make_constant("SHORT-FLOAT-EPSILON",
+		make_shortfloat(float_epsilon));
+  make_constant("SINGLE-FLOAT-EPSILON",
+		make_longfloat(double_epsilon));
+  make_constant("DOUBLE-FLOAT-EPSILON",
+		make_longfloat(double_epsilon));
+  make_constant("LONG-FLOAT-EPSILON",
+		make_longfloat(double_epsilon));
+
+  make_constant("SHORT-FLOAT-NEGATIVE-EPSILON",
+		make_shortfloat(float_negative_epsilon));
+  make_constant("SINGLE-FLOAT-NEGATIVE-EPSILON",
+		make_longfloat(double_negative_epsilon));
+  make_constant("DOUBLE-FLOAT-NEGATIVE-EPSILON",
+		make_longfloat(double_negative_epsilon));
+  make_constant("LONG-FLOAT-NEGATIVE-EPSILON",
+		make_longfloat(double_negative_epsilon));
+
+  /* Normalized constants added, CM */
+  make_constant("LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT",
+		make_shortfloat(smallest_norm_float));
+  make_constant("LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT",
+		make_shortfloat(-smallest_norm_float));
+  make_constant("LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT",
+		make_longfloat(smallest_norm_double));
+  make_constant("LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT",
+		make_longfloat(-smallest_norm_double));
+  make_constant("LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT",
+		make_longfloat(smallest_norm_double));
+  make_constant("LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT",
+		make_longfloat(-smallest_norm_double));
+  make_constant("LEAST-POSITIVE-NORMALIZED-LONG-FLOAT",
+		make_longfloat(smallest_norm_double));
+  make_constant("LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT",
+		make_longfloat(-smallest_norm_double));
 
+  plus_half = make_ratio(small_fixnum(1), small_fixnum(2),1);
+  enter_mark_origin(&plus_half);
 
+  minus_half = make_ratio(small_fixnum(-1), small_fixnum(2),1);
+  enter_mark_origin(&minus_half);
 
-#else
-
-	uf.i=0x7f7fffff;
-	u.i[HIND]=0x7fefffff;
-	u.i[LIND]=0xffffffff;
-	
-	biggest_float=uf.f;
-	biggest_double=u.d;
-
-/* 	((int *) &biggest_float)[0]= 0x7f7fffff; */
-/* 	((int *) &biggest_double)[HIND] = 0x7fefffff; */
-/* 	((int *) &biggest_double)[LIND] = 0xffffffff; */
-
-#ifdef BAD_FPCHIP
- /* &&&& I am adding junk values to get past debugging */
-        biggest_float = 1.0e37;
-        smallest_float = 1.0e-37;
-        biggest_double = 1.0e308;
-        smallest_double = 1.0e-308;
-        printf("\n Used fake values for float max and mins ");
-#endif
-#endif
-#endif
-
-#if defined(S3000) && ~defined(DBL_MAX_10_EXP)
-	l[0] = 0x7fffffff;
-	l[1] = 0xffffffff;
-	l[0] = 0x7fffffff;
-	l[1] = 0xffffffff;
-	biggest_float = *(float *)l;
-	biggest_float = *(float *)l;
-	biggest_float = *(float *)l;
-	biggest_float = 0.0;
-	biggest_float = biggest_float + 1.0;
-	biggest_float = biggest_float + 2.0;
-	biggest_float = *(float *)l;
-	biggest_float = *(float *)l;
-	strcmp("I don't like", "DATA GENERAL.");
-	biggest_float = *(float *)l;
-	biggest_double = *(double *)l;
-	biggest_double = *(double *)l;
-	biggest_double = *(double *)l;
-	biggest_double = 0.0;
-	biggest_double = biggest_double + 1.0;
-	biggest_double = biggest_double + 2.0;
-	biggest_double = *(double *)l;
-	biggest_double = *(double *)l;
-	strcmp("I don't like", "DATA GENERAL.");
-	biggest_double = *(double *)l;
-#endif
-
-#ifdef DBL_MAX_10_EXP
-	biggest_double = DBL_MAX;
-	smallest_norm_double = DBL_MIN;
-	smallest_norm_float = FLT_MIN;
-	biggest_float = FLT_MAX;
-#endif
-	
-	{
-	  
-	  volatile double rd,dd,td,td1;
-	  volatile float  rf,df,tf,tf1;
-	  int i,j;
-#define MAX 500
-	  
-	  for (rf=1.0f,df=0.5f,i=j=0;i<MAX && j<MAX && df!=1.0f;i++,df=1.0f-(0.5f*(1.0f-df)))
-	    for (tf=rf,tf1=tf+1.0f,j=0;j<MAX && tf1!=1.0f;j++,rf=tf,tf*=df,tf1=tf+1.0f);
-	  if (i==MAX||j==MAX)
-	    printf("WARNING, cannot calculate float_epsilon: %d %d %f   %f %f %f\n",i,j,rf,df,tf,tf1);
-	  float_epsilon=rf;
-
-	  for (rf=1.0f,df=0.5f,i=j=0;i<MAX && j<MAX && df!=1.0f;i++,df=1.0f-(0.5f*(1.0f-df)))
-	    for (tf=rf,tf1=1.0f-tf,j=0;j<MAX && tf1!=1.0f;j++,rf=tf,tf*=df,tf1=1.0f-tf);
-	  if (i==MAX||j==MAX)
-	    printf("WARNING, cannot calculate float_negative_epsilon: %d %d %f   %f %f %f\n",i,j,rf,df,tf,tf1);
-	  float_negative_epsilon=rf;
-	  
-	  for (rd=1.0,dd=0.5,i=j=0;i<MAX && j<MAX && dd!=1.0;i++,dd=1.0-(0.5*(1.0-dd)))
-	    for (td=rd,td1=td+1.0,j=0;j<MAX && td1!=1.0;j++,rd=td,td*=dd,td1=td+1.0);
-	  if (i==MAX||j==MAX)
-	    printf("WARNING, cannot calculate double_epsilon: %d %d %f   %f %f %f\n",i,j,rd,dd,td,td1);
-	  double_epsilon=rd;
-
-	  for (rd=1.0,dd=0.5,i=j=0;i<MAX && j<MAX && dd!=1.0;i++,dd=1.0-(0.5*(1.0-dd)))
-	    for (td=rd,td1=1.0-td,j=0;j<MAX && td1!=1.0;j++,rd=td,td*=dd,td1=1.0-td);
-	  if (i==MAX||j==MAX)
-	    printf("WARNING, cannot calculate double_negative_epsilon: %d %d %f   %f %f %f\n",i,j,rd,dd,td,td1);
-	  double_negative_epsilon=rd;
-	  
-	}
-
-	
-#ifdef IEEEFLOAT
-	/* Maybe check for "right" answer here */
-#endif
-
-	make_si_constant("+INF",make_longfloat(INFINITY));
-	make_si_constant("-INF",make_longfloat(-INFINITY));
-	make_si_constant("NAN",make_longfloat(NAN));
-
-	make_si_constant("+SINF",make_shortfloat(INFINITY));
-	make_si_constant("-SINF",make_shortfloat(-INFINITY));
-	make_si_constant("SNAN",make_shortfloat(NAN));
-
-	make_constant("MOST-POSITIVE-SHORT-FLOAT",
-		      make_shortfloat(biggest_float));
-	make_constant("LEAST-POSITIVE-SHORT-FLOAT",
-		      make_shortfloat(smallest_float));
-	make_constant("LEAST-NEGATIVE-SHORT-FLOAT",
-		      make_shortfloat(-smallest_float));
-	make_constant("MOST-NEGATIVE-SHORT-FLOAT",
-		      make_shortfloat(-biggest_float));
-
-	make_constant("MOST-POSITIVE-SINGLE-FLOAT",
-		      make_longfloat(biggest_double));
-	make_constant("LEAST-POSITIVE-SINGLE-FLOAT",
-		      make_longfloat(smallest_double));
-	make_constant("LEAST-NEGATIVE-SINGLE-FLOAT",
-		      make_longfloat(-smallest_double));
-	make_constant("MOST-NEGATIVE-SINGLE-FLOAT",
-		      make_longfloat(-biggest_double));
-
-	make_constant("MOST-POSITIVE-DOUBLE-FLOAT",
-		      make_longfloat(biggest_double));
-	make_constant("LEAST-POSITIVE-DOUBLE-FLOAT",
-		      make_longfloat(smallest_double));
-	make_constant("LEAST-NEGATIVE-DOUBLE-FLOAT",
-		      make_longfloat(-smallest_double));
-	make_constant("MOST-NEGATIVE-DOUBLE-FLOAT",
-		      make_longfloat(-biggest_double));
-
-	make_constant("MOST-POSITIVE-LONG-FLOAT",
-		      make_longfloat(biggest_double));
-	make_constant("LEAST-POSITIVE-LONG-FLOAT",
-		      make_longfloat(smallest_double));
-	make_constant("LEAST-NEGATIVE-LONG-FLOAT",
-		      make_longfloat(-smallest_double));
-	make_constant("MOST-NEGATIVE-LONG-FLOAT",
-		      make_longfloat(-biggest_double));
-
-	make_constant("SHORT-FLOAT-EPSILON",
-		      make_shortfloat(float_epsilon));
-	make_constant("SINGLE-FLOAT-EPSILON",
-		      make_longfloat(double_epsilon));
-	make_constant("DOUBLE-FLOAT-EPSILON",
-		      make_longfloat(double_epsilon));
-	make_constant("LONG-FLOAT-EPSILON",
-		      make_longfloat(double_epsilon));
-
-	make_constant("SHORT-FLOAT-NEGATIVE-EPSILON",
-		      make_shortfloat(float_negative_epsilon));
-	make_constant("SINGLE-FLOAT-NEGATIVE-EPSILON",
-		      make_longfloat(double_negative_epsilon));
-	make_constant("DOUBLE-FLOAT-NEGATIVE-EPSILON",
-		      make_longfloat(double_negative_epsilon));
-	make_constant("LONG-FLOAT-NEGATIVE-EPSILON",
-		      make_longfloat(double_negative_epsilon));
-
-	/* Normalized constants added, CM */
-	make_constant("LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT",
-		      make_shortfloat(smallest_norm_float));
-	make_constant("LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT",
-		      make_shortfloat(-smallest_norm_float));
-	make_constant("LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT",
-		      make_longfloat(smallest_norm_double));
-	make_constant("LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT",
-		      make_longfloat(-smallest_norm_double));
-	make_constant("LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT",
-		      make_longfloat(smallest_norm_double));
-	make_constant("LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT",
-		      make_longfloat(-smallest_norm_double));
-	make_constant("LEAST-POSITIVE-NORMALIZED-LONG-FLOAT",
-		      make_longfloat(smallest_norm_double));
-	make_constant("LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT",
-		      make_longfloat(-smallest_norm_double));
-
-	plus_half = make_ratio(small_fixnum(1), small_fixnum(2),1);
-	enter_mark_origin(&plus_half);
-
-	minus_half = make_ratio(small_fixnum(-1), small_fixnum(2),1);
-	enter_mark_origin(&minus_half);
-
-	make_function("FLOAT", Lfloat);
-	make_function("NUMERATOR", Lnumerator);
-	make_function("DENOMINATOR", Ldenominator);
-	make_function("ROUND", Lround);
-	make_function("DECODE-FLOAT", Ldecode_float);
-	make_function("SCALE-FLOAT", Lscale_float);
-	make_function("FLOAT-RADIX", Lfloat_radix);
-	make_function("FLOAT-SIGN", Lfloat_sign);
-	make_function("FLOAT-DIGITS", Lfloat_digits);
-	make_function("FLOAT-PRECISION", Lfloat_precision);
-/* 	make_function("INTEGER-DECODE-FLOAT", Linteger_decode_float); */
-	make_function("COMPLEX", Lcomplex);
-	make_function("REALPART", Lrealpart);
-	make_function("IMAGPART", Limagpart);
 }
--- gcl27-2.7.0.orig/o/print.d
+++ gcl27-2.7.0/o/print.d
@@ -1012,9 +1012,10 @@ static int
 needs_escape (object x) {
 
   fixnum i,all_dots=1;
+  unsigned char ch;
 
   for (i=0;i<VLEN(x);i++)
-    switch(x->st.st_self[i]) {
+    switch((ch=x->st.st_self[i])) {
     case ' ':
     case '#':
     case '(':
@@ -1031,6 +1032,8 @@ needs_escape (object x) {
       break;
     default:
       all_dots=0;
+      if (Vreadtable->s.s_dbind->rt.rt_self[ch].rte_chattrib!=cat_constituent)
+	return 1;
       break;
     }
 
@@ -1646,7 +1649,7 @@ write_object(object x,int level) {
 		case smm_string_input:
 		        write_unreadable_str(x,"#<string-input stream ");
 			y = x->sm.sm_object0;
-			if (y) {
+			if (y!=OBJNULL) {
 			  write_str(" from \"");
 			  j = VLEN(y);
 			  for (i = 0;  i < j && i < 16;  i++)
--- gcl27-2.7.0.orig/o/read.d
+++ gcl27-2.7.0/o/read.d
@@ -1676,7 +1676,6 @@ copy_readtable(object from,object to) {
   if (to == Cnil) {
     to = alloc_object(t_readtable);
     to->rt.rt_self = NULL;
-    to->rt.rt_self = OBJNULL;
     to->rt.rt_case = OBJNULL;
     /*  For GBC not to go mad.  */
     vs_push(to);
--- gcl27-2.7.0.orig/unixport/sys_init.c
+++ gcl27-2.7.0/unixport/sys_init.c
@@ -53,6 +53,9 @@ gcl_init_system(object no_init)
   check_init(lsp,gcl_typeof,no_init);
   check_init(lsp,gcl_subtypep,no_init);
   check_init(lsp,gcl_bit,no_init);
+#ifndef pre_gcl
+  check_init(lsp,gcl_bnum,no_init);
+#endif
 #ifdef pre_gcl/*FIXME coerce in compiled funcall*/
   check_init(lsp,gcl_type,no_init);
   check_init(lsp,gcl_typecase,no_init);
@@ -100,7 +103,9 @@ gcl_init_system(object no_init)
   
   check_init(lsp,gcl_callhash,no_init);
   check_init(lsp,gcl_describe,no_init);
+#ifdef pre_gcl
   check_init(lsp,gcl_bnum,no_init);
+#endif
 #ifndef pre_gcl
   check_init(lsp,gcl_mnum,no_init);
 #endif
