From ceb3952764e49400d4419fea64a9201a32dad3de Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Tue, 12 Dec 2017 16:41:56 +0100
Subject: [PATCH] system: Add BeagleBone Black installer.

* gnu/bootloader/u-boot.scm (u-boot-beaglebone-black-bootloader): New exported
  bootloader.
* gnu/system/install.scm (beaglebone-black-installation-os): New exported variable.
---
 gnu/bootloader/u-boot.scm | 25 ++++++++++++++++++++++++-
 gnu/system/install.scm    | 29 +++++++++++++++++++++++++++--
 2 files changed, 51 insertions(+), 3 deletions(-)

diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 963b0d7597..397eb8181c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -21,18 +21,35 @@
   #:use-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
   #:use-module (gnu system)
+  #:use-module (gnu build bootloader)
   #:use-module (gnu packages bootloaders)
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix utils)
-  #:export (u-boot-bootloader))
+  #:export (u-boot-bootloader
+            u-boot-beaglebone-black-bootloader))
 
 (define install-u-boot
   #~(lambda (bootloader device mount-point)
       (if bootloader
         (error "Failed to install U-Boot"))))
 
+(define install-beaglebone-black-u-boot
+  ;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
+  ;; This first stage bootloader called MLO (U-Boot SPL) is expected at
+  ;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
+  ;; the MLO and is expected at 0x60000.  Write both first stage ("MLO") and
+  ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
+  ;; specified DEVICE.
+  #~(lambda (bootloader device mount-point)
+      (let ((mlo (string-append bootloader "/libexec/MLO"))
+            (u-boot (string-append bootloader "/libexec/u-boot.img")))
+        (write-file-on-device mlo (* 256 512)
+                              device (* 256 512))
+        (write-file-on-device u-boot (* 1024 512)
+                              device (* 768 512)))))
+
 
 
 ;;;
@@ -45,3 +62,9 @@
    (name 'u-boot)
    (package #f)
    (installer install-u-boot)))
+
+(define u-boot-beaglebone-black-bootloader
+  (bootloader
+   (inherit u-boot-bootloader)
+   (package u-boot-beagle-bone-black)
+   (installer install-beaglebone-black-u-boot)))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index c2f73f7e8f..8864415d7c 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -22,6 +22,7 @@
 
 (define-module (gnu system install)
   #:use-module (gnu)
+  #:use-module (gnu bootloader u-boot)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -42,7 +43,8 @@
   #:use-module (gnu packages nvi)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-26)
-  #:export (installation-os))
+  #:export (installation-os
+            beaglebone-black-installation-os))
 
 ;;; Commentary:
 ;;;
@@ -372,7 +374,30 @@ You have been warned.  Thanks for being so brave.\x1b[0m
                      nvi                          ;:wq!
                      %base-packages))))
 
-;; Return it here so 'guix system' can consume it directly.
+(define beaglebone-black-installation-os
+  (operating-system
+    (inherit installation-os)
+    (bootloader (bootloader-configuration
+                 (bootloader u-boot-beaglebone-black-bootloader)
+                 (target "/dev/sda")))
+    (kernel linux-libre)
+    (initrd (lambda (fs . rest)
+              (apply base-initrd fs
+                     ;; This module is required to mount the sd card.
+                     #:extra-modules (list "omap_hsmmc")
+                     rest)))
+    (services (append
+               ;; mingetty does not work on serial lines.
+               ;; Use agetty with board-specific serial parameters.
+               (list (agetty-service
+                      (agetty-configuration
+                       (extra-options '("-L"))
+                       (baud-rate "115200")
+                       (term "vt100")
+                       (tty "ttyO0"))))
+               (operating-system-user-services installation-os)))))
+
+;; Return the default os here so 'guix system' can consume it directly.
 installation-os
 
 ;;; install.scm ends here