Trailing-Edge
-
PDP-10 Archives
-
BB-K911B-SM
-
sources/free.mac
There are 49 other files named free.mac in the archive. Click here to see a list.
;<4.MONITOR>FREE.MAC.27, 3-Jan-80 08:08:47, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<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,1980 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::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
;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
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
;ACCEPTS IN T1/ PRI ,, LEN
; T2/ FLAGS ,, POOL #
; 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
; .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(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
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
;SET UP THE HEADER WORD (THE WORD PRECEDING THE START OF THE
;BLOCK AS RETURNED TO THE USER). ZERO THE BLOCK 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
;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
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 (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
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(MONX05)] ;RETURN 'NO FREE SPACE'
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
; 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
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
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(RESBAD)
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(RESBND)
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(RESBAZ)
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
.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
;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 (IPCFX8) ;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