Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0057/pfhsno.mac
There are 2 other files named pfhsno.mac in the archive.  Click here to see a list.
00100	
  00200		TITLE PFHSNO
    00300	
  00400		ENTRY S$$PFZ
    00500	
  00600		SEARCH UUOSYM
   00700		SEARCH S$$NDF
   00800		SALL
  00900	
  01000	
  01100	;*******************************************************************
    01200	;
 01300	;DECSYSTEM-10 PAGE FAULT HANDLER.....MAY 1977
  01400	;
 01500	;REVISED VERSION JULY 1978
 01600	;ADAPTED FOR FASBOL LIBRARY  AUGUST 1978
  01700	;
 01800	;
 01900	;NIGEL DERRETT
   02000	;DATALOGISK AFDELING, MATEMATISK INSTITUT, AARHUS UNIVERSITY, DENMARK
   02100	;
 02200	;********************************************************************
   02300	;
 02400	;********************************************************************
   02500	;
 02600	;This page-fault handler uses a sort of "second chance" algorithm.
 02700	;Any pages which have not been accessed for 2 time-slots are regarded
   02800	;as candidates to be shoved out
 02900	;
 03000	;Fasbol programs overwrite the last 1k of core, so the standard
    03100	;page fault handler cannot be used.
  03200	;This handler should be loaded with the user program. It removes
   03300	;the system pfh, if present.
    03400	;
 03500	;Non-VM systems should set the switch P$VM in SDDNDF to zero;
 03600	;VM systems should set it to 1.
 03700	;Systems with both VM and non-VM users will need two versions of FASBOL
 03800	;and FASLIB.
03900	;
 04000	;To initialise the page fault handler:
    04100	;	JSR S$$PFZ##
   04200	;No regs are altered.
 04300	;
 04400	;****************************************************************************
04500	
  04600	
  04700	PAGE
   04800	;**********************************************************************
 04900	;
 05000	; DUMMY MODULE FOR NON-VM SYSTEMS
    05100	;
 05200	;**********************************************************************
 05300	
  05400	IFE P$VM<
   05500			; dummy code for non-vm systems
    05600	
  05700		S$$PFZ:	0
  05800			JRSTF  @ S$$PFZ
05900	>
 06000	
  06100	
  06200	IFN P$VM<
   06300	
  06400			; rest of pfh
  06500	
  06600	PAGE
   06700	;**********************************************************************
 06800	;
 06900	; FEATURES
  07000	;
 07100	;**********************************************************************
 07200	
  07300		FTTEST=0	; switch for producing trace output
  07400		FTSHOW=0	; switch for producing "hello" message
    07500		FTNOTM=0	; switch to disable time interrupts
  07600				; (useful for debugging)
07700	
  07800	
  07900	PAGE
   08000	;************************************************************************
    08100	;
 08200	; CONSTANTS
 08300	;
 08400	;************************************************************************
    08500	
  08600	; Registers
 08700		T1=1
  08800		T2=2
  08900		T3=3
  09000		T4=4
  09100		PN=5	; page number
   09200		P=6	; stack pointer
  09300	
  09400		; ***NOTE***
    09500		; The entry code at START requires the regs to be in this order
   09600		; GETIN, CREATE, and ACCESS require that PN = T4+1
 09700		; Others require that T1-T4 are consecutive.
  09800	
  09900	
  10000	; Constants
 10100	
  10200	IFN FTNOTM<
      10300		TIMINT=0		; no time traps
 10400	>
 10500	IFE FTNOTM<
 10600		TIMINT=1000		; interval between time traps
    10700	>
 10800	
  10900		FFLSTA=2		; initial force level
11000	
  11100		MAPSIZE=17		; size of a page map
    11200		PAGSIZ=1000		; size of a page
  11300	
  11400		ALSIZE=20		; size of argument list for CLRABS
 11500	
  11600	IFN FTTEST,<
11700		STKSIZ=40		; large stack when testing - for OUTNUM
 11800	>
 11900	IFE FTTEST,<
12000		STKSIZ=20		; small stack normally
   12100	>
 12200	
  12300	
  12400	PAGE
   12500	;**********************************************************************
 12600	;
 12700	; MACROS
    12800	;
 12900	;**********************************************************************
 13000	
  13100	
  13200	DEFINE NOOP <JFCL 0,0>
13300	
  13400	
  13500	IFN FTTEST,<
13600	DEFINE TRACE(AC, TEXT)<
    13700	IFN AC,<	IFN AC-T1 < EXCH T1, AC >
   13800			PUSHJ P, OUTNUM
13900			IFN AC-T1,< EXCH T1, AC >
14000		>
14100		OUTSTR [ASCIZ/TEXT
   14200	/]
14300	>> ; end IFN FTTEST
   14400	
  14500	
  14600	IFE FTTEST,<
14700		DEFINE TRACE(AC,TXT)<>
    14800	>  ; end IFE FTTEST
   14900	
  15000	
  15100	IFN FTTEST,<
15200	DEFINE ERROR(TEXT)<
   15300		JRST [	OUTSTR ERMST
  15400			OUTSTR [ASCIZ/TEXT
  15500	/]
15600			HALT .
    15700		     ]
