Changeset 14417

Timestamp:

Nov 7, 2010, 1:00:06 PM (14 years ago)

Author:

Gary Byers

Message:

No more *NX-NIL*, *NX-T*.

Location:

trunk/source/compiler

Files:

• ARM/arm2.lisp (modified) (2 diffs)
• PPC/ppc2.lisp (modified) (3 diffs)
• X86/x862.lisp (modified) (1 diff)
• nx-basic.lisp (modified) (4 diffs)
• nx0.lisp (modified) (5 diffs)
• nx1.lisp (modified) (5 diffs)
• nxenv.lisp (modified) (2 diffs)

trunk/source/compiler/ARM/arm2.lisp

@@ -7439 +7439 @@
                          j
                          (if *arm2-reckless*
-                           *nx-nil*
+                           (make-nx-nil)
                            (nx-lookup-target-uvector-subtag keyword ))
                          keyword        ;(make-acode (%nx1-operator immediate) )
@@ -7494 +7494 @@
                          k
                          (if *arm2-reckless*
-                           *nx-nil*
+                           (make-nx-nil)
                            (nx-lookup-target-uvector-subtag keyword ))
                          keyword ;(make-acode (%nx1-operator immediate) )

trunk/source/compiler/PPC/ppc2.lisp

@@ -7634 +7634 @@
 (defppc2 ppc2-fixnum-overflow fixnum-overflow (seg vreg xfer form)
   (destructuring-bind (op n0 n1) (acode-unwrapped-form form)
-    (ppc2-use-operator op seg vreg xfer n0 n1 *nx-t*)))
+    (ppc2-use-operator op seg vreg xfer n0 n1 (make-nx-t))))
 
 
@@ -7678 +7678 @@
                          j
                          (if *ppc2-reckless*
-                           *nx-nil*
+                           (make-nx-nil)
                            (nx-lookup-target-uvector-subtag keyword ))
                          keyword        ;(make-acode (%nx1-operator immediate) )
@@ -7733 +7733 @@
                          k
                          (if *ppc2-reckless*
-                           *nx-nil*
+                           (make-nx-nil)
                            (nx-lookup-target-uvector-subtag keyword ))
                          keyword ;(make-acode (%nx1-operator immediate) )

trunk/source/compiler/X86/x862.lisp

