Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/free.mac
There are 49 other files named free.mac in the archive. Click here to see a list.
;<1BOSACK>FREE.ORG.6, 5-Jun-78 18:44:11, EDIT BY BOSACK
;<3A.MONITOR>FREE.MAC.7, 8-Jun-78 11:11:53, EDIT BY MILLER
;CHANGE RESLCK TO USE DIFFERENT THRESHOLD THAN ASGFRE
;<3A.MONITOR>FREE.MAC.6, 8-Jun-78 10:29:05, EDIT BY MILLER
;MAKE NON-PI FUNCTIONS OF RESLCK RESIDENT
;<3.SM10-RELEASE-3>FREE.MAC.5, 6-Jan-78 13:39:49, EDIT BY ENGEL
;fix for tco #1888 - remove entries for current level only
;<3.SM10-RELEASE-3>FREE.MAC.4, 20-Dec-77 15:17:51, EDIT BY MILLER
;FIX TYPEOS
;<3.SM10-RELEASE-3>FREE.MAC.3, 20-Dec-77 15:02:16, EDIT BY MILLER
;FIX BUG IN CODE THAT MOVES THE JSB STACK. MUST PRESERVE ENTRY COUNT
;<ENGEL>FREE.MAC.1, 13-Dec-77 10:37:46, EDIT BY ENGEL
;TCO #1888 - FOR NESTED INTERRUPTS RELEASE ONLY CURRENT OR HIGHER STACK ENTRIES
;<3-MONITOR>FREE.MAC.89, 7-Nov-77 13:02:10, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>FREE.MAC.88, 12-Oct-77 13:47:20, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>FREE.MAC.87, 15-Aug-77 19:29:19, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.86, 23-Jul-77 22:12:02, EDIT BY CROSSLAND
;<3-NSW-MONITOR>FREE.MAC.1, 23-Jul-77 15:53:22, EDIT BY CLEMENTS
;<3-MONITOR>FREE.MAC.85, 30-Jun-77 13:51:50, EDIT BY HURLEY
;MAKE ASGFRE ZERO THE BLOCK CORRECTLY
;<3-MONITOR>FREE.MAC.84, 7-Jun-77 16:40:11, EDIT BY HURLEY
;MAKE ASGRES WORK ON MODEL B
;<3-MONITOR>FREE.MAC.83, 2-May-77 20:32:28, EDIT BY BOSACK
;<3-MONITOR>FREE.MAC.82, 22-Mar-77 11:41:49, EDIT BY HURLEY
;MAKE ASGRES REMEMBER WHICH POOL THE STORAGE CAME FROM
;<3-MONITOR>FREE.MAC.81, 1-Mar-77 11:34:39, EDIT BY HURLEY
;ZERO THE RESIDENT FREE BLOCKS IN ASGRES
;<3-MONITOR>FREE.MAC.80, 24-Feb-77 10:22:37, EDIT BY MILLER
;ADD LOGICAL LINK POOL
;<3-MONITOR>FREE.MAC.79, 23-Feb-77 19:44:53, EDIT BY HALL
;TCO 1740 - ADD UNLOCKING OF TELETYPE LOCKS TO JSB STACK PROCESSING
;<3-MONITOR>FREE.MAC.78, 15-Feb-77 15:02:57, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.77, 15-Feb-77 14:37:18, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.76, 14-Feb-77 14:42:25, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.75, 14-Feb-77 11:25:26, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.74, 11-Feb-77 09:41:52, EDIT BY HURLEY
;ADDED JOB 0 ROUTINE TO GROW AND SHRINK RESIDENT FREE POOL
;<3-MONITOR>FREE.MAC.73, 10-Feb-77 17:28:05, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.72, 10-Feb-77 13:38:31, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.71, 9-Feb-77 18:40:41, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.70, 9-Feb-77 17:07:01, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.69, 8-Feb-77 16:20:14, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.68, 3-Feb-77 15:37:10, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.67, 3-Feb-77 12:20:58, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.66, 28-Jan-77 10:42:54, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.65, 28-Jan-77 10:14:15, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.64, 28-Jan-77 10:00:07, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.63, 27-Jan-77 19:49:17, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.62, 27-Jan-77 17:16:09, EDIT BY HURLEY
;TCO 1729 - ADD ROUTINE TO ASSIGN RESIDENT FREE SPACE
;<3-MONITOR>FREE.MAC.61, 27-Dec-76 17:32:31, EDIT BY HURLEY
;<3-MONITOR>FREE.MAC.60, 1-Dec-76 18:57:44, Edit by MCLEAN
;<3-MONITOR>FREE.MAC.59, 1-Dec-76 01:13:42, Edit by MCLEAN
;<3-MONITOR>FREE.MAC.58, 27-Nov-76 20:27:44, Edit by MCLEAN
;<2-MONITOR>FREE.MAC.56, 5-Nov-76 13:20:11, Edit by HESS
;FIX ASGJFS AND ASGPGS ENTRIES
;<1B-MONITOR>FREE.MAC.2, 8-MAY-76 13:00:46, EDIT BY MILLER
;TCO 1284. CHECK FOR BLOCK OF LENGTH 1 AT ASGFRE
;<1B-MONITOR>FREE.MAC.1, 6-MAY-76 14:59:47, EDIT BY MILLER
;TCO 1280. UNMAP JSB PAGES WHEN RETURNED
;<2MONITOR>FREE.MAC.54, 16-JAN-76 17:47:50, EDIT BY MURPHY
;<2MONITOR>FREE.MAC.53, 23-DEC-75 12:49:16, EDIT BY LEWINE
;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 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
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::CAMLE B,2(A) ; Any possibility of success?
RET ; No. return immediately
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
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)
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
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
LOCK 1(A)
HRRZ D,0(A)
JUMPE D,RELFR0 ; Jump if old style free block
HLRZ D,4(A)
HRRZ A,4(A)
CAILE D,0(B)
CAILE A,0(B)
JRST RELFRA ;LOSSAGE - OUT OF RANGE
MOVE A,0(P)
RELFR0: PUSH P,B
HRLI B,0 ;SOME FIX NEEDED HERE TO KEEP OUT OF SEC 0 ***!!
HLLM B,0(P)
MOVE B,-1(P)
RELFR1: HLRZ C,0(B) ; Get loc of next block
JUMPE C,RELFR2 ; End of list
CAML C,0(P)
JRST RELFR2 ; Or above block being returned
MOVE B,C
JRST RELFR1
RELFRA: BUG(CHK,RELRNG,<RELFRE: BLOCK OUT OF RANGE>)
POP P,A
UNLOCK 1(A)
RET
RELFR2: CAMN C,0(P) ; Releasing a block already released?
JSP CX,RELFRB ;YES, LOSSAGE
CAIN A,0(B) ;THIS FIRST BLOCK ON FREE LIST?
JRST RELFR6 ;YES
HRRZ D,0(B) ;COMPUTE END OF PREVIOUS BLOCK
ADD D,B
CAMLE D,0(P) ;PREVIOUS BLOCK OVERLAPS ONE BEING RELEASED?
JSP CX,RELFRB ;YES, LOSSAGE
RELFR6: JUMPE C,RELFR7 ;AT END OF FREE LIST?
HRRZ D,0(P) ;COMPUTE END OF THIS BLOCK
ADD D,@0(P)
CAMLE D,C ;OVERLAPS NEXT BLOCK ON FREE LIST?
JSP CX,RELFRB ;YES, LOSSAGE
RELFR7: HRRZ D,@0(P)
ADDM D,2(A) ; Augment count of remaining storage
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)
RELFR5: MOVE C,0(P)
HRLM C,0(B)
HRRZ D,0(B) ; Length of predecessor
ADD D,B ; End of predecessor
CAME D,C ; Same as new block
JRST RELFR4 ; No, done
MOVE C,0(C)
HLLM C,0(B)
HRRZS C
ADDM C,0(B)
RELFR4: UNLOCK 1(A)
POP P,B
POP P,A
RET
RELFR3: HRLM C,@0(P) ; Point returned block to successor
JRST RELFR5
RELFRB: UNLOCK (<1(A)>)
BUG(CHK,RELBAD,<RELFRE-BAD BLOCK BEING RELEASED>)
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
;ASGPG1 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
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
RET ; No words left
ASGPG2: MOVN B,B
MOVSI A,400000
ROT A,(B)
ANDCAM A,JBCOR(C) ; Mark as used
UNLOCK JBCLCK
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
CALL ASGPAG ; Get another page of job storage
JRST ASGJF2 ; No pages left
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
MOVE B,A
MOVEI A,JSBFRE
CALL RELFRE ; Release the new block
POP P,C
POP P,B
JRST ASGJF0 ; Try again
ASGJF2: 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
>
;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
;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
HRLI A,-1(A) ;FORM BLT
SETZM A,-1(A) ;GET A ZERO
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/ FORK HANDLE
; 2/ PSIPIB 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
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
CAME 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 SATCK 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
MOVEM A,SAVDTM
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
;ROUTINE TO ASSIGN RESIDENT FREE SPACE
;ACCEPTS IN T1/ PRI ,, LEN
; T2/ FLAGS ,, POOL #
; CALL ASGRES
;RETURNS +1: FAILED TO GET THE REQUESTED SPACE
; +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
; .RESTP TERMINAL POOL - USED FOR ALL TERMINAL RELATED
; STORAGE
; .RESEP ERROR POOL - USED BY SYSERR AND ITS FRIENDS
; .RESNP NETWORK POOL - USED BY DECNET MODULES
; .RSTMP TIMER POOL - USED BY TIMER JSYS
RESCD
ASGRES::ASUBR <ASGREA,ASGREF,ASGREC>
HRRZI T1,4(T1) ;CONVERT TO THE # OF 4 WORD BLOCKS
ASH T1,-2 ; PLUS 1 WORD FOR THE LENGTH
MOVEM T1,ASGREC ;SAVE THE COUNT OF BLOCKS NEEDED
HRRZ T2,ASGREF ;GET POOL NUMBER
CAIL T2,RESQTL ;IS THIS A LEGAL NUMBER?
JRST [ BUG(CHK,ASGREQ,<ILLEGAL POOL NUMBER GIVEN TO ASGRES>)
RETBAD ()]
CAML T1,RESUTB(T2) ;IS THERE ENOUGH IN THE POOL?
RETBAD (MONX05) ;NO
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(CHK,ASGREP,<ILLEGAL PRIORITY GIVEN TO ASGRES>)
RETBAD()]
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
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
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
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
HRL T2,ASGREF ;GET POOL # OF ASSIGNMENT
MOVEM T2,(T1) ;SAVE THIS IN THE HEADER WORD
AOS T1 ;RETURN POINTER TO FIRST FREE WORD
SETZM 0(T1) ;ZERO THE FIRST WORD OF THE BLOCK
LSH T2,2 ;NOW ZERO THE BLOCK
HRL T3,T1 ;START AT FIRST WORD
HRRI T3,1(T1) ;WORD +1
ADD T2,T1 ;GET POINTER TO END OF BLOCK (+1)
HRRZS T2 ;STAY IN SAME SECTION
BLT T3,-2(T2) ;ZERO THE BLOCK
RETSKP ;AND GIVE THE SUCCESSFUL RETURN
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
; +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
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 [ PION ;NO, GIVE ERROR RETURN
RETBAD ()]
MOVEI T2,200(T1) ;YES, GRAB THIS BLOCK
TRZ T2,177 ;GET POINTER TO NEXT FREE BLOCK
MOVEM T2,RESFFB ;STORE NEW POINTER
PION
JRST GRORE2 ;GO RETURN THIS BLOCK
GRORE1: PIOFF ;GET A FULL PAGE (IF NECESSARY)
MOVE T1,RESFFB ;GET FIRST FREE BLOCK
CAIL T1,NRESFB ;ANY LEFT?
JRST [ PION ;NO
RETBAD()]
MOVEI T2,200(T1) ;GET THIS PAGE (OR PARTIAL BLOCK)
TRZ T2,177
MOVEM T2,RESFFB ;STORE NEW POINTER
PION
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
GRORE2: SUB T2,T1 ;GET THE SIZE OF THIS BLOCK
LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK
ADD T1,RESBAS ;...
HRRZM T2,(T1) ;STORE SIZE OF THE BLOCK
MOVNS T2 ;FUDGE THE USE COUNT
ADDM T2,RESUTB ;FOR THE GENERAL POOL
AOS T1 ;GET POINTER TO BLOCK FOR RELRES
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
; +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 (MONX01) ;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
; +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
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 (MONX01) ;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
SETOS1: 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
PION ;THROUGH THE TOUCHY PART FOR NOW
JUMPLE T3,RSKP ;ALL DONE?
CALL BITMS2 ;NO, CONTINUE WITH NEXT WORD IN BLOCK
JRST SETOS1 ;BIT MASK OBTAINED, GO MARK THE BITS
SETOS2: PION ;BIT ALREADY IN USE, MUST UNDO OTHERS
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
;ROUTINE TO RETURN RESIDENT FREE SPACE TO THE FREE POOL
;ACCEPTS IN T1/ ADDRESS OF THE BLOCK
; CALL RELRES
;RETURNS +1: ALWAYS
RELRES::SOS T2,T1 ;GET THE ADDRESS OF THE START OF THE BLOCK
MOVE T1,(T2) ;GET THE NUMBER OF BLOCKS IN THIS BLOCK
SUB T2,RESBAS ;GET THE OFFSET INTO THE FREE POOL
TRNE T1,-1 ;ZERO LENGTH BLOCK?
TDNE T2,[-1,,3] ;THIS MUST START ON A 4 WORD BOUNDRY IN POOL
JRST [ BUG(CHK,RESBAD,<RELRES: ILLEGAL ADDRESS PASSED TO RELRES>)
RET]
LSH T2,-2 ;GET 4 WORD BLOCK NUMBER
IDIVI T2,^D36 ;GET POSITION OF BLOCK WITHIN BIT TABLE
HRRZ T4,T1 ;SEE IF THIS BLOCK IS WITHIN THE POOL
ADD T4,T2 ;GET END OF BLOCK
CAIL T4,NRESFB ;IS THIS WITHIN THE BIT TABLE LIMITS
JRST [ BUG(CHK,RESBND,<RELRES: RELEASING SPACE BEYOND END OF RESIDENT FREE POOL>)
RET] ;YES, JUST EXIT
HLRZ T4,T1 ;GET POOL NUMBER
HRRZS T1 ;GET THE SIZE OF THE BLOCK
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
BUG(CHK,RESBAZ,<RELRES: FREE BLOCK RETURNED MORE THAN ONCE>)
RET ;EXIT
;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
CLRBT1: PIOFF ;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 [ PION ;BITS ARE ALREADY 0
RET] ;GIVE FAILURE RETURN WITHOUT DOING MORE
ANDCAM T1,(T4) ;CLEAR THE BITS
PION ;THROUGH INTERLOCKED CODE
JUMPLE T3,RSKP ;ANY MORE TO BE CLEARED?
CALL BITMS2 ;YES, GET NEXT BIT MASK
JRST CLRBT1 ;LOOP BACK FOR REST OF BITS
;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
MOVEI T1,RESFRB ;GET JOB 0 THRESHOLD VALUE
MOVEM T1,UPRSAV ;ESTABLISH LIMIT
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: .RESGQ/4 ;GENERAL POOL QUOTA
.RESTQ/4 ;TERMINAL POOL QUOTA
.RESNQ/4 ;NETWORK POOL QUOTA
.RESLQ/4 ;LOGICAL LINK 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,UPRSAV ;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
CAMG T1,UPRSAV ;ARE WE 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
PIOFF ;MUST BE DONE INTERLOCKED
CAME T3,RESFFB ;STILL HAVE SAME FIRST FREE BLOCK?
JRST [ PION ;NO, GO TRY AGAIN
OKSKED
JRST RESLK1]
LDB T4,T2 ;GET THE BIT
JUMPN T4,[PION ;IF = 1, THEN IN USE SOMEWHERE
OKSKED
RET] ;SO RETURN
MOVEI T4,1 ;NOT IN USE, MARK IT TAKEN
DPB T4,T2 ;...
SOS RESFRE ;COUNT DOWN THE FREE COUNT
SOS T1,RESFFB ;AND REMOVE IT FROM FREE POOL
PION ;THROUGH INTERLOCKED CODE
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
TNXEND
END