15800	>> ; end IFN FTTEST
   15900	
  16000	
  16100	IFE FTTEST,<
16200	DEFINE ERROR(TEXT)<
   16300		HALT .
16400	>> ; end IFE FTTEST
   16500	
  16600	
  16700	DEFINE MESSAGE(TEXT)<
 16800		OUTSTR [ASCIZ/TEXT
   16900	/]
17000	>
 17100	
  17200	
  17300	PAGE
   17400	;*****************************************************************
 17500	;
 17600	; ENTRY POINT FOR HANDLER WHEN A PAGE FAULT OCCURS
  17700	;
 17800	;*****************************************************************
 17900	
  18000	
  18100	; Here starteth the handler proper
        18200	
  18300	PFHSTR:	JRST START
    18400	FPC:	0			; PC of page fault word
18500	PFWD:	0			; page fault word
18600	VTIME:	0			; virtual time elapsed
    18700	PGRATE:	0			; page rate
    18800	PSIVEC:	0			; PSI vectors
  18900		BLOCK 3			; reserved by DEC
    19000	
  19100	
  19200	; Normal entry point
  19300	START:	SOSE  SEMAFO		; check whether we are in the PFH already
19400	START1:	ERROR<START1>		; yes - error - the handler is not reentrant
19500	
  19600		DMOVEM T1,SAVT1		; save accumulators which we will use
  19700		DMOVEM T3,SAVT3		;
   19800		DMOVEM PN,SAVPN		;
   19900		MOVE P, STKWD		; Set up stack
  20000	
  20100		SKIPGE PFWD		; has WS changed ?
20200		PUSHJ P, REINIT		; yes - reinitialize
    20300	
  20400	DISPCH:	HRRZ T1,PFWD		; get cause
    20500		TRACE T1,<Cause of page fault>
 20600	
  20700		SOJE T1, DISP2		; Unless it is ALLOW-ACCESS
   20800		; get an up-to-date version of the USEDTHISTIME map
20900		MOVE T2, [XWD .PAGGA, UTMBLK]
  21000		PAGE. T2,		; get access allowed map
 21100	STAER2:	ERROR<STAER2>		; nasty!
 21200	
  21300	DISP2:	; T1 = faulttype-1
  21400		CAIGE T1, 4		; if cause is ZERO-PAGE
21500		CAIN T1, 1		; or non-uuo page not in core
21600		SETOM LASTPC		; then forget LASTPC
  21700					; We are actually doing something useful
   21800					; so we can't be in a dump-mode IO loop.
   21900	
  22000		LDB PN,[POINT 17,PFWD,17]; get page number for fault
    22100		TRACE PN,<Fault page number>
   22200	
  22300		PUSHJ P, TABLE(T1)	; dispatch using fault type (T1 = faulttype-1)
 22400	
  22500		;back here after handliing fault
    22600		DMOVE T1, SAVT1		; restore regs
22700		DMOVE T3, SAVT3		;
   22800		DMOVE PN, SAVPN		;
   22900		AOS SEMAFO		; reset semaphore
  23000		JRSTF @FPC		; return to program
23100	
  23200	TABLE:	JRST ACCESS		; access not allowed
  23300		JRST GETIN		; page not in core
      23400		JRST GETUUO		; UUO argument not in core
  23500		JRST TIME		; time trap
    23600		JRST CREATE		; zero page
  23700		JRST CREATE		; UUO zero page	
  23800	
  23900	
  24000	
  24100	PAGE
   24200	;**********************************************************************
 24300	;
 24400	; INITIALISATION
 24500	;
 24600	;**********************************************************************
 24700	
  24800	S$$PFZ:	; JSR here to initialise pfh
 24900		0
25000	
  25100		; Save regs
25200		DMOVEM T1, SAVT1
25300		DMOVEM T3, SAVT3
25400		DMOVEM PN, SAVPN
25500		MOVE P, STKWD		; set up stack
  25600	
  25700		TRACE 0,<Initialising PFH>
25800	
  25900		IFE FTTEST<
26000		   IFN FTSHOW< MESSAGE<Fasbol PFH setup>
 26100		>>
    26200	
  26300		; set up the bit maps
26400	
  26500		; first get the WS
   26600		MOVE T1, [XWD .PAGWS, INMBLK]
  26700		PAGE. T1,		; get WS
  26800	INITE1:	ERROR<INITE1>		; should never happen
   26900	
  27000		; now set up the others
   27100		MOVEI T1, MAPSIZE-1	; T1 is index into bitmap vectors
   27200	INIT1:	SETOM , ULTMAP(T1)	; set USEDLASTTIME map
    27300		SOJGE T1, INIT1		; and loop
    27400		; We mark all pages as USED-LAST-TIME so that they
 27500		; don't get shoved out during the first timeslice.
 27600	
  27700		; USEDTHISTIME map is set up when it is needed.
    27800	
  27900		; set up flags
  28000		MOVEI T1, FFLSTA	; initial force level
   28100		MOVEM T1, FORCFL	; initialise force level
