(in-package "CL-USER")


(defun put-field (n a b)
  (let ((mask (- (expt 2 (+ (- a b) 1)) 1)))
    (ash (logand mask n) b)))


(defun make-micro-store ()
  (with-open-file (fin "micro.input" :direction :input)
    (with-open-file (fout "micro.data" :direction :output :if-exists :overwrite :if-does-not-exist :create)
      (loop
       with akt-line = nil
       with addr = -1
       with addr-new = nil
       with val = nil
       do
       (setf akt-line (read-line fin nil nil))
       (if (null akt-line)
           (return-from nil nil))
       (setf akt-line (split-string akt-line '(#\Space #\Tab #\Newline)))
       (setf akt-line (mapcar #'(lambda (x) (read-from-string x)) akt-line))
;       (format t "**** ~a~%" akt-line)
       (setf addr-new (car akt-line))
       (setf val
             (+
              (put-field (nth 1 akt-line) 31 27)
              (put-field (nth 2 akt-line) 26 22)
              (put-field (nth 3 akt-line) 21 17)
              (put-field (nth 4 akt-line) 16 14)
              (put-field (nth 5 akt-line) 13 11)
              (put-field (nth 6 akt-line) 10 9)
              (put-field (nth 7 akt-line) 8 6)
              (put-field (nth 8 akt-line) 5 0)))
       (if (/= addr-new (+ addr 1))
           (format fout "@~4,'0X ~%" addr-new))
       (format fout "~32,'0B~%" val)
       (setf addr addr-new)))))












(defun split-string (str delims)
  (let ((spos 0)
        (spos-new 0)
        (len (length str))
        (res nil))
    (loop
      do      
      (setf spos (position-if #'(lambda (c) (not (member c delims))) str :start spos))
      (when (null spos)
        (return-from split-string (reverse res)))
      (setf spos-new (position-if #'(lambda (c) (member c delims)) str :start spos))
      (when (null spos-new)
        (return-from split-string (reverse (push (subseq str spos len) res))))
      (push (subseq str spos spos-new) res)
      (setf spos spos-new))))

(make-micro-store)