* $Source: /commtar/monoBANK/RTS/tKchunk.a,v $ * $Revision: 1.10 $ $Date: 88/02/28 22:26:20 $ $Author: callen $ PUNCH ' ALIAS GETMEM,FREEMEM,##GETM,##FREEM' #TKCHUNK ADASTART 'CICS storage allocation routines for PAA', X CICS=NO does NOT do CICS calls *********************************************************************** * * * This module is used to allocate and free space in the * * CICS Program Allocation Area (PAA). The PAA is used to * * satisfy: * * * * - all heap requests * * - stack requests for unrestricted tasks * * * * The Ada specs for these routines are: * * * * procedure Allocate ( * * Number_Of_SUs_Requested : in Natural; * * Number_Of_SUs_Returned : out Natural; * * Where : out Address); * * * * pragma Interface(AIE_Assembler, Allocate, "getmem"); * * * * procedure Free ( * * Size_in_SUs : in Natural; * * Where : in Address); * * * * pragma Interface(AIE_Assembler, Free, "freemem"); * * * * In addition to the Ada-callable interface, the allocate * * and free routines can be called directly from assembler. * * This makes life easier in the stack routines. * * * * The PAA is referenced thru a small CSECT called the * * PAA header. This header contains the remaining free * * space in the PAA, pointers to free lists, and the address * * of the remaining free space. * * * *********************************************************************** EJECT CHUNK EQU 4096 chunk size ENTRY ##GETM,##FREEM for assembler callers GETMEM ADAENTRY 0,GETRET LA R11,ALLOCATE point to the allocate routine BALR R10,R11 call the routine STM R5,R6,PR2STO save amount and where GETRET ADARTN , return to caller SPACE FREEMEM ADAENTRY 0,FREERET LA R11,FREE point to the free routine BALR R10,R11 call the routine FREERET ADARTN , return to caller DROP EJECT *********************************************************************** * * * These stubs provide the assembler interface to the * * PAA routines. The calling sequences are: * * * * ##GETM: * * * * L R0,=A(amount of storage wanted) * * L R15,=V(##GETM) * * BALR R14,R15 call PAA allocate * * * R15 = amount obtained * * * R1 = address of storage * * * * ##FREEM: * * L R0,=A(amount being returned) * * L R1,=A(storage) * * L R15,=V(##FREEM) * * BALR R14,R15 call PAA deallocate * * * * * *********************************************************************** SPACE ##GETM DS 0H USING *,R15 addressability STM R4,R11,REGSAVEA save registers used LA R11,ALLOCATE point to allocate routine LR R4,R0 copy desired amount to R4 BALR R10,R11 call routine LR R1,R6 copy pointer to storage to R1 LR R0,R5 copy amount actually gotten LM R4,R11,REGSAVEA restore registers LR R15,R0 restore amount gotten BR R14 return to caller DROP R15 SPACE ##FREEM DS 0H USING *,R15 addressability STM R4,R11,REGSAVEA save registers used LA R11,FREE point to free routine LR R4,R0 copy amount freed to R4 LR R5,R1 copy address of storage to R5 BALR R10,R11 call routine LM R4,R11,REGSAVEA restore registers BR R14 return to caller DROP R15 REGSAVEA DS 8A register save area EJECT *********************************************************************** * * * This subroutine actually does the storage allocation. * * It presumes that the caller has saved and will restore * * registers as required. * * * * Register usage: * * * * R13 -> Ada global area * * R11 = address of this routine (used as base register) * * R10 = return address * * R4 = amount of space wanted * * R5 = amount of space actually allocated (on return) * * R6 -> space allocated (on return) * * R7 -> PAA header * * R8-R9 used as work registers * * * *********************************************************************** ALLOCATE DS 0H USING ALLOCATE,R11 establish addressability ICM R7,B'1111',=V(#RTS$PAH) get PAA header address BNZ PAAOK if non-zero, proceed * * If PAA address is not resolved then something is seriously * screwed up. We should ultimately raise an exception; for * now, just generate a unique program interrupt. * EX 0,* generate "execute" exception PAAOK DS 0H USING PAAHDR,R7 map the PAA header LTR R5,R4 copy amount wanted to R5 BNZ ROUNDUP if non-zero, round up * if zero, request is no good ALLOFAIL DS 0H come here on failures SR R5,R5 set amount allocated to zero LR R6,R5 null out pointer to storage BR R10 return to caller * ROUNDUP DS 0H LA R5,CHUNK-1(,R5) add chunksize-1 to amount N R5,=A(-CHUNK) clear out garbage bits * R5 = amount to allocate C R5,=A(CHUNK) exactly chunk size? BNE USEBIG if not, try big list * * Desired amount is exactly the chunk size; see if there * are any chunks on the exact size list, and use the first * one if there are some. * ICM R6,B'1111',PAAEXACT get address of first chunk BZ USEBIG if none, try big list USING ELEMENT,R6 map the element L R8,ELENEXT get pointer to next block ST R8,PAAEXACT save in PAA header B ALLODONE all done DROP R6 SPACE USEBIG DS 0H * * Either request is for more than one chunk or else there are * no single chunks available. Try the "big" chunk list. * L R6,PAABIG get address of first big chunk BIGLOOP DS 0H LTR R6,R6 end of list? BZ USEFREE if so, try free list USING ELEMENT,R6 map the element C R5,ELESIZE is this element big enough? BNH POPOFF if so, pop it off the list L R6,ELENEXT if not, bump to next element B BIGLOOP and try it POPOFF DS 0H * * R6 points to the chunk we will use. Pop this chunk out * of the list. * L R5,ELESIZE get actual size L R8,ELEPREV R8 -> previous element ICM R9,B'1111',ELENEXT R9 -> next element ST R9,ELENEXT-ELEMENT(,R8) update previous "next" BZ ALLODONE if no next, done ST R8,ELEPREV-ELEMENT(,R9) update next "previous" DROP R6 SPACE ALLODONE DS 0H * * We have the space; R5 contains the length and R6 points * to the area. If we want to we could zero the storage at * this point; for now, just return. * BR R10 return to caller SPACE USEFREE DS 0H * * Trying the exact or big lists has failed; see if we have * enough free space left to satisfy the request. * L R8,PAASIZE get the size left in the PAA CR R5,R8 is there enough space left? BH ALLOFAIL if not, request has failed SLR R8,R5 subtract space we need ST R8,PAASIZE save remaining size L R6,PAAFREE get address of free area LR R8,R6 copy to R8 AR R8,R5 add size we took ST R8,PAAFREE adjust free pointer B ALLODONE all done DROP EJECT *********************************************************************** * * * This subroutine actually does the storage de-allocation. * * It presumes that the caller has saved and will restore * * registers as required. * * * * Register usage: * * * * R13 -> Ada global area * * R11 = address of this routine (used as base register) * * R10 = return address * * R4 = amount of space being returned * * R5 -> space to be returned * * R6 -> PAA header * * R7-R9 used as work registers * * * *********************************************************************** FREE DS 0H USING FREE,R11 establish addressability ICM R6,B'1111',=V(#RTS$PAH) get PAA header address BNZ PAAFOK if non-zero, proceed * * If PAA address is not resolved then something is seriously * screwed up. We should ultimately raise an exception; for * now, just generate a unique program interrupt. * EX 0,* generate "execute" exception PAAFOK DS 0H USING PAAHDR,R6 map the PAA header LA R4,CHUNK-1(,R4) add chunksize-1 to amount N R4,=A(-CHUNK) clear out garbage bits * R4 = amount to free C R4,=A(CHUNK) exactly chunk size? BNE RETBIG if not, return to big list * * Return to exact chunk list. * USING ELEMENT,R5 map the element L R7,PAAEXACT get current head of list ST R7,ELENEXT chain to current element ST R5,PAAEXACT update head of list BR R10 return to caller DROP R5 SPACE RETBIG DS 0H * * Return to big chunk list * USING ELEMENT,R5 map the element ST R4,ELESIZE save the size of the chunk ST R6,ELEPREV PAA header is "previous" ICM R7,B'1111',PAABIG point to the first element ST R7,ELENEXT chain to current element ST R5,PAABIG make this new first element DROP R5 BZR R10 if no other elements, done USING ELEMENT,R7 map old first element ST R5,ELEPREV insert new previous BR R10 return to caller DROP EJECT * * These DSECTs describe the PAA header and the free element * header. WARNING: do NOT rearrange the fields, since this * code depends upon the PAABIG and ELENEXT fields being at * the same offset! * PAAHDR DSECT PAASIZE DS F size left in PAA PAABIG DS A -> big chunk list PAAEXACT DS A -> exact (single) chunk list PAAFREE DS A -> free space left PAALEN EQU *-PAAHDR length of PAA header SPACE ELEMENT DSECT ELESIZE DS F size of this chunk ELENEXT DS A -> next free chunk ELEPREV DS A -> previous chunk SPACE ADAPSTAK STKLOCAL EQU * ADAPSTKE ADAUDA ADAGLOBL ADAEND END * $Cprt start$ * * Copyright (C) 1988 by Intermetrics, Inc. * * This material may be used duplicated or disclosed by or for the * U.S. Government pursuant to the copyright license under DAR clause * 7-104.9(a) (May 1981). * * This project was spnsored by the STARS Foundation * Naval Research Laboratory, Washington DC * * $Cprt end$