Google
 

Trailing-Edge - PDP-10 Archives - BB-D480C-SB_1981 - formem.mac
There are 11 other files named formem.mac in the archive. Click here to see a list.
	SEARCH	FORPRM
	TV	FORMEM	MEMORY MANAGEMENT,6(2033)
	SUBTTL	CHRIS SMITH/CKS

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

1100	CKS	5-Jun-79
	New for version 6

1160	CKS	9-Oct-80	Q1244
	When memory fills up, scrounge pages from STARTP going upward.

1275	DAW	20-Feb-81
	Return whole 30-bit address of memory at %GTBLK

1410	JLC	07-Apr-81
	Change %MVBLK to return new size in T3.

1464	DAW	12-May-81
	Error messages.

1466	CKS	18-May-81
	Add TOPS-20 PSI interface

1510	BL	4-Jun-81	Q10-06197
	Fix IllMemRef bug due to all pages being initialized as existing.

1523	JLC	04-Jul-81
	1022 interface. Rerouted all core expansion and contraction
	requests through one routine (EXPADR), called indirectly
	through %EXPNT, with the desired expansion value in %DESHG.
	Made all references to .JBFF indirect through %JBFPT.

1527	JLC/BL	09-Jul-81
	Fixes to BL's code (VMDDT fix), removal of some crocks.

1531	JLC	10-Jul-81
	Integrated %GTPGS for below and above page 600. Restricted
	page use to below 775.

1542	JLC	17-Jul-81
	Fixed %MVBLK for slightly changed calling sequence in FORIO.

1633	JLC	24-Aug-81
	Cleaned up some comments that were misleading

1667	JLC	9-Sep-81
	One-word patch at GETLP+11 makes lowseg core request work.

1727	JLC	18-Sep-81
	Another fix to low-core memory manager. Free-list was one word off.

1740	JLC	23-Sep-81
	Yet more fixes to low segment memory manager. Fixed so that
	free-list memory is included in larger requests if the
	free-list memory is at .JBFF.

1756	JLC	1-Oct-81
	Fix ots memory manager. For GTPGS, start at STARTP minus number
	of pages desired, and go down. Then at TRYHRD, start at STARTP+1
	minus number of pages desired and go up.

1773	DAW	8-Oct-81
	Change name of error code "CMU" to "IEM", for "internal error in
	memory manager".

2015	DAW	20-Oct-81
	AC T1 was being smashed in CREPG (TOPS-10).

2025	JLC	26-Oct-81
	Fix LSTRIM for the 1022 folks - we were using a non-transparent
	subroutine.

2033	JLC	19-Nov-81
	Incorrect calling sequence for %MVBLK.
	Don't smash LH(back-link) in %FREBLK, it is useful for debugging.

***** End Revision History *****

\
	SUBTTL	OTS MEMORY MANAGER

	ENTRY	ALCOR%,DECOR%,%FUNCT
	INTERN	%MEMINI
	INTERN	%GTBLK,%FREBLK,%MVBLK
	INTERN	%GTPGS,%FREPGS
	INTERN	%LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB

	EXTERN	%POPJ,%POPJ1,%POPJ2,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVE
	EXTERN	I.XSIR,%LEVTAB,%CHNTAB
	EXTERN	I.RUNTM,U.ACS
IF10,<	EXTERN	I.DEV,I.FILE,I.PPN	>
	EXTERN	%ALCHN,%DECHN,%ABORT,%HALT
IFN FTSHR,<EXTERN Z.DATA  >

	SEGMENT	CODE

	COMMENT	&

FOROTS dynamic memory is allocated in pages starting at STARTP (the highest
usable page), growing downward.  Memory for overlays is allocated at .JBREL,
growing upward.  If the two segments meet, the user is out of memory.

The memory from STARTP up to page TOPP will be used when the rest of memory is
full.  This memory is also used by SORT, RMS, and DDT, and conflicts can occur.
The conflicts are preferable to the alternative, giving up and exiting.

Memory is strung together in blocks, chained in a doubly linked list.  Both
allocated and free blocks are on the list.  All blocks are consecutive, so the
%FREBLK routine can examine the previous and next blocks to see if they should
be coalesced with the block being freed.

Each block is preceded by a two-word header with forward and backward links, a
flag telling whether the block is allocated or free, and the size of the block
if it is free.  The list is terminated by a zero word.

To facilitate debugging, the unused left half of the second word of an
allocated block header is set to the return address in the routine that
allocated the block.  This helps find routines that fail to free their blocks.

	&



;FORMAT OF BLOCK HEADER

HFLNK==0			;(LH) -1 IF BLOCK ALLOCATED, 0 IF FREE
				;(RH) LINK TO FOLLOWING BLOCK
HSIZE==1			;(LH) SIZE OF BLOCK IF FREE, ELSE
				;     RETURN ADDRESS IN ALLOCATING ROUTINE
HBLNK==1			;(RH) LINK TO PRECEDING BLOCK
HLEN==2				;LENGTH OF BLOCK HEADER



M==10				;FREE BLOCK WHICH IS WITHIN M WORDS
				;OF DESIRED SIZE IS CONSIDERED EXACT FIT
				;(MUST BE AT LEAST HLEN)

;THIS IS PART OF THE 1022 INTERFACE
;ALL REFERENCES TO .JBFF ARE INDIRECT REFERENCES THROUGH JBFPNT, WHICH IS 
;SET TO .JBFF IN %MEMINI. 1022 WILL, BEHIND OUR BACKS, CHANGE THE CONTENTS
;OF JBFPNT. LSEXP, THE "CORE UUO" SIMULATOR, IS HANDLED IN A SIMILAR
;FASHION.

	DEFINE	JOBFF	<@%JBFPT>	
	DEFINE	LSEXP	<@%EXPNT>

;ROUTINE TO GET A BLOCK OF MEMORY
;ARGS:	 T1 = LENGTH OF BLOCK
;RETURN: T1 = ADDRESS OF BLOCK, CLEARED TO ZERO

%GTBLK:	PUSHJ	P,GTBLKX	;TRY IT
;	  ERR	(MFU,999,105,?,Memory full,,%ABORT)
	 $ECALL	MFU,%ABORT
	MOVE	T2,(P)		;GET RETURN ADDRESS OFF STACK
	HRLM	T2,-1(T1)	;STORE IN BLOCK HEADER FOR DEBUGGING
	POPJ	P,


GTBLKX:	MOVE	T4,FREPTR	;POINT TO START OF LIST
	SETOM	WRAP		;FLAG NO WRAPAROUND YET

GBSRCH:	SKIPGE	T4,(T4)		;GET LINK TO NEXT BLOCK.  IS IT FREE?
	  JRST	GBSRCH		;NO, KEEP LOOKING
	JUMPE	T4,GBEOL	;ZERO MEANS END OF LIST, GO WRAP AROUND
	HRRZ	T2,HBLNK(T4)	;GET START ADDRESS OF THE FREE BLOCK
	HLRZ	T3,HSIZE(T2)	;GET SIZE OF FREE BLOCK
	CAIGE	T3,(T1)		;IS IT BIG ENOUGH?
	  JRST	GBSRCH		;NO, KEEP LOOKING


GOTBLK:	CAIG	T3,M(T1)	;IS SIZE CLOSE ENOUGH?
	  JRST	GBFIT		;YES, DON'T SPLIT BLOCK
	SUBI	T3,HLEN(T1)	;COMPUTE LENGTH OF REMAINING FREE BLOCK
	HRLM	T3,HSIZE(T2)	;STORE IN HEADER
	ADDI	T3,HLEN(T2)	;GET START ADDRESS OF ALLOCATED BLOCK
	HRROM	T4,HFLNK(T3)	;FIX UP POINTERS
	HRRZM	T2,HBLNK(T3)
	HRRZM	T3,HFLNK(T2)
	HRRM	T3,HBLNK(T4)
	MOVEM	T2,FREPTR	;START NEXT SEARCH AT NEW FREE BLOCK
	MOVEI	T1,HLEN(T3)	;GET ADDRESS OF NEW ALLOCATED BLOCK
	JRST	GBZERO		;GO CLEAR NEW BLOCK, RETURN

GBFIT:	HRROM	T4,HFLNK(T2)	;JUST MARK WHOLE BLOCK ALLOCATED
	MOVEM	T4,FREPTR	;START NEXT SEARCH AT FOLLOWING BLOCK
	MOVEI	T1,HLEN(T2)	;POINT TO BLOCK

GBZERO:	MOVSI	T2,(T1)		;MAKE BLT POINTER TO CLEAR BLOCK
	HRRI	T2,1(T1)
	SETZM	(T1)		;CLEAR FIRST WORD
	CAILE	T4,(T2)		;CHECK FOR 1-WORD BLOCK
	  BLT	T2,-1(T4)	;CLEAR REST OF BLOCK
	XMOVEI	T1,(T1)		;Section number in left half
	JRST	%POPJ1		;SUCCESS RETURN
GBEOL:	HRRZ	T4,BEGPTR	;RESET FREE POINTER TO START OF LIST
	MOVEM	T4,FREPTR
	AOSG	WRAP		;ALREADY LOOKED THROUGH WHOLE LIST?
	  JRST	GBSRCH		;NO, DO SO

	STKVAR	<SAVET,NP>	;ALLOCATE SPACE ON STACK
	MOVEM	T1,SAVET	;SAVE T1
	MOVEI	T1,2*HLEN+777(T1) ;ADD IN 2 HEADERS, ROUND UP TO PAGE BOUND
	LSH	T1,-9		;CONVERT TO PAGES
	MOVEM	T1,NP		;SAVE PAGES TO ALLOCATE
	PUSHJ	P,%GTPGS	;GET SOME PAGES
	  JRST	[UNSTK		;CAN'T, GIVE ERROR RETURN
		 POPJ P,]

	MOVE	T2,NP		;GET LENGTH IN PAGES
	LSHC	T1,9		;CONVERT ADDRESS, LENGTH TO WORDS
	ADDI	T2,(T1)		;GET END+1 ADDRESS OF NEW CORE
	HRRZ	T3,BEGPTR	;GET POINTER TO START OF OLD CORE
	CAIE	T2,(T3)		;NEW CORE CONTIGUOUS WITH OLD?
	  JRST	GBHOLE		;NO, GO HANDLE HOLE

	MOVEI	T4,(T2)		;COPY END ADDRESS OF NEW CORE
	SKIPLE	HFLNK(T4)	;CONTIGUOUS WITH A FREE BLOCK?
	  HRRZ	T4,HFLNK(T4)	;YES, CONSIDER NEW CORE ENDING AT END OF FREE BLOCK
	JRST	GBCONT		;CONTINUE BELOW

