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

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

FreeBSD syscalls.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 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  #+freebsd-target
27  (require "X8664-FREEBSD-SYSCALLS")
28  )
29
30
31; write nbytes bytes from buffer buf to file-descriptor fd.
32(defun fd-write (fd buf nbytes)
33  (syscall syscalls::write fd buf nbytes))
34
35(defun fd-read (fd buf nbytes)
36  (syscall syscalls::read fd buf nbytes))
37
38(defun fd-open (path flags &optional (create-mode #o666))
39  (with-cstrs ((p path))
40    (syscall syscalls::open p flags create-mode)))
41
42(defun fd-chmod (fd mode)
43  (syscall syscalls::fchmod fd mode))
44
45;;; This should really be conditionalized on whether the seek system
46;;; call supports 64-bit offsets or on whether one has to use some
47;;; variant.
48#+(and ppc32-target linux-target)
49(defun fd-lseek (fd offset whence)
50  (let* ((high (ldb (byte 32 32) offset))
51         (low (ldb (byte 32 0) offset)))
52    (declare (type (unsigned-byte 32) high low))
53    (%stack-block ((pos 8))
54      (let* ((res (syscall syscalls::_llseek fd high low pos whence)))
55        (declare (fixnum res))
56        (if (< res 0)
57          res
58          (let* ((pos-high (%get-unsigned-long pos 0))
59                 (pos-low (%get-unsigned-long pos 4)))
60            (declare (type (unsigned-byte 32) pos-high pos-low))
61            (if (zerop pos-high)
62              pos-low
63              (dpb pos-high (byte 32 32) pos-low))))))))
64
65#-(and ppc32-target linux-target)
66(defun fd-lseek (fd offset whence)
67  #+freebsd-target
68  (syscall syscalls::lseek fd 0 offset whence)
69  #-freebsd-target
70  (syscall syscalls::lseek fd offset whence))
71
72(defun fd-close (fd)
73  (syscall syscalls::close fd)) 
74
75(defun fd-tell (fd)
76  (fd-lseek fd 0 #$SEEK_CUR))
77
78;;; Kernels prior to 2.4 don't seem to have a "stat" variant
79;;; that handles 64-bit file offsets.
80(defun fd-size (fd)
81  (without-interrupts
82   (let* ((curpos (fd-lseek fd 0 #$SEEK_CUR)))
83     (unwind-protect
84          (fd-lseek fd 0 #$SEEK_END)
85       (fd-lseek fd curpos #$SEEK_SET)))))
86
87(defun fd-ftruncate (fd new)
88  (syscall syscalls::ftruncate fd new))
89
90(defun %string-to-stderr (str)
91  (with-cstrs ((s str))
92    (fd-write 2 s (length str))))
93
94(defun pdbg (string)
95  (%string-to-stderr string)
96  (%string-to-stderr #.(string #\LineFeed)))
97
98
99
100;;; Not really I/O, but ...
101(defun malloc (size)
102  (ff-call 
103   (%kernel-import target::kernel-import-malloc)
104   :unsigned-fullword size :address))
105
106(defun free (ptr)
107  (ff-call 
108   (%kernel-import target::kernel-import-free)
109   :address ptr :void))
110
111
112;;; Yield the CPU, via a platform-specific syscall.
113(defun yield ()
114  (%syscall target::yield-syscall :signed-fullword))
115
Note: See TracBrowser for help on using the repository browser.