*DECK DB$LNKG 
USETEXT CDGDFTX 
      FUNC DB$LNKG((BLOCK),LENGTH,SAVEPTR); 
      BEGIN 
 #
* *   DB$LNKG - GET BLOCK FROM SAVED BLOCK CHAIN PAGE  1
* *   J E ESLER                                  DATE  4/12/78
* 
* DC  PURPOSE 
* 
*     THIS FUNCTION TAKES A BLOCK OFF THE SAVED BLOCK CHAIN AND 
*     LINKS IT ONTO A CHAIN OF BLOCKS.  IF THERE ARE NO SAVED 
*     BLOCKS, A BLOCK IS RESERVED.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM BLOCK;            #ADDRESS OF BLOCK TO LINK TO#
      ITEM LENGTH;           #LENGTH OF BLOCK TO BE CREATED#
      ITEM SAVEPTR;          #POINTER TO PROPER SAVED BLOCK CHAIN#
# 
* DC  EXIT CONDITIONS 
* 
*     THIS FUNCTION RETURNS THE ADDRESS OF THE BLOCK WHICH WAS
*     ASSIGNED. 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;     #GENERATE FLOW POINT#
      XREF FUNC DB$LNK;      #CREATE LINKED BLOCK#
# 
* DC  NON-LOCAL VARIABLES 
# 
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM PRIOR(0,24,18); #PRIOR AND NEXT POINTERS MUST BE IN# 
        ITEM NEXT(0,42,18);  #THESE LOCATIONS OF THE FIRST WORD OF# 
                             #EACH BLOCK ENTRY TO BE LINKED#
  
        ITEM NEXTIDL I(00,00,60);  # POINTER TO NEXT IDLE BLOCK        #
        END 
      XDEF ITEM IN$LNKG B=FALSE;  #TRUE DURING DB$LNK CALL FROM DB$LNKG#
 #
# 
  
      ITEM NEW;              #ADDRESS OF NEW BLOCK# 
      CONTROL EJECT;
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("LNKG   ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
      IF SAVEPTR NQ 0 THEN
        BEGIN 
        NEW = SAVEPTR;
        SAVEPTR = NEXTIDL[NEW]; 
        NEXT[NEW] = NEXT[BLOCK];
        NEXT[BLOCK] = NEW;
        PRIOR[NEW] = BLOCK; 
        IF NEXT[NEW] NQ 0 THEN
          PRIOR[NEXT[NEW]] = NEW; 
        DB$LNKG = NEW;
        RETURN; 
        END 
      ELSE
        BEGIN 
        IN$LNKG = TRUE;      # PREVENT DB$CRMR FROM CALLING DB$LNKG    #
                             # AGAIN DURING MEMORY OVERFLOW PROCESSING.#
        DB$LNKG = DB$LNK(BLOCK,LENGTH); 
        IN$LNKG = FALSE;
        RETURN; 
        END 
      END 
      TERM; 
