Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	MTHPRM,FORPRM
	TV	EXTEND	Calls routines with large arrays as arguments,11(2)
	SUBTTL	Alan H. Martin/Thomas G. Speer  15-Sep-86

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982,1987

;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.

;This software is provided for informational purposes only, and is NOT
;SUPPORTED by Digital.  Furthermore, Digital makes no claim that  this
;software will ever be supported in the future.

;*****************************  WARNING  *****************************
;*                                                                   *
;*            MOST USES OF EXTENDED ADDRESSING APPLICATIONS          *
;*	      WILL REQUIRE A SUBSTANTIAL INCREASE IN SWAPPING        *
;*	      SPACE ALLOCATION.                                      *
;*                                                                   *
;*            FORDDT WILL NOT WORK IN NON-ZERO SECTIONS OR WHEN      *
;*            USED WITH A PROGRAM LOADED WITH EXTEND.REL. SUCH       *
;*            USES OF FORDDT ARE NOT SUPPORTED.                      *
;*                                                                   *
;*            NON-SECTION-ZERO CALLS TO SORT OR DBMS WILL NOT WORK   *
;*            AND ARE NOT SUPPORTED.                                 *
;*                                                                   *
;*********************************************************************


	SALL			;Suppress nasty macro expansions
	.DIRECTIVE SFCOND	;Suppress listing of failing conditionals
	.DIRECTIVE FLBLST	;List first line of binary data only

COMMENT \

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

***** Begin Version 7 *****

0	AHM	1-Nov-82
	Create EXTEND

***** End V7 Development *****

1	TGS	28-Jun-83
	PURGE F.MED so it won't conflict with ERRSET in FORMSC if loaded
	with EXTEND.REL

***** Begin V11 Development *****

2	TGS	1-Sep-86
	Create TOPS-10 version of EXTEND

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

\

COMMENT |
EXTEND.HLP -- Help file for EXTEND Version 11		September 1986

        Routines for using large arrays from Fortran programs


Fortran programs can manipulate arrays containing more than 256K words
of data.  Such arrays (called "large" arrays) cannot be declared local
to program units, or declared in COMMON blocks.  They must be  created
by a system subroutine named EXTEND and passed as arguments to all  of
the subprograms that must manipulate them.  To call a subroutine which
requires large  arrays, you  must call  EXTEND with  an argument  list
which includes the name of your subroutine that you want to be invoked
with large arrays  as arguments.   EXTEND will create  the arrays  and
then call the subroutine.   When that routine  returns to EXTEND,  the
arrays are discarded and control returns to the caller of EXTEND.

Before you can use large arrays, you have to initialize the subroutine
package.  Do this by:

	CALL EXTINI

This routine builds a  map of available free  sections for use by  the
large arrays allocated in  the call to  EXTEND.  Thus any  application
which intends to reserve non-zero sections for other purposes must  do
so before a call to EXTINI.

If your subroutine requires arguments in addition to the large arrays,
append them to the argument list for the call to EXTEND.  They will be
passed to the subroutine.  This is what a call to EXTEND looks like:

	CALL EXTEND(SUBRTN,N, SCALAR1,SIZE1,...,SCALARN,SIZEN, ARG1,...,ARGm)

is a call to the EXTEND routine with m+2N+2 arguments, where:

SUBRTN		Is the name of a Fortran subroutine to call using the N
		large arrays, N array sizes and m extra values (ARG1...ARGm)
		as arguments.  SUBRTN should be declared to be EXTERNAL.

N		Is the number of large arrays to generate.

SCALAR1, . . .	Are N scalar variables of the same type as the array elements
SCALARN,	in large array arguments to SUBRTN.  Note that a CHARACTER
		variable must be of the desired length for the elements of the
		corresponding array.

SIZE1, . . .	Are N scalars of type INTEGER which give the number of elements
SIZEN		in the large arrays.  These arguments are passed on to SUBRTN
		for use in adjustable array dimension declarations.

ARG1, . . .	Are "m" arguments of any type which are passed on to SUBRTN
ARGm		following the N large array arguments.

