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


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 20:00:44