LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031685. :SYSTEM-TYPE :LOGICAL :VERSION 9. :TYPE "LISP" :NAME "PHYSICAL-MEMORY" :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 2758728216. :AUTHOR "REL3" :LENGTH-IN-BYTES 11669. :LENGTH-IN-BLOCKS 12. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ; -*-  Mode:Common-Lisp; Package:System-Internals; 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 assorted routines for manipulating physical memory.;;; Edit History;;;                   Patch;;;   Date    Author  Number   Description;;;------------------------------------------------------------------------------;;; 08-01-86    ab             - Broke off from ROOM & PAGE.;;;                            - Changed Set-Memory-Size to take new size in pages;;;                            instead of words, and to just display memory usage;;;                            with arg of nil.;;;                            - Wrote new functions Get-Contiguous-Physical-Pages;;;                            and Return-Contiguous-Physical-Pages.  Also;;;                            Associate-Virtual-With-Physical-Page.;;;;;; Physical Memory Utilities;;;(DEFVAR %Working-Memory-Size nil)(ADD-INITIALIZATION "Clear Mem Size" '(SETQ %Working-Memory-Size nil) :BEFORE-COLD) (DEFUN display-memory-configuration (&optional (STREAM *standard-output*))  (DOLIST (board (find-memory-boards-and-sizes))      (FORMAT stream "~2% ~3d Megabytes of memory (~:d words) in slot ~:d"      (FLOOR (CDR board) (EXPT 2 20.))      (FLOOR (CDR board) 4.)            (CAR board)))  (VALUES)) (DEFUN physical-memory-status (&optional (stream *standard-output*))  "Displays information about physical memory configuration and usage."  (LET* ((actual-size (system-communication-area %sys-com-memory-size)) (working-size   (OR %working-memory-size (system-communication-area %sys-com-memory-size))) (deleted-pages   (MULTIPLE-VALUE-BIND (ignore fixed-wired)       (count-wired-pages)     fixed-wired)) (perm-wired-pages (calculate-number-of-perm-wired-physical-pages)) (dead-pages (- deleted-pages perm-wired-pages)))    (FORMAT stream    "~2%Total Physical Memory Available:           ~10,:d words   ~7,:d pages ~              ~%User-Set Memory Size (size in use):        ~10,:d words   ~7,:d pages ~              ~%Permanently Wired Size (for system use):   ~10,:d words   ~7,:d pages ~              ~%Size Deleted (other than perm wired):      ~10,:d words   ~7,:d page~p"    actual-size (CEILING actual-size page-size) working-size    (CEILING working-size page-size) (* perm-wired-pages page-size) perm-wired-pages    (* dead-pages page-size) dead-pages dead-pages)    (display-memory-configuration stream)    (VALUES)))(DEFUN calculate-number-of-perm-wired-physical-pages ()  ;; Returns number of PHYSICAL pages allocated to system data structures.  (+    ;; Pages in FIXED areas.    (truncate (system-communication-area %SYS-COM-Wired-Size) page-size)    ;; PPD.  One word per physical memory page    (ceiling (pages-of-physical-memory) page-size)    ;; PHT.    (truncate (get-paging-parameter %PHT-Index-Limit)      (* page-size 4))    ))(DEFUN find-memory-boards-and-sizes ()  ;; Returns a-list of memory-board-slot/size-in-bytes pairs.  (DO ((slot #xFF (1- slot))       (board-alist nil)       (id-rom-byte nil)       (size nil))      ((< slot #xF0) board-alist)    (SETQ id-rom-byte (%nubus-read-8b-careful slot cromo-id-byte))    ;; Check for valid config roms    (IF (NUMBERP id-rom-byte)(WHEN (= id-rom-byte crom-rom-valid-flag)  ;; See if this is a memory board  (WHEN (LDB-TEST (BYTE 1 crom-memory-source-resource-bit)  (%nubus-read-8b slot cromo-resource-bits))    (setq size (%nubus-read-8b slot cromo-board-type-memory-size-offset))    ;; Mem board size: #KB = Mantissa * (2 ** Exp)    (SETQ size  (* (LDB %%cromo-board-type-memory-mantissa-bits size)     (EXPT 2 (LDB %%cromo-board-type-memory-exponent-bits size))))    ;; Add this to our alist, converting size to number of bytes and slot    ;; address to slot number.    (PUSH (CONS (LDB (BYTE 4. 0) slot) (* size 1024.)) board-alist)))))) (DEFUN set-memory-size (new-size &optional (verbose nil) &aux actual-size)  (DECLARE (ARGLIST new-size-in-pages))  "Specify how much main memory is to be used, in pages.This is mainly useful running benchmarks with different memory sizes.  If NEW-SIZE-IN-PAGES is NIL, information about current physical memory usage is displayed."  (CHECK-ARG new-size (AND (NUMBERP new-size) (> new-size 0))     "a positive number")  (UNLESS new-size    (display-memory-configuration)    (RETURN-FROM set-memory-size nil))  ;; Get words from pages.  (SETQ new-size (* new-size page-size))  (SETQ actual-size (system-communication-area %sys-com-memory-size))  (IF (> new-size actual-size)      (FERROR nil "Requested memory size ~d. is greater than actual physical memory available ~d."      new-size actual-size))  (LET ((minimum-size (+ (system-communication-area %sys-com-wired-size) (* page-size 64.))))    (IF (< new-size minimum-size)(FERROR nil "Requested memory size ~d. is smaller than mininum size needed ~d."new-size minimum-size)))  ;; For first time thru  (IF (NULL %working-memory-size)      (SETQ %working-memory-size actual-size))  (LET* ((old-size %working-memory-size) (old-pages (CEILING old-size page-size)) (new-pages (CEILING new-size page-size)) (ppd-slot (get-ppd-slot-addr)) (ppd-offset (get-ppd-slot-offset)))    (IF (< new-size old-size);; Delete pages(DO ((pages-to-delete (- old-pages new-pages))     (pages-deleted 0)     (pg (1- old-pages) (1- pg)))    ((= pages-deleted pages-to-delete))  (UNLESS (page-user-wired-p pg ppd-slot ppd-offset)    (IF (NOT (%delete-physical-page pg));; %delete-physical-page returns t if successfully deleted.;; It returns t if page was already deleted.(IF verbose    (FORMAT t "~%Page ~d. did not exist" pg)))    ;; Count page as one deleted, even if was already deleted in PPD.    ;; This will assure our counts don't get screwed up by asynchronous    ;; creating and deleting of physical pages.    (DECF %working-memory-size page-size)    (INCF pages-deleted)));; Add pages (or do nothing)(DO ((pages-to-add (- new-pages old-pages))     (pages-added 0)     (pg old-pages (1+ pg)))    ((= pages-added pages-to-add))  (UNLESS (page-user-wired-p pg ppd-slot ppd-offset)    (IF (%delete-physical-page pg)(IF verbose    (FORMAT t "~%Page ~d. already existed" pg));; Don't call %create on page already in use.  That would;; bash someone's data.(%create-physical-page pg))    ;; Count page as one added, even if it already existed.    (INCF %working-memory-size page-size)    (INCF pages-added))))    (display-memory-configuration)))(DEFUN get-contiguous-physical-pages (number-of-pages)  "Finds NUMBER-OF-PAGES pages of contigous physical memory suitablefor use and removes the pages from the virtual memory system, performingthe necessary processing on the evicted virtual pages.  Returns twovalues: the NuBus slot number (of the form #x+Fs), and the byte offsetof the first word of the contiguous pages.  In the unlikely case that no block of contiguous physical pages can be found, NILs are returned."  (DECLARE (inline convert-pfn-to-physical-page)   (VALUES nubus-slot slot-offset))  (CHECK-ARG number-of-pages     (AND (NUMBERP number-of-pages)  (PLUSP number-of-pages)  (<= number-of-pages      ;; upper bound of 1/4 of memory shd be reasonable.      (TRUNCATE (pages-of-physical-memory) 4.)))     "a positive number less than ~d" (TRUNCATE (pages-of-physical-memory) 4.))  (WITHOUT-INTERRUPTS    ;; Start at high physical memory    (DO* ((pg (1- (pages-of-physical-memory)) (1- pg))  (ppd-slot (get-ppd-slot-addr))  (ppd-offset (get-ppd-slot-offset))  (pht-slot (get-pht-slot-addr))  (pht-offset (get-pht-slot-offset))  (map-addr (system-communication-area %sys-com-physical-memory-map))  (start-block pg)  (pages-in-block 0)  (slot) (offset) (last-slot)   (end (number-of-system-wired-pages)));; There are non-wired pages below this,                                        ;; but will be in small chunks; not worth going farther. ((OR (= pages-in-block number-of-pages)      (<= pg end))  (VALUES slot offset))      (IF (Page-Perm-Or-User-Wired-P pg ppd-slot ppd-offset pht-slot pht-offset)  ;; Hit one we can't delete.  Start over  (DO ((p start-block (1- p))       (i pages-in-block (1- i)))      ((<= i 0)       ;; At end reset block counters.       (SETQ start-block (1- pg)     pages-in-block 0))    ;; Double check that it was indeed deleted, then    ;; re-create it.    (WHEN (page-perm-wired-p p ppd-slot ppd-offset)      (%create-physical-page p)))  ;; Page can be deleted.  (PROGN    (%delete-physical-page pg)    (INCF pages-in-block)))      (WHEN (= pages-in-block number-of-pages);; We've found enough contiguous pages.  Translate page frame number;; to NuBus address & make sure all are in same slot.(MULTIPLE-VALUE-SETQ (slot offset)  (convert-pfn-to-slot-offset (1+ (- start-block pages-in-block)) map-addr))(MULTIPLE-VALUE-SETQ (last-slot nil)  (convert-pfn-to-slot-offset start-block map-addr))(WHEN (NOT (= slot last-slot))  (DO ((p start-block (1- p))       (i pages-in-block (1- i)))      ((<= i 0)       ;; At end reset block counters.       (SETQ start-block (1- pg)     pages-in-block 0))    ;; Double check that it was indeed deleted, then    ;; re-create it.    (WHEN (page-perm-wired-p p ppd-slot ppd-offset)      (%create-physical-page p))))))    ))(DEFUN return-contiguous-physical-pages (number-of-pages slot offset)  (DO* ((adr (DPB slot %%Nubus-F-and-Slot-Bits offset))(pfn (convert-physical-address-to-pfn adr) (1+ pfn))(ppd-slot (get-ppd-slot-addr))(ppd-offset (get-ppd-slot-offset))(pgs 0 (1+ pgs))(highest-pfn (1- (pages-of-physical-memory))))       ((OR (>= pgs number-of-pages)    (> pfn highest-pfn)))    ;; If page has been deleted, return it to pool.    (WITHOUT-INTERRUPTS       (WHEN (page-perm-wired-p pfn ppd-slot ppd-offset)(%create-physical-page pfn)))    ))(DEFUN show-pg-deletions (&optional (nbr 20.))  (do ((i (1- (pages-of-physical-memory)) (1- i))       (count 0 (1+ count)))      ((= count nbr))    (format t "~%Pg ~o, deleted = ~a" i (page-perm-wired-p i)))  )(DEFUN associate-virtual-with-physical-page (virtual-page-address     nubus-slot slot-offset)  (LET* ((phys-pg (DPB nubus-slot       (BYTE (BYTE-SIZE %%Nubus-F-And-Slot-Bits)     (- (BYTE-SIZE %%Physical-Page-Number)(BYTE-SIZE %%Nubus-F-And-Slot-Bits)))       (LSH slot-offset (BYTE-SIZE %%Physical-Page-Offset)))) (pfn (convert-physical-page-to-pfn phys-pg)) (adr (LOGAND virtual-page-address (- page-size))) (vpn (LSH virtual-page-address (BYTE-SIZE %%VA-Offset-Into-Page))))        (WITHOUT-INTERRUPTS       (UNLESS (%page-status adr);; Associate the physical & virtual addresses.  This is like "putting";; page VPN in physcial frame PFN.(%page-in pfn vpn);; Now dirty page.  This guarantees it will be swapped out eventually.;; When that happens the DPMT swap space will be allocated.(%P-DPB (%P-LDB (BYTE 1 0) adr) (BYTE 1 0) adr)))    ))r-page))     (swap-band-usable-size       (* (FLOOR swap-band-num-pages cluster-size) cluster-size)))(WHEN (LDB-TEST %%lpdib-status-type-bit swap-band-status);read/write band  (INCF usable-size swap-band-usable-size))))    (SETQ used (- usable-size free))    (WHEN (MINUSP free)      (FERROR nil "the amount of calculated free swap space (~a) cannot be negative." free))    (VALUES usable-size free used)))(DEFF swap-space-daemon-info 'swap-space-info);;;(make-obsolete swap-space-daemon-info 'swap-space-info);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Changing Swap Space allocation.;;;(D