src/glisp/dep-openmcl.lisp

   1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
   2 ;;; ---------------------------------------------------------------------------
   3 ;;;     Title: OpenMCL dependent stuff + fixups
   4 ;;;   Created: 2005-08-25 11:50
   5 ;;;    Author:
   6 ;;;   License: MIT style (see below)
   7 ;;; ---------------------------------------------------------------------------
   8 ;;;  (c) copyright 1999 by Gilbert Baumann
   9
  10 ;;;  Permission is hereby granted, free of charge, to any person obtaining
  11 ;;;  a copy of this software and associated documentation files (the
  12 ;;;  "Software"), to deal in the Software without restriction, including
  13 ;;;  without limitation the rights to use, copy, modify, merge, publish,
  14 ;;;  distribute, sublicense, and/or sell copies of the Software, and to
  15 ;;;  permit persons to whom the Software is furnished to do so, subject to
  16 ;;;  the following conditions:
  17 ;;;
  18 ;;;  The above copyright notice and this permission notice shall be
  19 ;;;  included in all copies or substantial portions of the Software.
  20 ;;;
  21 ;;;  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  22 ;;;  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  23 ;;;  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  24 ;;;  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  25 ;;;  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  26 ;;;  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  27 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  28
  29 (defun glisp::read-byte-sequence (&rest ap)
  30   (apply #'read-sequence ap))
  31
  32 (defun glisp::read-char-sequence (&rest ap)
  33   (apply #'read-sequence ap))
  34
  35 (defmacro glisp::with-timeout ((&rest options) &body body)
  36   (declare (ignore options))
  37   `(progn
  38      ,@body))
  39
  40 (defun glisp::open-inet-socket (hostname port)
  41   (values
  42    (ccl::make-socket :address-family :internet
  43                      :type :stream
  44                      :remote-host hostname
  45                      :remote-port port)
  46    :byte))
  47
  48 (defstruct (server-socket (:constructor make-server-socket-struct))
  49   fd
  50   element-type
  51   port)
  52
  53
  54 #||
  55 (export 'glisp::make-server-socket :glisp)
  56 (defun glisp::make-server-socket (port &key (element-type '(unsigned-byte 8)))
  57   (make-server-socket-struct :fd (ext:create-inet-listener port)
  58                              :element-type element-type
  59                              :port port))
  60
  61
  62 (defun glisp::accept-connection/low (socket)
  63   (mp:process-wait-until-fd-usable (server-socket-fd socket) :input)
  64   (values
  65    (sys:make-fd-stream (ext:accept-tcp-connection (server-socket-fd socket))
  66                        :input t :output t
  67                        :element-type (server-socket-element-type socket))
  68    (cond ((subtypep (server-socket-element-type socket) 'integer)
  69           :byte)
  70          (t
  71           :char))))
  72
  73 (export 'glisp::close-server-socket :glisp)
  74 (defun glisp::close-server-socket (socket)
  75   (unix:unix-close (server-socket-fd socket)))
  76 ||#
  77
  78 ;;;;;;
  79
  80 (defun glisp::g/make-string (length &rest options)
  81   (apply #'make-array length :element-type 'base-char options))
  82
  83
  84
  85 (defun glisp::run-unix-shell-command (command)
  86   (nth-value 1 (ccl:external-process-status
  87    (ccl:run-program "/bin/sh" (list "-c" command) :wait t :input nil
  88                        :output nil))))
  89
  90 (defun glisp::getenv (string)
  91   (ccl::getenv string))