;; serial bytestream receiver. copies into sram
;; new VGA

(setf *test-a7*
      
      '(let ()
       
         (defun not (x)
           (if x nil -1))

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

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


         (defun irq (x)
           (let ((ch (get-word (p-constr 57344 0) 16)) ; read serial char
                 (getpt (get-word 100 0))
                 (insrtpt (get-word 100 4)))

;             (%print ch)
;             (%print insrtpt)

             (set-word 110 insrtpt ch)

;             (%print -1)
;             (%print (get-word 110 insrtpt))

             (let ((insrtpt1 (next-i insrtpt 15)))
               (if (not (%= insrtpt1 getpt))
                   (set-word 100 4 insrtpt1)))

;             (%print (get-word 100 4))

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

         (defun getch ()
           (let ((getpt (get-word 100 0))
                 (insrtpt (get-word 100 4)))
             (if (%= getpt insrtpt)
                 -1
               (let ((ch (p-shiftl (get-word 110 getpt) 2)))
                 (set-word 100 0 (next-i getpt 15))
                 ch))))


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

;; ser-out writes a byte to serial out

         (defun ser-out (ch)
           (set-byte base_ctrl 20 ch))

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


         (setq base_vga (p-constr 61440 0))
         (setq base_sram (p-constr 53248 0))
         (setq base_ctrl (p-constr 57344 0))

;;         (%print (tag-and (p-shiftr base_sram 14) 0))
;;         (%print (tag-and (p-shiftr (p-shiftl base_sram 16) 14) 0))

         (setq base_low (p-constr 0 0))

         (set-word 100 0 0) ; getpt
         (set-word 100 4 0) ; insrtpt

         (let ((q 0))
           (defun print-char (c)
             (set-byte base_vga (p-shiftl q 2) c)
             (setq q (if (%>= q 5453) 0 (%+ q 1)))))


         (setq *st* 0)
         (setq *x* 0)

          (do ((j 0 (%+ j 1))
               (i 0 i))
              ((not *x*))
            (let ((ch (getch)))
              (print-hex 5336 j)
              (print-hex 5320 i)
              (if (not (%= ch -1))
                  (cond
                   ((%= *st* 0) (setf *ch1* ch) (setf *st* 1))
                   ((%= *st* 1) (setf *ch2* ch) (setf *st* 2))
                   ((%= *st* 3) (if (%= ch 33)
                                    (setf *st* 0)
                                  (if (%= ch 32)
                                      (setf *st* 4)
                                    (if (%= ch 34)
                                        (setf *x* nil)))))
                   ((%= *st* 6) (if (%= ch 32)
                                    (setf i (%+ i 1)))
                    (setf *st* 0))
                   (1 nil))
                (cond
                 ((%= *st* 2) (ser-out (setf *x* (%+ (p-shiftl *ch1* 4) *ch2*)))
                  (setf *st* 3))
                 ((%= *st* 4) (set-byte base_sram i *x*) 
                  (setf *st* 5))
                 ((%= *st* 5) (ser-out (get-byte base_sram i)) 
                  (setf *st* 6))))))
                 
                

         
          (do ((i 0 (%+ i 1)))
               ((%>= i 12))
             (print-hex (%+ 133 (p-shiftl i 4)) (get-word base_sram (p-shiftl i 2))))))


;;;;           (do ((i 0 (%+ i 1)))
;;;;               ((%>= i 1000000)))

;;;;           (do ((i 0 (%+ i 1)))
;;;;               ((%>= i 24)) 
;;;;             (set-byte base_sram (%+ i 128) i))


;;;;           (do ((i 0 (%+ i 1)))
;;;;               ((%>= i 24))
;;;;             (print-hex (%+ 133 (p-shiftl i 4)) (get-byte base_sram (%+ i 128))))))