1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
/****************************************************************/
/* vxwcom.c
/* rpc communication with VxWorks
/* (c) 1991, Toshihiro Matsui, Electrotechnical Laboratory
/* Copying and modification is free as long as the copied and modified
/* products are also copy/modify-free.
/****************************************************************
#include "eus.h"
#include "vxw_proto.h"
static void putlong(s,i)
pointer s;
long i;
{ unsigned char *ip= (unsigned char *)&i;
writech(s,*ip++); writech(s,*ip++); writech(s,*ip++); writech(s,*ip++);}
static unsigned long getlong(con)
pointer con;
{ register unsigned int ival=0;
ival=readch(con);
ival=(ival<<8)+readch(con);
ival=(ival<<8)+readch(con);
ival=(ival<<8)+readch(con);
/* printf("result=%d\n",ival); */
return(ival);}
static putlength(s,len)
pointer s;
unsigned int len;
{ if (len<128) writech(s,len);
else if (len<16384) {
writech(s, 0x80 | (len >> 8));
writech(s, len & 0xff);}
else error(E_USER, (pointer)"argument to large");}
static int putarg(s,p)
pointer s,p;
{ numunion nu;
register int i,len, elmt;
register unsigned char *bp;
if (isint(p)) {
writech(s, A_LONG); putlong(s,intval(p));}
else if (isflt(p)) {
writech(s, A_FLOAT); nu.fval=fltval(p); putlong(s, nu.ival);}
else {
if (isarray(p)) p=p->c.ary.entity;
if (isvector(p)) {
len=vecsize(p); elmt=elmtypeof(p);
writech(s, A_VECTOR);
bp= p->c.str.chars;
switch(elmt) {
case ELM_BIT: len=(len+7)/8; break;
case ELM_FOREIGN: bp=(unsigned char *)p->c.ivec.iv[0]; break;
case ELM_CHAR: case ELM_BYTE: break;
case ELM_POINTER: error(E_USER, (pointer)"binary vector expected"); break;
case ELM_FLOAT: case ELM_INT: len<<=2; break;}
putlength(s,len);
writestr(s,bp,len); }
else error(E_USER, (pointer)"invalid argument for VXW"); } }
pointer CALL_VXW(context *ctx, int n, pointer argv[])
{ int i=0, j, argc=3, len, stat;
pointer con=argv[0], entry=argv[1], result=argv[2];
pointer in,out;
pointer p,result_vec;
numunion rv, nu;
if (!isiostream(con)) error(E_STREAM);
in=con->c.iostream.in; out=con->c.iostream.out;
if (issymbol(entry)) entry= (pointer)getstring(entry);
if (isstring(entry)) {
writech(out, A_SYMBOL);
writech(out, vecsize(entry));
writestr(out, entry->c.str.chars, vecsize(entry));}
else if (isint(entry)) {
writech(out, A_LONG);
putlong(out, intval(entry));}
while (argc<n) {
if (debug) { prinx(ctx, argv[argc],STDOUT); terpri(STDOUT);}
putarg(out, argv[argc++]);}
writech(out, A_END);
if (result==K_INTEGER) writech(out, A_LONG);
else if (result==K_FLOAT) writech(out, A_FLOAT);
else {
if (isarray(result)) result=result->c.ary.entity;
if (isvector(result)) {
writech(out, A_VECTOR);
len=vecsize(result);
if ((elmtypeof(result) == ELM_INT) || (elmtypeof(result) == ELM_FLOAT))
len=len*sizeof(long);
putlength(out,len);}
else error(E_NOVECTOR);}
flushstream(out);
/*read protocol status*/
stat=readch(in);
if (stat != (int)NULL) return(cons(ctx, makeint(stat), NIL));
/*read result*/
if (result==K_INTEGER)
return(makeint(getlong(in)));
else if (result==K_FLOAT) {
rv.ival=getlong(in);
return(makeflt(rv.fval));}
else if (result==K_STRING) { }
else { /*vector*/
for (i=0; i<len; i++) result->c.str.chars[i]=readch(in);
return(argv[2]);}
}
pointer vxwcom(context *ctx, int n, pointer argv[], pointer env)
{ pointer mod = argv[0];
defun(ctx, "VXW",mod,CALL_VXW,NULL);
return(T);
}
|