The EXTEND subroutine performs a call to SUBRTN that looks like this:

	CALL SUBRTN(ARRAY1,SIZE1,...,ARRAYN,SIZEN, ARG1,...,ARGm)


Consider the following program for example:

	PROGRAM BIG
	REAL A,XVEC(10)
	DOUBLE PRECISION B,EPS
	CHARACTER C*132,CARD*80
	EXTERNAL FOO
	CALL EXTINI
	CALL EXTEND(FOO,3, A,1000000,B,1000000,C,100000, XVEC,EPS,CARD)
	END

It will allocate an array of 1000000 real numbers (call it ARRAYA), an
array of 1000000  double precision  numbers (ARRAYB) and  an array  of
100000 132 character long  strings (ARRAYC).  It will  appear as if  a
Fortran subroutine named EXTEND was called which looks like this:

	SUBROUTINE EXTEND(XVEC,EPS,CARD)
	REAL ARRAYA(1000000),XVEC
	DOUBLE PRECISION ARRAYB(1000000),EPS
	CHARACTER ARRAYC(100000)*132,CARD*80
	CALL FOO(ARRAYA,1000000,ARRAYB,1000000,ARRAYC,100000,
	1 XVEC,EPS,CARD)
	END



To load a program which calls EXTEND:

	.LOAD FOO.FOR,SYS:EXTEND.REL

See your system administrator to find out where EXTEND.REL is.

|

	SUBTTL	Definitions

; Argument block offsets

; Offsets from the beginning of the arg block

	SUBRTN==0		;Address of routine to call
	N==1			;Number of generated arrays
	ARRAYS==2		;Beginning of 2N arguments that give the
				; types of the generated array elements
	MINARG==4		;Minimum # of args in call to EXTEND

; Relative position of generated array types and sizes

	TYPE==0			;First item is the scalar for the type
	SIZE==1			;Second item is the integer size

; Private ACs

	I==U			;Pointer to indirect words
	LL==D			;Copy of incoming arg block pointer
	A==F			;Address of arg block being created

; Random symbols

	EXTERN	FUNCT.		;OTS core manager entry point
	EXTERN	ABORT.		;Subroutine to return control to
				; the operating system on errors

	INTERN	%EXTND		;FOROTS 0-to-1 section map switch

	%EXTND==-1		;Force non-zero OTS
	NSEC==40		;Number of sections to search.

SUBTTL	TOPS-20 error message

IF20,<

	HELLO	(EXTINI)
	JRST	EXTNN2

	HELLO	(EXTEND)
EXTNN2:	PUSHJ	P,F.EN2		;Use /EXTEND on TOPS-20
	JRST	ABORT.

	$FERR	(?,EN2,21,0,<Use /EXTEND on TOPS-20>)

> ;End IF20

IF10,<
	SUBTTL	Variables

	SEGMENT	DATA		;Down to the low segment

; Note that starred (;*;) variables are stored on the stack around the
; call to the user's routine in case EXTEND is called recursively.

; Two tables describing chunks of free core

CHUNKS:	BLOCK	1		;Holds -# of chunks,,0
FREADR:	BLOCK	NSEC		;The number of words available in each chunk
FRESIZ:	BLOCK	NSEC		;Address of first free location in each chunk

; A table describing what sections were created and must be  discarded
; upon exit from EXTEND.

RETPTR:	BLOCK	1		;Pointer to first free entry in RETARG
RETORG:	BLOCK	1	;*;	;Contents of RETPTR at routine entry
RETARG:	BLOCK	NSEC		;PAGE. args to discard sections we create
				;(number of pages,,first page)
RETEND==.-1

PAGBLK:	BLOCK	2		;PAGE. UUO argument block
VRTUAL:	BLOCK	1		;Set when we go virtual

; Random scalars

ARGN:	BLOCK	1	;*;	;Number of pass along arguments
ARGLST:	BLOCK	1	;*;	;Holds the address of the argument list
				; being constructed
ROUTIN:	BLOCK	1		;Holds address of user's routine to call


; FUNCT. arguments

