TITLE CORE1 - LOGICAL AND PHYSICAL CORE ALLOCATION ROUTINES - V714
SUBTTL T. HASTINGS/TH/RCC/CHW/JMF/DAL 20-JUL-88
	SEARCH	F,S
	$RELOC
	$HIGH



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;  OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988.
;ALL RIGHTS RESERVED.

.CPYRT<1973,1988>

XP VCORE1,714
			;THIS MACRO PUTS VERSION NO. IN STORAGE MAP AND GLOB

	ENTRY	CORE1		;ALWAYS LOAD CORE1(FOR LIB SEARCH)


;CORE ALLOCATION IS DONE ON A 1K BLOCK BASIS
;USING A USE BIT TABLE(CORTAB).  EACH 1K BLOCK IS REPRESENTED BY A 1 OR 2
;BIT ENTRY IN CORTAB (2 BITS IF THE LOCK UUO IS INCLUDED IN THE SYSTEM)
;A ZERO ENTRY MEANS BLOCK NOT IN USE
;A NON-ZERO ENTRY INDICATES MEMORY IN USE AS FOLLOWS:
;(NUMBERS IN BRACKETS INDICATE CONTENTS OF ENTRIES IN CORTAB IN THE FOLLOWING FORMAT
;[CONTENTS OF CORTAB IN SYSTEM NOT INCLUDING LOCK UUO, CONTENTS OF CORTAB
;IN SYSTEM INCLUDING LOCK UUO]

; 1. IN USE BY MONITOR [1,2]
; 2. IN USE BY A LOCKED JOB [-,2]
; 3. IN USE BY A JOB NOT LOCKED [1,1]
; 4. NON-EXISTANT [1,2]

;WHEN THE SYSTEM IS STARTED, SYSINI SETS THE CORTAB TABLE
;IT ALSO SETS A BYTE POINTER(CORLST) WHICH POINTS TO THE
;LOWEST NON-EXISTANT BLOCK IMMEDIATELY ABOVE THE HIGHEST
;EXISTANT BLOCK. IT ALSO SETS CORTAL TO THE NO. OF
;FREE BLOCKS AVAILABLE.
;THE CORE1 ROUTINE ASSIGNS CORE IF POSSIBLE, SETS THE USE BITS,
;AND MOVES THE JOB IF NEW ASSIGNMENT IS A DIFFERENT PLACE THAN OLD
;THE JBTADR TABLE IS ALSO UPDATED BY THE CORE ROUTINES
;LH=PROTECTION,RH=RELOCATION
;JOBADR IS MODIFIED IF CORE FOR CURRENT JOB
;HARDWARE RELOC. AND PROTEC. ARE RESET IF CURRENT JOB
;FINALLY JOBREL(PROTECTION) IN JOB DATA AREA IS ALWAYS UPDATED

;LIST OF GLOBALS AFFECTED:
;JBTADR,CORTAL,CORTAB,HOLEF,SHFWAT,JOBADR,HOLES

;CORE UUO
;CALL:	MOVEI	AC,HIGHEST REL. ADR. DESIRED IN LOW SEG
;	HRLI	AC,HIGHEST REL. ADR. DESIRED IN HIGH SEG
;	CALL	AC,[SIXBIT /CORE/]
;	ERROR	RETURN
;	OK	RETURN TO USER, JOB MOVED IF NECESSARY
;RETURN NO. OF FREE 1K BLOCKS IN AC(OR MAX. NO. BLOCKS ALLOWED IF SWAPPING SYS)
;BOTH HALVES 0 MEANS ERROR RETURN NO. OF FREE 1K BLOCKS(OR MAX. NO. OF BLOCKS
; ALLOWED IF SWAPPING SYSTEM) IMMEDIATELY WITHOUT AFFECTING CORE
; OR WAITING FOR IO DEVICES
;LH=0 MEANS DO NOT CHANGE HIGH SEG ASSIGNMENT
;RH=0 MEANS DO NOT CHANGE LOW SEG ASSIGNMENT


CORUUO::SKIPE	T1		;IF ZERO CORE REQUESTED JUST RETURN
				; THE AMOUNT AVAILABLE
	PUSHJ	P,CHGCOR	;CHANGE THE CORE ASSIGNMENT
	  SKIPA			;NOT ENOUGH
	AOS	(P)		;OK RETURN TO USER
	PUSHJ	P,CORBND	;T1 = UPPER BOUND ON WORDS FOR JOB
	LSH	T1,W2KLSH	;CONVERT TO K

	JRST	STOTAC##	;STORE IN USER AC AND RETURN TO USER
;SUBROUTINE TO CHANGE CORE - JUST LIKE CORE UUO
; EXCEPT VALUE NOT STORED IN USER'S UUO ACS
; USED BY MONITOR JOBS INSTEAD OF CORE UUOS
;CALL:	MOVE	T1,XWD NEW HIGH, NEW LOW SEG HIGHEST ADR
;	PUSHJ	P,CHGCOR
;	  ERROR RETURN
;	OK RETURN

CHGCOR::PUSHJ	P,SAVE4##	;SAVE P1-P4
	PUSH	P,T1		;NO, SAVE HIGHEST DESIRED ADDRESS IN BOTH SEGS
	MOVSI	T2,JACCT
	TDNE	T2,JBTSTS##(J)	;PRIVILEGED PROGRAM?
	TLO	P1,PHONLY	;YES, PHYSICAL ONLY THEN

	PUSHJ	P,IOWAIT##	;WAIT FOR ALL DEVICE INACTIVE
IFN FTMP,<
	PUSHJ	P,UPMM##	;GET THE MEMORY MANAGEMENT RESOURCE
>
	HRRZ	T1,(P)		;HIGHEST REL. LOC. DESIRED FOR LOW SEG(RH)
	JUMPE	T1,CORU1	;IS RH 0(IF YES DO NOT CHANGE LOW SEG)?
	IORI	T1,PG.BDY	;NO, MAKE IT AN EVEN MULTIPLE OF 1K-1
IFN FTLOCK,<
	MOVSI	T2,NSHF!NSWP	;LOCKED JOBS CANNOT CHANGE THEIR SIZE
	TDNN	T2,JBTSTS##(J)	;IS HE LOCKED?
>
	PUSHJ	P,CORE1		;TRY TO ASSIGN CORE
	  JRST	CORERR		;NOT AVAILABLE, ERROR RETURN
				; SUM OF NEW LOW AND OLD HIGH SEG TOO BIG

CORU1:	HLRZ	T1,(P)		;CHECK TO SEE IF USER IS REQUESTING HIGH CORE
	PUSHJ	P,UCORHI##	;TRY TO ASSIGN CORE FOR HIGH SEG,
				; UCORHI EXPECTS ARG ON PD LIST
	  JRST	CORERR		;ERROR-ACTIVE IO(SAVE IN PROGRESS FOR SOME USER)
				; OR PROTECTION FAILURE (CAN'T UPDATE)
	AOS	-1(P)		;SET FOR OK(SKIP) RETURN
CORERR:	POP	P,T1		;REMOVE ARG FROM LIST
IFN FTMP,<
	PUSHJ	P,TGVMM##	;GIVE UP THE MM IF OWNED
>
	MOVE	T1,JBTSTS##(J)	;JOB STATUS WORD
	TLNE	T1,JXPN!SWP	;MUST LOW SEGMENT BE SWAPPED OUT TO EXPAND OR
				; HIGH SEGMENT LOGICAL CORE ASSIGNED ON DISK?
	PUSHJ	P,WSCHED##	;YES, CALL SCHEDULER TO STOP JOB
				; LOW SEG MUST BE SWAPPED OUT TO EXPAND
	POPJ	P,
;SUBROUTINE TO RETURN UPPER BOUND CORE LIMIT FOR JOB IN WORDS
;CALL:	MOVE	J,JOB NO
;	PUSHJ	P,CORBND
;	ALWAYS RETURN - T1 = UPPER BOUND

CORBND::PUSH	P,T2
IFN FTLOCK,<
	PUSH	P,J		;SAVE JOB NUMBER
	SETZ	T2,
	MOVSI	T1,NSWP!NSHF
	TDNE	T1,JBTSTS##(J)	;SEGMENT LOCKED?
	PUSHJ	P,SEGSIZ##	;YES, GET ITS CORE SIZE
	PUSH	P,T2		;SAVE CORE SIZE
	MOVSI	T2,LOKSEG	;USING LOCKED SEG?
	TDNN	T2,JBTSGN##(J)	; THAT IS LOCKED?
	JRST	CRBND1		;NO
	HRRZ	T1,JBTSGN##(J)	;POINTER TO BLOCKS
	JUMPE	T1,CRBND1	;?
CRBND0:	SKIPLE	J,.HBSGN(T1)	;SEGMENT WORD
	TLNN	J,SHRSEG	;ONLY SHARABLE ONES COUNT
	JRST	CRBN0A
	HRRZS	J		;CLEAR JUNK
	MOVE	T2,JBTSTS##(J)	;IS THIS SEG LOCKED?
	TLNE	T2,NSHF!NSWP	;LOCKED?
	PUSHJ	P,SEGSIZ##	;YES, GET HIGH SEG SIZE
	ADDM	T2,(P)		;ADD IT IN
CRBN0A:	HRRZ	T1,.HBLNK(T1)	;NEXT HIGH SEG
	JUMPN	T1,CRBND0	;PROCEED IF MORE
CRBND1:	POP	P,T1		;GET BACK LOW SEG SIZE
	LSH	T1,P2WLSH
	ADD	T1,CORMAX##	;ADD TO CORMAX TO GET APPARENT CORMAX
	POP	P,J		;RESTORE JOB NUMBER
>
IFE FTLOCK,<
	MOVE	T1,CORMAX##	;GET CORMAX
>
	LDB	T2,JBYLCR##	;GET THIS JOBS CORE LIMIT
	JUMPE	T2,CRBND2
	LSH	T2,^D9
	CAMLE	T1,T2		;WE WANT
	MOVE	T1,T2		; THE SMALLER OF THE TWO
CRBND2:	PUSHJ	P,FNDPDB##	;FIND THE PDB
	  JRST	CRBND4		;NO LIMIT OR GUIDELINE IF NO PDB
	HRRZ	T2,.PDCVL##(W)	;CURRENT PHYSICAL LIMIT OR GUIDELINE
	JUMPE	T2,CRBND3	;IGNORE IF NONE
	TRZN	T2,400000	;LIMIT?
	JUMPL	P1,CRBND3	;NO, IGNORE GUIDELINE IF PHONLY
	LSH	T2,P2WLSH	;NUMBER OF WORDS
	CAMLE	T1,T2		;SMALLEST YET?
	MOVE	T1,T2		;NO, USE SMALLER
CRBND3:	HRRZ	T2,.PDMVL##(W)	;FINALLY, MAX PHYSICAL LIMIT
	JUMPE	T2,CRBND4
	LSH	T2,P2WLSH
	CAMLE	T1,T2
	MOVE	T1,T2
CRBND4:IFN FTLOCK,<
	LSH	T1,W2PLSH
	CAILE	T1,@CORLIM##	;CORLIM MIGHT BE EVEN SMALLER
	HRRZ	T1,CORLIM##	; IF SO, IT IS THE LIMIT
	LSH	T1,P2WLSH
>
	SUBI	T1,UPMSZW##	;ACCOUNT FOR THE FACT THAT THE UPMP IS ALLOCATED
				; FROM USER CORE. THUS, MAXIMUM SIZE A JOB
				; A JOB CAN OBTAIN IS MIN (CORMAX, JOB LIMIT)-
				; THE SIZE OF THE USER PAGE MAP PAGE
	JUMPL	P1,T2POPJ##	;RETURN IF PHYSICAL ONLY
	PUSHJ	P,FNDPDB##
	  PJRST	T2POPJ##	;NO LIMITS IF NO PDB
	HLRZ	T2,.PDCVL##(W)	;CURRENT VIRTUAL LIMIT
	LSH	T2,P2WLSH	;CONVERT TO PAGES
	CAMGE	T1,T2
	MOVE	T1,T2
	PJRST	T2POPJ##	;YES, USE SMALLER JOB LIMIT

;CORLM.	UUO -- SET JOB'S CORE LIMIT
;CALL:	HRLZI	AC,12
;	HRRI	AC,LIMIT IN NO. OF WORDS
;	SETUUO	AC,
;	ERROR
;	OK

CORELM::JUMPE	T2,CORLM1
	CAIG	T2,MINMAX##	;GREATER THAN MIN
	MOVEI	T2,MINMAX##	;YES--USE MINMAX
CORLM1:	ADDI	T2,PG.BDY	;ROUND UP TO LAST LOWSEG ADDRESS
				;  + HIGH SEG SIZE
				;THIS IS TO BE SIMILAR TO CORE UUO
	TLNE	T2,-1		;SEE IF OVERFLOW
	SETOM	T2		;YES--SET TO INFINITY
	LSH	T2,-^D9		;CONVERT TO 512 UNITS
	DPB	T2,JBYLCR##	;STORE
	JRST	CPOPJ1##	;RETURN


;ROUTINE TO TEST FOR ANY ACTIVE DEVICES

;CALL:	MOVE	J,JOB NUMBER OR HIGH SEG NUMBER
;	MOVE	R,ADDRESS OF JOB DATA AREA
;	PUSHJ	P,ANYACT
;	DEVICES	ACTIVE
;	DEVICES	NOT ACTIVE EXCEPT POSSIBLY TTY
;IN REENTRANT SYSTEMS ANYACT IS BROKEN INTO 2 CALLS, ANYSAV AND ANYDEV
;ANYSAV TESTS WHTETHER THIS IS A HI SEG THAT HAS A SAVE IN PROGRESS
ANYACT::PUSHJ	P,ANYSAV##	;IS A SAVE IN PROGRESS FOR HI SEG?
	  POPJ	P,		;YES - RETURN


ANYDEV::PUSHJ	P,SAVE2##	;PRESERVE ACCUMULATORS P1, P2, P3

IFN FTMP,<
	PUSHJ	P,ANYRUN##	;IS THIS JOB RUNNING ON THE SLAVE
	  POPJ	P,		;YES, RETURN IMMEDIATELY
>
	CAILE	J,JOBMAX##	;YES, IT THIS A HIGH SEG?
	JRST	CPOPJ1##	;YES, OK TO SHUFFLE OR SWAP SINCE NSHF,NSWP NOT SET
				; AND NO SAVE IN PROGRESS
	LDB	P1,PJBSTS##	;JOB'S QUEUE CODE
	CAIE	P1,PIOWQ##	;IN PAGING I/O WAIT?
	CAIN	P1,DIOWQ##	;OR DSK I/O WAIT?
	POPJ	P,		;YES, CAN'T SWAP IT OUT NOW
				; ONLY HAPPENS IF LOCK IS TRYING
				; TO FORCE THIS JOB OUT
	MOVEI	P1,0		;ASSUME JOB IS CURRENT JOB (DEVICE TABLE IS THE MONITOR)
	CAME	J,.CPJOB##	;IS IT?
	PUSHJ	P,SVEUB##	;NO, MAKE THE JOB DATA AREA ADDRESSABLE
	PUSH	P,T1
ANY:	PUSHJ	P,NXTCH##
	  JRST	ANY3
IFN FTMPXSER,<
	HRRZ	F,T1
	LDB	P2,PDVTYP##	;GET THE DEVICE TYPE
	CAIE	P2,.TYMPX	;MPX?
	JRST	ANY1		;NO--JUST LOOK AT IOACT
	PUSHJ	P,MPXACT##	;SEE IF IT IS ACTIVE
	  JRST	TPOPJ##		;RETURN IF ACTIVE
	JRST	ANY		;LOOK AT NEXT DEVICE
> ;END FTMPXSER
ANY1:	TRNN	S,IOACT		;IS DEVICE ACTIVE?
	JRST	ANY
	MOVSI	P2,DVTTY	;DEVICE IS A TTY BIT
	TDNN	P2,DEVMOD(T1)	;NOT FINISHED, IS DEVICE TTY?
	JRST	TPOPJ##		;NO, ERROR RETURN, CANNOT ASSIGN CORE
	JRST	ANY		;YES, KEEP LOOKING FOR AN ACTIVE DEVICE
ANY3:
	SKIPN	F,DIADSK##	;DSK CHAN STOPPED?
	JRST	TPOPJ1##	;NO, OK RETURN
	LDB	P1,PJOBN##	;YES, IS THIS THE JOB THAT STOPPED IT!
	CAMN	P1,J
	JRST	TPOPJ##		;YES, SOMETHING IS ACTIVE

	PJRST	TPOPJ1##	;OK RETURN
;ROUTINE TO FLUSH PHYSICAL CORE ASSIGNED IN MEMORY
;NOTE: THIS ROUTINE DIFFERS SIGNIFICANTLY FROM CORE0 AND CORE1 IN THAT
;IT IS ONLY A PHYSICAL  REMOVAL OF CORE(VIRTAL IS NOT AFFECTED)
;SEE COMMENTS FOR CORE1
;CALL:	MOVE	J,HIGH OR LOW SEGMENT NUMBER
;	PUSHJ	P,KCORE1
;	ALWAYS	RETURN HERE
;SCORE1 IS CALLED FROM SHUFFLER WITH T1 SET TO SEG SIZE


KCORE1::MOVEI	T1,0		;SETUP DESIRED HIGHEST ADR
SCORE1::SOS	(P)		;CORE1 WILL ALWAYS SKIP RETURN
	MOVE	R,JBTADR##(J)
	PJRST	CORE1A		;BYPASS LOGICAL CORE ASSIGNMENT PART
				; AND FLUSH PHYSICAL CORE(LOGICAL CORE UNEFFECTED)
;CALL:	MOVE	T1,HIGHEST LEGAL ASSRESSABLE LOC. DESIRED
;	MOVE	J,JOB NUMBER
;	MOVE	R,[XWD PROT.,RELOC.]=JBTADR(J)
;	PUSHJ	P,CORE0
;	ERROR	;EITHER JOB HAS ACTIVE IO
		; OR NOT ENOUGH CORE
;	OK	RETURN
;JOB IS MOVED IF NECESSARY TO SATISFY REQUEST
;R IS SET TO NEW CORE ASSIGNMENT ON EITHER RETURN
;0 MEANS NONE ASSIGNED IN MEMORY, ASSIGNED ON DISK
;ENTER HERE FROM CORE CONSOLE COMMAND OR INITIAL CORE
;ASSIGNMENT OF JUST A JOB DATA AREA FOR RUN COMMAND
;IE ENTER WHEN DEVICES MAY BE ACTIVE OR JOB MAY HAVE NO PREVIOUS CORE
;JOB CAN HAVE CORE IN MEMORY, CORE ON DISK, OR NONE EITHER PLACE
;JOB CANNOT BE IN PROCESS OF SWAP OUT OR SWAP IN(CALLER'S RESPONSIBILITY)
;CORE0 NO LONGER REASSIGN CORE ON DISK IF OLD CORE ON DISK
;BECAUSE OF FRAGMENTED SWAPPING(TOO HARD) UNLESS 0 BEING ASKED FOR
;THEREFORE THE CORE COMMAND CAUSES JOB TO BE SWAPPED INTO CORE FIRST(INCORE=1)
;HOWEVER, THE R,RUN,GET,KJOB COMMANDS DO NOT REQUIRE THE PREVIOUS CORE IMAGE TO
;BE SWAPPED IN(AS THIS IS SLOW). THEY ASK FOR 140 WORDS, AND LARGER DISK SPACE IS RELINQUISHED
;UPON SWAPIN BY THE SWAPPER, VIRTAL IS INCREASED THEN RATHER THAN
;ON THE CALL TO CORE0.
;IT WILL TRY TO REASSIGN CORE IN MEMORY IF OLD CORE IN MEMORY
;IF THIS FAILS, IT WILL REASSIGN NEW CORE ON DISK AND ASK SWAPPER TO EXPAND
;IF JOB DID NOT HAVE OLD CORE, AN ATTEMPT WILL BE MADE TO ASSIGN CORE IN MEMORY
;IF THIS FAILS, TI WILL BE ASSIGNED ON THE DISK AND ASK SWAPPER TO EXPAND
;THE OTHER PLACES IN THE MONITOR WHERE THE IN-CORE COUNT IS TOUCHED IS
;IN GET WHERE IT INCREMENTS TO SHARE COPY ALREADY IN CORE.
;AND END OF SWAPIN OF LOW SEG AND HIGH SEG IS ALREADY IN CORE FOR OTHER USER
;THE CORE ROUTINES DO NOT ALTER THE HIGH SEG IN CORE COUNT.  IT IS UP TO THE  CALLER
;(IN SEGCON) TO CALL THE CORE ROUTINES ONLY IF IN CORE COUNT IS 0.
;AND END OF SWAPIN OF LOW SEG AND HIGH SEG IS ALREADY IN CORE FOR OTHER USER
CORE0::	MOVE	R,JBTADR##(J)
	JUMPN	R,CORE0A	;DOES JOB HAVE CORE IN MEMORY?
				; (ALWAYS TRUE BOTH SEGS IF CORE UUO)
	PUSHJ	P,SUMSEG##	;NO, WILL SUM OF BOTH SEGMENTS FIT IN PHYSICAL CORE?
				; LARGEST PERMITTED CORE. COMPARE SUM WITH CORMAX

	  POPJ	P,		;NO, GIVE ERROR RETURN
	MOVSI	T2,SWP		;IS JOB SWAPPED OUT?
	TDNN	T2,JBTSTS##(J)	;(MAY HAVE 0 DISK SPACE ALTHOUGH SWAPPED OUT)
	JRST	CORE1		;NO, TRY TO ASSIGN CORE IN MEMORY
	PUSHJ	P,CHGSWP##	;YES, CHANGE ASSIGNMENT OF SWAPPING SPACE ON DISK
				; INCREASE VIRTAL(COUNT OF FREE 1K BLOCKS OF SWAPPING
				; (SHOULD NEVER NEED TO DECREASE VIRTAL SINCE
				; CORE COMMAND ALWAYS SWAPS JOB IN FIRST).
				; (FRAGMENTATION POSTPONES RETURNING SPACE AND
				; INCREASING VIRTAL UNTIL SWAP IN IF NOT ASKING
				; FOR 0 VIRTUAL CORE)
	JRST	CPOPJ1##	;GIVE OK RETURN TO CALLER

CORE0A:

	SKIPN	.CPSTS##	;NO,IS TIME SHARING STOPPED BY
				; TRPSET UUO DONE FOR JOB 1?
	PUSHJ	P,ANYACT	;NO,ANY ACTIVE DEVICE?
	  POPJ	P,		;YES, CANNOT ASSIGN CORE
				; NO, FALL INTO CORE1
;ROUTINE TO TRY TO ASSIGN CORE IN CORE
;LOW OR HIGH SEG MUST NOT BE SWAPPED OUT(CALLER'S RESPONSIBILITY)
;AND MUST NOT HAVE ANY ACTIVE DEVICES(IT MAY HAVE 0 CORE IN CORE THOUGH)
;IN OTHER WORDS HIGH OR LOW SEG MAY OR MAY NOT HAVE VIRTUAL CORE
;BUT IF IT HAS VIRTUAL CORE IT MUST BE IN PHYSICAL CORE
;THIS IS BOTH A LOGICAL AND A PHYSICAL CORE ASSIGNMENT
;FIRST OLD CORE IS RETURNED TO SYSTEM
;THEN NEW REQUEST IS ATTEMPTED TO BE SATISFIED IN LOWEST
;POSITION POSSIBLE.  THUS CORE TENDS TO BE PACKED
;IF NEW REQUEST CANNOT BE GRANTED, OLD AMOUNT IS RETAINED, IF NON-SWAPPING SYS
;OTHERWISE SWAPPER IS CALLED(XPAND) TO EXPAND CORE BY SWAPPING OUT



CORE1::	MOVE	R,JBTADR##(J)
	JUMPL	T1,CPOPJ##	;DON'T ALLOW NEGATIVE ARGUMENTS
IFN FTLOCK,<
	MOVSI	T2,NSHF!NSWP	;LOCKED SEGMENTS CANNOT CHANGE THEIR CORE SIZE
	TDNE	T2,JBTSTS##(J)	;IS THIS SEGMENT LOCKED?
	POPJ	P,		;YES, ERROR RETURN
	;END IFN FTLOCK
>
	CAILE	J,JOBMAX##	;IS THIS A HIGH SEGMENT?
	JRST	CORE12		;YES, PROCEED
	MOVE	T3,T1		;LOW SEGMENT, SAVE AMOUNT OF CORE REQUESTED
	SETZ	T1,		;SEARCH HIGH SEGMENTS IN THIS SECTION
CORE30:	PUSHJ	P,NXSPCS##	;GET NEXT HIGH SEG IN PCS
	  JRST	CORE31		;ALL CLEAR
	PUSH	P,T1		;SAVE FOR CHAINING
	PUSHJ	P,HSVAD##	;COMPUTE HIGH SEGMENT BOUNDS
	CAIL	T3,(T2)		;TRYING TO EXPAND INTO THE HIGH SEGMENT?
	JUMPN	T1,TPOPJ##	;YES IF THERE IS ONE - FAIL IF SO (FIXING STACK)
	POP	P,T1		;RESTORE CHAINING ARG
	JRST	CORE30

CORE31:	MOVE	T1,T3		;OK, RESTORE ARGUMENT
CORE12:	NOSCHEDULE		;PREVENT SCHEDULING

	PUSHJ	P,SEGSIZ##	;T2=OLD SEG SIZE
	JUMPE	T2,CORE10
	CAIG	J,JOBMAX##	;IF THIS IS A LOW SEGMENT,
	SUBI	T2,UPMPSZ##	;SUBTRACT OUT THE SIZE OF THE UPMP WHICH WAS
				; ADDED IN FOR ACCOUNTING PURPOSES

CORE10:	SKIPN	T3,T1		;IS O BEING REQUESTED?
	MOVNI	T3,1		;YES, PRETEND -1(DEPEND ON ASH BUG WHICH KEEPS -1
				; ON RT. SHIFT)
	ASH	T3,W2PLSH	;CONVERT TO NO. OF K-1(01,0,1,2,...)
	SUB	T3,T2		;NO. OF K-1 INCREASE=NEW-OLD-1
	PUSHJ	P,VIRCHK##	;ALLOCATE CORE ON DSK? (USER JUST GOING
				; VIRTUAL OR ALREADY VIRTUAL)
	  POPJ	P,		;ALREADY VIRTUAL BUT TRYING TO EXCEED LIMITS
	  PJRST	CPOPJ1##	;YES, TAKE GOOD RETURN
	PUSHJ	P,SAVE1##
	TLO	P1,PHONLY	;PHYSICAL ONLY FOR CORBND

	CAMGE	T3,VIRTAL##	;IS THERE ENOUGH FREE VIRTUAL CORE IN SYSTEM?

	PUSHJ	P,SUMSEG##	;YES, IS SUM OF SEGS LESS THAN MAX. ALLOWED CORE+1?

	  POPJ	P,		;NO, ERROR RETURN
	AOJE	T3,CPOPJ1##	;YES, GET NO. K OF INCREASE AND
				;RETURN WITHOUT MOVING CORE IF NO CHANGE IN SIZE
	CAILE	J,JOBMAX##	;IF A LOW SEG...
	JRST	CORE11
	SKIPN	R		;IF GOING FROM 0 TO N,
	ADDI	T3,UPMPSZ##+1	;U DECREASE VIRTAL
	SKIPN	T1		;IF GOING FROM N TO 0,
	SUBI	T3,UPMPSZ##+1	;U DECREASE VIRTAL
CORE11:	MOVNS	T3		;MAKE MINUS FOR UPDATE
	ADDM	T3,VIRTAL##	;AND UPDATE TOTAL VIRTUAL CORE IN SYSTEM
				; SINCE THIS REQUEST CAN BE SATISFIIED

;HERE TO ALLOCATE PHYSICAL CORE IN CORE OR ON THE DISK
;ALWAYS SKIP RETURN - R = NEW PROTECTION,,RELOCATION
; R = 0 IF CORE IS ASSIGNED ON THE SWAPPING SPACE

CORE1A::JUMPE	R,CORGT0	;JUMP IF SEGMENT HAS NO CORE IN CORE
	HLRZ	T3,R		;T3 = CURRENT HIGHEST RELATIVE ADDRESS IN THE SEGMENT
	SKIPN	T1		;IS ZERO CORE BEING REQUESTED?
	MOVNI	T1,1		;YES, PRETEND -1 AND DEPEND ON BUG IN ASH
				; WHICH MAKES -1 = -1 WHEN SHIFTED
	SUB	T3,T1		;T3 = NUMBER OF WORDS OF INCREASE OR DECREASE IN
				; SEGMENT SIZE
	ASH	T3,W2PLSH	;CONVERT TO NUMBER OF PAGES OF INCREASE OR DECREASE
	JUMPG	T3,CORE1B	;JUMP IF SEGMENT IS GETTING SMALLER
	MOVMS	T3		;T3 = NUMBER OF PAGES OF INCREASE
	PUSHJ	P,FRDCR##	;ARE THERE THAT MANY FREE PAGES AVAILABLE IN CORE?
	  JRST	CORGT7		;NO, MARK THE SEGMENT AS EXPANDING AND ALLOCATE
				; THE REQUIRED NUMBER OF PAGES ON SWAP-IN
	PUSH	P,T3		;SAVE THE NUMBER OF PAGES OF INCREASE
	LDB	T1,JBYSSA##	;FIRST PAGE OF SEGMENT
	MOVE	T2,(P)		;T2 = NUMBER OF PAGES TO ADD TO THE SEGMENT
	ADDM	T2,JBTIMI##(J)	;INCREASE JBTIMI BY THAT NUMBER OF PAGES

	CAILE	J,JOBMAX##	;IF A HISEG,
	PUSHJ	P,SCPAGS	;KEEP THEM IN ORDER
	MOVE	T2,(P)		;SCPAGS CLOBBERS THIS
	PUSHJ	P,ADPAGS	;ALLOCATE ENOUGH PAGES TO SATISFY THE REQUEST
	POP	P,T2		;RESTORE THE NUMBER OF PAGES OF INCREASE
	LSH	T2,^D18+P2WLSH	;CONVERT TO NUMBER OF WORDS OF INCREASE IN
				; POSITION TO UPDATE CURRENT RELOCATION
	ADD	R,T2		;R = NEW PROTECTION,,RELOCATION
	JRST	CORGT2		;STORE NEW PROTECTION,,RELOCATION AND CLEAR
				; PAGES JUST ADDED TO INSURE SECURITY
CORE1B:	JUMPG	T1,CORE1C	;REQUESTING 0K CORE IN CORE?
IFN FTMP&FTKL10,<
	PUSHJ	P,CLCSN##	;YES, DON'T HAVE TO SWEEP BEFORE WE
				; RUN HIM AGAIN
>;END IFN FTMP&FTKL10
	CAMN	J,.CPJOB##	;CORE 0 ON THE CURRENT JOB?
	JRST	[MOVEI T2,NUPMPP## ;NULL JOB'S UPMP PAGE NUMBER
		 CONO PI,PI.OFF	;MAKE CHANGING THE SPT AND THE UBR ATOMIC
		 MOVEM T2,@.CPSPT## ;POINT SPT AT THE NULL JOB'S MAP
		 DATAO PAG,NULDOP## ;AND THE UBR AT THE NULL JOB'S MAP
		 CONO PI,PI.ON	;BOTH AGREE, ALLOW INTERRUPTS AGAIN
		 JRST .+1]	;AND CONTINUE

	PUSH	P,T3		;SAVE THE NUMBER OF PAGES OF DECREASE
	PUSH	P,J		;IN CASE LEFT HALF CRUFT,
	HRRZS	J		;CLEAR CRUFT
	LDB	T1,JBYSSA##	;FIRST PAGE OF THE SEGMENT
	POP	P,J
	JRST	CORE1D		;GO RETURN PAGES
CORE1C:	LDB	T2,[POINT 9,R,8];T2 = THE CURRENT SIZE OF THE SEGMENT IN
				; PAGES - 1
	SUBI	T2,(T3)		;COMPUTE THE RELATIVE PAGE NUMBER OF THE FIRST
				; PAGE TO RETURN TO THE FREE CORE LIST
	PUSH	P,T3		;SAVE THE NUMBER OF PAGES OF DECREASE
	PUSHJ	P,SNPAGS	;FIND THE ABSOLUTE PAGE NUMBER OF THE FIRST PAGE
				; TO RETURN TO THE FREE CORE LIST
IFN FTXMON,<
	XJRST	[MCSEC1+.+1]
>
	SSX	T1,MS.MEM	;SET SECTION NUMBER
	HRRZ	T2,PAGTAB(T1)	;T2 = THE LINK TO THE FIRST PAGE TO FREE
	HLLZS	PAGTAB(T1)	;INDICATE THAT THIS IS NOW THE LAST PAGE
				; OF THE SEGMENT
	MOVE	T1,T2		;T1 = THE ABSOLUTE PAGE NUMBER OF FIRST PAGE TO FREE
IFN FTXMON,<
	JRST	@[0,,.+1]	;RETURN TO SECTION 0
>
CORE1D:	PUSHJ	P,GVPAGS	;RETURN FREED PAGES TO THE FREE CORE LIST
	LDB	T2,IMGOUT##	;SWAPPER DEALLOCATION?
	JUMPN	T2,CORE1E	;JUMP IF YES
	LDB	T2,IMGIN##	;UPDATE IMGIN TO REFLECT # OF PAGES ALLOCD
	SUB	T2,(P)
	DPB	T2,IMGIN##
CORE1E:	POP	P,T2		;RESTORE THE NUMBER OF PAGES OF DECREASE
	LSH	T2,^D18+P2WLSH	;CONVERT TO NUMBER OF WORDS OF DECREASE AND
				; POSITION TO UPDATE CURRENT RELOCATION
	SUB	R,T2		;R = NEW PROTECTION,,RELOCATION
	SKIPG	R		;WERE ALL OF THE PAGES BELONGING TO THE SEGMENT
				; RETURNED TO FREE CORE
	SETZB	T1,R		;YES, INDICATE SEGMENT HAS NO CORE IN CORE
	CAILE	J,JOBMAX##	;IS THIS SEGMENT A HIGH SEGMENT?
	JUMPE	R,CORGT1	;YES, AND DOES IT STILL HAVE CORE IN CORE?
	JUMPN	R,CORGT2	;NO, DOES LOW SEGMENT HAVE CORE IN CORE?
	LDB	T1,IMGOUT##	;SWAPPER DEALLOCATION?
	SKIPN	T1
	PUSHJ	P,JOBFNQ##	;NO, CHECK VIRTUAL PAGES
	HRRZ	T1,JBTUPM##(J)	;NO, RETURN UPMP TO THE FREE CORE LIST
	SETZ	R,
	HLLZS	JBTUPM##(J)	;INDICATE NO UPMP OR CORE IN CORE
	PUSHJ	P,GVPAGS	;GIVE UP THE PAGE ALLOCATED TO THE UPMP
	JRST	CORGT6		;STORE R AND RETURN
;HERE WHEN THE SEGMENT IS EXPANDING FROM ZERO (CALLED BY THE SWAPPER AND ABOVE)
CORGET::PUSHJ	P,SVEUB##	;SAVE UBR ON CALL FROM THE SWAPPER
CORGT0:	JUMPE	T1,CPOPJ1##	;RETURN IF MULTIPLE CALLS TO RETURN CORE
	AOS	T2,T1		;T2 = NUMBER OF WORDS OF CORE REQUIRED TO
				; SATISFY REQUEST
	LSH	T2,W2PLSH	;T2 = NUMBER OF PAGES REQUIRED
	MOVE	T3,T2
	CAILE	J,JOBMAX##
	JRST	CORG0A		;NO
	LDB	T3,IMGOUT##
	JUMPE	T3,CORG0B
	LDB	T3,NZSICN##	;# OF NZS MAPS WANTED FOR SWAPIN
	SKIPE	T3		;ANY WANTED?
	DPB	T3,NZSXCN##	;YES, WE "HAVE THEM NOW"
	LDB	T3,IFYPGS##
	JUMPE	T3,[LDB T3,NFYPGS##
		JRST CORG0C]
	MOVEI	T4,0
	DPB	T4,IFYPGS##
	CAIA
CORG0B:	MOVEI	T3,UPMPSZ##+1
	DPB	T3,NFYPGS##
CORG0C:	ADDM	T2,T3		;ADD THAT IN
	LDB	T4,NZSSCN##
	ADD	T3,T4		;# OF NZS MAPS
CORG0A:	CAMLE	T3,BIGHOL##	;NO, IS THERE ENOUGH FREE CORE IN CORE TO
				; ACCOMODATE THE REQUEST?
	SOJA	T1,CORGT7	;NO, MARK THE SEGMENT AS EXPANDING AND ALLOCATE
				; THE REQUIRED NUMBER OF PAGES ON SWAP-IN
	DPB	T2,IMGIN##	;STORE THE NUMBER OF PAGES ALLOCATED IN CORE
	HRLI	R,-1(T1)	;R = NEW PROTECTION,,?
	CAILE	J,JOBMAX##
	SKIPA	T2,T3
	MOVEI	T2,-UPMPSZ##-1(T3)
	PUSHJ	P,GTPAGS	;ALLOCATE THE PAGES TO SATISFY THE REQUEST
	HRLI	T1,(<PM.DCD>B2+PM.WRT+PM.PUB+PM.CSH+PM.AAB+PM.COR)

	CAILE	J,JOBMAX##	;IS THIS A LOW SEGMENT
	JRST	CORGT1		;NO, UPMP HAS ALREADY BEEN ALLOCATED
	PUSH	P,T1		;SAVE THE PAGE NUMBER OF FIRST PAGE OF THE LOW SEGMENT
	MOVEI	T2,UPMPSZ##+1	;ALLOCATE ONE PAGE FOR THE UPMP
	PUSHJ	P,GTPAGS	;GET ONE PAGE OFF THE FREE CORE LIST
	HRRM	T1,JBTUPM##(J)	;STORE IT AS THE ADDRESS OF THE UPMP
	MOVE	T3,.CPMAP##
	HRLI	T1,(<PM.DCD>B2+PM.WRT+PM.PUB+PM.AAB)
	MOVEM	T1,.EUPMP/PAGSIZ(T3)

	CLRPT	.EUPMP		;THE UPMP IS NOW MAPPED THROUGH THE EXEC
	     	      		; MAP. CLEAR THE AM SO THE NEW MAPPING
				; WILL BE IN AFFECT
	SETZM	.EUPMP
	MOVE	T2,[.EUPMP,,.EUPMP+1]
	BLT	T2,.EUPMP+PG.BDY ;ZERO THE ENTIRE UPMP
	MOVSI	T2,NUPPMT##	;NOW SETUP THE REST OF THE MAP FROM THE
	HRRI	T2,.EUPMP+.UPTVC ; PROTOTYPE MAP (NULL JOB'S UPMP)
	BLT	T2,.EUPMP+NUPMPL##-1
	MOVE	T2,T1
IFN FTXMON,<
	XJRST	[MCSEC1+.+1]	;REFERENCES TO PAGTAB REQUIRE WE MUST BE IN SECTION 1
	SSX	T2,MS.MEM
	HRR	T1,PAGTAB(T2)
	JRST	@[0,,.+1]	;RETURN TO SECTION 0
>
IFE FTXMON,<
	HRR	T1,PAGTAB(T2)
>
	EXCH	T1,.EUPMP/PAGSIZ(T3)
	CLRPT	.EUPMP
	SETZM	.EUPMP
	MOVE	T2,[.EUPMP,,.EUPMP+1]
	BLT	T2,.EUPMP+PG.BDY
	EXCH	T1,.EUPMP/PAGSIZ(T3)
	CLRPT	.EUPMP
	TLO	T1,(PM.PUB+PM.CSH+PM.COR) ;ALWAYS PUBLIC HERE, USER MAP SPECIFIES
	MOVEM	T1,.EUPMP+SECTAB	;SECTION 0 MAP POINTER
IFN FTMP,<
	SKIPE	[M.CPU##-1]	;IF NOT CONFIGURED FOR SMP
>
	TLZ	T1,(PM.CSH)	;TURN ON CACHE BIT
	MOVEM	T1,.EUPMP+.UMUPM ;PAGE MAP - UNCACHED IF SMP
	HRR	T1,JBTUPM##(J)	;PROCESS TABLE
	MOVEM	T1,.EUPMP+.UMUPT ;PROCESS TABLE MAPPING - UNCACHED IF SMP
	TLO	T1,(PM.CSH)
	MOVEM	T1,.EUPMP+.UMUUP ;PROCESS TABLE MAPPING - CACHED REFERENCES

	POP	P,T1		;RESTORE THE MAPPING FOR THE FIRST PAGE OF THE
				; LOW SEGMENT
	PUSHJ	P,STEUB##	;MAKE THE UPMP ADDRESSABLE (SET THE UBR TO
				; POINT TO THIS PAGE)
	MOVEM	T1,.UPMAP
IFN FTMP,<
	TLZ	T1,(PM.CSH)	;TURN OFF CACHE BIT
>
	MOVEM	T1,.UPMP+.UMJDT
	CLRPT	.JDAT		;CLEAR OUT OLD ENTRY FOR .JDAT
;	DPB	T1,JBYLSA##	;STORE FIRST PAGE OF LOW SEG IN JBTAD2
;	JRST	CORGT2		;CLEAR THE PAGES JUST ALLOCATED
CORGT1:	DPB	T1,JBYHSA##	;STORE THE STARTING PAGE NUMBER OF THE HIGH SEG
CORGT2:	JUMPE	R,CORGT6	;ALL DONE IF THE SEGMENT HAS NO CORE AT THIS POINT
	HLRZ	T1,R		;T1 = HIGHEST RELATIVE ADDRESS SEGMENT CURRENTLY HAS
	HLRZ	T2,JBTADR##(J)	;T2 = HIGHEST RELATIVE ADDRESS SEGMENT PREVIOUSLY HAD
	JUMPN	T2,CORGT3	;JUMP IF SEGMENT HAD CORE IN CORE
	LDB	T2,IMGOUT##	;T2=AMT OF CORE SEG HAD WHEN LAST IN CORE
	LSH	T2,P2WLSH	;CONVERT TO NUMBER OF WORDS
	SOS	T2		;HIGHEST RELATIVE ADDRESS
CORGT3:	CAMG	T1,T2		;CURRENT SEGMENT SIZE GREATER THAN PREVIOUS SIZE?
	JRST	CORGT5		;NO, NOTHING TO CLEAR
	SUB	T1,T2		;T1 = NUMBER OF WORDS OF INCREASE
	ADDI	T2,1		;T2 = NUMBER OF WORDS PREVIOUSLY ALLOCATED THE SEGMENT
	LSH	T2,W2PLSH	;CONVERT TO PAGE NUMBER OF LAST PAGE
				; PREVIOUSLY ALLOCATED TO THE SEGMENT
	PUSHJ	P,ZERHGH##	;IF JOB HAS A NON-SHARABLE HI-SEG
	  JRST	CORGT5		; ZERO THE CORE DIFFERENTLY
	ADDM	T1,CLRWRD##	;INCREASE COUNT OF NUMBER OF WORDS CLEARED
	PUSHJ	P,SNPAGS	;GET THE ABSOLUTE PAGE NUMBER OF THE FIRST
				; NEW PAGE (PAGE TO BE CLEARED)
	MOVSI	T3,SHRSEG	;IS THIS SEGMENT SHARABLE
	CAILE	J,JOBMAX##	;?
	TDNN	T3,JBTSTS##(J)	;?
	TDZA	T3,T3		;LOW SEG OR NOT SHARABLE, CLEAR T3
	SKIPA	T3,JBTADR##(J)	;OLD SIZE OF HIGH SEG
	SOJA	T3,CORG3A	;T3=-1 IS FLAG THAT THERE'S NOTHING TO UPDATE
	LSH	T3,W2PLSH-^D18	;LAST RELATIVE PAGE ALLOCATED TO IT
	ADD	T3,JBTVAD##(J)	;ADDRESS OF HIGH SEG MAP
CORG3A:
IFN FTXMON,<
	XJRST	 [MCSEC1+CORGT4]	;REFERENCES TO PAGTAB REQUIRE WE MUST BE IN SECTION 1
>
CORGT4:	HRLI	T1,(<PM.DCD>B2!PM.WRT!PM.CSH!PM.AAB!PM.COR!PM.PUB)
IFN FTMP&FTKL10,<
	PUSHJ	P,MLSCSH##	;IS FRECOR CACHED
	 TDZ	T1,[PM.CSH]	;NO, MUST BE UNCACHED
>
	MOVE	T2,.CPMAP##
	MOVEM	T1,.EUPMP/PAGSIZ(T2)

	CLRPT	.EUPMP
	MOVEI	T2,.EUPMP+1	;MAKE A BLT POINTER
	HRLI	T2,.EUPMP	;SET TO ZERO THE PAGE
	SETZM	.EUPMP		;ZERO THE FIRST WORD OF THE PAGE
	BLT	T2,.EUPMP+PG.BDY
				;ZERO THE PAGE
	AOSN	T3		;IF WAS -1
	SOSA	T3		;BE SURE IT STAYS THAT WAY
	MOVEM	T1,(T3)		;STORE NEW POINTER
	ANDI	T1,PM.PAG	;CLEAR THE ACCESS BITS
	SSX	T1,MS.MEM	;SET SECTION NUMBER
	HRRZ	T1,PAGTAB(T1)	;GET THE ABSOLUTE PAGE NUMBER OF THE
				; NEXT PAGE OF THE SEGMENT
	JUMPN	T1,CORGT4	;IF NOT THE LAST PAGE ZERO IT
IFN FTXMON,<
	JRST	@[0,,.+1]	;RETURN TO SECTION 0
>
CORGT5:	HRRI	R,.VJDT		;ASSUME A HIGH SEGMENT,.I.E., RH(R) = EVA
				; OF THE VESTIGUAL JOB DATA AREA
	CAILE	J,JOBMAX##	;IS IT A HIGH SEGMENT?
	JRST	CORGT6		;NO
	HRRI	R,.JDAT		;LOW SEGMENT, RH(R) = EVA OF JOB DATA AREA
	HLRZM	R,.JDAT+JOBREL## ;STORE THE NEW SIZE OF THE LOW SEGMENT FOR THE
				; USER SO HE WON'T GET CONFUSED ON EXAMINE COMMAND
CORGT6:	SKIPE	R		;GETTING CORE?
	PUSHJ	P,IICLNK##	;YES, ADD TO IN-CORE LIST
	MOVEM	R,JBTADR##(J)	;STORE NEW PROTECTION,,RELOCATION
	LDB	T1,IMGOUT##	;CORE ALLOCATION FOR THE SWAPPER?
 	JUMPN	T1,CPOPJ1##	;YES, ALL DONE
	CAMN	J,.CPJOB##	;IS THIS THE CURRENT JOB (CORE UUO)?
	PUSHJ	P,SETREL##	;YES, SETUP THE MAP AND SOFTWARE RELOCTATION INFO.
	AOS	(P)		;GIVE SKIP (OK) RETURN
	CAILE	J,JOBMAX##	;IS THIS A HIGH SEGMENT?
	PJRST	CURHGH##	;YES SEE IF CORE WAS ALLOCATED FOR THE HIGH
				; SEGMENT WHICH THE CURRENT JOB MIGHT BE SHARING
	SKIPE	R		;DON'T STORE JOB IF CORE 0
				; NULL JOB MIGHT BE ADDRESSABLE
	MOVEM	J,.USJOB	;SAVE THE JOB NUMBER FOR DEBUGGING AND
				; VIRCHK (FOR GIVING BACK HIGH SEG CORE)
	CAMN	J,.CPJOB##	;CURRENT JOB?
	TLNN	R,-PAGSIZ	; OR ONLY ONE PAGE ALLOCATED TO THE CURRENT JOB?
				; IF ONLY 1 PAGE SETREL MIGHT NOT CALL MAPLOW
	JUMPN	R,MAPLOW	;NO, SETUP THE MAP FOR E AND D COMMANDS
	POPJ	P,		;YES, MAP IS ALREADY SETUP
;HERE IF NOT ENOUGH FREE PAGES AVAILABLE IN CORE TO SATISFY REQUEST
; INDICATE JOB IS EXPANDING AND THE REQUIRED NUMBER OF PAGES WILL BE
; ALLOCATED WHEN THE SEGMENT IS NEXT SWAPPED IN
CORGT7:	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	XPAND##		;AND MARK THE JOB AS EXPANDING
;ROUTINE TO SETUP THE PORTION OF THE MAP WHICH MAPS THE
; LOW SEGMENT
;CALLING SEQUENCE:
;	PUSHJ	P,MAPLOW
;	...	ALWAYS RETURN HERE

MAPLOW::LDB	T1,PCORSZ##	;HIGHEST PAGE IN THE LOW SEGMENT
	ADDI	T1,1		;LOW SEGMENT SIZE
	PUSHJ	P,CLRWS##	;CLEAR WORKING SET BITS
	LDB	T1,[POINT 9,JBTADR##(J),8];NEW HIGHEST PAGE IN THE LOW SEGMENT
	ADDI	T1,1		;NEW LOW SEGMENT SIZE
	PUSHJ	P,ADJWS##	;SET WORKING SET BITS FOR NEW SIZE
	MOVEI	T1,.UPMAP-1
	MOVSI	T2,(<PM.DCD>B2+PM.WRT+PM.PUB+PM.CSH+PM.AAB+PM.COR)

IFN FTLOCK,<
	MOVSI	T3,(JS.NCS)	;DON'T CACHE BIT
	TDNE	T3,JBTST2##(J)	;SHOULD CACHE BIT BE OFF IN THE MAP?
	PUSHJ	P,[TDZ T2,[PM.CSH] ;YES, CLEAR IT
		   JRST CSDMP##];AND FLUSH THE CACHE
>
	LDB	T3,JBYLSA##	;FIRST PHYSICAL PAGE IN THE LOW SEGMENT
	HLRZ	T4,JBTADR##(J)	;LOW SEGMENT SIZE
	PUSHJ	P,REMAP		;SETUP THE MAP FOR THE LOW SEGMENT
	PJRST	STEUB##		;CLEAR PAGE TABLE AND RETURN
;ROUTINE TO SETUP THE PORTION OF THE MAP WHICH MAPS THE HIGH SEGMENT
;CALLING SEQUENCE:
;	PUSHJ	P,MAPHGH
;	...	ALWAYS RETURN HERE
;IF CALLED AT REMHGH, T1 HAS ADDRESS OF HIGH SEG DATA BLOCK FOR
;SEGMENT BEING REMOVED.

SETMAP::SKIPA	J,.CPJOB##	;CURRENT JOB NUMBER
REMHGH::TDZA	T3,T3		;REMOVE HIGH SEG
MAPHGH::SETO	T3,		;REDO MAPS
MAPHGX::PUSHJ	P,SAVE2##	;SAVE P1
	PUSHJ	P,SVEUB##	;MAKE SURE THE JOB IS ADDRESSABLE
	JUMPE	T3,MAPHG0	;REMHGH MUST HAVE WHICH HS SPECIFIED
	SKIPN	T1,JBTSGN##(J)	;ADDR OF HIGH SEG DATA BLOCK
	POPJ	P,		;NONE
MAPHG0:	SE1ENT			;ENTER SECTION 1 (FOR MAPS)
HGHLOP:	HRRZS	P2,T1		;MORE PERMANENT PLACE, CLEAR JUNK
	JUMPE	P2,HGHLP8	;?
	JUMPE	T3,HGHLP1	;REMOVING HIGH SEG?
	MOVE	T3,.HBSGN(T1)	;NO, LOAD DATA BITS # SEGMENT # INTO T3
	TLNN	T3,REDOMP	;NEED TO REDO THIS SEGMENT?
	JRST	HGHLP7		;NO
HGHLP1:	PUSHJ	P,HSVAD##	;COMPUTE HIGH SEGMENT STARTING AND ENDING ADDRESSES
	MOVSI	P1,SPYSEG	;SIGN BIT
	TDON	P1,.HBSGN(P2)	;IS THIS A SPY SEG
	HLRZ	P1,JBTADR##(P1)	;NO, GET SIZE
	HRLZS	P1		;HIGH SEGMENT SIZE,,0
	SKIPL	USRHCU##	;SAVE IN PROGRESS?
	HRRM	T1,JOBHRL##+.JDAT ;YES, DON'T CLOBBER IOWD IN COMPRESSED LOW SEGMENT
	TLNN	T3,SHRSEG+SPYSEG  ;HIGH SEGMENT SHARABLE?
	JUMPN	T3,SCWEXO	;NO, THE MAP IS RIGHT EXCEPT FOR W.E. AND PUBLIC BITS
	LDB	T1,[PSG2LH+.HBSG2(P2)]	;SECTION # OF HIGH SEG
	LSH	T1,S2PLSH	;PAGE #
	LSH	T2,W2PLSH
	ADD	T1,T2		;1ST PAGE
	ADD	T1,[MS.MAP+UMAPS-1] ;SET UP FOR PRE-INCREMENT
	JUMPL	T3,SETSPY	;JUMP IF A SPY SEGMENT
	HRRZ	T2,T3		;GET COPY WITHOUT BITS
	JUMPE	T3,SETM20	;IF REMOVING HIGH SEG, STORE 0
	SKIPN	T2,JBTVAD##(T2)	;DID THIS SEGMENT GO AWAY?
	JRST	SETM20		;YES
	MOVSI	T2,(<PM.ICD>B2+PM.WRT+PM.CSH+PM.NIA)
IFN FTLOCK!FTMP,<
	TLNE	T3,NCSH+NOCSH	;CACHE?
	PUSHJ	P,[TLZ T2,(PM.CSH);NO, CLEAR THE BIT
		   JRST CSDMP##];AND FLUSH THE CACHE
>
	PUSH	P,T1		;CHKPUB CLOBBERS T1
	PUSHJ	P,CHKPUB	;SEE IF THE SEGMENT SHOULD BE CONCEALED
	  TLO	T2,(PM.PUB)	;JACCT OR NOT EXECUTE ONLY, SO MAKE PAGES PUBLIC
	POP	P,T1		;RESTORE T1
	TLNN	T3,UWPOFF	;USER WRITE PROTECT OFF?
	TLZ	T2,(PM.WRT)	;NO, DON'T ALLOW WRITE
	HRRZS	T3		;CLEAR JUNK
	LDB	T4,[POFFLH##+JBTVAD##(T3)]
	TLO	T2,(T4)		;STARTING OFFSET OF MAP
	HRRI	T2,JBTUPM##-SPTTAB##(T3) ;OFFSET INTO SPT
SETM20:	HLRZ	T4,P1		;HIGH SEGMENT SIZE
	PUSHJ	P,REMASH	;MAP THE HIGH SEGMENT INTO THE USER'S ADDRESS SPACE
	JRST	SETMP3		;CONTINUE

;HERE FOR SPY SEG
SETSPY:	MOVSI	T2,(<PM.DCD>B2!PM.PUB!PM.NIA) ;SPY SEGS MUST BE PUBLIC BUT
				;NOT WRITABLE OR CACHED
	LDB	T3,[POINT 9,P1,8];SIZE OF THE SPY SEGMENT
SETMP2:	AOS	T1		;INCREMENT
	MOVEM	T2,(T1)		;AND DEPOSIT, MAP MONITOR ADDRESSES
	AOS	T2		;STEP TO NEXT MONITOR PAGE
	SOJGE	T3,SETMP2	;MAP AS MANY PAGES AS THE USER REQUESTED

SETMP3:	LDB	T3,[PHSSLH+.HBHSZ(P2)] ;PREVIOUS HS SIZE
	TLNE	P1,-1		;IF THE HIGH SEGMENT SIZE ISN'T 0,
	SUBI	T3,1		;HIGHEST PAGE IN THE HIGH SEGMENT
	LDB	T2,[POINT 9,P1,8]  ;CURRENT SIZE -1 OF THE SEGMENT IN PAGES
	PUSHJ	P,ZERMAP	;ZERO MAP SLOTS NO LONGER A PART OF THE HIGH SEGMENT
	MOVSI	T1,(UP.CTX)	;DOING CONTEXT STUFF?
	CAMN	J,.CPJOB##	;ONLY IF AT UUO LEVEL
	TDNN	T1,.USBTS	;?
	CAIA			;NOT DOING A PUSH
	JRST	SETMP4		;YES, DON'T CHANGE .HBHSZ
	TLNE	P1,-1		;IF THERE STILL IS A HIGH SEGMENT
	ADDI	T2,1		;COMPUTE NEW NUMBER OF PAGES IN THE HIGH SEGMENT
	DPB	T2,[PHSSLH+.HBHSZ(P2)]	;STORE NEW NUMBER OF PAGES IN THE HIGH SEGMENT
SETMP4:	MOVSI	T1,REDOMP	;CLEAR REDOMP FOR THIS SEGMENT
	ANDCAM	T1,.HBSGN(P2)
HGHLP7:	JUMPE	T3,HGHLP8	;REMOVE ONLY ONE HS
	SKIPE	T1,.HBLNK(P2)	;NEXT SEGMENT
	JRST	HGHLOP
HGHLP8:	CLRPGT			;CLEAR THE PAGING MEMORY SO NEW MAPPING WILL BE SEEN
	POPJ	P,		;RETURN

;SUBROUTINE TO MAKE WRITE-ENABLE AND PUBLIC BITS RIGHT FOR A HI SEG
;P2 HAS HIGH SEG BLOCK ADDR FOR THIS JOB

SCWEXO::MOVE	R,JBTADR##(J)	;MAKE SURE R IS SETUP TO POINT AT
				; THE LOW SEGMENT
	SKIPG	.HBSGN(P2)	;REAL HIGH SEG?
	POPJ	P,		;NO, DON'T BOTHER
	MOVE	T1,P2		;PUT HIGH SEG BLOCK IN T1 FOR HSVAD
	PUSHJ	P,HSVAD##	;GET HIGH SEG ADDRESSES
	DMOVE	T3,T1		;COPY NUMBERS
	LSHC	T3,W2PLSH	;ORIGIN PAGE, HIGHEST PAGE
	PUSHJ	P,CHKPUB	;SEE IF THE HIGH SEGMENT SHOULD BE CONCEALED
	  TLO	T3,400000	;NO, MAKE THE HIGH SEGMENT PUBLIC
	LDB	T1,[PSG2LH+.HBSG2(P2)]	;GET SECTION #
	LSH	T1,S2PLSH	;PART OF PAGE #
	IORI	T1,(T4)		;AND PUT IN REST
	SE1ENT			;FOR PAGE MAP REFERENCES
SCWEX1:	PUSHJ	P,TSWST##	;IS THIS PAGE IN THE WORKING SET?
	  JRST	SCWEX2		;NO, SKIP IT
	PUSHJ	P,GTPME##	;GET CONTESTS OF MAP
	TLO	T2,(PM.NIA)	;NO I/O ALLOWED
	TLZ	T2,(PM.WRT!PM.PUB) ;ASSUME WRITE-LOCKED AND EXECUTE ONLY
	SKIPGE	T3		;PUBLIC?
	TLO	T2,(PM.PUB)	;YES, TURN ON THE PUBLIC BIT
	MOVEM	T2,(T4)		;STORE BACK IN THE MAP WITH NEW ATTRIBUTES
SCWEX2:	MOVEI	T2,HLGPNO	;IGNORE SECTION # HERE
	ANDI	T2,(T1)
	CAIE	T2,(T3)		;LAST PAGE?
	AOJA	T1,SCWEX1	;NO, LOOP OVER ALL HIGH SEGMENT PAGES
	CLRPGT			;CLEAR THE PAGING MEMORY SO NEW MAPPING WILL BE SEEN
	POPJ	P,		;RETURN

;SUBROUTINE TO SEE IF A HIGH SEGMENT SHOULD BE CONCEALED, CALL WITH J =
; JOB NUMBER, AND P2=HIGH SEGEMENT BLOCK ADDR FOR HIGH SEG IN QUESTION
;RETURNS CPOPJ1 IF SO

CHKPUB:	MOVE	T1,.HBSGN(P2)	;SEGMENT WORD
	TLNN	T1,GTSSEG	;SEGMENT GETSEGED?
	POPJ	P,		;NO, ALWAYS PUBLIC
IFN FTFDAE,<
	MOVSI	T1,(JS.FXO)	;XO BY THE FILE DAEMON BIT
	TDNE	T1,JBTST2##(J)	;IS IT EXECUTE ONLY ?
	JRST	CPOPJ1##	;YES, MAKE IT CONCEALED
>
	MOVE	T1,JBTSTS##(J)	;CURRENT JOB STATUS
	TLNN	T1,JACCT	;A PRIVLEDGED PROGRAM (TOO STUPID TO BE XO)?
	TRNN	T1,JS.XO	;AN EXECUTE ONLY PROGRAM?
	POPJ	P,		;NO, MAKE THE HIGH SEGMENT PUBLIC
	JRST	CPOPJ1##	;YES, MAKE IT CONCEALED
;SUBROUTINE TO SETUP THE USER PAGE MAP PAGE TO REFLECT THE LOCATION
; OF THE PAGES OF A SEGMENT IN PHYSICAL MEMORY
;CALLING SEQUENCE:
;	MOVE	T1,BYTE POINTER TO THE MAP
;	MOVE	T2,PAGE ATTRIBUTES
;	MOVE	T3,ABSOLUTE PAGE NUMBER OF FIRST PAGE OF THE SEGMENT
;	MOVE	T4,HIGHEST ADDRESS IN THE SEGMENT
;	PUSHJ	P,REMAP
;	...	ALWAYS RETURN HERE

REMAP:	JUMPE	T4,CPOPJ##	;IF THE SEGMENT IS ZERO LENGTH RETURN
	SE1ENT			;MUST BE IN SECTION 1
	LSH	T4,W2PLSH	;CONVERT TO NUMBER OF PAGES - 1
REMAP1:	TDO	T3,T2		;ABSOLUTE PAGE NUMBER PLUS ACCESS BITS
	AOS	T1
	MOVEM	T3,(T1)		;STORE PHYSICAL LOCATION OF THE PAGE AND
				; THE ACCESS BITS IN THE MAP
	TDZ	T3,T2		;CLEAR ACCESS BITS
	SSX	T3,MS.MEM	;SET SECTION NUMBER
	HRRZ	T3,PAGTAB(T3)	;GET THE ABSOLUTE PAGE NUMBER OF THE NEXT
				; PAGE IN THE SEGMENT
	SOJL	T4,CPOPJ##	;RETURN IF ALL THE PAGES IN THE SEGMENT
				; HAVE BEEN MAPPED
	JUMPG	T3,REMAP1	;MAP ALL THE PAGES IN THE SEGMENT
	STOPCD	.,STOP,PMU,	;++PAGTAB MESSED UP

;EQUIVALENT ROUTINE FOR A SHARABLE HIGH SEG

REMASH:	JUMPE	T4,CPOPJ##	;IF THE SEGMENT IS ZERO LENGTH RETURN
	LSH	T4,W2PLSH	;CONVERT TO NUMBER OF PAGES - 1
	SKIPE	T3,T2		;IF STORING ZERO, STORE ALL ZEROES
	MOVSI	T3,1		;INCREMENT THROUGH SPT
REMSH1:	AOS	T1
	MOVEM	T2,(T1)		;STORE PHYSICAL LOCATION OF THE PAGE AND
				; THE ACCESS BITS IN THE MAP
	ADD	T2,T3		;INCREMENT
				; PAGE IN THE SEGMENT
	SOJGE	T4,REMSH1	;CONTINUE
	POPJ	P,

;ROUTINE TO DETERMINE IF THE SIZE OF A SEGMENT HAS CHANGED SINCE THE LAST
; TIME THE JOB WHOSE ADDRESSING SPACE CONTAINS THIS SEGMENT WAS RUN.  IF THE
; SEGMENT IS SMALLER THAN THE IT PREVIOUSLY WAS, THE ROUTINE
; ZEROES THE LOCATIONS IN THE MAP WHICH CORRESPOND TO THE PAGES REMOVED FROM
; THE SEGMENT (OR ALL THE LOCATIONS IF THE SEGMENT WAS REMOVED) SO THE JOB
; WILL PAGE FAIL ON AN ILLEGAL MEMORY REFERENCE
;CALLING SEQUENCE:
;	MOVE	T3,PREVIOUS SEGMENT SIZE IN PAGES - 1
;	PUSHJ	P,ZERMAP
;	...	ALWAYS RETURN HERE - T2 = CURRENT SEGMENT SIZE IN PAGES - 1

ZERMAP:	SE1ENT			;NEED TO BE IN SECTION 1 FOR MAPS
	SUBI	T3,(T2)		;NEW SIZE MINUS OLD SIZE
	JUMPLE	T3,CPOPJ##	;RETURN IF THE SEGMENT IS THE SAME
				; SIZE OR BIGGER THAN IT WAS THE LAST TIME
				; THE JOB WAS RUN
ZRMAP1:	AOS	T1		;INCREMENT
	SETZM	(T1)		;ZERO
	SOJG	T3,ZRMAP1	; ILLEGAL MEMORY REFERENCE
	POPJ	P,		;RETURN
;SUBROUTINE TO RETURN PAGES TO THE LINKED LIST OF FREE PAGES AND UPDATE
; BIGHOL (THE TOTAL NUMBER OF FREE PAGES) AND CORTAL (THE TOTAL NUMBER
; OF FREE PAGES PLUS THE NUMBER OF PAGES OCCUPIED BY
; DORMANT OR IDLE SEGMENTS)
;CALLING SEQUENCE:
;	MOVE	T1,FIRST PAGE TO RETURN TO THE FREE CORE LIST
;	PUSHJ	P,GVPAGS
;	ALWAYS RETURN HERE

GVPAGS::
IFN FTMP,<
	PUSHJ	P,MMOWN##	;OWN THE MM RESOURCE?
	  PUSHJ	P,MMDIE		;NO, MUST DIE
>
	SE1ENT			;MUST BE IN SECTION 1 TO REFERENCE PAGTAB
	HRRZS	T2,T1		;T2 = FIRST PAGE TO RETURN (CLEAR ANY JUNK IN LH)
	EXCH	T1,PAGPTR##	;STORE FIRST PAGE TO FREE AS FIRST PAGE ON THE
				; FREE CORE LIST AND GET FIRST PAGE ON CURRENT LIST
	PUSH	P,T1		;SAVE
	SSX	T2,MS.MEM
	HRRZ	T1,PT2TAB(T2)	;GET BACK LINK (IF ANY)
	SKIPE	T1		;IGNORE IF NONE
	HLLZS	@[IW MS.MEM,PAGTAB(T1)] ;CLEAR BACK LINK
	HLLZS	PT2TAB(T2)	;NO BACK LINK
	MOVSI	T1,(P2.LIP)	;LOKCON CHECK
	MOVEI	T3,1		;AT LEAST ONE PAGE IS BEING RETURNED
GVPAG1:	MOVSI	T4,FREPAG	;THIS PAGE IS ON THE FREE CORE LIST BIT
	SSX	T2,MS.MEM	;SET SECTION NUMBER
	TDNE	T4,PAGTAB(T2)	;PAGE MUST NOT BE FREE ALREADY
	STOPCD	.,STOP,ARF,	;++ATTEMPT TO RETURN FREE PAGE
	IORB	T4,PAGTAB(T2)	;MARK THIS PAGE AS BEING ON THE FREE CORE LIST
				; AND GET THE NEXT PAGE TO BE RETURNED
	TDNN	T1,PT2TAB(T2)	;LOKCON WAITING FOR THIS PAGE?
	JRST	GVPAG5		;NO, PROCEED
	HRRZ	T1,PT2TAB(T2)	;YES, PREVIOUS PAGE TO THIS ONE
	SSX	T4,MS.MEM	;SET SECTION IN SUCCESSOR
	SSX	T1,MS.MEM	;AND PREDECESSOR
	TRNE	T4,-1		;IS THE A SUCCESSOR?
	HRRM	T1,PT2TAB(T4)	;YES, SET OUR PREDECESSOR AS HIS
	PUSH	P,T1		;FOR IF WE EXIT
	TRNN	T1,-1		;IS THIS FIRST PAGE ON FREE LIST?
	MOVEI	T1,PAGPTR-PAGTAB ;YES, SET TO STORE IN PAGPTR
	HRRM	T4,PAGTAB(T1)	;STORE SUCCESSOR
	SOS	T3		;UNDO THE FOLLOWING AOJA
	AOS	LOKHOL##	;ONE MORE PAGE IN LOKCON'S QUEUE
	AOS	LOKTAL##	;AND LOKCON'S VERSION OF CORTAL
	HRRZ	T1,LOKPTR##	;FIRST PAGE IN LOKCON'S QUEUE
	SSX	T1,MS.MEM	;IN CASE POINTED @PAGPTR
	HRRM	T1,PAGTAB(T2)	;IS NOW OUR SUCCESSOR
	HRRZM	T2,LOKPTR##	;WE ARE NOW FIRST
	HLLZS	PT2TAB(T2)	;WE HAVE NO PREDECESSOR
	TRNE	T1,-1		;DO WE HAVE A SUCCESSOR?
	HRRM	T2,PT2TAB(T1)	;YES, SET US AS PREDECESSOR
	MOVSI	T1,(P2.LIP)	;RESTORE T1
	POP	P,T2		;REAL LAST PAGE ON FREE LIST
GVPAG5:	TRNN	T4,-1		;LAST PAGE TO BE RETURNED?
	JRST	GVPAG2		;YES, UPDATE BIGHOL AND CORTAL AND RETURN
	HRRZ	T2,T4		;INDEX TO NEXT PAGE TO FREE
	AOJA	T3,GVPAG1	;COUNT NUMBER OF PAGES FREED AND RETURN NEXT PAGE
GVPAG2:	POP	P,T1		;RESTORE T1 (OLD PAGPTR)
	TRNN	T2,-1
	MOVEI	T2,PAGPTR-PAGTAB ;THEN POINT AT PAGPTR
	HRRM	T1,PAGTAB(T2)	;LINK THE REST OF THE FREE CORE LIST TO THE PAGES
	SSX	T1,MS.MEM
				; FREED
	ADDM	T3,BIGHOL##	;UPDATE THE AMOUNT OF FREE CORE BY THE NUMBER
				; OF PAGES FREED
	ADDM	T3,CORTAL##	;ALSO, UPDATE THE AMOUNT OF POTENTIALLY FREE CORE
IFN FTMP&FTKL10,<
	SETOM	SAVCTL##	;MAKE SURE A SWEEP HAPPENS
>
	CAIE	T2,PAGPTR-PAGTAB ;ALREADY SET IF NO PAGES ADDED
	TRNN	T1,-1		;OR IF THERE WERE NO PAGES
	POPJ	P,		;THEN RETURN NOW
	HRRM	T2,PT2TAB(T1)
	POPJ	P,		;AND RETURN
;SUBROUTINE TO FIND THE NTH PAGE FOR N.LT.THE NUMBER OF PAGES
; ASSIGNED TO THE JOB OR THE JOBS LAST PAGE
;CALLING SEQUENCE:
;	PUSHJ	P,SCPAGS	;TO FIND THE LAST PAGE OF THE JOB
;OR
;	PUSHJ	P,SNPAGS	;TO FIND THE NTH PAGE OF A JOB
;	RETURN HERE - T1 = PAGE NUMBER OF THE NTH PAGE

SCPAGS::MOVEI	T2,-1		;STOP AFTER SCANNING ALL PAGES
SNPAGS::
IFN FTMP,<
	PUSHJ	P,MMOWN##	;OWN THE MM RESOURCE?
	  PUSHJ	P,MMDIE		;NO, MUST DIE
>
	SE1ENT			;MUST BE IN SECTION 1 TO REFERENCE PAGTAB
	PUSH	P,J		;SAVE J
IFN FTXMON,<
	HRRZS	J		;COULD BE IN SECTION 1 AND LH OF J CONTAINS CRUFT
>
	LDB	T3,JBYHSA##	;PHYSICAL PAGE NUMBER OF PAGE 0 IN THE LOW SEGMENT
	CAIG	J,JOBMAX##	;IS THIS A HIGH SEGMENT?
	LDB	T3,JBYLSA##	;YES, PHYSICAL PAGE NUMBER OF FIRST PAGE OF
				; THE HIGH SEGMENT
	POP	P,J		;RESTORE SEGMENT NUMBER
SNPAG1::HRRZ	T1,T3		;CURRENT PAGE WITHIN THE SEGMENT
	SSX	T1,MS.MEM	;SET SECTION NUMBER
	SKIPGE	T3,PAGTAB(T1)	;GET NEXT PAGE IN THE SEGMENT
	STOPCD	.,STOP,PSF,	;++PAGE IN SEGMENT FREE
	TRNE	T3,-1		;IS THIS THE LAST PAGE IN THE SEGMENT?
	SOJGE	T2,SNPAG1	;NO, IS THIS THE NTH PAGE WITHIN THE SEGMENT?
	HRRZS	T1		;RETURN ONLY THE PHYSICAL PAGE NUMBER
	POPJ	P,		;YES, RETURN WITH T1 = NTH OR LAST PAGE
;SUBROUTINE TO GET PAGES FROM THE LINKED LIST OF FREE PAGES AND
; UPDATE CORTAL AND BIGHOL
;CALLING SEQUENCE:
;	MOVE	T1,WHERE TO BEGIN ALLOCATION IF ADDING PAGES
;	MOVE	T2,NUMBER OF PAGES TO ALLOCATE
;	PUSHJ	P,ADPAGS	;OR
;	PUSHJ	P,GTPAGS	;IF NO PAGES ARE CURRENTLY ALLOCATED
;	ALWAYS RETURN HERE - T1 = PAGE NUMBER OF FIRST PAGE ALLOCATED

ADPAGS::MOVE	T4,PAGPTR##	;FIRST FREE PAGE
	SE1ENT			;GET TO SECTION 1
	SSX	T1,MS.MEM	;SET SECTION INDEX
	PUSH	P,PAGTAB(T1)	;SAVE PREVIOUS LINK
	HRRM	T4,PAGTAB(T1)	;LINK IT TO THE PAGES CONTAINED IN THIS SEGMENT
	MOVE	T4,T1		;PRE-LOAD PAGE
	JRST	GTPAG0
GTPAGS::
	SETZ	T4,
	SE1ENT			;GET TO SECTION 1
	PUSH	P,T4		;VALUE TO PUT ON END OF PAGTAB CHAIN
GTPAG0:
IFN FTMP,<
	PUSHJ	P,MMOWN##	;OWN THE MM RESOURCE?
	  PUSHJ	P,MMDIE		;NO, MUST DIE
>
	SKIPN	T1,PAGPTR##	;GET FIRST FREE PAGE
	STOPCD	.,STOP,PEZ,	;++PAGPTR=0
	MOVNS	T2		;MINUS NUMBER OF PAGES BEING ALLOCATED
	ADDM	T2,BIGHOL##	;DECREASE THE NUMBER OF FREE PAGES BY THAT AMOUNT
	ADDM	T2,CORTAL##	;AND THE NUMBER OF POTENTIALLY FREE PAGES
	MOVE	T3,T1		;FIRST PAGE TO ALLOCATE
GTPAG1:	SSX	T3,MS.MEM
	HRRM	T4,PT2TAB(T3)	;SET PREVIOUS POINTER (CLEARING REST)
	HRRZ	T4,T3		;ALLOCATE THIS PAGE
	MOVSI	T3,FREPAG	;PREPARE TO MARK THIS PAGE AS IN-USE
	SKIPN	T4		;END OF THE FREE CORE LIST?
	STOPCD	.,STOP,FPI,	;++FREE PAGE INUSE
	SSX	T4,MS.MEM	;SET SECTION INDEX
	ANDCAB	T3,PAGTAB(T4)	;CLEAR THE BIT INDICATING A FREE PAGE AND GET
				; THE NEXT PAGE ON THE FREE CORE LIST
	AOJL	T2,GTPAG1	;LOOP UNTIL ALL PAGES REQUESTED ARE ALLOCATED
	HRRZM	T3,PAGPTR##	;STORE THE NEW FIRST PAGE IN THE FREE CORE LIST
	SSX	T3,MS.MEM
	HLLZS	PT2TAB(T3)	;IT HAS NO BACK LINK NOW
	POP	P,T3		;THE BEGINNING OF THE REST OF THE CHAIN
	HRRZM	T3,PAGTAB(T4)	;POINT NEW PART TO OLD PART
	JUMPE	T3,CPOPJ##	;RETURN IF NO BACK LINK TO UPDATE
	SSX	T3,MS.MEM	;POINT TO PAGTAB SECTION
	HRRM	T4,PT2TAB(T3)	;UPDATE BACK LINK
	POPJ	P,		;AND RETURN TO THE CALLER

;HERE IF TRYING TO DO CORE ALLOCATION WITHOUT THE MM RESOURCE
IFN FTMP,<
MMDIE::	STOPCD	.,STOP,DOM,	;DON'T OWN MM RESOURCE
>
;*** THIS PROBABLY CAN BE MADE TO DO SOME REASONABLE RECOVERY
SUBTTL	SWAP - USER PROGRAM SWAPPING ROUTINES

;SUBROUTINE TO SETUP THE MAP FOR A JOB WHICH WAS JUST SWAPPED IN
; THIS INCLUDES THE TRAP LOCATIONS AS WELL AS THE MAP ITSELF
;CALLING SEQUENCE:
;	MOVE	J,JOB NUMBER OF JOB JUST SWAPPED IN
;	MOVE	R,XWD LOW SEGMENT SIZE, EVA OF THE JOB DATA AREA
;	SETUP THE USER BASE REGISTER TO POINT TO THIS JOB'S UPMP
;	PUSHJ	P,MAPUSR
;	ALWAYS RETURN HERE

MAPUSR::MOVE	R,JBTADR##(J)	;R=WXD LOW SEGMENT SIZE, ADDRESS OF JOB DATA AREA
	PJRST	MAPHGH		;MAP THE HIGH SEGMENT
SUBTTL	SWPSER - SWAPPING SERVICE ROUTINE

;SUBROUTINE TO MAKE THE FIRST WORD OF A SEGMENT ADDRESSABLE FOR JBTCHK
; CALLING SEQUENCE:
;	MOVE	T1,IOWD USED FOR SWAPPING
;	MOVE	J,SEGMENT NUMBER OF SEGMENT SWAPPED IN OR OUT
;	PUSHJ	P,GETCHK
;	ALWAYS RETURN HERE
;T1 = EXEC VIRTUAL ADDRESS OF WORD 0 OF THE SEGMENT.  IF THIS IS A LOW
; SEGMENT, JUST SETUP THE UBR SINCE T1 CONTAINS THE ADDRESS OF WORD 0
; OF THE SEGMENT MAPPED THROUGH THE PER PROCESS MAP.  IF THIS IS A HIGH
; SEGMENT, MAP WORD 0 THROUGH THE EXEC MAP SINCE THE SEGMENT MAY BE
; DORMANT OR IDLE AND THUS NOT APPEAR IN ANY USERS MAP.

GETCHK::LDB	T1,JBYLSA		;ABSOLUTE PAGE #

;SUBROUTINE TO MAKE A PHYSICAL PAGE ADDRESSABLE FOR SWAPPER
;CALLING SEQUENCE:
;	MOVEI	T1,PAGE NUMBER
;	PUSHJ	P,SWPAD
;	ALWAYS RETURNS HERE
;T1=EVA OF FIRST WORD IN PAGE
;PRESERVES T2-T4
SWPAD::	PUSHJ	P,SAVE1##
	MOVE	P1,.CPMAP##
	HRLI	T1,(<PM.DCD>B2+PM.WRT+PM.PUB)
	MOVEM	T1,.ECKSM/PAGSIZ(P1)
	CLRPT	.ECKSM		;FLUSH THE ASSOCIATIVE MEMORY SO THE NEW
	     	      		; MAPPING WILL BE IN EFFECT
	MOVEI	T1,.ECKSM	;T1 = EXEC VIRTUAL ADDRESS OF WORD 0 OF THE
				; HIGH SEGMENT
	POPJ	P,		;RETURN
;ROUTINE TO CLEAR PART OF JOB DATA AREA(PART PROTECTED FROM USER IO)
;CALLED WHEN SWAP READ ERROR AND AT SYSTEM RESTART(140)
;	MOVE	J,JOB NO.
;CALL:	MOVE	R,ADDRESS OF JOB DATA AREA
;	PUSHJ	P,CLRJOB

CLRJOB::PUSHJ	P,SVEUB##	;MAKE SURE JOB DATA AREA IS ADDRESSABLE
	SETZM	USRPRT##	;FIRST LOC. PROTECTED FROM USER
	MOVSI	T1,USRPRT##
	HRRI	T1,USRPR1##
	MOVE	T2,.JDAT+JOBDDT##	;SAVE DDT STARTING ADDRESS
	BLT	T1,USRJDA##+17
	MOVEM	T2,.JDAT+JOBDDT##
	SETZM	.JDAT+JOBENB##	;ALSO CLEAR APR ENABLE WORD
	SETZM	.JDAT+JOBPD1##	;AND UUO PC FLAGS(USED WHEN JOB STARTS)
	PJRST	ESTOP1##	;GO SET JOB STATUS NOT BE ALLOWED
				;NOTE JACCT IS CLEARED

	SUBTTL	CORE ALLOCATION  --  EXTENSIBLE BITMAP MEMORY ROUTINES


;ROUTINES CALLED TO ALLOCATE EXTENSIBLE BITMAP MEMORY
;LINKAGE:
;	T2/ NUMBER OF WORDS
;	T3/ ADDRESS OF ALLOCATION CONTROL BLOCK
;	PUSHJ	P,GTXWDS
;RETURNS:
;	CPOPJ ON ALLOCATION ERROR
;	CPOPJ1 ON SUCCESS WITH:
;	T1/ ADDRESS OF MEMORY ALLOCATED

GTXWDS::TDZA	T1,T1		;CLEAR ZERO FLAG AND SKIP
GTXWDZ::SETO	T1,		;SET ZERO FLAG
	PUSHJ	P,SAVE4##	;SAVE P1-P4
	PUSH	P,T1		;SAVE ZERO FLAG
	MOVE	P4,T3		;SAVE ADDRESS OF ALLOCATION CONTROL BLOCK
	SKIPN	P3,ACBAHB(P4)	;GET ADDRESS OF ALLOCATION HEADER BLOCK
	STOPCD	CPOPJ##,DEBUG,CORNAH ;++NO ALLOCATION HEADER BLOCK
	IDIV	T2,AHBCSZ(P3)	;COMPUTE NUMBER OF CHUNKS TO ALLOCATE
	SKIPE	T3		;ANY REMAINDER?
	ADDI	T2,1		;YES, ROUND UP
	IMUL	T2,AHBCSZ(P3)	;CONVERT BACK INTO WORDS
	MOVE	P1,T2		;SAVE IN P1

GTXWD0:	MOVE	T1,P1		;GET WORD COUNT
	ADDB	T1,ACBUSD(P4)	;UPDATE ALLOCATOR'S COUNT OF USED MEMORY
	CAMLE	T1,ACBMAX(P4)	;WITHIN MAXIMUM ALLOWABLE AMOUNT?
	JRST	GTXWX1		;NO, GO FIX COUNT AND RETURN
	CAMLE	T1,ACBHWM(P4)	;GREATER THAN PREVIOUS HIGH WATER MARK?
	MOVEM	T1,ACBHWM(P4)	;YES, STORE NEW HIGH WATER MARK

	MOVN	T1,P1		;GET NEGATIVE WORD COUNT
	ADDB	T1,AHBFRE(P3)	;UPDATE HEADER BLOCK'S COUNT OF FREE WORDS
	JUMPL	T1,GTXWX2	;IF NOT ENOUGH, GO TRY AND EXTEND POOL
	CAMGE	T1,AHBLWM(P3)	;LESS THAN PREVIOUS LOW WATER MARK?
	MOVEM	T1,AHBLWM(P3)	;YES, STORE NEW LOW WATER MARK

	SKIPA	P2,AHBAEB(P3)	;GET ADDRESS OF FIRST ALLOCATION EXTENT BLOCK
GTXWD1:	MOVE	P2,AEBNXT(P2)	;GET ADDRESS OF NEXT ALLOCATION EXTENT BLOCK
	JUMPE	P2,GTXWX2	;AT END OF LIST, GO ATTEMPT TO EXTEND POOL
	MOVE	T1,P1		;GET NUMBER OF WORDS TO ALLOCATE
	IDIV	T1,AHBCSZ(P3)	;CONVERT INTO CHUNKS
	MOVEI	T2,AEBBMP(P2)	;GET ADDRESS OF BIT MAP AOBJN POINTER
	CAMG	P1,AEBFRE(P2)	;DOES THIS EXTENT HAVE ENOUGH FREE WORDS?
	PUSHJ	P,GETBIT	;YES, TRY TO ALLOCATE CORE
	  JRST	GTXWD1		;FAILED, LOOP BACK FOR NEXT ALLOCATION EXTENT
	IMUL	T1,AHBCSZ(P3)	;COMPUTE WORD OFFSET OF ALLOCATION
	ADD	T1,AEBADR(P2)	;COMPUTE ADDRESS OF ALLOCATION
	EXCH	T1,(P)		;SAVE ADDRESS, GET BACK ZERO FLAG

				;CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

	MOVN	T2,P1		;GET NEGATIVE WORD COUNT
	ADDB	T2,AEBFRE(P2)	;UPDATE EXTENT BLOCK'S COUNT OF FREE WORDS
	CAMGE	T2,AEBLWM(P2)	;LESS THAN PREVIOUS LOW WATER MARK?
	MOVEM	T2,AEBLWM(P2)	;YES, STORE NEW LOW WATER MARK

	JUMPE	T1,GTXWD2	;JUMP IF NOT ZEROING ALLOCATED CORE

IFE FTXMON,<
	MOVS	T1,(P)		;GET STARTING ADDRESS OF ALLOCATION
	HLRI	T1,1(T1)	;GET ADDRESS OF SECOND WORD OF ALLOCATION
	MOVE	T2,P1		;GET NUMBER OF WORDS ALLOCATED
	ADD	T2,(P)		;COMPUTE LAST ADDRESS+1 TO ZERO WITH BLT
	SETZM	-1(T1)		;ZERO FIRST WORD OF ALLOCATION
	CAIE	T2,(T1)		;IS ALLOCATION ONE WORD LONG?
	BLT	T1,-1(T2)	;NO, ZERO REMAINDER OF ALLOCATION
>; END IFE FTXMON
IFN FTXMON,<
	MOVE	T1,P1		;GET NUMBER OF WORDS ALLOCATED
	SUBI	T1,1		;COMPUTE WORDS TO ZERO WITH XBLT
	MOVE	T2,(P)		;GET STARTING ADDRESS OF ALLOCATION
	MOVE	T3,T2		;GET ADDRESS OF SECOND WORD OF ALLOCATION
	ADDI	T3,1		;...
	SETZM	(T2)		;ZERO FIRST WORD OF ALLOCATION
	EXTEND	T1,[XBLT]	;ZERO REMAINDER OF ALLOCATION
>; END IFN FTXMON

GTXWD2:	MOVE	T1,AHBFRE(P3)	;GET HEADER BLOCKS'S COUNT OF FREE WORDS
	ADD	T1,AHBPND(P3)	;PLUS CURRENT PENDING ALLOCATION AMOUNT
	CAMGE	T1,AHBTHR(P3)	;BELOW ALLOCATION THRESHOLD?
	PUSHJ	P,GTXXTD	;YES, GO TRY TO EXTEND POOL
	  JFCL			;DON'T CARE IF EXTENSION FAILED OR PENDING
	PJRST	TPOPJ1##	;RESTORE ADDRESS OF ALLOCATION AND RETURN


;HERE IF REQUESTED AMOUNT WOULD PUT ALLOCATOR OVER MAXIMUM

GTXWX1:	MOVN	T1,P1		;GET NEGATIVE WORD COUNT
	ADDM	T1,ACBUSD(P4)	;FIX ALLOCATOR'S COUNT OF USED MEMORY
	PJRST	TPOPJ##		;CLEAN STACK AND RETURN

;HERE TO EXTEND A BITMAP MEMORY POOL

GTXWX2:	ADDM	P1,AHBFRE(P3)	;FIX HEADER BLOCK'S COUNT OF FREE WORDS
	MOVN	T1,P1		;GET NEGATIVE WORD COUNT
	ADDM	T1,ACBUSD(P4)	;FIX ALLOCATOR'S COUNT OF USED MEMORY
	PUSHJ	P,GTXXTD	;EXTEND ALLOCATOR'S POOL IF POSSIBLE
	  PJRST	TPOPJ##		;FAILED OR PENDING, CLEAN STACK AND RETURN
	JRST	GTXWD0		;LOOP BACK TO TRY WITH LARGER POOL
;ROUTINE CALLED TO EXTEND A BITMAP MEMORY POOL
;LINKAGE:
;	P3/ ADDRESS OF ALLOCATION HEADER BLOCK
;	PUSHJ	P,GTXXTD
;RETURNS:
;	CPOPJ IF EXTENSION FAILED OR PENDING
;	CPOPJ1 IF EXTENSION COMPLETED

GTXXTD:	PUSHJ	P,SAVE2##	;SAVE P1-P2
	MOVE	P1,AHBMIN(P3)	;GET MINIMUM FREE ALLOCATION AMOUNT
	SUB	P1,AHBFRE(P3)	;COMPUTE TARGET INCREMENTAL ALLOCATION
	SUB	P1,AHBPND(P3)	;...
	TRZE	P1,PG.BDY	;ROUND UP TO PAGE BOUNDARY
	ADDI	P1,PAGSIZ	;...
	PJMPLE	P1,CPOPJ##	;RETURN IF DON'T NEED INCREMENTAL ALLOCATION
	CAMGE	P1,AHBINC(P3)	;LESS THAN INCREMENTAL ALLOCATION AMOUNT?
	MOVE	P1,AHBINC(P3)	;YES, GET INCREMENTAL ALLOCATION AMOUNT
	MOVE	T1,AHBMAX(P3)	;GET MAXIMUM ALLOCATION AMOUNT
	SUB	T1,AHBCUR(P3)	;COMPUTE MAXIMUM AMOUNT TO ADD TO ALLOCATION
	SUB	T1,AHBPND(P3)	;...
	CAMLE	P1,T1		;LESS THAN TARGET INCREMENTAL ALLOCATION
	MOVE	P1,T1		;YES, USE MAXIMUM INCREMENTAL ALLOCATION
	PJMPLE	P1,CPOPJ##	;RETURN NOW IF AT MAXIMUM ALLOCATION

	MOVE	T2,P1		;GET INCREMENTAL ALLOCATION AMOUNT
	IDIV	T2,AHBCSZ(P3)	;COMPUTE INCREMENTAL NUMBER OF CHUNKS
	ADDI	T2,^D35		;CALCULATE NUMBER OF WORDS FOR BITMAP
	IDIVI	T2,^D36		;...
	ADDI	T2,AEBLEN	;ADD IN SIZE OF ALLOCATION EXTENT BLOCK
	PUSHJ	P,GETWDS	;ALLOCATE SECTION 0 CORE
	  POPJ	P,		;FAILED, RETURN NOW
	MOVE	P2,T1		;SAVE ADDRESS OF ALLOCATION EXTENT BLOCK

	MOVEM	P1,AEBSIZ(P2)	;INITIALIZE EXTENT BLOCK'S EXTENT SIZE
	MOVEM	P1,AEBFRE(P2)	;AND COUNT OF FREE WORDS
	MOVEM	P1,AEBLWM(P2)	;AND LOW WATER MARK
	MOVE	T2,P1		;GET INCREMENTAL ALLOCATION AMOUNT
	IDIV	T2,AHBCSZ(P3)	;CONVERT TO CHUNKS
	ADDI	T2,^D35		;CALCULATE NUMBER OF WORDS FOR BITMAP
	IDIVI	T2,^D36		; (REMAINDER IN T3)
	MOVN	T1,T2		;BUILD AOBJN POINTER TO BIT MAP
	HRLZS	T1		;...
	HRRI	T1,AEBBMP+1(P2)	;...
	MOVEM	T1,AEBBMP(P2)	;AND SAVE IN EXTENT BLOCK
	SETZM	AEBBMP+1(P2)	;ZERO FIRST WORD OF BITMAP
	MOVSI	T1,AEBBMP+1(P2)	;CONSTRUCT BLT POINTER TO CLEAR BITMAP
	HRRI	T1,AEBBMP+2(P2)	;...
	ADDI	T2,AEBBMP+1(P2)	;CALCULATE ADDRESS OF WORD FOLLOWING BITMAP
	CAIE	T2,AEBBMP+2(P2)	;IS BITMAP ONE WORD LONG?
	BLT	T1,-1(T2)	;NO, ZERO REMAINDER OF BITMAP

				;CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

	SUBI	T3,^D35		;CALCULATE NUMBER OF BITS TO MARK OFF
	MOVNS	T3		; IN LAST WORD OF BITMAP
	SETO	T1,		;START WITH A COMPLETE MASK
	LSH	T1,(T3)		;COMPUTE MASK OF BITS TO KEEP
	SETCAM	T1,-1(T2)	;MARK OFF APPROPRIATE BITS IN LAST WORD

	ADDM	P1,AHBPND(P3)	;UPDATE HEADER BLOCK'S PENDING ALLOCATION
	MOVE	T1,P1		;GET INCREMENTAL ALLOCATION AMOUNT
	LSH	T1,W2PLSH	;CONVERT TO PAGES
	HRL	T1,AHBSEC(P3)	;GET SECTION NUMBER FOR ALLOCATION
	XMOVEI	T2,GTXXT1	;GET ADDRESS OF CALLBACK ROUTINE
	MOVE	T3,P2		;GET ADDRESS OF ALLOCATION EXTENT BLOCK
	MOVE	T4,P3		;AND ADDRESS OF ALLOCATION HEADER BLOCK
	PJRST	GETCLP##	;QUEUE ALLOCATION REQUEST AND RETURN

;HERE ON ALLOCATION COMPLETION CALLBACK

GTXXT1:	PUSHJ	P,SAVE3##	;SAVE P1-P3
	MOVE	P2,T3		;GET BACK ADDRESS OF ALLOCATION EXTENT BLOCK
	MOVE	P3,T4		;AND ADDRESS OF ALLOCATION HEADER BLOCK
	MOVEM	T1,AEBADR(P2)	;STORE ALLOCATED ADDRESS OF NEW EXTENT
	MOVE	P1,AEBSIZ(P2)	;GET SIZE OF ALLOCATION EXTENT

	SKIPA	T1,AHBAEB(P3)	;GET ADDRESS OF FIRST ALLOCATION EXTENT BLOCK
GTXXT2:	MOVE	T1,AEBNXT(T1)	;GET ADDRESS OF NEXT ALLOCATION EXTENT BLOCK
	SKIPE	AEBNXT(T1)	;FOUND END OF EXTENT BLOCK CHAIN?
	JRST	GTXXT2		;NO, LOOP BACK
	SETZM	AEBNXT(P2)	;LINK NEW EXTENT BLOCK AT END OF CHAIN
	MOVEM	P2,AEBNXT(T1)	;...

	MOVN	T1,P1		;GET NEGATIVE INCREMENTAL ALLOCATION AMOUNT
	ADDM	T1,AHBPND(P3)	;UPDATE HEADER BLOCK'S PENDING AMOUNT
	ADDM	P1,AHBCUR(P3)	;AND CURRENT ALLOCATION AMOUNT
	ADDM	P1,AHBFRE(P3)	;AND CURRENT FREE WORD AMOUNT
	POPJ	P,		;RETURN
;ROUTINE CALLED TO DEALLOCATE EXTENSIBLE BITMAP MEMORY
;LINKAGE:
;	T1/ NUMBER OF WORDS
;	T2/ ADDRESS OF MEMORY
;	T3/ ADDRESS OF ALLOCATION CONTROL BLOCK
;	PUSHJ	P,GVXWDS
;RETURNS:
;	CPOPJ ALWAYS

GVXWDS::PUSHJ	P,SAVE4##	;SAVE P1-P4
	MOVE	P4,T3		;SAVE ADDRESS OF ALLOCATION CONTROL BLOCK
	MOVE	P3,ACBAHB(P4)	;GET ADDRESS OF ALLOCATION HEADER BLOCK
	MOVE	P1,T1		;GET SIZE OF MEMORY TO DEALLOCATE
	IDIV	P1,AHBCSZ(P3)	;CALCULATE NUMBER OF CHUNKS
	SKIPE	P2		;ANY REMAINDER?
	ADDI	P1,1		;YES, ROUND UP
	IMUL	P1,AHBCSZ(P3)	;CONVERT BACK INTO WORDS

	SKIPA	P2,AHBAEB(P3)	;GET ADDRESS OF FIRST ALLOCATION EXTENT BLOCK
GVXWD1:	MOVE	P2,AEBNXT(P2)	;GET ADDRESS OF NEXT ALLOCATION EXTENT BLOCK
	SKIPN	P2		;AT END OF ALLOCATION EXTENT LIST?
	STOPCD	CPOPJ##,DEBUG,CORCNA ;++YES, CHUNK NOT ALLOCATED
	MOVE	T1,AEBSIZ(P2)	;GET SIZE OF EXTENT
	ADD	T1,AEBADR(P2)	;COMPUTE LAST ADDRESS WITHIN EXTENT
	SUBI	T1,1		;...
	CAML	T2,AEBADR(P2)	;DOES CHUNK FALL WITHIN THIS EXTENT?
	CAMLE	T2,T1		;...
	JRST	GVXWD1		;NO, LOOP BACK AND TRY NEXT EXTENT

	PUSH	P,T2		;SAVE ADDRESS OF CHUNK
	MOVE	T1,P1		;GET NUMBER OF WORDS TO DEALLOCATE
	IDIV	T1,AHBCSZ(P3)	;CONVERT TO CHUNKS
	POP	P,T2		;GET BACK CHUNK ADDRESS
	SUB	T2,AEBADR(P2)	;COMPUTE CHUNK OFFSET WITHIN EXTENT
	IDIV	T2,AHBCSZ(P3)	;...
	SKIPE	T3		;ANY REMAINDER?
	STOPCD	CPOPJ##,DEBUG,CORNCB ;++NOT ON A CHUNK BOUNDARY
	IDIVI	T2,^D36		;COMPUTE BIT TABLE AND BIT NUMBER OFFSETS
	HRLS	T2		;MAKE AN AOBJN POINTER TO REST OF BITMAP
	ADD	T2,AEBBMP(P2)	;...
	PUSHJ	P,SETZRS	;CLEAR THE BITS

	ADDM	P1,AEBFRE(P2)	;UPDATE FREE WORD COUNTS
	ADDM	P1,AHBFRE(P3)	;...
	MOVN	T1,P1		;GET NEGATIVE WORD COUNT
	ADDM	T1,ACBUSD(P4)	;UPDATE USED WORD COUNT
	POPJ	P,		;AND RETURN
	SUBTTL	CORE ALLOCATION  --  NZS BITMAP MEMORY ROUTINES


;SUBROUTINES TO GET "FREE" CORE FROM NON-ZERO SECTIONS.  USED
;BY DECNET, SCA, AND ETHERNET CODE (TO GIVE THEM A SEPARATE POOL,
;AND TO ALLOW CORE TO BE IN EXTENDED SECTIONS).
;CALL:
;	T2/ NUMBER OF WORDS DESIRED
;	PUSHJ	P,GET?WS
;RETURN:
;	CPOPJ IF AMOUNT DESIRED NOT AVAILABLE
;	CPOPJ1 IF SUCCESS WITH:
;	T1/ START OF CHUNK

IFN FTSCA,<
	$CSENT	(GETSWS::)	;GLOBAL ENTRY POINT
	PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVEI	P1,SCAPTR##	;ADDRESS OF AOBJN TABLE DESCRIBING POOL
	MOVE	P2,SCALOC##	;ADDRESS OF BASE OF POOL
	PJRST	GETXWS		;TRY TO FIND THE SPACE
>; END IFN FTSCA

IFN FTENET,<
GETEWZ::PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVEI	P1,ETHPTR##	;ADDRESS OF AOBJN TABLE DESCRIBING POOL
	MOVE	P2,ETHLOC##	;ADDRESS OF BASE OF POOL
	PJRST	GETXWZ		;TRY TO FIND THE SPACE
GETEWS::PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVEI	P1,ETHPTR##	;ADDRESS OF AOBJN TABLE DESCRIBING POOL
	MOVE	P2,ETHLOC##	;ADDRESS OF BASE OF POOL
	PJRST	GETXWS		;TRY TO FIND THE SPACE
IFN FTKL10,<
GETNWZ::PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVEI	P1,KNIPTR##	;ADDRESS OF AOBJN TABLE DESCRIBING POOL
	MOVE	P2,KNILOC##	;ADDRESS OF BASE OF POOL
	PJRST	GETXWZ		;TRY TO FIND THE SPACE
GETNWS::PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVEI	P1,KNIPTR##	;ADDRESS OF AOBJN TABLE DESCRIBING POOL
	MOVE	P2,KNILOC##	;ADDRESS OF BASE OF POOL
	PJRST	GETXWS		;TRY TO FIND THE SPACE
>; END IFN FTKL10
>; END IFN FTENET

;HERE TO DO THE WORK FOR GET?WS

IFN FTDECNET!FTSCA!FTENET,<
GETXWZ:	MOVEI	T1,3(T2)	;MAKE IT 4-WORD INCREMENTS
	ASH	T1,-2
	EXCH	T2,P1		;SAVE SIZE, GET AOBJN POINTER TO BIT TABLE
	PUSHJ	P,GETBIT	;FIND THAT MANY BITS
	  POPJ	P,		;NO GO, RETURN FAILURE.
	ASH	T1,2		;CONVERT TO NUMBER OF WORDS
	ADD	T1,P2		;ADD IN START ADDRESS OF POOL.
	SETZM	(T1)		;ZERO FIRST WORD OF CHUNK
	SOS	T2,P1		;GET SIZE OF REMAINDER OF CHUNK
	PJUMPE	T2,CPOPJ1##	;RETURN IF NO OTHER WORDS TO ZERO
	MOVE	T3,T1		;GET START ADDRESS OF CHUNK
	XMOVEI	T4,1(T3)	;AND START ADDRESS +1 OF CHUNK
	EXTEND	T2,[XBLT]	;ZERO REMAINDER OF CHUNK
	JRST	CPOPJ1##	;RETURN SUCCESS
GETXWS:	MOVEI	T1,3(T2)	;MAKE IT 4-WORD INCREMENTS
	ASH	T1,-2
	MOVE	T2,P1		;AOBJN WORD TO BIT TABLE DESCRIBING THIS POOL
	PUSHJ	P,GETBIT	;FIND THAT MANY BITS
	  POPJ	P,		;NO GO, RETURN FAILURE.
	ASH	T1,2		;CONVERT TO NUMBER OF WORDS
	ADD	T1,P2		;ADD IN START ADDRESS OF POOL.
	JRST	CPOPJ1##	;RETURN SUCCESS
>; END IFN FTDECNET!FTSCA!FTENET
;SUBROUTINES TO RETURN "FREE" CORE OBTAINED BY A CALL TO GET?WS.
;CALL:
;	T1/ NUMBER OF WORDS TO RETURN
;	T2/ ADDRESS OF CHUNK
;	PUSHJ	P,GIV?WS
;RETURN:
;	CPOPJ ALWAYS

IFN FTSCA,<
	$CSENT	(GIVSWS::)	;GLOBAL ENTRY POINT
	PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVE	P1,SCAPTR##	;AOBJN TABLE DESCRIBING POOL
	MOVE	P2,SCALOC##	;ADDRESS OF BASE OF POOL
	PJRST	GIVXWS		;RETURN THE SPACE
>; END IFN FTSCA

IFN FTENET,<
GIVEWS::PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVE	P1,ETHPTR##	;AOBJN TABLE DESCRIBING POOL
	MOVE	P2,ETHLOC##	;ADDRESS OF BASE OF POOL
	PJRST	GIVXWS		;RETURN THE SPACE
IFN FTKL10,<
GIVNWS::PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	MOVE	P1,KNIPTR##	;AOBJN TABLE DESCRIBING POOL
	MOVE	P2,KNILOC##	;ADDRESS OF BASE OF POOL
	PJRST	GIVXWS		;RETURN THE SPACE
>; END IFN FTKL10
>; END IFN FTENET

IFN FTDECNET!FTSCA!FTENET,<
GIVXWS:	ADDI	T1,3		;ROUND UP
	ASH	T1,-2		;CONVERT WORD COUNT TO 4-WORD COUNT
	SUB	T2,P2		;CONVERT FROM ABSOLUTE TO RELATIVE ADDRESS
	ASH	T2,-2		;CONVERT TO NUMBER OF 4 WORD BLOCKS
	IDIVI	T2,^D36		;CONVERT TO OFFSET INTO TABLE OF BITS
	HRLS	T2		;LEFT HALF....
	ADD	T2,P1		;MAKE AN AOBJN POINTER TO REST OF TABLE
	PJRST	SETZRS		;AND ZERO BITS IN THE TABLE
>;END IFN FTDECNET!FTSCA!FTENET
	SUBTTL	CORE ALLOCATION  --  SECTION 0 BITMAP MEMORY ROUTINES


;SUBROUTINE TO GET "FREE" CORE
;ENTER GETWDS: T2=# WORDS TO GET
;RETURN CPOPJ IF NOT AVAILABLE, WITH T2=LARGEST HOLE AVAILABLE
;RETURN CPOPJ1 IF GOTTEN, WITH T1=LOC OF CORE
	$CSENT	(GETWDS::)	;GLOBAL ENTRY POINT
	ADDI	T2,3		;CONVERT TO 4 WORD BLOCKS
	ASH	T2,-2
	MOVE	T1,T2		;NUMBER OF BLOCKS TO GET
	SKIPE	DINITF##	;INITIALIZATION?
	SKIPE	FREPTR##	;YES, BUT HAS FREE POINTER BEEN SET UP?
	CAIA			;CAN USE REGULAR ALLOCATION NOW
	JRST	GETWDI		;JUST ALLOCATE FROM SYSSIZ
	MOVEI	T2,FREPTR##	;L(AOBJN WORD)
	PUSH	P,T1		;SAVE NUMBER BEING REQUESTED
	PUSHJ	P,GETBIT	;GET, SET THE BITS
	  JRST	GET4W2		;NOT ENOUGH AVAILABLE
	POP	P,T2		;RESTORE AMOUNT GOTTEN
IFN FTRSP,<
	ADDM	T2,FRUSED##	;BUMP FREE-CORE-USED WORD
>
	LSH	T1,2		;*4 TO CONVERT TO AN ADDRESS
	ADD	T1,LOCORE##	;+START OF TABLE = ACTUAL ADDRESS
	PJRST	CPOPJ1##	;TAKE GOOD RETURN

;HERE IF REQUESTED AMOUNT ISNT AVAILABLE
GET4W2:	MOVE	T2,T1		;LARGEST HOLE WE FOUND
	JRST	TPOPJ##		;TAKE LOST RETURN

	$INIT

;HERE TO GET CORE DURING INITIALIZATION
GETWDI:	PUSH	P,T1		;SAVE NUMBER OF BLOCKS REQUESTED
	LSH	T2,2		;BACK TO WORDS NOW
	MOVE	T1,SYSSIZ##	;T1 = START OF ALLOCATION
	ADD	T2,T1		;T2 = NEW FIRST FREE
	MOVEM	T2,SYSSIZ##	;UPDATE SYSSIZ
	SKIPE	.UONCE##	;USER MODE?
	JRST  	GETWRO		;NEED CORE UUO
	SUBI	T2,1		;BACK OFF BY A WORD
	CAMLE	T2,LOWLIM##	;GONE PAST THE LIMIT?
	STOPCD	.,STOP,EMA,	;++EXCEEDED MEMORY ALLOCATION
	JRST	T2POJ1##	;RESTORE # BLOCKS REQUESTED AND RETURN

GETWRO:	MOVEM	T2,.JBFF##	;KEEP MONITOR HAPPY
	CAMLE	T2,.JBREL##	;ALREADY HAVE CORE?
	CORE	T2,		;GET IT NOW
	  JFCL
	JRST	T2POJ1##	;RESTORE # BLOCKS REQUESTED AND RETURN

	$HIGH

;SUBROUTINE TO ZERO BITS IN A BIT TABLE
;CALLING SEQUENCE:
;	MOVE	T1,NUMBER OF BITS TO CLEAR
;	MOVE	T2,AOBJN POINTER TO TABLE
;	MOVE	T3,BIT POSITION WITHIN TABLE
;	PUSHJ	P,ZERBTS
;ALWAYS RETURNS CPOPJ

ZERBTS::IDIVI	T3,^D36		;36 BITS/WORD
	HRLS	T3		;WORD NUMBER TO BOTH HALVES
	ADD	T2,T3		;POINT AOBJN POINTER TO WORD IN TABLE
	MOVE	T3,T4		;BIT POSITION WITHIN WORD
	PJRST	SETZRS		;ZERO TIME BITS

;SUBROUTINE TO RETURN "FREE" CORE
;ENTER GIVWDS: T1=# WDS. TO RETURN, T2=START ADR. OF CORE
	$CSENT	(GIVWDS::)	;GLOBAL ENTRY POINT
	SKIPE	DINITF##	;INITIALIATION?
	SKIPE	FREPTR		;YES, BUT FREE POINTER SET UP?
	CAIA			;OK TO DO BIT MAP STUFF
	JRST	GIVWDI		;INITIALIZATION, A BIT MORE TRICKY
	ADDI	T1,3		;CONVERT TO # 4WD. BLOCKS
	ASH	T1,-2
	SUB	T2,LOCORE##	;GET ADR. RELATIVE TO START OF TABLE
IFN FTRSP,<
	MOVN	T3,T1
	ADDM	T3,FRUSED##	;DECREMENT FREE-CORE USED
>
	LSH	T2,-2		;/4 TO CONVERT TO BITS
	IDIVI	T2,^D36		;COMPUTE WORD LOC, STARTING BIT
	HRLS	T2		;WORD POSITION IN BOTH HALVES
	ADD	T2,FREPTR##	;SET AOBJN WORD FOR TABLE
	JRST	SETZRS		;FALL INTO SETZRS

	$INIT

;HERE DURING INITIALIZATION

GIVWDI:	POPJ	P,		;THANKS, WE DID OUR BEST
				;MAYBE CALL GVFWDS HERE?

	$HIGH
;SUBROUTINE TO SET ZEROS IN A TABLE
;ARG	T1=HOW MANY BITS TO CLEAR
;	T2=AOBJN POINTER FOR TABLE
;	T3=POSITION IN WORD OF FIRST BIT TO CLEAR
;	(0=BIT 0, 1=BIT 1, ETC.)

SETZRS::PUSH	P,P3
	SETZ	P3,		;NOT TABLE RELATIVE
	PUSHJ	P,SETZRP	;ZERO THE BITS
	JRST	P3POPJ##	;RESTORE P3 AND RETURN
SETZRP::EXCH	T1,T3		;SET ACS FOR CLRBTS
	MOVEI	T4,^D36		;ADJUST FOR 1ST WORD
	SUBM	T4,T1
	HRRZ	T4,T2		;SET T4 FOR CLRBTS
	PUSH	P,T2		;SAVE AOBJN WORD
	PUSHJ	P,CLRBTS	;CLEAR SOME BITS
	  STOPCD	T2POPJ##,DEBUG,BAC, ;++BIT ALREADY CLEAR
	POP	P,T2		;RESTORE AOBJN WORD
	HLRE	T3,T2		;LENGTH OF POINTER
	SUB	T2,T3		;COMPUTE TOP OF TABLE
	CAILE	T4,(T2)		;FINAL ADR PAST TOP?
	STOPCD	CPOPJ##,DEBUG,PTT,	;++PAST TOP OF TABLE
	POPJ	P,		;NO, GOOD RETURN
	STRTAD==200000
	RELABP==40000
;SUBROUTINE TO FIND N CONSECUTIVE 0'S IN A TABLE
;ENTER WITH P1 = AOBJN WORD TO THE TABLE
;P2 = PREVIOUS BEST SO FAR
;RH(P3)= HOW MANY,  BIT STRTAD =1 IF START LOC SPECIFIED
;LH(P3) HAS BITS 0,1,2 USED BY FILSER
;EXIT CPOPJ1 IF FOUND, WITH P4 = WHERE THE HOLE IS, P1=UPDATED POINTER
;EXIT CPOPJ IF UNSUCCESSFUL, P2 = LARGEST HOLE FOUND
;P2,P4 CHANGED
;NOTE--SHOULD NOT CONTAIN A METER POINT SINCE IS CALLED
;      BY ENDSTS ON 407 START BEFORE METINI IS CALLED
GETZ::	PUSHJ	P,SETR		;ZERO R IF OLD STYLE CALL
GETZ0:	TLNE	P3,STRTAD	;START LOC SPECIFIED?  (NOTE THAT ENTRY TO ROUTINE
				; IS AT GETZR IF START LOC SPECIFIED)
	POPJ	P,		;YES, ERROR RETURN
	HRRM	P1,-2(P)	;STORE ABOJN POINTER IN INDIRECT WORD
	SETCM	T1,@-2(P)	;WORD TO INVESTIGATE
	JRST	GETZA		;SKIP CALL TO SETR
GETZX::	PUSHJ	P,SETR		;SETUP INDIRECT POINTER
GETZA:	MOVEI	T4,^D36		;NO. SET UP COUNT
	JUMPE	T1,GETZ4	;FULL IF 0
	JUMPG	T1,GETZ3	;1ST BIT UNAVAILABLE IF POSITIVE
GETZ1:	SETCA	T1,		;SET TO REAL CONTENTS
	JFFO	T1,.+2		;COUNT THE NUMBER OF 0'S
	MOVEI	T2,^D36		;36 OF THEM
	JRST	GETZB		;SKIP CALL TO SETR
GETZR::	PUSHJ	P,SETR		;SETUP INDIRECT POINTER TO THE BIT TABLE
GETZB:	MOVE	T3,T2		;SHIFT COUNT (T3 CAN BE .GT. 36 AT GETZ2)
	MOVEM	P1,P4		;SAVE POSITION IN P4
	HRLM	T4,P4		;LOC OF HOLE
GETZ2:	CAIL	T3,(P3)		;FOUND ENOUGH?
	JRST	CPOPJ1##	;YES. GOOD RETURN
	CAILE	T3,(P2)		;NO. BEST SO FAR?
	HRRI	P2,(T3)		;YES. SAVE IT
	SUBI	T4,(T2)		;DECREASE POSITION COUNTER
	JUMPLE	T4,GETZ5	;0'S ON END
	TLNE	P3,STRTAD	;THIS HOLE NOT GOOD ENOUGH
	POPJ	P,		;ERROR RETURN IF START ADDRESS GIVEN
	SETCA	T1,		;NOW WE WANT TO COUNT 1'S
	LSH	T1,1(T2)	;REMOVE BITS WE ALREADY LOOKED AT
	JUMPE	T1,GETZ4	;GO IF THE REST OF THE WORD IS ALL ONES
GETZ3:	JFFO	T1,.+1		;NUMBER OF (REAL) 1'S
	LSH	T1,(T2)		;GET RID OF THEM
	CAIN	T4,^D36		;1ST POSITION IN WORD?
	ADDI	T4,1		;YES, SUBTRACT REAL JFFO COUNT
	SUBI	T4,1(T2)	;DECREASE POSITION COUNT
	JUMPG	T4,GETZ1	;TRY NEXT 0 - HOLE
GETZ4:	AOBJN	P1,GETZ0	;1'S ON END - START FRESH AT NEXT WORD

;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT THE WORD HAD 0'S ON THE END
GETZ5:	AOBJP	P1,CPOPJ##	;THROUGH IF END OF SAT
	HRRM	P1,-2(P)	;STORE UPDATED AOBJN POINTER
	SKIPGE	T1,@-2(P)	;NEXT WORD POSITIVE?
	JRST	GETZ0		;NO. THIS HOLE NOT GOOD ENOUGH
	JFFO	T1,.+2		;YES. COUNT THE 0'S
	MOVEI	T2,^D36		;36 0'S
	ADDI	T3,(T2)		;ADD TO PREVIOUS ZERO-COUNT
	MOVEI	T4,^D36		;RESET T4
	JRST	GETZ2		;AND TEST THIS HOLE

;SUBROUTINE TO SET UP A BIT MASK FOR IORM OR ANDCAM INTO A TABLE
;ENTER WITH T1=POSITION (36=BIT0, 1=BIT35)
; AND T3=HOW MANY
;AFTER THE FIRST CALL USE BITMS2, T3=COUNT RETURNS T1=MASK,
;T3=REMAINING COUNT ROUTINE HAS RETURNED FINAL MASK IF
;T3 .LE. 0 ASSUMES T4=ADR IN TABLE, BITMS2 INCREMENTS T4

BITMSK::PUSH	P,T1		;SAVE POSITION
	MOVN	T1,T3		;- COUNT
	CAILE	T3,^D36		;MORE THAN 1 WORD?
	MOVNI	T1,^D36		;YES, SETTLE FOR A WORD (OR LESS)
	MOVSI	T2,400000	;SET TO PROPOGATE A MASK
	ASH	T2,1(T1)	;GET THE RIGHT NUMBER OF BITS
	SETZ	T1,
	LSHC	T1,@0(P)	;POSITION THE BITS IN T1 (=MASK)
	SUB	T3,0(P)		;REDUCE THE COUNT TO THE NEW VALUE
	PJRST	T2POPJ##	;AND RETURN
;HERE AFTER FIRST CALL, MASK STARTS AT BIT 0
BITMS2::SETO	T1,		;MASK STARTS AT BIT 0
	MOVNI	T2,-^D36(T3)	;SET UP SHIFT
	CAIGE	T3,^D36		;DONT SHIFT IS .GE. 36
	LSH	T1,(T2)		;POSTION THE MASK
	SUBI	T3,^D36		;REDUCE THE COUNT
	AOJA	T4,CPOPJ##	;UPDATE THE POSITION AND RETURN

;SUBROUTINE TO MARK BITS AS TAKEN IN A TABLE
;USES ACS AS RETURNED BY GETZ - P3=HOW MANY
;  LH(P4)=POSITION, RH(P4)=WHERE (POSITION=36 IF BIT0, 1 IF BIT35)
;RETURNS CPOPJ IF BIT IS ALREADY SET, CPOPJ1 NORMALLY, RESPECTS T1
SETOS::	PUSHJ	P,SETR		;SETUP INDIRECT POINTER TO THE BIT TABLE
	PUSH	P,T1		;SAVE T1
	MOVE	T4,P4		;WHERE
	HRRZ	T3,P3		;COUNT
	HLRZ	T1,P4		;POSITION IN WORD
	PUSHJ	P,BITMSK	;SET UP A MASK
SETOS1:	HRRM	T4,-3(P)	;FOR INDIRECT
	BTSOFF			;BETTER NOT INTERRUPT HERE
	TDNE	T1,@-3(P)	;BIT ALREADY ON?
	JRST	SETOS2		;YES
	IORM	T1,@-3(P)	;NO, NOW IT IS
	BTSON			;RESTOR PI
	JUMPLE	T3,TPOPJ1##	;DONE IF COUNT .LE. 0
	PUSHJ	P,BITMS2	;NOT DONE, GET MASK FOR NEXT WORD
	JRST	SETOS1		;AND GO SET THE BITS IN THAT WORD
;HERE IF BIT ALREADY ON
SETOS2:	BTSON			;PI CAN BE ON
	PUSH	P,T3		;SAVE CURRENT COUNT
	HLRZ	T1,P4		;RESTORE ORIGINAL VALUES
	HRRZ	T3,P3
	MOVE	T4,P4
	PUSHJ	P,BITMSK	;AND GENERATE A MASK
SETOS3:	HRRM	T4,-4(P)	;SET FOR INDIRECT
	CAMN	T3,(P)		;IS THE COUNT FOR MASK=COUNT WHEN SET?
	JRST	SETOS4		;YES, DONE
	ANDCAM	T1,@-4(P)	;NO, CLEAR THOSE BITS
	PUSHJ	P,BITMS2	;GENERATE NEXT MASK
	JRST	SETOS3		;AND CONTINUE
SETOS4:	POP	P,(P)		;CLEARED ALL THE RIGHT BITS - FIX PD LIST
	JRST	TPOPJ##		;AND NON-SKIP RETURN


;SUBROUTINE TO OBTAIN FREE BITS, MARK THEM AS TAKEN IN THE TABLE
;ENTER WITH T1=HOW MANY,
;T2=XWD ADR OF 1ST WORD OF TABLE, ADR OF TABLE AOBJN WORD (OR 0, LOC OF AOBJN)
;RETURNS CPOPJ IF NOT ENOUGH AVAILABLE, T1=SIZE OF LARGEST HOLE
;RETURNS CPOPJ1 IF GOTTEN, T1= RELATIVE ADDRESS OF BLOCK OBTAINED
;T3 IS UPDATED AOBJN POINTER
GETBIT::PUSHJ	P,SAVE4##	;SAVE P1-P4
	TLNN	T2,-1		;STARTING AT AN OFFSET?
	HRL	T2,(T2)		;NO, START AT FIRST WORD
	PUSH	P,T2		;SAVE ADR OF AOBJN WORD FOR TABLE
GETBI1:	HRRZ	P1,0(P)		;GET AOBJN WORD
	MOVE	P1,(P1)
	SETZ	P2,		;NO BEST SO FAR
	MOVE	P3,T1		;NUMBER OF BITS TO GET
	PUSHJ	P,GETZ		;GET THE BITS
	  JRST	GETBI2		;NOT ENOUGH AVAILABLE
	HRRZ	T1,P4		;GOT THEM - FIRST WORD WITH ZEROES
	HLRZ	T2,(P)		;LOC OF FIRST WORD OF TABLE
	SUBI	T1,(T2)		;COMPUTE RELATIVE ADDRESS OF START
	IMULI	T1,^D36		;36 BITS PER WORD
	HLRZ	T2,P4		;BIT POSITION OF 1ST 0 IN THE WORD
	MOVNS	T2
	ADDI	T1,^D36(T2)	;T1= RELATIVE LOC WITHIN THE TABLE
	PUSHJ	P,SETOS		;MARK THE BITS AS TAKEN
	  SKIPA	T1,P3		;SOME FINK SNUCK IN ON US!
	AOSA	-1(P)		;GOT THEM - WIN RETURN
	JRST	GETBI1		;TRY AGAIN TO GET SOME BITS

	MOVE	T3,P1		;UPDATED POINTER
	JRST	T2POPJ##	;RETURN
;HERE IF NOT ENOUGH ARE AVAILABLE
GETBI2:	MOVE	T1,P2		;T1=LARGEST HOLE FOUND
	PJRST	T2POPJ##	;NON-SKIP RETURN
;ROUTINE TO CLEAR BITS FROM A TABLE
;ENTER T1=POSITION, T3=COUNT, T4=TABLE ADR
; POSITION=36 IF BIT0, 1 IF BIT35
;RETURNS POPJ IF BIT ALREADY 0, POPJ1 OTHERWISE
CLRBTS::PUSHJ	P,BITMSK	;GENERATE A MASK
	PUSHJ	P,SETR		;SETUP TABLE ADDRESS
CLRBT1:	HRRM	T4,-2(P)	;SET INDIRECT WORD
	BTSOFF			;CANT INTERRUPT
	MOVE	T2,@-2(P)	;WORD TO CLEAR BITS FROM
	TDC	T2,T1		;ARE THE BITS ALREADY OFF?
	TDNE	T2,T1
	PJRST	ONPOPB##	;YES, RESTORE PI AND NON-SKIP
	MOVEM	T2,@-2(P)	;NO, NOW THEY ARE
	BTSON			;RESTORE THE PI
	JUMPLE	T3,CPOPJ1##	;DONE IF COUNT .LE. 0
	PUSHJ	P,BITMS2	;GENERATE MASK FOR NEXT WORD
	JRST	CLRBT1		;AND GO CLEAR THOSE BITS

;SUBROUTINE TO FIND N CONSECUTIVE ZEROS IN A TABLE
;ARGS	T1=AOBJN POINTER TO TABLE
;	T2=PREVIOUS BEST
;	T3=HOW MANY, BIT STRTAD=1 IF START ADDR SPECIFIED
;VALUES	IF UNSUCCESSFUL, T2=LARGEST HOLE FOUND, NON-SKIP RETURN
;	IF SUCCESSFUL, T4=POSITION OF BEGINNING OF HOLE, SKIP RETURN
;THIS ROUTINE CALLS GETZ BUT SATISFIES STANDARD AC CONVENTIONS


CLGETZ::PUSHJ	P,SAVE4##		;SAVE GLOBAL ACS
	MOVE	P1,T1		;SET ACS FOR GETZ
	MOVE	P2,T2
	MOVE	P3,T3
	PUSHJ	P,GETZ		;GET THE BITS
	  CAIA		;NOT ENOUGH AVAILABLE
	AOS	(P)		;OK, SET FOR SKIP RETURN
	MOVE	T1,P1		;RESTORE T-ACS WITH ANSWERS
	MOVE	T2,P2
	MOVE	T3,P3
	MOVE	T4,P4
	POPJ	P,		;TAKE WIN OR LOSE RETURN
;SUBROUTINE TO SET BITS IN A TABLE
;ARGS	T3=HOW MANY
;	T4=POSITION OF FIRST, RH=ADDR, LH=POSITION, 36=BIT 0,1=BIT 35
;THIS ROUTINE CALLS SETOS BUT SATISFIES STANDARD AC CONVENTIONS
CSETOS::PUSHJ	P,SAVE4##		;SAVE P1-P4
	MOVE	P3,T3		;SET ACS FOR SETOS
	MOVE	P4,T4
	PUSHJ	P,SETOS		;SET THE BITS
	STOPCD	CPOPJ##,DEBUG,BNZ,	;++BIT NOT ZERO

	POPJ	P,		;OK, RETURN
;INTERFACE ROUTINE TO GETZ/SETOS WHICH ALLOWS THEM TO BE CALLED WITH AN
; EXTENDED ADDRESS AND A AOBJN POINTER RELATIVE TO A BIT TABLE
;CALLING SEQUENCE:
;	MOVE	R,ADDRESS OF THE BIT TABLE
;	MOVE	P1,AOBJN POINTER RELATIVE TO THE TABLE
;	TLO	P3,RELABP	;INDICATE THIS FORM OF CALL
;	PUSHJ	P,SETR		;MUST BE IN A NON-ZERO SECTION IF RELABP IS ON
;ALWAYS RETURN CPOPJ, -2(P) IS AN INSTRUCTION FORMAT INDIRECT WORD TO BIT TABLE

SETR:	PUSH	P,R		;SAVE R, SOME CALLERS MAY WANT IT RETURNED
	MOVSI	R,400000+R	;LOCAL INSTRUCTION FORMAT INDIRECT WORD
	EXCH	R,-1(P)		;SAVE IT ON THE STACK, GET RETURN ADDRESS
	MOVEM	R,1(P)		;TO CALL THE CALLER
IFN FTXMON,<
	TLNN	P3,RELABP	;RELATIVE AOBJN POINTER SPECIFIED?
	JRST	SETR1		;NO, OLD CALL
	TLNN	R,(SECMSK)	;MUST BE IN A NON-ZERO SECTION IF RELABP IS ON
	STOPCD	SETR2,DEBUG,NNS,;++NOT IN A NON-ZERO SECTION
>
	TLNN	P3,RELABP	;NEW CALL?
SETR1:	TDZA	R,R		;NO, NO RELOCATION
	MOVE	R,(P)		;YES, GET RELOCATION
	PUSHJ	P,@1(P)		;CALL CALLER AS A COROUTINE
	  CAIA			;NON-SKIP RETURN
	AOS	-2(P)		;PROPAGATE SKIP
SETR2:	POP	P,R		;RESTORE R
	POP	P,(P)		;POP OFF JUNK
	POPJ	P,		;AND RETURN
COREND:	END