Go to the documentation of this file.00001
00002
00003
00004
00005
00006
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)
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