28200		SETOM  LASTPC		; LASTPC := nothing
  28300		SETZM DMPADS		; not doing dump-mode IO
   28400		SETZM SEMAFO		; initialise semaphore
28500	
  28600		; ensure that I am in core before I take over from the system PFH.
28700		MOVEI T1, PFHSTR	; address of first word
 28800	INITA:	MOVE T2, (T1)		; access word - ensure that page is in core
  28900		ADDI T1, PAGSIZ		; bump up address to point to next page
     29000		CAIG T1, PFHEND		; all done?
   29100		JRST INITA		; no - check next page
  29200		MOVEI T1, PFHEND	; get end of loop right - check end addr is OK
   29300		MOVE T2, (T1)		; access word
   29400	
  29500		; set up .JBPFH word in jobdat area to tell monitor we're here
    29600		MOVE T1, [XWD PFHEND,PFHSTR]
   29700		MOVEM T1, .JBPFH
29800	
  29900		; remove old pfh from last 1K (if it is there)
30000		MOVE T1, [XWD .PAGCD, RPFLS1]	; set up call
   30100		PAGE. T1,		; destroy page 776
  30200		JRST [			; error return
   30300			TRACE T1, <Error code from 776>
    30400			JRST INIT2
30500		     ]
30600	INIT2:	MOVE T1, [XWD .PAGCD, RPFLS2]	; set up call
  30700		PAGE. T1,		; destroy page 777
  30800		JRST [			; error return
   30900			TRACE T1, <Error code from 777>
    31000			JRST INIT3
31100		     ]
31200	INIT3:
 31300		
 31400		; set up incore map again - without old pfh
   31500		PUSHJ P, REINIT
 31600	
  31700		; clear access bits for incore pages
31800		PUSHJ P, CLRABS
 31900	
  32000		; set up timing interval
  32100		MOVEI T1, TIMINT	; get timing interval
   32200		HRLI T1, 26		; set up call of SETUUO
32300		SETUUO T1,		; set timing interval
   32400	STERR:	ERROR<STERR>		; oops!
    32500	
  32600		DMOVE T1, SAVT1		; restore regs
32700		DMOVE T3, SAVT3
 32800		DMOVE P,  SAVPN
 32900		AOS SEMAFO		; restore semaphore
33000		JRSTF  @S$$PFZ		; return to caller
  33100	
  33200	; end of INIT code
    33300	
  33400	
  33500	PAGE
   33600	;************************************************************************
    33700	;
 33800	; REINIT
    33900	;
 34000	;************************************************************************
    34100	
  34200	REINIT:	; subroutine
  34300		; Who's been eating my porridge ?
   34400		; Either the user or the monitor has altered the working set
 34500		; (the PF.HCB bit was set).
         34600		; This subroutine resets the INCORE bitmap
    34700		; nonskip return
34800	
  34900		TRACE 0,<WS changed - resetting>
    35000	
  35100		MOVE T1, [XWD .PAGWS, INMBLK]	; set up call
   35200		PAGE. T1,		; INMAP := working set
   35300	REERR:	ERROR<REERR>		; HELP!
    35400		POPJ P,			; That's all folks!
  35500	
  35600	; end of subroutine REINIT
 35700	
  35800	
  35900	PAGE
   36000	;*********************************************************************
  36100	;
 36200	; GETIN
36300	;
 36400	;*********************************************************************
  36500	
  36600	GETIN:	; subroutine to get a page into core
    36700		; page number in PN
  36800		; nonskip return
36900	
  37000		TRACE PN,<Fault on page>
  37100	
  37200		PUSHJ P, OUTPAG		; start by shoving somebody out
   37300		NOOP			; nobody got shoved out, but never mind
37400					; we will try to increase the incore size
  37500	GETIN1:	MOVEI T4, 1		; put in arg for PAGE UUO
 37600					; pageno is in PN
 37700					; requires that T4 and PN are consecutive regs
  37800		MOVE T1, [XWD .PAGIO, T4]  ; set up call
 37900		PAGE. T1,		; get page into core
38000		JRST GETFC		; didn't suceed - force a page out
38100	
  38200		; we have now got the page in - by fair means or foul
   38300		TRACE PN,<In OK>
38400	
  38500		; now set the bit in the INCORE map,
38600		PUSHJ P, MARKIN		;
   38700	
  38800		; allow access to the page
38900		JRST ACCESS		; and return direct to caller
    39000	
  39100	GETFC:	; Here if we couldn't get the page in
   39200		; error code in T1
   39300		PUSHJ P, FORCE		; force a page out
  39400		JRST GETIN1		; and try again
   39500	
  39600	
  39700	; end of subroutine GETIN
  39800	
  39900	
  40000	PAGE
   40100	;**********************************************************************
 40200	;
 40300	; CREATE
    40400	;
 40500	;**********************************************************************
 40600	
  40700	CREATE:	; Subroutine to create a new page
 40800		; pageno in PN
  40900		; nonskip return
41000	
  41100		TRACE PN,<Create page>
    41200	
  41300		; unlike GETIN we don't shove a page out first
