;;; -*- 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 (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 the code to set up the virtual memory maps during ;; Cold Boot. ;;; ;;; Edit History ;;; ;;; Patch ;;; Date Author Number Description ;;;------------------------------------------------------------------------------ ;;; 08-86 drp - Original ;;; 11-27-86 ab - Fix code to use new functiopn %compute-page-hash-lisp, ;;; which can take a PHT-Size & PHT-Index argument. The ;;; code to copy the page tables may take a page exception ;;; to set up the maps, hence the microcode's PHT-Size and ;;; index cannot be altered until the context switch takes ;;; place. ;;; 12-17-86 ab - Fix %initialize-tv-screen-memory to update pht-search-depth ;;; counter after adding entries to PHT. Otherwise hash ;;; collisions encountered while adding screen PHT entries ;;; may not be found in later PHT lookups. ;;; 12-18-86 ab - Cleaned up code. Fixed problems with sizing PHT in ;;; large memory configurations, and off-by-one error in ;;; calculating PHT index size. Made %find-page-hash-table-hole ;;; more general; it now returns the max hash depth. Moved ;;; a couple things to PAGE-DEFS. ;;; 02-26-87 ab - Changed %initialize-tv-screen-memory to update ;;; new A-Mem counter %IO-Space-Virtual-Address when it adds ;;; TV screen memory to PHT. Also have it set up the screen ;;; memory PHT with cache-inhibit ON (for Explorer II). ;;; 03-24-87 epm Generalize the assumptions about F4 being the boot memory board ;;; since on Explorer II it may not be. ;;; 04-02-87 ab Make sure critical paging symbols are compiled as constants. ;;; 06-24-87 ab Sys 3-37 - Add Color Support changes to %initialize-tv-screen-memory ;;; 09-03-87 ab/rjf sys 3-89 - Make sure we don't call %CREATE-PHYSICAL-PAGE on PFN greater ;;; than the max. Fixed problem with booting with 128MB. ;;; 11-17-87 rjf sys 3-116 - Fixed so would work correctly with spi-board. ;;; 01-12-88 ab - Modifications to %BOOT-VIRTUAL-MEMORY and ;;; ADD-MEM-BUSIFC-TO-ADDRESS-TRANSLATIONS for MX. ;;; 12-20-88 RJF - Made Memory-board-p safer. It was causing problems ;;; for a customer ;;; 02-27-89 JLM Added support for MP. ;;; 03/15/89 RJF Fixed copy-page-table to correctly return new ;;; hash depth. Page in %PHYS-LOGDPB and %PHYS-LOGLDB ;;; in case function called instead of miscop. ;;; 04/25/89 RJF/HRC Changed %boot-virtual-memory to turn on pre-paging ;;; which is off to avoid overrunning the 2MB started ;;; with at boot time. ;;;;;;;;;;; ;; ;; Vars ;; ;; A running count of our memory size, in pages. (DEFVAR *Memory-Size-In-Pages* 0.) (DEFVAR *Map-Entry-Index* 0.) (DEFVAR *Boot-Memory-Board-slot*) ;initial value is NIL to avoid any extraneous magic (DEFVAR *pht-search-depth* 0) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; %boot-virtual-memory ;; ;;------ %Boot-Virtual-Memory ;; ;; %boot-virtual-memory assumes that the microcode has already set up the ;; virtual memory tables for 2MB of physical memory in the Memory-Bus-IF slot ;; (slot 4 in a normal chassis). Since a memory board is required to be in ;; this slot, and since a memory board will always be at least 2MB, this is ;; a valid assumption (even a 32MB board without the base register set can ;; have its first 8MB accessed anyway). ;; ;; %boot-virtual-memory runs very early in lisp-reinitialize, right after ;; the SIB initializations on COLD-BOOT only. It finds out how much physical ;; memory actually exists in this configuration, and sets up the memory tables ;; accordingly. ;; ;; Returns T if the tables were actually resized; else NIL. ;; ;; Tables involved: ;; ;; 1) Physical Memory Map ;; Located in a set of A-Memory registers, the physical memory map is used ;; in translating between PFNs (logical page frame numbers, from 0 to ;; (pages-of-physical-memory)) and Nubus Physical addresses (32-bit byte ;; addresses). Each entry in the table represents contiguous Nubus memory. ;; The low bits contain the number of 2MB quanta, and the high bits contain ;; a starting Nubus physical page number (22 bits). ;; ;; 2) PPD (Physical Page Data Table) ;; Contains one entry for each page of physical memory. The high half ;; is used to link the microcode's LRU paging list, and the low half is ;; used to index into the PHT. ;; ;; 3) PHT (Page Hash Table) ;; Contains a 2-word entry for every physical page (4 x this actually, until ;; 32MB is reached). Provides a mapping between virtual page number and ;; current physical memory location for the page. Hash key is from highish ;; bits of virtual address. ;; (DEFUN %boot-virtual-memory () (initialize-vars) ;; Start by putting our initial 2MB in our running totals. As a side ;; effect, this will also set the base register on our main memory board ;; if it is a 32MB board (so we can later access the rest of the memory). (add-mem-busifc-to-address-translations) ;; Now find all the memory boards we own (which slots), and the total sizes. ;; Upon return, *Memory-Size-In-Pages* will have the total memory size. (UNLESS (mx-p) (find-our-memory-boards)) ;; Now, if our actual physical memory is greater than what is stored in ;; the SCA (ie, what the Ucode thinks our physical memory is), re-size ;; all the tables as appropriate. Note this initial size check will stop ;; us from creating the tables twice (which would be a disaster) in case ;; this function is called at top level by the user. (COND ((> *Memory-Size-In-Pages* (pages-of-physical-memory)) (create-new-page-tables) ;; Lastly, let the Ucode etc know what the new total memory size is. (SETF (AREF #'system-communication-area %Sys-Com-Memory-Size) (* *Memory-Size-In-Pages* page-size)) t) (t nil)) (SETF %DISK-SWITCHES (DPB 1. %%MULTI-PAGE-SWAPIN-ENABLE %DISK-SWITCHES))) ;; TURN ON PRE-PAGING NOW THAT WE HAVE RAM. (DEFUN initialize-vars () (SETF *Map-Entry-Index* 0. *Memory-Size-In-Pages* 0.)) ;;; New version to dynamically determine the bus interface board 3-24-87 (DEFUN add-mem-busifc-to-address-translations () (setq *Boot-Memory-Board-Slot* (ldb %%PPN-F-And-Slot-Bits (convert-pfn-to-physical-page 0))) ;; First 2M are already in physical-memory-map entry 0. (incf *Map-Entry-Index*) (COND ((NOT (mx-p)) (MULTIPLE-VALUE-BIND (size slot) (find-memory-board-size *Boot-memory-board-slot* t) (INCF *Memory-Size-In-Pages* size) (WHEN (> size 2M-bytes-in-pages) ;; If our main memory board was > 2M, go ahead and put the rest of the board ;; memory in the next physical memory map entry. (add-to-address-translations (DPB slot %%Nubus-F-And-Slot-Bits 2M-bytes) (- size 2M-bytes-in-pages))))) (t ;; MX case (LET (pbr-value size slot) (SETQ pbr-value (io-space-read Mx-Phys-Bus-Resource-Register)) (SETQ size (COND ((LDB-TEST %%PBR-Memex12 pbr-value) (floor (* 12. 1m-byte) page-size-in-bytes)) ((LDB-TEST %%PBR-Memex8 pbr-value) (floor (* 8. 1m-byte) page-size-in-bytes)) (t (floor (* 4. 1m-byte) page-size-in-bytes)))) (INCF *Memory-Size-In-Pages* size) (SETQ slot Processor-Slot-Number) (add-to-address-translations (DPB slot %%Nubus-F-And-Slot-Bits 2M-bytes) (- size 2M-bytes-in-pages))))) ) ;;;----- Find-Memory-Board-Size ----- ;;; ;;; Finds the capacity of the memory board in the given slot. ;;; If the Capacity is greater than 8M bytes then the ;;; Base register can optionally be set to allow access to the rest ;;; of the memory. ;;; Return the Base (Base Register Value or #xFs number) and ;;; Amount of memory Accessible in Pages. ;;; ;;; FYI: About the setting up the base register. ;;; Base Register bit: | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | ;;; ;;; Set to: | 0 | Slot Number | 0 | 0 | 0 | ;;; ;;; The slot number is put in bits 3-6, this gives every slot a ;;; unique base register. The reason it is not 4-7 (nibble boundary) ;;; is because slot #xF would create a base address of #xF0 which is ;;; conflicting with the nubus address at slot 0. Also, bits 0-2 ;;; can not be used; this is the memory board spec. ;;; rjf 11/17/87 - fixed so would work correctly with spi-board (DEFUN find-memory-board-size (slot &optional (set-base-register t)) (LET ((size (%nubus-read-8b slot CROMO-Board-Type-Memory-Size-Offset)) size-in-pages) ;; 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)))) (SETQ size-in-pages (FLOOR (* size 1k-byte) (* page-size 4))) (WHEN (AND (> size-in-pages 8M-bytes-in-pages) set-base-register) ;; Greater than 8MB. Need to set base register so we can access ;; the rest of the memory on the board (LET ((new-base (if (= (LDB (BYTE 4. 0) slot) #xf) #xe8 (DPB (LDB (BYTE 4. 0) slot) (BYTE 4. 4.) 0)))) (%nubus-write-8b slot %Memory-Base-Test-Register new-base) (SETQ slot new-base)) ) ;; Return size in pages and slot (possibly new). (VALUES size-in-pages slot))) ;;; The Address Translation map (Physical Memory Map) has an entry per ;;; contiguous chunk of memory up to 2^10 2Mbytes. ;;; Each entry is 32 bits: ;;; With the high-order 22 bits being the high-order ;;; 22-bits of the starting physical address. ;;; And the low-order 10 bits being the number of 2M byte ;;; chunks on at that address. ;;; (DEFUN add-to-address-translations (adr size) (WITHOUT-INTERRUPTS (LET ((map-pointer (%POINTER-PLUS (AREF #'system-communication-area %Sys-Com-Physical-Memory-Map) *Map-Entry-Index*)) (2-mb-quanta (FLOOR size 2m-bytes-in-pages))) ;; Clear the low 3 bytes (%P-DPB 0 %%Nubus-All-But-F-And-Slot-Bits map-pointer) ;; Adr is a 32-bit Nubus base Address. (%P-DPB (LDB %%physical-page-number adr) %%Phys-Mem-Map-Physical-Page-Number map-pointer) (%P-DPB 2-mb-quanta %%Phys-Mem-Map-2MB-Quantum map-pointer) (INCF *Map-Entry-Index*))) ) ;;;----- Find-Our-Memory-Boards ----- ;;; ;;; Find all of OUR memory boards and how much we are allowed ;;; to access. The default is that all the boards in the ;;; Nubus are ours, but this may not be true in multiprocessing ;;; environments. ;;; Note: checks 16. Nubus Slots. ;;; Set up the Base Register for each Memory Board. ;;; Add each board to the Address Translation map (physical memory map). ;;; (DEFUN find-our-memory-boards () (DO ((slots-i-own (get-paging-parameter %Slots-I-Own)) (bit-index 0 (1+ bit-index))) ((= bit-index 16.)) ;; Make sure we own the board, and don't include the main ;; memory board, which has already been added to the configuration. (WHEN (AND (/= bit-index (ldb (byte 4. 0) *boot-memory-board-slot*)) ;3-24-87 epm (LDB-TEST (BYTE 1 bit-index) slots-i-own)) (LET ((slot (DPB bit-index (BYTE 4. 0.) #xf0))) (WHEN (memory-board-p slot) ;; It is a memory board. ;; Get size & slot (setting base register if necessary. (MULTIPLE-VALUE-BIND (size base-reg) (find-memory-board-size slot t) (INCF *Memory-Size-In-Pages* size) (add-to-address-translations (DPB base-reg %%Nubus-F-And-Slot-Bits 0.) size))))))) (DEFUN memory-board-p (slot) (LET ((id-rom-byte (%nubus-read-8b-careful slot CROMO-Id-Byte)) (config-reg (%nubus-read-8b-careful slot %Memory-Configuration-Register)) (resource-type (%nubus-read-8b-careful slot CROMO-Resource-Bits))) ;; Check for valid config roms. (AND (NUMBERP id-rom-byte) (= id-rom-byte CROM-ROM-Valid-Flag) (NUMBERP resource-type) (LDB-TEST (BYTE 1 CROM-Memory-Source-Resource-Bit) ;See if this is a memory board? resource-type) (NOT (LDB-TEST (BYTE 1 2) config-reg)) ; Self-Test light is not on. t))) ;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Making new PPD/PHT ;; (PROCLAIM '(inline Return-Old-Page-Tables Add-All-New-Pages)) ;; This functions returns the pages used to hold the OLD Page Tables ;; back to the system for use. (DEFUN return-old-page-tables (ppd-starting-pfn pht-starting-pfn number-of-word-entries) (DOTIMES (i (FLOOR number-of-word-entries Page-Size)) (%create-physical-page (+ PPD-Starting-PFN i))) (DOTIMES (i (FLOOR (MIN (* Number-of-word-entries 8.) Maximum-PHT-Size) page-size)) (%create-physical-page (+ PHT-Starting-PFN i))) ) ;;ab 9/3/87. Make sure we don't call %CREATE-PHYSICAL-PAGE on PFN greater than the max. ;; Fixes the "can't boot with 128MB physical memory" problem. ;; Call %Create-Physical-Page for every new page added. (DEFUN add-all-new-pages (starting-pfn number-of-pages) (LOOP for pg from (MIN Highest-Valid-PPD-Index Highest-Valid-PPD-Link (1- (+ number-of-pages starting-pfn))) downto starting-pfn by 1 do (%create-physical-page pg)) ) ;; If we get here, there must be more physical memory to add. We are ;; guaranteed that there is at least 2Mbytes unknown to the system. ;; Pick it up from the second slot of the Physical Memory Map. ;; ;; We return the slot/offset addresses where the new PPD and PHT will go. ;; NOTE: This code is not checking the amount of memory available, ;; but rather just using the known-to-be-available 2MB. ;; This is okay up to 128M bytes, since we only need 1.5M bytes ;; total for the PPD and PHT. If by chance we have more than 128M ;; then the code will need to be changed or we'll need to be guaranteed ;; more than 2M bytes. YOU HAVE BEEN WARNED!!!!! ;; (DEFUN allocate-new-page-tables (number-of-pages) (LET* ((map-ptr (%POINTER-PLUS (AREF #'system-communication-area %Sys-Com-Physical-Memory-Map) 1)) ;; New PPD will start at this memory quantum's lowest address (new-ppd-slot (%P-LDB %%Nubus-F-And-Slot-Bits map-ptr)) (new-ppd-offset (DPB 0 %%NuBus-Offset-Into-Page (%P-LDB %%NuBus-All-But-F-And-Slot-Bits map-ptr))) ;; PPD has a 1-word entry per physical page. (new-ppd-size-in-bytes (* number-of-pages 4.)) ;; New PHT will start on same board, right after PPD (new-pht-slot new-ppd-slot) (new-pht-offset (+ new-ppd-offset new-ppd-size-in-bytes))) (VALUES new-ppd-slot new-ppd-offset new-pht-slot new-pht-offset new-ppd-size-in-bytes))) ;;------ Initialize-Page-Tables ;; ;; Note: Here and elsewhere, the PHT usually contains 4 2-word entries per physical ;; page. The extra entries are there to buffer against hash collisions. ;; However, there is a maximum PHT size that is limited by our 16-bit ;; index into it; that is, we can only index a PHT that has 2^^16 entries or less. ;; Hence there is a maximum PHT size of 2^^16 entries * 2 words/entry. ;; Thus, at 16MB, there are only 2 2-wd entries/page, and at 32MB it becomes ;; "straight mapped" (no collisions) at 1 1-wd entry/page. There are no ;; collisions at 32MB because there are 2^^16 virtual pages also. (DEFUN initialize-page-tables (ppd-slot ppd-offset pht-slot pht-offset number-of-memory-pages) (DOTIMES (i number-of-memory-pages) ;; initialize PPD to -1. (%nubus-write ppd-slot (+ (* i 4.) ppd-offset) -1)) (DOTIMES (i (MIN (* number-of-memory-pages 8.) ; 4 2-word entries per page Maximum-PHT-Size)) ; or the maximum addressible size ;; initialize PHT to 0s. (%nubus-write pht-slot (+ (* i 4.) pht-offset) 0)) ) ;;----- Create-New-Page-Tables ;; ;; NOTE: This function MUST NOT do any consing OR take a page fault since it copies ;; the PHT & PPD (which is side-effected by page faults). ;; (DEFUN create-new-page-tables () ;; Bind everything that could take page fault to locals here. (LET* ((memory-size-in-pages *Memory-Size-In-Pages*) (current-PPD-slot (get-ppd-slot-addr)) (current-PPD-offset (get-ppd-slot-offset)) (current-PHT-slot (get-pht-slot-addr)) (current-PHT-offset (get-pht-slot-offset)) (current-PPD-size (pages-of-physical-memory)) new-max-hash-depth new-ppd-slot new-ppd-offset new-pht-slot new-pht-offset new-ppd-size-in-bytes new-pht-num-entries new-pht-size-in-words new-pht-size-in-bytes new-pht-index-length) ;; ;; Get the slot/offset info for the new table locations. (MULTIPLE-VALUE-SETQ (new-ppd-slot new-ppd-offset new-pht-slot new-pht-offset new-ppd-size-in-bytes) (allocate-new-page-tables memory-size-in-pages)) ;; Set up default entry values (initialize-page-tables new-ppd-slot new-ppd-offset new-pht-slot new-pht-offset memory-size-in-pages) ;; New PHT size = Num-words-in-PHT * 4 bytes/word ;; Num-Words-In-PHT is the smaller of: # memory pages * 4 entries/page * 2 words/entry ;; Maximum-Pht-Size (in words) (SETQ new-pht-size-in-words (MIN (* memory-size-in-pages 4. 2.) Maximum-PHT-Size) new-pht-num-entries (FLOOR new-pht-size-in-words 2.) new-pht-size-in-bytes (* new-pht-size-in-words 4.) ;; This is length-in-bits of the largest PHT entry number in this size PHT. new-pht-index-length (INTEGER-LENGTH (1- new-pht-num-entries))) (page-in-structure #'create-new-page-tables) (page-in-structure #'copy-page-tables) (page-in-structure #'%find-page-hash-table-hole) (page-in-structure #'%PHYS-LOGDPB) (page-in-structure #'%PHYS-LOGLDB) (page-in-structure '%counter-block-a-mem-address) ;; Let's NOT PAGE or CONS starting HERE !!! (WITHOUT-INTERRUPTS ;; Copy PPD and PHT. ;; Rehash each PHT entry on the fly. (SETQ new-max-hash-depth (copy-page-tables current-ppd-slot current-ppd-offset new-ppd-slot new-ppd-offset current-pht-slot current-pht-offset new-pht-slot new-pht-offset current-ppd-size new-pht-size-in-bytes new-pht-index-length)) ;; This is the "CONTEXT SWITCH", where we change from ;; using the old tables to using the new ones. (set-ppd-address new-ppd-slot new-ppd-offset) (set-pht-address new-pht-slot new-pht-offset) (set-paging-parameter %pht-index-size new-pht-index-length) (set-paging-parameter %pht-index-limit new-pht-size-in-bytes) (set-paging-parameter %physical-page-data-end new-ppd-size-in-bytes) (set-paging-parameter %pht-search-depth new-max-hash-depth) ;; Clean up after context switch ;; First return pages used for old tables to the virtual memory system for later use. ;; (They'll get linked into the PPD). (return-old-page-tables (convert-slot-offset-to-pfn current-ppd-slot current-ppd-offset) (convert-slot-offset-to-pfn current-pht-slot current-pht-offset) current-ppd-size) ;; Now make sure all newly-added physical pages are made known to the virtual memory system. ;; (This means they get linked into the PPD). (add-all-new-pages (convert-slot-offset-to-pfn new-pht-slot (+ new-pht-offset new-pht-size-in-bytes)) (- memory-size-in-pages current-ppd-size (FLOOR (+ new-ppd-size-in-bytes new-pht-size-in-bytes) page-size-in-bytes)))) )) (DEFUN copy-page-tables (old-ppd-slot old-ppd-offset new-ppd-slot new-ppd-offset old-pht-slot old-pht-offset new-pht-slot new-pht-offset old-number-pages new-pht-size-in-bytes new-pht-index-length &aux (max-hash-depth 0) already-in-pht old-ppd-index-field old-pht-index) (DOTIMES (pfn old-number-pages) ;; Copy old PPD link field to new PPD entry. (set-ppd-link pfn (ppd-link pfn old-ppd-slot old-ppd-offset) new-ppd-slot new-ppd-offset) ;; Get old PPD link field, and the associated PHT-index. (SETQ old-ppd-index-field (ppd-index-field pfn old-ppd-slot old-ppd-offset) old-pht-index (LSH old-ppd-index-field 3)) (IF (NOT (valid-pht-index old-ppd-index-field)) ;; ;; PHT index not valid; just copy the PPD index field to new PPD. (set-ppd-index-field pfn old-ppd-index-field new-ppd-slot new-ppd-offset) ;; ;; PHT index is valid. Get the virtual address in old PHT entry, find ;; where it hashes to in new PHT, copy the old PHT entry over, and fix ;; up the new PPD index field to have the correct PHT entry-index. (LET* ((virtual-address (%logdpb (pht-vpn old-pht-index old-pht-slot old-pht-offset) %%Va-Page-Number 0.)) new-pht-index) (MULTIPLE-VALUE-SETQ (new-pht-index max-hash-depth already-in-pht) (%find-page-hash-table-hole virtual-address new-pht-slot new-pht-offset new-pht-size-in-bytes new-pht-index-length max-hash-depth)) (WHEN already-in-pht ; this shouldn't happen! (%crash unexpected-duplicate-pht-entry new-pht-index t)) ;; Fix up new PPD index field to contain the (entry) index into the PHT. (set-ppd-index-field pfn (LSH new-pht-index -3) new-ppd-slot new-ppd-offset) ;; Just copy the old PHT's 2-word entry to the new PHT, a halfword at a time (%phys-logdpb (%phys-logldb %%Q-high-half old-pht-slot (+ old-pht-offset old-pht-index)) %%Q-high-half new-pht-slot (+ new-pht-offset new-pht-index)) (%phys-logdpb (%phys-logldb %%Q-low-half old-pht-slot (+ old-pht-offset old-pht-index)) %%Q-low-half new-pht-slot (+ new-pht-offset new-pht-index)) (%phys-logdpb (%phys-logldb %%Q-high-half old-pht-slot (+ old-pht-offset old-pht-index 4)) %%Q-high-half new-pht-slot (+ new-pht-offset new-pht-index 4)) (%phys-logdpb (%phys-logldb %%Q-low-half old-pht-slot (+ old-pht-offset old-pht-index 4)) %%Q-low-half new-pht-slot (+ new-pht-offset new-pht-index 4))))) ;; return new maximum hash depth max-hash-depth ) (DEFUN %find-page-hash-table-hole (virtual-address pht-slot pht-offset pht-index-limit pht-index-size current-max-hash-depth) "Returns three values: 1) The byte index into the Page Hash Table (specified by the PHT-SLOT and PHT-OFFSET arguments) of the first vacant entry appropriate for use by VIRTUAL-ADDRESS; and 2) A NEW-MAX-HASH-DEPTH, which may be greater or equal to the CURRENT-MAX-HASH-DEPTH passed in; and 3) A flag which, if T, means the virtual address already has a valid PHT entry." (WITHOUT-INTERRUPTS (LOOP WITH virtual-page-nbr = (LDB %%Va-Page-Number virtual-address) WITH already-in-PHT = nil FOR hash = (%compute-page-hash-lisp virtual-address pht-index-limit pht-index-size) THEN (%rehash hash pht-index-limit) FOR depth = 1 THEN (1+ depth) FOR entry-valid-p = (pht-valid-p hash pht-slot pht-offset) FOR entry-vpn = (pht-vpn hash pht-slot pht-offset) UNTIL (OR (NOT entry-valid-p) (SETQ already-in-pht (= virtual-page-nbr entry-vpn))) FINALLY (RETURN (VALUES hash (MAX depth current-max-hash-depth) already-in-pht)))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; %initialize-tv-screen-memory ;; ;; Global variables containing virtual addresses of color screen buffers. ;; No virtual memory is allocated for the y-incrementing color buffers. (DEFPARAMETER TV:CSIB-EXPANS-NO-TRANSP-VA nil "Virtual address of the color board's expansion mode screen memory.") (DEFPARAMETER TV:CSIB-EXPANS-TRANSP-VA nil ;;; this variable is obsolete, it is not used. 7/88 grh "Virtual address of the color board's expansion mode screen memory with transparency.") (DEFPARAMETER TV:CSIB-COLOR-NO-TRANSP-VA nil "Virtual address of the color board's 8-bit screen memory.") (DEFPARAMETER *BW-TV-IO-SPACE-VIRTUAL-ADDRESS* "Virtual address of B&W screen memory.") ;; new 7/88 GRH - support for multiple monitors. (defvar tv:*csib-slots-vas* nil "List of virtual addresses for each CSIB. Form is: (slot 1bit-VA 8bit-VA)") (defvar tv:*sib-slots-vas* nil "List of virtual addresses for each SIB. Form is: (slot 1bit-VA)") (DEFUN %initialize-tv-screen-memory () ;; Set up the pht entries for the black & white or color screen (LET* ((pgs-per-color-buffer (truncate %CSIB-BYTES-PER-COLOR-SCREEN page-size-in-bytes)) (pgs-per-expans-buffer (truncate %CSIB-BYTES-PER-EXPANS-SCREEN page-size-in-bytes)) (words-per-color-buffer (* pgs-per-color-buffer page-size)) (words-per-expans-buffer (* pgs-per-expans-buffer page-size)) (io-sp-start-adr a-memory-virtual-address) ; first unmappable virtual address ;; Set up %disk-run-light virtual address to be in middle of next to last line on screen ;; run-light-offset = ;; (let ((wds-per-line 32.) ;; (lines-per-screen 808.)) ;; (- (* wds-per-line (- lines-per-screen 2)) ;; (+ (quotient wds-per-line 2) 1)) (run-light-offset #x64AF) (primary-slot (- tv:sib-slot-number #xf0))) ;; *********************************************************** ;; This setq may be eliminated immediately prior to a build. - GRH 6/88 ;; It determines the virtual address for the main screen array and cannot be ;; easily changed after a build since many things point to this array ;; such as the cold-load-stream, disk-save, and suggestions. ;; It currently allocates about 2 megabytes that it does *NOT* need. (setq io-sp-start-adr (%pointer-difference io-sp-start-adr (* page-size (truncate %TV-Screen-Number-Bytes page-size-in-bytes)))) ;; It should be replaced with the following ;; (SETQ io-sp-start-adr (%pointer-difference io-sp-start-adr ;; words-per-expans-buffer)) ;; ************************************************************** ;; First allocate memory for the primary (keyboard) SIB/CSIB. (setq tv:*sib-slots-vas* nil) (setq tv:*csib-slots-vas* nil) (cond ((not tv:sib-is-csib) ;; SIB ;; setup some globals (SETQ *BW-TV-IO-SPACE-VIRTUAL-ADDRESS* io-sp-start-adr %disk-run-light (%pointer-plus io-sp-start-adr run-light-offset) tv:*sib-slots-vas* (list (list primary-slot io-sp-start-adr))) ;; allocate virtual memory for buffer (add-tv-screen-pages-to-pht io-sp-start-adr (dpb tv:sib-slot-number %%NuBus-F-And-Slot-Bits %TV-Screen-Memory-Start-Byte-Offset) pgs-per-expans-buffer)) (t ;; CSIB ;; allocate virtual memory for 1bit buffer (add-tv-screen-pages-to-pht io-sp-start-adr (dpb tv:sib-slot-number %%NuBus-F-And-Slot-Bits %CSIB-Expans-Xinc-No-transp-byte-offset) pgs-per-expans-buffer) ;; set up globals (SETQ %disk-run-light (%pointer-plus io-sp-start-adr run-light-offset) ;; for compatibility with old single sib system. *BW-TV-IO-SPACE-VIRTUAL-ADDRESS* io-sp-start-adr TV:CSIB-EXPANS-NO-TRANSP-VA io-sp-start-adr TV:CSIB-COLOR-NO-TRANSP-VA (%pointer-difference io-sp-start-adr words-per-color-buffer) tv:*csib-slots-vas* (list (list primary-slot io-sp-start-adr ;; calculate 8bit buffer VA (SETQ io-sp-start-adr (%pointer-difference io-sp-start-adr words-per-color-buffer))))) ;; allocate memory for 8bit color buffer (add-tv-screen-pages-to-pht io-sp-start-adr (dpb tv:sib-slot-number %%NuBus-F-And-Slot-Bits %CSIB-Color-Xinc-No-transp-byte-offset) pgs-per-color-buffer) )) ;; allocate memory for all other SIBs. (dolist (slot (remove primary-slot tv:*sib-slots*)) (WITHOUT-INTERRUPTS ;; calculate buffer virtual address (SETQ io-sp-start-adr (%pointer-difference io-sp-start-adr words-per-expans-buffer)) ;; setup tv:*sib-slots-vas* (setq tv:*sib-slots-vas* (cons (list slot io-sp-start-adr) tv:*sib-slots-vas*)) ;; allocate virtual memory for buffer (add-tv-screen-pages-to-pht io-sp-start-adr (dpb (+ #xF0 slot) %%NuBus-F-And-Slot-Bits %TV-Screen-Memory-Start-Byte-Offset) pgs-per-expans-buffer) )) ;; now allocate memory for all other CSIBs. (dolist (slot (remove primary-slot tv:*csib-slots*)) (WITHOUT-INTERRUPTS ;; calculate VA for 1bit buffer (SETQ io-sp-start-adr (%pointer-difference io-sp-start-adr words-per-expans-buffer)) ;; allocate virtual memory for 1bit buffer (add-tv-screen-pages-to-pht io-sp-start-adr (dpb (+ #xF0 slot) %%NuBus-F-And-Slot-Bits %CSIB-Expans-Xinc-No-transp-byte-offset) pgs-per-expans-buffer) ;; for primary SIB set up primary buffers & disk run light globals (when (= tv:sib-slot-number (+ #xF0 slot)) (SETQ %disk-run-light (%pointer-plus io-sp-start-adr run-light-offset) ;; for compatibility with old single sib system. *BW-TV-IO-SPACE-VIRTUAL-ADDRESS* io-sp-start-adr TV:CSIB-EXPANS-NO-TRANSP-VA io-sp-start-adr TV:CSIB-COLOR-NO-TRANSP-VA (%pointer-difference io-sp-start-adr words-per-color-buffer))) ;; Save VAs in global (setq tv:*csib-slots-vas* (cons (list slot io-sp-start-adr ;; calculate 8bit buffer VA (SETQ io-sp-start-adr (%pointer-difference io-sp-start-adr words-per-color-buffer))) tv:*csib-slots-vas*)) ;; allocate memory for 8bit color buffer (add-tv-screen-pages-to-pht io-sp-start-adr (dpb (+ #xF0 slot) %%NuBus-F-And-Slot-Bits %CSIB-Color-Xinc-No-transp-byte-offset) pgs-per-color-buffer) )) ;; Fix %IO-Space-Virtual-Address & set *io-space-virtual-address* variable (let ((unsigned-io-sp-start-adr (convert-to-unsigned io-sp-start-adr)) (a-mem-ptr (%POINTER-PLUS a-memory-virtual-address (+ %counter-block-a-mem-address %io-space-virtual-address)))) (%P-DPB (LDB %%Q-High-Half unsigned-io-sp-start-adr) %%Q-High-Half a-mem-ptr) (%P-DPB (LDB %%Q-Low-Half unsigned-io-sp-start-adr) %%Q-Low-Half a-mem-ptr) (set-io-space-virtual-address)) )) (DEFUN add-tv-screen-pages-to-pht (starting-virtual-address starting-physical-address number-pages) (LET ((pht-slot (get-pht-slot-addr)) (pht-offset (get-pht-slot-offset))) (WITHOUT-INTERRUPTS (LOOP WITH pht-index-limit = (get-paging-parameter %pht-index-limit) WITH pht-index-size = (get-paging-parameter %pht-index-size) WITH pht-index WITH new-max-hash-depth WITH already-in-pht FOR vpn = (ldb %%VA-Page-Number starting-virtual-address) THEN (%POINTER-PLUS vpn 1) FOR ppn = (ldb %%Physical-Page-Number starting-physical-address) THEN (%POINTER-PLUS ppn 1) FOR virtual-address = starting-virtual-address THEN (%POINTER-PLUS virtual-address Page-Size) FOR max-hash-depth = (get-paging-parameter %pht-search-depth) THEN new-max-hash-depth FOR cnt FROM 0 BY 1 UNTIL (= cnt number-pages) DO (MULTIPLE-VALUE-SETQ (pht-index new-max-hash-depth already-in-pht) (%find-page-hash-table-hole virtual-address pht-slot pht-offset pht-index-limit pht-index-size max-hash-depth)) ;; If already in pht, just means this function has been called before. (UNLESS already-in-pht (set-pht-vpn pht-index vpn pht-slot pht-offset) (set-pht-valid-p pht-index t pht-slot pht-offset) (set-pht-swap-status pht-index %PHT-Swap-Status-Wired pht-slot pht-offset) (set-pht-phys-pg pht-index ppn pht-slot pht-offset) (set-pht-meta-bits pht-index %Region-representation-type-structure pht-slot pht-offset) (set-pht-access-bits pht-index %PHT-Map-Access-Read-Write pht-slot pht-offset) (set-pht-status-bits pht-index %PHT-Map-Status-Read-Write pht-slot pht-offset) (set-pht-cache-inhibit pht-index t pht-slot pht-offset)) ;; At end, make sure to update the system's %PHT-Search-Depth reflecing ;; any deeper hash collisions we may have caused. FINALLY (set-paging-parameter %Pht-Search-Depth new-max-hash-depth)))) ) (DEFUN add-shared-pages-to-pht (starting-virtual-address starting-physical-address number-pages &optional (representation-type :structure) (redirect nil)) (LET ((pht-slot (get-pht-slot-addr)) (pht-offset (get-pht-slot-offset))) (WITHOUT-INTERRUPTS (do ((pht-index-limit (get-paging-parameter %pht-index-limit)) (pht-index-size (get-paging-parameter %pht-index-size)) (pht-index) (new-max-hash-depth) (already-in-pht) (vpn (ldb %%VA-Page-Number starting-virtual-address) (%POINTER-PLUS vpn 1)) (ppn (lDb %%Physical-Page-Number starting-physical-address) (%POINTER-PLUS ppn 1)) (virtual-address starting-virtual-address (%POINTER-PLUS virtual-address Page-Size)) (max-hash-depth (get-paging-parameter %pht-search-depth) new-max-hash-depth) (cnt 0 (+ 1 cnt))) ((= cnt number-pages) (set-paging-parameter %Pht-Search-Depth new-max-hash-depth) t) (MULTIPLE-VALUE-SETQ (pht-index new-max-hash-depth already-in-pht) (%find-page-hash-table-hole virtual-address pht-slot pht-offset pht-index-limit pht-index-size max-hash-depth)) (cond ((and already-in-pht (not redirect)) (return nil)) ((and already-in-pht redirect) (progn (set-pht-swap-status pht-index %PHT-Swap-Status-Wired pht-slot pht-offset) (set-pht-phys-pg pht-index ppn pht-slot pht-offset) (set-pht-meta-bits pht-index ;; multiply by two to move the bits up to the proper place (* 2. (if (eq representation-type :structure) %Region-representation-type-structure %Region-representation-type-list)) pht-slot pht-offset) (set-pht-access-bits pht-index %PHT-Map-Access-Read-Write pht-slot pht-offset) (set-pht-status-bits pht-index %PHT-Map-Status-Read-Write pht-slot pht-offset) (set-pht-modified-p pht-index t) (%change-page-status virtual-address nil nil) )) (t (progn (set-pht-vpn pht-index vpn pht-slot pht-offset) (set-pht-valid-p pht-index t pht-slot pht-offset) (set-pht-swap-status pht-index %PHT-Swap-Status-Wired pht-slot pht-offset) (set-pht-phys-pg pht-index ppn pht-slot pht-offset) (set-pht-meta-bits pht-index ;; multiply by two to move the bits up to the proper place (* 2. (if (eq representation-type :structure) %Region-representation-type-structure %Region-representation-type-list)) pht-slot pht-offset) (set-pht-access-bits pht-index %PHT-Map-Access-Read-Write pht-slot pht-offset) (set-pht-status-bits pht-index %PHT-Map-Status-Read-Write pht-slot pht-offset) (set-pht-cache-inhibit pht-index t pht-slot pht-offset))))))))