Commit 71643bf1 authored by Antoine Martin's avatar Antoine Martin
Browse files

Add support for parallelism

Run the generation of .texi files and .html files in parallel
parent 4980520e
......@@ -90,3 +90,49 @@
:dist-name dist-name
:function #'ql-dist:provided-releases
:filter filter))
(defmacro endpush (object place)
"Like push, but at the end."
`(setf ,place (nconc ,place (list ,object))))
(defun map-objects-thread (file mutex waitqueue
&key dist-name function (filter 'identity) evals pre-file)
(unless (probe-file file)
(error "~S does not exist" file))
(let ((dist (ql-dist:find-dist dist-name)))
(unless dist
(error "~S does not name any known dist" dist-name))
(let ((objects (funcall function dist)))
(dolist (object objects)
(let ((name (ql-dist:name object)))
(when (funcall filter name)
(ql-dist:ensure-installed object)
(let ((*default-pathname-defaults*
(base-directory object)))
(run-sbcl :file file
:pre-file pre-file
:environment-pairs (list "*qrmapper-object-name*"
name)
:evals evals)
(with-mutex (mutex)
(endpush name *buffer*)
(condition-notify waitqueue))))))))
(with-mutex (mutex)
(endpush :done *buffer*)))
(defun map-releases-thread (file mutex waitqueue
&key (dist-name "quicklisp") (filter 'identity)
pre-file)
"For each release in a dist (defaults to the \"quicklisp\" dist),
start an independent SBCL process and load FILE with the variable
CL-USER:*QRMAPPER-OBJECT-NAME* bound to the release's name.
This is the multi-threaded version, passing the built texis
to the thread in charge of generating html files."
(map-objects-thread file
mutex
waitqueue
:pre-file pre-file
:dist-name dist-name
:function #'ql-dist:provided-releases
:filter filter))
......@@ -5,6 +5,14 @@
(:import-from :sb-ext
:run-program
:native-namestring)
(:import-from :sb-thread
:make-thread
:make-mutex
:make-waitqueue
:with-mutex
:condition-notify
:condition-wait
:join-thread)
(:import-from :cl-ppcre
:regex-replace)
(:import-from :3bmd
......@@ -69,6 +77,22 @@ The resulting .texi file is placed inside the release's directory, in
(merge-pathnames "map-declt.lisp"
(asdf:system-source-directory "quickref")))))
(defvar *buffer* nil)
(defun build-parallel (&key (makeinfo-path *makeinfo-path*))
(let* ((mutex (make-mutex))
(wq (make-waitqueue))
(thread (make-thread
(lambda ()
(build-texis-thread mutex wq
:makeinfo-path makeinfo-path)))))
(map-releases-thread (merge-pathnames
"map-declt.lisp"
(asdf:system-source-directory "quickref"))
mutex
wq)
(join-thread thread)))
(defun uninstall-releases ()
(dolist (release (ql-dist:provided-releases t))
(ql-dist:uninstall release)))
......@@ -81,6 +105,7 @@ The resulting .texi file is placed inside the release's directory, in
(makeinfo-path *makeinfo-path*)
(log-errors *log-errors*)
(remove-cache *remove-cache*)
parallel
uninstall)
"Run the whole Quickref process, from generating the .texi files with Declt
to creating the corresponding html files with makeinfo.
......@@ -105,6 +130,9 @@ be found in ~/texi-logfiles/ and ~/declt-logfiles/ for now."
(uninstall-releases))
(ql:update-all-dists :prompt nil)
(ql:update-client :prompt nil)
(build-releases)
(build-texis)
(if parallel
(build-parallel)
(progn
(build-releases)
(build-texis)))
(build-index)))
......@@ -135,3 +135,22 @@ The resulting file is written at ~/quickref/index.html"
(*log-errors* log-errors))
(dolist (texi (get-texi-pathnames))
(build-texi texi))))
(defun build-texis-thread (mutex wq
&key
(makeinfo-path *makeinfo-path*)
(log-errors *log-errors*))
(let ((*makeinfo-path* makeinfo-path)
(*log-errors* log-errors))
(loop :named l do
(let ((release nil))
(with-mutex (mutex)
(unless *buffer*
(condition-wait wq mutex))
(setf release (pop *buffer*)))
(when (eql release :done)
(return-from build-texis-thread))
(let ((file (from-quickref-dir
(format nil "texis/~A.texi" release))))
(when (probe-file file)
(build-texi file)))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment