Trailing-Edge
-
PDP-10 Archives
-
BB-M080M-SM
-
monitor-sources/free.mac
There are 49 other files named free.mac in the archive. Click here to see a list.
; *** Edit 7384 to FREE.MAC by MCCOLLUM on 15-Oct-86, for SPR #21288
; Add ASGF2 to FILST1. This bit should ALWAYS shadow the state of ASGF in
; FILSTS
; *** Edit 7320 to FREE.MAC by MCCOLLUM on 12-Jun-86
; Change references of FBSIZ to FBKSIZ and define FBKSIZ in TRVAR at SETVAR
;------------------------- Autopatch Tape # 13 -------------------------
; *** Edit 7207 to FREE.MAC by WAGNER on 9-Dec-85
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs.
;------------------------- Autopatch Tape # 12 -------------------------
; Edit 7140 to FREE.MAC by WAGNER on 27-Aug-85, for SPR #838626 (TCO 6-1-1530)
; Modify text for RELBAD, RESBAZ, FSPARB, FSPPRE, FSPSCC, RELINC, FSPPTR and
; FSPASN BUGHLTS to reflect their being BUGHLTS instead of BUGCHKS.
;TCO 6.1.1530 - Change text for BUGHLTS to reflect their being HLTS.
; UPD ID= 2215, SNARK:<6.1.MONITOR>FREE.MAC.74, 12-Jun-85 08:40:04 by PAETZOLD
;TCO 6.1.1443 - Fix smashed AC causing ILMNRFs in RESLK3.
; UPD ID= 2077, SNARK:<6.1.MONITOR>FREE.MAC.73, 3-Jun-85 14:36:54 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 2018, SNARK:<6.1.MONITOR>FREE.MAC.72, 28-May-85 12:08:03 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 2002, SNARK:<6.1.MONITOR>FREE.MAC.71, 24-May-85 12:00:35 by MCCOLLUM
;Change RESBAZ to a BUGHLT.
; UPD ID= 1898, SNARK:<6.1.MONITOR>FREE.MAC.70, 4-May-85 16:03:19 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1879, SNARK:<6.1.MONITOR>FREE.MAC.69, 4-May-85 12:50:19 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1848, SNARK:<6.1.MONITOR>FREE.MAC.68, 30-Apr-85 12:31:59 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1804, SNARK:<6.1.MONITOR>FREE.MAC.67, 24-Apr-85 10:17:59 by PALMIERI
;TCO 6.1.1339 Put ASGDCN and RELDCN under FTNSPSRV
; UPD ID= 1749, SNARK:<6.1.MONITOR>FREE.MAC.66, 12-Apr-85 13:41:24 by MCCOLLUM
;Change RELRNG to a HLT
; UPD ID= 1642, SNARK:<6.1.MONITOR>FREE.MAC.65, 15-Mar-85 11:50:21 by MCCOLLUM
;Change RELBAD to a HLT.
; UPD ID= 1176, SNARK:<6.1.MONITOR>FREE.MAC.64, 11-Dec-84 09:30:49 by LEACHE
;Change FSPOUT to BUGINF
; UPD ID= 1104, SNARK:<6.1.MONITOR>FREE.MAC.63, 19-Nov-84 16:08:52 by LEACHE
;Change JSB-stack routines to use 30-bit addressing
; UPD ID= 5039, SNARK:<6.MONITOR>FREE.MAC.62, 30-Oct-84 14:18:47 by LEACHE
;Fix off-by-1 bug at LIMCHK
; UPD ID= 5034, SNARK:<6.MONITOR>FREE.MAC.61, 29-Oct-84 14:50:38 by LEACHE
;TCO 6.2265 Fix minimum block size logic
; UPD ID= 4995, SNARK:<6.MONITOR>FREE.MAC.60, 24-Oct-84 19:15:50 by LEACHE
;Fix typo in previous
; UPD ID= 4993, SNARK:<6.MONITOR>FREE.MAC.59, 24-Oct-84 19:02:45 by LEACHE
;TCO 6.2259 - Add protection against bad block lengths
; UPD ID= 4982, SNARK:<6.MONITOR>FREE.MAC.58, 23-Oct-84 15:34:11 by LEACHE
;Temporarily change FSPOUT to BUGHLT
; UPD ID= 4966, SNARK:<6.MONITOR>FREE.MAC.57, 19-Oct-84 15:22:59 by LEACHE
;More of previous
; UPD ID= 4958, SNARK:<6.MONITOR>FREE.MAC.56, 18-Oct-84 15:45:32 by LEACHE
;TCO 6.2254 Add history buffers to swappable freespace
; UPD ID= 4757, SNARK:<6.MONITOR>FREE.MAC.55, 27-Aug-84 10:41:39 by LEACHE
;TCO 6.2203 Fix bug at ASGSW1; Call FSPCK after pool is locked
; UPD ID= 4542, SNARK:<6.MONITOR>FREE.MAC.54, 15-Jul-84 10:55:52 by PURRETTA
;Update copyright notice
; UPD ID= 4182, SNARK:<6.MONITOR>FREE.MAC.53, 8-May-84 14:11:56 by LEACHE
;TCO 6.2052 Protect against allocating not-yet deallocated block at RELRE1
;Make FSPCK handle the case of totally exhausted pool
; UPD ID= 4058, SNARK:<6.MONITOR>FREE.MAC.52, 11-Apr-84 04:49:56 by LEACHE
; Fix arguments to 2 BUGCHKs
; UPD ID= 4016, SNARK:<6.MONITOR>FREE.MAC.51, 31-Mar-84 16:15:04 by PAETZOLD
;TCO 6.2019 - Replace a SUB P,BHC with an ADJSP.
; UPD ID= 3400, SNARK:<6.MONITOR>FREE.MAC.50, 3-Jan-84 13:47:01 by LEACHE
;Remove 2 routines from DEBUG conditional
; UPD ID= 3347, SNARK:<6.MONITOR>FREE.MAC.49, 19-Dec-83 15:39:39 by LEACHE
;More of previous
; UPD ID= 3217, SNARK:<6.MONITOR>FREE.MAC.48, 28-Nov-83 09:44:59 by LEACHE
;Add more sanity checking to freespace manager
; UPD ID= 3083, SNARK:<6.MONITOR>FREE.MAC.47, 26-Oct-83 12:20:50 by HALL
;Fix ASGRSB to be resident. Bug introduced by UPD ID 1795
; UPD ID= 2919, SNARK:<6.MONITOR>FREE.MAC.46, 21-Sep-83 12:01:53 by LEACHE
;Place call to FILHDR under FSPDBG conditional
; UPD ID= 2849, SNARK:<6.MONITOR>FREE.MAC.45, 19-Aug-83 14:29:41 by MURPHY
;Fix ref to section 0 at FILHDR+3.
; UPD ID= 2837, SNARK:<6.MONITOR>FREE.MAC.44, 17-Aug-83 11:31:59 by HALL
;TCO 6.1502 - Treat (1,,n) as (0,,n) in RELRES
; UPD ID= 2794, SNARK:<6.MONITOR>FREE.MAC.43, 4-Aug-83 00:29:25 by LEACHE
;TCO 6.1641 Move swappable freespace out of section zero
; UPD ID= 2642, SNARK:<6.MONITOR>FREE.MAC.42, 28-Jun-83 08:09:27 by GRANT
;TCO 6.1502 - fix bug in CHKRFS, it always checks section 0 quota
; UPD ID= 2599, SNARK:<6.MONITOR>FREE.MAC.41, 20-Jun-83 14:39:28 by HALL
;TCO 6.1689 - Move fork tables to extended section
; Reference FKJOB via DEFSTR
; Move EA.ENT from ASGREX to ASGRB0
; UPD ID= 2545, SNARK:<6.MONITOR>FREE.MAC.40, 31-May-83 16:44:36 by MURPHY
;TCO 6.1525 - Move RESBTB to extended section.
; UPD ID= 2444, SNARK:<6.MONITOR>FREE.MAC.39, 8-May-83 11:02:41 by HALL
;TCO 6.1641 - Move swappable and JSB free space to extended section
; Add temporary entry points to ASGSWP and RELSWP for hiding the header
; UPD ID= 2278, SNARK:<6.MONITOR>FREE.MAC.38, 14-Apr-83 15:35:38 by HAUDEL
;More TCO 6.1502 - reference memory and not the old immediate value
; UPD ID= 2041, SNARK:<6.MONITOR>FREE.MAC.37, 20-Mar-83 13:30:18 by HALL
;Still trying
; UPD ID= 2040, SNARK:<6.MONITOR>FREE.MAC.36, 20-Mar-83 13:27:22 by HALL
;Typo in previous edit
; UPD ID= 2037, SNARK:<6.MONITOR>FREE.MAC.35, 20-Mar-83 12:42:07 by HALL
;TCO 6.1502 - allow free space in extended section
; Make ASGRSB use full word in AC 2
; In ASGREX, check PC of caller if requesting extended section
; In ASGREX, force section 0/1 free space if free space not created yet
; In RELRES, check for PC in section 0 if returning extended free space
; In RELRES, don't lose section number when pointing to trailer word
; Remove temporary code limiting all actions to section 0 free space
; UPD ID= 1800, SNARK:<6.MONITOR>FREE.MAC.34, 14-Feb-83 15:03:20 by HALL
;TCO 6.1502 - allow free space in extended section
; Add CHKRFS
; Allow multiple kinds of free space
; UPD ID= 1755, SNARK:<6.MONITOR>FREE.MAC.33, 3-Feb-83 13:53:50 by GRANT
;TCO 6.1493 - add new UNITS pool to resident free space
;Clean up the comments, page boundaries
; UPD ID= 1535, SNARK:<6.MONITOR>FREE.MAC.31, 16-Dec-82 12:43:27 by HAUDEL
;Add more code to RESBSW conditional assembly
; UPD ID= 1530, SNARK:<6.MONITOR>FREE.MAC.30, 11-Dec-82 09:52:10 by HAUDEL
;Change RESBSW conditional assembly code
; UPD ID= 1529, SNARK:<6.MONITOR>FREE.MAC.29, 11-Dec-82 09:39:14 by HAUDEL
;No change with the edit, do to user error with ALU
; UPD ID= 1373, SNARK:<6.MONITOR>FREE.MAC.28, 25-Oct-82 11:39:00 by GRANT
;TCO 6.1326 - add header word to swappable free space blocks
; UPD ID= 844, SNARK:<6.MONITOR>FREE.MAC.27, 6-Jun-82 12:54:47 by CDUNN
;Fix RELFRM BUGHLT after move from BUGS.MAC. Also fix half removed
;BUGHLTs...
; UPD ID= 841, SNARK:<6.MONITOR>FREE.MAC.26, 4-Jun-82 22:03:08 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 812, SNARK:<6.MONITOR>FREE.MAC.25, 2-Jun-82 11:40:31 by GRANT
;TCO 6.1150 - Don't update block count until address has been verified
; UPD ID= 519, SNARK:<6.MONITOR>FREE.MAC.24, 17-Mar-82 13:58:06 by GRANT
;TCO 6.1071 - Clear left half of returned header word in RELFR6
; UPD ID= 411, SNARK:<6.MONITOR>FREE.MAC.23, 19-Feb-82 18:07:09 by WALLACE
;TCO 6.1062 - Add routine RELJFR, to Release JSB Free Space
; 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 BE USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985.
;ALL RIGHTS RESERVED.
SEARCH PROLOG
TTITLE FREE ; Storage routines
SWAPCD
;NO SPECIAL AC DEFINITIONS HEREIN
;LOCAL DEFINITIONS FOR JSBSTK
;Definitions for stack record
DEFSTR (JSCOD,JSSTCD,17,18) ;THE CODE
DEFSTR (JSFRK,JSSTFK,17,18) ;THE FORK HANDLE
DEFSTR (JSLVL,JSSTFK,35,18) ;THE INTERRUPT LEVEL
SUBTTL Swappable and JSB Free Space Manager (old)
;These routines assign and release free space from two pools: swappable
;free space and JSB free space. Each area is identified by a block of
;words at the beginning of the area. The caller specifies which
;area is to be used by passing the address of the header. The format
;of the header is as follows:
; 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
;ASGSWP - ROUTINE TO ASSIGN SPACE FROM THE SWAPPABLE 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
IFN SWPHSW,<
MOVE T4,(P) ;GET CALLER
>
STKVAR <FLAG,CALLR> ;FLAG: PLACE TO HOLD ENTRY TYPE
;CALLR: CALLER'S PC
MOVEM T3,FLAG ;SAVE ENTRY TYPE
IFN SWPHSW,<
MOVEM T4,CALLR ;SAVE CALLER
AOS T1 ;MAKE ROOM FOR HEADER WORD
>
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
IFN SWPHSW,<
SOS (T1) ;ADJUST COUNT FOR CALLER
>
HRRZS T2,0(T1) ;INITIALIZE SPACE TO 0'S
IFN SWPHSW,<
MOVEM T2,1(T1) ;PUT IN COUNT
MOVE T3,CALLR ;RETRIEVE CALLER
MOVEM T3,(T1) ;PUT IT IN
AOS T1 ;ADJUST ADDRESS FOR CALLER
>
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
ENDSV.
;NOTE: This entire page is temporary. Don't call these routines without
;talking to people about it first.
;ASGSWH - Temporary version of ASGSWP that hides the header from the
;caller. Will not do stacking.
;Caller should not expect to find count in first word of free space
ASGSWH: STKVAR <ASGSIZ,ASGADR>
MOVEM T1,ASGSIZ ;SAVE COUNT USER REQUESTED
AOS T1 ;MAKE ROOM FOR HIDDEN HEADER
MOVE T2,T1 ;SET UP FOR ASGFRE
MOVEI T1,SWPFRE
CALL ASGFRE
RETBAD (MONX06)
AOS T1 ;POINT PAST THE HEADER
MOVEM T1,ASGADR ;SAVE ADDRESS TO RETURN TO CALLER
SETZM (T1) ;ZERO THE FIRST WORD AFTER HEADER
MOVE T2,T1 ;SOURCE
MOVE T3,T2
ADDI T3,1 ;DESTINATION
MOVE T1,ASGSIZ ;SIZE
SUBI T1,1
CALL XBLTA
MOVE T1,ASGADR ;RETURN ADDRESS OF FIRST DATA WORD
RETSKP
ENDSV.
;RELSWH - Releasing version of ASGSWH. Assumes caller never touched the
;header
RELSWH:
MOVE T2,T1 ;SET UP FOR RELFRE
SOS T2 ;POINT TO THE HEADER THAT WAS HIDDEN
MOVEI T1,SWPFRE
CALL RELFRE
RET
;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.(HLT,RELFRM,FREE,SOFT,<Illegal to deassign 0 free space>,,<
Cause: This is a free space problem. The calling routine is trying to release
a block of storage of zero length. It is illegal to free a block of
zero length.
Action: Look at the dump. Backing up the stack will show which routine made
the call to release the storage.
>)]
RELMES::
IFN SWPHSW,<
MOVE T2,(T1) ;GET "USER'S HEADER" WORD
AOS T2 ;ADJUST THE COUNT
MOVEM T2,-1(T1) ;PUT IT IN "REAL HEADER"
SOS T1 ;GET "REAL HEADER" ADDRESS
>
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
;ASGFRE - 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
ASGFRE::SKIPG B ;CHECK FOR LEGAL REQUEST
BUG.(HLT,ASGFR0,FREE,SOFT,<ASGFRE - Illegal to assign 0 free space>,,<
Cause: An illegal request for free space is being made. The calling routine
is asking for zero words of free space.
Action: Look at the dump. By backing up the stack you
should be able to tell what routine called for the illegal
free space.
>)
SKIPGE INTDF ;IS THE PROCESS NOINT?
JRST [ MOVE C,0(P) ;GET PC OF THE CALL
BUG.(CHK,ASGINT,FREE,SOFT,<ASGFRE called OKINT>,<<C,CALLER>>,<
Cause: This is a free space problem. Calls to swapable free space
routines should be made only while the calling process is NOINT. The
calling routine is not protecting itself from losing free space. It is
OKINT. Since it is OKINT it could get interupted and never return,
thus losing the free block assigned.
Action: Make the routine be NOINT until it has ensured that the block will
be freed when it is interrupted (e.g. JSB stack).
Data: CALLER - The address of the calling routine
>)
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:
ADJSP P,-1 ; Clean up one stack location
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.(CHK,RELINT,FREE,SOFT,<RELFRE called OKINT>,<<A,CALLER>>,<
Cause: This is a free space problem. The calling routine is trying to release
a swapable free space block while it is OKINT. This is dangerous since
it could get interrupted and loose the block. All
free space actions should occur while NOINT.
Action: Make the calling routine become NOINT when it removes the address
of the block about to be released from the database. The routine
can be made OKINT when control is returned to it.
Data: CALLER - The address of the calling routine.
>)
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: MOVE C,(P) ;GET ADDRESS OF FREE STORAGE HEADER
;**;[7384] Change BUG. macro at RELFRA: + 1 L JDM 15-Oct-86
BUG.(CHK,RELRNG,FREE,SOFT,<RELFRE - Block out of range>,<<B,BLOCK>,<C,POLHDR>,<A,POLLOW>,<D,POLHGH>>,<
Cause: This is a free space problem. The caller to the free space
routines is trying to return a block that was not given
out by the free space manager. The block is outside the
range of free space management.
Action: If the problem persists, change the CHK to a HLT and
look through the dump. By looking at the stack you
should be able to determine who called for the releasing
of the block.
Data: BLOCK - Address of block being released
POLHDR - Address of free storage header (e.g. ASGRES)
POLHGH - High address of free space pool
POLLOW - Low address of free space pool
>) ;[7384]
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
TLZ T4,-1 ;CLEAR OUT LH - JUST IN CASE USER DIDN'T
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.(HLT,RELBAD,FREE,SOFT,<RELFRE - Bad block being released>,<<CX,CALLER>,<A,POLHDR>,<B,LSTBLK>,<C,NXTBLK>>,<
Cause: This is a free space problem. The block being returned does not fit
into the free space. When blocks are returned to the free space pool,
there is a consistency check performed. The block is merged into
existing blocks that follow it in free space. This block overlaps
into existing free blocks. It cannot be merged.
Action: Looking at the stack will show the caller. It is possible that the
length of the current block is incorrect. It is equally likely that
the block(s) before this block (in free space) have had incorrect
lengths on return. Thus, the caller may not be the culprit.
Data: CALLER - Caller to this BUGHLT
POLHDR - Address of header of this pool
LSTBLK - Address of last block before this one
NXTBLK - Address of first block after this one
>)
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
;RELJFR - Release JSB Free Space
;T2/ Location of Block to Be Returned
; CALL RELJFR
; Returns +1: Always
RELJFR::MOVEI T1,JSBFRE ;Get address of JSB Free Space Header
CALLRET RELFRE ; and call routine to release the space
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
COMMENT \
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
Note - although labeled a "stack", the data-structure functions as
a simple table.
For 6.1, the JSB-stack routines have been changed to store a 36-bit
datum. Comments in the code about "old-style freespace manager"
and "change for 30-bit addressing" indicate instructions that should
be changed if the JSB stack itself is ever moved to an extended section.
JSB stack descriptor (in JSB)
JSFSTK:
!=======================================================!
JSSTCN ! Size of stack in words !
!=======================================================!
JSSTCC ! Current number of records in use !
!=======================================================!
JSSTMR ! Maximum number of available records !
!=======================================================!
JSSTAD ! Pointer to stack !
!=======================================================!
Format of single stack record:
!-------------------------------------------------------!
JSSTCD ! ENTRY TYPE CODE (JSCOD) ! Unused !
!-------------------------------------------------------!
JSSTFK ! SYSTEM FORK # (JSFRK) ! PSI LEVEL # (JSLVL) !
!-------------------------------------------------------!
JSSTDT ! DATA !
!-------------------------------------------------------!
Record size = JSRSZ
\ ;End comment
;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,SKDATM,SKCODE> ;WORK STORAGE
HRRZM A,SKDATM ;SAVE ARGUMENTS
CAILE B,STKHWD ;Halfword datum?
MOVEM A,SKDATM ;No, fullword
MOVEM B,SKCODE ;""
NOINT ;PREVENT INTS
LOCK JSFLCK ;LOCK THE STACK
SKIPN JSFSTK+JSSTAD ;HAVE A STACK YET?
JRST ASGSTK ;No, go get one
MOVE D,JSFSTK+JSSTCC ;Get current record count
CAMGE D,JSFSTK+JSSTMR ;Room for more?
JRST JSBST1 ;Yes, go use it
;Stack is full
MOVE B,JSFSTK+JSSTCN ;Get size of existing stack
ADDI B,JSSTSZ ;GET MORE SPACE THIS TIME
CALL JSBST4 ;GO GET SOME
JRST JSBSF5 ;FAILED. GIVE IT UP
MOVEM A,SVA ;Save address of new block
MOVE A,JSFSTK+JSSTCN ;Get current stack size
SOS A ;Discount the header word - only needed
; for old-style freespace manager
MOVE B,JSFSTK+JSSTAD ;Get address of current stack
MOVE C,SVA ;Get address of new stack
XBLT. A ;Move the stack
MOVEI A,JSBFRE ;Release to this pool
MOVE B,JSFSTK+JSSTAD ;Get address of old stack
SOS B ;Reveal the header - only needed for old-style
; freespace manager
CALL RELFRE ;Release the space
MOVEI A,JSSTSZ ;Get size-increment
ADDM A,JSFSTK+JSSTCN ;Record the size of new stack
MOVE C,SVA ;Get pointer to new stack
;Change to MOVEM for 30-bit addressing
HRRZM C,JSFSTK+JSSTAD ;Save it
JSBST0: MOVE A,JSFSTK+JSSTCN ;Get size of stack
IDIVI A,JSRSZ ;Divide by words per record
MOVEM A,JSFSTK+JSSTMR ;Save maximum # of records
JSBST1: MOVE D,JSFSTK+JSSTMR ;Fetch maximum # records
MOVE C,JSFSTK+JSSTAD ;Get stack address
JSBST2: SKIPN JSSTCD(C) ;THIS ONE FREE?
JRST JSBST3 ;YES
ADDI C,JSRSZ ;Step to next record
SOJG D,JSBST2 ;NO KEEP LOOKING
BUG.(HLT,JSTERR,FREE,SOFT,<JSB stack error>,,<
Cause: This is a problem with the JSB-stack logic; the count for the stack
indicated that free cells were available, however none could be
found.
Action: Analyze the dump.
>)
;INSERT ENTRY AT CURRENT STACK CELL
JSBST3: MOVE A,SKDATM ;THE DATUM
MOVEM A,JSSTDT(C) ;STASH IT
MOVE A,PSIBIP ;RECORD CURRENT BREAK LEVEL
JFFO A,.+1
STOR B,JSLVL,(C)
MOVE B,SKCODE ;THE CODE
STOR B,JSCOD,(C) ;STORE THE CODE
MOVE A,FORKX ;CURRENT FORK
STOR A,JSFRK,(C) ;SAVE THIS
AOS JSFSTK+JSSTCC ;Increment current record count
JRST JSBSF5 ;GO FINISH UP
;Get initial stack
ASGSTK: MOVEI B,JSSTSZ+1 ;Get this much space
; +1 to hide the header - only needed for
; old style freespace manager
MOVEM B,JSFSTK+JSSTCN ;Save it
CALL JSBST4 ;GO ASSIGN SOME FREE SPACE
JRST JSBSF5 ;FAILED. GIVE IT UP
SETZM JSFSTK+JSSTCC ;Reset current count
MOVEM A,JSFSTK+JSSTAD ;Save pointer
JRST JSBST0 ;Return with stack available
;GET SOME SPACE FOR LARGER STACK
JSBST4: CALL ASGJFR ;GET IT
RETBAD ;NONE THERE
AOS A ;Hide the header - only needed for old style
; freespace manager
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 PSIPIB
JSBSF6: SKIPG JSFSTK+JSSTCC ;HAVE ANY ENTRIES IN THE STACK?
JRST JSBSF5 ;NO, GO FINISH UP
MOVE D,JSFSTK+JSSTMR ;Get max # records
MOVE C,JSFSTK+JSSTAD ;Get stack pointer
JSBSF1: SKIPN JSSTCD(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: ADDI C,JSRSZ ;Step to next record
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
MOVE A,JSSTDT(C) ;THE DATUM
SETZM JSSTCD(C) ;FREE ENTRY
MOVE B,CODTBL-1(B) ;FETCH ROUTINE ADDRESS
CALL 0(B) ;CALL IT
SOS JSFSTK+JSSTCC ;Decrement current count
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
SKIPG JSFSTK+JSSTCC ;HAVE ANY ENTRIES IN THE STACK?
JRST JSBSF5 ;NO, GO WRAP UP
STKVAR <SAVDTM,SAVCOD> ;WORK CELLS
HRRZM A,SAVDTM ;SAVE ARGUMENTS
CAILE B,STKHWD ;Halfword datum?
MOVEM A,SAVDTM ;No, fullword
MOVEM B,SAVCOD
MOVE C,JSFSTK+JSSTAD ;Get pointer
MOVE D,JSFSTK+JSSTMR ;Get max record count
JSFRM1: SKIPE JSSTCD(C) ;ONE HERE?
JRST JSFRM2 ;YES
JSFRM3: ADDI C,JSRSZ ;Increment to next record
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
MOVE A,JSSTDT(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 JSSTCD(C) ;CLEAR IT
SOS JSFSTK+JSSTCC ;Decrement current record count
JRST JSBSF5 ;GO WRAP UP
SUBTTL Resident Free Space Manager
COMMENT *
;For each type of resident free space, there is a descriptor block
;containing information that previously was stored in resident locations
;The following list contains the offset, the name that was used before
;Release 6, and the meaning of the offset.
Offset Old Meaning
Name
.REBAS RESBAS Starting address of free space
.REEND RESFRZ Address of last word of free space
.RETOT NRESFB Total size of free space in blocks
.REPR1 RESMIN If remaining space less than this, allocate only priority 1
.REGRO RESAVE If remaining space less than this, grow free space (larger than .REPR1)
.REBTB RESBTB Address of start of bit table
.REBTL RESBTL Length of bit table (words)
.RETFR RESFRE Total remaining unallocated blocks
.REFFB RESFFB Number of block just past end of free space
.REPMX RESQTL Number of pools
.REQTA RESQTB Address of block containing quota for each pool
.REPFR RESUTB Address of block containing count of unallocated blocks per pool
*
.REBAS==0 ;RESBAS Starting address of free space
.REEND==1 ;RESFRZ Address of last word of free space
.RETOT==2 ;NRESFB Total size of free space in blocks
.REPR1==3 ;RESMIN If remaining space less than this, allocate only priority 1
.REGRO==4 ;RESAVE If remaining space less than this, grow free space (larger than .REPR1)
.REBTB==5 ;RESBTB Address of start of bit table
.REBTL==6 ;RESBTL Length of bit table (words)
.RETFR==7 ;RESFRE Total remaining unallocated blocks
.REFFB==10 ;RESFFB Number of block just past end of free space
.REPMX==11 ;RESQTL Number of pools
.REQTA==12 ;RESQTB Address of block containing quota for each pool
.REPFR==13 ;RESUTB Address of block containing count of unallocated blocks per pool
;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
; .RESUP UNITS POOL - USED BY PHYSIO AND DSKALC
;Areas of free space are preceded by a header. If debugging is turned on,
;they are also followed by a trailer. The format is as follows:
COMMENT [
+-------------------------------------------------------+
! Pool # ! # of blocks !
!-------------------------------------------------------!
* ! Flags ! PC of caller !
!-------------------------------------------------------!
! Body of free block !
!-------------------------------------------------------!
! . !
!-------------------------------------------------------!
! . !
!-------------------------------------------------------!
! . !
!-------------------------------------------------------!
! Body of free space !
!-------------------------------------------------------!
* ! 101010 ! Address of header !
+-------------------------------------------------------+
[
;* These words appear only if RESHSW is nonzero
;Flags:
; Bit 0 - ON if block is in use, OFF if it is not
;If debugging is on, a trace is made of the events, and stored in locations
;starting at XXXBUF. At any time, XXXPTR points to the word most recently
;written.
;The format is as follows:
COMMENT [
+-------------------------------------------------------+
! 0 ! 010101 !
!-------------------------------------------------------!
! Flags ! Address of start of block !
!-------------------------------------------------------!
! Pool # ! # of 4-word blocks !
!-------------------------------------------------------!
! Caller's PC !
!-------------------------------------------------------!
! Job # ! Fork handle !
!-------------------------------------------------------!
! TODCLK !
!-------------------------------------------------------!
! GETZ counter ! GETZ2 counter !
+-------------------------------------------------------+
[
;Flags:
; Left half is 0 if assigning, -1 if deassigning
;ASGRES - Assign resident free space
;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 following flag is defined and should be used by callers whose free
;space must be in section 0. It is not yet supported but will be some day
; RS%SE0==:1B0 ;SPACE MUST BE IN SECTION 0
;ENTRY FOR BLCAL. CALLS
; BLCAL ASGRSB,<LENGTH,PRIORITY,POOL>
; RETURNS SAME AS FOR ASGRES
RESCD
ASGRSB::BLSUB. <LEN,PRI,POO>
SAVEAC <T2,T4>
HRRZ T1,LEN
HRL T1,PRI
MOVE T2,POO
CALLRET ASGRES ;DO THE WORK
ENDBS.
ASGRES::MOVE T4,(P) ;GET PC OF CALLER
ASGRB0: EA.ENT ;NEED THIS FOR FORK TABLES IN DEBUG CODE
IFN RESBSW,< ;USE RING BUFFER TO RECORD ASSIGNMENTS
CALL ASGREX ;DO THE WORK
RET ;FAILED
HRRZI T2,010101 ;SET UP FRAME MARK
CALL XXXPUT ;STORE IT
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
CAIL T2,0 ;IS IT SCHEDULER
JRST [ LOAD T3,FKJO%,(T2) ;NO. GET JOB NUMBER
HRL T2,T3 ;COMBINE JOB AND FORK NUMBERS
JRST .+1]
CALL XXXPUT ;STORE IT
MOVE T2,TODCLK ;GET TIME
CALL XXXPUT ;STORE IT
MOVE T2,XXXCT2 ;GET COUNTER
HRL T2,XXXCT1 ;GET THE OTHER COUNTER
CALL XXXPUT
SETZM XXXCT2 ;ZERO THE COUNTER
MOVEI 2,1
MOVEM 2,XXXCT1 ;RESET XXXCT1
RETSKP ;SKIP
XXXMAX==^D3000 ;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(XXXCT1,1) ;COUNTER FOR GETZ LOOP
RS(XXXCT2,1) ;COUNTER FOR GETZ2
RS(XXXPTR,1) ;INDEX INTO BUFFER
RS(XXXBUF,XXXMAX) ;BUFFER
;ASGREX - Worker routine for ASGRES
;ACCEPTS IN T1/ PRI ,, LEN
; T2/ FLAGS ,, POOL #
; T4/ PC OF CALLER
; CALL ASGREX
;RETURNS +1: FAILED TO GET THE REQUESTED SPACE
; T1/ ERROR CODE
; +2: ADDRESS OF BLOCK IN T1
ASGREX:
> ;END OF IFN RESBSW
ASUBR <ASGREA,ASGREF,ASGREC,ASGCAL>
ACVAR <W1>
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
XMOVEI W1,RESNTB ;ASSUME NON-ZERO SECTION NUMBER
TXNE T2,RS%SE0 ;DID USER REQUEST SECTION 0?
XMOVEI W1,RES0TB ;YES. RESTRICT USE TO SECTION 0
;IF THE CALLER OF THIS ROUTINE IS RUNNING IN SECTION 0 ON AN EXTENDED
;ADDRESSING MACHINE, THERE MAY BE TROUBLE LATER WHEN THE CALLER USES
;THE ADDRESS RETURNED BY THIS ROUTINE. THIS ROUTINE RETURNS AN ADDRESS
;IN A NON-ZERO SECTION, AND THE CALLER PROBABLY DOES AN INDEXED REFERENCE
;TO THAT ADDRESS. IN SECTION 0, THE LEFT HALF OF THE AC WILL BE IGNORED.
;THE CODE UNDER THE CONDTIONAL TESTS FOR THIS CASE AND BUGHLT'S, THUS
;AVERTING LATER DISASTER.
IFN SEC0SW,< ;IF TESTING FOR RUNNING IN SECTION 0
TXNE T2,RS%SE0 ;REQUESTED SECTION 0?
JRST ASGRE2 ;YES. DON'T CHECK PC OF CALLER
TXNN T4,VSECNO ;REQUESTED EXTENDED. RUNNING IN SECTION 0?
BUG.(HLT,SEC0FS,FREE,SOFT,<ASGRES called from section 0>,<<T4,PC>>,<
Cause: A routine in FREE that provides free space in a non-zero section
was called from section 0. This is dangerous because the routine
returns a 30-bit address, and the caller will probably use the
address in an index register, thus losing the section number.
Action: It is essential that any code that references a non-zero section
run in a non-zero section. The long-term solution is to study the
entire stack and make all the code run in section 1. For the short
term, it may be possible to insert an EA.ENT at the beginning of
the routine that called ASGRES. Note that this may lead to other
problems, including slower performance and ILMNRF BUGHLT's.
Data: PC - the PC from which ASGRES was called
>)
> ;END SECTION 0 CHECK
;..
;..
ASGRE2: SKIPE XRESFL ;IF WE'RE NOT READY YET (MAP NOT SET UP)
XMOVEI W1,RES0TB ; THEN GIVE SECTION 0 REGARDLESS
HRRZ T2,ASGREF ;GET POOL NUMBER
SKIPE T2 ;0 ISN'T A LEGAL POOL NUMBER
CAML T2,.REPMX(W1) ;IS POOL NUMBER TOO LARGE?
JRST [ BUG.(CHK,ASGREQ,FREE,SOFT,<Illegal pool number given to ASGRES>,,<
Cause: This is a free space problem. The caller is requesting resident
free space. In T2 the caller is providing a pool number for where
the free space should come from. This pool number is incorrect.
Action: If the problem persists change the BUGCHK to a BUGHLT to find the
culprit. The caller putting a bad value into T2.
>)
RETBAD (MONX03)] ;RETURN 'MONITOR INTERNAL ERROR'
ADD T2,.REPFR(W1) ;POINT TO TABLE OF FREE BLOCKS PER POOL
CAML T1,(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 MINIMUM, WE MAY WANT TO EXPAND THE POOL.
;..
ASGRE0: MOVE T2,.RETFR(W1) ;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,FREE,SOFT,<Illegal priority given to ASGRES>,,<
Cause: This is a free space problem. The caller is asking for resident
free space. In T3 the caller gives a priority for this request.
The priority determines how ASGRES is going to handle this request
when free space is low. This priority is out of range.
Action: If the problem persists change the BUGCHK to a BUGHLT and look
through the dump to find the caller.
>)
RETBAD(MONX03)] ;RETURN 'MONITOR INTERNAL ERROR'
CAMGE T2,.REPR1(W1) ;WOULD THIS PUT US UNDER THE MINIMUM?
JRST [ CAIE T3,.RESP1 ;YES. 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
MOVE T2,.REBTB(W1) ;GET START OF BITTABLE
MOVE T3,.REBTL(W1) ;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
ADD T3,.REPFR(W1) ;POINT TO TABLE OF FREE BLOCKS PER POOL
ADDM T2,(T3) ;DECREMENT THE POOL COUNT OF FREE BLOCKS
ADDB T2,.RETFR(W1) ;DECREMENT THE TOTAL COUNT OF FREE BLOCKS
;..
;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,.REFFB(W1) ;GET FIRST FREE BLOCK
CAMGE T2,.REGRO(W1) ;BELOW THE AVERAGE DESIRED?
CAML T3,.RETOT(W1) ;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,.REBAS(W1) ;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
MOVE T4,W1 ;T4/ ADDRESS OF DESCRIPTOR BLOCK
CALL GRORES ;TRY TO EXPAND THE FREE POOL
RETBAD () ;COULDNT GET ANY MORE
JRST ASGRE0 ;GOT SOME, GO SEE IF THIS WAS ENOUGH
ENDAV. ;END ACVAR
;ROUTINE TO EXPAND THE RESIDENT FREE POOL
;ACCEPTS IN T1/ PRIORITY NUMBER (.RESP1, .RESP2, OR .RESP3)
; T4/ ADDRESS OF DESCRIPTOR BLOCK
; CALL GRORES
;RETURNS +1: COULD NOT GET ANY
; T1/ ERROR CODE
; +2: FOUND SOME
GRORES: STKVAR <<GRORET,2>,GROADR>
MOVEM T4,GROADR ;SAVE ADDRESS OF DESCRIPTOR BLOCK
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. .REFFB 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,.REFFB(T4) ;GET FIRST FREE BLOCK
TRNE T1,177 ;IS THERE ANY LEFT ON THIS PAGE?
CAML T1,.RETOT(T4) ;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,.REFFB(T4) ;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,.REFFB(T4) ;GET FIRST FREE BLOCK
CAML T1,.RETOT(T4) ;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,.REFFB(T4) ;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,.REBAS(T4)
CALL FPTA ;LOCK IT DOWN
CALL MLKPG ;...
DMOVE T1,GRORET ;GET BLOCK NUMBER BACK AGAIN
MOVE T4,GROADR ;RESTORE ADDRESS OF DESCRIPTOR BLOCK
;..
;AT THIS POINT THE PAGE TO WHICH .REFFB PREVIOUSLY POINTED IS LOCKED
;DOWN. .REFFB HAS BEEN MOVED TO THE BEGINNING OF THE NEXT PAGE.
; T1/ .REFFB BEFORE THE EXPANSION
; T2/ .REFFB AFTER THE EXPANSION
; T4/ ADDRESS OF DESCRIPTOR BLOCK FOR FREE SPACE
;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,.REBAS(T4) ;...
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
ADD T3,.REPFR(T4) ;POINT TO TABLE OF FREE BLOCKS PER POOL
MOVNS T2 ;FUDGE THE USE COUNT
ADDM T2,(T3) ;DECREASE COUNT OF FREE BLOCKS FOR 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
MOVE 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:
IFN RESBSW,<
AOS XXXCT2 ;INCREMENT THE COUNTER
>
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
IFN RESBSW,<
AOS XXXCT1 ;INCREMENT THE COUNTER
>
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
IFN RESBSW,<
AOS XXXCT1 ;INCREMENT THE COUNTER
>
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
; * * * *
;NOTE: This works only as long as the bit tables are in sections 0/1
; * * * *
IFN RESBSW,<
SETOS1: PUSH P,T2 ;SAVE SOME ACS
PUSH P,T3 ;THAT WE NEED
HRRZ T2,T4 ;COPY ADDRESS WITHIN SECTION
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,@[EP. RSECMP(T2)] ;SET WRITE BIT IN MMAP
CLRPT (T4) ;MAKE IT SEEN BY HARDWARE
IORM T1,(T4) ;NOW MARK THESE AS IN USE
ANDCAM T3,@[EP. RSECMP(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
HRRZ 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,@[EP. RSECMP(T2)] ;WRITE-ENABLE BITTABLE
CLRPT (T4) ;LET HARDWARE KNOW
ANDCAM T1,(T4) ;CLEAR THESE BITS
ANDCAM T3,@[EP. RSECMP(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:
; T1/ ADDRESS OF THE BLOCK (RS%GRO INDICATES "GROWING")
; CALL RELRES
;RETURNS +1: ALWAYS
RELRES::MOVE T4,(P) ;GET PC OF CALLER
EA.ENT
COMMENT %
STKVAR LEGEND
RELGRO ;Flag indicating block release is really part
;of pool-growth mechanism
;0 = not growing; -1 = growing
RELRAD ;Address of block being released
RELCAL ;PC of caller
RELADR ;Address of pool descriptor block
RELSIZ ;# of 4-word blocks in returned block
RELPLN ;Pool number
% ;End comment
STKVAR <RELGRO,RELRAD,RELCAL,RELADR,RELSIZ,RELPLN>
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 T4,RELCAL ;SAVE PC OF CALLER
XMOVEI T3,RES0TB ;ASSUME SECTION 0
;MONUMENT: When ASGRES assigns free space from section 0/1, it returns an
;address of the form (0,,n). However, because sections 0 and 1 are mapped
;together, (1,,n) is also a valid address. This could be generated if a
;user of free space did XMOVEI AC,(T1) while running in section 1, and then
;saved (AC) as the address of free space. The kludge below recognizes that;possibility by treating the two addresses as equivalent, and then forcing
;the section 0 address before checking the bounds.
HLRZ T2,T1 ;GET SECTION NUMBER OF BLOCK
CAIG T2,1 ;0 OR 1?
IFNSK.
HRRZS T1 ;YES. FORCE SECTION 0 ADDRESS
HRRZS RELRAD
ELSE.
IFN SEC0SW,< ;IF TESTING FOR RUNNING IN SECTION 0
TXNN T4,VSECNO ;RUNNING IN SECTION 0?
BUG.(HLT,SEC0RL,FREE,SOFT,<RELRES called from section 0>,<<T4,PC>>,<
Cause: A routine in FREE that releases free space was called from section
0 with an address of free space in a non-zero section. This probably
means that the caller should be running in a non-zero section, since
any attempt to reference the free space would fail.
Action: It is essential that any code that references a non-zero section
run in a non-zero section. The long-term solution is to study the
entire stack and make all the code run in section 1. For the short
term, it may be possible to insert an EA.ENT at the beginning of
the routine that called RELRES. Note that this may lead to other
problems, including slower performance and ILMNRF BUGHLT's.
Data: PC - the PC from which RELRES was called
>)
> ;END SECTION 0 CHECK
XMOVEI T3,RESNTB ;EXTENDED SECTION FREE POOL
ENDIF.
RELRE3: MOVEM T3,RELADR ;SAVE ADDRESS OF DESCRIPTOR BLOCK
MOVE T2,T1 ;Get block address in T2
SUBI T2,RSHLEN ;Point to header word
LOAD T4,RSPOO,(T2) ;Get pool number
MOVEM T4,RELPLN ;Save it
LOAD T4,RSSIZ,(T2) ;GET NUMBER OF 4-WORD BLOCKS
MOVEM T4,RELSIZ ;Save it
IFN RESBSW,< ;USE RING BUFFER TO RECORD RELEASING
HRRZI T2,010101 ;SET UP FRAME MARK
CALL XXXPUT ;STORE IT
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
CAIL T2,0 ;IS IT SCHEDULER
JRST [ LOAD T3,FKJO%,(T2) ;NO. GET JOB NUMBER
HRL T2,T3 ;COMBINE WITH FORK NUMBER
JRST .+1]
CALL XXXPUT ;STORE IT
MOVE T2,TODCLK ;GET TIME
CALL XXXPUT ;STORE IT
MOVEI 2,0
CALL XXXPUT ;DUMMY ENTRY FOR SYMMETRY
> ;END OF IFN RESBSW
;CHECK FOR "ADDRESS WITHIN RESIDENT FREE SPACE"
MOVE T3,RELADR ;RESTORE ADDRESS OF DESCRIPTOR BLOCK
CAML T1,.REBAS(T3) ;ADDRESS PRECEDES START OF FREE SPACE?
CAML T1,.REEND(T3) ;NO. FOLLOWS END OF FREE SPACE?
JRST RESOUT ;ADDRESS IS 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.(CHK,RESBAD,FREE,SOFT,<RELRES - Illegal address passed to RELRES>,<<T1,BADADR>,<T2,CALLER>>,<
Cause: This is a free space problem. The caller is trying to release some
resident free space. The address being specified is not a legal
resident free space address.
Action: If the problem persists change the BUGCHK to a BUGHLT and find the
caller. The caller is providing an illegal address.
Find where the caller get the address and how that location gets
modified.
Data: BADADR - the address given to the free space manager
CALLER - the PC when the free space manager was called
>)
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
CAML T4,.REPMX(T3) ; 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
ADD T4,T1 ;POINT TO TRAILER WORD
SOS T4
LOAD T2,RSFLG,(T4) ;GET THE FLAG
CAIE T2,RESFLG ;OK?
JRST RESINC ;NO
;Note that this is an 18-bit comparison. The trailer contains the offset
;within the section for the header, not the full 30-bit address.
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"
; T1/ Address of header of free space as passed by caller
; T3/ Address of descriptor block for free space
;..
RELRE1: MOVE T4,.REBTB(T3) ;POINT TO BIT TABLE
MOVE T2,T1 ;SAVE THE HEADER ADDRESS
SUB T2,.REBAS(T3) ;GET OFFSET INTO FREE SPACE
LSH T2,-2 ;GET 4-WORD BLOCK NUMBER
IDIVI T2,^D36 ;GET POSITION OF BLOCK IN BIT TABLE
ADD T4,T2 ;POINT TO WORD IN BIT TABLE
IFN RESHSW,< ;IF DEBUGGING
SETZRO RSINU,(T1) ;TURN OFF "IN USE" BIT
> ;END OF IFN RESHSW
LOAD T1,RSSIZ,(T1) ;GET NUMBER OF 4-WORD BLOCKS
MOVEI T2,^D36 ;GET BIT POSITION IN CORRECT FORMAT
SUBM T2,T3 ; FOR CLRBTS
EXCH T3,T1 ;SET UP FOR CALL TO CLRBTS
CALL CLRBTS ;FREE UP THIS SPACE
JRST [MOVE T1,RELRAD ;ALREADY FREE. GET THE BAD ADDRESS
MOVE T2,RELCAL ; AND THE CALLER
BUG.(HLT,RESBAZ,FREE,SOFT,<RELRES - Free block returned more than once>,<<T1,BADADR>,<T2,CALLER>>,<
Cause: This is a free space problem. The caller is returning a block to
resident free space. The block being returned is already a released
block in the resident free space pool. Thus, the caller is either
returning the same block twice or has a completely random address which
is incorrect.
Action: The caller may or may not be the culprit. It is possible that some
other routine is picking up the wrong address and releasing it.
Data: BADADR - the address given to the free space manager
CALLER - the PC when the free space manager was called
>)
RET]
;Note: as we are now PION, we are in a window such that an interrupt
;routine may have just acquired the very block we are still releasing;
;this is why pool number and block size were saved previous to call to
;CLRBTS. If we are in the window, the pool count is deficient by the
;value stored in RELSIZ (We are going to rectify that with the next
;few inststructions...).
MOVE T4,RELPLN ;Get pool number
MOVE T2,RELSIZ ;Get number of 4-word blocks
MOVE T3,RELADR ;POINT TO DESCRIPTOR BLOCK
ADD T4,.REPFR(T3) ;POINT TO FREE ENTRY FOR POOL
ADDM T2,(T4) ;ADD BACK THE SPACE TO USAGE TABLE
ADDM T2,.RETFR(T3) ;UPDATE THE OVERALL FREE COUNT
RET
RESOUT: MOVE T1,RELRAD ;GET BAD ADDRESS
MOVE T2,RELCAL ;GET CALLER
BUG.(CHK,RESBND,FREE,SOFT,<RELRES - Releasing space beyond end of resident free pool>,<<T1,BADADR>,<T2,CALLER>>,<
Cause: This is a free space problem. The caller is trying to release resident
free space. The address passed to RELRES is outside the range of the
resident free space pool.
Action: If the problem persists change the BUGCHK to a BUGHLT.
Data: BADADR - the address given to the free space manager
CALLER - the PC when the free space manager was called
>)
RET
RESINC: MOVE T1,RELRAD ;GET BADADR
MOVE T2,RELCAL ;GET CALLER
BUG.(HLT,RESCHK,FREE,SOFT,<RELRES - Resident free space was overwritten>,<<T1,BADADR>,<T2,CALLER>>,<
Cause: Resident free space has been overwritten.
Action: Look at the header of the free space segment; it contains the PC of the
assigner of the space. Try to figure out why more space was used
than was requested.
Data: BADDAR - Address passed to RELRES
CALLER - PC when RELRES was called
>)
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
HRRZ 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,@[EP. RSECMP(T3)] ;MAKE PAGE WRITABLE
CLRPT (T4) ;TELL HARDWARE
ANDCAM T1,(T4) ;CLEAR THE BITS
ANDCAM T2,@[EP. RSECMP(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
;CHKRFS - Check to see if there's enough resident free space
;ACCEPTS:
; T1/ Number of words required
; T2/ Flags,,pool number
; CALL CHKRFS
;RETURNS +1: Not enough space
; +2: There was enough when you asked
;Flags:
; RS%SE0==:1B0 ;SPACE MUST BE IN SECTION 0
CHKRFS::
XMOVEI T3,RESNTB ;ASSUME NON-ZERO SECTION NUMBER
TXZN T2,RS%SE0 ;DID USER REQUEST SECTION 0?
IFSKP.
HRRZS T2 ;YES, GET RID OF FLAGS
XMOVEI T3,RES0TB ;RESTRICT USE TO SECTION 0
ENDIF.
ADD T2,.REPFR(T3) ;POINT TO TABLE OF FREE BLOCKS BY POOL NO.
ASH T1,-2 ;COMPUTE NUMBER OF 4-WORD BLOCKS REQUIRED
CAMLE T1,(T2) ;USER NEEDS FEWER THAN WE HAVE FREE?
RETBAD ;NO. RETURN ERROR
RETSKP ;YES. RETURN SUCCESS
;RESFPI - INITIALIZATION ROUTINE FOR THE RESIDENT FREE POOL
RESFPI::
XMOVEI T3,RES0TB
CALL RESFPX
XMOVEI T3,RESNTB
CALL RESFPX
RET
RESFPX:
MOVE T1,.REBTL(T3) ;GET LENGTH OF BIT TABLE
SOS T1
MOVE T2,.REBTB(T3) ;SOURCE
IFN RESBSW,<
HLRZ T3,T2 ;SEE WHAT SECTION HAS BIT TABLE
CAIE T3,RESSEC ;THIS ONE?
BUG.(HLT,RBTSEC,FREE,SOFT,<RESBTB in wrong section>,,<
Cause: Debugging code attempts to write-protect the allocation
table by changing the map directly. It assumes that
the bit table is in the section used by NRPE, but
the address is not in that section.
>)
> ;END REWBSW
SETOM (T2) ;INITIALIZE FIRST WORD
XMOVEI T3,1(T2) ;DESTINATION
XBLT. T1
RET
REPEAT 0,<
MOVE T1,.REBTL(T3) ;GET LENGTH OF BIT TABLE
MOVE T4,.REBTB(T3) ;GET START OF BIT TABLE
RESFP1: SETOM (T4) ;MARK ALL BITS AS "IN USE"
AOS T4
SOJG T1,RESFP1 ;LOOP FOR ALL WORDS IN THE BIT TABLE
RET ;ALL SET UP
>
;ROUTINE CALLED BY JOB 0 TO LOCK AND UNLOCK FREE SPACE
; CALL RESLCK
;RETURNS +1: ALWAYS
SWAPCD
RESLCK::XMOVEI T4,RES0TB ;SECTION 0 FREE SPACE
CALL RESLCX
XMOVEI T4,RESNTB ;NON-ZERO FREE SPACE
CALL RESLCX
RET
;Accepts:
; T4/ Address of descriptor block
; CALL RESLCX
;Returns +1: always
RESLCX::STKVAR <LCKADR,LCKPIF>
MOVEM T4,LCKADR ;SAVE ADDRESS OF DESCRIPTOR BLOCK
RESLK5: MOVE T1,.REGRO(T4) ;SEE HOW CLOSE TO THE AVERAGE WE ARE
CAMG T1,.RETFR(T4) ;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
MOVE T4,LCKADR ;RESTORE ADDRESS OF DESCRIPTOR BLOCK
JRST RESLK5 ;GO SEE IF THIS WAS ENOUGH
;Current remaining space is sufficient. See if we need to unlock any
;(that is, we have more than a page to spare)
RESLK1: MOVE T1,.RETFR(T4) ;NOW CHECK IF SOME NEEDS UNLOCKING
SUBI T1,PGSIZ/4 ;NUMBER BLOCKS ON A PAGE
CAMG T1,.REGRO(T4) ;ARE WE WELL ABOVE THE AVERAGE?
RET ;NO, THEN EXIT
MOVE T3,.REFFB(T4) ;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
ADD T1,.REBTB(T4) ;GET OFFSET INTO BIT TABLE
JRST RESLK3 ;GO TO RESMON FOR CRITICAL CODE
;Resident code to do non-PI functions
; T1/ Address of bit table word
; T2/ Byte pointer to bit
; T3/ Number of first free block
; T4/ Address of descriptor block
RESCD
RESLK3: NOSKED
MOVEM T1,LCKPIF ;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,LCKPIF ;SAVE PI STATE FLAG RESTORE T1
CAME T3,.REFFB(T4) ;STILL HAVE SAME FIRST FREE BLOCK?
IFNSK.
MOVE T1,LCKPIF ;NO. GET PI STATE FLAG
SKIPE T1 ;WAS PI ON?
PION ;YES. TURN IT BACK ON
OKSKED
JRST RESLK1 ;GO TRY AGAIN
ENDIF.
;..
;..
LDB T4,T2 ;GET THE BIT (NOTE: USES T1 IN BYTE POINTER!)
SKIPN T4 ;BLOCK IN USE?
IFSKP.
EXCH T1,LCKPIF ;YES. SAVE T1. RESTORE PI STATE FLAG
SKIPE T1 ;WAS PI ON?
PION ;YES. TURN IT BACK ON
OKSKED
RET ;AND RETURN
ENDIF.
;Here when block is not in use. Decrement free block count and pointer
;to first free block, and clear the bit in the bit table
IFN RESBSW,<
MOVE T3,LCKADR ;GET ADDRESS OF DESCRIPTOR BLOCK
HRRZ T3,.REBTB(T3) ;GET ADDRESS OF START OF BIT TABLE
IDIVI T3,PGSIZ ;GET PAGE NUMBER OF BIT TABLE
MOVX T4,PTWR ;GET WRITE FLAG
IORM T4,@[EP. RSECMP(T3)] ;SET WRITE ACCESS IN MONITOR MAP
MOVE T3,LCKADR ;GET ADDRESS AGAIN
MOVE T3,.REBTB(T3)
CLRPT (T3) ;LET HARDWARE KNOW
> ;END OF IFN RESBSW
MOVEI T4,1 ;NOT IN USE, MARK IT TAKEN
DPB T4,T2 ;NOTE: USES AC 1 IN BYTE POINTER!
MOVE T4,LCKADR ;GET BACK THE FREE SPACE DESCRIPTOR
IFN RESBSW,<
HRRZ T3,T3
IDIVI T3,PGSIZ ;BACK TO PAGE NUMBER OF BIT TABLE
MOVX T1,PTWR ;GET WRITE FLAG
ANDCAM T1,@[EP. RSECMP(T3)] ;CLEAR WRITE-ENABLE
MOVE T4,LCKADR ;GET ADDRESS OF DESCRIPTOR BLOCK
MOVE T2,.REBTB(T4) ;GET ADDRESS OF BIT TABLE
CLRPT (T2) ;LET HARDWARE KNOW
> ;END OF IFN RESBSW
SOS .RETFR(T4) ;COUNT DOWN THE FREE COUNT
SOS T1,.REFFB(T4) ;AND REMOVE IT FROM FREE POOL
EXCH T1,LCKPIF ;SAVE T1 RESTORE PI STATE FLAG
SKIPE T1 ;WAS PI ON?
PION ;THROUGH INTERLOCKED CODE
MOVE T1,LCKPIF ;RESTORE T1 CLEAN UP STACK
JRST RESLK4 ;NOW, BACK TO SWPMON
;RETURN TO SWAPPABLE CODE FOR PI FUNCTIONS
; T1/ Number of block to be released
; T4/ Address of descriptor block
SWAPCD
RESLK4: LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK
ADD T1,.REBAS(T4) ;...
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
MOVE T4,LCKADR ;GET ADDRESS OF DESCRIPTOR BLOCK
RESLK2: OKSKED
JRST RESLK1 ;GO SEE IF MORE WORK NEEDED
SUBTTL Routines for new swappable freespace manager
; EXTERN FSPTAB,FSPTBL,ENQFSX,IPCFSX,GENFSX,JSBFSX,DCNFSX
EXTERN FSPTAB,FSPTBL,ENQFSX,IPCFSX
IFN FTNSPSRV,<
EXTERN DCNFSX
> ;End IFN FTNSPSRV
;************************************************************************
COMMENT %
Conditional assembly features
FSPDBG allows headers greater than length 3 and the existence of
trailers. Headers and trailers may be any size as long as
the trailer is no larger than the header.
FSPACC allows accounting of requested and granted block sizes and
traversal length required to find desired size.
Requests larger than constant FSPBSC-1 are counted in a single
category.
% ;End comment
COMMENT %
Swappable and JSB freespace structures
Freespace-descriptor index table
FSPTAB: *-------------------------------------------------------------*
* Pointer to freespace descriptor *
*-------------------------------------------------------------*
* Pointer to freespace descriptor *
*-------------------------------------------------------------*
.
.
.
*-------------------------------------------------------------*
* Pointer to freespace descriptor *
*-------------------------------------------------------------*
FSPTBL = Freespace-descriptor index-table size in words
Freespace descriptor
*-------------------------------------------------------------*
FSPPFL: 0 * Flags *
*-------------------------------------------------------------*
FSPLOK: 1 * Pool lock *
*-------------------------------------------------------------*
FSPORG: 2 * Origin address of freespace pool *
*-------------------------------------------------------------*
FSPEND: 3 * Ending address of freespace pool *
*-------------------------------------------------------------*
FSPCNT: 4 * Count of space remaining in pool *
*-------------------------------------------------------------*
FSPSML: 5 * Smallest balance of free space achieved *
*-------------------------------------------------------------*
FSPBAP: 6 * Pointer to block-accounting area *
*-------------------------------------------------------------*
FSPMTB: 7 * Minimum total block size *
*-------------------------------------------------------------*
FSPFFB: 10 * Pointer to first free block *
*-------------------------------------------------------------*
FSPRFB: 11 * Randomized pointer to first free block *
*-------------------------------------------------------------*
FSPHDS: 12 * Block header size *
*-------------------------------------------------------------*
FSPTRS: 13 * Block trailer size *
*-------------------------------------------------------------*
FSPHTS: 14 * Combined header and trailer size *
*-------------------------------------------------------------*
FSPBCS: 15 * Smaller of header or trailer size *
*-------------------------------------------------------------*
FSPHBO: 16 * History buffer address *
*-------------------------------------------------------------*
FSPHBX: 17 * Max History transactions * Index to current hist rec *
*-------------------------------------------------------------*
FSPDSS = descriptor size in words
;Offsets for history records
FSPHST==0 ;Transaction type:
;-1 = assign
; 0 = deassign
FSPHPC==1 ;PC of caller
FSPHJF==2 ;Job,,fork of caller
FSPHBA==3 ;Block address
FSPHBS==4 ;Block size
FSPHRS==5 ;History record size
FSPHRC==^D200 ;# of history records per pool
*-------------------------------------------------------------*
n+0 * *
*-------------------------------------------------------------*
n+1 * Count for blocksize 1 *
*-------------------------------------------------------------*
n+2 * Count for blocksize 2 *
*-------------------------------------------------------------*
.
.
.
*-------------------------------------------------------------*
n+end-1 * Count for blocksize "end"-1 *
*-------------------------------------------------------------*
n+end * Count for all blocks of size "end" or greater *
*-------------------------------------------------------------*
Where "end" is the last offset in the accounting block.
FSPBSC = accounting-block size in words
There are actually 3 of the previously described blocks
in the accounting area:
(1) a count of requests for each blocksize
(2) a count of filled requests for each blocksize
(3) a count of the list traversal-lengths for each blocksize
Freespace block header/trailer
*-------------------------------------------------------------*
FSPDPC: -7 * PC of block assigner *
*-------------------------------------------------------------*
FSPDJF: -6 * Job #,,fork # of block assigner *
*-------------------------------------------------------------*
FSPDPC: -5 * PC of block deassigner *
*-------------------------------------------------------------*
FSPDJF: -4 * Job #,,fork # of block deassigner *
*-------------------------------------------------------------*
FSPFLG: -3 * Flags,,unique code *
*-------------------------------------------------------------*
FSPSIZ: -2 * Size of block (including header/trailer) *
*-------------------------------------------------------------*
FSPNXT: -1 * Pointer to next block *
*-------------------------------------------------------------*
At a minimum, a header of length 3 is required (no trailer
is ever required). The header is infinitely expandable, as
is any trailer.
While in the pool, blocks are manipulated by pointers that
address the first word past the header (thus the negative
offsets for the header definitions). Before a block is
assigned to the user, the pointer is SOS'd and the user area
of the block overlays the header by 1 word. (Specifically,
the user area of the block begins with header word FSPNXT.)
% ;End comment
COMMENT %
Routine to set up global variables
CALL: JSP T4,SETVAR
RETURNS +1: ALWAYS
TRVAR LEGEND:
FLAGS Entry flags
CALRPC PC of caller
DATUM Datum identifier code for use when stacking entries
BLKSIZ Desired block size (Requested + Block header and trailer size)
BADDR Address of "first block"
PADDR Address of predecessor of user block
FRAGSZ Size of block fragment
PASS -1 = First pass, 0 = second pass through assignment algorithm
ENDPL Ending address of freespace pool
TRAVRS When block accounting is in effect, counts length of traverse
for this size block
BLOCKX When block accounting is in effect, contains the descriptor
address plus the appropriate index for this block size
DESNDX Descriptor index for the pool
% ;End comment
;**;[7320] Change 1 line at SETVAR: + 0 L JDM 12-JUN-86
SETVAR: TRVAR <FLAGS,CALRPC,DATUM,BLKSIZ,BADDR,PADDR,FRAGSZ,PASS,TRAVRS,BLOCKX,DESNDX,FBKSIZ> ;[7320]
CALLRET 0(T4)
;Miscellaneous flags used by swappable freespace routines
;These flags are kept in TRVAR FLAGS for ASGFSP and RELFSP
;Flags for entry type:
FSP.SK==1B0 ;We want this entry stacked
;(RH)F contains datum code
;Flags for returned block merge-states
FSP.MS==1B1 ;Merged with successor
FSP.MP==1B2 ;Merged with predecessor
COMMENT *
Routine to initialize swappable free space. Zeroes the entire pool,
turns it into one block, and initializes the free pool lock.
Note: Free PIDs occur in the interval [1...MAXPID]
Used PIDs are identified by their swappable free space
pointer and occur in the interval of the swappable free space
addresses. The 2 intervals must not overlap, so MAXPID
should always be less than the first free space address.
This is guaranteed as long as swappable free space is in a
non-zero section.
* ;End comment
;RETURNS: +1 Always
FSPINI::SAVEAC<T1,T2,T3,T4,P1,P2,P3> ;Save our AC's
JSP T4,SETVAR ;Setup global variables
; SETZM FSPTAB+JSBFSX ;Make sure that this slot is zero
;So that JSB space is initialized only on
; job start-up
MOVSI P3,-FSPTBL ;Get AOBJN pointer
FSPIN: MOVE P1,FSPTAB(P3) ;Get address of pool descriptor
JUMPE P1,ININXT ;No descriptor, skip this slot
CALL POOLIN ;Do the work
ININXT: AOBJN P3,FSPIN ;Do entire table
;(Not for V6)
;Having skipped the initialization of JSB freespace,
;simply set up a pointer to the job area where the template descriptor
;(JSBDES) will be moved.
; MOVEI T1,JSBFRE ;Get address of JSB descriptor
; MOVEM T1,FSPTAB+JSBFSX ;Store it
RET
COMMENT %
Not for V6
;Routine to initialize JSB freespace
;Called on job-startup
JSBFIN::HRLI T1,JSBDES ;Get origin of JSB descriptor template
HRRI T1,JSBFRE ;Get JSB address to move it to
BLT T1,JSBFRE+FSPDSS-1 ;Move it
;Initialize bittable for JSB freespace pages
MOVE T1,[XWD JBCOR,JBCOR+1]
SETZM JBCOR
BLT T1,JBCOR+3
UNLOCK JBCLCK ;Unlock the ASGPAG lock
UNLOCK JSFLCK ;Unlock the resource-stack lock
;Initialize the JSB pool itself
MOVE P1,FSPTAB+JSBFSX ;Get address of descriptor
CALLRET POOLIN ;Go do the work
% ;End comment
;Subroutine to initialize a freespace pool
;Args: P1/ Address of pool descriptor
;Zero the free pool
POOLIN:
COMMENT %
MOVE T1,FSPCNT(P1) ;Get pool length
SOS T1 ;Less 1
MOVE T2,FSPORG(P1) ;Get origin of free pool
SETZM (T2) ;Zero first cell
MOVE T3,T2 ;Get free pool origin in T3
AOS T3 ;Increment it
XBLT. T1 ;Zero the pool
% ;End comment
;Initialize the dummy header
MOVE T1,FSPFFB(P1) ;Get address of dummy header
MOVE T2,FSPHDS(P1) ;Get blocksize
MOVEM T2,FSPSIZ(T1) ;Store that as size of dummy header
MOVE T3,T1 ;Get dummy-header address in T3
ADD T3,T2 ;Add header size to calc start of next block
MOVEM T3,FSPNXT(T1) ;Use that as next pointer of dummy header
;Turn entire pool into 1 block
MOVE T1,FSPCNT(P1) ;Get length of free pool
MOVE T2,FSPORG(P1) ;Get origin of freespace pool
MOVE T3,FSPHDS(P1) ;Get header size
ADD T2,T3 ;Adjust pointer for header length
MOVEM T1,FSPSIZ(T2) ;Store the block size (all of free pool)
SETZM FSPNXT(T2) ;Make sure next-pointer is zero
MOVE T1,T2 ;Get block address in T1
MOVEI T2,FSPUCD ;Get the unique code
HRRZM T2,FSPFLG(T1) ;Store in header
IFN FSPDBG,<
MOVE P2,T1 ;Get block address in P2
CALL FILHDR ;Complete header and trailer
>
SETOM FSPLOK(P1) ;Initialize free pool lock
RET
;The following are entry points to the central swappable-
;free space allocator (ASGFSP)
;ARGS: T1/ Desired block size
;ASGGEN::MOVEI T2,GENFSX ;Get free-pool descriptor index
; JRST ASGCOM ;Join common code
IFN FTNSPSRV,<
ASGDCN::MOVEI T2,DCNFSX ;Get free-pool descriptor index
JRST ASGCOM ;Join common code
> ;End IFN FTNSPSRV
ASGIPC::MOVEI T2,IPCFSX ;Get free-pool descriptor index
JRST ASGCOM ;Join common code
ASGENQ::MOVEI T2,ENQFSX ;Get free-pool descriptor index
ASGCOM:
IFN FSPDBG,<
MOVE T3,(P) ;Get PC of caller
>
JSP T4,SETVAR ;Set up global variables
IFN FSPDBG,<
MOVEM T3,CALRPC ;Save PC
>
SETZM FLAGS ;Zero flags word
JRST ASGFSP ;Enter main routine
;The following are entry points to the central swappable-
;free space deallocator (RELFSP)
;ARGS: T1/ Block address
;RELJSB::MOVEI T2,JSBFSX ;Get free-pool descriptor index
; JRST RELCOM ;Join common code
;RELGEN::MOVEI T2,GENFSX ;Get free-pool descriptor index
; JRST RELCOM ;Join common code
IFN FTNSPSRV,<
RELDCN::MOVEI T2,DCNFSX ;Get free-pool descriptor index
JRST RELCOM ;Join common code
> ;End IFN FTNSPSRV
RELIPC::MOVEI T2,IPCFSX ;Get free-pool descriptor index
JRST RELCOM ;Join common code
RELENQ::MOVEI T2,ENQFSX ;Get free-pool descriptor index
RELCOM:
IFN FSPDBG,<
MOVE T3,(P) ;Get PC of caller
>
JSP T4,SETVAR ;Set up global variables
IFN FSPDBG,<
MOVEM T3,CALRPC ;Save PC
>
SETZM FLAGS ;Zero flags word
JRST RELFSP ;Enter main routine
COMMENT %
Central routine for allocating swappable free space
ARGS: T1/ Desired block size
T2/ Free pool descriptor index
RETURNS: +1 Failure, error code in T1
+2 success, block address in T1
% ;End comment
ASGFSP: SAVEAC <P1>
MOVEM T2,DESNDX ;Save pool descriptor index
MOVE P1,FSPTAB(T2) ;Get address of pool descriptor
SKIPLE T2,T1 ;Is this request legal?
JRST ASGFS1 ;Yes
MOVE T1,DESNDX ;Get pool number
MOVE T3,CALRPC ;Get caller's PC
BUG.(HLT,FSPZER,FREE,SOFT,<ASGFSP - Illegal to assign 0 FREE space>,<<T1,POOLN>,<T3,CALRPC>>,<
Cause: An illegal request for free space is being made. The calling routine
is asking for zero words of free space.
Action: Look at the dump. By backing up the stack you
should be able to tell what routine called for the illegal
free space.
Data: POOLN Pool number
CALRPC PC of caller of ASGFSP
>)
ASGFS1: SKIPL INTDF ;Is the process NOINT?
JRST ASGFS2 ;Yes
MOVE T4,DESNDX ;Get pool number
MOVE T3,CALRPC ;Get caller's PC
BUG.(HLT,FSPANN,FREE,SOFT,<ASGFRE called OKINT>,<<T4,POOLN>,<T3,CALRPC>>,<
Cause: This is a free space problem. Calls to swapable free space
routines should be made only while the calling process is NOINT. The
calling routine is not protecting itself from losing free space. It is
OKINT. Since it is OKINT it could get interrupted and never return,
thus losing the free block assigned.
Action: The data supplied gives the address of the calling routine. Make
the routine NOINT until it has insured that the block will be
freed when it is interrupted (e.g. JSB stack).
Data: POOLN - Pool number
CALRPC - Caller of RELFSP
>)
ASGFS2:
IFN FSPACC,<
CALL BLKACC ;Account for this block request
>
ADD T2,FSPHTS(P1) ;Add header+trailer length to desired block size
SOS T2 ;Less 1 as we will give the next-pointer word
; in the header to the user
CAMGE T2,FSPMTB(P1) ;Is this request below minimum size?
MOVE T2,FSPMTB(P1) ;Yes, allocate the minimum size block
CAMLE T2,FSPCNT(P1) ;Is requested block size .LEQ. remaining space?
JRST ASGRT3 ;No, return
CSKED ;Don't reschedule
LOCK FSPLOK(P1) ;Lock this free storage list
IFN FSPDBG,<
MOVE T1,FSPPFL(P1) ;Get flags
TXNE T1,FS.CHK ;Should we check this pool?
CALL FSPCK ;Yes, check integrity of pool
JFCL ;We will try even though pool may be damaged
>
MOVEM T2,BLKSIZ ;Save desired block size
MOVEI T2,377777 ;Get initial best block size
;**;[7320]Change 1 line at ASGFS2: + 23 L JDM 12-JUN-86
MOVEM T2,FBKSIZ ;[7320]SAVE IT FOR LATER
SETZM PADDR ;Initial location of predecessor
SETOM PASS ;This is pass 1
SKIPN T2,FSPRFB(P1) ;Get address of randomized first block
MOVE T2,FSPFFB(P1) ;There was none, use first free block
CAMN T2,FSPFFB(P1) ;Is it really the head of list?
SETZM PASS ;Yes, don't allow a second pass
IFN FSPACC,<
SETZM TRAVRS ;Zero traverse length
>
;...
;...
;Perform free-pool traversal
ASGSW1:
IFN FSPACC,<
AOS TRAVRS ;Count length of this traverse
>
MOVE T3,FSPNXT(T2) ;Get pointer to next block
JUMPE T3,ASGRT1 ;No more free blocks, so fail
MOVE T4,FSPSIZ(T3) ;Get size of block
MOVEM T2,PADDR ;Save address of predecessor
;**;[7320]Change 1 line at ASGSW1: + 8 L JDM 12-JUN-86
MOVEM T4,FBKSIZ ;[7320]This is a better "first block", save its size.
CAMN T4,BLKSIZ ;Is it exactly the desired block size?
JRST ASGSW9 ;Yes, go use it
CAML T4,BLKSIZ ;Is it greater than the desired block size?
JRST ASGSW6 ;Yes, go fragment it
ASGSW4: MOVE T2,T3 ;Step to next free block
JRST ASGSW1 ;And repeat
;Here with PADDR pointing to predecessor of "first block". If we can
;we will split "first block" and return fragment to free pool.
ASGSW6: MOVE T2,PADDR ;Get address of predecessor
JUMPE T2,ASGRT1 ;There is none, exit (no "first block")
MOVE T3,FSPNXT(T2) ;Get address of best block
;**;[7320]Change 1 line at ASGSW6: + 0 3 JDM 12-JUN-86
MOVE T4,FBKSIZ ;[7320]Get size of "first block"
SUB T4,BLKSIZ ;Subtract the desired block size
MOVEM T4,FRAGSZ ;And keep fragment size here
MOVE T4,FSPMTB(P1) ;Get minimum block size
CAMLE T4,FRAGSZ ;Would a fragment be above minimum size?
JRST ASGSW8 ;No, return entire block to user
MOVE T1,BLKSIZ ;Get desired block size
MOVEM T1,FSPSIZ(T3) ;Reduce "first block" to desired block size
ADD T1,T3 ;Calculate address of block fragment
MOVE T2,FSPNXT(T3) ;Get "first block's" next-pointer
MOVEM T2,FSPNXT(T1) ;Point fragment at that block
MOVE T2,PADDR ;Get address of predecessor
MOVEM T1,FSPNXT(T2) ;Point predecessor to fragment
IFN FSPDBG,<
SKIPN FSPTRS(P1) ;Is there a trailer?
JRST ASGSW7 ;No
ADD T2,FSPSIZ(T2) ;Step to trailer of predecessor
SUB T2,FSPTRS(P1) ;...
MOVEM T1,FSPNXT(T2) ;Update pointer in trailer
>
ASGSW7: MOVE T2,FRAGSZ ;Get fragment size
MOVEM T2,FSPSIZ(T1) ;Store in header of block fragment
;...
;...
MOVEI T4,FSPUCD ;Get unique code
MOVEM T4,FSPFLG(T1) ;Store in header of block fragment
IFN FSPDBG,<
CALL FILTRL ;Update the trailer of fragment
>
JRST ASGRET ;Go finish up and return successfully
;Here if a fragment would be below minimum block size.
;**;[7320]Change 1 line at ASGSW8: + 0 L JDM 12-JUN-86
ASGSW8: MOVE T4,FBKSIZ ;[7320]Get size of "first block"
MOVEM T4,BLKSIZ ;Make it the desired block size
;Here if "first block" size is exactly right.
ASGSW9: MOVE T4,FSPNXT(T3) ;Get next pointer out of newly assigned block
MOVEM T4,FSPNXT(T2) ;Point previous block to succeeding block
;Make sure predecessor trailer contains same pointer as header
IFN FSPDBG,<
SKIPN FSPTRS(P1) ;Is there a trailer?
JRST ASGRET ;No
ADD T2,FSPSIZ(T2) ;Step to trailer of predecessor
SUB T2,FSPTRS(P1) ;...
MOVEM T4,FSPNXT(T2) ;Point previous block to succeeding block
>
;...
;...
;Exit code for successful attempt
ASGRET: MOVE T2,FSPNXT(T3) ;Get next pointer from newly-allocated block
MOVEM T2,FSPRFB(P1) ;Start next traverse here
MOVE T2,FSPCNT(P1) ;Get current free space balance
SUB T2,BLKSIZ ;Subtract size of block just allocated
MOVEM T2,FSPCNT(P1) ;Save adjusted balance
CAMGE T2,FSPSML(P1) ;Is this the smallest balance seen so far?
MOVEM T2,FSPSML(P1) ;Yes, remember it
UNLOCK FSPLOK(P1) ;Unlock the freespace pool
ECSKED ;Allow reschedule
MOVX T2,FSP.AS!FSPUCD ;Get block-assigned bit + unique code
MOVEM T2,FSPFLG(T3) ;Store in header
MOVE T1,T3 ;Get pointer to newly allocated block
IFN FSPDBG,<
CALL FILHDR ;Fill in the remainder of the header + trailer
>
CALL ZERBLK ;Zero the block
IFN FSPACC,<
SKIPN T2,BLOCKX ;Can we do block accounting?
JRST ASGRTG ;No
AOS FSPFIL(T2) ;Account for filled block-request
MOVE T3,TRAVRS ;Get length of traverse
ADDM T3,FSPTRV(T2) ;Add it to current total
>
ASGRTG:
IFN FSPDBG,<
CALL HISTRY ;Generate a history record
>
SOS T1 ;Include next-pointer word in user area
MOVE T2,FSPPFL(P1) ;Get flags
TXNN T2,FS.CNT ;User want to see count word?
RETSKP ;No, return with block address in T1
SOS T1 ;Point to count word of header
MOVN T2,FSPHTS(P1) ;Get -(combined header and trailer size)
ADDM T2,(T1) ;Leave just the user block size
AOS (T1) ;Allow for header overlay
RETSKP
;Exit code for unsuccessful attempt
ASGRT1: AOSLE PASS ;Can we do a second pass?
JRST ASGRT2 ;No
MOVE T2,FSPFFB(P1) ;Yes, start list traverse with first free block
JRST ASGSW1 ;Do a second pass
ASGRT2: UNLOCK FSPLOK(P1) ;Unlock the freespace pool
ECSKED ;Allow reschedule
IFN FSPACC,<
SKIPN T2,BLOCKX ;Can we do block accounting?
JRST ASGRT3 ;No
MOVE T3,TRAVRS ;Get length of traverse
ADDM T3,FSPTRV(T2) ;Add it to current total
>
ASGRT3: MOVE T2,DESNDX ;Get pool number
BUG.(INF,FSPOUT,FREE,SOFT,<Freespace pool exhausted>,<<T2,POOLN>>,<
Cause: This is a free space problem. There is no more space available
in the freespace pool.
Action: The data supplied gives the pool number (pool descriptor index) of
the pool in question. If the pool repeatedly runs out of space,
the pool size must be increased and the monitor rebuilt.
Data: POOLN - Freespace pool number
>)
MOVEI T1,MONX06 ;Tell him no free space
RET
COMMENT *
Central routine for deassigning swappable free space
ARGS: T1/ Block Address
T2/ Pool descriptor index
AC usage:
F/ Internal flags
P1/ Pool descriptor address
P2/ User block address
Returns: +1 Always
* ;End comment
RELFSP::SAVEAC <F,P1,P2,P3,Q1> ;Save AC's
MOVEM T2,DESNDX ;Save pool descriptor index
MOVE P1,FSPTAB(T2) ;Get address of descriptor
SKIPL INTDF ;Are we NOINT?
JRST RLF1 ;Yes
MOVE T4,DESNDX ;Get pool number
MOVE T3,CALRPC ;Get caller's PC
BUG.(HLT,FSPDNN,FREE,SOFT,<RELFSP called OKINT>,<<T4,POOLN>,<T3,CALRPC>>,<
Cause: This is a free space problem. The calling routine is trying to release
a swapable free space block while it is OKINT. This is dangerous since
it could get interrupted and loose the block. All
free space actions should occur while NOINT.
Action: The data supplied gives the address of the calling routine. Make
the routine become NOINT when it removes the address of the block
about to be released from the database. The routine
can be made OKINT when control is returned to it.
Data: POOLN - Pool number
CALRPC - PC of caller of RELFSP
>)
RLF1: CSKED ;Don't allow reschedule
LOCK FSPLOK(P1) ;Lock free space pool
;See if the returned block falls correctly within the address
;range for this pool.
MOVE F,FLAGS ;Keep flags here
MOVE P2,T1 ;Keep user block address here
MOVE T2,FSPPFL(P1) ;Get pool flags
TXNN T2,FS.CNT ;Does user see count word?
JRST LIMCHK ;No
MOVE T2,(P2) ;Get the block length
ADD T2,FSPHTS(P1) ;Add combined header/trailer size
HRRZM T2,(P2) ;Set block size in RH only
SOS (P2) ;Allow for header overlay
AOS P2 ;Step the pointer to first header word
LIMCHK: AOS T1,P2 ;Exclude next-pointer word from user area
; and get it in T1 for HISTRY
IFN FSPDBG,<
CALL HISTRD ;Generate a history record
>
MOVE T4,FSPEND(P1) ;Get ending pool address
MOVE T1,FSPORG(P1) ;Get origin pool address
CAMLE T4,P2 ;Is the user block beyond the end?
CAMLE T1,P2 ;Is the user block before the start?
JRST RELBBA ;No, bad address
MOVE T2,FSPSIZ(P2) ;Get the blocksize
ADD T2,FSPCNT(P1) ;Calculate augmented poolsize
SOS T2 ;Adjust by 1 for correct compare
ADD T2,T1 ;Add pool origin address
CAMG T2,T4 ;If poolcount pushes last pool addr beyond
; FSPEND, we have a problem.
CAMGE T2,T1 ;If poolcount pushes first pool addr below
; FSPORG, we have a problem
JRST RELBBS ;We have a problem, go complain
CALL BLKCKP ;Check the block and complain if bad
SKIPA ;Block is bad
JRST BLKOK
MOVE T4,FSPFLG(P2) ;Get flags word
TXZ T4,FSP.AS ;Turn off block-assigned bit
MOVEM T4,FSPFLG(P2) ;Replace flags
MOVE P3,P2 ;Get block address in P3
IFN FSPDBG,<
CALL UPDHDR ;Update header
>
JRST RLFRR ;Return, leaving block in limbo
BLKOK: MOVE T3,FSPSIZ(P2) ;Get user block length
MOVEM T3,BLKSIZ ;Save it
;The block starts within the address interval for this pool. Traverse
;the pool until we find either the end of the chain, or a block beyond
;the one we wish to return.
RLFR0: MOVE T2,FSPFFB(P1) ;Get address of first free block
MOVEM T2,PADDR ;Save as predecessor of predecessor
RLFR1: MOVE T3,FSPNXT(T2) ;Get address of next block on chain
JUMPE T3,RLFR2 ;At end of chain?
CAML T3,P2 ;No, past the user block?
JRST RLFR2 ;Yes
MOVEM T2,PADDR ;No, save as predecessor of predecessor
MOVE T2,T3 ;Step to the next block
JRST RLFR1 ;Continue search
COMMENT *
Here when the traverse through the chain is complete.
Either:
1. The last block in the chain precedes (lower address)
the block we wish to return.
2. A block has been found that succedes (higher address)
the block we wish to return. We also check to see
if we are attempting to return a block that is already
on the list.
Block being returned will go between address in T2 and address in
T3.
T2/ Address of block preceding user block
T3/ Address of block succeding user block or zero
* ;End comment
RLFR2: CAME T3,T2 ;Releasing already-released block?
JRST CHKPRE ;No
MOVE T4,CALRPC ;Get caller's PC
MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPARB,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T4,CALRPC>,<P2,BLKADR>>,<
Cause: The caller is attempting to release a block that has already been
released.
Action: Looking at the stack will show the caller. It is possible that the
length of the current block is incorrect. It is equally likely that
the block(s) before this block (in free space) have had incorrect
lengths on return. Thus, the caller may not be the culprit.
Data: POOLN - Pool number
CALRPC - PC of caller of RELFSP
BLKADR - Address of user block
>)
;See if preceding block will overlap user block. If so, BUGCHK.
CHKPRE: MOVE T4,FSPSIZ(T2) ;Get size of preceding block
ADD T4,T2 ;Compute start of next block
CAMG T4,P2 ;Does previous block overlap user's block?
JRST CHKSUC ;No
MOVE Q1,DESNDX ;Get pool number
MOVE T4,CALRPC ;Get caller's PC
BUG.(HLT,FSPPRE,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T4,CALRPC>,<P2,BLKADR>>,<
Cause: This is a free space problem. The block being returned does not fit
into the free pool. The block would overlap the preceding block
in the pool.
Action: Looking at the stack will show the caller. It is possible that the
length of the current block is incorrect. It is equally likely that
the block(s) before this block (in free space) have had incorrect
lengths on return. Thus, the caller may not be the culprit.
Data: POOLN - Pool number
CALRPC - PC of caller of RELFSP
BLKADR - Address of user block
>)
;See if the user block would overlap the one after it
CHKSUC: JUMPE T3,RLFR5 ;If end of list, skip overlap checking
MOVE T4,P2 ;Get address of user block
ADD T4,BLKSIZ ;Compute address of next block
CAMG T4,T3 ;Does that block overlap succeding block?
JRST RLFR4 ;No
MOVE T1,CALRPC ;Get caller's PC
MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPSCC,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T1,CALRPC>,<P2,BLKADR>>,<
Cause: This is a free space problem. The block being returned does not fit
into the free pool. The block would overlap the succeeding block
in the pool.
Action: Looking at the stack will show the caller. It is possible that the
length of the current block is incorrect. It is equally likely that
the block(s) before this block (in free space) have had incorrect
lengths on return. Thus, the caller may not be the culprit.
Data: POOLN Pool number
CALRPC PC of caller of RELFSP
BLKADR Address of user block
>)
;See if the user block can me Merged with its successor.
RLFR4: CAME T4,T3 ;Same as succeeding block address?
JRST RLFR5 ;No, we can't do the merge
;...
;..
;Merge user block and successor
MOVE T4,FSPSIZ(T3) ;Get length of succeeding block
ADDM T4,FSPSIZ(P2) ;Augment length of user block
MOVE T4,FSPNXT(T3) ;Get addr of successor's successor
MOVEM T4,FSPNXT(P2) ;Make user block point to it
IFN FSPDBG,<
TXO F,FSP.MS ;Indicate merge state
>
JRST RLFR6 ;Go attend to predecessor
;Here when user block cannot be merged with its successor
RLFR5: MOVEM T3,FSPNXT(P2) ;Point user block to successor
;Make the predecessor point to the user block. Also see if they
;can be merged.
RLFR6: MOVEM T2,FSPRFB(P1) ;Assume we can't merge - make predecessor the
; randomized first block
MOVEM P2,FSPNXT(T2) ;Make predecessor point to user block
MOVE T4,FSPSIZ(T2) ;Get length of predecessor
ADD T4,T2 ;Compute first address after predecessor
CAME T2,FSPFFB(P1) ;Is the predecessor the dummy header?
CAME T4,P2 ;Does predecessor extend to user block?
JRST RLFRG ;Yes, No, can't do merge
;Merge predecessor and user block
MOVE T4,FSPNXT(P2) ;Get user block's successor
MOVEM T4,FSPNXT(T2) ;Make predecessor point to it
MOVE T4,FSPSIZ(P2) ;Get size of user block
ADDM T4,FSPSIZ(T2) ;Augment length of predecessor
IFN FSPDBG,<
TXO F,FSP.MP ;Indicate merge state
>
MOVE T4,PADDR ;Get predecessor of predecessor
MOVEM T4,FSPRFB(P1) ;Make that our random first block
;User block successfully returned to free pool
RLFRG: MOVE T4,FSPFLG(P2) ;Get flags word
TXZ T4,FSP.AS ;Turn off block-assigned bit
MOVEM T4,FSPFLG(P2) ;Replace flags
IFN FSPDBG,<
CALL MOVHDR ;Update header and trailer
>
MOVE T4,BLKSIZ ;Get size of user block
ADDM T4,FSPCNT(P1) ;Increment pool word count
RLFRR: UNLOCK FSPLOK(P1) ;Unlock the pool
;**;[7207] ADD 1 LINE AT RLFRR:+1.L DSW 12/06/85
SETZM IPPKFR ;[7207] CLEAR FLAG TO ALLOW IPCF RETRYS
ECSKED ;Allow reschedule
RET ;Return
RLFRB: UNLOCK FSPLOK(P1) ;Unlock the pool
ECSKED ;Allow reschedule
MOVE T4,CALRPC ;Get caller's PC
MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,RELINC,FREE,SOFT,<RELFSP - Bad block being released>,<<Q1,POOLN>,<T4,CALRPC>,<P2,BLKADR>>,<
Cause: This is a free space problem. The block being returned does not fit
into the free space. When blocks are returned to the free space pool,
there is a consistency check performed. The block is merged into
existing blocks that follow it in free space. This block overlaps
into existing free blocks. It cannot be merged.
Action: Looking at the stack will show the caller. It is possible that the
length of the current block is incorrect. It is equally likely that
the block(s) before this block in free space have had incorrect
lengths on return. Thus, the caller may not be the culprit.
Data: POOLN - Pool number
CALRPC - PC of caller of RELFSP
BLKADR - Address of user block
>)
RET ;Return
;Here when caller is trying to return a block that will
;cause an invalid pool word-count to be calculated.
RELBBS: UNLOCK FSPLOK(P1) ;Unlock the pool
ECSKED ;Allow reschedule
MOVE T3,CALRPC ;Get the caller of RELFSP
MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPBPC,FREE,SOFT,<RELFSP - Bad pool count>,<<Q1,POOLN>,<T3,CALRPC>,<P2,BLKADR>>,<
Cause: This is a free space problem. The caller to the free space
routines is trying to return a block so that when the pool count
is augmented by the blocksize, an invalid number results. The
blocksize may be in error, or the pool count may already be in
error.
Action: Look through the dump. If the blocksize is wrong, then study the
code at the calling PC for possible errors. If the pool count is
wrong, then more investigation is required. The history buffer for the
pool may contain helpful data.
Data: POOLN - Pool number
CALRPC - PC of caller to RELFSP
BLKADR - Address of block being returned
>)
RET ;Exit RELFSP
;Here when caller is trying to return a block whose address
;does not fall within the legal free-space address interval.
RELBBA: UNLOCK FSPLOK(P1) ;Unlock the pool
ECSKED ;Allow reschedule
MOVE T3,CALRPC ;Get the caller of RELFSP
MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPBND,FREE,SOFT,<RELFSP - Block out of range>,<<Q1,POOLN>,<T3,CALRPC>,<P2,BLKADR>>,<
Cause: This is a free space problem. The caller to the free space
routines is trying to return a block that was not given
out by the free space manager. The block is outside the
range of free space management.
Action: Look through the dump. By looking at the stack you
should be able to determine who called for the releasing
of the block.
Data: POOLN - Pool number
CALRPC - PC of caller to RELFSP
BLKADR - Address of block being returned
>)
RET ;Exit RELFSP
;****************** SWAPPABLE FREESPACE SUBROUTINES ****************
;Routine to complete a history record
;ARGS:
; T1/ Block pointer
; P1/ Pool descriptor
;RETURNS: +1 always
IFN FSPDBG,<
HISTRD: SETZM T2 ;Indicate deassign
SKIPA
HISTRY: SETOM T2 ;Indicate assign
SKIPN FSPHBP(P1) ;Is there a history buffer?
RET ;No
AOS T3,FSPHBX(P1) ;Increment history buffer index
HLRZ T4,T3 ;Get max # history records
HRRZS T3 ;Keep left half zero
CAMGE T3,T4 ;In range?
JRST RANGOK ;Yes
SETZM T3 ;Wrap-around the index
HRRM T3,FSPHBX(P1) ;...
RANGOK: IMULI T3,FSPHRS ;Multiply index by record size
ADD T3,FSPHBP(P1) ;Add the origin of the history buffer
; T3 now points to origin of current record
MOVEM T2,FSPHST(T3) ;Store transaction type
MOVE T4,CALRPC ;Get the caller's PC
MOVEM T4,FSPHPC(T3) ;Store in record
HRLZ T2,JOBNO ;Get the job number
HRR T2,FORKX ;Get the fork number
MOVEM T2,FSPHJF(T3) ;Store in record
MOVEM T1,FSPHBA(T3) ;Store block address
MOVE T2,FSPSIZ(T1) ;Fetch the block size
MOVEM T2,FSPHBS(T3) ;Store in record
RET
> ;End IFN FSPSBG
COMMENT *
Routine to complete filling in of block header in newly-allocated block.
(Flags, block-length and next-pointer are already filled in.)
Also moves the contents of the header to the trailer.
ARGS: T1/ Block pointer
P1/ Pool descriptor address
RETURNS: +1 always
Entry FILHDR is called to finish header and generate trailer for a
soon-to-be-allocated user block.
Entry FILTRL is called to update the trailer of that portion of a
fragmented block that will remain in the pool.
* ;End comment
IFN FSPDBG,<
HDRTAB: BLOCK FSPBHS
RELOC HDRTAB
[RET] ;Zero length header
RELOC HDRTAB-FSPNXT
HTDONE ;Pointer to next block (already filled in)
RELOC HDRTAB-FSPSIZ
HTDONE ;Size of block (already filled in)
RELOC HDRTAB-FSPFLG
HTDONE ;flags (already filled in)
RELOC HDRTAB-FSPDJF
HTDONE ;Deassigning fork and job
RELOC HDRTAB-FSPDPC
HTDONE ;Deassigning PC
RELOC HDRTAB-FSPAJF
HT6 ;Assigning fork and job
RELOC HDRTAB-FSPAPC
HT7 ;Assigning PC
RELOC HDRTAB+FSPBHS+1
;...
;...
FILHDR: SAVET ;Save our AC's
;Complete the header
HRRZ T2,FSPHDS(P1) ;Get header size
MOVE T3,HDRTAB(T2) ;Get dispatch address
CAIG T2,FSPBHS ;Reasonable index?
JUMPGE T2,(T3) ;Dispatch and fill in as much as there is
RET ;Bad index
HT7: MOVE T2,CALRPC ;Get caller's PC
MOVEM T2,FSPAPC(T1) ;Store in header
HT6: MOVE T2,JOBNO ;Get job number of requestor
HRLM T2,FSPAJF(T1) ;Store in header
MOVE T2,FORKX ;Get fork number of requestor
HRRM T2,FSPAJF(T1) ;Store in header
;Move header to trailer
HTDONE: SKIPA
FILTRL: SAVET
SKIPG FSPTRS(P1) ;Is there a trailer?
RET ;No, so return now
MOVE T2,T1 ;Get block address in T2
SUB T2,FSPHDS(P1) ;Make T2 point to top of header
MOVE T3,FSPSIZ(T1) ;Get block size
ADD T3,T2 ;Make T3 point to end of trailer+1
SUB T3,FSPTRS(P1) ;Make T3 point to start of trailer
MOVE T1,FSPTRS(P1) ;Get trailer size
XBLT. T1 ;Move as much of header as will fit in trailer
RET ;Return
> ;End FSPDBG conditional
;Routine to zero a block
;ARGS: T1/ Block address
; P1/ Pool descriptor address
;RETURNS +1 always
ZERBLK: SAVET ;Save our AC's
MOVE T2,T1 ;Get block address in T2
SOS T2 ;Allow for header overlay
SETZM (T2) ;Zero the first word
MOVE T1,FSPSIZ(T1) ;Get the length of the block
SUB T1,FSPHTS(P1) ;Subtract size of the header
; CAIG T1,1 ;Is our block size greater than 1?
SKIPG T1 ;Is our user block size greater than 1?
; Header overlay means 0 = 1-word user size
RET ;No, so we have zeroed the whole block
MOVE T3,T2 ;Get the block address again
AOS T3 ;Get addr +1
XBLT. T1 ;Zero the block
RET ;Return
;Routine to account for block request
;ARGS: T2/ Block size
;RETURNS: BLOCKX/ Index into request accounting-area for this blocksize
IFN FSPACC,<
BLKACC: SKIPE T3,FSPBAP(P1) ;Can we do block accounting for this pool?
JRST BLKAC1 ;Yes
SETZM BLOCKX ;No
RET
BLKAC1:
CAILE T2,FSPBSC-2 ;Can we actually account for this size block?
ADDI T3,FSPBSC-1 ;No, use this as a catch-all
CAIG T2,FSPBSC-2 ;...
ADD T3,T2 ;Yes, use the offset for that block size
MOVEM T3,BLOCKX ;Save this index
AOS FSPREQ(T3) ;Increment count of requests for that size
RET
> ;End FSPACC conditional
COMMENT %
Routine to move header to trailer after block is released
ARGS: P1/ Pool descriptor address
P2/ User block address
T2/ Predecessor address
T3/ Successor address
F / Merge flags
AC USAGE:
P3/ Address of header to be updated
P4/ Address of trailer to be updated
%
IFN FSPDBG,<
MOVHDR: SAVEAC <P3,P4>
;Point P4 at user trailer
MOVE P4,P2 ;Point to user block
TXNE F,FSP.MS ;Successor merge?
MOVE P4,T3 ;Yes, point to successor
ADD P4,FSPSIZ(P4) ;Point to block trailer
SUB P4,FSPHTS(P1) ;...
;Point P3 at predecessor header
MOVE P3,T2 ;Get predecessor block address
TXNN F,FSP.MP ;Did a predecessor merge occur?
MOVE P3,P2 ;No, move to user block
CALL UPDHDR ;Update the header
SUB P3,FSPHDS(P1) ;Get physical start of block
EXCH P2,T1 ;Save P2
MOVE P2,FSPTRS(P1) ;Get trailer size
XBLT. P2 ;Move header to trailer
EXCH P2,T1 ;Recover P2
TXNE F,FSP.MP ;Predecessor merge?
JRST MOVHD1 ;Yes
;No predecessor merge -
;Make sure predecessor trailer contains same pointer as header
SKIPN FSPTRS(P1) ;Is there a trailer?
JRST MOVHD2 ;No
ADD T2,FSPSIZ(T2) ;Step to trailer of predecessor
SUB T2,FSPTRS(P1) ;...
MOVEM P2,FSPNXT(T2) ;Point previous block to user block
JRST MOVHD2
;Here if predecessor merge
MOVHD1: MOVE T1,P2 ;Get address of user block
CALL ZERHDR ;Zero predecessor trailer and user header
MOVHD2: TXNN F,FSP.MS ;Successor merge?
RET ;No
MOVE T1,T3 ;Get address of successor
CALLRET ZERHDR ;Zero user trailer and successor header
> ;End FSPDBG conditional
COMMENT %
Routine to update header data after block is released
ARGS: P1/ Pool descriptor address
P3/ Block address
%
IFN FSPDBG,<
UPDHDR: SAVEAC<T1,T2> ;Save our AC's
MOVE T1,FSPHDS(P1) ;Get header size
CAIGE T1,<-FSPDJF>+1 ;Enough room to even try?
RET ;No
MOVE T2,FORKX ;Get our fork number
HRRM T2,FSPDJF(P3) ;Save it
MOVE T2,JOBNO ;Get our job number
HRLM T2,FSPDJF(P3) ;Save it
CAIGE T1,<-FSPDPC>+1 ;Room for PC?
RET ;No
MOVE T2,CALRPC ;Get the PC
MOVEM T2,FSPDPC(P3) ;Save it
RET
> ;End FSPDBG conditional
;Routine to zero a block header/trailer after the block has been merged
;with another.
;ARGS: T1/ Block pointer
; P1/ Pool descriptor address
;RETURNS +1 always
IFN FSPDBG,<
ZERHDR: SAVET
MOVE T2,T1 ;Get address of block
SUB T2,FSPHTS(P1) ;Point to start of previous block's trailer
SETZM (T2) ;Zero first word
MOVE T3,T2 ;Get block address again
AOS T3 ;Get address +1
MOVE T1,FSPHTS(P1) ;Get combined header/trailer size
SOS T1 ;Adjust block length
XBLT. T1 ;Zero the header and trailer
RET ;Return
> ;End FSPDBG conditional
;Routine to compare block header against block trailer
;ARGS:
; P1/ Address of pool descriptor
; P2/ Address of block
;Destroys T1-T4
;Returns: +1 Block header/trailer do not match
; +2 Block OK
BLKCKP: SAVET ;Enter here to avoid comparison of pointers
SETZM T3
JRST BLKCOM
BLKCHK: SAVET ;Enter here to compare entire header and trailer
SETOM T3
BLKCOM: MOVN T4,FSPBCS(P1) ;Get block-check size (as AOBJN pointer)
SKIPN T4 ;Is there a trailer?
RETSKP ;No
MOVE T1,FSPFLG(P2) ;Get the flags word from block header
;Calculated risk here, somebody might have trashed the flags
TXNE T1,FSP.BD ;Have we already complained about this block?
RET ;Yes
MOVE T1,P2 ;Get user block address in T1
MOVE T2,P2 ;And T2
ADD T2,FSPSIZ(T1) ;Add block size
SUB T2,FSPTRS(P1) ;Make T2 point to trailer
JUMPN T3,CHKALL ;Comparing entire header?
AOS T4 ;No, "decrement" count to avoid comparison of
;pointers
SOS T1 ;Additional SOS prevents comparison of pointers
SOS T2 ;...
CHKALL: HRLZS T4 ;Complete the AOBJN pointer
CHKLP: SOS T1 ;Pointers are at ends of header/trailer;
SOS T2 ; Step them back
MOVE T3,(T1) ;Get word of header
CAME T3,(T2) ;Compare against trailer
JRST BADBLK ;They don't match, complain
AOBJN T4,CHKLP ;Keep checking
;Now see if the length is reasonable
CAMN P2,FSPFFB(P1) ;Is this the dummy header?
RETSKP ;Yes, just return success
MOVE T2,FSPEND(P1) ;Get highest address in freepool
SUB T2,FSPORG(P1) ;Get size of pool (-1)
AOS T2 ;Get true size
MOVE T3,FSPSIZ(P2) ;Get blocksize
CAML T2,T3 ;Is poolsize .LSS. blocksize?
CAMGE T3,FSPMTB(P1) ;Is blocksize .GE. minimum size?
SKIPA ;Bad blocksize
RETSKP ;Everything OK
BADSZ: BUG.(HLT,FSPBBS,FREE,SOFT,<Bad blocksize>,<<P1,POOLN>,<P2,BLKADR>>,<
Cause: This is a free space problem; The block size is either smaller
than the minimum block size for this pool, or larger than the entire
amount of space allocated to the pool.
Action: If the condition is noticed when a block is being returned to the list,
it is simply marked deassigned (and bad) but not returned to the list.
If the list header is large enough to include it, the PC, job
number and fork number of the assigner and deassigner are stored in
the header/trailer. These may give a clue as to what code caused the
problem.
If the problem persists, change the BUGCHK to a BUGHLT and analyze the
dump.
Data: POOLN - Pool number
BLKADR - Address of the block. Zero indicates it is the pool
descriptor itself that contains the bad pointer.
>)
RET ;Return +1
;Here when header and trailer don't match
BADBLK: MOVX T3,FSP.BD ;Get the bad-block flag
IORM T3,FSPFLG(P2) ;Turn it on in header
MOVE T1,DESNDX ;Get pool number
BUG.(HLT,FSPBLK,FREE,SOFT,<Block damaged>,<<T1,POOLN>,<P2,BLKADR>>,<
Cause: This is a free space problem. The header of the block does not match
its trailer.
Action: If the condition is noticed when a block is being returned to the list,
it is simply marked deassigned (and bad) but not returned to the list.
If the list header is large enough to include it, the PC, job
number and fork number of the assigner and deassigner are stored in
the header/trailer. These may give a clue as to what code caused the
damage.
If the problem persists, change the BUGCHK to a BUGHLT and analyze the
dump.
Data: POOLN - Pool number
BLKADR - Address of the block. Zero indicates it is the pool
descriptor itself that contains the bad pointer.
>)
RET ;Return +1
IFN FSPDBG,<
;External routine to check integrity of freespace pool
;Args: T1/ Pool descriptor index
;Returns +1 Problem with pool
; +2 Pool Ok
FSPCHK: SKIPL T1 ;Range check the index
CAILE T1,FSPTBL ;...
RET ;Bad index
SKIPN P1,FSPTAB(T1) ;Get pool # in P1
RET ;No pool descriptor for that index
SETZM T1 ;Use T1 as return flag
LOCK FSPLOK(P1) ;Lock the pool
CSKED ;Defer reschedule
CALL FSPCK ;Check the pool
SETOM T1 ;Indicate +1 return
UNLOCK FSPLOK(P1) ;Unlock the pool
ECSKED ;Allow reschedule
SKIPE T1 ;+1/+2 return?
RET
RETSKP
;Internal routine to check integrity of freespace pool
;Args: P1/ Address of pool descriptor
; Called with pool locked and CSKED
;Returns +1 Problem with pool
; +2 Pool Ok
FSPCK: SAVEAC <T1,T2,T3,T4,Q1,Q2,P2>
MOVE T4,FSPEND(P1) ;Get ending pool address
MOVE T3,FSPORG(P1) ;Get starting pool address
MOVE T2,FSPFFB(P1) ;Get address of first free block
MOVE T2,FSPNXT(T2) ;Get first real block
JUMPE T2,RSKP ;Zero indicates totally exhausted pool
FSPCLP: MOVE T1,T2 ;Keep current block address here
MOVE T2,FSPNXT(T1) ;Get next-pointer
SKIPN T2 ;End of list?
RETSKP ;Yes
CAML T2,T3 ;In range?
CAML T2,T4 ;...
JRST BADPTR ;No, bad pointer
MOVE Q2,FSPFLG(T2) ;Get flags from that block
TXNE Q2,FSP.AS ;Is the block assigned?
CALL BLKASN ;Yes - it shouldn't be
MOVE Q1,FSPSIZ(T1) ;Get block size
ADD Q1,T1 ;Add address of block to find succeeding block
HRRZ Q2,FSPFLG(Q1) ;Get unique code
CAIE Q2,FSPUCD ;Is this a real block?
JRST BADSIZ ;No, bad block size or succeeding block damaged
MOVE P2,T1 ;Yes, get block address in P2
CALL BLKCHK ;Compare header and trailer and complain if bad
JFCL ;Ignore +1 return
JRST FSPCLP ;Keep going through list
BADPTR: MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPPTR,FREE,SOFT,<Block contains bad pointer>,<<Q1,POOLN>,<T1,BLKADR>,<T2,NXTPTR>>,<
Cause: This is a free space problem. A free block in the freespace pool
was found to contain a pointer that did not fall within the legal
address interval for that pool.
Action: Analyze the Dump.
Data: POOLN Pool number
BLKADR Address of the block containing the bad pointer.
NXTPTR The bad pointer
>)
RET
BADSIZ: MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPBSZ,FREE,SOFT,<Block contains bad blocksize>,<<Q1,POOLN>,<T1,BLKADR>>,<
Cause: This is a free space problem. When the address of the current block
is incremented by its blocksize, the result should be the address of
the next block in the chain. This is not the case. It indicates that
the blocksize of the current block is incorrect, or that the successor
of the current block has suffered header damage.
Action: If the problem persists, change the BUGCHK to a BUGHLT and analyze the
dump.
Data: POOLN Pool number
BLKADR Address of the current block.
>)
RET
BLKASN: MOVE Q1,DESNDX ;Get pool number
BUG.(HLT,FSPASN,FREE,SOFT,<Assigned-block in free-list>,<<Q1,POOLN>,<T1,BLKADR>>,<
Cause: This is a free space problem. A block in the freespace pool was
found to have the "block-assigned" bit set.
Action: Analyze the Dump.
Data: POOLN Pool number
BLKADR Address of the block.
>)
RET
> ;End FSPDBG conditional
;****************************************
ENDTV. ;End SETVAR TRVAR
;****************************************
TNXEND
END