Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
formem.mac
There are 11 other files named formem.mac in the archive. Click here to see a list.
SEARCH MTHPRM,FORPRM
TV FORMEM MEMORY MANAGEMENT,10(4237)
SUBTTL CHRIS SMITH/CKS/DAW/JLC/BL/EGM/AHM/PLB
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
;
;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 V7 Development *****
3330 TGS 6-Jul-83 SPR:10-33967
In order to preserve the user symbol table in case of overlays,
FORMEM resets .JBFF above .JBSYM(rh). It does not consider the
case of a program loaded /SYMSEG:HIGH.
3333 TGS 22-Jul-83 SPR:NONE
Allow Edit 3330 to handle the /OTS:NONSHARE case where there is
no hiseg (.JBHRL=0)
3345 MRB 29-Aug-83 SPR:10-34134
The code at CHKPFH: munges the registers before calling INUSCK.
3441 TGS 7-Sep-84 SPR:20-20332
%MRKPG/%UMKPG use the wrong instruction in their calls to DOPGS when
testing whether any page within the range is already allocated or
non-allocated. Since the instruction skips on the first non-allocated
or allocated page, the full range may never be tested.
3442 TGS 17-Sep-84 SPR:20-20357
Check if DDT is in core at memory initialization time. If it is,
leave pages above 763 marked as unavailable, as is done now. If
no DDT, mark ENDP:777 (TOPS20 only) as available. This allows
TOPMEM calls above original ENDP to be honored if DDT is absent.
(Edit 4200 in V10)
BEGIN V10
4017 PLB 23-Jun-83
Make Lowseg memory manager (LSGET/LSFREE) return/take
global addresses. Lowseg memory comes from FOROTS' section.
4023 JLC 29-Jun-83
Use F.TOP and F.BOT as the bottom and top of FOROTS,
both set to zero for /OTS:NONSHARE, set in the CCL
file for OTS:SHARE.
4035 JLC 22-Jul-83
Create local AC save routine for
FUNCT., since it can be called from within an I/O
statement which does dynamic concatenation.
4044 JLC 19-Sep-83
Added new variables to keep track of the number of blocks
and pages allocated, for debugging purposes.
4050 JLC 6-Oct-83
Changed deallocation error reporting. Fixed MINILP so
it avoids the bug-halt at KILPGS.
4065 JLC 6-Dec-83
Make STARTP and ENDP into variables %STRTP and %ENDP.
4105 JLC 28-Feb-84
Modify the calling sequence for error calls.
4111 JLC 16-Mar-84
Modify the calling sequence for error calls again.
4120 PLB 26-Apr-84
Modify %MEMINI to use PDVs for initial memory map.
4122 JLC 2-May-84
Destroy pages on restart for TOPS-20.
4131 JLC 12-Jun-84
Modify %GTBLK, %GTSPC, %MVBLK, and %MVSPC so that they have
non-skip error returns, so that proper diagnostics can be
given for memory full.
4152 JLC 24-Sep-84
Add code in PDV checking to fill in .JBSYM with IOWD-format
symbol table pointer if the symbol table is in the same section,
or symbol vector if not in the same section.
4156 JLC 25-Oct-84
Fix day-one problem in F.COR: if the request crossed into
section 1, the code truncated it to a halfword; it now
gives an error (not enough memory available).
4170 JLC 20-Nov-84
Fix another day-one problem in TRYHRD: stop counting down when
the bottom page is zero.
4174 JLC 9-Jan-85
Always mark page 0 as used and allocated, since we do not
want to give it to the memory manager to allocate, and
LINK does not mark it used for extended addressing programs.
4175 JLC 15-Jan-85
Fix F.GAD, F.RAD, and F.ROT to accept address arguments
with section numbers, as long as it is the same section
as FOROTS.
4200 TGS 28-Jan-85
Implement V7 edit 3442: Initialize ENDP/%ENDP to 777. In section
0, set %ENDP for MINILP to 763 if DDT is in core; if not, leave
at 777. For non-zero sections, simply set page 777 as unavailable,
unless old UDDT is in core.
(Modules FORPRM, FORMEM)
4202 JLC 15-Feb-84
Move ALCHN. and DECHN. to here, so that a local SAVAC routine
can be called instead of %SAVAC (which turns on %UDBAD, and
nobody was turning it off). Fix DOPDVS so that it unmaps
unallocated pages.
4203 JLC 13-Mar-85
Use FMACS, the local saved AC0, and not @AU.ACS.
4205 JLC 29-Mar-85
Fix a bug in the page-marking algorithm, and expand
the PDV scan to all PDVs.
***** End V10 Development *****
4237 MRB 30-DEC-85 SPR:20-20995
Cant use ddt with extended programs on 5.1 systems.
There is 1000(8) pages in a section. Rouine DOPDVS.
***** End Revision History *****
\
SUBTTL OTS MEMORY MANAGER
INTERN %MEMINI,%FUNCX,%MRKPG,%UMKPG,%ALCHF,%DECHF
INTERN %GTBLK,%FREBLK,%MVBLK,%GTSPC,%MVSPC
INTERN %GTPGS,%FREPGS
INTERN %LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB,%JBASE
INTERN %STRTP,%ENDP
EXTERN %POPJ,%POPJ1,%POPJ2,%SAVE1,%SAVE2,%SAVE3,%SAVE4
EXTERN I.XSIR,%LEVTAB,%CHNTAB,%FCHTB,%BLCNT,%PGCNT,%CHMSK
EXTERN I.RUNTM,%FSECT,%SVCNV
IF10,< EXTERN I.DEV,I.FILE,I.PPN >
EXTERN %ABORT,%HALT
EXTERN F.BOT,F.TOP
EXTERN %ABFLG
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 %ENDP 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
POPJ P, ;[4131] MEMORY FULL
MOVE T2,(P) ;GET RETURN ADDRESS OFF STACK
HRLM T2,-1(T1) ;STORE IN BLOCK HEADER FOR DEBUGGING
JRST %POPJ1 ;[4131] SKIP RETURN
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
AOS %BLCNT ;INCREMENT # BLOCKS ALLOCATED
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)
%FREBL: SKIPE %ABFLG ;ABORTING?
POPJ P, ;YES. DO NOT DEALLOCATE CORE
CAIN T1,0 ;BAD CALL IF ARG=0
$ECALL IEM,%ABORT ;REPORT ERROR
SOSGE %BLCNT ;DECREMENT COUNT OF BLOCKS ALLOCATED
$ECALL IEM,%ABORT ;DEALLOCATED MORE THAN WE ALLOCATED!
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?
$ECALL IEM,%ABORT ;No, error
HRRZ T4,HBLNK(T3) ;GET BACK LINK OF SUCCESSOR
CAIE T4,-HLEN(T1) ;CHECK IT
$ECALL IEM,%ABORT ;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
$SNH ;NEGATIVE FREE BLOCK SIZE!
;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
POPJ P, ;[4131] CAN'T. NON-SKIP RETURN
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
JRST %POPJ1 ;[4131] SKIP RETURN FOR SUCCESS
SEGMENT DATA
%STRTP: BLOCK 1 ;START PAGE FOR TOP OF MEMORY
%ENDP: BLOCK 1 ;LAST-DITCH TOP OF MEMORY
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
MOVE P1,%STRTP ;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: MOVE 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
CAMG T1,%STRTP ;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
SOJGE P1,TRYLP2 ;[4170] SOME PAGE ALLOCATED, TRY AGAIN
POPJ P, ;[4170] DON'T GO BELOW PAGE 0, HOWEVER
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.
;[3441] ARGS: T1 = STARTING PAGE
;[3441] T2 = NUMBER OF PAGES
%MRKPG: PUSHJ P,%SAVE4 ;SAVE P1-P4
DMOVE P1,T1 ;GET INTO THE CORRECT ACS
;[3441]
MOVEI T1,3 ;CHECK IF USED ALREADY
PUSHJ P,DOPGS ;MOVE THROUGH THE BIT MAP
TDNN T1,PTAB(T2) ;[3441] WITH THIS INSTRUCTION
TRNA ;[3441] NONE ALLOCATED IN RANGE, OK
POPJ P, ;[3441] AT LEAST ONE ALLOCATED, ERROR
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
MOVEI T1,1 ;CHECK IF THEY ARE INDEED ALLOCATED
PUSHJ P,DOPGS ;MOVE THROUGH BITMAP
TDNE T1,PTAB(T2) ;[3441] WITH THIS INSTRUCTION
TRNA ;[3441] ALL ALLOCATED, OK
POPJ P, ;[3441] 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
;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
ADDM P2,%PGCNT ;INCREMENT ALLOCATED PAGE COUNT
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: MOVN T1,P2 ;GET NEGATIVE # PAGES TO DESTROY
ADDB T1,%PGCNT ;DECREMENT ALLOCATED PAGE COUNT
JUMPGE T1,KILPGX ;OK
$ECALL PGD,%ABORT ;TRYING TO DEALLOCATE MORE THAN ALLOCATED
KILPGX:
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.
;[4120] DELETION OCCURS ONLY UNDER TOP-10
;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
SETZM VRTBIT ;START BY TRYING FOR PHYSICAL PAGES
SKIPN .JBCOR ;[4120] DO WE HAVE A LINK CREATED LOCAL JOBDAT?
PJRST DOPDVS ;[4120] NO, MUST SCAN FOR PDVS
MOVE T1,[252525,,252525] ;INIT TO '010101....010101'
MOVEM T1,PTAB ;PAGE BIT TABLE = ALL UAVAILABLE & NONEXISTENT
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 T2,.JBHRL ;[3330] GET HIGHSEG BREAK
JUMPE T2,MRKHOL ;[3333] NO HISEG?
HLRZ T1,.JBHRL ;[3330] GET SEG SIZE
SUBI T2,-1(T1) ;[3330] T2/ BEGINNING OF HISEG
ANDI T2,777000 ;[3330] ROUNDED DOWN TO PAGE BOUNDARY
HRRZ T1,.JBSYM ;GET THE TABLE ADDR AGAIN
CAML T1,T2 ;[3330] IS IT IN THE HISEG?
JRST SETJFF ;[3330] YES, DON'T POINT .JBFF INTO HISEG
MRKHOL: HRL T1,JOBFF ;[3333] 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
MOVEM P1,%JBASE ;SAVE FOR MEMORY MANAGER DEBUGGER
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 %ENDP, 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.
PUSHJ P,DDTCHK ;[4200] CHECK IF DDT IS IN CORE AND SET %ENDP
MINILP: CAMG P1,%ENDP ;[4200] 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:
CAIGE P1,F.TOP/1000
CAIGE P1,F.BOT/1000 ;IS PAGE IN FOROTS?
JRST CHKDDT ;NO
AOJA P1,MINILP ;YES, LEAVE IT
CHKDDT: HRRZ T1,JOBDDT ;[4200] DDT ADDR
JUMPE T1,CHKPFH ;NO DDT. GO CHECK PFH
HLRZ T2,JOBDDT ;[4200] HIGH ADDR
PUSHJ P,INUSCK ;PAGE IN DDT?
AOJA P1,MINILP ;YES, LEAVE IT
CHKPFH: HRRZ T1,.JBPFH ;[3345]FIRST PFH ADDR
JUMPE T1,PAGOK ;[3345]NO PFH IF ZERO
HLRZ T2,.JBPFH ;[3345]LAST PFH ADDR
PUSHJ P,INUSCK ;PAGE IN PFH?
AOJA P1,MINILP ;YES, LEAVE IT
PAGOK: MOVEI P2,1 ;SET LENGTH OF 1 PAGE
MOVEI T1,(P1) ;COPY PAGE NUMBER FOR CHKNEX
PUSHJ P,CHKNEX ;SEE IF PAGE EXISTS
PUSHJ P,KILPGX ;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
;DDTCHK
;[4200] ROUTINE TO CHECK IF DDT IS IN CORE
; PURPOSE: TO DETERMINE WHETHER MINILP SHOULD LEAVE DDT PAGES IN-
; VIOLATE (I.E. UNAVAILABLE AND NONEXISTENT) OR AVAILABLE IN THE BITMAP,
; DEPENDING ON WHETHER DDT IS PART OF THE CORE IMAGE. IT SETS %ENDP
; (MINILP LOOP LIMIT) AND A FAKE JOBDDT.
; ON TOPS10, THIS ROUTINE SIMPLY SETS UP JOBDDT WITH .JBDDT FOR USE BY
; CHKDDT.
; ON TOPS20, WE CHECK IF DDT IS IN CORE. IF IT IS NOT, LEAVE %ENDP AT 777
; AND RETURN. IF DDT IS MAPPED, SETUP JOBDDT FOR CHKDDT WITH TOP,,START
; ADDRESSES OF DDT AND SET %ENDP TO 763 (I.E. LEAVE DDT INVIOLATE)
IF10,< ;[4200] Created this routine
DDTCHK: MOVE T1,.JBDDT ;IF10, JUST SET JOBDDT TO .JBDDT
MOVEM T1,JOBDDT
POPJ P, ;AND RETURN
>;END IF10
IF20,< ;[4200] Created this routine
DDTCHK: SETZM JOBDDT ;ASSUME DDT ABSENT
PUSHJ P,DDTINC ;SEE IF DDT IS REALLY THERE
POPJ P, ;NO DDT, LEAVE %ENDP AT TOP OF CORE
MOVEI T1,763 ;DDT IS THERE, SET TOP OF RANGE TO
MOVEM T1,%ENDP ; 763, NOT TOP OF CORE
MOVE T1,[777000,,764000] ;AND SET JOBDDT TO DDT RANGE
MOVEM T1,JOBDDT
POPJ P, ;RETURN
>;END IF20
;[4200] ROUTINE TO CHECK IF DDT'S ENTRY VECTOR IS PRESENT
; RETURNS +1 IF DDT IS NOT IN CORE
; RETURNS +2 IF DDT IS PRESENT
IF20,< ;[4200] Created this routine
DDTINC: MOVE T1,[.FHSLF,,770] ;SEE IF DDT'S PAGE EXISTS
RPACS% ;GET ACCESS BITS FOR THE PAGE
TXNN T2,PA%PEX ;DOES IT EXIST?
POPJ P, ;NO, NO DDT
MOVE T1,770000 ;YES, SEE IF IT LOOKS LIKE DDT
CAME T1,[JRST 770002] ;SAME BIRTHMARK?
POPJ P, ;NO, NO DDT
JRST %POPJ1 ;YES, SKIP RETURN
>;END IF20
SUBTTL DOPDVS - Process PDVs to set up PTAB and JOBDAT
;++
; FUNCTIONAL DESCRIPTION:
;
; New in 4120 /PLB
;
; The PDV scan works as following: The memory bit map PTAB in
; intialized to all available. Then all PDVs located within the
; current (FOROTS) section are stepped through. If the .PVMEM
; pointer is present, then we scan all subtables, marking all
; pages indicated in the current section as allocated in PTAB.
; Lastly we scan upwards through PTAB looking for the first
; suitable unused page. Local JOBDAT locations .JBFF, .JBREL,
; and .JBSA<LH> will be set up pointing to this page.
;
; CALLING SEQUENCE:
;
; PUSHJ P,DOPDVS
; (ONLY CALL IS A PJRST FROM %MEMINI)
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; PDVs in current section
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; Sets up PTAB, the memory bitmap, as well as .JBFF, .JBREL,
; and .JBSA<LH> of the section local JOBDAT for use by FOROTS.
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Yes
;
;--
IF10,<
DOPDVS: POPJ P, ;DOES NOTHING ON TOPS-10
> ;END IF10
IF20,<
DOPDVS: SETZM PTAB ;[4200] CLEAR BIT TABLE
MOVE T1,[PTAB,,PTAB+1] ;[4200]
BLT T1,PTAB+^D28 ;[4200]
MOVEI T1,1 ;[4174] BUT EXCLUDE PAGE 0 NO MATTER WHAT
IORM T1,PTAB ;[4174] BECAUSE ALLOCATING PAGE 0 IS A BIG MISTAKE!
SETZM PDVCNT ;NO PDVS SEEN YET
SETZM PDVTTL ;NO TOTAL YET
MOVSI T1,1 ;[4205] START IN SECTION 1
MOVEM T1,PDVBLK+.POADR ;[4205] FOR PDV SEARCH
HRLOI T1,777 ;[4205] END IN SECTION 777
MOVEM T1,PDVBLK+.POADE ;[4205]
XMOVEI T1,. ;[4205] GET SECTION,,.
HLLZM T1,LOWADR ;[4205] SAVE LOWEST ADDR IN THIS SECTION
HLLOM T1,HIADR ;[4205] AND HIGHEST ADDR IN THIS SECTION
PDVGET: MOVEI T1,.POADE+1 ;GET PDVOP% ARG BLOCK LENGTH
MOVEI T2,.FHSLF ;AND FORK HANDLE (US)
DMOVEM T1,PDVBLK+.POCT1 ;STORE
MOVEI T1,MAXPDV ;GET LENGTH
XMOVEI T2,PDVA ;AND ADDR OF PDVA BLOCK
DMOVEM T1,PDVBLK+.POCT2 ;STORE
MOVEI T1,.POGET ;FUNCTION TO GET PDVA'S
XMOVEI T2,PDVBLK ;GET BLOCK ADDR
PDVOP% ;GO FISH
ERJMP NOMORE ;FAILED, END OF THE LINE
HRRZ P4,PDVBLK+.POCT2 ;GET NUMBER RETURNED
JUMPE P4,NOMORE ;GET ANY?
HLRZ T1,PDVBLK+.POCT2 ;GET NUMBER EXISTING
SKIPN PDVTTL ;SEEN THE TOTAL YET?
MOVEM T1,PDVTTL ;STORE AS TOTAL
MOVN P4,P4 ;GET -COUNT OF PDVS
MOVSI P4,(P4) ;GET -COUNT,,0
PDVCHK: MOVE P2,PDVA(P4) ;GET PDV -- TOP OF PDV LOOP
MOVE T2,.PVCNT(P2) ;GET COUNT OF WORDS IN PDV
CAIGE T2,.PVMEM+1 ;LONG ENOUGH FOR US?
JRST NXTPDV ;NOPE.
SKIPG .PVSYM(P2) ;DOES IT HAVE A GLOBAL SYMBOL VECTOR ADDRESS?
JRST PDVNS ;NO. SKIP IT FOR .JBSYM
XMOVEI T1,@.PVSYM(P2) ;YES. GET ITS GLOBAL ADDRESS
MOVEM T1,.JBSYM ;SAVE FOR FORERR AND FORDDT
PUSHJ P,%SVCNV ;CONVERT TO ADDRESS AND LENGTH
HLLZ T0,T1 ;GET JUST SECTION NUMBER
CAMN T0,%FSECT ;SAME AS THIS SECTION?
CAILE T2,777000 ;AND IS SYMBOL TABLE .LE. 511 PAGES?
JRST PDVNS ;NO
MOVNI T2,(T2) ;YES. MAKE LENGTH NEGATIVE
HRLI T1,(T2) ;MAKE IT AN IOWD
MOVEM T1,.JBSYM ;SAVE IT AGAIN
PDVNS: XMOVEI P3,@.PVNAM(P2) ;GET ADDRESS OF NAME STRING
$BLDBP P3 ;MAKE ME A BP!
MOVE T1,P3 ;GET COPY OF BP
HRROI T2,[ASCIZ 'FOROTS%'] ;GET OFFICIAL NAME
STCMP ;COMPARE STRINGS
JUMPE T1,NXTPDV ;A PERFECT MATCH! - IGNORE THIS PDV
MOVE T1,P3 ;GET BP AGAIN
HRROI T2,[ASCIZ 'FOROTS'] ;GET LESS OFFICIAL NAME
STCMP ;COMPARE AGAIN
JUMPE T1,NXTPDV ;LOOKS LIKE FOROTS... IGNORE
;SINCE THE LOW SEG INFO IS WRONG
XMOVEI P3,@.PVMEM(P2) ;GET MEMORY BLOCK ADDR
JUMPE P3,NXTPDV ;NONE
MOVN T2,.PMCNT(P3) ;GET -BLOCK COUNT
AOJE T2,NXTPDV ;REMOVE COUNT WORD
MOVEM T2,MEMCNT ;STORE WORDS LEFT
ADDI P3,1 ;POINT TO FIRST SUB-TABLE
MEMLOP: XMOVEI P1,@.PMLOW(P3) ;GET LOW ADDR
CAMN P1,[1,,0] ;[4205] WAS IT AN IFIW 0?
HLL P1,P3 ;[4205] YES. GET PDV SECTION
CAMLE P1,HIADR ;[4205] COMPARE TO OUR HIGH
JRST NXTBLK ; WHOLE BLOCK IS ABOVE US
CAMGE P1,LOWADR ;COMPARE TO OUR LOW
MOVE P1,LOWADR ; TAKE LARGER OF THE TWO
XMOVEI P2,@.PMHI(P3) ;GET HI ADDR
CAMGE P2,LOWADR ;COMPARE TO LOW RANGE
JRST NXTBLK ; WHOLE BLOCK IS BELOW US
CAMLE P2,HIADR ;[4205] COMPARE TO HIGH LIMIT
MOVE P2,HIADR ;[4205] TAKE SMALLER OF THE TWO
;; NOTE THAT WE ROUND THE WORD ADDRESS TO PAGE ADDRESSES
;; IT IS POSSIBLE TO ADD THE UNUSED FRAGMENT TO THE FREE-LIST.
MOVEI P1,(P1) ;GET LOCAL ADDR
LSH P1,-^D9 ;GET LOW PAGE
MOVEI P2,(P2) ;GET LOCAL ADDR
LSH P2,-^D9 ;GET HIGH PAGE
SUBI P2,(P1) ;[4205] GET PAGE COUNT
ADDI P2,1 ;[4205]
MOVEI T1,3 ;BIT PATTERN (EXISTS + ALLOCATED)
PUSHJ P,DOPGS ;CALL BIT MAP HACKER
IORM T1,PTAB(T2) ;MARK AS IN USE
NXTBLK: HRRZ T1,.PMDAT(P3) ;GET CURRENT SUBTABLE LENGTH
ADDI P3,(T1) ;BUMP SUBTABLE POINTER BY THAT MUCH
ADDB T1,MEMCNT ;INCREMENT WORDS SEEN BY THAT MUCH
JUMPL T1,MEMLOP ;STILL MORE WORDS? LOOP.
NXTPDV: AOS T1,PDVCNT ;SAY WE HAVE SEEN ONE MORE PDV
AOBJN P4,PDVCHK ;LOOP FOR NEXT PDV
; NO MORE PDVAs IN THIS BATCH, DO WE NEED TO DO ANOTHER PDVOP%???
; I DON'T KNOW HOW YOU GOT THAT MANY PDV'S BUT IT WAS
; EASY ENOUGH TO ADD THE CODE TO DO IT RIGHT.
CAML T1,PDVTTL ;MORE TO GO?
JRST NOMORE ;NOPE.. SEEN IT ALL
MOVE T1,PDVA+MAXPDV-1 ;GET LAST PDVA
ADDI T1,1 ;GET LAST PDVA+1
MOVEM T1,PDVBLK+.POADR ;STORE AS LOW ADDRESS
JRST PDVGET ;GO LOOK FOR MORE
; HERE WHEN NO MORE PDV'S ARE TO BE FOUND; MARK PAGES USED BY DDT
NOMORE: PUSHJ P,DDTCHK ;[4200] SET %ENDP FOR UDDT
MOVE P1,%ENDP ;[4200] GET TOP OF CORE
MOVEI P2,1000 ;[4237] Get total pages in section.
SUB P2,P1 ;[4200] IN P2
SKIPN P2 ;[4200] BUT MARK AT LEAST ONE
MOVEI P2,1 ;[4200]
MOVEI T1,3 ;GET BITS (EXISTS + ALLOCATED)
PUSHJ P,DOPGS ;HACK THE BITMAP
IORM T1,PTAB(T2) ;INSTRUCTION TO SET BITS
; MARK FOROTS PAGES
MOVEI P1,F.BOT/1000 ;GET FOROTS START PAGE
JUMPE P1,DOSEAR ;ZERO? MUST BE NONSHARE
MOVEI P2,<<F.TOP-F.BOT>/1000> ;GET LENGTH
MOVEI T1,3 ;GET BITS (EXISTS + ALLOCATED)
PUSHJ P,DOPGS ;HACK THE BITMAP
IORM T1,PTAB(T2) ;INSTRUCTION TO SET BITS
;NOW SEARCH FOR THE FIRST FREE GAP, AND SET UP LOCAL JOBDAT
DOSEAR: MOVEI P1,1 ;START AT PAGE 1
;;; MOVEI P2,1 ;GAP NEED ONLY BE ONE PAGE LONG
MOVEI P2,2 ;EXPERIMENT: REQUIRE GAP TO BE 2 PAGES
MOVEI P3,F.BOT/1000 ;GET BOTTOM OF FOROTS
JUMPN P3,SRCLOP ;OK?
MOVEI P3,ENDP ;NO, MUST BE NONSHARE: SEARCH ALL
SRCLOP: CAIL P1,(P3) ;ARE WE AT END OF ROPE?
$ECALL MFU,%ABORT ; MEMORY FULL
MOVEI T1,1 ;GET PAGE-ALLOCATED BIT
PUSHJ P,DOPGS ;MOVE THROUGH BIT MAP
TDNE T1,PTAB(T2) ;ALLOCATED?
AOJA P1,SRCLOP ; YES, KEEP LOOKING
MOVEI T1,(P1) ;NO, COPY PAGE NUMBER
LSH T1,^D9 ;MAKE INTO ADDRESS
CAIGE T1,1000 ;ABOVE PAGE 1?
MOVEI T1,.JBDA ;NO!! START ABOVE JOBDAT
MOVEM T1,.JBFF ;STORE AS NEXT WORD TO USE
HRLM T1,.JBSA ;AND INITIAL VALUE THEREOF
SUBI T1,1 ;GET END OF LAST PAGE
ORI T1,777 ;MAKE SURE IT LOOKS GOOD
MOVEM T1,.JBREL ;STORE AS LIMIT WORD
;[4202] NOW WE MUST UNMAP ALL THE PAGES FROM THIS SECTION THAT
;HAVE BEEN MAPPED BEFORE BY FOROTS. WE GO THROUGH THE BITMAP,
;A PAGE AT A TIME, AND CALL KILPGX FOR ALL PAGES FOR WHICH
;THE PAGE IS NOT ALLOCATED.
MOVEI P1,777 ;START AT THE TOP
MOVEI P2,1 ;1 PAGE AT A TIME
RUNMLP: MOVEI T1,1 ;USE ALLOCATED BIT AS THE MASK
PUSHJ P,DOPGS ;ONLY 1 PAGE AT A TIME, THOUGH
TDNN T1,PTAB(T2) ;CHECK IF ALLOCATED
PUSHJ P,KILPGX ;NOT ALLOCATED. KILL IT!
SOJGE P1,RUNMLP ;LOOP DOWN TO 0
RET ;OUR WORK IS DONE
> ;IF20
;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
JOBDDT: BLOCK 1 ;[4200] FAKE .JBDDT
%JBASE: BLOCK 1 ;.JBFF POINTING AFTER SYMBOL TABLE
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
VRTBIT: BLOCK 1 ;0 IF TRYING FOR PHYSICAL PAGES,
; PA.GCD IF TRYING FOR VIRTUAL PAGES
IF10,<
PBLK: BLOCK 1 ;ARG COUNT WORD
BLOCK PLEN ;ARGS
> ;END IF10
IF20,< ;[4120]
PDVBLK: BLOCK .POADE+1 ;[4120] BLOCK FOR PDVOP%
PDVA: BLOCK MAXPDV ;[4120] BLOCK OF PDVA'S
PDVCNT: BLOCK 1 ;[4120] NUMBER OF PDV'S SEEN
PDVTTL: BLOCK 1 ;[4120] TOTAL PDVS IN RANGE
LOWADR: BLOCK 1 ;[4120] LOWEST ADDR IN SECTION
HIADR: BLOCK 1 ;[4205] HIGHEST ADDR IN SECTION
MEMCNT: BLOCK 1 ;[4120] COUNT OF WORDS LEFT IN .PVMEM BLOCK
> ;END IF20
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
XMOVEI T1,(T1) ;[4017] GET GLOBAL ADDRESS
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
XMOVEI T1,(T1) ;[4017] GET GLOBAL ADDRESS
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
XMOVEI T1,(T1) ;[4017] GET GLOBAL ADDRESS
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
XMOVEI T1,(T1) ;[4017] GET GLOBAL 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
$ECALL MFU,%ABORT ;[4131] CAN'T
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
MOVEI T1,(T1) ;[4017] MAKE LOCAL ADDRESS
MOVEI T2,(T2) ;[4017] MAKE LOCAL ADDRESS
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
$ECALL MFU,%ABORT ;[4131] CAN'T. OUT OF MEMORY
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
MOVEM T1,FMACS ;GIVE ADDRESS TO USER IN AC0
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
IF10,<
;ALLOCATE I/O CHANNEL
;TWO ENTRY POINTS:
;ALCHN.: STANDARD FORTRAN CALLING SEQUENCE, ONE ARG POINTED TO BY L
; ARG = 0 TO FIND A FREE CHANNEL, 1-17 TO ALLOCATE THAT SPECIFIC CHANNEL
;RETURN: T0 = CHANNEL NUMBER ALLOCATED, OR -1 IF NO FREE CHANNELS
;%ALCHF: T1 = 0 TO FIND A FREE CHANNEL, 1-17 TO ALLOCATE THAT SPECIFIC CHANNEL
;RETURN: T1 = CHANNEL NUMBER ALLOCATED. NONSKIP RETURN IF NO FREE CHANNELS
FENTRY (ALCHN)
PUSHJ P,SAVAC ;SAVE USER'S ACS
MOVE T1,@0(L) ;GET USER'S ARG
TDNE T1,[-20] ;IF NEGATIVE OR OVER 17, ERROR
JRST ALCHNX
PUSHJ P,%ALCHF ;TRY TO ALLOCATE CHANNEL
ALCHNX: SETO T1, ;CAN'T
MOVEM T1,FMACS ;[4203] STORE FOR USER
POPJ P, ;RETURN
%ALCHF: JUMPN T1,ALCHN1 ;IF SPECIFIC REQUEST, GO TRY TO ALLOCATE IT
ALCHN: MOVE T0,%CHMSK ;GET ALLOCATED CHANNEL MASK
JFFO T0,ALCHN1 ;FIND FIRST FREE CHANNEL
POPJ P, ;NONE, ERROR RETURN
ALCHN1: MOVNI T3,(T1) ;GET SHIFT COUNT FOR CHANNEL
MOVSI T2,(1B0) ;GET A 1 BIT
LSH T2,(T3) ;SHIFT INTO POSITION
TDNN T2,%CHMSK ;CHANNEL FREE?
POPJ P, ;NO, ERROR RETURN
ANDCAM T2,%CHMSK ;MARK IT ALLOCATED
JRST %POPJ1 ;SUCCESS RETURN
;DEALLOCATE CHANNEL
;TWO ENTRY POINTS:
;DECHN.: STANDARD FORTRAN CALLING SEQUENCE, ONE ARG POINTED TO BY L
; ARG = CHANNEL NUMBER TO DEALLOCATE
;RETURN: T0 = 0 IF DEALLOCATED OK, -1 IF CHANNEL WASN'T ALLOCATED
;%DECHF: T1 = CHANNEL NUMBER TO DEALLOCATE
;NONSKIP RETURN IF CHANNEL NOT ALLOCATED, SKIP RETURN IF OK
FENTRY (DECHN)
PUSHJ P,SAVAC ;SAVE USER'S ACS
MOVE T1,@0(L) ;GET ARG
TDNE T1,[-20] ;RANGE CHECK
JRST DECHNX ;ILLEGAL CHANNEL, ERROR
PUSHJ P,%DECHF ;DEALLOCATE THE CHANNEL
DECHNX: SKIPA T1,[-1] ;CAN'T
SETZ T1, ;CAN, DID
MOVEM T1,FMACS ;[4203] STORE FOR RETURN TO USER
POPJ P, ;RETURN
%DECHF: MOVNI T1,(T1) ;GET SHIFT COUNT
MOVSI T2,(1B0) ;GET A 1 BIT
LSH T2,(T1) ;SHIFT INTO POSITION
TDNE T2,%CHMSK ;CHANNEL ALLOCATED?
POPJ P, ;NO, ERROR
IORM T2,%CHMSK ;DEALLOCATE IT
JRST %POPJ1 ;SUCCESS
>;END IF10
IF20,<
FENTRY (ALCHN)
SETO T0, ;NO CHANNELS AVAILABLE ON -20
%ALCHF: POPJ P, ;SAY SO AND RETURN
FENTRY (DECHN)
SETO T0, ;NO CHANNEL CAN BE ALLOCATED
%DECHF: POPJ P, ;ERROR RETURN
>;END IF20
;SAVAC - SAVE THE AC'S LOCALLY IN FORMEM, AS THESE ROUTINES CAN BE
;CALLED WITHIN I/O STATEMENTS.
SAVAC: POP P,RETA ;SAVE THE RETURN ADDR
MOVEM 0,FMACS ;SAVE AC 0
MOVE 0,[1,,FMACS+1] ;SAVE THE REST
BLT 0,FMACS+17
PUSHJ P,@RETA ;RETURN TO FOROTS, LEAVE RESTORE RETURN ADDR
HRLZI 16,FMACS ;RESTORE THE ACS
BLT 16,16 ;WITH A BLT
POPJ P, ;RETURN TO USER'S PROGRAM
SEGMENT DATA
FMACS: BLOCK 20 ;LOCAL AC SAVE AREA
RETA: BLOCK 1 ;RETURN ADDRESS
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
TLNN T1,-1 ;CHECK FOR REASONABLE ADDRESS
JRST GADOK1 ;[4175] LOCAL ADDR IS ALWAYS AN OK ARG
HLLZ T3,T1 ;[4175] GET THE SECTION NUMBER
XMOVEI T4,. ;[4175] GET FOROTS' SECTION NUMBER
HLLZ T4,T4 ;[4175]
CAME T3,T4 ;[4175] THE SAME?
JRST ERR3 ;[4175] NO. JUNK CALL
MOVEI T1,(T1) ;[4175] YES. JUST GET LOCAL ADDRESS
GADOK1: ADD T2,T1 ;[4175] COMPUTE END+1 OF REQUESTED CORE
TLNE T2,-1 ;CHECK END+1 FOR REASONABLE ADDRESS
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 TRYSYM ;ALREADY ALLOCATED. TRY FREEING SYMBOLS
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
TLNE T2,-1 ;DID WE GO TO THE NEXT SECTION?
JRST ERR1 ;YES. WE CAN'T DO THAT!
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
TLNN T1,-1 ;CHECK ARGS
JRST RADOK1 ;[4175] LOCAL ADDR IS ALWAYS AN OK ARG
HLLZ T3,T1 ;[4175] GET THE SECTION NUMBER
XMOVEI T4,. ;[4175] GET FOROTS' SECTION NUMBER
HLLZ T4,T4 ;[4175]
CAME T3,T4 ;[4175] THE SAME?
JRST ERR3 ;[4175] NO. JUNK CALL
MOVEI T1,(T1) ;[4175] YES. JUST GET LOCAL ADDRESS
RADOK1: ADD T2,T1 ;[4175] COMPUTE END+1 OF REQUESTED CORE
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
TLNN T1,-1 ;[4175] CHECK
JRST ROTOK1 ;[4175] LOCAL ADDR IS ALWAYS AN OK ARG
HLLZ T3,T1 ;[4175] GET THE SECTION NUMBER
XMOVEI T4,. ;[4175] GET FOROTS' SECTION NUMBER
HLLZ T4,T4 ;[4175]
CAME T3,T4 ;[4175] THE SAME?
JRST ERR3 ;[4175] NO. JUNK CALL
MOVEI T1,(T1) ;[4175] YES. JUST GET LOCAL ADDRESS
ROTOK1: 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
SEGMENT CODE
END