Retro1.org codex

*DECK EXRETSB 
      PROC RETTSB ( (TSBN) ); 
      BEGIN # RETTSB #
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        RETTSB              M. D. PICKARD       76/12/2
* 
*     2. FUNCTIONAL DESCRIPTION 
*        RETTSB WILL RETURN AN ASSIGNED TSB TO THE FREE SPACE OF
*        THE TSB AREA.
* 
*     3. METHOD USED
*        IF THE TSBN IS VALID THE BLOCK IS RETURNED TO THE FREE 
*        SPACE BY CALLING GIVETSB AND THE TSBN IS RETURNED
*        BY CALLING GIVTSBN.
* 
*     4. ENTRY PARAMETERS 
*        TSBN (FORMAL)       TSB NUMBER OF TSB THAT IS TO BE RETURNED 
* 
*     5. EXIT PARAMETERS
*        NONE.
* 
*     6. COMDECKS CALLED
*        TSBBASE             TSB MANAGER BASED ARRAY DEFINITIONS
*        TSBDEFS             TSB MANAGER SYMPL DEFS 
*        TSBDATA             TSB MANAGER DATA AREA DEFINITIONS
* 
*     7. ROUTINES CALLED
*        GIVETSB             GIVE TSB BACK TO FREE SPACE
*        GIVTSBN             RETURNS A TSBN TO THE FREE TSBN CHAIN
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
      CONTROL NOLIST;        # STOPS LIST TSBDEFS,TSBDATA,TSBBASE   # 
*CALL CYBERDEFS 
*CALL TSBDEFS 
*CALL TSBBASE 
*CALL TSBDATA 
      CONTROL LIST; 
      ITEM
           TSBN U;           # TSBN OF TSB TO BE RETURNED              #
      XREF
        BEGIN 
        PROC GIVETSB; 
        END 
      ITEM
           TEMP U,           # TEMPORARY UNSIGNED INTEGER              #
           TEMPB B;          # TEMPORARY BOOLEAN                       #
      CONTROL EJECT;
      PROC GIVTSBN ( (TSBN) );
      BEGIN # GIVTSBN # 
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        GIVTSBN             M. D. PICKARD       76/12/13 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        GIVTSBN WILL RETURN AN ASSIGNED TSBN TO THE CHAIN OF 
*        UNASSIGNED TSBN"S IN THE TSB INFORMATION TABLE ( TSBIT ).
* 
*     3. METHOD USED
*        THE CHAIN OF UNASSIGNED (FREE) TSBN"S IS SEARCHED FINDING
*        THE APPROPRIATE SPOT, TSBN IS LINKED INTO THE CHAIN. 
* 
*     4. ENTRY PARAMETERS 
*        TSBN                TSBN ( TSB NUMBER ) THAT IS TO BE RETURNED 
* 
*     5. EXIT PARAMETERS
*        NONE.
* 
*     6. COMDECKS CALLED
*        NONE.
* 
*     7. ROUTINES CALLED
*        GETTSB 
*        GIVETSB
*        MOVEI               MOVES BLOCK OF CENTRAL MEMORY WORDS
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
      ITEM
           TSBN U;           # TSB NUMBER TO BE RETURNED               #
 
      NUMFREE[0] = NUMFREE[0] + 1; # BUMP NUMBER OF FREE TSBN"S        #
      IF LOWFREE[0] EQ 0
      THEN                   # THIS IS THE ONLY FREE TSBN              #
        BEGIN 
        FWDPTR[TSBN] = 0;    # END OF FREE CHAIN POINTER               #
        LOWFREE[0] = TSBN;        #SET LOWFREE TO THIS TSBN         # 
        END 
      ELSE                   # FIND THE TSBN"S PLACE IN THE FREE CHAIN #
        BEGIN 
        IF TSBN LS LOWFREE[0] 
        THEN                 # TSBN WILL BE NEW LOWFREE                #
          BEGIN 
          FWDPTR[TSBN] = LOWFREE[0]; # POINT TO OLD LOWFREE            #
          LOWFREE[0] = TSBN; # SET NEW LOWFREE AT RETURNED TSBN        #
          END 
        ELSE
          BEGIN              # SEARCH FOR ITS SPOT IN FREE CHAIN       #
          TEMPB = FALSE;     # END OF LOOP INDICATOR                   #
          FOR TEMP = LOWFREE[0] WHILE NOT TEMPB DO
            BEGIN            # SEARCH TIL HIT                          #
            FWDPTR[TSBN] = FWDPTR[TEMP]; # SET FWDPTR TO NEXT ONE      #
            IF TSBN LS FWDPTR[TSBN] 
            THEN             # PLACE IS FOUND                          #
              BEGIN 
              TEMPB = TRUE;  # SET END OF LOOP                         #
              FWDPTR[TEMP] = TSBN; # SET NEW FWDPTR FOR PREVIOUS TSBN  #
              END 
            ELSE             # SEE IF END OF CHAIN                     #
              BEGIN 
              IF FWDPTR[TSBN] EQ 0
              THEN           # THIS IS THE END OF CHAIN                #
                BEGIN 
                TEMPB = TRUE; # SET END OF LOOP                        #
                FWDPTR[TEMP] = TSBN; # POINT OLD END OF CHAIN TO TSBN  #
                END 
              ELSE           # CONTINUE SEARCH                         #
                TEMP = FWDPTR[TEMP]; # BUMP TO NEXT IN CHAIN           #
              END 
            END 
          END 
        END 
      RETURN; 
      END # GIVTSBN # 
      CONTROL EJECT;         # RETTSB CODE STARTS HERE                 #
      IF ( TBUSY[TSBN] ) AND ( TSBN LS LENGTH[0] ) AND ( TSBN GR 0 )
      THEN                   # TSBN IS VALID                           #
        BEGIN 
        GIVETSB(TTSBFWA[TSBN]); # GIVE BACK THE TSB TO FREE SPACE      #
        TBUSY[TSBN] = FALSE; # CLEAR BUSY FLAG                         #
        TTSBFWA[TSBN] = 0;   # CLEAR TSB FWA                           #
        GIVTSBN(TSBN);       # RETURN THIS TSBN TO FREE CHAIN          #
        END 
      RETURN; 
      END TERM # RETTSB #