Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50263/pfhsno.mac
There are 2 other files named pfhsno.mac in the archive. Click here to see a list.
	TITLE PFHSNO

	ENTRY S$$PFZ

	SEARCH UUOSYM
	SEARCH S$$NDF
	SALL


;*******************************************************************
;
;DECSYSTEM-10 PAGE FAULT HANDLER.....MAY 1977
;
;REVISED VERSION JULY 1978
;ADAPTED FOR FASBOL LIBRARY  AUGUST 1978
;
;
;NIGEL DERRETT
;DATALOGISK AFDELING, MATEMATISK INSTITUT, AARHUS UNIVERSITY, DENMARK
;
;********************************************************************
;
;********************************************************************
;
;This page-fault handler uses a sort of "second chance" algorithm.
;Any pages which have not been accessed for 2 time-slots are regarded
;as candidates to be shoved out
;
;Fasbol programs overwrite the last 1k of core, so the standard
;page fault handler cannot be used.
;This handler should be loaded with the user program. It removes
;the system pfh, if present.
;
;Non-VM systems should set the switch P$VM in SDDNDF to zero;
;VM systems should set it to 1.
;Systems with both VM and non-VM users will need two versions of FASBOL
;and FASLIB.
;
;To initialise the page fault handler:
;	JSR S$$PFZ##
;No regs are altered.
;
;****************************************************************************


PAGE
;**********************************************************************
;
; DUMMY MODULE FOR NON-VM SYSTEMS
;
;**********************************************************************

IFE P$VM<
		; dummy code for non-vm systems

	S$$PFZ:	0
		JRSTF  @ S$$PFZ
>


IFN P$VM<

		; rest of pfh

PAGE
;**********************************************************************
;
; FEATURES
;
;**********************************************************************

	FTTEST=0	; switch for producing trace output
	FTSHOW=0	; switch for producing "hello" message
	FTNOTM=0	; switch to disable time interrupts
			; (useful for debugging)


PAGE
;************************************************************************
;
; CONSTANTS
;
;************************************************************************

; Registers
	T1=1
	T2=2
	T3=3
	T4=4
	PN=5	; page number
	P=6	; stack pointer

	; ***NOTE***
	; The entry code at START requires the regs to be in this order
	; GETIN, CREATE, and ACCESS require that PN = T4+1
	; Others require that T1-T4 are consecutive.


; Constants

IFN FTNOTM<
	TIMINT=0		; no time traps
>
IFE FTNOTM<
	TIMINT=1000		; interval between time traps
>

	FFLSTA=2		; initial force level

	MAPSIZE=17		; size of a page map
	PAGSIZ=1000		; size of a page

	ALSIZE=20		; size of argument list for CLRABS

IFN FTTEST<
	STKSIZ=40		; large stack when testing - for OUTNUM
>
IFE FTTEST<
	STKSIZ=20		; small stack normally
>


PAGE
;**********************************************************************
;
; MACROS
;
;**********************************************************************


DEFINE NOOP <JFCL 0,0>


IFN FTTEST<
DEFINE TRACE(AC, TEXT)<
IFN AC	<	IFN AC-T1 < EXCH T1, AC >
		PUSHJ P, OUTNUM
		IFN AC-T1 < EXCH T1, AC >
	>
	OUTSTR [ASCIZ/TEXT
/]
>> ; end IFN FTTEST


IFE FTTEST<
	DEFINE TRACE(AC,TXT)<>
>  ; end IFE FTTEST


IFN FTTEST<
DEFINE ERROR(TEXT)<
	JRST [	OUTSTR ERMST
		OUTSTR [ASCIZ/TEXT
/]
		HALT .
	     ]
>> ; end IFN FTTEST


IFE FTTEST<
DEFINE ERROR(TEXT)<
	HALT .
>> ; end IFE FTTEST


DEFINE MESSAGE(TEXT)<
	OUTSTR [ASCIZ/TEXT
/]
>


PAGE
;*****************************************************************
;
; ENTRY POINT FOR HANDLER WHEN A PAGE FAULT OCCURS
;
;*****************************************************************


; Here starteth the handler proper

PFHSTR:	JRST START
FPC:	0			; PC of page fault word
PFWD:	0			; page fault word
VTIME:	0			; virtual time elapsed
PGRATE:	0			; page rate
PSIVEC:	0			; PSI vectors
	BLOCK 3			; reserved by DEC


; Normal entry point
START:	SOSE  SEMAFO		; check whether we are in the PFH already
START1:	ERROR<START1>		; yes - error - the handler is not reentrant

	DMOVEM T1,SAVT1		; save accumulators which we will use
	DMOVEM T3,SAVT3		;
	DMOVEM PN,SAVPN		;
	MOVE P, STKWD		; Set up stack

	SKIPGE PFWD		; has WS changed ?
	PUSHJ P, REINIT		; yes - reinitialize

DISPCH:	HRRZ T1,PFWD		; get cause
	TRACE T1,<Cause of page fault>

	SOJE T1, DISP2		; Unless it is ALLOW-ACCESS
	; get an up-to-date version of the USEDTHISTIME map
	MOVE T2, [XWD .PAGGA, UTMBLK]
	PAGE. T2,		; get access allowed map
STAER2:	ERROR<STAER2>		; nasty!

