src/glisp/dep-clisp.lisp

   1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
   2 ;;; ---------------------------------------------------------------------------
   3 ;;;     Title: CLISP 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 (in-package :CL-USER)
  30
  31 (eval-when (compile load eval)
  32   (if (fboundp 'cl::define-compiler-macro)
  33       (pushnew 'define-compiler-macro *features*)))
  34
  35 (setq lisp:*load-paths* '(#P"./"))
  36
  37 (import 'lisp:read-byte-sequence :glisp)
  38 (export 'lisp:read-byte-sequence :glisp)
  39 (import 'lisp:read-char-sequence :glisp)
  40 (export 'lisp:read-char-sequence :glisp)
  41 (export 'glisp::compile-file :glisp)
  42 (export 'glisp::run-unix-shell-command :glisp)
  43 (export 'glisp::make-server-socket :glisp)
  44
  45
  46 #||
  47 (export 'glisp::read-byte-sequence :glisp)
  48 (defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence)))
  49   (let (c (i start))
  50     (loop
  51       (cond ((= i end) (return i)))
  52       (setq c (read-byte input nil :eof))
  53       (cond ((eql c :eof) (return i)))
  54       (setf (aref sequence i) c)
  55       (incf i) )))
  56 ||#
  57
  58
  59 (defun glisp::compile-file (&rest ap)
  60   (and (apply #'compile-file ap)
  61        (apply #'compile-file-pathname ap)))
  62
  63 (defmacro glisp::with-timeout ((&rest ignore) &body body)
  64   (declare (ignore ignore))
  65   `(progn
  66      ,@body))
  67
  68 (defun glisp::open-inet-socket (hostname port)
  69   (values
  70    (lisp:socket-connect port hostname)
  71    :byte))
  72
  73 (defun glisp:make-server-socket (port)
  74   (lisp:socket-server port))
  75
  76 (defun glisp::accept-connection/low (socket)
  77   (let ((stream (lisp:socket-accept socket)))
  78     (setf (stream-element-type stream) '(unsigned-byte 8))
  79     (values
  80      stream
  81      :byte)))
  82
  83 (defun glisp::g/make-string (length &rest options)
  84   (apply #'make-array length
  85          :element-type
  86          '#.(cond ((stringp (make-array 1 :element-type 'string-char))
  87                    'string-char)
  88                   ((stringp (make-array 1 :element-type 'base-char))
  89                    'base-char)
  90                   (t
  91                    (error "What is the string element type of the day?")))
  92          options))
  93
  94 (defun glisp:run-unix-shell-command (command)
  95   (lisp:shell command))
  96
  97 #+DEFINE-COMPILER-MACRO
  98 (cl:define-compiler-macro ldb (bytespec value &whole whole)
  99   (let (pos size)
 100     (cond ((and (consp bytespec)
 101                 (= (length bytespec) 3)
 102                 (eq (car bytespec) 'byte)
 103                 (constantp (setq size (second bytespec)))
 104                 (constantp (setq pos (third bytespec))))
 105            `(logand ,(if (eql pos 0) value `(ash ,value (- ,pos)))
 106                     (1- (ash 1 ,size))))
 107           (t
 108            whole))))
 109
 110 #-DEFINE-COMPILER-MACRO
 111 (progn
 112   (export 'glisp::define-compiler-macro :glisp)
 113   (defmacro glisp::define-compiler-macro (name args &body body)
 114     (declare (ignore args body))
 115     `(progn
 116        ',name)))
 117
 118 #||
 119 (defun xlib:draw-glyph (drawable gcontext x y elt &rest more)
 120   (apply #'xlib:draw-glyphs drawable gcontext x y (vector elt) more))
 121 ||#
 122
 123 (export 'glisp::getenv :glisp)
 124 (defun glisp::getenv (var)
 125   (sys::getenv var))