FNOPC:	BLOCK	1		;Holds opcode for FUNCT. calls
FNSTS:	BLOCK	1		;Holds status upon return fron FUNCT. calls
FNARG1:	BLOCK	1		;First argument for FUNCT.
FNARG2:	BLOCK	1		;Second argument for FUNCT.

	SEGMENT	CODE		;Up to the high segment

	SUBTTL	EXTINI - Global initialization entry point

; EXTINI - subroutine to initialize some global OWN variables
; Call:
;	XMOVEI	L,ZERARG
;	PUSHJ	P,EXTINI
; Return: always
; RETPTR/	Address of first free location in PAGE. argument save area
; FREADR through FREADR+NSEC-1/	Address of first free word in each chunk
; FRESIZ through FRESIZ+NSEC-1/	Number of free words in each chunk

	HELLO	(EXTINI)

	XMOVEI	T1,0		;Get the section local address of AC 0
	JUMPN	T1,EXTI.1	;Is it 1,,0 ?  If not, we are in section 0

; Note that CALL  EXTEND will not  work if FOROTS  was initialized  in
; section 0 because FOROTS stores addresses of some section local data
; structures as 30  bit numbers  and so can  get very  confused if  an
; address is stored with a section number of 0 and fetched when we are
; no longer running in section 0.

	PUSHJ	P,F.ES0		;No, complain
	JRST	ABORT.		; and die

	$FERR (?,ES0,21,0,<EXTINI called in section 0 - RUN /USE-SECTION:1>)

EXTI.1:	XMOVEI	T1,RETARG	;Point to the PAGE. return section arg table
	MOVEM	T1,RETPTR	;Save it for later use

; Set up the chunk tables.  First we look for a free section.

	MOVSI	T3,-NSEC	;Set up an AOBJN counter for the sections
	SETZ	T4,		;Point to the first chunk
EXTI.2:	MOVEI	T1,0(T3)	;Look at the next section
	LSH	T1,^D9		;Make a page number in that section
	TLO	T1,.PAGCA	;Page-access code
	PAGE.	T1,		;See if page/section exists
	 JRST	PAGERR
	TXNN	T1,PA.GSN	;Does section exist?
	 JRST	EXTI.5		;Yes
	HRLZM	T3,FREADR(T4)	;No, save chunk origin

	MOVEI	T0,1		;At least one free section, look for more
EXTI.3:	AOBJP	T3,EXTI.4	;Is there a section after this one?
	MOVEI	T1,0(T3)	;Yes, look at it
	LSH	T1,^D9		;Make page number in section
	TLO	T1,.PAGCA
	PAGE.	T1,
	 JRST	PAGERR
	TXNE	T1,PA.GSN	;Section exist?
	 AOJA	T0,EXTI.3	;No, tally it and look at the next section

EXTI.4:	HRLZM	T0,FRESIZ(T4)	;No, save away the size of this chunk in words
	ADDI	T4,1		;Move chunk pointer
EXTI.5:	AOBJN	T3,EXTI.2	;No, go check the next section

	MOVN	T4,T4		;Get the negative number of chunks
	HRLZM	T4,CHUNKS	;Save away as an AOBJN pointer

; If section 1 is a data section, then we must ask for 20 locations to
; avoid using the ACs as part of  a large array.  Note that this  will
; prevent us from ever returning section 1 to the monitor.

	MOVEI	T1,20		;We may have to steal the non-zero section ACs
	MOVS	T2,FREADR+0	;Look at the first chunk
	CAIN	T2,1		;Does it start at 1,,0 ?
	 PUSHJ	P,GETWRD	;Yes, steal some core
	GOODBYE			;Done initializing things

	SUBTTL	Top level routine for EXTEND

	HELLO	(EXTEND)

	PUSHJ	P,INIT		;Set up ARGN, ARGLST, etc.

	PUSHJ	P,ALCARG	;Get SUBRTN's argument list from the heap

	PUSHJ	P,GENARY	;Generate all of the necessary large arrays

	PUSHJ	P,COPARG	;Copy over all of the pass along arguments

	PUSHJ	P,CALLEM	;Call the user's routine

	PUSHJ	P,RETCOR	;Free arg list, EFIWs and extra sections

	GOODBYE

	SUBTTL	INIT - subroutine to initialize ROUTIN, ARGN and RETORG

