[q-lang-cvs] q/modules/clib clib.c,1.82,1.83 clib.q,1.32,1.33

[Albert G. <ag...@us...>]

Update of /cvsroot/q-lang/q/modules/clib
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv6345/modules/clib

Modified Files:
	clib.c clib.q 
Log Message:
add int/float vector operations, as suggested by John Cowan

Index: clib.q
===================================================================
RCS file: /cvsroot/q-lang/q/modules/clib/clib.q,v
retrieving revision 1.32
retrieving revision 1.33
diff -C2 -d -r1.32 -r1.33
*** clib.q	16 Dec 2007 20:23:21 -0000	1.32
--- clib.q	18 Jan 2008 10:06:05 -0000	1.33
***************
*** 257,260 ****
--- 257,291 ----
  (B1:ByteStr>=B2:ByteStr)		= (bcmp B1 B2>=0);
  
+ /* As of Q 7.11, clib supports a number of additional operations which allow
+    you to treat byte strings as mutable C vectors of signed/unsigned 8/16/32
+    bit integers or single/double precision floating point numbers. The
+    following functions provide read/write access to the elements of such C
+    vectors. Note that the given index argument I is interpreted relative to
+    the corresponding element type. Thus, e.g., get_uint32 B I returns the Ith
+    32 bit integer rather than the integer at byte offset I. */
+ 
+ /* NOTE: Integer arguments must fit into machine integers, otherwise these
+    operations will fail. Integers passed for floating point arguments will be
+    coerced to floating point values automatically. */
+ 
+ public extern get_int8 B I, get_int16 B I, get_int32 B I;
+ public extern get_uint8 B I, get_uint16 B I, get_uint32 B I;
+ public extern get_float B I, get_double B I;
+ 
+ public extern put_int8 B I X, put_int16 B I X, put_int32 B I X;
+ public extern put_uint8 B I X, put_uint16 B I X, put_uint32 B I X;
+ public extern put_float B I X, put_double B I X;
+ 
+ /* Some convenience functions to convert between byte strings and lists of
+    integer/floating point elements. */
+ 
+ public extern int8_list B, int16_list B, int32_list B;
+ public extern uint8_list B, uint16_list B, uint32_list B;
+ public extern float_list B, double_list B;
+ 
+ public extern int8_vect Xs, int16_vect Xs, int32_vect Xs;
+ public extern uint8_vect Xs, uint16_vect Xs, uint32_vect Xs;
+ public extern float_vect Xs, double_vect Xs;
+ 
  /****************************************************************************/
  

Index: clib.c
===================================================================
RCS file: /cvsroot/q-lang/q/modules/clib/clib.c,v
retrieving revision 1.82
retrieving revision 1.83
diff -C2 -d -r1.82 -r1.83
*** clib.c	16 Dec 2007 20:23:21 -0000	1.82
--- clib.c	18 Jan 2008 10:06:04 -0000	1.83
***************
*** 4040,4043 ****
--- 4040,4564 ----
  }
  