DISP2:	; T1 = faulttype-1
	CAIGE T1, 4		; if cause is ZERO-PAGE
	CAIN T1, 1		; or non-uuo page not in core
	SETOM LASTPC		; then forget LASTPC
				; We are actually doing something useful
				; so we can't be in a dump-mode IO loop.

	LDB PN,[POINT 17,PFWD,17]; get page number for fault
	TRACE PN,<Fault page number>

	PUSHJ P, TABLE(T1)	; dispatch using fault type (T1 = faulttype-1)

	;back here after handliing fault
	DMOVE T1, SAVT1		; restore regs
	DMOVE T3, SAVT3		;
	DMOVE PN, SAVPN		;
	AOS SEMAFO		; reset semaphore
	JRSTF @FPC		; return to program

TABLE:	JRST ACCESS		; access not allowed
	JRST GETIN		; page not in core
	JRST GETUUO		; UUO argument not in core
	JRST TIME		; time trap
	JRST CREATE		; zero page
	JRST CREATE		; UUO zero page	



PAGE
;**********************************************************************
;
; INITIALISATION
;
;**********************************************************************

S$$PFZ:	; JSR here to initialise pfh
	0

	; Save regs
	DMOVEM T1, SAVT1
	DMOVEM T3, SAVT3
	DMOVEM PN, SAVPN
	MOVE P, STKWD		; set up stack

	TRACE 0,<Initialising PFH>

	IFE FTTEST<
	   IFN FTSHOW< MESSAGE<Fasbol PFH setup>
	>>

	; set up the bit maps

	; first get the WS
	MOVE T1, [XWD .PAGWS, INMBLK]
	PAGE. T1,		; get WS
INITE1:	ERROR<INITE1>		; should never happen

	; now set up the others
	MOVEI T1, MAPSIZE-1	; T1 is index into bitmap vectors
INIT1:	SETOM , ULTMAP(T1)	; set USEDLASTTIME map
	SOJGE T1, INIT1		; and loop
	; We mark all pages as USED-LAST-TIME so that they
	; don't get shoved out during the first timeslice.

	; USEDTHISTIME map is set up when it is needed.

	; set up flags
	MOVEI T1, FFLSTA	; initial force level
	MOVEM T1, FORCFL	; initialise force level
	SETOM  LASTPC		; LASTPC := nothing
	SETZM DMPADS		; not doing dump-mode IO
	SETZM SEMAFO		; initialise semaphore

	; ensure that I am in core before I take over from the system PFH.
	MOVEI T1, PFHSTR	; address of first word
INITA:	MOVE T2, (T1)		; access word - ensure that page is in core
	ADDI T1, PAGSIZ		; bump up address to point to next page
	CAIG T1, PFHEND		; all done?
	JRST INITA		; no - check next page
	MOVEI T1, PFHEND	; get end of loop right - check end addr is OK
	MOVE T2, (T1)		; access word

	; set up .JBPFH word in jobdat area to tell monitor we're here
	MOVE T1, [XWD PFHEND,PFHSTR]
	MOVEM T1, .JBPFH

	; remove old pfh from last 1K (if it is there)
	MOVE T1, [XWD .PAGCD, RPFLS1]	; set up call
	PAGE. T1,		; destroy page 776
	JRST [			; error return
		TRACE T1, <Error code from 776>
		JRST INIT2
	     ]
INIT2:	MOVE T1, [XWD .PAGCD, RPFLS2]	; set up call
	PAGE. T1,		; destroy page 777
	JRST [			; error return
		TRACE T1, <Error code from 777>
		JRST INIT3
	     ]
INIT3:
	
	; set up incore map again - without old pfh
	PUSHJ P, REINIT

	; clear access bits for incore pages
	PUSHJ P, CLRABS

	; set up timing interval
	MOVEI T1, TIMINT	; get timing interval
	HRLI T1, 26		; set up call of SETUUO
	SETUUO T1,		; set timing interval
STERR:	ERROR<STERR>		; oops!

	DMOVE T1, SAVT1		; restore regs
	DMOVE T3, SAVT3
	DMOVE P,  SAVPN
	AOS SEMAFO		; restore semaphore
	JRSTF  @S$$PFZ		; return to caller

; end of INIT code


PAGE
;************************************************************************
;
; REINIT
;
;************************************************************************

REINIT:	; subroutine
	; Who's been eating my porridge ?
	; Either the user or the monitor has altered the working set
	; (the PF.HCB bit was set).
	; This subroutine resets the INCORE bitmap
	; nonskip return

	TRACE 0,<WS changed - resetting>

	MOVE T1, [XWD .PAGWS, INMBLK]	; set up call
	PAGE. T1,		; INMAP := working set
REERR:	ERROR<REERR>		; HELP!
	POPJ P,			; That's all folks!

; end of subroutine REINIT


PAGE
;*********************************************************************
;
; GETIN
;
;*********************************************************************

GETIN:	; subroutine to get a page into core
	; page number in PN
	; nonskip return

	TRACE PN,<Fault on page>

	PUSHJ P, OUTPAG		; start by shoving somebody out
	NOOP			; nobody got shoved out, but never mind
				; we will try to increase the incore size
