From 06377e84a929d50ebed8a9f3f6d8a23d905036d5 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sat, 30 Sep 2017 02:17:31 -0700 Subject: [PATCH] devops: Specify target Scheme arch; support cross-compiling to svm. When a host's target arch is svm, do NOT build Debian packages. --- src/devops/build.scm | 15 ++++++++---- src/devops/devops.scm | 56 +++++++++++++++++++++++-------------------- 2 files changed, 41 insertions(+), 30 deletions(-) diff --git a/src/devops/build.scm b/src/devops/build.scm index 071fa8dc2..88af40e26 100644 --- a/src/devops/build.scm +++ b/src/devops/build.scm @@ -99,11 +99,18 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (rename-file elogfile logfile)))))) (define (build-core-pkg name vers) - (let ((sarch build-scheme-architecture) - (pkgdir (string build-dir"/"name"-"vers))) + (let* ((sarch build-scheme-architecture) + (target (if (string-prefix? "svm" sarch) "svm" sarch)) + (pkgdir (string build-dir"/"name"-"vers)) + (host (shell-output + "echo \"(display microcode-id/compiled-code-type)\"" + " | ${MIT_SCHEME_EXE=mit-scheme} --batch-mode")) + (cross (if (string=? target host) + "" + " --enable-cross-compiling"))) (run "rm -rf "pkgdir) (run "cd "build-dir" && tar xzf "name"-"vers".tar.gz") - (run "cd "pkgdir"/src && ./configure --enable-native-code="sarch) + (run "cd "pkgdir"/src && ./configure"cross" --enable-native-code="target) (run "cd "pkgdir"/src && make") (run "cd "pkgdir"/src/microcode && make distclean") (run "cd "pkgdir"/doc && ./configure") @@ -113,7 +120,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (run "chmod 444 "pkgdir"-"sarch".tar.gz") (run "rm -rf "pkgdir) (run "cd "build-dir" && tar xzf "name"-"vers"-"sarch".tar.gz") - (run "cd "pkgdir"/src && ./configure") + (run "cd "pkgdir"/src && ./configure"cross" --enable-native-code="target) (run "cd "pkgdir"/src && make compile-microcode") (run "cd "pkgdir"/src && umask 022 && make install") (run "cd "pkgdir"/doc && ./configure") diff --git a/src/devops/devops.scm b/src/devops/devops.scm index 33b33ed85..271af182e 100644 --- a/src/devops/devops.scm +++ b/src/devops/devops.scm @@ -456,7 +456,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if (string=? proj name) (write-pkg-status name vers sarch files host i/o))) - (if (host-ubuntu? host) + (if (host-build-ubuntu? host) (let ((dsc (string name"_"vers".dsc")) (tar (string name"_"vers".tar.xz"))) (if (or (not (member dsc files)) @@ -523,9 +523,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (error "could not find build script"))))) i/o) - ;;(verify-host-debian-architecture host i/o) - ;;(if (host-ubuntu? host) - ;; (verify-host-ubuntu-ness host i/o)) + (verify-host-architecture host i/o) (write-line `(begin (set! project-name ,(project-name)) @@ -535,7 +533,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (set! build-debian-architecture ,(host-debian-architecture host)) (set! build-ubuntu? - ,(host-ubuntu? host)) + ,(host-build-ubuntu? host)) (build)) i/o) (flush-output-port i/o) @@ -545,20 +543,20 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (close-input-port i/o) (close-output-port i/o)) -(define (verify-host-debian-architecture host i/o) - (let ((darch (read-reply '(read-debian-architecture) i/o))) - (if (not (string? darch)) - (error "no Debian architecture")) - (if (not (string=? darch (host-debian-architecture host))) - (error "wrong Debian architecture")))) - -(define (verify-host-ubuntu-ness host i/o) - (let ((str (read-reply '(if (ubuntu?) "yes" "no") i/o))) - (if (not (string? str)) - (error "no Ubuntu-ness")) - (let ((ubu? (string=? "yes" str))) - (if (not (eq? ubu? (host-ubuntu? host))) - (error "wrong Ubuntu-ness"))))) +(define (verify-host-architecture host i/o) + (if (host-build-ubuntu? host) + (begin + (let ((darch (read-reply '(read-debian-architecture) i/o))) + (if (not (string? darch)) + (error "no Debian architecture")) + (if (not (string=? darch (host-debian-architecture host))) + (error "wrong Debian architecture"))) + (let ((str (read-reply '(if (ubuntu?) "yes" "no") i/o))) + (if (not (string? str)) + (error "no Ubuntu-ness")) + (let ((ubu? (string=? "yes" str))) + (if (not (eq? ubu? (host-ubuntu? host))) + (error "wrong Ubuntu-ness"))))))) (define (call-with-host-i/o host receiver) (call-with-current-continuation @@ -675,22 +673,28 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. n))) (define-record-type - (make-host name user directory darch os) + (make-host name user directory arch os) host? (name host-name) (user host-user) (directory host-directory) - (darch host-debian-architecture) + (arch host-scheme-architecture) (os host-os)) (define (host-ubuntu? host) (os-ubuntu? (host-os host))) -(define (host-scheme-architecture host) - (let ((darch (host-debian-architecture host))) - (cond ((string=? "amd64" darch) "x86-64") - ((string=? "i386" darch) "i386") - (else (error "unknown Debian architecture:" darch))))) +(define (host-build-ubuntu? host) + (and (host-ubuntu? host) + (not (string-prefix? "svm" (host-scheme-architecture host))))) + +(define (host-debian-architecture host) + (let ((arch (host-scheme-architecture host))) + (cond ((string=? "x86-64" arch) "amd64") + ((string=? "i386" arch) "i386") + ((string=? "svm1-32" arch) #f) + ((string=? "svm1-64" arch) #f) + (else (error "unknown host architecture:" arch))))) (define (host-ubuntu-codename host) (ubuntu-os-codename (host-os host))) -- 2.25.1