;;; -*- Mode:Common-Lisp; Package:SI; Base:8.; Cold-Load:t; -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(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) 1986- 1989 Texas Instruments Incorporated. All rights reserved.

;;; This file contains macros and inlines for the paging system.

;;;
;;; Edit History
;;;
;;;                   Patch
;;;   Date    Author  Number   Description
;;;------------------------------------------------------------------------------
;;; 06-23-86    ab             Created from pieces of MEMORY-MANAGEMENT;PAGE
;;;                              and DISK-SAVE-INTERNAL.
;;; 08-13-86    ab             Added %Virtual-Page-Number & more DPMT accessors.
;;;                            Changed SUBSTs to INLINEs.
;;; 09-22-86    ab             Updated all PHT & PPD accessors for new physical
;;;                              memory tables.   Added new PHT accessors and
;;;                              paging-parameter accessors.
;;;                            Updated all PPD- & PHT-hacking routines for the new
;;;                              physical memory tables.
;;;                            Updated Physical-Memory-Map-hacking routines for the
;;;                              new format of that A-Memory table.
;;; 12-17-86    ab             Fixed doc strings on PHT accessors.  Made set- routines
;;;                              for PHT fields.  Also made PFN to slot/offset format 
;;;                              converters.  Put %compute-page-hash-lisp here.
;;; 02-23-87    ab             Added accessors for new PHT2 cache-inhibit bit.
;;; 04-02-87    ab             Make sure critical paging symbols are compiled into
;;;                              constants.  Add %page-frame-number.
;;; 01-12-87    ab             Added new WIRED-P predicate for virtual addresses.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Vars
;;;

;;; QCOM stuff that missed SPECIAL declarations.

(PROCLAIM '(SPECIAL disk-block-size disk-block-word-size disk-block-byte-size
		    disk-blocks-per-page Page-Size-In-Bytes Cluster-Size-In-Blocks 
		    1k-byte-in-words 1k-byte 1m-byte 2M-bytes 8M-bytes 32M-bytes
		    1M-byte-in-pages 2M-bytes-in-pages 8M-bytes-in-pages 32M-bytes-in-pages
		    PHT-Rehash-Constant Maximum-2MB-Quantum Maximum-Page-Devices
		    Maximum-PHT-Size Lowest-Valid-PPD-Index Highest-Valid-PPD-Index
		    Lowest-Valid-PPD-Link Highest-Valid-PPD-Link
		    A-Memory-Physical-Memory-Map-Words PHT-Status-Codes-List
		    ))


(EVAL-WHEN (EVAL compile load)
(DEFVAR *paging-constants*
	'(Page-Size Page-Size-In-Bytes
	  Page-Cluster-Size Cluster-Size Cluster-Size-In-Words Cluster-Size-In-Blocks
	  disk-block-size disk-block-word-size disk-block-byte-size disk-blocks-per-page
	  1k-byte-in-words 1k-byte 1m-byte 2M-bytes 8M-bytes 32M-bytes
	  1M-byte-in-pages 2M-bytes-in-pages 8M-bytes-in-pages 32M-bytes-in-pages 
	  A-Memory-Physical-Memory-Map-Words Maximum-Page-Devices
	  Lowest-Valid-PPD-Index Highest-Valid-PPD-Index Lowest-Valid-PPD-Link Highest-Valid-PPD-Link
	  PHT-Rehash-Constant Maximum-2MB-Quantum Maximum-PHT-Size
		      
;; ** WARNING **
;; The following symbols are offsets into the a-memory counter block.  If the order of those
;; counters is changed all files in the virtual memory defsystem must be recompiled.
		      
	  %PHT-Index-Size %PHT-Index-Limit %Physical-Page-Data-Address %Physical-Page-Data-End
	  %Least-Used-Page %Most-recently-referenced-Page %PHT-Search-Depth %Page-Hash-Table-Address
	  ))
  
(DEFVAR *paging-constants-lists*
	'(NuBus-Physical-Address-Fields Cluster-Description-Fields VA-Field-Descriptors
	  Physical-Map-Fields PPD-Descriptors Page-Hash-Table-Fields 
	  ))
  