41400		; we assume that the user is growing.
    41500	CREA1:	MOVEI T4, 1		; put in argument for PAGE UUO
  41600					; pageno is in PN
 41700					; requires that T4 and PN are consecutive regs
  41800		MOVE T1, [XWD .PAGCD, T4]  ; set up call
 41900		PAGE. T1,		; create page in core
    42000		JRST CFORC		; didn't succeed - force a page out
    42100	
  42200		; we have now created the page - by fair means or foul
  42300		TRACE PN,<Created OK>
42400	
  42500		; now set the bit in the INCORE map,
42600		; we don't set access allowed, since he may be grabbing a large vector
 42700		; and he may not use it for a while.
42800		JRST MARKIN		; and return direct to caller
    42900	
  43000	
  43100	CFORC:	; here if we weren't able to create a new page
    43200		; T1 contains error code from PAGE UUO.
  43300	
  43400		; find out what went wrong
43500		CAIN T1, PAGNS%		; no more swapping space ?
   43600		JRST PFHNMS		; yes
   43700		PUSHJ P, FORCE		; no - try forcing a page out
 43800					; T1 = error code
 43900		JRST CREA1		; try again
   44000	
  44100	; end of subroutine CREATE
 44200	
  44300	PAGE
   44400	;****************************************************************************
44500	;
 44600	; FORCE
44700	;
 44800	;****************************************************************************
44900	
  45000	FORCE:	; subroutine to force pages out in order to get one in, or to
    45100		; create a new one.
  45200		; on entry  T1 = error code from PAGE. UUO
    45300		; nonskip return
45400		TRACE 0,<Forcing>
    45500	
  45600		CAIE T1, PAGLE%		; did we fail because of not enough
    45700					; physical core?
  45800	FORCER:	ERROR<FORCER>		; no - then shoving out pages won't help.
   45900	
  46000		; yes - shove out page and try again
46100	
  46200	FORC1:	PUSHJ P, OUTPAG		; shove out a page
46300		SKIPA			; didn't succeed - continue
 46400		POPJ P,			; page shoved out - return
46500	
  46600		; there are no more candidate pages at this level of forcing
 46700		; try more brutal methods
 46800		SOSL FORCFL		; reduce forcing level
 46900		JRST FORC1		; and loop unless it was already minimum
    47000	
  47100		; we are at the lowest level of forcing, and still we
   47200		; can't find a candidate page
  47300		; This user is just too small
  47400		PUSHJ P, TOSMAL		; tell him the bad news
 47500		; if he continues, then he may have got more core
  47600		; so let the calling routine try again
   47700		POPJ P,
    47800	
  47900	; end of subroutine FORCE
  48000	
  48100	PAGE
   48200	;**********************************************************************
 48300	;
 48400	; TOSMAL
    48500	;
 48600	;*********************************************************************
  48700	
  48800	TOSMAL: ; Subroutine called when user hasn't got enough physical core
   48900		; Normal return if user does a CONTINUE
  49000	
  49100	PFHNEP:	MESSAGE<?PFHNEP - NOT ENOUGH PHYSICAL CORE>
 49200		HALT .+1		; stop, and give him a chance to do
 49300					; something about it
   49400		; if he continues, then he may have got more core
  49500		; so return to caller
49600		POPJ P,
    49700	
  49800	; end of subroutine TOSMAL
 49900	
  50000	
  50100	PAGE
   50200	;**********************************************************************
 50300	;
 50400	; PFHNMS
    50500	;
 50600	;**********************************************************************
 50700	
  50800	PFHNMS:	MESSAGE<?PFHNMS - NO MORE VM SWAPPING SPACE AVAILABLE>
50900		HALT .			; stop
 51000	
  51100	
  51200	PAGE
   51300	;**********************************************************************
 51400	;
 51500	; MARKIN
    51600	;
 51700	;**********************************************************************
 51800	
  51900	MARKIN:	; subroutine
  52000		; here if we have successfully got a page into core
52100		; This subroutine marks the page in the INCORE map.
52200		; nonskip return
52300	
  52400		MOVE T1, PN		; T1 := page number
    52500		PUSHJ P, GETBIT 	; T1 := index into bitmap, T2 := bit
   52600		IORM T2, INMAP(T1)	; set bit in INCORE map
    52700		POPJ P,			; return
   52800	
  52900	; end of subroutine MARKIN
 53000	
  53100	
  53200	PAGE
   53300	;*************************************************************************
   53400	;
 53500	; ACCESS
    53600	;
 53700	;*************************************************************************
   53800	
  53900	ACCESS: ; subroutine to allow access to a page
 54000		; PN = page number
   54100		; nonskip return
54200	
  54300		TRACE PN,<Allow access to page>
