.
.                            BUFFER ALLOCATION ROUTINES
.
.                     JULY 1972                     JOHN WALKER
.
.                           (C)  Copyright 1972  John Walker
.                         This software is in the public domain
.
.
.                 THIS  ELEMENT CONSISTS OF ROUTINES TO ALLOCATE AND RELEASE
.         VARIABLE  LENGTH BUFFERS.  BUFFERS ARE ALLOCATED FROM AND RETURNED
.         TO  A FREE SPACE POOL.  THIS SPACE MAY EXPAND AND CONTRACT DYNAMI-
.         CALLY.
.
.         TO ALLOCATE A BUFFER:
.
.                 LA,U      A0,<LENGTH REQUIRED>
.                 LMJ       X11,BGET
.                 <RETURN>
.
.         UPON  RETURN,  A0  CONTAINS  THE  ADDRESS OF THE FIRST WORD OF THE
.         BUFFER.
.
.         TO RELEASE A BUFFER:
.
.                 LA,U      A0,<ADDRESS OF BUFFER>
.                 LMJ       X11,BREL
.                 <RETURN>
.
.         BOTH  ROUTINES  DESTROY  ONLY THE REGISTERS X11 AND A0, AND MAY BE
.         CALLED  BY  ACTIVITIES RUNNING IN THE MINOR SET OF REGISTERS.  THE
.         ROUTINES  ARE  QUARTER  WORD INSENSITIVE, AND MAY BE CALLED SIMUL-
.         TANEOUSLY  BY MULTI-ACTIVITY PROGRAMS OR INCORPORATED INTO A REEN-
.         TRANT PROCESSOR.
.
.                 THE  ABOVE  IS SUFFICIENT INFORMATION TO INTELLIGENTLY USE
.         THE  BUFFER  ALLOCATION PACKAGE.  THOSE OF YOU WHOSE BLOOD COURSES
.         AT THE THOUGHT OF THE UNKNOWN ARE NOW INVITED DOWN THE RABBIT HOLE
.         TO LEARN HOW THIS THING OPERATES AND HOW TO CONFIGURE IT OPTIMALLY
.         FOR AN APPLICATION.
/.
.                 EACH  BUFFER  IS PRECEDED BY TWO WORDS OF CONTROL INFORMA-
.         TION.  THIS INFORMATION CONSISTS OF FOUR HALF WORD ITEMS:
.
.                 SIZE      SIZE  OF THIS BUFFER INCLUDING CONTROL
.                           WORDS.   THIS FIELD IS NEGATIVE IF THE
.                           BUFFER IS IN USE.
.
.                 HL        LINK  TO  PREVIOUS  BLOCK IN CORE.  IF
.                           ZERO, THE PREVIOUS BLOCK IS IN USE.
.
.                 FL        LINK TO NEXT FREE BUFFER (USED ONLY IF
.                           BUFFER IS FREE).
.
.                 BL - ARQ  IF  BUFFER  IS  FREE, LINK TO PREVIOUS
.                           FREE BUFFER (BL), IF BUFFER IS IN USE,
.                           ADDRESS  OF  REQUESTOR  OF  THE BUFFER
.                           (ARQ).
.
.                 AT  THE  TAG HEAD IS THE HEAD OF THE LIST OF FREE BUFFERS.
.         THE LENGTH FIELD OF THE HEAD IS SET TO -1 TO PREVENT ALLOCATION OF
.         THE HEAD.
.
.                 THE  ROUTINE  BGET  ALLOCATES  BUFFERS  BY THE 'FIRST FIT'
.         METHOD,  AS  FOLLOWS:   STARTING  AT  HEAD,  IT  LINKS THROUGH THE
.         BUFFERS  UNTIL  IT  FINDS ONE LARGE ENOUGH TO SATISFY THE REQUEST.
.         HAVING FOUND ONE, IT DETERMINES HOW MUCH UNUSED SPACE WILL BE LEFT
.         OVER  ONCE  THE  REQUESTED  SPACE IS GIVEN TO THE USER.  IF ENOUGH
.         SPACE REMAINS TO FORM ANOTHER FREE BLOCK, IT REDUCES THE LENGTH OF
.         THE  FREE BLOCK BY THE LENGTH TO BE ALLOCATED, CONSTRUCTS A BUFFER
.         FROM  THE  END  OF  THE  FREE  BLOCK, AND PASSES THAT TO THE USER.
.         OTHERWISE,  THE  ENTIRE  FREE  BLOCK IS UNCHAINED AND GIVEN TO THE
.         USER.  THE HEAD LINK OF THE NEXT BLOCK IS CLEARED TO INDICATE THAT
.         THE BLOCK HAS BEEN ALLOCATED.
.
.                 THE ROUTINE BREL RETURNS A BUFFER TO THE FREE POOL, POSSI-
.         BLY  RECOMBINING  IT  WITH  CONTIGUOUS  BLOCKS TO FORM LARGER FREE
.         BLOCKS.   IF  BOTH  THE PRECEDING AND FOLLOWING BLOCKS OF A BUFFER
.         ARE  IN  USE,  THE  BUFFER BEING RELEASED IS SIMPLY CHAINED TO THE
.         LIST  OF FREE BUFFERS.  IF THE PRECEDING BLOCK IS FREE, THE BUFFER
.         BEING  RETURNED  IS  APPENDED  TO  THE  PRECEDING BUFFER, WHICH IS
.         ALREADY  ON  THE  FREE  LIST.   AT  THIS POINT, THE NEXT BUFFER IS
.         EXAMINED.   IF  IT  IS  FREE, IT IS REMOVED FROM THE FREE LIST AND
.         ABSORBED INTO THE BUFFER BEING RELEASED.
.
.                 IF  THE  EQU  EXPINC IS NONZERO, CODE WILL BE GENERATED TO
.         DYNAMICALLY  EXPAND THE BUFFER POOL WHEN SPACE IS EXHAUSTED.  THIS
.         CODE,  STARTING AT THE TAG MT, ACQUIRES ENOUGH CORE TO SATISFY THE
.         REQUEST  (OR AT LEAST EXPINC WORDS), AND CONSTRUCTS A LARGE BUFFER
.         OF  IT.   AN 'IMPENETRABLE BARRIER' ONE WORD LONG IS PLACED AT THE
.         END  OF  THE  BUFFER.   THIS  BARRIER CONTAINS THE NEGATIVE OF THE
.         BLOCK  LENGTH IN THE SIZE FIELD TO STOP RECOMBINATION.  THE END OF
.         CORE  POINTER,  LASTD, IS UPDATED.  THE NEW BUFFER IS THEN CHAINED
.         TO THE FREE LIST, AND THE USER REQUEST IS THEN RETRIED.
.
.                 THE  EQU  LCORE CONTROLS WHETHER EXPANSION BLOCKS ACQUIRED
.         BY  THE  ABOVE  MECHANISM  WILL BE RELEASED WHEN TOTALLY FREE.  IN
.         GENERAL,  THIS  MECHANISM IS USEFUL ONLY TO PROGRAMS WITH LONG RUN
.         TIMES,  LARGE  SIZE VARIATIONS, AND A TRUE NESTING OF REQUESTS AND
.         RELEASES.   THE  CODE, WHICH STARTS AT THE TAG BRL5, CHECKS WHEN A
.         BUFFER  IS  RELEASED  TO SEE IF IT EXTENDS TO THE END OF CORE.  IF
.         SO,  THE ROUTINE STARTING AT BRL3 IS INVOKED TO DETERMINE FROM THE
.         SIZE  FIELD  AND  THE BARRIER WORD WHETHER THE ENTIRE BLOCK IS NOW
.         FREE.   IF  IT  IS,  THE BLOCK IS UNCHAINED FROM THE FREE LIST AND
.         RELEASED  VIA LCORE$.  IF OTHER EXPANSION BLOCKS ARE PRESENT, THEY
.         ARE EXAMINED FOR POSSIBLE RELEASE.
.
.                 BUFFERS ARE INITIALLY ALLOCATED FROM A POOL ASSEMBLED INTO
.         THE  ELEMENT.   THE  SIZE OF THIS INITIAL RESERVE IS DETERMINED BY
.         THE  EQU  BSIZE.   THE  INTERNAL  BUFFER  STARTS AT THE TAG BIBUF,
.         IMMEDIATELY  BEFORE  THE  HEAD PACKET.  THE FIRST WORD OF THE HEAD
.         SERVES  AS THE BARRIER WORD FOR THE INTERNAL BUFFER.  BSIZE MAY BE
.         ZERO, IN WHICH CASE THE INITIAL RESERVE WILL NOT BE GENERATED, AND
.         THE  HEAD  WILL  BE  CHAINED  TO  ITSELF.  IN THIS CASE, THE FIRST
.         REQUEST MADE UPON BGET WILL ALLOCATE AN EXPANSION BLOCK.
.
.                 THE   ROUTINE   MUST   PROTECT  ITS  DATA  FOR  USE  IN  A
.         MULTI-ACTIVITY  ENVIRONMENT.  THE PROCS P AND V ARE USED TO INVOKE
.         AND  RELEASE  PROTECTION,  RESPECTIVELY.   THE  EQU TSQ DETERMINES
.         WHETHER  NORMAL  TEST  AND  SET  SYNCHRONISATION  OR  TEST AND SET
.         QUEUEING  WILL BE USED FOR DATA PROTECTION.  TEST AND SET QUEUEING
.         MUST  BE  USED IF BGET AND BREL ARE TO BE CALLED SIMULTANEOUSLY BY
.         REAL-TIME  AND  REGULAR (BATCH OR DEMAND) ACTIVITIES.  THE PROGRAM
.         MUST  EXECUTE AN ER TSQRG$ BEFORE AMY REFERENCE TO BGET, IF TSQ IS
.         THE SELECTED SYNCHRONISATION METHOD.
.
.                 THE  REST  OF THE EQU'S CONTROL ERROR CHECKING AND DIAGNO-
.         SIS.  MAXSIZ ESTABLISHES A BOUND ON THE LARGEST BUFFER REQUEST, TO
.         TRAP  WILD  CALLS.   ADDITIONALLY, IF MAXSIZ IS SUFFICIENTLY SMALL
.         THAT EXPINC WILL ALWAYS BE ENOUGH EXPANSION CORE TO SATISFY A USER
.         REQUEST,  TWO  INSTRUCTIONS  WILL  BE  REMOVED  FROM THE EXPANSION
.         ROUTINE.
.
.                 TRACE  TURNS  ON  CODE  WHICH LOGS EXPANSIONS AND CONTRAC-
.         TIONS,  AND  DEFINES  AN  EXTERNAL  TAG  BTRACE.  IF BTRACE IS SET
.         NON-ZERO,  ALL  BGET AND BREL CALLS WILL BE LOGGED UPON OCCURENCE.
.         THIS IS USEFUL IN TRACKING DOWN ERRORS.
.
.                 IF  STATS  IS  SET  TO  1,  STATISTICS WILL BE KEPT ON THE
.         NUMBER OF BGET AND BREL CALLS, THE TOTAL SPACE IN USE AT ANY TIME,
.         AND  THE  MAXIMUM SPACE IN USE SO FAR.  THIS INFORMATION, STARTING
.         AT  THE  TAG  BSTATW,  MAY  BE ACCESSED BY THE USER PROGRAM (WHICH
.         SHOULD  SET  THE  LOCK FIRST), OR MAY BE EDITED AND PRINTED BY THE
.         CALL:
.                 LMJ       X11,BSTATP
.         THE SUBROUTINE BSTATP IS GENERATED ONLY IF STATS IS SET TO 1.
.
.                 IF ANY ERROR IS DETECTED BY BGET OR BREL, THE ACTION TAKEN
.         DEPENDS ON THE SETTING OF ERRLEV.  FIVE SETTINGS, DESCRIBED BEFORE
.         THE  VARIABLE,  ACCOMODATE PROGRAMS ACROSS THE SPECTRUM FROM THOSE
.         ABOVE SUSPICION TO THOSE BENEATH CONTEMPT.
.
.                 THE CORE ALLOCATION ALGORITHM USED HEREIN IS AN ADAPTATION
.         OF  THE  MECHANISM  USED  IN  THE  ALGOL COMPILER DESIGNED AT CASE
.         WESTERN  RESERVE  UNIVERSITY.   THE OCTAL EDITOR SUBROUTINE IN THE
.         MANNER  OF  EXEC  II WAS ADAPTED FROM A ROUTINE BY DEREK ZAVE (NOT
.         THE FAMOUS 12 INSTRUCTION EDITOR).
.
.         TO  ASSEMBLE  THIS  ROUTINE, THE WALKER ER PROCS MUST BE AVAILABLE
.         (ELEMENT ERPROCS).
/.
.
          FANG
.
.
.         THE FOLLOWING PARAMETERISE THIS VERSION OF BGET
.
.
.         ERRLEV DETERMINES THE AMOUNT OF ERROR DIAGNOSIS AND
.         CHECKING TO BE PERFORMED BY BGET AND BREL.  THE HIGHER
.         THE VALUE, THE HIGHER THE QUALITY OF ERROR DIAGNOSIS.
.         PERMITTED VALUES ARE:
.
.                   0     NO ERROR CHECKING AT ALL
.                   1     EABT$ IF AN ERROR IS DETECTED
.                   2     EABT$ WITH CODES IN REGISTERS
.                              A0 = +(ERROR CODE,USER A0)
.                              X11 = CALL ADDRESS
.                   3     ERROR NUMBER, X11, A0 EDITED
.                   4     ERROR MESSAGE, X11, A0 EDITED
.
ERRLEV    EQU       ;
                    4*(DEBUG>0)+2*(DEBUG=0)
.
.         EXPANSION INCREMENT IN WORDS
.         IF ZERO, EXPANSION IS NOT PERMITTED
.         THIS IS THE ACTUAL AMOUNT OF SPACE, INCLUDING CONTROL
.         WORDS, TO BE ALLOCATED.  THE MAXIMUM BUFFER THAT CAN
.         CARVED OUT OF THIS SPACE IS NCWIU WORDS SMALLER.
.
EXPINC    EQU       ;
                    DYNMEM
