diff --git a/compiler/ARM/arm2.lisp b/compiler/ARM/arm2.lisp index 4921905bf..8a32338e3 100644 --- a/compiler/ARM/arm2.lisp +++ b/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 diff --git a/compiler/PPC/ppc2.lisp b/compiler/PPC/ppc2.lisp index af85fd957..f3e747b77 100644 --- a/compiler/PPC/ppc2.lisp +++ b/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 diff --git a/compiler/X86/x862.lisp b/compiler/X86/x862.lisp index 767acb8a2..146fce9b0 100644 --- a/compiler/X86/x862.lisp +++ b/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) diff --git a/compiler/acode-rewrite.lisp b/compiler/acode-rewrite.lisp index 001b36039..55cfaca4a 100644 --- a/compiler/acode-rewrite.lisp +++ b/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) diff --git a/compiler/nx-basic.lisp b/compiler/nx-basic.lisp index 36a14826f..ef9d0cff0 100644 --- a/compiler/nx-basic.lisp +++ b/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) diff --git a/compiler/nx1.lisp b/compiler/nx1.lisp index 746760e7e..d9d90ecc5 100644 --- a/compiler/nx1.lisp +++ b/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))) diff --git a/compiler/nxenv.lisp b/compiler/nxenv.lisp index 4d327681c..bc5efa40e 100644 --- a/compiler/nxenv.lisp +++ b/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)))) diff --git a/level-1/l1-aprims.lisp b/level-1/l1-aprims.lisp index 1c1294616..e60edbd16 100644 --- a/level-1/l1-aprims.lisp +++ b/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) diff --git a/level-1/sysutils.lisp b/level-1/sysutils.lisp index 3fff24d42..375723bdf 100644 --- a/level-1/sysutils.lisp +++ b/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)) diff --git a/lib/arglist.lisp b/lib/arglist.lisp index 2b12436b8..0d6b672c8 100644 --- a/lib/arglist.lisp +++ b/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)) diff --git a/lib/level-2.lisp b/lib/level-2.lisp index 7991d3ecd..dbca7c401 100644 --- a/lib/level-2.lisp +++ b/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)) diff --git a/lib/read.lisp b/lib/read.lisp index 3964cb25c..6d939a900 100644 --- a/lib/read.lisp +++ b/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