LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031683. :SYSTEM-TYPE :LOGICAL :VERSION 9. :TYPE "LISP" :NAME "PAGING-PROCESS" :DIRECTORY ("REL3-SOURCE" "MEMORY-MANAGEMENT") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758728183. :AUTHOR "REL3" :LENGTH-IN-BYTES 4650. :LENGTH-IN-BLOCKS 5. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ;;; -*- 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 (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) 1986,1987 Texas Instruments Incorporated. All rights reserved.;;; This file contains the internals of the Lisp Paging processes.;;; Edit History;;;                   Patch;;;   Date    Author  Number   Description;;;------------------------------------------------------------------------------;;; 09-22-86    ab             - Original.  Code to create background page;;;                            process which updates maximum PHT hash depth.;;; 04-02-87    ab             - Change UPDATE-PHT-DEPTH to FERROR if new;;;                            computed depth is greater than UCODE-recorded depth.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Background Page Process;;;(DEFUN compute-table-depth (&optional    (num-pages (pages-of-physical-memory)))  "Scan the current memory layout reporting the deepest scan."  ;; Scan the PPD and look up the virtual address for each page that's  ;; in virtual memory (permanently wired and deleted pages are ignored).  ;;  ;; This function should not take any page faults or cons.  (LOOP WITH ppd-slot = (get-ppd-slot-addr)WITH ppd-offset = (get-ppd-slot-offset)WITH pht-slot = (get-pht-slot-addr)WITH pht-offset = (get-pht-slot-offset)WITH pht-index-limit = (get-paging-parameter %Pht-Index-Limit)WITH max = 0WITH depth = 0WITH vaFOR pfn FROM (1- num-pages) DOWNTO 0FOR pht-index = (valid-pht-index (ppd-index-field pfn ppd-slot ppd-offset))WHEN pht-index;; Index will be NIL if invalid.DO;; Page is part of virtual memory -- get the virtual address from PHT.(SETQ va (LSH (pht-vpn pht-index pht-slot pht-offset)      (BYTE-SIZE %%va-offset-into-page)));; Calculate how many steps the hash algorithm took to get here.(UNLESS (= va (LSH (LDB %%va-page-number -1)   (BYTE-SIZE %%va-offset-into-page)));; Dummy page  (SETQ depth(DO ((computed-hash (%compute-page-hash va)    (%rehash computed-hash pht-index-limit))     (cnt 0 (1+ cnt)))    ((= computed-hash pht-index) cnt)  ())));; See if it is the longest path so far.(WHEN (> depth max) (SETQ max depth))FINALLY (RETURN max))  )(DEFUN update-pht-depth (&optional (num-pages (pages-of-physical-memory)))  ;; The PHT-SEARCH-DEPTH counter is continually updated by the Ucode to be the  ;; longest hash-chain length so far.  When hashing, Ucode looks at this to determine  ;; how many steps to check before giving up and declaring hard fault.  Through  ;; deletions the chain can get shorter, but this fact won't be recorded by the Ucode.  ;; Hence we check periodically from Lisp to see what the max table depth is, and update  ;; the counter from that calculation.  (page-in-structure #'update-pht-depth)  (page-in-structure #'compute-table-depth)  (LET ((old-depth (get-paging-parameter %pht-search-depth))(new-depth (compute-table-depth num-pages)))    (IF (<= new-depth old-depth)(set-paging-parameter %pht-search-depth new-depth);; This shouldn't happen.(FERROR nil "Computed PHT depth ~d. is larger than microcode-recorded depth of ~d."new-depth old-depth))));; This is initial function for the background paging process.;; It can be redefined as more functionality is added.(DEFUN page-background-loop () "Update the %PHT-SEARCH-DEPTH meter with the current table data."  (DO-FOREVER    (LET ((num-pages (pages-of-physical-memory)))      ;; Only do regularly for systems with 8 MB of memory or less.      ;; On larger systems, only do after a complete gc.      (WHEN (<= num-pages (FLOOR (* 8. 1024. 1024.) Page-Size))(WITHOUT-INTERRUPTS  ;; Update the counter which holds the current max PHT hash depth.  (update-pht-depth)))    ;; Once every 30 minutes    (PROCESS-SLEEP (* 60. 60. 30.))))  )(EVAL-WHEN (LOAD)  ;; Start up the background paging process.  Keep it at a low priority.  (PROCESS-RUN-FUNCTION '(:name "Page-Background" :restart-after-reset t :restart-after-boot t :priority -100.)'page-background-loop)  ;; In addition, update the PHT depth after GCs.  (ADD-INITIALIZATION "Update PHT max hash depth" '(update-pht-depth) '(:after-full-gc :normal))  )rd))) (full       (%P-LDB %%lpdib-page-band-full-flag (+ pointer %lpdib-flag-word))) (block-size (- end start)) (size       (CEILING block-size disk-blocks-per-page)) (usable-size   (* (FLOOR size cluster-size) cluster-size)) (free   ;; Must call Free-Page-Cluster-Count since %Free-Cluster-Count variable   ;; only has aggregate for ALL swap bands.   (* (free-page-cluster-count logical-page-device) cluster-size)) (used (- usable-size free)))    (