; INIT - subroutine to initialize ROUTIN, ARGN and RETORG
; Call:
;	PUSHJ	P,INIT
; Return: always
; ROUTIN/	Address of user routine to call with large array arguments
; ARGN/		Number of pass along arrays

INIT:	SKIPN	T1,RETPTR	;Get the first available location in RETARG
	 JRST	INIWRN		;CALL EXTINI sets RETPTR, too bad user didn't
	MOVEM	T1,RETORG	;Remember it for later
	XMOVEI	T1,@SUBRTN(L)	;Get the address of the user's routine
	MOVEM	T1,ROUTIN	;Save it for later use
	SKIPN	(T1)		;Is the first word of the routine non-zero ?
	 JRST	RERR		;No, user forgot his EXTERNAL declaration
	SKIPGE	T1,@N(L)	;Get the number of pass along args
	 JRST	NERR		;Negative number - yell at user
	MOVEM	T1,ARGN		;Save it away

;If N.GE.0, there must be at least 4 arguments in the EXTEND call.

	HLRE	T1,-1(L)	;Get EXTEND arg count
	MOVN	T1,T1		;Positive
	CAIL	T1,MINARG	;At least the minimum args?
	 POPJ	P,		;Yes, OK

	PUSHJ	P,F.BXL		;No. Bad arglist for EXTEND
	JRST	ABORT.
	$FERR (?,BXL,21,0,<Too few arguments in CALL EXTEND>)
	
INIWRN:	PUSHJ	P,F.CEN		;Complain,
	FUNCT	(EXTINI,<>)	; initialize
	JRST	INIT		; and try again
	$FERR (%,CEN,21,0,<CALL EXTINI was not done before CALL EXTEND>)

NERR:	PUSHJ	P,F.NNA		;Complain,
	JRST	ABORT.		; and die
	$FERR (?,NNA,21,0,<Negative number of large arrays in CALL EXTEND>)

RERR:	PUSHJ	P,F.MED		;Complain,
	JRST	ABORT.		; and die
	$FERR (?,MED,21,0,<Missing EXTERNAL declaration in CALL to EXTEND>)

IF2,<	PURGE	F.MED	>	;[1]

	SUBTTL	ALCARG - Get new arg list from the heap

; ALCARG - subroutine to allocate the argument list
; Call:
;	PUSHJ	P,ALCARG
; Return: always
; A, ARGLST/	Pointer to new argument list, complete with count word set up

ALCARG:

; First we compute M+2N so that we know how much core to allocate  for
; the arg list.

	HLRE	T1,-1(L)	;Get the negative of the total
				; number of our arguments
	MOVN	T1,T1		;Convert total to positive number
	SUBI	T1,2		;Exclude SUBRTN and N from the count

; Now figure out how big an argument list to dynamically allocate.  If
; there are any  arguments for SUBRTN,  we need a  word for each  pass
; along argument (M), a word for  each generated argument (N), a  word
; for each large array size (N) and  a word for the count, or  M+2N+1.
; If there are  no arguments, then  we need  two words -  one for  the
; count, and  one for  the  empty arg  block  which allows  people  to
; reference 0(L) without an ill mem ref.

	SKIPE	T3,T1		;Is M+2N equal to 0 ? (Stash it away for later)
	 AOSA	T1		;No, T1 gets M+2N+1
	  MOVEI	T1,2		;Yes, get room for count and idiot phantom arg
	MOVEM	T1,FNARG2	;Save the size for the call
	PUSHJ	P,ALLOC		;Go get some core
	AOS	A,FNARG1	;Fetch address+1
	MOVEM	A,ARGLST	;Save it away
	MOVN	T3,T3		;Negate the arg list's count word
	HRLZM	T3,-1(A)	; and save it away (-size,,0)
	POPJ	P,		;Done allocating the arg block

	SUBTTL	GENARY - Generate large arrays in the free sections

