Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/tkb36/stgm.bli
There are 4 other files named stgm.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>STGM.BLI.3, 3-Dec-79 15:02:34, Edit by SROBINSON
MODULE STGM ( ! STORAGE MANAGER
IDENT = 'X2.0'
) =
BEGIN
!
!
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1986. ALL RIGHTS RESERVED.
!
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY: TKB-20 AND VNP-20
!
! ABSTRACT:
!
!
! THIS MODULE PROVIDES THREE STORAGE MANAGEMENT SUBROUTINES.
!
! GETSTG(AMOUNT) GETS 'AMOUNT' OF STORAGE, RETURNING ITS
! ADDRESS AS ITS VALUE. RETURNING A 0 INDICATES THAT NO
! STORAGE IS AVAILABLE.
!
! FRESTG(ADDRESS,AMOUNT) FREES 'AMOUNT' OF STORAGE STARTING
! AT 'ADDRESS'. IT RETURNS NO VALUE.
!
! INISTG(AMOUNT) INITIALIZED STORAGE MANAGEMENT. SUBSEQUENTLY,
! AT LEAST 'AMOUNT' OF STORAGE WILL BE AVAILABLE THROUGH GETSTG.
! RETURNING A 0 INDICATES THAT INITIALIZATION FAILED, 1 THAT IT
! SUCCEEDED.
!
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
!
! MODIFIED BY:
!
! Scott G. Robinson, 3-DEC-79 : Version X2.0
! - Ensure DECnet-10 Compatibility
!
! , : VERSION
! 01 -
!--
!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
INISTG : NOVALUE, !INITIALIZE STORAGE MANAGER
GETSTG, !GET STORAGE
COLLECT_STORAGE : NOVALUE, !COMBINE ADJACENT STORAGE BLOCKS
FRESTG : NOVALUE, !FREE STORAGE
GETBLK, !GET A BLOCK
FREBLK : NOVALUE; !FREE A BLOCK
!
! INCLUDE FILES:
!
! NONE
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
LITERAL
DEBUG = 0;
!
! DEFINE A STRUCTURE WHICH PROVIDES ACCESS TO ADDRESSES.
! IF %BPUNIT = %BPADDR, THIS IS THE SAME AS STRUCTURE "VECTOR".
!
STRUCTURE
ADDRESSES [INDEX; VLENGTH] =
[((VLENGTH*%BPADDR) + (%BPUNIT - 1))/%BPUNIT]
(ADDRESSES + ((INDEX*%BPADDR)/%BPUNIT))<(INDEX*%BPADDR) MOD %BPUNIT, %BPADDR>;
!
! DEFINE THE OFFSETS IN THE HEADER FOR A STORAGE BLOCK ON THE
! FREE CHAIN.
!
LITERAL
FSTG_SIZE = 0, !SIZE OF THIS BLOCK
FSTG_NEXT = 1, !POINTER TO NEXT BLOCK, OR 0 IF NONE.
FSTG_PREV = 2, !POINTER TO PREV BLOCK, OR 0 IF THIS IS FIRST.
FSTG_HDRL = 3; !LENGTH OF A FREE STORAGE HEADER
!
! OWN STORAGE:
!
OWN
INITIALIZED : INITIAL (0),
FSTG_ROOT : ADDRESSES [FSTG_HDRL],
COUNTS : VECTOR [513];
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
ERROR : NOVALUE; !
GLOBAL ROUTINE INISTG (AMOUNT) : NOVALUE = ! INIT STORAGE MANAGER
!++
! FUNCTIONAL DESCRIPTION:
!
! ROUTINE TO INITIALIZE THE FREE STORAGE LIST.
! AFTER INITIALIZATION IS COMPLETE A MINIMUM AMOUNT
! OF STORAGE IS GUARANTEED AVAILABLE VIA GETSTG.
!
! FORMAL PARAMETERS:
!
! AMOUNT - MIN FREE STORAGE PERMITTED
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! MAY DO A CORE UUO TO GET STORAGE
!
!--
BEGIN
LOCAL
STG_POINTER;
!
INITIALIZED = 1;
FSTG_ROOT [FSTG_NEXT] = 0;
IF ((STG_POINTER = GETSTG (.AMOUNT)) EQL 0)
THEN
ERROR (UPLIT (%ASCIZ'NOT ENOUGH STORAGE FOR INITIALIZATION - INISTG'))
ELSE
FRESTG (.STG_POINTER, .AMOUNT);
END;
ROUTINE GET_MORE_CORE (AMOUNT) = !GET CORE FROM END OF PROGRAM
!++
! FUNCTIONAL DESCRIPTION:
!
! GET CORE FROM THE END OF THE PROGRAM.
! THE PROGRAM WILL BE EXTENDED IF NECESSARY USING THE
! CORE UUO.
!
! FORMAL PARAMETERS:
!
! AMOUNT - NUMBER OF WORDS TO GET
!
! IMPLICIT INPUTS:
!
! .JBFF
! .JBREL
!
! IMPLICIT OUTPUTS:
!
! .JBFF
! .JBREL
!
! ROUTINE VALUE:
!
! A POINTER TO THE STORAGE GOTTEN, OR 0
! IF THE MONITOR WON'T GIVE US ANY MORE.
!
! SIDE EFFECTS
!
! MAY DO A CORE UUO TO GET MORE CORE
!
!--
BEGIN
LOCAL
STG_POINTER,
TEMP;
EXTERNAL LITERAL
%NAME ('.JBFF'),
%NAME ('.JBREL');
%IF %SWITCHES(TOPS10)
%THEN
BUILTIN
UUO;
%FI
REGISTER
R;
STG_POINTER = .(%NAME ('.JBFF'))<0, 18>;
TEMP = .(%NAME ('.JBFF'))<0, 18> + .AMOUNT;
IF (.TEMP GEQ %O'400000')
THEN
STG_POINTER = 0
ELSE
BEGIN !WE ARE UNDER 2**17 WORDS
%NAME ('.JBFF')<0, 18> = .TEMP;
%IF %SWITCHES(TOPS10)
%THEN
IF (.(%NAME ('.JBREL'))<0, 18> LSS .(%NAME ('.JBFF'))<0, 18>)
THEN
BEGIN !GET MORE CORE FROM MONITOR
R = .(%NAME ('.JBFF'))<0, 18>;
IF (UUO (1, %O'047', R, %O'11') EQL 0) THEN STG_POINTER = 0;
END; ! OF NEED TO GET MORE CORE FROM MONITOR
%FI
END;
.STG_POINTER
END; !OF ROUTINE GET_MORE_CORE
!
ROUTINE SEARCH_CHAIN (AMT) = !SEARCH THE FREE STORAGE LIST
!++
! FUNCTIONAL DESCRIPTION:
!
! SEARCH THE FREE STORAGE LIST FOR A FREE BLOCK BIG ENOUGH
! TO SATISFY A REQUEST FOR AMT WORDS.
!
! FORMAL PARAMETERS:
!
! AMT - NUMBER OF WORDS IN THE REQUEST
!
! IMPLICIT INPUTS:
!
! THE FREE STORAGE LIST
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! A POINTER TO A SUITABLE BLOCK ON THE FREE LIST, OR
! 0 IF NO BLOCK IS SUITABLE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
STG_PTR : REF ADDRESSES,
BEST_PTR : REF ADDRESSES;
!
STG_PTR = .FSTG_ROOT [FSTG_NEXT];
BEST_PTR = 0;
WHILE (.STG_PTR NEQ 0) DO
BEGIN
IF (.STG_PTR [FSTG_SIZE] GEQ .AMT)
THEN
BEGIN !REQUEST WILL FIT
IF (.BEST_PTR NEQ 0)
THEN
BEGIN !WE HAD A PREVIOUS FIT
IF (.BEST_PTR [FSTG_SIZE] GTR .STG_PTR [FSTG_SIZE]) THEN BEST_PTR = .STG_PTR;
END
ELSE
BEST_PTR = .STG_PTR;
END; !OF REQUEST WILL FIT
STG_PTR = .STG_PTR [FSTG_NEXT];
END; !OF SCAN OF FREE LIST
.BEST_PTR
END; !OF ROUTINE SEARCH_CHAIN
GLOBAL ROUTINE GETSTG (AMOUNT) = !GET STORAGE
!++
! FUNCTIONAL DESCRIPTION:
!
! ROUTINE TO GET STORAGE.
!
! FORMAL PARAMETERS:
!
! AMOUNT - NUMBER OF WORDS TO GET
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! A POINTER TO THE STORAGE GOTTEN, OR 0 IF STORAGE EXHAUSTED
!
! SIDE EFFECTS
!
! MAY DO A CORE UUO TO GET STORAGE
!
!--
BEGIN
LOCAL
AMT,
NEXT_PTR : REF ADDRESSES,
PREV_PTR : REF ADDRESSES,
THIS_PTR : REF ADDRESSES,
RESULT : REF VECTOR,
UNUSED_AMOUNT;
IF ( NOT .INITIALIZED)
THEN
BEGIN
ERROR (UPLIT (%ASCIZ'CALL TO GETSTG BEFORE INISTG'));
0
END
ELSE
BEGIN
AMT = .AMOUNT; !AMOUNT OF STORAGE REQUESTED
IF (((.AMT + 7)/8) GTR 512)
THEN
COUNTS [512] = .COUNTS [512] + 1
ELSE
COUNTS [((.AMT + 7)/8)] = .COUNTS [((.AMT + 7)/8)] + 1;
!
! ROUND STORAGE REQUEST UP TO COVER SPACE NEEDED FOR FREE STORAGE
! CHAIN HEADERS.
!
IF ((.AMT*%BPVAL) LSS (FSTG_HDRL*%BPADDR)) THEN AMT = ((FSTG_HDRL*%BPADDR) + (%BPVAL - 1))/%BPVAL;
!
! SEARCH THE STORAGE CHAIN FOR A LARGE ENOUGH BLOCK
!
IF ((THIS_PTR = SEARCH_CHAIN (.AMT)) EQL 0)
THEN
BEGIN !NOT ENOUGH SPACE ON THE FREE STORAGE CHAIN
COLLECT_STORAGE (); !TRY TO FIND SPACE BY COMBINING BLOCKS
IF ((THIS_PTR = SEARCH_CHAIN (.AMT)) EQL 0)
THEN
BEGIN !EVEN COMBINING BLOCKS ISN'T GOOD ENOUGH
IF ((THIS_PTR = GET_MORE_CORE (.AMT)) NEQ 0) THEN FRESTG (.THIS_PTR, .AMT);
!APPEND NEW STG TO FREE CHAIN
COLLECT_STORAGE (); !BE SURE NEW BLOCK COMBINED WITH OLD ONES
THIS_PTR = SEARCH_CHAIN (.AMT);
END;
END; !OF NOT ENOUGH STORAGE ON FREE CHAIN
!
! WE HAVE THE STORAGE OR IT IS UNAVAILABLE
!
IF (.THIS_PTR NEQ 0)
THEN
BEGIN
PREV_PTR = .THIS_PTR [FSTG_PREV];
NEXT_PTR = .THIS_PTR [FSTG_NEXT];
IF (.NEXT_PTR NEQ 0) THEN NEXT_PTR [FSTG_PREV] = .PREV_PTR ELSE FSTG_ROOT [FSTG_PREV] = .PREV_PTR;
IF (.PREV_PTR NEQ 0) THEN PREV_PTR [FSTG_NEXT] = .NEXT_PTR ELSE FSTG_ROOT [FSTG_NEXT] = .NEXT_PTR;
IF (((UNUSED_AMOUNT = .THIS_PTR [FSTG_SIZE] - .AMT)*%BPVAL) GEQ (FSTG_HDRL*%BPADDR))
THEN
BEGIN !FREE UNUSED STORAGE IN THIS BLOCK
NEXT_PTR = .THIS_PTR + .AMT;
FRESTG (.NEXT_PTR, .UNUSED_AMOUNT);
END;
RESULT = .THIS_PTR;
INCR COUNTER FROM 0 TO .AMT - 1 DO
RESULT [.COUNTER] = 0;
END;
.THIS_PTR
END !OF INITIALIZED
END;
ROUTINE COLLECT_STORAGE : NOVALUE = !COMBINE STORAGE ON FREE LIST
!++
! FUNCTIONAL DESCRIPTION:
!
! THIS INTERNAL ROUTINE IS USED TO
! COMBINE ADJACENT BLOCKS ON THE FREE LIST INTO SINGLE
! BLOCKS.
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! THE FREE STORAGE LIST
!
! IMPLICIT OUTPUTS:
!
! AN UPDATED FREE STORAGE LIST
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
NEXT_PTR : REF ADDRESSES,
PREV_PTR : REF ADDRESSES,
THIS_PTR : REF ADDRESSES;
!
PREV_PTR = .FSTG_ROOT [FSTG_NEXT];
IF (.PREV_PTR NEQ 0)
THEN
BEGIN !WE HAVE A FREE LIST
WHILE ((THIS_PTR = .PREV_PTR [FSTG_NEXT]) NEQ 0) DO
BEGIN !SCAN THE FREE LIST
IF ((.PREV_PTR [FSTG_SIZE] + .PREV_PTR) EQL .THIS_PTR)
THEN
BEGIN !"PREV" AND "THIS" ARE ADJACENT
NEXT_PTR = .THIS_PTR [FSTG_NEXT];
PREV_PTR [FSTG_SIZE] = .PREV_PTR [FSTG_SIZE] + .THIS_PTR [FSTG_SIZE];
IF (.NEXT_PTR NEQ 0)
THEN
BEGIN !"THIS" IS NOT THE LAST ITEM IN THE FREE LIST
PREV_PTR [FSTG_NEXT] = .NEXT_PTR;
NEXT_PTR [FSTG_PREV] = .PREV_PTR;
END
ELSE
BEGIN !"THIS" IS LAST IN FREE LIST
PREV_PTR [FSTG_NEXT] = 0;
FSTG_ROOT [FSTG_PREV] = .PREV_PTR;
END; !OF LAST IN FREE LIST PROCESSING
THIS_PTR = .PREV_PTR; !CHECK NEW BLOCK AGAINST NEXT
END; !OF COMBINING ADJACENT BLOCKS
PREV_PTR = .THIS_PTR; !GO ON TO NEXT BLOCK (UNLESS COMBINED)
END; !OF SCAN OF FREE LIST
END; !OF HAVING A FREE LIST
END; !OF ROUTINE COLLECT_STORAGE
GLOBAL ROUTINE FRESTG (ADDRESS, AMOUNT) : NOVALUE = !FREE STORAGE
!++
! FUNCTIONAL DESCRIPTION:
!
! THIS ROUTINE RETURNS STORAGE TO THE FREE LIST
!
! FORMAL PARAMETERS:
!
! ADDRESS - POINTER TO THE STORAGE TO FREE
! AMOUNT - LENGTH OF THAT STORAGE
!
! IMPLICIT INPUTS:
!
! THE FREE STORAGE LIST
!
! IMPLICIT OUTPUTS:
!
! THE FREE STORAGE LIST
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
AMT,
NEXT_PTR : REF ADDRESSES,
STG_PTR : REF ADDRESSES,
FOUND_PLACE;
MAP
ADDRESS : REF ADDRESSES;
!
AMT = .AMOUNT; !AMOUNT OF STORAGE REQUESTED
!
! ROUND STORAGE REQUEST UP TO COVER SPACE NEEDED FOR FREE STORAGE
! CHAIN HEADERS.
!
IF ((.AMT*%BPVAL) LSS (FSTG_HDRL*%BPADDR)) THEN AMT = ((FSTG_HDRL*%BPADDR) + (%BPVAL - 1))/%BPVAL;
!
! FIND PLACE TO INSERT THIS BLOCK IN THE FREE STORAGE LIST
!
STG_PTR = FSTG_ROOT;
FOUND_PLACE = 0;
WHILE ((.STG_PTR NEQ 0) AND (.FOUND_PLACE EQL 0)) DO
BEGIN
NEXT_PTR = .STG_PTR [FSTG_NEXT];
IF ((.NEXT_PTR NEQ 0) AND (.NEXT_PTR GTRA .ADDRESS)) THEN FOUND_PLACE = 1 ELSE STG_PTR = .NEXT_PTR;
END;
IF (.STG_PTR EQL 0)
THEN
BEGIN !NEW BLOCK GOES AT END OF CHAIN
STG_PTR = .FSTG_ROOT [FSTG_PREV];
END;
ADDRESS [FSTG_SIZE] = .AMT;
ADDRESS [FSTG_PREV] = (IF (.STG_PTR EQL FSTG_ROOT) THEN 0 ELSE .STG_PTR);
IF (.STG_PTR NEQ 0)
THEN
BEGIN !THERE IS AN OLD CHAIN
ADDRESS [FSTG_NEXT] = .STG_PTR [FSTG_NEXT];
NEXT_PTR = .STG_PTR [FSTG_NEXT];
STG_PTR [FSTG_NEXT] = .ADDRESS;
IF (.NEXT_PTR NEQ 0) THEN NEXT_PTR [FSTG_PREV] = .ADDRESS ELSE FSTG_ROOT [FSTG_PREV] = .ADDRESS;
END
ELSE
BEGIN !THIS IS ONLY ITEM ON LIST
ADDRESS [FSTG_NEXT] = 0;
FSTG_ROOT [FSTG_NEXT] = .ADDRESS;
FSTG_ROOT [FSTG_PREV] = .ADDRESS;
END;
COLLECT_STORAGE ();
END;
GLOBAL ROUTINE GETBLK (BLOCK_TYPE, BLOCK_LENGTH) = !GET A BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! THIS ROUTINE GETS A BLOCK AND FILLS IN ITS HEADER.
!
! FORMAL PARAMETERS:
!
! BLOCK_TYPE - THE TYPE OF THE BLOCK TO GET
! BLOCK_LENGTH - THE LENGTH OF THE BLOCK TO GET
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! A POINTER TO THE BLOCK GOTTEN, OR 0 IF OUT OF STORAGE
!
! SIDE EFFECTS
!
! MAY DO A CORE UUO TO GET STORAGE
!
!--
BEGIN
LOCAL
RESULT : REF ADDRESSES;
!
IF ((RESULT = GETSTG (.BLOCK_LENGTH)) NEQ 0)
THEN
BEGIN
RESULT [0] = .BLOCK_TYPE;
RESULT [1] = .BLOCK_LENGTH;
END;
.RESULT
END;
!
GLOBAL ROUTINE FREBLK (ADDRESS) : NOVALUE = !FREE A BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! THIS ROUTINE RETURNS A BLOCK GOTTEN BY GETBLK
!
! FORMAL PARAMETERS:
!
! ADDRESS - POINTER TO THE BLOCK TO BE FREED
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
LEN;
MAP
ADDRESS : REF ADDRESSES;
!
LEN = .ADDRESS [1];
FRESTG (.ADDRESS, .LEN);
END;
!
END
ELUDOM
! Local Modes:
! Comment Start:!
! Comment Column:36
! Mode:Fundamental
! Auto Save Mode:2
! End: