00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026 return(ival);}
00027
00028
00029 static putlength(s,len)
00030 pointer s;
00031 unsigned int len;
00032 { if (len<128) writech(s,len);
00033 else if (len<16384) {
00034 writech(s, 0x80 | (len >> 8));
00035 writech(s, len & 0xff);}
00036 else error(E_USER, (pointer)"argument to large");}
00037
00038 static int putarg(s,p)
00039 pointer s,p;
00040 { numunion nu;
00041 register int i,len, elmt;
00042 register unsigned char *bp;
00043
00044 if (isint(p)) {
00045 writech(s, A_LONG); putlong(s,intval(p));}
00046 else if (isflt(p)) {
00047 writech(s, A_FLOAT); nu.fval=fltval(p); putlong(s, nu.ival);}
00048 else {
00049 if (isarray(p)) p=p->c.ary.entity;
00050 if (isvector(p)) {
00051 len=vecsize(p); elmt=elmtypeof(p);
00052 writech(s, A_VECTOR);
00053 bp= p->c.str.chars;
00054 switch(elmt) {
00055 case ELM_BIT: len=(len+7)/8; break;
00056 case ELM_FOREIGN: bp=(unsigned char *)p->c.ivec.iv[0]; break;
00057 case ELM_CHAR: case ELM_BYTE: break;
00058 case ELM_POINTER: error(E_USER, (pointer)"binary vector expected"); break;
00059 case ELM_FLOAT: case ELM_INT: len<<=2; break;}
00060 putlength(s,len);
00061 writestr(s,bp,len); }
00062 else error(E_USER, (pointer)"invalid argument for VXW"); } }
00063
00064 pointer CALL_VXW(context *ctx, int n, pointer argv[])
00065 { int i=0, j, argc=3, len, stat;
00066 pointer con=argv[0], entry=argv[1], result=argv[2];
00067 pointer in,out;
00068 pointer p,result_vec;
00069 numunion rv, nu;
00070
00071 if (!isiostream(con)) error(E_STREAM);
00072 in=con->c.iostream.in; out=con->c.iostream.out;
00073
00074 if (issymbol(entry)) entry= (pointer)getstring(entry);
00075 if (isstring(entry)) {
00076 writech(out, A_SYMBOL);
00077 writech(out, vecsize(entry));
00078 writestr(out, entry->c.str.chars, vecsize(entry));}
00079 else if (isint(entry)) {
00080 writech(out, A_LONG);
00081 putlong(out, intval(entry));}
00082
00083 while (argc<n) {
00084 if (debug) { prinx(ctx, argv[argc],STDOUT); terpri(STDOUT);}
00085 putarg(out, argv[argc++]);}
00086
00087 writech(out, A_END);
00088
00089 if (result==K_INTEGER) writech(out, A_LONG);
00090 else if (result==K_FLOAT) writech(out, A_FLOAT);
00091 else {
00092 if (isarray(result)) result=result->c.ary.entity;
00093 if (isvector(result)) {
00094 writech(out, A_VECTOR);
00095 len=vecsize(result);
00096 if ((elmtypeof(result) == ELM_INT) || (elmtypeof(result) == ELM_FLOAT))
00097 len=len*sizeof(long);
00098 putlength(out,len);}
00099 else error(E_NOVECTOR);}
00100 flushstream(out);
00101
00102
00103 stat=readch(in);
00104 if (stat != (int)NULL) return(cons(ctx, makeint(stat), NIL));
00105
00106
00107 if (result==K_INTEGER)
00108 return(makeint(getlong(in)));
00109 else if (result==K_FLOAT) {
00110 rv.ival=getlong(in);
00111 return(makeflt(rv.fval));}
00112 else if (result==K_STRING) { }
00113 else {
00114 for (i=0; i<len; i++) result->c.str.chars[i]=readch(in);
00115 return(argv[2]);}
00116 }
00117
00118 pointer vxwcom(context *ctx, int n, pointer argv[], pointer env)
00119 { pointer mod = argv[0];
00120 defun(ctx, "VXW",mod,CALL_VXW,NULL);
00121 return(T);
00122 }
00123
00124
00125