.
.         MAXIMUM REQUEST SIZE (NO MAXIMUM IF ZERO)
.
MAXSIZ    EQU       ;
                    0
.
.         SHOULD LCORE$ BE USED TO RELEASE EXPANSION BLOCKS ?
.
LCORE     EQU       ;
                    1
.
.         IF MANUAL IS SET NONZERO, SPACE ALLOCATED VIA MCORE$ WILL NOT
.         BE RELEASED WHEN POSSIBLE VIA BREL, BUT WILL BE KEPT IN THE
.         AVAILABLE SPACE POOL UNTIL A CALL ON BRELC IS MADE.  AT THAT TIME,
.         ANY ELIGIBLE SPACE WILL BE RELEASED.  THIS PREVENTS MCORE/LCORE
.         TOGGLING (WITH ATTENDANT I/O RUNDOWN) IN PROGRAMS ALLOCATING AND
.         RELEASING MANY BUFFERS.
.
MANUAL    EQU       ;
                    1
.
.         INITIAL RESERVE SIZE (MAY BE ZERO)
.
BSIZE     EQU       ;
                    512*(DYNMEM>0)+14000*(DYNMEM=0)
.
.         SET TO 1 TO ENABLE TRACING OF OPERATIONS
.
TRACE     EQU       ;
                    jwsite>0
.
.         STATS CONTROLS THE KEEPING OF STATISTICS ON BREL USAGE.
.         IF SET TO 1, THE ROUTINE KEEPS TRACK OF THE NUMBER OF
.         ALLOCATE AND RELEASE CALLS, AND CODE IS GENERATED FOR
.         THE SUBROUTINE 'BSTAT', WHICH EDITS THE INFORMATION
.         WHEN CALLED BY THE USER.
.
STATS     EQU       ;
                    debug>0
.
.         TSQ IS ONE IF TEST AND SET QUEUEING IS TO BE THE
.         METHOD OF CRITICAL SECTION LOCKING.
.
. TSQ     EQU       ;
.                   0
/.
.
.         DERIVATIVE VARIABLES FROM CONFIGURATION
.
.         THIS COMPUTED VARIABLE DETERMINES WHETHER
.         'EXPINC' IS ALWAYS ENOUGH CORE.
.
BOUNDED   EQU       (MAXSIZ=0)++((MAXSIZ+NCWIU+1)>EXPINC)
.
.         THIS COMPUTED VARIABLE TELLS WHETHER
.         WE WILL USE LCORE$ TO RELEASE CORE
.
CORREL    EQU       (EXPINC>0)**(LCORE>0)
.
.         MANREL IS NONZERO IF MANUAL RELEASE IS DESIRED AND NEEDED
.
MANREL    EQU       CORREL**(MANUAL>0)
.
.         THIS COMPUTED VARIABLE CONTROLS ERROR CHECKING CODE
.
CHECK     EQU       ERRLEV>0
.
.         THIS COMPUTED VARIABLE DETERMINES WHETHER THE CODE
.         FOR THE INTERNAL OCTAL EDITOR SHOULD BE GENERATED.
.
EDITOR    EQU       TRACE++(ERRLEV>2)++STATS
.
.         CHECK VALIDITY OF PARAMETERS
.
          DO        (BSIZE=0)**(EXPINC=0) , I FLAG INDICATES NO CORE POSSIBLE
/.
.
.         PROCS
.
          AXR$
          DEFUNCT$
          LIT$      2
P         PROC      1,1                 TO GENERATE ERROR CALL
KABONG*   NAME      0
          DO        ERRLEV<2 , EABT$
          DO        ERRLEV>1 , I$ 072,010,P(1,1),,,KABTRAP
          END
.
E$        PROC      1,2
E$BO*     NAME      0
B         EQU       E$(1,1)-1
Y         FORM      6,12,18
          DO        E$(0,0)=0 , SLJ    EBO$
          Y         E$(1,3),B-B/6*6,E$(1,2)+B/6
          END
.
P*        PROC      1                   INVOKE CRITICAL SECTION
          TS        P(1,1)              SET THE LOCK
          END
.
V*        PROC      1                   RELEASE CRITICAL SECTION
          DO        TSQ=0 , SZ,S1 V(1,1)
          DO        TSQ>0 , CTS$  V(1,1)
          END
.
P         PROC      0,1                 CRITICAL SECTION LOCK
SEMA4*    NAME      0
          DO        TSQ=0 , * 0
          DO        TSQ>0 , TCELL$
          END
/.
.
.         BUFFER FORMAT EQUATES
.
HL        EQUF      0,,H1               POINTER TO PREVIOUS BLOCK
.                                       ZERO MEANS PREVIOUS BLOCK IN USE
.
SIZE      EQUF      0,,XH2              SIZE OF BLOCK INCLUDING CONTROL WORDS
.                                       NEGATIVE MEANS BLOCK IS IN USE
.
FBL       EQUF      1                   LINK WORD
FL        EQUF      FBL,,H1             FORWARD LINK TO NEXT FREE BLOCK
BL        EQUF      FBL,,H2             BACKWARD LINK TO PREVIOUS FREE BLOCK
.
ARQ       EQUF      1,,H2               ADDRESS OF REQUEST OF BLOCK IF IN USE
.
NCWIU     EQU       2                   NUMBER OF CONTROL WORDS IF IN USE
.
MIN       EQU       NCWIU+1             MINIMUM SIZE BUFFER TO KEEP
/.
.
.         DATA AREA
.
          ON        BSIZE>0
BIBUF     *         0,BSIZE
          *         HEAD,HEAD
          RES       BSIZE-NCWIU
          OFF       BSIZE>0
          DO        BSIZE=0 ,BIBUF.
HEAD      *         BIBUF,-1            HL,SIZE
          *         BIBUF,BIBUF         INITIALLY ONE BIG (?) BLOCK
.
          ON        STATS
BSTATW*   .
GETCALL   *         0                   NUMBER OF BGET CALLS
RELCALL   *         0                   NUMBER OF BREL CALLS
INUSE     EQUF      $,,H1               WORDS IN USE
MAXUSE    EQUF      $,,XH2              -(MAX WORDS USED SO FAR)
          *         0,0
          OFF       STATS
.
CRIT      SEMA4     .                   CRITICAL SECTION LOCK
.
          ON        EXPINC>0
LASTD     EQUF      $,,H1               NEXT USABLE ADDRESS
SVLEN     EQUF      $,,XH2              SAVE FOR BUFFER LENGTH
SNAPR     *         LASTD$+1,$-$
          OFF       EXPINC>0
.
SVA1      RES       2                   SAVE A1, A2
/.
.
.         REQUEST CORE BLOCK
.
.
.         LA,U      A0,<LENGTH>
.         LMJ       X11,BGET
.         <RETURN>                      A0 = BUFFER ADDRESS
.
$(1).
BGET*     P         CRIT                INVOKE CRITICAL SECTION LOCK
          ON        TRACE
          TNZ       BTRACE              IS TRACE OUTPUT DESIRED ?
          J         BGTTF               NO.  SKIP EDITING
          SA        A0,TSAVE            SAVE A0
          E$BO      38,T$BGET,12        EDIT PARAMETER
          LA,U      A0,,X11             GET RETURN ADDRESS
          ANA,U     A0,1                BACK IT UP
          E$BO      6,T$BGET,6          EDIT INTO TRACE LINE
          PRINT$    T$BGET,T$LBGET      PRINT THE TRACE
          LA        A0,TSAVE            RELOAD A0
BGTTF     .
          OFF       TRACE
          DS        A1,SVA1             SAVE A1, A2
          ON        STATS
          LA        A1,GETCALL          LOAD NUMBER OF BGET CALLS
          AA,U      A1,1                INCREMENT IT
          SA        A1,GETCALL          UPDATE CALLS ON BGET SO FAR
          OFF       STATS
          ON        CHECK**(MAXSIZ>0)
          TG,U      A0,MAXSIZ           IS USER REQUEST WITHIN RANGE ?
          KABONG    1                   NO.  ERROR CODE 1
          OFF       CHECK**(MAXSIZ>0)
          LNA,U     A0,NCWIU,A0         A0 = -(ACTUAL LENGTH NEEDED)
          ON        STATS
          ANU       A0,INUSE            A1 = -(TOTAL WORDS ALLOCATED)
          SNA       A1,INUSE            UPDATE INUSE COUNT
          TLE       A1,MAXUSE           IS IT A NEW HIGH (LOW)
          SA        A1,MAXUSE           YES.  UPDATE MAX USE
          OFF       STATS
