Retro1.org codex

*DECK EXGETSB 
      PROC GETTSB ( (SIZE),(IDENT), TFWA ); 
      BEGIN # GETTSB #
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        GETTSB              M. D. PICKARD       76/11/15 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        GETTSB WILL FIND A FREE TSB OF THE REQUESTED SIZE. THE 
*        TSB HEADER IS WRITTEN INDICATING THAT THE TSB IS ASSIGNED, 
*        FIXED POSITION AND ASSOCIATED TO THE SPECIFIED IDENT.
*        THE ADDRESS OF THE TSB IS RETURNED TO THE CALLER 
* 
*     3. METHOD USED
*        IF A FREE TSB EXISTS THAT IS GREATER OR EQUAL IN SIZE TO THE 
*        REQUEST SIZE, A TSB IS CHOSEN TO SATISFY THE REQUEST.
*        IF A FREE TSB THAT WILL SATISFY THE REQUEST DOES NOT EXIST,
*        THEN AN ATTEMPT IS MADE TO MOVE ASSIGNED VARIABLE POSITION 
*        BLOCKS UNTIL A CONTIGUOUS FREE AREA DOES EXIST THAT WILL 
*        SATISFY THE REQUEST. 
*        IF THE LATTER FAILS MORE FIELD LENGTH IS REQUESTED TO CREATE 
*        A FREE TSB THAT WILL SATISFY THE REQUEST.
*        WHEN A TSB IS FOUND THAT SATISFIES THE REQUEST, THE HEADER 
*        IS BUILT AND THE ADDRESS RETURNED TO THE CALLER. 
* 
*     4. ENTRY PARAMETERS 
*        A. FORMAL PARAMETERS 
*           SIZE             NUMBER OF WORDS IN REQUESTED TSB 
*                            MUST BE GREATER THAN ZERO AND LESS THAN
*                            MAXTSBL
* 
*           IDENT            IDENTIFIER FOR BLOCK, PLACED IN HEADER 
*                            MUST BE GREATER THAN ZERO AND LESS THAN
*                            MAXTSBI
*        B. TSBMGR GLOBAL PARAMETERS
*           BIGFREE          BIGGEST AVAILABLE FREE TSB 
*           CTSBLWA          CURRENT TSB AREA LAST WORD ADDRESS 
*           FFFWA            FIRST FREE TSB FIRST WORD ADDRESS
* 
*     5. EXIT PARAMETERS
*        TFWA                TSB FIRST WORD ADDRESS RETURNED TO CALLER
*                            TFWA WILL BE ZERO IF REQUEST NOT SATISFIED 
* 
*     6. COMDECKS CALLED
*        TSBBASE             TSB MANAGER BASED ARRAY DEFINITIONS
*        TSBDATA             TSB MANAGER DATA AREA DEFINITIONS
*        TSBDEFS             TSB MANAGER SYMPL DEFS 
* 
*     7. ROUTINES CALLED
*        FIRSTF              GET FWA OF FIRST FREE TSB IN THE TSB AREA
*        GETFREE             GETS FWA OF NEXT FREE TSB
*        MESSAGE             ISSUES DAYFILE MESSAGES  (MACREL)
*        GETBIG              GETS SIZE OF BIGGEST FREE TSB
*        NEWFREE             CREATE NEW FREE TSB WITH EXCESS OF 
*                            NEWLY ASSIGNED TSB 
*        SQUEEZE             CONSOLIDATES FREE SPACE IN TSB AREA AND
*                            GETS MORE FIELD LENGTH IF NEEDED 
* 
*     8. DAYFILE MESSAGES 
*        "TSB LOGICAL ERROR" INFORMATIVE MESSAGE
* 
 #
*ENDIF
      CONTROL NOLIST;        # STOPS LIST TSBDEFS,TSBDATA,TSBBASE   # 
