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