Trailing-Edge
-
PDP-10 Archives
-
BB-R595B-SM_11-9-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: