(setf *print01*

'(


;;
;; the print routines
;;


(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))))

(setq base_vga (p-constr 61440 0))


(defun qprint (str obj)
  (cond ((numberp obj)
         (print-number str obj))
        ((stringp obj)
         (print-string str obj)))
  (new-line))

(defun print-number (str num)
  )


(defconstant +out-pos-base+ 5453)
(defconstant +out-pos-last+ 5985)

(defun print-string (str s)
  (let ((len (length s)))
    (funcall str #\")
    (do ((i 0 (%+ i 1)))
        ((%>= i len))
      (funcall str (char s i)))
    (funcall str #\")))

(let ((out-pos +out-pos-base+))
  
  (defun set-outpos (pos)
    (setf out-pos pos))

  (setq sout #'(lambda (c)
                 (set-byte base_vga (p-shiftl out-pos 2) (char-code c))
                 (setq out-pos (if (%<= out-pos +out-pos-last+) (%+ out-pos 1) +out-pos-base+))))
  
  (defun new-line ()
    (set-outpos (%+ out-pos (%- 133 (%rem out-pos 133))))))



                                        
               




))