Retro1.org codex

*DECK EXGITSB 
      PROC GIVETSB ( (FWA) ); 
      BEGIN # GIVETSB # 
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        GIVETSB             M. D. PICKARD       76/11/19 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        GIVETSB WILL RETURN AN ASSIGNED BLOCK TO THE AVAILABLE 
*        SPACE IN THE TSB AREA. 
* 
*     3. METHOD USED
*        THE TSB IS SET TO FREE. THE TSB PRECEEDING IT AND AFTER IT 
*        ARE CHECKED, IF TWO FREE TSB"S ARE CONTIGUOUS THEY ARE MADE
*        INTO ONE BLOCK.
* 
*     4. ENTRY PARAMETERS 
*        A. FORMAL PARAMETERS 
*           FWA              ADDRESS OF TSB BEING RETURNED
* 
*        B. TSBMGR GLOBAL PARAMETERS
*           CTSBLWA          CURRENT LAST WORD ADDRESS OF TSB"S 
*           TSBFWA           TSB AREA FIRST WORD ADDRESS
* 
*     5. EXIT PARAMETERS
*        FFFWA (TSBMGR GLOBAL)  FIRST FREE TSB ADDRESS
*        BIGFREE (TSBMGR GLOBAL)  BIGGEST FREE TSB IN TSB AREA
* 
*     6. COMDECKS CALLED
*        TSBBASE             TSB MANAGER BASED ARRAY DEFINITIONS
*        TSBDATA             TSB MANAGER DATA AREA DEFINITIONS
*        TSBDEFS             TSB MANAGER SYMPL DEFS 
* 
*     7. ROUTINES CALLED
*        GETBIG              GET BIGGEST FREE TSB 
*        FIRSTF              GET FIRST FREE TSB 
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
      CONTROL NOLIST;        # STOPS LIST TSBDEFS,TSBDATA,TSBBASE   # 
*CALL CYBERDEFS 
*CALL TSBDEFS 
*CALL TSBBASE 
*CALL TSBDATA 
      CONTROL LIST; 
      ITEM
           FWA U;            # FWA OF TSB BEING GIVEN BACK             #
      XREF
        BEGIN 
        PROC FIRSTF;
        PROC GETBIG;
        END 
      ITEM
           TEMPA U,          # TEMPORARY ADDRESS FOR TSB"S             #
           TEMPL U;          # TEMPORARY LENGTH OF ACCUMULATED TSB     #
      P<FTSBHDR> = FWA;      # SET FREE HEADER AT RELEASED TSB         #
      TEMPL = FTSBL[0];      # SAVE AMOUNT BEING RETURNED              #
      FBUSY[0] = FALSE;      # SET NOT BUSY                            #
      FIDENT[0] = 0;         # CLEAR IDENT FIELD                       #
      FNOTMOV[0] = FALSE;    # ALLOW MOVING                            #
      IF FPTSBL[0] NQ 0 
      THEN                   # THERE IS A TSB BEFORE THIS              #
        BEGIN 
        TEMPA = FWA - FPTSBL[0]; # ADDRESS OF PREVIOUS TSB             #
        P<FTSBHDR> = TEMPA;  # SET FREE HEADER AT PREVIOUS TSB         #
        IF FBUSY[0] 
        THEN                 # TSB PREVIOUS TSB IS ASSIGNED            #
          TEMPA = FWA;       # RESET TO ORIGINAL FREE TSB FWA          #
        ELSE
          TEMPL = TEMPL + FTSBL[0]; # ADD LENGTH OF BOTH TSB"S         #
        END 
      ELSE                   # SET ADDRESS TO TSB BEING GIVEN BACK     #
        TEMPA = FWA;
      P<FTSBHDR> = TEMPA + TEMPL; # POINT TO NEXT TSB                  #
      IF LOC(FTSBHDR) LS CTSBLWA
      THEN                   # THERE IS A NEXT TSB (NOT AT END)        #
        IF NOT FBUSY[0] 
        THEN                 # IT IS FREE ALSO, COMBINE W/ THE REST    #
          TEMPL = TEMPL + FTSBL[0]; # ADD LENGTH TO THAT ACCUMULATED   #
      P<FTSBHDR> = TEMPA;    # SET HEADER AT ADDRESS OF NEW FREE TSB   #
      FTSBL[0] = TEMPL;      # SET LENGTH                              #
      P<BTSBHDR> = TEMPA + TEMPL; # NEXT TSB                           #
      BPTSBL[0] = TEMPL;     # SET NEW PREVIOUS TSB LENGTH             #
      IF TEMPL GR BIGFREE THEN         # RESET BIGFREE IF RETURNED    # 
        BIGFREE = TEMPL ;         # VALUE IS GREATER                  # 
      IF TEMPA LS FFFWA THEN      #RESET FFFWA IF RETURNED  IS LOWER  # 
        FFFWA = TEMPA ; 
      RETURN; 
      END TERM # GIVETSB #