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,) > ;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,) 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,) INIWRN: PUSHJ P,F.CEN ;Complain, FUNCT (EXTINI,<>) ; initialize JRST INIT ; and try again $FERR (%,CEN,21,0,) NERR: PUSHJ P,F.NNA ;Complain, JRST ABORT. ; and die $FERR (?,NNA,21,0,) RERR: PUSHJ P,F.MED ;Complain, JRST ABORT. ; and die $FERR (?,MED,21,0,) 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, ;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,) INEERR: PUSHJ P,F.INE ;Complain, JRST ABORT. ; and die $FERR (?,INE,21,0,) 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,) ; 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,) 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,,) 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,) -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,) > ; End of IF10 END