*DECK,GETBUF
USETEXT IP$COM
USETEXT TSB$COM 
USETEXT GLOBALI 
      FUNC GETBUF (SIZE,MOVEABLEFLAG) U;
*IF DEF,IMS 
 #
*1DC  GETBUF
* 
*     1. PROC NAME           AUTHOR              DATE 
*        GETBUF              B. M. WEST          16 FEB 1977
* 
*     2. FUNCTIONAL DESCRIPTION 
*        CALL REQTSB TO OBTAIN A BUFFER 
* 
*     3. METHOD USED
*        IF ENOUGH SPACE IS AVAILABLE TO SATISFY THE REQUEST
*        GETBUF CALLS REQTSB TO ACQUIRE THE BUFFER AND RETURN 
*        WITH THE ORDINAL OF THE BUFFER AS THE VALUE OF THE FUNCTION
*        GETBUF ELSE ZERO IS RETURNED.
* 
*        IF THE BUFFERS ARE LIKELY TO BE REARRANGED TO SATISFY THE
*        REQUEST GETBUF CALLS SETACN TO REINITIALIXE THE POINTERS 
*        TO CALLING ACN"S TABLES. 
* 
* 
*     4. ENTRY PARAMETER
*        SIZE                SIZE OF BUFFER BEING REQUESTED 
*                            MUST BE GREATER THAN ZERO AND
*                            LESS THAN MAXTSBL
*        MOVEABLEFLAG        IF SET MAKE BUFFER MOVEABLE
* 
*     5. EXIT PARAMETER 
*        ORDINAL             UNSIGNED INTEGER RESULTS OF FUNCTION 
*                            CALL IS THE ORDINAL TO THE LIST OF 
*                            BUFFER ADDRESS. IF ZERO NO BUFFER
*                            WAS FOUND. 
* 
*     6. COMDECKS USED. 
*        RBF$COM
*        TSBMDEFS 
*        TSBMDATA 
*        TSBMBASE 
* 
*     7. ROUTINES CALLED
*        REQTSB              REQUESTS A TSB 
*        MOVEOK              CHANGE STATUS TO MOVEABLE
*        SETACN              SET UP CONNECTION CONTROL BLOCK TABLES 
*        SQUEEZE             REORGANISE BUFFER AREA FOR MOVE FREE SPACE 
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
  
      BEGIN # GETBUF #
      XREF PROC MOVEOK;      # CHANGES BUFFER STATUS TO MOVEABLE       #
      XREF PROC REQTSB;      # REQUEST A TASK SEQUENCE BLOCK           #
      XREF PROC SETUPACN;    # SET UP CONTROL BLOCKS                # 
      XREF PROC SQUEEZE;     # REORGANISE BUFFERS FOR MORE SPACE       #
  
      ITEM SIZE U;
      ITEM ORDINAL U; 
      ITEM MOVINGLIKELY B;   # BUFFERS LIKELY TO MOVE FLAG             #
      ITEM MOVEABLEFLAG B;
      ITEM TSBADDR I; 
#                                                                      #
#     SET MOVINGLIKELY AND TEST FOR ENOUGH SPACE TO SATISFY REQUEST    #
#                                                                      #
      MOVINGLIKELY = SIZE GQ BIGFREE OR NUMFREE[0] EQ 0 ; 
      IF SIZE GQ MAXFL - CTSBLWA
      THEN
        IF SIZE GQ BIGFREE
        THEN
          BEGIN # SQUEEZE REQUIRED #
          SQUEEZE (0,TSBADDR);
          MOVINGLIKELY = TRUE;
          IF SIZE GQ BIGFREE
          THEN
            BEGIN # NO SPACE AVAILABLE #
            SETUPACN (ACN); 
            GETBUF = 0; 
            RETURN; 
            END   # NO SPACE AVAILABLE #
          END   # SQUEEZE REQUIRED #
#                                                                      #
#     REQUEST BUFFER WHICH IS AVAILABLE                                #
      REQTSB(SIZE,TSBADDR,ORDINAL); 
      IF MOVEABLEFLAG 
      THEN
        MOVEOK (ORDINAL); 
      IF MOVINGLIKELY 
      THEN
        SETUPACN (ACN); 
      GETBUF = ORDINAL; 
      RETURN; 
      END # GETBUF #
      TERM; 