54400	
  54500		MOVEI T4, 1		; put in arg for PAGE UUO
   54600					; PN is pageno
    54700					; requires that T4 and PN are consecutive regs
  54800		MOVE T1, [XWD .PAGAA, T4]  ; set up call
 54900		PAGE. T1,		; allow acess to page
    55000	ACERR:	ERROR<ACERR>		; help!!
   55100		POPJ P,			; all done
 55200	
  55300	; end of subroutine ACCESS
 55400	
  55500	
  55600	PAGE
   55700	;************************************************************************
    55800	;
 55900	; OUTPAG and OUTPGN
   56000	;
 56100	;************************************************************************
    56200	
  56300		; Subroutines to shove a candidate page out
   56400		; OUTPAG has no parameters, and starts looking for a candidate
    56500		; at page 1
56600		; OUTPGN starts looking at pageno in T1
  56700		; Skip return if OK, nonskip return if there were no candidates left.
  56800		; all regs smashed
   56900	
  57000	OUTPAG:	MOVEI T1, 1		; OUTPAG starts looking at page 1
   57100	OUTPGN:				; OUTPGN starts lookin at pageno in T1
   57200		TRACE 0,<Shove someone out>
    57300		MOVE T2, FORCFL		; param for FINPAG
 57400		PUSHJ P, FINPAG		; find a candidate page
 57500		POPJ P,			; no candidates - nonskip return
    57600	
  57700		; T1 contains the number of the page we are going to shove out
    57800		TRACE T1,<Shove out page>
 57900		MOVE T4, T1		; T4 := pageno
    58000		HRLI T4, 400000		; set bit 0 (direction bit for PAGE UUO)
    58100		MOVEI T3, 1		; put in argument for PAGE UUO
   58200		MOVE T2, [XWD .PAGIO, T3]  ; set up call
 58300		PAGE. T2,		; shove out page
    58400		JRST OUTER		; didn't succeed - investigate
    58500	
  58600		; we have shoved the page out OK.
   58700		; T1 = pageno
   58800		TRACE T1,<Shoved out OK>
  58900		PUSHJ P, GETBIT		; T1 = index, T2 = bit
  59000		ANDCAM T2, INMAP(T1)	; clear bit in INCORE map
59100		MOVEI T1, (T4)		; T1 := pageno
 59200		JRST SKPRET		; return
59300	
  59400	OUTER:	; here if we couldn't shove the page out - PAGE UUO failed
       59500		; error code is in T2
59600		CAIN T2, PAGNS%		; VM swapping space used up?
 59700		JRST PFHNMS		; yes
   59800		CAIE T2, PAGSH%		; was the page in a sharable hiseg ?
   59900	OUTER1:	ERROR<OUTER1>		; no - then I don't know what to do
    60000	
  60100		; yes -the hiseg is sharable.
  60200		; Make note, so that we don't bother to look at it again
60300		TRACE 0,<Sharable Hiseg>
  60400		MOVEI T1, 377		; pageno of highest page in lowseg
  60500		MOVEM T1, TOPPAG	; update TOPPAG
    60600		POPJ P,			; no candidates - nonskip return
    60700	
  60800	; end of subroutine OUTPAG
 60900	
  61000	PAGE
   61100	;**********************************************************************
 61200	;
 61300	; TIME
 61400	;
 61500	;**********************************************************************
 61600	
  61700	TIME:	; Subroutine
    61800		; We come here at regular intervals, determined by a SETUUO
  61900		; at initialisation time.
 62000		; Do accouting.
 62100		; throw out all candidate pages which have not been used in
  62200		; this timeslice.
    62300	
  62400		TRACE 0,<Time>
  62500	
  62600		MOVEI T1, FFLSTA
62700		CAME  T1, FORCFL	; were we forcing?
 62800		JRST  [	MOVEM T1, FORCFL	; yes - reset force level
 62900			JRST TIM2		; and don't shove more pages out
  63000		      ]
    63100	
  63200		; remove all candidate pages which haven't been shoved out yet
    63300		MOVEI T1, 1		; start looking at page 1
   63400	TIM1:	PUSHJ P, OUTPGN		; shove a page out
 63500		SKIPA			; none left - break out of loop
  63600		JRST TIM1		; loop
    63700	
  63800	TIM2:	; set up usedlasttime map
 63900		; USEDLASTTIME := USEDTHISTIME
 64000		HRLI T1, UTTMAP
 64100		HRRI T1, ULTMAP
 64200		BLT T1, ULTMAP+MAPSIZE-1
  64300	
  64400		; clear access bits for incore pages
64500		JRST CLRABS		; (and return direct to caller)
  64600	
  64700	; end of subroutine TIME
   64800	
  64900	
  65000	PAGE
   65100	;**********************************************************************
 65200	;
 65300	; CLRABS
    65400	;
 65500	;*********************************************************************
  65600	
  65700	CLRABS:	; Subroutine to clear access bits for incore pages
    65800		; This means that we can find out which pages have been
 65900		; accessed during each time interval, and thus we can
   66000		; determine a (hopefully) sensible working set.
    66100		;
66200		; We only clear access bits for potential candidates for
66300		; shoving out.
  66400		;
     66500		; nonskip return