GETIN1:	MOVEI T4, 1		; put in arg for PAGE UUO
				; pageno is in PN
				; requires that T4 and PN are consecutive regs
	MOVE T1, [XWD .PAGIO, T4]  ; set up call
	PAGE. T1,		; get page into core
	JRST GETFC		; didn't suceed - force a page out

	; we have now got the page in - by fair means or foul
	TRACE PN,<In OK>

	; now set the bit in the INCORE map,
	PUSHJ P, MARKIN		;

	; allow access to the page
	JRST ACCESS		; and return direct to caller

GETFC:	; Here if we couldn't get the page in
	; error code in T1
	PUSHJ P, FORCE		; force a page out
	JRST GETIN1		; and try again


; end of subroutine GETIN


PAGE
;**********************************************************************
;
; CREATE
;
;**********************************************************************

CREATE:	; Subroutine to create a new page
	; pageno in PN
	; nonskip return

	TRACE PN,<Create page>

	; unlike GETIN we don't shove a page out first
	; we assume that the user is growing.
CREA1:	MOVEI T4, 1		; put in argument for PAGE UUO
				; pageno is in PN
				; requires that T4 and PN are consecutive regs
	MOVE T1, [XWD .PAGCD, T4]  ; set up call
	PAGE. T1,		; create page in core
	JRST CFORC		; didn't succeed - force a page out

	; we have now created the page - by fair means or foul
	TRACE PN,<Created OK>

	; now set the bit in the INCORE map,
	; we don't set access allowed, since he may be grabbing a large vector
	; and he may not use it for a while.
	JRST MARKIN		; and return direct to caller


CFORC:	; here if we weren't able to create a new page
	; T1 contains error code from PAGE UUO.

	; find out what went wrong
	CAIN T1, PAGNS%		; no more swapping space ?
	JRST PFHNMS		; yes
	PUSHJ P, FORCE		; no - try forcing a page out
				; T1 = error code
	JRST CREA1		; try again

; end of subroutine CREATE

PAGE
;****************************************************************************
;
; FORCE
;
;****************************************************************************

FORCE:	; subroutine to force pages out in order to get one in, or to
	; create a new one.
	; on entry  T1 = error code from PAGE. UUO
	; nonskip return
	TRACE 0,<Forcing>

	CAIE T1, PAGLE%		; did we fail because of not enough
				; physical core?
FORCER:	ERROR<FORCER>		; no - then shoving out pages won't help.

	; yes - shove out page and try again

FORC1:	PUSHJ P, OUTPAG		; shove out a page
	SKIPA			; didn't succeed - continue
	POPJ P,			; page shoved out - return

	; there are no more candidate pages at this level of forcing
	; try more brutal methods
	SOSL FORCFL		; reduce forcing level
	JRST FORC1		; and loop unless it was already minimum

	; we are at the lowest level of forcing, and still we
	; can't find a candidate page
	; This user is just too small
	PUSHJ P, TOSMAL		; tell him the bad news
	; if he continues, then he may have got more core
	; so let the calling routine try again
	POPJ P,

; end of subroutine FORCE

PAGE
;**********************************************************************
;
; TOSMAL
;
;*********************************************************************

TOSMAL: ; Subroutine called when user hasn't got enough physical core
	; Normal return if user does a CONTINUE

PFHNEP:	MESSAGE<?PFHNEP - NOT ENOUGH PHYSICAL CORE>
	HALT .+1		; stop, and give him a chance to do
				; something about it
	; if he continues, then he may have got more core
	; so return to caller
	POPJ P,

; end of subroutine TOSMAL


PAGE
;**********************************************************************
;
; PFHNMS
;
;**********************************************************************

PFHNMS:	MESSAGE<?PFHNMS - NO MORE VM SWAPPING SPACE AVAILABLE>
	HALT .			; stop


PAGE
;**********************************************************************
;
; MARKIN
;
;**********************************************************************

MARKIN:	; subroutine
	; here if we have successfully got a page into core
	; This subroutine marks the page in the INCORE map.
	; nonskip return

	MOVE T1, PN		; T1 := page number
	PUSHJ P, GETBIT 	; T1 := index into bitmap, T2 := bit
	IORM T2, INMAP(T1)	; set bit in INCORE map
	POPJ P,			; return

; end of subroutine MARKIN


PAGE
;*************************************************************************
;
; ACCESS
;
;*************************************************************************

ACCESS: ; subroutine to allow access to a page
	; PN = page number
	; nonskip return

	TRACE PN,<Allow access to page>

	MOVEI T4, 1		; put in arg for PAGE UUO
				; PN is pageno
				; requires that T4 and PN are consecutive regs
	MOVE T1, [XWD .PAGAA, T4]  ; set up call
	PAGE. T1,		; allow acess to page
ACERR:	ERROR<ACERR>		; help!!
	POPJ P,			; all done

; end of subroutine ACCESS


PAGE
;************************************************************************
;
; OUTPAG and OUTPGN
;
;************************************************************************

	; Subroutines to shove a candidate page out
	; OUTPAG has no parameters, and starts looking for a candidate
	; at page 1
	; OUTPGN starts looking at pageno in T1
	; Skip return if OK, nonskip return if there were no candidates left.
	; all regs smashed

