From 28784602fc5748be7e3639858b58e8f7aa398407 Mon Sep 17 00:00:00 2001
From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Tue, 29 Mar 2022 10:06:25 +1100
Subject: [PATCH] added "debugging" support

---
 asm/Makefile    |   3 +-
 asm/fas2txt.lsp | 118 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 120 insertions(+), 1 deletion(-)
 create mode 100755 asm/fas2txt.lsp

diff --git a/asm/Makefile b/asm/Makefile
index 4afe034..87a63e2 100644
--- a/asm/Makefile
+++ b/asm/Makefile
@@ -1,6 +1,7 @@
 reaper: reaper.asm
-	fasm $^ $@
+	fasm $^ -s $@.fas $@
 	chmod a+x $@
+	./fas2txt.lsp $@.fas > $@.map
 
 clean:
 	rm -f reaper
diff --git a/asm/fas2txt.lsp b/asm/fas2txt.lsp
new file mode 100755
index 0000000..98f4c41
--- /dev/null
+++ b/asm/fas2txt.lsp
@@ -0,0 +1,118 @@
+#!/usr/bin/newlisp
+#
+# Print an assembly listing for ELF targets associating binary address
+# with source lines.
+
+(signal 2 exit) ; exit on Ctrl-C
+
+; Format a byte or list of bytes into a hex string
+(define (hex L)
+  (if (list? L) (string "0x" (join (map (curry format "%02x") L)))
+    ; else
+    (hex (list L))))
+
+; Helper function to "copy out" a NUL terminated string from the
+; beginning of a memblock. (only an issue with utf8-enabled newlisp)
+(define (asciiz X) (get-string (address X)))
+
+; Helper function to set and print a variable
+(define (print-assign X Y) (set X (println X " = " Y)))
+
+; Helper "macro" to set variables and print their assignments
+(define-macro (setf-print)
+  (map (fn (P) (print-assign (P 0) (eval (P 1)))) (explode (args) 2)))
+
+; Load the .fas file here; named last on the command line
+(setf FAS (read-file (main-args -1)))
+
+(setf-print
+ SIGNATURE (hex (reverse (unpack (dup "b" 4) FAS)))
+ VERSION (unpack "bb" (4 FAS))
+ HEADER-LENGTH ((unpack "u" (6 FAS)) 0)
+ INFILEP ((unpack "lu" (8 FAS)) 0)
+ OUTFILEP ((unpack "lu" (12 FAS)) 0)
+ STRINGS-TABLE-OFFSET ((unpack "lu" (16 FAS)) 0)
+ STRINGS-TABLE-LENGTH ((unpack "lu" (20 FAS)) 0)
+ SYMBOLS-TABLE-OFFSET ((unpack "lu" (24 FAS)) 0)
+ SYMBOLS-TABLE-LENGTH ((unpack "lu" (28 FAS)) 0)
+ PREPROCESSED-OFFSET ((unpack "lu" (32 FAS)) 0)
+ PREPROCESSED-LENGTH ((unpack "lu" (36 FAS)) 0)
+ ASSEMBLY-DUMP-OFFSET ((unpack "lu" (40 FAS)) 0)
+ ASSEMBLY-DUMP-LENGTH ((unpack "lu" (44 FAS)) 0)
+ SECTION-TABLE-OFFSET ((unpack "lu" (48 FAS)) 0)
+ SECTION-TABLE-LENGTH ((unpack "lu" (52 FAS)) 0)
+ SYMBOL-REFERENCES-DUMP-OFFSET ((unpack "lu" (56 FAS)) 0)
+ SYMBOL-REFERENCES-DUMP-LENGTH ((unpack "lu" (60 FAS)) 0)
+ )
+
+(setf
+ STRINGS (STRINGS-TABLE-OFFSET STRINGS-TABLE-LENGTH FAS)
+ _ (println STRINGS)
+ PREP (PREPROCESSED-OFFSET PREPROCESSED-LENGTH FAS)
+ )
+
+(setf-print
+ MAIN-FILE (asciiz (INFILEP STRINGS))
+ )
+
+; Hash tables for filename->content and macroid->firstline
+(define FILES:FILES nil)   ; for captured file content
+(define MACROS:MACROS nil) ; for captured first-appearance-line of macros
+
+; Get/cache content of file
+(define (get-file NAME)
+  (or (FILES NAME) (FILES NAME (read-file NAME))))
+
+; Check if N is the first-appearence-line in macro ID
+; (capture N for the very first appearance of ID)
+(define (macro-start ID N)
+  (if (MACROS ID) (= (MACROS ID) N) (MACROS ID N)))
+
+; The file name for prep entry index i (with 0 = main file)
+(define (source-file i)
+  (if (= i) MAIN-FILE (asciiz (i PREP))))
+
+; Extract and format the file line with line number LN that is at at
+; position i of file FILE.
+(define (get-line i FILE LN)
+  (letn ((DATA (get-file FILE))
+         (END (find "\n" DATA nil i))
+         (R (i (- END i) DATA)) )
+    (format "%s:%-5d %s" FILE LN R)))
+
+; Format a "macro" prep entry by prepending an informative line for
+; the first-appearance-line.
+(define (resolve-macro AT PL)
+  (if (macro-start (PL 2) (PL 1))
+      (string (PREP-SOURCE-LINE "--------" (PL 2)) "\n"
+              (PREP-SOURCE-LINE AT (PL 3)))
+    ; else
+    (PREP-SOURCE-LINE AT (PL 3))))
+
+; Format output for "address" AT and prep line PL (unpacked)
+(define (prep-source AT PL)
+  (if (!= (& 0x80000000 (PL 1))) (resolve-macro AT PL)
+    ; else
+    (string AT " " (get-line (PL 2) (source-file (PL 0)) (PL 1)))))
+
+; Format output for "address" AT and prep line at P (index)
+(define (PREP-SOURCE-LINE AT P)
+  (prep-source AT (unpack "lu lu lu lu" (P PREP))))
+
+; Format output for assembly line L (memblock)
+(define (ASSEMBLY-LINE L)
+  (let ((AL (unpack "lu lu lu lu lu b b b b" (or L ""))))
+    (PREP-SOURCE-LINE (hex (AL 2)) (AL 1))
+    ))
+
+; divide memblock D into memblocks of size N
+(define (frag N D)
+  (unpack (dup (string "s" N " ") (/ (length D) N)) D))
+
+#### Main action(s) start here
+
+(map println
+     (map ASSEMBLY-LINE
+          (frag 28 (ASSEMBLY-DUMP-OFFSET ASSEMBLY-DUMP-LENGTH FAS))))
+
+(exit 0)
-- 
2.39.2