Browse Source

Commit with useful stuff

Macoy Madson 4 months ago
  1. 31
  2. 10
  3. 32
  4. 10
  5. 332
  6. 7
  7. 30
  8. 19


@ -9,10 +9,33 @@ cd $CAKELISP_DIR
cd ../..
echo "\n\nGameLib Project\n\n"
echo "\n\nKernel\n\n"
$CAKELISP --verbose-processes --execute \
src/Config_Linux.cake \
src/Main.cake || exit $?
$CAKELISP --verbose-processes --skip-build \
src/Kernel.cake || exit $?
# (todo complexity) This should be able to be moved over to Cakelisp's build system
$GCC -Wall -O2 -ffreestanding -nostdinc -nostdlib -nostartfiles -c src/boot.S \
-o cakelisp_cache/boot.o || exit $?
# (todo features) -mfpu=crypto-neon-fp-armv8 -mfloat-abi=hard
$GCC -Wall -O2 -ffreestanding -nostdinc -nostdlib -nostartfiles \
-march=armv8-a+crc -mcpu=cortex-a72 \
-c cakelisp_cache/default/Kernel.cake.c \
-o cakelisp_cache/default/Kernel.cake.c.o || exit $?
$LD -nostdlib cakelisp_cache/boot.o cakelisp_cache/default/Kernel.cake.c.o -T src/link.ld \
-o cakelisp_cache/kernel8.elf || exit $?
# Strip the elf
$OBJCOPY -O binary cakelisp_cache/kernel8.elf kernel8.img || exit $?
echo "\nBuilt successfully\n"


@ -1,16 +1,16 @@
Copyright (c) 2021 Macoy Madson
Copyright (c) 2023 Macoy Madson
This file is part of GameLib Project.
This file is part of Raspberry Pi Bare Metal.
GameLib Project is free software: you can redistribute it and/or modify
Raspberry Pi Bare Metal 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.
GameLib Project is distributed in the hope that it will be useful,
Raspberry Pi Bare Metal 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 GameLib Project. If not, see <>.
along with Raspberry Pi Bare Metal. If not, see <>.


