.TITLE DSA_ROUTINES Dynamic Storage Allocation Routines ; ; Structure of the first block: ; ; +--------------------------------------------------+ ; | Address of first byte beyond block's end | 0 ; +--------------------------------------------------+ ; | Address of next block in area (or zero) | 4 ; +--------------------------------------------------+ ; | Address of first free byte in block | 8 ; +--------------------------------------------------+ ; | Address of memory allocation routine | 12 ; +--------------------------------------------------+ ; | Address of block where next INSERT will occur | 16 ; +--------------------------------------------------+ ; | Address of block at current FETCH point | 20 ; +--------------------------------------------------+ ; | Address of next string to be FETCHed | 24 ; +--------------------------------------------------+ ; | | 28 ; | Data strings; the last string in | ; the block is followed by a zero ; | byte. | ; | | ; +--------------------------------------------------+ ; ; ; Structure of subsequent blocks: ; ; +--------------------------------------------------+ ; | Address of first byte beyond block's end | 0 ; +--------------------------------------------------+ ; | Address of next block in area (or zero) | 4 ; +--------------------------------------------------+ ; | Address of first free byte in block | 8 ; +--------------------------------------------------+ ; | | 12 ; | Data strings; the last string in | ; the block is followed by a zero ; | byte. | ; | | ; +--------------------------------------------------+ ; ; The data strings are stored in the block as 'Counted ASCII Str- ; ings'. Counted ASCII Strings have as their first byte an integer ; giving the length of the string; this length does not count this ; first byte. See the MACRO Reference Manual. ; ; The address in the third longword of each block points to the loc- ; ation of the zero byte in that block. ; ; ; Common /DSA__/ contains three quantities which can be manipulated ; (with care) by applications to achieve more functionality: ; ; BLOCK1 -- Address of the first block in the current area. The ; application can save this value, process another area, ; then restore the value. This allows a subprogram to ; manipulate its own area without affecting the calling ; program. ; ; INSBLK -- Address of the block where the last string was insert- ; ed by DSA_INSERT. See below for its uses. ; ; INSPTR -- Address where the last string was inserted by routine ; DSA_INSERT. If the values of INSBLK and INSPTR are ; saved after an insert is made, this string can later ; be quickly fetched, by storing the saved values into ; the sixth and seventh longwords of the area's first ; block, and then doing a DSA_FETCH. ; .PSECT DSA__,PIC,OVR,GBL,SHR,NOEXE,LONG ; COMMON /DSA__/ BLOCK1: .LONG ; Address of first block in current area INSBLK: .LONG ; Block where last insert was done INSPTR: .LONG ; Address where last insert was done .PSECT $CODE,PIC,CON,SHR,NOWRT,LONG ;; ; SUBROUTINE DSA_INITIALIZE ( block , length [, allocator] ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; This routine must be called before using any other routines of the ; Dynamic Storage Allocation Package. Each call to DSA_INITIALIZE, ; in effect, makes a new area of storage available to the calling ; program. The area is not fixed in size, but automatically expands ; as the calling program places data in the area. By calling ; DSA_INITIALIZE multiple times (with different BLOCK arguments), ; independent multiple areas are created. ; ; The calling routine must provide a block of storage for the DSA ; package to use as the beginning of the area. The name and length ; of this block must be passed to DSA_INITIALIZE as the BLOCK and ; LENGTH arguments. Both arguments are passed by reference. The ; block must be at least 32 bytes long, and is normally much longer. ; ; After routine DSA_INSERT has been called a number of times, and ; this first block has been filled up, the DSA package obtains more ; space for the area. By default, the DSA package obtains the space ; transparently to the caller. However, if the caller needs to have ; control of memory allocation, he/she may provide a subroutine for ; the DSA package to call to perform the allocation. The name of ; this routine is the ALLOCATOR argument (remember to declare this ; name EXTERNAL in the calling routine). This subroutine must have ; two arguments, both passed by reference. The first argument is the ; length of a block of memory which the DSA package can use, and the ; second argument is the address of the block. Typically, this rou- ; tine will call LIB$GET_VM to get the memory. This routine must NOT ; return unless the memory has been successfully allocated. If the ; ALLOCATOR argument isn't supplied, the DSA package uses LIB$GET_VM ; to allocate memory in 8192-byte chunks. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_INITIALIZE, ^M<> MOVL 4(AP), R0 ; R0 = Address of first block in area MOVL @8(AP), R1 ; R1 = Block length, in bytes MOVL R0, BLOCK1 ; Save address of first block ADDL3 R0, R1, (R0) ; Longword 1 of block points to end of block CLRL 4(R0) ; Longword 2 is cleared (points to next block) ADDL3 R0, #28, R1 ; R1 = start of data in first block CLRB (R1) ; Insert zero byte in first block MOVL R1, 8(R0) ; Longword 3 of block points to zero byte MOVL R0, 16(R0) ; Longword 5 points to insert block MOVL R0, 20(R0) ; Longword 6 points to fetch block (this) MOVL R1, 24(R0) ; Longword 7 points to first fetch string CMPL (AP), #3 ; How many arguments supplied? BLSS INIT2 ; Branch if < 3 MOVL 12(AP), 12(R0) ; Longword 4 is address of allocation routine RET ; Return INIT2: MOVAB DSA_ALLOCATE,12(R0) ; Longword 4 is address of default ; allocation routine RET ; Return ; ; SUBROUTINE DSA_ALLOCATE ( length , block ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; This routine is not called by the user; it is the default alloca- ; tion routine used when the ALLOCATOR argument is not supplied on ; the call to DSA_INITIALIZE. This routine simply calls LIB$GET_VM ; requesting allocation of an 8192-byte block. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 25 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_ALLOCATE, ^M<> MOVL #8192, @4(AP) ; Set LENGTH argument to 8192 PUSHL 8(AP) ; ADDRESS is 2nd argument to LIB$GET_VM PUSHL 4(AP) ; LENGTH is 1st argument to LIB$GET_VM CALLS #2, G^LIB$GET_VM ; Call LIB$GET_VM BLBC R0, AERROR ; Branch if LIB$GET_VM got an error RET ; Return AERROR: $EXIT_S R0 ; LIB$GET_VM failed; print diagnostic ; and halt the program. ;; ; SUBROUTINE DSA_INSERT ( string [, block] ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Inserts the character string STRING into a Dynamic Storage Alloc- ; ation area. The STRING argument must be passed by descriptor, and ; the string must be less than 256 bytes long. ; ; If the BLOCK argument is present, the string is inserted into the ; area headed by this block. If this argument is absent, the string ; is inserted into the last area referenced by any DSA routine; in ; either case the area must have been previously initialized by the ; DSA_INITIALIZE routine. ; ; Strings are inserted in the area sequentially. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_INSERT, ^M MOVL 4(AP), R1 ; R1 = Address of string descriptor MOVZWL (R1), R6 ; R6 = Length of string MOVL 4(R1), R7 ; R7 = Address of string CMPL (AP), #1 ; More than one argument supplied? BGTR INSERT2 ; Branch if second argument present MOVL BLOCK1, R8 ; R8 = Address of first block in area INSERT1: MOVL 16(R8), R9 ; R9 = Insert block address MOVL 8(R9), R10 ; R10 = Insert point ADDL3 R10, R6, R1 ; R1 = End address of inserted string INCL R1 ; Allow for new zero byte CMPL R1, (R9) ; Compare R1 with block end address BGEQ NO_SPACE ; Branch if not enough space in block INSERT_IT: MOVQ R9, INSBLK ; Save Insert block address and insert point MOVB R6, (R10)+ ; Put string length as first byte MOVC3 R6, (R7), (R10) ; Copy string into block CLRB (R3) ; Insert zero byte after string MOVL R3, 8(R9) ; Update 'first free byte address' in block RET ; Return NO_SPACE: TSTL 4(R9) ; Is pointer to next block zero? BEQL ALLOCATE ; Branch if no more blocks in area MOVL 4(R9), R9 ; R9 = updated insert block address MOVL R9, 16(R8) ; Update final block address in first block ADDL3 R9, #12, R10 ; R10 = address of insert point CMPL R1, (R9) ; Compare R1 with new block end address BGEQ NO_SPACE ; Branch if not enough space in new block BRB INSERT_IT ; There is space; go do the insert ALLOCATE: MOVQ #0, -(SP) ; Reserve space on stack for two arguments PUSHAL 4(SP) ; ARG2 address (block address) onto stack PUSHAL 4(SP) ; ARG1 address (block length) onto stack CALLS #2, @12(R8) ; Call the allocation routine MOVQ (SP)+, R1 ; R1 = length of block; R2 = address of block MOVL R2, 4(R9) ; Place link pointer in previous block MOVL R2, 16(R8) ; Update final block address in first block CLRL 4(R2) ; Clear link pointer in this block ADDL3 R2, R1, (R2) ; Place end pointer in this block MOVL R2, R9 ; R9 = insert block address ADDL3 R2, #12, R10 ; R10 = address of insert point BRB INSERT_IT ; Now go complete the insert operation INSERT2: MOVL 8(AP), R8 ; R8 = Explicit first block address MOVL R8, BLOCK1 ; Store new first block pointer BRB INSERT1 ; Continue with the insert operation ;; ; SUBROUTINE DSA_FETCH_START [( block )] ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Resets the 'Current Fetch Point' of a Dynamic Storage Allocation ; Area to the first string in the area. the Current Fetch Point is ; the point at which: ; ; * Routine DSA_FETCH will fetch the next string ; ; * Routine DSA_SEARCH will begin its search. ; ; * Routine DSA_REPLACE will replace a string. ; ; If the BLOCK argument is present, the Current Fetch Point of the ; area headed by this block is reset. If this argument is absent, ; the Current Fetch Point of the last area referenced by any DSA ; routine is reset. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_FETCH_START, ^M<> TSTL (AP) ; Are there any arguments? BGTR START2 ; Branch if argument supplied MOVL BLOCK1, R1 ; Use existing first block address START1: MOVL R1, 20(R1) ; Sixth longword = starting fetch block ADDL3 R1, #28, 24(R1) ; Seventh longword = starting fetch addr RET ; Return START2: MOVL 4(AP), R1 ; R1 = new first block address MOVL R1, BLOCK1 ; Store new first block pointer BRB START1 ; Now complete the FETCH_START operation ;; ; LOGICAL FUNCTION DSA_FETCH ( string , length [,block] ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Obtains the next sequential string from a Dynamic Storage Alloca- ; tion area. The string is returned in CHARACTER argument STRING ; and its length is returned in INTEGER*4 argument LENGTH (If the ; data is not really a character string, an EQUIVALENCE statement ; can be used in the calling routine to equivalence STRING with ; other variables). ; ; If the BLOCK argument is present, the string is fetched from the ; area headed by this block. If this argument is absent, the string ; is fetched from the last area referenced by any DSA routine. ; ; The string is fetched from the 'Current Fetch Point' of the area. ; When DSA_INITIALIZE, DSA_FETCH_START, DSA_DEALLOCATE, or DSA_CLEAR ; is called, the Current Fetch Point is set to the first string in ; the area. Each call to DSA_FETCH advances the Current Fetch Point ; by one string until all strings have been fetched. Calls to the ; DSA_SEARCH and DSA_REPLACE routines can change the Current Fetch ; Point; see the descriptions of these routines for details. ; ; The function result is set to .TRUE. unless there were no more ; strings to sequentially fetch, in which case the value .FALSE. is ; returned. Subsequent calls will then continue to return .FALSE. ; until DSA_FETCH_START is called to reset the Current Fetch Point ; or DSA_INSERT is called to add a new string to the area. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_FETCH, ^M CMPL (AP), #2 ; Are there more than two arguments? BGTR FETCH2 ; Branch if third argument supplied MOVL BLOCK1, R8 ; R8 = Address of first block in area FETCH1: MOVQ 20(R8), R9 ; R9 = current fetch block address, ; R10 = current fetch string address MOVE: MOVZBL (R10)+, R6 ; R6 = length of string (zero if e.o.b.) BEQL BLOCK_DONE ; Branch if this block exhausted MOVL 4(AP), R1 ; R1 = string descriptor address MOVC5 R6,(R10),#^A' ',(R1),@4(R1) ; Copy string to ARG1 MOVL R6, @8(AP) ; Copy string length to ARG2 ADDL3 R6, R10, 24(R8) ; Update current fetch string address MOVL #1, R0 ; Return .SUCCESS. as function result RET ; Return BLOCK_DONE: MOVL 4(R9), R9 ; R9 = next fetch block address BEQL NO_MORE ; branch if pointer is zero ADDL3 R9, #12, R10 ; R10 = next fetch string address MOVL R9, 20(R8) ; Update first block fetch block pointer BRB MOVE ; Now go complete the fetch NO_MORE: CLRL R0 ; Return .FAILURE. as function result RET ; Return FETCH2: MOVL 12(AP), R8 ; R8 = explicit first block address MOVL R8, BLOCK1 ; Save new first block address BRB FETCH1 ; Continue with the fetch operation ;; ; SUBROUTINE DSA_CLEAR [( block )] ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Causes a DSA area to be cleared of data. The entire area remains ; allocated, but all of the data it contains is zeroed out. ; ; If the BLOCK argument is present, the area headed by this block is ; cleared. If this argument is absent, the last area referenced by ; any DSA routine is cleared. ; ; After DSA_CLEAR is called for an area, the area can be used again, ; as if it were just inititialized by DSA_INITIALIZE. ; ; Also see routine DSA_DEALLOCATE. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_CLEAR, ^M TSTL (AP) ; Are there any arguments? BGTR CLEAR2 ; Branch if argument supplied MOVL BLOCK1, R6 ; Use existing first block address CLEAR1: ADDL3 R6, #28, R7 ; R1 = start of data in first block MOVL R6, 16(R6) ; Reset pointer to insert block MOVQ R6, 20(R6) ; Reset fetch block and string pointers CLEAR_LOOP: MOVL R7, 8(R6) ; Reset this block's start of data pointer SUBL3 R7, (R6), R2 ; R2 = length of this block's data area MOVC5 #0,(R7),#0,R2,(R7) ; Move zeros into block's whole data area MOVL 4(R6), R6 ; Go to next block, if any BEQL CLEAR_DONE ; Branch if no more blocks ADDL3 R6, #12, R7 ; R1 = start of data in this block BRB CLEAR_LOOP ; Go reset this block CLEAR_DONE: RET ; Return CLEAR2: MOVL 4(AP), R6 ; R0 = new first block address MOVL R6, BLOCK1 ; Store new first block pointer BRB CLEAR1 ; Now complete the clear operation ;; ; SUBROUTINE DSA_DEALLOCATE ( [deallocator] [, block] ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Causes all of the dynamically-allocated blocks of a DSA area to be ; deallocated, and re-initializes the first block. By default (if no ; DEALLOCATOR argument is supplied), DSA_DEALLOCATE calls routine ; LIB$FREE_VM to free each block of the area. Note that LIB$FREE_VM ; can only free blocks which were allocated by routine LIB$GET_VM. ; ; If the DEALLOCATOR argument is present, it is the name of a func- ; tion subprogram provided by the calling program (remember that the ; name must be declared EXTERNAL in the calling routine). This func- ; tion is called iteratively by DSA_DEALLOCATE, once for each block ; to be deallocated. This function must have two arguments, both ; INTEGER*4. The first argument is the length of a block of memory ; which the DSA package wants freed, and the second argument is the ; address of the block. This routine must return a valid VMS status ; value as the function result; if an error or warning status is re- ; turned, DSA_DEALLOCATE will abort the program. ; ; If the BLOCK argument is present, the area headed by this block is ; deallocated. If this argument is absent, the last area referenced ; by any DSA routine is deallocated. To specify the BLOCK argument ; without specifying the DEALLOCATOR argument, use the format: ; ; CALL DSA_DEALLOCATE(,blockname) ; ; ; After DSA_DEALLOCATE is called for an area, the area can be used ; again, as if it were just inititialized by DSA_INITIALIZE. ; ; Also see routine DSA_CLEAR. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_DEALLOCATE, ^M MOVL BLOCK1, R0 ; R0 = default first block address MOVAB G^LIB$FREE_VM, R3 ; R3 = default deallocation routine CASEB (AP), #0, #2 ; Case table for number of arguments CTABLE: .WORD NOARGS-CTABLE .WORD ONEARG-CTABLE .WORD TWOARGS-CTABLE TWOARGS: MOVL 8(AP), R0 ; R0 = new first block address MOVL R0, BLOCK1 ; Store new first block pointer TSTL 4(AP) ; Is first argument null? BEQL NOARGS ; Branch if first argument not supplied MOVL 4(AP), R3 ; R3 = address of deallocation routine BRB NOARGS ; Go perform the deallocation ONEARG: MOVL 4(AP), R3 ; R3 = address of deallocation routine NOARGS: ADDL3 R0, #28, R1 ; R1 = start of data in first block MOVL R0, 16(R0) ; Reset pointer to insert block MOVQ R0, 20(R0) ; Reset fetch block and string pointers MOVL R1, 8(R0) ; Reset first block's start of data pointer CLRB (R1) ; Insert zero byte at start of data location MOVL 4(R0), R0 ; R0 = address of next block (zero if none) BEQL DEALL_DONE ; Branch if no more blocks DEALL_LOOP: MOVL 4(R0), R2 ; R2 = next block's address SUBL3 R0, (R0), R1 ; R1 = length of this block MOVQ R0, -(SP) ; Save R0 and R1 on the stack PUSHAL (SP) ; ARG2 address (length of block) onto stack PUSHAL 8(SP) ; ARG1 address (address of block) onto stack CALLS #2, (R3) ; Call deallocation routine BLBC R0, DERROR ; Branch if deallocation routine failed ADDL2 #8, SP ; Clean up the stack MOVL R2, R0 ; R0 = pointer to next block, if any BNEQ DEALL_LOOP ; Go deallocate this block, if it exists DEALL_DONE: RET ; Return DERROR: $EXIT_S R0 ; Deallocation failed; print diagnostic and ; halt the program ;; ; LOGICAL FUNCTION DSA_SEARCH ( string [, block] ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Searches a Dynamic Storage Allocation area for the next occurence ; of a string whose leftmost part matches the CHARACTER argument ; STRING. The search starts at the 'Current Fetch Point' of the ; area (see routines DSA_FETCH and DSA_FETCH_START for a discussion ; of the Current Fetch Point), and continues sequentially to the end ; of the area. When a match is found, the function result is set to ; logical .TRUE. and the Current Fetch Point is set to point to the ; matched string. If no match is found, the function result is set ; to .FALSE. and the Current Fetch Point is unchanged. ; ; If the BLOCK argument is present, the area headed by this block ; is searched. If this argument is absent, the last area referenced ; by any DSA routine is searched. ; ; Note that if it is desired to search an entire area for ALL match- ; es of a string, a DSA_FETCH must be done after each successful ; call to DSA_SEARCH, to move the Current Fetch Point beyond the ; matched string; otherwise DSA_SEARCH will match on the same string ; on every call. ; ; Note also that if it is necessary to ensure that a string stored ; in an area EXACTLY matches an argument string ENTIRELY, a fetch ; must be done after a match and the length of the fetched string ; checked against the length of the search argument string. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_SEARCH, ^M MOVL 4(AP), R1 ; R1 = Address of string descriptor MOVZWL (R1), R6 ; R6 = Length of string MOVL 4(R1), R7 ; R7 = Address of string CMPL (AP), #1 ; Is there more than one argument? BGTR SEARCH2 ; Branch if second argument supplied MOVL BLOCK1, R8 ; R8 = Address of first block SEARCH1: MOVQ 20(R8), R9 ; R9 = current fetch block address, ; R10 = current fetch string address SLOOP: MOVZBL (R10)+, R11 ; R11 = length of string (zero if block end) BEQL BLOCK_SCANNED ; Branch if this block exhausted CMPB R6, R11 ; Compare lengths of arg and next block string BGTR NEXT ; Skip this block string if arg longer CMPC3 R6, (R7), (R10) ; Compare arg string and block string BNEQ NEXT ; Branch if not equal MOVAB -(R10), 24(R8) ; Update current fetch string address MOVL #1, R0 ; Return .SUCCESS. as function result RET ; Return NEXT: ADDL2 R11, R10 ; R10 updated to point to next string in block BRB SLOOP ; Go continue the search loop BLOCK_SCANNED: MOVL 4(R9), R9 ; R9 = next fetch block address BEQL NO_MATCH ; branch if pointer is zero ADDL3 R9, #12, R10 ; R10 = next fetch string address MOVL R9, 20(R8) ; Update first block fetch block pointer BRB SLOOP ; Go continue the search loop NO_MATCH: CLRL R0 ; Return .FAILURE. as function result RET ; Return SEARCH2: MOVL 8(AP), R8 ; R8 = explicit first block address MOVL R8, BLOCK1 ; Save new first block address BRB SEARCH1 ; Continue with the search operation ;; ; SUBROUTINE DSA_DELETE [(block)] ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Deletes the string at the Current Fetch Point. The string is re- ; moved from the area and the space it used is zeroed out. The Cur- ; rent Fetch Point then points to the next string in the area. ; ; Attempting a deletion when the Current Fetch Point is past the ; last string in the area is not an error; it just ends up being an ; expensive no-operation. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 16 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_DELETE, ^m TSTL (AP) ; Are there any arguments? BGTR DELETE2 ; Branch if argument supplied MOVL BLOCK1, R8 ; R8 = address of first block in area DELETE1: MOVQ 20(R8), R9 ; R9 = current fetch block address, ; R10 = current fetch string address MOVZBL (R10), R1 ; R1 = length of string to delete INCL R1 ; R1 = total length to delete (length byte) SUBL3 R10, (R9), R2 ; R2 = length of block in+after string SUBL3 R1, R2, R3 ; R3 = length of block after string ADDL3 R10, R1, R4 ; R4 = address of block after string SUBL2 R1, 8(R9) ; Update zero byte pointer in block MOVC5 R3,(R4),#0,R2,(R10) ; Delete the string; zero out free area ; If the current fetch point is at the end of the block where the ; deletion took place, advance it to the start of the first subsequent ; block containing any data (so subsequent DELETEs will work). MOVL R9, R1 ; R1 = saved address of current block TSTB (R10) ; Is new fetch point at zero byte? BNEQ FETCHOK ; Branch if not; no adjustment needed TSTL 4(R9) ; Is this the last block in the area? BEQL FETCHOK ; Branch if so; no adjustment possible MLOOP: MOVL 4(R9), R9 ; R9 = possible new fetch block address ADDL3 R9, #12, R10 ; R10 = possible new fetch string address TSTB (R10) ; Is new fetch point at zero byte? BNEQ FETCHUP ; Branch if not; this is the spot we want TSTL 4(R9) ; Is this the last block in the area? BNEQ MLOOP ; Loop if not; continue searching FETCHUP: MOVQ R9, 20(R8) ; Update current fetch point pointers ; If the deletion was made at the INSERT point and the block is now ; empty, move the insert point backwards as far as possible to re- ; duce possible future allocation needs. FETCHOK: CMPL R1, R8 ; Was removal in the first block in the area? BEQL RETURN ; Quit if so; no adjustment possible CMPL R1, 16(R8) ; Was removal in current INSERT block? BNEQ RETURN ; Quit if not; no adjustment possible TSTB 12(R1) ; Is this block now empty? BNEQ RETURN ; Quit if not MOVL R8, R3 ; R3 = candidate for new insert block MOVL R8, R2 ; R2 = current block being examined INSLOOP: MOVL 4(R2), R2 ; R2 = pointer to next block in area BEQL INSUP ; Branch if there are no more blocks TSTB 12(R2) ; Is this next block empty? BEQL INSLOOP ; Loop if so MOVL R2, R3 ; Block may be the new insert block BRB INSLOOP ; Loop until last non-empty block is found INSUP: MOVL R3, 16(R8) ; Update insert block address RETURN: RET ; Return DELETE2: MOVL 4(AP), R8 ; R8 = new first block address MOVL R8, BLOCK1 ; Store new first block pointer BRB DELETE1 ; Now complete the DELETE operation ;; ; LOGICAL FUNCTION DSA_REPLACE ( string [, block] ) ; ; ; This is part of the Dynamic Storage Allocation Package. ; ; Replaces the string at the Current Fetch Point of a Dynamic Stor- ; age Allocation area. See the notes for routine DSA_FETCH for a ; description of the Current Fetch Point. After this routine exe- ; cutes, the Current Fetch Point will point to the next string in ; the area. ; ; The argument STRING, passed by descriptor, is the string to be put ; in the area as the replacement for the current string. The length ; of this string must be exactly the same as the length of the re- ; placed string. ; ; If the replace operation succeeds, a value of .TRUE. is returned ; as the function result. If the operation fails (the lengths of the ; strings are different, or the Current Fetch Point is past the last ; string in the area) a .FALSE. function result is returned. ; ; If the BLOCK argument is present, the string is replaced in the ; area headed by this block. If this argument is absent, the string ; is replaced in the last area referenced by any DSA routine. ; ; .INDEX STORAGE ALLOCATION>> ; ; Alan L. Zirkle Naval Surface Weapons Center ; Code K105 ; 25 Jul 1984 Dahlgren, Virginia 22448 ; .ENTRY DSA_REPLACE, ^M MOVL 4(AP), R0 ; R0 = address of string descriptor MOVZWL (R0), R6 ; R6 = length of string MOVL 4(R0), R7 ; R7 = address of string CMPL (AP), #1 ; More than one argument supplied? BGTR REPLACE2 ; Branch if second argument present MOVL BLOCK1, R8 ; R8 = address of first block in area REPLACE1: MOVQ 20(R8), R0 ; R0 = current fetch block address ; R1 = current fetch point REPLACE3: TSTB (R1) ; Are we at the end of a block? BEQL NEXT_BLOCK ; Branch if at end of block CMPB (R1), R6 ; Is string's length same as string's in area? BNEQ RERROR ; Branch if lengths are not identical MOVC3 R6, (R7), 1(R1) ; Perform the replacement MOVL R3, 24(R8) ; Update the current fetch point MOVL #1, R0 ; Return .SUCCESS. as function result RET ; Return NEXT_BLOCK: MOVL 4(R0), R0 ; R0 = pointer to next block, if any BEQL RERROR ; Quit if there are no more blocks ADDL3 R0, #12, R1 ; R1 = new current fetch point MOVQ R0, 20(R8) ; Update current fetch pointers in first block BRB REPLACE3 ; Go complete the replacement RERROR: CLRL R0 ; Return .FAILURE. as function result RET ; Return REPLACE2: MOVL 8(AP), R8 ; R8 = explicit first block address MOVL R8, BLOCK1 ; Store new first block pointer BRB REPLACE1 ; COntinue with the replace operation .END