BGET0     LA,U      A2,HEAD             POINT TO HEAD OF FREE BLOCKS
BGET1     LA        A2,FL,A2            LINK TO NEXT BLOCK
          TNE,U     A2,HEAD             DOES THAT BRING US BACK HOME ?
          ON        EXPINC>0
          J         MT                  YES.  NEED MORE CORE TO SATISFY REQUEST
          OFF       EXPINC>0
          ON        EXPINC=0
          KABONG    4                   NO MORE CORE.  FATAL ERROR
          OFF       EXPINC=0
          AU        A0,SIZE,A2          IS THIS BLOCK BIG ENOUGH ?
          JN        A1,BGET1            NO.  LOOK AT NEXT ONE
          TLE,U     A1,MIN              CAN WE SPLIT THIS BLOCK ?
          J         BGET3               NO.  JUST REMOVE THE WHOLE THING
.                                       OTHERWISE, TAKE THE SECOND PART
.                                       AND LEAVE THE FIRST PART ON THE FREELIST
          SA        A1,SIZE,A2          UPDATE SIZE REMAINING
          AA,U      A1,,A2              POINT TO PART TO BE GIVEN TO USER
          SA        A2,HL,A1            POINT BACK TO PREVIOUS BUFFER
BGET2     SA        A0,SIZE,A1          STORE SIZE, MARKING IN USE
          ANU,XU    A1,,A0              COMPUTE NEXT BUFFER ADDRESS
          SZ        HL,A2               MARK THIS BUFFER IN USE
          SX        X11,ARQ,A1          SAVE REQUESTOR'S ADDRESS
          LA,U      A0,NCWIU,A1         PASS BACK ADDRESS TO USER
          DL        A1,SVA1             RESTORE REGISTERS
          ON        TRACE
          TNZ       BTRACE              TRACING REQUESTS ?
          J         BGTTF1              NO.  SKIP THIS
          SA        A0,TSAVE            SAVE A0
          E$BO      38,T$BGET1,12       EDIT ADDRESS RETURNED
          PRINT$    T$BGET1,T$LBGET1    PRINT TRACE LINE
          LA        A0,TSAVE            RELOAD A0
BGTTF1    .
          OFF       TRACE
          V         CRIT                CLEAR CRITICAL SECTION
          J         0,X11               RETURN TO CALLING SEQUENCE
.
BGET3     LA        A0,FL,A2            LOAD FORWARD LINK IN BLOCK
          LA        A1,BL,A2            LOAD BACKWARD LINK
          SA        A0,FL,A1            PUT FORWARD LINK IN LAST BLOCK
          SA        A1,BL,A0            PUT BACKWARD LINK IN NEXT BLOCK
          LNA       A0,SIZE,A2          LOAD -(ACTUAL BLOCK SIZE)
          LA,U      A1,,A2              GET BUFFER ADDRESS IN A1
          J         BGET2               JOIN RETURN TO USER CODE
.
.         ACQUIRE AN EXPANSION BLOCK
.
          ON        EXPINC>0
MT        .
          SA        A0,SVLEN            SAVE USER LENGTH REQUEST
          ON        BOUNDED
          LMA       A0,A0               LOAD POSITIVE LENGTH REQUESTED
          TLE,U     A0,EXPINC           IS USER REQUEST > EXPANSION SIZE ?
          OFF       BOUNDED
          LA,U      A0,EXPINC           LOAD SIZE OF EXPANSION BLOCK
          ON        TRACE
          TNZ       BTRACE              TRACE REQUESTS ?
          J         MTTRC               NO.  SKIP LOGGING
          E$BO      16,T$RQST,6         LOG REQUEST
          SA        A0,TSAVE            SAVE A0 OVER TRACE
          PRINT$    T$RQST,T$LRQST      PRINT THE MESSAGE
          LA        A0,TSAVE            RELOAD A0
MTTRC     .
          OFF       TRACE
          LNA,U     A2,,A0              LOAD -(BUFFER LENGTH)
          LXI,U     A2                  CLEAR H1 OF A2, FORMING END BARRIER
          AU        A0,LASTD            COMPUTE HIGHEST ADDRESS NEEDED
          DSC       A0,36               SWAP A0, A1
          LXI,U     A0,0200000          EXPAND FOR ENTIRE PROGRAM
          MCORE$    .                   OBTAIN THE CORE
          SA        A2,,A0              PUT AT END OF EXPANSION BLOCK
          AA,U      A0,1                COMPUTE NEXT WORD TO REQUEST
          SA        A0,LASTD            UPDATE END-OF-CORE WORD
          ANA,U     A0,1,A1             A0 = START OF NEW BUFFER AREA
          SA        A1,SIZE,A0          SAVE SIZE OF BUFFER IN BUFFER
          LA,U      A1,HEAD             GET ADDRESS OF HEAD OF CHAIN
          SA        A1,BL,A0            SET UP BACK LINK OF NEW BUFFER
          LA        A1,HEAD+FL          GET FIRST BUFFER IN CHAIN
          SA        A1,FL,A0            LINK TO NEW ONE
          SA        A0,BL,A1            POINT OLD ONE TO THIS ONE
          SZ        HL,A0               DON'T ALLOW RECOMBINATION
          SA        A0,HEAD+FL          CHAIN THIS ONE TO THE HEAD
          LA        A0,SVLEN            RELOAD LENGTH OF BUFFER
          J         BGET0               CONTINUE
          OFF       EXPINC>0
