LispmFPGA

Main
Home
Project Log
The code
Videos

The compiler
Sample
Compilation


System Software
A LispOS
kernel

Some videos

The LispmFPGA sending columns of characters to a VGA screen. To accomplish this, the design includes a self-built text-mode VGA controller. As the left column is copied first to SRAM and then refetched from there, the identity of left and right running column indicates, that the SRAM controller is working properly:

The Lisp program behind the scene:



(setf *test-a1*
      
      '(let ()
       
         (defun p-shiftl (x i)
           (do ((j 0 (%+ j 1)))
               ((%>= j i) x)
             (setq x (p-shiftl-1 x))))

         (defun p-shiftr (x i)
           (do ((j 0 (%+ j 1)))
               ((%>= j i) x)
             (setq x (p-shiftr-1 x))))

  
         (defun mul (a b)
           (let ((acc 0)
                 (i 32))
             (do-until ((%= i 0) acc)
                       (if (%= (tag-and (addr-and b 1) 0) 1)
                           (setq acc (%+ acc a)))
                       (setq b (p-shiftr-1 b))
                       (setq a (p-shiftl-1 a))
                       (setq i (%- i 1)))))

         (defun irq (x)
           (progn
             (do ((i 0 (%+ i 1)))
                 ((%>= i 44))
               (set-byte base_vga (%+ 532 i) (%+ i 33)))
             (%print (get-word (p-constr 57344 0) 8))
             (let ((s (get-status)))
               (set-status (addr-ior s 128))
               x)))

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

         (defun print-hex-digit (pos val)
           (set-byte base_vga pos (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))))

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

         (setq base_vga (p-constr (mul (mul 15 16) 256) 0))
         (setq base_sram (p-constr (mul (mul 13 16) 256) 0))
         (setq base_ctrl (p-constr (mul (mul 14 16) 256) 0))

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


         (defun move-bytes (a y b x n)
           (do ((i 0 (%+ i 1)))
               ((%>= i n))
             (set-byte b (%+ i x) (get-byte a (%+ i y)))))

         (defun compare-bytes (a y b x n)
           (do ((i 0 (%+ i 1))
                (d 0 d))
               ((%>= i n) d)
             (setq d (%+ d (if (%= (get-byte a (%+ i y)) (get-byte b (%+ i x))) 0 1)))))

         (defun fill-bytes (a x c n)
           (do ((i 0 (%+ i 1)))
               ((%>= i n))
             (set-byte a (%+ i x) (%+ c i))))

         (do ((x 0 (if (%>= x 5320) 0 (%+ x 133)))
              (dd 0 dd)
              (q 33 (if (%>= q 81) 33 (%+ q 1))))
             ((%>= x 8000))
           (fill-bytes base_sram x q 27)
           (move-bytes base_sram x base_vga x 27)
           (move-bytes base_sram x base_sram (%+ x 8192) 27)
           (move-bytes base_sram x base_vga (%+ x 44) 27)
           (move-bytes base_vga x base_vga (%+ x 78) 27)
           (setq dd (%+ dd (compare-bytes base_sram x base_sram (%+ x 8192) 27)))
           (print-hex 5985 dd)))))


Navbutton Zentrum Anfang Anfang Ende   mailto Webmaster     Zuletzt geändert - 17 02 2008
Impressum