From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/nmemio/msvfwa.x | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 sys/nmemio/msvfwa.x (limited to 'sys/nmemio/msvfwa.x') diff --git a/sys/nmemio/msvfwa.x b/sys/nmemio/msvfwa.x new file mode 100644 index 00000000..cd3313c5 --- /dev/null +++ b/sys/nmemio/msvfwa.x @@ -0,0 +1,55 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + + +# 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, nelem, sz_align, fwa_align) + +int fwa, dtype, nelem, sz_align, fwa_align, nbits +pointer bufptr, lwl, offset + +pointer mgdptr() +int coerce(), sizeof() + +include "nmemio.com" + +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) + + nbits = sizeof(TY_INT) * 8 * SZB_CHAR + if (nbits == 64) { + if (sizeof (dtype) == sizeof (TY_CHAR)) + offset = (nelem / SZ_INT + 1) + else if (sizeof (dtype) == sizeof (TY_REAL)) + offset = (nelem / SZ_REAL + 1) + else + offset = nelem + + } else if (nbits == 32) { + + if (sizeof(dtype) < sz_align) + offset = (nelem / (SZ_INT / sizeof(dtype))) + 1 + else + offset = (nelem * sizeof (dtype)) / SZB_CHAR + } + + lwl = bufptr + offset + + Memi[bufptr-5] = fwa # first word address + Memi[bufptr-4] = lwl # last word location + Memi[bufptr-3] = dtype # data type + Memi[bufptr-2] = nelem # no. of elements + Memi[bufptr-1] = lsentinal # lower sentinal + Memi[lwl] = usentinal # upper sentinal + + # Return pointer of type dtype to the first cell of the data area. + return (coerce (bufptr, TY_INT, dtype)) +end -- cgit