(setf *print01*

'(let ()


(setf nil (get-word 200 32))

(setq t 't)



;; keyboard interface routines
;;
;;

(%print 100)

(defun next-i (i m)
  (addr-and (%+ i 1) m))

(%print 200)

(defun mod-m (i m)
  (if (%>= i m)
      (%- i m)
    i))


;;
;; irq puts characters into a fifo
;; get pointer - located at (100 0)
;; insert pointer - located at (100 4)
;;

(setq base_ctrl (p-constr 57344 0))


(defconstant *raw-queue* 112)

(%print 300)

;; get point and insert point in der raw-queue

(set-word 100 0 0)
(set-word 100 4 0)

(defun irq (x)
  (let ((ch (get-word base_ctrl 8))
        (get-pt (get-word 100 0))
        (insrt-pt (get-word 100 4)))

    (set-byte *raw-queue* insrt-pt (p-shiftl ch 2))

    (let ((insrt-pt1 (next-i insrt-pt 31)))

      (if (not (%= insrt-pt1 get-pt))
          (set-word 100 4 insrt-pt1)))

    (let ((s (get-status)))
      (set-status (addr-ior s 128))
      x)))

;;
;; at (0 16) is the pointer to the interrupt routine
;; 


(set-word (p-constr 0 16) 0 (%symbol-function 'irq))

(%print 400)
;;
;; the print routines
;;

(defun not (x)
  (if x nil 1))

(defun %/= (a b)
  (if (%= a b) nil 1))

(%print 500)

(defun to-ascii (val)
  (if (%<= val 9)
      (%+ val 48)
    (%+ val 55)))

(defun print-hex-digit (pos val)
  (set-byte base_vga (p-shiftl pos 2) (to-ascii val)))

(defun print-hex-byte (pos val)
  (print-hex-digit (%+ pos 1) (addr-and val 15))
  (print-hex-digit pos (addr-and (tag-and (p-shiftr val 4) 0) 15)))


(defun print-hex (pos val)
  (let ((v val))
    (print-hex-byte (%+ pos 6) (addr-and (p-shiftl val 2) 255))
    (print-hex-byte (%+ pos 4) (addr-and (setq v (tag-and (p-shiftr v 6) 0)) 255))
    (print-hex-byte (%+ pos 2) (addr-and (setq v (tag-and (p-shiftr v 8) 0)) 255))
    (print-hex-byte pos (addr-and (tag-and (p-shiftr v 8) 0) 255))))


(%print 900)

(setq base_vga (p-constr 61440 0))

(%print 1000)
    
))