src/os.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          os.lisp
   6 ;;;; Purpose:       Operating system interface for UFFI
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Sep 2002
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg.
  13 ;;;; Much of this code was taken from other open source project and copyright
  14 ;;;; for that code is noted below where appropriate.
  15 ;;;;
  16 ;;;; UFFI users are granted the rights to distribute and use this software
  17 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  18 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  19 ;;;; *************************************************************************
  20
  21 (in-package #:uffi)
  22
  23 ;; modified from function ASDF -- Copyright Dan Barlow and Contributors
  24
  25 (defun run-shell-command (control-string  &rest args &key output)
  26   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
  27 synchronously execute the result using a Bourne-compatible shell, with
  28 output to *trace-output*.  Returns the shell's exit code."
  29   (unless output
  30     (setq output *trace-output*))
  31
  32   (let ((command (apply #'format nil control-string args)))
  33     #+sbcl
  34     (sb-impl::process-exit-code
  35      (sb-ext:run-program
  36       "/bin/sh"
  37       (list "-c" command)
  38       :input nil :output output))
  39
  40     #+(or cmu scl)
  41     (ext:process-exit-code
  42      (ext:run-program
  43       "/bin/sh"
  44       (list "-c" command)
  45       :input nil :output output))
  46
  47     #+allegro
  48     (excl:run-shell-command command :input nil :output output)
  49
  50     #+lispworks
  51     (system:call-system-showing-output
  52      command
  53      :shell-type "/bin/sh"
  54      :output-stream output)
  55
  56     #+clisp                             ;XXX not exactly *trace-output*, I know
  57     (ext:run-shell-command  command :output :terminal :wait t)
  58
  59     #+openmcl
  60     (nth-value 1
  61                (ccl:external-process-status
  62                 (ccl:run-program "/bin/sh" (list "-c" command)
  63                                  :input nil :output output
  64                                  :wait t)))
  65
  66     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
  67     (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
  68     ))