OUTPAG:	MOVEI T1, 1		; OUTPAG starts looking at page 1
OUTPGN:				; OUTPGN starts lookin at pageno in T1
	TRACE 0,<Shove someone out>
	MOVE T2, FORCFL		; param for FINPAG
	PUSHJ P, FINPAG		; find a candidate page
	POPJ P,			; no candidates - nonskip return

	; T1 contains the number of the page we are going to shove out
	TRACE T1,<Shove out page>
	MOVE T4, T1		; T4 := pageno
	HRLI T4, 400000		; set bit 0 (direction bit for PAGE UUO)
	MOVEI T3, 1		; put in argument for PAGE UUO
	MOVE T2, [XWD .PAGIO, T3]  ; set up call
	PAGE. T2,		; shove out page
	JRST OUTER		; didn't succeed - investigate

	; we have shoved the page out OK.
	; T1 = pageno
	TRACE T1,<Shoved out OK>
	PUSHJ P, GETBIT		; T1 = index, T2 = bit
	ANDCAM T2, INMAP(T1)	; clear bit in INCORE map
	MOVEI T1, (T4)		; T1 := pageno
	JRST SKPRET		; return

OUTER:	; here if we couldn't shove the page out - PAGE UUO failed
	; error code is in T2
	CAIN T2, PAGNS%		; VM swapping space used up?
	JRST PFHNMS		; yes
	CAIE T2, PAGSH%		; was the page in a sharable hiseg ?
OUTER1:	ERROR<OUTER1>		; no - then I don't know what to do

	; yes -the hiseg is sharable.
	; Make note, so that we don't bother to look at it again
	TRACE 0,<Sharable Hiseg>
	MOVEI T1, 377		; pageno of highest page in lowseg
	MOVEM T1, TOPPAG	; update TOPPAG
	POPJ P,			; no candidates - nonskip return

; end of subroutine OUTPAG

PAGE
;**********************************************************************
;
; TIME
;
;**********************************************************************

TIME:	; Subroutine
	; We come here at regular intervals, determined by a SETUUO
	; at initialisation time.
	; Do accouting.
	; throw out all candidate pages which have not been used in
	; this timeslice.

	TRACE 0,<Time>

	MOVEI T1, FFLSTA
	CAME  T1, FORCFL	; were we forcing?
	JRST  [	MOVEM T1, FORCFL	; yes - reset force level
		JRST TIM2		; and don't shove more pages out
	      ]

	; remove all candidate pages which haven't been shoved out yet
	MOVEI T1, 1		; start looking at page 1
TIM1:	PUSHJ P, OUTPGN		; shove a page out
	SKIPA			; none left - break out of loop
	JRST TIM1		; loop

TIM2:	; set up usedlasttime map
	; USEDLASTTIME := USEDTHISTIME
	HRLI T1, UTTMAP
	HRRI T1, ULTMAP
	BLT T1, ULTMAP+MAPSIZE-1

	; clear access bits for incore pages
	JRST CLRABS		; (and return direct to caller)

; end of subroutine TIME


PAGE
;**********************************************************************
;
; CLRABS
;
;*********************************************************************

CLRABS:	; Subroutine to clear access bits for incore pages
	; This means that we can find out which pages have been
	; accessed during each time interval, and thus we can
	; determine a (hopefully) sensible working set.
	;
	; We only clear access bits for potential candidates for
	; shoving out.
	;
	; nonskip return

	TRACE 0,<Clear access bits>

	SETZM  ALIST 		; init alist count

	MOVEI T1, 1		; starting page for FINPAG

CLR1:	MOVEI T2, 0		; force level - INCORE
	PUSHJ P, FINPAG		; find a candidate page
				; T1 = last page found
				; T2 = 0 (force level)
	JRST CLR2		; none left - exit
	; T1 = pageno
	; We put the page numbers in an array (ALIST) and clear
	; them several at a time.  This reduces the number of
	; PAGE. UUOs.
	; The zero'th element of ALIST contains the number of
	; pagenos in the list.
	AOS T2, ALIST		; increment arglist index, and put it in T2
	MOVE T3, T1		; T3 := pageno
	HRLI T3, 600000		; set bit0 - clear access perm
				;     bit1 - automatic access allow (6.03)
	MOVEM T3, ALIST(T2)	; put arg in list
	CAIL T2, ALSIZE-1	; is arglist full
	PUSHJ P, CLRALL		; yes - clear the pages we have so far
	AOJA T1, CLR1		; loop for next page (T1 is still pageno)

CLR2:	; here when we are finished
	SKIPE ALIST		; unless arg list is empty
	PUSHJ P, CLRALL		; clear access for pages left in list
	POPJ P,			; return

; end of subroutine CLRABS

PAGE



CLRALL:	; subroutine to clear the access bits for all the pages
	; in ALIST in one go
	; T1, T3 and T4 are not altered
	; T2 is overwritten
	; nonskip return

	TRACE 0,<Clear list>

	MOVE T2, [XWD .PAGAA, ALIST] ; set up call
	PAGE. T2,		; clear access bits
CLERR:	ERROR<CLERR>		; oops!
	SETZM ALIST		; zero index
	POPJ P,			; return

; end of subroutine CLRALL


PAGE
;*****************************************************************
;
; FINPAG
;
;*****************************************************************

