feat: implement linking

host/assembler.fnl

@@ -2,10 +2,11 @@
 	{: r
 	: move
 	: branch
-	: branch-link}
+	: branch-link
+  : relocatable-instructions}
 	(require :host.assembler.opcodes))
-(local {: any : slice : push : map} (require :deps.lume))
+(local {: any : slice : push : map :match find-pred} (require :deps.lume))
-(local {: word->byte} (require :host.util))
+(local {: word->byte : hex} (require :host.util))
 
 (fn label [name] {:label name})
 (fn label? [value]
@@ -16,6 +17,12 @@
 			(:error (.. "Duplicate label " label))
 			(tset table :labels label index)))
 
+(fn replace-label!
+  [form offset]
+  "Replace the label form with *offset* for later linking"
+  (each [i v (ipairs form)] (when (label? v) (tset form i offset)))
+  form)
+
 (fn assemble [forms offset]
 	(let [state {:labels {} :instructions [] :reverse-labels []}]
 		(each [_ form (ipairs forms)]
@@ -23,18 +30,32 @@
 					(insert-label state form (+ offset (* 4 (length (. state :instructions)))))
 					(push (. state :instructions)
 								(if (any (slice form 2) label?)
-										(do
+										(let [{: type :offset addend} (. relocatable-instructions (. form 1))]
-											(push (. state :reverse-labels) (+ 1 (length (. state :instructions))))
+											(push (. state :reverse-labels) {: type :label (. (find-pred form label?) :label) :offset (+ offset (* 4 (length (. state :instructions))))})
-											form)
+                      ((. form 1) (table.unpack (replace-label! (slice form 2) addend))))
 										((. form 1) (table.unpack (slice form 2)))))))
 		state))
 
-; (fn link [{: labels : instructions : reverse-labels}]
+(fn link [{: labels : instructions : reverse-labels} base]
-; 	())
+	(each [_ {: type :label target : offset} (ipairs reverse-labels)]
+    (match type
+      :jump-24 (let [index (+ 1 (/ (- offset base) 4))
+                     instruction (. instructions index)
+                     addend (lshift (band instruction 0xffffff) 2)
+                     symbol (. labels target)
+                     relocation (- (+ symbol addend) offset)
+                     new-instruction 
+                     (bor
+                       (band instruction (bnot 0xffffff))
+                       (band (rshift relocation 2) 0xffffff))]
+                 (print (hex (band (rshift relocation 2) 0xffffff)) (hex instruction) (hex new-instruction))
+                 (tset instructions index new-instruction))))
+  instructions)
 
-(assemble
+(map (link (assemble
-	[[move (r 8) (r 2)]
+        [[move (r 8) (r 2)]
-	 :label-1
+         :label-1
-	 [move (r 9) (r 3)]
+         [move (r 9) (r 3)]
-	 [branch (label :label-1)]]
+         [branch (label :label-1)]]
-	0x8000)
+        0x8000)
+      0x8000) hex)

host/assembler/opcodes.fnl

@@ -1,4 +1,7 @@
 (local util (require :host.util))
+(local {: push} (require :deps.lume))
+
+(local relocatable-instructions {})
 
 (macro construct-opcode [& forms]
   `(bor ,(unpack 
@@ -29,6 +32,10 @@
                :sp 0xd
                n n)})
 
+(fn c [n]
+  "Create a coprocessor register for use in instructions"
+  {:coprocessor n})
+
 (fn register? [x]
   (and (= (type x) :table) (. x :register)))
 
@@ -48,8 +55,17 @@
         cond (. conditions (or cond :always))]
     {: cond : set-flags}))
 
+(fn immediate-12bit [x]
+  "Calculate a 12 bit immediate value"
+  (let [rotation (calculate-rotation x)]
+    (when (= nil rotation) (error "Unencodable immediate value"))
+    (bor
+      (band (util.rotate-left x rotation) 0xff)
+      (lshift (/ rotation 2) 8))))
+
 (fn move [dest source ?options]
-  {:fnl/docstring "Set register *dest* to a value\n*source* can be a register or an immediate value smaller than 4096"
+  {:fnl/docstring
+   "Set register *dest* to a value\n*source* can be a register or an immediate value"
    :fnl/arglist [dest source & {: cond : flags}]}
   (let [{: cond : set-flags} (parse-conditions ?options)
         source-register (register? source)
@@ -62,16 +78,15 @@
         [set-flags 20]
         [dest 12]
         [source-register 0])
-      (let [rotation (calculate-rotation source)]
+      (construct-opcode
-        (when (= nil rotation) (error "Unencodable immediate value"))
+        (cond 28)
-        (construct-opcode
+        (1 25)
-          (cond 28)
+        (0xd 21)
-          (1 25)
+        (set-flags 20)
-          (0xd 21)
+        (dest 12)
-          (set-flags 20)
+        (immediate-12bit source)))))
-          (dest 12)
+
-          ((/ rotation 2) 8)
+(fn subtract [offset ?options])
-          ((band (util.rotate-left source rotation) 0xff) 0))))))
 
 (fn branch [offset ?options]
   (let [{: cond} (parse-conditions ?options)
@@ -81,6 +96,7 @@
       (cond 28)
       (10 24)
       ((band (rshift offset 2) 0xffffff) 0))))
+(tset relocatable-instructions branch {:type :jump-24 :offset -8})
 
 (fn branch-link [offset ?options]
   (let [{: cond} (parse-conditions ?options)
@@ -90,8 +106,17 @@
       (cond 28)
       (11 24)
       ((band (rshift offset 2) 0xffffff) 0))))
+(tset relocatable-instructions branch-link {:type :jump-24 :offset -8})
+
+(fn branch-exchange [{: register} ?options]
+  (let [{: cond} (parse-conditions ?options)]
+    (construct-opcode
+      (cond 28)
+      (0x12fff1 4)
+      (register 0))))
 
 {: r
  : move
  : branch
- : branch-link}
+ : branch-link
+ : relocatable-instructions}

target/boot.lasm

@@ -0,0 +1,43 @@
+(config! {:address 0x8000})
+(const! mmio-base 0x3f000000)
+(label! :boot)
+(move sp :boot)
+
+; shut down cores 1-3
+(move-to-coprocessor {:processor 15
+                      :operations [0 5]
+                      :source-register (r 5)
+                      :dest-registers [(c 0) (c 0)]})
+
+(and (r 5) (r 5) 3)
+(cmp (r 5) 0)
+(branch {:cond :not-equal} :halt)
+
+;; set r3 to gpio base
+(move (r 3) :mmio-base)
+(or (r 3) (r 3) 0x200000)
+
+;; set r4 to uart-base
+(or (r 4) (r 4) 0x1000)
+
+;; disable uart 0
+(or (r 5) (r 4) 0x30)
+(store (r 5) 0)
+
+;;; see https://www.raspberrypi.org/app/uploads/2012/02/BCM2835-ARM-Peripherals.pdf
+;;; pages 100 and following
+
+;; disable pull-up/pull down
+(or (r 5) (r 3) 0x94)
+(store (r 5) 0)
+;; delay for 150 cycles
+(move (r 0) 150) 
+(branch-link :delay)
+
+(label! end)
+(branch :end)
+
+(label! delay)
+(subtract {:flags true} (r 0) 1)
+(branch {:cond :not-equal} #delay)
+(branch-exchange lr)