;;; -*- Mode:LISP; Package:LAMBDA; Base:8; Lowercase:T; Readtable:ZL -*- ;;; ;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc. ;;; ; Run the function (set-up-tv). Then the nu tv approximates the cadr tv. Just ; relocate references to the cadr bit map to locations starting at 100000 in ; the tv board's slot space. (defconst tv-config-reg 0) (defconst tv-mem-control-reg 1) (defconst tv-interrupt-reg 2) (defconst tv-status-reg 3) (defconst tv-data-rate-reg 4) (defconst tv-data-port-a 14) (defconst tv-command-port-a 15) (defconst tv-data-port-b 16) (defconst tv-command-port-b 17) ;(defconst tv-slot 8) (defconst tv-slot-on-normal-sdu 8) (defconst tv-config-reset-bit 0001) (defconst tv-config-enable-bit 0101) (defconst tv-config-mode-bits 0302) (defun read-tv-config () (send *proc* :bus-slot-read (send *proc* :tv-slot) 0)) (defun write-tv-config (data) (send *proc* :bus-slot-write (send *proc* :tv-slot) 0 data)) (defun reset-tv () (let ((old-status (read-tv-config))) (write-tv-config (dpb 1 tv-config-reset-bit old-status)) (write-tv-config (dpb 0 tv-config-reset-bit old-status)))) (defun enable-tv () (write-tv-config (dpb 1 tv-config-enable-bit (read-tv-config)))) (defun disable-tv () (write-tv-config (dpb 0 tv-config-enable-bit (read-tv-config)))) (defun set-up-tv (&OPTIONAL words-per-line) (cond ((access-path-lmi-serial-protocol *proc*) (funcall *proc* ':tyo-cr #/t) (funcall *proc* ':read-32)) (t (reset-tv) (enable-tv) (tv-set-move-mode) (tv-enable-copy-a-to-b) (tv-black-on-white) (cond ((numberp words-per-line) (tv-set-words-per-line words-per-line)) ((null words-per-line) (tv-set-vcmem-mode)) (t (tv-set-cadr-mode)))))) (defconst vcmem-xor-mode 0) (defconst vcmem-ior-mode 1) (defconst vcmem-and-mode 2) (defconst vcmem-move-mode 3) (defun tv-set-mode (mode) (write-tv-config (dpb mode tv-config-mode-bits (read-tv-config)))) (defun tv-set-xor-mode () (write-tv-config (dpb vcmem-xor-mode tv-config-mode-bits (read-tv-config)))) (defun tv-set-ior-mode () (write-tv-config (dpb vcmem-ior-mode tv-config-mode-bits (read-tv-config)))) (defun tv-set-and-mode () (write-tv-config (dpb vcmem-and-mode tv-config-mode-bits (read-tv-config)))) (defun tv-set-move-mode () (write-tv-config (dpb vcmem-move-mode tv-config-mode-bits (read-tv-config)))) ;;; Memory control stuff (defconst tv-refresh-per-line-bits 0002) (defconst tv-refresh-1-per-line 0) (defconst tv-refresh-2-per-line 1) (defconst tv-refresh-3-per-line 2) (defconst tv-refresh-4-per-line 3) (defconst tv-mem-bank-bit 0201) (defconst tv-copy-a-to-b-bit 0301) (defconst tv-reverse-video-bit 0401) (defconst tv-interrupt-enable-bit 0501) (defconst tv-bus-selector-bit 0601) (defun read-tv-mem-control (&optional (slot (send *proc* :tv-slot))) (logand 177777 (send *proc* :bus-slot-read slot tv-mem-control-reg nil 177777))) (defun write-tv-mem-control (data &optional (slot (send *proc* :tv-slot))) (send *proc* :bus-slot-write slot tv-mem-control-reg data)) (defun tv-enable-copy-a-to-b () (write-tv-mem-control (dpb 1 tv-copy-a-to-b-bit (read-tv-mem-control)))) (defun tv-black-on-white () (write-tv-mem-control (dpb 1 tv-reverse-video-bit (read-tv-mem-control)))) (defun tv-white-on-black () (write-tv-mem-control (dpb 0 tv-reverse-video-bit (read-tv-mem-control)))) (defun tv-enable-interrupts (&optional (slot (send *proc* :tv-slot))) (write-tv-mem-control (dpb 1 tv-interrupt-enable-bit (read-tv-mem-control slot)) slot)) (defun tv-disable-interrupts (&optional (slot (send *proc* :tv-slot))) (write-tv-mem-control (dpb 0 tv-interrupt-enable-bit (read-tv-mem-control slot)) slot)) ;;; Scan line table (defconst tv-scan-line-table-begin (ash #16r6000 -2) "beginning of scan line table in words") (defconst tv-scan-line-table-length (ash #16r1000 -2)) (defconst do-it-to-myself nil) (defun read-tv-scan-line-table (adr) (if do-it-to-myself (%nubus-read (dpb 0004 (send *proc* :tv-slot) #xf0) (* 4 (+ adr tv-scan-line-table-begin))) (send *proc* :bus-slot-read (send *proc* :tv-slot) (+ adr tv-scan-line-table-begin)))) (defun write-tv-scan-line-table (adr data) (if do-it-to-myself (%nubus-write (dpb 0004 (send *proc* :tv-slot) #xf0) (* 4 (+ adr tv-scan-line-table-begin)) data) (send *proc* :bus-slot-write (send *proc* :tv-slot) (+ adr tv-scan-line-table-begin) data))) (defun tv-set-all-scan-lines-to-zero () (dotimes (adr tv-scan-line-table-length) (write-tv-scan-line-table adr 0))) (defun tv-set-all-scan-lines (pointer) (dotimes (adr tv-scan-line-table-length) (write-tv-scan-line-table adr pointer))) ;;; Bit map stuff (defconst tv-bit-map-begin (ash #16r20000 -2) "beginning of bit map in words") (defconst tv-bit-map-length (ash #16r20000 -2) "length of bit map in words") (defun read-tv-bit-map (adr) (send *proc* :bus-slot-read (send *proc* :tv-slot) (+ adr tv-bit-map-begin))) (defun write-tv-bit-map (adr data) (send *proc* :bus-slot-write (send *proc* :tv-slot) (+ adr tv-bit-map-begin) data)) (defun tv-clear-bit-map () (tv-set-move-mode) (do ((adr (1- 70000) (1- adr))) ((or (< adr 0) (send terminal-io ':tyi-no-hang)) ()) (write-tv-bit-map adr 0))) (defun fast-tv-clear-bit-map (&aux (bit-map-adr 1) (bit-map-end 2) (four 3)) "this doesn't work yet" (assure-noop-cleared-and-no-carryover) (write-m-mem bit-map-adr (logior #16rf0000000 (dpb (send *proc* :tv-slot) 3004 0) (ash tv-bit-map-begin 2))) (write-m-mem bit-map-end (logior #16rf0000000 (dpb (send *proc* :tv-slot) 3004 0) (ash (+ tv-bit-map-begin tv-bit-map-length) 2))) (write-m-mem four 4) (uload (bit-map-adr bit-map-end four) 0 ; ((md) (a-constant 17400000)) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-seta lam-ir-func-dest lam-func-dest-md lam-ir-slow-dest 1) ; ((md) setz) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setz lam-ir-func-dest lam-func-dest-md lam-ir-slow-dest 1) again ; ((vma-start-write) bit-map-adr) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-setm lam-ir-m-src bit-map-adr lam-ir-func-dest lam-func-dest-vma-start-write lam-ir-slow-dest 1) ; (jump-less-than-xct-next bit-map-adr bit-map-end again) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-m<=a lam-ir-m-src bit-map-adr lam-ir-a-src bit-map-end lam-ir-jump-addr again) ;((bit-map-adr) add bit-map-adr (a-constant 4)) (lam-ir-op lam-op-alu lam-ir-ob lam-ob-alu lam-ir-aluf lam-alu-add lam-ir-m-src bit-map-adr lam-ir-a-src four lam-ir-m-mem-dest bit-map-adr) done ; (jump done halt-lambda) (lam-ir-op lam-op-jump lam-ir-jump-cond lam-jump-cond-unc lam-ir-jump-addr done lam-ir-halt 1)) (setup-machine-to-start-at 0) ; (enable-lambda) ; (process-sleep 2) ; (disable-lambda) ; (assure-noop-cleared-and-no-carryover) ) (defconst tv-words-per-line 31) (defconst tv-cadr-mode t "if t make the vcmem look like a cadr, at the expense of having garbage on the right.") (defun tv-set-cadr-mode () (setq tv-cadr-mode t) (setq tv-words-per-line 30) (tv-load-scan-line-table)) (defun tv-set-vcmem-mode () (setq tv-cadr-mode nil) (setq tv-words-per-line 31) (tv-load-scan-line-table)) (defun tv-set-words-per-line (n) (setq tv-cadr-mode nil) (setq tv-words-per-line n) (tv-load-scan-line-table)) (defun tv-set-unix-mode () (setq tv-cadr-mode nil) (setq tv-words-per-line 40) (tv-load-scan-line-table)) (defun tv-load-scan-line-table () (do ((line-number 0 (1+ line-number)) (bit-map-pointer 0 (+ bit-map-pointer (* 2 tv-words-per-line)))) ((>= line-number tv-scan-line-table-length) ()) (write-tv-scan-line-table line-number bit-map-pointer))) (defun tv-plot-point (x y &optional (mode vcmem-xor-mode)) (tv-set-mode mode) (let ((adr (+ (* y tv-words-per-line) (// x 32.))) (data (ash 1 (logand x 37)))) (send *proc* :bus-slot-write (send *proc* :tv-slot) (+ adr tv-bit-map-begin) data))) (defun tv-draw-test-line () (dotimes (x 100) (tv-plot-point x x))) (defun tv-draw-vertical-line (x) (tv-set-xor-mode) (dotimes (i 300) (tv-plot-point x i))) (defun tv-draw-horizontal-line (y) (tv-set-xor-mode) (do ((i 500 (1+ i))) ((> i 1000) ()) (tv-plot-point i y))) ;;; video lookup table (defun read-tv-video-lookup-table (adr) (logand 7777 (send *proc* :bus-slot-read (send *proc* :tv-slot) (+ adr #16r2000)))) (defun write-tv-video-lookup-table (adr data) (send *proc* :bus-slot-write (send *proc* :tv-slot) (+ adr #16r2000) data)) (defun putchar (c &optional (font fonts:cptfont)) (format t "~%") (do ((y 0 (1+ y))) ((>= y (font-char-height font)) ()) (do ((x 0 (1+ x))) ((>= x (font-char-width font)) ()) (if (zerop (aref font (+ (* c (font-char-height font) (font-char-width font)) (* y (font-char-width font)) x))) (format t ".") (format t "X"))) (format t "~%"))) ;;; vcmem serial stuff (defun tv-read-status () (logand 177777 (send *proc* :bus-slot-read (send *proc* :tv-slot) tv-status-reg))) (defun tv-write-status (data) (send *proc* :bus-slot-write (send *proc* :tv-slot) tv-status-reg data)) (defconst tv-serial-parity-error 1001) (defconst tv-serial-framing-error 1101) (defconst tv-serial-overrun-error 1201) (defconst tv-serial-thre 1301) (defconst tv-serial-tre 1401) (defconst tv-serial-fifo-empty 1501) (defconst tv-serial-fifo-full 1601) (defconst tv-serial-baud 0004) (defconst tv-serial-stop-bit 0401) (defconst tv-serial-parity-sense 0501) (defconst tv-serial-word-length 0602) (defconst tv-serial-parity-enable 1001) (defconst tv-baud-alist '((0 . 50.) (1 . 75.) (2 . 110.) (3 . 134.) (4 . 150.) (5 . 300.) (6 . 600.) (7 . 1200.) (10 . 1800.) (11 . 2000.) (12 . 2400.) (13 . 3600.) (14 . 4800.) (15 . 7200.) (16 . 9600.) (17 . 19200.))) (defconst tv-word-length-alist '((0 . 5) (1 . 6) (2 . 7) (3 . 8))) (defun tv-print-status-of-serial-port (string port-status-0 port-status-1) (setq port-status-0 (logand port-status-0 377) port-status-1 (logand port-status-1 377)) (format t "~&~A: status 0: ~O, status 1: ~O" string port-status-0 port-status-1)) (defun tv-print-serial-status () (tv-read-and-print-serial-port-status 14 "port A") (tv-read-and-print-serial-port-status 16 "port B")) (defun tv-read-and-print-serial-port-status (port-base string) (send *proc* :bus-slot-write (send *proc* :tv-slot) (+ port-base 1) 0) (let ((r0 (send *proc* :bus-slot-read (send *proc* :tv-slot) (+ port-base 1)))) (send *proc* :bus-slot-write (send *proc* :tv-slot) (+ port-base 1) 1) (tv-print-status-of-serial-port string r0 (send *proc* :bus-slot-read (send *proc* :tv-slot) (+ port-base 1))))) ; some of the bits are write only, so this or-ing in will have to go ;(defun tv-set-baud-rate (baud) ; (let ((code (rassoc baud tv-baud-alist))) ; (if (null code) ; (format t "~&Bad baud rate~&") ; (tv-write-port-control (dpb (car code) tv-serial-baud (tv-read-port-control)))))) ;(defun tv-set-word-length (&optional (length 8.)) ; (let ((code (rassoc length tv-word-length-alist))) ; (if (null code) ; (format t "~&bad word length alist~&") ; (tv-write-port-control (dpb (car code) tv-serial-word-length (tv-read-port-control)))))) (defconst vcmem-type ':new-mouse) (defun tv-read-serial-data () (selectq vcmem-type (:new-kbd nil) (:new-mouse (logand 377 (send *proc* :bus-slot-read (send *proc* :tv-slot) 16))))) (defun tv-print-chars () (do () ((send terminal-io :tyi-no-hang)) (format t "~O " (tv-get-char)))) (defun tv-read-loop () (do () ((send terminal-io :tyi-no-hang)) (format t "~O " (tv-read-serial-data)))) ;(defun tv-disable-parity () ; (tv-write-port-control (dpb 1 tv-serial-parity-enable (tv-read-port-control)))) (defun tv-get-char () (do () ((not (tv-fifo-empty-p)))) (tv-read-serial-data)) (defun tv-fifo-empty-p () (selectq vcmem-type (:new-kbd (not (ldb-test 0001 (send *proc* :bus-slot-read (send *proc* :tv-slot) 15)))) (:new-mouse (not (ldb-test 0001 (send *proc* :bus-slot-read (send *proc* :tv-slot) 17)))))) (defun set-up-vcmem-like-ucode () (send *proc* :bus-slot-write (send *proc* :tv-slot) 2 (logior (if (= (ldb 0404 (send *proc* :tv-slot)) (ldb 0404 (send *proc* :rg-slot))) #xf0000000 #xe0000000) (ash (send *proc* :rg-slot) 24.) (* (+ 400 260) 4))) (send *proc* :bus-slot-write (send *proc* :tv-slot) 1 ;turn on interrupt (logior 40 (send *proc* :bus-slot-read (send *proc* :tv-slot) 1))) (send *proc* :bus-slot-write (send *proc* :tv-slot) 4 #x88) ;baud rates (set-up-serial-port 15) (set-up-serial-port 17)) (defun set-up-serial-port (adr) (mapcar #'(lambda (data) (send *proc* :bus-slot-write (send *proc* :tv-slot) adr data)) '(0 #x18 #x1 #x18 #x3 #xc1 #x4 #x84 #x5 #xea)))