Go to the documentation of this file.00001
00002
00003
00004
00005 #include "../c/eus.h"
00006 #include "euslocal.h"
00007 #define TRUE 1
00008 #define NULL 0
00009 #define is_view_num(v) \
00010 (isnum(v)|| isstring(v) || ((v)== T) || ((v) == NIL))
00011
00012 cknumtoint(v)
00013 pointer v;
00014 {
00015 if (isint(v)) return(intval(v));
00016 else if (isflt(v)) return(fltval(v));
00017 else if (isstring(v)) return((int)(v->c.str.chars));
00018 else if (T == v) return(TRUE);
00019 else if (NIL == v) return(NULL);
00020 else error(E_NONUMBER);
00021 }
00022 float cknumtoflt(v)
00023 pointer v;
00024 {
00025 if (isint(v)) return((float)intval(v));
00026 else if (isflt(v)) return(fltval(v));
00027 else error(E_NONUMBER);
00028 }
00029
00030 pointer makebool(v)
00031 long v;
00032 {
00033 if (v) return(T);
00034 else return(NIL);
00035 }
00036
00037 pointer makebnum(v)
00038 register long v;
00039 {
00040 pointer b;
00041 int w;
00042 w = -v;
00043 if ((v > 0) && (v > 0x1fffffff)) {
00044 b = makevector(C_INTVECTOR,1);
00045 b -> c.ivec.iv[0] = v;
00046 }
00047 else if ((w > 0) && (w > 0x1fffffff)) {
00048 b = makevector(C_INTVECTOR,1);
00049 b -> c.ivec.iv[0] = v;
00050 }
00051 else b = makeint(v);
00052 return(b);
00053 }
00054
00055
00056 static int argc;
00057 static float *fargv;
00058 static int *iargv;
00059
00060 trans_argv_iargv(n,argv,main_iargv)
00061 register int n;
00062 register pointer argv[];
00063 register int main_iargv[];
00064 {
00065 iargv = main_iargv;
00066 argc = 0;
00067 while (n-- >0) trans_argv_iargv_aux(*argv++);
00068 return(argc);
00069 }
00070 trans_argv_iargv_aux(a)
00071 register pointer a;
00072 {
00073 register int j,size;
00074 if (is_view_num(a)) { *iargv++ = cknumtoint(a); argc++;}
00075 else if (T == a) { *iargv++ = TRUE; argc++; }
00076 else if (NIL == a) { *iargv++ = NULL; argc++; }
00077 else if (isfltvector(a)) {
00078 size=vecsize(a); argc+= size;
00079 for (j=0; j<size; j++) *iargv++ = (int)a->c.fvec.fv[j];
00080 }
00081 else if (isintvector(a)) {
00082 size=vecsize(a); argc+= size;
00083 for (j=0; j<size; j++) *iargv++ = (int)a->c.ivec.iv[j];
00084 }
00085 else if (isarray(a)) {
00086 trans_argv_iargv_aux(a->c.ary.entity);
00087 }
00088 else if (isvector(a)) {
00089 size=vecsize(a);
00090 for (j=0; j<size; j++) trans_argv_iargv_aux(a->c.vec.v[j]);
00091 }
00092 else if (islist(a)) {
00093 while (islist(a)) {
00094 trans_argv_iargv_aux(ccar(a));
00095 a=ccdr(a);}
00096 }
00097 else error(E_NOINT);
00098 }
00099
00100 trans_argv_fargv(n,argv,main_fargv)
00101 register int n;
00102 register pointer argv[];
00103 register float main_fargv[];
00104 {
00105 fargv = main_fargv;
00106 argc = 0;
00107 while (n-- >0) trans_argv_fargv_aux(*argv++);
00108 return(argc);
00109 }
00110 trans_argv_fargv_aux(a)
00111 register pointer a;
00112 {
00113 register int j,size;
00114 if (is_view_num(a)) {
00115 *fargv++ = (float)cknumtoflt(a); argc++;
00116 }
00117 else if (isfltvector(a)) {
00118 size=vecsize(a); argc += size;
00119 for (j=0; j<size; j++) *fargv++ = a->c.fvec.fv[j];
00120 }
00121 else if (isintvector(a)) {
00122 size=vecsize(a); argc+= size;
00123 for (j=0; j<size; j++) *fargv++ = (float)a->c.ivec.iv[j];
00124 }
00125 else if (isarray(a)) {
00126 trans_argv_fargv_aux(a->c.ary.entity);
00127 }
00128 else if (isvector(a)) {
00129 size=vecsize(a);
00130 for (j=0; j<size; j++) trans_argv_fargv_aux(a->c.vec.v[j]);
00131 }
00132 else if (islist(a)) {
00133 while (islist(a)) {
00134 trans_argv_fargv_aux(ccar(a));
00135 a=ccdr(a);
00136 }
00137 }
00138 else error(E_NONUMBER);
00139 }
00140
00141 trans_argv_farrayargv(n,argv,dimension,farrayargv)
00142 register int n;
00143 register pointer *argv;
00144 register float *farrayargv;
00145 register int dimension;
00146 {
00147 register float fargv[3*256];
00148 register int i,j,size,rem;
00149 size=trans_argv_fargv(n,argv,fargv);
00150
00151
00152
00153 if ((size % dimension) != 0) error(E_MISMATCHARG);
00154 size /= dimension;
00155 for (j=0; j<dimension; j++) {
00156 for (i=0; i<size; i++)
00157 *farrayargv++ = fargv[i*dimension + j];
00158 }
00159 return(size);
00160 }
00161
00162 largv2cargv(n,argv,cargv,from,to)
00163 register int n;
00164 register pointer argv[];
00165 register long cargv[];
00166 int from,to;
00167 {
00168 register int i,cargc=0;
00169 register pointer l;
00170 cargc = trans_argv_iargv(n,argv,cargv);
00171 if ((cargc<from) || (cargc>to)) error(E_MISMATCHARG);
00172 return(cargc);
00173 }