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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by wlott, Sat Nov 3 00:26:39 1990 UTC revision 1.9 by wlott, Sun Jan 13 00:52:08 1991 UTC
# Line 1170  Line 1170 
1170                (setf if-exists :supersede))))                (setf if-exists :supersede))))
1171    
1172          ;; Okay, now we can try the actual open.          ;; Okay, now we can try the actual open.
1173          (multiple-value-bind          (loop
1174              (fd errno)            (multiple-value-bind
1175              (mach:unix-open namestring mask mode)                (fd errno)
1176            (cond ((numberp fd)                (mach:unix-open namestring mask mode)
1177                   (case direction              (cond ((numberp fd)
1178                     ((:input :output :io)                     (return
1179                      (make-fd-stream fd                      (case direction
1180                                      :input input                        ((:input :output :io)
1181                                      :output output                         (make-fd-stream fd
1182                                      :element-type element-type                                         :input input
1183                                      :file namestring                                         :output output
1184                                      :original original                                         :element-type element-type
1185                                      :delete-original delete-original))                                         :file namestring
1186                     (:probe                                         :original original
1187                      (let ((stream (%make-fd-stream :name namestring                                         :delete-original delete-original))
1188                                                     :fd fd                        (:probe
1189                                                     :element-type element-type)))                         (let ((stream
1190                        (close stream)                                (%make-fd-stream :name namestring :fd fd
1191                        stream))))                                                 :element-type element-type)))
1192                  ((eql errno mach:enoent)                           (close stream)
1193                   (case if-does-not-exist                           stream)))))
1194                     (:error                    ((eql errno mach:enoent)
1195                      (cerror "Return NIL."                     (case if-does-not-exist
1196                              "Error opening ~S, ~A."                       (:error
1197                              pathname                        (cerror "Return NIL."
1198                              (mach:get-unix-error-msg errno)))                                "Error opening ~S, ~A."
1199                     (:create                                pathname
1200                      (cerror "Return NIL."                                (mach:get-unix-error-msg errno)))
1201                              "Error creating ~S, path does not exist."                       (:create
1202                              pathname)))                        (cerror "Return NIL."
1203                   nil)                                "Error creating ~S, path does not exist."
1204                  ((eql errno mach:eexist)                                pathname)))
1205                   (unless (eq nil if-exists)                     (return nil))
1206                      ((eql errno mach:eexist)
1207                       (unless (eq nil if-exists)
1208                         (cerror "Return NIL."
1209                                 "Error opening ~S, ~A."
1210                                 pathname
1211                                 (mach:get-unix-error-msg errno)))
1212                       (return nil))
1213                      ((eql errno mach:eacces)
1214                       (cerror "Try again."
1215                              "Error opening ~S, ~A."
1216                              pathname
1217                              (mach:get-unix-error-msg errno)))
1218                      (t
1219                     (cerror "Return NIL."                     (cerror "Return NIL."
1220                             "Error opening ~S, ~A."                             "Error opening ~S, ~A."
1221                             pathname                             pathname
1222                             (mach:get-unix-error-msg errno)))                             (mach:get-unix-error-msg errno))
1223                   nil)                     (return nil)))))))))
                 (t  
                  (cerror "Return NIL."  
                          "Error opening ~S, ~A."  
                          pathname  
                          (mach:get-unix-error-msg errno))  
                  nil)))))))  
1224    
1225  ;;;; Initialization.  ;;;; Initialization.
1226    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

  ViewVC Help
Powered by ViewVC 1.1.5