No temp cons

compiler/ARM/arm2.lisp

@@ -9371,18 +9371,6 @@ v idx-reg constidx val-reg (arm2-unboxed-reg-for-aset seg type-keyword val-reg s
                                          (t :u32))))))))
         (^))))))
 
-
-
-
-
-
-(defarm2 arm2-%temp-list %temp-list (seg vreg xfer arglist)
-  (arm2-use-operator (%nx1-operator list) seg vreg xfer arglist))
-
-(defarm2 arm2-%temp-cons %temp-cons (seg vreg xfer car cdr)
-  (arm2-use-operator (%nx1-operator cons) seg vreg xfer car cdr))
-
-
 ;;; Under MacsBug 5.3 (and some others ?), this'll do a low-level user
 ;;; break.  If the debugger doesn't recognize the trap instruction,
 ;;; you'll have to manually advance the PC past it.  "arg" winds up in the

compiler/PPC/ppc2.lisp

@@ -8688,16 +8688,6 @@
                                                 (t :u32))))))))
       (^)))
 
-
-
-
-(defppc2 ppc2-%temp-list %temp-list (seg vreg xfer arglist)
-  (ppc2-use-operator (%nx1-operator list) seg vreg xfer arglist))
-
-(defppc2 ppc2-%temp-cons %temp-cons (seg vreg xfer car cdr)
-  (ppc2-use-operator (%nx1-operator cons) seg vreg xfer car cdr))
-
-
 ;;; Under MacsBug 5.3 (and some others ?), this'll do a low-level user
 ;;; break.  If the debugger doesn't recognize the trap instruction,
 ;;; you'll have to manually advance the PC past it.  "arg" winds up in the

compiler/X86/x862.lisp

@@ -11310,16 +11310,6 @@
       (x862-x8664-ff-call-return seg vreg resultspec)
       (^))))
 
-
-
-(defx862 x862-%temp-list %temp-list (seg vreg xfer arglist)
-  (x862-use-operator (%nx1-operator list) seg vreg xfer arglist))
-
-(defx862 x862-%temp-cons %temp-cons (seg vreg xfer car cdr)
-  (x862-use-operator (%nx1-operator cons) seg vreg xfer car cdr))
-
-
-
 (defx862 x862-%debug-trap %debug-trap (seg vreg xfer arg)
   (x862-one-targeted-reg-form seg arg ($ *x862-arg-z*))
   (! %debug-trap)

compiler/acode-rewrite.lisp

@@ -681,7 +681,7 @@
       ))))
 
 
