crow-httpd: switch from CVS RCSID to GIT revision for versioning
[mmondor.git] / mmsoftware / cl / server / io.lisp
CommitLineData
267e4533 1;;;; $Id: io.lisp,v 1.3 2012/10/12 22:49:58 mmondor Exp $
ace88c7a
MM
2
3#|
4
5Copyright (c) 2012, Matthew Mondor
6All rights reserved.
7
8Redistribution and use in source and binary forms, with or without
9modification, are permitted provided that the following conditions
10are met:
111. Redistributions of source code must retain the above copyright
12 notice, this list of conditions and the following disclaimer.
132. Redistributions in binary form must reproduce the above copyright
14 notice, this list of conditions and the following disclaimer in the
15 documentation and/or other materials provided with the distribution.
16
17THIS SOFTWARE IS PROVIDED BY MATTHEW MONDOR ``AS IS'' AND ANY EXPRESS OR
18IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
19OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
20IN NO EVENT SHALL MATTHEW MONDOR BE LIABLE FOR ANY DIRECT, INDIRECT,
21INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
22BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
23USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
26THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27
28|#
29
30;;;; IO, optimized block input/output for ECL using file descriptors and syscalls
31
32
26eda510 33(declaim (optimize (speed 3) (safety 0) (debug 0)))
ace88c7a
MM
34
35(defpackage :io
36 (:use :cl)
37 (:export #:vector-read
38 #:vector-write))
39
40(in-package :io)
41
ace88c7a
MM
42
43
44(ffi:clines "
45#include <errno.h>
46#include <stdint.h>
47#include <unistd.h>
48")
49
50(defun vector-read (vector fd)
26eda510 51 (declare (type fixnum fd))
267e4533
MM
52 (unless (and (eq 'ext:byte8 (array-element-type vector))
53 (array-has-fill-pointer-p vector))
54 (error "ARRAY-ELEMENT-TYPE for vector ~S is not EXT:BYTE8 with FILL-POINTER"
55 vector))
ace88c7a 56 (multiple-value-bind (bytes errno)
267e4533
MM
57 (ffi:c-inline (vector fd) (:object :fixnum)
58 (values :fixnum :fixnum) "
ace88c7a
MM
59{
60 cl_object vector = #0;
61 int fd = #1, err = 0;
62 size_t ret;
63
267e4533
MM
64 ecl_disable_interrupts();
65
ace88c7a
MM
66 while ((ret = read(fd, vector->vector.self.b8, vector->vector.dim))
67 == -1 && errno == EINTR) ;
68
69 if (ret == -1)
70 err = errno;
71 else
72 vector->vector.fillp = ret;
73
267e4533
MM
74 ecl_enable_interrupts();
75
ace88c7a
MM
76 @(return 0) = ret;
77 @(return 1) = err;
267e4533 78}" :one-liner nil :side-effects t)
ace88c7a
MM
79 (declare (type fixnum bytes errno)
80 (ignore errno))
81 (if (< bytes 1)
26eda510
MM
82 (error 'end-of-file :stream nil) ; XXX Not ideal but allright now
83 (the fixnum bytes))))
ace88c7a
MM
84
85(defun vector-write (fd vector)
26eda510 86 (declare (type fixnum fd))
ace88c7a 87 (unless (eq 'ext:byte8 (array-element-type vector))
267e4533
MM
88 (error "ARRAY-ELEMENT-TYPE for vector ~S is not EXT:BYTE8"
89 vector))
ace88c7a 90 (multiple-value-bind (bytes errno)
267e4533
MM
91 (ffi:c-inline (fd vector) (:fixnum :object)
92 (values :fixnum :fixnum) "
ace88c7a
MM
93{
94 cl_object vector = #1;
95 int fd = #0, err = 0;
96 size_t ret;
97 uint8_t *ptr, *toptr;
98
267e4533
MM
99 ecl_disable_interrupts();
100
ace88c7a
MM
101 for (ptr = vector->vector.self.b8,
102 toptr = &ptr[vector->vector.fillp], ret = 0;
103 (ret != -1 || errno == EINTR) && ptr < toptr;
104 ptr += ret)
105 ret = write(fd, ptr, (toptr - ptr));
106
107 if (ret == -1)
108 err = errno;
109 else
110 ret = vector->vector.fillp;
111
267e4533
MM
112 ecl_enable_interrupts();
113
ace88c7a
MM
114 @(return 0) = ret;
115 @(return 1) = err;
267e4533 116}" :one-liner nil :side-effects t)
ace88c7a
MM
117 (declare (type fixnum bytes errno)
118 (ignore errno))
119 (if (< bytes 1)
26eda510
MM
120 (error 'end-of-file :stream nil) ; XXX Not ideal but allright now
121 (the fixnum bytes))))