cmp: don't pass "raw" boolean values in the second pass

T and NIL are expected to be wrapped in an intermediate structure representing
the value. This improves the separation between the host and the target language.

src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp

@@ -138,10 +138,11 @@
 
 (define-c-inliner float (return-type arg &optional float)
   (let ((arg-c-type (lisp-type->rep-type (inlined-arg-type arg)))
-        (flt-c-type (lisp-type->rep-type (inlined-arg-type float))))
-    (when (member flt-c-type '(:float :double :long-double))
-      (if (eq arg-c-type flt-c-type)
-          (inlined-arg-loc arg)
+        (flt-c-type (and float (lisp-type->rep-type (inlined-arg-type float)))))
+    (if (member arg-c-type '(:float :double :long-double))
+        (when (or (null float) (eq arg-c-type flt-c-type))
+          (inlined-arg-loc arg))
+        (when (member flt-c-type '(:float :double :long-double))
           (produce-inline-loc (list arg)
                               (list :object)
                               (list flt-c-type)

src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp

@@ -13,6 +13,8 @@
 (in-package "COMPILER")
 
 (define-c-inliner cl:princ (return-type expression &optional stream)
+  (unless stream
+    (setf stream (emit-inline-form *c1nil* nil)))
   (multiple-value-bind (foundp value)
       (loc-immediate-value-p (inlined-arg-loc expression))
     (cond

src/cmp/cmpbackend-cxx/cmppass2-data.lsp

@@ -241,6 +241,8 @@
 
 (defun wt-vv-value (vv value)
   (etypecase value
+    ((eql CL:T)      (wt "ECL_T"))
+    ((eql CL:NIL)    (wt "ECL_NIL"))
     (fixnum          (wt-fixnum value vv))
     (character       (wt-character value vv))
     (float           (wt-number value vv))

src/cmp/cmpbackend-cxx/cmppass2-eval.lsp

@@ -91,7 +91,7 @@
                (case rep-type
                  (:bool '((:bool) (:object) "(#0)?ECL_NIL:ECL_T" nil t))
                  (:object '((:object) (:object) "Null(#0)?ECL_T:ECL_NIL" nil t))
-                 (otherwise (return-from negate-argument nil)))))))
+                 (otherwise (return-from negate-argument *vv-nil*)))))))
 
 (defun c2fmla-not (c1form arg)
   (declare (ignore c1form))
@@ -129,7 +129,7 @@
           (let ((*destination* `(JUMP-FALSE ,false-label)))
             (mapc #'c2expr* butlast))
           (c2expr last))
-        (unwind-exit nil))))
+        (unwind-exit *vv-nil*))))
 
 (defun c2fmla-or (c1form butlast last)
   (declare (ignore c1form))
@@ -141,7 +141,7 @@
            (let ((*destination* `(JUMP-TRUE ,true-label)))
              (mapc #'c2expr* butlast))
            (c2expr last))
-         (unwind-exit t))
+         (unwind-exit *vv-t*))
         (t
          (with-exit-label (common-exit)
            (with-exit-label (normal-exit)
@@ -240,7 +240,7 @@
            (wt-nl "cl_env_copy->nvalues = 0;")
            (unwind-exit 'VALUES))
           (t
-           (unwind-exit 'NIL))))
+           (unwind-exit *vv-nil*))))
    ;; For a single form, we must simply ensure that we only take a single
    ;; value of those that the function may output.
    ((endp (rest forms))

src/cmp/cmpbackend-cxx/cmppass2-exit.lsp

@@ -67,10 +67,12 @@
     (case (car *destination*)
       (JUMP-TRUE
        (set-jump-true loc (second *destination*))
-       (when (eq loc t) (return-from unwind-exit)))
+       (when (eq loc *vv-t*)
+         (return-from unwind-exit)))
       (JUMP-FALSE
        (set-jump-false loc (second *destination*))
-       (when (eq loc nil) (return-from unwind-exit)))))
+       (when (eq loc *vv-nil*)
+         (return-from unwind-exit)))))
   (dolist (ue *unwind-exit* (baboon-improper-*exit*))
     ;; perform all unwind-exit's which precede *exit*
     (cond

src/cmp/cmpbackend-cxx/cmppass2-fun.lsp

@@ -44,7 +44,7 @@
            (wt "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";")))
      ;; bind closed locations because of possible circularities
        (loop for var in closed-vars
-          do (bind nil var)))
+          do (bind *vv-nil* var)))
   ;; create the functions:
   (mapc #'new-local funs)
   ;; - then assign to it
@@ -204,7 +204,8 @@
         (wt-nl "if (i >= narg) {")
         (let ((*opened-c-braces* (1+ *opened-c-braces*)))
           (bind-init (second opt) (first opt))
-          (when (third opt) (bind nil (third opt))))
+          (when (third opt)
+            (bind *vv-nil* (third opt))))
         (wt-nl "} else {")
         (let ((*opened-c-braces* (1+ *opened-c-braces*))
               (*unwind-exit* *unwind-exit*))
@@ -212,7 +213,8 @@
           (bind va-arg-loc (first opt))
           (if (car type-check)
               (c2expr* (car type-check)))
-          (when (third opt) (bind t (third opt))))
+          (when (third opt)
+            (bind *vv-t* (third opt))))
         (wt-nl "}"))
       (wt-nl-close-brace)))
 
@@ -230,7 +232,8 @@
            ;; declaration on some variables.
            (if rest (wt ",(cl_object*)&" rest-loc) (wt ",NULL"))
            (wt (if allow-other-keys ",TRUE);" ",FALSE);"))))
