#lang racket
(require "merl.rkt")

; Print an error message to standard error and exit
(define (err message)
  (eprintf "ERROR: ~a~n" message)
  (exit))

; Helper for converting input number to relocation address
(define (convert-number s)
  (define num
    (cond [(string-prefix? s "0x")
            (string->number (string-replace s "0x" "#x") 16 'number-or-false)]
          [else (string->number s 10 'number-or-false)]))
  (when (> num #xFFFFFFFF) 
        (err "Invalid relocation address (out of 32-bit range)"))
  (cond [num]
        [else (err "Invalid relocation address (failed to parse number)")]))

; Get the relocation address from the first command line argument
(define reloc-address
  (cond [(> (vector-length (current-command-line-arguments)) 0)
         (convert-number (vector-ref (current-command-line-arguments) 0))]
        [else (err "Relocation address must be provided as command line argument.")]))
; Use it to compute the relocation offset
(define reloc-offset (- reloc-address HEADER-SIZE))

; Perform relocation on a MERL file (modifies the struct!)
(define (relocate-code! m offset)
  (for ([e (merl-table m)])
    (when (equal? (entry-format-code e) REL)
          (define index (/ (- (entry-location e) HEADER-SIZE) WORD-SIZE))
          (vector-set! (merl-code m) index 
                       (+ (vector-ref (merl-code m) index) offset)))))

; Main program
(define m (read-merl))
(relocate-code! m reloc-offset)
; Print just the code segment in readable hex
(for ([word (merl-code m)])
  (write-word-readable word))