+ FUNCTION(clib,get_int8,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < m->size)
+     return mkint((signed char)m->v[i]);
+   else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_int8,argc,argv)
+ {
+   bstr_t *m;
+   long i, x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && isint(argv[2], &x) && i >= 0 && i < m->size) {
+     m->v[i] = (signed char)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_int16,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < (m->size >> 1)) {
+     short *v = (short*)m->v;
+     return mkint(v[i]);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_int16,argc,argv)
+ {
+   bstr_t *m;
+   long i, x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && isint(argv[2], &x) &&
+       i >= 0 && i < (m->size >> 1)) {
+     short *v = (short*)m->v;
+     v[i] = (short)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_int32,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < (m->size >> 2)) {
+     long *v = (long*)m->v;
+     return mkint(v[i]);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_int32,argc,argv)
+ {
+   bstr_t *m;
+   long i, x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && isint(argv[2], &x) &&
+       i >= 0 && i < (m->size >> 2)) {
+     long *v = (long*)m->v;
+     v[i] = (long)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_uint8,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < m->size)
+     return mkuint((unsigned char)m->v[i]);
+   else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_uint8,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   unsigned long x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && isuint(argv[2], &x) && i >= 0 && i < m->size) {
+     m->v[i] = (unsigned char)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_uint16,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < (m->size >> 1)) {
+     unsigned short *v = (unsigned short*)m->v;
+     return mkuint(v[i]);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_uint16,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   unsigned long x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && isuint(argv[2], &x) &&
+       i >= 0 && i < (m->size >> 1)) {
+     short *v = (short*)m->v;
+     v[i] = (short)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_uint32,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < (m->size >> 2)) {
+     unsigned long *v = (unsigned long*)m->v;
+     return mkuint(v[i]);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_uint32,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   unsigned long x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && isuint(argv[2], &x) &&
+       i >= 0 && i < (m->size >> 2)) {
+     unsigned long *v = (unsigned long*)m->v;
+     v[i] = (unsigned long)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_float,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < (m->size / sizeof(float))) {
+     float *v = (float*)m->v;
+     return mkfloat(v[i]);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_float,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   double x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) &&
+       (isfloat(argv[2], &x) || ismpz_float(argv[2], &x)) &&
+       i >= 0 && i < (m->size / sizeof(float))) {
+     float *v = (float*)m->v;
+     v[i] = (float)x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,get_double,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   if (argc == 2 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) && i >= 0 && i < (m->size / sizeof(double))) {
+     double *v = (double*)m->v;
+     return mkfloat(v[i]);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,put_double,argc,argv)
+ {
+   bstr_t *m;
+   long i;
+   double x;
+   if (argc == 3 && isobj(argv[0], type(ByteStr), (void**)&m) &&
+       isint(argv[1], &i) &&
+       (isfloat(argv[2], &x) || ismpz_float(argv[2], &x)) &&
+       i >= 0 && i < (m->size / sizeof(double))) {
+     double *v = (double*)m->v;
+     v[i] = x;
+     return mkvoid;
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,int8_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size;
+     signed char *v = (signed char*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkint(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,uint8_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size;
+     unsigned char *v = (unsigned char*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkuint(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,int16_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size >> 1;
+     short *v = (short*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkint(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,uint16_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size >> 1;
+     unsigned short *v = (unsigned short*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkuint(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,int32_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size >> 2;
+     long *v = (long*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkint(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,uint32_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size >> 2;
+     unsigned long *v = (unsigned long*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkuint(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,float_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size / sizeof(float);
+     float *v = (float*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkfloat(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,double_list,argc,argv)
+ {
+   bstr_t *m;
+   if (argc == 1 && isobj(argv[0], type(ByteStr), (void**)&m)) {
+     int i, n = m->size / sizeof(double);
+     double *v = (double*)m->v;
+     expr *xv;
+     if (n <= 0) return mknil;
+     xv = malloc(n*sizeof(expr));
+     if (!xv) return __ERROR;
+     for (i = 0; i < n; i++)
+       xv[i] = mkfloat(v[i]);
+     return mklistv(n, xv);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,int8_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     long x;
+     signed char *v;
+     while (iscons(xs, &hd, &tl) && isint(hd, &x)) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && isint(hd, &x)) {
+       xs = tl; v[n++] = (signed char)x;
+     }
+     return mkbstr(n, v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,int16_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     long x;
+     short *v;
+     while (iscons(xs, &hd, &tl) && isint(hd, &x)) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n*sizeof(short)))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && isint(hd, &x)) {
+       xs = tl; v[n++] = (short)x;
+     }
+     return mkbstr(n*sizeof(short), v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,int32_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     long x;
+     long *v;
+     while (iscons(xs, &hd, &tl) && isint(hd, &x)) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n*sizeof(long)))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && isint(hd, &x)) {
+       xs = tl; v[n++] = x;
+     }
+     return mkbstr(n*sizeof(long), v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,uint8_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     unsigned long x;
+     unsigned char *v;
+     while (iscons(xs, &hd, &tl) && isuint(hd, &x)) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && isuint(hd, &x)) {
+       xs = tl; v[n++] = (unsigned char)x;
+     }
+     return mkbstr(n, v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,uint16_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     unsigned long x;
+     unsigned short *v;
+     while (iscons(xs, &hd, &tl) && isuint(hd, &x)) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n*sizeof(unsigned short)))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && isuint(hd, &x)) {
+       xs = tl; v[n++] = (unsigned short)x;
+     }
+     return mkbstr(n*sizeof(unsigned short), v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,uint32_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     unsigned long x;
+     unsigned long *v;
+     while (iscons(xs, &hd, &tl) && isuint(hd, &x)) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n*sizeof(unsigned long)))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && isuint(hd, &x)) {
+       xs = tl; v[n++] = x;
+     }
+     return mkbstr(n*sizeof(unsigned long), v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,float_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     double x;
+     float *v;
+     while (iscons(xs, &hd, &tl) && (isfloat(hd, &x) || ismpz_float(hd, &x))) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n*sizeof(float)))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && (isfloat(hd, &x) || ismpz_float(hd, &x))) {
+       xs = tl; v[n++] = (float)x;
+     }
+     return mkbstr(n*sizeof(float), v);
+   } else
+     return __FAIL;
+ }
+ 
+ FUNCTION(clib,double_vect,argc,argv)
+ {
+   if (argc == 1) {
+     expr xs = argv[0], hd, tl;
+     int i, n = 0;
+     double x;
+     double *v;
+     while (iscons(xs, &hd, &tl) && (isfloat(hd, &x) || ismpz_float(hd, &x))) {
+       xs = tl; n++;
+     }
+     if (!isnil(xs)) return __FAIL;
+     if (n <= 0) return mkbstr(0, NULL);
+     if (!(v = malloc(n*sizeof(double)))) return __ERROR;
+     xs = argv[0]; n = 0;
+     while (iscons(xs, &hd, &tl) && (isfloat(hd, &x) || ismpz_float(hd, &x))) {
+       xs = tl; v[n++] = x;
+     }
+     return mkbstr(n*sizeof(double), v);
+   } else
+     return __FAIL;
+ }
+ 
  /* references: ************************************************************/