; GENARY - subroutine to generate large arrays in the free sections
; Call:
; A/	Address of first word in new argument list for generated arguments
; ARGN/	Number of large arrays to generate
;	PUSHJ	P,GENARY
; Return: always
; A/	Address of word in new arg list after generated arrays
; LL/	Address of word in old arg list after generated arrays
; Destroys I

GENARY:	MOVN	LL,ARGN		;Get the negative number of large arrays
	HRLZ	LL,LL		;Make an AOBJN pointer into the old arg block
	HRRI	LL,ARRAYS(L)	;Point to the beginning of the scalars
	JUMPGE	LL,GENXIT	;Are there any arrays to generate ?
				;Yes, allocate them

ARYLUP:	LDB	T2,[POINTR(TYPE(LL),ARGTYP)] ;Get this scalar's type
	MOVEI	T1,1		;Assume it is numeric - we need 1 indirect word
	CAIN	T2,TP%CHR	;Is it character?
	 MOVEI	T1,2		;Yes, need 2 word character descriptor
	MOVEM	T1,FNARG2	;Save the size for the call
	PUSHJ	P,ALLOC		;Go get some core
	HRRZ	I,FNARG1	;Fetch its address
	TXO	I,<IFIW>	;Make a local indirect and index word (heh heh)
	DPB	T2,[POINTR(I,ARGTYP)] ;Drop off the arg type
	CAIE	T2,TP%CHR	;Are we playing with characters?
	 JRST	NOTCHR		;No, go hack numerics

	XMOVEI	T2,@TYPE(LL)	;Get the address of the character descriptor
	SKIPG	T1,1(T2)	;Get the element length
	 JRST	BCAERR		;Not positive - bad character argument
	MOVEM	T1,1(I)		;Save it away
	SKIPG	T2,@SIZE(LL)	;Fetch the number of elements desired
	 JRST	INEERR		;Tell ninny he has illegal number of elements
	IMUL	T1,T2		;Multiply by number of elements
	ADDI	T1,4		;Round up ahead of time
	IDIVI	T1,5		;Convert from characters to words
	PUSHJ	P,GETWRD	;Find a place for the array
	TXO	T1,IFOWG	;Make the address into a OWGBP
	JRST	ARYFIN		;Go store it and set up the arg block word

NOTCHR:	SKIPG	T1,@SIZE(LL)	;Get the array size
	 JRST	INEERR		;Illegal number of elements
	TRNE	T2,10		;High order bit set in arg type ?
	 LSH	T1,1		;Yes, DP data type, multiply size by 2
	PUSHJ	P,GETWRD	;Find a place for the array
	TXO	I,<@>		;Numeric args use indirection

ARYFIN:	MOVEM	T1,0(I)		;Save the address away
	MOVEM	I,TYPE(A)	;Store the "array" argument word
	MOVE	T1,SIZE(LL)	;Get the arg block word for the size
	MOVEM	T1,SIZE(A)	;Copy it over
	ADDI	LL,1		;Allow for the fact that each large array
	ADDI	A,2		; takes two arguments to describe
	AOBJN	LL,ARYLUP	;Go back for more arguments

GENXIT:	POPJ	P,		;Done with the large arrays

BCAERR:	PUSHJ	P,F.BCA		;Complain,
	JRST	ABORT.		; and die

	$FERR (?,BCA,21,0,<Bad character argument in CALL EXTEND>)

INEERR:	PUSHJ	P,F.INE		;Complain,
	JRST	ABORT.		; and die

	$FERR (?,INE,21,0,<Illegal number of array elements in CALL EXTEND>)

	SUBTTL	COPARG - Copy over the pass along arguments to the new arg list

; COPARG - subroutine to copy over the pass along arguments to the new arg list
; Call:
; ARGN/	Number of generated arrays
; A/		Address of place to put first pass along argument in new list
; LL/		Address of first pass along argument in user's list
;	PUSHJ	P,COPARG
; Return: always