*CALL CYBERDEFS 
*CALL TSBDEFS 
*CALL TSBBASE 
*CALL TSBDATA 
      CONTROL LIST; 
      ITEM
           SIZE U,           # SIZE IN WORDS OF REQUESTED BLOCK        #
           IDENT U,          # IDENTIFIER OF REQUESTED BLOCK           #
           TFWA U;           # ADDRESS OF ASSIGNED BLOCK               #
      XREF
        BEGIN 
        PROC FIRSTF;
        PROC GETBIG;
        PROC MESSAGE; 
        PROC SQUEEZE; 
       PROC ZERO ;
        END 
      $BEGIN                 # START DEBUG CODE HERE                 #
      XREF
        PROC ABORT; 
      $END
      ITEM
           FOUND B,          # INDICATES BLOCK IS FOUND                #
           CFWA U,           # CURRENT FREE TSB FWA                    #
           TEMP U;           # TEMPORARY UNSIGNED INTEGER              #
      ARRAY TSBLERR [0:0] P(2); # TSB LOGICAL ERROR DAYFILE MESSAGE    #
        ITEM
             TLERRM C (0,0,17) = [ "TSB LOGICAL ERROR" ], 
             TLERRZ U (1,42,18) = [ 0 ];
      CONTROL EJECT;
      PROC NEWFREE ( (FWA),(LENGTH) );
      BEGIN # NEWFREE # 
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        NEWFREE             M. D. PICKARD       76/11/16 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        NEWFREE CREATES A NEW FREE TSB AT THE END OF A BLOCK THAT
*        IS CHOSEN TO SATISFY A REQUEST WHEN THE BLOCK IS BIGGER THAN 
*        THE REQUESTED SIZE.
* 
*     3. METHOD USED
*        CREATE FREE TSB HEADER AT FWA + LENGTH. UPDATE LENGTH FIELD
*        ON TSB BEING ASSIGNED AND PREVIOUS BLOCK LENGTH ON TSB AFTER 
*        THE NEW FREE TSB.
* 
*     4. ENTRY PARAMETERS 
*        A. FORMAL PARAMETERS 
*           FWA              FWA OF CHOSEN TSB
*           LENGTH           AMOUNT THAT WILL BE ASSIGNED 
* 
*        B. TSBMGR GLOBAL PARAMETERS
*           FTSBHDR          BASED ARRAY SET AT FWA 
* 
*     5. EXIT PARAMETERS
*        NONE.
* 
*     6. COMDECKS CALLED
*        NONE.
* 
*     7. ROUTINES CALLED
*        NONE.
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
      ITEM
           FWA U,            # FWA OF TSB BEING ASSIGNED               #
           LENGTH U;         # LENGTH OF TSB BEING ASSIGNED            #
      P<BTSBHDR> = FWA + FTSBL[0]; # SET BUSY HEADER FORMAT AT NEXT TSB#
      TEMP = FTSBL[0];       # SAVE OLD LENGTH OF TSB BEING ASSIGNED   #
      FTSBL[0] = LENGTH;     # UPDATE LENGTH OF TSB BEING ASSIGNED     #
      P<FTSBHDR> = FWA + LENGTH; # SET FREE TSB FORMAT ON NEW TSB      #
      FBUSY[0] = FALSE;      # SET NOT BUSY ON NEW TSB HEADER          #
      FNOTMOV[0] = FALSE;    # ALLOW MOVING OF NEW TSB                 #
      FHDRRSV[0] = 0;        # CLEAR RESERVED AREA IN HEADER           #
      FIDENT[0] = 0;         # CLEAR IDENT FIELD                       #
      FPTSBL[0] = LENGTH;    # SET NEW TSB"S PREVIOUS TSB LENGTH       #
      FTSBL[0] = TEMP - LENGTH; # SET LENGTH OF NEW BLOCK              #
      BPTSBL[0] = FTSBL[0];  # SET NEW PREVIOUS TSB LENGTH ON NEXT TSB #
      RETURN; 
      END # NEWFREE # 
      CONTROL EJECT;
      PROC GETFREE ( (FWA), FFWA ); 
      BEGIN # GETFREE # 
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        GETFREE             M. D. PICKARD       76/11/16 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        GETFREE WILL SEARCH THE TSB AREA FOR THE NEXT FREE TSB 
*        STARTING AT FWA. 
* 
*     3. METHOD USED
*        START A FWA + LENGTH OF THAT TSB AND SEARCH FOR A NOT BUSY 
*        TSB UNTIL CTSBLWA. RETURN ADDRESS OF FREE TSB OR CTSBLWA.
* 
*     4. ENTRY PARAMETERS 
*        A. FORMAL PARAMETERS 
*           FWA              FIRST WORD ADDRESS OF TSB TO START SEARCH
*        B. TSBMGR GLOBAL PARAMETERS
*           CTSBLWA          CURRENT TSB AREA LAST WORD ADDRESS 
* 
*     5. EXIT PARAMETERS
*        FFWA                ADDRESS OF NEXT FREE TSB OR CTSBLWA
* 
*     6. COMDECKS CALLED
*        NONE.
* 
*     7. ROUTINES CALLED
*        NONE.
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
      ITEM
           FWA U,            # START ADDRESS OF SEARCH                 #
           FFWA U;           # NEXT FREE TSB FWA OR CTSBLWA            #
      P<FTSBHDR> = FWA;      # SET FREE HEADER AT START TO GET LENGTH  #
      P<FTSBHDR> = FWA + FTSBL[0]; # PUT HEADER AT NEXT TSB            #
      FOR FFWA = LOC(FTSBHDR) WHILE 
                             ( FBUSY[0] AND ( FFWA LQ CTSBLWA)) DO
        BEGIN 
        FFWA = FFWA + FTSBL[0]; # BUMP TO NEXT TSB                     #
        P<FTSBHDR> = FFWA; # RESET HEADER                              #
        END 
      RETURN; 
      END # GETFREE # 
      CONTROL EJECT;         # *** GETTSB CODE STARTS HERE ***         #
      IF FFFWA EQ CTSBLWA 
      THEN                   # FIRST FREE IS AT END OF TSB AREA        #
        SQUEEZE(SIZE,CFWA);  # NOTHING IS LEFT TO CONSOLIDATE, GET SOME#
      FOUND = FALSE;         # INITIALIZE LOOP END CONDITION           #
      FOR CFWA = FFFWA WHILE (NOT FOUND AND ( CFWA LS CTSBLWA )) DO 
        BEGIN                # FIND A TSB THAT WILL SATISFY THE REQUEST#
        IF BIGFREE GQ SIZE
        THEN                 # THERE IS A TSB BIG ENOUGH               #
          BEGIN              # SEARCH ALL FREE TSB"S UNTIL REQUEST IS  #
                             # SATISFIED                               #
          P<FTSBHDR> = CFWA; # SET FREE TSB HEADER FORMAT AT FREE TSB  #
          IF FTSBL[0] GQ SIZE # CHECK LENGTH OF TSB AGAINST REQ. SIZE  #
          THEN               # THIS FREE TSB IS BIG ENOUGH             #
            BEGIN 
            FOUND = TRUE;    # END OF LOOP INDICATOR                   #
            IF FTSBL[0] EQ BIGFREE THEN 
              BIGFREE = 0 ; 
            TFWA = CFWA;     # SET RETURN PARAMETER                    #
            TEMP = SIZE + TSBHDRL; # INSURE AT LEAST ROOM FOR ONE WORD #
                                   #                               TSB #
            IF TEMP LS FTSBL[0] # IS THERE ENOUGH FOR A NEW FREE TSB   #
            THEN                # AT THE END                           #
              NEWFREE(CFWA,SIZE);      # CREATE THE NEW FREE TSB       #
            END 
          ELSE               # GET ADDRESS OF NEXT FREE TSB            #
            GETFREE(CFWA,CFWA); # GET NEXT FREE TSB                    #
          END 
        ELSE                         # SQUEEZE FREE TSB"S TOGETHER OR  #
          SQUEEZE(SIZE,CFWA);        # GET FL TO SATISFY REQUEST       #
        END 
      IF FOUND
      THEN                   # BUILD HEADER FOR ASSIGNED TSB           #
        BEGIN 
        P<BTSBHDR> = TFWA;   # POINT BUSY HEADER FOR CHOSEN FREE TSB   #
        BBUSY[0] = TRUE;     # SET ASSIGNED (BUSY) FLAG                #
        BNOTMOV[0] = TRUE;   # SET FIXED POSITION FLAG                 #
        BHDRRSV[0] = 0;      # CLEAR RESERVED AREA                     #
        BIDENT[0] = IDENT;   # PUT IDENTIFIER IN HEADER                #
        SIZE = ( TFWA + TSBHDRL ) - TSBFWA; # USE SIZE AS TEMPORARY    #
        ZERO(LOC(TSBAREA[SIZE]) ,BTSBL[0]-TSBHDRL   );# CLEAR AREA    # 
          FIRSTF; 
        IF BIGFREE EQ 0 THEN      # RE-ESTAB BIGFREE IF USED          # 
          GETBIG ;
        END 
      ELSE                   # LOGICAL ERROR IN TSB STRUCTURE          #
        BEGIN 
        TFWA = 0;            # SET ERROR RETURN FLAG                   #
        MESSAGE(TSBLERR,3); # ISSUE LOCAL DAYFILE MESSAGE              #
        $BEGIN
        ABORT;               # ***** DEBUG MODE ABORT *****            #
        $END
        END 
      RETURN; 
      END TERM # GETTSB #