/[cl-ipc]/cl-ipc/uffi.lisp
ViewVC logotype

Contents of /cl-ipc/uffi.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Fri Sep 9 08:50:06 2005 UTC (8 years, 7 months ago) by skamphausen
Branch: MAIN
Branch point for: cl-ipc
Initial revision
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
2
3 ;;; $Header: /tiger/var/lib/cvsroots/cl-ipc/cl-ipc/uffi.lisp,v 1.1 2005/09/09 08:50:06 skamphausen Exp $
4 ;;; $Id: uffi.lisp,v 1.1 2005/09/09 08:50:06 skamphausen Exp $
5
6 ;;; Copyright (C) 2005 by
7 ;;; Dr. Edmund Weitz http://weitz.de
8 ;;; and
9 ;;; Stefan Kamphausen http://www.skamphausen.de
10 ;;; All rights reserved.
11
12 ;;; Redistribution and use in source and binary forms, with or without
13 ;;; modification, are permitted provided that the following conditions
14 ;;; are met:
15
16 ;;; * Redistributions of source code must retain the above copyright
17 ;;; notice, this list of conditions and the following disclaimer.
18
19 ;;; * Redistributions in binary form must reproduce the above
20 ;;; copyright notice, this list of conditions and the following
21 ;;; disclaimer in the documentation and/or other materials
22 ;;; provided with the distribution.
23
24 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
25 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
27 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
28 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
29 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
30 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35
36 (in-package :cl-ipc)
37
38 (defconstant +ipc-create-flag+ #o00001000)
39 (defconstant +ipc-exclusive-flag+ #o00002000)
40 (defconstant +ipc-rmid+ 0)
41
42 ;; def-struct from UFFI!
43 ;; #. is reader macro to eval at read time
44 (def-struct msg-struct
45 (mtype :long)
46 (text (:array :char #.+message-length+)))
47
48 (def-foreign-type msg-struct-pointer (* msg-struct))
49
50 (def-function ("msgget" msg-get)
51 ((key :int)
52 (flag :int))
53 :returning :int
54 :module :cl-ipc)
55
56 (def-function ("msgrcv" msg-receive)
57 ((id :int)
58 (msg msg-struct-pointer)
59 (msg-size :unsigned-int)
60 (msg-type :long)
61 (flag :int))
62 :returning :int
63 :module :cl-ipc)
64
65 (def-function ("msgctl" msg-control)
66 ((id :int)
67 (command :int)
68 (msqid_ds :pointer-void))
69 :returning :int
70 :module :cl-ipc)
71
72 (defun msg-close (id)
73 (ignore-errors
74 (msg-control id +ipc-rmid+ (make-null-pointer :void))))
75
76

  ViewVC Help
Powered by ViewVC 1.1.5