/.
.
.         RELEASE CORE BLOCK
.
.         LA,U      A0,<ADDRESS>
.         LMJ       X11,BREL
.         <RETURN>                      X11, A0 DESTROYED
.
BREL*     ANA,U     A0,NCWIU            POINT TO ACTUAL BUFFER START
          LXI,U     X11,,X11            SAVE RETURN POINT
          P         CRIT                INVOKE CRITICAL SECTION
          ON        TRACE
          TNZ       BTRACE              TRACING REQUESTS ?
          J         BRLTF               NO.  SKIP THIS EDITING
          SA        A0,TSAVE            SAVE A0
          AA,U      A0,NCWIU            COMPUTE USER ADDRESS
          E$BO      38,T$BREL,12        EDIT ADDRESS PASSED
          LA,U      A0,,X11             GET RETURN ADDRESS
          ANA,U     A0,1                BACK IT UP
          E$BO      6,T$BREL,6          EDIT IT INTO THE TRACE
          PRINT$    T$BREL,T$LBREL      PRINT TRACE
          LA        A0,TSAVE            RELOAD A0
BRLTF     .
          OFF       TRACE
          DS        A1,SVA1             SAVE A1, A2
          ON        CHECK
          TN        SIZE,A0             IS IT IN USE ?
          KABONG    2                   NO.  RELEASE OF UNALLOCATED BUFFER
          OFF       CHECK
          ON        STATS
          LA        A1,RELCALL          LOAD NUMBER OF BREL CALLS
          AA,U      A1,1                INCREMENT IT
          SA        A1,RELCALL          UPDATE TOTAL BREL CALLS
          LA        A1,INUSE            LOAD NUMBER OF WORDS IN USE
          AA        A1,SIZE,A0          COMPUTE NEW TOTAL
          SA        A1,INUSE            UPDATE THE TOTAL
          OFF       STATS
          LA        A2,HL,A0            IS PREVIOUS BLOCK IN USE ?
          JNZ       A2,BRL1             NO.  A2 POINTS TO PREVIOUS BLOCK
.                                       CHAIN TO AVAILABLE LIST
          LA,U      A2,HEAD             GET HEAD OF CHAIN
          SA        A2,BL,A0            CHAIN NEW BLOCK TO HEAD
          LA        A2,HEAD+FL          GET FIRST AVAILABLE
          SA        A2,FL,A0            CHAIN TO THIS BLOCK
          SA        A0,HEAD+FL          THIS BUFFER IS NOW FIRST
          SA        A0,BL,A2            MAKE OLD FIRST BUFFER POINT TO THIS ONE
          LA,U      A2,,A0              LOAD ADDRESS OF BLOCK BEING RETURNED
BRL1      ANU       A0,SIZE,A0          POINT TO NEXT BLOCK
          ON        CHECK
          TZ        HL,A1               IS BLOCK MARKED IN USE ?
          KABONG    3                   YES.  BAD NEXT BUFFER LINK
          OFF       CHECK
          TP        SIZE,A1             IS NEXT BLOCK AVAILABLE ?
          J         BRL2                NO.  CANNOT COMBINE IT
.                                       REMOVE NEXT BLOCK FROM FREE LIST
          LXM       X11,FL,A1           GET FORWARD LINK OF NEXT BLOCK
          LA        A0,BL,A1            ...AND BACKWARD LINK
          SX        X11,FL,A0           UPDATE FORWARD LINK OF PREVIOUS BUFFER
          SA        A0,BL,X11           UPDATE BACKWARD LINK OF NEXT BUFFER
          AA        A1,SIZE,A1          POINT TO NEXT BLOCK IN CORE
BRL2      SA        A2,HL,A1            POINT NEXT BLOCK
          ANA,U     A1,,A2              COMPUTE TOTAL LENGTH
          SA        A1,SIZE,A2          STORE SIZE, MARKING AVAILABLE
          ON        CORREL**(MANREL=0)
BRL5      AA,U      A1,1,A2             A1 = END OF BUFFER+1
          TNE       A1,LASTD            IS THIS THE END OF CORE ?
          J         BRL3                YES.  THINK ABOUT LCORE$ POSSIBILITIES
          OFF       CORREL**(MANREL=0)
BRL4      DL        A1,SVA1             RESTORE REGISTERS
          V         CRIT                CLEAR CRITICAL SECTION
          LA        A0,X11              GET BACK RETURN POINT
          SSL       A0,18               MOVE RETURN TO MODIFIER
          J         0,A0                RETURN
.
.         RELEASE FREE EXPANSION BLOCKS
.
          ON        CORREL
BRL3      ANA,U     A1,1                POINT TO FINAL (BARRIER) WORD
          LMA,XH2   A0,,A1              LOAD SIZE SENTINEL
          TE        A0,SIZE,A2          IS THE WHOLE BLOCK FREE ?
          J         BRL4                NO.  SKIP THIS STUFF
          ON        TRACE
          TNZ       BTRACE              TRACING REQUESTS ?
          J         BRL3T               NO.  SKIP LCORE LOGGING
          E$BO      15,T$RTRN,6         EDIT WORDS RELEASED
          PRINT$    T$RTRN,T$LRTRN      PRINT LOGGING MESSAGE
BRL3T     .
          OFF       TRACE
.                                       UNCHAIN FROM FREE LIST
          LA        A0,FL,A2            LOAD POINTER TO NEXT BUFFER
          LX        A1,BL,A2            LOAD POINTER TO LAST BUFFER
          SA        A0,FL,A1            CHAIN NEXT TO LAST
          SX        A1,BL,A0            CHAIN LAST TO NEXT
          SA        A2,LASTD            UPDATE NEXT FREE WORD
          LA,U      A0,,A2              LOAD TOP OF CORE
          ANA,U     A0,1                PARAMETER IS HIGHEST WORD NEEDED
          LXI,U     A0,0200000          SET FOR PROGRAM-WIDE RELEASE
          LCORE$    .                   RELEASE UNUSED CORE
          LXI,U     A0                  CLEAR PROGRAM-WIDE FLAG
          TLE,U     A0,LASTD$+1         ARE WE STILL EXPANDED ?
          J         BRL4                RETURN
          LA,XH2    A1,,A0              YES.  LOAD LENGTH FROM THIS BARRIER
          AU,U      A1,,A0              A2 = ADDRESS OF LAST BUFFER HEAD
          LA        A1,SIZE,A2          LOAD SIZE OF THAT BUFFER
          JN        A1,BRL4             DONE WITH CONTRACTION OF THIS ONE BUSY
          ON        MANREL
          AA,U      A1,1,A2             COMPUTE END OF BUFFER + 1 ADDRESS
          TNE       A1,LASTD            DOES THIS BUFFER ABUT THE END OF MEMORY?
          J         BRL3                YES.  INVESTIGATE LCORE$
          J         BRL4                NO.  NO FURTHER RELEASE POSSIBLE
          OFF       MANREL
          ON        MANREL=0
          J         BRL5                CHECK FOR FURTHER RELEASES
          OFF       MANREL=0
          OFF       CORREL
/.
.
.         RELEASE ANY AVAILABLE EXPANSION BUFFERS
.
.         LMJ       X11,BRELC
.         <RETURN>                      X11, A0 DESTROYED
.
.         IF THE CONFIGURATION TAGS MANUAL AND LCORE ARE SET, THIS CODE WILL
.         BE ENABLED TO PERMIT THE RELEASE OF EXPANSION BLOCKS AT ANY
.         TIME DESIRED BY THE CALLING PROGRAM.
.
          ON        MANREL
BRELC*    LXI,U     X11,,X11            SAVE ENTRY ADDRESS
          P         CRIT                INVOKE CRITICAL SECTION LOCK
          DS        A1,SVA1             SAVE A1, A2
          LA        A1,LASTD            LOAD LAST ALLOCATED ADDRESS + 1
          TLE,U     A1,LASTD$+1         ARE WE EXPANDED CURRENTLY ?
          J         BRL4                NO.  DON'T NEED TO RELEASE
          LA,U      A2,HEAD             LOAD ADDRESS OF BUFFER CHAIN HEAD
BRC1      LA        A2,FL,A2            CHAIN TO NEXT AVAILABLE BUFFER
          TNE,U     A2,HEAD             END OF CHAIN AND NO FIND ?
          J         BRL4                YES.  RETURN HAVING DONE NOTHING
          LA        A1,SIZE,A2          LOAD SIZE OF THIS BUFFER
          JN        A1,BRC1             IGNORE IT IF IT'S ALLOCATED
          AA,U      A1,1,A2             COMPUTE FIRST WORD AFTER THIS BUFFER
          TE        A1,LASTD            IS IT LAST WORD ALLOCATED ?
          J         BRC1                NO.  THIS BUFFER DOES NOT ADJOIN END
          J         BRL3                YES.  THIS BUFFER IS AT END AND AVAIL
.                                       GO ENTER RELEASE CODE
          OFF       MANREL
/.
.
.         STATISTICS EDITOR
.
.         LMJ       X11,BSTATP
.         <RETURN>                      NO REGISTERS CHANGED
.
          ON        STATS
BSTATP*   P         CRIT                SET CRITICAL SECTION
          SA        A0,SVA1             SAVE A0
          LA        A0,GETCALL          LOAD NUMBER OF BGET CALLS
          E$BO      8,STATMS,8          EDIT INTO MESSAGE
          LA        A0,RELCALL          GET NUMBER OF REL CALLS
          E$BO      29,STATMS,8         AND PUT IT INTO THE MESSAGE
          LA        A0,INUSE            LOAD NUMBER OF WORDS IN USE
          E$BO      48,STATMS,6         EDIT WORDS IN USE
          LNA       A0,MAXUSE           LOAD MAXIMUM WORDS IN USE
          E$BO      89,STATMS,6         EDIT THAT
          PRINT$    STATMS,STATMSL      PRINT THE CURRENT STATISTICS
          LA        A0,SVA1             LOAD UP USER'S A0
          V         CRIT                CLEAR CRITICAL SECTION
          J         0,X11               RETURN TO CALL
          OFF       STATS
/.
.
.         ERROR AND TRACE HANDLER
.
          ON        ERRLEV>1
KABTRAP   LMJ       A2,$+1              SAVE ADDRESS TRAPPED
          ANA,U     A2,1                BACK UP TO EX INSTRUCTION
          LA,H1     A2,,A2              RECOVER ERROR CODE
          LSSL      A2,18+10            SHIFT OFF F, J
          SSL       A2,18+10+4          SHIFT OFF X, RIGHT JUSTIFY
          LXI,U     A0,,A2              SAVE ERROR CODE FOR USER
          TE,U      A2,2                ERROR DETECTED FROM BREL ?
          TNE,U     A2,3                ...BREL ?
          J         KABNG1              YES.  MUST CONVERT X11 TO USER RETURN
          ON        EXPINC=0
          TNE,U     A2,4                WAS IT NO MORE CORE ERROR ?
          LNA,XU    A0,NCWIU,A0         YES.  CONVERT A0 TO USER PARAMETER
          LXI,U     A0,,A2              RESTORE ERROR CODE IN H1
          OFF       EXPINC=0
