(let ((char (format-directive-character directive)))
(typecase char
(base-char
- (aref *format-directive-expanders* (char-code char)))
- (character nil))))
+ (aref *format-directive-expanders* (sb!xc:char-code char))))))
(*default-format-error-offset*
(1- (format-directive-end directive))))
(declare (type (or null function) expander))
\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)
(defun %set-format-directive-expander (char fn)
- (setf (aref *format-directive-expanders* (char-code (char-upcase char))) fn)
+ (let ((code (sb!xc:char-code (char-upcase char))))
+ (setf (aref *format-directive-expanders* code) fn))
char)
(defun %set-format-directive-interpreter (char fn)
- (setf (aref *format-directive-interpreters*
- (char-code (char-upcase char)))
- fn)
+ (let ((code (sb!xc:char-code (char-upcase char))))
+ (setf (aref *format-directive-interpreters* code) fn))
char)
(defun find-directive (directives kind stop-at-semi)
(if params
(expand-bind-defaults ((count 1)) params
`(progn
- (fresh-line stream)
- (dotimes (i (1- ,count))
- (terpri stream))))
+ (when (plusp ,count)
+ (fresh-line stream)
+ (dotimes (i (1- ,count))
+ (terpri stream)))))
'(fresh-line stream)))
(def-format-directive #\| (colonp atsignp params)