/[cmucl]/src/code/fd-stream.lisp
ViewVC logotype

Contents of /src/code/fd-stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Sat Nov 3 00:26:39 1990 UTC (23 years, 5 months ago) by wlott
Branch: MAIN
Changes since 1.7: +3 -3 lines
Changed predict-name to unix-namestring.
1 ;;; -*- Log: code.log; Package: LISP -*-
2
3 ;;; **********************************************************************
4 ;;; This code was written as part of the Spice Lisp project at
5 ;;; Carnegie-Mellon University, and has been placed in the public domain.
6 ;;; If you want to use this code or any part of Spice Lisp, please contact
7 ;;; Scott Fahlman (FAHLMAN@CMUC).
8 ;;; **********************************************************************
9 ;;;
10 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/fd-stream.lisp,v 1.8 1990/11/03 00:26:39 wlott Exp $
11 ;;;
12 ;;; Streams for UNIX file descriptors.
13 ;;;
14 ;;; Written by William Lott, July 1989 - January 1990.
15 ;;;
16 ;;; **********************************************************************
17
18
19 (in-package "SYSTEM")
20
21 (export '(fd-stream fd-stream-p fd-stream-fd make-fd-stream
22 beep *beep-function*
23 output-raw-bytes
24 *tty* *stdin* *stdout* *stderr*))
25
26
27 (in-package "EXTENSIONS")
28
29 (export '(*backup-extension*))
30
31
32 (in-package "LISP")
33
34
35 ;;;; Buffer manipulation routines.
36
37 (defvar *available-buffers* ()
38 "List of available buffers. Each buffer is an dynamic alien.")
39
40 (defconstant bytes-per-buffer (* 4 1024)
41 "Number of bytes per buffer.")
42
43 ;;; NEXT-AVAILABLE-BUFFER -- Internal.
44 ;;;
45 ;;; Returns the next available alien buffer, creating one if necessary.
46 ;;;
47 (proclaim '(inline next-available-buffer))
48 ;;;
49 (defun next-available-buffer ()
50 (if *available-buffers*
51 (pop *available-buffers*)
52 (allocate-system-memory bytes-per-buffer)))
53
54
55 ;;;; The FD-STREAM structure.
56
57 (defstruct (fd-stream
58 (:print-function %print-fd-stream)
59 (:constructor %make-fd-stream)
60 (:include stream
61 (misc #'fd-stream-misc-routine)))
62
63 (name nil) ; The name of this stream
64 (file nil) ; The file this stream is for
65 (original nil) ; The original file (for :if-exists :rename)
66 (delete-original nil) ; for :if-exists :rename-and-delete
67 (element-size 1) ; Number of bytes per element.
68 (element-type 'base-character) ; The type of element being transfered.
69 (fd -1 :type fixnum) ; The file descriptor
70 (buffering :full) ; One of :none, :line, or :full
71 (char-pos nil) ; Character position if known.
72 (listen nil) ; T if we don't need to listen
73
74 ;; The input buffer.
75 (unread nil)
76 (ibuf-sap nil)
77 (ibuf-length nil)
78 (ibuf-head 0 :type fixnum)
79 (ibuf-tail 0 :type fixnum)
80
81 ;; The output buffer.
82 (obuf-sap nil)
83 (obuf-length nil)
84 (obuf-tail 0 :type fixnum)
85
86 ;; Output flushed, but not written due to non-blocking io.
87 (output-later nil)
88 (handler nil))
89
90 (defun %print-fd-stream (fd-stream stream depth)
91 (declare (ignore depth))
92 (format stream "#<Stream for ~A>"
93 (fd-stream-name fd-stream)))
94
95
96
97 ;;;; Output routines and related noise.
98
99 (defvar *output-routines* ()
100 "List of all available output routines. Each element is a list of the
101 element-type output, the kind of buffering, the function name, and the number
102 of bytes per element.")
103
104 ;;; DO-OUTPUT-LATER -- internal
105 ;;;
106 ;;; Called by the server when we can write to the given file descriptor.
107 ;;; Attemt to write the data again. If it worked, remove the data from the
108 ;;; output-later list. If it didn't work, something is wrong.
109 ;;;
110 (defun do-output-later (stream)
111 (let* ((stuff (pop (fd-stream-output-later stream)))
112 (base (car stuff))
113 (start (cadr stuff))
114 (end (caddr stuff))
115 (reuse-sap (cadddr stuff))
116 (length (- end start)))
117 (multiple-value-bind
118 (count errno)
119 (mach:unix-write (fd-stream-fd stream)
120 base
121 start
122 length)
123 (cond ((eql count length) ; Hot damn, it workded.
124 (when reuse-sap
125 (push base *available-buffers*)))
126 ((not (null count)) ; Sorta worked.
127 (push (list base
128 (+ start count)
129 end)
130 (fd-stream-output-later stream)))
131 ((= errno mach:ewouldblock)
132 (error "Write would have blocked, but SERVER told us to go."))
133 (t
134 (error "While writing ~S: ~A"
135 stream
136 (mach:get-unix-error-msg errno))))))
137 (unless (fd-stream-output-later stream)
138 (system:remove-fd-handler (fd-stream-handler stream))
139 (setf (fd-stream-handler stream) nil)))
140
141 ;;; OUTPUT-LATER -- internal
142 ;;;
143 ;;; Arange to output the string when we can write on the file descriptor.
144 ;;;
145 (defun output-later (stream base start end reuse-sap)
146 (cond ((null (fd-stream-output-later stream))
147 (setf (fd-stream-output-later stream)
148 (list (list base start end reuse-sap)))
149 (setf (fd-stream-handler stream)
150 (system:add-fd-handler (fd-stream-fd stream)
151 :output
152 #'(lambda (fd)
153 (declare (ignore fd))
154 (do-output-later stream)))))
155 (t
156 (nconc (fd-stream-output-later stream)
157 (list (list base start end reuse-sap)))))
158 (when reuse-sap
159 (let ((new-buffer (next-available-buffer)))
160 (setf (fd-stream-obuf-sap stream) new-buffer)
161 (setf (fd-stream-obuf-length stream) bytes-per-buffer))))
162
163 ;;; DO-OUTPUT -- internal
164 ;;;
165 ;;; Output the given noise. Check to see if there are any pending writes. If
166 ;;; so, just queue this one. Otherwise, try to write it. If this would block,
167 ;;; queue it.
168 ;;;
169 (defun do-output (stream base start end reuse-sap)
170 (if (not (null (fd-stream-output-later stream))) ; something buffered.
171 (progn
172 (output-later stream base start end reuse-sap)
173 ;; ### check to see if any of this noise can be output
174 )
175 (let ((length (- end start)))
176 (multiple-value-bind
177 (count errno)
178 (mach:unix-write (fd-stream-fd stream) base start length)
179 (cond ((eql count length)) ; Hot damn, it worked.
180 ((not (null count))
181 (output-later stream base (+ start count) end reuse-sap))
182 ((= errno mach:ewouldblock)
183 (output-later stream base start end reuse-sap))
184 (t
185 (error "While writing ~S: ~A"
186 stream
187 (mach:get-unix-error-msg errno))))))))
188
189 ;;; FLUSH-OUTPUT-BUFFER -- internal
190 ;;;
191 ;;; Flush any data in the output buffer.
192 ;;;
193 (defun flush-output-buffer (stream)
194 (let ((length (fd-stream-obuf-tail stream)))
195 (unless (= length 0)
196 (do-output stream (fd-stream-obuf-sap stream) 0 length t)
197 (setf (fd-stream-obuf-tail stream) 0))))
198
199 ;;; DEF-OUTPUT-ROUTINES -- internal
200 ;;;
201 ;;; Define output routines that output numbers size bytes long for the
202 ;;; given bufferings. Use body to do the actual output.
203 ;;;
204 (defmacro def-output-routines ((name size &rest bufferings) &body body)
205 (cons 'progn
206 (mapcar
207 #'(lambda (buffering)
208 (let ((function
209 (intern (let ((*print-case* :upcase))
210 (format nil name (car buffering))))))
211 `(progn
212 (defun ,function (stream byte)
213 ,(unless (eq (car buffering) :none)
214 `(when (< (fd-stream-obuf-length stream)
215 (+ (fd-stream-obuf-tail stream)
216 ,size))
217 (flush-output-buffer stream)))
218 ,@body
219 (incf (fd-stream-obuf-tail stream) ,size)
220 ,(ecase (car buffering)
221 (:none
222 `(flush-output-buffer stream))
223 (:line
224 `(when (eq (char-code byte) (char-code #\Newline))
225 (flush-output-buffer stream)))
226 (:full
227 ))
228 (values))
229 (setf *output-routines*
230 (nconc *output-routines*
231 ',(mapcar
232 #'(lambda (type)
233 (list type
234 (car buffering)
235 function
236 size))
237 (cdr buffering)))))))
238 bufferings)))
239
240 (def-output-routines ("OUTPUT-CHAR-~A-BUFFERED"
241 1
242 (:none character)
243 (:line character)
244 (:full character))
245 (if (eq (char-code byte)
246 (char-code #\Newline))
247 (setf (fd-stream-char-pos stream) 0)
248 (incf (fd-stream-char-pos stream)))
249 (setf (sap-ref-8 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
250 (char-code byte)))
251
252 (def-output-routines ("OUTPUT-BYTE-~A-BUFFERED"
253 1
254 (:none (signed-byte 8) (unsigned-byte 8))
255 (:full (signed-byte 8) (unsigned-byte 8)))
256 (when (characterp byte)
257 (if (eq (char-code byte)
258 (char-code #\Newline))
259 (setf (fd-stream-char-pos stream) 0)
260 (incf (fd-stream-char-pos stream))))
261 (setf (sap-ref-8 (fd-stream-obuf-sap stream) (fd-stream-obuf-tail stream))
262 byte))
263
264 (def-output-routines ("OUTPUT-SHORT-~A-BUFFERED"
265 2
266 (:none (signed-byte 16) (unsigned-byte 16))
267 (:full (signed-byte 16) (unsigned-byte 16)))
268 (setf (sap-ref-16 (fd-stream-obuf-sap stream)
269 (truncate (fd-stream-obuf-tail stream) 2))
270 byte))
271
272 (def-output-routines ("OUTPUT-LONG-~A-BUFFERED"
273 4
274 (:none (signed-byte 32) (unsigned-byte 32))
275 (:full (signed-byte 32) (unsigned-byte 32)))
276 (setf (sap-ref-32 (fd-stream-obuf-sap stream)
277 (truncate (fd-stream-obuf-tail stream) 4))
278 byte))
279
280 ;;; OUTPUT-RAW-BYTES -- public
281 ;;;
282 ;;; Does the actual output. If there is space to buffer the string, buffer
283 ;;; it. If the string would normally fit in the buffer, but doesn't because
284 ;;; of other stuff in the buffer, flush the old noise out of the buffer and
285 ;;; put the string in it. Otherwise we have a very long string, so just
286 ;;; send it directly (after flushing the buffer, of course).
287 ;;;
288 (defun output-raw-bytes (stream thing &optional start end)
289 "Output THING to stream. THING can be any kind of vector or a sap. If THING
290 is a SAP, END must be supplied (as length won't work)."
291 (let ((start (or start 0))
292 (end (or end (length thing))))
293 (declare (fixnum start end))
294 (let* ((len (fd-stream-obuf-length stream))
295 (tail (fd-stream-obuf-tail stream))
296 (space (- len tail))
297 (bytes (- end start))
298 (newtail (+ tail bytes)))
299 (cond ((minusp bytes) ; Error case
300 (cerror "Just go on as if nothing happened..."
301 "~S called with :END before :START!"
302 'output-raw-bytes))
303 ((zerop bytes)) ; Easy case
304 ((<= bytes space)
305 (if (system-area-pointer-p thing)
306 (system-area-copy thing
307 (* start vm:byte-bits)
308 (fd-stream-obuf-sap stream)
309 (* tail vm:byte-bits)
310 (* bytes vm:byte-bits))
311 (copy-to-system-area thing
312 (+ (* start vm:byte-bits)
313 (* vm:vector-data-offset vm:word-bits))
314 (fd-stream-obuf-sap stream)
315 (* tail vm:byte-bits)
316 (* bytes vm:byte-bits)))
317 (setf (fd-stream-obuf-tail stream) newtail))
318 ((<= bytes len)
319 (flush-output-buffer stream)
320 (if (system-area-pointer-p thing)
321 (system-area-copy thing
322 (* start vm:byte-bits)
323 (fd-stream-obuf-sap stream)
324 0
325 (* bytes vm:byte-bits))
326 (copy-to-system-area thing
327 (+ (* start vm:byte-bits)
328 (* vm:vector-data-offset vm:word-bits))
329 (fd-stream-obuf-sap stream)
330 0
331 (* bytes vm:byte-bits)))
332 (setf (fd-stream-obuf-tail stream) bytes))
333 (t
334 (flush-output-buffer stream)
335 (do-output stream thing start end nil))))))
336
337 ;;; FD-SOUT -- internal
338 ;;;
339 ;;; Routine to use to output a string. If the stream is unbuffered, slam
340 ;;; the string down the file descriptor, otherwise use OUTPUT-RAW-BYTES to
341 ;;; buffer the string. Update charpos by checking to see where the last newline
342 ;;; was.
343 ;;;
344 ;;; Note: some bozos (the FASL dumper) call write-string with things other
345 ;;; than strings. Therefore, we must make sure we have a string before calling
346 ;;; position on it.
347 ;;;
348 (defun fd-sout (stream thing start end)
349 (let ((start (or start 0))
350 (end (or end (length thing))))
351 (declare (fixnum start end))
352 (if (stringp thing)
353 (let ((last-newline (and (find #\newline (the simple-string thing)
354 :start start :end end)
355 (position #\newline (the simple-string thing)
356 :from-end t
357 :start start
358 :end end))))
359 (ecase (fd-stream-buffering stream)
360 (:full
361 (output-raw-bytes stream thing start end))
362 (:line
363 (output-raw-bytes stream thing start end)
364 (when last-newline
365 (flush-output-buffer stream)))
366 (:none
367 (do-output stream thing start end nil)))
368 (if last-newline
369 (setf (fd-stream-char-pos stream)
370 (- end last-newline 1))
371 (incf (fd-stream-char-pos stream)
372 (- end start))))
373 (ecase (fd-stream-buffering stream)
374 ((:line :full)
375 (output-raw-bytes stream thing start end))
376 (:none
377 (do-output stream thing start end nil))))))
378
379 ;;; PICK-OUTPUT-ROUTINE -- internal
380 ;;;
381 ;;; Find an output routine to use given the type and buffering. Return as
382 ;;; multiple values the routine, the real type transfered, and the number of
383 ;;; bytes per element.
384 ;;;
385 (defun pick-output-routine (type buffering)
386 (dolist (entry *output-routines*)
387 (when (and (subtypep type (car entry))
388 (eq buffering (cadr entry)))
389 (return (values (symbol-function (caddr entry))
390 (car entry)
391 (cadddr entry))))))
392
393
394 ;;;; Input routines and related noise.
395
396 (defvar *input-routines* ()
397 "List of all available input routines. Each element is a list of the
398 element-type input, the function name, and the number of bytes per element.")
399
400 ;;; DO-INPUT -- internal
401 ;;;
402 ;;; Fills the input buffer, and returns the first character. Throws to
403 ;;; eof-input-catcher if the eof was reached. Drops into system:server if
404 ;;; necessary.
405 ;;;
406 (defun do-input (stream)
407 (let ((fd (fd-stream-fd stream))
408 (ibuf-sap (fd-stream-ibuf-sap stream))
409 (buflen (fd-stream-ibuf-length stream))
410 (head (fd-stream-ibuf-head stream))
411 (tail (fd-stream-ibuf-tail stream)))
412 (unless (zerop head)
413 (cond ((eq head tail)
414 (setf head 0)
415 (setf tail 0)
416 (setf (fd-stream-ibuf-head stream) 0)
417 (setf (fd-stream-ibuf-tail stream) 0))
418 (t
419 (decf tail head)
420 (system-area-copy ibuf-sap (* head vm:byte-bits)
421 ibuf-sap 0 (* tail vm:byte-bits))
422 (setf head 0)
423 (setf (fd-stream-ibuf-head stream) 0)
424 (setf (fd-stream-ibuf-tail stream) tail))))
425 (setf (fd-stream-listen stream) nil)
426 #+serve-event
427 (multiple-value-bind
428 (count errno)
429 (mach:unix-select (1+ fd) (ash 1 fd) 0 0 0)
430 (case count
431 (1)
432 (0
433 (system:wait-until-fd-usable fd :input))
434 (t
435 (error "Problem checking to see if ~S is readable: ~A"
436 stream
437 (mach:get-unix-error-msg errno)))))
438 (multiple-value-bind
439 (count errno)
440 (mach:unix-read fd
441 (system:int-sap (+ (system:sap-int ibuf-sap) tail))
442 (- buflen tail))
443 (cond ((null count)
444 (if #+serve-event (eql errno mach:ewouldblock)
445 #-serve-event nil
446 (progn
447 (system:wait-until-fd-usable fd :input)
448 (do-input stream))
449 (error "Error reading ~S: ~A"
450 stream
451 (mach:get-unix-error-msg errno))))
452 ((zerop count)
453 (throw 'eof-input-catcher nil))
454 (t
455 (incf (fd-stream-ibuf-tail stream) count))))))
456
457 ;;; INPUT-AT-LEAST -- internal
458 ;;;
459 ;;; Makes sure there are at least ``bytes'' number of bytes in the input
460 ;;; buffer. Keeps calling do-input until that condition is met.
461 ;;;
462 (defmacro input-at-least (stream bytes)
463 (let ((stream-var (gensym))
464 (bytes-var (gensym)))
465 `(let ((,stream-var ,stream)
466 (,bytes-var ,bytes))
467 (loop
468 (when (>= (- (fd-stream-ibuf-tail ,stream-var)
469 (fd-stream-ibuf-head ,stream-var))
470 ,bytes-var)
471 (return))
472 (do-input ,stream-var)))))
473
474 ;;; INPUT-WRAPPER -- intenal
475 ;;;
476 ;;; Macro to wrap around all input routines to handle eof-error noise. This
477 ;;; should make provisions for filling stream-in-buffer.
478 ;;;
479 (defmacro input-wrapper ((stream bytes eof-error eof-value) &body read-forms)
480 (let ((stream-var (gensym))
481 (element-var (gensym)))
482 `(let ((,stream-var ,stream))
483 (if (fd-stream-unread ,stream)
484 (prog1
485 (fd-stream-unread ,stream)
486 (setf (fd-stream-unread ,stream) nil)
487 (setf (fd-stream-listen ,stream) nil))
488 (let ((,element-var
489 (catch 'eof-input-catcher
490 (input-at-least ,stream-var ,bytes)
491 ,@read-forms)))
492 (cond (,element-var
493 (incf (fd-stream-ibuf-head ,stream-var) ,bytes)
494 ,element-var)
495 (,eof-error
496 (error "EOF while reading ~S" stream))
497 (t
498 ,eof-value)))))))
499
500 ;;; DEF-INPUT-ROUTINE -- internal
501 ;;;
502 ;;; Defines an input routine.
503 ;;;
504 (defmacro def-input-routine (name
505 (type size sap head)
506 &rest body)
507 `(progn
508 (defun ,name (stream eof-error eof-value)
509 (input-wrapper (stream ,size eof-error eof-value)
510 (let ((,sap (fd-stream-ibuf-sap stream))
511 (,head (fd-stream-ibuf-head stream)))
512 ,@body)))
513 (setf *input-routines*
514 (nconc *input-routines*
515 (list (list ',type ',name ',size))))))
516
517 ;;; INPUT-CHARACTER -- internal
518 ;;;
519 ;;; Routine to use in stream-in slot for reading string chars.
520 ;;;
521 (def-input-routine input-character
522 (character 1 sap head)
523 (code-char (sap-ref-8 sap head)))
524
525 ;;; INPUT-UNSIGNED-8BIT-BYTE -- internal
526 ;;;
527 ;;; Routine to read in an unsigned 8 bit number.
528 ;;;
529 (def-input-routine input-unsigned-8bit-byte
530 ((unsigned-byte 8) 1 sap head)
531 (sap-ref-8 sap head))
532
533 ;;; INPUT-SIGNED-8BIT-BYTE -- internal
534 ;;;
535 ;;; Routine to read in a signed 8 bit number.
536 ;;;
537 (def-input-routine input-signed-8bit-number
538 ((signed-byte 8) 1 sap head)
539 (signed-sap-ref-8 sap head))
540
541 ;;; INPUT-UNSIGNED-16BIT-BYTE -- internal
542 ;;;
543 ;;; Routine to read in an unsigned 16 bit number.
544 ;;;
545 (def-input-routine input-unsigned-16bit-byte
546 ((unsigned-byte 16) 2 sap head)
547 (sap-ref-16 sap (truncate head 2)))
548
549 ;;; INPUT-SIGNED-16BIT-BYTE -- internal
550 ;;;
551 ;;; Routine to read in a signed 16 bit number.
552 ;;;
553 (def-input-routine input-signed-16bit-byte
554 ((signed-byte 16) 2 sap head)
555 (signed-sap-ref-16 sap (truncate head 2)))
556
557 ;;; INPUT-UNSIGNED-32BIT-BYTE -- internal
558 ;;;
559 ;;; Routine to read in a unsigned 32 bit number.
560 ;;;
561 (def-input-routine input-unsigned-32bit-byte
562 ((unsigned-byte 32) 4 sap head)
563 (sap-ref-32 sap (truncate head 4)))
564
565 ;;; INPUT-SIGNED-32BIT-BYTE -- internal
566 ;;;
567 ;;; Routine to read in a signed 32 bit number.
568 ;;;
569 (def-input-routine input-signed-32bit-byte
570 ((signed-byte 32) 4 sap head)
571 (signed-sap-ref-32 sap (truncate head 2)))
572
573 ;;; PICK-INPUT-ROUTINE -- internal
574 ;;;
575 ;;; Find an input routine to use given the type. Return as multiple values
576 ;;; the routine, the real type transfered, and the number of bytes per element.
577 ;;;
578 (defun pick-input-routine (type)
579 (dolist (entry *input-routines*)
580 (when (subtypep type (car entry))
581 (return (values (symbol-function (cadr entry))
582 (car entry)
583 (caddr entry))))))
584
585 ;;; STRING-FROM-SAP -- internal
586 ;;;
587 ;;; Returns a string constructed from the sap, start, and end.
588 ;;;
589 (defun string-from-sap (sap start end)
590 (let* ((length (- end start))
591 (string (make-string length)))
592 (copy-from-system-area sap (* start vm:byte-bits)
593 string (* vm:vector-data-offset vm:word-bits)
594 (* length vm:byte-bits))
595 string))
596
597 ;;; FD-STREAM-READ-LINE -- internal
598 ;;;
599 ;;; Reads a line, returning a simple string. Note: this relies on the fact
600 ;;; that the input buffer does not change during do-input.
601 ;;;
602 (defun fd-stream-read-line (stream eof-error-p eof-value)
603 (let ((eof t))
604 (values
605 (or (let ((sap (fd-stream-ibuf-sap stream))
606 (results (when (fd-stream-unread stream)
607 (prog1
608 (list (string (fd-stream-unread stream)))
609 (setf (fd-stream-unread stream) nil)
610 (setf (fd-stream-listen stream) nil)))))
611 (catch 'eof-input-catcher
612 (loop
613 (input-at-least stream 1)
614 (let* ((head (fd-stream-ibuf-head stream))
615 (tail (fd-stream-ibuf-tail stream))
616 (newline (do ((index head (1+ index)))
617 ((= index tail) nil)
618 (when (= (sap-ref-8 sap index)
619 (char-code #\newline))
620 (return index))))
621 (end (or newline tail)))
622 (push (string-from-sap sap head end)
623 results)
624
625 (when newline
626 (setf eof nil)
627 (setf (fd-stream-ibuf-head stream)
628 (1+ newline))
629 (return))
630 (setf (fd-stream-ibuf-head stream) end))))
631 (cond ((null results)
632 nil)
633 ((null (cdr results))
634 (car results))
635 (t
636 (apply #'concatenate 'simple-string (nreverse results)))))
637 (if eof-error-p
638 (error "EOF while reading ~S" stream)
639 eof-value))
640 eof)))
641
642
643 ;;; FD-STREAM-READ-N-BYTES -- internal
644 ;;;
645 ;;; The n-bin routine.
646 ;;;
647 (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
648 (let* ((sap (fd-stream-ibuf-sap stream))
649 (elsize (fd-stream-element-size stream))
650 (offset (* elsize start))
651 (bytes (* elsize requested))
652 (result
653 (catch 'eof-input-catcher
654 (loop
655 (input-at-least stream 1)
656 (let* ((head (fd-stream-ibuf-head stream))
657 (tail (fd-stream-ibuf-tail stream))
658 (available (- tail head))
659 (copy (min available bytes)))
660 (if (typep buffer 'system-area-pointer)
661 (system-area-copy sap (* head vm:byte-bits)
662 buffer (* offset vm:byte-bits)
663 (* copy vm:byte-bits))
664 (copy-from-system-area sap (* head vm:byte-bits)
665 buffer (+ (* offset vm:byte-bits)
666 (* vm:vector-data-offset
667 vm:word-bits))
668 (* copy vm:byte-bits)))
669 (incf (fd-stream-ibuf-head stream) copy)
670 (incf offset copy)
671 (decf bytes copy))
672 (when (zerop bytes)
673 (return requested))))))
674 (cond (result)
675 ((not eof-error-p)
676 (- requested (/ bytes elsize)))
677 (t
678 (error "Hit eof on ~S after reading ~D ~D~2:*-bit byte~P~*, ~
679 but ~D~2:* ~D-bit byte~P~:* ~[were~;was~:;were~] requested."
680 stream
681 (- requested (/ bytes elsize))
682 (* elsize 8)
683 requested)))))
684
685
686 ;;;; Utility functions (misc routines, etc)
687
688 ;;; SET-ROUTINES -- internal
689 ;;;
690 ;;; Fill in the various routine slots for the given type. Input-p and output-p
691 ;;; indicate what slots to fill. The buffering slot must be set prior to
692 ;;; calling this routine.
693 ;;;
694 (defun set-routines (stream type input-p output-p)
695 (let ((target-type (case type
696 ((:default unsigned-byte)
697 '(unsigned-byte 8))
698 (signed-byte
699 '(signed-byte 8))
700 (t
701 type)))
702 (input-type nil)
703 (output-type nil)
704 (input-size nil)
705 (output-size nil))
706
707 (when (fd-stream-obuf-sap stream)
708 (push (fd-stream-obuf-sap stream) *available-buffers*)
709 (setf (fd-stream-obuf-sap stream) nil))
710 (when (fd-stream-ibuf-sap stream)
711 (push (fd-stream-ibuf-sap stream) *available-buffers*)
712 (setf (fd-stream-ibuf-sap stream) nil))
713
714 (when input-p
715 (multiple-value-bind
716 (routine type size)
717 (pick-input-routine target-type)
718 (unless routine
719 (error "Could not find any input routine for ~S" target-type))
720 (setf (fd-stream-ibuf-sap stream) (next-available-buffer))
721 (setf (fd-stream-ibuf-length stream) bytes-per-buffer)
722 (setf (fd-stream-ibuf-tail stream) 0)
723 (if (subtypep type 'character)
724 (setf (fd-stream-in stream) routine
725 (fd-stream-bin stream) #'ill-bin
726 (fd-stream-n-bin stream) #'ill-bin)
727 (setf (fd-stream-in stream) #'ill-in
728 (fd-stream-bin stream) routine
729 (fd-stream-n-bin stream) #'fd-stream-read-n-bytes))
730 (setf input-size size)
731 (setf input-type type)))
732
733 (when output-p
734 (multiple-value-bind
735 (routine type size)
736 (pick-output-routine target-type (fd-stream-buffering stream))
737 (unless routine
738 (error "Could not find any output routine for ~S buffered ~S."
739 (fd-stream-buffering stream)
740 target-type))
741 (setf (fd-stream-obuf-sap stream) (next-available-buffer))
742 (setf (fd-stream-obuf-length stream) bytes-per-buffer)
743 (setf (fd-stream-obuf-tail stream) 0)
744 (if (subtypep type 'character)
745 (setf (fd-stream-out stream) routine
746 (fd-stream-bout stream) #'ill-bout)
747 (setf (fd-stream-out stream)
748 (or (if (eql size 1)
749 (pick-output-routine 'base-character
750 (fd-stream-buffering stream)))
751 #'ill-out)
752 (fd-stream-bout stream) routine))
753 (setf (fd-stream-sout stream)
754 (if (eql size 1) #'fd-sout #'ill-out))
755 (setf (fd-stream-char-pos stream) 0)
756 (setf output-size size)
757 (setf output-type type)))
758
759 (when (and input-size output-size
760 (not (eq input-size output-size)))
761 (error "Element sizes for input (~S:~S) and output (~S:~S) differ?"
762 input-type input-size
763 output-type output-size))
764 (setf (fd-stream-element-size stream)
765 (or input-size output-size))
766
767 (setf (fd-stream-element-type stream)
768 (cond ((equal input-type output-type)
769 input-type)
770 ((or (null output-type) (subtypep input-type output-type))
771 input-type)
772 ((subtypep output-type input-type)
773 output-type)
774 (t
775 (error "Input type (~S) and output type (~S) are unrelated?"
776 input-type
777 output-type))))))
778
779 ;;; FD-STREAM-MISC-ROUTINE -- input
780 ;;;
781 ;;; Handle the various misc operations on fd-stream.
782 ;;;
783 (defun fd-stream-misc-routine (stream operation &optional arg1 arg2)
784 (case operation
785 (:read-line
786 (fd-stream-read-line stream arg1 arg2))
787 (:listen
788 (or (not (eql (fd-stream-ibuf-head stream)
789 (fd-stream-ibuf-tail stream)))
790 (fd-stream-listen stream)
791 (setf (fd-stream-listen stream)
792 (not (zerop (mach:unix-select (1+ (fd-stream-fd stream))
793 (ash 1 (fd-stream-fd stream))
794 0
795 0
796 0))))))
797 (:unread
798 (setf (fd-stream-unread stream) arg1)
799 (setf (fd-stream-listen stream) t))
800 (:close
801 (cond (arg1
802 ;; We got us an abort on our hands.
803 (when (and (fd-stream-file stream)
804 (fd-stream-obuf-sap stream))
805 ;; Can't do anything unless we know what file were dealing with,
806 ;; and we don't want to do anything strange unless we were
807 ;; writing to the file.
808 (if (fd-stream-original stream)
809 ;; Have an handle on the original, just revert.
810 (multiple-value-bind
811 (okay err)
812 (mach:unix-rename (fd-stream-original stream)
813 (fd-stream-file stream))
814 (unless okay
815 (cerror "Go on as if nothing bad happened."
816 "Could not restore ~S to it's original contents: ~A"
817 (fd-stream-file stream)
818 (mach:get-unix-error-msg err))))
819 ;; Can't restore the orignal, so nuke that puppy.
820 (multiple-value-bind
821 (okay err)
822 (mach:unix-unlink (fd-stream-file stream))
823 (unless okay
824 (cerror "Go on as if nothing bad happened."
825 "Could not remove ~S: ~A"
826 (fd-stream-file stream)
827 (mach:get-unix-error-msg err)))))))
828 (t
829 (fd-stream-misc-routine stream :finish-output)
830 (when (and (fd-stream-original stream)
831 (fd-stream-delete-original stream))
832 (multiple-value-bind
833 (okay err)
834 (mach:unix-unlink (fd-stream-original stream))
835 (unless okay
836 (cerror "Go on as if nothing bad happened."
837 "Could not delete ~S during close of ~S: ~A"
838 (fd-stream-original stream)
839 stream
840 (mach:get-unix-error-msg err)))))))
841 (mach:unix-close (fd-stream-fd stream))
842 (when (fd-stream-obuf-sap stream)
843 (push (fd-stream-obuf-sap stream) *available-buffers*)
844 (setf (fd-stream-obuf-sap stream) nil))
845 (when (fd-stream-ibuf-sap stream)
846 (push (fd-stream-ibuf-sap stream) *available-buffers*)
847 (setf (fd-stream-ibuf-sap stream) nil))
848 (lisp::set-closed-flame stream))
849 (:clear-input
850 (setf (fd-stream-ibuf-head stream) 0)
851 (setf (fd-stream-ibuf-tail stream) 0)
852 (loop
853 (multiple-value-bind
854 (count errno)
855 (mach:unix-select (1+ (fd-stream-fd stream))
856 (ash 1 (fd-stream-fd stream))
857 0 0 0)
858 (cond ((eql count 1)
859 (do-input stream)
860 (setf (fd-stream-ibuf-head stream) 0)
861 (setf (fd-stream-ibuf-tail stream) 0))
862 (t
863 (return))))))
864 (:force-output
865 (flush-output-buffer stream))
866 (:finish-output
867 (flush-output-buffer stream)
868 #+serve-event
869 (do ()
870 ((null (fd-stream-output-later stream)))
871 (system:serve-all-events)))
872 (:element-type
873 (fd-stream-element-type stream))
874 (:line-length
875 80)
876 (:charpos
877 (fd-stream-char-pos stream))
878 (:file-length
879 (multiple-value-bind
880 (okay dev ino mode nlink uid gid rdev size
881 atime mtime ctime blksize blocks)
882 (mach:unix-fstat (fd-stream-fd stream))
883 (declare (ignore ino nlink uid gid rdev
884 atime mtime ctime blksize blocks))
885 (unless okay
886 (error "Error fstating ~S: ~A"
887 stream
888 (mach:get-unix-error-msg dev)))
889 (if (zerop mode)
890 nil
891 (/ size (fd-stream-element-size stream)))))
892 (:file-position
893 (fd-stream-file-position stream arg1))
894 (:file-name
895 (fd-stream-file stream))))
896
897 ;;; FD-STREAM-FILE-POSITION -- internal.
898 ;;;
899 (defun fd-stream-file-position (stream &optional newpos)
900 (if (null newpos)
901 (system:without-interrupts
902 ;; First, find the position of the UNIX file descriptor in the
903 ;; file.
904 (multiple-value-bind
905 (posn errno)
906 (mach:unix-lseek (fd-stream-fd stream) 0 mach:l_incr)
907 (cond ((numberp posn)
908 ;; Adjust for buffered output:
909 ;; If there is any output buffered, the *real* file position
910 ;; will be larger than reported by lseek because lseek
911 ;; obviously cannot take into account output we have not
912 ;; sent yet.
913 (dolist (later (fd-stream-output-later stream))
914 (incf posn (- (caddr later) (cadr later))))
915 (incf posn (fd-stream-obuf-tail stream))
916 ;; Adjust for unread input:
917 ;; If there is any input read from UNIX but not supplied to
918 ;; the user of the stream, the *real* file position will
919 ;; smaller than reported, because we want to look like the
920 ;; unread stuff is still available.
921 (decf posn (- (fd-stream-ibuf-tail stream)
922 (fd-stream-ibuf-head stream)))
923 (when (fd-stream-unread stream)
924 (decf posn))
925 ;; Divide bytes by element size.
926 (/ posn (fd-stream-element-size stream)))
927 ((eq errno mach:espipe)
928 nil)
929 (t
930 (system:with-interrupts
931 (error "Error lseek'ing ~S: ~A"
932 stream
933 (mach:get-unix-error-msg errno)))))))
934 (let (offset origin)
935 ;; Make sure we don't have any output pending, because if we move the
936 ;; file pointer before writing this stuff, it will be written in the
937 ;; wrong location.
938 (flush-output-buffer stream)
939 (do ()
940 ((null (fd-stream-output-later stream)))
941 (system:serve-all-events))
942 ;; Clear out any pending input to force the next read to go to the
943 ;; disk.
944 (setf (fd-stream-unread stream) nil)
945 (setf (fd-stream-ibuf-head stream) 0)
946 (setf (fd-stream-ibuf-tail stream) 0)
947 ;; Trash cashed value for listen, so that we check next time.
948 (setf (fd-stream-listen stream) nil)
949 ;; Now move it.
950 (cond ((eq newpos :start)
951 (setf offset 0 origin mach:l_set))
952 ((eq newpos :end)
953 (setf offset 0 origin mach:l_xtnd))
954 ((numberp newpos)
955 (setf offset (* newpos (fd-stream-element-size stream))
956 origin mach:l_set))
957 (t
958 (error "Invalid position given to file-position: ~S" newpos)))
959 (multiple-value-bind
960 (posn errno)
961 (mach:unix-lseek (fd-stream-fd stream) offset origin)
962 (cond ((numberp posn)
963 t)
964 ((eq errno mach:espipe)
965 nil)
966 (t
967 (error "Error lseek'ing ~S: ~A"
968 stream
969 (mach:get-unix-error-msg errno))))))))
970
971
972
973 ;;;; Creation routines (MAKE-FD-STREAM and OPEN)
974
975 ;;; MAKE-FD-STREAM -- Public.
976 ;;;
977 ;;; Returns a FD-STREAM on the given file.
978 ;;;
979 (defun make-fd-stream (fd
980 &key
981 (input nil input-p)
982 (output nil output-p)
983 (element-type 'base-character)
984 (buffering :full)
985 file
986 original
987 delete-original
988 (name (if file
989 (format nil "file ~S" file)
990 (format nil "descriptor ~D" fd))))
991 "Create a stream for the given unix file descriptor. If input is non-nil,
992 allow input operations. If output is non-nil, allow output operations. If
993 neither input nor output are specified, default to allowing input.
994 element-type indicates the element type to use (as for open). Buffering
995 indicates the kind of buffering to use (one of :none, :line, or :full). If
996 file is spesified, it should be the name of the file. Name is used to
997 identify the stream when printed."
998 (cond ((not (or input-p output-p))
999 (setf input t))
1000 ((not (or input output))
1001 (error "File descriptor must be opened either for input or output.")))
1002 (let ((stream (%make-fd-stream :fd fd
1003 :name name
1004 :file file
1005 :original original
1006 :delete-original delete-original
1007 :buffering buffering)))
1008 (set-routines stream element-type input output)
1009 stream))
1010
1011 ;;; PICK-PACKUP-NAME -- internal
1012 ;;;
1013 ;;; Pick a name to use for the backup file.
1014 ;;;
1015 (defvar *backup-extension* ".BAK"
1016 "This is a string that OPEN tacks on the end of a file namestring to produce
1017 a name for the :if-exists :rename-and-delete and :rename options. Also,
1018 this can be a function that takes a namestring and returns a complete
1019 namestring.")
1020 ;;;
1021 (defun pick-backup-name (name)
1022 (etypecase *backup-extension*
1023 (string (concatenate 'simple-string name *backup-extension*))
1024 (function (funcall *backup-extension* name))))
1025
1026 ;;; ASSURE-ONE-OF -- internal
1027 ;;;
1028 ;;; Assure that the given arg is one of the given list of valid things.
1029 ;;; Allow the user to fix any problems.
1030 ;;;
1031 (defun assure-one-of (item list what)
1032 (unless (member item list)
1033 (loop
1034 (cerror "Enter new value for ~*~S"
1035 "~S is invalid for ~S. Must be one of~{ ~S~}"
1036 item
1037 what
1038 list)
1039 (format *query-io* "Enter new value for ~S: " what)
1040 (force-output *query-io*)
1041 (setf item (read *query-io*))
1042 (when (member item list)
1043 (return))))
1044 item)
1045
1046 ;;; OPEN -- public
1047 ;;;
1048 ;;; Open the given file.
1049 ;;;
1050 (defun open (filename
1051 &key
1052 (direction :input)
1053 (element-type 'base-character)
1054 (if-exists nil if-exists-given)
1055 (if-does-not-exist nil if-does-not-exist-given))
1056 "Return a stream which reads from or writes to Filename.
1057 Defined keywords:
1058 :direction - one of :input, :output, :io, or :probe
1059 :element-type - Type of object to read or write, default BASE-CHARACTER
1060 :if-exists - one of :error, :new-version, :rename, :rename-and-delete,
1061 :overwrite, :append, :supersede or nil
1062 :if-does-not-exist - one of :error, :create or nil
1063 See the manual for details."
1064 ;; First, make sure that DIRECTION is valid. Allow it to be changed if not.
1065 (setf direction
1066 (assure-one-of direction
1067 '(:input :output :io :probe)
1068 :direction))
1069
1070 ;; Calculate useful stuff.
1071 (multiple-value-bind
1072 (input output mask)
1073 (case direction
1074 (:input (values t nil mach:o_rdonly))
1075 (:output (values nil t mach:o_wronly))
1076 (:io (values t t mach:o_rdwr))
1077 (:probe (values t nil mach:o_rdonly)))
1078 (let* ((pathname (pathname filename))
1079 (namestring (unix-namestring pathname input)))
1080
1081 ;; Process if-exists argument if we are doing any output.
1082 (cond (output
1083 (unless if-exists-given
1084 (setf if-exists
1085 (if (eq (pathname-version pathname) :newest)
1086 :new-version
1087 :error)))
1088 (setf if-exists
1089 (assure-one-of if-exists
1090 '(:error :new-version :rename
1091 :rename-and-delete :overwrite
1092 :append :supersede nil)
1093 :if-exists))
1094 (case if-exists
1095 ((:error nil)
1096 (setf mask (logior mask mach:o_excl)))
1097 ((:rename :rename-and-delete)
1098 (setf mask (logior mask mach:o_creat)))
1099 ((:new-version :supersede)
1100 (setf mask (logior mask mach:o_trunc)))
1101 (:append
1102 (setf mask (logior mask mach:o_append)))))
1103 (t
1104 (setf if-exists :ignore-this-arg)))
1105
1106 (unless if-does-not-exist-given
1107 (setf if-does-not-exist
1108 (cond ((eq direction :input) :error)
1109 ((and output
1110 (member if-exists '(:overwrite :append)))
1111 :error)
1112 ((eq direction :probe)
1113 nil)
1114 (t
1115 :create))))
1116 (setf if-does-not-exist
1117 (assure-one-of if-does-not-exist
1118 '(:error :create nil)
1119 :if-does-not-exist))
1120 (if (eq if-does-not-exist :create)
1121 (setf mask (logior mask mach:o_creat)))
1122
1123 (let ((original (if (member if-exists
1124 '(:rename :rename-and-delete))
1125 (pick-backup-name namestring)))
1126 (delete-original (eq if-exists :rename-and-delete))
1127 (mode #o666))
1128 (when original
1129 ;; We are doing a :rename or :rename-and-delete.
1130 ;; Determine if the file already exists, make sure the original
1131 ;; file is not a directory and keep the mode
1132 (let ((exists
1133 (multiple-value-bind
1134 (okay err/dev inode orig-mode)
1135 (mach:unix-stat namestring)
1136 (declare (ignore inode))
1137 (cond (okay
1138 (when (and output (= (logand orig-mode #o170000)
1139 #o40000))
1140 (error "Cannot open ~S for output: Is a directory."
1141 namestring))
1142 (setf mode (logand orig-mode #o777))
1143 t)
1144 ((eql err/dev mach:enoent)
1145 nil)
1146 (t
1147 (error "Cannot find ~S: ~A"
1148 namestring
1149 (mach:get-unix-error-msg err/dev)))))))
1150 (when (or (not exists)
1151 ;; Do the rename.
1152 (multiple-value-bind
1153 (okay err)
1154 (mach:unix-rename namestring original)
1155 (unless okay
1156 (cerror "Use :SUPERSEDE instead."
1157 "Could not rename ~S to ~S: ~A."
1158 namestring
1159 original
1160 (mach:get-unix-error-msg err))
1161 t)))
1162 (setf original nil)
1163 (setf delete-original nil)
1164 ;; In order to use SUPERSEDE instead, we have
1165 ;; to make sure mach:o_creat corresponds to
1166 ;; if-does-not-exist. mach:o_creat was set
1167 ;; before because of if-exists being :rename.
1168 (unless (eq if-does-not-exist :create)
1169 (setf mask (logior (logandc2 mask mach:o_creat) mach:o_trunc)))
1170 (setf if-exists :supersede))))
1171
1172 ;; Okay, now we can try the actual open.
1173 (multiple-value-bind
1174 (fd errno)
1175 (mach:unix-open namestring mask mode)
1176 (cond ((numberp fd)
1177 (case direction
1178 ((:input :output :io)
1179 (make-fd-stream fd
1180 :input input
1181 :output output
1182 :element-type element-type
1183 :file namestring
1184 :original original
1185 :delete-original delete-original))
1186 (:probe
1187 (let ((stream (%make-fd-stream :name namestring
1188 :fd fd
1189 :element-type element-type)))
1190 (close stream)
1191 stream))))
1192 ((eql errno mach:enoent)
1193 (case if-does-not-exist
1194 (:error
1195 (cerror "Return NIL."
1196 "Error opening ~S, ~A."
1197 pathname
1198 (mach:get-unix-error-msg errno)))
1199 (:create
1200 (cerror "Return NIL."
1201 "Error creating ~S, path does not exist."
1202 pathname)))
1203 nil)
1204 ((eql errno mach:eexist)
1205 (unless (eq nil if-exists)
1206 (cerror "Return NIL."
1207 "Error opening ~S, ~A."
1208 pathname
1209 (mach:get-unix-error-msg errno)))
1210 nil)
1211 (t
1212 (cerror "Return NIL."
1213 "Error opening ~S, ~A."
1214 pathname
1215 (mach:get-unix-error-msg errno))
1216 nil)))))))
1217
1218 ;;;; Initialization.
1219
1220 (defvar *tty* nil
1221 "The stream connected to the controlling terminal or NIL if there is none.")
1222 (defvar *stdin* nil
1223 "The stream connected to the standard input (file descriptor 0).")
1224 (defvar *stdout* nil
1225 "The stream connected to the standard output (file descriptor 1).")
1226 (defvar *stderr* nil
1227 "The stream connected to the standard error output (file descriptor 2).")
1228
1229 ;;; STREAM-INIT -- internal interface
1230 ;;;
1231 ;;; Called when the cold load is first started up.
1232 ;;;
1233 (defun stream-init ()
1234 (stream-reinit)
1235 (setf *terminal-io* (make-synonym-stream '*tty*))
1236 (setf *standard-input* (make-synonym-stream '*stdin*))
1237 (setf *standard-output* (make-synonym-stream '*stdout*))
1238 (setf *error-output* (make-synonym-stream '*stderr*))
1239 (setf *query-io* (make-synonym-stream '*terminal-io*))
1240 (setf *debug-io* *query-io*)
1241 (setf *trace-output* *standard-output*)
1242 nil)
1243
1244 ;;; STREAM-REINIT -- internal interface
1245 ;;;
1246 ;;; Called whenever a saved core is restarted.
1247 ;;;
1248 (defun stream-reinit ()
1249 (setf *available-buffers* nil)
1250 (setf *stdin*
1251 (make-fd-stream 0 :name "Standard Input" :input t :buffering :line))
1252 (setf *stdout*
1253 (make-fd-stream 1 :name "Standard Output" :output t :buffering :line))
1254 (setf *stderr*
1255 (make-fd-stream 2 :name "Standard Error" :output t :buffering :line))
1256 (let ((tty (mach:unix-open "/dev/tty" mach:o_rdwr #o666)))
1257 (if tty
1258 (setf *tty*
1259 (make-fd-stream tty :name "the Terminal" :input t :output t
1260 :buffering :line))
1261 (setf *tty* (make-two-way-stream *stdin* *stdout*))))
1262 nil)
1263
1264
1265 ;;;; Beeping.
1266
1267 (defun default-beep-function (stream)
1268 (write-char #\bell stream)
1269 (finish-output stream))
1270
1271 (defvar *beep-function* #'default-beep-function
1272 "This is called in BEEP to feep the user. It takes a stream.")
1273
1274 (defun beep (&optional (stream *terminal-io*))
1275 (funcall *beep-function* stream))
1276
1277
1278 ;;;; File position and file length.
1279
1280 ;;; File-Position -- Public
1281 ;;;
1282 ;;; Call the misc method with the :file-position operation.
1283 ;;;
1284 (defun file-position (stream &optional position)
1285 "With one argument returns the current position within the file
1286 File-Stream is open to. If the second argument is supplied, then
1287 this becomes the new file position. The second argument may also
1288 be :start or :end for the start and end of the file, respectively."
1289 (unless (streamp stream)
1290 (error "Argument ~S is not a stream." stream))
1291 (funcall (stream-misc stream) stream :file-position position))
1292
1293 ;;; File-Length -- Public
1294 ;;;
1295 ;;; Like File-Position, only use :file-length.
1296 ;;;
1297 (defun file-length (stream)
1298 "This function returns the length of the file that File-Stream is open to."
1299 (unless (streamp stream)
1300 (error "Argument ~S is not a stream." stream))
1301 (funcall (stream-misc stream) stream :file-length))
1302
1303 ;;; File-Name -- internal interface
1304 ;;;
1305 ;;; Kind of like File-Position, but is an internal hack used by the filesys
1306 ;;; stuff to get and set the file name.
1307 ;;;
1308 (defun file-name (stream &optional new-name)
1309 (when (fd-stream-p stream)
1310 (if new-name
1311 (setf (fd-stream-file stream) new-name)
1312 (fd-stream-file stream))))

  ViewVC Help
Powered by ViewVC 1.1.5