#!/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)