66600	
  66700		TRACE 0,<Clear access bits>
    66800	
  66900		SETZM  ALIST 		; init alist count
   67000	
  67100		MOVEI T1, 1		; starting page for FINPAG
  67200	
  67300	CLR1:	MOVEI T2, 0		; force level - INCORE
 67400		PUSHJ P, FINPAG		; find a candidate page
 67500					; T1 = last page found
 67600					; T2 = 0 (force level)
 67700		JRST CLR2		; none left - exit
  67800		; T1 = pageno
   67900		; We put the page numbers in an array (ALIST) and clear
 68000		; them several at a time.  This reduces the number of
   68100		; PAGE. UUOs.
   68200		; The zero'th element of ALIST contains the number of
   68300		; pagenos in the list.
    68400		AOS T2, ALIST		; increment arglist index, and put it in T2
   68500		MOVE T3, T1		; T3 := pageno
    68600		HRLI T3, 600000		; set bit0 - clear access perm
    68700					;     bit1 - automatic access allow (6.03)
 68800		MOVEM T3, ALIST(T2)	; put arg in list
    68900		CAIL T2, ALSIZE-1	; is arglist full
 69000		PUSHJ P, CLRALL		; yes - clear the pages we have so far
 69100		AOJA T1, CLR1		; loop for next page (T1 is still pageno)
69200	
  69300	CLR2:	; here when we are finished
    69400		SKIPE ALIST		; unless arg list is empty
  69500		PUSHJ P, CLRALL		; clear access for pages left in list
  69600		POPJ P,			; return
   69700	
  69800	; end of subroutine CLRABS
 69900	
  70000	PAGE
   70100	
  70200	
  70300	
  70400	CLRALL:	; subroutine to clear the access bits for all the pages
    70500		; in ALIST in one go
 70600		; T1, T3 and T4 are not altered
70700		; T2 is overwritten
  70800		; nonskip return
70900	
  71000		TRACE 0,<Clear list>
 71100	
  71200		MOVE T2, [XWD .PAGAA, ALIST] ; set up call
    71300		PAGE. T2,		; clear access bits
 71400	CLERR:	ERROR<CLERR>		; oops!
    71500		SETZM ALIST		; zero index
 71600		POPJ P,			; return
   71700	
  71800	; end of subroutine CLRALL
 71900	
  72000	
  72100	PAGE
   72200	;*****************************************************************
 72300	;
 72400	; FINPAG
    72500	;
 72600	;*****************************************************************
 72700	
  72800	FINPAG:	; subroutine to find a candidate page
  72900		; T1 = pageno to start looking at.  This must be a valid pageno
   73000		; T2 = force level (see explanation below)
    73100		; we consider all pages between T1 and TOPPAG as candidates
  73200		; T1,T2,T3,T4 overwritten
 73300		; skip return if candidate is found - T1 = candidate
    73400		; nonskip return if no candidate found
   73500	
  73600	
  73700		; The force level has the following effect
    73800		; forcelevel = 0  - consider all incore pages as candidates
  73900		; forcelevel = 1  - consider all incore pages which haven't been
  74000		;			accessed in the last time slot
  74100		; forcelevel = 2  - consider all incore pages which haven't been
  74200		;			accessed in the last two time slots
  74300		;
74400		; In any case we ignore pages which are not swapout possibilities
 74500		;
74600		; page containing PC of fault
  74700		; PFH page(s)   (if resident)
  74800		; DDT pages if we are debugging the PFH
  74900		; page containing APR trap word
75000		; page(s) containing Interrupt vector
    75100		; page(s) containing PSI vectors
    75200		; page(s) to which the pfh iis doing dump-mode I/O
 75300		;
75400		; The caller must ensure that we don't look at page zero (i.e. T1 gt 0)
75500		; and that we don't look at page 777 for a VMX handler or a page in
    75600		; a sharable hiseg (i.e. TOPPAG sensible).
    75700	
  75800		TRACE T1,<Find candidate>
 75900	
  76000		DMOVEM T1, FPSTP	; save start and force level values
    76100		IDIVI T1, 44		; T1 := index into bitmap of start page
   76200		MOVEM T1, FPINDX	; save it as well
  76300		JRST FPAG2		; skip over beginning of loop
76400	
  76500	FPAGL1:	; beginning of main loop
76600		; here to find next word in bitmap
  76700		; T1,T2,T3,T4 unknown
76800		AOS T1, FPINDX		; increment index and put it into T1
    76900	
  77000	FPAG2:	; T1 = index into bitmap
 77100		; T2,T3,T4 rubbish
   77200		; find a bitword of candidates
 77300		MOVE T3, INMAP(T1)	; T3 := INCORE
   77400		SKIPLE T2, FPLEV	; if forcelevel gt 0
    77500		ANDCM T3, UTTMAP(T1)	;    /\ NOT USED-THIS-TIME
    77600		CAILE T2, 1		; if forcelevel gt 1
   77700		ANDCM T3, ULTMAP(T1)	;    /\ NOT USED-LAST-TIME
    77800	
  77900	FPAGL2:	; beginning of inner loop
    78000		; here to find next nonzero bit in bitword
    78100		; T3 = bitword
  78200		; T1,T2,T4, unknown
  78300		JFFO T3, .+1		; T3 unchanged, T4 := bitno of nonzero bit
