From: Nathan Froyd Date: Sat, 9 May 2009 13:00:29 +0000 (+0000) Subject: 1.0.28.34: convert once-used DEFMACROs to EVAL-WHEN'd SB!XC:DEFMACROs X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c0578d9893429c9c0da80ea5920360e4621fddab;p=sbcl.git 1.0.28.34: convert once-used DEFMACROs to EVAL-WHEN'd SB!XC:DEFMACROs There were a couple FIXMEs lurking about this. Fixing themm is easy enough and reduces the core size slightly. --- diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index 2fc0f3a..5315b24 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -350,8 +350,8 @@ ;;;; format directive machinery -;;; FIXME: only used in this file, could be SB!XC:DEFMACRO in EVAL-WHEN -(defmacro def-complex-format-directive (char lambda-list &body body) +(eval-when (:compile-toplevel :execute) +(#+sb-xc-host defmacro #-sb-xc-host sb!xc:defmacro def-complex-format-directive (char lambda-list &body body) (let ((defun-name (intern (format nil "~:@(~:C~)-FORMAT-DIRECTIVE-EXPANDER" char))) @@ -370,8 +370,7 @@ ,@body))) (%set-format-directive-expander ,char #',defun-name)))) -;;; FIXME: only used in this file, could be SB!XC:DEFMACRO in EVAL-WHEN -(defmacro def-format-directive (char lambda-list &body body) +(#+sb-xc-host defmacro #-sb-xc-host sb!xc:defmacro def-format-directive (char lambda-list &body body) (let ((directives (sb!xc:gensym "DIRECTIVES")) (declarations nil) (body-without-decls body)) @@ -385,6 +384,7 @@ ,@declarations (values (progn ,@body-without-decls) ,directives)))) +) ; EVAL-WHEN (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index c851874..792e610 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -281,9 +281,8 @@ :start2 src :end2 (+ src commainterval))) new-string)))) -;;; FIXME: This is only needed in this file, could be defined with -;;; SB!XC:DEFMACRO inside EVAL-WHEN -(defmacro interpret-format-integer (base) +(eval-when (:compile-toplevel :execute) +(sb!xc:defmacro interpret-format-integer (base) `(if (or colonp atsignp params) (interpret-bind-defaults ((mincol 0) (padchar #\space) (commachar #\,) (commainterval 3)) @@ -294,6 +293,7 @@ (*print-radix* nil) (*print-escape* nil)) (output-object (next-arg) stream)))) +) ; EVAL-WHEN (def-format-interpreter #\D (colonp atsignp params) (interpret-format-integer 10)) diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index 81da10f..4536eb3 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -286,8 +286,8 @@ ;;; ;;; FIXME: was rewritten, should be tested (or rewritten again, this ;;; time using ONCE-ONLY, *then* tested) -;;; FIXME: become SB!XC:DEFMACRO inside EVAL-WHEN (COMPILE EVAL)? -(defmacro with-pathname ((pathname pathname-designator) &body body) +(eval-when (:compile-toplevel :execute) +(sb!xc:defmacro with-pathname ((pathname pathname-designator) &body body) (let ((pd0 (gensym))) `(let* ((,pd0 ,pathname-designator) (,pathname (etypecase ,pd0 @@ -296,7 +296,7 @@ (file-stream (file-name ,pd0))))) ,@body))) -(defmacro with-native-pathname ((pathname pathname-designator) &body body) +(sb!xc:defmacro with-native-pathname ((pathname pathname-designator) &body body) (let ((pd0 (gensym))) `(let* ((,pd0 ,pathname-designator) (,pathname (etypecase ,pd0 @@ -307,7 +307,7 @@ (file-stream (file-name ,pd0))))) ,@body))) -(defmacro with-host ((host host-designator) &body body) +(sb!xc:defmacro with-host ((host host-designator) &body body) ;; Generally, redundant specification of information in software, ;; whether in code or in comments, is bad. However, the ANSI spec ;; for this is messy enough that it's hard to hold in short-term @@ -363,6 +363,7 @@ ,hd0)) (host ,hd0)))) ,@body))) +) ; EVAL-WHEN (defun find-host (host-designator &optional (errorp t)) (with-host (host host-designator) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 224911a..f885d57 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -27,12 +27,6 @@ (/show0 "unix.lisp 21") -(defmacro def-enum (inc cur &rest names) - (flet ((defform (name) - (prog1 (when name `(defconstant ,name ,cur)) - (setf cur (funcall inc cur 1))))) - `(progn ,@(mapcar #'defform names)))) - ;;; Given a C-level zero-terminated array of C strings, return a ;;; corresponding Lisp-level list of SIMPLE-STRINGs. (defun c-strings->string-list (c-strings) @@ -63,7 +57,8 @@ ;;; macros in this file, are only used in this file, and could be ;;; implemented using SB!XC:DEFMACRO wrapped in EVAL-WHEN. -(defmacro syscall ((name &rest arg-types) success-form &rest args) +(eval-when (:compile-toplevel :execute) +(sb!xc:defmacro syscall ((name &rest arg-types) success-form &rest args) `(locally (declare (optimize (sb!c::float-accuracy 0))) (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) @@ -75,7 +70,7 @@ ;;; This is like SYSCALL, but if it fails, signal an error instead of ;;; returning error codes. Should only be used for syscalls that will ;;; never really get an error. -(defmacro syscall* ((name &rest arg-types) success-form &rest args) +(sb!xc:defmacro syscall* ((name &rest arg-types) success-form &rest args) `(locally (declare (optimize (sb!c::float-accuracy 0))) (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) @@ -84,15 +79,10 @@ (error "Syscall ~A failed: ~A" ,name (strerror)) ,success-form)))) -(/show0 "unix.lisp 109") - -(defmacro void-syscall ((name &rest arg-types) &rest args) - `(syscall (,name ,@arg-types) (values t 0) ,@args)) - -(defmacro int-syscall ((name &rest arg-types) &rest args) +(sb!xc:defmacro int-syscall ((name &rest arg-types) &rest args) `(syscall (,name ,@arg-types) (values result 0) ,@args)) -(defmacro with-restarted-syscall ((&optional (value (gensym)) +(sb!xc:defmacro with-restarted-syscall ((&optional (value (gensym)) (errno (gensym))) syscall-form &rest body) #!+sb-doc @@ -104,6 +94,12 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (unless #!-win32 (eql ,errno sb!unix:eintr) #!+win32 nil (return (values ,value ,errno)))) ,@body)) +) ; EVAL-WHEN + +;;; FIXME: This could go in the above EVAL-WHEN, but it's used by +;;; SB-EXECUTABLE. +(defmacro void-syscall ((name &rest arg-types) &rest args) + `(syscall (,name ,@arg-types) (values t 0) ,@args)) #!+win32 (progn diff --git a/version.lisp-expr b/version.lisp-expr index a611eb1..3465bb7 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.28.33" +"1.0.28.34"