Paste number 153255: linux-custom.scm

Paste number 153255: linux-custom.scm
Pasted by: DusXMT
When:7 years, 1 week ago
Share:Tweet this! |
Paste contents:
Raw Source | XML | Display As
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <>
;;; Copyright © 2013, 2014 Andreas Enge <>
;;; Copyright © 2012 Nikita Karetnikov <>
;;; Copyright © 2014, 2015 Mark H Weaver <>
;;; This file is part of GNU Guix.
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; GNU General Public License for more details.
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <>.

(define-module (gnu packages linux-custom)
  #:use-module ((guix licenses))
  #:use-module (gnu packages)
  #:use-module (gnu packages linux)
  #:use-module (guix packages))

;; Find the order number of the item of the argument
;; list that contains the build phases.
(define (find-phases-order args order)
   (if (null? args) #f
     (if (eqv? (car args) '#:phases) (+ order 1)
       (find-phases-order (cdr args) (+ order 1)))))

(define-public linux-libre-custom
  (let* ((build-phase
          '(lambda* (#:key system inputs #:allow-other-keys #:rest args)
             ;; Apply the neat patch.
             (system* "patch" "-p1" "--force"
                      "-i" (assoc-ref inputs "patch/freedo+gnu"))

             (let ((arch (car (string-split system #\-))))
               (setenv "ARCH"
                       (cond ((string=? arch "i686") "i386")
                             (else arch)))
               (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))

             (let ((build  (assoc-ref %standard-phases 'build))
                   (config (assoc-ref inputs "custom-kern-config")))

               ;; Use the custom config if available, and 'defconfig' otherwise.
               (if config
                     (copy-file config ".config")
                     (chmod ".config" #o666))
                   (system* "make" "defconfig"))

               (zero? (system* "make" "oldconfig"))

               ;; Call the default `build' phase so `-j' is correctly
               ;; passed.
               (apply build #:make-flags "all" args))))

        ;; The build system arguments of vanilla linux-libre.
        (orig-args (package-arguments linux-libre))

        ;; The order number of the item of the arguments list
        ;; that contains the build phases.
          (find-phases-order orig-args 0))

        ;; The new arguments list.
          (let ((new-list (list-copy orig-args)))
            (list-set! new-list orig-args-phases-num
                 'build ,build-phase
                 ,(list-ref orig-args orig-args-phases-num)))

   (package (inherit linux-libre)
    (name "linux-libre-custom")
        `("custom-kern-config" ,(search-path %load-path
         (package-native-inputs linux-libre)))
    (arguments new-args))))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.