FINPAG:	; subroutine to find a candidate page
	; T1 = pageno to start looking at.  This must be a valid pageno
	; T2 = force level (see explanation below)
	; we consider all pages between T1 and TOPPAG as candidates
	; T1,T2,T3,T4 overwritten
	; skip return if candidate is found - T1 = candidate
	; nonskip return if no candidate found


	; The force level has the following effect
	; forcelevel = 0  - consider all incore pages as candidates
	; forcelevel = 1  - consider all incore pages which haven't been
	;			accessed in the last time slot
	; forcelevel = 2  - consider all incore pages which haven't been
	;			accessed in the last two time slots
	;
	; In any case we ignore pages which are not swapout possibilities
	;
	; page containing PC of fault
	; PFH page(s)   (if resident)
	; DDT pages if we are debugging the PFH
	; page containing APR trap word
	; page(s) containing Interrupt vector
	; page(s) containing PSI vectors
	; page(s) to which the pfh iis doing dump-mode I/O
	;
	; The caller must ensure that we don't look at page zero (i.e. T1 gt 0)
	; and that we don't look at page 777 for a VMX handler or a page in
	; a sharable hiseg (i.e. TOPPAG sensible).

	TRACE T1,<Find candidate>

	DMOVEM T1, FPSTP	; save start and force level values
	IDIVI T1, 44		; T1 := index into bitmap of start page
	MOVEM T1, FPINDX	; save it as well
	JRST FPAG2		; skip over beginning of loop

FPAGL1:	; beginning of main loop
	; here to find next word in bitmap
	; T1,T2,T3,T4 unknown
	AOS T1, FPINDX		; increment index and put it into T1

FPAG2:	; T1 = index into bitmap
	; T2,T3,T4 rubbish
	; find a bitword of candidates
	MOVE T3, INMAP(T1)	; T3 := INCORE
	SKIPLE T2, FPLEV	; if forcelevel gt 0
	ANDCM T3, UTTMAP(T1)	;    /\ NOT USED-THIS-TIME
	CAILE T2, 1		; if forcelevel gt 1
	ANDCM T3, ULTMAP(T1)	;    /\ NOT USED-LAST-TIME

FPAGL2:	; beginning of inner loop
	; here to find next nonzero bit in bitword
	; T3 = bitword
	; T1,T2,T4, unknown
	JFFO T3, .+1		; T3 unchanged, T4 := bitno of nonzero bit

	; The order of the following instructions is important
	; If they are shuffled around the PFH may get into a loop.

	; calculate page number
	MOVE T1, FPINDX		; T1 := index into bitmap
	IMULI T1, 44		; T1:= pageno of bit 0 of candidate word
	ADDI T1, (T4)		; T1:= pageno corresponding to nonzero bit

	; T1 = page number
	; T3 = candidate bitword
	; T4 = bit number
	; T2 unknown
	CAMLE T1, TOPPAG	; pageno gt end?
	POPJ P, 		; yes - end of loop - error return

	JUMPE T3, FPAGL1	; if candidate word is empty get next
				; (This test must come after the
				; test for end of loop)

	; remove bit from candidate word
	MOVNI T4, (T4)		; T4 :=  -bitno
	MOVEI T2, 1		; T2 := bit35
	LSH T2, 43(T4)		; shift it left 35-bitno  places
	ANDCM T3, T2		; remove bit from candidate word

	CAMGE T1, FPSTP		; is pageno gt startpage
	JRST FPAGL2		; yes - go on to next candidate
	; (This test is necessary because
	; we start at the left hand end of the first word.
	; It must come after removal of the bit
	; from candidate word or we will loop forever.)

	; T1 = pageno
	;	1 le T1 le TOPPAG le 777
	; T3 = candidate bitword
	; T2,T4 rubbish

	; now check if this page is special in some way

	TRACE T1,<Candidate>

	MOVE T2, FPC		; PC at page fault
	HRLI T2, (T2)		; T2 = [address,,address]
	PUSHJ P, BADPGS		; check if it is this page

	; is this page part of the PFH?
	MOVE T2, .JBPFH		; T2 := [last address,,first address]
	PUSHJ P, BADPGS		; check if this page is part of pfh?

IFN FTTEST<
	; if we are debugging the pfh then don't shove DDT pages out
	SKIPN T2, .JBDDT	; is DDT alive?   T2 := DDT addresses
	JRST FPAGT1		; no - continue
	PUSHJ P, BADPGS		; check
> ; end IFN FTTEST

FPAGT1:	; check for APR interrupt address
	SKIPN T2, .JBAPR	; APR trapping?  T2 := APR trap address
	JRST FPAGT2		; no - continue
	HRLI T2, (T2)		; T2 := [address,,address]
	PUSHJ P, BADPGS		; is this the APR page?

FPAGT2:	; check for the interrupt vector
	SKIPN T2, .JBINT	; Interrupt handling?  T2 := interrupt vec adr.
	JRST FPAGT3		; no - continue
	HRLI T2, (T2)		; copy address into Left half
	ADD T2, [3,,0]		; lh := address of highest word in vector
	PUSHJ P, BADPGS		; is this an interrupt vector page?

FPAGT3:	; check for PSI interrupt vectors
	SKIPN T2, PSIVEC	; user enabled for PSI interrupts?
	JRST FPAGT4		; no - continue
	; Format of T2 is
	; bits 0-8   index of highest PSI block
	; rh         address of PSI vector
	LSH T2, -31		; shift T2 25 places to the right
	; T2 is now bits 0-10 of the PSIVEC value
	; i.e. it is  (index of highest PSI block)*4   (maybe +something)
	;  = offset of highest PSI block  (they are 4 words long)
	ADDI T2, 3		; offset of last word of last block
	ADD T2, PSIVEC		; address of last PSI word
	HRLI T2, (T2)		; into left half
	HRR T2, PSIVEC		; starting address into right half
	PUSHJ P, BADPGS		; does this page contain PSI interrupt block?

