diff options
Diffstat (limited to 'sys/memio')
-rw-r--r-- | sys/memio/README | 1 | ||||
-rw-r--r-- | sys/memio/begmem.x | 65 | ||||
-rw-r--r-- | sys/memio/calloc.x | 20 | ||||
-rw-r--r-- | sys/memio/coerce.x | 25 | ||||
-rw-r--r-- | sys/memio/doc/memio.hlp | 308 | ||||
-rw-r--r-- | sys/memio/kmalloc.x | 21 | ||||
-rw-r--r-- | sys/memio/krealloc.x | 103 | ||||
-rw-r--r-- | sys/memio/malloc.x | 24 | ||||
-rw-r--r-- | sys/memio/malloc1.x | 84 | ||||
-rw-r--r-- | sys/memio/mfree.x | 27 | ||||
-rw-r--r-- | sys/memio/mgdptr.x | 34 | ||||
-rw-r--r-- | sys/memio/mgtfwa.x | 27 | ||||
-rw-r--r-- | sys/memio/mkpkg | 24 | ||||
-rw-r--r-- | sys/memio/msvfwa.x | 23 | ||||
-rw-r--r-- | sys/memio/realloc.x | 22 | ||||
-rw-r--r-- | sys/memio/salloc.x | 155 | ||||
-rw-r--r-- | sys/memio/sizeof.x | 12 | ||||
-rw-r--r-- | sys/memio/vmalloc.x | 28 | ||||
-rw-r--r-- | sys/memio/zzdebug.c | 366 | ||||
-rw-r--r-- | sys/memio/zzdebug.x | 86 |
20 files changed, 1455 insertions, 0 deletions
diff --git a/sys/memio/README b/sys/memio/README new file mode 100644 index 00000000..597f1114 --- /dev/null +++ b/sys/memio/README @@ -0,0 +1 @@ +MEMIO -- Memory allocation and management facilities. diff --git a/sys/memio/begmem.x b/sys/memio/begmem.x new file mode 100644 index 00000000..e61f6e1e --- /dev/null +++ b/sys/memio/begmem.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +.help begmem, fixmem +.nf ___________________________________________________________________________ +BEGMEM, FIXMEM -- Try to get/release physical memory for a process. The +actual amount of physical memory available (in chars) is returned. On a +machine with virtual memory, these routines adjust the working set size. + +On any machine, BEGMEM may be used to determine the amount of available +physical memory, to tune algorithms for optimum performance. BEGMEM returns +as its function value the actual working set size of the process after +the adjustment (or the current working set size if "best_size" is zero). +On some systems this represents a soft limit on the actual amount of memory +which can be used; it is a guarantee that at least that much space is +available. Some systems will allow the actual working set to dynamically +exceed this value at runtime if the process pages heavily. The hard limit +on the working set of a process is given by the "max_size" parameter. + +Note that the working set must include space not only for a task specific +data buffers, but also for all other process data buffers and for the text +(instruction space) of the code being executed. There is no easy way to +determine this, hence the application is expected to estimate it. A typical +value for the base text+data size required to execute a program is 150Kb. +.endhelp ______________________________________________________________________ + + +# BEGMEM -- Attempt to the adjust the amount of physical memory allocated +# to a process. Save the old memory size in OLD_SIZE, so that memory may +# later be restored with FIXMEM. The new working set size is returned as +# the function value and the hard limit on the working set size is returned +# in MAX_SIZE. In general, the process can be expected to page, possibly +# heavily, or swap out if the working set size is exceeded. All sizes are +# returned in SPP chars. If BEST_SIZE is zero the working set size is not +# changed, i.e., the current working set parameters are returned. + +int procedure begmem (best_size, old_size, max_size) + +int best_size # desired working set size +int old_size # former working set size +int max_size # max physical memory available to this process + +int new_size + +begin + call zawset (best_size * SZB_CHAR, new_size, old_size, max_size) + new_size = new_size / SZB_CHAR + old_size = old_size / SZB_CHAR + max_size = max_size / SZB_CHAR + + return (new_size) +end + + +# FIXMEM -- Restore the original working set size. + +procedure fixmem (old_size) + +int old_size +int j1, j2, j3 + +begin + call zawset (old_size * SZB_CHAR, j1, j2, j3) +end diff --git a/sys/memio/calloc.x b/sys/memio/calloc.x new file mode 100644 index 00000000..c1b7ffb4 --- /dev/null +++ b/sys/memio/calloc.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CALLOC -- Allocate and zero a block of memory. + +procedure calloc (ubufp, buflen, dtype) + +pointer ubufp # user buffer pointer [OUTPUT] +int buflen # nelements of space required, +int dtype # of this data type + +pointer char_ptr +pointer coerce() +int sizeof() +errchk malloc + +begin + call malloc (ubufp, buflen, dtype) + char_ptr = coerce (ubufp, dtype, TY_CHAR) + call aclrc (Memc[char_ptr], buflen * sizeof (dtype)) +end diff --git a/sys/memio/coerce.x b/sys/memio/coerce.x new file mode 100644 index 00000000..7d42f3bf --- /dev/null +++ b/sys/memio/coerce.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# COERCE -- Coerce a pointer from one datatype to another, choosing the +# next larger element for t2 in the event that t1 is not aligned with t2. + +pointer procedure coerce (ptr, type1, type2) + +pointer ptr # input pointer +int type1, type2 # from, to data types +int n +pointer p +include <szdtype.inc> + +begin + p = ptr - 1 + if (type1 == TY_CHAR) + return (p / ty_size[type2] + 1) + else if (type2 == TY_CHAR) + return (p * ty_size[type1] + 1) + else { + p = p * ty_size[type1] # ptr to char + n = ty_size[type2] + return (((p + n-1) / n) + 1) + } +end diff --git a/sys/memio/doc/memio.hlp b/sys/memio/doc/memio.hlp new file mode 100644 index 00000000..1bc5c0a0 --- /dev/null +++ b/sys/memio/doc/memio.hlp @@ -0,0 +1,308 @@ +.help memio Feb83 "Dynamic Memory Management Routines" +.sh +Introduction + + The memory management routines manage both a stack and a heap. +Storage for the stack may be fragmented, and chunks of stack storage are +allocated dynamically from the heap as needed. Programs may allocate +heap storage directly if desired, for large or semipermanent buffers. +Stack storage is intended for use with small buffers, where the overhead +of allocating and deallocating space must be kept to a minimum. + + +.ks +.nf +heap routines: + + malloc (ptr, number_of_elements, data_type) + calloc (ptr, number_of_elements, data_type) + realloc (ptr, number_of_elements, data_type) + mfree (ptr, data_type) + + +stack routines: + + salloc (ptr, number_of_elements, data_type) + smark (ptr) + sfree (ptr) +.fi +.ke + + +MALLOC allocates space on the heap. CALLOC does the same, and fills the buffer +with zeroes. REALLOC is used to change the size of a previously allocated +buffer, copying the contents of the buffer if necessary. MFREE frees space +allocated by a prior call to MALLOC, CALLOC, or REALLOC. + +Space is allocated on the stack with SALLOC. SMARK should be called before +SALLOC, to mark the position of the stack pointer. SFREE returns all space +allocated on the stack since the matching call to SMARK. + + +.KS +Example: +.nf + pointer buf, sp + + begin + call smark (sp) + call salloc (buf, SZ_BUF, TY_CHAR) + while (getline (fd, Memc[buf]) != EOF) { + (code to use buffer ...) + } + call sfree (sp) +.fi +.KE + + +These routines will generate an error abort if memory cannot be allocated +for some reason. + +.sh +Heap Management + + Since many operating systems provide heap management facilities, +MALLOC and MFREE consist of little more than calls to Z routines to +allocate and free blocks of memory. The main function of MALLOC is +to convert the physical buffer address returned by the Z routine into +a pointer of the requested type. + +The pointer returned to the calling routine does not point at the beginning +of the physical buffer, but at a location a few bytes into the buffer. +The physical address of the buffer is stored in the buffer, immediately +before the cell pointed to by the pointer returned by MALLOC. The +stored address must be intact when MFREE is later called to deallocate +the buffer, or a "Memory corrupted" error diagnostic will result. + +The Z routines required to manage the heap are the following: + +.KS +.nf + zmget (bufadr, nbytes) + zmrget (bufadr, nbytes) + zmfree (buf_addr) +.fi +.KE + +The "get" routines should return NULL as the buffer address if space +cannot be allocated for some reason. + +.sh +Stack Management + + The heap management routines have quite a bit of overhead associated +with them, which precludes their use in certain applications. In addition, +the heap can be most efficiently managed when it contains few buffers. +The stack provides an efficient mechanism for parceling out small amounts +of storage, which can later all be freed with a single call. + +The main use of the stack is to provide automatic storage for local +arrays in procedures. The preprocessor compiles code which makes calls +to the stack management routines whenever an array is declared with the +storage calls AUTO, or whenever the ALLOC statement is used in a procedure. + + +.KS +.nf + auto char lbuf[SZ_LINE] + real x[n], y[n] + int n + + begin + alloc (x[npix], y[npix]) + + while (getline (fd, lbuf) != EOF) { + ... +.fi +.KE + + +The AUTO storage class and the ALLOC statement are provided in the full +preprocessor, but not in the subset preprocessor. The following subset +preprocessor code is functionally equivalent to the code show above: + + +.KS +.nf + pointer lbuf, x, y, sp + int n, getline() + + begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + n = npix + call salloc (x, n, TY_REAL) + call salloc (y, n, TY_REAL) + + while (getline (fd, Memc[lbuf]) != EOF) { + ... + + call sfree (sp) +.fi +.KE + +.sh +Semicode for Stack Management + + At any given time, the "stack" is a contiguous buffer of a certain size. +Stack overflow is handled by calling MALLOC to allocate another stack segment. +A pointer to the previous stack segment is kept in each new stack segment, +to permit reclamation of stack space. + + + + +.KS +.nf + salloc smark sfree + + + + stack_overflow + + + + malloc realloc mfree + + + + zmget zmrget zmfree + + + + Structure of the Memory Management Routines +.fi +.KE + + + + +.tp 5 +.nf +procedure salloc (bufptr, nelements, data_type) + +bufptr: upon output, contains pointer to the allocated space +nelements: number of elements of space to be allocated +data_type: data type of the elements and of the buffer pointer + +begin + # align stack pointer for the specified data type, + # compute amount of storage to be allocated + + if (data_type == TY_CHAR) + nchars = nelements + else { + sp = sp + mod (sp-1, sizeof(data_type)) + nchars = nelements * sizeof(data_type) + } + + if (sp + nchars > stack_top) # see if room + call stack_overflow (nchars) + + if (data_type == TY_CHAR) # return pointer + bufptr = sp + else + bufptr = (sp-1) / sizeof(data_type) + 1 + + sp = sp + nchars # bump stack ptr + return +end + + + + +.tp 5 +procedure sfree (old_sp) # pop the stack + +begin + # return entire segments until segment containing the old + # stack pointer is reached + + while (old_sp < stack_base || old_sp > stack_top) { + if (this is the first stack segment) + fatal error, invalid value for old_sp + stack_base = old_segment.stack_base + stack_top = old_segment.stack_top + mfree (segment_pointer, TY_CHAR) + segment_pointer = old_segment + } + + sp = old_sp +end + + + + +.tp 5 +procedure smark (old_sp) # save stack pointer + +begin + old_sp = sp +end + + + + +.tp 5 +procedure stack_overflow (nchars_needed) # increase stk size + +begin + # allocate storage for new segment + segment_size = max (SZ_STACK, nchars_needed + SZ_STKHDR) + malloc (new_segment, segment_size, TY_CHAR) + + # initialize header for the new segment + new_segment.old_segment = segment_pointer + new_segment.stack_base = new_segment + SZ_STKHDR + new_segment.stack_top = new_segment + segment_size + + # make new segment the current segment + segment_pointer = new_segment + stack_base = new_segment.stack_base + stack_top = new_segment.stack_top + sp = stack_base +end + + +.fi +The segment header contains fields describing the location and size of +the segment, plus a link pointer to the previous segment in the list. + + +.KS +.nf + struct stack_header { + char *stack_base + char *stack_top + struct stack_header *old_segment + } +.fi +.KE + +.sh +Pointers and Addresses + + Pointers are indices into (one indexed) Fortran arrays. A pointer to +an object of one datatype will in general have a different value than a +pointer to an object of a different datatype, even if the objects are stored +at the same physical address. Pointers have strict alignment requirements, +and it is not always possible to coerce the type of a pointer. For this +reason, the pointers returned by MALLOC and SALLOC are always aligned for +all data types, regardless of the data type requested. + +The IRAF system code must occasionally manipulate and store true physical +addresses, obtained with the function LOC. The problem with physical +addresses is that they are unsigned integers, but Fortran does not provide +any unsigned data types. Thus, comparisons of addresses are difficult +in Fortran. + +A second LOC primitive is provided for use in routines which must compare +addresses. LOCC returns the address of the object passed as argument, +right shifted to the size of a CHAR. Thus, the difference between LOCC(a[1]) +and LOCC(a[n]) is the size of the N element array A in chars. + +The relationship between chars, bytes, and machine addresses is machine +dependent. Bytes seem to be the smallest units. Some machines are byte +addressable, others are word addressable. The size of a CHAR in machine +bytes is given by the constant SZB_CHAR. The size of a machine word in +machine bytes is given by the constant SZB_WORD. diff --git a/sys/memio/kmalloc.x b/sys/memio/kmalloc.x new file mode 100644 index 00000000..7bfc4ee0 --- /dev/null +++ b/sys/memio/kmalloc.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <config.h> + +# KMALLOC -- Allocate space on the heap. Equivalent to MALLOC, except that a +# memory allocation failure is indicated by returning ERR as the function value. + +int procedure kmalloc (ubufp, nelems, dtype) + +pointer ubufp # user buffer pointer (output) +int nelems # number of elements of storage required +int dtype # datatype of the storage elements + +int sz_align, fwa_align +int malloc1() + +begin + sz_align = SZ_MEMALIGN + call zlocva (Memc, fwa_align) + return (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align)) +end diff --git a/sys/memio/krealloc.x b/sys/memio/krealloc.x new file mode 100644 index 00000000..5c6198c8 --- /dev/null +++ b/sys/memio/krealloc.x @@ -0,0 +1,103 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <config.h> +include <syserr.h> + +# KREALLOC -- Change the size of a previously allocated buffer, moving the +# buffer if necessary. If there is no old buffer (NULL pointer) simply +# allocate a new buffer. This routine is equivalent to REALLOC except that it +# merely returns ERR as the function value if an error occurs. +# +# Buffer reallocation or resizing can always be implemented by allocating a new +# buffer, copying the contents of the old buffer to the new buffer, and then +# deleting the old buffer. Nonetheless we use a OS entry point to do the actual +# reallocation, because often it will be possible to change the size of a buffer +# without moving it, particularly when decreasing the size of the buffer. +# +# Allowing the OS to move a buffer causes problems due to the difference in +# alignment criteria imposed by the IRAF pointer scheme, which enforces +# stringent alignment criteria, versus OS memory allocation schemes which +# typically only align on word or longword boundaries. Therefore we must +# check the offset of the data area after reallocation, possibly shifting +# the contents of data area up or down a few chars to reestablish alignment +# with Mem. + +int procedure krealloc (ptr, a_nelems, a_dtype) + +pointer ptr # buffer to be reallocated +int a_nelems # new size of buffer +int a_dtype # buffer datatype + +pointer dataptr +int nelems, dtype, nchars, old_fwa, new_fwa +int char_shift, old_char_offset, new_char_offset +int status, locbuf, loc_Mem + +int mgtfwa(), sizeof(), kmalloc() +pointer mgdptr(), msvfwa(), coerce() +data loc_Mem /NULL/ + +begin + # Copy over the number of elements and the data type in case they are + # located in the block of memory we are reallocating. + + nelems = a_nelems + dtype = a_dtype + + if (ptr == NULL) { + return (kmalloc (ptr, nelems, dtype)) + + } else { + if (dtype == TY_CHAR) + nchars = nelems + 1 + SZ_INT + SZ_MEMALIGN + else + nchars = nelems * sizeof(dtype) + SZ_INT + SZ_MEMALIGN + old_fwa = mgtfwa (ptr, dtype) + new_fwa = old_fwa + + # Change the buffer size; any error is fatal. + call zraloc (new_fwa, nchars * SZB_CHAR, status) + if (status == ERR) { + ptr = NULL + return (ERR) + } + + # Compute the char offset of the old data area within the original + # buffer; zraloc() guarantees that the old data will have the same + # offset in the new buffer. Compute the char offset of the new + # data area. These need not be the same due to the OS allocating + # the new buffer to alignment criteria less than those required + # by MEMIO. + + call zlocva (Memc[coerce(ptr,dtype,TY_CHAR)], locbuf) + old_char_offset = (locbuf - old_fwa) + + # We must compute a pointer to the data area within the new + # buffer before we can compute the char offset of the new data + # area within the new buffer. + + if (loc_Mem == NULL) + call zlocva (Memc, loc_Mem) + + dataptr = mgdptr (new_fwa, TY_CHAR, SZ_MEMALIGN, loc_Mem) + call zlocva (Memc[dataptr], locbuf) + new_char_offset = (locbuf - new_fwa) + + # Shift the old data to satisfy the new alignment criteria, + # if necessary. + + char_shift = (new_char_offset - old_char_offset) + if (char_shift != 0) { + call amovc (Memc[dataptr - char_shift], Memc[dataptr], + nelems * sizeof(dtype)) + } + + # Save the fwa of the OS buffer in the buffer header, and return + # new pointer to user. + + ptr = msvfwa (new_fwa, dtype, SZ_MEMALIGN, loc_Mem) + } + + return (OK) +end diff --git a/sys/memio/malloc.x b/sys/memio/malloc.x new file mode 100644 index 00000000..d5886c36 --- /dev/null +++ b/sys/memio/malloc.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <config.h> + +# MALLOC -- Allocate space on the heap. An array of at least NELEMS elements +# of data type DTYPE is allocated, aligned to SZ_MEMALIGN (the biggest type) +# with the global common Mem. + +procedure malloc (ubufp, nelems, dtype) + +pointer ubufp # user buffer pointer (output) +int nelems # number of elements of storage required +int dtype # datatype of the storage elements + +int sz_align, fwa_align +int malloc1() + +begin + sz_align = SZ_MEMALIGN + call zlocva (Memc, fwa_align) + if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR) + call syserr (SYS_MFULL) +end diff --git a/sys/memio/malloc1.x b/sys/memio/malloc1.x new file mode 100644 index 00000000..33001ff1 --- /dev/null +++ b/sys/memio/malloc1.x @@ -0,0 +1,84 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +.help malloc1 +.nf ------------------------------------------------------------------------- +MEMIO -- Internal data structures. + +If "p" is the pointer returned by malloc, the first element of storage is +referenced by the expression "Mem_[p]", where the underscore is replaced +by the appropriate type suffix. A pointer to an object of one data type +is NOT equivalent to a pointer to another data type, even if both pointers +reference the same physical address. + +The actual physical address of the physical buffer area allocated is stored +in the integer cell immediately preceeding the buffer returned to the user. +If this cell is corrupted, the condition will later be detected, and a fatal +error ("memory corrupted") will result. + +For example, for a machine with a 4 byte integer, the first part of the +buffer area might appear as follows (the first few unused cells may or +may not be needed to satisfy the alignment criteria): + + offset allocation + + 0 start of the physical buffer (from zmaloc) + 1 + 2 + 3 + 4 byte 1 of saved fwa (address of cell 0) + 5 byte 2 " " " + 6 byte 3 " " " + 7 byte 4 " " " + 8 first cell available to user (maximum alignment) + +MALLOC, given the CHAR address of the buffer allocated by the z-routine, +adds space for the saved fwa (an integer), and determines the address of the +next cell which is sufficiently aligned, relative to the Mem common. This +cell marks the start of the user buffer area. The buffer fwa is saved in the +integer location immediately preceding the "first cell". + +MFREE, called with a pointer to the buffer to be returned, fetches the location +of the physical buffer from the save area. If this does not agree with the +buffer pointer, either (1) the buffer pointer is invalid or of the wrong +datatype, or (2), the save area has been overwritten (memory has been +corrupted). If everything checks out, the buffer fwa is passed to a z-routine +to free the physical buffer space. + +TODO: - Add debugging routine to summarize allocated buffer space and + check for buffer overruns (add sentinel at end of buffer). + - Keep track of buffers allocated while a program is running and + return at program termination, like closing open files. +.endhelp --------------------------------------------------------------------- + + +# MALLOC1 -- Low level procedure which does the actual buffer allocation. + +int procedure malloc1 (output_pointer, nelems, dtype, sz_align, fwa_align) + +pointer output_pointer # buffer pointer (output) +int nelems # number of elements of storage required +int dtype # datatype of the storage elements +int sz_align # number of chars of alignment required +int fwa_align # address to which buffer is to be aligned + +int fwa, nchars, status +int sizeof() +pointer msvfwa() + +begin + if (dtype == TY_CHAR) + nchars = nelems + 1 + SZ_INT + sz_align # add space for EOS + else + nchars = nelems * sizeof (dtype) + SZ_INT + sz_align + + call zmaloc (fwa, nchars * SZB_CHAR, status) + + if (status == ERR) + return (ERR) + else { + output_pointer = msvfwa (fwa, dtype, sz_align, fwa_align) + return (OK) + } +end diff --git a/sys/memio/mfree.x b/sys/memio/mfree.x new file mode 100644 index 00000000..f7c83f1d --- /dev/null +++ b/sys/memio/mfree.x @@ -0,0 +1,27 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# MFREE -- Free a previously allocated buffer. If the buffer has already been +# returned (NULL pointer), ignore the request. Once the buffer has been +# returned, the old pointer value is of not useful (and invalid), so set it +# to NULL. + +procedure mfree (ptr, dtype) + +pointer ptr +int fwa, dtype, status +int mgtfwa() +errchk mgtfwa + +begin + if (ptr != NULL) { + fwa = mgtfwa (ptr, dtype) + + call zmfree (fwa, status) + if (status == ERR) + call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted") + + ptr = NULL + } +end diff --git a/sys/memio/mgdptr.x b/sys/memio/mgdptr.x new file mode 100644 index 00000000..4efc628c --- /dev/null +++ b/sys/memio/mgdptr.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# MGDPTR -- Given the fwa of a memory area, compute a pointer to the start +# of the data area which satisfies the desired alignment criteria. Memory +# is allocated in units of chars, and ZLOCVA, ZMALOC, etc., return pointers +# in units of chars. + +pointer procedure mgdptr (fwa, dtype, sz_align, fwa_align) + +int fwa, dtype, sz_align, fwa_align +#long bufadr +int bufadr +pointer bufptr +int modulus, loc_Mem +int sizeof() +data loc_Mem /NULL/ + +begin + # Compute the address of the start of the user buffer area, which + # must be aligned with fwa_align (usually Mem) for all data types. + + if (loc_Mem == NULL) + call zlocva (Memc, loc_Mem) + bufadr = fwa + SZ_INT + + modulus = mod (bufadr - fwa_align, sz_align) + if (modulus != 0) + bufadr = bufadr + (sz_align - modulus) + + # Compute the buffer pointer for the desired datatype. + bufptr = (bufadr - loc_Mem) / sizeof(dtype) + 1 + + return (bufptr) +end diff --git a/sys/memio/mgtfwa.x b/sys/memio/mgtfwa.x new file mode 100644 index 00000000..9b39f6eb --- /dev/null +++ b/sys/memio/mgtfwa.x @@ -0,0 +1,27 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <config.h> +include <mach.h> + +# MGTFWA -- Given a user buffer pointer, retrieve physical address of buffer. +# If physical address of buffer does not seem reasonable, memory has probably +# been overwritten, a fatal error. + +int procedure mgtfwa (ptr, dtype) + +pointer ptr, bufptr +int dtype +int locbuf, fwa +int coerce() + +begin + bufptr = coerce (ptr, dtype, TY_INT) + fwa = Memi[bufptr-1] + call zlocva (Memi[bufptr-1], locbuf) + + if (abs (locbuf - fwa) > SZ_VMEMALIGN) + call sys_panic (SYS_MCORRUPTED, "Memory has been corrupted") + + return (fwa) +end diff --git a/sys/memio/mkpkg b/sys/memio/mkpkg new file mode 100644 index 00000000..c9c86f23 --- /dev/null +++ b/sys/memio/mkpkg @@ -0,0 +1,24 @@ +# Memory i/o (MEMIO) portion of the system library. + +$checkout libsys.a lib$ +$update libsys.a +$checkin libsys.a lib$ +$exit + +libsys.a: + begmem.x <mach.h> + calloc.x + coerce.x <szdtype.inc> + kmalloc.x <config.h> + krealloc.x <config.h> <mach.h> + malloc.x <config.h> + malloc1.x <mach.h> + mfree.x + mgdptr.x + mgtfwa.x <config.h> <mach.h> + msvfwa.x + realloc.x + salloc.x <config.h> <szdtype.inc> + sizeof.x <szdtype.inc> + vmalloc.x <config.h> <mach.h> + ; diff --git a/sys/memio/msvfwa.x b/sys/memio/msvfwa.x new file mode 100644 index 00000000..d5df074d --- /dev/null +++ b/sys/memio/msvfwa.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# MSVFWA -- Determine the buffer address which satisfies the maximum alignment +# criteria, save the buffer fwa in the integer cell immediately preceding +# this, and return a pointer to the user area of the buffer. + +pointer procedure msvfwa (fwa, dtype, sz_align, fwa_align) + +int fwa, dtype, sz_align, fwa_align +pointer bufptr, mgdptr() +int coerce() + +begin + # Compute the pointer to the data area which satisfies the desired + # alignment criteria. Store the fwa of the actual OS allocated buffer + # in the integer cell preceeding the data area. + + bufptr = mgdptr (fwa, TY_INT, sz_align, fwa_align) + Memi[bufptr-1] = fwa + + # Return pointer of type dtype to the first cell of the data area. + return (coerce (bufptr, TY_INT, dtype)) +end diff --git a/sys/memio/realloc.x b/sys/memio/realloc.x new file mode 100644 index 00000000..40229b8f --- /dev/null +++ b/sys/memio/realloc.x @@ -0,0 +1,22 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# REALLOC -- Change the size of a previously allocated buffer, moving the +# buffer if necessary. If there is no old buffer (NULL pointer) simply +# allocate a new buffer. + +procedure realloc (ubufp, nelems, dtype) + +pointer ubufp # buffer to be reallocated +int nelems # new size of buffer +int dtype # buffer datatype + +int krealloc() + +begin + if (krealloc (ubufp, nelems, dtype) == ERR) { + ubufp = NULL + call syserr (SYS_MFULL) + } +end diff --git a/sys/memio/salloc.x b/sys/memio/salloc.x new file mode 100644 index 00000000..34f06217 --- /dev/null +++ b/sys/memio/salloc.x @@ -0,0 +1,155 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <config.h> +include <syserr.h> + +# SALLOC.X -- Stack management routines. Stack storage is allocated in +# segments. Space for each segment is dynamically allocated on the heap. +# Each segment contains a pointer to the previous segment to permit +# reclamation of the space (see "Mem.hlp" for additional details). +# This is a low level facility, hence any failure to allocate or deallocate +# stack storage is fatal. + + +# Segment header structure. The header size parameter SZ_STKHDR is defined +# in <config.h> because it is potentially machine dependent. SZ_STKHDR +# must be chosen such that the maximum alignment criteria is maintained. + +define SH_BASE Memi[$1] # char pointer to base of segment +define SH_TOP Memi[$1+1] # char pointer to top of segment + 1 +define SH_OLDSEG Memi[$1+2] # struct pointer to header of prev.seg. + + +# SALLOC -- Allocate space on the stack. + +procedure salloc (output_pointer, nelem, datatype) + +pointer output_pointer # buffer pointer (output) +int nelem # number of elements of storage required +int datatype # datatype of the storage elements + +int nchars, dtype +include <szdtype.inc> +pointer sp, cur_seg +common /salcom/ sp, cur_seg + +begin + dtype = datatype + if (dtype < 1 || dtype > MAX_DTYPE) + call sys_panic (500, "salloc: bad datatype code") + + # Align stack pointer for any data type. Compute amount of + # storage to be allocated. Always add space for at least one + # extra char for the EOS in case a string is stored in the buffer. + + sp = (sp + SZ_MEMALIGN-1) / SZ_MEMALIGN * SZ_MEMALIGN + 1 + if (dtype == TY_CHAR) + nchars = nelem + 1 # add space for EOS + else + nchars = nelem * ty_size[dtype] + 1 + + # Check for stack overflow, add new segment if out of room. + # Since SMARK must be called before SALLOC, cur_seg cannot be + # null, but we check anyhow. + + if (cur_seg == NULL || sp + nchars >= SH_TOP(cur_seg)) + call stk_mkseg (cur_seg, sp, nchars) + + if (dtype == TY_CHAR) + output_pointer = sp + else + output_pointer = (sp-1) / ty_size[dtype] + 1 + + sp = sp + nchars # bump stack pointer +end + + +# SMARK -- Mark the position of the stack pointer, so that stack space +# can be freed by a subsequent call to SFREE. This routine also performs +# initialization of the stack, since it the very first routine called +# during task startup. + +procedure smark (old_sp) + +pointer old_sp # value of the stack pointer (output) +bool first_time +pointer sp, cur_seg +common /salcom/ sp, cur_seg +data first_time /true/ + +begin + if (first_time) { + sp = NULL + cur_seg = NULL + call stk_mkseg (cur_seg, sp, SZ_STACK) + first_time = false + } + + old_sp = sp +end + + +# SFREE -- Free space on the stack. Return whole segments until segment +# containing the old stack pointer is reached. + +procedure sfree (old_sp) + +pointer old_sp # previous value of the stack pointer + +pointer old_seg +pointer sp, cur_seg +common /salcom/ sp, cur_seg + +begin + # The following is needed to avoid recursion when SFREE is called + # by the IRAF main during processing of SYS_MSSTKUNFL. + + if (cur_seg == NULL) + return + + # If the stack underflows (probably because of an invalid pointer) + # it is a fatal error. + + while (old_sp < SH_BASE(cur_seg) || old_sp > SH_TOP(cur_seg)) { + if (SH_OLDSEG(cur_seg) == NULL) + call sys_panic (SYS_MSSTKUNFL, "Salloc underflow") + + old_seg = SH_OLDSEG(cur_seg) # discard segment + call mfree (cur_seg, TY_STRUCT) + cur_seg = old_seg + } + + sp = old_sp # pop stack +end + + +# STK_MKSEG -- Create and add a new stack segment (link at head of the +# segment list). Called during initialization, and upon stack overflow. + +procedure stk_mkseg (cur_seg, sp, segment_size) + +pointer cur_seg # current segment +pointer sp # salloc stack pointer +int segment_size # size of new stack segment + +int nchars, new_seg +pointer coerce() +int kmalloc() + +begin + # Compute size of new segment, allocate the buffer. + nchars = max (SZ_STACK, segment_size) + SZ_STKHDR + if (kmalloc (new_seg, nchars / SZ_STRUCT, TY_STRUCT) == ERR) + call sys_panic (SYS_MFULL, "Out of memory") + + # Output new stack pointer. + sp = coerce (new_seg, TY_STRUCT, TY_CHAR) + SZ_STKHDR + + # Set up the segment descriptor. + SH_BASE(new_seg) = sp + SH_TOP(new_seg) = sp - SZ_STKHDR + nchars + SH_OLDSEG(new_seg) = cur_seg + + # Make new segment the current segment. + cur_seg = new_seg +end diff --git a/sys/memio/sizeof.x b/sys/memio/sizeof.x new file mode 100644 index 00000000..3b4977fe --- /dev/null +++ b/sys/memio/sizeof.x @@ -0,0 +1,12 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# SIZEOF -- Return the size in chars of one of the fundamental datatypes. + +int procedure sizeof (dtype) + +int dtype +include <szdtype.inc> + +begin + return (ty_size[dtype]) +end diff --git a/sys/memio/vmalloc.x b/sys/memio/vmalloc.x new file mode 100644 index 00000000..25e2de0d --- /dev/null +++ b/sys/memio/vmalloc.x @@ -0,0 +1,28 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <config.h> +include <mach.h> + +# VMALLOC -- Like malloc, but force the buffer to be aligned on a virtual +# memory page boundary. This feature can be used, e.g., in 4.XBSD UNIX +# to "bypass" the system buffer cache (to avoid copying file data from the +# system cache into the file buffer). VMALLOC can be made equivalent to MALLOC +# via the parameters in <config.h>, if the local machine which does not have +# virtual memory. + +procedure vmalloc (ubufp, nelems, dtype) + +pointer ubufp # user buffer pointer (output) +int nelems # number of elements of storage required +int dtype # datatype of the storage elements + +int sz_align, fwa_align +int malloc1() + +begin + sz_align = SZ_VMEMALIGN + fwa_align = VMEM_BASE + if (malloc1 (ubufp, nelems, dtype, sz_align, fwa_align) == ERR) + call syserr (SYS_MFULL) +end diff --git a/sys/memio/zzdebug.c b/sys/memio/zzdebug.c new file mode 100644 index 00000000..35b0f7ad --- /dev/null +++ b/sys/memio/zzdebug.c @@ -0,0 +1,366 @@ +/* zzdebug.x -- translated by f2c (version 20061008). + You must link the resulting object file with libf2c: + on Microsoft Windows system, link with libf2c.lib; + on Linux or Unix systems, link with .../path/to/libf2c.a -lm + or, if you install libf2c.a in a standard place, with -lf2c -lm + -- in that order, at the end of the command line, as in + cc *.o -lf2c -lm + Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., + + http://www.netlib.org/f2c/libf2c.zip +*/ + +#include "f2c.h" + +/* Common Block Declarations */ + +struct { + logical xerflg, xerpad[84]; +} xercom_; + +#define xercom_1 xercom_ + +struct { + doublereal memd[1]; +} mem_; + +#define mem_1 mem_ + +/* Table of constant values */ + +static integer c__4 = 4; +static integer c__1 = 1; +static integer c__0 = 0; +static integer c__2 = 2; +static integer c__1023 = 1023; +static integer c_b46 = 999999999; + +integer sysruk_(task, cmd, rukarf, rukint) +shortint *task, *cmd; +integer *rukarf, *rukint; +{ + /* Initialized data */ + + static shortint dict[14] = { 115,116,97,99,107,0,114,101,97,108,108,111, + 99,0 }; + static shortint st0009[29] = { 105,110,118,97,108,105,100,32,115,101,116, + 32,115,116,97,116,101,109,101,110,116,58,32,39,37,115,39,10,0 }; + static shortint st0010[25] = { 105,110,118,97,108,105,100,32,83,69,84,32, + 105,110,32,73,82,65,70,32,77,97,105,110,0 }; + static integer dp[3] = { 1,7,0 }; + static integer lmarg = 5; + static integer maxch = 0; + static integer ncol = 0; + static integer rukean = 3; + static integer ntasks = 0; + static shortint st0001[9] = { 116,116,121,110,99,111,108,115,0 }; + static shortint st0002[6] = { 99,104,100,105,114,0 }; + static shortint st0003[3] = { 99,100,0 }; + static shortint st0004[6] = { 104,111,109,101,36,0 }; + static shortint st0005[6] = { 72,79,77,69,36,0 }; + static shortint st0006[4] = { 115,101,116,0 }; + static shortint st0007[6] = { 114,101,115,101,116,0 }; + static shortint st0008[2] = { 9,0 }; + + /* System generated locals */ + integer ret_val; + + /* Local variables */ + static integer i__, rmarg; + extern logical streq_(); + extern /* Subroutine */ integer trealc_(); + extern integer envgei_(); + extern /* Subroutine */ integer xfchdr_(), erract_(), eprinf_(), tstack_() + ; + extern integer envscn_(); + extern /* Subroutine */ integer xffluh_(), pargsr_(), envlit_(), syspac_() + , xerpsh_(), strtbl_(); + extern logical xerpop_(); + extern /* Subroutine */ integer zzepro_(); + + /* Parameter adjustments */ + --cmd; + --task; + + /* Function Body */ + if (! (ntasks == 0)) { + goto L110; + } + i__ = 1; +L120: + if (! (dp[i__ - 1] != 0)) { + goto L122; + } +/* L121: */ + ++i__; + goto L120; +L122: + ntasks = i__ - 1; +L110: + if (! (task[1] == 63)) { + goto L130; + } + xerpsh_(); + rmarg = envgei_(st0001); + if (! xerpop_()) { + goto L140; + } + rmarg = 80; +L140: + strtbl_(&c__4, dict, dp, &ntasks, &lmarg, &rmarg, &maxch, &ncol); + ret_val = 0; + goto L100; +L130: + if (! (streq_(&task[1], st0002) || streq_(&task[1], st0003))) { + goto L150; + } + xerpsh_(); + if (! (cmd[*rukarf] == 0)) { + goto L170; + } + xerpsh_(); + xfchdr_(st0004); + if (! xerpop_()) { + goto L180; + } + xfchdr_(st0005); +L180: + goto L171; +L170: + xfchdr_(&cmd[*rukarf]); +L171: +/* L162: */ + if (! xerpop_()) { + goto L160; + } + if (! (*rukint == 1)) { + goto L190; + } + erract_(&rukean); + if (xercom_1.xerflg) { + goto L100; + } + goto L191; +L190: +L191: +L160: + ret_val = 0; + goto L100; +L150: + if (! (streq_(&task[1], st0006) || streq_(&task[1], st0007))) { + goto L200; + } + xerpsh_(); + if (! (cmd[*rukarf] == 0)) { + goto L220; + } + envlit_(&c__4, st0008, &c__1); + xffluh_(&c__4); + goto L221; +L220: + if (! (envscn_(&cmd[1]) <= 0)) { + goto L230; + } + if (! (*rukint == 1)) { + goto L240; + } + eprinf_(st0009); + pargsr_(&cmd[1]); + goto L241; +L240: + goto L91; +L241: +L230: +L221: +/* L212: */ + if (! xerpop_()) { + goto L210; + } + if (! (*rukint == 1)) { + goto L250; + } + erract_(&rukean); + if (xercom_1.xerflg) { + goto L100; + } + goto L251; +L250: +L91: + syspac_(&c__0, st0010); +L251: +L210: + ret_val = 0; + goto L100; +L200: +/* L151: */ +/* L131: */ + if (! streq_(&task[1], &dict[dp[0] - 1])) { + goto L260; + } + tstack_(); + ret_val = 0; + goto L100; +L260: + if (! streq_(&task[1], &dict[dp[1] - 1])) { + goto L270; + } + trealc_(); + ret_val = 0; + goto L100; +L270: + ret_val = -1; + goto L100; +L100: + zzepro_(); + return ret_val; +} /* sysruk_ */ + +/* Subroutine */ integer tstack_() +{ + /* Initialized data */ + + static shortint st0001[12] = { 98,117,102,102,101,114,95,115,105,122,101, + 0 }; + static shortint st0002[28] = { 98,117,102,102,101,114,32,112,111,105,110, + 116,101,114,61,37,100,44,32,115,105,122,101,61,37,100,10,0 }; + + /* Local variables */ + static integer sp; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) +#define memi ((integer *)&mem_1) +#define meml ((integer *)&mem_1) +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) +#define memx ((complex *)&mem_1) + static integer junk; + extern /* Subroutine */ integer pargi_(), sfree_(), smark_(); + extern integer clglpi_(); + static integer bufsie; + extern /* Subroutine */ integer salloc_(), xffluh_(), xprinf_(), zzepro_() + ; + + smark_(&sp); +L110: + if (! (clglpi_(st0001, &bufsie) != -2)) { + goto L111; + } + salloc_(&junk, &bufsie, &c__2); + xprinf_(st0002); + pargi_(&junk); + pargi_(&bufsie); + xffluh_(&c__4); + goto L110; +L111: + sfree_(&sp); +/* L100: */ + zzepro_(); + return 0; +} /* tstack_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + +/* Subroutine */ integer trealc_() +{ + /* Initialized data */ + + static shortint st0001[12] = { 97,98,99,100,101,102,103,104,105,106,107,0 + }; + static shortint st0002[11] = { 48,49,50,51,52,53,54,55,56,57,0 }; + static shortint st0003[25] = { 97,32,105,115,32,97,116,32,37,100,44,32, + 115,105,122,101,32,37,100,58,32,37,115,10,0 }; + static shortint st0004[25] = { 98,32,105,115,32,97,116,32,37,100,44,32, + 115,105,122,101,32,37,100,58,32,37,115,10,0 }; + static shortint st0005[33] = { 45,45,45,45,45,45,45,45,45,45,45,45,45,45, + 45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,10,0 }; + static shortint st0006[10] = { 97,95,98,117,102,115,105,122,101,0 }; + static shortint st0007[10] = { 98,95,98,117,102,115,105,122,101,0 }; + static shortint st0008[30] = { 97,32,98,117,102,32,37,100,44,32,115,105, + 122,101,32,37,100,32,45,45,62,32,37,100,58,32,37,115,10,0 }; + static shortint st0009[30] = { 98,32,98,117,102,32,37,100,44,32,115,105, + 122,101,32,37,100,32,45,45,62,32,37,100,58,32,37,115,10,0 }; + + /* Local variables */ + static integer a, b, sza, szb; +#define memb ((logical *)&mem_1) +#define memc ((shortint *)&mem_1) +#define memi ((integer *)&mem_1) +#define meml ((integer *)&mem_1) +#define memr ((real *)&mem_1) +#define mems ((shortint *)&mem_1) +#define memx ((complex *)&mem_1) + extern /* Subroutine */ integer pargi_(); + extern integer clgeti_(); + extern /* Subroutine */ integer xrealc_(), xmallc_(), eprinf_(), xmfree_() + , pargsr_(); + static integer newsza, newszb; + extern /* Subroutine */ integer zzepro_(), xstrcy_(); + + xmallc_(&a, &c__1023, &c__2); + xstrcy_(st0001, &memc[a - 1], &c_b46); + sza = 1023; + xmallc_(&b, &c__1023, &c__2); + xstrcy_(st0002, &memc[b - 1], &c_b46); + szb = 1023; + eprinf_(st0003); + pargi_(&a); + pargi_(&sza); + pargsr_(&memc[a - 1]); + eprinf_(st0004); + pargi_(&b); + pargi_(&szb); + pargsr_(&memc[b - 1]); + eprinf_(st0005); +L110: + newsza = clgeti_(st0006); + if (! (newsza == 0)) { + goto L120; + } + goto L100; +L120: + xrealc_(&a, &newsza, &c__2); + newszb = clgeti_(st0007); + if (! (newszb == 0)) { + goto L130; + } + goto L100; +L130: + xrealc_(&b, &newszb, &c__2); + eprinf_(st0008); + pargi_(&a); + pargi_(&sza); + pargi_(&newsza); + pargsr_(&memc[a - 1]); + eprinf_(st0009); + pargi_(&b); + pargi_(&szb); + pargi_(&newszb); + pargsr_(&memc[b - 1]); + sza = newsza; + szb = newszb; +/* L111: */ + goto L110; +/* L112: */ + xmfree_(&a, &c__2); + xmfree_(&b, &c__2); +L100: + zzepro_(); + return 0; +} /* trealc_ */ + +#undef memx +#undef mems +#undef memr +#undef meml +#undef memi +#undef memc +#undef memb + + diff --git a/sys/memio/zzdebug.x b/sys/memio/zzdebug.x new file mode 100644 index 00000000..556c4fa1 --- /dev/null +++ b/sys/memio/zzdebug.x @@ -0,0 +1,86 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Debug MEMIO. + +task stack=t_stack, realloc=t_realloc + + +# Test the SALLOC routine, which allocates storage on the stack. + +procedure t_stack + +int bufsize +pointer sp, junk +int clglpi() + +begin + call smark (sp) + + while (clglpi ("buffer_size", bufsize) != EOF) { + call salloc (junk, bufsize, TY_CHAR) + call printf ("buffer pointer=%d, size=%d\n") + call pargi (junk) + call pargi (bufsize) + call flush (STDOUT) + } + + call sfree (sp) +end + + +# Test the REALLOC procedure, used to change the size of a buffer. +# Work with two buffers, so that memory can be fragmented, forcing buffers +# to move. + +procedure t_realloc() + +pointer a, b +int sza, new_sza, szb, new_szb +int clgeti() + +begin + call malloc (a, SZ_LINE, TY_CHAR) + call strcpy ("abcdefghijk", Memc[a], ARB) + sza = SZ_LINE + call malloc (b, SZ_LINE, TY_CHAR) + call strcpy ("0123456789", Memc[b], ARB) + szb = SZ_LINE + + call eprintf ("a is at %d, size %d: %s\n") + call pargi (a) + call pargi (sza) + call pargstr (Memc[a]) + call eprintf ("b is at %d, size %d: %s\n") + call pargi (b) + call pargi (szb) + call pargstr (Memc[b]) + call eprintf ("-------------------------------\n") + + repeat { + new_sza = clgeti ("a_bufsize") + if (new_sza == 0) + return + call x_realloc (a, new_sza, TY_CHAR) + new_szb = clgeti ("b_bufsize") + if (new_szb == 0) + return + call x_realloc (b, new_szb, TY_CHAR) + + call eprintf ("a buf %d, size %d --> %d: %s\n") + call pargi (a) + call pargi (sza) + call pargi (new_sza) + call pargstr (Memc[a]) + call eprintf ("b buf %d, size %d --> %d: %s\n") + call pargi (b) + call pargi (szb) + call pargi (new_szb) + call pargstr (Memc[b]) + + sza = new_sza + szb = new_szb + } + + call mfree (a, TY_CHAR) + call mfree (b, TY_CHAR) +end |