src/glisp/dep-cmucl.lisp

   1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
   2 ;;; ---------------------------------------------------------------------------
   3 ;;;     Title: CMUCL dependent stuff + fixups
   4 ;;;   Created: 1999-05-25 22:32
   5 ;;;    Author: Gilbert Baumann <gilbert@base-engineering.com>
   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 (export 'glisp::read-byte-sequence :glisp)
  30 (export 'glisp::read-char-sequence :glisp)
  31 (export 'glisp::run-unix-shell-command :glisp)
  32
  33 (export 'glisp::getenv :glisp)
  34
  35 (export 'glisp::make-server-socket :glisp)
  36 (export 'glisp::close-server-socket :glisp)
  37
  38 (defun glisp::read-byte-sequence (&rest ap)
  39   (apply #'read-sequence ap))
  40
  41 (defun glisp::read-char-sequence (&rest ap)
  42   (apply #'read-sequence ap))
  43
  44 (defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence)))
  45   (let (c (i start))
  46     (loop
  47       (cond ((= i end) (return i)))
  48       (setq c (read-byte input nil :eof))
  49       (cond ((eql c :eof) (return i)))
  50       (setf (aref sequence i) c)
  51       (incf i) )))
  52
  53 (defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence)))
  54   (let ((r (read-sequence sequence input :start start :end end)))
  55     (cond ((and (= r start) (> end start))
  56            (let ((byte (read-byte input nil :eof)))
  57              (cond ((eq byte :eof)
  58                     r)
  59                    (t
  60                     (setf (aref sequence start) byte)
  61                     (incf start)
  62                     (if (> end start)
  63                         (glisp::read-byte-sequence sequence input :start start :end end)
  64                       start)))))
  65           (t
  66            r))))
  67
  68 (defmacro glisp::with-timeout ((&rest ignore) &body body)
  69   (declare (ignore ignore))
  70   `(progn
  71      ,@body))
  72
  73 (defun glisp::open-inet-socket (hostname port)
  74   (let ((fd (extensions:connect-to-inet-socket hostname port)))
  75     (values
  76      (sys:make-fd-stream fd
  77                          :input t
  78                          :output t
  79                          :element-type '(unsigned-byte 8)
  80                          :name (format nil "Network connection to ~A:~D" hostname port))
  81      :byte)))
  82
  83 (defstruct (server-socket (:constructor make-server-socket-struct))
  84   fd
  85   element-type
  86   port)
  87
  88 (defun glisp::make-server-socket (port &key (element-type '(unsigned-byte 8)))
  89   (make-server-socket-struct :fd (ext:create-inet-listener port)
  90                              :element-type element-type
  91                              :port port))
  92
  93 (defun glisp::accept-connection/low (socket)
  94   (mp:process-wait-until-fd-usable (server-socket-fd socket) :input)
  95   (values
  96    (sys:make-fd-stream (ext:accept-tcp-connection (server-socket-fd socket))
  97                        :input t :output t
  98                        :element-type (server-socket-element-type socket))
  99    (cond ((subtypep (server-socket-element-type socket) 'integer)
 100           :byte)
 101          (t
 102           :char))))
 103
 104 (defun glisp::close-server-socket (socket)
 105   (unix:unix-close (server-socket-fd socket)))
 106
 107 (defun glisp::g/make-string (length &rest options)
 108   (apply #'make-array length :element-type 'base-char options))
 109
 110
 111 (defun glisp:run-unix-shell-command (command)
 112   (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))
 113
 114 (defun glisp::getenv (string)
 115   (cdr (assoc string ext:*environment-list* :test #'string-equal)))