COPARG:	HLRE	T1,-1(L)	;Get the negative of our argument count
	MOVN	T1,T1		;Positivize it
	MOVE	T2,ARGN		;Get the number of generated arrays
	LSH	T2,1		;Generated arrays use two argumants each
	SUBI	T1,2(T2)	;Don't count generated arrays, "SUBRTN" and "N"
	JUMPE	T1,COPA.1	;Are there any generated arguments ?
				;Yes, set up for BLT

	HRRZ	T2,A		;Destination is our arg list
	ADD	T1,T2		;Compute end of args to copy
	HRL	T2,LL		;Source is the user's arg list
	BLT	T2,-1(T1)	;Move things around

COPA.1:	POPJ	P,		;Done with the pass along arguments

	SUBTTL	CALLEM - Call the user's routine

; CALLEM - subroutine to call the user's routine
; Call:
; ARGN/		Number of generated arrays
; ARGLST/	Address of first word in generated argument list
; ROUTIN/	Address of routine to call
;	PUSHJ	P,CALLEM
; Return: always, save the following variables in case of a recursive call:
; ARGN/		Number of generated arrays
; ARGLST/	Address of first word in generated argument list

CALLEM:	PUSH	P,ARGN		;Save the number of generated arrays
	PUSH	P,ARGLST	;Save the address of the user's arg list
	PUSH	P,RETORG	;Save the first location we used

	XMOVEI	L,@ARGLST	;Point to the arg list
	PUSHJ	P,@ROUTIN	;Call the user's routine

	POP	P,RETORG	;Restore our old RETARG origin
	POP	P,ARGLST	;Restore the address of the user's arg list
	POP	P,ARGN		;Restore the number of generated arrays
	POPJ	P,		;Return to the main line code

	SUBTTL	RETCOR - Return our arg list, indirect words and extra sections

; RETCOR - subroutine to return our arg list, indirect words and extra sections
; Call:
; ARGN/		Number of generated arrays
; ARGLST/	Address of first word in generated argument list
; RETPTR/	Address of first unused word in PAGE. argument save area
;	PUSHJ	P,RETCOR
; Return: always
; Destroys A

RETCOR:	MOVN	A,ARGN		;Get the negative number of generated arrays
	JUMPGE	A,RETC.2	;Any arrays?  If so, free up indirect words
	HRLZ	A,A		;No, put count in left half
	HRR	A,ARGLST	;Yes, there are, point to the arg list

RETC.1:	HRRZ	T1,0(A)		;Point to the indirect word
	MOVEM	T1,FNARG1	;Save it away for the call
	LDB	T2,[POINTR (TYPE(A),ARGTYP)] ;Get the data type
	MOVEI	T1,1		;Assume array is numeric and has an EFIW
	CAIN	T2,TP%CHR	;Is it type character ?
	 MOVEI	T1,2		;Yes, two word descriptor to return
	MOVEM	T1,FNARG2	;Save away the size
	PUSHJ	P,FREE		;Go return some core
	ADDI	A,1		;Account for the size arg
	AOBJN	A,RETC.1	;Loop back for the rest of the args

RETC.2:	SOS	T1,ARGLST	;Point to the start of the arg list
	HRRZM	T1,FNARG1	;Save it away for the call
	HLRE	T1,0(T1)	;Get the size word
	SKIPE	T1		;Is it zero length ?
	 SOSA	T1		;No, allow for the count word itself
	  MOVNI	T1,2		;Yes, it is actually two words long
	MOVNM	T1,FNARG2	;Save size for call
	PUSHJ	P,FREE		;Free up the arg list

	MOVE	T4,RETORG	;Point to start of table
	MOVE	T1,T4		;Make copy for storing
	SUB	T4,RETPTR	;Subtract first free to get negative count
	MOVEM	T1,RETPTR	;Restore our old limit
	JUMPE	T4,RETC.4	;Are there any sections to return ?
	HRLZ	T4,T4		;Yes, put AOBJN count in left half of AC
	HRR	T4,RETORG	;Point to the start of our arguments

