Merge pull request #1587 from clasp-developers/tarball

Add archive function for koga

Author: yitzchak

include/clasp/mps

@@ -135,4 +135,8 @@
                        (:tree ,(uiop:getcwd))
                        :inherit-configuration))
   (asdf:load-system :koga)
-  (apply #'uiop:symbol-call "KOGA" (if help "HELP" "SETUP") initargs))
+  (apply #'uiop:symbol-call "KOGA"
+                            (cond (help "HELP")
+                                  ((getf initargs :archive) "ARCHIVE")
+                                  (t "SETUP"))
+                            initargs))

koga

@@ -0,0 +1,41 @@
+(in-package #:koga)
+
+(defun read-file-form (path &optional tag)
+  (if tag
+      (read-from-string (run-program-capture (format nil "git show ~a:~a" tag path)))
+      (uiop:read-file-form path)))
+
+(defun archive (&rest initargs
+                &key archive extensions tag
+                &allow-other-keys)
+  (declare (ignore initargs))
+  (let* ((prefix (format nil "clasp-~a/"
+                        (getf (read-file-form #P"version.sexp" tag) :version)))
+         (tar-name (concatenate 'string (if (stringp archive) archive "archive") ".tar"))
+         (gz-name (concatenate 'string tar-name ".gz")))
+    (uiop:delete-file-if-exists tar-name)
+    (uiop:delete-file-if-exists gz-name)
+    (message nil "Creating main archive...")
+    (run-program (format nil "git archive --output=~a --prefix=~a --format=tar ~a"
+                         tar-name prefix (or tag "HEAD")))
+    (uiop:call-with-temporary-file
+     (lambda (temp-path)
+       (loop for source in (read-file-form #P"repos.sexp" tag)
+             for name = (getf source :name)
+             for directory = (getf source :directory)
+             for extension = (getf source :extension)
+             when (or (not extension)
+                      (member extension extensions))
+               do (message nil "Creating ~(~a~) archive..." name)
+                  (run-program (format nil "git archive --output=~a --format=tar --prefix=~a~a ~a"
+                                       temp-path prefix directory
+                                       (if tag
+                                           (or (getf source :branch)
+                                               (getf source :commit))
+                                           "HEAD"))
+                               :directory directory)
+                  (run-program (format nil "tar --concatenate --file ~a ~a"
+                                       tar-name temp-path))))
+     :want-stream-p nil)
+    (message nil "Compressing archive...")
+    (run-program (format nil "gzip ~a" tar-name))))

src/asttooling/include

@@ -1,12 +1,13 @@
-(asdf:defsystem #:koga
+(asdf:defsystem "koga"
   :description "A lisp based metabuilder for Clasp."
-  :depends-on (#:alexandria
-               #:asdf-groveler
-               #:clasp-scraper
-               #:closer-mop
-               #:ninja
-               #:shasht
-               #:trivial-features)
+  :depends-on ("alexandria"
+               "asdf-groveler"
+               "clasp-scraper"
+               "closer-mop"
+               "ninja"
+               "shasht"
+               "trivial-features")
+  :serial t
   :components ((:file "packages")
                (:file "utilities")
                (:file "header")
@@ -19,4 +20,5 @@
                (:file "scripts")
                (:file "config-header")
                (:file "ninja")
-               (:file "compile-commands")))
+               (:file "compile-commands")
+               (:file "archive")))

src/clbind/include

@@ -2,7 +2,8 @@
   (:use #:common-lisp)
   (:nicknames #:k)
   (:documentation "A lisp based metabuilder for Clasp.")
-  (:export #:configure
+  (:export #:archive
+           #:configure
            #:*extensions*
            #:framework
            #:help

src/core/include

@@ -81,7 +81,10 @@
 
 (defmethod print-prologue (configuration (name (eql :load-clasp)) output-stream)
   (format output-stream "(load #P\"sys:src;lisp;kernel;clasp-builder.lisp\")
-(setq core::*number-of-jobs* ~a)
+(setq core::*number-of-jobs*
+      (if (ext:getenv \"CLASP_BUILD_JOBS\")
+          (parse-integer (ext:getenv \"CLASP_BUILD_JOBS\"))
+          ~a))
 (defvar *system* (core:load-clasp :reproducible ~s
                                   :name (elt core:*command-line-arguments* 0)
                                   :position (parse-integer (elt core:*command-line-arguments* 1))
@@ -92,7 +95,10 @@
 
 (defmethod print-prologue (configuration (name (eql :snapshot-clasp)) output-stream)
   (format output-stream "(load #P\"sys:src;lisp;kernel;clasp-builder.lisp\")
-(setq core::*number-of-jobs* ~a)
+(setq core::*number-of-jobs*
+      (if (ext:getenv \"CLASP_BUILD_JOBS\")
+          (parse-integer (ext:getenv \"CLASP_BUILD_JOBS\"))
+          ~a))
 (defvar *system* (core:load-clasp :reproducible ~s
                                   :name (elt core:*command-line-arguments* 1)
                                   :position (parse-integer (elt core:*command-line-arguments* 2))
@@ -103,7 +109,10 @@
 (defmethod print-prologue (configuration (name (eql :compile-clasp)) output-stream)
   (format output-stream "(setq cmp:*default-output-type* ~s)
 (load #P\"sys:src;lisp;kernel;clasp-builder.lisp\")
-(setq core::*number-of-jobs* ~a)
+(setq core::*number-of-jobs*
+      (if (ext:getenv \"CLASP_BUILD_JOBS\")
+          (parse-integer (ext:getenv \"CLASP_BUILD_JOBS\"))
+          ~a))
 (core:load-and-compile-clasp :reproducible ~s :system-sort ~s
                              :name (elt core:*command-line-arguments* 0)
                              :position (parse-integer (elt core:*command-line-arguments* 1))

src/gctools/include

@@ -80,11 +80,11 @@
                                  :required t))))
 
 (defmethod configure-unit (configuration (unit (eql :dis)))
-  "Find the llvm0dis binary."
+  "Find the llvm-dis binary."
   (with-accessors ((dis dis)
                    (llvm-bindir llvm-bindir))
       configuration
-    (message :emph "Configuring ar")
+    (message :emph "Configuring llvm-dis")
     (setf dis (configure-program "dis"
                                  (or dis (merge-pathnames #P"llvm-dis" llvm-bindir))
                                  :required t))))
@@ -303,7 +303,7 @@ has not been set."
 (defmethod configure-unit (configuration (unit (eql :reproducible)))
   "Configure for a reproducible build."
   (when (reproducible-build configuration)
-    (message :emph "Configuring reducible build")
+    (message :emph "Configuring reproducible build")
     (append-cflags configuration
                    (format nil "-ffile-prefix-map=..=~a"
                            (normalize-directory (root :install-share))))

src/koga/archive.lisp

@@ -29,7 +29,7 @@
 
 (test-true
  run-program-hello-world
- (let* ((stream (ext:run-program "/bin/bash" (list "-c" "echo hello world")))
+ (let* ((stream (ext:run-program "/bin/sh" (list "-c" "echo hello world")))
         (output (read-line stream)))
    (close stream)
    (string= output "hello world")))

src/koga/koga.asd

@@ -1449,10 +1449,11 @@ static void* OBJ_DEALLOCATOR_table[] = {~%")
       (let ((sorted-header-list (sort header-list #'string<)))
         (with-output-to-string (sout)
           (loop for header in sorted-header-list
-                do (format sout "#include \"~a\"~%"
-                           (if (uiop:absolute-pathname-p header)
-                               (merge-pathnames (enough-namestring header *clasp-sys*) *clasp-code*)
-                               header))))))))
+                do (format sout "#include <~a>~%"
+                           (uiop:enough-pathname (truename (if (uiop:absolute-pathname-p header)
+                                                               (merge-pathnames (enough-namestring header *clasp-sys*) *clasp-code*)
+                                                               header))
+                                                 (truename #P"../include/")))))))))
 
 (defun generate-code
     (packages-to-create normal-functions setf-functions symbols classes gc-managed-types enums