xref: /petsc/src/sys/utils/memc.c (revision be7314b09a558091375cab512a4901878ccc5021)
1 #define PETSC_DLL
2 
3 /*
4     We define the memory operations here. The reason we just do not use
5   the standard memory routines in the PETSc code is that on some machines
6   they are broken.
7 
8 */
9 #include "petsc.h"        /*I  "petsc.h"   I*/
10 #if defined(PETSC_HAVE_FORTRAN_CAPS)
11 #define fortrancopy_ FORTRANCOPY
12 #define fortranzero_ FORTRANZERO
13 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
14 #define fortrancopy_ fortrancopy
15 #define fortranzero_ fortranzero
16 #endif
17 EXTERN_C_BEGIN
18 extern void fortrancopy_(PetscInt*,PetscScalar*,PetscScalar*);
19 extern void fortranzero_(PetscInt*,PetscScalar*);
20 EXTERN_C_END
21 
22 
23 /*
24     On the IBM Rs6000 using the Gnu G++ compiler you may have to include
25   <string.h> instead of <memory.h>
26 */
27 #if defined(PETSC_HAVE_MEMORY_H)
28 #include <memory.h>
29 #endif
30 #if defined(PETSC_HAVE_STRINGS_H)
31 #include <strings.h>
32 #endif
33 #if defined(PETSC_HAVE_STRING_H)
34 #include <string.h>
35 #endif
36 #if defined(PETSC_HAVE_STDLIB_H)
37 #include <stdlib.h>
38 #endif
39 #include "petscfix.h"
40 #include "petscbt.h"
41 #if defined(PETSC_PREFER_DCOPY_FOR_MEMCPY)
42 #include "petscblaslapack.h"
43 #endif
44 
45 #undef __FUNCT__
46 #define __FUNCT__ "PetscMemcpy"
47 /*@
48    PetscMemcpy - Copies n bytes, beginning at location b, to the space
49    beginning at location a. The two memory regions CANNOT overlap, use
50    PetscMemmove() in that case.
51 
52    Not Collective
53 
54    Input Parameters:
55 +  b - pointer to initial memory space
56 -  n - length (in bytes) of space to copy
57 
58    Output Parameter:
59 .  a - pointer to copy space
60 
61    Level: intermediate
62 
63    Compile Option:
64     PETSC_PREFER_DCOPY_FOR_MEMCPY will cause the BLAS dcopy() routine to be used
65                                   for memory copies on double precision values.
66     PETSC_PREFER_COPY_FOR_MEMCPY will cause C code to be used
67                                   for memory copies on double precision values.
68     PETSC_PREFER_FORTRAN_FORMEMCPY will cause Fortran code to be used
69                                   for memory copies on double precision values.
70 
71    Note:
72    This routine is analogous to memcpy().
73 
74   Concepts: memory^copying
75   Concepts: copying^memory
76 
77 .seealso: PetscMemmove()
78 
79 @*/
80 PetscErrorCode PETSC_DLLEXPORT PetscMemcpy(void *a,const void *b,size_t n)
81 {
82   unsigned long al = (unsigned long) a,bl = (unsigned long) b;
83   unsigned long nl = (unsigned long) n;
84 
85   PetscFunctionBegin;
86   if (n > 0 && !b) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to copy from a null pointer");
87   if (n > 0 && !a) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to copy to a null pointer");
88   if (a != b) {
89 #if !defined(PETSC_HAVE_CRAY90_POINTER)
90     if ((al > bl && (al - bl) < nl) || (bl - al) < nl) {
91       SETERRQ3(PETSC_ERR_ARG_INCOMP,"Memory regions overlap: either use PetscMemmov()\n\
92               or make sure your copy regions and lengths are correct. \n\
93               Length (bytes) %ld first address %ld second address %ld",nl,al,bl);
94     }
95 #endif
96 #if (defined(PETSC_PREFER_DCOPY_FOR_MEMCPY) || defined(PETSC_PREFER_COPY_FOR_MEMCPY) || defined(PETSC_PREFER_FORTRAN_FORMEMCPY))
97    if (!(((long) a) % sizeof(PetscScalar)) && !(n % sizeof(PetscScalar))) {
98       size_t len = n/sizeof(PetscScalar);
99 #if defined(PETSC_PREFER_DCOPY_FOR_MEMCPY)
100       PetscBLASInt one = 1,blen = PetscBLASIntCast(len);
101       BLAScopy_(&blen,(PetscScalar *)b,&one,(PetscScalar *)a,&one);
102 #elif defined(PETSC_PREFER_FORTRAN_FORMEMCPY)
103       fortrancopy_(&len,(PetscScalar*)b,(PetscScalar*)a);
104 #else
105       size_t      i;
106       PetscScalar *x = (PetscScalar*)b, *y = (PetscScalar*)a;
107       for (i=0; i<len; i++) y[i] = x[i];
108 #endif
109     } else {
110       memcpy((char*)(a),(char*)(b),n);
111     }
112 #elif defined(PETSC_HAVE__INTEL_FAST_MEMCPY)
113     _intel_fast_memcpy((char*)(a),(char*)(b),n);
114 #else
115     memcpy((char*)(a),(char*)(b),n);
116 #endif
117   }
118   PetscFunctionReturn(0);
119 }
120 
121 #undef __FUNCT__
122 #define __FUNCT__ "PetscBitMemcpy"
123 /*@C
124    PetscBitMemcpy - Copies an amount of data. This can include bit data.
125 
126    Not Collective
127 
128    Input Parameters:
129 +  b - pointer to initial memory space
130 .  bi - offset of initial memory space (in elementary chunk sizes)
131 .  bs - length (in elementary chunk sizes) of space to copy
132 -  dtype - datatype, for example, PETSC_INT, PETSC_DOUBLE, PETSC_LOGICAL
133 
134    Output Parameters:
135 +  a - pointer to result memory space
136 -  ai - offset of result memory space (in elementary chunk sizes)
137 
138    Level: intermediate
139 
140    Note:
141    This routine is analogous to PetscMemcpy(), except when the data type is
142    PETSC_LOGICAL.
143 
144    Concepts: memory^comparing
145    Concepts: comparing^memory
146 
147 .seealso: PetscMemmove(), PetscMemcpy()
148 
149 @*/
150 PetscErrorCode PETSC_DLLEXPORT PetscBitMemcpy(void *a,PetscInt ai,const void *b,PetscInt bi,PetscInt bs,PetscDataType dtype)
151 {
152   char           *aa = (char *)a,*bb = (char *)b;
153   size_t         dsize;
154   PetscErrorCode ierr;
155 
156   PetscFunctionBegin;
157   if (bs > 0 && !b) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to copy from a null pointer");
158   if (bs > 0 && !a) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to copy to a null pointer");
159   if (dtype != PETSC_LOGICAL) {
160     ierr = PetscDataTypeGetSize(dtype,&dsize);CHKERRQ(ierr);
161     ierr = PetscMemcpy(aa+ai*dsize,bb+bi*dsize,bs*dsize);CHKERRQ(ierr);
162   } else {
163     PetscBT  at = (PetscBT) a;
164     PetscBT  bt = (PetscBT) b;
165     PetscInt i;
166     for (i=0; i<bs; i++) {
167       if (PetscBTLookup(bt,bi+i)) {ierr = PetscBTSet(at,ai+i);CHKERRQ(ierr);}
168       else                        {ierr = PetscBTClear(at,ai+i);CHKERRQ(ierr);}
169     }
170   }
171   PetscFunctionReturn(0);
172 }
173 
174 #undef __FUNCT__
175 #define __FUNCT__ "PetscMemzero"
176 /*@
177    PetscMemzero - Zeros the specified memory.
178 
179    Not Collective
180 
181    Input Parameters:
182 +  a - pointer to beginning memory location
183 -  n - length (in bytes) of memory to initialize
184 
185    Level: intermediate
186 
187    Compile Option:
188    PETSC_PREFER_BZERO - on certain machines (the IBM RS6000) the bzero() routine happens
189   to be faster than the memset() routine. This flag causes the bzero() routine to be used.
190 
191    Concepts: memory^zeroing
192    Concepts: zeroing^memory
193 
194 .seealso: PetscMemcpy()
195 @*/
196 PetscErrorCode PETSC_DLLEXPORT PetscMemzero(void *a,size_t n)
197 {
198   PetscFunctionBegin;
199   if (n > 0) {
200     if (!a) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to zero at a null pointer");
201 #if defined(PETSC_PREFER_ZERO_FOR_MEMZERO)
202     if (!(((long) a) % sizeof(PetscScalar)) && !(n % sizeof(PetscScalar))) {
203       size_t      i,len = n/sizeof(PetscScalar);
204       PetscScalar *x = (PetscScalar*)a;
205       for (i=0; i<len; i++) x[i] = 0.0;
206     } else {
207 #elif defined(PETSC_PREFER_FORTRAN_FOR_MEMZERO)
208     if (!(((long) a) % sizeof(PetscScalar)) && !(n % sizeof(PetscScalar))) {
209       PetscInt len = n/sizeof(PetscScalar);
210       fortranzero_(&len,(PetscScalar*)a);
211     } else {
212 #endif
213 #if defined(PETSC_PREFER_BZERO)
214       bzero((char *)a,n);
215 #elif defined (PETSC_HAVE__INTEL_FAST_MEMSET)
216       _intel_fast_memset((char*)a,0,n);
217 #else
218       memset((char*)a,0,n);
219 #endif
220 #if defined(PETSC_PREFER_ZERO_FOR_MEMZERO) || defined(PETSC_PREFER_FORTRAN_FOR_MEMZERO)
221     }
222 #endif
223   }
224   PetscFunctionReturn(0);
225 }
226 
227 #undef __FUNCT__
228 #define __FUNCT__ "PetscMemcmp"
229 /*@
230    PetscMemcmp - Compares two byte streams in memory.
231 
232    Not Collective
233 
234    Input Parameters:
235 +  str1 - Pointer to the first byte stream
236 .  str2 - Pointer to the second byte stream
237 -  len  - The length of the byte stream
238          (both str1 and str2 are assumed to be of length len)
239 
240    Output Parameters:
241 .   e - PETSC_TRUE if equal else PETSC_FALSE.
242 
243    Level: intermediate
244 
245    Note:
246    This routine is anologous to memcmp()
247 @*/
248 PetscErrorCode PETSC_DLLEXPORT PetscMemcmp(const void *str1,const void *str2,size_t len,PetscTruth *e)
249 {
250   int r;
251 
252   PetscFunctionBegin;
253   if (len > 0 && !str1) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to compare at a null pointer");
254   if (len > 0 && !str2) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to compare at a null pointer");
255   r = memcmp((char *)str1,(char *)str2,len);
256   if (!r) *e = PETSC_TRUE;
257   else    *e = PETSC_FALSE;
258   PetscFunctionReturn(0);
259 }
260 
261 #undef __FUNCT__
262 #define __FUNCT__ "PetscMemmove"
263 /*@
264    PetscMemmove - Copies n bytes, beginning at location b, to the space
265    beginning at location a. Copying  between regions that overlap will
266    take place correctly.
267 
268    Not Collective
269 
270    Input Parameters:
271 +  b - pointer to initial memory space
272 -  n - length (in bytes) of space to copy
273 
274    Output Parameter:
275 .  a - pointer to copy space
276 
277    Level: intermediate
278 
279    Note:
280    This routine is analogous to memmove().
281 
282    Since b can overlap with a, b cannot be declared as const
283 
284    Concepts: memory^copying with overlap
285    Concepts: copying^memory with overlap
286 
287 .seealso: PetscMemcpy()
288 @*/
289 PetscErrorCode PETSC_DLLEXPORT PetscMemmove(void *a,void *b,size_t n)
290 {
291   PetscFunctionBegin;
292   if (n > 0 && !a) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to copy to null pointer");
293   if (n > 0 && !b) SETERRQ(PETSC_ERR_ARG_NULL,"Trying to copy from a null pointer");
294 #if !defined(PETSC_HAVE_MEMMOVE)
295   if (a < b) {
296     if (a <= b - n) {
297       memcpy(a,b,n);
298     } else {
299       memcpy(a,b,(int)(b - a));
300       PetscMemmove(b,b + (int)(b - a),n - (int)(b - a));
301     }
302   }  else {
303     if (b <= a - n) {
304       memcpy(a,b,n);
305     } else {
306       memcpy(b + n,b + (n - (int)(a - b)),(int)(a - b));
307       PetscMemmove(a,b,n - (int)(a - b));
308     }
309   }
310 #else
311   memmove((char*)(a),(char*)(b),n);
312 #endif
313   PetscFunctionReturn(0);
314 }
315 
316 
317 
318 
319