Google
 

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: