Update POIU to work with ASDF 2.31.

#+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.

;;; 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*

#+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*

(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?"))

(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 ()

(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)

|#

);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))

                (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

":" ; : "-*- 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

      *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)

         exprs)

      (apply 'values ,res)))))

(load-system :asdf)

(load-system :poiu :verbose t)

(setf *load-verbose* t

(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

 ;; 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))))

     :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)