file.lisp

(in-package :cl-izhora)

(defun print-machine (machine &key (stream t))
  (let
      ((model (izhora-model machine))
       (a (izhora-a machine))
       (b (izhora-b machine))
       (c (izhora-c machine))
       (pc (izhora-pc machine))
       (rp (izhora-rp machine))
       (sp (izhora-sp machine))
       (i0 (izhora-i0 machine))
       (i1 (izhora-i1 machine))
       (l (izhora-l machine))
       (sc (izhora-sc machine))
       (ct (izhora-ct machine))
       (ext nil))
    (case model
      (0 (format stream "MODEL: IZHORA 1~%"))
      (1 (format stream "MODEL: IZHORA 1A~%"))
      (2 (format stream "MODEL: IZHORA 1B~%"))
      (3 (format stream "MODEL: IZHORA 2~%")))
    (unless (zerop pc) (format stream "PC : ~4,'0X~%" pc))
    (unless (zerop a) (format stream "A  : ~4,'0X~%" a))
    (unless (zerop b) (format stream "B  : ~4,'0X~%" b))
    (unless (zerop c) (format stream "C  : ~4,'0X~%" c))
    (unless (zerop sc) (format stream "SC : ~4,'0X~%" sc))
    (unless (zerop ct) (format stream "CT : ~4,'0X~%" ct))
    (unless (zerop rp) (format stream "RP : ~4,'0X~%" rp))
    (unless (zerop sp) (format stream "SP : ~4,'0X~%" sp))
    (unless (zerop i0) (format stream "I0 : ~4,'0X~%" i0))
    (unless (zerop i1) (format stream "I1 : ~4,'0X~%" i1))
    (unless (zerop l) (format stream "L  : ~4,'0X~%" l))
    (loop for x from 0 to #xFFFF do
      (unless (zerop (aref (izhora-code machine) x))
	(format stream "~4,'0X ~8,'0X~%" x (aref (izhora-code machine) x))))
    (loop for x from 0 to (1- (length (izhora-extmem machine))) do
      (if (plusp (aref (izhora-extmem machine) x)) (setf ext t)))
    (when ext
      (format stream "~%#EXTERNAL MEMORY: ~%")
      (loop for x from 0 to (1- (length (izhora-extmem machine))) do
	(unless (zerop (aref (izhora-extmem machine) x))
	  (format stream "~8,'0X ~8,'0X~%" x (aref (izhora-extmem machine) x)))))))

(defun save-machine (machine file &key comment)
  (with-open-file
      (stream (concatenate 'string file ".izh")
	      :direction :output :if-exists :supersede)
    (when comment
      (format stream "#~a~%" comment))
    (print-machine machine :stream stream))
  t)

(defun load-machine (file)
  (let (machine (extmem 0))
    (with-open-file
	(stream (concatenate 'string file ".izh")
		:direction :input :if-does-not-exist nil)
      (when stream
	(setf machine (make-izhora))
	(loop for line = (read-line stream nil)
              while line
              do (unless (or (find #\# line) (zerop (length line)))
		   (if (find #\: line)
		       (progn
			 (when (search "MODEL" line :test #'string-equal)
			   (when (search "IZHORA 1" line :test #'string-equal)
			     (setf (izhora-model machine) 0))
			   (when (search "IZHORA 1A" line :test #'string-equal)
			     (setf (izhora-model machine) 1))
			   (when (search "IZHORA 1B" line :test #'string-equal)
			     (setf (izhora-model machine) 2))
			   (when (search "IZHORA 2" line :test #'string-equal)
			     (setf (izhora-model machine) 3)))
			 (when (search "A" line :test #'string-equal)
			   (setf (izhora-a machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (or (search "B :" line :test #'string-equal)
				   (search "B:" line :test #'string-equal))
			   (setf (izhora-b machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (and
				(or (search "C :" line)(search "C:" line))
				(not (search "PC" line :test #'string-equal))
				(not (search "SC" line :test #'string-equal)))
			   (setf (izhora-c machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "PC" line :test #'string-equal)
			   (setf (izhora-pc machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "SC" line :test #'string-equal)
			   (setf (izhora-sc machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "CT" line :test #'string-equal)
			   (setf (izhora-ct machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "RP" line :test #'string-equal)
			   (setf (izhora-rp machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "SP" line :test #'string-equal)
			   (setf (izhora-sp machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "I0" line :test #'string-equal)
			   (setf (izhora-i0 machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "I1" line :test #'string-equal)
			   (setf (izhora-i1 machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (search "L" line :test #'string-equal)
			   (setf (izhora-l machine)
				 (parse-integer line :start 4 :radix 16 :junk-allowed t))))
		       (progn
			 (when (= (length (subseq line 0 (search " " line))) 4)
			   (setf (aref (izhora-code machine)
				       (parse-integer line :radix 16 :junk-allowed t))
				 (parse-integer line :start 4 :radix 16 :junk-allowed t)))
			 (when (= (length (subseq line 0 (search " " line))) 8)
			   (setf extmem (parse-integer line :radix 16 :junk-allowed t))
			   (if (> extmem (1- (length (izhora-extmem machine))))
			       (adjust-array (izhora-extmem machine) extmem))
			   (setf (aref (izhora-extmem machine)
				       (parse-integer line :radix 16 :junk-allowed t))
				 (parse-integer line :start 8 :radix 16 :junk-allowed t)))))))))
    machine))