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-32) unstable; urgency=medium
 .
   * Version_2_7_0pre35
Author: Camm Maguire <camm@debian.org>

---
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: 2025-02-02

--- gcl27-2.7.0.orig/clcs/makefile
+++ gcl27-2.7.0/clcs/makefile
@@ -8,6 +8,10 @@ APPEND=../xbin/append
 
 all: $(addsuffix .c,$(FILES)) $(addsuffix .h,$(FILES)) $(addsuffix .data,$(FILES)) $(addsuffix .o,$(FILES))
 
+$(addsuffix .c,$(FILES)) $(addsuffix .h,$(FILES)) $(addsuffix .data,$(FILES)) $(addsuffix .o,$(FILES)):	$(addsuffix .lisp,$(FILES)) ./saved_clcs_gcl
+	echo "(progn (compiler::cdebug) (mapc (quote compile-file) (mapcar (quote string-downcase) (quote ($(addsuffix .lisp,$(FILES)))))) (compiler::dump-inl-hash \"../cmpnew/gcl_cmpnopt.lsp\"))" | ./saved_clcs_gcl
+
+
 gprof_objs: $(addprefix ../gprof/,$(addsuffix .o,$(FILES)))
 
 ../gprof/%.o: %.c #$(DECL)
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpcall.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpcall.lsp
@@ -74,16 +74,16 @@
       (list (make-list (length all) :initial-element t)
 	    '* #.(flags ans set svt) 
 	    (concatenate 'string
-	    "({object _z;fixnum _v=(fixnum)#v;
-        fcall.fun=#0;fcall.valp=_v;fcall.argd=#n-1;
-        _z=Rset && !(#0)->fun.fun_argd && 
-        fcall.argd>=(#0)->fun.fun_minarg && fcall.argd<=((#0)->fun.fun_maxarg) ? 
+	    "({object _z,_f=#0;fixnum _v=(fixnum)#v;
+        fcall.fun=_f;fcall.valp=_v;fcall.argd=#n-1;
+        _z=Rset && !(_f)->fun.fun_argd &&
+        fcall.argd>=(_f)->fun.fun_minarg && fcall.argd<=((_f)->fun.fun_maxarg) ?
         "
 	    (if args
-		"(#0)->fun.fun_self(#*)"
-	      "((#0)->fun.fun_maxarg ? (#0)->fun.fun_self(#?) : (#0)->fun.fun_self(#*))")
+		"(_f)->fun.fun_self(#*)"
+	      "((_f)->fun.fun_maxarg ? (_f)->fun.fun_self(#?) : (_f)->fun.fun_self(#*))")
 	    " : call_proc_cs2(#?);
-           if (!(#0)->fun.fun_neval && !(#0)->fun.fun_vv) vs_top=_v ? (object *)_v : sup;
+           if (!(_f)->fun.fun_neval && !(_f)->fun.fun_vv) vs_top=_v ? (object *)_v : sup;
            _z;})")) all))
     (close-inline-blocks)))
 
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpenv.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpenv.lsp
@@ -448,7 +448,7 @@
 	       (cmpwarn "The declaration specifier ~s is unknown." (car decl))))))
     (let ((c1b (c1progn body)))
       (cond ((null dl) c1b)
-	    ((unless *safe-compile* (member (car c1b) '(lit var))) c1b)
+	    ((member (car c1b) '(var lit)) c1b)
 	    ((eq (car c1b) 'decl-body) (setf (third c1b) (nunion dl (third c1b))) c1b)
 	    ((list 'decl-body (copy-info (cadr c1b)) dl c1b))))))
 
@@ -474,25 +474,6 @@
 	  (inline (setq *notinline* (remove (cadr decl) *notinline*)))
 	  (otherwise (baboon)))))
 
-;; (defun local-compile-decls (decls)
-;;   (dolist (decl decls)
-;;     (unless (consp decl) (setq decl (list decl 3)))
-;;     (case (car decl)
-;; 	  (debug (setq *debug* (cadr decl)))
-;; 	  (safety
-;; 	   (let ((level (cadr decl)))
-;; 	     (declare (fixnum level))
-;; 	     (setq *compiler-check-args* (or *compiler-check-args* (>= level 1))
-;; 		   *safe-compile* (or *safe-compile* (>= level 2))
-;; 		   *compiler-new-safety* (or *compiler-new-safety* (>= level 3))
-;; 		   *compiler-push-events* (or *compiler-push-events* (>= level 4)))));FIXME
-;; 	  (space (setq *space* (cadr decl)))
-;; 	  (notinline (push (cadr decl) *notinline*))
-;; 	  (speed) ;;FIXME
-;; 	  (compilation-speed) ;;FIXME
-;; 	  (inline (setq *notinline* (remove (cadr decl) *notinline*)))
-;; 	  (otherwise (baboon)))))
-
 (defun c2decl-body (decls body)
   (let ((*compiler-check-args* *compiler-check-args*)
         (*safe-compile* *safe-compile*)
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpeval.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpeval.lsp
@@ -608,14 +608,151 @@
 (si::putprop 'comment 'c1comment 'c1)
 (si::putprop 'comment 'c2comment 'c2)
 
+
+
+(defvar *inl-hash* (make-hash-table :test 'eq))
+
+(defun ibtp (t1 t2 &aux (a1 (atomic-tp t1))(a2 (atomic-tp t2)))
+  (if (unless (type-and t1 t2) (and a1 a2 (listp t1) (listp t2) (equal (car t1) (car t2))))
+      (car t1) (type-or1 t1 t2)))
+
+(defun coalesce-inl (cl inl tps rt &aux (lev (this-safety-level)))
+  (when (> lev (third inl))
+    (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-coalesce)
+		   "Coalescing safety ~s: ~s ~s" (car cl) (third inl) lev)
+    (setf (third inl) lev))
+  (unless (type<= rt (cdr (fifth inl)))
+    (let ((n (ibtp (cdr (fifth inl)) rt)))
+      (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-coalesce)
+		     "Coalescing return-type ~s: ~s ~s" (car cl) (cdr (fifth inl)) n)
+      (setf (cdr (fifth inl)) n)))
+  (mapl (lambda (x y &aux (cx (car x))(cy (car y)))
+	  (unless (type<= cy cx)
+	    (let ((n (ibtp cx cy)))
+	      (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-coalesce)
+			     "Coalescing arg-type ~s: ~s ~s" (car cl) cx n)
+	      (setf (car x) n))))
+	(car inl) tps))
+
+(defun can-coalesce (x tr inl tps)
+  (and (equal tr (second x))
+       (string= (car (last inl)) (car (last x)))
+       (>= (car inl) (third x))
+       (eql (length tps) (length (car x)))
+       (every 'type>= tps (car x))))
+
+(defun remove-comment (s &aux (b (string-match #v"/\\*" s))(e (string-match #v"\\*/" s)))
+  (if (< -1 b e) (string-concatenate (subseq s 0 b) (remove-comment (subseq s (+ e 2)))) s))
+
+(defun lit-inl2 (form &aux (lf (eq 'lit (car form))))
+  (list (this-safety-level)
+	(mapcar (lambda (x) (assert (eq (car x) 'ub)) (third x)) (when lf (fifth form)))
+	(cons (when lf (third form)) (info-type (cadr form)))
+	(if lf (remove-comment (fourth form)) "")))
+
+(defun cl-to-fn (cl)
+  (when (null (cdr (last cl)))
+    (let ((fn (car cl)))
+      (when (symbolp fn)
+	(unless (local-fun-p fn)
+	  fn)))))
+
+(defun get-inl-list (cl &optional set &aux (fn (cl-to-fn cl)))
+  (when fn
+    (or (gethash fn *inl-hash*)
+	(when set
+	  (setf (gethash fn *inl-hash*) (list nil))))))
+
+(defun inls-match (cl fms &aux (lev (this-safety-level))
+			    (tps (mapcar (lambda (x) (info-type (caddr x))) fms)))
+  (when (member-if-not 'atomic-tp tps)
+    (car (member tps (car (get-inl-list cl))
+		 :test (lambda (x y &aux (cy (car y)))
+			 (when (<= lev (third y))
+			   (when (eql (length x) (length cy))
+			     (every 'type<= x cy))))))))
+
+(defun ?add-inl (cl fms fm)
+  (unless (or (member-if 'atomic-tp fms :key (lambda (x) (info-type (caddr x))))
+	      (atomic-tp (info-type (cadr fm))) (exit-to-fmla-p)); (inls-match cl fms)
+    (let* ((tps (mapcar (lambda (x) (info-type (caddr x))) fms))
+	   (tr (mapcar (lambda (x &aux (v (car (last x))))
+			 (when (and (consp v) (eq (car v) 'var))
+			   (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME
+		       (if (eq (car fm) 'var) (list (list fm)) (fifth fm))))
+	   (nat (let ((i -1)) (mapcan (lambda (x &aux (y (incf i))) (unless (atomic-tp x) (list y))) tps))))
+      (unless (or (member nil tr) (set-difference nat tr))
+	(let* ((pl (get-inl-list cl t))
+	       (inl (lit-inl2 fm))
+	       (z (member-if (lambda (x) (can-coalesce x tr inl tps)) (car pl))))
+	  (cond (z (coalesce-inl cl (car z) tps (cdr (third inl)))
+		   (setf (cdr z) (remove-if (lambda (x) (can-coalesce x tr inl tps)) (cdr z))))
+		(pl
+		 (let ((x (list* tps tr inl)))
+		   (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-add)
+				  "Adding inl-hash ~s: ~s" (car cl) x)
+		   (push x (car pl))))))))))
+
+(defun prepend-comment (form s)
+  (if *annotate*
+      (si::string-concatenate "/* " (prin1-to-string form) " */" (remove-comment s))
+      s))
+
+(defun apply-inl (cl fms &aux (inl (inls-match cl fms)))
+  (when inl
+    (let* ((c1fms (mapcar (lambda (x) (cdr (nth x fms))) (second inl))))
+      (unless (member-if-not (lambda (x)
+			       (case (car x)
+				 (var (eq (var-kind (caaddr x)) 'lexical))
+				 ((lit location) t)))
+			     c1fms)
+	(cond ((zerop (length (car (last inl))))
+	       (let* ((x (car c1fms))(h (pop x))
+		      (i (copy-info (pop x))))
+		 (setf (info-type i) (type-and (cdr (fifth inl)) (info-type i)))
+		 (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply)
+				"Applying var inl-hash ~s" (car cl))
+		 (list* h i x)))
+	      ((let ((x (c1lit (list (car (fifth inl)) (prepend-comment (cons 'applied cl) (car (last inl)))) (mapcar 'list  (fourth inl) c1fms))))
+		 (setf (info-type (cadr x)) (type-and (cdr (fifth inl)) (info-type (cadr x))))
+		 (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply)
+				"Applying inl-hash ~s: ~s: ~s" (car cl) (fourth x))
+		 x)))))))
+
+(defun dump-inl-hash (f)
+  (with-open-file (s f :direction :output)
+    (prin1 '(in-package :compiler) s)
+    (terpri s)
+    (maphash (lambda (x y)
+	       (prin1
+		`(setf (gethash ',x *inl-hash*)
+		       (list
+			(list
+			 ,@(mapcar (lambda (z)
+				     `(list (mapcar 'uniq-tp ',(pop z))
+					    ',(pop z) ',(pop z) ',(pop z)
+					    (cons ',(caar z) (uniq-tp ',(cdar z)))
+					    ,(cadr z)))
+				   (car y)))))
+		      s)
+	       (terpri s))
+	     *inl-hash*))
+  nil)
+
+(defun show-inls (fn)
+  (mapcar (lambda (x) (list (mapcar 'cmp-unnorm-tp (car x)) (third x) (car (last x))))
+	  (car (gethash fn *inl-hash*))))
+
 (defun c1inline (args env inls)
-  (let* ((cl (pop args))
-	 (fm (pop args))
-	 (nargs (under-env env (c1let-* (cdr fm) t inls)))
-	 (s cl))
-    (assert (and (eq (car fm) 'let*) (not args)))
-    (cond ((eq (car nargs) 'var) nargs)
-	  ((list 'inline (copy-info (cadr nargs)) s nargs)))))
+  (let* ((cl (pop args))(fm (pop args)))
+    (or (apply-inl cl inls)
+	(let* ((nargs (under-env env (c1let-* (cdr fm) t inls))))
+	  (case (car nargs)
+	    ((var lit)
+	     (?add-inl cl inls nargs)
+	     (when (stringp (fourth nargs)) (setf (fourth nargs) (prepend-comment cl (fourth nargs))))
+	     nargs)
+	    (otherwise (list 'inline (copy-info (cadr nargs)) cl nargs)))))))
 
 (defvar *annotate* nil)
 
@@ -836,7 +973,7 @@
 ;(defvar *callees* nil)
 
 (defun maybe-reverse-type-prop (dt f)
-  (unless (or *safe-compile* (when (consp f) (eq (car f) 'lit)));FIXME push-vbind/c1var copy
+  (unless *safe-compile*;FIXME push-vbind/c1var copy  (when (consp f) (eq (car f) 'lit))
     (set-form-type f (coerce-to-one-value dt))))
 
 ;; (defun maybe-reverse-type-prop (dt f)
@@ -980,22 +1117,6 @@
 (defun mi4 (fn args la src env inls)
   (c1inline (list (cons fn (append args la)) (blla (cadr src) args la (cddr src))) env inls))
 
-;; (defun mi4 (fn args la src env inls &aux *callees*)
-;;   (let* (;(*compiler-check-args* (>= (this-safety-level) 2))
-;; 	 (src (assert-safety fn (blla (cadr src) args la (cddr src)))))
-;;       (c1inline (list (cons fn (append args la)) src) env inls)))
-
-;; (defun mi4 (fn args la src env inls &aux *callees*)
-;;   (let* ((*compiler-check-args* (>= (this-safety-level) 2))
-;; 	 (src (assert-safety (blla (cadr src) args la (cddr src)))))
-;;       (c1inline (list (cons fn (append args la)) src) env inls)))
-
-;; (defun mi4 (fn args la src env &aux *callees*)
-;;   (let* ((*compiler-check-args* (>= (this-safety-level) 2))
-;; 	 (src (blla (cadr src) args la (cddr src))))
-;;       (assert-safety src)
-;;       (under-env env (c1inline (list (cons fn (append args la)) src)))))
-
 (defun sir-tag (sir)
   (cadar (member-if (lambda (x) (and (eq (caar x) (car sir)) (cdddr x)))
 		    (reverse *src-inline-recursion*))))
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpinline.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpinline.lsp
@@ -440,22 +440,22 @@
     (coerce-loc *value-to-go* type)))
     
 
-(defun lit-loc (tp inl args bind stores)
-  (declare (ignore bind stores))
+(defun lit-loc (key inl args bind safety oargs stores &aux (tp (get key 'cmp-lisp-type)))
+  (declare (ignore bind safety oargs stores))
   (let ((sig (list (mapcar (lambda (x) (info-type (cadr x))) args) tp))) 
     (get-inline-loc (list (car sig) (cadr sig) (flags rfa) inl) args)))
 
-;; (defun lit-loc (tp inl args)
-;;   (let* ((sig (list (mapcar (lambda (x) (info-type (cadr x))) args) tp))) 
-;;     (get-inline-loc (list (car sig) (cadr sig) (flags rfa) inl) args)))
-
 (defun ub-loc (v &aux (c (car v)))
   (ecase c
       (var (cons c (caddr v)))
       (lit (apply 'lit-loc (cddr v)))
-      (location (caddr v))
-      ((decl-body inline) (ub-loc (car (last v))))));FIXME
+      (location (caddr v))));FIXME
 
+(defun args-info-changed-info (i forms)
+  (do-referred (v i)
+    (when (var-p v)
+      (when (args-info-changed-vars v forms)
+	(return-from args-info-changed-info t)))))
 
 (defun inline-args (forms types &optional fun &aux locs ii)
   (do ((forms forms (cdr forms))
@@ -503,7 +503,12 @@
 		       (push (wt-push-loc loc type) locs))
 		      ((push (coerce-loc loc type) locs))))
 		 (push (wt-push-loc form type t) locs)))
-	      (lit (push (coerce-loc (apply 'lit-loc (cddr form)) type) locs))
+	      (lit
+	       (let* ((loc (apply 'lit-loc (cddr form)))
+		      (loc (if (or (args-info-changed-info (cadr form) (cdr forms))
+				   (member-if (lambda (x) (iflag-p (info-flags (cadr x)) side-effects)) (cdr forms)))
+			       (wt-push-loc loc type) (coerce-loc loc type))))
+		 (push loc locs)))
 	      (ub (push (list 'gen-loc (caddr form) (ub-loc (fourth form))) locs))
               (structure-ref (push (coerce-loc-structure-ref (cdr form) type) locs))
               (SETQ
@@ -522,6 +527,7 @@
 			      types (list* type  types))))));; want (setq types (list* type type (cdr  types))) but type is first of types
               (otherwise (push (wt-push-loc form type t) locs))))))
 
+
 ;; (defun inline-args (forms types &optional fun &aux locs ii)
 ;;   (do ((forms forms (cdr forms))
 ;;        (types types (cdr types)))
--- gcl27-2.7.0.orig/cmpnew/gcl_cmptop.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmptop.lsp
@@ -664,114 +664,6 @@
        `(,nm ,regs 
 	     ,@(when doc `(,doc))
 	     ,@rd ,@rc ,@bl)))))
-
-;; (defun new-defun-args (args &optional (tag (tmpsym)))
-;;   (let* ((nm (si::funid-to-sym (car args)))
-;; 	 (args (ttl-tag-src args tag nm))
-;; 	 (args (cdr args))
-;; 	 (ll (pop args))
-;; 	 (opts (member-if (lambda (x) (member x '(&optional &rest &key &aux))) ll)));FIXME centralize
-;;     (multiple-value-bind
-;;      (doc decls ctps args)
-;;      (parse-body-header args)
-;;      (let* ((regs (ldiff ll opts))
-;; 	    (dl (decl-safety decls))
-;; 	    (sl (effective-safety decls))
-;; 	    (s (> sl 0))
-;; 	    (od (split-decls regs decls))
-;; 	    (rd (pop od))
-;; 	    (oc (split-ctps regs ctps))
-;; 	    (rc (pop oc))
-;; 	    (oc (append (when s rc) (car oc)))
-;; 	    (rc (mapcar (lambda (x) `(declare (,@(when s `(hint)) ,(caddr x) ,(cadr x)))) rc))
-;; 	    (rc (cons `(declare (optimize (safety ,dl))) rc))
-;; 	    (narg (when opts +nargs+))
-;; 	    (nr (length regs))
-;; 	    (regs (or regs (when narg (list +first+))))
-;; 	    (m (min 63 (mll ll)))
-;; 	    (args `(,@(car od) ,@oc ,@args))
-;; 	    (opts (if narg (cons narg opts) opts))
-;; 	    (args (if narg `((declare ((integer ,(- m) ,m) ,narg)) ,@args) args))
-;; 	    (opts (cons +mv+ opts))
-;; 	    (args `((declare (ignorable ,+mv+) (fixnum ,+mv+)) ,@args))
-;; 	    (vals `((fun-valp) ,@(when narg `((vfun-nargs)))));FIXME
-;; 	    (bl (list (blla opts vals nil args narg nr (when (eq (car regs) +first+) +first+))))
-;; 	    (bl `((let ((,+fun+ (fun-fun))) (declare (ignorable ,+fun+)) (bind-reg-clv) ,@bl))))
-;;        `(,nm ,regs 
-;; 	     ,@(when doc `(,doc))
-;; 	     ,@rd ,@rc ,@bl)))))
-
-;; (defun new-defun-args (args &optional (tag (tmpsym)))
-;;   (let* ((nm (si::funid-to-sym (car args)))
-;; 	 (args (ttl-tag-src args tag nm))
-;; 	 (args (cdr args))
-;; 	 (ll (pop args))
-;; 	 (opts (member-if (lambda (x) (member x '(&optional &rest &key &aux))) ll)));FIXME centralize
-;;     (multiple-value-bind
-;;      (doc decls ctps args)
-;;      (parse-body-header args)
-;;      (let* ((regs (ldiff ll opts))
-;; 	    (dl (decl-safety decls))
-;; 	    (sl (effective-safety decls))
-;; 	    (s (> sl 0))
-;; 	    (od (split-decls regs decls))
-;; 	    (rd (pop od))
-;; 	    (oc (split-ctps regs ctps))
-;; 	    (rc (pop oc))
-;; 	    (oc (append (when s rc) (car oc)))
-;; 	    (rc (mapcar (lambda (x) `(declare (,@(when s `(hint)) ,(caddr x) ,(cadr x)))) rc))
-;; 	    (rc (cons `(declare (optimize (safety ,dl))) rc))
-;; 	    (narg (when opts +nargs+))
-;; 	    (nr (length regs))
-;; 	    (regs (or regs (when narg (list +first+))))
-;; 	    (m (min 63 (mll ll)))
-;; 	    (args `(,@(car od) ,@oc (bind-reg-clv) ,@args))
-;; 	    (opts (if narg (cons narg opts) opts))
-;; 	    (args (if narg `((declare ((integer ,(- m) ,m) ,narg)) ,@args) args))
-;; 	    (opts (cons +fun+ (cons +mv+ opts)))
-;; 	    (args `((declare (ignorable ,+fun+ ,+mv+) (fixnum ,+mv+)) ,@args))
-;; 	    (vals `((fun-fun) (fun-valp) ,@(when narg `((vfun-nargs)))));FIXME
-;; 	    (bl (list (blla opts vals nil args narg nr (when (eq (car regs) +first+) +first+)))))
-;;        `(,nm ,regs 
-;; 	     ,@(when doc `(,doc))
-;; 	     ,@rd ,@rc ,@bl)))))
-
-;; (defun new-defun-args (args &optional (tag (tmpsym)))
-;;   (let* ((nm (si::funid-to-sym (car args)))
-;; 	 (args (ttl-tag-src args tag nm))
-;; 	 (args (cdr args))
-;; 	 (ll (pop args))
-;; 	 (opts (member-if (lambda (x) (member x '(&optional &rest &key))) ll)))
-;;     (multiple-value-bind
-;;      (doc decls ctps args)
-;;      (parse-body-header args)
-;;      (let* ((regs (ldiff ll opts))
-;; 	    (dl (decl-safety decls))
-;; 	    (sl (effective-safety decls))
-;; 	    (s (> sl 0))
-;; 	    (rd (split-decls regs decls))
-;; 	    (od (cadr rd))
-;; 	    (rd (car rd))
-;; 	    (rc (split-ctps regs ctps))
-;; 	    (oc (cadr rc))
-;; 	    (rc (car rc))
-;; 	    (oc (append (when s rc) oc))
-;; 	    (rc (mapcar (lambda (x) `(declare (,@(when s `(hint)) ,(caddr x) ,(cadr x)))) rc))
-;; 	    (rc (cons `(declare (optimize (safety ,dl))) rc))
-;; 	    (narg (when opts +nargs+))
-;; 	    (nr (length regs))
-;; 	    (regs (or regs (when narg (list +first+))))
-;; 	    (m (min 63 (mll ll)))
-;; 	    (args `(,@od ,@oc (bind-reg-clv) ,@args))
-;; 	    (opts (if narg (cons narg opts) opts))
-;; 	    (args (if narg `((declare ((integer ,(- m) ,m) ,narg)) ,@args) args))
-;; 	    (opts (cons +fun+ (cons +mv+ opts)))
-;; 	    (args `((declare (ignorable ,+fun+ ,+mv+) (fixnum ,+mv+)) ,@args))
-;; 	    (vals `((fun-fun) (fun-valp) ,@(when narg `((vfun-nargs)))));FIXME
-;; 	    (bl (list (blla opts vals nil args narg nr (when (eq (car regs) +first+) +first+)))))
-;;        `(,nm ,regs 
-;; 	     ,@(when doc `(,doc))
-;; 	     ,@rd ,@rc ,@bl)))))
     
 (defun c1va-pop (args)
   (declare (ignore args))
@@ -870,40 +762,126 @@
   
 (defun c1ub (args)
   (let* ((key (pop args))
-;	 (info (make-info :type #topaque :flags (iflags side-effects)));FIXME
 	 (info (make-info :type #topaque))
-	 (nargs (c1args args info)))
-    (list* 'ub info key nargs)))
+	 (c1?form (car args))
+	 (narg (cond ((when (consp c1?form) (info-p (cadr c1?form)));FIXME is this dangerous?
+		      (add-info info (cadr c1?form))
+		      c1?form)
+		     ((c1arg c1?form info)))))
+    (list* 'ub info key (list narg))))
 (setf (get 'ub 'c1) 'c1ub)
 (setf (get 'unbox 'c1) 'c1ub)
 
 
-(let ((ars (let ((i -1))
-	     (mapl (lambda (x)
-		     (setf (car x) (concatenate 'string "#" (write-to-string (incf i)))))
-		   (make-list call-arguments-limit)))))
-  (defun c1lit (args &aux (as ars))
-    (flet ((as nil (assert as) (pop as)))
-	  (let* ((tp (get (pop args) 'cmp-lisp-type :opaque))
-		 (info (make-info :type tp)) ;FIXME boolean
-		 (inl (apply 'concatenate 'string
-			     (mapcar (lambda (x) (if (stringp x) x (as))) args)))
-		 (nargs (mapcan (lambda (x)
-				  (unless (stringp x) (list (c1arg (cons 'ub x) info))))
-				args)))
-	    (when (eq tp :opaque) (baboon))
-	    (when (find #\= inl)
-	      (c1side-effects nil)
-	      (setf (info-flags info) (logior (iflags side-effects) (info-flags info))))
-	    (let ((form (list 'lit info (info-type info) inl nargs nil (make-vs info))))
-	      (setf (sixth form) (new-bind form))
-	      form)))))
-
+(defvar *ars* (let ((i -1))
+		(mapl (lambda (x)
+			(setf (car x) (concatenate 'string "#" (write-to-string (incf i)))))
+		      (make-list call-arguments-limit))))
+
+(defvar *arps* (mapcar (lambda (x)
+			 (compile-regexp (concatenate 'string "(" x ")([^0-9]|$)")))
+		       *ars*))
+
+(defun arg-n (n) (the string (nth n *ars*)));FIXME assert
+(defun arg-pat (n) (nth n *arps*))
+
+(defun argsub (str pat new)
+  (declare (string str new))
+  (let ((x (string-match pat str)))
+    (if (eql x -1) str
+	(concatenate 'string
+		     (subseq str 0 (match-beginning 1))
+		     new
+		     (argsub (subseq str (match-end 1)) pat new)))))
+
+(defun lit-string-merge (s ns i n j &aux (ns (lit-string-move ns 0 (1+ j) i)))
+  (if (< j 0)
+      (lit-string-move (argsub s (arg-pat i) ns) (1+ i) (1+ n) j)
+      (argsub (lit-string-move s (1+ i) (1+ n) j) (arg-pat i) ns)))
+
+(defun lit-string-move (s i n j)
+  (if (> n i)
+      (cond ((eql j 0) s)
+	    ((< j 0) (lit-string-move (argsub s (arg-pat i) (arg-n (+ i j))) (1+ i) n j))
+	    ((argsub (lit-string-move s (1+ i) n j) (arg-pat i) (arg-n (+ i j)))))
+      s))
+
+(defun ml (x &optional key)
+  (case (car x)
+    (ub (ml (car (last x)) (third x)))
+    (location (let* ((fvt (or (car (assoc (info-type (cadr x)) +value-types+ :test 'type<=)) t))
+		     (str (fm-to-string (caddr x))))
+		(when str
+		  (c1lit (list key (loc-str str key fvt))))))
+    (lit (let* ((fvt (get (third x) 'cmp-lisp-type)))
+	   (list* (pop x) (pop x) (pop x) (loc-str (pop x) key fvt) x)))))
+
+(defun fm-to-string (form)
+  (typecase form
+;    (null "Cnil")
+;    (true "Ct")
+    ((cons (eql vv) t) (fm-to-string (cadr form)))
+    ((cons (member char-value fixnum-value character-value) t) (fm-to-string (caddr form)))
+    ((eql most-negative-fixnum)  #.(string-concatenate "(" (write-to-string (1+ most-negative-fixnum)) "- 1)"))
+    (integer (format nil "~a" form)); string character
+    (float (format nil "~10,,,,,,'eG" form))
+    ((complex float)
+     (string-concatenate "(" (fm-to-string (realpart form)) " + I * " (fm-to-string (realpart form)) ")"))))
+
+(defun loc-str (x key ft &aux p (tt (get key 'cmp-lisp-type))(cast (strcat "(" key ")"))(pp (find #\* cast)))
+  (string-concatenate
+   (cond ((member key '(:cnum :creal)) "")
+	 ((eq ft tt) "")
+	  ((equal ft t)
+	   (if *compiler-new-safety*
+	       (let ((v (member key '(:char :int :fixnum))))
+		 (if v (si::string-concatenate (setq p "object_to_") (strcat key))
+		   (si::string-concatenate cast (setq p "object_to_") (if pp "pointer" "dcomplex"))))
+	       (or (setq p (cdr (assoc tt +to-c-var-alist+ :test 'type<=))) cast)))
+	  ((eq tt t) (or (setq p (cdr (assoc ft +wt-c-var-alist+))) ""))
+	 ((and (type>= #tint tt) (type>= tt ft)) "")
+	 ((and (type>= #tcnum tt) (type>= #t(or character cnum) ft)) cast)
+	 ((baboon) ""))
+   (if p "(" "")
+   x
+   (if p ")" "")))
+
+(defun c1lit (args &optional c1args
+	      &aux (lev (this-safety-level))
+		(key (pop args))(tp (get key 'cmp-lisp-type :opaque)))
+  (when (eq tp :opaque) (baboon))
+  (let* ((as *ars*)
+	 (inl (apply 'concatenate 'string
+		     (mapcar (lambda (x) (if (stringp x) x (if as (pop as) (baboon)))) args)))
+	 (info (make-info :type tp));FIXME boolean
+	 (nargs (mapcan (lambda (x) (unless (stringp x) (list (c1arg (cons 'ub x) info))))
+			(or c1args args)))
+	 (oargs nargs)
+	 (lna (length nargs))(i 0)
+	 (nargs (mapcan (lambda (x &aux (f (ml x))(ff (fifth f))(lff (length ff)))
+			  (cond (f (setq inl (lit-string-merge inl (fourth f) i lna (1- lff)))
+				   (setq lev (min lev 1));FIXME?
+;				   (when (> lev (seventh f)) (setq lev (seventh f))); (break)
+				   (incf i lff)(copy-list ff));FIXME?
+				((incf i)(list x))))
+			nargs))
+	 (form (list 'lit info key inl nargs nil lev oargs (make-vs info))))
+    (when (find #\= inl)
+      (c1side-effects nil)
+      (setf (info-flags info) (logior (iflags side-effects) (info-flags info))))
+    (setf (sixth form) (new-bind form))
+    form))
 
-(defun c2lit (tp inl args bind stores)
+(defun c2lit (key inl args bind safety oargs stores &aux (tp (get key 'cmp-lisp-type :opaque)))
   (let* ((*inline-blocks* 0)
-	 (*restore-avma*  *restore-avma*))
-    (unwind-exit (lit-loc tp inl args bind stores) nil (cons 'values (if (equal tp #t(returns-exactly)) 0 1)))
+	 (*restore-avma*  *restore-avma*)
+	 (*compiler-check-args* *compiler-check-args*)
+	 (*safe-compile* *safe-compile*)
+	 (*compiler-new-safety* *compiler-new-safety*)
+	 (*compiler-push-events* *compiler-push-events*))
+    (local-compile-decls `((safety ,safety)))
+    (unwind-exit (lit-loc key inl args bind safety oargs stores) nil
+		 (cons 'values (if (equal tp #t(returns-exactly)) 0 1)))
     (close-inline-blocks)))
 
 ;; (defun c2lit (tp inl args)
--- gcl27-2.7.0.orig/cmpnew/gcl_cmptype.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmptype.lsp
@@ -796,8 +796,7 @@
   (case (car fm)
     (inline (carcdr-c1form-narg (fourth fm)))
     (let* (carcdr-c1form-narg (fifth fm)))
-    (lit (carcdr-c1form-narg (car (fifth fm))))
-    (ub (fourth fm))))
+    (lit (fourth (car (eighth fm))))))
 
 (defun get-binding-form (b &aux (v (get-var b)))
   (if v
@@ -808,11 +807,11 @@
 
 
 (defun co1carcdr (f x);FIXME c1 prop?
-  (let* ((c1form (mi1 f x))
+  (let* ((c1form (mi1 f x));NOTE this cannot be exponential/double eval, esp. for ACL2!
 	 (narg (carcdr-c1form-narg c1form))
 	 (atp (when (and narg (ignorable-form narg)) (atomic-tp (info-type (cadr narg)))))
 	 (tp (car atp))
-	 (b (when (consp tp) (funcall f tp))))
+	 (b (when (consp tp) (funcall f tp))));FIXME nil
     (typecase b
       (null c1form)
       (binding (or (get-binding-form b) c1form))
@@ -1161,17 +1160,20 @@
 
 (defun kingdoms-with-individuals (tp)
   (when (consp tp)
-    (ntp-kingdoms-with-individuals (caddr tp))))
+    (let ((ntp (caddr tp)))
+      (if (caddr ntp)
+	  (mapcar 'car (car (si::ntp-and (caar ntp) (si::ntp-not (cadar ntp)))))
+	  (ntp-kingdoms-with-individuals ntp)))))
 
 
 (declaim (inline bump-individuals))
 (defun bump-individuals (f tp)
   (cond ((cmpt tp) (cons (car tp) (mapcar (lambda (x) (bump-individuals f x)) (cdr tp))))
 	((let* ((x (kingdoms-with-individuals tp))
-		(x (remove-if-not f x :key 'cdr))
-		(x (remove-duplicates (mapcar 'car x))))
+		(x (remove-if-not (lambda (x) (if (consp x) (funcall f (cdr x)) t)) x))
+		(x (remove-duplicates (mapcar (lambda (x) (if (consp x) (car x) x)) x))))
 	   (if x
-	       (compiler::type-or1 (cmp-norm-tp (cons 'or x)) tp)
+	       (type-or1 (cmp-norm-tp (cons 'or x)) tp)
 	       tp)))))
 
 (declaim (inline unprintable-individual-p))
--- gcl27-2.7.0.orig/cmpnew/gcl_cmpvar.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpvar.lsp
@@ -212,8 +212,7 @@
 
 (defun find-vs (form)
   (case (car form)
-    ((var lit) (car (last form)))
-    ((inline decl-body) (find-vs (car (last form))))))
+    ((var lit) (car (last form)))))
 
 (defun c1var (name)
   (let* ((info (make-info))
@@ -292,24 +291,20 @@
     (var form))))
 
 (defun lit-bind (x)
-  (when (consp x)
-    (case (car x)
-      (lit (sixth x))
-      ((inline decl-body) (lit-bind (car (last x)))))))
+  (case (car x)
+    (lit (sixth x))))
 
 (defun get-bind (x)
   (typecase
    x
    ((cons (eql var) t) (when (check-vs (car (last x))) (var-bind (local-var (caddr x)))))
-   ((cons (member inline decl-body) t) (get-bind (car (last x))))
    ((cons (eql lit) t) (when (check-vs (car (last x))) (lit-bind x)))
    (var (var-bind x))
    (binding x)))
 
 (defun repeatable-var-binding (form)
   (case (car form)
-	((var location lit) form)
-	((decl-body inline) (when (repeatable-var-binding (car (last form))) form))))
+	((var location lit) form)))
 
 (defun repeatable-binding-p (form &aux (i (cadr (repeatable-var-binding form))))
   (when i
@@ -555,6 +550,8 @@
 	     (sft (car (last form)) type)
 	     (mapc (lambda (x y) (sft y (var-type x)))
 		   (caddr form) (cadddr form)))
+	    (lit (mapc (lambda (x) (do-setq-tp x nil (type-and nt (var-type x))))
+		       (local-aliases (get-top-var-binding (lit-bind form)) nil)))
 	    (var (do-setq-tp (caaddr form) nil (type-and nt (var-type (caaddr form)))))
 	    (progn (sft (car (last (third form))) type))))))))
 	  ;; (if
--- gcl27-2.7.0.orig/git.tag
+++ gcl27-2.7.0/git.tag
@@ -1,2 +1,2 @@
-"Version_2_7_0pre34"
+"Version_2_7_0pre35"
 
--- gcl27-2.7.0.orig/lsp/gcl_arraylib.lsp
+++ gcl27-2.7.0/lsp/gcl_arraylib.lsp
@@ -118,7 +118,7 @@
 		   `(,(pop y)
 		     (check-type v ,x)
 		     ,(case x
-			(character `(progn (*uchar (c-array-self a) i t (char-code v)) v))
+			(character `(code-char (*uchar (c-array-self a) i t (char-code v))))
 			(bit `(set-0-byte-array-self v a i))
 			(otherwise `(,(caddr y) (c-array-self a) i t v)))))
 		 *array-type-info*)))
--- gcl27-2.7.0.orig/lsp/gcl_predlib.lsp
+++ gcl27-2.7.0/lsp/gcl_predlib.lsp
@@ -100,7 +100,7 @@
 	   (typecase
 	    object
 	    (function object) 
-	    ((and symbol (not boolean)) 
+	    (symbol
 	     (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 m  (integer 0 0))
--- gcl27-2.7.0.orig/lsp/gcl_s.lsp
+++ gcl27-2.7.0/lsp/gcl_s.lsp
@@ -70,7 +70,7 @@
 				      (lit :fixnum "((" (:fixnum x) "&(sizeof(fixnum)-1)) ? "
 					   "({fixnum _t;unsigned char *p1=(void *)(((fixnum *)" (:fixnum x) ")+" (:fixnum o) "),*p2=(void *)&_t,*pe=p1+sizeof(fixnum);for (;p1<pe;) *p2++=*p1++;_t;}) : "
 					   "((fixnum *)" (:fixnum x) ")[" (:fixnum o) "])"))
-				 `(if s (lit ,x "((" ,(strcat x) "*)" (:fixnum x) ")[" (:fixnum o) "]=" (,x y))
+				 `(if s (lit ,x "(((" ,(strcat x) "*)" (:fixnum x) ")[" (:fixnum o) "]=" (,x y) ")")
 				      (lit ,x "((" ,(strcat x) "*)" (:fixnum x) ")[" (:fixnum o) "]"))))) +ks+)))
   (defmacro mfff nil
    `(progn
--- gcl27-2.7.0.orig/lsp/gcl_seq.lsp
+++ gcl27-2.7.0/lsp/gcl_seq.lsp
@@ -100,15 +100,17 @@
    ((++ (x &optional (n 1)) `(prog1 ,x (incf ,x ,n))));FIXME immnum
    (let* ((rs (make-sequence rt (reduce '+ seqs :key 'length :initial-value 0)))
 	  (rt (unless (listp rs) (array-element-type rs)))(rh rs)(i 0))
-     (dolist (seq seqs rs)
-       (let* ((st (unless (listp seq) (array-element-type seq)))(sh seq)(j 0)
-	      (ls (if st (length seq) array-dimension-limit)))
-	 (if (when rt (eq rt st))
-	     (set-array-n rs (++ i ls) seq (++ j ls) ls)
-	     (do nil ((or (>= j ls) (unless st (endp sh))))
-	       (let ((tmp (if st (aref seq (++ j)) (pop sh))))
-		 (if rt (setf (aref rs (++ i)) tmp)
-		     (setf (car rh) tmp rh (cdr rh)))))))))))
+     (mapc ;FIXME dolist does not unroll seqs
+      (lambda (seq &aux (sh seq)(j 0)(st (unless (listp seq) (array-element-type seq)))
+		     (ls (if st (length seq) array-dimension-limit)))
+	(if (when rt (eq rt st))
+	    (set-array-n rs (++ i ls) seq (++ j ls) ls)
+	    (do nil ((or (>= j ls) (unless st (endp sh))))
+	      (let ((tmp (if st (aref seq (++ j)) (pop sh))))
+		(if rt (setf (aref rs (++ i)) tmp)
+		    (setf (car rh) tmp rh (cdr rh)))))))
+      seqs)
+     rs)))
 
 (eval-when
  (compile eval)
--- gcl27-2.7.0.orig/makefile
+++ gcl27-2.7.0/makefile
@@ -52,10 +52,12 @@ gprof_objs: $(addprefix $(PORTDIR)/,$(ad
 $(PORTDIR)/saved_gcl_gprof: $(PORTDIR)/saved_gcl
 	mkdir -p gprof
 	for i in o lsp cmpnew xgcl-2; do $(MAKE) -C $$i gprof_objs; done
+	cp cmpnew/gcl_cmpnopt.lsp.saved_gcl cmpnew/gcl_cmpnopt.lsp
 	$(MAKE) -C unixport $(@F)
 
 $(PORTDIR)/saved_ansi_gcl_gprof: $(PORTDIR)/saved_gcl_gprof $(PORTDIR)/saved_ansi_gcl
 	for i in mod pcl clcs; do $(MAKE) -C $$i gprof_objs; done
+	cp cmpnew/gcl_cmpnopt.lsp.saved_ansi_gcl cmpnew/gcl_cmpnopt.lsp
 	$(MAKE) -C unixport $(@F)
 
 ASRC:=$(shell ls -1 o/*.c o/*.d o/*.h h/*.h lsp/*.lsp cmpnew/*.lsp mod/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h
@@ -93,6 +95,7 @@ $(PORTDIR)/saved_pre_gcl: $(HDIR)cmpincl
 	(cd $(BINDIR); $(MAKE) all)
 	$(MAKE) mpfiles
 	rm -f o/cmpinclude.h ; cp h/cmpinclude.h o
+	rm -f cmpnew/gcl_cmpnopt.lsp
 	(cd $(ODIR); $(MAKE) all)
 	$(MAKE) $<
 	rm -f o/cmpinclude.h ; cp h/cmpinclude.h o
@@ -114,6 +117,7 @@ $(PORTDIR)/saved_gcl2: $(PORTDIR)/saved_
 
 $(PORTDIR)/saved_gcl: $(PORTDIR)/saved_gcl2 $(HDIR)cmpinclude.h
 	cd $(@D) && echo '(time (load "boot.lisp"))' | ./$(<F) && $(MAKE) $(@F)
+	cp cmpnew/gcl_cmpnopt.lsp cmpnew/gcl_cmpnopt.lsp.saved_gcl
 	echo '(si::do-recomp t)' | $@ && cd $(@D) && $(MAKE) $(@F)
 
 $(PORTDIR)/saved_mod_gcl: $(PORTDIR)/saved_gcl
@@ -128,6 +132,7 @@ $(PORTDIR)/saved_pcl_gcl: $(PORTDIR)/sav
 
 $(PORTDIR)/saved_ansi_gcl: $(PORTDIR)/saved_pcl_gcl
 	(cd $(CLCSDIR); $(MAKE) clean; $(MAKE) all)
+	cp cmpnew/gcl_cmpnopt.lsp cmpnew/gcl_cmpnopt.lsp.saved_ansi_gcl
 	cd $(@D) && $(MAKE) $(@F)
 
 ansi-tests/test_results: $(PORTDIR)/saved_ansi_gcl
--- gcl27-2.7.0.orig/mod/makefile
+++ gcl27-2.7.0/mod/makefile
@@ -10,35 +10,17 @@ CAT=cat
 APPEND=../xbin/append
 
 OBJS	= gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o gcl_ansi_io.o $(EXTRA_LOBJS)
-# gcl_ansi_io.o export.o autoload.o auto_new.o
+SRCS	= gcl_destructuring_bind.lsp gcl_defpackage.lsp gcl_make_defpackage.lsp gcl_loop.lsp gcl_ansi_io.lsp
 
 LISP=$(PORTDIR)/saved_gcl
 
 COMPILE_FILE=$(LISP) $(PORTDIR) $(LISPFLAGS) -system-p -c-file -data-file \
 	-h-file -compile
-#CFLAGS	= -c -O -I../h 
 
-# .lsp.c: 
-# 	@ ../xbin/if-exists $(PORTDIR)/saved_gcl \
-# 	"rm -f $*.c $*.h $*.data $*.o" \
-# 	"$(COMPILE_FILE) $* "
-
-# .lsp.o: 
-# 	 @ ../xbin/if-exists $(PORTDIR)/saved_gcl \
-# 	"rm -f $*.c $*.h $*.data $*.o" \
-# 	"$(COMPILE_FILE) $* " \
-# 	"$(CC) $(OFLAG) $(CFLAGS) -c $*.c " \
-# 	"${APPEND} ${NULLFILE} $*.data $*.o "
-
-
-
-# .lsp.o: $(PORTDIR)/saved_gcl
-# 	rm -f $*.c $*.h $*.data $*.o
-# 	$(COMPILE_FILE) $*.lsp
-# #	$(CC) $(OFLAG) $(CFLAGS) -c $*.c
-# #	${APPEND} ${NULLFILE} $*.data $*.o
+all:	$(OBJS)
 
-all:	$(OBJS) #$(RL_OBJS)
+$(OBJS): $(SRCS) $(LISP)
+	echo "(progn (compiler::cdebug) (mapc (quote compile-file) (mapcar (quote string-downcase) (quote ($(SRCS))))) (compiler::dump-inl-hash \"../cmpnew/gcl_cmpnopt.lsp\"))" | $(LISP)
 
 gprof_objs: $(addprefix ../gprof/,$(OBJS))
 
@@ -49,11 +31,6 @@ gprof_objs: $(addprefix ../gprof/,$(OBJS
 %.o: %.lsp $(LISP)
 	$(COMPILE_FILE) $<
 
-
-# .c.o:
-# 	$(CC) $(OFLAG) $(CFLAGS) -c $*.c
-# 	${APPEND} ${NULLFILE} $*.data  $*.o
-
 .lsp.fn: ../cmpnew/gcl_collectfn.o
 	../xbin/make-fn $*.lsp
 
@@ -64,10 +41,6 @@ fns1:	$(FNS)
 fns:	../cmpnew/gcl_collectfn.o
 	$(MAKE) fns1 -e "FNS=`echo ${OBJS} | sed -e 's:\.o:\.fn:g'`"
 
-#../cmpnew/collectfn.o: ../cmpnew/collectfn.lsp
-#	(cd ../cmpnew ; $(PORTDIR)/saved_gcl $(PORTDIR)/ collectfn.lisp collectfn S1000)
-
-
 clean:
 	rm -f *.o core a.out *.fn *.c *.h *.data
 allclean:
--- gcl27-2.7.0.orig/pcl/makefile
+++ gcl27-2.7.0/pcl/makefile
@@ -62,7 +62,7 @@ remake-sys-files:
 		| $(LISP) ../unixport/ $(LISPFLAGS)
 	$(MAKE) clean
 	$(MAKE)
-	echo $(SETUP) '(pcl::load-pcl)(si::all-conflicts)' \
+	echo $(SETUP) '(pcl::load-pcl)(si::all-conflicts)(compiler::dump-inl-hash "../cmpnew/gcl_cmpnopt.lsp")' \
 		| $(LISP) ../unixport/ $(LISPFLAGS)
 
 tar:
--- gcl27-2.7.0.orig/unixport/boot.lisp
+++ gcl27-2.7.0/unixport/boot.lisp
@@ -58,3 +58,22 @@
   (si::chdir "../xgcl-2")
   (load "sysdef.lisp")(load "sys-proclaim.lisp")(compiler::cdebug))
 #+(and pre-gcl xgcl)(xlib::compile-xgcl)
+
+(in-package :compiler)
+;FIXME safety 2
+(dolist (l '(sbit svref schar char));ensure in *inl-hash*
+  (compile nil `(lambda (x y) (declare (optimize (safety 1))) (,l x y)))
+  (compile nil `(lambda (x y z) (declare (optimize (safety 1))) (setf (,l x y) z))))
+
+(dolist (l si::+array-types+)
+  (compile nil `(lambda (x y) (declare (optimize (safety 1))((vector ,l) x)) (aref x y)))
+  (compile nil `(lambda (x y z) (declare (optimize (safety 1))((vector ,l) x)(,l z)) (setf (aref x y) z)))
+  (compile nil `(lambda (x y z) (declare (optimize (safety 1))((vector ,l) x)) (setf (aref x y) z))))
+
+(compile nil `(lambda (x) (declare (optimize (safety 1))((or simple-vector simple-string simple-bit-vector) x)) (length x)))
+
+(compile nil `(lambda (x) (declare (optimize (safety 2))) (address x)))
+(compile nil `(lambda (x) (declare (optimize (safety 2))) (nani x)))
+
+(when (fboundp 'compiler::dump-inl-hash)
+  (compiler::dump-inl-hash "../cmpnew/gcl_cmpnopt.lsp"))
--- gcl27-2.7.0.orig/unixport/init_raw.lsp.in
+++ gcl27-2.7.0/unixport/init_raw.lsp.in
@@ -64,6 +64,8 @@
   (load (make-pathname :name "tk-package" :type "lsp" :directory gtk))
   (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew))
   (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew))
+  (let ((x (make-pathname :name "gcl_cmpnopt" :type "lsp" :directory cmpnew)))
+    (when (probe-file x) (load x)))
   (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp))
   
   (gbc t))
