wrappers.lisp

   1 ;;; A collection of wrappers around extended functionality that may be
   2 ;;; different across CL implementations.
   3
   4 ;;; To add support for a new CL implementation, an entry in each of
   5 ;;; these functions must be made for it.
   6
   7 (in-package :lice)
   8
   9 ;;; Weak Pointers
  10
  11 (defun weak-pointer-p (wp)
  12   #+clisp (ext:weak-pointer-p (wp))
  13   #-(or clisp) (declare (ignore wp)))
  14
  15 (defun make-weak-pointer (data)
  16   #+clisp (ext:make-weak-pointer data)
  17   #+cmu (extensions:make-weak-pointer data)
  18   #+sbcl (sb-ext:make-weak-pointer data)
  19   #+(or movitz mcl) data)
  20
  21 (defun weak-pointer-value (wp)
  22   #+clisp (ext:weak-pointer-value wp)
  23   #+cmu (extensions:weak-pointer-value wp)
  24   #+sbcl (sb-ext:weak-pointer-value wp)
  25   #+(or movitz mcl) (values wp t))
  26
  27 ;;; Some wrappers for access to filesystem things. file type, file
  28 ;;; size, ownership, modification date, mode, etc
  29
  30 (defun file-stats (pathname)
  31   "Return some file stats"
  32   #+sbcl
  33   (let ((stat (sb-posix:lstat pathname)))
  34     (values (sb-posix:stat-mode stat)
  35             (sb-posix:stat-size stat)
  36             (sb-posix:stat-uid stat)
  37             (sb-posix:stat-gid stat)
  38             (sb-posix:stat-mtime stat)))
  39   #+clisp
  40   (let ((stat (sys::file-stat pathname)))
  41     (values (butlast (sys::file-stat-mode stat))
  42             (sys::file-stat-size stat)
  43             (sys::file-stat-uid stat)
  44             (sys::file-stat-gid stat)
  45             (sys::file-stat-mtime stat)))
  46   #-(or sbcl clisp)
  47   (error "Not implemented"))
  48
  49 ;;; subprocesses
  50
  51 (defun run-program (program args &key (output :stream) (error :stream) (input :stream) (sentinel nil))
  52   #+sbcl (let ((p (sb-ext:run-program program args :output output :error error :input input :status-hook sentinel)))
  53            (values p
  54                    (sb-ext:process-input p)
  55                    (sb-ext:process-output p)
  56                    (sb-ext:process-error p)))
  57   #-sbcl (error "Not implemented"))
  58
  59 (defun internal-process-alive-p (process)
  60   #+sbcl (sb-ext:process-alive-p process)
  61   #-sbcl (error "Not implemented"))
  62
  63 (defun internal-process-kill (process &optional (signal 3))
  64   #+sbcl (sb-ext:process-kill process signal)
  65   #-(or sbcl) (error "Not implemented"))
  66
  67 ;;; threads
  68
  69 (defun make-thread (function)
  70   #+sbcl (sb-thread:make-thread function)
  71   #-(or sbcl) (error "Not implemented"))
  72
  73 (defun thread-alive-p (thread)
  74   #+sbcl (sb-thread:thread-alive-p thread)
  75   #-(or sbcl) (error "Not implemented"))
  76
  77 (defun kill-thread (thread)
  78   #+sbcl (sb-thread:terminate-thread thread)
  79   #-(or sbcl) (error "Not implemented"))
  80
  81 (defun make-mutex ()
  82   #+sbcl (sb-thread:make-mutex)
  83   #-(or sbcl) (error "Not implemented"))
  84
  85 (defmacro with-mutex ((mutex) &body body)
  86   #+sbcl `(sb-thread:with-mutex (,mutex) ,@body)
  87   #-(or sbcl) (error "Not implemented"))
  88
  89 ;;; environment
  90
  91 (defun getenv (var)
  92   "Return the value of the environment variable."
  93   #+clisp (ext:getenv (string var))
  94   #+sbcl (sb-posix:getenv (string var))
  95   #-(or clisp sbcl)
  96   (error "Not implemented"))
  97
  98 ;;; debugger
  99
 100 (defun backtrace-as-string (&optional (depth most-positive-fixnum))
 101   (with-output-to-string (s)
 102     #+sbcl (sb-debug:backtrace depth s)
 103     #-(or sbcl)
 104     (error "Not implemented")))
 105
 106 ;;; two way streams
 107
 108
 109 (provide :lice-0.1/wrappers)
 110