fas2txt.lsp

   1 #!/usr/bin/newlisp
   2 #
   3 # Print an assembly listing for ELF targets associating binary address
   4 # with source lines.
   5
   6 (signal 2 exit) ; exit on Ctrl-C
   7
   8 ; Format a byte or list of bytes into a hex string
   9 (define (hex L)
  10   (if (list? L) (string "0x" (join (map (curry format "%02x") L)))
  11     ; else
  12     (hex (list L))))
  13
  14 ; Helper function to "copy out" a NUL terminated string from the
  15 ; beginning of a memblock. (only an issue with utf8-enabled newlisp)
  16 (define (asciiz X) (get-string (address X)))
  17
  18 ; Helper function to set and print a variable
  19 (define (print-assign X Y) (set X (println X " = " Y)))
  20
  21 ; Helper "macro" to set variables and print their assignments
  22 (define-macro (setf-print)
  23   (map (fn (P) (print-assign (P 0) (eval (P 1)))) (explode (args) 2)))
  24
  25 ; Load the .fas file here; named last on the command line
  26 (setf FAS (read-file (main-args -1)))
  27
  28 (setf-print
  29  SIGNATURE (hex (reverse (unpack (dup "b" 4) FAS)))
  30  VERSION (unpack "bb" (4 FAS))
  31  HEADER-LENGTH ((unpack "u" (6 FAS)) 0)
  32  INFILEP ((unpack "lu" (8 FAS)) 0)
  33  OUTFILEP ((unpack "lu" (12 FAS)) 0)
  34  STRINGS-TABLE-OFFSET ((unpack "lu" (16 FAS)) 0)
  35  STRINGS-TABLE-LENGTH ((unpack "lu" (20 FAS)) 0)
  36  SYMBOLS-TABLE-OFFSET ((unpack "lu" (24 FAS)) 0)
  37  SYMBOLS-TABLE-LENGTH ((unpack "lu" (28 FAS)) 0)
  38  PREPROCESSED-OFFSET ((unpack "lu" (32 FAS)) 0)
  39  PREPROCESSED-LENGTH ((unpack "lu" (36 FAS)) 0)
  40  ASSEMBLY-DUMP-OFFSET ((unpack "lu" (40 FAS)) 0)
  41  ASSEMBLY-DUMP-LENGTH ((unpack "lu" (44 FAS)) 0)
  42  SECTION-TABLE-OFFSET ((unpack "lu" (48 FAS)) 0)
  43  SECTION-TABLE-LENGTH ((unpack "lu" (52 FAS)) 0)
  44  SYMBOL-REFERENCES-DUMP-OFFSET ((unpack "lu" (56 FAS)) 0)
  45  SYMBOL-REFERENCES-DUMP-LENGTH ((unpack "lu" (60 FAS)) 0)
  46  )
  47
  48 (setf
  49  STRINGS (STRINGS-TABLE-OFFSET STRINGS-TABLE-LENGTH FAS)
  50  _ (println STRINGS)
  51  PREP (PREPROCESSED-OFFSET PREPROCESSED-LENGTH FAS)
  52  )
  53
  54 (setf-print
  55  MAIN-FILE (asciiz (INFILEP STRINGS))
  56  )
  57
  58 ; Hash tables for filename->content and macroid->firstline
  59 (define FILES:FILES nil)   ; for captured file content
  60 (define MACROS:MACROS nil) ; for captured first-appearance-line of macros
  61
  62 ; Get/cache content of file
  63 (define (get-file NAME)
  64   (or (FILES NAME) (FILES NAME (read-file NAME))))
  65
  66 ; Check if N is the first-appearence-line in macro ID
  67 ; (capture N for the very first appearance of ID)
  68 (define (macro-start ID N)
  69   (if (MACROS ID) (= (MACROS ID) N) (MACROS ID N)))
  70
  71 ; The file name for prep entry index i (with 0 = main file)
  72 (define (source-file i)
  73   (if (= i) MAIN-FILE (asciiz (i PREP))))
  74
  75 ; Extract and format the file line with line number LN that is at at
  76 ; position i of file FILE.
  77 (define (get-line i FILE LN)
  78   (letn ((DATA (get-file FILE))
  79          (END (find "\n" DATA nil i))
  80          (R (i (- END i) DATA)) )
  81     (format "%s:%-5d %s" FILE LN R)))
  82
  83 ; Format a "macro" prep entry by prepending an informative line for
  84 ; the first-appearance-line.
  85 (define (resolve-macro AT PL)
  86   (if (macro-start (PL 2) (PL 1))
  87       (string (PREP-SOURCE-LINE "--------" (PL 2)) "\n"
  88               (PREP-SOURCE-LINE AT (PL 3)))
  89     ; else
  90     (PREP-SOURCE-LINE AT (PL 3))))
  91
  92 ; Format output for "address" AT and prep line PL (unpacked)
  93 (define (prep-source AT PL)
  94   (if (!= (& 0x80000000 (PL 1))) (resolve-macro AT PL)
  95     ; else
  96     (string AT " " (get-line (PL 2) (source-file (PL 0)) (PL 1)))))
  97
  98 ; Format output for "address" AT and prep line at P (index)
  99 (define (PREP-SOURCE-LINE AT P)
 100   (prep-source AT (unpack "lu lu lu lu" (P PREP))))
 101
 102 ; Format output for assembly line L (memblock)
 103 (define (ASSEMBLY-LINE L)
 104   (let ((AL (unpack "lu lu lu lu lu b b b b" (or L ""))))
 105     (PREP-SOURCE-LINE (hex (AL 2)) (AL 1))
 106     ))
 107
 108 ; divide memblock D into memblocks of size N
 109 (define (frag N D)
 110   (unpack (dup (string "s" N " ") (/ (length D) N)) D))
 111
 112 #### Main action(s) start here
 113
 114 (map println
 115      (map ASSEMBLY-LINE
 116           (frag 28 (ASSEMBLY-DUMP-OFFSET ASSEMBLY-DUMP-LENGTH FAS))))
 117
 118 (exit 0)