PageRenderTime 97ms CodeModel.GetById 30ms app.highlight 47ms RepoModel.GetById 13ms app.codeStats 0ms

/src/mesch/zmemory.c

https://github.com/ljsking/compiler
C | 745 lines | 500 code | 130 blank | 115 comment | 114 complexity | 1af3e558fb046903db1f03b855fbea1c MD5 | raw file
  1
  2/**************************************************************************
  3**
  4** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved.
  5**
  6**			     Meschach Library
  7** 
  8** This Meschach Library is provided "as is" without any express 
  9** or implied warranty of any kind with respect to this software. 
 10** In particular the authors shall not be liable for any direct, 
 11** indirect, special, incidental or consequential damages arising 
 12** in any way from use of the software.
 13** 
 14** Everyone is granted permission to copy, modify and redistribute this
 15** Meschach Library, provided:
 16**  1.  All copies contain this copyright notice.
 17**  2.  All modified copies shall carry a notice stating who
 18**      made the last modification and the date of such modification.
 19**  3.  No charge is made for this software or works derived from it.  
 20**      This clause shall not be construed as constraining other software
 21**      distributed on the same medium as this software, nor is a
 22**      distribution fee considered a charge.
 23**
 24***************************************************************************/
 25
 26
 27/* Memory allocation and de-allocation for complex matrices and vectors */
 28
 29#include	<stdio.h>
 30#include	"zmatrix.h"
 31
 32static	char	rcsid[] = "$Id: zmemory.c,v 1.2 1994/04/05 02:13:14 des Exp $";
 33
 34
 35
 36/* zv_zero -- zeros all entries of a complex vector
 37   -- uses __zzero__() */
 38#ifndef ANSI_C
 39ZVEC	*zv_zero(x)
 40ZVEC	*x;
 41#else
 42ZVEC	*zv_zero(ZVEC *x)
 43#endif
 44{
 45   if ( ! x )
 46     error(E_NULL,"zv_zero");
 47   __zzero__(x->ve,x->dim);
 48   
 49   return x;
 50}
 51
 52/* zm_zero -- zeros all entries of a complex matrix
 53   -- uses __zzero__() */
 54#ifndef ANSI_C
 55ZMAT	*zm_zero(A)
 56ZMAT	*A;
 57#else
 58ZMAT	*zm_zero(ZMAT *A)
 59#endif
 60{
 61   int		i;
 62   
 63   if ( ! A )
 64     error(E_NULL,"zm_zero");
 65   for ( i = 0; i < A->m; i++ )
 66     __zzero__(A->me[i],A->n);
 67   
 68   return A;
 69}
 70
 71/* zm_get -- gets an mxn complex matrix (in ZMAT form) */
 72#ifndef ANSI_C
 73ZMAT	*zm_get(m,n)
 74int	m,n;
 75#else
 76ZMAT	*zm_get(int m, int n)
 77#endif
 78{
 79   ZMAT	*matrix;
 80   unsigned int	i;
 81   
 82   if (m < 0 || n < 0)
 83     error(E_NEG,"zm_get");
 84
 85   if ((matrix=NEW(ZMAT)) == (ZMAT *)NULL )
 86     error(E_MEM,"zm_get");
 87   else if (mem_info_is_on()) {
 88      mem_bytes(TYPE_ZMAT,0,sizeof(ZMAT));
 89      mem_numvar(TYPE_ZMAT,1);
 90   }
 91   
 92   matrix->m = m;		matrix->n = matrix->max_n = n;
 93   matrix->max_m = m;	matrix->max_size = m*n;
 94#ifndef SEGMENTED
 95   if ((matrix->base = NEW_A(m*n,complex)) == (complex *)NULL )
 96   {
 97      free(matrix);
 98      error(E_MEM,"zm_get");
 99   }
100   else if (mem_info_is_on()) {
101      mem_bytes(TYPE_ZMAT,0,m*n*sizeof(complex));
102   }
103#else
104   matrix->base = (complex *)NULL;
105#endif
106   if ((matrix->me = (complex **)calloc(m,sizeof(complex *))) == 
107       (complex **)NULL )
108   {	free(matrix->base);	free(matrix);
109	error(E_MEM,"zm_get");
110     }
111   else if (mem_info_is_on()) {
112      mem_bytes(TYPE_ZMAT,0,m*sizeof(complex *));
113   }
114#ifndef SEGMENTED
115   /* set up pointers */
116   for ( i=0; i<m; i++ )
117     matrix->me[i] = &(matrix->base[i*n]);
118#else
119   for ( i = 0; i < m; i++ )
120     if ( (matrix->me[i]=NEW_A(n,complex)) == (complex *)NULL )
121       error(E_MEM,"zm_get");
122     else if (mem_info_is_on()) {
123	mem_bytes(TYPE_ZMAT,0,n*sizeof(complex));
124     }
125#endif
126   
127   return (matrix);
128}
129
130
131/* zv_get -- gets a ZVEC of dimension 'dim'
132   -- Note: initialized to zero */
133#ifndef ANSI_C
134ZVEC	*zv_get(size)
135int	size;
136#else
137ZVEC	*zv_get(int size)
138#endif
139{
140   ZVEC	*vector;
141
142   if (size < 0)
143     error(E_NEG,"zv_get");
144
145   if ((vector=NEW(ZVEC)) == (ZVEC *)NULL )
146     error(E_MEM,"zv_get");
147   else if (mem_info_is_on()) {
148      mem_bytes(TYPE_ZVEC,0,sizeof(ZVEC));
149      mem_numvar(TYPE_ZVEC,1);
150   }
151   vector->dim = vector->max_dim = size;
152   if ((vector->ve=NEW_A(size,complex)) == (complex *)NULL )
153   {
154      free(vector);
155      error(E_MEM,"zv_get");
156   }
157   else if (mem_info_is_on()) {
158      mem_bytes(TYPE_ZVEC,0,size*sizeof(complex));
159   }
160   return (vector);
161}
162
163/* zm_free -- returns ZMAT & asoociated memory back to memory heap */
164#ifndef ANSI_C
165int	zm_free(mat)
166ZMAT	*mat;
167#else
168int	zm_free(ZMAT *mat)
169#endif
170{
171#ifdef SEGMENTED
172   int	i;
173#endif
174   
175   if ( mat==(ZMAT *)NULL || (int)(mat->m) < 0 ||
176       (int)(mat->n) < 0 )
177     /* don't trust it */
178     return (-1);
179   
180#ifndef SEGMENTED
181   if ( mat->base != (complex *)NULL ) {
182      if (mem_info_is_on()) {
183	 mem_bytes(TYPE_ZMAT,mat->max_m*mat->max_n*sizeof(complex),0);
184      }	   
185      free((char *)(mat->base));
186   }
187#else
188   for ( i = 0; i < mat->max_m; i++ )
189     if ( mat->me[i] != (complex *)NULL ) {
190	if (mem_info_is_on()) {
191	   mem_bytes(TYPE_ZMAT,mat->max_n*sizeof(complex),0);
192	}
193	free((char *)(mat->me[i]));
194     }
195#endif
196   if ( mat->me != (complex **)NULL ) {
197      if (mem_info_is_on()) {
198	 mem_bytes(TYPE_ZMAT,mat->max_m*sizeof(complex *),0);
199      }	   
200      free((char *)(mat->me));
201   }
202   
203   if (mem_info_is_on()) {
204      mem_bytes(TYPE_ZMAT,sizeof(ZMAT),0);
205      mem_numvar(TYPE_ZMAT,-1);
206   }
207   free((char *)mat);
208   
209   return (0);
210}
211
212
213/* zv_free -- returns ZVEC & asoociated memory back to memory heap */
214#ifndef ANSI_C
215int	zv_free(vec)
216ZVEC	*vec;
217#else
218int	zv_free(ZVEC *vec)
219#endif
220{
221   if ( vec==(ZVEC *)NULL || (int)(vec->dim) < 0 )
222     /* don't trust it */
223     return (-1);
224   
225   if ( vec->ve == (complex *)NULL ) {
226      if (mem_info_is_on()) {
227	 mem_bytes(TYPE_ZVEC,sizeof(ZVEC),0);
228	 mem_numvar(TYPE_ZVEC,-1);
229      }
230      free((char *)vec);
231   }
232   else
233   {
234      if (mem_info_is_on()) {
235	 mem_bytes(TYPE_ZVEC,vec->max_dim*sizeof(complex)+
236		      sizeof(ZVEC),0);
237	 mem_numvar(TYPE_ZVEC,-1);
238      }
239      
240      free((char *)vec->ve);
241      free((char *)vec);
242   }
243   
244   return (0);
245}
246
247
248/* zm_resize -- returns the matrix A of size new_m x new_n; A is zeroed
249   -- if A == NULL on entry then the effect is equivalent to m_get() */
250#ifndef ANSI_C
251ZMAT	*zm_resize(A,new_m,new_n)
252ZMAT	*A;
253int	new_m, new_n;
254#else
255ZMAT	*zm_resize(ZMAT *A, int new_m, int new_n)
256#endif
257{
258   unsigned int	i, new_max_m, new_max_n, new_size, old_m, old_n;
259   
260   if (new_m < 0 || new_n < 0)
261     error(E_NEG,"zm_resize");
262
263   if ( ! A )
264     return zm_get(new_m,new_n);
265   
266   if (new_m == A->m && new_n == A->n)
267     return A;
268
269   old_m = A->m;	old_n = A->n;
270   if ( new_m > A->max_m )
271   {	/* re-allocate A->me */
272      if (mem_info_is_on()) {
273	 mem_bytes(TYPE_ZMAT,A->max_m*sizeof(complex *),
274		      new_m*sizeof(complex *));
275      }
276
277      A->me = RENEW(A->me,new_m,complex *);
278      if ( ! A->me )
279	error(E_MEM,"zm_resize");
280   }
281   new_max_m = max(new_m,A->max_m);
282   new_max_n = max(new_n,A->max_n);
283   
284#ifndef SEGMENTED
285   new_size = new_max_m*new_max_n;
286   if ( new_size > A->max_size )
287   {	/* re-allocate A->base */
288      if (mem_info_is_on()) {
289	 mem_bytes(TYPE_ZMAT,A->max_m*A->max_n*sizeof(complex),
290		new_size*sizeof(complex));      
291      }
292
293      A->base = RENEW(A->base,new_size,complex);
294      if ( ! A->base )
295	error(E_MEM,"zm_resize");
296      A->max_size = new_size;
297   }
298   
299   /* now set up A->me[i] */
300   for ( i = 0; i < new_m; i++ )
301     A->me[i] = &(A->base[i*new_n]);
302   
303   /* now shift data in matrix */
304   if ( old_n > new_n )
305   {
306      for ( i = 1; i < min(old_m,new_m); i++ )
307	MEM_COPY((char *)&(A->base[i*old_n]),
308		 (char *)&(A->base[i*new_n]),
309		 sizeof(complex)*new_n);
310   }
311   else if ( old_n < new_n )
312   {
313      for ( i = min(old_m,new_m)-1; i > 0; i-- )
314      {   /* copy & then zero extra space */
315	 MEM_COPY((char *)&(A->base[i*old_n]),
316		  (char *)&(A->base[i*new_n]),
317		  sizeof(complex)*old_n);
318	 __zzero__(&(A->base[i*new_n+old_n]),(new_n-old_n));
319      }
320      __zzero__(&(A->base[old_n]),(new_n-old_n));
321      A->max_n = new_n;
322   }
323   /* zero out the new rows.. */
324   for ( i = old_m; i < new_m; i++ )
325     __zzero__(&(A->base[i*new_n]),new_n);
326#else
327   if ( A->max_n < new_n )
328   {
329      complex	*tmp;
330      
331      for ( i = 0; i < A->max_m; i++ )
332      {
333	 if (mem_info_is_on()) {
334	    mem_bytes(TYPE_ZMAT,A->max_n*sizeof(complex),
335			 new_max_n*sizeof(complex));
336	 }
337
338	 if ( (tmp = RENEW(A->me[i],new_max_n,complex)) == NULL )
339	   error(E_MEM,"zm_resize");
340	 else {
341	    A->me[i] = tmp;
342	 }
343      }
344      for ( i = A->max_m; i < new_max_m; i++ )
345      {
346	 if ( (tmp = NEW_A(new_max_n,complex)) == NULL )
347	   error(E_MEM,"zm_resize");
348	 else {
349	    A->me[i] = tmp;
350	    if (mem_info_is_on()) {
351	       mem_bytes(TYPE_ZMAT,0,new_max_n*sizeof(complex));
352	    }
353	 }
354      }
355   }
356   else if ( A->max_m < new_m )
357   {
358      for ( i = A->max_m; i < new_m; i++ )
359	if ( (A->me[i] = NEW_A(new_max_n,complex)) == NULL )
360	  error(E_MEM,"zm_resize");
361	else if (mem_info_is_on()) {
362	   mem_bytes(TYPE_ZMAT,0,new_max_n*sizeof(complex));
363	}
364      
365   }
366   
367   if ( old_n < new_n )
368   {
369      for ( i = 0; i < old_m; i++ )
370	__zzero__(&(A->me[i][old_n]),new_n-old_n);
371   }
372   
373   /* zero out the new rows.. */
374   for ( i = old_m; i < new_m; i++ )
375     __zzero__(A->me[i],new_n);
376#endif
377   
378   A->max_m = new_max_m;
379   A->max_n = new_max_n;
380   A->max_size = A->max_m*A->max_n;
381   A->m = new_m;	A->n = new_n;
382   
383   return A;
384}
385
386
387/* zv_resize -- returns the (complex) vector x with dim new_dim
388   -- x is set to the zero vector */
389#ifndef ANSI_C
390ZVEC	*zv_resize(x,new_dim)
391ZVEC	*x;
392int	new_dim;
393#else
394ZVEC	*zv_resize(ZVEC *x, int new_dim)
395#endif
396{
397   if (new_dim < 0)
398     error(E_NEG,"zv_resize");
399
400   if ( ! x )
401     return zv_get(new_dim);
402
403   if (new_dim == x->dim)
404     return x;
405
406   if ( x->max_dim == 0 )	/* assume that it's from sub_zvec */
407     return zv_get(new_dim);
408   
409   if ( new_dim > x->max_dim )
410   {
411      if (mem_info_is_on()) { 
412	 mem_bytes(TYPE_ZVEC,x->max_dim*sizeof(complex),
413		      new_dim*sizeof(complex));
414      }
415
416      x->ve = RENEW(x->ve,new_dim,complex);
417      if ( ! x->ve )
418	error(E_MEM,"zv_resize");
419      x->max_dim = new_dim;
420   }
421   
422   if ( new_dim > x->dim )
423     __zzero__(&(x->ve[x->dim]),new_dim - x->dim);
424   x->dim = new_dim;
425   
426   return x;
427}
428
429
430/* varying arguments */
431
432#ifdef ANSI_C
433
434#include <stdarg.h>
435
436
437/* To allocate memory to many arguments. 
438   The function should be called:
439   zv_get_vars(dim,&x,&y,&z,...,NULL);
440   where 
441     int dim;
442     ZVEC *x, *y, *z,...;
443     The last argument should be NULL ! 
444     dim is the length of vectors x,y,z,...
445     returned value is equal to the number of allocated variables
446     Other gec_... functions are similar.
447*/
448
449int zv_get_vars(int dim,...) 
450{
451   va_list ap;
452   int i=0;
453   ZVEC **par;
454   
455   va_start(ap, dim);
456   while (par = va_arg(ap,ZVEC **)) {   /* NULL ends the list*/
457      *par = zv_get(dim);
458      i++;
459   } 
460
461   va_end(ap);
462   return i;
463}
464
465
466
467int zm_get_vars(int m,int n,...) 
468{
469   va_list ap;
470   int i=0;
471   ZMAT **par;
472   
473   va_start(ap, n);
474   while (par = va_arg(ap,ZMAT **)) {   /* NULL ends the list*/
475      *par = zm_get(m,n);
476      i++;
477   } 
478
479   va_end(ap);
480   return i;
481}
482
483
484
485/* To resize memory for many arguments. 
486   The function should be called:
487   v_resize_vars(new_dim,&x,&y,&z,...,NULL);
488   where 
489     int new_dim;
490     ZVEC *x, *y, *z,...;
491     The last argument should be NULL ! 
492     rdim is the resized length of vectors x,y,z,...
493     returned value is equal to the number of allocated variables.
494     If one of x,y,z,.. arguments is NULL then memory is allocated to this 
495     argument. 
496     Other *_resize_list() functions are similar.
497*/
498
499int zv_resize_vars(int new_dim,...)
500{
501   va_list ap;
502   int i=0;
503   ZVEC **par;
504   
505   va_start(ap, new_dim);
506   while (par = va_arg(ap,ZVEC **)) {   /* NULL ends the list*/
507      *par = zv_resize(*par,new_dim);
508      i++;
509   } 
510
511   va_end(ap);
512   return i;
513}
514
515
516
517int zm_resize_vars(int m,int n,...) 
518{
519   va_list ap;
520   int i=0;
521   ZMAT **par;
522   
523   va_start(ap, n);
524   while (par = va_arg(ap,ZMAT **)) {   /* NULL ends the list*/
525      *par = zm_resize(*par,m,n);
526      i++;
527   } 
528
529   va_end(ap);
530   return i;
531}
532
533
534/* To deallocate memory for many arguments. 
535   The function should be called:
536   v_free_vars(&x,&y,&z,...,NULL);
537   where 
538     ZVEC *x, *y, *z,...;
539     The last argument should be NULL ! 
540     There must be at least one not NULL argument.
541     returned value is equal to the number of allocated variables.
542     Returned value of x,y,z,.. is VNULL.
543     Other *_free_list() functions are similar.
544*/
545
546int zv_free_vars(ZVEC **pv,...)
547{
548   va_list ap;
549   int i=1;
550   ZVEC **par;
551   
552   zv_free(*pv);
553   *pv = ZVNULL;
554   va_start(ap, pv);
555   while (par = va_arg(ap,ZVEC **)) {   /* NULL ends the list*/
556      zv_free(*par); 
557      *par = ZVNULL;
558      i++;
559   } 
560
561   va_end(ap);
562   return i;
563}
564
565
566
567int zm_free_vars(ZMAT **va,...)
568{
569   va_list ap;
570   int i=1;
571   ZMAT **par;
572   
573   zm_free(*va);
574   *va = ZMNULL;
575   va_start(ap, va);
576   while (par = va_arg(ap,ZMAT **)) {   /* NULL ends the list*/
577      zm_free(*par); 
578      *par = ZMNULL;
579      i++;
580   } 
581
582   va_end(ap);
583   return i;
584}
585
586
587
588#elif VARARGS
589
590#include <varargs.h>
591
592/* To allocate memory to many arguments. 
593   The function should be called:
594   v_get_vars(dim,&x,&y,&z,...,NULL);
595   where 
596     int dim;
597     ZVEC *x, *y, *z,...;
598     The last argument should be NULL ! 
599     dim is the length of vectors x,y,z,...
600     returned value is equal to the number of allocated variables
601     Other gec_... functions are similar.
602*/
603
604int zv_get_vars(va_alist) va_dcl
605{
606   va_list ap;
607   int dim,i=0;
608   ZVEC **par;
609   
610   va_start(ap);
611   dim = va_arg(ap,int);
612   while (par = va_arg(ap,ZVEC **)) {   /* NULL ends the list*/
613      *par = zv_get(dim);
614      i++;
615   } 
616
617   va_end(ap);
618   return i;
619}
620
621
622
623int zm_get_vars(va_alist) va_dcl
624{
625   va_list ap;
626   int i=0, n, m;
627   ZMAT **par;
628   
629   va_start(ap);
630   m = va_arg(ap,int);
631   n = va_arg(ap,int);
632   while (par = va_arg(ap,ZMAT **)) {   /* NULL ends the list*/
633      *par = zm_get(m,n);
634      i++;
635   } 
636
637   va_end(ap);
638   return i;
639}
640
641
642
643/* To resize memory for many arguments. 
644   The function should be called:
645   v_resize_vars(new_dim,&x,&y,&z,...,NULL);
646   where 
647     int new_dim;
648     ZVEC *x, *y, *z,...;
649     The last argument should be NULL ! 
650     rdim is the resized length of vectors x,y,z,...
651     returned value is equal to the number of allocated variables.
652     If one of x,y,z,.. arguments is NULL then memory is allocated to this 
653     argument. 
654     Other *_resize_list() functions are similar.
655*/
656
657int zv_resize_vars(va_alist) va_dcl
658{
659   va_list ap;
660   int i=0, new_dim;
661   ZVEC **par;
662   
663   va_start(ap);
664   new_dim = va_arg(ap,int);
665   while (par = va_arg(ap,ZVEC **)) {   /* NULL ends the list*/
666      *par = zv_resize(*par,new_dim);
667      i++;
668   } 
669
670   va_end(ap);
671   return i;
672}
673
674
675int zm_resize_vars(va_alist) va_dcl
676{
677   va_list ap;
678   int i=0, m, n;
679   ZMAT **par;
680   
681   va_start(ap);
682   m = va_arg(ap,int);
683   n = va_arg(ap,int);
684   while (par = va_arg(ap,ZMAT **)) {   /* NULL ends the list*/
685      *par = zm_resize(*par,m,n);
686      i++;
687   } 
688
689   va_end(ap);
690   return i;
691}
692
693
694
695/* To deallocate memory for many arguments. 
696   The function should be called:
697   v_free_vars(&x,&y,&z,...,NULL);
698   where 
699     ZVEC *x, *y, *z,...;
700     The last argument should be NULL ! 
701     There must be at least one not NULL argument.
702     returned value is equal to the number of allocated variables.
703     Returned value of x,y,z,.. is VNULL.
704     Other *_free_list() functions are similar.
705*/
706
707int zv_free_vars(va_alist) va_dcl
708{
709   va_list ap;
710   int i=0;
711   ZVEC **par;
712   
713   va_start(ap);
714   while (par = va_arg(ap,ZVEC **)) {   /* NULL ends the list*/
715      zv_free(*par); 
716      *par = ZVNULL;
717      i++;
718   } 
719
720   va_end(ap);
721   return i;
722}
723
724
725
726int zm_free_vars(va_alist) va_dcl
727{
728   va_list ap;
729   int i=0;
730   ZMAT **par;
731   
732   va_start(ap);
733   while (par = va_arg(ap,ZMAT **)) {   /* NULL ends the list*/
734      zm_free(*par); 
735      *par = ZMNULL;
736      i++;
737   } 
738
739   va_end(ap);
740   return i;
741}
742
743
744#endif
745