Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-85 - mcb/tkb36/pchn.bli
There are 4 other files named pchn.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>PCHN.BLI.3,  3-Dec-79 14:43:42, Edit by SROBINSON
MODULE PCHN (					! PROCESS CHAINED BLOCKS
		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 DOES PROCESSING OF BLOCKS THAT HAVE BEEN
!	 CHAINED TOGETHER USING CHAIN BLOCKS.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
!
! MODIFIED BY:
!
!	Scott G. Robinson, 17-NOV-78 : VERSION X0.1-2A
!	- Fix BLD_CHAIN (et al) to remove ROOT_BLOCK so
!	   macro expansion will not occur with library file
!
!	Scott G. Robinson, 16-DEC-78 : VERSION X0.1-3A
!	- Add new routine DEL_PTRS which frees storage held by
!	  pointer blocks
!-----------------------------------------------------------------------
!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Ensure DECnet-10 Compatibility
!
!	, : VERSION
! 01	-
!--

!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    ADD_POINTER : NOVALUE,			!PUT NEXT POINTER IN NON-FULL CHAIN BLOCK
    INIT_CHAIN : NOVALUE,			!CREATE A NEW CHAIN BLOCK
    BLD_CHAIN,					!ADD POINTER TO CHAIN (GLOBAL)
    FND_CHAIN,					!FIND A CHAINED BLOCK
    DEL_PTRS : NOVALUE;				!DELETE CHAIN BLOCKS

!
! INCLUDE FILES:
!

LIBRARY 'TKBLIB';

!REQUIRE 'BLOCKH.REQ';				!PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'CHAIN.REQ';				!DEFINE CHAIN BLOCK
!REQUIRE 'ANYBLK.REQ';				!DEFINE GENERIC BLOCK
!REQUIRE 'BLOCKT.REQ';				!END OF DEFINING BLOCKS
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    ERRMSG,					!PRINT AN ERROR MESSAGE
    GETBLK,					!GET A BLOCK FROM FREE STORAGE
    FREBLK;					!RETURN A BLOCK TO FREE STORAGE
ROUTINE ADD_POINTER (POINTER, ADDRESS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!
! ADD AN ADDRESS TO A CHAIN BLOCK.  THERE MUST BE ROOM.
!
!
! FORMAL PARAMETERS:
!
!	POINTER - POINTER TO THE CHAIN BLOCK
!	ADDRESS - THE ADDRESS TO BE ADDED
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	THE CONTENTS OF THE CHAIN BLOCK IS MODIFIED
!
!--

    BEGIN

    LOCAL
	PTRS,
	BITPOS;

    MAP
	POINTER : REF CHAIN_BLOCK;

    STRUCTURE
	POINTERS [LOCN] =
	    (POINTERS + (LOCN/%BPVAL))<(LOCN MOD %BPVAL), %BPADDR>;

!
    PTRS = .POINTER [NUM_CHAIN_PTRS];
    BITPOS = ((%FIELDEXPAND (CHAIN_PTRS, 0)*%BPVAL) + %FIELDEXPAND (CHAIN_PTRS, 1)) + (.PTRS*%BPADDR);
    POINTERS [.POINTER, .BITPOS] = .ADDRESS;
    POINTER [NUM_CHAIN_PTRS] = .PTRS + 1;
    END;
ROUTINE INIT_CHAIN (POINTER, SUB_TYPE, UPPER_BLOCK) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	INITIALIZE A CHAIN BLOCK
!
! FORMAL PARAMETERS:
!
!	POINTER - POINTER TO THE CHAIN BLOCK TO BE INITIALIZED
!	SUB_TYPE - TYPE OF BLOCK THAT THIS CHAIN BLOCK POINTS TO
!	UPPER_BLOCK - POINTER TO THE BLOCK THAT POINTS TO THIS CHAIN BLOCK
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	POINTER : REF CHAIN_BLOCK;

!
    POINTER [NUM_CHAIN_PTRS] = 0;
    POINTER [CHAIN_STYPE] = .SUB_TYPE;
    POINTER [CHAIN_BACK] = .UPPER_BLOCK;
    END;
GLOBAL ROUTINE BLD_CHAIN (ROOT_BLOCK_PTR, FIRST_CHAIN, NEW_BLOCK) = 	!BUILD A CHAIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	BLD_CHAIN APPENDS A POINTER TO A (POSSIBLY EMPTY) LIST
!	 OF POINTERS.  THIS PERMITS A FIELD IN A BLOCK TO POINT
!	 TO A LOT OF OTHER BLOCKS.  BLD_CHAIN WILL OBTAIN SPACE
!	 FROM THE FREE LIST IF NECESSARY TO HOLD THE POINTERS.
!
! FORMAL PARAMETERS:
!
!	ROOT_BLOCK_PTR - BLOCK THAT POINTS
!	FIRST_CHAIN - OLD CONTENTS OF POINTER CELL
!	NEW_BLOCK - POINTER TO BE ADDED TO THE LIST
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NEW CONTENTS OF POINTER CELL, OR 0 IF OUT OF STORAGE.
!
! SIDE EFFECTS
!
!	MAY OBTAIN STORAGE FROM FREE STORAGE LIST
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'BUILD_CHAIN');

    LOCAL
	LAST_PTR : REF CHAIN_BLOCK,
	NEXT_PTR : REF CHAIN_BLOCK;

    MAP
	FIRST_CHAIN : REF CHAIN_BLOCK,
	ROOT_BLOCK_PTR : REF ANY_BLOCK,
	NEW_BLOCK : REF ANY_BLOCK;

    IF (.FIRST_CHAIN EQL 0)
    THEN

	IF ((NEXT_PTR = GETBLK (CHAIN_TYP, CHAIN_LEN)) EQL 0)
	THEN
	    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN				!NO OLD CHAIN AND WE HAVE STORAGE
	    INIT_CHAIN (.NEXT_PTR, .NEW_BLOCK [ANY_TYPE], .ROOT_BLOCK_PTR);
	    ADD_POINTER (.NEXT_PTR, .NEW_BLOCK);
	    NEXT_PTR [CHAIN_NEXT] = .NEXT_PTR;
	    NEXT_PTR [CHAIN_PREV] = .NEXT_PTR;
	    .NEXT_PTR
	    END

    ELSE
	BEGIN					!THERE IS ALREADY A CHAIN BLOCK
	LAST_PTR = .FIRST_CHAIN [CHAIN_PREV];	!POINT TO LAST CHAIN BLOCK

	IF (.LAST_PTR [NUM_CHAIN_PTRS] LSS MAX_CHAIN_PTRS)
	THEN
	    ADD_POINTER (.LAST_PTR, .NEW_BLOCK)	!SIMPLE CASE
	ELSE
	    BEGIN				!LAST CHAIN BLOCK FULL, GET NEW ONE.

	    IF ((NEXT_PTR = GETBLK (CHAIN_TYP, CHAIN_LEN)) EQL 0)
	    THEN
		ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
	    ELSE
		BEGIN				! WE HAVE STORAGE
		INIT_CHAIN (.NEXT_PTR, .NEW_BLOCK [ANY_TYPE], .ROOT_BLOCK_PTR);
		ADD_POINTER (.NEXT_PTR, .NEW_BLOCK);
		NEXT_PTR [CHAIN_PREV] = .LAST_PTR;
		FIRST_CHAIN [CHAIN_PREV] = .NEXT_PTR;
		NEXT_PTR [CHAIN_NEXT] = .FIRST_CHAIN;
		LAST_PTR [CHAIN_NEXT] = .NEXT_PTR;
		END;				! OF HAVING STORAGE

	    END;				! OF NEEDING A NEW CHAIN BLOCK

	.FIRST_CHAIN
	END					! OF ALREADY HAVE A CHAIN
    END;					! OF ROUTINE BLD_CHAIN
GLOBAL ROUTINE FND_CHAIN (CHAIN_PTR, SELECTOR, SELARG) = 	!FIND A BLOCK IN A CHAIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	FND_CHAIN SEARCHES THE BLOCKS OF A CHAIN FOR THE FIRST
!	 ONE ACCEPTABLE TO THE SELECTOR SUBROUTINE.
!
! FORMAL PARAMETERS:
!
!	CHAIN_PTR - POINTER TO THE INITIAL CHAIN BLOCK, OR 0 IF NONE.
!	SELECTOR - SUBROUTINE TO SELECT A SUITABLE BLOCK
!	SELARG - ARGUMENT TO GIVE TO SELECTOR SUBROUTINE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0 IF NO CHAIN BLOCKS OR NONE ARE ACCEPTABLE TO THE
!	 SELECTOR SUBROUTINE.  OTHERWISE THE VALUE RETURNED
!	 IS THE NON-ZERO VALUE RETURNED BY THE SELECTOR
!	 SUBROUTINE WHEN FIRST PRESENTED WITH AN ACCEPTABLE
!	 BLOCK.
!
! SIDE EFFECTS
!
!	THE SELECTOR SUBROUTINE MAY HAVE SIDE EFFECTS.
!
!--

    BEGIN

    STRUCTURE
	POINTERS [LOCN] =
	    (POINTERS + (LOCN/%BPVAL))<(LOCN MOD %BPVAL), %BPADDR>;

    LOCAL
	BIT_POSITION,
	SBRVAL,
	CHAINP : REF CHAIN_BLOCK,
	NCP,
	CPINX,
	BLOCKP : REF ANY_BLOCK;

!

    IF ((CHAINP = .CHAIN_PTR) EQL 0)
    THEN
	0
    ELSE
	BEGIN
!

	DO
	    BEGIN
	    NCP = .CHAINP [NUM_CHAIN_PTRS];
	    CPINX = 0;

	    DO
		BEGIN
		BIT_POSITION = ((%FIELDEXPAND (CHAIN_PTRS, 0)*%BPVAL) + %FIELDEXPAND (CHAIN_PTRS, 1)) + (
		.CPINX*%BPADDR);
		BLOCKP = .POINTERS [.CHAINP, .BIT_POSITION];
		SBRVAL = (.SELECTOR) (.BLOCKP, .SELARG);
		CPINX = .CPINX + 1;
		END
	    UNTIL ((.CPINX EQL .NCP) OR (.SBRVAL NEQ 0));

	    CHAINP = .CHAINP [CHAIN_NEXT];
	    END
	UNTIL ((.CHAINP EQL .CHAIN_PTR) OR (.SBRVAL NEQ 0));

	.SBRVAL
	END

    END;					! OF ROUTINE FND_CHAIN
GLOBAL ROUTINE DEL_PTRS (CHAIN_PTR) : NOVALUE = 	!DELETE CHAIN BLOCKS

!++
! FUNCTIONAL DESCRIPTION:
!
!	FREE MEMORY HELD FOR CHAIN BLOCKS.
!
! FORMAL PARAMETERS:
!
!	CHAIN_PTR - ADDRESS OF FIRST CHAIN BLOCK
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	SOME MEMORY MAY BE RETURNED TO THE FREE POOL
!
!--

    BEGIN

    LOCAL
	CHAINP : REF CHAIN_BLOCK,
	NEXT_BLOCK;

    IF ((CHAINP = .CHAIN_PTR) NEQ 0)
    THEN
	BEGIN

	DO
	    BEGIN
	    NEXT_BLOCK = .CHAINP [CHAIN_NEXT];
	    FREBLK (.CHAINP);
	    CHAINP = .NEXT_BLOCK;
	    END
	UNTIL (.CHAINP EQL .CHAIN_PTR)

	END;

    END;					!OF DEL_PTRS

END

ELUDOM
! Local Modes:
! Comment Start:!
! Comment Column:36
! Auto Save Mode:2
! Mode:Fundamental
! END: