Initial revision

glisp/dep-clisp.lisp

@@ -0,0 +1,176 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
+;;; ---------------------------------------------------------------------------
+;;;     Title: CLISP dependent stuff + fixups
+;;;   Created: 1999-05-25 22:32
+;;;    Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
+;;;   License: GPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;;  (c) copyright 1999 by Gilbert Baumann
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package :CL-USER)
+
+(eval-when (compile load eval)
+  (if (fboundp 'cl::define-compiler-macro)
+      (pushnew 'define-compiler-macro *features*)))
+
+(setq lisp:*load-paths* '(#P"./"))
+
+(import 'lisp:read-byte-sequence :glisp)
+(export 'lisp:read-byte-sequence :glisp)
+(import 'lisp:read-char-sequence :glisp)
+(export 'lisp:read-char-sequence :glisp)
+(export 'glisp::compile-file :glisp)
+(export 'glisp::run-unix-shell-command :glisp)
+(export 'glisp::make-server-socket :glisp)
+
+
+#||
+(export 'glisp::read-byte-sequence :glisp) 
+(defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence)))
+  (let (c (i start))
+    (loop
+      (cond ((= i end) (return i)))
+      (setq c (read-byte input nil :eof))
+      (cond ((eql c :eof) (return i)))
+      (setf (aref sequence i) c)
+      (incf i) )))
+||#
+
+
+(defun glisp::compile-file (&rest ap)
+  (and (apply #'compile-file ap)
+       (apply #'compile-file-pathname ap)))
+
+(defmacro glisp::with-timeout ((&rest ignore) &body body)
+  (declare (ignore ignore))
+  `(progn
+     ,@body))
+
+(defun glisp::open-inet-socket (hostname port)
+  (values
+   (lisp:socket-connect port hostname)
+   :byte))
+
+(defun glisp:make-server-socket (port)
+  (lisp:socket-server port))
+
+(defun glisp::accept-connection/low (socket)
+  (let ((stream (lisp:socket-accept socket)))
+    (setf (stream-element-type stream) '(unsigned-byte 8))
+    (values 
+     stream
+     :byte)))
+
+(defun glisp::g/make-string (length &rest options)
+  (apply #'make-array length 
+         :element-type 
+         '#.(cond ((stringp (make-array 1 :element-type 'string-char))
+                   'string-char)
+                  ((stringp (make-array 1 :element-type 'base-char))
+                   'base-char)
+                  (t
+                   (error "What is the string element type of the day?")))
+         options))
+
+(defun glisp:run-unix-shell-command (command)
+  (lisp:shell command))
+
+#+DEFINE-COMPILER-MACRO
+(cl:define-compiler-macro ldb (bytespec value &whole whole)
+  (let (pos size)
+    (cond ((and (consp bytespec)
+                (= (length bytespec) 3)
+                (eq (car bytespec) 'byte)
+                (constantp (setq size (second bytespec)))
+                (constantp (setq pos (third bytespec))))
+           `(logand ,(if (eql pos 0) value `(ash ,value (- ,pos)))
+                    (1- (ash 1 ,size))))
+          (t
+           whole))))
+
+#-DEFINE-COMPILER-MACRO
+(progn
+  (export 'glisp::define-compiler-macro :glisp)
+  (defmacro glisp::define-compiler-macro (name args &body body)
+    (declare (ignore args body))
+    `(progn
+       ',name)))
+
+#||
+(defun xlib:draw-glyph (drawable gcontext x y elt &rest more)
+  (apply #'xlib:draw-glyphs drawable gcontext x y (vector elt) more))
+||#
+
+(defmacro glisp::defsubst (name args &body body)
+  `(progn
+     (declaim (inline ,name))
+     (defun ,name ,args .,body)))
+
+(export 'glisp::getenv :glisp)
+(defun glisp::getenv (var)
+  (sys::getenv var))
+
+
+
+(export 'glisp::mp/process-run-function :glisp)
+(defun glisp:mp/process-run-function (name fn &rest args)
+  (apply #'mp:process-run-function name fn args))
+
+(export 'glisp::mp/process-kill :glisp)
+(defun glisp:mp/process-kill (proc)
+  (mp:process-kill proc))
+
+(export 'glisp::mp/current-process :glisp)
+(defun glisp:mp/current-process ()
+  (mp:current-process))
+
+(export 'glisp::mp/seize-lock :glisp)
+(defun glisp::mp/seize-lock (lock &key whostate)
+  whostate
+  (mp:process-lock lock))
+
+(export 'glisp::mp/release-lock :glisp)
+(defun glisp::mp/release-lock (lock)
+  (mp:process-unlock lock))
+
+(export 'glisp::mp/process-yield :glisp)
+(defun glisp::mp/process-yield (&optional process-to-run)
+  process-to-run
+  (mp:process-allow-schedule))
+
+(export 'glisp::mp/process-wait :glisp)
+(defun glisp::mp/process-wait (whostate predicate)
+  (mp::process-wait whostate predicate))
+
+(defmacro glisp::mp/with-lock ((lock) &body body)
+  `(mp:with-process-lock (,lock)
+     ,@body))
+
+(defun glisp::mp/make-lock (&key name)
+  (mp:make-process-lock :name name))
+
+
+
+
+
+
+
+
+
+
+
+