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


euslisp
Author(s): Toshihiro Matsui
autogenerated on Fri Feb 21 2020 03:20:54