Update POIU to work with ASDF 2.31.

diff --git a/poiu.lisp b/poiu.lisp
index 5afe121..35d9b70 100644 (file)
--- a/poiu.lisp
+++ b/poiu.lisp
@@ -3,8 +3,8 @@
 #+xcvb (module (:depends-on ("asdf")))
 (in-package :asdf)
 (eval-when (:compile-toplevel :load-toplevel :execute)
-(defparameter *poiu-version* "1.29.12")
-(defparameter *asdf-version-required-by-poiu* "2.26.174"))
+(defparameter *poiu-version* "1.29.13")
+(defparameter *asdf-version-required-by-poiu* "2.31"))
 #|
 POIU is a modification of ASDF that may operate on your systems in parallel.
 This version of POIU was designed to work with ASDF no earlier than specified.
@@ -95,8 +95,8 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
 
 ;;; Check versions
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  #-(or clisp clozure sbcl)
-  (format *error-output* "POIU doesn't support your Lisp implementation (yet). Help port POIU!")
+  #-(or allegro clisp clozure sbcl)
+  (warn "POIU doesn't support forking on your Lisp implementation (yet). Help port POIU!")
   (unless (or #+asdf3 (version<= *asdf-version-required-by-poiu* (asdf:asdf-version)))
     (error "POIU ~A requires ASDF ~A or later, but you only have ~A loaded."
            *poiu-version*
@@ -375,8 +375,6 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
 
 #+sbcl
 (progn
-(defun posix-exit (code)
-  (sb-posix:exit code))
 ;; Simple heuristic: if we have allocated more than the given ratio
 ;; of what is allowed between GCs, then trigger the GC.
 ;; Note: can possibly modify parameters and reset in sb-ext:*after-gc-hooks*
@@ -416,8 +414,6 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
 (progn
 (defun can-fork-p ()
   (null (cdr (ccl::all-processes))))
-(defun posix-exit (n)
-  (ccl:quit n))
 (defun posix-fork ()
   (unless (null (cdr (ccl:all-processes)))
     (error "Cannot fork: more than one active thread. Are you using single-threaded-ccl?"))
@@ -446,8 +442,6 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
 (progn
 (defun can-fork-p ()
   (and (find-symbol* 'wait "LINUX" nil) (find-symbol* 'fork "LINUX" nil) t))
-(defun posix-exit (n)
-  (ext:quit n))
 (defun posix-fork ()
   (funcall (find-symbol* 'fork "LINUX")))
 (defun posix-setpgrp ()
@@ -460,7 +454,7 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
 (defun posix-wait ()
   (handler-case
       (multiple-value-bind (pid status code) (funcall (find-symbol* 'wait "LINUX"))
-        (values (and pid (not (= pid -1))) (list pid status code)))
+        (values (unless (= pid -1) pid) (list pid status code)))
     ((and system::simple-os-error (satisfies no-child-process-condition-p)) ()
       (values nil nil))))
 (defun posix-wexitstatus (x)
@@ -482,10 +476,27 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
 |#
 );clisp
 
-#-(or sbcl ccl clisp)
+#+allegro ;;; Allegro specific fork support
+(progn
+(defun can-fork-p ()
+  (null (cdr mp:*all-processes*)))
+(defun posix-fork ()
+  (excl.osi:fork))
+(defun posix-setpgrp ()
+  (excl.osi:setpgrp))
+(defun posix-wait (&key pid nowait)
+  (format t "~&~S: posix-wait :pid ~S :nowait ~S~%" (excl::getpid) pid nowait)
+  (multiple-value-bind (exit-status pid signal)
+      (sys:reap-os-subprocess :pid (or pid -1) :wait (not nowait))
+    (values pid (list exit-status signal))))
+(defun posix-wexitstatus (x)
+  (first x))
+(trace posix-fork posix-wait posix-wexitstatus sys:reap-os-subprocess)
+);allegro
+
+#-(or sbcl ccl clisp allegro)
 (progn
 (defun can-fork-p () nil)
-(defun posix-exit (n) nil)
 (defun posix-fork () nil)
 (defun posix-setpgrp () nil)
 (defun posix-wait () (values nil nil))
@@ -565,7 +576,7 @@ The original copyright and (MIT-style) licence of ASDF (below) applies to POIU:
                 (ignore-errors (values (funcall function data t)))
               (process-return result-file result condition))
          (finish-outputs)
-         (posix-exit 0)))
+         (quit 0 nil)))
       (t ; in the parent
        (make-instance 'background-process
                       :pid pid

diff --git a/test.lisp b/test.lisp
index 9fa2beb..ceb6691 100755 (executable)
--- a/test.lisp
+++ b/test.lisp
@@ -1,10 +1,8 @@
 ":" ; : "-*- Lisp -*-" \
-; case "${1:-sbcl}" in (sbcl) : \
-; sbcl --load test.lisp
-;; (ccl) : \
-; ../single-threaded-ccl/stccl --load test.lisp
-;; (clisp) : \
-; clisp -i ../asdf/asdf.lisp -i test.lisp
+; case "${1:-sbcl}" in (sbcl) sbcl --load test.lisp \
+;; (allegro) alisp -L test.lisp \
+;; (ccl) ../single-threaded-ccl/stccl --load test.lisp \
+;; (clisp) clisp -i test.lisp \
 ;; (*) echo "Unrecognized/unsupported Lisp: $1" ; exit 42
 ;; esac 2>&1 | tee foo ; exit
 
@@ -15,9 +13,14 @@
       *compile-verbose* nil
       *compile-print* nil)
 
-(require "asdf")
+(ignore-errors (funcall 'require "asdf"))
+#-asdf2 (load "../asdf/build/asdf.lisp")
 
-(in-package :asdf)
+(asdf:load-system :asdf)
+
+(in-package :asdf) ;; in case there was a punt, be in the NEW asdf package.
+
+#+clisp (trace asdf::read-file-form asdf::read-file-forms)
 
 (pushnew :DBG *features*)
 (defmacro DBG (tag &rest exprs)
@@ -34,8 +37,6 @@ outputs a tag plus a list of source expressions and their resulting values, retu
          exprs)
       (apply 'values ,res)))))
 
-(load-system :asdf)
-
 (load-system :poiu :verbose t)
 
 (setf *load-verbose* t
@@ -46,15 +47,6 @@ outputs a tag plus a list of source expressions and their resulting values, retu
 
 (format *error-output* "~&POIU ~A~%" *poiu-version*)
 
-(defun print-backtrace (out)
-  "Print a backtrace (implementation-defined)"
-  (declare (ignorable out))
-  #+clozure (let ((*debug-io* out))
-             (ccl:print-call-history :count 100 :start-frame-number 1)
-             (finish-output out))
-  #+sbcl
-  (sb-debug:backtrace most-positive-fixnum out))
-
 #+(or)
 (trace
  traverse ;; traverse-component
@@ -68,16 +60,16 @@ outputs a tag plus a list of source expressions and their resulting values, retu
  ;; compile-file load
  operate call-recording-breadcrumbs perform-plan
 )
-;;#+clisp (trace posix-wexitstatus posix-wait)
+#+allegro (trace posix-fork posix-wexitstatus posix-wait excl::getpid quit)
 
-(defvar *fare* (asdf::user-homedir))
+(defvar *fare* (asdf/common-lisp:user-homedir-pathname))
 (defun subnamestring (base sub)
-  (namestring (asdf::subpathname base sub)))
+  (namestring (asdf/driver:subpathname base sub)))
 
 (block nil
   (handler-bind ((error #'(lambda (condition)
                             (format t "~&ERROR:~%~A~%" condition)
-                            (print-backtrace *standard-output*)
+                            (print-backtrace :stream *standard-output*)
                             (format t "~&ERROR:~%~A~%" condition)
                             (finish-output)
                             (return))))
@@ -85,11 +77,11 @@ outputs a tag plus a list of source expressions and their resulting values, retu
      :exscribe :verbose t
      :force :all
      :breadcrumbs-to "/tmp/breadcrumbs.text")
-    (funcall (asdf::find-symbol* :process-command-line :exscribe)
+    (funcall (asdf/package:find-symbol* :process-command-line :exscribe)
              `("-I" ,(subnamestring *fare* "fare/www/")
                "-o" "-" "-H" ,(subnamestring *fare* "fare/www/index.scr")))))
 
-(format t "~&~S~%" (asdf::implementation-identifier))
+(format t "~&~S~%" (asdf/os:implementation-identifier))
 (format t "~&Compiled with as many as ~D forked subprocesses~%" *max-actual-forks*)
 
-(asdf::posix-exit 0)
+(quit 0)