78400	
  78500		; The order of the following instructions is important
  78600		; If they are shuffled around the PFH may get into a loop.
   78700	
  78800		; calculate page number
   78900		MOVE T1, FPINDX		; T1 := index into bitmap
    79000		IMULI T1, 44		; T1:= pageno of bit 0 of candidate word
  79100		ADDI T1, (T4)		; T1:= pageno corresponding to nonzero bit
    79200	
  79300		; T1 = page number
   79400		; T3 = candidate bitword
  79500		; T4 = bit number
    79600		; T2 unknown
    79700		CAMLE T1, TOPPAG	; pageno gt end?
   79800		POPJ P, 		; yes - end of loop - error return
  79900	
  80000		JUMPE T3, FPAGL1	; if candidate word is empty get next
  80100					; (This test must come after the
 80200					; test for end of loop)
80300	
  80400		; remove bit from candidate word
    80500		MOVNI T4, (T4)		; T4 :=  -bitno
80600		MOVEI T2, 1		; T2 := bit35
80700		LSH T2, 43(T4)		; shift it left 35-bitno  places
   80800		ANDCM T3, T2		; remove bit from candidate word
80900	
  81000		CAMGE T1, FPSTP		; is pageno gt startpage
81100		JRST FPAGL2		; yes - go on to next candidate
  81200		; (This test is necessary because
   81300		; we start at the left hand end of the first word.
 81400		; It must come after removal of the bit
  81500		; from candidate word or we will loop forever.)
    81600	
  81700		; T1 = pageno
   81800		;	1 le T1 le TOPPAG le 777
81900		; T3 = candidate bitword
  82000		; T2,T4 rubbish
 82100	
  82200		; now check if this page is special in some way
    82300	
  82400		TRACE T1,<Candidate>
 82500	
  82600		MOVE T2, FPC		; PC at page fault
    82700		HRLI T2, (T2)		; T2 = [address,,address]
 82800		PUSHJ P, BADPGS		; check if it is this page
   82900	
  83000		; is this page part of the PFH?
83100		MOVE T2, .JBPFH		; T2 := [last address,,first address]
  83200		PUSHJ P, BADPGS		; check if this page is part of pfh?
   83300	
  83400	IFN FTTEST<
 83500		; if we are debugging the pfh then don't shove DDT pages out
 83600		SKIPN T2, .JBDDT	; is DDT alive?   T2 := DDT addresses
  83700		JRST FPAGT1		; no - continue
   83800		PUSHJ P, BADPGS		; check
  83900	> ; end IFN FTTEST
    84000	
  84100	FPAGT1:	; check for APR interrupt address
 84200		SKIPN T2, .JBAPR	; APR trapping?  T2 := APR trap address
84300		JRST FPAGT2		; no - continue
   84400		HRLI T2, (T2)		; T2 := [address,,address]
84500		PUSHJ P, BADPGS		; is this the APR page?
 84600	
  84700	FPAGT2:	; check for the interrupt vector
  84800		SKIPN T2, .JBINT	; Interrupt handling?  T2 := interrupt vec adr.
  84900		JRST FPAGT3		; no - continue
   85000		HRLI T2, (T2)		; copy address into Left half
  85100		ADD T2, [3,,0]		; lh := address of highest word in vector
    85200		PUSHJ P, BADPGS		; is this an interrupt vector page?
    85300	
  85400	FPAGT3:	; check for PSI interrupt vectors
 85500		SKIPN T2, PSIVEC	; user enabled for PSI interrupts?
85600		JRST FPAGT4		; no - continue
   85700		; Format of T2 is
    85800		; bits 0-8   index of highest PSI block
  85900		; rh         address of PSI vector
  86000		LSH T2, -31		; shift T2 25 places to the right
86100		; T2 is now bits 0-10 of the PSIVEC value
86200		; i.e. it is  (index of highest PSI block)*4   (maybe +something)
 86300		;  = offset of highest PSI block  (they are 4 words long)
    86400		ADDI T2, 3		; offset of last word of last block
    86500		ADD T2, PSIVEC		; address of last PSI word
    86600		HRLI T2, (T2)		; into left half
86700		HRR T2, PSIVEC		; starting address into right half
 86800		PUSHJ P, BADPGS		; does this page contain PSI interrupt block?
    86900	
  87000	FPAGT4:	; Check whether this is a page to which the PFH
  87100		; is trying to do dump-mode IO
 87200		SKIPN T2, DMPADS		; doing dump-mode IO for user?
   87300		JRST FPAGT5			; no - continue
  87400		PUSHJ P, BADPGS			; check if this is in use
   87500	
  87600	FPAGT5:	; EUREKA!!!
   87700		TRACE T1,<Candidate found>
87800		JRST SKPRET		; success return
  87900					; T1 = pageno
88000	
  88100	
  88200	PAGE
   88300	
  88400	
  88500	
  88600	BADPGS:	; dirty subroutine to check whether a page contains all or part
 88700		; of a vector.
  88800		; T1 = pageno
   88900		; T2 = [highest address of vector,,lowest address of vector]
 89000		; T2,T4 are overwritten
   89100		; T1,T3 preserved
    89200		; if page contains all or part of vector we pop the return address