@ -1,3 +1,31 @@
#+title: GameLib Project
#+title: Raspberry Pi Bare Metal
This is a template repository for gamelib-based projects.
* Setup
- Download the [[][Arm GNU toolchain]]: x86_64 Linux hosted cross toolchains, ~AArch64 bare-metal target (aarch64-none-elf)~ [[][link]]
- Download the [[][latest firmware]] (use the Download ZIP button, aka [[][this]])
- Format an SD card as ~msdos~ partitioned, with a ~FAT32~ at least as large as the firmware/boot contents + your ~kernel8.img~
- Copy the contents of the firmware ~boot/~ onto the SD card
- Remove all ~kernel*.img~ files
** ~config.txt~
Put the following for ~config.txt~:
# Mode 82 = 1920x1080 60Hz
* Build
- Run
- Copy ~kernel8.img~ to the SD card
* References
- [[][Rpi 4 OS tutorial]]
- [[][Arm Programmer's guide]]
- [[][Mailbox property interface]]
* My stumbling blocks
- Not having *all* the firmware on the SD card
- Not writing the LED blink code correctly, i.e. I wasn't waiting while the LED was off, so it was just solid on. Viewing the disassembly helped clue me in to it.
- Frame buffer pointer needed to be converted from a GPU address to a CPU address


@ -1,10 +0,0 @@
(comptime-define-symbol 'Unix)
;; Uncomment for profiling
;; (comptime-define-symbol 'Profile)
(add-build-options-global "-O3")
(add-cakelisp-search-directory "Dependencies/gamelib/src")
(import "ProfilerAutoInstrument.cake")))


@ -0,0 +1,332 @@
(set-cakelisp-option cakelisp-src-dir "Dependencies/cakelisp/src")
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(add-cakelisp-search-directory "src")
;; Cakelisp
(c-preprocessor-define-constant NULL 0)
(defgenerator var-aligned (name symbol
module-type-index (index any)
alignment-index (index symbol)
value-index (index array))
(var module-type-output (template (in std vector) StringOutput))
(var module-type-output-after-name (template (in std vector) StringOutput))
(unless (tokenizedCTypeToString_Recursive
environment context tokens module-type-index
true module-type-output module-type-output-after-name
(return false))
(addModifierToStringOutput (call-on back module-type-output) StringOutMod_SpaceAfter)
(PushBackAll (field output source) module-type-output)
(var alignment-directive (array 128 char) (array 0))
(SafeSnprintf alignment-directive (sizeof alignment-directive) "__attribute__((aligned(%s)))"
(call-on c_str (field (at alignment-index tokens) contents)))
(addStringOutput (field output source) alignment-directive StringOutMod_SpaceAfter
(addr (at alignment-index tokens)))
(addStringOutput (field output source) (path name > contents)
StringOutMod_ConvertVariableName name)
(PushBackAll (field output source) module-type-output-after-name)
;; Value
(addLangTokenOutput (field output source) StringOutMod_SpaceAfter (addr (at value-index tokens)))
(addStringOutput (field output source) "=" StringOutMod_SpaceAfter (addr (at value-index tokens)))
(var expression-context EvaluatorContext context)
(set (field expression-context scope) EvaluatorScope_ExpressionsOnly)
(unless (= 0 (EvaluateGenerate_Recursive
environment expression-context tokens value-index
(return false))
(addLangTokenOutput (field output source) StringOutMod_EndStatement name)
(return true))
;; Helpers
(defun write-absolute-addr
(address (long long)
value (unsigned int))
(set (deref (type-cast address (addr (volatile (unsigned int)))))
(defun read-absolute-addr
(address (long long)
&return (unsigned int))
(return (deref (type-cast address (addr (volatile (unsigned int)))))))
;; VideoCore/GPU
;; Note: must be 16-byte aligned!
(def-type-alias mailbox-buffer (array 36 (volatile (unsigned int))))
(def-type-alias mailbox-addr (addr (volatile (unsigned int))))
(c-preprocessor-define-constant c-rpi-peripheral-base 0xfe000000UL)
(c-preprocessor-define-constant c-videocore-mailbox-start-addr
(+ c-rpi-peripheral-base 0x0000b880UL))
;; (todo clarity) This could be more easily read as a struct
(c-preprocessor-define-constant c-videocore-mailbox-read
(+ c-videocore-mailbox-start-addr 0x0UL))
(c-preprocessor-define-constant c-videocore-mailbox-poll
(+ c-videocore-mailbox-start-addr 0x10UL))
(c-preprocessor-define-constant c-videocore-mailbox-sender
(+ c-videocore-mailbox-start-addr 0x14UL))
(c-preprocessor-define-constant c-videocore-mailbox-status
(+ c-videocore-mailbox-start-addr 0x18UL))
(c-preprocessor-define-constant c-videocore-mailbox-config
(+ c-videocore-mailbox-start-addr 0x1cUL))
(c-preprocessor-define-constant c-videocore-mailbox-write
(+ c-videocore-mailbox-start-addr 0x20UL))
(c-preprocessor-define-constant c-videocore-mailbox-request
(c-preprocessor-define-constant c-videocore-mailbox-response
(c-preprocessor-define-constant c-videocore-mailbox-full
(c-preprocessor-define-constant c-videocore-mailbox-empty
(defenum mailbox-channel
mailbox-channel-power ;; 0
mailbox-channel-fb ;; 1
mailbox-channel-vuart ;; 2
mailbox-channel-vchiq ;; 3
mailbox-channel-leds ;; 4
mailbox-channel-btns ;; 5
mailbox-channel-touch ;; 6
mailbox-channel-count ;; 7
mailbox-channel-properties) ;; 8
;; (var c-mailbox-tag-set-power (const (unsigned int)) 0x28001)
;; (var c-mailbox-tag-set-clock-rate (const (unsigned int)) 0x38002)
(var c-mailbox-tag-set-physical-width-height (const (unsigned int)) 0x48003)
(var c-mailbox-tag-set-virtual-width-height (const (unsigned int)) 0x48004)
(var c-mailbox-tag-set-virtual-offset (const (unsigned int)) 0x48009)
(var c-mailbox-tag-set-pixel-depth (const (unsigned int)) 0x48005)
(var c-mailbox-tag-set-pixel-order (const (unsigned int)) 0x48006)
(var c-mailbox-tag-allocate-frame-buffer (const (unsigned int)) 0x40001)
(var c-mailbox-tag-get-pixel-pitch (const (unsigned int)) 0x40008)
(var c-mailbox-tag-end-sentinel (const (unsigned int)) 0)
(defun-local mailbox-blocking-call
(in-out-box-16byte-aligned mailbox-addr
channel (unsigned char)
&return int)
;; (todo clarity) This could more easily be written as a bit-packed struct
(var-cast-to packed-mailbox-and-channel (unsigned int)
(bit-or (bit-and (type-cast in-out-box-16byte-aligned (long long)) 0xfffffff0)
(bit-and channel 0xf)))
;; Wait until we can write
(while (bit-and (read-absolute-addr c-videocore-mailbox-status) c-videocore-mailbox-full)
(write-absolute-addr c-videocore-mailbox-write packed-mailbox-and-channel)
;; (todo performance) It is supposed to be possible to send multiple commands without blocking
;; (todo robustness) This could get stuck forever
(while 1
(while (bit-and (read-absolute-addr c-videocore-mailbox-status) c-videocore-mailbox-empty)
(when (= packed-mailbox-and-channel (read-absolute-addr c-videocore-mailbox-read))
(return (= (at 1 in-out-box-16byte-aligned) c-videocore-mailbox-response))))
(return 0))
(defstruct-local pixel-framebuffer
width int
height int
pitch int
pixel-order int
data (addr (unsigned char)))
;; Note that you can't really have more than one I presume
(defun-local initialize-framebuffer
(framebuffer (addr pixel-framebuffer))
(var-aligned mail mailbox-buffer 16 (array 0))
(set (at 0 mail) (* 35 4)) ;; Length of message (bytes)
(set (at 1 mail) c-videocore-mailbox-request)
;; (todo clarity) This is begging to be made into a cleaner interface. Could define structs for
;; all tags, then a push tag function?
;; See
;; Note that these are already padded correctly because they only need to be aligned to 1 byte
(set (at 2 mail) c-mailbox-tag-set-physical-width-height)
(set (at 3 mail) 8) ;; Value size in bytes
(set (at 4 mail) 0) ;; Response space
(set (at 5 mail) 1920) ;; Value width
(set (at 6 mail) 1080) ;; Value height
(set (at 7 mail) c-mailbox-tag-set-virtual-width-height)
(set (at 8 mail) 8) ;; Value size in bytes
(set (at 9 mail) 8) ;; Response space
(set (at 10 mail) 1920) ;; Value width
(var virtual-width-index int 10)
(set (at 11 mail) 1080) ;; Value height
(var virtual-height-index int 11)
(set (at 12 mail) c-mailbox-tag-set-virtual-offset)
(set (at 13 mail) 8) ;; Value size in bytes
(set (at 14 mail) 8) ;; Response space
(set (at 15 mail) 0) ;; Value x
(set (at 16 mail) 0) ;; Value y
(var desired-pixel-depth int 32)
(set (at 17 mail) c-mailbox-tag-set-pixel-depth)
(set (at 18 mail) 4) ;; Value size in bytes
(set (at 19 mail) 4) ;; Response space
(set (at 20 mail) desired-pixel-depth) ;; Value depth
(var pixel-depth-index int 20)
(set (at 21 mail) c-mailbox-tag-set-pixel-order)
(set (at 22 mail) 4) ;; Value size in bytes
(set (at 23 mail) 4) ;; Response space
(set (at 24 mail) 1) ;; Value pixel order
(var pixel-order-index int 24)
(set (at 25 mail) c-mailbox-tag-allocate-frame-buffer)
(set (at 26 mail) 8) ;; Value size in bytes
(set (at 27 mail) 8) ;; Response space
(set (at 28 mail) 4096) ;; Requested buffer alignment in bytes; response becomes the base address
(var frame-buffer-address-index int 28)
(set (at 29 mail) 0) ;; Empty space for the frame buffer size in bytes
(set (at 30 mail) c-mailbox-tag-get-pixel-pitch)
(set (at 31 mail) 4) ;; Value size in bytes
(set (at 32 mail) 4) ;; Response space
(set (at 33 mail) 0) ;; Pitch added bytes per line
(var pitch-index int 33)
(set (at 34 mail) c-mailbox-tag-end-sentinel)
(and (mailbox-blocking-call mail mailbox-channel-properties)
(= (at pixel-depth-index mail) desired-pixel-depth)
(at frame-buffer-address-index mail))
(set (at frame-buffer-address-index mail)
(bit-and (at frame-buffer-address-index mail)
0x3fffffff)) ;; Convert GPU address to arm address
(set-fields (deref framebuffer)
width (at virtual-width-index mail)
height (at virtual-height-index mail)
pitch (at pitch-index mail)
pixel-order (at pixel-order-index mail)
data (type-cast (type-cast (at frame-buffer-address-index mail) (long long))
(addr (unsigned char))))))
(var g-framebuffer (addr pixel-framebuffer) null)
(def-type-alias argb-color int)
(defun-local set-pixel
(x int y int
color argb-color)
(unless g-framebuffer
(var c-pixel-bytes int 4)
(var offset int (+ (* y (path g-framebuffer > pitch)) (* x c-pixel-bytes)))
(set (at offset (type-cast (path g-framebuffer > data) (addr (unsigned int))))
(c-preprocessor-define-constant c-gpio-gp-function-select-0 0)
(c-preprocessor-define-constant c-gpio-gp-function-select-1 1)
(c-preprocessor-define-constant c-gpio-gp-function-select-2 2)
(c-preprocessor-define-constant c-gpio-gp-function-select-3 3)
(c-preprocessor-define-constant c-gpio-gp-function-select-4 4)
(c-preprocessor-define-constant c-gpio-gp-function-select-5 5)
(c-preprocessor-define-constant c-gpio-gpset0 7)
(c-preprocessor-define-constant c-gpio-gpset1 8)
(c-preprocessor-define-constant c-gpio-gp-clear0 10)
(c-preprocessor-define-constant c-gpio-gp-clear1 11)
(c-preprocessor-define-constant c-gpio-base-offset 0xfe200000ULL)
(c-preprocessor-define-constant c-gpio-led-gp-function-select c-gpio-gp-function-select-4)
(c-preprocessor-define-constant c-gpio-led-gp-function-bit 6)
(c-preprocessor-define-constant c-gpio-led-gpset c-gpio-gpset1)
(c-preprocessor-define-constant c-gpio-led-gp-clear c-gpio-gp-clear1)
(c-preprocessor-define-constant c-gpio-led-bit 10)
;; Main
(defun fail-loop ()
(while 1
(var g-gpio (addr (volatile (unsigned int))))
(var wait-counter (volatile (unsigned int)) 0)
(var num-blinks (volatile (unsigned int)) 0)
(defun blink-led (requested-num-blinks int)
(set g-gpio (type-cast c-gpio-base-offset (addr (unsigned int))))
;; Enable the led as an output
(set (at c-gpio-led-gp-function-select g-gpio)
(bit-or (at c-gpio-led-gp-function-select g-gpio) (bit-shift-<< 1 c-gpio-led-gp-function-bit)))
(set num-blinks 0)
(while (< num-blinks requested-num-blinks)
(incr num-blinks)
(while (< wait-counter 500000)
(incr wait-counter))
(set (at c-gpio-led-gp-clear g-gpio) (bit-shift-<< 1 c-gpio-led-bit))
(set wait-counter 0)
(while (< wait-counter 500000)
(incr wait-counter))
(set (at c-gpio-led-gpset g-gpio) (bit-shift-<< 1 c-gpio-led-bit))
(set wait-counter 0)))
(defun set-led-fail ()
(set g-gpio (type-cast c-gpio-base-offset (addr (unsigned int))))
;; Enable the led as an output
(set (at c-gpio-led-gp-function-select g-gpio)
(bit-or (at c-gpio-led-gp-function-select g-gpio) (bit-shift-<< 1 c-gpio-led-gp-function-bit)))
(while 1
(while (< wait-counter 100000)
(incr wait-counter))
(set (at c-gpio-led-gp-clear g-gpio) (bit-shift-<< 1 c-gpio-led-bit))
(set wait-counter 0)
(while (< wait-counter 500000)
(incr wait-counter))
(set (at c-gpio-led-gpset g-gpio) (bit-shift-<< 1 c-gpio-led-bit))
(set wait-counter 0)))
(c-preprocessor-define-constant c-color-test 0xffdd55ee)
(defun main ()
(blink-led 5)
(var framebuffer pixel-framebuffer (array 0))
(initialize-framebuffer (addr framebuffer))
(unless (field framebuffer data)
(set g-framebuffer (addr framebuffer))
(blink-led 3)
(each-in-range (path g-framebuffer > height) y
(each-in-range (path g-framebuffer > width) x
(var offset int (+ (* y (/ (path g-framebuffer > pitch) 4)) x))
(set (at offset (type-cast (path g-framebuffer > data) (addr (unsigned int))))
(? (or (mod y 100)
(mod x 100))
0xff555555 0xffee2222))))
(set wait-counter 0)
(set (at c-gpio-led-gp-function-select g-gpio)
(bit-or (at c-gpio-led-gp-function-select g-gpio) (bit-shift-<< 1 c-gpio-led-gp-function-bit)))
;; (var pixel-index int 0)
(var led-on int 0)
(while 1
(incr wait-counter)
(when (> wait-counter 100000)
(set led-on (not led-on))
(if led-on
(set (at c-gpio-led-gpset g-gpio) (bit-shift-<< 1 c-gpio-led-bit))
(set (at c-gpio-led-gp-clear g-gpio) (bit-shift-<< 1 c-gpio-led-bit)))
(set wait-counter 0)))
;; Never return


@ -1,7 +0,0 @@
(set-cakelisp-option cakelisp-src-dir "Dependencies/cakelisp/src")
(add-cakelisp-search-directory "Dependencies/gamelib/src")
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(add-cakelisp-search-directory "src")
(defun main (&return int)
(return 0))


@ -0,0 +1,30 @@
.section ".text.boot" // Put this at start of kernel
.global _start
// mpidr_el1: Processor and cluster IDs
mrs x1, mpidr_el1 // "Move into Register from System" mpidr_el1 into x1
and x1, x1, #3
cbz x1, 2f
// Not main core, so spin (wait for event then branch back to 1)
1: wfe
b 1b
2: // Main core
// Set stack to start below our _start
ldr x1, =_start
mov sp, x1
// Set up BSS
ldr x1, =__bss_start
ldr w2, =__bss_size
3: cbz w2, 4f
// (todo performance) Use NEON to set this instead (though might need to initialize it)
str xzr, [x1], #8
sub w2, w2, #1
cbnz w2, 3b // Continue setting if non-zero
// Jump to main (note that we never expect this to return)
4: bl main
// If main returns, halt
b 1b


@ -0,0 +1,19 @@
. = 0x80000; /* Kernel load address for AArch64 */
.text : { KEEP(*(.text.boot)) *(.text .text.* .gnu.linkonce.t*) }
.rodata : { *(.rodata .rodata.* .gnu.linkonce.r*) }
PROVIDE(_data = .);
.data : { *(.data .data.* .gnu.linkonce.d*) }
.bss (NOLOAD) : {
. = ALIGN(16);
__bss_start = .;
*(.bss .bss.*)
__bss_end = .;
_end = .;
/DISCARD/ : { *(.comment) *(.gnu*) *(.note*) *(.eh_frame*) }
__bss_size = (__bss_end - __bss_start)>>3;