From d7d819976cb5d84766bffd2c5272c86203687ee9 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 31 Mar 2008 00:16:26 +0100
Subject: [PATCH] Upgrade everything for SBCL.

---
 .gitignore    |  1 +
 infix.lisp    |  6 +++---
 mdw-mop.lisp  |  5 ++++-
 optparse-test |  4 ++++
 safely.lisp   | 20 +++++++++++++++-----
 sys-base.lisp |  5 ++++-
 6 files changed, 31 insertions(+), 10 deletions(-)

diff --git a/.gitignore b/.gitignore
index b94a63c..2335672 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
 *.x86f
 *.fas
 *.lib
+*.fasl
diff --git a/infix.lisp b/infix.lisp
index 579bce4..64a0a30 100644
--- a/infix.lisp
+++ b/infix.lisp
@@ -610,11 +610,11 @@
   (pushval `(loop ,@(strip-progn (parse-infix 0)))))
 
 (defopfunc bind operand
-  (labels ((loop ()
+  (labels ((loopy ()
 	    (let ((ids (parse-ident-list))
 		  (valform (progn (delim '=) (parse-infix 0)))
 		  (body (if (delim '|,| nil)
-			    (loop)
+			    (loopy)
 			    (progn
 			      (delim 'in)
 			      (strip-progn (parse-infix 0))))))
@@ -622,7 +622,7 @@
 			`(let ((,(car ids) ,valform)) ,@body)
 			`(multiple-value-bind ,ids ,valform ,@body))))))
     (get-token)
-    (pushval (car (loop)))))
+    (pushval (car (loopy)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Parsing function bodies and lambda lists.
diff --git a/mdw-mop.lisp b/mdw-mop.lisp
index 9488e0e..e813f97 100644
--- a/mdw-mop.lisp
+++ b/mdw-mop.lisp
@@ -27,7 +27,10 @@
 ;;; Packages.
 
 (defpackage #:mdw.mop
-  (:use #:common-lisp #:mdw.base #+(or cmu clisp) #:mop #+ecl #:clos)
+  (:use #:common-lisp #:mdw.base
+	#+(or cmu clisp) #:mop
+	#+sbcl #:sb-mop
+	#+ecl #:clos)
   (:export #:copy-instance #:copy-instance-using-class
 	   #:with-slot-variables
 	   #:compatible-class
diff --git a/optparse-test b/optparse-test
index 4441483..4f3ad5f 100755
--- a/optparse-test
+++ b/optparse-test
@@ -1,5 +1,9 @@
 #! /usr/local/bin/runlisp
 
+(cl:defpackage #:optparse-test
+  (:use #:common-lisp))
+(cl:in-package #:optparse-test)
+
 (let ((*compile-verbose* nil)
       (*load-verbose* nil))
   (asdf:oos 'asdf:load-op "mdw" :verbose nil))
diff --git a/safely.lisp b/safely.lisp
index 0a05f8b..b5d7ff8 100644
--- a/safely.lisp
+++ b/safely.lisp
@@ -30,6 +30,11 @@
 	   #:safely-writing))
 (in-package #:safely)
 
+#+(or cmu sbcl)
+(eval-when (:compile-toplevel :execute)
+  (import #+cmu '(ext:unix-namestring unix:unix-link)
+	  #+sbcl '(sb-int:unix-namestring)))
+
 (defstruct (safely (:predicate safelyp))
   "Stores information about how to commit or undo safe writes."
   (streams nil)
@@ -136,19 +141,24 @@
   (safely-unwind (safely-trail safe))
   (safely-reset safe))
 
+#+sbcl
+(defun unix-link (from to)
+  (sb-unix::int-syscall ("link" sb-alien:c-string sb-alien:c-string)
+			from to))
+
 (defun safe-copy (file tag)
   "Make a copy of the FILE.  Return the new name."
 
-  #+cmu
+  #+(or cmu sbcl)
   ;; Use link(2) where available.
   (generate-fresh-file-name file tag
 			    (lambda (name)
-			      (let ((from (ext:unix-namestring file t))
-				    (to (ext:unix-namestring name nil)))
+			      (let ((from (unix-namestring file t))
+				    (to (unix-namestring name nil)))
 				(and from to
-				     (unix:unix-link from to)))))
+				     (unix-link from to)))))
 
-  #-cmu
+  #-(or cmu sbcl)
   ;; Otherwise just copy the file contents and hope for the best.
   (with-open-file (input file :element-type :default)
     (multiple-value-bind
diff --git a/sys-base.lisp b/sys-base.lisp
index ef71916..e973e90 100644
--- a/sys-base.lisp
+++ b/sys-base.lisp
@@ -25,7 +25,8 @@
 
 (defpackage #:runlisp
   (:use #:common-lisp)
-  (:export #:*lisp-interpreter* #:*command-line-strings* #:run))
+  (:export #:*lisp-interpreter* #:*command-line-strings* #:run)
+  #+cmu (:import-from #:ext #:*command-line-strings*))
 (defvar runlisp:*command-line-strings* '("<interactive>"))
 
 (defpackage #:mdw.sys-base
@@ -40,6 +41,7 @@
    after fork, for example, to avoid flushing buffers."
   (declare (type (unsigned-byte 32) code))
   #+cmu (unix::void-syscall ("_exit" c-call:int) code)
+  #+sbcl (sb-ext:quit :unix-status code :recklessly-p t)
   #+(or clisp ecl) (ext:quit code))
 
 #-clisp
@@ -48,6 +50,7 @@
    return to the top-level REPL."
   (if (boundp '*lisp-interpreter*)
       #+(or cmu ecl) (ext:quit code)
+      #+sbcl (sb-ext:quit :unix-status code)
       (progn
         (unless (zerop code)
           (format t "~&Exiting unsuccessfully with code ~D.~%" code))
-- 
2.11.0