FPAGT4:	; Check whether this is a page to which the PFH
	; is trying to do dump-mode IO
	SKIPN T2, DMPADS		; doing dump-mode IO for user?
	JRST FPAGT5			; no - continue
	PUSHJ P, BADPGS			; check if this is in use

FPAGT5:	; EUREKA!!!
	TRACE T1,<Candidate found>
	JRST SKPRET		; success return
				; T1 = pageno


PAGE



BADPGS:	; dirty subroutine to check whether a page contains all or part
	; of a vector.
	; T1 = pageno
	; T2 = [highest address of vector,,lowest address of vector]
	; T2,T4 are overwritten
	; T1,T3 preserved
	; if page contains all or part of vector we pop the return address
	; off the stack and jump direct to FPAGL2
	; nonskip return otherwise

	LDB T4, [POINT 9,T2,26]	; pageno of lowest address
	LSH T2, -33		; pageno of highest address
	CAIG T1, (T2)		; if T1 gt highest pageno
	CAIGE T1, (T4)		; or if T1 lt lowest pageno
	POPJ P,			;    then we are OK
	; no good - lowest page le T1 le highest
	POP P, T4		; remove return address from stack
	JRST FPAGL2		; and try next candidate

; end of subroutine BADPGS

; end of subroutine FINPAG


PAGE
;******************************************************************
;
; GETUUO
;
;******************************************************************

GETUUO:	; Subroutine to get a UUO argument into core
	; PN = Page number
	;
	; The subroutine checks whether the user program has
	; got into a page fault loop trying to do dump-mode I/O
	; to more core than his physical allowance.
	; In this case the pfh simulates the I/O a page at a time.

	TRACE PN,<Fault on page for UUO>

	MOVE T1, FPC		; PC for this fault
	CAMN T1, LASTPC		; same as PC for previous fault ?
	JRST GUUO1		; yes

				; no - we are not in a page fault loop
	MOVEM T1, LASTPC	; remember this PC for next time
	MOVEI T1, 30
	MOVEM T1, LPCCT		; reset counter
	JRST GETIN		; get the page in
				; (and return direct to caller)

GUUO1:	SOSLE T2, LPCCT		; have the last 24 faults all been from
				; the same PC?
	JRST GETIN		; no - get page (and return direct to caller)
	JUMPN T2, GUUO2		; yes - is this the 24'th fault?
	PUSHJ P, CHKIOD		; yes - is it a dump-mode I/O instruction?
	JRST SIMDMP		; yes - go and simulate I/O for user
				; (return direct to caller)
GUUO2:	; no - the last 24 (or more) faults have all been from the same PC
	; but it isn't a dump-mode I/O instruction. (Or it is not
	; one which we feel confident to simulate.)
	; It is conceivable that he isn't actually in a loop
	; in which case we don't want to kill his program
	; so we let him continue until we are absolutely certain.
	CAMGE T2, [-140]	; have the last 100 page faults all been
				; from the same PC
	PUSHJ P, TOSMAL		; yes - tell him he is too small
				; if he continues he may have got more core
	JRST GETIN		; keep trying - get the page in
				; (and return direct to caller)

; end of subroutine GETUUO


PAGE
;***************************************************************************
;
; CHKIOD
;
;***************************************************************************

CHKIOD:	; Subroutine to check whether the user program is trying to
	; do a dump-mode I/O instruction
	; on entry T1 = PC
	; Nonskip return if the user is doing dump-mode i/o to a "nice" device
	;  with T2 = instruction
	; Skip return if not dump-mode I/O
	; In either case T1,T2,T3,T4 destroyed.
	;
	; The criterion for a "nice" device is that it can do
	; dump-mode I/O  1000 (octal) words at a time.
	; Devices allowed are disk, dectape
	; magtape is allowed for record dump i/o only

	PUSHJ P, GETINS		; get instruction word
				; T2 = instruction,  T3 = opcode
	CAIE T3, 56		; is it IN ?
	CAIN T3, 57		; or OUT ?
	JRST CHD1		; yes
	CAIE T3, 66		; is it INPUT ?
	CAIN T3, 67		; or OUTPUT ?
	JRST CHD1		; yes
	JRST SKPRET		; no - not an I/O instruction - skip return

CHD1:	; The instruction is an I/O instruction
	LDB T4, [POINT 4,T2,12]	; T4 := channel number
	MOVE T3, [GETSTS 0, T1]	; inst we will XCT
	DPB T4,[POINT 4,T3,12]	; put chan no in XCT word for GETSTS
	XCT T3			; Do a GETSTS,   T1 := status
	ANDI T1, 17		; T1 := mode
	CAIGE T1, 16		; dump mode ? (16 or 17)
	JRST SKPRET		; no - skip return
	DEVCHR T4,		; get characteristics
	TLNE T4, 200100		; is this a "nice" device ?
				;   disc
				;   dectape
	POPJ P,			; yes - nonskip return
	TLNE T4, 000020		; is it a magtape ?
	CAIE T1, 16		; and is data mode record dump ?
	JRST SKPRET		; no - skip return
	POPJ P,			; yes - nonskip return

