Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/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) 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 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: