From 27a028cff1559dec1cb1faaee01659ade816c908 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 13 Sep 2002 15:54:35 +0000 Subject: [PATCH] 0.7.7.20-backend-cleanup-1.10: OAOO treatment for WITH-ADJUSTABLE-VECTOR --- src/compiler/alpha/macros.lisp | 16 ---------------- src/compiler/generic/utils.lisp | 19 ++++++++++++++++++- src/compiler/hppa/macros.lisp | 30 ++++++++++-------------------- src/compiler/mips/macros.lisp | 32 ++++++++++---------------------- src/compiler/ppc/macros.lisp | 21 --------------------- src/compiler/sparc/macros.lisp | 21 --------------------- src/compiler/x86/macros.lisp | 16 ---------------- version.lisp-expr | 2 +- 8 files changed, 39 insertions(+), 118 deletions(-) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 998cec0..d472eef 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -176,22 +176,6 @@ ,@body)) ;;;; error code - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (declare (type (vector (unsigned-byte 8) 16) ,var)) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (:compile-toplevel :load-toplevel :execute) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp index b63b3c6..38fa31c 100644 --- a/src/compiler/generic/utils.lisp +++ b/src/compiler/generic/utils.lisp @@ -1,4 +1,5 @@ -;;;; utility functions needed by the back end to generate code +;;;; utility functions and macros needed by the back end to generate +;;;; code ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -58,3 +59,19 @@ (- list-pointer-lowtag) (* static-fun-index (pad-data-block fdefn-size)) (* fdefn-raw-addr-slot n-word-bytes)))) + +;;; Various error-code generating helpers +(defvar *adjustable-vectors* nil) + +(defmacro with-adjustable-vector ((var) &rest body) + `(let ((,var (or (pop *adjustable-vectors*) + (make-array 16 + :element-type '(unsigned-byte 8) + :fill-pointer 0 + :adjustable t)))) + (declare (type (vector (unsigned-byte 8) 16) ,var)) + (setf (fill-pointer ,var) 0) + (unwind-protect + (progn + ,@body) + (push ,var *adjustable-vectors*)))) diff --git a/src/compiler/hppa/macros.lisp b/src/compiler/hppa/macros.lisp index d66bdae..5daaace 100644 --- a/src/compiler/hppa/macros.lisp +++ b/src/compiler/hppa/macros.lisp @@ -1,3 +1,13 @@ +;;;; various useful macros for generating HPPA code + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. (in-package "SB!VM") @@ -80,7 +90,6 @@ ;;; Load-Stack-TN, Store-Stack-TN -- Interface ;;; ;;; Move a stack TN to a register and vice-versa. -;;; (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -97,9 +106,6 @@ ((control-stack) (storew reg cfp-tn offset)))))) - -;;; MAYBE-LOAD-STACK-TN -- Interface -;;; (defmacro maybe-load-stack-tn (reg reg-or-stack) "Move the TN Reg-Or-Stack into Reg if it isn't already there." (once-only ((n-reg reg) @@ -133,22 +139,6 @@ ;;;; Error Code - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (declare (type (vector (unsigned-byte 8) 16) ,var)) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (compile load eval) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) diff --git a/src/compiler/mips/macros.lisp b/src/compiler/mips/macros.lisp index 7f8f077..45ce543 100644 --- a/src/compiler/mips/macros.lisp +++ b/src/compiler/mips/macros.lisp @@ -1,3 +1,13 @@ +;;;; various useful macros for generating MIPS code + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. (in-package "SB!VM") ;;; Handy macro for defining top-level forms that depend on the compile @@ -98,7 +108,6 @@ ;;; Load-Stack-TN, Store-Stack-TN -- Interface ;;; ;;; Move a stack TN to a register and vice-versa. -;;; (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -115,9 +124,6 @@ ((control-stack) (storew reg cfp-tn offset)))))) - -;;; MAYBE-LOAD-STACK-TN -- Interface -;;; (defmacro maybe-load-stack-tn (reg reg-or-stack) "Move the TN Reg-Or-Stack into Reg if it isn't already there." (once-only ((n-reg reg) @@ -132,7 +138,6 @@ ;;;; Storage allocation: - (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size) &body body) "Do stuff to allocate an other-pointer object of fixed Size with a single @@ -149,7 +154,6 @@ ;;;; Three Way Comparison - (defun three-way-comparison (x y condition flavor not-p target temp) (ecase condition (:eq @@ -179,22 +183,6 @@ ;;;; Error Code - - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (compile load eval) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index 2dfb14b..03748fa 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -105,7 +105,6 @@ ;;; Load-Stack-TN, Store-Stack-TN -- Interface ;;; ;;; Move a stack TN to a register and vice-versa. -;;; (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -122,9 +121,6 @@ ((control-stack) (storew reg cfp-tn offset)))))) - -;;; MAYBE-LOAD-STACK-TN -- Interface -;;; (defmacro maybe-load-stack-tn (reg reg-or-stack) "Move the TN Reg-Or-Stack into Reg if it isn't already there." (once-only ((n-reg reg) @@ -139,7 +135,6 @@ ;;;; Storage allocation: - (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size) &body body) "Do stuff to allocate an other-pointer object of fixed Size with a single @@ -157,22 +152,6 @@ ;;;; Error Code - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (declare (type (vector (unsigned-byte 8) 16) ,var)) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (:compile-toplevel :load-toplevel :execute) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) diff --git a/src/compiler/sparc/macros.lisp b/src/compiler/sparc/macros.lisp index dc0e1f5..a7c2abd 100644 --- a/src/compiler/sparc/macros.lisp +++ b/src/compiler/sparc/macros.lisp @@ -105,7 +105,6 @@ ;;; Load-Stack-TN, Store-Stack-TN -- Interface ;;; ;;; Move a stack TN to a register and vice-versa. -;;; (defmacro load-stack-tn (reg stack) `(let ((reg ,reg) (stack ,stack)) @@ -122,9 +121,6 @@ ((control-stack) (storew reg cfp-tn offset)))))) - -;;; MAYBE-LOAD-STACK-TN -- Interface -;;; (defmacro maybe-load-stack-tn (reg reg-or-stack) "Move the TN Reg-Or-Stack into Reg if it isn't already there." (once-only ((n-reg reg) @@ -139,7 +135,6 @@ ;;;; Storage allocation: - (defmacro with-fixed-allocation ((result-tn temp-tn type-code size) &body body) "Do stuff to allocate an other-pointer object of fixed Size with a single @@ -157,22 +152,6 @@ ;;;; Error Code - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (declare (type (vector (unsigned-byte 8) 16) ,var)) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (:compile-toplevel :load-toplevel :execute) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index ca4519c..af03663 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -271,22 +271,6 @@ ,@forms)) ;;;; error code - -(defvar *adjustable-vectors* nil) - -(defmacro with-adjustable-vector ((var) &rest body) - `(let ((,var (or (pop *adjustable-vectors*) - (make-array 16 - :element-type '(unsigned-byte 8) - :fill-pointer 0 - :adjustable t)))) - (declare (type (vector (unsigned-byte 8) 16) ,var)) - (setf (fill-pointer ,var) 0) - (unwind-protect - (progn - ,@body) - (push ,var *adjustable-vectors*)))) - (eval-when (:compile-toplevel :load-toplevel :execute) (defun emit-error-break (vop kind code values) (let ((vector (gensym))) diff --git a/version.lisp-expr b/version.lisp-expr index 6e267b1..7e2dbc1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.7.20-backend-cleanup-1.9" +"0.7.7.20-backend-cleanup-1.10" -- 1.7.10.4