eusstream.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* eusstream.c
3 /* euLisp stream i/o routines
4 /* (c)T.Matsui
5 /* 1986-Mar
6 /* 1987-Mar extension of string output stream
7 /* 1987-May filestream, socketstream,...
8 /****************************************************************/
9 static char *rcsid="@(#)$Id$";
10 
11 #include <ctype.h>
12 #include <fcntl.h>
13 #include <signal.h>
14 #include <sys/types.h>
15 #if system5
16 #include <sys/ipc.h>
17 #include <sys/msg.h>
18 #endif
19 #include "eus.h"
20 #include <sys/msg.h>
21 
22 extern int errno;
23 int ch[MAXTHREAD]; /*current character*/
24 int written_count[MAXTHREAD];
25 
26 /****************************************************************/
27 /* open and close stream primitives
28 /****************************************************************/
29 
30 pointer openfile(ctx,fname,dir,acsmode,size)
31 register context *ctx;
32 char *fname;
33 int dir,acsmode,size;
34 { int fd,flag;
35  pointer s,si,so,fnamep;
36  extern pointer mkiostream();
37  fd=open(fname, dir, acsmode);
38  if (fd<0) return(NULL);
39  fnamep=makestring(fname,strlen(fname));
40  vpush(fnamep);
41  if (dir & O_RDWR) {
42  si=mkfilestream(ctx,K_IN,makebuffer(size),fd,fnamep);
43  vpush(si);
44  so=mkfilestream(ctx,K_OUT,makebuffer(size),fd,fnamep);
45  s=mkiostream(ctx,vpop(),so);}
46  else if ((dir & 3)==0) {
47  s=mkfilestream(ctx,K_IN,makebuffer(size),fd,fnamep);}
48  else if (dir & O_WRONLY) {
49  s=mkfilestream(ctx,K_OUT,makebuffer(size),fd,fnamep);}
50  vpop(); /*fnamep*/
51  return(s);}
52 
54 pointer s;
55 { int fd,stat;
56  if (s->c.stream.direction==K_OUT) flushstream(s);
57  else if (!isstream(s)) error(E_STREAM);
58  if (pisfilestream(s) && !isint(s->c.fstream.fname)) { /*message queu?*/
59  fd=intval(s->c.fstream.fd);
60  if (fd>=0) stat=close(fd);
61  else stat= -1;
62 /* if (debug) fprintf(stderr,"closestream fd=%d stat=%d\n",fd,(stat?errno:0)); */
63  pointer_update(s->c.stream.direction,NIL);
64  return(stat);}
65  return(0);}
66 
67 /****************************************************************/
68 /* read primitive
69 /****************************************************************/
70 
71 static int fillstream(s)
72 register pointer s;
73 { register int c;
74  pointer lsave;
75  register byte *strbuf;
77 
78  strbuf=(s->c.stream.buffer)->c.str.chars;
79  if (pisfilestream(s)) {
80  if (isint(s->c.fstream.fname)) { /*message queue*/
81  lsave=s->c.stream.buffer->c.str.length;
82  tryqread:
83 /* news doesnot have message queu, what a bsd machine!*/
84 #if !news
85  c=msgrcv(intval(s->c.fstream.fd), /*qid*/
86  strbuf-4,intval(lsave),0,0);
87 #endif
88 #if system5 || Solaris2
89  if (c<0) { breakck; goto tryqread;}
90 #endif
91 #if sun3 || sun4 || vax || apollo || news || sanyo || mips || alpha || Linux
92  breakck;
93 #endif
94  s->c.stream.buffer->c.str.length=lsave;
95  if (c==0) return(EOF);
96  else return(0);}
97  else {
98  tryfread:
99  GC_REGION(c=read(intval(s->c.fstream.fd), strbuf,
100  intval((s->c.stream.buffer)->c.str.length)););
101  if (debug) {
102  printf(";; read; stat=%d errno=%d, intsig=%d\n", c, errno, ctx->intsig);}
103  breakck;
104 #if !Cygwin /* if (c<0) goto tryfread; */
105  if (c<0) goto tryfread;
106 #endif
107  if (c<=0) return(EOF);
108  s->c.stream.tail=makeint(c);
109  return(0);} }
110  else if (s->cix==streamcp.cix) return(EOF); /*string streams cannot fill*/
111  else if (csend(euscontexts[thr_self()], s, K_FILL, 0)==NIL) return(EOF);
112  else return(0);}
113 
114 int readch(s)
115 register pointer s;
116 { register pointer b;
117  register byte *strbuf;
118  register int c;
119 /* if (s->c.stream.direction!=K_IN) return(ch=EOF); */
120  b=s->c.stream.buffer;
121  if (elmtypeof(b)==ELM_FOREIGN) strbuf=(byte *)(b->c.ivec.iv[0]);
122  else strbuf=b->c.str.chars;
123  c=intval(s->c.stream.count);
124  if (c>=intval(s->c.stream.tail)) {
125  if (fillstream(s)==EOF){
126 #if 0
127  fprintf(stderr, "EOF ");
128 #endif
129  return(ch[thr_self()]=EOF);}
130  c=0;}
131  ch[thr_self()]=strbuf[c++];
132  s->c.stream.count=makeint(c);
133 #if 0
134  fprintf(stderr, "%x",ch[thr_self()]);
135 #endif
136  return(ch[thr_self()]);}
137 
139 register pointer s;
140 int ch;
141 { register pointer b;
142  register byte *sb;
143  register int c;
144  if (ch==EOF) return(ch);
145  c=intval(s->c.stream.count);
146  if (c) {
147  b=s->c.stream.buffer;
148  if (elmtypeof(b)==ELM_FOREIGN) sb=(byte *)(b->c.ivec.iv[0]);
149  else sb=b->c.str.chars;
150  sb[--c]=ch;
151  s->c.stream.count=makeint(c);}
152  }
153 
154 
155 /****************************************************************/
156 /* output primitives
157 /****************************************************************/
158 
160 register pointer s;
161 { register int fno,stat,cnt,blen;
162  register pointer lsave,bstr,extstr;
163  context *ctx=euscontexts[thr_self()];
164 
165 // fno=intval(s->c.fstream.fd); // only when isfilestream(s). moved to inside of if(pisfilestream(s))
166  bstr=s->c.stream.buffer;
167  cnt=intval(s->c.stream.count);
168  blen=intval(bstr->c.str.length);
169  if (cnt<=0) return(0); /*no buffer: cannot write*/
170  if (pisfilestream(s)) {
171  fno=intval(s->c.fstream.fd); // moved by ikuo
172  if (isint(s->c.fstream.fname)) {
173  lsave=bstr->c.str.length;
174  bstr->c.str.length=(pointer)mypid;
175 #if !news
176  stat=msgsnd(fno,bstr->c.str.chars-4,cnt,0);
177 #endif
178  breakck;
179  bstr->c.str.length=lsave;}
180  else {
181  tryfwrite:
182  stat=write(fno,bstr->c.str.chars,cnt);
183 #if system5
184  if (stat<0) { breakck; goto tryfwrite;}
185 #endif
186 #if sun3 || sun4 || apollo || vax || news || sanyo || mips || alpha
187  breakck;
188 #endif
189  }
190  if (stat>=0) { s->c.stream.count=makeint(0); return(0);}
191  else return(-1);}
192  else if (s->cix==streamcp.cix) {
193  if (blen==cnt) { /*extend string output stream*/
194  if (blen>=1000000) error(E_LONGSTRING);
195  extstr=makebuffer(cnt*2);
196  memcpy(extstr->c.str.chars, bstr->c.str.chars, cnt);
197  /* substituted bcopy(bstr->c.str.chars,extstr->c.str.chars,cnt);*/
198  pointer_update(s->c.stream.buffer,extstr);
199  s->c.stream.tail=makeint(cnt*2-1);}
200  return(0); }
201  else if (csend(euscontexts[thr_self()], s,K_FLUSH,0)==NIL) return(-1); else return(0);
202  }
203 
205 register pointer s;
206 register byte ch;
207 { register int c,slen;
208  register byte *strbuf;
209  c=intval(s->c.stream.count);
210  strbuf=(s->c.stream.buffer)->c.str.chars;
211  slen=intval((s->c.stream.buffer)->c.str.length);
212  if (c>=slen) {
213  if (flushstream(s)<0) return(-1);
214  c=intval(s->c.stream.count);
215  strbuf=(s->c.stream.buffer)->c.str.chars;}
216  strbuf[c++]=ch; s->c.stream.count=makeint(c); written_count[thr_self()]++; }
217 
218 int writestr(s,mes,len) /* write string */
219 register pointer s; /*stream*/
220 register byte *mes;
221 register int len;
222 { register int bcount,bsize,i=0,count;
223  register byte *strbuf;
224 
225  bcount=intval(s->c.stream.count);
226  strbuf=(s->c.stream.buffer)->c.str.chars;
227  bsize=intval((s->c.stream.buffer)->c.str.length);
228  while (len>0) {
229  if (bcount>=bsize) {
230  if (flushstream(s)<0) return(-1);
231  bsize=intval((s->c.stream.buffer)->c.str.length);
232  bcount=intval(s->c.stream.count);
233  strbuf=(s->c.stream.buffer)->c.str.chars;}
234  count=min(len,bsize-bcount);
235  memcpy(&strbuf[bcount], &mes[i], count);
236  /* substituted bcopy(&mes[i],&strbuf[bcount],count); */
237  i+=count; len-=count; bcount+=count;
238  s->c.stream.count=makeint(bcount);}
239  written_count[thr_self()]+=i;
240  }
241 
if
if(n==1)
Definition: unixcall.c:492
mkfilestream
pointer mkfilestream(context *, pointer, pointer, int, pointer)
Definition: makes.c:253
NIL
pointer NIL
Definition: eus.c:110
flushstream
int flushstream(pointer s)
Definition: eusstream.c:159
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
s
short s
Definition: structsize.c:2
fillstream
static int fillstream(pointer s)
Definition: eusstream.c:71
intval
#define intval(p)
Definition: sfttest.c:1
min
#define min(x, y)
Definition: rmflags.c:17
pointer
struct cell * pointer
Definition: eus.h:165
eus.h
string::length
pointer length
Definition: eus.h:211
makestring
pointer makestring(char *, int)
Definition: makes.c:147
errno
int errno
E_LONGSTRING
@ E_LONGSTRING
Definition: eus.h:947
ch
int ch[MAXTHREAD]
Definition: eusstream.c:23
cell::cellunion::ivec
struct intvector ivec
Definition: eus.h:416
makebuffer
pointer makebuffer(int)
Definition: makes.c:140
string::chars
byte chars[1]
Definition: eus.h:212
closestream
int closestream(pointer s)
Definition: eusstream.c:53
mypid
eusinteger_t mypid
Definition: eus.c:38
rcsid
static char * rcsid
Definition: eusstream.c:9
cell::c
union cell::cellunion c
unreadch
int unreadch(pointer s, int ch)
Definition: eusstream.c:138
streamcp
cixpair streamcp
Definition: eus.c:74
writestr
int writestr(pointer s, byte *mes, int len)
Definition: eusstream.c:218
NULL
#define NULL
Definition: transargv.c:8
cixpair::cix
short cix
Definition: eus.h:453
euscontexts
context * euscontexts[MAXTHREAD]
Definition: eus.c:105
written_count
int written_count[MAXTHREAD]
Definition: eusstream.c:24
csend
pointer csend(context *,...)
E_STREAM
@ E_STREAM
Definition: eus.h:954
K_IN
pointer K_IN
Definition: eus.c:130
so
static char so[4]
Definition: helpsub.c:26
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
count
int count
Definition: thrtest.c:11
K_OUT
pointer K_OUT
Definition: eus.c:130
cell
Definition: eus.h:381
openfile
pointer openfile(context *ctx, char *fname, int dir, int acsmode, int size)
Definition: eusstream.c:30
writech
int writech(pointer s, byte ch)
Definition: eusstream.c:204
GC_REGION
#define GC_REGION(cmp_statement)
Definition: eus.h:173
readch
int readch(pointer s)
Definition: eusstream.c:114
mkiostream
pointer mkiostream(context *, pointer, pointer)
Definition: makes.c:269
K_FILL
pointer K_FILL
Definition: eus.c:131
intvector::iv
eusinteger_t iv[1]
Definition: eus.h:305
K_FLUSH
pointer K_FLUSH
Definition: eus.c:131
cell::cellunion::str
struct string str
Definition: eus.h:402
thr_self
unsigned int thr_self()
Definition: eus.c:25
context::intsig
int intsig
Definition: eus.h:546


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43