GBHOLE:	MOVEI	T4,-HLEN(T2)	;MAKE HOLE LOOK LIKE PERMANENTLY ALLOCATED BLOCK
	HRROM	T3,HFLNK(T4)	;SET FORWARD LINK OF HOLE
	HRRM	T4,HBLNK(T3)	;SET BACKWARD LINK

GBCONT:	HRROM	T1,BEGPTR	;NEW START OF LIST IS START OF NEW CORE
	MOVEM	T1,FREPTR	;ALSO START NEXT SEARCH THERE
	HRRZM	T4,HFLNK(T1)	;POINT FREE BLOCK TO ITS SUCCESSOR
	HRRZM	T1,HBLNK(T4)	;POINT SUCCESSOR BACK TO NEW FREE BLOCK
	MOVEI	T3,BEGPTR	;POINT FREE BLOCK BACK TO LIST HEAD
	HRRZM	T3,HBLNK(T1)

	MOVEI	T3,(T4)		;COMPUTE LENGTH OF FREE BLOCK
	SUBI	T3,HLEN(T1)

	MOVEI	T2,(T1)		;PUT POINTER TO FREE BLOCK IN RIGHT AC
	MOVE	T1,SAVET	;RESTORE T1
	UNSTK			;RESTORE P
	JRST	GOTBLK		;DONE, RETURN TO MAIN CODE
;ROUTINE TO FREE A BLOCK OF MEMORY
;ARGS:	T1 = ADDRESS OF BLOCK TO BE FREED (AS RETURNED BY %GTBLK)

%FREBLK:
	JUMPE	T1,[$SNH]	;BAD CALL IF ARG=0
	HRRZ	T2,HBLNK-HLEN(T1) ;POINT TO PREDECESSOR BLOCK
	HRRZ	T3,HFLNK-HLEN(T1) ;POINT TO SUCCESSOR BLOCK

	HRRZ	T4,HFLNK(T2)	;GET FWD LINK OF PREDECESSOR
	CAIE	T4,-HLEN(T1)	;DOES IT POINT TO CURRENT BLOCK?
;	  ERR	(IEM,,,?,Core messed up,,%HALT) ;NO, FATAL ERROR
	 $ECALL	IEM,%HALT	;No, fatal error
	HRRZ	T4,HBLNK(T3)	;GET BACK LINK OF SUCCESSOR
	CAIE	T4,-HLEN(T1)	;CHECK IT
	 $ECALL	IEM,%HALT	;WRONG, ERROR

	SKIPGE	HFLNK(T2)	;IF PREDECESSOR IS FREE, POINT TO IT
	  HRRZ	T2,HFLNK(T2)	; ELSE POINT TO BLOCK BEING FREED
	SKIPLE	HFLNK(T3)	;IF SUCCESSOR IS FREE, POINT TO ITS SUCCESSOR
	  HRRZ	T3,HFLNK(T3)
	HRRZM	T3,HFLNK(T2)	;FIX POINTERS
	HRRM	T2,HBLNK(T3)	;(LH = return address of GTBLK caller..)

	CAMGE	T2,FREPTR	;DOES FREPTR POINT TO INTERIOR OF NEW BLOCK?
	CAMG	T3,FREPTR
	  JRST	.+2		;NO, OK
	MOVEM	T2,FREPTR	;MAKE SURE FREPTR POINTS TO START OF SOME BLOCK

	SUBI	T3,HLEN(T2)	;COMPUTE LENGTH OF NEW FREE BLOCK
	HRLM	T3,HSIZE(T2)	;STORE IN BLOCK HEADER
	JUMPG	T3,%POPJ	;AND RETURN
	$ECALL	IEM,%HALT	;Unless size was negative or zero
;ROUTINE TO MOVE A CORE BLOCK INTO A BIGGER BLOCK
;ARGS:	 T1 = OLD ADDRESS
;	 T2 = OLD LENGTH
;	 T3 = NEW LENGTH
;RETURN: T1 = NEW ADDRESS
;	 T2 = END+1 ADDR OF OLD DATA IN NEW BLOCK (I.E. NEW ADDR + OLD LENGTH)
;	 T3 = NEW LENGTH (FOR CONVENIENCE IN EXPRB)

%MVBLK:
	STKVAR	<NLEN,OLEN,OADR> ;SPACE FOR NEW LENGTH, OLD LENGTH, ADDRESS
	EXCH	T1,T3		;GET NEW LENGTH IN T1, OLD ADDR IN T3
	MOVEM	T1,NLEN		;SAVE NEW LENGTH FOR LATER
	DMOVEM	T2,OLEN		;SAVE T2-T3
	PUSHJ	P,%GTBLK	;GET NEW BLOCK

	MOVE	T2,OLEN		;GET OLD LENGTH BACK
	HRLZ	T3,OADR		;GET OLD ADDRESS IN LH
	HRRI	T3,(T1)		;NEW ADDRESS IN RH
	ADDI	T2,(T1)		;NEW ADDRESS + OLD LENGTH
	BLT	T3,-1(T2)	;MOVE OLD DATA TO NEW BLOCK

	EXCH	T1,OADR		;SAVE NEW ADDRESS, GET OLD ADDRESS
	MOVEM	T2,OLEN		;SAVE NEW END+1 ADDRESS ON STACK

	PUSHJ	P,%FREBLK	;FREE OLD BLOCK

	POP	P,T1		;GET STUFF TO RETURN OFF STACK
	POP	P,T2
	POP	P,T3		;RETURN NEW LENGTH IN T3
	POPJ	P,		;DONE
;ROUTINE TO FIND AND ALLOCATE CONSECUTIVE PAGES OF MEMORY
;ARGS:	 T1 = NUMBER OF PAGES TO GET
;RETURN: T1 = PAGE NUMBER OF FIRST PAGE
;NONSKIP RETURN IF CAN'T, SKIP IF OK

%GTPGS:	PUSHJ	P,%SAVE3	;SAVE P ACS

	MOVEI	P1,STARTP	;START LOOKING AT THE TOP OF FOROTS DATA AREA
	SUBI	P1,-1(T1)	;MINUS # PAGES DESIRED
	MOVEI	P2,(T1)		;SET NUMBER OF PAGES TO GET

GETPLP:	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH PAGE BIT MAP
	  TDNN	T1,PTAB(T2)	;SEE IF PAGES ARE ALL NOT ALLOCATED
	   JRST	TRYRET		;ALL FREE, FINE
	SOJGE	P1,GETPLP	;SOME PAGE ALLOCATED, TRY AGAIN

;HERE WHEN REQUEST CAN'T BE SATISFIED USING PAGES 0 THROUGH STARTP.
;LOOK FROM STARTP+1 TO 777 FOR ENOUGH CONSECUTIVE PAGES.

TRYHRD:	MOVEI	P1,STARTP+1	;START AT PAGE 600
	SUBI	P1,-1(P2)	;TAKE IN # PAGES DESIRED

TRYLP2:	MOVEI	T1,(P1)		;COPY TEST PAGE BOTTOM
	ADDI	T1,-1(P2)	;GET TOP PAGE DESIRED
	CAILE	T1,777		;AT TOP OF MEMORY?
	  POPJ	P,		;YES, GIVE UP
	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH PAGE BIT MAP
	  TDNN	T1,PTAB(T2)	;SEE IF PAGES ARE ALL NOT ALLOCATED
	   JRST	TRYRET		;ALL FREE, FINE
	AOJA	P1,TRYLP2	;SOME PAGE ALLOCATED, TRY AGAIN

TRYRET:	PUSHJ	P,CREPGX	;CREATE THE PAGES
	  POPJ	P,		;CAN'T, TOO BAD

	MOVEI	T1,(P1)		;RETURN STARTING PAGE TO CALLER
	OR	T1,PAGSEC	;In current section
	JRST	%POPJ1		;SUCCESS

;ROUTINE TO FREE PAGES
;ARGS:	 T1 = FIRST PAGE
;	 T2 = NUMBER OF PAGES
;ON RETURN, PAGES ARE MARKED FREE IN BIT MAP

%FREPGS:
	PUSHJ	P,%SAVE2	;SAVE P1-P2
	DMOVE	P1,T1		;PUT ARGS IN RIGHT ACS
	SUB	P1,PAGSEC	;Get relative page # in section
	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH BIT MAP
	  ANDCAM T1,PTAB(T2)	;MARK PAGE FREE
	POPJ	P,		;DONE
;ROUTINE TO CREATE PAGES
;ARGS:	 P1 = FIRST PAGE TO ALLOCATE
;	 P2 = NUMBER OF PAGES TO ALLOCATE
;ERROR RETURN IF PAGES ARE ALLREADY ALLOCATED
;OR (10 ONLY) IF PAGES CAN'T BE CREATED (CORE LIMIT EXCEEDED OR SOMETHING)

CREPGS:	MOVEI	T1,1		;GET PAGE-ALLOCATED BIT
	PUSHJ	P,DOPGS		;MOVE THROUGH BIT MAP
	  TDNN	T1,PTAB(T2)	;ARE PAGES ALREADY ALLOCATED?
	   JRST	CREPGX		;ALL FREE, FINE
	POPJ	P,		;SOME PAGE ALLOCATED, ERROR

CREPGX:				;ENTRY POINT FOR PAGES ALREADY CHECKED

IF20,<
	DMOVE	T1,P1		;TOUCH THE PAGE
	LSH	T1,9
	XMOVEI	T1,(T1)		;In current section
CR20LP:	SKIP	(T1)		;TO CREATE IT
	ADDI	T1,1000
	SOJG	T2,CR20LP

>;END IF20

IF10,<
	PUSHJ	P,%SAVE4	;SAVE P1-P4
	MOVEI	P3,(P1)		;INITIALIZE P3, NUMBER OF PAGE BEING CREATED
	MOVE	P4,[-PLEN,,1]	;GET AOBJN POINTER TO PAGE. BLOCK
	MOVEI	T1,2		;GET PAGE-EXISTS BIT
	PUSHJ	P,DOPGS		;MOVE BIT THROUGH BIT MAP
	  PUSHJ	P,CREPG		;GO CREATE PAGE IF IT DOESN'T EXIST
	   JRST	.+2		;CREATED OK, SKIP
	POPJ	P,		;COULDN'T CREATE THEM, ERROR RETURN

	TRNE	P4,-2		;IF ARG BLOCK IS NONEMPTY,
	PUSHJ	P,PGUUO		;DO FINAL UUO
	  JRST	.+2		;WORKED, FINE
	POPJ	P,		;DIDN'T WORK, ERROR RETURN
