;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Base:8; Readtable:ZL -*- (defvar *page-cleaner-ppd-index*) (defun clean-pages () (let ((ppd-base (%region-origin physical-page-data)) (ppd-index *page-cleaner-ppd-index*) (pht-base (%region-origin page-table-area)) (phys-pages (floor (aref #'sys:system-communication-area sys:%sys-com-memory-size) 256.)) pht-adr (disk-page-reads (read-meter '%count-disk-page-reads)) (disk-page-writes (read-meter '%count-disk-page-writes)) (ccwp %DISK-RQ-CCW-LIST) (ccwstart %disk-rq-ccw-list) (ccwend (* page-rqb-size 2)) vpage-start (n-pages 0) (local-page-offset page-offset) (region-bits-origin (%region-origin region-bits)) ) ;;find next dirty page, but only if it is one of the next N pages (do ((i 0 (1+ i))) ((= i 5) (setq *page-cleaner-ppdl-index* ppd-index) (return-from clean-pages nil)) (setq pht-adr (+ (%p-ldb (byte 16. 0) (+ ppd-base ppd-index)) pht-base)) (when (and (not (= pht-adr #o177777)) (= (%p-ldb %%pht1-valid-bit pht-adr) 1) (= (%p-ldb %%pht1-swap-status-code pht-adr) %pht-swap-status-normal) (or (= (%p-ldb %%pht1-modified-bit pht-adr) 1) (= (%p-ldb %%pht2-map-status-code (1+ pht-adr)) %pht-map-status-read-write))) (return nil)) (incf ppd-index) (when (= ppd-index phys-pages) (setq ppd-index 0))) ;;get here with PHT-ADR pointing to the PHT entry for first dirty page ;;we want to write out this, and any following dirty virtual pages (wire-page-rqb) (setq vpage-start (%p-ldb %%pht1-virtual-page-number pht-adr)) (do ((vpage vpage-start (+ vpage 1)) (vadr (lsh vpage-start 8) (%make-pointer-offset #.dtp-fix vadr #o400))) (()) (let ((page-status (%page-status vadr)) (logical-adr (%physical-address vadr))) (when (or (null page-status) (not (= 1 (ldb %%pht1-modified-bit page-status))) (null logical-adr)) (return nil)) (incf n-pages) (setf (aref page-rqb ccwp) (+ logical-adr 1)) (setf (aref page-rqb (+ ccwp 1)) (lsh logical-adr -16.)) (incf ccwp 2) (when (= ccwp ccwend) (return nil)) )) (when (not (= ccwp ccwstart)) (setf (ldb (byte 1 0) (aref page-rqb (- ccwp 2))) 0) (disk-write-wired page-rqb 0 (+ vpage-start local-page-offset)) (do ((vadr (lsh page-start 8) (%make-pointer-offset #.dtp-fix vadr #o400)) (i 0 (1+ i))) ((= i n-pages)) (let ((page-status (%page-status vadr))) (when (null page-status) (ferror nil "page slipped away!!")) (%change-page-status vadr (+ 1_23. page-status) (%p-ldb %%region-map-bits (+ region-bits-origin (%region-number vadr))))))))) (DEFUN CLEAN-DIRTY-PAGES () (DO ((ADR (%REGION-ORIGIN PAGE-TABLE-AREA) (+ ADR 2)) (N (TRUNCATE (AREF (SYMBOL-FUNCTION 'SYSTEM-COMMUNICATION-AREA) %SYS-COM-PAGE-TABLE-SIZE) 2) (1- N)) (N-DIRTY 0)) ((ZEROP N) N-DIRTY) (COND ((AND (NOT (ZEROP (%P-LDB %%PHT1-VALID-BIT ADR))) (NOT (= (%P-LDB %%PHT1-SWAP-STATUS-CODE ADR) %PHT-SWAP-STATUS-WIRED)) (OR (= (%P-LDB %%PHT1-MODIFIED-BIT ADR) 1) (= (%P-LDB %%PHT2-MAP-STATUS-CODE (1+ ADR)) %PHT-MAP-STATUS-READ-WRITE))) (SETQ N-DIRTY (1+ N-DIRTY)) (REALLY-PAGE-OUT-PAGE (LSH (%P-LDB %%PHT1-VIRTUAL-PAGE-NUMBER ADR) 8.)))))) (DEFUN REALLY-PAGE-OUT-PAGE (ADDRESS &AUX CCWP PS PHYS-ADR) "Write it on the disk, changing in-core page table status to RWF, etc." (select-processor ((:lambda :cadr) (WITHOUT-INTERRUPTS (SETQ ADDRESS (%POINTER ADDRESS)) (UNWIND-PROTECT (PROG () (WIRE-PAGE-RQB) (SETQ CCWP %DISK-RQ-CCW-LIST) ;; We collect some page frames to put them in, remembering the ;; PFNs as CCWs. (COND ((OR (NULL (SETQ PS (%PAGE-STATUS ADDRESS))) (= 0 (LDB %%PHT1-MODIFIED-BIT PS)) (NULL (SETQ PHYS-ADR (%PHYSICAL-ADDRESS ADDRESS)))) (RETURN NIL)) (T (LET ((PFN (LSH PHYS-ADR -8))) (ASET (1+ (LSH PFN 8)) PAGE-RQB CCWP) (ASET (LSH PFN -8) PAGE-RQB (1+ CCWP))) (SETQ CCWP (+ 2 CCWP)) (ASET (LOGAND (AREF PAGE-RQB (- CCWP 2)) -2) ;Turn off chain bit PAGE-RQB (- CCWP 2)) (DISK-WRITE-WIRED PAGE-RQB 0 (+ (LSH ADDRESS -8) PAGE-OFFSET)) (%CHANGE-PAGE-STATUS ADDRESS (+ 1_23. %PHT-SWAP-STATUS-FLUSHABLE) (LDB %%REGION-MAP-BITS (%REGION-BITS (%REGION-NUMBER ADDRESS)))) (RETURN T) ))) ;; UNWIND-PROTECT forms (UNWIRE-PAGE-RQB) ))) (:explorer nil))) (DEFUN PAGE-IN-WORDS-old (ADDRESS NWDS &AUX (CCWX 0) CCWP BASE-ADDR) (lambda-or-cadr-only) (WITHOUT-INTERRUPTS (SETQ ADDRESS (%POINTER ADDRESS)) (UNWIND-PROTECT (PROGN (WIRE-PAGE-RQB) ;; This DO is over the whole frob (DO ((ADDR (LOGAND (- PAGE-SIZE) ADDRESS) (%MAKE-POINTER-OFFSET DTP-FIX ADDR PAGE-SIZE)) (N (+ NWDS (LOGAND (1- PAGE-SIZE) ADDRESS)) (- N PAGE-SIZE))) ((NOT (PLUSP N))) (SETQ CCWX 0 CCWP %DISK-RQ-CCW-LIST BASE-ADDR ADDR) ;; This DO is over pages to go in a single I/O operation. ;; We collect some page frames to put them in, remembering the ;; PFNs as CCWs. (DO-FOREVER (OR (EQ (%PAGE-STATUS ADDR) NIL) (RETURN NIL)) (LET* ((fast-cache-mode-p (ldb-test %%processor-switch-fast-cache-mode (%processor-switches nil))) (PFN (if fast-cache-mode-p (%FINDCORE-HEXADEC (LDB (BYTE 4 8) ADDR)) (%findcore)))) (SETF (AREF PAGE-RQB CCWP) (1+ (LSH PFN 8))) (SETF (AREF PAGE-RQB (1+ CCWP)) (LSH PFN -8))) (INCF CCWX 1) (INCF CCWP 2) (UNLESS (< CCWX PAGE-RQB-SIZE) (RETURN NIL)) (SETQ ADDR (%POINTER-PLUS ADDR PAGE-SIZE)) (DECF N PAGE-SIZE) (UNLESS (PLUSP N) (RETURN NIL))) (WHEN (PLUSP CCWX) ;We have something to do, run the I/O op ;; Turn off chain bit (SETF (AREF PAGE-RQB (- CCWP 2)) (LOGAND (AREF PAGE-RQB (- CCWP 2)) -2)) (DISK-READ-WIRED PAGE-RQB 0 (+ (LSH BASE-ADDR -8) PAGE-OFFSET)) ;; Make these pages in (DO ((I 0 (1+ I)) (CCWP %DISK-RQ-CCW-LIST (+ 2 CCWP)) (VPN (LSH BASE-ADDR -8) (1+ VPN)) (PFN)) ((= I CCWX)) (SETQ PFN (DPB (AREF PAGE-RQB (1+ CCWP)) #o1010 (LDB #o1010 (AREF PAGE-RQB CCWP)))) (UNLESS (%PAGE-IN PFN VPN) ;; Page already got in somehow, free up the PFN (%CREATE-PHYSICAL-PAGE (LSH PFN 8)))) (SETQ CCWX 0)))) ;; UNWIND-PROTECT forms (UNWIRE-PAGE-RQB) ;I guess it's better to lose some physical memory than to get two pages ;swapped into the same address, in the event that we bomb out. ; (DO ((CCWP %DISK-RQ-CCW-LIST (+ CCWP 2)) ; (N CCWX (1- N))) ; ((ZEROP N)) ; (%CREATE-PHYSICAL-PAGE (DPB (AREF PAGE-RQB (1+ CCWP)) ; #o2006 ; (AREF PAGE-RQB CCWP)))) )))