floatdouble.c
Go to the documentation of this file.
1 /*
2 /* FLOAT-VECTOR <---> DOUBLE-VECTOR conversion
3 /* (c)1990 MATSUI Toshihiro, Electrotechnical Laboratory
4 /*
5 /* gcc -c -Di386 -DLinux -w -DGCC -fpic -I/usr/local/eus/include -O sync.c
6 /* ld -shared -o floatdouble.so floatdouble.o
7 */
8 
9 #include "eus.h"
10 extern pointer makefvector();
11 
12 static pointer F2D(ctx,n,argv)
13 context *ctx;
14 int n;
15 pointer argv[];
16 { pointer f=argv[0],d;
17  float *fp;
18  register int i,len;
19  union doublefloat {
20  struct {float low,high;} fval;
21  double dval;
22  } f2d;
23 
24  ckarg2(1,2);
25  if (!isfltvector(f)) error(E_FLOATVECTOR);
26  len=vecsize(f);
27  if (n==1) d=makefvector(len*2);
28  else {
29  d=argv[1];
30  if (!isfltvector(d)) error(E_FLOATVECTOR);
31  if (vecsize(d)<2*len) error(E_ARRAYINDEX);}
32  for (i=0; i<len*2; i++) d->c.fvec.fv[i] = 0.0;
33  fp=d->c.fvec.fv;
34  for (i=0; i<len; i++) {
35  f2d.dval = (double)f->c.fvec.fv[i];
36  *fp++ = f2d.fval.low; *fp++ = f2d.fval.high;}
37  return(d);}
38 
39 static pointer D2F(ctx,n,argv)
40 context *ctx;
41 int n;
42 pointer argv[];
43 { pointer d=argv[0],f;
44  float *fp;
45  register int i,len;
46  union doublefloat {
47  struct {float low,high;} fval;
48  double dval;
49  } f2d;
50 
51  ckarg2(1,2);
52  if (!isfltvector(d)) error(E_FLOATVECTOR);
53  len=(vecsize(d)+1)/2;
54  if (n==1) f=makefvector(len);
55  else {
56  f=argv[1];
57  if (!isfltvector(f)) error(E_FLOATVECTOR);
58  if (vecsize(f)<len) error(E_ARRAYINDEX);}
59  fp=d->c.fvec.fv;
60  for (i=0; i<len; i++) {
61  f2d.fval.low = *fp++; f2d.fval.high = *fp++;
62  f->c.fvec.fv[i]= (float)f2d.dval;}
63  return(f);}
64 
65 pointer S2F(ctx,n,argv) /*short word to float*/
66 context *ctx;
67 int n;
68 pointer argv[];
69 { pointer s=argv[0],f;
70  register float *fp;
71  register short *sp;
72  register int i,len,v;
73  register float factor;
74  numunion nu;
75 
76  ckarg2(1,3);
77  if (!isstring(s)) error(E_NOSTRING);
78  len=(vecsize(s)+1)/2;
79  if (n>=2) factor=ckfltval(argv[1]); else factor=1.0;
80  if (n<3) f=makefvector(len);
81  else {
82  f=argv[2];
83  if (!isfltvector(f)) error(E_FLOATVECTOR);
84  if (vecsize(f)<len) error(E_ARRAYINDEX);}
85  fp=f->c.fvec.fv;
86  sp=(short *)s->c.str.chars;
87  for (i=0; i<len; i++) fp[i]= sp[i] * factor;
88  return(f);}
89 
90 floatdouble(ctx,n,argv)
91 context *ctx;
92 int n;
93 pointer argv[];
94 { pointer mod=argv[0];
95  defun(ctx,"FLOAT2DOUBLE",mod,F2D,NULL);
96  defun(ctx,"DOUBLE2FLOAT",mod,D2F,NULL);
97  defun(ctx,"SHORT2FLOAT",mod,S2F,NULL);
98  }
99 
100 
numunion
Definition: eus.h:428
E_FLOATVECTOR
@ E_FLOATVECTOR
Definition: eus.h:981
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
context
Definition: eus.h:524
s
short s
Definition: structsize.c:2
floatdouble
floatdouble(context *ctx, int n, argv)
Definition: floatdouble.c:90
ckfltval
float ckfltval()
eus.h
F2D
static pointer F2D(context *ctx, int n, argv)
Definition: floatdouble.c:12
E_NOSTRING
@ E_NOSTRING
Definition: eus.h:957
D2F
static pointer D2F(context *ctx, int n, argv)
Definition: floatdouble.c:39
E_ARRAYINDEX
@ E_ARRAYINDEX
Definition: eus.h:967
NULL
#define NULL
Definition: transargv.c:8
d
d
makefvector
pointer makefvector()
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
f
f
cell
Definition: eus.h:381
S2F
pointer S2F(context *ctx, int n, argv)
Definition: floatdouble.c:65
n
GLfloat n[6][3]
Definition: cube.c:15
v
GLfloat v[8][3]
Definition: cube.c:21


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43