floatdouble.c
Go to the documentation of this file.
00001 /*
00002 /* FLOAT-VECTOR  <---> DOUBLE-VECTOR conversion 
00003 /* (c)1990 MATSUI Toshihiro, Electrotechnical Laboratory
00004 /*
00005 /* gcc -c -Di386 -DLinux -w -DGCC  -fpic  -I/usr/local/eus/include -O sync.c 
00006 /* ld -shared -o floatdouble.so floatdouble.o
00007 */
00008 
00009 #include "eus.h"
00010 extern pointer makefvector();
00011 
00012 static pointer F2D(ctx,n,argv)
00013 context *ctx;
00014 int n;
00015 pointer argv[];
00016 { pointer f=argv[0],d;
00017   float  *fp;
00018   register int i,len;
00019   union doublefloat {
00020     struct {float low,high;} fval;
00021     double dval;
00022   } f2d;
00023 
00024   ckarg2(1,2);
00025   if (!isfltvector(f)) error(E_FLOATVECTOR);
00026   len=vecsize(f);
00027   if (n==1) d=makefvector(len*2);
00028   else {
00029     d=argv[1];
00030     if (!isfltvector(d)) error(E_FLOATVECTOR);
00031     if (vecsize(d)<2*len) error(E_ARRAYINDEX);}
00032   for (i=0; i<len*2; i++) d->c.fvec.fv[i] = 0.0;
00033   fp=d->c.fvec.fv;
00034   for (i=0; i<len; i++) {
00035     f2d.dval = (double)f->c.fvec.fv[i]; 
00036     *fp++ = f2d.fval.low; *fp++ = f2d.fval.high;}
00037   return(d);}
00038 
00039 static pointer D2F(ctx,n,argv)
00040 context *ctx;
00041 int n;
00042 pointer argv[];
00043 { pointer d=argv[0],f;
00044   float *fp;
00045   register int i,len;
00046   union doublefloat {
00047     struct {float low,high;} fval;
00048     double dval;
00049   } f2d;
00050 
00051   ckarg2(1,2);
00052   if (!isfltvector(d)) error(E_FLOATVECTOR);
00053   len=(vecsize(d)+1)/2;
00054   if (n==1) f=makefvector(len);
00055   else {
00056     f=argv[1];
00057     if (!isfltvector(f)) error(E_FLOATVECTOR);
00058     if (vecsize(f)<len) error(E_ARRAYINDEX);}
00059   fp=d->c.fvec.fv;
00060   for (i=0; i<len; i++) {
00061     f2d.fval.low = *fp++; f2d.fval.high = *fp++;
00062     f->c.fvec.fv[i]= (float)f2d.dval;}
00063   return(f);}
00064 
00065 pointer S2F(ctx,n,argv) /*short word to float*/
00066 context *ctx;
00067 int n;
00068 pointer argv[];
00069 { pointer s=argv[0],f;
00070   register float *fp;
00071   register short *sp;
00072   register int i,len,v;
00073   register float factor;
00074   numunion nu;
00075 
00076   ckarg2(1,3);
00077   if (!isstring(s)) error(E_NOSTRING);
00078   len=(vecsize(s)+1)/2;
00079   if (n>=2) factor=ckfltval(argv[1]); else factor=1.0;
00080   if (n<3) f=makefvector(len);
00081   else {
00082     f=argv[2];
00083     if (!isfltvector(f)) error(E_FLOATVECTOR);
00084     if (vecsize(f)<len) error(E_ARRAYINDEX);}
00085   fp=f->c.fvec.fv;
00086   sp=(short *)s->c.str.chars;
00087   for (i=0; i<len; i++) fp[i]= sp[i] * factor;
00088   return(f);}
00089 
00090 floatdouble(ctx,n,argv)
00091 context *ctx;
00092 int n;
00093 pointer argv[];
00094 { pointer mod=argv[0];
00095   defun(ctx,"FLOAT2DOUBLE",mod,F2D,NULL);
00096   defun(ctx,"DOUBLE2FLOAT",mod,D2F,NULL);
00097   defun(ctx,"SHORT2FLOAT",mod,S2F,NULL);
00098   }
00099 
00100 


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 18:05:53