(in-package "CL-USER")

(defun is-addr-line (str)
  (position #\@ str))

(defun get-addr (str)
  (parse-integer (subseq str (+ 1 (position #\@ str))) :radix 16))


(defun extract-mod (val modulus)
  (multiple-value-bind (a b) (floor (floor val (expt 256 modulus)) 256)
    b))


(defun make-xi-init (ifname ofname base from-addr to-addr width select)
  (with-open-file (fin ifname :direction :input)
    (with-open-file (fout ofname :direction :output :if-exists :supersede :if-does-not-exist :create)
      (let ((mem-map (make-array (+ 1 (- to-addr from-addr)) :initial-element 0)))
        (loop
         with addr = from-addr
         with val = nil
         with akt-line = nil
         do
         (setf akt-line (read-line fin nil nil))
         (if (null akt-line)
             (return-from nil nil))
         (when (is-addr-line akt-line)
             (setf addr (* width (get-addr akt-line)))
             (setf akt-line (read-line fin nil nil)))
         (if (null akt-line)
             (return-from nil nil))
         (setf val (parse-integer akt-line :radix base))
         (if (< addr to-addr)
             (loop for m from 0 to 3 do
                   (setf (aref mem-map (+ (- addr from-addr) m)) (extract-mod val m))))
         (setf addr (+ addr 4)))

        (format fout "Dump of File ~a ~%" ifname)
        (loop for i from 0 to (- to-addr from-addr 1) do
              (format fout "~2,'0X" (aref mem-map i))
              (if (= 0 (rem (+ i 1) 32))
                  (format fout "~%"))
              finally (format fout "~%***~%"))
        
        (loop
         with out-line = 0
         with out-addr = 0
         with mult = 1
         with val = nil
         for addr from 0 to (- to-addr from-addr 1) by 4 do
         (setf val 
               (loop 
                with s = 0 
                for m from 3 downto 0 do 
                (setf s (+ (* 256 s) (aref mem-map (+ addr m))))
                finally return s)) 
         (loop
          for m from 0 to 3 do
          (if (/= (logand select (expt 2 m)) 0)
              (progn
                (setf out-line (+ out-line (* mult (extract-mod val m))))
                (setf out-addr (+ out-addr 1))
                (setf mult (* mult 256)))))
         (when (and (> out-addr 0) (= (rem out-addr 32) 0))
           (format fout "defparam [user_instance].INIT_~2,'0X = 256'h~64,'0X ;~%" (floor (- out-addr 1) 32) out-line)
           (setf mult 1)
           (setf out-line 0)))))))