89300		; off the stack and jump direct to FPAGL2
89400		; nonskip return otherwise
89500	
  89600		LDB T4, [POINT 9,T2,26]	; pageno of lowest address
 89700		LSH T2, -33		; pageno of highest address
 89800		CAIG T1, (T2)		; if T1 gt highest pageno
 89900		CAIGE T1, (T4)		; or if T1 lt lowest pageno
   90000		POPJ P,			;    then we are OK
  90100		; no good - lowest page le T1 le highest
 90200		POP P, T4		; remove return address from stack
 90300		JRST FPAGL2		; and try next candidate
    90400	
  90500	; end of subroutine BADPGS
 90600	
  90700	; end of subroutine FINPAG
 90800	
  90900	
  91000	PAGE
   91100	;******************************************************************
91200	;
 91300	; GETUUO
    91400	;
 91500	;******************************************************************
91600	
  91700	GETUUO:	; Subroutine to get a UUO argument into core
91800		; PN = Page number
   91900		;
92000		; The subroutine checks whether the user program has
    92100		; got into a page fault loop trying to do dump-mode I/O
 92200		; to more core than his physical allowance.
   92300		; In this case the pfh simulates the I/O a page at a time.
   92400	
  92500		TRACE PN,<Fault on page for UUO>
    92600	
  92700		MOVE T1, FPC		; PC for this fault
   92800		CAMN T1, LASTPC		; same as PC for previous fault ?
 92900		JRST GUUO1		; yes
    93000	
  93100					; no - we are not in a page fault loop
93200		MOVEM T1, LASTPC	; remember this PC for next time
  93300		MOVEI T1, 30
    93400		MOVEM T1, LPCCT		; reset counter
    93500		JRST GETIN		; get the page in
  93600					; (and return direct to caller)
  93700	
  93800	GUUO1:	SOSLE T2, LPCCT		; have the last 24 faults all been from
    93900					; the same PC?
    94000		JRST GETIN		; no - get page (and return direct to caller)
    94100		JUMPN T2, GUUO2		; yes - is this the 24'th fault?
  94200		PUSHJ P, CHKIOD		; yes - is it a dump-mode I/O instruction?
  94300		JRST SIMDMP		; yes - go and simulate I/O for user
  94400					; (return direct to caller)
 94500	GUUO2:	; no - the last 24 (or more) faults have all been from the same PC
    94600		; but it isn't a dump-mode I/O instruction. (Or it is not
    94700		; one which we feel confident to simulate.)
   94800		; It is conceivable that he isn't actually in a loop
    94900		; in which case we don't want to kill his program
  95000		; so we let him continue until we are absolutely certain.
    95100		CAMGE T2, [-140]	; have the last 100 page faults all been
    95200					; from the same PC
95300		PUSHJ P, TOSMAL		; yes - tell him he is too small
  95400					; if he continues he may have got more core
95500		JRST GETIN		; keep trying - get the page in
   95600					; (and return direct to caller)
  95700	
  95800	; end of subroutine GETUUO
 95900	
  96000	
  96100	PAGE
   96200	;***************************************************************************
 96300	;
 96400	; CHKIOD
    96500	;
 96600	;***************************************************************************
 96700	
  96800	CHKIOD:	; Subroutine to check whether the user program is trying to
96900		; do a dump-mode I/O instruction
    97000		; on entry T1 = PC
   97100		; Nonskip return if the user is doing dump-mode i/o to a "nice" device
 97200		;  with T2 = instruction
  97300		; Skip return if not dump-mode I/O
  97400		; In either case T1,T2,T3,T4 destroyed.
  97500		;
97600		; The criterion for a "nice" device is that it can do
   97700		; dump-mode I/O  1000 (octal) words at a time.
97800		; Devices allowed are disk, dectape
 97900		; magtape is allowed for record dump i/o only
 98000	
  98100		PUSHJ P, GETINS		; get instruction word
  98200					; T2 = instruction,  T3 = opcode
 98300		CAIE T3, 56		; is it IN ?
 98400		CAIN T3, 57		; or OUT ?
   98500		JRST CHD1		; yes
98600		CAIE T3, 66		; is it INPUT ?
   98700		CAIN T3, 67		; or OUTPUT ?
98800		JRST CHD1		; yes
98900		JRST SKPRET		; no - not an I/O instruction - skip return
99000	
  99100	CHD1:	; The instruction is an I/O instruction
  99200		LDB T4, [POINT 4,T2,12]	; T4 := channel number
99300		MOVE T3, [GETSTS 0, T1]	; inst we will XCT
    99400		DPB T4,[POINT 4,T3,12]	; put chan no in XCT word for GETSTS
  99500		XCT T3			; Do a GETSTS,   T1 := status
   99600		ANDI T1, 17		; T1 := mode
 99700		CAIGE T1, 16		; dump mode ? (16 or 17)
   99800		JRST SKPRET		; no - skip return
99900		DEVCHR T4,		; get characteristics