@* tjc: Set of general utilities.

@(../include/tjc.h@>=
#ifndef __TJC__
#define __TJC__
@<Macros@>@;
@<Prototypes@>@;
#endif


@ @<Macros@>=
#ifdef USE_FLOAT                                /* fp type definition */
typedef float real;
#define Real Float
#define PRINTF_REAL "%f"
#else
typedef double real;
#define Real Double
#define PRINTF_REAL "%g"
#endif

#define CCAT(x,y) x ## y
#define CCAT2(x,y) CCAT (x, y)
#define CCAT3(x,y,z) CCAT2 (CCAT2(x, y), z)


#ifdef __GNUC__
#define ATTRIBUTE(x)  __attribute__ (x)
#else
#define ATTRIBUTE(x)
#endif

#if defined(__cplusplus) && defined(__GNUC__)
#define UNUSED(x)
#define RCSID(x)   static char rcsid[] ATTRIBUTE ((unused)) = x;
#else
#define UNUSED(x)  x ATTRIBUTE ((unused))
#define RCSID(x)   static char UNUSED (rcsid[]) = x;
#endif

#if !defined(__cplusplus) || !defined(__GNUC__)
enum bool_tag {false, true};
#define bool                    enum bool_tag
#endif

#ifndef __cplusplus
#define EXTERN_C
#else
#define EXTERN_C                extern "C"
#endif

#define LEN(x)                 ((int) ( sizeof (x) / sizeof ((x)[0]) ))

#ifdef __cplusplus

inline int max (int i, int j) { return i < j ? j : i; }
inline int min (int i, int j) { return i > j ? j : i; }
inline int range (int x, int i, int j) { return min (max (x, i), j); }
inline int mod (int i, int j) { return (i + j) % j; }
/* inline int abs (int x) { return x >= 0 ? x : -x; } already in stdlib */

#ifdef __GNUC__
inline int sqr (int x) { return x * x; }
#endif

#else

#define max(a,b)               ((a) < (b) ? (b) : (a))
#define min(a,b)               ((a) > (b) ? (b) : (a))
#define range(a,b,c)           (min ( max (a, b), c))
#define mod(i,j)               (((i) + (j)) % (j))
#define abs(x)                 ((x) >= 0 ? (x) : -(x))
#define sqr(x)                 ((x) * (x))

#endif


@ ml.c
@c
#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <tjc.h>

@<rows copy@>@;
@<rows zero@>@;
@<rows square of norm@>@;
@<rows product@>@#


@ @<Prototypes@>=
void error (const char *fmt, ...) ATTRIBUTE ((format (printf, 1, 2)));
@ @c
void error (const char *fmt, ...) {
    va_list argp;

    va_start (argp, fmt);
    vfprintf (stderr, fmt, argp);
    va_end (argp);
    fflush (stderr);
}


@ Creates single memory matrix from any vector of vectors and deallocate source.
@<Prototypes@>=
typedef enum {tab_mat, tab_rows} mat_type;

typedef struct {
    mat_type type;
    int rows;
    union {
        int i;
        int *ip;
    } cols;
    int tots;
} tab_info;

#define alloc_real_mat(rows,cols) alloc_real_tab (tab_mat, rows, (int *) cols, NULL)
#define alloc_copy_real_mat(rows,cols,x) alloc_real_tab (tab_mat, rows, (int *) cols, x)
/* Duplicate row structure */
#define dup_real_mat(x)         alloc_real_mat (TAB_ROWS (x), MAT_COLS (x))
#define dup_copy_real_mat(x)    alloc_copy_real_mat (TAB_ROWS (x), MAT_COLS (x), x)


#define alloc_real_rows(rows,cols) alloc_real_tab (tab_rows, rows, cols, NULL)
#define alloc_copy_real_rows(rows,cols,x) alloc_real_tab (tab_rows, rows, cols, x)
#define dup_real_rows(x)         alloc_real_rows (TAB_ROWS (x), ROW_COLS (x))
#define dup_copy_real_rows(x)    alloc_copy_real_rows (TAB_ROWS (x), ROW_COLS (x), x)


#define TAB_INFO(x) (((tab_info *) x)[-1])
#define TAB_TYPE(x) (TAB_INFO (x).type)
#define TAB_ROWS(x) (TAB_INFO (x).rows)
#define MAT_COLS(x) ((TAB_INFO (x).cols.i))
#define ROW_COLS(x) (TAB_INFO (x).cols.ip)
#define TAB_TOTS(x) (TAB_INFO (x).tots)

#define ROW_TOTS TAB_TOTS

real **alloc_real_tab (const mat_type type, const int rows, const int *cols, real **x);
@ @c
real **alloc_real_tab (const mat_type type, const int rows, const int *cols, real **x) {
    int i, totcols;
    real **idx;
    tab_info *m;
    int colsint;

    m = (tab_info *) malloc (sizeof (tab_info) + rows * sizeof (real *));
    if (!m)
        return NULL;

    switch (type) {
    case tab_mat:
        colsint = (int) cols;
        totcols = colsint * rows;
        break;
    case tab_rows:
        totcols = 0;
        for (i = 0; i < rows; i++)
            totcols += cols[i];
        break;
    }

    idx = (real **) (m + 1);                    /* point past |tab_info| */
    idx[0] = (real *) calloc (totcols, sizeof (real));
    /* allocate rows and set pointers to them */

    if (!idx[0]) {
        free (m);
        return NULL;
    }

    switch (type) {
    case tab_mat:
        for (i = 0; i < rows - 1; i++) {
            if (x)
                memcpy (idx[i], x[i], colsint * sizeof (real));
            if (i < rows - 1)                       /* skip last iteration */
                idx[i + 1] = idx[i] + colsint;
        }
        m -> cols.i = colsint;
       break;

    case tab_rows:
        for (i = 0; i < rows; i++) {
            if (x)
                memcpy (idx[i], x[i], cols[i] * sizeof (real));
            if (i < rows - 1)                       /* skip last iteration */
                idx[i + 1] = idx[i] + cols[i];
        }

        m -> cols.ip = (int *) malloc (rows * sizeof (int)); /* no error test */
        memcpy (m -> cols.ip, cols, rows * sizeof (int));
        break;
    }

    m -> tots = totcols;
    m -> rows = rows;
    m -> type = type;
    return idx;
}


@ Deallocate matrices.
@<Prototypes@>=
#define free_real_mat free_real_tab
#define free_real_rows free_real_tab
void free_real_tab (real **m);
@ @c
void free_real_tab (real **m) {
    if (m) {
        free (m[0]);
        if (TAB_TYPE (m) == tab_rows)
            free (ROW_COLS (m));
        free (&TAB_INFO(m));
    }
}


@ @<Prototypes@>=
void copy_real_rows (real **a, real **b);
@ @<rows copy@>=
void copy_real_rows (real **a, real **b) {
    memcpy (a[0], b[0], TAB_TOTS (a) * sizeof (real));
}

@ @<Prototypes@>=
void zero_real_rows (real **a);
@ @<rows zero@>=
void zero_real_rows (real **a) {
    memset (a[0], 0, TAB_TOTS (a) * sizeof (real));
}

@ @<Prototypes@>=
real square_of_norm_real_rows (real **a);
@ @<rows square of norm@>=
real square_of_norm_real_rows (real **a) {
    int i;
    real sum = 0.0, x;
    for (i = 0; i < TAB_TOTS (a); i++) {
        x = a[0][i];
        sum += x * x;
    }
    return sum;
}

@ @<Prototypes@>=
real product_real_rows (real **a, real **b);
@ @<rows product@>=
real product_real_rows (real **a, real **b) {
    int i;
    real sum = 0.0;
    for (i = 0; i < TAB_TOTS (a); i++)
        sum += a[0][i] * b[0][i];
    return sum;
}

@
\vfill
\begin{rcslog}
$Log: tjc.w,v $
\Revision 1.10  1996/11/04 03:18:45  tjchol01
Added info structures to matrices.

\Revision 1.9  1996/10/29 05:33:40  tjchol01
Changed to |USE_FLOAT| in place of Real.

\Revision 1.8  1996/10/21 21:47:38  tjchol01
Put Real definitions back here.

\Revision 1.7  1996/09/29 05:03:26  tjchol01
Matrix functions added a long time ago.

\Revision 1.6  1996/05/27 03:03:16  tjchol01
|error| function with variable number of arguments.  Modified |UNUSED|.
A bit more CWEB-like.

\Revision 1.5  1996/05/05 03:32:13  tjchol01
Only a header |tjc.h| generated.

\Revision 1.4  1996/05/05 03:07:21  tjchol01
Moving all \ML{} specific contents to |ml.w| and changing name to
|tjc.w|.

\Revision 1.3  1996/05/02 06:26:42  tjchol01
Working with ml.w in scg.w.

\Revision 1.2  1996/05/01 01:19:51  tjchol01
Changing name to tjc-ml.w.

\Revision 1.1  1996/04/30 06:35:15  tjchol01
Makefiles working.
\endrcslog
@