KABNG2    .
          ON        ERRLEV>2
          E$BO      41,REGM,6           EDIT A0 CONTENTS INTO MESSAGE
          LXM,U     A0,,X11             GET RETURN ADDRESS
          E$BO      22,REGM,6           EDIT IT INTO THE MESSAGE
          SSL       A0,18               RIGHT JUSTIFY ERROR NUMBER
          OFF       ERRLEV>2
          ON        ERRLEV=3
          E$BO      15,ERCM,3           EDIT ERROR NUMBER
          OFF       ERRLEV=3
          ON        ERRLEV=4
          PRINT$P   ERRMT-1,A0          PRINT THE MESSAGE
          OFF       ERRLEV=4
          ON        ERRLEV>2
          PRINT$    DIAGM,DIAGL         PRINT REGISTER CONTENTS
          OFF       ERRLEV>2
          EABT$     .                   TERMINATE RUN
.
KABNG1    SX        X11,ERRTMP          SAVE X11
          LX,H1     X11,ERRTMP          RELOAD RETURN ADDRESS
          J         KABNG2              RETURN TO ERROR ROUTINE
          OFF       ERRLEV>1
.
$(2).
          ON        ERRLEV>2
DIAGM     .
          ON        ERRLEV=3
ERCM      'ERROR CODE: 999'
          OFF       ERRLEV=3
REGM      'RETURN ADDRESS: 999999  PARAMETER: 999999'
DIAGL     EQU       $-DIAGM
          OFF       ERRLEV>2
          ON        ERRLEV=4
ERRM1     'SIZE REQUESTED EXCEEDS MAXIMUM BUFFER SIZE'
ERRL1     EQU       $-ERRM1
ERRM2     'ADDRESS PASSED TO BREL IS NOT AN ALLOCATED BUFFER'
ERRL2     EQU       $-ERRM2
ERRM3     'BREL ERROR:  NEXT BUFFER BACKPOINTER IS BAD.'
ERRL3     EQU       $-ERRM3
ERRM4     'INSUFFICIENT CORE TO SATISFY REQUEST'
ERRL4     EQU       $-ERRM4
PF        FORM      12,6,18
ERRMT     .
          PF        1,ERRL1,ERRM1
          PF        1,ERRL2,ERRM2
          PF        1,ERRL3,ERRM3
          PF        1,ERRL4,ERRM4
          OFF       ERRLEV=4
          ON        ERRLEV>1
ERRTMP    RES       1
          OFF       ERRLEV>1
          ON        TRACE
TSAVE     RES       1                   TRACE REGISTER SAVE
BTRACE*   *         0                   TRACE CONTROL WORD
T$BGET    '999999  LMJ  X11,BGET  A0=999999999999'
T$LBGET   EQU                           $-T$BGET
T$BGET1   '      BUFFER ALLOCATED AT 999999999999'
T$LBGET1  EQU                           $-T$BGET1
T$BREL    '999999  LMJ  X11,BREL  A0=999999999999'
T$LBREL   EQU                           $-T$BREL
          ON        EXPINC>0
T$RQST    'REQUESTED 999999 WORDS VIA MCORE$.'
T$LRQST   EQU       $-T$RQST
          OFF       EXPINC>0
          ON        CORREL
T$RTRN    'RELEASED 999999 WORDS VIA LCORE$.'
T$LRTRN   EQU       $-T$RTRN
          OFF       CORREL
          OFF       TRACE
.
          ON        STATS
STATMS    .
          '99999999 BGET CALLS, 99999999 BREL CALLS, '
          '999999 WORDS IN USE, MAXIMUM USE SO FAR: 999999.'
STATMSL   EQU       $-STATMS
          OFF       STATS
.
.         OCTAL EDITOR FOR TRACE AND ERROR MESSAGES
.
          ON        EDITOR
EBO$      I$        .
          J         $(1)                ENTER REENTRANT IBANK
$(1)      DS        A0,SA0
          DS        A2,SA2
          SR        R1,VR1
          SR        R2,VR2
          LA,H1     A2,*EBO$
          AND,U     A2,077
          LA,U      A2,0
          AA,H2     A2,*EBO$
          LXI,U     A2,-1               SET UP WORD INCREMENT
          LXI,U     A3,-1               SET UP CHARACTER INCREMENT
          LR,U      R2,-7               INITIALISE MASK FOR MLU
          LR,S1     R1,*EBO$
          J         EBO2
EBO1      MLU,U     A0,'0'
          EX        STORE,*A3
          SSL       A0,3
EBO2      JGD       R1,EBO1
LEAVE     DL        A0,SA0
          LA,H2     A2,EBO$             LOAD PARAMETER ADDRESS
          AA,U      A2,1                POINT TO NEXT INSTRUCTION
          SA,H2     A2,EBO$             SET UP FOR INDIRECT RETURN
          DL        A2,SA2
          LR        R1,VR1
          LR        R2,VR2
          J         *EBO$               RETURN
STORE     LMJ       A3,STORE1
          SA,S2     A1,,A2
          SA,S3     A1,,A2
          SA,S4     A1,,A2
          SA,S5     A1,,A2
          SA,S6     A1,,A2
STORE1    SA,S1     A1,,*A2
          LA,U      A1,,A3
          LXM,U     A3,5
          J         0,A1
$(2).
VR1       RES       1
VR2       RES       1
SA0       RES       2
SA2       RES       2
          OFF       EDITOR
          END