#!/bin/sh --
exec /home/nyef/sbcl/bin/sbcl --noinform --eval "(with-open-file (i \"$0\") (read-line i) (read-line i) (load i) (quit))"
;;;
;;; crtc-lcd-test.lisp
;;;
;;; Test program for experimenting with the CRTC LCD controls.
;;;

;; I can't believe I'm doing this.
(cl:in-package :cl-user)

;; For mmap().
(require :sb-posix)

;; Where the wild things are.
(defparameter *mmio-range-file* "/sys/bus/pci/devices/0000:00:05.0/resource0")
(defparameter *mmio-range-length* #x1000000) ;; 16 megs.
(defvar *mmio-sap*)

(defun call-with-open-card (fun)
  (if (boundp '*mmio-sap*)
    (funcall fun)
    (with-open-file (mmio-file *mmio-range-file* :direction :io :if-exists :overwrite)
       (let ((*mmio-sap* (sb-posix:mmap nil *mmio-range-length*
					(logior sb-posix::prot-read sb-posix::prot-write)
					sb-posix::map-shared
					(sb-sys:fd-stream-fd mmio-file) 0)))
	 (unwind-protect
	     (funcall fun)
	   (sb-posix:munmap *mmio-sap* *mmio-range-length*))))))

(defmacro with-open-card (&body body)
  `(call-with-open-card (lambda () ,@body)))

;; This, of course, doesn't actually work properly (race condition).
(defmacro without-card-interrupts (&body body)
  (let ((temp (gensym)))
    `(let ((,temp (sb-sys:sap-ref-32 *mmio-sap* #x140)))
       (unwind-protect
	   (progn
	     (setf (sb-sys:sap-ref-32 *mmio-sap* #x140) 0)
	     ,@body)
	 (setf (sb-sys:sap-ref-32 *mmio-sap* #x140) ,temp)))))

(defun crtc-reg (addr)
  (setf (sb-sys:sap-ref-8 *mmio-sap* #x6013d4) addr)
  (sb-sys:sap-ref-8 *mmio-sap* #x6013d5))

(defun (setf crtc-reg) (value addr)
  (setf (sb-sys:sap-ref-8 *mmio-sap* #x6013d4) addr)
  (setf (sb-sys:sap-ref-8 *mmio-sap* #x6013d5) value))

(defun tdms-data (panel addr)
  (setf (sb-sys:sap-ref-32 *mmio-sap* (+ #x6808b0 (* 8 panel))) (logior #x10000 addr))
  (sb-sys:sap-ref-32 *mmio-sap* (+ #x6808b4 (* 8 panel))))

;; Scratch space.
(defun test1 ()
  (with-open-card
    (format t "intr_en_0: ~X~%" (sb-sys:sap-ref-32 *mmio-sap* #x140))
    (format t "crtc-index: ~X~%" (sb-sys:sap-ref-8 *mmio-sap* #x6013d4))))

(defun test2 ()
  (with-open-card
   (without-card-interrupts
    ;;(format t "crtc-index: ~X~%" (sb-sys:sap-ref-8 *mmio-sap* #x6013d4))
    ;;(setf (sb-sys:sap-ref-8 *mmio-sap* #x6013d4) #x33)
    ;;(format t "NV_VGA_CRTCX_LCD: #x~(~02,'0X~)~%" (sb-sys:sap-ref-8 *mmio-sap* #x6013d5))
    (format t "NV_VGA_CRTCX_LCD: #x~(~2,'0X~)~%" (crtc-reg #x33))
    (format t "NV_VGA_CRTCX_PIXEL: #x~(~2,'0X~)~%" (crtc-reg #x28))
    (format t "NV_VGA_CRTCX_VDISPE: #x~(~2,'0X~)~%" (crtc-reg #x12)))))

(defun test3 (val)
  (with-open-card
   (without-card-interrupts
    (setf (crtc-reg #x33) val))))

(defun test4 ()
  (with-open-card
   (without-card-interrupts
    (format t "panel reg 04: #x~(~2,'0X~)~%" (tdms-data 0 #x04))
    (format t "panel reg 2e: #x~(~2,'0X~)~%" (tdms-data 0 #x2e))
    (format t "panel reg 33: #x~(~2,'0X~)~%" (tdms-data 0 #x33))
    (format t "other reg 2e: #x~(~2,'0X~)~%" (tdms-data 1 #x2e)))))

;; Script control.
#+(or)
(with-open-card
 ;;(test2)
 ;;(test3 #x0b)
 (test2))
(test4)
(quit)

;;; EOF