1 ;;;; miscellaneous system hacking macros
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!IMPL")
14 (defmacro atomic-incf
/symbol
(symbol-name &optional
(delta 1))
16 `(incf ,symbol-name
,delta
)
19 (declare (optimize (safety 0) (speed 3)))
20 (sb!vm
::locked-symbol-global-value-add
',symbol-name
,delta
)))
22 ;;; When >0, inhibits garbage collection.
23 (declaim (type index
*gc-inhibit
*))
24 (defvar *gc-inhibit
*) ; initialized in cold init
26 (defmacro without-gcing
(&rest body
)
28 "Executes the forms in the body without doing a garbage collection."
31 (atomic-incf/symbol
*gc-inhibit
*)
33 (atomic-incf/symbol
*gc-inhibit
* -
1)
34 (when (and *need-to-collect-garbage
* (zerop *gc-inhibit
*))
38 ;;; EOF-OR-LOSE is a useful macro that handles EOF.
39 (defmacro eof-or-lose
(stream eof-error-p eof-value
)
41 (error 'end-of-file
:stream
,stream
)
44 ;;; These macros handle the special cases of T and NIL for input and
47 ;;; FIXME: Shouldn't these be functions instead of macros?
48 (defmacro in-synonym-of
(stream &optional check-type
)
49 (let ((svar (gensym)))
50 `(let ((,svar
,stream
))
51 (cond ((null ,svar
) *standard-input
*)
52 ((eq ,svar t
) *terminal-io
*)
53 (T ,@(when check-type
`((enforce-type ,svar
,check-type
)))
55 (unless (input-stream-p ,svar
)
56 (error 'simple-type-error
58 :expected-type
'(satisfies input-stream-p
)
59 :format-control
"~S isn't an input stream"
60 :format-arguments
(list ,svar
)))
62 (defmacro out-synonym-of
(stream &optional check-type
)
63 (let ((svar (gensym)))
64 `(let ((,svar
,stream
))
65 (cond ((null ,svar
) *standard-output
*)
66 ((eq ,svar t
) *terminal-io
*)
67 (T ,@(when check-type
`((check-type ,svar
,check-type
)))
69 (unless (output-stream-p ,svar
)
70 (error 'simple-type-error
72 :expected-type
'(satisfies output-stream-p
)
73 :format-control
"~S isn't an output stream."
74 :format-arguments
(list ,svar
)))
77 ;;; WITH-mumble-STREAM calls the function in the given SLOT of the
78 ;;; STREAM with the ARGS for ANSI-STREAMs, or the FUNCTION with the
79 ;;; ARGS for FUNDAMENTAL-STREAMs.
80 (defmacro with-in-stream
(stream (slot &rest args
) &optional stream-dispatch
)
81 `(let ((stream (in-synonym-of ,stream
)))
83 `(if (ansi-stream-p stream
)
84 (funcall (,slot stream
) stream
,@args
)
85 ,@(when stream-dispatch
86 `(,(destructuring-bind (function &rest args
) stream-dispatch
87 `(,function stream
,@args
)))))
88 `(funcall (,slot stream
) stream
,@args
))))
90 (defmacro with-out-stream
(stream (slot &rest args
) &optional stream-dispatch
)
91 `(let ((stream (out-synonym-of ,stream
)))
93 `(if (ansi-stream-p stream
)
94 (funcall (,slot stream
) stream
,@args
)
95 ,@(when stream-dispatch
96 `(,(destructuring-bind (function &rest args
) stream-dispatch
97 `(,function stream
,@args
)))))
98 `(funcall (,slot stream
) stream
,@args
))))
100 ;;;; These are hacks to make the reader win.
102 ;;; This macro sets up some local vars for use by the
103 ;;; FAST-READ-CHAR macro within the enclosed lexical scope. The stream
104 ;;; is assumed to be a ANSI-STREAM.
105 (defmacro prepare-for-fast-read-char
(stream &body forms
)
106 `(let* ((%frc-stream%
,stream
)
107 (%frc-method%
(ansi-stream-in %frc-stream%
))
108 (%frc-buffer%
(ansi-stream-in-buffer %frc-stream%
))
109 (%frc-index%
(ansi-stream-in-index %frc-stream%
)))
110 (declare (type index %frc-index%
)
111 (type ansi-stream %frc-stream%
))
114 ;;; This macro must be called after one is done with FAST-READ-CHAR
115 ;;; inside its scope to decache the ANSI-STREAM-IN-INDEX.
116 (defmacro done-with-fast-read-char
()
117 `(setf (ansi-stream-in-index %frc-stream%
) %frc-index%
))
119 ;;; a macro with the same calling convention as READ-CHAR, to be used
120 ;;; within the scope of a PREPARE-FOR-FAST-READ-CHAR
121 (defmacro fast-read-char
(&optional
(eof-error-p t
) (eof-value ()))
124 (funcall %frc-method% %frc-stream%
,eof-error-p
,eof-value
))
125 ((= %frc-index%
+ansi-stream-in-buffer-length
+)
126 (prog1 (fast-read-char-refill %frc-stream%
,eof-error-p
,eof-value
)
127 (setq %frc-index%
(ansi-stream-in-index %frc-stream%
))))
129 (prog1 (code-char (aref %frc-buffer% %frc-index%
))
130 (incf %frc-index%
)))))
132 ;;;; And these for the fasloader...
134 ;;; Just like PREPARE-FOR-FAST-READ-CHAR except that we get the BIN
135 ;;; method. The stream is assumed to be a ANSI-STREAM.
137 ;;; KLUDGE: It seems weird to have to remember to explicitly call
138 ;;; DONE-WITH-FAST-READ-BYTE at the end of this, given that we're
139 ;;; already wrapping the stuff inside in a block. Why not rename this
140 ;;; macro to WITH-FAST-READ-BYTE, do the DONE-WITH-FAST-READ-BYTE stuff
141 ;;; automatically at the end of the block, and eliminate
142 ;;; DONE-WITH-FAST-READ-BYTE as a separate entity? (and similarly
143 ;;; for the FAST-READ-CHAR stuff) -- WHN 19990825
144 (defmacro prepare-for-fast-read-byte
(stream &body forms
)
145 `(let* ((%frc-stream%
,stream
)
146 (%frc-method%
(ansi-stream-bin %frc-stream%
))
147 (%frc-buffer%
(ansi-stream-in-buffer %frc-stream%
))
148 (%frc-index%
(ansi-stream-in-index %frc-stream%
)))
149 (declare (type index %frc-index%
)
150 (type ansi-stream %frc-stream%
))
153 ;;; Similar to fast-read-char, but we use a different refill routine & don't
154 ;;; convert to characters. If ANY-TYPE is true, then this can be used on any
155 ;;; integer streams, and we don't assert the result type.
156 (defmacro fast-read-byte
(&optional
(eof-error-p t
) (eof-value ()) any-type
)
157 ;; KLUDGE: should use ONCE-ONLY on EOF-ERROR-P and EOF-VALUE -- WHN 19990825
159 ,(if (and (eq eof-error-p t
) (not any-type
)) '(unsigned-byte 8) t
)
162 (funcall %frc-method% %frc-stream%
,eof-error-p
,eof-value
))
163 ((= %frc-index%
+ansi-stream-in-buffer-length
+)
164 (prog1 (fast-read-byte-refill %frc-stream%
,eof-error-p
,eof-value
)
165 (setq %frc-index%
(ansi-stream-in-index %frc-stream%
))))
167 (prog1 (aref %frc-buffer% %frc-index%
)
168 (incf %frc-index%
))))))
169 (defmacro done-with-fast-read-byte
()
170 `(done-with-fast-read-char))