(DEFUN fix-paging-constants ()
  (DOLIST (var *paging-constants*)
    (SETF (GET var 'compiler:system-constant) t))
  (DOLIST (lst *paging-constants-lists*)
    (DOLIST (var (SYMBOL-VALUE lst))
      (SETF (GET var 'compiler:system-constant) t))))
(fix-paging-constants))

(DEFVAR *io-space-virtual-address* nil)

(DEFUN set-io-space-virtual-address (&aux adr)
  (SETQ adr (%pointer-plus %counter-block-a-mem-address
			   (+ a-memory-virtual-address %io-space-virtual-address)))
  (SETQ *io-space-virtual-address*
	(%logdpb (%p-ldb (BYTE (- (BYTE-SIZE %%Q-pointer) (BYTE-SIZE %%Q-low-half))
			       (BYTE-POSITION %%Q-high-half))
			 adr)
		 (BYTE (- (BYTE-SIZE %%Q-pointer) (BYTE-SIZE %%Q-low-half))
		       (BYTE-POSITION %%Q-high-half))
		 (%p-ldb %%Q-low-half adr))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; DPMT (Disk-Page-Mapping-Table) accessors


(DEFMACRO Get-DPMT-Bitmap (cluster-number dpmt)
  `(AREF ,dpmt (* 4 ,cluster-number)))

(DEFMACRO Get-DPMT-Device-Status (cluster-number dpmt)
  `(AREF ,dpmt (1+ (* 4 ,cluster-number))))

(DEFMACRO Get-DPMT-Device-A-Status (cluster-number dpmt)
  `(LET ((dev-status (get-dpmt-device-status ,cluster-number ,dpmt)))
     (LDB (BYTE (BYTE-SIZE %%DPMTE-Device-A-Status)
		(- (BYTE-POSITION %%DPMTE-Device-A-Status)
		   (BYTE-POSITION %%Q-HIGH-HALF)))
	  dev-status)))

(DEFMACRO Get-DPMT-Device-B-Status (cluster-number dpmt)
  `(LET ((dev-status (get-dpmt-device-status ,cluster-number ,dpmt)))
     (LDB (BYTE (BYTE-SIZE %%DPMTE-Device-B-Status)
		(- (BYTE-POSITION %%DPMTE-Device-B-Status)
		   (BYTE-POSITION %%Q-HIGH-HALF)))
	  dev-status)))

(DEFMACRO Get-DPMT-Device-A (cluster-number dpmt)
  `(LET ((dev-a (get-dpmt-device-status ,cluster-number ,dpmt)))
     (LDB (BYTE (BYTE-SIZE %%DPMTE-Device-A-LPDIB-Index)
		(- (BYTE-POSITION %%DPMTE-Device-A-LPDIB-Index)
		   (BYTE-POSITION %%Q-HIGH-HALF)))
	  dev-a)))

(DEFMACRO Get-DPMT-Device-B (cluster-number dpmt)
  `(LET ((dev-b (get-dpmt-device-status ,cluster-number ,dpmt)))
     (LDB (BYTE (BYTE-SIZE %%DPMTE-Device-B-LPDIB-Index)
		(- (BYTE-POSITION %%DPMTE-Device-B-LPDIB-Index)
		   (BYTE-POSITION %%Q-HIGH-HALF)))
	  dev-b)))

(DEFMACRO Get-DPMT-Device-B-Offset (cluster-number dpmt)
  `(AREF ,dpmt (+ 2 (* 4 ,cluster-number))))

(DEFMACRO Get-DPMT-Device-A-Offset (cluster-number dpmt)
  `(AREF ,dpmt (+ 3 (* 4 ,cluster-number))))
		

(DEFMACRO Set-DPMT-Bitmap (cluster-number value dpmt)
  `(SETF (AREF ,dpmt (* 4 ,cluster-number)) ,value))

(DEFMACRO Set-DPMT-Device-Status (cluster-number value dpmt)
  `(SETF (AREF ,dpmt (1+ (* 4 ,cluster-number))) ,value))

(DEFMACRO Set-DPMT-Device-A-Status (cluster-number value dpmt)
  `(LET ((dev-status (get-dpmt-device-status ,cluster-number ,dpmt)))
     (SETF (AREF ,dpmt (1+ (* 4 ,cluster-number)))
	   (DPB ,value
		(BYTE (BYTE-SIZE %%DPMTE-Device-A-Status)
		      (- (BYTE-POSITION %%DPMTE-Device-A-Status)
			 (BYTE-POSITION %%Q-HIGH-HALF)))
		dev-status))))

(DEFMACRO Set-DPMT-Device-B-Status (cluster-number value dpmt)
  `(LET ((dev-status (get-dpmt-device-status ,cluster-number ,dpmt)))
     (SETF (AREF ,dpmt (1+ (* 4 ,cluster-number)))
	   (DPB ,value
		(BYTE (BYTE-SIZE %%DPMTE-Device-B-Status)
		      (- (BYTE-POSITION %%DPMTE-Device-B-Status)
			 (BYTE-POSITION %%Q-HIGH-HALF)))
		dev-status))))

(DEFMACRO Set-DPMT-Device-A (cluster-number value dpmt)
  `(LET ((dev-a (get-dpmt-device-status ,cluster-number ,dpmt)))
     (SETF (AREF ,dpmt (1+ (* 4 ,cluster-number)))
	   (DPB ,value
		(BYTE (BYTE-SIZE %%DPMTE-Device-A-LPDIB-Index)
		      (- (BYTE-POSITION %%DPMTE-Device-A-LPDIB-Index)
			 (BYTE-POSITION %%Q-HIGH-HALF)))
		dev-a))))

(DEFMACRO Set-DPMT-Device-B (cluster-number value dpmt)
  `(LET ((dev-b (get-dpmt-device-status ,cluster-number ,dpmt)))
     (SETF (AREF ,dpmt (1+ (* 4 ,cluster-number)))
	   (DPB ,value
		(BYTE (BYTE-SIZE %%DPMTE-Device-B-LPDIB-Index)
		      (- (BYTE-POSITION %%DPMTE-Device-B-LPDIB-Index)
			 (BYTE-POSITION %%Q-HIGH-HALF)))
		dev-b))))

(DEFMACRO Set-DPMT-Device-B-Offset (cluster-number value dpmt)
  `(SETF (AREF ,dpmt (+ 2 (* 4 ,cluster-number))) ,value))

(DEFMACRO Set-DPMT-Device-A-Offset (cluster-number value dpmt)
  `(SETF (AREF ,dpmt (+ 3 (* 4 ,cluster-number))) ,value))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Low-Level Accessors
;;;

;;; All these routines are guaranteed not to take a page fault or cons
;;; if you call them with the &OPTIONAL args supplied.


;;;
;;; Conversion
;;;

(PROCLAIM '(inline physical-page-number))
(DEFUN Physical-Address (physical-page-number)
  "Given 22-bit physical page number, returns 32-bit NuBus address."
  (ASH physical-page-number (BYTE-SIZE %%Physical-Page-Offset)))

(PROCLAIM '(inline physical-page-number))
(DEFUN Physical-Page-Number (physical-address)
  "Given 32-bit NuBus address, returns 22-bit physical page number."
  (ASH physical-address (- (BYTE-SIZE %%Physical-Page-Offset))))


;;;
;;; Paging-Parameter access (counters, etc.)
;;;

(PROCLAIM '(inline get-ppd-address))
(DEFUN get-ppd-address ()
  (LET* ((a-mem-addr (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Physical-Page-Data-Address)))
	 (slot (%P-LDB %%Nubus-F-and-Slot-Bits a-mem-addr))
	 (offset (%P-LDB %%Nubus-All-But-F-and-Slot-Bits a-mem-addr)))
    (VALUES slot offset))
  )

(PROCLAIM '(inline set-ppd-address))
(DEFUN set-ppd-address (slot offset)
  (LET ((a-mem-addr (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Physical-Page-Data-Address))))
    (%P-DPB slot %%Nubus-F-and-Slot-Bits a-mem-addr)
    (%P-DPB offset %%Nubus-All-But-F-and-Slot-Bits a-mem-addr))
  )
    

(PROCLAIM '(inline get-ppd-slot-addr))
(DEFUN get-ppd-slot-addr ()
  (%P-LDB %%Nubus-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Physical-Page-Data-Address))))

(PROCLAIM '(inline set-ppd-slot-addr))
(DEFUN set-ppd-slot-addr (slot)
  (%P-DPB slot
	  %%Nubus-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Physical-Page-Data-Address))))

(DEFSETF get-ppd-slot-addr set-ppd-slot-addr)


(PROCLAIM '(inline get-ppd-slot-offset))
(DEFUN get-ppd-slot-offset ()
  (%P-LDB %%Nubus-All-But-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Physical-Page-Data-Address))))

(PROCLAIM '(inline set-ppd-slot-offset))
(DEFUN set-ppd-slot-offset (offset)
  (%P-DPB offset
	  %%Nubus-All-But-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Physical-Page-Data-Address))))

(DEFSETF get-ppd-slot-offset set-ppd-slot-offset)



(PROCLAIM '(inline get-pht-address))
(DEFUN get-pht-address ()
  (LET* ((a-mem-addr (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Page-Hash-Table-Address)))
	 (slot (%P-LDB %%Nubus-F-and-Slot-Bits a-mem-addr))
	 (offset (%P-LDB %%Nubus-All-But-F-and-Slot-Bits a-mem-addr)))
    (VALUES slot offset))
  )

(PROCLAIM '(inline set-pht-address))
(DEFUN set-pht-address (slot offset)
  (LET ((a-mem-addr (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address  %Page-Hash-Table-Address))))
    (%P-DPB slot %%Nubus-F-and-Slot-Bits a-mem-addr)
    (%P-DPB offset %%Nubus-All-But-F-and-Slot-Bits a-mem-addr))
  )
    

(PROCLAIM '(inline get-pht-slot-addr))
(DEFUN get-pht-slot-addr ()
  (%P-LDB %%Nubus-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Page-Hash-Table-Address))))

(PROCLAIM '(inline set-pht-slot-addr))
(DEFUN set-pht-slot-addr (slot)
  (%P-DPB slot
	  %%Nubus-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Page-Hash-Table-Address))))

(DEFSETF get-pht-slot-addr set-pht-slot-addr)


(PROCLAIM '(inline get-pht-slot-offset))
(DEFUN get-pht-slot-offset ()
  (%P-LDB %%Nubus-All-But-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Page-Hash-Table-Address))))

(PROCLAIM '(inline set-pht-slot-offset))
(DEFUN set-pht-slot-offset (offset)
  (%P-DPB offset
	  %%Nubus-All-But-F-and-Slot-Bits
	  (%MAKE-POINTER-OFFSET
		       dtp-fix %counter-block-a-mem-address
		       (+ #.a-memory-virtual-address %Page-Hash-Table-Address))))

(DEFSETF get-pht-slot-offset set-pht-slot-offset)



(PROCLAIM '(inline get-paging-parameter))
(DEFUN get-paging-parameter (counter-block-offset)
  "Read a paging parameter known to be 24 bits or smaller from the counter block."
  (%P-LDB (BYTE (1- (BYTE-SIZE %%Q-Pointer)) 0)
	  (%MAKE-POINTER-OFFSET
	    dtp-fix #.a-memory-virtual-address
	    (+ %counter-block-a-mem-address counter-block-offset)))
  )

(PROCLAIM '(inline set-paging-parameter))
(DEFUN set-paging-parameter (counter-block-offset value)
  "Write a paging parameter known to be 24 bits or smaller from the counter block."
  (%P-DPB value
	  (BYTE (1- (BYTE-SIZE %%Q-Pointer)) 0)
	  (%MAKE-POINTER-OFFSET
	    dtp-fix #.a-memory-virtual-address 
	    (+ %counter-block-a-mem-address counter-block-offset)))	
  )


;;;;;;;;;;;;;;;;;;;
;;;
;;; PPD accessors
;;;

(PROCLAIM '(inline ppd-index-field))
(DEFUN ppd-index-field (pfn &optional (ppd-slot (get-ppd-slot-addr))
		                      (ppd-offset (get-ppd-slot-offset)))
  "Given a PFN, returns the unshifted ppd index field."
  (%phys-logldb %%PPD-Index-field ppd-slot (+ ppd-offset (LSH pfn 2)))
  )

(PROCLAIM '(inline set-ppd-index-field))
(DEFUN set-ppd-index-field (pfn value
			    &optional (ppd-slot (get-ppd-slot-addr))
			              (ppd-offset (get-ppd-slot-offset)))
  "Given a PFN and a value, sets the PPD index field for that page."
  (%phys-logdpb value %%PPD-Index-field ppd-slot (+ ppd-offset (LSH pfn 2)))
  )

(PROCLAIM '(inline ppd-link))
(DEFUN ppd-link (pfn &optional (ppd-slot (get-ppd-slot-addr))
		               (ppd-offset (get-ppd-slot-offset)))
  "Given a PFN, returns the PPD link field."
  (%phys-logldb %%PPD-Link-Field ppd-slot (+ ppd-offset (LSH pfn 2)))
  )

(PROCLAIM '(inline set-ppd-link))
(DEFUN set-ppd-link (pfn value
		     &optional (ppd-slot (get-ppd-slot-addr))
		               (ppd-offset (get-ppd-slot-offset)))
  "Given a PFN and a value, sets the PPD link field for that page."
  (%phys-logdpb value %%PPD-Link-Field ppd-slot (+ ppd-offset (LSH pfn 2)))
  )


(PROCLAIM '(inline valid-pht-index))
(DEFUN Valid-PHT-Index (ppd-index-field)
  "Given the PPD index field for a page frame, returns a valid PHT index for that page if
the page is not perm wired or free; else returns nil."
  (WHEN (<= Lowest-Valid-PPD-Index ppd-index-field Highest-Valid-PPD-Index)      ;; not free or perm wired
    (LSH ppd-index-field 3)))

(PROCLAIM '(inline valid-ppd-link))
(DEFUN Valid-PPD-Link (ppd-link-field)
  "Returns the PPD-LINK-FIELD if it is valid; else NIL."
  (WHEN (<= Lowest-Valid-PPD-Link ppd-link-field Highest-Valid-PPD-Link)
    ppd-link-field)
  )

(PROCLAIM '(inline page-free-p))
(DEFUN Page-Free-P (pfn &optional (ppd-slot (get-ppd-slot-addr))
		                  (ppd-offset (get-ppd-slot-offset)))
  "T if page frame number PFN is free for use; else NIL."
  (= (%PHYS-LOGLDB %%PPD-Index-Field ppd-slot (+ ppd-offset (LSH pfn 2)))
     %PPD-Free-Page))

(PROCLAIM '(inline page-perm-wired-p))
(DEFUN Page-Perm-Wired-P (pfn &optional (ppd-slot (get-ppd-slot-addr))
				        (ppd-offset (get-ppd-slot-offset)))
  "T if page frame number PFN is permanently wired (not available in the physical memory
pool); else NIL."
  (= (%PHYS-LOGLDB %%PPD-Link-Field ppd-slot (+ ppd-offset (LSH pfn 2)))
     %PPD-Link-Wired-Page))

(PROCLAIM '(inline page-user-wired-p))
(DEFUN Page-User-Wired-P (pfn &optional (ppd-slot (get-ppd-slot-addr))
		                        (ppd-offset (get-ppd-slot-offset))
					(pht-slot (get-pht-slot-addr))
					(pht-offset (get-pht-slot-offset)))
  "T if page frame number PFN is user-wired; else NIL."
  (LET (pht-index)
    (IF (SETQ pht-index (valid-pht-index (%PHYS-LOGLDB %%PPD-Index-Field
						       ppd-slot
						       (+ ppd-offset (LSH pfn 2)))))
	(= (%PHYS-LOGLDB %%PHT1-Swap-Status-Code pht-slot (+ pht-offset pht-index))
	   %PHT-Swap-Status-Wired))
    ))

(PROCLAIM '(inline page-perm-or-user-wired-p))
(DEFUN Page-Perm-Or-User-Wired-P (pfn &optional (ppd-slot (get-ppd-slot-addr))
		                                (ppd-offset (get-ppd-slot-offset))
					        (pht-slot (get-pht-slot-addr))
					        (pht-offset (get-pht-slot-offset)))
  "T if page frame number PFN is permanently wired (a system page) or user wired; else NIL."
  (OR (page-perm-wired-p pfn ppd-slot ppd-offset)
      (page-user-wired-p pfn ppd-slot ppd-offset pht-slot pht-offset))
  )


;;;;;;;;;;;;;;;;;;;;
;;;
;;; PHT Accessors
;;;
   
;; PHT1

(PROCLAIM '(inline pht-vpn))
(DEFUN pht-vpn (byte-index &optional (pht-slot (get-pht-slot-addr))
			             (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns the PHT entry's virtual page number (VPN)."
  (%phys-logldb %%Pht1-Virtual-Page-Number pht-slot (+ pht-offset byte-index))
  )

(PROCLAIM '(inline set-pht-vpn))
(DEFUN set-pht-vpn (byte-index value
		    &optional (pht-slot (get-pht-slot-addr))
			      (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a VALUE, sets the PHT entry's
virtual page number."
  (%phys-logdpb value %%Pht1-Virtual-Page-Number pht-slot (+ pht-offset byte-index))
  )


(PROCLAIM '(inline pht-swap-status))
(DEFUN pht-swap-status (byte-index &optional (pht-slot (get-pht-slot-addr))
				             (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns the PHT entry's swap status."
  (%phys-logldb %%PHT1-Swap-Status-Code pht-slot (+ pht-offset byte-index))
  )

(PROCLAIM '(inline set-pht-swap-status))
(DEFUN set-pht-swap-status (byte-index value
			    &optional (pht-slot (get-pht-slot-addr))
			              (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a VALUE, sets the PHT swap status."
  (%phys-logdpb value %%PHT1-Swap-Status-Code pht-slot (+ pht-offset byte-index))
  )


(PROCLAIM '(inline pht-modified-p))
(DEFUN pht-modified-p (byte-index &optional (pht-slot (get-pht-slot-addr))
				            (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns t if the PHT entry is marked
modified; else nil."
  (= 1 (%phys-logldb %%PHT1-Modified-Bit pht-slot (+ pht-offset byte-index)))
  )

(PROCLAIM '(inline set-pht-modified-p))
(DEFUN set-pht-modified-p (byte-index t-or-nil-value
		           &optional (pht-slot (get-pht-slot-addr))
				     (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a T-OR-NIL-VALUE, sets the PHT
entry modified or unmodified."
  (IF (EQ t-or-nil-value nil)
      (%phys-logdpb 0 %%PHT1-Modified-Bit pht-slot (+ pht-offset byte-index))
      (%phys-logdpb 1 %%PHT1-Modified-Bit pht-slot (+ pht-offset byte-index))))


(PROCLAIM '(inline pht-valid-p))
(DEFUN pht-valid-p (byte-index &optional (pht-slot (get-pht-slot-addr))
		                         (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns t if the PHT entry is valid; else nil."
  (= 1 (%phys-logldb %%PHT1-Valid-Bit pht-slot (+ pht-offset byte-index)))
  )

(PROCLAIM '(inline set-pht-valid-p))
(DEFUN set-pht-valid-p (byte-index t-or-nil-value
		        &optional (pht-slot (get-pht-slot-addr))
                                  (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a T-OR-NIL-VALUE, sets the PHT
entry valid or invalid."
  (IF (EQ t-or-nil-value nil)
      (%phys-logdpb 0 %%PHT1-Valid-Bit pht-slot (+ pht-offset byte-index))
      (%phys-logdpb 1 %%PHT1-Valid-Bit pht-slot (+ pht-offset byte-index))))


(PROCLAIM '(inline pht-bg-write-p))
(DEFUN pht-bg-write-p (byte-index &optional (pht-slot (get-pht-slot-addr))
				            (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns t if the PHT entry is currently
being written in the background; else nil."
  (= 1 (%phys-logldb %%PHT1-Background-Writing-Bit pht-slot (+ pht-offset byte-index)))
  )

(PROCLAIM '(inline set-pht-bg-write-p))
(DEFUN set-pht-bg-write-p (byte-index t-or-nil-value
		           &optional (pht-slot (get-pht-slot-addr))
				     (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a T-OR-NIL-VALUE, sets the PHT
entry background-write bit on or off."
  (IF (EQ t-or-nil-value nil)
      (%phys-logdpb 0 %%PHT1-Background-Writing-Bit pht-slot (+ pht-offset byte-index))
      (%phys-logdpb 1 %%PHT1-Background-Writing-Bit pht-slot (+ pht-offset byte-index))))


;; PHT2

(PROCLAIM '(inline pht-phys-pg))
(DEFUN pht-phys-pg (byte-index &optional (pht-slot (get-pht-slot-addr))
				         (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns the PHT entry's physical page number."
  (%phys-logldb %%PHT2-Physical-Page-Number pht-slot (+ pht-offset byte-index 4))
  )

(PROCLAIM '(inline set-pht-phys-pg))
(DEFUN set-pht-phys-pg (byte-index physical-page
			&optional (pht-slot (get-pht-slot-addr))
			          (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a PHYSICAL-PAGE number, sets the PHT
entry's physical page component."
  (%phys-logdpb physical-page %%PHT2-Physical-Page-Number pht-slot (+ pht-offset byte-index 4))
  )


(PROCLAIM '(inline pht-meta-bits))
(DEFUN pht-meta-bits (byte-index &optional (pht-slot (get-pht-slot-addr))
				           (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns the PHT entry's meta bits."
  (%phys-logldb %%PHT2-Meta-Bits pht-slot (+ pht-offset byte-index 4.))
  )

(PROCLAIM '(inline set-pht-meta-bits))
(DEFUN set-pht-meta-bits (byte-index meta-bits
			  &optional (pht-slot (get-pht-slot-addr))
			            (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and a META-BITS value, sets the 
PHT entry's meta bits."
  (%phys-logdpb meta-bits %%PHT2-Meta-Bits pht-slot (+ pht-offset byte-index 4))
  )


(PROCLAIM '(inline pht-access-bits))
(DEFUN pht-access-bits (byte-index &optional (pht-slot (get-pht-slot-addr))
				             (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns the PHT entry's access bits.
WARNING: this field overlaps with one bit of the status bits."
  (%phys-logldb %%PHT2-Map-Access-Code pht-slot (+ pht-offset byte-index 4.))
  )

(PROCLAIM '(inline set-pht-access-bits))
(DEFUN set-pht-access-bits (byte-index access-bits
			    &optional (pht-slot (get-pht-slot-addr))
			              (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and an ACCESS-BITS value, sets the 
PHT entry's access bits.  WARNING: this field overlaps with one bit of the status
bits."
  (%phys-logdpb access-bits %%PHT2-Map-Access-Code pht-slot (+ pht-offset byte-index 4))
  )


(PROCLAIM '(inline pht-status-bits))
(DEFUN pht-status-bits (byte-index &optional (pht-slot (get-pht-slot-addr))
				             (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns the PHT entry's status bits.
WARNING: this field overlaps with one bit of the access bits."
  (%phys-logldb %%PHT2-Map-Status-Code pht-slot (+ pht-offset byte-index 4.))
  )

(PROCLAIM '(inline set-pht-status-bits))
(DEFUN set-pht-status-bits (byte-index status-bits
			    &optional (pht-slot (get-pht-slot-addr))
			              (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, and an ACCESS-BITS value, sets the 
PHT entry's status bits.  WARNING: this field overlaps with one bit of the access
bits."
  (%phys-logdpb status-bits %%PHT2-Map-Status-Code pht-slot (+ pht-offset byte-index 4))
  )


(PROCLAIM '(inline pht-cache-inhibit-p))
(DEFUN pht-cache-inhibit-p (byte-index &optional (pht-slot (get-pht-slot-addr))
				                 (pht-offset (get-pht-slot-offset)))
  "Given a byte index to a PHT-1 word, returns T if the page has cache-inhibit set;
else returns NIL."
  (= 1 (%phys-logldb %%PHT2-Cache-Inhibit-Bit pht-slot (+ pht-offset byte-index 4.)))
  )

(PROCLAIM '(inline set-pht-cache-inhibit))
(DEFUN set-pht-cache-inhibit (byte-index cache-inhibit-p
			      &optional (pht-slot (get-pht-slot-addr))
			                (pht-offset (get-pht-slot-offset)))
  "Given BYTE-INDEX, the index of a PHT1-word, sets the page's cache-inhibit ON
if CACHE-INHIBIT-P is non-NIL; else sets cache-inhibit OFF."
  (%phys-logdpb (IF cache-inhibit-p 1 0)
		%%PHT2-Cache-Inhibit-Bit pht-slot
		(+ pht-offset byte-index 4))
  )



;;;
;;; Misc
;;;

;;ab 1/12/88 new.
(PROCLAIM '(inline wired-p))
(DEFUN wired-p (va)
  (= (LDB (BYTE 3. 0) (%page-status va))
     %PHT-Swap-Status-Wired))

;; NOTE: PHT valid is not always 100% up to date.  H/W level 2 map modified will be.
(PROCLAIM '(inline phys-page-pht-modified-p))
(DEFUN Phys-Page-PHT-Modified-P (pfn &optional (ppd-slot (get-ppd-slot-addr))
		                               (ppd-offset (get-ppd-slot-offset))
					       (pht-slot (get-pht-slot-addr))
					       (pht-offset (get-pht-slot-offset)))
  "T if page frame number PFN is marked modified in the PHT; else NIL.  Note that
the PHT modified bit is sometimes not set for modified pages (but the level 2 map 
will indicate the correct status in this case), so this function cannot be used to
determine whether a page is REALLY modified with 100% accuracy."
  (LET ((pht-index (valid-pht-index
		     (%PHYS-LOGLDB %%PPD-Index-Field
				   ppd-slot
				   (+ ppd-offset (LSH pfn 2))))))
    (WHEN pht-index
      (SETQ pht-offset (+ pht-offset pht-index))
      (AND (= 1 (%PHYS-LOGLDB %%PHT1-Valid-Bit pht-slot pht-offset))
	   (= 1 (%PHYS-LOGLDB %%PHT1-Modified-Bit pht-slot pht-offset))))
    ))

(PROCLAIM '(inline %virtual-page-number))
(DEFUN %virtual-page-number (pfn &optional (ppd-slot (get-ppd-slot-addr))
			     (ppd-offset (get-ppd-slot-offset))
			     (pht-slot (get-pht-slot-addr))
			     (pht-offset (get-pht-slot-offset)))
  "Given a page frame number PFN, returns the virtual page number currently associated
with this physical page frame, or NIL if none.  Note the value returned is a PAGE NUMBER,
not a full page address, so will always fit in a fixnum."
  (LET ((pht-index (valid-pht-index
		     (%PHYS-LOGLDB %%PPD-Index-Field
				   ppd-slot
				   (+ ppd-offset (LSH pfn 2))))))
    (WHEN pht-index
      (%PHYS-LOGLDB %%PHT1-Virtual-Page-Number pht-slot (+ pht-offset pht-index))))
  )

(DEFUN %page-frame-number (va &optional (pht-slot (get-pht-slot-addr))
			                (pht-offset (get-pht-slot-offset))
					(max-byte-index (get-paging-parameter %pht-index-limit))
					(max-index-size (get-paging-parameter %pht-index-size))
					(max-hash-depth (get-paging-parameter %pht-search-depth))
					(a-mem-phys-map-address
					  (AREF #'system-communication-area %sys-com-physical-memory-map)))
  "Given a virtual address VA, returns the page frame number (PFN) currently associated
with it, or NIL if none."
  (WITHOUT-INTERRUPTS 
    (LOOP FOR hash = (%compute-page-hash-lisp (SETQ va (%pointer va)) max-byte-index max-index-size)
	  THEN (%rehash hash max-byte-index)
	  FOR depth = 0 THEN (1+ depth)
	  WITH vpn = (LDB %%va-page-number va)
	  UNTIL (> depth max-hash-depth) DO
	  (WHEN (AND (= vpn (pht-vpn hash pht-slot pht-offset))
		     (pht-valid-p hash pht-slot pht-offset))
	    (RETURN (convert-physical-page-to-pfn
		      (pht-phys-pg hash pht-slot pht-offset) a-mem-phys-map-address)))
	  FINALLY (RETURN nil)))) 

(PROCLAIM '(inline %compute-page-hash-lisp))
(DEFUN %compute-page-hash-lisp (va &optional (max-byte-index (get-paging-parameter %pht-index-limit))
				             (max-index-size (get-paging-parameter %pht-index-size)))
  "Given a virtual address VA, returns the first page hash (a byte index into the PHT).
This is the same as %compute-page-hash except that this version can compute the hash for
PHT sizes different from that which the microcode is currently using.  This allows it to
compute page hashs for arbitrary hash tables.
  To compute the page hash based on a different PHT size, supply values for the optional
arguments MAX-BYTE-INDEX and MAX-INDEX-SIZE.  The defaults for these arguments is to use 
the current microcode parameters.
  MAX-BYTE-INDEX is the PHT size in bytes.  MAX-INDEX-SIZE is the number of bits needed
to represent MAX-BYTE-INDEX (ie, (INTEGER-LENGTH max-byte-index)).
  Use %REHASH to compute the next hash value, if a collision occurs."
  (LET* ((hash-field-of-va
	   (LDB (BYTE max-index-size (BYTE-POSITION %%Va-Page-Number)) va))
	 ;; Allow for 2 words per entry and 4 bytes per word
	 (byte-index
	   (LSH hash-field-of-va 3.)))
    (IF (>= byte-index max-byte-index)
	(- byte-index max-byte-index)
	byte-index)
  ))

(PROCLAIM '(inline %rehash))
(DEFUN %rehash (old-pht-index &optional (max-index (get-paging-parameter %Pht-Index-Limit)))
  "Given a PHT hash value (which is a PHT byte index) returns the next hash value (rehash).
  If you supply a value for the optional MAX-INDEX argument, it is taken to be the PHT size
in bytes of the PHT you are rehashing.  This defaults to the current PHT size."
  (INCF old-pht-index PHT-Rehash-Constant)
  (IF (>= old-pht-index max-index)
      (- old-pht-index max-index)
      old-pht-index)
  )




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Physical-Memory Misc routines
;;;


(PROCLAIM '(inline pages-of-physical-memory))
(DEFUN Pages-Of-Physical-Memory ()
  "Returns number of pages in physical memory on this machine."
  (MULTIPLE-VALUE-BIND (quo ignore)
      (FLOOR (AREF #'system-communication-area %Sys-Com-Memory-Size) Page-Size)
    quo))

(PROCLAIM '(inline Words-Of-Physical-Memory))
(DEFUN Words-Of-Physical-Memory ()
  "Returns number of words of physical memory on this machine."
  (AREF #'system-communication-area %Sys-Com-Memory-Size))

(PROCLAIM '(inline Bytes-Of-Physical-Memory))
(DEFUN Bytes-Of-Physical-Memory ()
  "Returns number of bytes of physical memory on this machine."
  (* (AREF #'system-communication-area %Sys-Com-Memory-Size) 4.))

(PROCLAIM '(inline Number-Of-System-Wired-Pages))
(DEFUN Number-Of-System-Wired-Pages ()
  "Returns number of virtual pages assigned to the permanently-wired areas."
  (MULTIPLE-VALUE-BIND (quo ignore)
      (FLOOR (AREF #'system-communication-area %Sys-Com-Wired-Size) Page-Size)
    quo))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Nubus address/PFN translators
;;;

;; These next are here because some routines loaded later want to DECLARE these INLINE.

;; The first three of these are guaranteed not to cons or take a page fault
;; if you call them with their optional args supplied and if you locally
;; declare them INLINE where they are used.

;; The Physical Memory Map in A-Memory is cumulative as the memory was added, with a single word
;; word for each integral array of memory (usually a board).  The low order 10 bits is the number
;; of 2MB sized quanta starting at the physical page address referenced in the high order
;; 22 bits of the word.  To translate an address, walk the table sequentially, counting pages
;; as you go, until you find the entry that contains the page.
;; Entries for slots that do not contain a memory board are -1.
(DEFUN convert-physical-page-to-pfn (physical-page-number
				     &optional (a-mem-phys-map-address
						 (AREF #'system-communication-area
						   %Sys-Com-Physical-Memory-Map)))
  "Given a physical page number, returns its page frame number (PFN)."
  (LET ((tot-pfn 0)
	map-addr num-quanta phys-pg num-pfns)
    (DOTIMES (entry A-Memory-Physical-Memory-Map-Words (SETQ tot-pfn nil))
      (SETQ map-addr (+ a-mem-phys-map-address entry))
      (SETQ phys-pg (%P-LDB %%Physical-Page-Number map-addr))
      (UNLESS (= phys-pg (LDB %%Physical-Page-Number -1))
	(SETQ num-quanta (%P-LDB %%Phys-Mem-Map-2MB-Quantum map-addr))
	(SETQ num-pfns
	      (* num-quanta 2m-bytes-in-pages))
	(IF (<= phys-pg  physical-page-number  (+ phys-pg num-pfns -1))
	    (RETURN (INCF tot-pfn (- physical-page-number phys-pg)))
	    (INCF tot-pfn num-pfns))))
    tot-pfn
    ))

;; The reverse translation is accomplished in the same manner as conversion from physical 
;; page address to PFN, using the Physical-Memory-Map table in A-Memeory
(DEFUN convert-pfn-to-physical-page (pfn
				     &optional (a-mem-phys-map-address
						 (AREF #'system-communication-area
						   %Sys-Com-Physical-Memory-Map)))
  "Given a page-frame-number (PFN), returns a physical page number.  The physical page
number is just the Nubus address excluding the offset into page."
  (LET ((tot-pfn 0)
	map-addr num-quanta phys-pg num-pfns)
    (DOTIMES (entry A-Memory-Physical-Memory-Map-Words (SETQ phys-pg nil))
      (SETQ map-addr (+ a-mem-phys-map-address entry))
      (SETQ num-quanta (%P-LDB %%Phys-Mem-Map-2MB-Quantum map-addr))
      (SETQ phys-pg (%P-LDB %%Physical-Page-Number map-addr))
      (UNLESS (= phys-pg (LDB %%Physical-Page-Number -1))
	(SETQ num-pfns
	      (* num-quanta 2m-bytes-in-pages))
	(IF (<= tot-pfn  pfn  (+ tot-pfn num-pfns -1))
	    (RETURN (INCF phys-pg (- pfn tot-pfn)))
	    (INCF tot-pfn num-pfns))))
    phys-pg))


;; Same as above, but nubus address specified as slot and offset.
(DEFUN convert-slot-offset-to-pfn (nubus-slot byte-offset-into-slot
				   &optional (a-mem-phys-map-address
					       (AREF #'system-communication-area
						 %Sys-Com-Physical-Memory-Map)))
  "Given a Nubus address specified by NUBUS-SLOT and BYTE-OFFSET-INTO-SLOT, returns the
corresponding logical page frame number (PFN)."
  (DECLARE (inline convert-pfn-to-physical-page))
  (convert-physical-page-to-pfn
    (DPB nubus-slot (BYTE (BYTE-SIZE %%NuBus-F-And-Slot-Bits)
			  (- (BYTE-SIZE %%Physical-Page-Number)
			     (BYTE-SIZE %%Nubus-F-And-Slot-Bits)))
	 (LDB (BYTE (- (BYTE-SIZE %%Nubus-All-But-F-And-Slot-Bits)
		       (BYTE-SIZE %%Nubus-Offset-Into-Page))
		    (BYTE-SIZE %%Physical-Page-Offset))
	    byte-offset-into-slot))
    a-mem-phys-map-address)
  )

(DEFUN convert-pfn-to-slot-offset (pfn
				   &optional (a-mem-phys-map-address
					       (AREF #'system-communication-area
						 %Sys-Com-Physical-Memory-Map)))
  "Given a PFN (logical page frame number), returns the 32-bit Nubus address 
for the page in two pieces:  the nubus slot and the byte offset into the slot."
  (DECLARE (inline convert-pfn-to-physical-page)
	   (VALUES Nubus-slot byte-offset-into-slot))
  (LET* ((phys-page 
	   (convert-pfn-to-physical-page pfn a-mem-phys-map-address))
	 (nubus-slot
	   (LDB (BYTE (BYTE-SIZE %%NuBus-F-And-Slot-Bits)
		      (- (BYTE-SIZE %%Physical-Page-Number)
			 (BYTE-SIZE %%Nubus-F-And-Slot-Bits)))
		phys-page))
	 (byte-offset-into-slot
	   (DPB 
	     (LDB (BYTE (- (BYTE-SIZE %%Physical-Page-Number)
			   (BYTE-SIZE %%Nubus-F-And-Slot-Bits))
			0)
		  phys-page)
	     %%Physical-Page-Number
	     0)))
    
    (VALUES nubus-slot byte-offset-into-slot))
  )

;; These will cons:

(DEFUN convert-pfn-to-physical-address (pfn)
  "Converts physical page frame number (PFN) into 32-bit NuBus address."
  (DPB (convert-pfn-to-physical-page pfn) %%Physical-Page-Number 0)
  )

(DEFUN convert-physical-address-to-pfn (physical-address)
  "Converts a 32-bit NuBus address into a page frame number (PFN)."
  (convert-physical-page-to-pfn (LDB %%Physical-Page-Number physical-address))
  )