Trailing-Edge
-
PDP-10 Archives
-
TOPS-20_V6.1_DECnetSrc_7-23-85
-
mcb/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) 1980, 1981, 1982
! DIGITAL EQUIPMENT CORPORATION
! Maynard, Massachusetts
!
! 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: