source: trunk/ccl/level-0/l0-io.lisp @ 3799

Last change on this file since 3799 was 3799, checked in by gb, 15 years ago

Hopefully, the "split" 64-bit lseek is at best LinuxPPC32-specific.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
Line 
1; -*- Mode: Lisp; Package: CCL; -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel)
20  #+linuxppc-target
21  (require "PPC-LINUX-SYSCALLS")
22  #+linuxx8664-target
23  (require "X8664-LINUX-SYSCALLS")
24  #+darwin-target
25  (require "DARWIN-SYSCALLS"))
26
27
28; write nbytes bytes from buffer buf to file-descriptor fd.
29(defun fd-write (fd buf nbytes)
30  (syscall syscalls::write fd buf nbytes))
31
32(defun fd-read (fd buf nbytes)
33  (syscall syscalls::read fd buf nbytes))
34
35(defun fd-open (path flags &optional (create-mode #o666))
36  (with-cstrs ((p path))
37    (syscall syscalls::open p flags create-mode)))
38
39(defun fd-chmod (fd mode)
40  (syscall syscalls::fchmod fd mode))
41
42;;; This should really be conditionalized on whether the seek system
43;;; call supports 64-bit offsets or on whether one has to use some
44;;; variant.
45#+(and ppc32-target linux-target)
46(defun fd-lseek (fd offset whence)
47  (let* ((high (ldb (byte 32 32) offset))
48         (low (ldb (byte 32 0) offset)))
49    (declare (type (unsigned-byte 32) high low))
50    (%stack-block ((pos 8))
51      (let* ((res (syscall syscalls::_llseek fd high low pos whence)))
52        (declare (fixnum res))
53        (if (< res 0)
54          res
55          (let* ((pos-high (%get-unsigned-long pos 0))
56                 (pos-low (%get-unsigned-long pos 4)))
57            (declare (type (unsigned-byte 32) pos-high pos-low))
58            (if (zerop pos-high)
59              pos-low
60              (dpb pos-high (byte 32 32) pos-low))))))))
61
62#-(and ppc32-target linux-target)
63(defun fd-lseek (fd offset whence)
64  (syscall syscalls::lseek fd offset whence))
65
66(defun fd-close (fd)
67  (syscall syscalls::close fd)) 
68
69(defun fd-tell (fd)
70  (fd-lseek fd 0 #$SEEK_CUR))
71
72;;; Kernels prior to 2.4 don't seem to have a "stat" variant
73;;; that handles 64-bit file offsets.
74(defun fd-size (fd)
75  (without-interrupts
76   (let* ((curpos (fd-lseek fd 0 #$SEEK_CUR)))
77     (unwind-protect
78          (fd-lseek fd 0 #$SEEK_END)
79       (fd-lseek fd curpos #$SEEK_SET)))))
80
81(defun fd-ftruncate (fd new)
82  (syscall syscalls::ftruncate fd new))
83
84(defun %string-to-stderr (str)
85  (with-cstrs ((s str))
86    (fd-write 2 s (length str))))
87
88(defun pdbg (string)
89  (%string-to-stderr string)
90  (%string-to-stderr #.(string #\LineFeed)))
91
92
93
94;;; Not really I/O, but ...
95(defun malloc (size)
96  (ff-call 
97   (%kernel-import target::kernel-import-malloc)
98   :unsigned-fullword size :address))
99
100(defun free (ptr)
101  (ff-call 
102   (%kernel-import target::kernel-import-free)
103   :address ptr :void))
104
105
106;;; Yield the CPU, via a platform-specific syscall.
107(defun yield ()
108  (%syscall target::yield-syscall :signed-fullword))
109
Note: See TracBrowser for help on using the repository browser.