>

	MOVEI	T1,3		;GET PAGE-ALLOCATED AND PAGE-EXISTS BITS
	PUSHJ	P,DOPGS		;MOVE THROUGH BIT MAP
	  IORM	T1,PTAB(T2)	;MARK PAGE EXISTING AND ALLOCATED

	JRST	%POPJ1		;SUCCESS RETURN
IF10,<

;ROUTINE TO CREATE A PAGE IF NECESSARY
;CALLED FROM INSIDE DOPGS, SO MUST BE CAREFUL
;ARGS:	 T1, T2 = BIT AND OFFSET FROM DOPGS
;		  (TO CHECK IF PAGE IS MARKED NONEXISTENT IN BIT MAP)
;	 P3 = PAGE NUMBER TO CREATE
;	 P4 = AOBJN POINTER TO PAGE. ARG BLOCK
;RETURN: P1-P2, T1-T4 UNCHANGED
;	 P3, P4 UPDATED FOR NEXT ITERATION OF DOPGS
;NONSKIP RETURN IF PAGE CREATED OK
;SKIP RETURN (TO TERMINATE DOPGS) IF PAGE COULDN'T BE CREATED

CREPG:	TDNE	T1,PTAB(T2)	;DOES PAGE EXIST ALREADY?
	  AOJA	P3,%POPJ	;YES, FINE

	HLL	P3,VRTBIT	;SET PA.GCD IF WANT A VIRTUAL PAGE
	MOVEM	P3,PBLK(P4)	;PUT PAGE NUMBER IN ARG BLOCK
	ADDI	P3,1		;INCREMENT FOR NEXT TIME
	AOBJN	P4,%POPJ	;RETURN IF BLOCK NOT FULL YET

PGUUO:	SUBI	P4,1		;UNDO EXTRA INCREMENT FROM AOBJN
	HRRZM	P4,PBLK		;STORE COUNT WORD
PGUUO1:	MOVE	P4,[.PAGCD,,PBLK] ;POINT TO ARG BLOCK
	PAGE.	P4,		;TRY TO CREATE PAGES
	  JRST	VIRT		;DIDN'T WORK, GO TRY TO GO VIRTUAL
	MOVE	P4,[-PLEN,,1]	;RESET AOBJN POINTER
	POPJ	P,		;DONE

