source: branches/qres/ccl/library/syscall.lisp

Last change on this file was 13070, checked in by gz, 10 years ago

r13066, r13067 from trunk: copyrights etc

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.2 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2001-2009 Clozure Associates
4;;;   This file is part of Clozure CL. 
5;;;
6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with Clozure CL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   Clozure CL 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;;; "Generic" syscall sypport.
18
19(in-package "CCL")
20
21(defpackage "SYSCALLS" (:use))
22
23(defstruct syscall
24  (idx 0 :type fixnum)
25  (arg-specs () :type list)
26  (result-spec nil :type symbol)
27  (min-args 0 :type fixnum))
28
29(defvar *os-syscall-definitions* ())
30
31(defun platform-syscall-definitions (platform-os)
32  (or (getf *os-syscall-definitions* platform-os)
33      (setf (getf *os-syscall-definitions* platform-os)
34            (make-hash-table :test 'eq))))
35
36(defun backend-syscall-definitions (backend)
37  (platform-syscall-definitions (backend-platform-syscall-mask backend)))
38
39
40
41(defmacro define-syscall (platform name idx (&rest arg-specs) result-spec
42                               &key (min-args (length arg-specs)))
43  `(progn
44    (setf (gethash ',name (platform-syscall-definitions ,platform))
45     (make-syscall :idx ,idx
46      :arg-specs ',arg-specs
47      :result-spec ',result-spec
48      :min-args ,min-args))
49    ',name))
50
51(defmacro syscall (name &rest args)
52  (let* ((info (or (gethash name (backend-syscall-definitions *target-backend*))
53                   (error "Unknown system call: ~s" name)))
54         (idx (syscall-idx info))
55         (arg-specs (syscall-arg-specs info))
56         (n-argspecs (length arg-specs))
57         (n-args (length args))
58         (min-args (syscall-min-args info))
59         (result (syscall-result-spec info)))
60    (unless (and (>= n-args min-args) (<= n-args n-argspecs))
61      (error "wrong number of args in ~s" args))
62    (do* ((call ())
63          (specs arg-specs (cdr specs))
64          (args args (cdr args)))
65         ((null args)
66          `(%syscall ,idx ,@(nreverse (cons result call))))
67      (push (car specs) call)
68      (push (car args) call))))
Note: See TracBrowser for help on using the repository browser.