Ignore:
Timestamp:
Oct 14, 2008, 6:30:00 PM (13 years ago)
Author:
gz
Message:

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-0/l0-io.lisp

    r10972 r11089  
    1717(in-package "CCL")
    1818
    19 (eval-when (:compile-toplevel)
    20   #+linuxppc-target
    21   (require "PPC-LINUX-SYSCALLS")
    22   #+linuxx8664-target
    23   (require "X8664-LINUX-SYSCALLS")
    24   #+darwinppc-target
    25   (require "DARWINPPC-SYSCALLS")
    26   #+darwinx8664-target
    27   (require "DARWINX8664-SYSCALLS")
    28   #+freebsd-target
    29   (require "X8664-FREEBSD-SYSCALLS")
    30   )
     19
    3120
    3221
     
    194183;;; write nbytes bytes from buffer buf to file-descriptor fd.
    195184(defun fd-write (fd buf nbytes)
    196   (ignoring-eintr
    197    (syscall syscalls::write fd buf nbytes)))
     185  (ignoring-eintr
     186   (int-errno-ffcall
     187    (%kernel-import target::kernel-import-lisp-write)
     188             :int fd :address buf :ssize_t nbytes :ssize_t)))
    198189
    199190(defun fd-read (fd buf nbytes)
    200   (ignoring-eintr (syscall syscalls::read fd buf nbytes)))
     191  (ignoring-eintr
     192   (int-errno-ffcall
     193    (%kernel-import target::kernel-import-lisp-read)
     194             :int fd :address buf :ssize_t nbytes :ssize_t)))
    201195
    202196
     
    206200   #-(or darwin-target windows-target) with-cstrs
    207201   ((p path))
    208     (let* ((fd (syscall syscalls::open p flags create-mode)))
     202    (let* ((fd (int-errno-ffcall
     203                (%kernel-import target::kernel-import-lisp-open)
     204                :address p :int flags :mode_t create-mode :int)))
    209205      (declare (fixnum fd))
    210206      (when (or (= fd (- #$EMFILE))
     
    212208        (gc)
    213209        (drain-termination-queue)
    214         (setq fd (syscall syscalls::open p flags create-mode)))
     210        (setq fd (int-errno-ffcall
     211                  (%kernel-import target::kernel-import-lisp-open)
     212                           :address p :int flags :mode_t create-mode :int)))
    215213      fd)))
    216214
    217215(defun fd-chmod (fd mode)
    218   (syscall syscalls::fchmod fd mode))
    219 
    220 ;;; This should really be conditionalized on whether the seek system
    221 ;;; call supports 64-bit offsets or on whether one has to use some
    222 ;;; variant.
    223 #+(and ppc32-target linux-target)
     216  (int-errno-ffcall (%kernel-import target::kernel-import-lisp-fchmod)
     217                    :int fd
     218                    :mode_t mode
     219                    :int))
     220
    224221(defun fd-lseek (fd offset whence)
    225   (let* ((high (ldb (byte 32 32) offset))
    226          (low (ldb (byte 32 0) offset)))
    227     (declare (type (unsigned-byte 32) high low))
    228     (%stack-block ((pos 8))
    229       (let* ((res (syscall syscalls::_llseek fd high low pos whence)))
    230         (declare (fixnum res))
    231         (if (< res 0)
    232           res
    233           (let* ((pos-high (%get-unsigned-long pos 0))
    234                  (pos-low (%get-unsigned-long pos 4)))
    235             (declare (type (unsigned-byte 32) pos-high pos-low))
    236             (if (zerop pos-high)
    237               pos-low
    238               (dpb pos-high (byte 32 32) pos-low))))))))
    239 
    240 #-(and ppc32-target linux-target)
    241 (defun fd-lseek (fd offset whence)
    242   #+freebsd-target
    243   (syscall syscalls::lseek fd 0 offset whence)
    244   #-freebsd-target
    245   (syscall syscalls::lseek fd offset whence))
     222  (int-errno-ffcall
     223   (%kernel-import target::kernel-import-lisp-lseek)
     224   :int fd
     225   :signed-doubleword offset
     226   :int whence
     227   :signed-doubleword))
    246228
    247229(defun fd-close (fd)
    248   (syscall syscalls::close fd))
     230  (int-errno-ffcall (%kernel-import target::kernel-import-lisp-close)
     231                    :int fd
     232                    :int))
    249233
    250234(defun fd-tell (fd)
     
    254238;;; that handles 64-bit file offsets.
    255239(defun fd-size (fd)
    256   (without-interrupts
    257    (let* ((curpos (fd-lseek fd 0 #$SEEK_CUR)))
    258      (unwind-protect
    259           (fd-lseek fd 0 #$SEEK_END)
    260        (fd-lseek fd curpos #$SEEK_SET)))))
     240  (rlet ((stat #+win64-target #>_stat64 #+win32-target #>__stat64 #-windows-target :stat))
     241    (if (eql 0 (ff-call (%kernel-import target::kernel-import-lisp-fstat)
     242                        :int fd
     243                        :address stat
     244                        :int))
     245      (pref stat
     246            #-windows-target :stat.st_size
     247            #+win64-target #>_stat64.st_size
     248            #+win32-target #>__stat64.st_size)
     249      -1)))
     250
    261251
    262252(defun fd-ftruncate (fd new)
    263   (syscall syscalls::ftruncate fd new))
     253  (int-errno-ffcall (%kernel-import target::kernel-import-lisp-ftruncate)
     254                    :int fd :off_t new :int))
    264255
    265256(defun %string-to-stderr (str)
Note: See TracChangeset for help on using the changeset viewer.