VIRTER:	MOVE	T1,PBLK+1	;T1:= page number (for ERR call)
;	  ERR	(CCP,999,106,?,Can't create page $O (PAGE. error $O),<T1,P4>)
	$ECALL	CCP,%ABORT	;"?Can't create page n"

VIRT:	CAIN	P4,PAGNX%	;NO VIRTUAL PRIVS?
	  JRST	%POPJ1		;YES, GIVE UP ON CREATING PAGE
	CAIE	P4,PAGLE%	;Skip if "Core limit exceeded"
	 JRST	VIRTER		;NO, all other errors are fatal
	SKIPE	VRTBIT		;ALREADY WENT VIRTUAL?
	  JRST	%POPJ1		;YES, GIVE UP.  PAGE CAN'T BE CREATED

	MOVSI	T0,(PA.GCD)	;GET VIRTUAL BIT
	MOVEM	T0,VRTBIT	;SET FOR FUTURE CALLS
	MOVE	P4,[-PLEN,,1]	;MAKE AOBJN POINTER TO PAGE. ARG BLOCK
	HLLM	T0,PBLK(P4)	;PUT BIT INTO ARG BLOCK
	  AOBJN	P4,.-1

	SKIPE	.JBPFH		;PFH ALREADY READ IN, OR USER PFH?
	  JRST	PGUUO1		;YES, WONDERFUL, GO TRY AGAIN
;NOW THE TRICK IS TO MAKE ROOM FOR THE PAGE FAULT HANDLER.  PHYSICAL
;MEMORY IS FULL, BUT THE PFH MUST RESIDE IN PHYSICAL MEMORY.  THEREFORE
;PAGE OUT 1 OR 2 PAGES TO MAKE ROOM FOR IT.  THEN TOUCH ONE OF THE
;PAGED-OUT PAGES TO FORCE THE MONITOR TO READ IN THE PFH NOW.  THE ONLY
;PURPOSE FOR THAT IS TO CATCH MONITOR AND FOROTS BUGS HERE, NOT IN SOME
;RANDOM MEMORY REFERENCE SOMEWHERE ELSE.

	STKVAR	<SAVEP,,PCNT>	;ALLOCATE SOME TEMP VARIABLES
	DMOVEM	P1,SAVEP	;SAVE P1-P2
	SETOM	PCNT		;PCNT WILL GO POSITIVE AFTER 2 PAGES
	MOVEI	P2,1		;FIRST PAGE NUMBER IS 1

VIRTLP:	TRNE	P2,777000	;PAGE NUMBER OVER 1000?
	  JRST	VRTRET		;YES, RAN OUT OF PAGES.  NICE TRY

	MOVSI	P1,.PAGCA	;SET TO CHECK PAGE ACCESS BITS
	HRRI	P1,(P2)		;PUT IN PAGE NUMBER
	PAGE.	P1,		;GET BITS FOR THE PAGE
	 $SNH			;Shouldn't fail
	TXNE	P1,PA.GNE+PA.GPO+PA.GCP ;CHECK EXISTING PAGE, IN CORE, CAN BE PAGED OUT
	  AOJA	P2,VIRTLP	;NO DICE, TRY NEXT PAGE

	MOVE	P4,[.PAGIO,,P1] ;POINT TO ARG BLOCK
	MOVEI	P1,1		;SET COUNT WORD TO 1
	TXO	P2,PA.GAF	;SET TO PAGE THE PAGE OUT
	PAGE.	P4,		;DO IT
	  JRST	VRTRET		;DIDN'T MAKE IT, GIVE UP
	AOSG	PCNT		;INCREMENT COUNT OF PAGES WE'VE DONE
	  AOJA	P2,VIRTLP	;NOT ENOUGH YET, LOOP

	LSH	P2,9		;CONVERT PAGE NUMBER TO ADDRESS
	SKIP	(P2)		;READ IN PFH

VRTRET:	DMOVE	P1,SAVEP	;RESTORE P1-P2
	UNSTK			;RESTORE P
	JRST	PGUUO1		;GO TRY UUO AGAIN

>;END IF10
;ROUTINE TO DESTROY PAGES
;ARGS:	 P1 = FIRST PAGE TO DESTROY
;	 P2 = NUMBER OF PAGES TO DESTROY
;ON RETURN, PAGES ARE GONE

KILPGS:

IF20,<
	SETO	T1,		;UNMAP THE PAGES
	MOVSI	T2,.FHSLF	;FROM THIS FORK
	HRRI	T2,(P1)		;STARTING AT GIVEN PAGE NUMBER
	MOVSI	T3,(PM%CNT)	;WE ARE GIVING A COUNT
	HRRI	T3,(P2)		;WHICH IS IN P2
	PMAP%			;DESTROY THE PAGES
>

IF10,<
	STKVAR	<SAVEP,>	;SAVE P1-P2
	DMOVEM	P1,SAVEP
KILLP:	MOVE	T1,[-PLEN,,1]	;GET AOBJN POINTER TO PAGE. BLOCK
	HRLI	P1,(PA.GAF)	;SET TO DESTROY THE PAGES
KILLP1:	MOVEM	P1,PBLK(T1)	;PUT PAGE NUMBER IN BLOCK
	ADDI	P1,1		;INCREMENT PAGE NUMBER
	SOJLE	P2,EKILLP	;IF COUNT HIT 0, DONE
	AOBJN	T1,KILLP1	;KEEP GOING UNTIL BLOCK FILLS UP
	SUBI	T1,1		;UNDO EXTRA INCREMENT FROM AOBJN

EKILLP:	HRRZM	T1,PBLK		;SET COUNT IN ARG BLOCK
	MOVE	T1,[.PAGCD,,PBLK] ;SET TO DESTROY PAGES
	MOVE	T2,PBLK+1	;Get page number incase error
	PAGE.	T1,		;DO IT
;	  ERR	(CDP,999,106,?,<Can't destroy page $O (PAGE. error $O)>,<T2,T1>)
	 $ECALL	CDP,%ABORT
	JUMPG	P2,KILLP	;IF MORE LEFT TO DO, DO THEM

	DMOVE	P1,SAVEP	;RESTORE P1-P2
	UNSTK
>

	MOVEI	T1,3		;GET BOTH BITS
	PUSHJ	P,DOPGS		;MOVE T1 THROUGH BITS IN PTAB
	  ANDCAM T1,PTAB(T2)	;MARK PAGES FREE AND NONEXISTENT
	POPJ	P,		;DONE
;ROUTINE TO HANDLE PAGE BIT MAP
;CALL:
;	MOVEI	P1,FIRSTPAGE	;FIRST PAGE TO DO
;	MOVEI	P2,NPAGES	;NUMBER OF PAGES TO DO
;	MOVEI	T1,N		;BIT PATTERN
;	PUSHJ	P,DOPGS		;MOVE IT THROUGH BIT MAP
;	  INST	T1,PTAB(T2)	;ANY INSTRUCTION
;	    <INST DIDN'T SKIP, EVER>
;	<INST SKIPPED, AT LEAST ONCE>
;
;THE INSTRUCTION AFTER THE CALL IS EXECUTED REPEATEDLY WITH T1
;CONTAINING THE ORIGINAL BIT PATTERN, SHIFTED OVER APPROPRIATELY, AND
;T2 CONTAINING THE APPROPRIATE INDEX INTO PTAB.  IF THE INSTRUCTION
;SKIPS, CONTROL RETURNS FROM DOPGS IMMEDIATELY; IF IT NEVER SKIPS,
;THE INSTRUCTION IS EXECUTED FOR ALL PAGES FROM P1 TO P1+P2-1.

DOPGS:	STKVAR	<FIRSTP,NP,BITPAT> ;ALLOCATE SPACE ON STACK
	DMOVEM	P1,FIRSTP	;SAVE FIRST PAGE, NUMBER OF PAGES
	MOVEM	T1,BITPAT	;SAVE BIT PATTERN
	IDIVI	P1,^D18		;GET BYTE POS WITHIN WORD
	LSH	P2,1		;BYTES ARE 2 BITS LONG
	LSH	T1,(P2)		;MOVE BIT PATTERN TO RIGHT POSITION
	MOVEI	T2,(P1)		;GET OFFSET WITHIN TABLE
	MOVE	P2,NP		;GET COUNT BACK
	JRST	DOPLP1		;START AT BEGINNING

DOPLP:	LSH	T1,2		;MOVE BIT PATTERN OVER
	JUMPN	T1,DOPLP1	;LOOP IF STILL IN WORD
	MOVE	T1,BITPAT	;RESET T1 TO BEGINNING OF NEXT WORD
	ADDI	T2,1		;BUMP INDEX TO NEXT WORD
DOPLP1:	SOJL	P2,DOPRET	;QUIT WHEN DONE
	XCT	@-.L(P)		;DO THE INSTRUCTION
	  JRST	DOPLP		;NONSKIP

	AOS	-.L(P)		;PASS ON SKIP RETURN
DOPRET:	DMOVE	P1,FIRSTP	;RESTORE P1-P2
	UNSTK			;RESTORE P
	JRST	%POPJ1		;RETURN, SKIPPING OVER INST
;ROUTINE TO INITIALIZE MEMORY

;CALLED FROM INIT. ON PROGRAM START OR RESTART

;PUTS MEMORY INTO A KNOWN, CONSISTENT STATE BY DELETING ALL
;PAGES IT DOESN'T LIKE.  IT LIKES PAGES BELOW .JBFF, PAGES
;BETWEEN RH(.JBHRL)-LH(.JBHRL)+1 AND RH(.JBHRL), PAGES IN FOROTS,
;AND PAGES ABOVE STARTP.  ALL OTHERS GO.

;ALSO SETS UP FREE LIST POINTERS BEGPTR, FREPTR, AND FLBEG,
;AND THE PAGE BIT MAP PTAB.

%MEMINI:
	PUSHJ	P,%SAVE4	;SAVE P1-P4

	XMOVEI	T2,.		;Get section number
	HLRZ	T2,T2
	LSH	T2,^D9		;Get page # to "OR"
	MOVEM	T2,PAGSEC	;Page # of start of this section

	MOVEI	T1,.JBFF	;SETUP .JBFF PNTR
	MOVEM	T1,%JBFPT
	XMOVEI	T1,EXPADR	;SETUP ADDR OF MEMORY EXPANDER/CONTRACTOR
	MOVEM	T1,%EXPNT
	SETZM	EOL		;MAKE A ZERO TO END FREE LIST
	MOVEI	T1,EOL		;POINT TO THE ZERO
	MOVEM	T1,FREPTR	;START SEARCHING THERE
	HRROM	T1,BEGPTR	;IT'S ALSO START OF FREE LIST

	SETZM	FLBEG		;NO LOW SEG FREE LIST YET

IF10,<
	SETZM	VRTBIT		;START BY TRYING FOR PHYSICAL PAGES
>

;BL;	Change at %MEMINI+7
	MOVE	T1,[252525,,252525]	;INIT TO '010101....010101'
	MOVEM	T1,PTAB		;PAGE BIT TABLE = ALL UAVAILABLE & NONEXISTENT
;	SETOM	PTAB		;SET PAGE BIT TABLE TO ALL UNAVAILABLE
	MOVE	T1,[PTAB,,PTAB+1]
	BLT	T1,PTAB+^D28

	MOVE	P1,JOBFF	;GET END+1 OF LOW SEGMENT
	ADDI	P1,777		;ROUND UP TO A PAGE BOUNDARY
	LSH	P1,-9		;GET FIRST PAGE AFTER LOW SEGMENT
	MOVEM	P1,LPAGE	;SAVE IT FOR LOW SEG CORE ALLOCATION
;PTAB NOW HAS ALL PAGES MARKED AS UNAVAILABLE.  GO THROUGH IT, PAGE
;BY PAGE, AND MARK EACH PAGE AVAILABLE IF IT PASSES ALL THE TESTS.
;THE LOOP GOES FROM .JBFF TO PAGE TOPP, CHECKING EACH PAGE TO SEE IF
;IT'S IN THE DATA AREA OR IN FOROTS OR IN VMDDT OR IN THE PFH OR IN
;THE SYMBOL TABLE.

MINILP:	CAILE	P1,760		;HAVE WE HIT TOP OF OUR CORE?
	  POPJ	P,

	HRRZ	T1,.JBHRL	;GET HS BREAK
	MOVEI	T2,(T1)		;COPY IT
	HLRZ	T3,.JBHRL	;GET HS LENGTH
	SUBI	T1,-1(T3)	;SUBTRACT, GIVING HS ORIGIN
	JUMPL	T1,CHKDAT	;NO HS. CHECK DATA AREA
	PUSHJ	P,INUSCK	;CHECK FOR IN USE
	 AOJA	P1,MINILP	;IN USE. DON'T BOTHER

CHKDAT:
IFN FTSHR,<
	CAIG	P1,Z.DATA/1000
	CAIGE	P1,F.CODE/1000	;IS PAGE IN FOROTS?
	  JRST	CHKSYM		;NO
	AOJA	P1,MINILP	;YES, LEAVE IT
>

CHKSYM:	HRRZ	T1,.JBSYM	;SYMBOL TABLE ADDR
	MOVEI	T2,(T1)		;COPY IT
	HLRE	T3,.JBSYM	;NEG COUNT
	SUB	T2,T3		;GET HIGH ADDR+1
	SOJL	T2,CHKDDT	;IF NEG, NO SYMBOLS
	PUSHJ	P,INUSCK	;PAGE IN SYMBOL TABLE?
	 AOJA	P1,MINILP	;YES, LEAVE IT

CHKDDT:	HRRZ	T1,.JBDDT	;DDT ADDR
	JUMPE	T1,CHKPFH	;NO DDT. GO CHECK PFH
	HLRZ	T2,.JBDDT	;HIGH ADDR
	PUSHJ	P,INUSCK	;PAGE IN DDT?
	 AOJA	P1,MINILP	;YES, LEAVE IT

CHKPFH:	HRRZ	T1,.JBPFH	;PFH ADDR
	MOVEI	T2,(T1)		;COPY IT
	HLRE	T3,.JBPFH	;NEG COUNT
	SUB	T2,T3		;GET HIGH ADDR+1
	SOJL	T2,PAGOK	;NO PFH IF NEG
	PUSHJ	P,INUSCK	;PAGE IN PFH?
	 AOJA	P1,MINILP	;YES, LEAVE IT

PAGOK:	MOVEI	T1,(P1)		;COPY PAGE NUMBER FOR CHKNEX
	MOVEI	P2,1		;SET LENGTH OF 1 PAGE
	PUSHJ	P,CHKNEX	;SEE IF PAGE EXISTS
	  PUSHJ	P,KILPGS	;YES, MAKE IT NOT EXIST

	MOVEI	T1,3		;MARK PAGE AVAILABLE AND NONEXISTENT
	PUSHJ	P,DOPGS		;SHIFT T1 TO RIGHT PLACE IN BIT MAP
	  ANDCAM T1,PTAB(T2)

	AOJA	P1,MINILP	;LOOP ON TO NEXT PAGE

;ROUTINE TO CHECK IF PAGE IS WITHIN GIVEN BOUNDARIES
;
;	CALLED WITH LOW ADDR IN T1, HIGH ADDR IN T2, PAGE NUMBER IN P1
;	SKIP RETURN IF PAGE IS FREE

INUSCK:	LSH	T1,-9		;TO PAGE
	LSH	T2,-9		;TO PAGE
	CAMG	P1,T2		;PAGE IN USE?
	CAMGE	P1,T1
	 JRST	%POPJ1		;NO
	POPJ	P,		;YES
;ROUTINE TO CHECK IF A PAGE EXISTS
;ARGS:	 T1 = PAGE NUMBER
;SKIP RETURN IF PAGE IS NONEXISTENT

IF20,<
CHKNEX:	HRLI	T1,.FHSLF	;THIS FORK, PAGE NUMBER IS IN T1
	RPACS%			;READ PAGE ACCESS
	TXNN	T2,P1%PEX	;CHECK PAGE-EXISTS BIT (IN RH SO UNWRITTEN
				;  FILE PAGES ARE CONSIDERED TO EXIST)
	  AOS	(P)		;PAGE NONEXISTENT
	POPJ	P,		;PAGE EXISTS
>

IF10,<
CHKNEX:	HRLI	T1,.PAGCA	;CHECK ACCESS
	PAGE.	T1,		;TO PAGE NUMBER IN T1
	 $SNH			;SHOULD NEVER FAIL
	TXNE	T1,PA.GNE	;CHECK PAGE-NONEXISTENT BIT
	  AOS	(P)		;PAGE NONEXISTENT
	POPJ	P,		;PAGE EXISTS
>
	SEGMENT	DATA

BEGPTR:	BLOCK	1		;POINTER TO START OF LIST
FREPTR:	BLOCK	1		;POINTER TO BLOCK TO START SEARCH AT
EOL:	BLOCK	2		;THE ZERO WORD AT END OF LIST

WRAP:	BLOCK	1		;-1 IF FIRST PASS THROUGH LIST

PAGSEC:	BLOCK	1		;Page # of start of this section

%PTAB:
PTAB:	BLOCK	^D29		;THE BIT TABLE
				;2 BITS PER PAGE. 01 MEANS PAGE ALLOCATED
				;		  10 MEANS PAGE EXISTS
				;PAGE 0 IS RIGHT 2 BITS OF FIRST WORD

IF10,<
PBLK:	BLOCK	1		;ARG COUNT WORD
	BLOCK	PLEN		;ARGS

VRTBIT:	BLOCK	1		;0 IF TRYING FOR PHYSICAL PAGES,
				; PA.GCD IF TRYING FOR VIRTUAL PAGES
>
	SUBTTL	OVERLAY (LOW SEGMENT) MEMORY MANAGER

	SEGMENT	CODE

	COMMENT	&

"Low segment" in these routines means the pages between 0 and .JBREL which
are used to hold the root segment and all of the user's overlays.  Note that
in the strict TOPS-10 sense, the low segment is these pages and also the
pages at the top of core with the OTS free storage and data in them.

The free list for the low segment is kept in one contiguous block of memory
in OTS free core.  Each word in the list gives the start and end address of
one block of free memory, the start address in the left half and the end
address + 1 in the right half.  The list is in increasing order on address.
All blocks are disjoint and not contiguous.

The free list table is pointed to by FLBEG and its length is in FLLEN.  The
maximum size of the free list is determined by the size of the table; this
number is in FLMAX.

	&
;ROUTINE TO MARK A BLOCK OF THE LOW SEG "ALLOCATED"
;ARGS:	 T1 = ADDRESS OF BEGINNING OF BLOCK
;	 T2 = ADDRESS OF END+1 OF BLOCK
;NONSKIP RETURN:  NOT ENOUGH MEMORY
;1 SKIP:  	  BLOCK ALREADY ALLOCATED OR OVERLAPS ALLOCATED BLOCK
;2 SKIPS:	  OK, BLOCK ALLOCATED

LSGET:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	SKIPN	P3,FLBEG	;POINT TO START OF FREE LIST
	  PUSHJ	P,LSINIT	;NONE YET, GO MAKE ONE

	MOVE	P4,FLLEN	;GET LENGTH OF FREE LIST
GETLP:	SOJGE	P4,EXPRET	;IF ONE THERE, WE'RE OK
	CAMGE	T2,JOBFF	;TRYING TO ALLOCATE BELOW .JBFF?
	 JRST	%POPJ1		;YES. ALREADY ALLOCATED
	MOVEM	T1,DESLOW	;SAVE T1,T2 FOR EXPAND ROUTINE
	MOVEM	T2,DESHGH
	PUSHJ	P,LSEXP		;GO EXPAND CORE
	 POPJ	P,		;NON-SKIP MEANS CAN'T (INSUFFICIENT MEMORY)
	MOVE	T1,DESLOW	;RESTORE T1,T2
	MOVE	T2,DESHGH
	MOVE	P2,T2		;COPY HIGH ADDR + 1
	ADDI	P2,777		;ROUND END+1 UP TO MULTIPLE OF 1000
	TRZ	P2,777

	HRRZ	P1,-1(P3)	;GET END+1 OF TOP EXISTING FREE BLOCK
	CAML	P1,JOBFF	;DOES BLOCK END AT .JBFF?
	  SOJA P3,EXPMRG	;YES, MERGE IN THE NEW CORE WITH TOP BLOCK
	MOVE	P1,JOBFF	;NO, NEW CORE IS A NEW FREE BLOCK
	PUSHJ	P,BLTUP		;MOVE LIST UP TO MAKE ROOM FOR NEW BLOCK
	HRLZM	P1,(P3)		;STORE START ADDRESS OF NEW FREE BLOCK
EXPMRG:	HRRM	P2,(P3)		;STORE NEW END+1 ADDRESS OF FREE BLOCK
	MOVEM	P2,JOBFF	;STORE UPDATED .JBFF
	ADDI	P2,777		;WANT PAGE BEYOND ALLOCATED CORE
IF20,<	TRZ	P2,777		;MAKE IT A PAGE
	MOVEI	P1,-1(P2)	;TOPS-10 PROGS NEED .JBREL, SO KEEP IT RIGHT
	MOVEM	P1,.JBREL  >
	LSH	P2,-9		;GET HIGHEST PAGE + 1 THAT WE ALLOCATED
	MOVEM	P2,LPAGE	;REMEMBER IT

EXPRET:	HLRZ	P1,(P3)		;GET BEG ADRESS OF A FREE BLOCK
	HRRZ	P2,(P3)		;GET END+1

	CAIGE	P2,(T2)		;DOES FREE BLOCK END BEFORE ALLOCATED BLOCK?
	  AOJA	P3,GETLP	;YES, SEARCH FOR ONE WITH HIGH ENOUGH END ADDR

	CAILE	P1,(T1)		;DOES FREE BLOCK START AFTER ALLOCATED BLOCK?
	  JRST	%POPJ1		;YES, ALREADY ALLOCATED

	MOVEI	T3,(P2)		;CALCULATE MAX SIZE OF BLOCK ALLOCATABLE
	SUBI	T3,(T1)		; AT THIS ADDRESS FOR FUNCT.
	MOVEM	T3,BLKSIZ

	CAIE	P1,(T1)		;DO BLOCKS BEGIN AT SAME PLACE?
	  JRST	GECHK		;YES, GO COMPARE END POINTERS
	CAIE	P2,(T2)		;DO BLOCKS END AT SAME PLACE?
	  JRST	GTOP		;NO, ALLOCATE TOP PART OF BLOCK

;BLOCK TO BE ALLOCATED IS ALL OF AN EXISTING FREE BLOCK
GALL:	PUSHJ	P,BLTDWN	;ALLOCATE WHOLE BLOCK BY REMOVING IT
	JRST	%POPJ2		; COMPLETELY FROM THE FREE LIST

;BLOCK TO BE ALLOCATED IS TOP OF AN EXISTING FREE BLOCK
GTOP:	HRLM	T2,(P3)		;END ADDRESS OF ALLOCATED BLOCK IS NEW
	JRST	%POPJ2		; START ADDRESS OF FREE BLOCK

GECHK:	CAIE	P2,(T2)		;DO BLOCKS END AT SAME PLACE?
	  JRST	GMIDDL		;NO, ALLOCATE CHUNK FROM MIDDLE

;BLOCK TO BE ALLOCATED IS BOTTOM OF AN EXISTING FREE BLOCK
GBOT:	HRRM	T1,(P3)		;START ADDRESS OF ALLOCATED BLOCK IS NEW
	JRST	%POPJ2		; END ADDRESS OF FREE BLOCK

;BLOCK TO BE ALLOCATED IS IN MIDDLE OF AN EXISTING FREE BLOCK
GMIDDL:	PUSHJ	P,BLTUP		;MAKE A HOLE IN THE FREE LIST
	HRRM	T1,(P3)		;SET NEW END ADDRESS
	HRLM	T2,1(P3)	;AND NEW START ADDRESS
	JRST	%POPJ2		;DONE
;HERE WHEN LOW SEG MUST BE EXPANDED TO ALLOCATE CORE.  FAKE A CORE UUO

EXPADR:	MOVE	T2,DESHGH	;GET DESIRED HIGH ADDR

	MOVE	P1,LPAGE	;GET HIGHEST PAGE NUMBER IN LOW SEG
	MOVEI	P2,777(T2)	;ROUND TOP ADDRESS TO ALLOCATE UP TO A PAGE
	LSH	P2,-9		;GIVING TOP PAGE TO ALLOCATE
	SUBI	P2,(P1)		;COMPUTE NUMBER OF PAGES TO CREATE
	JUMPE	P2,%POPJ1	;IF NONE, SKIP
	JUMPL	P2,DEALC	;CORE HAS TO BE REDUCED
	  PUSHJ	P,CREPGS	;CREATE THE PAGES
	 POPJ	P,		;INSUFFICIENT MEMORY
	JRST	%POPJ1		;OK. DONE

DEALC:	ADD	P1,P2		;GET LOWEST PAGE TO KILL
	MOVM	P2,P2		;MAKE COUNT POSITIVE
	PUSHJ	P,KILPGS	;KILL THE PAGES
	JRST	%POPJ1		;SKIP RETURN, LIKE ABOVE

LSINIT:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T1,SAVET	;SAVE T1-T2
	MOVEI	T1,FLSIZE+1	;GET INITIAL SIZE OF FREE LIST BLOCK
	PUSHJ	P,%GTBLK	;GET CORE FOR FREE LIST
	MOVEI	P3,1(T1)	;PUT IN RIGHT AC
	MOVEM	P3,FLBEG	;SAVE START ADDRESS
	SETZM	FLLEN		;TABLE HAS ZERO LENGTH INITIALLY
	SETZM	-1(P3)		;MAKE A FAKE FREE BLOCK STARTING AT 0 AND
				; ENDING AT 0 FOR BOUNDARY CONDITION IN LSFREE
	MOVEI	T1,FLSIZE	;SET FLMAX
	MOVEM	T1,FLMAX
	DMOVE	T1,SAVET	;RESTORE T1-T2
	UNSTK			;FIX STACK
	POPJ	P,		;ALL DONE
;ROUTINE TO MARK A BLOCK IN THE LOW SEGMENT "FREE"
;ARGS:	 T1 = BEG ADDRESS
;	 T2 = END+1 ADDRESS
;NONSKIP RETURN IF BLOCK WASN'T ALLOCATED, ELSE SKIP RETURN

LSFREE:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	SKIPN	P3,FLBEG	;POINT TO FREE LIST
	  POPJ	P,		;NONE SET UP, ERROR RETURN

	SKIPA	P4,FLLEN	;GET LENGTH OF FREE LIST
FREELP:	ADDI	P3,1		;BUMP TO NEXT ENTRY IN FREE LIST
	SOJL	P4,FREEFF	;END OF FREE LIST, GO CHECK .JBFF
	HRRZ	P1,-1(P3)	;GET START ADDRESS OF ALLOCATED BLOCK
	HLRZ	P2,(P3)		;GET END ADDRESS OF SAME ALLOCATED BLOCK

	CAIGE	P2,(T2)		;DOES ALLOCATED BLOCK END BEFORE FREE BLOCK?
	  JRST	FREELP		;YES, SEARCH FOR ONE WITH HIGH ENOUGH END ADR
	CAILE	P1,(T1)		;DOES ALLOCATED BLOCK START AFTER FREE BLOCK?
	  POPJ	P,		;YES, FREE BLOCK IS ALREADY FREE

	CAIE	P1,(T1)		;DO BLOCKS START AT SAME PLACE?
	  JRST	FECHK		;NO, GO COMPARE END POINTERS
	CAIE	P2,(T2)		;DO BLOCKS START AT SAME PLACE?
	  JRST	FTOP		;NO, FREE TOP PART OF BLOCK

;BLOCK TO BE FREED IS ALL OF AN EXISTING ALLOCATED BLOCK
	HRRZ	T2,(P3)		;SAVE POINTER TO END OF FREE BLOCK
	PUSHJ	P,BLTDWN	;REMOVE FREE BLOCK FROM LIST
;	HRRM	T2,-1(P3)	;COMBINE PREVIOUS AND FOLLOWING FREE BLOCKS
;	JRST	%POPJ1		;BLOCK FREED

;BLOCK TO BE FREED IS TOP OF AN EXISTING FREE BLOCK
FTOP:	HRRM	T2,-1(P3)	;NEW START ADDRESS OF FOLLOWING FREE BLOCK
	JRST	%POPJ1		; IS START ADDRESS OF BLOCK BEING FREED

FECHK:	CAIE	P2,(T2)		;DO BLOCKS END AT SAME PLACE?
	  JRST	FMIDDL		;NO, FREE BLOCK IN MIDDLE

;BLOCK TO BE FREED IS BOTTOM OF AN EXISTING ALLOCATED BLOCK
FBOT:	HRLM	T1,(P3)		;NEW END ADDRESS OF FREE BLOCK IS START
	JRST	%POPJ1		; ADDRESS OF BLOCK BEING FREED

;BLOCK TO BE FREED IS IN MIDDLE OF AN EXISTING ALLOCATED BLOCK
FMIDDL:	PUSHJ	P,BLTUP		;MAKE A HOLE IN THE FREE LIST
	HRLM	T1,(P3)		;PUT A NEW ENTRY IN THE LIST
	HRRM	T2,(P3)
	JRST	%POPJ1		;BLOCK FREED
;HERE WHEN USER FREES A BLOCK ABOVE THE TOP EXISTING FREE BLOCK.
;SEE IF IT IS BELOW .JBFF AND IF SO, FREE IT

FREEFF:	CAMLE	T2,JOBFF	;TRYING TO FREE BLOCK ABOVE .JBFF?
	  POPJ	P,		;YES, ALREADY FREE
	SUBI	P3,1		;POINT TO TOP EXISTING FREE BLOCK

	HRRZ	P1,(P3)		;GET END ADDRESS OF TOP BLOCK
	CAILE	P1,(T1)		;DOES IT END AFTER THE ONE USER IS FREEING?
	  POPJ	P,		;YES, USER'S BLOCK IS ALREADY FREE

	CAIE	P1,(T1)		;IS USER'S BLOCK CONTIGUOUS WITH TOP BLOCK?
	  JRST	FNEW		;NO, GO CREATE NEW ENTRY IN FREE LIST
	HRRM	T2,(P3)		;MERGE FREE BLOCKS TOGETHER
	JRST	%POPJ1		;RETURN

FNEW:	PUSHJ	P,BLTUP		;MAKE NEW ENTRY IN FREE LIST
	HRLZM	T1,1(P3)	;BEG ADDRESS IS IN T1
	HRRM	T2,1(P3)	;END+1 ADDRESS IS IN T2
	JRST	%POPJ1		;ALL DONE
;ROUTINE TO LOCATE A FREE BLOCK OF SUFFICIENT SIZE
;ARGS:	 T2 = SIZE OF BLOCK TO FIND
;RETURN: T1 = ADDRESS OF A BLOCK TO ALLOCATE
;	 T2 UNCHANGED

LSFIND:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	MOVE	T1,JOBFF	;IF ALL ELSE FAILS, ALLOCATE AT .JBFF
	SKIPN	P3,FLBEG	;POINT TO FREE LIST
	  POPJ	P,		;NO FREE LIST, USE .JBFF
	MOVE	P4,FLLEN	;GET LENGTH OF LIST
FINDLP:	SOJL	P4,TOPCOR	;NO NEXT ENTRY, CHECK LAST ENTRY
	HLRZ	P1,(P3)		;GET START OF FREE BLOCK
	HRRZ	P2,(P3)		;AND END+1
	SUBI	P2,(P1)		;COMPUTE LENGTH
	CAIGE	P2,(T2)		;BIG ENOUGH?
	  AOJA	P3,FINDLP	;NO, KEEP LOOKING
	MOVEI	T1,(P1)		;PUT ADDRESS IN RIGHT AC
	POPJ	P,		;RETURN

TOPCOR:	HRRZ	P1,-1(P3)	;GET TOP+1 OF LAST FREE BLOCK
	CAMN	P1,JOBFF	;IS IT .JBFF?
	 HLRZ	T1,-1(P3)	;YES. USE BOTTOM OF BLOCK AS BASE LOC
	POPJ	P,
;ROUTINE TO CUT BACK THE LOW SEG SIZE TO MINIMUM
;NO ARGS

LSTRIM:	PUSHJ	P,%SAVE2	;SAVE P1-P2
	MOVE	P1,JOBFF	;GET HIGHEST ADDRESS WE NEED TO KEEP
	SKIPG	T1,FLLEN	;GET FREE LIST LENGTH
	  JRST	CALEXP		;NO FREE LIST, USE .JBFF
	ADD	T1,FLBEG	;POINT TO END OF FREE LIST
	HRRZ	T2,-1(T1)	;GET END+1 ADDRESS OF TOP FREE BLOCK
	CAIGE	T2,(P1)		;DOES TOP BLOCK END AT .JBFF?
	  JRST	CALEXP		;NO, CUT BACK TO .JBFF
	HLRZ	P1,-1(T1)	;CUT BACK TO START OF TOP FREE BLOCK
	SOS	FLLEN		;DELETE BLOCK FROM FREE LIST
CALEXP:	MOVEM	P1,DESHGH	;TELL LSEXP WE WANT TO SHRINK
	PUSHJ	P,LSEXP
	JFCL			;WILL ALWAYS SKIP RETURN

TRIMFF:	MOVE	P1,DESHGH	;GET NEW HIGH ADDR
	MOVEM	P1,JOBFF	;STORE NEW .JBFF
	ADDI	P1,777		;ROUND UP TO PAGE NUMBER
IF20,<	TRZ	P1,777		;ON TOPS-20, STORE .JBREL TOO
	MOVEI	P2,-1(P1)	; FOR OLD PROGS
	MOVEM	P2,.JBREL  >
	LSH	P1,-9		;GET FIRST PAGE GIVEN BACK
	MOVEM	P1,LPAGE	;STORE NEW HIGHEST PAGE+1
	POPJ	P,		;DONE
;ROUTINES TO EXPAND AND CONTRACT THE FREE LIST
;ARGS:	 P3 = ADDRESS IN LIST TO EXPAND OR CONTRACT AT
;RETURN: P3 UNCHANGED, T1-T4 UNCHANGED

;TO BE PRECISE:
;
;	BEFORE		  BLTUP		  BLTDWN
;
;   !-------------!  !-------------!  !-------------!
;   !             !  !             !  !             !  <-- FLBEG
;   !             !  !             !  !             !
;   !             !  !             !  !             !
;   !------!------!  !------!------!  !------!------!
;   !  B1  !  E1  !  !  B1  !  E1  !  !  B1  !  E1  !
;   !------!------!  !------!------!  !------!------!
;   !  B2  !  E2  !  !  B2  !  E2  !  !  B3  !  E3  !  <-- P3
;   !------!------!  !------!------!  !------!------!
;   !  B3  !  E3  !  !  B2  !  E2  !  !             !
;   !------!------!  !------!------!  !             !
;   !             !  !  B3  !  E3  !  !             !
;   !             !  !------!------!  !             !
;   !             !  !             !  !-------------!
;   !             !  !             !
;   !-------------!  !             !
;                    !             !
;                    !-------------!


BLTDWN:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T1,SAVET	;SAVE T1-T2
	SOSG	T1,FLLEN	;DECREMENT LS TABLE LENGTH
	  JRST	BLTRET		;ZERO LENGTH, ALL DONE
	ADD	T1,FLBEG	;COMPUTE END+1 OF TABLE
	MOVSI	T2,1(P3)	;SET BLT FROM ADDRESS
	HRRI	T2,(P3)		;AND BLT TO ADDRESS
	CAILE	T1,(T2)		;CHECK FOR 1-WORD TABLE
	  BLT	T2,-1(T1)	;MOVE THE TABLE DOWN ONE
	JRST	BLTRET		;ALL DONE

BLTUP:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T1,SAVET	;SAVE T1-T2
	AOS	T1,FLLEN	;INCREMENT TABLE LENGTH
	CAMLE	T1,FLMAX	;IN BOUNDS?
	  PUSHJ	P,BLTEXP	;NO, GO MOVE TO BIGGER TABLE
	ADD	T1,FLBEG	;COMPUTE END+1 OF NEW TABLE
	MOVEI	T2,-2(T1)	;GET END ADDR OF OLD TABLE
	SUBI	T2,(P3)		;COMPUTE LENGTH-1 WE NEED TO POP
	HRLI	T1,400000(T2)	;PUT INTO POP POINTER
	HRRI	T1,-2(T1)	;MAKE RH OF POINTER
	POP	T1,1(T1)	;BACKWARDS BLT
	JUMPL	T1,.-1

BLTRET:	DMOVE	T1,SAVET	;RESTORE T1-T2
	UNSTK
	POPJ	P,		;ALL DONE
;HERE WHEN FREE LIST TABLE FILLS UP
;MOVE THE FREE LIST INTO A BIGGER BLOCK.  FIX ALL POINTERS INTO THE FREE LIST
;TO POINT TO THE NEW BLOCK.  (THE ONLY THINGS THAT POINT TO THE FREE LIST ARE
;FLBEG AND P3.)

BLTEXP:	STKVAR	<SAVET,>	;ALLOCATE SPACE ON STACK
	DMOVEM	T3,SAVET	;SAVE T3-T4

	MOVE	T2,FLMAX	;GET OLD LENGTH OF TABLE
	MOVEI	T3,FLSIZE(T2)	;GET NEW LENGTH
	MOVEM	T3,FLMAX	;SAVE NEW LENGTH
	MOVE	T1,FLBEG	;GET OLD ADDRESS
	ADDI	T3,1		;FIX THINGS UP BECAUSE OF PHANTOM 0 WORD
	ADDI	T2,1		; BEFORE START OF LIST.  IT'S THERE BECAUSE
	SUBI	T1,1		; LSFREE USES -1(P3) SOMETIMES

	SUBI	P3,(T1)		;UNRELOCATE P3
	PUSHJ	P,%MVBLK	;MOVE TABLE TO BIGGER BLOCK
	ADDI	P3,(T1)		;RERELOCATE P3

	ADDI	T1,1		;SKIP PAST PHANTOM 0 WORD AT START OF TABLE
	MOVEM	T1,FLBEG	;STORE NEW ADDRESS OF TABLE

	MOVE	T1,FLLEN	;RESTORE T1
	DMOVE	T3,SAVET	;RESTORE T3-T4
	UNSTK			;FIX UP STACK POINTER
	POPJ	P,		;RETURN
	SEGMENT	DATA

FLBEG:	BLOCK	1		;START ADDRESS OF LS FREE STORAGE TABLE
FLLEN:	BLOCK	1		;LENGTH
FLMAX:	BLOCK	1		;MAX LENGTH

%EXPNT:	BLOCK	1		;ADDRESS OF "CORE UUO" SIMULATOR
%JBFPT:	BLOCK	1		;ADDRESS OF .JBFF
%LPAGE:
LPAGE:	BLOCK	1		;HIGHEST PAGE + 1 ALLOCATED IN LOW SEG
DESLOW:	BLOCK	1		;BOTTOM OF DESIRED BLOCK
%DESHG:
DESHGH:	BLOCK	1		;TOP OF DESIRED BLOCK

BLKSIZ:	BLOCK	1		;MAX SIZE OF ALLOCATABLE BLOCK FROM LSGET
	SUBTTL	ALCOR. AND DECOR.

	SEGMENT	CODE

;ROUTINES TO PROVIDE STANDARD INTERFACE TO FOROTS CORE MANAGEMENT FOR
;MACRO PROGRAMS.  STANDARD FORTRAN CALLING SEQUENCE, WITH ONE ARGUMENT
;POINTED TO BY AC 16.  RESULT RETURNED IN AC 0.


;ALCOR.  ALLOCATE A BLOCK OF CORE
;ARG:	 SIZE TO ALLOCATE
;RETURN: AC 0 = ADDRESS OF BLOCK, OR -1 IF NONE AVAILABLE

	'ALCOR.'
ALCOR%:	PUSHJ	P,%SAVE		;SAVE USER'S ACS
	MOVE	T1,@(L)		;GET NUMBER OF WORDS TO ALLOCATE
	PUSHJ	P,GTBLKX	;ALLOCATE A BLOCK
	  SETO	T1,		;NONE AVAILABLE
	MOVEM	T1,U.ACS+0	;GIVE ADDRESS TO USER
	JUMPL	T1,%POPJ	;DONE NOW IF ERROR
	MOVE	T2,-1(P)	;GET RETURN ADDRESS OFF STACK
	HRLM	T2,-1(T1)	;STORE IN BLOCK HEADER FOR DEBUGGING
	POPJ	P,		;RETURN



;DECOR.  DEALLOCATE A BLOCK OF CORE
;ARG:	ADDRESS OF BLOCK

	'DECOR.'
DECOR%:	PUSHJ	P,%SAVE		;SAVE USER'S ACS
	MOVE	T1,@(L)		;GET ADDRESS OF BLOCK
	PJRST	%FREBLK		;FREE IT AND RETURN
	SUBTTL	FUNCT.

	SEGMENT	CODE

;GENERAL-PURPOSE OTS INTERFACE.  USES STANDARD FORTRAN CALLING SEQUENCE,
;WITH ARG BLOCK POINTED TO BY AC 16.  THE FIRST THREE ARGS ARE STANDARD,
;THE REST ARE FUNCTION-SPECIFIC.  THIS ROUTINE DOES NOT CHECK THAT IT IS
;GIVEN THE CORRECT NUMBER OF ARGUMENTS, OR THAT THEY HAVE THE CORRECT TYPE.

;FUNCT. ARGS

	FN==0			;FUNCTION CODE
	ERRPFX==1		;3-CHAR PREFIX FOR ERRORS, ASCIZ
	STATUS==2		;RETURNED STATUS, NONZERO MEANS ERROR
	ARG1==3			;FUNCTION-DEPENDENT ARGS
	ARG2==4
	ARG3==5

;FUNCTION DISPATCH TABLE

FDISP:	EXP	F.ILL		;0  ILLEGAL
	EXP	F.GAD		;1  GET LS MEMORY AT ADDRESS
	EXP	F.COR		;2  GET LS MEMORY ANYWHERE
	EXP	F.RAD		;3  RETURN LS MEMORY
	EXP	F.GCH		;4  GET I/O CHANNEL
	EXP	F.RCH		;5  RETURN I/O CHANNEL
	EXP	F.GOT		;6  GET OTS MEMORY
	EXP	F.ROT		;7  RETURN OTS MEMORY
	EXP	F.RNT		;10 GET INITIAL RUNTIME
	EXP	F.IFS		;11 GET INITIAL RUN FILESPEC
	EXP	F.CBC		;12 CUT BACK LS TO MINIMUM
	EXP	F.RRS		;13 READ RETAIN STATUS (DBMS)
	EXP	F.WRS		;14 WRITE RETAIN STATUS (DBMS)
	EXP	F.GPG		;15 GET PAGES
	EXP	F.RPG		;16 RETURN PAGES
	EXP	F.GPSI		;17 GET TOPS-20 PSI CHANNEL
	EXP	F.RPSI		;20 RETURN TOPS-20 PSI CHANNEL
LDISP==.-FDISP-1		;MAX LEGAL FUNCTION CODE


;HERE IT IS

	'FUNCT.'
%FUNCT:	PUSHJ	P,%SAVE		;SAVE USER'S ACS
	SKIPLE	T1,@FN(L)	;GET FUNCTION CODE
	CAILE	T1,LDISP	;LEGAL?
	  SETZ	T1,		;NO, SET TO ILLEGAL FUNCTION
	JRST	@FDISP(T1)	;DISPATCH
;FUNCTION 0:  ILLEGAL
;
;RETURNS STATUS -1 (NOT IMPLEMENTED)


F.ILL:	SETOM	@STATUS(L)	;SET RETURN STATUS TO -1
	POPJ	P,		;AND RETURN





;FUNCTION 1:  GET LOW SEGMENT MEMORY AT GIVEN ADDRESS
;
;ARG1:	ADDRESS
;ARG2:	SIZE
;
;RETURNS STATUS 0 IF ALLOCATED OK
;		1 IF INSUFFICIENT MEMORY
;		2 IF ALREADY ALLOCATED AT THAT ADDRESS
;		3 IF ARGUMENT ERROR


F.GAD:	MOVE	T1,@ARG1(L)	;GET ADDRESS
	SKIPG	T2,@ARG2(L)	;AND LENGTH
	  JRST	GADX		;NEGATIVE LENGTH MEANS GET BIG BLOCK
	ADD	T2,T1		;COMPUTE END+1 OF REQUESTED CORE
	TLNN	T1,-1		;CHECK FOR REASONABLE ADDRESS
	TLNE	T2,-1		;AND LENGTH
	  JRST	ERR3		;JUNK CALL, REJECT IT

	PUSHJ	P,LSGET		;ALLOCATE THE CORE
	  JRST	ERR1		;NOT ENOUGH MEMORY
	  JRST	ERR2		;ALREADY ALLOCATED
	JRST	OKRET		;ALLOCATED


GADX:	AOJN	T2,ERR3		;ONLY LEGAL NEGATIVE ARG IS -1
	MOVEI	T2,1(T1)	;TRY TO ALLOCATE 1 WORD
	DMOVEM	T1,DTEMP	;SAVE BEG AND END+1 OF BLOCK
	PUSHJ	P,LSGET		;TRY FOR 1 WORD AT GIVEN ADDRESS
	  JRST	ERR1		;NOT ENOUGH MEMORY
	  JRST	ERR2		;ALREADY ALLOCATED

	DMOVE	T1,DTEMP	;GET BEG AND END+1 OF THE WORD
	PUSHJ	P,LSFREE	;FREE THE 1 WORD
	 $SNH			;Not allocated, internal error

	MOVE	T1,DTEMP	;GET ADDRESS
	MOVE	T2,BLKSIZ	;AND SIZE, RETURNED BY FIRST LSGET
	MOVEM	T2,@ARG2(L)	;GIVE ALLOCATED LENGTH TO USER
	ADDI	T2,(T1)		;COMPUTE END+1 OF BLOCK
	PUSHJ	P,LSGET		;ALLOCATE MAX SPACE
	  $SNH			;Not enough memory
	  $SNH			;Already allocated

	JRST	OKRET		;ALL OK





;FUNTION 2:  GET LOW SEGMENT MEMORY AT ANY ADDRESS
;
;ARG2:	SIZE
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY
;	 STATUS 0 IF ALLOCATED OK
;		1 IF INSUFFICIENT MEMORY
;		3 IF ARGUMENT ERROR


F.COR:	SKIPLE	T2,@ARG2(L)	;GET SIZE
	TLNE	T2,-1		;CHECK IT
	  JRST	ERR3		;WRONG

	PUSHJ	P,LSFIND	;FIND A SPOT WITH ENOUGH SPACE
	ADD	T2,T1		;COMPUTE END+1 OF CORE TO ALLOCATE
	PUSHJ	P,LSGET		;ALLOCATE IT
	  JRST	ERR1		;NOT ENOUGH MEMORY
	 $SNH			;Already allocated, internal error
	MOVEM	T1,@ARG1(L)	;STORE ADDRESS FOR CALLER
	JRST	OKRET		;RETURN





;FUNCTION 3:  RETURN LOW SEGMENT MEMORY
;
;ARG1:	ADDRESS
;ARG2:	SIZE
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF MEMORY WASN'T ALLOCATED
;		3 IF ARGUMENT ERROR


F.RAD:	MOVE	T1,@ARG1(L)	;GET ADDRESS
	SKIPG	T2,@ARG2(L)	;AND SIZE
	  JRST	ERR3		;ILLEGAL SIZE
	ADD	T2,T1		;COMPUTE END+1 OF CORE TO FREE
	TLNN	T1,-1		;CHECK ARGS
	TLNE	T2,-1
	  JRST	ERR3		;BAD

	PUSHJ	P,LSFREE	;DEALLOCATE BLOCK
	  JRST	ERR1		;WASN'T ALLOCATED
	JRST	OKRET		;OK, RETURN





;FUNCTION 4:  GET I/O CHANNEL
;
;RETURNS ARG1 = CHANNEL NUMBER
;	 STATUS 0 IF CHANNEL ALLOCATED OK
;		1 IF NO CHANNEL AVAILABLE (OR TOPS-20)


F.GCH:	SETZ	T1,		;REQUEST ANY AVAILABLE CHANNEL
	PUSHJ	P,%ALCHN	;ALLOCATE CHANNEL
	  JRST	ERR1		;NONE AVAILABLE
	MOVEM	T1,@ARG1(L)	;GIVE TO USER
	JRST	OKRET		;OK, RET





;FUNCTION 5:  RETURN I/O CHANNEL
;
;ARG1:	CHANNEL NUMBER
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF CHANNEL WASN'T ALLOCATED


F.RCH:	MOVE	T1,@ARG1(L)	;GET CHANNEL NUMBER
	TDNN	T1,[-20]	;ERROR IF ARG NOT IN 0-17
	PUSHJ	P,%DECHN	;FREE THE CHANNEL
	  JRST	ERR1		;WASN'T ALLOCATED
	JRST	OKRET		;OK




;FUNCTION 6:  GET MEMORY FROM OTS LIST
;
;ARG2:	SIZE
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY
;	 STATUS 0 IF ALLOCATED OK
;		1 IF NOT ENOUGH MEMORY
;		3 IF ARGUMENT ERROR


F.GOT:	SKIPLE	T1,@ARG2(L)	;GET SIZE
	TLNE	T1,-1		;CHECK FOR LEGALITY
	  JRST	ERR3		;BAD ARG
	PUSHJ	P,GTBLKX	;GET IT
	  JRST	ERR1		;NOT ENOUGH MEMORY
	MOVEM	T1,@ARG1(L)	;TELL USER THE ADDRESS
	MOVE	T2,-1(P)	;GET RETURN ADDRESS OFF STACK
	HRLM	T2,-1(T1)	;STORE IN BLOCK HEADER FOR DEBUGGING
	JRST	OKRET		;OK





;FUNTION 7:  RETURN MEMORY TO OTS LIST
;
;ARG1:	ADDRESS
;ARG2:	SIZE
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF WASN'T ALLOCATED
;		3 IF ARGUMENT ERROR


F.ROT:	SKIPLE	T1,@ARG1(L)	;GET ADDRESS
	TLNE	T1,-1		;CHECK
	  JRST	ERR3		;BAD
	PUSHJ	P,%FREBLK	;FREE BLOCK
	JRST	OKRET		;OK





;FUNCTION 10:  GET PROGRAM INITIAL RUNTIME
;
;RETURNS ARG1 = JOB (FORK) RUNTIME WHEN PROGRAM STARTED, IN MILLISECONDS
;	 STATUS 0, ALWAYS


F.RNT:	MOVE	T1,I.RUNTM	;GET RUNTIME
	MOVEM	T1,@ARG1(L)	;RETURN IT TO USER
	JRST	OKRET		;RETURN





;FUNCTION 11:  GET RUN FILESPEC (TOPS-10 ONLY)
;
;RETURNS ARG1 = DEVICE, SIXBIT
;	 ARG2 = FILENAME, SIXBIT
;	 ARG3 = PPN
;	 STATUS 0, ALWAYS


IF20,<
F.IFS==F.ILL			;NO RUNTIME FILESPEC AVAILABLE ON 20
>

IF10,<
F.IFS:	MOVE	T1,I.DEV	;GET DEVICE
	MOVEM	T1,@ARG1(L)
	MOVE	T1,I.FILE	;AND FILENAME
	MOVEM	T1,@ARG2(L)
	MOVE	T1,I.PPN	;AND PPN
	MOVEM	T1,@ARG3(L)
	JRST	OKRET		;OK, RET
>





;FUNCTION 12:  CUT BACK CORE TO MINIMUM
;
;RETURNS STATUS 0 ALWAYS, WITH LOW SEG SHRUNK IF POSSIBLE


F.CBC:	PUSHJ	P,LSTRIM	;TRIM LS SIZE, IF POSSIBLE
	JRST	OKRET		;RETURN OK ALWAYS





;FUNCTIONS 13-14:  READ AND WRITE RETAIN STATUS (RESERVED FOR DBMS)
;
;RETURNS ARG1 = 0
;	 STATUS 0, ALWAYS


F.RRS:
F.WRS:	SETZM	@ARG1(L)	;SET ARG TO ZERO
	JRST	OKRET		;OK RETURN





;FUNCTION 15:  GET PAGES
;
;ARG2:	SIZE TO BE ALLOCATED, WORDS
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY, ON PAGE BOUNDARY
;	 STATUS 0 IF ALLOCATED OK
;		1 IF NOT ENOUGH MEMORY
;		3 IF ARGUMENT ERROR

F.GPG:	SKIPG	T1,@ARG2(L)	;GET SIZE
	  JRST	ERR3		;BAD ARG
	ADDI	T1,777		;ROUND UP TO NUMBER OF PAGES
	LSH	T1,-9		;CONVERT WORDS TO PAGES
	TDNE	T1,[777777777000] ;CHECK
	  JRST	ERR3		;BAD ARG
	PUSHJ	P,%GTPGS	;ALLOCATE SOME PAGES
	  JRST	ERR1		;NOT ENOUGH MEMORY
	LSH	T1,9		;CONVERT PAGE NUMBER TO WORD ADDRESS
	MOVEM	T1,@ARG1(L)	;GIVE TO CALLER
	JRST	OKRET		;OK





;FUNCTION 16:  RETURN PAGES
;
;ARG1:	ADDRESS (WORD)
;ARG2:	SIZE (WORDS)
;
;RETURNS STATUS 0 IF DEALLOCATED OK
;		1 IF WASN'T ALLOCATED
;		3 IF ARGUMENT ERROR

F.RPG:	MOVE	T1,@ARG1(L)	;GET ADDRESS
	SKIPG	T2,@ARG2(L)	;AND SIZE
	  JRST	ERR3		;BAD SIZE, ERROR
	ADDI	T2,777		;ROUND SIZE UP TO MULTIPLE OF 1 PAGE
	LSH	T1,-9		;CONVERT ADDRESS TO PAGE
	LSH	T2,-9		;CONVERT SIZE
	TDNN	T1,[777777777000] ;RANGE CHECK
	TDNE	T2,[777777777000]
	  JRST	ERR3		;BAD
	PUSHJ	P,%FREPGS	;FREE THE PAGES
	JRST	OKRET		;OK



;FUNCTION 17:  GET TOPS-20 PSI CHANNEL
;
;ARG1:	CHANNEL NUMBER, OR -1 TO ALLOCATE ANY USER-ASSIGNABLE CHANNEL
;ARG2:	LEVEL NUMBER
;ARG3:	ADDRESS OF INTERRUPT ROUTINE
;
;RETURNS ARG1 = CHANNEL NUMBER ALLOCATED (IF -1 WAS SENT)
;	 STATUS 0 IF OK
;		1 IF CHANNEL WAS ALREADY ASSIGNED
;	 	2 IF NO FREE CHANNELS
;		3 IF ARGUMENT ERROR
;
;THIS ENTRY POINT PROVIDES ONLY CONTROLLED ACCESS TO THE PSI TABLES.
;IT WILL ARRANGE THAT THE TABLES EXIST AND THAT SIR AND EIR HAVE BEEN DONE
;BUT DOES NOT DO AIC OR ANY OTHER JSYS NECESSARY TO SET UP THE CHANNEL (ATI
;OR MTOPR, FOR EXAMPLE).

F.GPSI:	SKIPL	T1,@ARG1(L)	;GET CHANNEL NUMBER
	  JRST	GPSI1
	PUSHJ	P,GETPSI	;ALLOCATE A USER-ASSIGNABLE PSI CHANNEL
	  JRST	ERR2		;CAN'T
GPSI1:	CAIL	T1,^D36		;IN RANGE?
	  JRST	ERR3		;NO, BAD ARG
	SKIPE	%CHNTAB(T1)	;CHANNEL IN USE?
	  JRST	ERR1		;YES, ERROR
	SKIPLE	T2,@ARG2(L)	;GET PSI LEVEL
	CAILE	T2,3		;RANGE CHECK
	  JRST	ERR3		;BAD
	MOVE	T3,@ARG3(L)	;GET ADDRESS
	SKIPN	I.XSIR		;SIR FORMAT TABLES?
	  MOVEI	T4,-1		;YES, ADDRESS MUST FIT IN 18 BITS
	SKIPE	I.XSIR		;XSIR FORMAT TABLES?
	  MOVEI	T4,770000	;YES, ADDRESS MUST FIT IN 30 BITS
	TLNE	T3,(T4)		;DOES ADDRESS FIT?
	  JRST	ERR3		;DOESN'T, BAD ARGUMENT

	SKIPGE	@ARG1(L)	;RETURN CHANNEL TO USER
	  MOVEM	T1,@ARG1(L)
	MOVEM	T3,%CHNTAB(T1)	;STORE LEVEL AND ADDRESS IN TABLE
	SKIPN	I.XSIR		;SIR FORMAT?
	  HRLM	T2,%CHNTAB(T1)	;YES
	SKIPE	I.XSIR		;XSIR FORMAT?
	  DPB	T2,[POINT 6,%CHNTAB(T1),5] ;YES

	JRST	OKRET		;OK



;FUNCTION 20:  RETURN TOPS-20 PSI CHANNEL
;
;ARG1:	CHANNEL NUMBER
;
;RETURNS STATUS 0 IF OK
;		1 IF CHANNEL WASN'T IN USE
;		3 IF ARGUMENT ERROR
;
;THIS ENTRY POINT PROVIDES ONLY CONTROLLED ACCESS TO THE PSI TABLES.
;IT DOES NOT DO DIC OR ANY OTHER JSYS NECESSARY TO RELEASE A CHANNEL,
;IT JUST CLEARS THE LEVEL AND INTERRUPT ADDRESS FIELDS IN CHNTAB.

F.RPSI:	SKIPL	T1,@ARG1(L)	;GET ARG
	CAIL	T1,^D36		;RANGE CHECK
	  JRST	ERR3		;BAD
	SKIPN	%CHNTAB(T1)	;CHANNEL IN USE?
	  JRST	ERR1		;NO
	SETZM	%CHNTAB(T1)	;MARK CHANNEL FREE
	JRST	OKRET		;OK


;ROUTINE TO FIND A FREE PSI CHANNEL
;RETURNS T1 = CHANNEL NUMBER, IN 0:5 OR 23:35, THE USER-ASSIGNABLE CHANNELS

GETPSI:	MOVSI	T1,-6		;TRY 0-5 FIRST
	PUSHJ	P,GPSIX
	  JRST	%POPJ1		;WON, RETURN
	MOVE	T1,[-^D13,,^D23] ;NOW 23-35
	PUSHJ	P,GPSIX
	  JRST	%POPJ1		;SUCCEED
	POPJ	P,		;FAIL

GPSIX:	SKIPE	%CHNTAB(T1)	;TRY ONE
	  AOBJN	T1,.-1
	JUMPGE	T1,%POPJ1	;IF WE RAN OUT, FAILURE RETURN
	MOVEI	T1,(T1)		;CLEAR COUNT OUT OF LH
	POPJ	P,		;SUCCESS RETURN


;EXIT ROUTINES


OKRET:	JSP	T1,ERRX		;NORMAL RETURN
ERR1:	JSP	T1,ERRX		;ERROR RETURNS
ERR2:	JSP	T1,ERRX
ERR3:	JSP	T1,ERRX
ERRX:	SUBI	T1,ERR1		;CONVERT TO ERROR NUMBER
	HRRZM	T1,@STATUS(L)	;STORE FOR USER
	POPJ	P,		;RETURN






	SEGMENT	DATA

DTEMP:	BLOCK	2		;TEMP DOUBLEWORD
	PURGE	$SEG$
	END