; end of subroutine CHKIOD

PAGE
;*************************************************************************
;
; SIMDMP
;
;*************************************************************************

SIMDMP:	; Subroutine to simulate dump-mode I/O for user
	; We split up his I/O command list, and do it 1 page at a time.
	; On entry  T2 = instruction

	TRACE 0,<Simulating Dump mode IO>

	LDB T1, [POINT 13,T2,12]	; get opcode and channel
	DPB T1, [POINT 13,MYIOIN,12]	; set up I/O instruction for XCT
	PUSHJ P, GETEA		; T1 := effective address

SIMDL1:	; Beginning of main loop
	; T1 = address of command list entry
	PUSHJ P, GETWD		; T2 := command list entry
	JUMPE T2, SIMEND	; all finished ?
	JUMPL T2, SIMDL2	; is this an IOWD or a GOTO?
	MOVEI T1, (T2)		; it is a GOTO  T1 := address
	JRST SIMDL1		; loop

SIMDL2:	; Beginning of inner loop
	; Here when T2 is a genuine IOWD
	; T2 = -LEN,,ADR
	DMOVEM T1, SIMSVR	; save T1,T2
	HLRE T1, T2		; T1 := -LEN
	CAMG T1, [-PAGSIZ]	; LEN gt 1000 ?
	MOVNI T1, PAGSIZ	; yes - transfer 1 page only
	HRLI T2, (T1)		; new -LEN into T2
	MOVEM T2, MYIOWD	; set up I/O instruction

	; now get the page(s) addressed by my IOWD into core
	SETCA T1,		; T1 := LEN-1
	ADDI T1, (T2)		; T1 := highest address referenced
	HRLM T1, DMPADS		; put it in LH of DMPADS
	HRRM T2, DMPADS		; lowest address in  RH
				; tells FINPAG not to shove these pages out
	PUSHJ P, GETWD		; make sure highest address page is in core
	HRR T1, DMPADS		; lowest address
	PUSHJ P, GETWD		; make sure page is in core
	DMOVE T1, SIMSVR	; restore T1=address, T2=IOWD

	; now do the partial IO
	XCT MYIOIN		; do it
	SKIPA			; nonskip return - continue
	JRST SIMDME		; skip return - error
	ADD T2, [PAGSIZ,,PAGSIZ]	; increment IOWD
	JUMPL T2, SIMDL2	; if there is still something to do
				; then loop

	; we are finished with this IOWD
	AOJA T1, SIMDL1		; go on to next word in command list


SIMDME:	; here if we got an error return from the I/O instruction
	AOS  FPC		; pass on skip return to user prog

SIMEND:	; here when we are finished simulating the I/O
	AOS T1, FPC		; return to user PC +1
	SETZM DMPADS		; tell FINPAG we are finished
	PUSHJ P, GETINS		; get the instruction
				; This ensures that we don't get a
				; pagefault when we try to return
				; to the user prog
	POPJ P,			; all done

; end of subroutine SIMDMP


PAGE
;*******************************************************************
;
; GETWD
;
;*******************************************************************

GETWD:	; Subroutine to get the contents of an address
	; It checks whether the address is one of the regs we
	; have saved, and ensures that the page is in core
	; on entry T1 = address
	; nonskip return with T1= address, T2 = contents
	; T3,T4 destroyed

	CAIL T1, T1		; is this one of the regs we have saved ?
	CAILE T1, P		;
	JRST GETWD1		; no - continue

	MOVE T2, SAVT1-1(T1)	; yes - get saved value
	POPJ P,			; and return

GETWD1:	PUSH P, PN		; save PN
	PUSH P, T1		; save address
	LSH T1, -11		; pageno into T1
	MOVEI PN, (T1)		; and PN
	HRLI T1, .PAGCA		; set up call of PAGE. UUO
	PAGE. T1,		; get access bits for page
GEWER:	ERROR<GEWER>		; oops!
	TLNE T1, 020000		; is it allocated but zero?
	JRST [	PUSHJ P, CREATE	; yes - create it in core
		JRST GETWD2 ]	; and allow access
	TLNE T1, 004000		; is it paged out?
	JRST [	PUSHJ P, GETIN	; yes - get it in
		JRST GETWD3 ]	; and carry on
	TLNN T1, 040000		; is access allowed?
GETWD2:	PUSHJ P, ACCESS		; no - allow it

GETWD3:	; here when the page is in core and accessible
	POP P, T1		; T1 := address
	MOVE T2, (T1)		; contents
	POP P, PN		; restore PN
	POPJ P,			; return

; end of subroutine GETWRD


PAGE
;*********************************************************************
;
; GETEA
;
;*********************************************************************

GETEA: ; subroutine to calculate the effective address of an instruction
	; on input T2 = inst, which can contain indirection bit and acc field
	; nonskip return
	; T1 = effective address
	; T2,T3,T4 smashed

	LDB T1, [POINT 4,T2,17]	; get acc field
	JUMPE T1, GETEA1	; unless it is zero

	PUSH P, T2		; save instruction
	PUSHJ P, GETWD		; T2 := contents of acc
	POP P, T1		; T1 := instruction
	ADDI T2, (T1)		; add address field to accumulator contents
	HLL T2, T1		; T2 is instruction with new address part

