Trailing-Edge
-
PDP-10 Archives
-
bb-m780a-sm
-
monitor-sources/free.mac
There are 49 other files named free.mac in the archive. Click here to see a list.
; UPD ID= 303, SNARK:<5.MONITOR>FREE.MAC.23, 29-Oct-81 14:25:04 by GRANT
;XXXMAX=1500.
; UPD ID= 205, SNARK:<5.MONITOR>FREE.MAC.22, 22-Sep-81 17:27:57 by MURPHY
;MORE TCO 5.1514 - FLUSH USELESS VARIABLE (UPRSAV)
; UPD ID= 189, SNARK:<5.MONITOR>FREE.MAC.21, 16-Sep-81 19:46:27 by PAETZOLD
;Change PAGSIZ to PGSIZ
; UPD ID= 188, SNARK:<5.MONITOR>FREE.MAC.20, 16-Sep-81 17:52:12 by MURPHY
;TCO 5.1514 - PREVENT THRASHING ABOVE AND BELOW THRESHOLD IN RESLCK
; UPD ID= 130, SNARK:<5.MONITOR>FREE.MAC.19, 30-Aug-81 19:39:17 by PAETZOLD
;TCO 5.1462 - Check if PI was off before doing PION
; UPD ID= 2280, SNARK:<5.MONITOR>FREE.MAC.18, 1-Jul-81 15:37:17 by PAETZOLD
;TCO 5.1380 - Remove references to .RESEP and .RESEQ
; UPD ID= 1795, SNARK:<5.MONITOR>FREE.MAC.17, 6-Apr-81 18:02:50 by MURPHY
;BLSUB. ENTRY FOR ASGRES
;<5.MONITOR>FREE.MAC.16, 24-Jan-81 22:34:25, EDIT BY GRANT
;CONVERT RESFSW TO RESBSW OR RESHSW
; UPD ID= 1481, SNARK:<5.MONITOR>FREE.MAC.15, 22-Jan-81 16:40:10 by GRANT
;PUT THE FOLLOWING CODE UNDER THE RESFSW DEBUG SWITCH:
; 1) RING BUFFER USED BY ASGRES AND RELRES
; 2) THE SECOND HEADER WORD AND THE TRAILER WORD USED BY RESIDENT FREE SPACE
; 3) WRITE LOCKING THE RESIDENT FREE SPACE BIT TABLE
; UPD ID= 1250, SNARK:<5.MONITOR>FREE.MAC.14, 8-Nov-80 17:51:22 by GRANT
;TCO 5.1195 - Reorder the tests in RELRES
; UPD ID= 1249, SNARK:<5.MONITOR>FREE.MAC.13, 7-Nov-80 22:49:53 by GRANT
;TYPO IN PREVIOUS EDIT
; UPD ID= 1228, SNARK:<5.MONITOR>FREE.MAC.12, 4-Nov-80 11:27:34 by GRANT
;TCO 5.1188 - EXPAND RESIDENT FREE SPACE HEADER, CREATE TRAILER
; UPD ID= 973, SNARK:<5.MONITOR>FREE.MAC.11, 26-Aug-80 11:47:10 by GRANT
;Add time stamp to RELRES/ASGRES trace buffer info
; UPD ID= 905, SNARK:<5.MONITOR>FREE.MAC.10, 18-Aug-80 11:34:11 by GRANT
; UPD ID= 826, SNARK:<5.MONITOR>FREE.MAC.9, 4-Aug-80 10:19:41 by GRANT
;Add optional data to RESBAD, RESBAZ, and RESBND
; UPD ID= 776, SNARK:<5.MONITOR>FREE.MAC.8, 22-Jul-80 16:35:48 by HALL
;CHANGES TO RESIDENT FREE SPACE HANDLER:
; ALLOW HEADER OF ARBITRARY SIZE
; ALLOW POOL NUMBERS TO START AT 1
; UPD ID= 772, SNARK:<5.MONITOR>FREE.MAC.7, 22-Jul-80 14:15:31 by OSMAN
;Fix comment to advertize ASGPGS instead of ASGPG1
;TEMPORARY - MAKE RESIDENT BIT TABLE WRITE-LOCKED
;TEMPORARY - REMEMBER ALL CALLS TO ASGRES, ASGFRE
; UPD ID= 179, SNARK:<4.1.MONITOR>FREE.MAC.27, 28-Dec-79 14:23:32 by GRANT
;Change error code in ASGSWP from IPCFX8 to MONX06
;<4.MONITOR>FREE.MAC.26, 4-Oct-79 07:09:09, EDIT BY R.ACE
;ADD COMMENTS FOR JSB STACK
;<OSMAN.MON>FREE.MAC.1, 10-Sep-79 15:30:55, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>FREE.MAC.24, 16-Jul-79 09:20:03, EDIT BY OSMAN
;tco 4.2330 - Make RELRNG be a BUGHLT
;<4.MONITOR>FREE.MAC.23, 8-Jun-79 11:22:24, EDIT BY HALL
;MAKE BUGCHKS ASGINT AND RELINT PRINT PC AT TIME OF CALL
;<4.MONITOR>FREE.MAC.22, 20-Mar-79 12:36:22, Edit by MCLEAN
;FIX RELFRE BUGCHK RELINT TO BE IN A BETTER PLACE
;<4.MONITOR>FREE.MAC.20, 18-Mar-79 14:51:05, EDIT BY BOSACK
;MAKE RELFRE BUGCHK IF OKINT
;<4.MONITOR>FREE.MAC.19, 14-Mar-79 21:03:14, EDIT BY BOSACK
;MAKE ASGFRE CHECK FOR NOINT, BUGCHK IF NOT
;<4.MONITOR>FREE.MAC.18, 10-Mar-79 14:12:35, EDIT BY MILLER
;FIX ASGJF1 SOMEMORE
;<4.MONITOR>FREE.MAC.17, 9-Mar-79 14:47:44, Edit by MCLEAN
;<4.MONITOR>FREE.MAC.16, 9-Mar-79 14:42:42, EDIT BY MILLER
;FIX ASGJFR TO ADD NEW STRING BLOCK RACE FREE.
;<4.MONITOR>FREE.MAC.15, 9-Mar-79 14:11:45, Edit by MCLEAN
;MAKE BUGHLTS FOR ATTEMPTS TO ASSIGN/DEASSIGN 0 OR - SPACE
;<4.MONITOR>FREE.MAC.14, 5-Mar-79 16:38:21, EDIT BY KIRSCHEN
;REMOVE UNUSED LOGICAL LINK POOL
;<4.MONITOR>FREE.MAC.13, 4-Mar-79 17:19:39, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>FREE.MAC.12, 20-Feb-79 13:54:49, EDIT BY HALL
;BUGCHK RELRNG WAS MISSING A COMMA BEFORE OPTIONAL DATA
;<4.MONITOR>FREE.MAC.11, 9-Feb-79 16:27:19, EDIT BY DBELL
;TCO 4.2187 - FIX CONSISTANCY CHECK AT RELFR6
;<4.MONITOR>FREE.MAC.10, 31-Jan-79 12:11:51, EDIT BY KIRSCHEN
;REMOVE AC 'D' FROM ADDITIONAL DATA IN RELBAD (MAX FOUR ITEMS)
;<4.MONITOR>FREE.MAC.9, 8-Jan-79 06:44:59, EDIT BY GILBERT
;TCO 4.2155 - Implement hidden symbol tables:
; Make JSBST4 work if the JSB is below 400000.
;<4.MONITOR>FREE.MAC.8, 3-Jan-79 19:47:48, EDIT BY DBELL
;TCO 4.2148 - MAKE JSFRMV IMMUNE TO JUNK IN LEFT HALF OF T1
;<4.MONITOR>FREE.MAC.7, 3-Jan-79 13:56:07, EDIT BY DBELL
;MOVE THE ECSKED AT RELFRB AFTER THE BUGCHK SO TYPEOUT OF CX IS USEFUL
;<4.MONITOR>FREE.MAC.6, 8-Nov-78 14:27:21, EDIT BY HALL
;ADD ERROR CODES TO RETURN FROM ASGRES AND RELATED ROUTINES
;<4.MONITOR>FREE.MAC.5, 23-Oct-78 17:55:24, Edit by MCLEAN
;ADD A FEW CSKEDS AND ECSKED TO ASGFRE
;<4.MONITOR>FREE.MAC.4, 11-Oct-78 16:41:55, EDIT BY MILLER
;ADD ASWSWS AND RELMSS TO GET AND STACK SWAP FREE SPACE
;<4.MONITOR>FREE.MAC.3, 15-Aug-78 10:21:16, Edit by HALL
;TCO 1985 - ADD OPTIONAL DATA TO BUGCHK'S IN RELFRE
;<4.MONITOR>FREE.MAC.2, 19-Jul-78 00:03:21, Edit by MCLEAN
;MOVE ASGSWP/RELSWP/RELMES INTO HERE FROM IPCF
;<4.MONITOR>FREE.MAC.1, 20-Jun-78 16:55:15, Edit by ENGEL
;CHANGE CAME TO CAMGE AT JSBSF7
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
IFN RESBSW,< ;IF DEBUGGING
SEARCH PROKL ;NEED WRITE-PROTECTING STUFF
>
TTITLE FREE ; Storage routines
SWAPCD
;NO SPECIAL AC DEFINITIONS HEREIN
;LOCAL DEFINITIONS FOR JSBSTK
DEFSTR (JSCOD,,17,18) ;THE CODE
DEFSTR (JSFRK,1,17,18) ;THE FORK HANDLE
DEFSTR (JSLVL,1,35,18) ;THE INTERRUPT LEVEL
; Assign space in free storage region
; Call: RH(A) ; Location of free storage header
; B ; Size of block needed
; CALL ASGFRE
; Return
; +1 ; Not enough space
; +2 ; Ok, in a, the location of the block (absolute)
; Clobbers a,b,c,d
; Calling routine must take measures to prevent loss of free storage
; Space by inhibiting psi's until the space assigned
; Has been accounted for
; Free storage header format is:
; 0 ; Lh points to first free block
; 1 ; Lock
; 2 ; Space counter
; 3 ; Most common block size
; 4 ; Lh has max top of free storage
; Rh has min bottom
; 5 ; Temp 2
; 6 ; Temp 3
ASGFRE::SKIPG B ;CHECK FOR LEGAL REQUEST
BUG(ASGFR0)
SKIPGE INTDF ;IS THE PROCESS NOINT?
JRST [ MOVE C,0(P) ;GET PC OF THE CALL
BUG(ASGINT,<<C,D>>)
JRST .+1]
CAMLE B,2(A) ; Any possibility of success?
RET ; No. return immediately
CSKED ;DON'T RE-SCHEDULE
LOCK 1(A) ; Lock this free storage list
PUSH P,B ; Save desired block size
PUSH P,[0] ; BIGEST BLOCK SEEN SO FAR
MOVEI B,377777
MOVEM B,5(A) ; Initial best block size
SETZM 6(A) ; Initial location of best block
MOVE B,A ; Start with the header word
ASGFR1: HLRZ C,0(B) ; Get pointer to next block
JUMPE C,ASGFR2 ; No more free blocks to examine
HRRZ D,0(C) ; Get size of the block
CAMLE D,0(P)
MOVEM D,0(P)
CAMN D,-1(P) ; Is it the right size?
JRST ASGFR3 ; Just right use it
CAML D,-1(P) ; Too small
CAML D,5(A) ; Or bigger than best?
JRST ASGFR4 ; Yes, ignore it
MOVEM D,5(A) ; This one is better
MOVEM B,6(A)
ASGFR4: MOVE B,C ; Step to next block
JRST ASGFR1 ; And repeat
ASGFR2: SKIPN B,6(A) ; Did we find anything?
JRST [ UNLOCK 1(A) ; No. unlock and return
ECSKED ;ALLOW RESKED
POP P,B ; FLUSH TEMP
POP P,B ; Make transparent to b on error
RET]
MOVE D,-1(P) ; Get desired size
HLRZ C,0(B) ; Get pointer to block to be used
HRRM D,0(C) ; Convert to desired size
ADD D,C ; Pointer remainder of block
HRLM D,0(B) ; Point prev to remainder
HLLZ B,0(C) ; Get next
HLLM B,0(D) ; Point remainder to it
MOVE B,5(A)
SUB B,-1(P) ; Size of remainder
HRRM B,0(D) ; To header of remainder
ASGFR5: SUB P,BHC+1
MOVN B,0(P)
ADDM B,2(A) ; Reduce count of space left
UNLOCK 1(A)
ECSKED
MOVEI A,0(C) ; Get origin of block
HRROS (A) ; Set lh to ones
CAMN B,[-1] ;IS THIS A BLOCK OF 1 WORD?
JRST ASGFR6 ;YES. DON'T ZERO ANYTHING THEN
HRRZ B,(A) ; Get rh
HRRZI C,2(A)
SETZM -1(C) ;ZERO FIRST WORD BEFORE SETTING LEFT HALF INDEX
HRLI C,1(A)
ADD B,A
HRRZS B
CAILE B,(C)
BLT C,-1(B) ; Zero the block
ASGFR6: POP P,B
AOS (P)
RET
ASGFR3: HLL D,0(C)
HLLM D,0(B) ; Point predecessor to successor
JRST ASGFR5
; Release free storage block
; Call: A ; Location of free storage header (like asgfre)
; B ; Location of the block to be returned
; CALL RELFRE
; Clobbers b,c,d
;RELFRS IS CALLED TO REMOVE ENTRY FROM JSFSTK
;RIGHT HALF OF FIRST WORD OF BLOCK BEING RETURNED MUST CONTAIN
;NUMBER OF WORDS IN THE BLOCK (INCLUDING THE FIRST WORD)
;NOTE: BUGCHK RELINT PRINTS 0(P) AS IT WAS WHEN THIS ROUTINE
;WAS ENTERED. MUST BE CHANGED IF ANY MORE PUSHES ARE DONE.
RELFRS::PUSH P,A ;SAVE HEADER
PUSH P,B ;AND ADDRESS
MOVE A,B ;THE ADDRESS
MOVEI B,STKCD1 ;THE CODE
CALL JSFRMV ;REMOVE IT
POP P,B
SKIPA A,0(P) ;RESTORE A BUT DO NOT POP IT
RELFRE::PUSH P,A ;SAVE ADDRESS OF HEADER WORD FOR POOL
SKIPGE INTDF ;CHECK FOR NOINT
JRST [ MOVE A,-1(P) ;GET ADDRESS OF CALL
BUG(RELINT,<<A,D>>)
MOVE A,0(P) ;GET BACK ADDRESS OF HEADER
JRST .+1]
CSKED ;DON'T STOP SCHEDULING
LOCK 1(A) ;LOCK THIS FREE SPACE POOL
HRRZ D,0(A) ;GET RH OF HEADER WORD FOR POOL
JUMPE D,RELFR0 ; Jump if old style free block
;SEE IF THE BLOCK BEING RETURNED BEGINS OUTSIDE OF THE RANGE OF
;THE SPECIFIED POOL.
HLRZ D,4(A) ;GET UPPER LIMIT ON THIS POOL
HRRZ A,4(A) ;GET LOWER LIMIT ON THIS POOL
CAILE D,0(B) ;IS USER RETURNING BLOCK BEYOND THE END?
CAILE A,0(B) ;NO. BEFORE THE START?
JRST RELFRA ;LOSSAGE - OUT OF RANGE
;BLOCK STARTS WITHIN RANGE OF THE SPECIFIED POOL OF FREE SPACE. STEP
;THROUGH THE CHAIN OF FREE BLOCKS. STOP WHEN A BLOCK IS BEYOND THE
;ONE BEING RETURNED OR THE CHAIN ENDS
MOVE A,0(P) ;GET BACK ADDRESS OF POOL HEADER
RELFR0: PUSH P,B ;SAVE ADDRESS OF BLOCK BEING RETURNED
HRLI B,0 ;SOME FIX NEEDED HERE TO KEEP OUT OF SEC 0 ***!!
HLLM B,0(P) ;FORCE 0 INTO LEFT HALF OF ADDRESS
MOVE B,-1(P) ;GET ADDRESS OF POOL HEADER
RELFR1: HLRZ C,0(B) ;GET ADDRESS OF NEXT BLOCK ON CHAIN
JUMPE C,RELFR2 ;AT END OF THE CHAIN?
CAML C,0(P) ;NO. PAST THE BLOCK BEING RETURNED?
JRST RELFR2 ;YES.
MOVE B,C ;NO. STEP TO THE NEXT BLOCK
JRST RELFR1 ;GO CONTINUE THE SEARCH
;HERE WHEN CALLER IS TRYING TO RETURN A BLOCK THAT STARTS AFTER THE
;END OF THE SPECIFIED POOL OR BEFORE THE BEGINNING. BUGCHK PRINTS
;ADDRESS OF BLOCK, LOWER LIMIT ON POOL, UPPER LIMIT ON POOL
RELFRA: BUG(RELRNG,<<B,D>,<A,D>,<D,D>>)
; This has been made a HLT instead of a CHK
; so that any reasons for lost free space
; can hopefully be found.
POP P,A ;GET THE ADDRESS OF THE POOL
UNLOCK 1(A) ;UNLOCK THE POOL LOCK
ECSKED
RET
;HERE WHEN SEARCH THROUGH FREE SPACE CHAIN IS COMPLETE. EITHER
; 1) THE LAST BLOCK IN THE CHAIN WAS BEFORE (LOWER ADDRESS) THAN
;THE BLOCK BEING RETURNED (C CONTAINS 0)
;OR
; 2) A BLOCK HAS BEEN REACHED THAT IS AFTER (HIGHER ADDRESS)
;THE ONE BEING RELEASED (C CONTAINS THE ADDRESS OF THIS BLOCK)
;IF C CONTAINS THE ADDRESS OF THE BLOCK BEING RETURNED, BLOCK
;IS ALREADY IN THE CHAIN
;BLOCK BEING RETURNED WILL GO BETWEEN ADDRESS IN B AND ADDRESS IN C
; A/ ADDRESS OF HEADER FOR THE POOL
; B/ ADDRESS OF BLOCK PRECEDING BLOCK POINTED TO BY C
; C/ 0 OR ADDRESS OF FIRST BLOCK AFTER ONE BEING RETURNED
; 0(P)/ 0,,ADDRESS OF BLOCK BEING RETURNED
; -1(P)/ ADDRESS OF FREE SPACE POOL TO WHICH BLOCK IS BEING RETURNED
RELFR2: CAMN C,0(P) ; Releasing a block already released?
JSP CX,RELFRB ;YES, LOSSAGE
;SEE IF BLOCK THAT PRECEDES THIS BLOCK WILL OVERLAP IT. IF SO,
;GO BUGCHK.
CAIN A,0(B) ;THIS FIRST BLOCK ON FREE LIST?
JRST RELFR6 ;YES. SKIP OVERLAP CHECKING
HRRZ D,0(B) ;GET LENGTH OF PRECEDING BLOCK
ADD D,B ;COMPUTE ITS ENDING ADDRESS
CAMLE D,0(P) ;PREVIOUS BLOCK OVERLAPS ONE BEING RELEASED?
JSP CX,RELFRB ;YES, LOSSAGE
;SEE IF THIS BLOCK WOULD OVERLAP THE ONE AFTER IT
RELFR6: JUMPE C,RELFR7 ;IF END OF LIST, SKIP OVERLAP CHECKING
HRRZ D,@(P) ;GET SIZE OF BLOCK
ADD D,0(P) ;ADD ADDRESS TO GET ENDING ADDRESS
CAMLE D,C ;OVERLAPS NEXT BLOCK ON FREE LIST?
JSP CX,RELFRB ;YES, LOSSAGE
;NO ERRORS DETECTED. INCREMENT THE COUNT OF FREE SPACE FOR THE
;POOL
RELFR7: HRRZ D,@0(P) ;GET LENGTH OF BLOCK BEING RETURNED
ADDM D,2(A) ; Augment count of remaining storage
;..
;SEE IF THIS BLOCK CAN BE ADDED TO ITS SUCCESSOR.
;IT CAN BE IF ITS ENDING ADDRESS IS THE SAME AS THE ADDRESS OF THE
;NEXT BLOCK. IF SO, ADD LENGTH OF FOLLOWING BLOCK TO LENGTH OF
;BLOCK BEING RETURNED. MAKE BLOCK BEING RETURNED POINT TO THE
;SUCCESSOR OF THE ONE BEING MERGED.
;..
ADD D,0(P) ; Get end of block being returned
CAIE D,0(C) ; Same as following block location?
JRST RELFR3 ; No
HRRZ D,0(C) ; Get length of following block
ADDM D,@0(P) ; Augment length of block being returned
HLLZ D,0(C) ; Get loc of successor of successor
HLLM D,@0(P) ;MAKE BLOCK BEING RETURNED POINT TO IT
;MAKE THE PREDECESSOR POINT TO THE BLOCK BEING RETURNED. IF PREDECESSOR
;EXTENDS TO START OF BLOCK BEING RETURNED, MERGE THEM AND MAKE THE
;PREDECESSOR POINT TO THE SUCCESSOR OF THE BLOCK BEING RETURNED.
RELFR5: MOVE C,0(P) ;GET ADDRESS OF BLOCK BEING RETURNED
HRLM C,0(B) ;MAKE PREDECESSOR POINT TO IT
HRRZ D,0(B) ;GET LENGTH OF PREDECESSOR
ADD D,B ;COMPUTE ENDING ADDRESS OF PREDECESSOR
CAME D,C ;DOES PREDECESSOR EXTEND TO THIS BLOCK?
JRST RELFR4 ; No, done
MOVE C,0(C) ;GET (SUCCESSOR,,COUNT) FOR BLOCK BEING RETURNED
HLLM C,0(B) ;MAKE PREDECESSOR POINT TO IT
HRRZS C ;GET COUNT OF BLOCK BEING RETURNED
ADDM C,0(B) ;ADD TO PREDECESSOR'S COUNT
;HERE WHEN DONE. UNLOCK THE FREE SPACE POOL AND CLEAN THE STACK
RELFR4: UNLOCK 1(A) ;UNLOCK THE POOL LOCK
ECSKED
POP P,B
POP P,A
RET
;HERE WHEN RETURNING BLOCK CANNOT BE MERGED WITH THE ONE THAT
;FOLLOWS IT.
RELFR3: HRLM C,@0(P) ; Point returned block to successor
JRST RELFR5
RELFRB: UNLOCK (<1(A)>)
BUG(RELBAD,<<CX,D>,<A,D>,<B,D>,<C,D>>)
ECSKED
POP P,B
POP P,A
RET
; Assign a page in job area
; Call: CALL ASGPAG
; Return
; +1 ; None available
; +2 ; Success
; A ; Address of origin of page
;ASGPGS IS CALLED IN ORDER TO PUT THE PAGE ON THE JSB STACK
;SO IT CAN BE RELEASED IN CASE OF FORK RESET
ASGPGS::TDZA A,A ;ENTRY TO SAVE ASSIGNMENT
ASGPAG::SETO A, ;DON'T SAVE INFO
STKVAR <FLAG>
MOVEM A,FLAG ;SAVE TYPE OF ENTRY
CSKED ;DON'T STOP SCHEDULER
LOCK JBCLCK
MOVSI C,-4 ; Four words of bits
ASGPG1: MOVE A,JBCOR(C)
JFFO A,ASGPG2 ; Any bits?
AOBJN C,ASGPG1 ; No, try next word
UNLOCK JBCLCK
ECSKED
RET ; No words left
ASGPG2: MOVN B,B
MOVSI A,400000
ROT A,(B)
ANDCAM A,JBCOR(C) ; Mark as used
UNLOCK JBCLCK
ECSKED
MOVEI A,(C)
IMULI A,^D36
SUB A,B
LSH A,9
ADDI A,JSBPGA ; Origin of job mapped area
SKIPE FLAG ; WANT THE ADDRESS STACKED?
RETSKP
MOVEM A,FLAG ; YES. SAVE IT
MOVEI B,STKCD2 ; SAY IS FROM ASGPAG
CALL JSBSTK ; GO STACK IT ON THE JSB STACK
MOVE A,FLAG ; THE PAGE ADDRESS
RETSKP ; AND DONE
; Return page
; Call: A ; Location of page
; CALL RELPAG
;RELPGS IS CALLED TO REMOVE THE ENTRY FROM THE JSFSTK
RELPGS::PUSH P,A ;SAVE PAGE
MOVEI B,STKCD2 ;THE PROPER CODE
CALL JSFRMV ;GO REMOVE IT
SKIPA A,0(P) ;RESTORE A
RELPAG::PUSH P,A ;SAVE ADDRESS
MOVE B,A ;ADDRESS TO B
SETZ A, ;UNMAP REQUEST
CALL SETMPG ;MAKE SURE ALL SPACE RELEASED
POP P,A ;AND PROCEED
SUBI A,JSBPGA
LSH A,-9
IDIVI A,^D36
MOVSI C,400000
MOVNS B
ROT C,(B)
IORM C,JBCOR(A) ; Clear the bit
RET
; Assign job storage
; Call: B ; Size of block needed
; CALL ASGJFR
; Return
; +1 ; Not enough room
; +2 ; Success. location of block in A
ASGJFS::TDZA A,A ;STACK FLAG
ASGJFR::SETO A, ;DON'T STACK
STKVAR <FLAG>
MOVEM A,FLAG ;SAVE FLAG
ASGJF0: MOVEI A,JSBFRE
CALL ASGFRE ; Attempt to assign
JRST ASGJF1 ; Not enough
AOS (P) ; Success
SKIPE FLAG ; WANT STACKING?
RET
MOVEM A,FLAG ; YES.
MOVEI B,STKCD1 ; SAY IS FROM ASGJFR
CALL JSBSTK ; GO STACK IT
MOVE A,FLAG ; THE ADDRESS
RET ; AND DONE
ASGJF1: PUSH P,B
PUSH P,C
PUSH P,JSBFRE+4 ;SAVE CURRENT VALUES
CALL ASGPAG ; Get another page of job storage
JRST ASGJF2 ; No pages left
POP P,B ;GET BACK RANGE VALUES
CAME B,JSBFRE+4 ;DID FREE SPACE CHANGE SIZE?
JRST [ CALL RELPAG ;RELEASE THE PAGE
JRST ASGJF3] ;AND TRY AGAIN
CSKED ;SET UP TO OWN LOCK
LOCK JSBFRE+1 ;LOCK STRING DATA BASE
MOVEI B,1000
HRROM B,(A) ; Make a free block out of it
MOVEI B,1000(A)
HLRZ C,4+JSBFRE
CAMGE C,B
HRLM B,4+JSBFRE
UNLOCK JSBFRE+1 ;DONE UPDATING THE BLOCK
ECSKED ;AND DONE WITH CRITICAL REGION
MOVE B,A
MOVEI A,JSBFRE
CALL RELFRE ; Release the new block
ASGJF3: POP P,C
POP P,B
JRST ASGJF0 ; Try again
ASGJF2: POP P,0(P) ;GET RID OF SAVED RANGE WORD
POP P,C
POP P,B
RET ; Fail
IFN 0,<
; Put item onto deallocation list
; Call: LH(A) ; Routine to call to deallocate the item
; RH(A) ; Item identifier (address usually)
; CALL PUTITM
; Items put on the deallocation are automatically deallocated whenever
; A psi occurs and the user's program changes the pc such that
; The monitor routine in progress does not complete
PUTITM::PUSH P,B ; Free up some ac's
PUSH P,A
PUTIT0: MOVE A,INTLVL ; Get current interrupt level
SKIPE B,ITMHD(A) ; Get the correct item list header
JRST PUTIT1
PUSH P,A ; No header, create one
MOVEI A,PSBFRE
MOVEI B,6
CALL ASGPAG ; Assign a block of psb free storage
JSR BUGHLT
POP P,B
MOVEM A,ITMHD(B) ; Point the header to the block
HRLI A,1(B)
HRRI A,2(B)
SETZM 1(B)
BLT A,6(B) ; Clear the block
PUTIT1: HRLI B,5
AOS B ; Make aobjn pointer
PUTIT2: SKIPN (B) ; Search for an empty slot
JRST PUTIT3 ; Found
AOBJN B,PUTIT2
MOVE B,INTLVL ; No empty slots
MOVEI A,0
EXCH A,ITMHD(B) ; Clear header, get old header
HRLI A,RELITB ; Make into an item word
CALL PUTITM ; Call self, making first thing on
JRST PUTIT0 ; New block the old block. try again
PUTIT3: POP P,A
MOVEM A,(B)
POP P,B
RET
; Release all items on interrupt level specified in a
; Call: A ; Interrupt level
; CALL RELITM
RELITM::PUSH P,ITMHD(A)
SETZM ITMHD(A)
POP P,A
JUMPN A,RELITB
RET
RELITB: PUSH P,A
PUSH P,B
HRLI A,-5
AOS A
RELIT1: SKIPN B,(A)
JRST RELIT2
PUSH P,A
HRRZ A,B
HRLZS B
CALL (B)
POP P,A
RELIT2: AOBJN A,RELIT1
MOVE B,-1(P)
MOVEI A,PSBFRE
CALL RELFRE
POP P,B
POP P,A
RET
>
SUBTTL JSB STACK ROUTINES
;FOLLOWING IS A COLLECTION OF ROUTINES WHICH ARE USED TO QUEUE
;UP FREE SPACE DEALLOCATION. ENTRIES DESCRIBE FREE SPACE STRINGS
;OR PAGES WHICH THE JSYS WANTS TO RELEASE WHEN IT IS FINISHED. SHOULD
;IT BE INTERRUPTED AND NOT ALLOWED TO FINISH (I.E. VIA DEBRK, OR
;KFORK) THIS LIST WILL BE USED TO RELEASE THE FREE SPACE ACQUIRED
;BY THE PROCESS WHILE IN MONITOR CONTEXT. THIS MECHANISM ALLOWS
;MANY JSYS'S TO RUN OKINT WHICH ORDINARILY WOULD BE OBLIGED TO
;RUN NOINT
;JSB STACK POINTER (IN JSB)
; !=======================================================!
;JSFSTK ! - # OF ENTRIES !ADDR OF BLOCK IN FREESPACE !
; !=======================================================!
;JSB STACK (IN JSB FREESPACE)
; !=======================================================!
; ! -1 !WORD COUNT (INCL THIS WORD)!
; !-------------------------------------------------------!
; ! ENTRY TYPE CODE (JSCOD) ! DATA !
; !-------------------------------------------------------!
; ! SYSTEM FORK # (JSFRK) ! PSI LEVEL # (JSLVL) !
; !-------------------------------------------------------!
; ! REPEAT PREVIOUS 2 WORDS FOR EACH ENTRY !
; ! . !
; ! . !
; ! . !
; !=======================================================!
;ROUTINE TO PUT THE ASSIGNED SPACE ON THE JSB STACK. THIS STACK IS
;USED TO RELEASE ANY FREE SPACE ACCUMULATED BY A PROCESS WHICH
;IT COULD NOT RELEASE BECAUSE IT WAS INTERRUPTED.
;ACCEPTS:
; 1/ DATUM TO BE STACKED
; 2/ CODE IDENTIFYING TYPE OF DATUM
JSBSTK::STKVAR <SVA,SVB> ;WORK STORAGE
MOVEM A,SVA ;SAVE ARGS
MOVEM B,SVB ;""
NOINT ;PREVENT INTS
LOCK JSFLCK ;LOCK THE STACK
SKIPE C,JSFSTK ;HAVE A STACK YET?
JRST JSBST1 ;YES. GO TRY AND USE IT
MOVEI B,21
CALL JSBST4 ;GO ASSIGN SOME FREE SPACE
JRST JSBSF5 ;FAILED. GIVE IT UP
MOVEM A,JSFSTK ;SAVE IT
MOVE C,A ;MOVE POINTER
JSBST1: HRRZ D,0(C) ;GET COUNT
SOS D ;NUMBER OF ENTRIES
LSH D,-1 ;NUMBER OF FULL ENTRIES
JSBST2: AOS C ;NEXT CELL
SKIPN 0(C) ;THIS ONE FREE?
JRST JSBST3 ;YES
AOS C ;STP
SOJG D,JSBST2 ;NO KEEP LOOKING
MOVE A,JSFSTK ;GET CURRENT ASSIGNMENT
HRRZ B,0(A) ;THE COUNT
ADDI B,20 ;GET MORE SPACE THIS TIME
CALL JSBST4 ;GO GET SOME
JRST JSBSF5 ;FAILED. GIVE IT UP
MOVE B,JSFSTK ;OLD STACK
HLL A,B ;PRESERVE COUNT OF ENTRIES
PUSH P,A ;SAVE BLOCK
MOVEI A,1(A) ;INCREMENT ADDRESS
HRLI A,1(B) ;TO MOVE
HRRZ B,0(B) ;COUNT OF THIS ONE
ADDI B,-2(A) ;NUMBER TO MOVE
BLT A,0(B) ;MOVE IT
POP P,B ;BLOCK
EXCH B,JSFSTK ;MAKE IT CURRENT. GET OLD
MOVEI A,JSBFRE
HRRZS B ;GET ADDRESS ONLY
CALL RELFRE ;RELEASE FREE SPACE
MOVE C,JSFSTK ;GET IT AGAIN
JRST JSBST1 ;GO TRY INSERT NOW
;INSERT ENTRY AT 0(C)
JSBST3: MOVE A,SVA ;THE DATUM
MOVEM A,0(C) ;STASH IT
MOVE A,PSIBIP ;RECORD CURRENT BREAK LEVEL
JFFO A,.+1
STOR B,JSLVL,(C)
MOVE B,SVB ;THE CODE
STOR B,JSCOD,(C) ;STORE THE CODE
MOVE A,FORKX ;CURRENT FORK
STOR A,JSFRK,(C) ;SAVE THIS
MOVSI A,-1 ;INCREMENTER
ADDM A,JSFSTK ;ANOTHER ENTRY IN THE STACK
JRST JSBSF5 ;GO FINISH UP
;GET SOME SPACE
JSBST4: CALL ASGJFR ;GET IT
RETBAD ;NONE THERE
PUSH P,A ;SAVE ADDRESS
HRRZ B,0(A) ;END
SOS B
ADD B,0(P) ;THE LAST WORD TO ZERO
ADDI A,2
SETZM -1(A) ;GET A ZERO
HRLI A,-1(A) ;FORM BLT
BLT A,0(B) ;ZERO THE AREA
POP P,A ;THE AREA
RETSKP ;AND DONE
;ROUTINE TO PROCESS THE JSFSTK ENTRY FOR A GIVEN PROCESS.
;ACCEPTS:
; 1/ SYSTEM-WIDE FORK #
; 2/ PSIBIP TO INDICATE WHAT STACK LEVEL ENTRIES TO CLEAR (0=ALL)
;RETURNS +1 WITH ALL ENTRIES FOR THIS PROCESS HANDLED
;AND REMOVED FROM THE STACK
;DISPATCH TABLE FOR CODES
CODTBL: RELSTR ;FREE A STRING
RELPGA ;FREE A PAGE
DECRTT ;DECREMENT TTY LOCK COUNT
RELMES ;RELEASE A SWAPPABLE STRING
JSBSTF::NOINT ;PREVENT INTS
LOCK JSFLCK ;LOCK THE STACK
SAVET ;SAVE ACS
STKVAR <HLDBIP,HLDHND> ;HOLD THE PSIPIB FOR STACK CLEARING
MOVEM B,HLDBIP ;SAVE THE SPIPIB
JSBSF6: SKIPL C,JSFSTK ;HAVE ANY ENTRIES IN THE STACK?
JRST JSBSF5 ;GO FINISH UP
HRRZ D,0(C) ;THE COUNT
SOS D ;NUMBER OF ENTRIES IN TABLE
LSH D,-1 ;NUMBER OF FULL ENTRIES
JSBSF1: AOS C ;NEXT ONE
SKIPN 0(C) ;ANYTHING HERE?
JRST JSBSF4 ;NO
LOAD B,JSFRK,(C) ;GET FORK HANDLE
CAIN A,0(B) ;THIS IT?
JRST JSBSF2 ;YES. GO DO IT
JSBSF4: AOS C ;NEXT CELL
SOJG D,JSBSF1 ;MORE?
JSBSF5: UNLOCK JSFLCK ;FREE THE LOCK
OKINT ;ALLOW INTS
RET ;ALL DONE
JSBSF2: MOVEM A,HLDHND ;SAVE FORK HANDLE
MOVE A,HLDBIP ;RELEASE ENTIES FOR CURRENT OR
JFFO A,JSBSF7 ; HIGHER LEVELS ONLY.
JRST JSBSF3 ;NO HIGHER LEVELS - GO RELEASE SPACE
JSBSF7: LOAD A,JSLVL,(C) ;GET THIS ENTRIES STACK LEVEL
CAMGE A,B ;SKIP IF ENTRY IS OF HIGHER LEVEL THAN CURRENT
JRST [ MOVE A,HLDHND ;RESTOR A
JRST JSBSF4] ;NO - THEN DON'T RELEASE THIS LEVEL
JSBSF3: LOAD B,JSCOD,(C) ;GET CODE
HRRZ A,0(C) ;THE DATUM
SETZM 0(C) ;FREE ENTRY
MOVE B,CODTBL-1(B)
CALL 0(B)
MOVSI A,1 ;A DECREMENTER
ADDM A,JSFSTK ;ONE LESS ENTRY
MOVE A,HLDHND ;THE FORK HANDLE
JRST JSBSF6 ;CONTINUE
;ROUTINES TO PROCESS INDIVIDUAL STACK ENTRIES
;ROUTINE TO RELEASE A JSB STRING. A/STRING ADDRESS
RELSTR: MOVE B,A ;THE STRING
MOVEI A,JSBFRE ;THE HEADER
CALLRET RELFRE ;DO IT
;ROUTINE TO RELEASE A JSB PAGE . A/ PAGE
RELPGA: CALLRET RELPAG ;FREE IT
;ROUTINE TO DECREMENT A TTY LOCK. A/ TTY NUMBER
DECRTT: MOVE B,A ;MOVE TTY NUMBER
CALL STADYN ;GO FIND DATA BASE
RET ;ALREADY RELEASED.
CALLRET ULKTT ;GO UNLOCK THE DATA BASE
;ROUTINE TO REMOVE A CERTAIN ENTRY FROM THE TABLE
;ACCEPTS:
; 1/ DATUM
; 2/CODE
JSFRMV::NOINT ;PREVENT INTS
LOCK JSFLCK ;LOCK THE STACK
SKIPL C,JSFSTK ;HAVE ANY ENTRIES IN THE STACK?
JRST JSBSF5 ;GO WRAP UP
STKVAR <SAVDTM,SAVCOD> ;WORK CELLS
HRRZM A,SAVDTM ;SAVE ARGUMENTS
MOVEM B,SAVCOD
HRRZ D,0(C) ;COUNT
SOS D ;NUMBER OF ENTRIES
LSH D,-1 ;# OF FULL ENTRIES
JSFRM1: AOS C ;NEXT ONE
SKIPE 0(C) ;ONE HERE?
JRST JSFRM2 ;YES
JSFRM3: AOS C ;NEXT CELL
SOJG D,JSFRM1 ;NO. LOOP
JRST JSBSF5 ;GO WRAP UP
JSFRM2: LOAD A,JSFRK,(C) ;SEE IF CORRECT FORK
CAME A,FORKX ;IS IT?
JRST JSFRM3 ;NO
LOAD A,JSCOD,(C) ;PROPER CODE?
CAME A,SAVCOD
JRST JSFRM3 ;NO
HRRZ A,0(C) ;GET DATUM
CAME A,SAVDTM ;CORRECT?
JRST JSFRM3 ;NO
PUSH P,B ;SAVE. TAKE ENTRIES FROM PROPER PSI LEVEL ONLY
MOVE A,PSIBIP ;COMPUTE THE PSI LEVEL NUMBER
JFFO A,JSFRM4 ;JUMP WHEN NOT AT LEVEL ZERO.
JRST JSFRM5 ;LEVEL ZERO - CLEAN OFF ENTRIES
JSFRM4: LOAD A,JSLVL,(C) ;GET THE LEVEL NUMBER FROM STACK
CAME A,B ;ARE WE AT THAT LEVEL
JRST [ POP P,B ;NO - THEN CONTINUE LOOKING
JRST JSFRM3]
JSFRM5: POP P,B
SETZM 0(C) ;CLEAR IT
MOVSI A,1 ;A DECREMENTER
ADDM A,JSFSTK ;ONE LESS ENTRY
JRST JSBSF5 ;GO WRAP UP
SUBTTL
;ROUTINE TO ASSIGN RESIDENT FREE SPACE
;ENTRY FOR BLCAL. CALLS
; BLCAL ASGRSB,<LENGTH,PRIORITY,POOL>
; RETURNS SAME AS FOR ASGRES
ASGRSB::BLSUB. <LEN,PRI,POO>
SAVEAC <T2,T4>
HRRZ T1,LEN
HRL T1,PRI
HRRZ T2,POO
CALLRET ASGRES ;DO THE WORK
ENDBS.
;ACCEPTS IN T1/ PRI ,, LEN
; T2/ FLAGS ,, POOL # ;(NO FLAGS PRESENTLY DEFINED)
; CALL ASGRES
;RETURNS +1: FAILED TO GET THE REQUESTED SPACE
; T1/ ERROR CODE
; +2: ADDRESS OF BLOCK IN T1
;THE PRIORITIES ARE:
; .RESP1 HIGHEST PRIORITY - CALLER IS AT SCHED OR INTERRUPT
; LEVEL, NO PAGE FAULTS ARE ALLOWED. THIS
; REQUEST WILL BE SERVICED IF AT ALL POSSIBLE.
; .RESP2 CALLER IS AT INTERRUPT LEVEL OR SCHEDULER
; LEVEL BUT IT IS NOT CRITICAL THAT THE SPACE
; REQUEST BE GRANTED. SPACE WILL NOT BE GIVEN
; OUT IF DOING SO CAUSES THE AMOUNT OF FREE
; SPACE TO DROP BELOW THE MINIMUM GUARANTEED
; FOR THE HIGHEST PRIORITY CALLS.
; .RESP3 CALLER IS IN PROCESS CONTEXT. IT IS LEGAL TO
; CAUSE PAGE FAULTS. THE SPACE WILL BE GRANTED
; UNLESS THE TOTAL FREE POOL IS EXHAUSTED. IF
; NECESSARY, THIS ROUTINE WILL CAUSE ANOTHER
; PAGE TO BE LOCKED DOWN AND ASSIGN THE SPACE
; FROM THAT PAGE. CALLS AT THIS LEVEL WILL NOT
; CAUSE THE FREE SPACE COUNT TO DROP BELOW THE
; MINIMUM AMOUNT RESERVED FOR THE HIGHEST
; PRIORITY LEVEL.
;THE RESIDENT POOLS ARE:
; .RESGP GENERAL POOL - USED BY ALL CALLERS EXCEPT THE
; ROUTINES THAT HAVE THEIR OWN POOL
; SYSERR BLOCKS USE THIS POOL
; .RESTP TERMINAL POOL - USED FOR ALL TERMINAL RELATED
; STORAGE
; .RESNP NETWORK POOL - USED BY DECNET MODULES
; .RSTMP TIMER POOL - USED BY TIMER JSYS
RESCD
ASGRES::MOVE T4,(P) ;GET PC OF CALLER
ASGRB0:
IFN RESBSW,< ;USE RING BUFFER TO RECORD ASSIGNMENTS
CALL ASGREX ;DO THE WORK
RET ;FAILED
MOVEI T2,-RSHLEN(T1) ;GET ADDRESS OF BLOCK, AND ZERO AS FLAG
CALL XXXPUT ;STORE IT
MOVE T2,-RSHLEN(T1) ;GET HEADER OF BLOCK
CALL XXXPUT ;STORE IT
MOVE T2,(P) ;GET CALLER PC
CALL XXXPUT ;STORE IT
MOVE T2,FORKX ;GET FORK NUMBER
CALL XXXPUT ;STORE IT
MOVE T2,TODCLK ;GET TIME
CALL XXXPUT ;STORE IT
RETSKP ;SKIP
XXXMAX==^D1500 ;SIZE OF BUFFER
XXXPUT: AOS T3,XXXPTR ;ADVANCE COUNTER
CAIL T3,XXXMAX ;TOO HIGH?
SETZB T3,XXXPTR ;YES, RESET IT
MOVEM T2,XXXBUF(T3) ;STORE DATA ITEM
RET ;DONE
RS(XXXPTR,1) ;INDEX INTO BUFFER
RS(XXXBUF,XXXMAX) ;BUFFER
ASGREX:
> ;END OF IFN RESBSW
ASUBR <ASGREA,ASGREF,ASGREC,ASGCAL>
HRRZI T1,RSHLEN+RSTLEN+3(T1) ;CONVERT TO THE # OF
ASH T1,-2 ; 4-WORD BLOCKS NEEDED
MOVEM T1,ASGREC ;SAVE THE COUNT OF BLOCKS NEEDED
HRRZ T2,ASGREF ;GET POOL NUMBER
SKIPE T2 ;0 ISN'T A LEGAL POOL NUMBER
CAIL T2,RESQTL ;IS POOL NUMBER TOO LARGE?
JRST [ BUG(ASGREQ)
RETBAD (MONX03)] ;RETURN 'MONITOR INTERNAL ERROR'
CAML T1,RESUTB(T2) ;IS THERE ENOUGH IN THE POOL?
RETBAD (MONX05) ;NO. RETURN 'NO RESIDENT FREE SPACE'
;THERE IS ENOUGH SPACE IN THE REQUESTED POOL. IF GIVING THIS SPACE
;AWAY WILL PUT US UNDER A UM, WE MAY WANT TO EXPAND THE POOL.
ASGRE0: MOVE T2,RESFRE ;GET AMOUNT OF SPACE LEFT
SUB T2,ASGREC ;DECREMENT BY THE REQUESTED AMOUNT
HLRZ T3,ASGREA ;GET PRIORITY
CAILE T3,.RESP3 ;LEGAL VALUE?
JRST [ BUG(ASGREP)
RETBAD(MONX03)] ;RETURN 'MONITOR INTERNAL ERROR'
CAMGE T2,RESMIN ;WOULD THIS PUT US UNDER THE MINIMUM?
JRST [ CAIE T3,.RESP1 ;HIGHEST PRIORITY?
JRST ASGRE1 ;NO, GO TRY TO EXPAND THE FREE POOL
JRST .+1] ;YES, GO TRY TO GET SPACE ANYWAY
;EITHER REQUEST IS OF HIGHEST PRIORITY OR THERE IS SUFFICIENT
;SPACE
MOVE T1,ASGREC ;GET NUMBER OF BLOCKS DESIRED
MOVEI T2,RESBTB ;GET START OF BITTABLE
MOVEI T3,RESBTL ;AND THE LENGTH OF THE BITTABLE
CALL GETBIT ;GET AND SET THIS NUMBER OF BITS
JRST ASGRE1 ;COULD NOT GET IT, GO TRY TO EXPAND
MOVN T2,ASGREC ;GET NUMBER OF BLOCKS REQUESTED
HRRZ T3,ASGREF ;GET POOL NUMBER
ADDM T2,RESUTB(T3) ;DECREMENT THE USAGE COUNT
ADDB T2,RESFRE ;DECREMENT THE COUNT
;..
;IF THE FIRST FREE BLOCK (THE ONE AFTER THE LAST USED BLOCK) IS BELOW
;THE DESIRED LEVEL, WAKE UP JOB 0 TO LOCK DOWN ANOTHER PAGE.
;..
MOVE T3,RESFFB ;GET FIRST FREE BLOCK
CAMGE T2,RESAVE ;BELOW THE AVERAGE DESIRED?
CAIL T3,NRESFB ;YES, ANY BLOCKS LEFT?
SKIPA ;NO, DO NOT WAKE UP JOB 0
AOS JB0FLG ;YES, WAKE UP JOB 0 TO EXPAND FREE POOL
;SET UP THE HEADER AND TRAILER WORDS. ZERO THE BLOCK OF FREE SPACE
LSH T1,2 ;GET THE OFFSET IN THE FREE SPACE
ADD T1,RESBAS ;ADD IN THE BASE ADDRESS OF FREE SPACE
MOVE T2,ASGREC ;GET THE NUMBER OF BLOCKS ASSIGNED
STOR T2,RSSIZ,(T1) ;STORE IT IN THE HEADER
IFN RESHSW,< ;IF DEBUGGING
MOVE T3,ASGCAL ;GET CALLER'S PC
STOR T3,RSCAL,(T1) ;PUT IT IN HEADER
SETONE RSINU,(T1) ;SET THE "IN USE" BIT
> ;END OF IFN RESHSW
HRRZ T3,ASGREF ;GET POOL # OF ASSIGNMENT
STOR T3,RSPOO,(T1) ;STORE IT IN THE HEADER
ADDI T1,RSHLEN ;RETURN POINTER TO FIRST FREE WORD
SETZM 0(T1) ;ZERO THE FIRST WORD OF THE BLOCK
LSH T2,2 ;NOW ZERO THE BLOCK
SUBI T2,RSHLEN ;GET NUMBER OF WORDS TO ZERO
HRL T3,T1 ;START AT FIRST WORD
HRRI T3,1(T1) ;WORD +1
SOS T2 ;GO TO
ADD T2,T1 ; END OF THE BLOCK
BLT T3,(T2) ;ZERO THE BLOCK
IFN RESHSW,< ;IF DEBUGGING
MOVEI T3,RESFLG ;GET THE "TRAILER FLAG"
STOR T3,RSFLG,(T2) ;PUT FLAG IN TRAILER WORD
MOVEI T3,-RSHLEN(T1) ;GET ADDR OF HEADER
STOR T3,RSHED,(T2) ;PUT IT IN TRAILER WORD
> ;END OF IFN RESHSW
RETSKP
;HERE WHEN THE FREE SPACE NEEDS TO BE EXPANDED. DO IT, AND THEN
;GO TRY AGAIN TO SATISFY USER'S REQUEST
ASGRE1: HLRZ T1,ASGREA ;GET THE PRIORITY
CALL GRORES ;TRY TO EXPAND THE FREE POOL
RETBAD () ;COULDNT GET ANY MORE
JRST ASGRE0 ;GOT SOME, GO SEE IF THIS WAS ENOUGH
;ROUTINE TO EXPAND THE RESIDENT FREE POOL
;ACCEPTS IN T1/ PRIORITY NUMBER (.RESP1, .RESP2, OR .RESP3)
; CALL GRORES
;RETURNS +1: COULD NOT GET ANY
; T1/ ERROR CODE
; +2: FOUND SOME
GRORES: STKVAR <<GRORET,2>>
CAIE T1,.RESP3 ;IN PROCESS CONTEXT?
SKIPE RESIFL ;OR, IS THIS DURING SYSTEM START UP?
JRST GRORE1 ;YES, PAGES CAN BE LOCKED DOWN
;HERE WHEN WE CAN'T TAKE A PAGE FAULT. THE ONLY WAY WE CAN GROW
;FREE SPACE IS TO EXPAND TO THE END OF THE LAST PAGE THAT IS LOCKED
;DOWN. RESFFB POINTS TO THE BEGINNING OF THE LAST FREE BLOCK. IT
;ALWAYS IS ON THE LAST LOCKED-DOWN PAGE. IF IT IS A MULTIPLE OF 200,
;THEN IT POINTS TO THE BEGINNING OF A PAGE, AND THE PREVIOUS ONE
;HAS ALREADY BEEN LOCKED DOWN. IN THAT CASE, FREE SPACE CAN'T BE
;EXPANDED WITHOUT RISKING A PAGE FAULT.
PUSH P,T3 ;SAVE T3
SETO T3, ;ASSUME PION
CONSO PI,PIPION ;IS PION?
TDZA T3,T3 ;NO PIOFF
PIOFF ;ENTER TOUCHY CODE
MOVE T1,RESFFB ;GET FIRST FREE BLOCK
TRNE T1,177 ;IS THERE ANY LEFT ON THIS PAGE?
CAIL T1,NRESFB ;OR ANY LEFT IN ENTIRE POOL?
JRST [ SKIPE T3 ;NO GIVE ERROR...WAS PION?
PION ;YES SO TURN IT BACK ON
POP P,T3 ;RESTORE T3
RETBAD (MONX05)] ;RETURN 'NO FREE SPACE'
MOVEI T2,200(T1) ;YES, GRAB THIS BLOCK
TRZ T2,177 ;GET POINTER TO NEXT FREE BLOCK
MOVEM T2,RESFFB ;STORE NEW POINTER
SKIPE T3 ;WAS PION?
PION
POP P,T3 ;RESTORE T3
JRST GRORE2 ;GO RETURN THIS BLOCK
;HERE WHEN PRIORITY IS SUCH THAT PAGE FAULTS ARE ALLOWED.
; * * BUG: NEED TO LOCK DOWN ONLY WHEN CROSS PAGE BOUNDARY.
; * * PAGES NEVER GET PROPERLY UNLOCKED.
GRORE1:
PUSH P,T3 ;SAVE T3
SETO T3, ;ASSUME PION
CONSO PI,PIPION ;IS PI ON?
TDZA T3,T3 ;NO SO SET FLAG
PIOFF ;GET A FULL PAGE (IF NECESSARY)
MOVE T1,RESFFB ;GET FIRST FREE BLOCK
CAIL T1,NRESFB ;ANY LEFT?
JRST [ SKIPE T3 ;NO...WAS PION?
PION ;YES
POP P,T3 ;RESTORE T3
RETBAD(MONX05)] ;RETURN 'NO FREE SPACE'
MOVEI T2,200(T1) ;GET THIS PAGE (OR PARTIAL BLOCK)
TRZ T2,177
MOVEM T2,RESFFB ;STORE NEW POINTER
SKIPE T3 ;WAS PION?
PION ;YES
POP P,T3 ;RESTORE T3
DMOVEM T1,GRORET ;STORE THE BLOCK NUMBER
LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK
ADD T1,RESBAS
CALL FPTA ;LOCK IT DOWN
CALL MLKPG ;...
DMOVE T1,GRORET ;GET BLOCK NUMBER BACK AGAIN
;..
;AT THIS POINT THE PAGE TO WHICH RESFFB PREVIOUSLY POINTED IS LOCKED
;DOWN. RESFFB HAS BEEN MOVED TO THE BEGINNING OF THE NEXT PAGE.
; T1/ RESFFB BEFORE THE EXPANSION
; T2/ RESFFB AFTER THE EXPANSION
;MAKE THE NEW BLOCK LOOK LIKE A BLOCK OF FREE SPACE. STORE THE POOL
;NUMBER AND BLOCK COUNT IN THE HEADER AND CALL RELRES.. THIS BLOCK
;IS ALWAYS RETURNED TO THE GENERAL POOL.
GRORE2: SUB T2,T1 ;GET THE SIZE OF THIS BLOCK
LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK
ADD T1,RESBAS ;...
STOR T2,RSSIZ,(T1) ;STORE SIZE IN THE HEADER
MOVEI T3,.RESGP ;GET NUMBER OF THE GENERAL POOL
STOR T3,RSPOO,(T1) ;STORE POOL NUMBER IN THE HEADER
MOVNS T2 ;FUDGE THE USE COUNT
ADDM T2,RESUTB+.RESGP ;FOR THE GENERAL POOL
ADDI T1,RSHLEN ;GET POINTER TO BLOCK FOR RELRES
TXO T1,RS%GRO ;SAY WE ARE GROWING
CALL RELRES ;RELEASE THIS BLOCK TO THE FREE POOL
RETSKP ;AND GIVE SUCCESS RETURN
;ROUTINE TO FIND AND MARK A BLOCK OF CONSECUTIVE FREE BITS IN A TABLE
;ACCEPTS IN T1/ NUMBER OF BITS NEEDED
; T2/ ADDRESS OF START OF BITTABLE
; T3/ LENGTH OF THE BITTABLE
; CALL GETBIT
;RETURNS +1: NOT ENOUGH AVAILABLE
; T1/ ERROR CODE
; +2: T1/ RELATIVE OFFSET OF FIRST BIT OBTAINED
GETBIT: SAVEP ;SAVE SOME WORK ACS
ASUBR <GETBIC,GETBIA,GETBIL>
GETBI1: MOVE P1,GETBIA ;SET UP FOR GETZ - P1=ADR OF BIT TABLE
MOVE P2,GETBIL ;P2=LENGTH OF BIT TABLE
MOVE P3,GETBIC ;P3=COUNT OF BITS NEEDED
CALL GETZ ;GET THE BITS
RETBAD (MONX05) ;NONE FOUND
CALL SETOS ;MARK THEM AS TAKEN, IF STILL AVAILABLE
JRST GETBI1 ;OPPS, GRABBED AT INTERRUPT LEVEL
HRRZ T1,P4 ;GOT IT, GET ADR OF FIRST WORD WITH 0'S
SUB T1,GETBIA ;GET RELATIVE POSITION IN TABLE
IMULI T1,^D36 ;GET BIT POSITION IN TABLE
MOVN T2,P5 ;GET BIT POSITION IN WORD
ADDI T1,^D36(T2) ;NOW HAVE RELATIVE POSITION
RETSKP ;GIVE SUCCESSFUL RETURN
;CO-ROUTINE FOR GETBIT TO FIND N CONSECUTIVE 0'S IN A TABLE
;ACCEPTS IN P1/ ADDRESS OF TABLE
; P2/ LENGTH OF TABLE
; P3/ NUMBER OF BITS NEEDED
; CALL GETZ
;RETURNS +1: NONE FOUND
; T1/ ERROR CODE
; +2: P1-P3 UNCHANGED
; P4 LOC OF WORD IN TABLE OF FIRST 0 BIT
; P5 BIT NUMBER WITHIN WORD OF FIRST 0 BIT
; WHERE POSTION=36 IF BIT 0, 1 IF BIT 35
;USE OF AC'S:
; P1 IS UPDATED AS CODE STEPS THROUGH TABLE
; T3 IS RUNNING COUNT OF 0'S
GETZ: MOVEI T4,^D36 ;SET UP LOCAL COUNT WITHIN WORD
SETCM T1,(P1) ;GET WORD TO INVESTIGATE
JUMPE T1,GETZ4 ;FULL IF 0
JUMPG T1,GETZ3 ;1ST BIT UNAVAILABLE IF POSITIVE
GETZ1: SETCA T1, ;SET BACK TO REAL CONTENTS
JFFO T1,GETZR ;COUNT THE NUMBER OF 0'S
MOVEI T2,^D36 ;36 OF THEM
GETZR: MOVE T3,T2 ;SHIFT COUNT
MOVEM P1,P4 ;SAVE POSITION IN P4
MOVEM T4,P5 ;SAVE COUNT WITHIN WORD TOO
GETZ2: CAIL T3,(P3) ;FOUND ENOUGH?
RETSKP ;YES, THEN DONE
SUBI T4,(T2) ;NO, DECREASE POSITION COUNTER
JUMPLE T4,GETZ5 ;ARE THERE 0'S ON END?
SETCA T1, ;NO, NOW WE WANT TO COUNT 1'S
LSH T1,1(T2) ;REMOVE BIT ALREADY LOOKED AT
JUMPE T1,GETZ4 ;GO IF THE REST OF THE WORD IS ALL 1'S
GETZ3: JFFO T1,.+1 ;GET NUMBER OF REAL 1'S
LSH T1,(T2) ;GET RID OF THEM
CAIN T4,^D36 ;FIRST POSITION IN WORD?
ADDI T4,1 ;YES, SUBTRACT REAL JFFO COUNT
SUBI T4,1(T2) ;DECREASE POSITION COUNT
JUMPG T4,GETZ1 ;TRY NEXT 0, IF ANY MORE
GETZ4: AOS P1 ;NO MORE, STEP TO NEXT WORD
SOJG P2,GETZ ;LOOP BACK IF THERE ARE ANY MORE WORDS
GETZE: RETBAD (MONX05) ;NO MORE
;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT A WORD HAD 0'S ON THE END
GETZ5: AOS P1 ;STEP TO NEXT WORD
SOJLE P2,GETZE ;IF NO MORE, THEN ERROR
SKIPGE T1,(P1) ;NEXT WORD POSITIVE?
JRST GETZ ;NO, THIS HOLE IS NOT BIG ENOUGH
JFFO T1,GETZ6 ;YES, COUNT THESE 0'S
MOVEI T2,^D36 ;36 OF THEM
GETZ6: ADDI T3,(T2) ;ADD THEM INTO THE RUNNING TOTAL
MOVEI T4,^D36 ;RESET POSITION COUNT
JRST GETZ2 ;AND TEST THIS HOLE
;CO-ROUTINE TO GETBIT TO MARK A BLOCK OF BITS AS "IN USE"
;ACCEPTS IN P3/ HOW MANY BITS IN BLOCK
; P4/ POINTER TO WORD CONTAINING FIRST 0
; P5/ POSITION OF FIRST 0
; CALL SETOS
;RETURNS +1: BITS WERE ALREADY IN USE
; +2: BITS SUCCESSFULLY MARKED AS "IN USE"
SETOS: MOVE T4,P4 ;WHERE
HRRZ T3,P3 ;COUNT
MOVE T1,P5 ;POSITION IN WORD
CALL BITMSK ;GENERATE A BIT MASK
IFE RESBSW,<
SETOS1:
PUSH P,T2 ;SAVE T2
SETO T2, ;ASSUME PION
CONSO PI,PIPION ;IS PI ON?
TDZA T2,T2 ;NO SO SET FLAG
PIOFF ;PREVENT INTERRUPTIONS FROM ABOVE
TDNE T1,(T4) ;BIT ALREADY ON?
JRST SETOS2 ;YES, GO CLEAN UP AND EXIT
IORM T1,(T4) ;NO, NOW MARK THESE AS IN USE
SKIPE T2 ;WAS PI ON?
PION ;THROUGH THE TOUCHY PART FOR NOW
POP P,T2 ;RESTORE T2
JUMPLE T3,RSKP ;ALL DONE?
CALL BITMS2 ;NO, CONTINUE WITH NEXT WORD IN BLOCK
JRST SETOS1 ;BIT MASK OBTAINED, GO MARK THE BITS
SETOS2:
SKIPE T2 ;WAS PI ON?
PION ;BIT ALREADY IN USE, MUST UNDO OTHERS
POP P,T2 ;RESTORE T2
PUSH P,T3 ;SAVE CURRENT COUNT AS A STOPPING POINT
MOVE T4,P4 ;GET START OF BLOCK AGAIN
HRRZ T3,P3 ;AND ORIGINAL COUNT
MOVE T1,P5 ;AND POSITION OF FIRST 0 BIT
CALL BITMSK ;GET A BIT MASK
SETOS3: CAMN T3,(P) ;ARE WE UP TO POINT OF LOSSAGE?
JRST SETOS4 ;YES
ANDCAM T1,(T4) ;NO, CLEAR THESE BITS
CALL BITMS2 ;CONTINUE THROUGH THE BLOCK
JRST SETOS3 ;LOOP BACK UNTIL ALL CLEANED UP
SETOS4: POP P,(P) ;CLEAN UP STACK
RET ;AND GIVE NON-SKIP RETURN
> ;END OF IFE RESBSW
IFN RESBSW,<
SETOS1: PUSH P,T2 ;SAVE SOME ACS
PUSH P,T3 ;THAT WE NEED
MOVE T2,T4 ;COPY ADDRESS
LSH T2,-PGSFT ;GET PAGE NUMBER OF ADDRESS
MOVX T3,PTWR ;AND GET WRITE-FLAG
PUSH P,T3 ;SAVE T3
SETO T3, ;ASSUME PION
CONSO PI,PIPION ;PI ON?
TDZA T3,T3 ;NO
PIOFF ;PREVENT INTERRUPTIONS FROM ABOVE
EXCH T3,0(P) ;SAVE FLAG RESTORE T3
TDNE T1,(T4) ;BIT ALREADY ON?
JRST SETOS2 ;YES, GO CLEAN UP AND EXIT
IORM T3,MMAP(T2) ;SET WRITE BIT IN MMAP
CLRPT (T4) ;MAKE IT SEEN BY HARDWARE
IORM T1,(T4) ;NOW MARK THESE AS IN USE
ANDCAM T3,MMAP(T2) ;CLEAR WRITE-ENABLE AGAIN
CLRPT (T4) ;MAKE THAT SEEN AGAIN
POP P,T3 ;GET PI STATUS FLAG
SKIPE T3 ;WAS PION?
PION ;YES...THROUGH THE TOUCHY PART FOR NOW
POP P,T3 ;RESTORE ACS
POP P,T2 ;THAT WE USED
JUMPLE T3,RSKP ;ALL DONE?
CALL BITMS2 ;NO, CONTINUE WITH NEXT WORD IN BLOCK
JRST SETOS1 ;BIT MASK OBTAINED, GO MARK THE BITS
SETOS2:
POP P,T3 ;GET PI STATUS FLAG
SKIPE T3 ;WAS PION?
PION ;YES...BIT ALREADY IN USE, MUST UNDO OTHERS
POP P,T3 ;RESTORE ACS
POP P,T2 ;THAT WE USED
PUSH P,T3 ;SAVE CURRENT COUNT AS A STOPPING POINT
MOVE T4,P4 ;GET START OF BLOCK AGAIN
HRRZ T3,P3 ;AND ORIGINAL COUNT
MOVE T1,P5 ;AND POSITION OF FIRST 0 BIT
CALL BITMSK ;GET A BIT MASK
SETOS3: CAMN T3,(P) ;ARE WE UP TO POINT OF LOSSAGE?
JRST SETOS4 ;YES
PUSH P,T2 ;SAVE ACS AGAIN
PUSH P,T3 ;THAT WE USE
MOVE T2,T4 ;GET ADDRESS
LSH T2,-PGSFT ;CONVERT TO PAGE NUMBER
MOVX T3,PTWR ;GET WRITE BIT
PUSH P,T3 ;SAVE T3
SETO T3, ;ASSUME PION
CONSO PI,PIPION ;IS PI PN?
TDZA T3,T3 ;NO
PIOFF ;NO PI'S NOW
EXCH T3,0(P) ;RESTORE T3..SAVE PI STATE FLAG
IORM T3,MMAP(T2) ;WRITE-ENABLE BITTABLE
CLRPT (T4) ;LET HARDWARE KNOW
ANDCAM T1,(T4) ;CLEAR THESE BITS
ANDCAM T3,MMAP(T2) ;WRITE-PROTECT AGAIN
CLRPT (T4) ;LET IT BE KNOWN
POP P,T3 ;GET PI STATE FLAG
SKIPE T3 ;WAS PI ON?
PION ;YES...PI'S OK AGAIN
POP P,T3 ;RESTORE ACS
POP P,T2 ;THAT WE SAVED
CALL BITMS2 ;CONTINUE THROUGH THE BLOCK
JRST SETOS3 ;LOOP BACK UNTIL ALL CLEANED UP
SETOS4: POP P,(P) ;CLEAN UP STACK
RET ;AND GIVE NON-SKIP RETURN
> ;END OF IFN RESBSW
;ROUTINE TO RETURN RESIDENT FREE SPACE TO THE FREE POOL
;ACCEPTS IN T1/ ADDRESS OF THE BLOCK (RS%GRO INDICATES "GROWING")
; CALL RELRES
;RETURNS +1: ALWAYS
RELRES::MOVE T2,(P) ;GET PC OF CALLER
STKVAR <RELGRO,RELRAD,RELCAL>
SETZM RELGRO ;ASSUME "NOT GROWING"
TXZE T1,RS%GRO ;ARE WE REALLY GROWING?
SETOM RELGRO ;YES, SET THE "GROWING" FLAG
MOVEM T1,RELRAD ;SAVE ADDR PROVIDED BY USER
MOVEM T2,RELCAL ;SAVE PC OF CALLER
IFN RESBSW,< ;USE RING BUFFER TO RECORD RELEASING
HRROI T2,-RSHLEN(T1) ;GET ADDRESS OF BLOCK, AND -1 AS FLAG
CALL XXXPUT ;STORE IT
MOVE T2,-RSHLEN(T1) ;GET HEADER OF BLOCK
CALL XXXPUT ;STORE IT
MOVE T2,RELCAL ;GET CALLER PC
CALL XXXPUT ;STORE IT
MOVE T2,FORKX ;GET FORK NUMBER
CALL XXXPUT ;STORE IT
MOVE T2,TODCLK ;GET TIME
CALL XXXPUT ;STORE IT
> ;END OF IFN RESBSW
;CHECK FOR "ADDRESS WITHIN RESIDENT FREE SPACE"
MOVE T2,RESBAS ;GET THE BEGINNING
CAMGE T1,T2 ;BEYOND IT?
JRST RESOUT ;NO, OUT OF BOUNDS
MOVEI T2,RESFRZ ;GET THE END
CAML T1,T2 ;BEFORE IT?
JRST RESOUT ;NO, OUT OF BOUNDS
;CHECK FOR "LEGAL BLOCK ADDRESS"
SUBI T1,RSHLEN ;POINT TO HEADER
TRNE T1,3 ;ON A 4-WORD BOUNDARY?
JRST [ MOVE T1,RELRAD ;NO. GET THE BAD ADDRESS
MOVE T2,RELCAL ; AND THE CALLER
BUG(RESBAD,<<T1,BADADR>,<T2,CALLER>>)
RET]
;CHECK FOR "CONSISTENT BLOCK" - HEADER AND TRAILER ARE VERIFIED
MOVE T4,RELGRO ;GET THE "GROWING FLAG
JUMPN T4,RELRE1 ;IF GROWING, MOVE ON
LOAD T4,RSPOO,(T1) ;GET THE POOL NUMBER
CAILE T4,0 ;IS IT
CAIL T4,RESQTL ; VALID?
JRST RESINC ;NO
LOAD T4,RSSIZ,(T1) ;GET THE NUMBER OF BLOCKS
SKIPG T4 ;IS IT POSSIBLE?
JRST RESINC ;NO
IFN RESHSW,< ;IF DEBUGGING
LSH T4,2 ;CONVERT TO WORDS
ADDI T4,-1(T1) ;POINT TO TRAILER WORD
LOAD T2,RSFLG,(T4) ;GET THE FLAG
CAIE T2,RESFLG ;OK?
JRST RESINC ;NO
LOAD T2,RSHED,(T4) ;GET THE ADDR OF THE HEADER
HRRZ T4,T1 ;SAME SECTION
CAME T2,T4 ;OK?
JRST RESINC ;NO
> ;END OF IFN RESHSW
;UPDATE COUNTS AND FREE THE BLOCK - CHECKS FOR "BLOCK ALREADY FREE"
RELRE1: MOVE T2,T1 ;SAVE THE HEADER ADDRESS
SUB T2,RESBAS ;GET OFFSET INTO FREE SPACE
LSH T2,-2 ;GET 4-WORD BLOCK NUMBER
IDIVI T2,^D36 ;GET POSITION OF BLOCK IN BIT TABLE
LOAD T4,RSPOO,(T1) ;GET POOL NUMBER
LOAD T1,RSSIZ,(T1) ;GET NUMBER OF 4-WORD BLOCKS
ADDM T1,RESUTB(T4) ;ADD BACK THE SPACE FREED TO USAGE TABLE
ADDM T1,RESFRE ;COUNT UP THE FREE COUNT
MOVEI T4,RESBTB(T2) ;GET ADR OF FIRST WORD OF BLOCK
EXCH T3,T1 ;SET UP FOR CALL TO CLRBTS
MOVEI T2,^D36 ;GET BIT POSITION IN CORRECT FORMAT
SUBM T2,T1 ; FOR CLRBTS
CALL CLRBTS ;FREE UP THIS SPACE
JRST [MOVE T1,RELRAD ;ALREADY FREE. GET THE BAD ADDRESS
MOVE T2,RELCAL ; AND THE CALLER
BUG(RESBAZ,<<T1,BADADR>,<T2,CALLER>>)
RET]
MOVE T1,RELRAD ;GET ADDRESS PASSED BY CALLER
SUBI T1,RSHLEN ;POINT TO HEADER WORD
IFN RESHSW,< ;IF DEBUGGING
SETZRO RSINU,(T1) ;TURN OFF "IN USE" BIT
> ;END OF IFN RESHSW
RET
RESOUT: MOVE T1,RELRAD ;GET BAD ADDRESS
MOVE T2,RELCAL ;GET CALLER
BUG (RESBND,<<T1,BADADR>,<T2,CALLER>>)
RET
RESINC: MOVE T1,RELRAD ;GET BADADR
MOVE T2,RELCAL ;GET CALLER
BUG (RESCHK,<<T1,BADADR>,<T2,CALLER>>)
RET
;CLRBTS - ROUTINE TO CLEAR BITS IN A BIT TABLE
;ACCEPTS IN T1/ POSITION WITHIN WORD OF FIRST 0 (36=BIT 0, 1=BIT 35)
; T3/ COUNT OF THE NUMBER OF BITS TO BE CLEARED
; T4/ ADDRESS OF FIRST WORD CONTAINING THE BLOCK OF BITS
; CALL CLRBTS
;RETURNS +1: SOME OF THE BITS WERE ALREADY ZERO
; +2: SUCCESSFUL
CLRBTS: CALL BITMSK ;GENERATE A BIT MASK FOR THE FIRST WORD
IFE RESBSW,<
CLRBT1:
PUSH P,T3 ;SAVE T3
SETO T3, ;ASSUME PI ON
CONSO PI,PIPION ;IS PI ON
TDZA T3,T3 ;NO
PIOFF ;YES...ENTER INTERLOCKED CODE
MOVE T2,(T4) ;GET THE WORD TO BE CLEARED
TDC T2,T1 ;SEE IF ANY OF THE BITS ARE ALREADY 0
TDNE T2,T1 ;...
JRST [ SKIPE T3 ;WAS PI ON?
PION ;BITS ARE ALREADY 0
POP P,T3 ;RESTORE T3
RET] ;GIVE FAILURE RETURN WITHOUT DOING MORE
ANDCAM T1,(T4) ;CLEAR THE BITS
SKIPE T3 ;WAS PI ON?
PION ;THROUGH INTERLOCKED CODE
POP P,T3 ;RESTORE T3
JUMPLE T3,RSKP ;ANY MORE TO BE CLEARED?
CALL BITMS2 ;YES, GET NEXT BIT MASK
JRST CLRBT1 ;LOOP BACK FOR REST OF BITS
> ;END OF IFE RESBSW
IFN RESBSW,<
CLRBT1: PUSH P,T3 ;SAVE AN AC
MOVE T3,T4 ;COPY ADDRESS
LSH T3,-PGSFT ;CONVERT TO PAGE NUMBER
PUSH P,T3 ;SAVE T3
SETO T3, ;ASSUME PI ON
CONSO PI,PIPION ;IS PI ON?
TDZA T3,T3 ;NO
PIOFF ;YES...ENTER INTERLOCKED CODE
EXCH T3,0(P) ;SAVE PI STATE...RESTORE T3
MOVE T2,(T4) ;GET THE WORD TO BE CLEARED
TDC T2,T1 ;SEE IF ANY OF THE BITS ARE ALREADY 0
TDNE T2,T1 ;...
JRST [ POP P,T3 ;GET PI STATE FLAG
SKIPE T3 ;WAS PI ON?
PION ;YES...BITS ARE ALREADY 0
POP P,T3 ;RESTORE AC
RET] ;GIVE FAILURE RETURN WITHOUT DOING MORE
MOVX T2,PTWR ;GET WRITE FLAG
IORM T2,MMAP(T3) ;MAKE PAGE WRITABLE
CLRPT (T4) ;TELL HARDWARE
ANDCAM T1,(T4) ;CLEAR THE BITS
ANDCAM T2,MMAP(T3) ;WRITE-PROTECT AGAIN
CLRPT (T4) ;LET HARDWARE KNOW
POP P,T3 ;GET PI STATE FLAG
SKIPE T3 ;WAS PI ON?
PION ;YES...THROUGH INTERLOCKED CODE
POP P,T3 ;RESTORE AC
JUMPLE T3,RSKP ;ANY MORE TO BE CLEARED?
CALL BITMS2 ;YES, GET NEXT BIT MASK
JRST CLRBT1 ;LOOP BACK FOR REST OF BITS
> ;END OF IFN RESBSW
;ROUTINE TO BUILD A BIT MASK FOR N BITS WITHIN A WORD
;ACCEPTS IN T1/ POSITION OF FIRST BIT (36=BIT 0, 1=BIT 35)
; T3/ COUNT OF BITS IN MASK
; T4/ POSITION IN BIT TABLE OF THIS WORD
; CALL BITMSK
;RETURNS +1: T1/ MASK
; T3/ REMAINING COUNT (T3 .LE. 0 MEANS DONE)
; T4/ UPDATED TO POINT TO NEXT WORD IN TABLE (BITMS2)
BITMSK: PUSH P,T1 ;SAVE POSITION
MOVN T1,T3 ;GET NEGATIVE COUNT
CAILE T3,^D36 ;MORE THAN 1 WORD?
MOVNI T1,^D36 ;YES, SETTLE FOR ONE WORD (OR LESS)
MOVSI T2,400000 ;SET UP TO PROPAGATE A MASK
ASH T2,1(T1) ;GET THE RIGHT NUMBER OF BITS IN MASK
SETZ T1, ;CLEAR ANSWER AC
LSHC T1,@0(P) ;POSITION THE BITS PROPERLY IN T1
SUB T3,0(P) ;REDUCE THE COUNT TO THE NEW VALUE
POP P,(P) ;CLEAN UP THE STACK
RET ;AND EXIT WITH MASK IN T1
;SECONDARY ROUTINE FOR BIT MASK GENERATION. START WITH BIT 0.
;SAME OPERATION AS BITMSK EXCEPT THAT T4 IS INCREMENTED ON EXIT
BITMS2: SETO T1, ;MASK STARTS AT BIT 0
MOVNI T2,-^D36(T3) ;SET UP SHIFT
CAIGE T3,^D36 ;DONT SHIFT IF MORE THAN ONE WORD
LSH T1,(T2) ;POSITION THE MASK
SUBI T3,^D36 ;UPDATE THE COUNT
AOJA T4,R ;UPDATE TABLE ADDRESS AND RETURN
;INITIALIZATION ROUTINE FOR THE RESIDENT FREE POOL
RESFPI::MOVEI T1,RESBTL ;GET LENGTH OF THE RESIDENT BIT TABLE
RESFP1: SETOM RESBTB-1(T1) ;MARK ALL BITS AS "IN USE"
SOJG T1,RESFP1 ;LOOP FOR ALL WORDS IN THE BIT TABLE
MOVE T1,[RESFRP] ;GET ADDRESS OF START OF FREE POOL
MOVEM T1,RESBAS
SETZM RESFFB ;FIRST FREE BLOCK IS BLOCK # 0
SETZM RESFRE ;NO FREE SPACE YET
MOVEI T1,RESFRM ;GET INITIAL VALUE OF MINIMUM
MOVEM T1,RESMIN
MOVEI T1,RESFRA ;SET UP THE AVERAGE LEVEL
MOVEM T1,RESAVE ;THIS LEVEL IS MAINTAINED BY JOB 0
MOVSI T1,-RESQTL ;NOW SET UP THE USAGE TABLE
RESFP2: MOVE T2,RESQTB(T1) ;GET QUOTA
MOVEM T2,RESUTB(T1) ;SAVE AS USAGE
AOBJN T1,RESFP2 ;LOOP TIL TABLE INITIALIZED
RET ;ALL SET UP
RESQTB: 0 ;THIS POOL NOT USED
.RESGQ/4 ;GENERAL POOL QUOTA
.RESTQ/4 ;TERMINAL POOL QUOTA
.RESNQ/4 ;NETWORK POOL QUOTA
.RSTMQ/4 ;TIMER POOL QUOTA
RESQTL==:.-RESQTB ;THIS VALUE MUST MATCH THE ONE IN STG
;ROUTINE CALLED BY JOB 0 TO LOCK AND UNLOCK FREE SPACE
; CALL RESLCK
;RETURNS +1: ALWAYS
SWAPCD
RESLCK::MOVE T1,RESAVE ;SEE HOW CLOSE TO THE AVERAGE WE ARE
CAMG T1,RESFRE ;DO WE HAVE ENOUGH LOCKED DOWN?
JRST RESLK1 ;YES, GO SEE IF SOME NEEDS UNLOCKING
MOVEI T1,.RESP3 ;NEED MORE, GO GET SOME
CALL GRORES ;AT PROCESS LEVEL SO PAGE FAULTS ALLOWED
RET ;COULD NOT GET ANY, JUST RETURN
JRST RESLCK ;GO SEE IF THIS WAS ENOUGH
RESLK1: MOVE T1,RESFRE ;NOW CHECK IF SOME NEEDS UNLOCKING
SUBI T1,PGSIZ/4 ;NUMBER BLOCKS ON A PAGE
CAMG T1,RESAVE ;ARE WE WELL ABOVE THE AVERAGE?
RET ;NO, THEN EXIT
MOVE T3,RESFFB ;YES, TRY TO UNLOCK SOME
MOVE T1,T3 ;REMEMBER THE FIRST FREE BLOCK IN T3
IDIVI T1,^D36 ;BUILD A BYTE POINTER TO FIRST BIT
MOVNS T2 ;GET BIT NUMBER IN WORD
SKIPN T2 ;IS THIS THE FIRST BIT IN A WORD
SOSA T1 ;YES, BACK UP TO LAST BIT OF PREVIOUS WORD
ADDI T2,^D36 ;GET BIT POSITION WITHIN WORD
ROT T2,-6 ;USE THIS AS THE BIT POSITION
TLO T2,0100+T1 ;ONE BIT BYTE POINTER INDEXED BY T1
ADDI T1,RESBTB ;GET OFFSET INTO BIT TABLE
JRST RESLK3 ;GO TO RESMON FOR CRITICAL CODE
;RESIDENT CODE TO DO NON-PI FUNCTIONS
RESCD
RESLK3: NOSKED
PUSH P,T1 ;SAVE T1
SETO T1, ;ASSUME PI ON
CONSO PI,PIPION ;IS PI ON?
TDZA T1,T1 ;NO
PIOFF ;YES...MUST BE DONE INTERLOCKED
EXCH T1,0(P) ;SAVE PI STATE FLAG RESTORE T1
CAME T3,RESFFB ;STILL HAVE SAME FIRST FREE BLOCK?
JRST [ EXCH T1,0(P) ;SAVE T1 GET PI STATE FLAG
SKIPE T1 ;WAS PI ON?
PION ;YES...GO TRY AGAIN
POP P,T1 ;RESTORE T1 CLEAN UP STACK
OKSKED
JRST RESLK1]
LDB T4,T2 ;GET THE BIT
JUMPN T4,[EXCH T1,0(P) ;SAVE T1 RESTORE PI STATE FLAG
SKIPE T1 ;WAS PI ON?
PION ;YES...IF = 1, THEN IN USE SOMEWHERE
POP P,T1 ;RESTORE T1 CLEAN UP STACK
OKSKED
RET] ;SO RETURN
MOVEI T4,1 ;NOT IN USE, MARK IT TAKEN
IFN RESBSW,<
PUSH P,T3 ;SAVE AC
MOVX T3,PTWR ;GET WRITE FLAG
IORM T3,MMAP+<RESBTB/PGSIZ> ;SET IT
CLRPT RESBTB ;LET HARDWARE KNOW
> ;END OF IFN RESBSW
DPB T4,T2 ;...
IFN RESBSW,<
ANDCAM T3,MMAP+<RESBTB/PGSIZ> ;CLEAR WRITE-ENABLE
CLRPT RESBTB ;LET HARDWARE KNOW
POP P,T3 ;RESTORE AC
> ;END OF IFN RESBSW
SOS RESFRE ;COUNT DOWN THE FREE COUNT
SOS T1,RESFFB ;AND REMOVE IT FROM FREE POOL
EXCH T1,0(P) ;SAVE T1 RESTORE PI STATE FLAG
SKIPE T1 ;WAS PI ON?
PION ;THROUGH INTERLOCKED CODE
POP P,T1 ;RESTORE T1 CLEAN UP STACK
JRST RESLK4 ;NOW, BACK TO SWPMON
;RETURN TO SWAPPABLE CODE FOR PI FUNCTIONS
SWAPCD
RESLK4: LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK
ADD T1,RESBAS ;...
TRNE T1,777 ;IS THIS ON A PAGE BOUNDRY?
JRST RESLK2 ;NO, CANNOT UNLOCK THIS PAGE
CALL FPTA ;YES, THIS PAGE CAN NOW BE UNLOCKED
CALL MULKPG ;UNLOCK IT
RESLK2: OKSKED
JRST RESLK1 ;GO SEE IF MORE WORK NEEDED
;ROUTINE TO ASSIGN SPACE FROM THE FREE POOL
;ACCEPTS IN T1: DESIRED BLOCK SIZE
; CALL ASGSWP
;RETURNS +1: NOT ENOUGH ROOM, ERROR CODE IN T1
; +2: BLOCK ASSIGNED
; T1/ POINTER TO ASSIGNED BLOCK
ASGSWS::TDZA T3,T3 ;REMEMBER THIS ENTRY
ASGSWP::SETOM T3 ;REMEMBER THIS ENTRY
STKVAR <FLAG> ;PLACE TO HOLD ENTRY TYPE
MOVEM T3,FLAG ;SAVE IT
MOVE T2,T1 ;GET SIZE IN T2 FOR CALL TO ASGFRE
MOVEI T1,SWPFRE ;GET POINTER TO FREE SPACE HEADER
CALL ASGFRE ;GET THE SPACE
RETBAD (MONX06) ;NOT ENOUGH ROOM
HRRZS T2,0(T1) ;INITIALIZE SPACE TO 0'S
CAIG T2,1 ;MORE THAN 1 WORD?
JRST ASGSW0 ;NO. DONE
SETZM 1(T1) ;YES, CLEAR FIRST WORD AFTER LENGTH
HRLI T3,1(T1) ;SET UP A BLT POINTER
HRRI T3,2(T1) ;...
MOVEI T4,0(T1) ;GET POINTER TO BLOCK
ADDI T4,0(T2) ;GET POINTER TO END OF BLOCK + 1
CAILE T2,2 ;IS BLOCK LESS THAN 3 WORDS LONG?
BLT T3,-1(T4) ;NO, ZERO BLOCK (BUT NOT LENGTH WORD)
ASGSW0: SKIPE FLAG ;WANT TO STACK IT?
RETSKP ;NO
MOVEM T1,FLAG ;SAVE ADDRESS
MOVEI T2,STKCD4 ;ENTRY TYPE
CALL JSBSTK ;STACK IT
MOVE T1,FLAG ;GET BACK BLOCK ADDRESS
RETSKP ;RETURN WITH POINTER IN T1
;ROUTINE TO RELEASE A BLOCK TO THE FREE POOL
;ACCEPTS IN T1/ ADR OF BLOCK TO BE RELEASED
; T2/ LENGTH OF BLOCK
; CALL RELSWP
;RETURNS +1: ALWAYS - BLOCK RELEASED
; OR
;ACCEPTS IN T1: ADDRESS OF BLOCK TO BE RELEASED
; CALL RELMES
;RETURNS +1: ALWAYS - BLOCK RELEASED
;FIRST, ROUTINE TO UNSTACK ENTRY
RELMSS::PUSH P,T1 ;SAVE DATUM
MOVEI T2,STKCD4 ;TYPE
CALL JSFRMV ;REMOVE ENTRY
POP P,T1 ;RESTORE DATUM
JRST RELMES ;AND PROCEED
RELSWP::HRRZM T2,0(T1) ;GLOBAL CALL WITH LENGTH IN T2
JUMPLE T2,[ BUG(RELFRM)]
RELMES::MOVE T2,T1 ;SET UP FOR CALL TO RELFRE
MOVEI T1,SWPFRE ;GET ADR OF FREE LIST HEADER
HRRZS 0(T2) ;CLEAR LEFT HALF OF BLOCK SIZE WORD
CALLRET RELFRE ;RELEASE THE BLOCK AND RETURN
TNXEND
END