(defstruct pdp6
  ar
  mq
  mb
  sc
  fe

  div-neg)

(defmacro with-pdp6 (pdp6 &body body)
  `(with-accessors ((ar pdp6-ar)
		    (mq pdp6-mq)
		    (mb pdp6-mb)
		    (sc pdp6-sc)
		    (fe pdp6-fe))
       ,pdp6
     ,@body))

(defun pdp6-reset (apr)
  (with-pdp6 apr
    (setq ar 0
	  mq 0
	  mb 0
	  sc 0
	  fe 0
	  div-neg nil)))

(defvar pdp6 (make-pdp6))
;(setf pdp6 (make-pdp6))

(pdp6-reset pdp6)

(defun print-pdp6 (pdp6)
  (with-pdp6 pdp6
    (format t "~%AR/~12,'0o MQ/~12,'0o MB/~12,'0o"
	    ar mq mb)))

(defun wd (w)
  (ldb (byte 36 0) w))

(defun bit0 (x)
  (ldb (byte 1 35) x))

(defun bit35 (x)
  (ldb (byte 1 0) x))

(defun negp (x)
  (= (bit0 x) 1))

(defun ar-com (pdp6)
  (with-pdp6 pdp6
    (setq ar (logxor ar #o777777777777))))

(defun ar-cry-in (pdp6 c)
  (with-pdp6 pdp6
    (setq ar (wd (+ ar c)))))

(defun ar-add (pdp6)
  (with-pdp6 pdp6
    (setf ar (wd (+ ar mb)))))

(defun ar-sub (pdp6)
  (with-pdp6 pdp6
    (setf ar (wd (+ ar (- #o1000000000000 mb))))))

(defun ar-sub-abs (pdp6)
  (with-pdp6 pdp6
    (if (negp mb)
	(ar-add pdp6)
	(ar-sub pdp6))))

(defun ar-add-abs (pdp6)
  (with-pdp6 pdp6
    (if (negp mb)
	(ar-sub pdp6)
	(ar-add pdp6))))

(defun ar-negate (pdp6)
  (ar-com pdp6)
  (ar-cry-in pdp6 1))

(defun ar-mq-negate (pdp6)
  (with-pdp6 pdp6
    ;; rotate so MQ can be negated
    (psetq ar mq
	   mq mb
	   mb ar)
    (ar-negate pdp6)
    ;; rotate back
    (psetq ar mb
	   mq ar
	   mb mq)
    ;; if mq is 0, there was a carry that has to be propagated
    ;; BUG in PDP-6 schematics:
    ;;  if the sign bit is set (as it should be), MQ will not be 0
    ;;  so we check MQ1-35 instead
    (if (zerop (ldb (byte 35 0) mq))
	(ar-negate pdp6)
	(ar-com pdp6))))

;;; the fundamental algorithm is non-restoring division
(defun integer-div (pdp6)
  (with-pdp6 pdp6
    (format t "~%beginning:")
    (print-pdp6 pdp6)
    ;; init SC with -36
    (setq sc #o733)
    ;; close gap, MQ0 is a duplicate of the sign bit.
    ;; ~AR0 shifted in on the right is guaranteed to be 1
    ;; if AR is positive, else we have an overflow anyway
    (setq mq (wd (logior (ash mq 1)
			(logxor (bit0 ar) 1))))
    (print-pdp6 pdp6)
    ;; first division step
    ;; if result isn't negative, we have an overflow.
    ;; this also catches division by 0 because the dividend is positive
    (ar-sub-abs pdp6)
    (unless (negp ar)
      (print "overflow")
      (return-from integer-div nil))
    ;; first quotient bit is the sign and must be 0.
    ;; the other 35 bits are the magnitude.
    (loop
       (setq sc (ldb (byte 9 0) (+ sc 1)))
       ;; shift quotient bit in on the right
       (psetq ar (wd (logior (ash ar 1)
			     (bit0 mq)))
	      mq (wd (logior (ash mq 1)
			     (logxor (bit0 ar) 1))))
       (print-pdp6 pdp6)
       (when (= sc #o777)
	 (return))
       ;; the complemented sign of the last subtraction is now in MQ35.
       ;; to generate next bit add absolute if negative, subtract if positive.
       (if (/= (bit35 mq) (bit0 mb))
	   (ar-sub pdp6)
	   (ar-add pdp6))
       (print-pdp6 pdp6))
    ;; adjust remainder in AR
    (setq ar (dpb (logxor (bit35 mq) 1) (byte 1 35) (ash ar -1)))
    ;; if remainder is negative, we subtracted too often, add back
    (when (negp ar)
	(ar-add-abs pdp6))
    (print-pdp6 pdp6)
    ;; make remainder have same sign as dividend
    (when (pdp6-div-neg pdp6)
      (ar-negate pdp6))
    ;; shuffle registers and give quotient the correct sign
    (psetq ar mq
	   mq mb
	   mb ar)
    (unless (eq (pdp6-div-neg pdp6) (negp mq))
      (ar-negate pdp6))
    ;; quotient in AR
    ;; remainder in MQ
    ;; dividend in MB
    (psetq mb mq
	   mq mb)))

(defun divi (pdp6)
  (with-pdp6 pdp6
    (setf (pdp6-div-neg pdp6) (negp ar))
    (when (pdp6-div-neg pdp6)
      (ar-negate pdp6))
    (setq mq ar
	  ar 0)
    (integer-div pdp6)))

(defun div (pdp6)
  (with-pdp6 pdp6
    (setf (pdp6-div-neg pdp6) (negp ar))
    (when (pdp6-div-neg pdp6)
      (ar-mq-negate pdp6))
    (integer-div pdp6)))

(defun divi-test (pdp6 a b)
  (with-pdp6 pdp6
    (setq ar a
	  mb b)
    (format t "~%divi:")
    (divi pdp6)
    (print-pdp6 pdp6)))

(defun div-test (pdp6 a1 a2 b)
  (with-pdp6 pdp6
    (setq ar a1
	  mq a2
	  mb b)
    (format t "~%div:")
    (div pdp6)
    (print-pdp6 pdp6)))

(divi-test pdp6 #o777777777112 #o123)
(divi-test pdp6 #o400000000000 #o123)
(divi-test pdp6 #o000000000666 #o123)
(divi-test pdp6 #o000000000620 #o123)
(divi-test pdp6 #o377777777777 #o1)
(divi-test pdp6 #o000000000666 #o777777777655)
(div-test pdp6 #o777777777777 #o400000000000 #o000000100000)
(div-test pdp6 #o400000000000 #o400000000000 #o400000000000)

(print-pdp6 pdp6)