GETEA1:	TLNN T2, 000020		; indirection bit set ?
	JRST GETEA2		; no - continue
	MOVEI T1, (T2)		; get adr
	PUSHJ P, GETWD		; T2 := contents
	JRST GETEA		; and loop

GETEA2:	; all done - RH of T2 contains effective address
	MOVEI T1, (T2)		; T1 := EA
	POPJ P,			; return

; end of subroutine GETEA

PAGE
;**************************************************************************
;
; GETINS
;
;**************************************************************************

GETINS:	; Subroutine to get an instruction
	; It unwinds an XCT instruction

	; on entry T1 = PC
	; nonskip return
	; T2 = instruction
	; T3 = opcode

	PUSHJ P, GETWD		; T2 := instruction
	LDB T3, [POINT 9,T2,8]	; T3 :=  opcode
	CAIE T3, 256		; is it an XCT ?
	POPJ P,			; no - all done
	PUSHJ P, GETEA		; T1 := effective address
	JRST GETINS		; and loop

; end of subroutine GETINS

PAGE

;******************************************************************
;
; GETBIT
;
;******************************************************************

GETBIT:	; subroutine to calculate the index into the bitmap
	; and the bit corresponding to a page number.
	; page number in T1
	; on return T1 is index, T2 is bit
	; T3 overwritten, T4 preserved
	; nonskip return

	IDIVI T1, 44	; bit number in T2, index in T1
	MOVN T3, T2	; negative shift count into T3
	MOVEI T2, 1	; T2 := bit35
	LSH T2, 43(T3)	; shift bit left (35-bitnumber) places
	POPJ P,		; return

; end of subroutine GETBIT


PAGE
;******************************************************************
;
; SKPRET
;
;******************************************************************

SKPRET:	; JRST SKPRET is the same as doing a skip return

	AOS (P)		; set up skip return
	POPJ P,		; do it

; end of SKPRET


PAGE
;*****************************************************************
;
; OUTNUM
;
;*****************************************************************

IFN FTTEST<

OUTNUM:	; subroutine used by the TRACE macro to print a number on the TTY
	; argument is in T1
	; it is printed in the form  "LH,,RH - "
	; nonskip return
	; no regs are altered (not even T1)

	PUSH P, T1		; save T1
	HLRZ T1, T1		; get left half of argument
	PUSHJ P, POCT		; print it
	OUTSTR [ASCIZ/,,/]	; make output pretty
	HRRZ T1, (P)		; get right half of argument from
				; where we stored it on the stack
	PUSHJ P, POCT		; print it
	OUTSTR [ASCIZ/ - /]	; more pretty-print
	POP P, T1		; restore T1
	POPJ P,			; return

; end of subroutine OUTNUM


POCT:	; subroutine to print an 18-bit octal number
	; argument is in T1
	; T1 is destroyed, but no other regs are altered
	; nonskip return

	PUSH P, T2		; save T2
	IDIVI T1, 10		; T1 := T1/8 ; T2 := T1 modulo 8
	SKIPE ,T1		; any leading digits
	PUSHJ P, POCT		; yes - print them recursively
	ADDI T2, "0"		; convert digit to ascii
	OUTCHR T2		; print it
	POP P, T2		; restore T2
	POPJ P,			; return

; end of subroutine POCT


> ;end of IFN FTTEST


PAGE
;****************************************************************
;
; DATA AREA
;
;****************************************************************

SAVT1:	BLOCK 2		; register save area
SAVT3:	BLOCK 2
SAVPN:	BLOCK 2

FORCFL:	BLOCK 1		; current forcing level
SEMAFO: EXP 1		; semaphore
LASTPC:	BLOCK 1		; PC of last page fault - to check for loops
LPCCT:	BLOCK 1		; Number of times we have pagefaulted at the same PC
DMPADS:	BLOCK 1		; points to pages involved in dump I/O

FPSTP:	BLOCK 1		; private variables for FPAG
FPLEV:	BLOCK 1		; FPLEV must come immediately after FPSTP
FPINDX:	BLOCK 1

MYIOIN:	IN 0, MYIOWD	; IO instruction we will XCT for dump-mode IO
MYIOWD: BLOCK 1		; IO command list
	EXP 0		; end of IO command list

SIMSVR:	BLOCK 2

TOPPAG:	EXP 777		; highest possible candidate page no
STKWD:	IOWD STKSIZ,STACK
STACK:	BLOCK STKSIZ

UTMBLK:	EXP MAPSIZE
UTTMAP:	BLOCK MAPSIZE	; pages used in this time slice
ULTMAP:	BLOCK MAPSIZE	; pages used in last time slice
INMBLK:	EXP MAPSIZE
INMAP:	BLOCK MAPSIZE	; pages currently in core (working set)

ALIST:	BLOCK ALSIZE+1	; arglist for CLRABS
RPFLS1:	EXP 1		; arglist used for removing old pfh
	EXP 400000000776
RPFLS2:	EXP 1
	EXP 400000000777

IFN FTTEST<
ERMST:	ASCIZ/?PFHERR - PFH ERROR: /
>
PAGE
	LIT
PAGE
	PFHEND=.+1

> ; IFN P$VM

	END