\f
;;;; 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)))
,@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))
,@declarations
(values (progn ,@body-without-decls)
,directives))))
+) ; EVAL-WHEN
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
: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))
(*print-radix* nil)
(*print-escape* nil))
(output-object (next-arg) stream))))
+) ; EVAL-WHEN
(def-format-interpreter #\D (colonp atsignp params)
(interpret-format-integer 10))
;;;
;;; 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
(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
(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
,hd0))
(host ,hd0))))
,@body)))
+) ; EVAL-WHEN
(defun find-host (host-designator &optional (errorp t))
(with-host (host host-designator)
(/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)
;;; 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))
;;; 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))
(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
(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
;;; 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"
projects / sbcl.git / commitdiff