Ignore:
Timestamp:
Jul 29, 2006, 9:40:57 AM (13 years ago)
Author:
gb
Message:

Most BASIC-FILE-STREAM stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-sysio.lisp

    r4915 r4925  
    282282     (external-format :initform :default :initarg :external-format
    283283                      :accessor file-stream-external-format)))
     284
    284285 
    285286
     
    296297  (setf (slot-value s 'actual-filename) new))
    297298
    298 (defmethod print-object ((s fundamental-file-stream) out)
     299(defun print-file-stream (s out)
    299300  (print-unreadable-object (s out :type t :identity t)
    300301    (let* ((file-ioblock (stream-ioblock s nil)))
     
    303304        (format out "~d)" (file-ioblock-device file-ioblock))
    304305        (format out ":closed")))))
    305            
     306   
     307(defmethod print-object ((s fundamental-file-stream) out)
     308  (print-file-stream s out))
     309
     310(make-built-in-class 'basic-file-stream 'basic-stream 'file-stream)
     311
     312(defmethod stream-filename ((s basic-file-stream))
     313  (basic-file-stream.filename s))
     314
     315(defmethod stream-actual-filename ((s basic-file-stream))
     316  (basic-file-stream.actual-filename s))
     317
     318(defmethod (setf stream-filename) (new (s basic-file-stream))
     319  (setf (basic-file-stream.filename s) new))
     320
     321(defmethod (setf stream-actual-filename) (new (s basic-file-stream))
     322  (setf (basic-file-stream.actual-filename s) new))
     323
     324(defmethod print-object ((s basic-file-stream) out)
     325  (print-file-stream s out))
     326
    306327(defmethod stream-create-ioblock ((stream fundamental-file-stream) &rest args &key)
    307328  (declare (dynamic-extent args))
    308329  (apply #'make-file-ioblock :stream stream args))
    309330
     331(defmethod stream-create-ioblock ((stream basic-file-stream) &rest args &key)
     332  (declare (dynamic-extent args))
     333  (apply #'make-file-ioblock :stream stream args))
     334
    310335(defclass fundamental-file-input-stream (fundamental-file-stream fd-input-stream)
    311336    ())
    312337
     338(make-built-in-class 'basic-file-input-stream 'basic-file-stream 'basic-input-stream)
     339
     340
    313341(defclass fundamental-file-output-stream (fundamental-file-stream fd-output-stream)
    314342    ())
    315343
     344(make-built-in-class 'basic-file-output-stream 'basic-file-stream 'basic-output-stream)
     345
    316346(defclass fundamental-file-io-stream (fundamental-file-stream fd-io-stream)
    317347    ())
     348
     349(make-built-in-class 'basic-file-io-stream 'basic-file-stream 'basic-io-stream)
     350
    318351
    319352(defclass fundamental-file-character-input-stream (fundamental-file-input-stream
     
    321354    ())
    322355
     356(make-built-in-class 'basic-file-character-input-stream 'basic-file-input-stream 'basic-character-input-stream)
     357
     358
    323359(defclass fundamental-file-character-output-stream (fundamental-file-output-stream
    324360                                                    fd-character-output-stream)
    325361    ())
    326362
     363(make-built-in-class 'basic-file-character-output-stream 'basic-file-output-stream 'basic-character-output-stream)
     364
    327365(defclass fundamental-file-character-io-stream (fundamental-file-io-stream
    328366                                       fd-character-io-stream)
    329367    ())
    330368
     369(make-built-in-class 'basic-file-character-io-stream 'basic-file-io-stream 'basic-character-io-stream)
     370
    331371(defclass fundamental-file-binary-input-stream (fundamental-file-input-stream
    332372                                                fd-binary-input-stream)
    333373    ())
    334374
     375(make-built-in-class 'basic-file-binary-input-stream 'basic-file-input-stream 'basic-binary-input-stream)
     376
    335377(defclass fundamental-file-binary-output-stream (fundamental-file-output-stream
    336378                                                 fd-binary-output-stream)
    337379    ())
    338380
     381(make-built-in-class 'basic-file-binary-output-stream 'basic-file-output-stream 'basic-binary-output-stream)
     382
    339383(defclass fundamental-file-binary-io-stream (fundamental-file-io-stream fd-binary-io-stream)
    340384    ())
     385
     386(make-built-in-class 'basic-file-binary-io-stream 'basic-file-io-stream 'basic-binary-io-stream)
     387
    341388
    342389;;; This stuff is a lot simpler if we restrict the hair to the
     
    350397    (synch-file-octet-filepos file-ioblock)
    351398    nil))
     399
     400
     401(defmethod stream-clear-input ((f basic-file-input-stream))
     402  (let* ((file-ioblock (basic-stream-ioblock f)))
     403    (with-ioblock-input-locked (file-ioblock)
     404      (call-next-method)
     405      (synch-file-octet-filepos file-ioblock)
     406      nil)))
     407
    352408   
    353409(defmethod stream-clear-input ((f fundamental-file-io-stream))
     
    358414    nil))
    359415
     416(defmethod stream-clear-input ((f basic-file-io-stream))
     417  (let* ((file-ioblock (basic-stream-ioblock f)))
     418    (with-ioblock-input-locked (file-ioblock)
     419      (call-next-method)
     420      (synch-file-octet-filepos file-ioblock)
     421      nil)))
     422
    360423(defmethod stream-clear-output ((f fundamental-file-output-stream))
    361424  (with-stream-ioblock-output (file-ioblock f :speedy t)
     
    363426    (synch-file-octet-filepos file-ioblock)
    364427    nil))
     428
     429(defmethod stream-clear-output ((f basic-file-output-stream))
     430  (let* ((file-ioblock (basic-stream-ioblock f)))
     431    (with-ioblock-input-locked (file-ioblock)
     432      (call-next-method)
     433      (synch-file-octet-filepos file-ioblock)
     434      nil)))
    365435
    366436;;; Fill the input buffer, possibly doing newline translation.
     
    442512
    443513
     514(defmethod stream-position ((stream basic-file-input-stream) &optional newpos)
     515  (let* ((file-ioblock (basic-stream-ioblock stream)))
     516    (with-ioblock-input-locked (file-ioblock)
     517      (%ioblock-input-file-position file-ioblock newpos))))
    444518
    445519(defmethod stream-position ((stream fundamental-file-output-stream) &optional newpos)
     
    447521    (%ioblock-output-file-position file-ioblock newpos)))
    448522
     523(defmethod stream-position ((stream basic-file-output-stream) &optional newpos)
     524  (let* ((file-ioblock (basic-stream-ioblock stream)))
     525    (with-ioblock-output-locked (file-ioblock)
     526      (%ioblock-output-file-position file-ioblock newpos))))
    449527
    450528
     
    453531    (%ioblock-io-file-position file-ioblock newpos)))
    454532
     533(defmethod stream-position ((stream basic-file-io-stream) &optional newpos)
     534  (let* ((file-ioblock (basic-stream-ioblock stream)))
     535    (with-ioblock-input-locked (file-ioblock)
     536      (%ioblock-io-file-position file-ioblock newpos))))
    455537
    456538
     
    459541    (%ioblock-input-file-length file-ioblock newlen)))
    460542
     543(defmethod stream-length ((stream basic-file-input-stream) &optional newlen)
     544  (let* ((file-ioblock (basic-stream-ioblock stream)))
     545    (with-ioblock-input-locked (file-ioblock)
     546      (%ioblock-input-file-length file-ioblock newlen))))
    461547
    462548
     
    465551    (%ioblock-output-file-length file-ioblock newlen)))
    466552
     553
     554(defmethod stream-length ((stream basic-file-output-stream) &optional newlen)
     555  (let* ((file-ioblock (basic-stream-ioblock stream)))
     556    (with-ioblock-output-locked (file-ioblock)
     557      (%ioblock-output-file-length file-ioblock newlen))))
     558
    467559(defmethod stream-length ((s fundamental-file-io-stream) &optional newlen)
    468560  (with-stream-ioblock-input (file-ioblock s :speedy t)
    469561    (%ioblock-output-file-length file-ioblock newlen)))
    470562
    471 (defmethod close ((s fundamental-file-stream) &key abort)
     563(defmethod stream-length ((stream basic-file-io-stream) &optional newlen)
     564  (let* ((file-ioblock (basic-stream-ioblock stream)))
     565    (with-ioblock-input-locked (file-ioblock)
     566      (%ioblock-output-file-length file-ioblock newlen))))
     567
     568(defun close-file-stream (s abort)
    472569  (when (open-stream-p s)
    473570    (let* ((ioblock (stream-ioblock s t))
     
    481578            (unix-rename (namestring actual-filename) (probe-file-x filename)))
    482579          (delete-file actual-filename)))
    483       (setq *open-file-streams* (nremove s *open-file-streams*))
    484       (call-next-method))))
     580      (setq *open-file-streams* (nremove s *open-file-streams*)))))
     581
     582
     583(defmethod close ((s fundamental-file-stream) &key abort)
     584  (close-file-stream s abort)
     585  (call-next-method))
     586
     587(defmethod close ((s basic-file-stream) &key abort)
     588  (close-file-stream s abort)
     589  (call-next-method))
    485590
    486591(defmethod select-stream-class ((class fundamental-file-stream) in-p out-p char-p)
     
    637742  (file-stream-external-format s))
    638743
     744(defmethod stream-external-format ((s basic-file-stream))
     745  (basic-file-stream.external-format s))
     746
    639747(defmethod stream-external-format ((s broadcast-stream))
    640748  (let* ((last (last-broadcast-stream s)))
Note: See TracChangeset for help on using the changeset viewer.