LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031576. :SYSTEM-TYPE :LOGICAL :VERSION 9. :TYPE "LISP" :NAME "WINDOW-INITS" :DIRECTORY ("REL3-SOURCE" "KERNEL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758658468. :AUTHOR "REL3" :LENGTH-IN-BYTES 21609. :LENGTH-IN-BLOCKS 22. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;;; -*- cold-load:t; Mode:Common-Lisp; Package:SI; Base:8. -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;;; This file contains SIB and low-level window system data structure initializations. ;;;;;; Edit History;;;;;;                   Patch;;;   Date    Author  Number   Description;;;---------------------------------------------------------------------------------;;; 02-06-86    ab     --      Derived this file from WINDOW;COLD #204.;;;                            Eliminated #-explorer code.;;;                            Converted to Common Lisp.;;;                            Removed cold to support old-style processor ROMS;;;                              from Setup-Slot-Variables;;; 02-13-86    ab             Changed Startup-Keyboard and Startup-TV-Interrupt;;;                              to test for Cold-Booting in the Cold case;;;                              (instead of just their variables being unbound);;;                              so that *TV-Frame-Interrupt-Descriptor* and;;;                              *Keyboard* don't have to be unbound in the saved band.;;;                              This change helps the Lisp version of Disk-Save.;;; 03-24-86    sdk       Turned all the :element-type (:unsigned-byte 16.) specifiers to;;;       make-array into :type 'art-16b because subtypes don't work this;;;       early in the cold band.;;; 11-11-86    ab             Moved a couple of vars here from LISP-REINITIALIZE.;;;  2/18/87    GRH            Change kbd-initialize-warm and RESET-SIB to use new ;;;       WAIT-REAL-MILLISECONDS function for Exp2 compatibility.(Defmacro Byte-Mask (field)  `(DPB -1 ,field 0))(DefMacro aref-32b (array index)  `(dpb (aref ,array (1+ (* 2 ,index)))#o2020(aref ,array (* 2 ,index))))(DefMacro Aset-32b (value array index)  `(progn 'compile  (setf (aref ,array (1+ (* 2 ,index))) (ldb #o2020 ,value))  (setf (aref ,array (* 2 ,index)) (ldb #o0020 ,value))));; Moved here from Lisp-Reinitialize(DEFVAR TV:TV-SLOT-NUMBER nil "Slot number for tv board")  ; changed 10/23/86, -ab(DEFVAR TV:SIB-SLOT-NUMBER :UNBOUND "Slot number for SIB board")(DEFVAR Processor-Slot-Number :UNBOUND)(DEFVAR Nupi-Slot-Number :UNBOUND);; Patch 1-82, -ab;; Function to zero out unused SIB event locations.;; Patch 1-119, -ab;; Disable SIB event posting before zeroing out these locations;; so that warm boots will work right.  Problem will otherwise;; occur because the event posting address for the Graphics;; controller command acknowledge (at #x+FxF00014) cannot be zero;; for any length of time during warm boot because the SIB bus;; master enable IS active on warm boot (but not at this point;; during cold boot).  So during warm boot an event can be;; generated during the time the posting address is zero; this;; first interrupt never gets cleared, causing all sorts of;; of timing problems.;; System patch 2-54, -ab;; Use symbolic names for offsets.(Defun Clear-SIB-Event-Registers ()  ;; Disable SIB event posting first (important for warm boot)  (%nubus-write tv:Sib-Slot-Number %SIB-Interrupt-Enable 0.)  (Do ((offset (symbol-value (car SIB-Event-Address-Registers)) (+ offset 4.)))      ((> offset (symbol-value (car (last SIB-Event-Address-Registers)))))    (%nubus-write tv::Sib-Slot-Number offset 0)))   (DefVar *Keyboard*)(Defprop *Keyboard* "Keyboard device descriptor" :Documentation)(DefParameter *KBD-Buffer-Size* 128.)(DefVar *Keyboard-Char-Buffer*)(Defprop *Keyboard-Char-Buffer* "Keyboard character buffer" :Documentation)(Defun Initialize-KBD-Char-Buffer ()  (Let ((KBD-Start-Address (%Pointer (Locf (Lisp:aref *Keyboard-Char-Buffer* 0) ))))    (Aset-32b KBD-Start-Address *Keyboard* %KBD-Buffer-Start)    (Aset-32b (+ KBD-Start-Address *KBD-Buffer-Size*) *Keyboard* %KBD-Buffer-End)    (Aset-32b KBD-Start-Address *Keyboard* %KBD-Buffer-Front)    (Aset-32b KBD-Start-Address *Keyboard* %KBD-Buffer-Back))  )   ;; System Patch 1-100, -ab;; Displace array into device-descriptor-area instead of permanent-storage-area.;; System Patch 1-97, -ab;; Use TV:SIB-SLOT-NUMBER to initialize device descriptor (instead of %SysInt-Config-SIB).;; System patch 2-54, -ab;; Use symbolic names for offsets.(Defun Initialize-KBD-Cold ()  (Setq *Keyboard*(Make-Array  (* (Length KBD-Descriptor-Block) 2)  :type art-16b  :displaced-to (allocate-device-descriptor-space         (length KBD-Descriptor-Block))  ))  (Setq *Keyboard-Char-Buffer*(Make-Array  *KBD-Buffer-Size*  :type art-q  :displaced-to   (allocate-device-descriptor-space *KBD-Buffer-Size*)  ))  ;; Initialize keyboard descriptor.  ;; Clear link word.  (Aset-32b 0 *Keyboard* %KBD-Link)  ;; Information word contains device type.  (Aset-32b %KBD-Event-Type *Keyboard* %KBD-Information)  (Aset-32b    (dpb tv:sib-slot-number %%NuBus-F-And-Slot-Bits %SIB-KBD-UART-Mode)    *Keyboard* %KBD-Control-Space-Address)  (Aset-32b 0 *Keyboard* %KBD-Undefined)  (Initialize-KBD-Char-Buffer)  ;; Add keyboard descriptor to interrupt decode structure.  (%Add-Interrupt *Keyboard* %KBD-Event-Level)  );; Rel 2.1 system patch 2-48, -ab; I don't think this is used anymore.  Replaced by real timer below. -GRH 2/18/87(Defvar KBD-Timeout-Count 10000.);; Somewhere around 100 milliseconds.(defun millisecond-time ()  "Return the current millisecond time from the real time clock."  (do* ((slot tv:sib-slot-number)(milli-address #xf80004)(status-address #xf80050)status        milli-value(brake 0 (1+ brake)))       (())    (setq milli-value (%nubus-read-8b slot milli-address))    ; If we are running too fast put on the brakes till we get a good result.    (do ((b brake (1- b))) ((< b 0)))    (setq status (ldb (byte 1 0) (%nubus-read-8b slot status-address)))    (do ((b brake (1- b))) ((< b 0)))    (when (or (zerop status); read was valid      (= brake 100.))   ; give up      (return (+ (* 100. (ldb (byte 4 4) milli-value)) (* 10. (ldb (byte 4 0) milli-value)))))))  (defun wait-real-milliseconds (n)  "Wait N milliseconds.  The real time clock is used instead of the fake microsecond clock which is only accurate to 60ths of a second.  Clock  granularity is 10. milliseconds.  There will also be a couple of milliseconds of overhead associated with this function."  (without-interrupts     (let* ((last-time (millisecond-time))   (this-time)   (time-waited 0))      (do () (())(setq this-time (millisecond-time)      time-waited (+ time-waited     (if (< this-time last-time) (+ (- 1000. last-time) this-time) ; we wrapped (- this-time last-time)))      last-time this-time)(when (>= time-waited n)  (return time-waited))))));; System patch 1-97, -ab;; Use PROCESSOR-SLOT-NUMBER variable instead of %SysInt-Config-Processor;; System patch 2-54, -ab;; Use symbolic names for offsets.;; Rel 2.1 system patch 2-48, -ab;; Fix this so correct keyboard microprocessor reset is done (important for warm boot).;; This allows us to take the corresponding initialization out of microcode.;; Use the real time functions above, for Exp 2 compatibility. GRH 2/18/87(Defun Initialize-KBD-Warm () ;; (&aux (count 0))  (Let ((slot TV:SIB-SLOT-NUMBER))    ;; Reset the character buffer.    (Initialize-KBD-Char-Buffer)    ;;    ;; Set up event posting address for Keyboard Events.    (Let* ((Processor-Slot-Address     (DPB PROCESSOR-SLOT-NUMBER %%NuBus-F-And-Slot-Bits 0))   (Event-Address (+ Processor-Slot-Address SI:%SLOT-POWER-FAIL-EVENT     (* SI:%KBD-Event-Level 4.))))      (%NuBus-Write slot %SIB-KBD-Event-Address Event-Address))    ;;    ;; Now, enable SIB interrups briefly.  When we're done with the    ;; USART/keyboard initializations, the keyboard sends a 2-character    ;; sequence to acknowledge.  We want the Ucode interrupt routine to    ;; handle these, hence interrupts must be on here.    ;;  It's ok to turn on interrupts here because the vertical retrace    ;; event address has already been setup by Startup-TV-Interrupt.    (%nubus-write tv:Sib-Slot-Number %SIB-Interrupt-Enable  (byte-mask %%SIB-Interrupt-Enable))    ;;    ;; This is worst-case power-up initialization for the USART.    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode #x+0)    ;; need to wait 3.2 MICROseconds when writing to the USART    ;; this really waits 10 MILLIseconds.    (wait-real-milliseconds 1.)     (%NuBus-Write-8b slot %SIB-KBD-UART-Mode #x+0)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode #x+0)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode %KBD-Usart-Reset);#x40    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode %KBD-Usart-Mode);#x7F    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode %KBD-Usart-Command) ;#x14    (wait-real-milliseconds 1.)    ;;     ;;  After transmitting .. special escape sequence [warmboot c-m-c-m-whatever],    ;;  the keyboard microcomputer [on the keyboard!!!] ignores keyboard entries     ;;  except for special chords. ... The keyboard microcomputer resumes normal    ;;  acceptance of keyboard entries after it receives a reset command as part    ;;  of self-test procedures or a system reset.  Since a full reset is only    ;;  done on cold boot, the following keyboard soft reset is required for warm    ;;  boot (and won't hurt on cold boots).    ;;    ;; Wait for TXRDY (transmit ready);    (setq count 0);    (loop;      (if (ldb-test (byte 1. 0.) (%nubus-read-8b slot %SIB-KBD-UART-Mode));  (return);  (if (= KBD-Timeout-Count (incf count));      (return))));; Just return on timeout, and hope!    (wait-real-milliseconds 100.)    ;;    ;; Enable Transmit interrupts for response (note that this keeps receive enable on).    (%nubus-write-8b slot %SIB-KBD-UART-Mode #x+5)    ;;    ;; Send Reset Command to keyboard microcomputer.  This will cause the keyboard    ;; to send a 2-char response (00, x+70) which will be intercepted by the Ucode    ;; interrupt handler and placed in *Keyboard-Char-Buffer*.    (%nubus-write-8b slot %SIB-KBD-UART-Data #x+7)    ;;     ;; Now we must wait at LEAST 10 milliseconds for the keyboard reset to take.    ;; Then re-initialize the USART so it is in a state where it can send the 2-char    ;; response back.  The loop below should be 10 times that long.    (wait-real-milliseconds 100.);    (setq count 0);    (loop;      (when (= (incf count) KBD-Timeout-Count) (return)))    ;;    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode #x+0)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode #x+0)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode #x+0)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode %KBD-Usart-Reset)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode %KBD-Usart-Mode)    (wait-real-milliseconds 1.)    (%NuBus-Write-8b slot %SIB-KBD-UART-Mode %KBD-Usart-Command)    (wait-real-milliseconds 1.)    ;;    ;; Get the response characters out of the keyboard buffer as soon as the Ucode    ;; gets them so that they will not be fed into someone else's IO stream later.;    (setq count 0);    (loop;      (if (kbd-get-hardware-char);  (return);  (if (= KBD-Timeout-Count (incf count));      (return))));; Just return on timeout.    (wait-real-milliseconds 100.)    (kbd-get-hardware-char);    (setq count 0);    (loop;      (if (kbd-get-hardware-char);  (return);  (if (= KBD-Timeout-Count (incf count));      (return))));; Just return on timeout.    (wait-real-milliseconds 100.)    (kbd-get-hardware-char)    ;;    ;; Disable SIB events again.  They will be turned on for good later.    (%nubus-write slot %SIB-Interrupt-Enable 0)    ;;    ;; Finally, reset the keyboard buffer again so that it looks empty.    (Initialize-KBD-Char-Buffer)    ));; Added COLD-BOOTING test so *Keyboard* doesn't have to be;; unbound in saved band.  -ab(Defun Startup-Keyboard ()  (If (or Cold-Booting (Not (Boundp '*KEYBOARD*)))      (Initialize-KBD-COLD))  (Initialize-KBD-Warm));;; this actually shuts down all of the SIB interrupts;; System patch 2-54, -ab;; Use symbolic names for offsets.(Defun shutdown-KBD ()  (%NuBus-Write TV:SIB-SLOT-NUMBER %SIB-Interrupt-Enable 0)  (makunbound '*keyboard*))(Defun Kbd-Hardware-Char-Available ()  "Returns T if a character is available in the microcode interrupt buffer"  (%IO %KBD-IO-Char-Available *Keyboard*))(Defun Kbd-Get-Hardware-Char ()  "Returns the next character in the microcode interrupt buffer, and NIL if there is none"  (%IO %KBD-Get-Char *Keyboard*));;; TV frame interrupt initialization(DefVar *TV-Frame-Interrupt-Descriptor*);; System Patch 1-100, -ab;; Displace array into device-descriptor-area instead of permanent-storage-area.(Defun Cold-Initialize-TV-Interrupt ()  (Setq *TV-Frame-Interrupt-Descriptor*(Make-Array (* 2. 2.)       ;(length %IO-Descriptor-Words)    :type art-16b    :Displaced-To (allocate-device-descriptor-space 2)                     ))  (Aset-32b 0    *TV-Frame-Interrupt-Descriptor*    SI:%IO-Device-Block-Link)            ;Init Link Word     (Aset-32b SI:%TV-Frame-Event-Type                *TV-Frame-Interrupt-Descriptor*;Init info word    SI:%IO-Device-Descriptor-Word)       (%Add-Interrupt *TV-Frame-Interrupt-Descriptor* SI:%TV-Frame-Event-Level));; System Patch 1-97, -ab;; Use PROCESSOR-SLOT-NUMBER variable instead of %SysInt-Config-Processor;; System patch 2-54, -ab;; Use symbolic names for offsets.(Defun Warm-Initialize-TV-Interrupt ()  (Let* ((Processor-Slot-Address    (DPB PROCESSOR-SLOT-NUMBER %%NuBus-F-And-Slot-Bits 0))         (Event-Address (+ Processor-Slot-Address SI:%SLOT-POWER-FAIL-EVENT                           (* SI:%TV-Frame-Event-Level 4.))))    ;; Setup the event address    (%NuBus-Write TV:TV-SLOT-NUMBER %SIB-TV-Event-Address Event-Address)    ;; Enable the TV hardware to interrupt (enable retrace interrupt)    (%NuBus-Write TV:TV-SLOT-NUMBER %SIB-TV-Interrupt-Enable                   (Byte-Mask %%SIB-TV-Frame-Interrupt-Enable))    ));; Added COLD-BOOTING test so *TV-Frame...* doesn't have to be;; unbound in saved band.  -ab(Defun Startup-TV-Interrupt ()  (if (or Cold-Booting (Not (Boundp '*TV-Frame-Interrupt-Descriptor*)))      (Cold-Initialize-TV-Interrupt))  (Warm-Initialize-TV-Interrupt));; System patch 2-54, -ab;; Use symbolic names for offsets.(Defun Shutdown-TV-Interrupt ()  (%NuBus-Write TV:TV-Slot-Number %SIB-TV-Interrupt-Enable 0)  (makunbound '*TV-Frame-Interrupt-Descriptor*));; System patch 1-82, -ab;; Enable powerfail event by pointing SIB event detection register to;; processor i/o space.;; System patch 1-97, -ab;; Use TV::SIB-SLOT-NUMBER instead of hardcoded #xF5.;; System patch 1-119, -ab;; Use Processor-Slot number instead of hardcoded #xF6xxxxxx.;; System patch 2-54, -ab;; Use symbolic names for offsets.;; System patch Rel 2, 3-11, -ab;; Fix powerfail interrupt posting address to be FsE00000(Defun Enable-SIB-Interrupts ()  ;; Enable warm boot event  (%Nubus-Write TV:SIB-SLOT-NUMBER %SIB-Warmboot-Event-Address (dpb Processor-Slot-Number     %%NuBus-F-And-Slot-Bits      %Slot-Event-Receivers-Base))  ;; Enable powerfail event  (%Nubus-Write TV:SIB-SLOT-NUMBER %SIB-Powerfail-Event-Address-1(dpb Processor-Slot-Number     %%NuBus-F-And-Slot-Bits      %Slot-Power-Fail-Event))  ;; Enable SIB interrupts  (%NuBus-Write TV:SIB-SLOT-NUMBER %SIB-Interrupt-Enable(Byte-Mask %%SIB-Interrupt-Enable))  );;; This is used to run simple hardware initializations;;; Initializations on this list get done for a cold or warm boot before any;;; other initializations get run;;; Anything on this list must be able to be evaled in a very primitive cold;;; load environment(Defparameter Cold-Hardware-Initializations  '((Setup-Slot-Variables)              ;System patch 1-97, -ab    (Clear-SIB-Event-Registers);System patch 1-82, -ab    (Reset-SIB)                         ;Rel 2.1 system patch 2-48, -ab    (Startup-TV-Interrupt)    (Startup-Keyboard);;;    (Initialize-Sound)    (Initialize-SIB-Event-Posting);System patch 1-99, -ab    (Enable-SIB-Interrupts)    ));; Rel 2.1, system patch 2-48, -ab;; This performs the required SIB cold initialization sequence.;; Use the real time functions above, for Exp 2 compatibility. GRH 2/18/87(Defun Reset-SIB ()  ;; Only do full reset on Cold Boot.  (when Cold-Booting    (let ((slot tv:SIB-Slot-Number))      ;; Reset CRT controller by writing byte of zeros to reset register.      (%nubus-write-8b slot %SIB-CRT-Controller-Reset-Register 0);; #x+E00058            ;; Initialize interval timer.      ;;   Reset interval counter 0      (%nubus-write-8b slot %SIB-Interval-Counter-Control #x+30);; #x+F9000C      ;;   Reset interval counter 2      (%nubus-write-8b slot %SIB-Interval-Counter-Control #x+B0)      ;;   Start counter for short interval timer      (%nubus-write-8b slot %SIB-Short-Interval-Timer-Count 0);; #x+F90000      (%nubus-write-8b slot %SIB-Short-Interval-Timer-Count 0)      (%nubus-write-8b slot %SIB-Interval-Counter-Control 0)            ;;   RTC interrupt disable      (%nubus-write-8b slot %SIB-RTC-Interrupt-Control 0);; #x+F80044      ;;  Wait 100 units. (units = ?) before reading the interrupt status.      (do ((x 100. (1- x))) ((< x 0)))      ;;   Reset any pending interrupts on RTC (by reading it)      (%nubus-read-8b  slot %SIB-RTC-Interrupt-Status);; #x+F80040            ;; Reset SIB      (%nubus-write-8b slot %SIB-Reset (byte-mask %%SIB-Reset)) ;; #x+F00040            ;; Send CRT initialization sequence      (do* ((adr %SIB-CRT-Controller-Register-Base (+ adr 4))    (val-lst SIB-CRT-Init-Sequence-List (cdr val-lst))    (value (car val-lst) (car val-lst)))  ((>= adr %SIB-CRT-Controller-Reset-Register))(%nubus-write-8b slot adr value))      ;; After initializing CRT controller (by loading 23 registers)      ;; we must delay (at least 600 microseconds) to ensure that the data      ;; link is up      (wait-real-milliseconds 10.) ; mimimum wait available    )));;; System Patch 1-97, -ab;;; Setup the slot variables from the boot parameters left in high a-memory.;;; Boot parameters of interest are:;;;   a-boot-monitor  (x3FB) ;;;   a-boot-keyboard (x3FC);;;   a-boot-device   (x3FD);;; For now we assume that the SIB, monitor & keyboard are all on the same board;;; Eventually should have si:keyboard-slot-number, si:network-slot-number.;;; System patch 1-97, -ab;;; New function to set up slot variables in chassis-independent manner.;;; Put this function on hardware inits.  Replaces some lisp-reinitialize code.;;; System patch 2-55, -ab;;; Use symbolic names for a-memory boot parameter locations etc.;;; 2-6-86.  Remove code to support old-style processor ROMs.  -ab(Defun Setup-Slot-Variables ()  ;; Modified to get value from constant a-memory register for Explorer, -ab  (setq  TV:TV-SLOT-NUMBER (dpb #x+F (byte 4. 4.)  (%p-ldb %%NuBus-Slot-Bits  (+ sys:a-memory-virtual-address %A-Boot-KBD-Device-Address))))  ;;;The following code makes TV:SIB-SLOT-NUMBER an "alias" of TV:TV-SLOT-NUMBER.  (forward-value-cell 'TV:SIB-SLOT-NUMBER 'TV:TV-SLOT-NUMBER)  ;; Get Processor slot number from SCA where microcode stored it during boot. -ab  (setq PROCESSOR-SLOT-NUMBER (system-communication-area %SYS-COM-PROCESSOR-SLOT))  (setq NUPI-SLOT-NUMBER(dpb #x+F (byte 4. 4.)     (%p-ldb %%NuBus-Slot-Bits     (+ sys:a-memory-virtual-address %A-Boot-MCR-Device-Address))))  ) ;;; System patch 1-99;;; Initializes SIB to post overtemperature and fiber optic disconnect;;; events to reserved SCA locations.  9-12-85, -ab;; System patch 2-54, -ab;; Fix incorrect event address for fiber optic warning.  Use;; symbolic names for offsets.(Defun Initialize-SIB-Event-Posting ()  ;; Overtemp Event.  ;; Set posting location to zero.  (setf (system-communication-area %SYS-COM-OVERTEMP-EVENT) 0)  ;; Place NuBus addres of posting location in SIB event register.  (%nubus-write TV:SIB-SLOT-NUMBER %SIB-Overtemp-Warn-Event-Address (%physical-address    (locf (system-communication-area %SYS-COM-OVERTEMP-EVENT))))  ;; Fiber Optic Disconnect Event.  ;; Set fiber optic warning event location to zero.  (setf (system-communication-area %SYS-COM-FIBER-OPTIC-WARNING-EVENT) 0)  ;; Modify Video Attribute register to enable Fiber Optic interrupt.  (%nubus-write-8b TV:SIB-SLOT-NUMBER %SIB-TV-Video-Attribute (dpb 1 %%SIB-Fiber-Optic-Warning-Enable     (%nubus-read-8b TV:SIB-SLOT-NUMBER %SIB-TV-Video-Attribute)))  ;; Place NuBus address of posting location in SIB event register.  (%nubus-write TV:SIB-SLOT-NUMBER %SIB-Fiber-Optic-Link-Warning-Address(%physical-address   (locf (system-communication-area %SYS-COM-FIBER-OPTIC-WARNING-EVENT))))  )efprop simple-array array-validator type-validator)(eval-when (compile)(defmacro validate-range ( args predicate)  `(or (null ,args)      (and (<= (length ,args) 2)   (dolist (i ,args t)     (when (consp i) (setf i (first i)))     (unless (or (eq i '*)       (,predicate i))       (return nil)))))));eval-when(defun (:property complex type-validator) (&rest type)  (values (subtypep type 'real)))(defun (:property integer type-validator) (&rest args)  (validate-range args integerp))(defun (:property float type-validator) (&rest args)  (validate-range args floatp))  (defun (:property double-float type-validator) (&rest args)  (validate-range args double-floatp))(defun (:property long-float type-validator) (&rest args)  (validate-range args double-floatp))  ;;  long-floatp -- DRH(defun (:property short-float type-validator) (&rest args)  (validate-range args small-floatp))    ;