Today's portable C implementation of BGET is a direct descendent of this version, written in UNIVAC 1108 assembly language as part of the FANG file and tape utility. Here, for your amusement (or in case you happen to have a UNIVAC mainframe in your basement), is the program which begat BGET. As of the summer of 1996, twenty-four years after this code was written, programs incorporating it, without modification, are still in use on Unisys mainframes descended from the UNIVAC 1100 series.
. . 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