;; -*- Mode: Lisp; -*-
;; ---------------------------------------------------------------------------
;;     Title: Raw Disassembly for CCL x86-64
;;   Created: 2025-01-13
;;    Author: Gilbert Baumann <gilbert@bauhh.de>
;; ---------------------------------------------------------------------------
;;;  (c) copyright 2025 by Gilbert Baumann

;; Disassemble some function using essentially objdump. We write
;; /tmp/a.s (sic!) run it through cc and then objdump.

(in-package :cl-user)

;; ./compiler/X86/X8664/x8664-arch.lisp

;; lisp-kernel/x86-constants64.s lists the CCL register names:

;; imm0..imm2:		RAX, RDX, RCX
;; temp0..temp2:		RBX, R9, R10
;; arg_x, arg_y, arg_z:	R8, RDI, RSI
;; fn:			R13
;; rcontext_reg:		GS

;; Win64 specifics:
;; rcontext_reg:		R11

(defun code-bytes (function &aux (function (coerce function 'function)))
  (let* ((fv (ccl::function-to-function-vector function))
         (function-size-in-words (ccl::uvsize fv))
         ;;(code-words (ccl::%function-code-words function))
         (ncode-bytes (ash function-size-in-words target::word-shift))
         (code-bytes (make-array ncode-bytes
                                 :element-type '(unsigned-byte 8))))
    (ccl::%copy-ivector-to-ivector fv 0 code-bytes 0 ncode-bytes)
    (subseq code-bytes 7)))

(defun raw-disassemble (function)
  (let ((code (code-bytes function)))
    (with-open-file (o "/tmp/a.s" :direction :output :if-exists :supersede)
      (format o ".text~%")
      (loop for x across code
            do (format o ".byte ~d~%" x)))
    (let ((q
           (remove-if-not
            (lambda (x)
              (>= (length x) 3))
            (mapcar (lambda (x)
                      (split-sequence:split-sequence #\tab x))
                    (split-sequence:split-sequence
                     #\newline
                     (with-output-to-string (bag)
                       (ccl:run-program "/bin/sh" (list "-c" "cc -c /tmp/a.s -o /tmp/a.o ; objdump --disassemble /tmp/a.o")
                                        :output bag)))))))
      (let ((max (make-hash-table)))
        (dolist (line q)
          (loop for i from 0 for col in line do (setf (gethash i max 0) (max (gethash i max 0) (length col)))))
        (dolist (line q)
          (loop for i from 0
                for col in line
                do (let ((m (gethash i max)))
                     (format t "  ~vA" m col)))
          (terpri))))))