@@ -8699 +8699 @@
 (defx862 x862-fixnum-overflow fixnum-overflow (seg vreg xfer form)
   (destructuring-bind (op n0 n1) (acode-unwrapped-form form)
-    (x862-use-operator op seg vreg xfer n0 n1 *nx-t*)))
+    (x862-use-operator op seg vreg xfer n0 n1 (make-nx-t))))
 
 (defx862 x862-%aref2 simple-typed-aref2 (seg vreg xfer typename arr i j &optional dim0 dim1)

trunk/source/compiler/nx-basic.lisp

@@ -838 +838 @@
 
 (defun decomp-form (acode)
-  (cond ((eq acode *nx-t*) t)
-        ((eq acode *nx-nil*) nil)
+  (cond ((nx-null acode) t)
+        ((nx-t acode) nil)
         (t (let* ((op (car acode))
                   (num (length *next-nx-operators*))
@@ -888 +888 @@
           (opts (when opt (cons '&optional (apply #'mapcar
                                                   (lambda (var init supp)
-                                                    (if (and (not supp) (eq init *nx-nil*))
+                                                    (if (and (not supp) (nx-null init))
                                                       (decomp-arg var)
                                                       (list* (decomp-arg var)
@@ -904 +904 @@
                                                               sym
                                                               (list key sym))))
-                                                  (if (and (not supp) (eq init *nx-nil*) (eq arg sym))
+                                                  (if (and (not supp) (nx-null init) (eq arg sym))
                                                     sym
                                                     (list* arg
@@ -914 +914 @@
                    (cons '&aux (apply #'mapcar
                                       (lambda (var init)
-                                        (if (eq init *nx-nil*)
+                                        (if (nx-null init)
                                           (decomp-arg var)
                                           (list (decomp-arg var) (decomp-form init))))

trunk/source/compiler/nx0.lisp

@@ -66 +66 @@
 
 (defvar *nx-lambdalist* (make-symbol "lambdalist"))
-(defvar *nx-nil* (make-acode (%nx1-operator nil)))
-(defvar *nx-t* (make-acode (%nx1-operator t)))
+
+(defmacro make-nx-nil () `(make-acode ,(%nx1-operator nil)))
+(defmacro make-nx-t () `(make-acode `(%nx1-operator t)))
 
 (defun %nx-null (x)
-  (or (eq x *nx-nil*)
-      (if (acode-p x)
-        (eql (acode-operator x)
-             (%nx1-operator nil)))))
+  (let* ((x (acode-unwrapped-form x)))
+    (if (acode-p x)
+      (eql (acode-operator x)
+           (%nx1-operator nil)))))
 
 (defun %nx-t (x)
-  (or (eq x *nx-t*)
-      (if (acode-p x)
-        (eql (acode-operator x)
-             (%nx1-operator t)))))
+  (let* ((x (acode-unwrapped-form x)))
+        (if (acode-p x)
+          (eql (acode-operator x)
+               (%nx1-operator t)))))
 
 (defparameter *nx-current-compiler-policy* (%default-compiler-policy))
@@ -449 +450 @@
           (if (nx-null form)
             'null
-            (if (eq form *nx-t*)
+            (if (nx-t form)
               'boolean
               (nx-target-type 
@@ -1587 +1588 @@
         (until (eq keytail auxtail)
           (unless (eq (setq sym (pop keytail)) '&allow-other-keys)      
-            (setq kinit *nx-nil* ksupp nil)
+            (setq kinit (make-nx-nil) ksupp nil)
             (if (atom sym)
               (setq kvar sym kkey (make-keyword sym))
@@ -1683 +1684 @@
         (until (eq keytail auxtail)
           (unless (eq (setq sym (pop keytail)) '&allow-other-keys)      
-            (setq kinit *nx-nil* ksupp nil)
+            (setq kinit (make-nx-nil) ksupp nil)
             (if (atom sym)
               (setq kvar sym kkey (make-keyword sym))
@@ -1781 +1782 @@
 
 (defun nx1-immediate (form)
-  #+notyet
   (cond ((eq form t) (make-acode (%nx1-operator t)))
         ((null form) (make-acode (%nx1-operator nil)))
         ((nx1-target-fixnump form)
          (make-acode (%nx1-operator fixnum) form))
-        (t (make-acode (%nx1-operator immediate) form)))
-  #-notyet
-  (if (or (eq form t) (null form))
-    (nx1-sysnode form)
-    (make-acode
-     (if (nx1-target-fixnump form) 
-       (%nx1-operator fixnum)
-       (%nx1-operator immediate))   ; Screw: chars
-     form)))
+        (t (make-acode (%nx1-operator immediate) form))))
 
 (defun nx2-constant-form-value (form)

trunk/source/compiler/nx1.lisp

@@ -1422 +1422 @@
            (%nx1-operator let*)
            (list catchvar indexvar)
-           (list (make-acode (%nx1-operator cons) *nx-nil* *nx-nil*) *nx-nil*)
+           (list (make-acode (%nx1-operator cons) (make-nx-nil) (make-nx-nil)) (make-nx-nil))
            (make-acode
             (%nx1-operator local-tagbody)
@@ -1441 +1441 @@
                  body)))
               (make-acode (%nx1-operator local-go) looplabel)
-              *nx-nil*)))
+              (make-nx-nil))))
            0))))))
 
@@ -2012 +2012 @@
                   (progn
                     (push (%car optvars) vars) (push (%car arglist) vals)
-                    (when (%car spvars) (push (%car spvars) vars) (push *nx-t* vals)))
+                    (when (%car spvars) (push (%car spvars) vars) (push (make-nx-t) vals)))
                   (progn
                     (push (%car optvars) vars*) (push (%car inits) vals*)
-                    (when (%car spvars) (push (%car spvars) vars*) (push *nx-nil* vals*))))
+                    (when (%car spvars) (push (%car spvars) vars*) (push (make-nx-nil) vals*))))
                 (setq optvars (%cdr optvars) spvars (%cdr spvars) inits (%cdr inits)
                       arglist (%cdr arglist))))
@@ -2022 +2022 @@
                 (nx-error "Extra args ~s for (LAMBDA ~s ...)" args lambda-list))
               (when rest
-                (push rest vars*) (push *nx-nil* vals*)
-                (nx1-punt-bindings (cons rest nil) (cons *nx-nil* nil))
+                (push rest vars*) (push (make-nx-nil) vals*)
+                (nx1-punt-bindings (cons rest nil) (cons (make-nx-nil) nil))
                 (setq rest nil)))
             (when keys
@@ -2050 +2050 @@
                           (when (%car spvars)
                             (push (%car spvars) vars*)
-                            (push (if (%svref keyargs i) *nx-t* *nx-nil*) vals*))
+                            (push (if (%svref keyargs i) (make-nx-t) (make-nx-nil)) vals*))
                           (setq keyvars (%cdr keyvars) inits (%cdr inits) spvars (%cdr spvars)))
                         (setq keys hit))

trunk/source/compiler/nxenv.lisp

@@ -506 +506 @@
           nx-adjust-setq-count
           nx-init-var
-          nx1-sysnode
           ))
 
@@ -558 +557 @@
 
 
-(defun nx1-sysnode (form)
-  (if form
-    (if (eq form t)
-      *nx-t*)
-    *nx-nil*))
+
 )