RETC.3:	HLRZ	T1,(T4)		;Get total # pages in this chunk
	MOVNM	T1,PAGBLK	;Negative page count for PAGE.
	HRRZ	T1,(T4)		;Get first page # to destroy
	MOVEM	T1,PAGBLK+1	;Tell PAGE. about it
	MOVSI	T1,(PA.GAF)	;Kill pages bit
	HLLM	T1,PAGBLK+1
	MOVE	T1,[.PAGCD,,PAGBLK]
	PAGE.	T1,		;Try to kill them
	 JRST	PAGERR		;Should not fail

	AOBJN	T4,RETC.3	;Loop back for other sections
RETC.4:	POPJ	P,		;All done - return to main line code

	SUBTTL	GETWRD - Get n words of core, where n is large

; GETWRD - subroutine to search for free core
; Call:
; T1/	Number of words needed (can be bigger than a section)
;	PUSHJ	P,GETWRD
; Return: always
; T1/	Address of allocated core

; To allocate core, we first have to find the core in the chunk table.
; Just look for the first chunk with enough free words.

GETWRD:	MOVE	T4,CHUNKS	;Create AOBJN pointer for chunk table

GETW.1:	CAMG	T1,FRESIZ(T4)	;Does this chunk have enough free ?
	 JRST	GETW.2		;Yes, go take it
	AOBJN	T4,GETW.1	;No, try again
	PUSHJ	P,F.NFS		;No core left
	JRST	ABORT.
	$FERR (?,NFS,21,0,<Not enough free sections for CALL EXTEND>)

; T1/	Number of words needed
; T4/	-# chunks not ruled out,,# of chunk with enough space in it

; Now that we have found a  chunk with enough words available, we
; need to pre-allocate some pages with a PAGE. UUO.

GETW.2:	MOVE	T2,FREADR(T4)	;Get 1st free location in this chunk
	TRNE	T2,777		;Start on page boundary?
	 ADDI	T2,1000		;No, round up
	LSH	T2,-^D9		;Get 1st page #

	MOVE	T3,T1		;Get words needed in T3
	ADD	T3,FREADR(T4)	;Compute last address used+1
	TRNE	T3,777		;Start on page boundary?
	 ADDI	T3,1000		;No, round up
	LSH	T3,-^D9		;Get last page #

	SUB	T3,T2		;Get number of new pages (last-first)
	MOVN	T0,T1		;Save number of words needed, negate for later
	JUMPE	T3,GETW.3	;Don't PAGE. if no new pages needed
	
	HRLM	T3,@RETPTR	;Save total # pages needed
	MOVNM	T3,PAGBLK	;and as negative count for PAGE.
	HRRM	T2,@RETPTR	;Save starting page #
	MOVEM	T2,PAGBLK+1
	AOS	T1,RETPTR	;Point to the next location for next time
	MOVEI	T1,(T1)
	CAILE	T1,RETEND	;Too many recursive levels?
	 JRST	TOODEP		;Yes

CREPAG:	MOVE	T1,VRTUAL	;Get virtual bit (or 0)
	HLLM	T1,PAGBLK+1
	MOVE	T1,[.PAGCD,,PAGBLK]
	PAGE.	T1,		;Create the pages
	 JRST	TRYVRT		;Can't, try to go virtual

	MOVN	T1,T0		;Restore the number of words needed

GETW.3:	ADDM	T0,FRESIZ(T4)	;Shrink the chunk
	EXCH	T1,FREADR(T4)	;Get chunk origin, save amount used
	ADDM	T1,FREADR(T4)	;Account for what was used

	POPJ	P,		;Return to the caller with address in T1

TRYVRT:	CAIN	T1,PAGNX%	;Any privs to go virtual
	 JRST	PAGERR		;No, give up
	CAIE	T1,PAGLE%	;"Core limit exceeded"?
	 JRST	PAGERR		;No, something fatal
	SKIPE	VRTUAL		;Already went virtual?
	 JRST	PAGERR		;Yes, page can't be created

	MOVSI	T1,(PA.GCD)	;Get virtual bit
	MOVEM	T1,VRTUAL	;Set for future calls
	JRST	CREPAG		;Go try again