-(def-acode-rewrite acode-rewrite-formlist (list values %temp-list vector) asserted-type (formlist)
+(def-acode-rewrite acode-rewrite-formlist (list values vector) asserted-type (formlist)
   (dolist (form formlist) (rewrite-acode-form form)))
 
 (def-acode-rewrite acode-rewrite-multiple-value-bind multiple-value-bind asserted-type (vars valform body p2decls)

compiler/nx-basic.lisp

@@ -1032,7 +1032,7 @@
       (decomp-form (car form-list))
       `(,op ,@(decomp-formlist form-list)))))
 
-(defdecomp (prog1 multiple-value-prog1 or list %temp-list values) (op form-list)
+(defdecomp (prog1 multiple-value-prog1 or list values) (op form-list)
   `(,op ,@(decomp-formlist form-list)))
 
 (defdecomp multiple-value-call (op fn form-list)

compiler/nx1.lisp

@@ -494,9 +494,7 @@
 (defnx1 nx1-%null-ptr-p ((%null-ptr-p)) context (ptr)
   (nx1-form :value `(%ptr-eql ,ptr (%int-to-ptr 0))))
 
-(defnx1 nx1-binop ( (%ilsl) (%ilsr) (%iasr)
-                   (cons) (%temp-cons)) context
-        (arg1 arg2)
+(defnx1 nx1-binop ((%ilsl) (%ilsr) (%iasr) (cons)) context (arg1 arg2)
   (make-acode (%nx1-default-operator) (nx1-form :value arg1) (nx1-form :value arg2)))
 
 
@@ -806,7 +804,7 @@
                 (nx1-form :value v)))
 
 
-(defnx1 nx1-list-vector-values ((list) (vector) (values) (%temp-list)) context (&rest args)
+(defnx1 nx1-list-vector-values ((list) (vector) (values)) context (&rest args)
   (make-acode (%nx1-default-operator) (nx1-formlist context args)))
 
 

compiler/nxenv.lisp

@@ -268,8 +268,8 @@
      (with-variable-c-frame  #.(logior operator-acode-list-mask operator-assignment-free-mask) :infer)
      (uvref  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
      (uvset  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
-     (%temp-cons  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) cons)
-     (%temp-List  #.(logior operator-single-valued-mask operator-side-effect-free-mask) list)
+     ()                                 ;was %temp-cons
+     ()                                 ;was %temp-list
      (%make-uvector  #.(logior operator-assignment-free-mask operator-single-valued-mask  operator-side-effect-free-mask operator-acode-subforms-mask) :infer)
      (%decls-body  0 :infer)
      (%old-gvector  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
@@ -458,19 +458,6 @@
 
 (defconstant $eaclosedbit 24)
 
-(defmacro %temp-push (value place &environment env)
-  (if (not (consp place))
-    `(setq ,place (%temp-cons ,value ,place))
-    (multiple-value-bind (dummies vals store-var setter getter)
-                         (get-setf-expansion place env)
-      (let ((valvar (gensym)))
-        `(let* ((,valvar ,value)
-                ,@(mapcar #'list dummies vals)
-                (,(car store-var) (%temp-cons ,valvar ,getter)))
-           ,@dummies
-           ,(car store-var)
-           ,setter)))))
-
 ; undo tokens :
 
 (defconstant $undocatch 0)  ; do some nthrowing
@@ -539,9 +526,9 @@
                  0)
                 (if (proclaimed-ignore-p sym) (%ilsl $vbitignore 1) 0))))
     (push node (lexenv.variables env))
-    (%temp-push node *nx-all-vars*)
+    (push node *nx-all-vars*)
     (setf (var-binding-info node) *nx-bound-vars*)
-    (%temp-push node *nx-bound-vars*)
+    (push node *nx-bound-vars*)
     (dolist (decl (nx-effect-vdecls state sym env) (setf (var-bits node) bits))
       (case (car decl)
         (special (setq bits (%ilogior bits (ash -1 $vbitspecial) (%ilsl $vbitparameter 1))))

level-1/l1-aprims.lisp

@@ -69,8 +69,6 @@
   "Return constructs and returns a list of its arguments."
   args)
 
-(%fhave '%temp-list #'list)
-
 (defun list* (arg &rest others)
   "Return a list of the arguments with last cons a dotted pair"
   (cond ((null others) arg)

level-1/sysutils.lisp

@@ -358,14 +358,6 @@
 (defun preload-all-functions ()
   nil)
 
-
- ; used by arglist
-(defun temp-cons (a b)
-  (cons a b))
-
-
-
-
 (defun copy-into-float (src dest)
   (%copy-double-float src dest))
 

lib/arglist.lisp

@@ -45,35 +45,12 @@
 (record-arglist 'nfunction '(function-name lambda-expression))
 
 
-; Returns two values: the arglist & it's functions binding.
-; If the second arg is NIL, there was no function binding.
+;;; Returns two values: the arglist, and possibly a keyword indicating
+;;; how we figured it out.  If the second value is NIL, there was no
+;;; function binding.
 (defun arglist (sym &optional include-bindings)
-  (%arglist sym include-bindings))
-
-(defun arglist-string (sym &optional include-bindings)
-  (multiple-value-bind (res type)
-                       (%arglist-internal sym include-bindings)
-    (values
-     (if (stringp res)
-       res
-       (and res (with-standard-io-syntax (princ-to-string res))))
-     type)))
-
-(defun set-arglist (sym arglist)
-  (let ((real-sym (arglist-sym-and-def sym)))
-    (when (or real-sym (null sym))
-      (if (eq arglist t)
-        (remhash real-sym %lambda-lists%)
-        (setf (gethash real-sym %lambda-lists%) arglist)))))
-
-(defsetf arglist set-arglist)
-
-; Same as ARGLIST, but has the option of using TEMP-CONS instead of CONS
-; to cons up the list.
-(defun %arglist (sym &optional include-bindings)
   (multiple-value-bind (res type)
-                       (%arglist-internal
-                        sym include-bindings)
+      (%arglist-internal sym include-bindings)
     (when (stringp res)
       (with-input-from-string (stream res)
         (setq res nil)
@@ -96,6 +73,24 @@
                   (nreverse res))))))
     (values res type)))
 
+(defun arglist-string (sym &optional include-bindings)
+  (multiple-value-bind (res type)
+                       (%arglist-internal sym include-bindings)
+    (values
+     (if (stringp res)
+       res
+       (and res (with-standard-io-syntax (princ-to-string res))))
+     type)))
+
+(defun set-arglist (sym arglist)
+  (let ((real-sym (arglist-sym-and-def sym)))
+    (when (or real-sym (null sym))
+      (if (eq arglist t)
+        (remhash real-sym %lambda-lists%)
+        (setf (gethash real-sym %lambda-lists%) arglist)))))
+
+(defsetf arglist set-arglist)
+
 (defun %arglist-internal (sym include-bindings 
                               &aux def type)
   (multiple-value-setq (sym def) (arglist-sym-and-def sym))

lib/level-2.lisp

@@ -420,7 +420,6 @@
                    (%alloc-misc count subtag)))
     (%eval-redef %setf-double-float (x y))
     (%eval-redef %lisp-word-ref (x y))
-    (%eval-redef %temp-cons (x y))
     (%eval-redef require-fixnum (x))
     (%eval-redef require-symbol (x))
     (%eval-redef require-list (x))

lib/read.lisp

@@ -239,7 +239,7 @@
                                (if (eq tree lab)
                                  (progn
                                    (unless (memq tree scanned)
-                                     (setq scanned (%temp-cons tree scanned))
+                                     (push tree scanned)
                                      (circle-subst (cddr tree)))
                                    (cddr tree))
                                  (progn