Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
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,7(3245)
SUBTTL CHRIS SMITH/CKS/DAW/JLC/BL/EGM/AHM
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1983
;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.
2052 EGM 27-Apr-82
Add routine to cut back core for the block structured (OTS) core area.
Cause %FREPGS to kill off pages returned for TOPS-10. Cause CREPGS for
TOPS-10 to kill off any pages obtained for an incomplete request.
Make KILPGS for TOPS-10 more forgiving of 'page non existent' errors.
2053 EGM 23-Apr-82
Improve paged core usage when getting additional pages by:
1. Trying to get specific pages contiguous with the start of
the block list, and
2. Considering any initial free block size when determining
the number of new pages to get.
Also preserve the saved PC when linking in a new free block.
***** Begin Version 7 *****
3021 JLC 10-Nov-81
Fix lowseg memory manager bug. %MVBLK was called incorrectly.
Done in V6 as part of edit 2033.
3026 JLC 24-Nov-81
Change FUNCT., ALCOR., and DECOR. to call %FSAVE instead of
%SAVE, to avoid argument copying.
3027 JLC 30-Nov-81
Fix overlay symbol table problem - we were marking the page(s)
where the symbol table resides as allocated. This is not necessarily
true. OVRLAY sometimes purposely uses the area around and in the
place where the symbol table was. This complex patch marks the
area between .JBFF and the symbol table as a free list entry,
and marks just the symbol table as allocated; then if a lowseg
memory request fails we add the symbol table to the free list
and try again.
3056 JLC 23-Mar-82
Remove calls to %FSAVE.
3122 JLC 28-May-82
Changed some global refs.
3125 JLC 3-Jun-82
Moved the AC save routine back to the hiseg.
3126 JLC 7-Jun-82
Fixed ALCOR., which was using AU.ACS with an indirect. Since
it can be a negative stack pntr, this didn't work too well.
3131 JLC 11-Jun-82
Install $SNH non-skip return after call to LSFREE in F.GADX,
was skipping over valuable instruction.
3134 AHM 22-Jun-82
Make the FUNCT% dispatch table contain IFIWs.
3135 AHM 24-Jun-82
Make %MEMINI compute global addresses for .JBFF and EOL, and
prevent BLTUP from trying to shift the free list by zero
words, since the POP dies in a non-zero section.
3136 JLC 26-Jun-82
Support for moving spaces (rather than nulls) into allocated
space. Integration of TSG cut-back-core patches.
3141 JLC 2-Jul-82
Reinsertion of symbol table into free list had too many bounds
checks. It now just blindly puts it back into the free list.
3176 JLC 9-Sep-82
Install disk quota exceeded trap in FOROTS. FUNCT% detects
whether the routine address is that of FOROTS, and allows user
to overwrite it.
3200 JLC 24-Sep-82
Install new routines %MRKBL and %UNMBL to mark the pages used
by layered products in the page table.
3202 JLC 26-Oct-82
Install code to mark pages allocated or free, and new FUNCT
calls to utilize it, for SORT and DBMS.
3203 JLC 31-Oct-82
Fix SPCWD problem.
3211 AHM 10-Nov-82
Fix alternate return for bad args in CHKPGA. Insert missing
AC field in SKIPN in F.GPSI. Speed up some other code.
3223 JLC 22-Nov-82
Kill pages on %FREPGS calls on both -10 and -20 so that
we can leave the "don't overlay pages" bit on for DBMS.
3224 AHM 22-Nov-82
Reverse the sense of a test in one of the premature
optimizations in edit 3211.
3226 JLC 29-Nov-82
Remove check for DBMS in MINILP.
3231 JLC 14-Dec-82
Use FENTRY for entry points for DBMS interface.
3233 AHM/JLC 14-Dec-82
Fix extended addressing bug at %FREPGS.
3236 JLC 17-Dec-82
Move setup of FUNCT in .JBBLT here.
3244 JLC 31-Dec-82
Moved setup of FUNCT back to FORINI after all.
3245 JLC 5-Jan-83
Use ENDP for end page of core.
***** End Revision History *****
\
SUBTTL OTS MEMORY MANAGER
INTERN %MEMINI,%FUNCX,%MRKPG,%UMKPG
INTERN %GTBLK,%FREBLK,%MVBLK,%GTSPC,%MVSPC
INTERN %GTPGS,%FREPGS
INTERN %LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB
EXTERN %POPJ,%POPJ1,%POPJ2,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVAC
EXTERN I.XSIR,%LEVTAB,%CHNTAB,%FCHTB
EXTERN I.RUNTM,AU.ACS
IF10,< EXTERN I.DEV,I.FILE,I.PPN >
EXTERN %ALCHF,%DECHF,%ABORT,%HALT
EXTERN Z.DATA,F.HSO
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
%GTSPC: SKIPA T2,SPCWD(D) ;GET A WORD OF SPACES
%GTBLK: SETZ T2, ;RETURN BLOCK WITH ZEROES
MOVEM T2,BLTWRD ;SET FILL WORD
CGTBLK: JUMPE T1,[$SNH] ;ZERO-LENGTH CALL IS A BUG
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: MOVE T2,BLTWRD ;SET 1ST WORD TO DESIRED QUANTITY
MOVEM T2,(T1)
MOVSI T2,(T1) ;MAKE BLT POINTER TO CLEAR BLOCK
HRRI T2,1(T1)
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,SAVEP,> ;[2053] ALLOCATE SPACE ON STACK
MOVEM T1,SAVET ;SAVE T1
HRRZ T2,BEGPTR ;[2053] Get beginning of list
SKIPN (T2) ;[2053] EOL?
JRST GBANYP ;[2053] Yes - Get any pages, mark initial hole
SKIPG (T2) ;[2053] Is first block free?
JRST GBSSIZ ;[2053] No - use same size
HLRZ T3,HSIZE(T2) ;[2053] Free block size
SUBI T1,HLEN(T3) ;[2053] Reduce words needed
GBSSIZ: DMOVEM P1,SAVEP ;[2053] Save P ACs
MOVEI P1,(T2) ;[2053] Free block address, always top of page
MOVEI P2,HLEN+777(T1) ;[2053] Size + header, rounded to page
LSHC P1,-^D9 ;[2053] Last page number + 1/no. of pages
SUBI P1,(P2) ;[2053] First page number
PUSHJ P,CREPGS ;[2053] Try to get prefered pages
JRST [DMOVE P1,SAVEP ;[2053] No luck, restore P ACs
MOVE T1,SAVET ;[2053] Get original size
JRST GBANYP] ;[2053] Get any pages, mark hole
MOVEI T1,(P1) ;[2053] Got them, get first page number
LSH T1,^D9 ;[2053] New free block address
HRRZ T4,BEGPTR ;[2053] First block contiguous with new one
SKIPL (T4) ;[2053] Is first block free?
HRRZ T4,HFLNK(T4) ;[2053] Yes - new core ends at successor
DMOVE P1,SAVEP ;[2053] Restore P ACs
JRST GBCONT ;[2053] Use prefered pages
GBANYP: MOVEI T1,2*HLEN+777(T1) ;[2053] ADD 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
;[2053]
GBHOLE: MOVEI T4,-HLEN(T2) ;MAKE HOLE LOOK LIKE PERMANENTLY ALLOCATED BLOCK
HRLI T3,400000 ;[2052] Unique hole marker for CBC function
MOVEM T3,HFLNK(T4) ;[2052] 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
HRRM T1,HBLNK(T4) ;[2053] 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)
%MVSPC: MOVE T4,SPCWD(D) ;GET A WORD OF SPACES
MOVEM T4,BLTWRD ;RETURN NEW BLOCK WITH SPACES
JRST CMVBLK ;JOIN COMMON CODE
%MVBLK: SETZM BLTWRD ;RETURN NEW BLOCK WITH ZEROES
CMVBLK: EXCH T1,T3 ;GET NEW LENGTH IN T1, OLD ADDR IN T3
MOVEM T1,NLEN ;SAVE NEW LENGTH FOR LATER
MOVEM T2,OLEN ;SAVE OLD LENGTH
MOVEM T3,OADR ;SAVE OLD ADDRESS
PUSHJ P,CGTBLK ;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
MOVE T1,OADR ;GET NEW ADDR FOR RETURN
MOVE T2,OLEN ;GET ADDR OF 1ST FREE WORD IN EXPANDED AREA
MOVE T3,NLEN ;GET NEW LENGTH
POPJ P, ;DONE
SEGMENT DATA
OADR: BLOCK 1 ;OLD ADDRESS OF DATA
OLEN: BLOCK 1 ;OLD LENGTH
NLEN: BLOCK 1 ;NEW LENGTH
BLTWRD: BLOCK 1 ;BLOCK INITIALIZATION VALUE
SEGMENT CODE
;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 ENDP FOR ENOUGH CONSECUTIVE PAGES.
TRYHRD: MOVEI P1,ENDP ;START AT THE END OF CORE
SUBI P1,-1(P2) ;FIND BASE PAGE # WE WANT
TRYLP2: MOVEI T1,(P1) ;COPY TEST PAGE BOTTOM
ADDI T1,-1(P2) ;GET TOP PAGE DESIRED
CAIG T1,STARTP ;REACH WHERE WE FAILED BEFORE?
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
SOJA 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
;MARK A BLOCK OF CORE ALLOCATED IN THE PAGE TABLE. THIS ROUTINE
;IS CALLED WHENEVER A SHARABLE SEGMENT OF A LAYERED PRODUCT
;IS LOADED VIA GET% (GETSEG) BY FOROTS. THIS SHOULD PROBABLY
;BE MADE A FUNCT. CALL EVENTUALLY.
;ARGS: T1 = LOW ADDRESS
; T2 = HIGH ADDRESS
%MRKPG: PUSHJ P,%SAVE4 ;SAVE P1-P4
DMOVE P1,T1 ;GET INTO THE CORRECT ACS
DMOVEM P1,SAVPGS ;SAVE PAGE #/COUNT
MOVEI T1,3 ;CHECK IF USED ALREADY
PUSHJ P,DOPGS ;MOVE THROUGH THE BIT MAP
TDNE T1,PTAB(T2) ;WITH THIS INSTRUCTION
POPJ P, ;ALLOCATED ALREADY - NON-SKIP RETURN
DMOVE P1,SAVPGS ;GET PAGE #/COUNT AGAIN
MOVEI T1,3 ;SET PAGE-ALLOCATED AND PAGE-EXIST
PUSHJ P,DOPGS ;MOVE THROUGH THE BIT MAP
IORM T1,PTAB(T2) ;WITH THIS INSTRUCTION
JRST %POPJ1 ;SKIP RETURN
;UNMARK A BLOCK OF CORE IN THE PAGE TABLE. WHEN A LAYERED PRODUCT
;DECIDES TO LEAVE (SUCH AS SORT), THE USER SHOULD BE ABLE TO GET
;THE PAGES USED BY IT.
%UMKPG: PUSHJ P,%SAVE4 ;SAVE P1-P4
DMOVE P1,T1 ;GET INTO THE CORRECT ACS
DMOVEM P1,SAVPGS ;SAVE THEM
MOVEI T1,1 ;CHECK IF THEY ARE INDEED ALLOCATED
PUSHJ P,DOPGS ;MOVE THROUGH BITMAP
TDNN T1,PTAB(T2) ;WITH THIS INSTRUCTION
POPJ P, ;NON-SKIP MEANS AT LEAST ONE WASN'T
MOVEI T1,3 ;NOW FREE THEM
PUSHJ P,DOPGS ;MOVE THROUGH BITMAP
ANDCAM T1,PTAB(T2) ;WITH THIS INSTRUCTION
JRST %POPJ1 ;SKIP RETURN
SEGMENT DATA
SAVPGS: BLOCK 2 ;PAGE #/COUNT
SEGMENT CODE
;ROUTINE TO FREE PAGES
;ARGS: T1 = FIRST PAGE
; T2 = NUMBER OF PAGES
;[2052] On Return, pages are marked free in bit map for TOPS-20,
;[2052] or have been removed and marked free/non existent for TOPS-10
%FREPGS:
PUSHJ P,%SAVE2 ;SAVE P1-P2
DMOVE P1,T1 ;PUT ARGS IN RIGHT ACS
ANDI P1,777 ;[3233] MAKE PAGE LOCAL
PJRST KILPGS ;[2052] Remove the pages and update bit map
;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
PJRST KILPGS ;[2052] Can't get them all, kill any created
TRNE P4,-2 ;IF ARG BLOCK IS NONEMPTY,
PUSHJ P,PGUUO ;DO FINAL UUO
JRST .+2 ;WORKED, FINE
PJRST KILPGS ;[2052] Can't get them all, kill any created
>
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 T3,[-PLEN,,1] ;[2052] GET AOBJN POINTER TO PAGE. BLOCK
KILLP0: MOVE T1,T3 ;[2052] Get working AOBJN pointer
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
JRST [CAIE T1,PAGME% ;[2052] Page does not exist?
;[2052] ERR (CDP,999,106,?,<Can't destroy page $O (PAGE. error $O)>,<T2,T1>)
$ECALL CDP,%ABORT ;[2052] No - some fatal error
HRRZ T1,PBLK ;[2052] Get number of pages
CAIN T1,1 ;[2052] Doing 1 page at a time?
JRST .+1 ;[2052] Yes - just continue loop
;[2052] Don't know which page had error
SUBI P1,(T1) ;[2052] Back to first page
ADDI P2,(T1) ;[2052] Reset count
MOVE T3,[-1,,1] ;[2052] Use single step AOBJN ptr.
JRST KILLP0] ;[2052] From this page on
JUMPG P2,KILLP0 ;[2052] 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
;[2052]Routine to trim block structured (OTS) core area
;[2052]No arguments
;[2052]
;[2052] Trim back the block structured core area by removing all free pages
;[2052] at the beginning of the list. Stop triming when an allocated block
;[2052] or EOL is found, or after having split a block such that there are
;[2052] no more free pages at the beginning of the list.
PGTRIM: STKVAR <NXTBLK> ;[2052] Place to save pointer to next block
HRRZ T1,BEGPTR ;[2052] Start with first block
PGTNXT: SKIPG T2,(T1) ;[2052] Is it free, and not EOL?
JRST PGTDON ;[2052] No - finished
HLRZ T3,HSIZE(T1) ;[2052] Get block size for later
HLRZ T4,(T2) ;[2052] Get allocated marker for next block
CAIE T4,400000 ;[2052] Is it a hole?
JRST PGTNHL ;[2052] No - just look at this block
ADDI T3,HLEN ;[2052] Yes - absorb its length
HRLM T3,HSIZE(T1) ;[2052] Into current block
HRRZ T2,HFLNK(T2) ;[2052] Get its successor
HRRM T2,HFLNK(T1) ;[2052] Link hole out of the
HRRM T1,HBLNK(T2) ;[2052] Block structure entirely
JRST PGTPGS ;[2052] Go release some pages
PGTNHL: MOVEI T4,HLEN(T3) ;[2052] Actual block size
CAIGE T4,^D512 ;[2052] Have at least a page?
JRST PGTDON ;[2052] No - nothing more to do
TRZ T4,777000 ;[2052] Excess words in next page
JUMPE T4,PGTNSU ;[2052] None - release some pages from 1 block
CAIG T4,HLEN ;[2052] Enough room for a block of 1 word?
ADDI T4,^D512 ;[2052] No - one less page to free
SUBI T3,(T4) ;[2052] Reduce current block size
JUMPLE T3,PGTDON ;[2052] If no words left forget it
HRLM T3,HSIZE(T1) ;[2052] Save new block size
ADDI T3,HLEN(T1) ;[2052] Excess block address
HRRZM T2,HFLNK(T3) ;[2052] Setup forward link
HRRM T1,HBLNK(T3) ;[2052] Back link
SUBI T4,HLEN ;[2052] Actual size
HRLM T4,HSIZE(T3) ;[2052] Save away
HRRM T3,HFLNK(T1) ;[2052] Update predecessor pointer
HRRM T3,HBLNK(T2) ;[2052] And successor back pointer
PGTNSU: SETZ T2, ;[2052] No successor block to consider
PGTPGS: HRRZM T2,NXTBLK ;[2052] Save next block address
HRRZ T3,HBLNK(T1) ;[2052] Get block predecessor
HRRZ T4,HFLNK(T1) ;[2052] And successor
HRRM T4,HFLNK(T3) ;[2052] Link pages out of
HRRM T3,HBLNK(T4) ;[2052] Block structure
CAMN T1,FREPTR ;[2052] Giving up first free block?
MOVEM T4,FREPTR ;[2052] Yes - advance to next block
HLRZ T2,HSIZE(T1) ;[2052] Get size of block to free
ADDI T2,HLEN ;[2052] Actual size
LSHC T1,-^D9 ;[2052] Page number/no. of pages
PUSHJ P,%FREPGS ;[2052] Free pages
SKIPE T1,NXTBLK ;[2052] Get next block to do if any
JRST PGTNXT ;[2052] Check further
PGTDON: UNSTK ;[2052] Free local storage
POPJ P, ;[2052] Done
;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
XMOVEI T1,.JBFF ;[3135] 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
XMOVEI T1,EOL ;[3135] 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
SETZM SYMFP ;CLEAR "BETWEEN .JBFF AND .JBSYM" PNTR
SKIPN .JBSYM ;SYMBOL TABLE?
JRST SETJFF ;NO
HRRZ T1,.JBSYM ;YES. GET ITS ADDR
CAMG T1,JOBFF ;HOLE BETWEEN JBFF AND JBSYM?
JRST MRKSYM ;NO. JUST START MINILP ABOVE TABLE
HRRZ T1,.JBSYM ;GET THE TABLE ADDR AGAIN
HRL T1,JOBFF ;GET FIRST FREE LOC IN HOLE
MOVEM T1,SYMFP ;SAVE FUTURE FREE LIST ENTRY
MRKSYM: HRRZ T1,.JBSYM ;GET SYMBOL TABLE PNTR AGAIN
HLRE T2,.JBSYM ;CALC TOP OF TABLE+1
SUB T1,T2 ;P1 NOW POINTS TO TOP OF SYMTAB+1
CAMLE T1,JOBFF ;IF GREATER THAN CURRENT .JBFF
MOVEM T1,JOBFF ;SAVE AS NEW .JBFF
HRL T1,.JBSYM ;CREATE A SYMBOL TABLE FREE LIST ENTRY
MOVEM T1,SYMTP ;TO USE IF A CORE REQUEST FAILS
SETJFF: 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: CAIG P1,ENDP ;HAVE WE HIT TOP OF OUR CORE?
JRST NOTTOP ;NO
SKIPN SYMFP ;ANY SPACE BETWEEN .JBFF AND .JBSYM?
POPJ P, ;NO
PUSHJ P,LSINIT ;YES. MUST MARK A FREE BLOCK
AOS FLLEN ;MAKE AN ENTRY
MOVE T1,SYMFP ;GET THE FREE LIST ENTRY
MOVEM T1,(P3) ;STORE IT
POPJ P,
NOTTOP: 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:
CAIG P1,Z.DATA/1000
CAIGE P1,F.HSO/1000 ;IS PAGE IN FOROTS?
JRST CHKDDT ;NO
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
REQBOT: BLOCK 1 ;BOTTOM OF CORE REQUEST
REQTOP: BLOCK 1 ;TOP+1 OF CORE REQUEST
SYMFP: BLOCK 1 ;SPACE BETWEEN .JBFF AND SYMTAB
SYMTP: BLOCK 1 ;BOTTOM,,TOP+1 OF SYMBOL TABLE
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 = PAGE ALLOCATED
; 10 = PAGE EXISTS (TOPS-10)
; OR IS USED (TOPS-20)
;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
JUMPL T2,BLTRET ;[3135] Don't try to do 0 POPs
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
FENTRY (ALCOR)
PUSHJ P,%SAVAC ;SAVE USER'S ACS
MOVE T1,@(L) ;GET NUMBER OF WORDS TO ALLOCATE
PUSHJ P,GTBLKX ;ALLOCATE A BLOCK
SETO T1, ;NONE AVAILABLE
MOVE T2,AU.ACS ;GET ADDR OF USER'S ACS
MOVEM T1,(T2) ;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
FENTRY (DECOR)
PUSHJ P,%SAVAC ;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: IFIW F.ILL ;0 ILLEGAL
IFIW F.GAD ;1 GET LS MEMORY AT ADDRESS
IFIW F.COR ;2 GET LS MEMORY ANYWHERE
IFIW F.RAD ;3 RETURN LS MEMORY
IFIW F.GCH ;4 GET I/O CHANNEL
IFIW F.RCH ;5 RETURN I/O CHANNEL
IFIW F.GOT ;6 GET OTS MEMORY
IFIW F.ROT ;7 RETURN OTS MEMORY
IFIW F.RNT ;10 GET INITIAL RUNTIME
IFIW F.IFS ;11 GET INITIAL RUN FILESPEC
IFIW F.CBC ;12 CUT BACK LS TO MINIMUM
IFIW F.RRS ;13 READ RETAIN STATUS (DBMS)
IFIW F.WRS ;14 WRITE RETAIN STATUS (DBMS)
IFIW F.GPG ;15 GET PAGES
IFIW F.RPG ;16 RETURN PAGES
IFIW F.GPSI ;17 GET TOPS-20 PSI CHANNEL
IFIW F.RPSI ;20 RETURN TOPS-20 PSI CHANNEL
IFIW F.MPG ;21 SET PAGES USED
IFIW F.UPG ;22 SET PAGES FREE
IFIW F.USD ;23 GET # PAGES USED
IFIW F.MAP ;24 GET CORE BITMAP
LDISP==.-FDISP-1 ;MAX LEGAL FUNCTION CODE
;HERE IT IS
FENTRY (FUNCT)
FUNCT: PUSHJ P,%SAVAC ;SAVE USER'S ACS
%FUNCX: 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
DMOVEM T1,REQBOT ;SAVE BOTTOM, TOP+1 OF REQUEST
PUSHJ P,LSGET ;ALLOCATE THE CORE
JRST ERR1 ;NOT ENOUGH MEMORY
JRST TRYSYM ;ALREADY ALLOCATED. SEE IF SYMBOL TABLE
JRST OKRET ;ALLOCATED
;HERE IF F.GAD CALL FAILS WITH CORE ALREADY ALLOCATED.
;IF THE TOP OF THE CORE REQUEST IS WITHIN THE BOUNDS OF THE
;ORIGINAL SYMBOL TABLE, RECORDED AS ALLOCATED, THE SYMBOL
;TABLE IS INSERTED INTO THE FREE-CORE LIST. IT IS ASSUMED
;THAT THE USER (OR OVRLAY) KNOWS WHAT HE/SHE/IT IS DOING...
TRYSYM: SKIPN SYMTP ;ANY OLD SYMBOL TABLE?
JRST ERR2 ;NO
SKIPE FLLEN ;ANY ENTRIES IN FREE-LIST YET?
JRST INSSYM ;YES. GO INSERT THE SYMTAB ENTRY
PUSHJ P,LSINIT ;NO. CREATE A FREE LIST
AOS FLLEN ;INCR # ENTRIES
MOVE T1,SYMTP ;GET THE SYMBOL TABLE ENTRY
MOVEM T1,(P3) ;DROP IT INTO THE FREE LIST
JRST GADAGN ;GO TRY AGAIN
INSSYM: HLRZ T1,SYMTP ;GET BOTTOM OF OLD SYMBOL TABLE
HRRZ T2,SYMTP ;GET TOP+1 OF OLD SYMBOL TABLE
PUSHJ P,LSFREE ;PUT THE SYMBOL TABLE IN THE FREE-LIST
$SNH ;BETTER BE A FREE-LIST!
GADAGN: SETZM SYMTP ;DON'T TRY THIS AGAIN
DMOVE T1,REQBOT ;GET THE ORIGINAL CORE REQUEST PARAMS
PUSHJ P,LSGET ;TRY TO GET IT
JRST ERR1 ;MEMORY FULL
JRST ERR2 ;ALREADY ALLOCATED
JRST OKRET ;GOT IT!
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,%ALCHF ;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,%DECHF ;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
;
;[2052] Returns status 0 always, with low seg and OTS core shrunk if possible
F.CBC: PUSHJ P,LSTRIM ;TRIM LS SIZE, IF POSSIBLE
PUSHJ P,PGTRIM ;[2052] Trim OTS core 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). IF FOROTS WAS THE PREVIOUS OWNER OF
;THE CHANNEL (BY EVIDENCE OF THE %FCHTB ENTRY BEING IDENTICAL
;TO THE %CHNTAB ENTRY), IT IS NOT CONSIDERED AN ERROR CONDITION.
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
SKIPN T2,%CHNTAB(T1) ;[3211] CHANNEL IN USE?
JRST GPNIU ;NO. OK
CAME T2,%FCHTB(T1) ;WAS FOROTS USING IT?
JRST ERR1 ;NO. GENUINE ERROR
GPNIU: SKIPLE T2,@ARG2(L) ;GET PSI LEVEL
CAILE T2,3 ;RANGE CHECK
JRST ERR3 ;BAD
MOVE T3,@ARG3(L) ;GET ADDRESS
MOVEI T4,-1 ;ASSUME 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
MOVEM T1,@ARG1(L) ;RETURN CHANNEL TO USER
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
;FUNCTION 21: MARK PAGES USED IN BITMAP
;
;ARG1: 1ST PAGE NUMBER, IN RANGE [0:777]
;ARG2: NUMBER OF PAGES, IN RANGE [1:777]
;(ALSO, ARG1+ARG2 MUST BE IN RANGE[1:1000])
;
;RETURNS STATUS 0 IF OK
; 1 IF ONE OR MORE PAGES ALREADY MARKED ALLOCATED
; 3 IF ARGUMENT ERROR
;
F.MPG: PUSHJ P,CHKPGA ;CHECK PAGE ARGS
JRST ERR3 ;[3211] Invalid args, punt
PUSHJ P,%MRKPG ;MARK THE PAGES USED
JRST ERR1 ;AT LEAST ONE PAGE ALREADY IN USE
JRST OKRET ;MARKED
;FUNCTION 22: MARK PAGES FREE IN BITMAP
;
;ARG1: 1ST PAGE NUMBER, IN RANGE [0:777]
;ARG2: NUMBER OF PAGES, IN RANGE [1:777]
;(ALSO, ARG1+ARG2 MUST BE IN RANGE[1:1000])
;
;RETURNS STATUS 0 IF OK
; 1 IF ONE OR MORE PAGES ALREADY MARKED FREE
; 3 IF ARGUMENT ERROR
;
F.UPG: PUSHJ P,CHKPGA ;CHECK PAGE ARGUMENTS
JRST ERR3 ;[3211] Invalid args, punt
PUSHJ P,%UMKPG ;MARK PAGES FREE
JRST ERR1 ;AT LEAST ONE WAS ALREADY FREE
JRST OKRET ;ALL MARKED FREE
CHKPGA: SKIPL T1,@ARG1(L) ;[3211] GET PAGE #
CAILE T1,777 ;[3211] MUST BE A LOCAL PAGE ADDR
POPJ P, ;[3211] BAD CALL
SKIPG T2,@ARG2(L) ;[3224] GET # PAGES
POPJ P, ;[3211] BAD CALL
MOVE T3,T1 ;CHECK TOTAL
ADD T3,T2 ;[3211] COMPUTE TOP+1
CAILE T3,1000 ;[3211] TOP PAGE+1 MUST BE IN RANGE [1:1000]
POPJ P, ;[3211] BAD CALL
JRST %POPJ1 ;[3211] All OK, give skip return
;FUNCTION 23 - RETURN USED CORE INFO - NOT IMPLEMENTED
;RETURNS STATUS 3 FOR NOW
F.USD: JRST ERR3
;FUNCTION 24 - RETURN MEMORY BITMAP - NOT IMPLEMENTED
;RETURNS STATUS 3 FOR NOW
F.MAP: JRST ERR3
;EXIT ROUTINES
OKRET: SETZM @STATUS(L) ;NORMAL RETURN
POPJ P,
ERR1: MOVEI T1,1 ;ERROR RETURN 1
MOVEM T1,@STATUS(L)
POPJ P,
ERR2: MOVEI T1,2 ;ERROR RETURN 2
MOVEM T1,@STATUS(L)
POPJ P,
ERR3: MOVEI T1,3 ;ERROR RETURN 3
MOVEM T1,@STATUS(L)
POPJ P,
SEGMENT DATA
DTEMP: BLOCK 2 ;TEMP DOUBLEWORD
PURGE $SEG$
END