;Here when too many recursive calls to EXTEND

TOODEP:	PUSHJ	P,F.TRC
	JRST	ABORT.

	$FERR (?,TRC,21,0,<Too many recursive calls to EXTEND>)

	SUBTTL	-  PAGE. UUO failure

;PAGERR - Come here to die when PAGE. fails


PAGERR:	MOVE	T1,PGERTB(T1)	;Translate the PAGE. error code
	PUSHJ	P,F.PGF		;Do the error
	JRST	ABORT.

	$FERR (?,PGF,21,0,<PAGE. UUO failure - $A>,<T1>)

PGERTB:	[ASCIZ/Function not implemented/] 		;0
	[ASCIZ/Illegal argument/]			;1
	[ASCIZ/Illegal page number/]			;2
	[ASCIZ/Page should not exist, but does/]	;3
	[ASCIZ/Page should exist, but does not/]	;4
	[ASCIZ/Page should be in core, but is not/]	;5
	[ASCIZ/Page should not be in core, but is/]	;6
	[ASCIZ/Page is in sharable high segment/] 	;7
	[ASCIZ@Paging I/O error@]			;10
	[ASCIZ/No swapping space available/]		;11
	[ASCIZ/Core limit exceeded/]			;12
	[ASCIZ/Function illegal if page locked/]	;13
	[ASCIZ/Cannot allocate 0 page with virtual limit 0/] ;14
	[ASCIZ/Not enough privileges/]			;15
	[ASCIZ/Section should not exist, but does/]	;16
	[ASCIZ/Section should exist, but does not/]	;17
	[ASCIZ/Illegal section/]			;20

	SUBTTL	ALLOC - Hide the uglyness of calling FUNCT. to get core

; ALLOC - subroutine to get section local heap space from FOROTS
; Call:
; FNARG2/	Number of words needed
;	PUSHJ	P,ALLOC
; Return: core is available
; FNARG1/	Address of allocated core

ALLOC:	PUSH	P,L		;Save our arg pointer
	PUSH	P,[FN%GOT]	;Get opcode for getting OTS heap space
	POP	P,FNOPC		;Save it in the arg block
	XMOVEI	L,FNARGL	;Point to the FUNCT. arg list
	PUSHJ	P,FUNCT.	; and call it
	POP	P,L		;Restore the old arg pointer

	SKIPN	FNSTS		;Did the FUNCT. win ?
	 POPJ	P,		;Yes, return to caller

	PUSHJ	P,F.NEC		;No, complain
	JRST	ABORT.		; and die

	$FERR (?,NEC,21,0,<Not enough OTS core for CALL EXTEND>)

	-FNARGN,,0
FNARGL:	IFIW	TP%INT,FNOPC	;Address of opcode
	IFIW	TP%LIT,[ASCII |EXT|] ; ?EXTxxx should be printed for errors
	IFIW	TP%INT,FNSTS	;Address of status variable
	IFIW	TP%INT,FNARG1	;First real argument
	IFIW	TP%INT,FNARG2	;Second real argument
	FNARGN==.-FNARGL

	SUBTTL	FREE - Hide the uglyness of calling FUNCT. to return core

; FREE - subroutine to return section local heap space to FOROTS
; Call:
; FNARG1/	Address of core being returned
; FNARG2/	Number of words being returned
;	PUSHJ	P,FREE
; Return: core has been deallocated

FREE:	PUSH	P,L		;Save our arg pointer
	PUSH	P,[FN%ROT]	;Get opcode for returning OTS heap space
	POP	P,FNOPC		;Save it in the arg block
	XMOVEI	L,FNARGL	;Point to the FUNCT. arg list
	PUSHJ	P,FUNCT.	; and call it
	POP	P,L		;Restore the old arg pointer

	SKIPN	FNSTS		;Did the FUNCT. win ?
	 POPJ	P,		;Yes, return to caller

	PUSHJ	P,F.CRC		;No, complain
	JRST	ABORT.		; and die

	$FERR (?,CRC,21,0,<Can't return OTS core after CALL EXTEND>)

> ; End of IF10

	END