Commit with useful stuff

Build.sh

@@ -9,10 +9,33 @@ cd $CAKELISP_DIR
 
 cd ../..
 
-echo "\n\nGameLib Project\n\n"
+echo "\n\nKernel\n\n"
 
 CAKELISP=./Dependencies/cakelisp/bin/cakelisp
 
-$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=toolchain/arm-gnu-toolchain-12.3.rel1-x86_64-aarch64-none-elf/bin/aarch64-none-elf-gcc
+LD=toolchain/arm-gnu-toolchain-12.3.rel1-x86_64-aarch64-none-elf/bin/aarch64-none-elf-ld
+OBJCOPY=toolchain/arm-gnu-toolchain-12.3.rel1-x86_64-aarch64-none-elf/bin/aarch64-none-elf-objcopy
+
+$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"

COPYING

@@ -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
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 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 <https://www.gnu.org/licenses/>.
+along with Raspberry Pi Bare Metal.  If not, see <https://www.gnu.org/licenses/>.

ReadMe.org

@@ -1,3 +1,31 @@
-#+title: GameLib Project
+#+title: Raspberry Pi Bare Metal
 
-This is a template repository for gamelib-based projects.
+* Setup
+- Download the [[https://developer.arm.com/downloads/-/arm-gnu-toolchain-downloads][Arm GNU toolchain]]: x86_64 Linux hosted cross toolchains, ~AArch64 bare-metal target (aarch64-none-elf)~ [[https://developer.arm.com/-/media/Files/downloads/gnu/12.3.rel1/binrel/arm-gnu-toolchain-12.3.rel1-x86_64-aarch64-none-elf.tar.xz?rev=a8bbb76353aa44a69ce6b11fd560142d&hash=8DC6C55310058C1594FD6EEFD60F0B2528265C64][link]]
+- Download the [[https://github.com/raspberrypi/firmware][latest firmware]] (use the Download ZIP button, aka [[https://github.com/raspberrypi/firmware/archive/refs/heads/master.zip][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~:
+
+#+BEGIN_SRC txt
+  hdmi_group=2
+  # Mode 82 = 1920x1080 60Hz
+  hdmi_mode=82
+#+END_SRC
+
+* Build
+- Run ~Build.sh~
+- Copy ~kernel8.img~ to the SD card
+
+* References
+- [[https://www.rpi4os.com/][Rpi 4 OS tutorial]]
+- [[https://developer.arm.com/documentation/den0024/a/][Arm Programmer's guide]]
+- [[https://github.com/raspberrypi/firmware/wiki/Mailbox-property-interface][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

src/Config_Linux.cake

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

src/Kernel.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")
+
+(import
+ ;; Cakelisp
+ "CHelpers.cake")
+
+(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
+	       RequiredFeatureExposure_ModuleLocal)
+    (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
+		        output))
+    (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)))))
+       value))
+
+(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
+                                0x0)
+(c-preprocessor-define-constant c-videocore-mailbox-response
+                                0x80000000)
+(c-preprocessor-define-constant c-videocore-mailbox-full
+                                0x80000000)
+(c-preprocessor-define-constant c-videocore-mailbox-empty
+                                0x40000000)
+
+(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)
+    (ignore))
+  (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)
+      (ignore))
+    (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 https://github.com/raspberrypi/firmware/wiki/Mailbox-property-interface
+  ;; 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)
+  (when
+      (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
+    (return))
+  (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))))
+       color))
+
+;;
+;; GPIO
+;;
+
+(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
+    (ignore)))
+
+(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-led-fail))
+  (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
+  (fail-loop))

src/Main.cake

@@ -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))

src/boot.S

@@ -0,0 +1,30 @@
+	.section ".text.boot" // Put this at start of kernel
+
+	.global _start
+
+_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

src/link.ld

@@ -0,0 +1,19 @@
+SECTIONS
+{
+    . = 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.*)
+        *(COMMON)
+        __bss_end = .;
+    }
+    _end = .;
+
+   /DISCARD/ : { *(.comment) *(.gnu*) *(.note*) *(.eh_frame*) }
+}
+__bss_size = (__bss_end - __bss_start)>>3;