anchor.diff:  ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
   ;;;; DEALINGS IN THE SOFTWARE.
   
  -; State
  +;;; Program settings
  +
  +(defparameter *disasm* nil "Whether to disassemble")
  +
  +;;; State variables
  +
   (defparameter *ram* (make-array (* 64 1024) :initial-element 0 :element-type '(unsigned-byte 8)) "Primary segment")
   (defparameter *stack* (make-array (* 64 1024) :initial-element 0 :element-type '(unsigned-byte 8)) "Stack segment")
  -(defparameter *flags* '(:cf nil :sf nil :zf nil) "Flags")
  +(defparameter *flags* '(:cf 0 :sf 0 :zf 0) "Flags")
   (defparameter *registers* '(:ax 0 :bx 0 :cx 0 :dx 0 :bp 0 :sp #x100 :si 0 :di 0 :ip 0) "Registers")
   
  -; Constants
  +;;; Constants
  +
   (defconstant +byte-register-to-word+ '(:al (:ax nil) :ah (:ax t) :bl (:bx nil) :bh (:bx t) :cl (:cx nil) :ch (:cx t) :dl (:dx nil) :dh (:dx t)) "Mapping from byte registers to word registers")
   (defconstant +bits-to-register+ '(:ax :cx :dx :bx :sp :bp :si :di) "Mapping from index to word register")
   (defconstant +bits-to-byte-register+ '(:al :cl :dl :bl :ah :ch :dh :bh) "Mapping from index to byte register")
   
  -; Constant mappings
  +;;; Constant mappings
   
   (defun bits->word-reg (bits)
     (elt +bits-to-register+ bits))
  
positive.code: 
  (defun loop-instructions (&optional (return-disasm nil))
    "Loop through loaded instructions."
    (loop
       for ret = (parse-opcode (next-instruction))
       collecting ret into disasm
  
negative.code:   (incf (register :sp) 2)
    (read-word-from-ram (- (register :sp) 2) *stack*))
  
  ;;; Flag effects
  
  (defun set-cf-on-add (value is-word)
    (setf (flag :cf) (if is-word (max (floor (/ value #x10000)) 1) (max (floor (/ value #x100)))))
    value)
  
  (defun set-cf-on-sub (value1 value2)
    (setf (flag-p :cf) (> value2 value1))
    value1)
  
  (defun set-sf-on-op (value is-word)
    (setf (flag :sf) (if is-word (max (floor (/ value #x8000)) 1) (max (floor (/ value #x80)))))
    value)
  
  (defun set-zf-on-op (value)
    (setf (flag-p :zf) (= value 0))
    value)
  
  ;;; Operations
  
  (defmacro disasm-instr (on-disasm &body body)
    `(if *disasm*
         ,on-disasm
         (progn ,@body)))
  
  (defun clear-carry-flag ()
    (disasm-instr (list "clc")
      (setf (flag-p :cf) nil)))
  
  (defun set-carry-flag ()
    (disasm-instr (list "stc")
      (setf (flag-p :cf) t)))
  
  (defun mov-byte-to-register (opcode)
    (let ((reg (bits->byte-reg (mod opcode #x08))))
      (disasm-instr (list "mov" :src (next-instruction) :dest reg)
        (setf (byte-register reg) (next-instruction)))))
  
  (defun mov-word-to-register (reg)
    (disasm-instr (list "mov" :src (reverse-little-endian (next-instruction) (next-instruction)) :dest reg)
      (setf (register reg) (reverse-little-endian (next-instruction) (next-instruction)))))
  
  (defmacro with-one-byte-opcode-register (opcode &body body)
    `(let ((reg (bits->word-reg (mod ,opcode #x08))))
       ,@body))
  
  (defun push-register (reg)
    (disasm-instr (list "push" :src reg)
      (push-to-stack (register reg))))
  
  (defun pop-to-register (reg)
    (disasm-instr (list "pop" :dest reg)
      (setf (register reg) (pop-from-stack))))
  
  (defun inc-register (reg)
    (disasm-instr (list "inc" :op1 reg)
      (set-sf-on-op (set-zf-on-op (incf (register reg))) t)))
  
  (defun dec-register (reg)
    (disasm-instr (list "dec" :op1 reg)
      (set-sf-on-op (set-zf-on-op (decf (register reg))) t)))
  
  (defun xchg-register (reg)
    (disasm-instr (if (eql reg :ax) '("nop") (list "xchg" :op1 :ax :op2 reg))
      (rotatef (register :ax) (register reg))))
  
  ;;; Opcode parsing
  
  (defun in-8-byte-block-p (opcode block)
    (= (truncate (/ opcode 8)) (/ block 8)))
  