-    (when rest (bind rest-loc rest)))
+    (when rest
+      (bind rest-loc rest)))
 
   (when varargs
     (wt-nl (if simple-varargs "va_end(args);" "ecl_va_end(args);")))
@@ -252,7 +255,7 @@
           (init (third kwd))
           (flag (fourth kwd)))
       (cond ((and (eq (c1form-name init) 'LOCATION)
-                  (null (c1form-arg 0 init)))
+                  (eq (c1form-arg 0 init) *vv-nil*))
              ;; no initform
              ;; ECL_NIL has been set in keyvars if keyword parameter is not supplied.
              (setf (second KEYVARS[i]) i)

src/cmp/cmpbackend-cxx/cmppass2-loc.lsp

@@ -175,15 +175,6 @@
               (wt "ecl_fdefinition(" vv ")")))
         ;; #'(SETF symbol)
         (if safe
-            #+(or)
-            (let ((set-loc (assoc name *setf-definitions*)))
-              (unless set-loc
-                (let* ((setf-vv (data-empty-loc))
-                       (name-vv (add-symbol name))
-                       (setf-form-vv (add-object fun-name)))
-                  (setf set-loc (list name setf-vv name-vv setf-form-vv))
-                  (push set-loc *setf-definitions*)))
-              (wt "ECL_SETF_DEFINITION(" (second set-loc) "," (fourth set-loc) ")"))
             (let ((set-loc (assoc name *setf-definitions*)))
               (unless set-loc
                 (let* ((setf-vv (data-empty-loc))

src/cmp/cmpbackend-cxx/cmppass2-var.lsp

@@ -196,7 +196,7 @@
         (let ((*destination* var)) (c2expr* form))))
   (dolist (save saves) (set-var (cdr save) (car save)))
   (wt-nl-close-many-braces braces)
-  (unwind-exit nil))
+  (unwind-exit *vv-nil*))
 
 ;;; bind must be called for each variable in a lambda or let, once the value
 ;;; to be bound has been placed in loc.

src/cmp/cmplocs.lsp

@@ -162,9 +162,7 @@
 
 (defun loc-in-c1form-movable-p (loc)
   "A location that is in a C1FORM and can be moved"
-  (cond ((member loc '(t nil))
-         t)
-        ((numberp loc)
+  (cond ((numberp loc)
          t)
         ((stringp loc)
          t)
@@ -191,11 +189,7 @@
                 (eq (sixth loc) 'cl:VALUES)))))
 
 (defun loc-immediate-value-p (loc)
-  (cond ((eq loc t)
-         (values t t))
-        ((eq loc nil)
-         (values t nil))
-        ((numberp loc)
+  (cond ((numberp loc)
          (values t loc))
         ((vv-p loc)
          (let ((value (vv-value loc)))

src/cmp/cmppass1-eval.lsp

@@ -55,9 +55,19 @@
        (when (c1form-p form)
          (return form)))))
 
-(defvar *c1nil* (make-c1form* 'LOCATION :type (object-type nil) :args nil))
+(defvar *vv-nil*
+  (make-vv :value CL:NIL))
+
+(defvar *vv-t*
+  (make-vv :value CL:T))
+
+(defvar *c1nil*
+  (make-c1form* 'LOCATION :type (object-type nil) :args *vv-nil*))
+
+(defvar *c1t*
+  (make-c1form* 'LOCATION :type (object-type t) :args *vv-t*))
+
 (defun c1nil () *c1nil*)
-(defvar *c1t* (make-c1form* 'LOCATION :type (object-type t) :args t))
 (defun c1t () *c1t*)
 
 (defun c1with-backend (forms)

src/cmp/cmptables.lsp

@@ -189,14 +189,11 @@
 
     (si:structure-ref . wt-structure-ref)
 
-    (cl:nil . "ECL_NIL")
-    (cl:t . "ECL_T")
     (cl:return . "value0")
     (cl:values . "cl_env_copy->values[0]")
     (va-arg . "va_arg(args,cl_object)")
     (cl-va-arg . "ecl_va_arg(args)")
-    (value0 . "value0")
-    ))
+    (value0 . "value0")))
 
 (defconstant +c2-dispatch-alist+
   '((cl:block . c2block)