unixcall.old.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* unixcall.c
3 /* 1986-Jul-6 original for Ustation
4 /* 1986-Dec process id's, file changes, syserrlist
5 /* 1987-Feb dup,isatty
6 /* 1987-Apr getwd,stat,time
7 /* 1988-Jan,Feb socket, select
8 /* 1988-Dec ioctl
9 /* 1990-Mar VxWorks
10 /* Copyright(c) 1988 MATSUI Toshihiro, Electrotechnical Laboratory.
11 /****************************************************************/
12 
13 static char *rcsid="@(#)$Id$";
14 
15 /* SunOS's gettimeofday used to accept only one argument.
16 #ifdef Solaris2
17 #define _SVID_GETTOD
18 #endif
19 */
20 
21 #include "eus.h"
22 
23 #if vxworks
24 #define NSIG NUM_SIGNALS
25 #define SIG_DFL 0
26 #include <sigLib.h>
27 #include <socket.h>
28 #include <in.h>
29 #else
30 #include <sys/types.h>
31 #include <sys/times.h>
32 #include <sys/stat.h>
33 #include <signal.h>
34 #include <sys/ioctl.h>
35 #include <sys/time.h>
36 #include <sys/socket.h>
37 #include <sys/un.h>
38 #include <netinet/in.h>
39 #include <netdb.h>
40 #include <sys/mman.h>
41 #include <string.h>
42 #endif
43 
44 /*SONY/news doesn't have message queu ipc facilities*/
45 #if !vxworks
46 #include <sys/ipc.h>
47 #include <sys/msg.h>
48 #endif
49 
50 #if SunOS4_1 || (mips && !IRIX && !IRIX6)
51 /* Sun likes to change ioccom constants frequently. */
52 #define IOC_VOID _IOC_VOID
53 #define IOC_IN _IOC_IN
54 #define IOC_OUT _IOC_OUT
55 #define IOC_INOUT _IOC_INOUT
56 #endif
57 
58 #if Linux
59 #define IOC_VOID 0
60 #endif
61 
62 #if Solaris2 || Linux || alpha
63 #include <errno.h>
64 #include <dirent.h>
65 #else
66 extern int errno;
67 #endif
68 
69 #if Linux
70 #define IOC_VOID 0
71 #endif
72 
73 
74 #if alpha
75 #include <sys/utsname.h>
76 #include <sys/types.h>
77 #include <sys/ipc.h>
78 #include <sys/msg.h>
79 #endif
80 
81 #if system5 || Linux
82 #include <sys/utsname.h>
83 #endif
84 
85 extern int sys_nerr;
86 /*extern char *sys_errlist[];*/
87 extern char *tzname[2];
88 extern time_t timezone, altzone; /*long*/
89 extern int daylight;
90 
91 extern pointer eussigvec[NSIG];
92 
93 extern int coerceintval(pointer);
94 
95 
96 /***************** times and status *****************/
97 
98 #if !vxworks
99 pointer PTIMES(ctx,n,argv)
100 register context *ctx;
101 int n;
102 pointer argv[];
103 { struct tms buffer;
104  register pointer t;
105  long et;
106  ckarg(0);
107  et=times(&buffer);
108  t=cons(ctx,makeint(buffer.tms_cstime),NIL);
109  t=cons(ctx,makeint(buffer.tms_cutime),t);
110  t=cons(ctx,makeint(buffer.tms_stime),t);
111  t=cons(ctx,makeint(buffer.tms_utime),t);
112  t=cons(ctx,mkbigint(et),t);
113  return(t);}
114 
115 pointer RUNTIME(ctx,n,argv)
116 register context *ctx;
117 int n;
118 pointer argv[];
119 { struct tms buffer;
120  ckarg(0);
121  times(&buffer);
122  return(makeint(buffer.tms_utime+buffer.tms_stime));}
123 
124 pointer LOCALTIME(ctx,n,argv)
125 register context *ctx;
126 pointer argv[];
127 { long clock;
128  struct tm *tms;
129  pointer timevec;
130  pointer *tv;
131  pointer tz0, tz1, tz;
132 
133  if (n==1) clock=coerceintval(argv[0]);
134  else clock=time(0);
135  tms=localtime((time_t *)&clock);
136  timevec=makevector(C_VECTOR,10);
137  vpush(timevec);
138  tz0=makestring(tzname[0],strlen(tzname[0]));
139  vpush(tz0);
140  tz1=makestring(tzname[1],strlen(tzname[1]));
141  vpush(tz1);
142  tz=cons(ctx, tz1, NIL);
143  tz=cons(ctx, tz0, tz);
144  tv=timevec->c.vec.v;
145  tv[0]=makeint(tms->tm_sec);
146  tv[1]=makeint(tms->tm_min);
147  tv[2]=makeint(tms->tm_hour);
148  tv[3]=makeint(tms->tm_mday);
149  tv[4]=makeint(tms->tm_mon);
150  tv[5]=makeint(tms->tm_year);
151  tv[6]=makeint(tms->tm_wday);
152  tv[7]=makeint(tms->tm_yday);
153  tv[8]=(tms->tm_isdst>0)?T:NIL;
154  tv[9]=tz;
155  vpop(); vpop(); vpop();
156  return(timevec);}
157 
158 pointer ASCTIME(ctx,n,argv)
159 register context *ctx;
160 int n;
161 register pointer argv[];
162 { register char *at;
163  struct tm tms1, *tms;
164  pointer a=argv[0];
165  int i;
166 
167  ckarg(1);
168  if (isintvector(argv[0])) tms=(struct tm *)a->c.ivec.iv;
169  else if (isvector(a)) {
170  tms1.tm_sec=ckintval(a->c.vec.v[0]);
171  tms1.tm_min=ckintval(a->c.vec.v[1]);
172  tms1.tm_hour=ckintval(a->c.vec.v[2]);
173  tms1.tm_mday=ckintval(a->c.vec.v[3]);
174  tms1.tm_mon=ckintval(a->c.vec.v[4]);
175  tms1.tm_year=ckintval(a->c.vec.v[5]);
176  tms1.tm_wday=ckintval(a->c.vec.v[6]);
177  /* tms1.tm_yday=ckintval(a->c.vec.v[7]); */
178  tms1.tm_isdst=(a->c.vec.v[8]==NIL)?0:1;
179  tms= &tms1; }
180  else error(E_NOINTVECTOR);
181  at=asctime(tms);
182  return(makestring(at,strlen(at)));}
183 
184 #if !Solaris2
185 pointer GETRUSAGE(ctx,n,argv)
186 register context *ctx;
187 int n; pointer argv[];
188 { register int who,i;
189  long rusage[18];
190  float utime,stime;
191  register pointer r=NIL;
192  numunion nu;
193 
194  ckarg(1); who=ckintval(argv[0]);
195  getrusage(who,rusage);
196  utime=rusage[0]+rusage[1]*1.0e-6;
197  stime=rusage[2]+rusage[3]*1.0e-6;
198  for (i=17; i>=4; i--) r=cons(ctx,makeint(rusage[i]),r);
199  r=cons(ctx,makeflt(stime),r); r=cons(ctx,makeflt(utime),r);
200  /*(utime stime maxrss ixrss idrss isrss page-reclaims page-faults swap
201  inblock outblock msgsnd msgrcv nsignals
202  voluntary-context-switch involuntary-context-switch) */
203  return(r);}
204 
206 register context *ctx;
207 int n; pointer argv[];
208 { ckarg(0);
209  return(makeint(getpagesize())); }
210 
211 #endif
212 
214 register context *ctx;
215 int n;
216 register pointer argv[];
217 { struct timeval /*{long tv_sec, tv_usec;}*/ tm;
218  float ftime;
219  pointer p;
220 
221  /* (sec usec timezone daylight) */
222  /* timezone is seconds west to the GMT */
223  gettimeofday(&tm, 0);
224  p=cons(ctx, makeint(daylight), NIL);
225  p=cons(ctx, makeint(timezone),p);
226  p=cons(ctx, mkbigint(tm.tv_usec), p);
227  p=cons(ctx, mkbigint(tm.tv_sec), p);
228  return(p);}
229 
230 pointer GETITIMER(ctx,n,argv)
231 register context *ctx;
232 int n;
233 register pointer argv[];
234 { int stat;
235  struct itimerval tmval;
236  float interval,value;
237  numunion nu;
238  ckarg(1);
239  stat=getitimer(ckintval(argv[0]), &tmval);
240  if (stat<0) return(NIL);
241  interval=tmval.it_interval.tv_sec + ( tmval.it_interval.tv_usec*1.0E-6);
242  value=tmval.it_value.tv_sec + (tmval.it_value.tv_usec*1.0E-6);
243  return(cons(ctx,makeflt(value),
244  cons(ctx,makeflt(interval),NIL)));}
245 
246 pointer SETITIMER(ctx,n,argv)
247 register context *ctx;
248 int n;
249 register pointer argv[];
250 { int stat;
251  pointer result=NIL;
252  struct itimerval tmval,oldtmval;
253  float interval,value;
254  numunion nu;
255 
256  ckarg(3);
257  value=ckfltval(argv[1]); interval=ckfltval(argv[2]);
258  tmval.it_value.tv_sec=value;
259  tmval.it_value.tv_usec=(value-tmval.it_value.tv_sec)*1.0E6;
260  tmval.it_interval.tv_sec=interval;
261  tmval.it_interval.tv_usec=(interval-tmval.it_interval.tv_sec)*1.0E6;
262  stat=setitimer(ckintval(argv[0]), &tmval, &oldtmval);
263  if (stat<0) return(result);
264  interval=oldtmval.it_interval.tv_sec + (oldtmval.it_interval.tv_usec*1.0E-6);
265  value=oldtmval.it_value.tv_sec + (oldtmval.it_value.tv_usec*1.0E-6);
266  return(cons(ctx,makeflt(interval),
267  cons(ctx,makeflt(value),result)));}
268 #endif /* ! vxworks */
269 
270 /****************************************************************/
271 /* signal handling
272 /****************************************************************/
273 
274 #ifdef SIGADDSET
275 #undef SIGADDSET
276 #endif
277 #ifdef SIGDELSET
278 #undef SIGDELSET
279 #endif
280 
281 pointer SIGADDSET(ctx,n,argv)
282 register context *ctx;
283 int n;
284 register pointer argv[];
285 { int signum;
286  sigset_t *set;
287  ckarg(2);
288  signum=ckintval(argv[1]);
289  if (isvector(argv[0]) &&
290  ((elmtypeof(argv[0])==ELM_INT) || (elmtypeof(argv[0])==ELM_BIT))) {
291  set=(sigset_t *)argv[0]->c.ivec.iv;
292  sigaddset(set, signum);
293  return(argv[0]);}
294  else error(E_USER,(pointer)"integer/bit vector expected for sigaddset");
295  }
296 
297 pointer SIGDELSET(ctx,n,argv)
298 register context *ctx;
299 int n;
300 register pointer argv[];
301 { int signum;
302  sigset_t *set;
303  ckarg(2);
304  signum=ckintval(argv[1]);
305  if (isvector(argv[0]) &&
306  ((elmtypeof(argv[0])==ELM_INT) || (elmtypeof(argv[0])==ELM_BIT))) {
307  set=(sigset_t *)argv[0]->c.ivec.iv;
308  sigdelset(set, signum);
309  return(argv[0]);}
310  else error(E_USER,(pointer)"integer/bit vector expected for sigaddset");
311  }
312 
314 context *ctx;
315 int n;
316 pointer argv[];
317 { sigset_t *set, *oset;
318  int how, stat;
319  ckarg2(2,3);
320  how=ckintval(argv[0]);
321  if (isvector(argv[1]) &&
322  ((elmtypeof(argv[1])==ELM_INT) || (elmtypeof(argv[1])==ELM_BIT))) {
323  set=(sigset_t *)argv[1]->c.ivec.iv;
324  if (isvector(argv[2]) &&
325  ((elmtypeof(argv[2])==ELM_INT) || (elmtypeof(argv[2])==ELM_BIT)))
326  oset=(sigset_t *)argv[2]->c.ivec.iv;
327  else oset=(sigset_t *)0;
328  stat=sigprocmask(how, set, oset);
329  if (stat==0) return(T); else return(makeint(-errno));
330  }
331  else error(E_USER,(pointer)"integer/bit vector expected for sigprocmask");
332  }
333 
334 pointer KILL(ctx,n,argv)
335 register context *ctx;
336 int n;
337 register pointer argv[];
338 { ckarg(2);
339  return(makeint(kill(ckintval(argv[0]),ckintval(argv[1]))));}
340 
341 #if Solaris2 || Linux || IRIX || IRIX6
342 pointer SIGNAL(ctx,n,argv)
343 register context *ctx;
344 int n;
345 pointer argv[];
346 { register int s,i;eusinteger_t f;
347  struct sigaction sv;
348  register pointer a=argv[1],oldval;
349  extern void eusint();
350 
351  ckarg2(1,3);
352  s=min(ckintval(argv[0]),NSIG-1);
353  oldval=eussigvec[s];
354  if (n==1) return(oldval);
355  if (isint(a)) { f=max(1,intval(a)); eussigvec[s]=NIL;}
356  else { f=(eusinteger_t)eusint; eussigvec[s]=a;}
357  sv.sa_handler= (void (*)())f;
358 #if Linux
359 
360 #if LIB6
361  for (i=0; i< _SIGSET_NWORDS; i++) sv.sa_mask.__val[i]=0;
362 #else
363  /* old type sigmask */
364  sv.sa_mask=0;
365 #endif
366 /*LIB6*/
367 
368 #elif (IRIX || IRIX6) && !IRIX6_2
369  for (i=0; i<4; i++) sv.sa_mask.sigbits[i]=0;
370 #else
371  for (i=0; i<4; i++) sv.sa_mask.__sigbits[i]=0;
372 #endif
373 
374  if (n==3) sv.sa_flags= ckintval(argv[2]);
375  else sv.sa_flags=0;
376  /* printf("signal %d flag=%d\n", s, sv.sa_flags); */
377  s=sigaction(s,&sv,0);
378  if (s== -1) return(makeint(-errno)); else return(oldval);
379  }
380 
381 #else
382 pointer SIGNAL(ctx,n,argv)
383 register context *ctx;
384 int n;
385 pointer argv[];
386 { register int s;eusinteger_t f;
387  struct sigvec sv;
388  register pointer a=argv[1],oldval;
389  extern void eusint();
390 
391  ckarg2(1,3);
392  s=min(ckintval(argv[0]),NSIG-1);
393  oldval=eussigvec[s];
394  if (n==1) return(oldval);
395  if (isint(a)) { f=max(1,intval(a)); eussigvec[s]=NIL;}
396  else { f=(eusinteger_t)eusint; eussigvec[s]=a;}/* ???? */
397  sv.sv_handler=(void (*)())f;
398  sv.sv_mask=0; /*sigmask(s)???;*/
399 /*news doesn't have system5 compatible signal handling option*/
400 #if sun3 || sun4 || mips || alpha
401  if (n==3) sv.sv_flags=ckintval(argv[2]);
402  else sv.sv_flags=0;
403 #endif
404  s=sigvec(s,&sv,0);
405  if (s== -1) return(makeint(-errno)); else return(oldval);
406  }
407 
408 #endif
409 
410 #if !vxworks
411 
412 pointer WAIT(ctx,n,argv)
413 register context *ctx;
414 int n;
415 pointer argv[];
416 { int completion=0, stat;
417  stat = wait(&completion);
418  return(cons(ctx,makeint(stat),
419  cons(ctx,makeint(completion),NIL)));}
420 
421 pointer ALARM(ctx,n,argv)
422 register context *ctx;
423 int n; pointer argv[];
424 { ckarg(1);
425  return(makeint(alarm(ckintval(argv[0]))));}
426 
427 
428 #if sun3 || sun4 || news || sanyo || alpha
429 #if !Solaris2
430 pointer UALARM(ctx,n,argv)
431 register context *ctx;
432 int n; pointer argv[];
433 { ckarg(2);
434  return(makeint(ualarm(ckintval(argv[0]), ckintval(argv[1]))));}
435 #endif
436 #endif
437 
438 #endif
439 
440 /**********************************************/
441 /* process, user, and group identification
442 /**********************************************/
443 
444 pointer GETPID(ctx,n,argv)
445 register context *ctx;
446 int n;
447 pointer *argv; /* unused argument */
448 { ckarg(0);
449  return(makeint(getpid()));}
450 
451 #if !vxworks
452 pointer GETPPID(ctx,n,argv)
453 register context *ctx;
454 int n;
455 pointer argv[];
456 { ckarg(0);
457  return(makeint(getppid()));}
458 
459 pointer GETPGRP(ctx,n,argv)
460 register context *ctx;
461 int n;
462 pointer argv[];
463 #if system5 | Linux
464 { ckarg(0);
465  return(makeint(getpgrp()));}
466 #else
467 { int pid;
468  if (n==1) pid=ckintval(argv[0]);
469  else pid=getpid();
470  return(makeint(getpgrp(pid)));}
471 #endif
472 
473 pointer SETPGRP(context *ctx, int n, pointer *argv)
474 #if system5 | Linux
475 { ckarg(0);
476  return(makeint(setpgrp()));}
477 #else
478 { int pid;
479  ckarg(2);
480  return(makeint(setpgrp(ckintval(argv[0]),ckintval(argv[1]))));}
481 #endif
482 
483 pointer GETUID(context *ctx, int n, pointer *argv)
484 { ckarg(0);
485  return(makeint(getuid()));}
486 
487 pointer GETEUID(ctx,n,argv)
488 register context *ctx;
489 int n;
490 pointer argv[];
491 { ckarg(0);
492  return(makeint(geteuid()));}
493 
494 pointer GETGID(ctx,n,argv)
495 register context *ctx;
496 int n;
497 pointer argv[];
498 { ckarg(0);
499  return(makeint(getgid()));}
500 
501 pointer GETEGID(ctx,n,argv)
502 register context *ctx;
503 int n;
504 pointer argv[];
505 { ckarg(0);
506  return(makeint(getegid()));}
507 
508 pointer SETUID(ctx,n,argv)
509 register context *ctx;
510 int n;
511 pointer argv[];
512 { ckarg(1);
513  n=setuid(ckintval(argv[0]));
514  if (n<0) return(makeint(errno)); else return(T);}
515 
516 pointer SETGID(ctx,n,argv)
517 register context *ctx;
518 int n;
519 pointer argv[];
520 { ckarg(1);
521  n=setgid(ckintval(argv[0]));
522  if (n<0) return(makeint(errno)); else return(T);}
523 
524 #endif
526 #if system5 || Linux
527 pointer UNAME(ctx,n,argv)
528 register context *ctx;
529 int n;
530 pointer *argv;
531 { struct utsname u;
532  pointer s;
533  ckarg(0);
534  uname(&u);
535  vpush(makestring(u.sysname,strlen(u.sysname)));
536  vpush(makestring(u.nodename,strlen(u.nodename)));
537  vpush(makestring(u.release,strlen(u.release)));
538  vpush(makestring(u.version,strlen(u.version)));
539  vpush(makestring(u.machine,strlen(u.machine)));
540  s=stacknlist(ctx,5);
541  return(s);}
542 #endif
543 
544 /****************************************************************/
545 /* process creation and deletion
546 /****************************************************************/
547 #if !vxworks
548 pointer FORK(ctx,n,argv)
549 register context *ctx;
550 int n;
551 pointer *argv;
552 { ckarg(0);
553  return(makeint(fork()));
554  }
555 
556 #if Solaris2
557 pointer FORK1(ctx,n,argv)
558 register context *ctx;
559 int n;
560 pointer *argv;
561 { ckarg(0);
562  return(makeint(fork1()));
563  }
564 #endif
565 
566 #if sun3 || sun4 || vax || news || sanyo || (mips && !IRIX && !IRIX6) || i386 || alpha
567 pointer VFORK(ctx,n,argv)
568 register context *ctx;
569 int n;
570 pointer *argv;
571 { ckarg(0);
572  return(makeint(vfork()));}
573 #endif
574 
575 pointer EXEC(ctx,n,argv)
576 register context *ctx;
577 int n;
578 pointer *argv;
579 { byte *exeargv[512];
580  int i=0,stat;
581  if (n>512) error(E_MISMATCHARG);
582  while (i<n) {
583  exeargv[i]=Getstring(argv[i])->c.str.chars;
584  i++;}
585  exeargv[i]=0;
586  stat=execvp(exeargv[0],(char **)exeargv);
587  return(makeint(-errno));}
588 
589 #if !Solaris2
590 static pointer SETPRIORITY(ctx,n,argv)
591 register context *ctx;
592 int n;
593 pointer *argv;
594 /* (SETPRIORITY which who priority)
595  which 0:process, 1:process-group, 2:user
596  who 0:self, others pid, pgrp-id user-id */
597 { ckarg(3);
598  return(makeint(setpriority(ckintval(argv[0]),
599  ckintval(argv[1]),
600  ckintval(argv[2]))));}
601 
602 static pointer GETPRIORITY(ctx,n,argv)
603 register context *ctx;
604 int n;
605 pointer *argv;
606 /* (GETPRIORITY which who) */
607 { ckarg(2);
608  return(makeint(getpriority(ckintval(argv[0]), ckintval(argv[1]))));}
609 #endif
610 #endif
612 pointer EXIT(ctx,n,argv)
613 register context *ctx;
614 int n;
615 pointer *argv;
616 { pointer exithook=speval(QEXITHOOK);
617 /*
618  Exit function can not finish threads which create in Euslisp
619 on SunOS 4.1. So we use thr_exit function on SunOS 4.1.
620 */
621 #if SunOS4_1 /* changed by H.Nakagaki at 28-Jun-1995 */
622  if (n==0) thr_exit(0);
623  else thr_exit(ckintval(argv[0]));
624 #else
625  if (exithook != NIL) {
626  ufuncall(ctx,exithook,exithook,(pointer)(ctx->vsp),0,0);}
627  if (n==0) exit(0);
628  else exit(ckintval(argv[0]));
629 #endif
630 }
631 
632 
633 /****************************************************************/
634 /* unix raw I/O and file systems
635 /****************************************************************/
636 
637 pointer UNIXREAD(ctx,n,argv)
638 register context *ctx;
639 int n;
640 pointer argv[];
641 /* (unix:read stream [length]) */
642 /* (unix:read fd buffer [length [offset]]) */
643 #if (WORD_SIZE == 64)
644 { register int fd,offset=0;
645  register long int size;
646 #else
647 { register int fd,size,offset=0;
648 #endif
649  register pointer strm,buf,count;
650  byte *bufp;
651 
652  ckarg2(1,4);
653  strm=argv[0];
654  if (isiostream(strm)) strm=strm->c.iostream.in;
655  if (isfilestream(strm)) {
656  if (strm->c.stream.direction!=K_IN) error(E_IODIRECTION);
657  if (isint(strm->c.fstream.fname)) error(E_STREAM);
658  buf=strm->c.fstream.buffer;
659  bufp=buf->c.str.chars;
660  fd=intval(strm->c.fstream.fd);
661  if (n==2) size=min(strlength(buf),ckintval(argv[1]));
662  else size=strlength(buf);}
663  else if (isint(strm)) {
664  fd=intval(strm);
665  buf=argv[1];
666  if (isvector(buf) && (elmtypeof(buf)==ELM_FOREIGN))
667  bufp=buf->c.foreign.chars;
668  else if (isstring(buf)) bufp=buf->c.str.chars;
669  else error(E_NOSTRING);
670  if (n>=3) size=min(strlength(buf),ckintval(argv[2]));
671  else size=strlength(buf);
672  if (n==4) offset=ckintval(argv[3]);}
673  else error(E_STREAM);
674  size=read(fd, &bufp[offset],size);
675  count=makeint(size);
676  if (isstream(strm)) {
677  strm->c.stream.count=0; strm->c.stream.tail=count;}
678  if (size<0) return(makeint(-errno));
679  else return(count);}
680 
681 pointer UNIXWRITE(ctx,n,argv)
682 register context *ctx;
683 register int n;
684 pointer *argv;
685 /* (unix:write fd string [count])
686  (unix:write stream string [count]) */
687 { register pointer strm,buf;
688  register int size,fd;
689  byte *bufp;
690  ckarg2(2,3);
691  strm=argv[0];
692  if (isiostream(strm)) strm=strm->c.iostream.out;
693  if (isfilestream(strm)) {
694  if (strm->c.stream.direction!=K_OUT) error(E_IODIRECTION);
695  if (isint(strm->c.fstream.fname)) error(E_STREAM);
696  fd=intval(strm->c.fstream.fd);}
697  else if (isint(strm)) fd=intval(strm);
698  else error(E_STREAM);
699  buf=argv[1];
700  if (isvector(buf) && (elmtypeof(buf)==ELM_FOREIGN))
701  bufp=buf->c.foreign.chars;
702  else if (isstring(buf)) bufp=buf->c.str.chars;
703  else error(E_NOSTRING);
704  size=strlength(buf);
705  if (n==3) size=min(size,ckintval(argv[2]));
706  size=write(fd,bufp,size);
707  return(makeint(size));}
708 
709 
710 pointer UNIXCLOSE(ctx,n,argv)
711 register context *ctx;
712 int n;
713 pointer argv[];
714 { ckarg(1);
715  if (close(ckintval(argv[0]))==0) return(T); else return(makeint(errno));}
716 
717 
718 pointer LOCKF(ctx,n,argv)
719 register context *ctx;
720 int n;
721 pointer argv[];
722 { register pointer a=argv[0];
723  int fd,func,size,result;
724  ckarg2(2,3);
725  if (isiostream(a)) a=a->c.iostream.out;
726  if (isfilestream(a)) fd=intval(a->c.fstream.fd);
727  else if (isint(argv[0])) fd=intval(argv[0]);
728  else error(E_STREAM);
729  func= ckintval(argv[1]);
730  if (n==3) size=ckintval(argv[2]);
731  else size=0;
732  result=lockf(fd,func,size);
733  return(makeint(result));}
734 
735 pointer FCNTL(ctx,n,argv)
736 register context *ctx;
737 int n;
738 pointer argv[];
739 { register pointer a=argv[0]; int fd,result;
740  ckarg(3);
741  if (isiostream(a)) a=a->c.iostream.in;
742  if (isfilestream(a)) fd=intval(a->c.fstream.fd);
743  else if (isint(argv[0])) fd=intval(argv[0]);
744  else error(E_STREAM);
745  result=fcntl(fd,ckintval(argv[1]),ckintval(argv[2]));
746  return(makeint(result));}
747 
748 
749 pointer IOCTL(ctx,n,argv)
750 register context *ctx;
751 int n;
752 register pointer argv[];
753 { register pointer strm;
754  eusinteger_t ctlarg;
755  int request;
756  int fd;
757  ckarg(3);
758  strm=argv[0];
759  if (isiostream(strm)) strm=strm->c.iostream.out;
760  if (isfilestream(strm)) {
761  fd=intval(strm->c.fstream.fd);
762  if (isint(strm->c.fstream.fname)) error(E_STREAM);}
763  else fd=ckintval(argv[0]);
764  if (isint(argv[1])) request=ckintval(argv[1]);
765  else if (isflt(argv[1])) error(E_NOINT);
766  else request=argv[1]->c.ivec.iv[0];
767  if (isstring(argv[2])) ctlarg=(eusinteger_t)(argv[2]->c.str.chars);/* ???? */
768  else ctlarg=ckintval(argv[2]);
769  return(makeint(ioctl(fd,request,ctlarg)));
770  }
771 
772 
773 #if !vxworks && !Solaris2
774 int bytesize(p)
775 pointer p;
776 { register int s=vecsize(p);
777  switch (elmtypeof(p)) {
778  case ELM_BIT: return((s+7)/8);
779  case ELM_BYTE: case ELM_CHAR: case ELM_FOREIGN: return(s);
780  case ELM_FLOAT: return(s*sizeof(float));
781  case ELM_INT: return(s*sizeof(int));
782  default: return(s*sizeof(pointer));}}
783 
784 #if Linux_ppc
785 #define IOC_IN _IOC_READ
786 #define IOC_OUT _IOC_WRITE
787 #define IOC_INOUT (IOC_IN | IOC_OUT)
788 #endif
789 
790 
791 pointer IOCTL_(ctx,n,argv)
792 register context *ctx;
793 /* (UNIX:IOCTL_ stream command1 command2) */
794 /* equivalent to C's ioctl(dev, _IO(command1, command2), addr) */
795 int n;
796 register pointer argv[];
797 { register pointer strm;
798  int size=0,x,y,fd;
799  eusinteger_t addr;
800  ckarg(3);
801  strm=argv[0];
802  if (isiostream(strm)) strm=strm->c.iostream.out;
803  if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
804  else fd=ckintval(strm);
805  if (isint(strm->c.fstream.fname)) error(E_STREAM);
806  x=ckintval(argv[1]); y=ckintval(argv[2]);
807 #if alpha || Linux_ppc
808  if (ioctl(fd,_IO(x, y), addr))
809 #else
810  if (ioctl(fd,IOC_VOID | (size<<16) | (x<<8) | y, addr))
811 #endif
812  return(makeint(-errno));
813  else return(T); }
814 
815 pointer IOCTL_R(ctx,n,argv)
816 register context *ctx;
817 /* (UNIX:IOCTL_R stream x y buffer [size]) */
818 /* equivalent to C's ioctl(dev, _IORN(size, x, y), addr) */
819 int n;
820 register pointer argv[];
821 { register pointer strm;
822  int size,x,y,fd;
823  eusinteger_t addr;
824  ckarg2(4,5);
825  strm=argv[0];
826  if (isiostream(strm)) strm=strm->c.iostream.out;
827  if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
828  else fd=ckintval(strm);
829  if (isint(strm->c.fstream.fname)) error(E_STREAM);
830  x=ckintval(argv[1]); y=ckintval(argv[2]);
831  if (isstring(argv[3]) || isintvector(argv[3]))
832  addr=(eusinteger_t)(argv[3]->c.str.chars);/* ???? */
833  else error(E_NOSTRING);
834  if (n==5) size=ckintval(argv[4]);
835  else size=bytesize(argv[3]);
836 #if alpha
837  if (ioctl(fd,_IOC(IOC_OUT, x, y, size), addr))
838 #else
839  if (ioctl(fd,IOC_OUT | (size<<16) | (x<<8) | y, addr))
840 #endif
841  return(makeint(-errno));
842  else return(T); }
843 
844 pointer IOCTL_W(ctx,n,argv)
845 register context *ctx;
846 /* (UNIX:IOCTL_W stream x y buffer [size]) */
847 /* equivalent to C's ioctl(dev, _IOWN(size, x, y), addr) */
848 int n;
849 register pointer argv[];
850 { register pointer strm;
851  int size,x,y,fd;
852  eusinteger_t addr;
853  ckarg2(4,5);
854  strm=argv[0];
855  if (isiostream(strm)) strm=strm->c.iostream.out;
856  if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
857  else fd=ckintval(strm);
858  if (isint(strm->c.fstream.fname)) error(E_STREAM);
859  x=ckintval(argv[1]); y=ckintval(argv[2]);
860  if (isstring(argv[3]) || isintvector(argv[3]))
861  addr=(eusinteger_t)(argv[3]->c.str.chars);/* ???? */
862  else error(E_NOSTRING);
863  if (n==5) size=ckintval(argv[4]);
864  else size=bytesize(argv[3]);
865 #if alpha || Linux_ppc
866  if (ioctl(fd,_IOC(IOC_IN, x, y, size), addr))
867 #else
868  if (ioctl(fd,IOC_IN | (size<<16) | (x<<8) | y, addr))
869 #endif
870  return(makeint(-errno));
871  else return(T); }
872 
873 pointer IOCTL_WR(ctx,n,argv)
874 register context *ctx;
875 /* (UNIX:IOCTL_WR stream x y buffer [size]) */
876 /* equivalent to C's ioctl(dev, _IOWRN(size, x, y), addr) */
877 int n;
878 register pointer argv[];
879 { register pointer strm=argv[0];
880  int size,x,y,fd;
881  eusinteger_t addr;
882 
883  ckarg2(4,5);
884  if (isiostream(strm)) strm=strm->c.iostream.out;
885  if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
886  else fd=ckintval(strm);
887  if (isint(strm->c.fstream.fname)) error(E_STREAM);
888  x=ckintval(argv[1]); y=ckintval(argv[2]);
889  if (isstring(argv[3]) || isintvector(argv[3]))
890  addr=(eusinteger_t)(argv[3]->c.str.chars);
891  else error(E_NOSTRING);
892  if (n==5) size=ckintval(argv[4]);
893  else size=bytesize(argv[3]);
894 #if alpha || Linux_ppc
895  if (ioctl(fd,_IOC(IOC_INOUT, x, y, size), addr))
896 #else
897  if (ioctl(fd,IOC_INOUT | (size <<16) | (x<<8) | y, addr))
898 #endif
899  return(makeint(-errno)) ;
900  else return(T); }
901 
902 #endif /*vxworks*/
903 
904 /* DUP and DUP2 work only for numeric fd, not for stream obj.*/
905 #if !vxworks
906 
907 pointer DUP(ctx,n,argv)
908 register context *ctx;
909 int n;
910 pointer *argv;
911 { int newfd,oldfd;
912  ckarg(1);
913  oldfd=ckintval(argv[0]);
914  newfd=dup(oldfd);
915  return(makeint(newfd));}
916 
917 pointer DUP2(ctx,n,argv)
918 register context *ctx;
919 int n;
920 pointer *argv;
921 { int newfd,oldfd,stat;
922  ckarg(2);
923  newfd=ckintval(argv[0]);
924  oldfd=ckintval(argv[1]);
925  stat=dup2(newfd,oldfd);
926  return(makeint(stat));}
927 
928 pointer MKNOD(ctx,n,argv)
929 register context *ctx;
930 int n;
931 pointer *argv;
932 { int stat;
933  ckarg(2);
934  stat=mknod((char *)Getstring(argv[0])->c.str.chars,ckintval(argv[1]),0);
935  if (stat<0) return(makeint(-errno));
936  else return(T);}
937 
938 pointer MKDIR(ctx, n, argv)
939 register context *ctx;
940 int n;
941 pointer *argv;
942 { int stat, mode;
943  ckarg2(1,2);
944  if (n==2) mode=ckintval(argv[1]); else mode=0775;
945  stat=mkdir((char *)Getstring(argv[0])->c.str.chars,mode);
946  if (stat<0) return(makeint(-errno));
947  else return(T);}
948 
949 pointer LINK(ctx,n,argv)
950 register context *ctx;
951 int n;
952 pointer argv[];
953 { int stat;
954  ckarg(2);
955  stat=link(Getstring(argv[0])->c.str.chars,Getstring(argv[1])->c.str.chars);
956  if (stat<0) return(makeint(-errno)); else return(T);}
957 
958 pointer UNLINK(ctx,n,argv)
959 register context *ctx;
960 int n;
961 pointer argv[];
962 { pointer s;
963  int stat;
964  ckarg(1);
965  s=Getstring(argv[0]);
966  stat=unlink(s->c.str.chars);
967  if (stat<0) return(makeint(-errno));
968  else return(T);}
969 
970 pointer RMDIR(ctx,n,argv)
971 register context *ctx;
972 int n;
973 pointer argv[];
974 { pointer s;
975  int stat;
976  ckarg(1);
977  s=Getstring(argv[0]);
978  stat=rmdir(s->c.str.chars);
979  if (stat<0) return(makeint(-errno));
980  else return(T);}
981 
982 pointer RENAME(ctx,n,argv) /*(rename from to)*/
983 register context *ctx;
984 int n;
985 register pointer argv[];
986 { byte *from, *to;
987  int stat;
988  ckarg(2);
989  from =(byte *)get_string(argv[0]);
990  to =(byte *)get_string(argv[1]);
991  stat=rename((char *)from,(char *) to);
992  if (stat<0) return(makeint(-errno));
993  else return(T);}
994 
995 pointer ACCESS(ctx,n,argv)
996 register context *ctx;
997 int n;
998 pointer *argv;
999 { pointer path;
1000  int mode,stat;
1001  ckarg2(1,2);
1002  path=Getstring(argv[0]);
1003  if (n==2) mode=ckintval(argv[1]); else mode=0;
1004  stat=access(path->c.str.chars,mode);
1005  if (stat==0) return(T); else return(makeint(-errno));}
1006 
1007 /*
1008 pointer FLOCK(ctx,n,argv)
1009 register context *ctx;
1010 int n;
1011 pointer argv[];
1012 { int fd=ckintval(argv[0]), op=ckintval(argv[1]), stat;
1013  ckarg(2);
1014  stat=flock(fd,op);
1015  if (stat==0) return(T); else return(makeint(-errno));}
1016 */
1017 
1018 pointer STAT(ctx,n,argv)
1019 register context *ctx;
1020 int n;
1021 pointer *argv;
1022 { register pointer a;
1023  struct stat s;
1024  ckarg(1);
1025  if (stat((char *)Getstring(argv[0])->c.str.chars, &s)<0) return(makeint(-errno));
1026  a=cons(ctx,mkbigint(s.st_ctime),NIL);
1027  a=cons(ctx,mkbigint(s.st_mtime),a);
1028  a=cons(ctx,mkbigint(s.st_atime),a);
1029  a=cons(ctx,makeint(s.st_size),a);
1030  a=cons(ctx,makeint(s.st_gid),a);
1031  a=cons(ctx,makeint(s.st_uid),a);
1032  a=cons(ctx,makeint(s.st_nlink),a);
1033  a=cons(ctx,makeint(s.st_rdev),a);
1034  a=cons(ctx,makeint(s.st_dev),a);
1035  a=cons(ctx,makeint(s.st_ino),a);
1036  a=cons(ctx,makeint(s.st_mode),a);
1037  return(a);}
1038 #endif /* !vxworks*/
1039 
1040 #if Solaris2 || linux || alpha
1041 /*
1042  Usage: (unix::directory "directory_name")
1043  Return: a reverse list of file names in "directory_name" dir.
1044 */
1045 
1046 pointer DIRECTORY(ctx, n, argv)
1047 register context *ctx;
1048 int n;
1049 pointer argv[];
1050 { register pointer a;
1051  register char *str;
1052  byte *s;
1053  DIR *dirp;
1054  struct dirent *direntp;
1055  int flag=0;
1056 
1057  ckarg2(0,1);
1058  if (n==1) s=get_string(argv[0]); else s=(byte *)".";
1059  dirp = opendir((char *)s);
1060  while ( (direntp = readdir( dirp )) != NULL ){
1061  str=direntp->d_name;
1062  if(flag) a=cons(ctx,makestring(str,strlen(str)),a);
1063  else { a=cons(ctx,makestring(str,strlen(str)),NIL); flag++;}
1064  }
1065  closedir(dirp);
1066  return (a);
1067 }
1068 #else
1069 pointer DIRECTORY(ctx, n, argv)
1070 register context *ctx;
1071 int n;
1072 pointer argv[];
1073 {
1074  printf("Not Implemented!");
1075  return (NIL);
1076 }
1077 #endif
1078 
1079 pointer LSEEK(ctx,n,argv)
1080 register context *ctx;
1081 int n;
1082 pointer *argv;
1083 { pointer strm,fd;
1084  int whence;
1085  ckarg2(2,3);
1086  if (n==3) whence=ckintval(argv[2]); else whence=0;
1087  strm=argv[0];
1088  if (isiostream(strm)) strm=strm->c.iostream.out;
1089  if (isfilestream(strm)){
1090  fd=strm->c.fstream.fd;
1091  if (isint(strm->c.fstream.fname)) error(E_STREAM);}
1092  else fd=strm;
1093  if (!isint(fd)) error(E_STREAM);
1094  return(makeint(lseek(intval(fd),ckintval(argv[1]),whence))); }
1095 
1096 #if !vxworks
1097 /*change current working directory*/
1098 pointer CHDIR(ctx,n,argv)
1099 register context *ctx;
1100 int n;
1101 pointer argv[];
1102 { register int stat;
1103  ckarg(1);
1104  stat=chdir(Getstring(argv[0])->c.str.chars);
1105  if (stat<0) return(makeint(-errno)); else return(T);}
1106 
1107 /*change file access mode*/
1108 pointer CHMOD(ctx,n,argv)
1109 register context *ctx;
1110 int n;
1111 pointer *argv;
1112 { byte *path;
1113  int mode,stat;
1114  ckarg(2);
1115  path=Getstring(argv[0])->c.str.chars;
1116  mode=ckintval(argv[1]);
1117  stat=chmod((char *)path,mode);
1118  if (stat==0) return(T); else return(makeint(errno));}
1119 
1120 /*change file owner*/
1121 pointer CHOWN(ctx,n,argv)
1122 register context *ctx;
1123 int n;
1124 pointer *argv;
1125 { byte *path;
1126  int owner,newowner,stat;
1127  ckarg(3);
1128  path=Getstring(argv[0])->c.str.chars;
1129  owner=ckintval(argv[1]);
1130  newowner=ckintval(argv[2]);
1131  stat=chown(path,owner,newowner);
1132  if (stat==0) return(T); else return(makeint(errno));}
1133 
1134 /*create two pipes*/
1135 pointer PIPE(ctx,n,argv)
1136 register context *ctx;
1137 int n;
1138 pointer *argv;
1139 { int pfd[2],stat,size;
1140  register pointer instream,outstream;
1141 
1142  ckarg2(0,1);
1143  if (n==1) size=ckintval(argv[0]); else size=128;
1144  stat=pipe(pfd);
1145  if (stat<0) return(makeint(-errno));
1146  instream=mkfilestream(ctx,K_IN,makebuffer(size),pfd[0],NIL); /*no file named*/
1147  vpush(instream);
1148  outstream=mkfilestream(ctx,K_OUT,makebuffer(size),pfd[1],NIL);
1149  return((pointer)mkiostream(ctx,vpop(),outstream));
1150  }
1151 
1152 
1153 /* message queu operations */
1154 #if !news
1155 pointer MSGGET(ctx,n,argv)
1156 register context *ctx;
1157 int n;
1158 pointer argv[];
1159 { register int key,qid,mode;
1160  ckarg2(1,2);
1161  key=ckintval(argv[0]);
1162  if (n==2) mode=ckintval(argv[1]); else mode=0666;
1163  qid=msgget(key,IPC_CREAT | (mode & 0777));
1164  return(makeint(qid));}
1165 
1166 pointer MSGRCV(ctx,n,argv)
1167 register context *ctx;
1168 int n;
1169 pointer *argv;
1170 { register int qid,mtype,flag,stat;
1171  register pointer buf,lsave;
1172  ckarg2(2,4);
1173  qid=ckintval(argv[0]);
1174  buf=argv[1];
1175  if (!isstring(buf)) error(E_NOSTRING);
1176  if (n>=3) mtype=ckintval(argv[2]); else mtype=0;
1177  if (n==4) if (argv[3]==NIL) flag=0; else flag=IPC_NOWAIT;
1178  else flag=0;
1179  lsave=buf->c.str.length;
1180  buf->c.str.length=(pointer)(eusinteger_t)mtype;/* ???? */
1181  rcv_again:
1182  stat=msgrcv(qid,&buf->c.str.length,intval(lsave),mtype,flag);
1183  if (stat<0) { breakck; goto rcv_again;}
1184  mtype=(int)(eusinteger_t)(buf->c.str.length);/* ???? */
1185  buf->c.str.length=lsave;
1186  if (stat<0) return(makeint(-errno));
1187  else return(cons(ctx,makeint(mtype),cons(ctx,makeint(stat),NIL)));}
1188 
1189 pointer MSGSND(ctx,n,argv)
1190 register context *ctx;
1191 int n;
1192 pointer *argv;
1193 { register int qid,msize,mtype,flag,stat;
1194  register pointer buf,lsave;
1195  ckarg2(2,5);
1196  qid=ckintval(argv[0]);
1197  buf=argv[1];
1198  if (!isstring(buf)) error(E_NOSTRING);
1199  lsave=buf->c.str.length;
1200  if (n>=3) {
1201  msize=ckintval(argv[2]);
1202  if (msize>intval(lsave) || msize<0) error(E_ARRAYINDEX);}
1203  else msize=intval(lsave);
1204  if (n>=4) mtype=ckintval(argv[3]); else mtype=mypid;
1205  if (n==5) if (argv[4]==NIL) flag=0; else flag=IPC_NOWAIT;
1206  else flag=0;
1207  buf->c.str.length=(pointer)(eusinteger_t)mtype;
1208  stat=msgsnd(qid,(struct msgbuf *)&buf->c.str.length,msize,flag);
1209  buf->c.str.length=lsave;
1210  if (stat<0) return(makeint(-errno));
1211  else return(makeint(stat));}
1212 
1213 pointer MSGCTL(ctx,n,argv)
1214 register context *ctx;
1215 int n;
1216 pointer argv[];
1217 { int qid,cmnd,stat;
1218  byte *buf;
1219  ckarg2(2,3);
1220  qid=ckintval(argv[0]); cmnd=ckintval(argv[1]);
1221  if (n==3) buf=get_string(argv[2]);
1222  else buf=NULL;
1223  stat=msgctl(qid,cmnd,(struct msqid_ds *)buf);
1224  if (stat==(int)NULL) return(T); else return(makeint(-errno));}
1225 #endif
1226 #endif
1227 
1228 /****************************************************************/
1229 /* UNIX subroutines
1230 /****************************************************************/
1231 
1232 pointer SYSTEM(ctx,n,argv)
1233 register context *ctx;
1234 int n;
1235 register pointer argv[];
1236 { int stat;
1237  eusinteger_t s;
1238 /* extern int eusint(); */
1239  extern void eusint(); /* ???? */
1240 
1241  s=(eusinteger_t)signal(SIGCHLD,SIG_DFL);/* ???? */
1242  if (n==0) stat=system("csh");
1243  else if (isstring(argv[0])) stat=system((char *)argv[0]->c.str.chars);
1244  else { signal(SIGCHLD,(void (*)())s); error(E_NOSTRING);}
1245  signal(SIGCHLD,(void (*)())s);
1246  return(makeint(stat));}
1247 
1248 pointer GETWD(ctx,n,argv)
1249 register context *ctx;
1250 int n;
1251 pointer argv[];
1252 { char buf[256];
1253  ckarg(0);
1254 #if Solaris2 || Linux
1255  getcwd(buf,256);
1256 #else
1257  getwd(buf);
1258 #endif
1259  return(makestring(buf,strlen(buf)));}
1260 
1261 pointer GETENV(ctx,n,argv)
1262 register context *ctx;
1263 int n;
1264 pointer *argv;
1265 { register char *envval;
1266  ckarg(1);
1267  envval=(char *)getenv((char *)Getstring(argv[0])->c.str.chars);
1268  if (envval) return(makestring(envval,strlen(envval)));
1269  else return(NIL);}
1270 
1271 #if sun3 || sun4 || vax || mips || i386 || alpha
1272 pointer PUTENV(ctx,n,argv)
1273 register context *ctx;
1274 int n;
1275 pointer argv[];
1276 {
1277  char *b;
1278  pointer a=argv[0];
1279  ckarg(1);
1280  if (!isstring(a)) error(E_NOSTRING);
1281  b= (char *)malloc(vecsize(a)+1);
1282  strcpy(b, (char *)a->c.str.chars);
1283  putenv(b);
1284  return(makeint((eusinteger_t)b));}
1285 #endif
1286 
1287 pointer ENVIRON(context *ctx, int n, pointer argv[])
1288 { extern char **environ;
1289  char *b;
1290  int count=0;
1291  ckarg(0);
1292  while (b=environ[count++]) {
1293  vpush(makestring(b, strlen(b)));}
1294  return(stacknlist(ctx, count-1)); }
1295 
1296 pointer SLEEP(ctx,n,argv)
1297 register context *ctx;
1298 int n;
1299 pointer *argv;
1300 { ckarg(1);
1301  sleep(ckintval(argv[0]));
1302  return(T);}
1303 
1304 #if sun3 || sun4 && !Solaris2 || Linux || alpha
1305 pointer USLEEP(ctx,n,argv)
1306 register context *ctx;
1307 int n;
1308 pointer *argv;
1309 { ckarg(1);
1310  usleep(ckintval(argv[0]));
1311  return(T);}
1312 #endif
1313 
1314 pointer ERRNO(ctx,n,argv)
1315 context *ctx;
1316 int n;
1317 pointer argv[];
1318 {
1319  return(makeint(errno));
1320  }
1321 
1322 pointer SYSERRLIST(ctx,n,argv)
1323 register context *ctx;
1324 register int n;
1325 pointer argv[];
1326 { char *errstr;
1327  ckarg(1);
1328  n=ckintval(argv[0]);
1329  if (0<=n && n<sys_nerr) {
1330  errstr=strerror(n);
1331  /* return(makestring(sys_errlist[n],strlen(sys_errlist[n]))); */
1332  return(makestring(errstr, strlen(errstr))); }
1333  else error(E_ARRAYINDEX);}
1334 
1335 pointer PAUSE(ctx,n,argv)
1336 register context *ctx;
1337 int n;
1338 pointer argv[];
1339 { ckarg(0);
1340  return(makeint(pause()));}
1341 
1342 pointer ISATTY(ctx,n,argv)
1343 register context *ctx;
1344 int n;
1345 pointer argv[];
1346 { pointer a;
1347  int fd;
1348  ckarg(1);
1349  a=argv[0];
1350  if (isiostream(a)) a=a->c.iostream.in;
1351  if (isfilestream(a)) fd=intval(a->c.fstream.fd);
1352  else fd=ckintval(a);
1353  if (isatty(fd)) return(T); else return(NIL);}
1354 
1355 
1356 /****************************************************************/
1357 /* functions for I P C (interprocess communication)
1358 /* using sockets
1359 /* 1988-Jan socket for internet
1360 /* 1988-Feb select system call
1361 /****************************************************************/
1362 
1363 pointer SOCKET(ctx,n,argv)
1364 register context *ctx;
1365 int n;
1366 pointer argv[];
1367 { int proto,s;
1368  ckarg2(2,3);
1369  if (n==3) proto=ckintval(argv[2]);
1370  else proto=0;
1371  s=socket(ckintval(argv[0]),ckintval(argv[1]),proto);
1372  if (s<0) return(makeint(-errno));
1373  else return(makeint(s)); }
1374 
1375 pointer BIND(ctx,n,argv) /*bind ipc socket to real path name*/
1376 register context *ctx;
1377 int n;
1378 register pointer argv[];
1379 { int s,l;
1380  pointer sockname;
1381  struct sockaddr *sa;
1382 
1383  ckarg(2);
1384  s=ckintval(argv[0]); /*socket id*/
1385  if (!isstring(argv[1])) error(E_USER,(pointer)"socket address expected");
1386  sa= (struct sockaddr *)(argv[1]->c.str.chars);
1387  if (sa->sa_family==AF_UNIX) l=strlen(sa->sa_data)+2;
1388  else l=sizeof(struct sockaddr_in);
1389  s=(int)bind(s, sa, l);
1390  if (s) return(makeint(-errno)); else return(makeint(0));}
1391 
1392 pointer CONNECT(ctx,n,argv)
1393 register context *ctx;
1394 int n;
1395 pointer argv[];
1396 { int s,l;
1397  struct sockaddr *sa;
1398  ckarg(2);
1399  s=ckintval(argv[0]); /*socket id*/
1400  if (!isstring(argv[1])) error(E_USER,(pointer)"socket address expected");
1401  sa= (struct sockaddr *)(argv[1]->c.str.chars);
1402  if (sa->sa_family==AF_UNIX) l=strlen(sa->sa_data)+2;
1403  else l=sizeof(struct sockaddr_in);
1404  s=(int)connect(s, sa, l);
1405  breakck;
1406  if (s) return(makeint(-errno)); else return(makeint(0));
1407 }
1408 
1409 pointer LISTEN(ctx,n,argv)
1410 register context *ctx;
1411 int n;
1412 pointer argv[];
1413 { int backlog,stat;
1414  ckarg2(1,2);
1415  if (n==2) backlog=ckintval(argv[1]);
1416  else backlog=3;
1417  stat=listen(ckintval(argv[0]),backlog);
1418  if (stat<0) return(makeint(-errno)); else return(makeint(0));}
1419 
1420 pointer ACCEPT(ctx,n,argv)
1421 register context *ctx;
1422 int n;
1423 pointer argv[];
1424 { int ns,len,s;
1425  pointer sockname;
1426 #if vxworks
1427  struct sockaddr sockun;
1428 #else
1429  struct sockaddr_un sockun;
1430 #endif
1431 
1432  ckarg(1);
1433  len=sizeof(sockun);
1434  s=ckintval(argv[0]);
1435  ns=accept(s, (struct sockaddr *)&sockun, &len);
1436  if (ns<0) return(makeint(-errno));
1437  sockname=makestring((char *)&sockun,len);
1438  return(cons(ctx,makeint(ns),cons(ctx,sockname,NIL)));}
1439 
1440 /* non-connected (datagram) socket communication */
1441 /* Address must be bound to a socket at the receiver side. */
1442 /* Sender specifies the address when it calls SENDTO. */
1443 pointer SENDTO(ctx,n,argv)
1444 register context *ctx;
1445 int n;
1446 pointer argv[];
1447 /* unix: sendto(sock,msg,len,flags,to,tolen) */
1448 /* eus: (SENDTO sock addr msg [len [flags]]) */
1449 { int len, sock, flags, stat;
1450  pointer msg, addr;
1451  ckarg2(3,5);
1452  sock=ckintval(argv[0]);
1453  addr=(pointer)Getstring(argv[1]);
1454  msg=(pointer)Getstring(argv[2]);
1455  if (n>=4) len=ckintval(argv[3]); else len=vecsize(msg);
1456  if (n>=5) flags=ckintval(argv[4]); else flags=0;
1457  stat=sendto(sock, (char *)msg->c.str.chars, len, flags,
1458  (struct sockaddr *)addr->c.str.chars, vecsize(addr));
1459  if (stat<0) stat= -errno;
1460  /* returns the number of bytes actually sent*/
1461  return(makeint(stat));}
1462 
1463 pointer RECVFROM(ctx,n,argv)
1464 register context *ctx;
1465 int n;
1466 pointer argv[];
1467 /* unix: recvfrom(s,buf,len,flags,from,fromlen) */
1468 /* eus: (RECVFROM sock [msg [from [flags]]])
1469  no address is required since it has already bound to
1470  the socket */
1471 { int len=2000, sock, flags, stat, addrlen;
1472  unsigned char buf[2000], *bufp=buf, *addrp=NULL;
1473  pointer msg, addr;
1474  ckarg2(1,4);
1475  sock=ckintval(argv[0]);
1476  if (n>=2) {
1477  msg=argv[1];
1478  if (isstring(msg)) msg=(pointer)Getstring(argv[1]); /*message buffer*/
1479  else msg=makebuffer(ckintval(argv[1]));
1480  bufp=msg->c.str.chars;
1481  len=vecsize(msg);}
1482  if (n>=3) {
1483  addr=Getstring(argv[2]);
1484  addrlen=vecsize(addr);
1485  addrp=addr->c.str.chars;}
1486  if (n>=4) flags=ckintval(argv[3]); else flags=0;
1487  stat=recvfrom(sock, (char *)bufp, len, flags, (struct sockaddr *)addrp, &addrlen);
1488  if (stat<0) return(makeint(-errno));
1489  /* if the result is negative, it indicates error number,
1490  otherwise, the actual length of the message is returned. */
1491  if (n<2) return(makestring((char *)bufp,stat));
1492  else return(makeint(stat));}
1493 
1494 #if !Solaris2
1495 pointer GETPEERNAME(ctx,n,argv)
1496 register context *ctx;
1497 int n;
1498 pointer argv[];
1499 { char name[128];
1500  int namelen, stat;
1501  ckarg(1);
1502  stat=getpeername(ckintval(argv[0]), (struct sockaddr *)name, &namelen);
1503  if (stat<0) return(makeint(-errno));
1504  else return(makestring(name,namelen));}
1505 #endif
1507 #if !vxworks
1508 
1509 eusinteger_t *checkbitvec(pointer a, long *size)
1510 { if (a==NIL) { *size=0; return(0);}
1511  if (!isvector(a)) error(E_NOVECTOR);
1512  switch(elmtypeof(a)) {
1513  case ELM_BIT: *size=vecsize(a); return(a->c.ivec.iv);
1514  case ELM_INT: *size=vecsize(a) * WORD_SIZE; return(a->c.ivec.iv);
1515  case ELM_BYTE: case ELM_CHAR:
1516  *size=vecsize(a) * 8; return(a->c.ivec.iv);
1517  case ELM_FOREIGN: *size=vecsize(a) * 8; return((eusinteger_t *)a->c.foreign.chars);
1518  default: error(E_USER,(pointer)"bit-vector expected");
1519  }
1520 }
1521 
1522 pointer SELECT(ctx,n,argv)
1523 register context *ctx;
1524 int n;
1525 register pointer argv[];
1526 { register pointer a=argv[0];
1527  long i, maxwidth, width,size0, size1, size2;
1528  fd_set *readfds, *writefds, *exceptfds;
1529  float timeout;
1530  struct timeval to;
1531  numunion nu;
1532 
1533  ckarg(4);
1534  readfds=(fd_set *)checkbitvec(argv[0], &size0);
1535  writefds=(fd_set *)checkbitvec(argv[1], &size1);
1536  exceptfds=(fd_set *)checkbitvec(argv[2], &size2);
1537  maxwidth=min(256, max(max(size0, size1), size2));
1538 
1539 /* printf("SELECT: readfds=%x\n", readfds);
1540  printf("SELECT: writefds=%x\n", writefds);
1541  printf("SELECT: exceptfds=%x\n", exceptfds); */
1542 
1543  /* find the highest numbered fd */
1544  width=0;
1545  for (i=0; i<maxwidth; i++) {
1546  if (readfds && FD_ISSET(i, readfds)) width=i;
1547  if (writefds && FD_ISSET(i, writefds)) width=i;
1548  if (exceptfds && FD_ISSET(i, exceptfds)) width=i;}
1549  width = width + 1;
1550 
1551  timeout=ckfltval(argv[3]);
1552  if (timeout==0.0)
1553  i=select(width, readfds, writefds, exceptfds,0);
1554  else {
1555  to.tv_sec=timeout;
1556  timeout=timeout-to.tv_sec;
1557  timeout=timeout*1000000;
1558  to.tv_usec=timeout;
1559  i=select(width, readfds, writefds, exceptfds,&to);}
1560  if (i<0) return(makeint(-errno));
1561  else return(makeint(i)); }
1562 
1563 pointer SELECT_READ(ctx,n,argv)
1564 register context *ctx;
1565 int n;
1566 pointer argv[];
1567 { struct timeval to;
1568  float timeout;
1569  long i, size, width, fds;
1570  fd_set *fdvec;
1571  numunion nu;
1572 
1573  ckarg(2);
1574  if (isint(argv[0])) {
1575  fds=intval(argv[0]);
1576  fdvec=(fd_set *)&fds;
1577  size=30; }
1578  else fdvec=(fd_set *)checkbitvec(argv[0], &size);
1579  size=min(256,size);
1580  for (i=0; i<size; i++) if (FD_ISSET(i, fdvec)) width=i;
1581  width = width+1;
1582 
1583  timeout=ckfltval(argv[1]);
1584  if (timeout==0.0) n=select(width, fdvec, 0, 0, 0);
1585  else {
1586  to.tv_sec=timeout;
1587  timeout=timeout-to.tv_sec;
1588  timeout=timeout*1000000;
1589  to.tv_usec=timeout;
1590  n=select(width, fdvec, 0, 0, &to);}
1591  if (n<0) return(makeint(-errno));
1592  if (isint(argv[0])) {
1593  /*fds=fdvec-> __fds_bits[0];*/
1594  /* fds_bits should be __fds_bits on some operating systems */
1595  return(makeint(fds)); }
1596  else return(argv[0]); }
1597 
1598 #endif /* !vxworks */
1599 
1600 
1601 /****************************************************************/
1602 /* physical memory allocator
1603 /* 1988-Jul
1604 /****************************************************************/
1605 pointer SBRK(ctx,n,argv)
1606 register context *ctx;
1607 int n; pointer argv[];
1608 { return(makeint(sbrk(ckintval(argv[0]))));}
1609 
1610 pointer MALLOC(ctx,n,argv)
1611 register context *ctx;
1612 int n; pointer argv[];
1613 { return(makeint(malloc(ckintval(argv[0]))));}
1614 
1615 pointer FREE(ctx,n,argv)
1616 register context *ctx;
1617 int n; pointer argv[];
1618 { free((void *)ckintval(argv[0]));
1619  return(makeint(1));}
1620 
1621 #if sun3 || sun4 || news || alpha
1622 pointer VALLOC(ctx,n,argv)
1623 register context *ctx;
1624 int n; pointer argv[];
1625 { return(makeint(valloc(ckintval(argv[0]))));}
1626 #endif
1627 
1628 #if sun3 || sun4 || news || alpha || Linux
1629 
1630 pointer MMAP(ctx,n,argv)
1631 register context *ctx;
1632 int n; register pointer argv[];
1633 { int fd;
1634  eusinteger_t offset,result,len;
1635  pointer strm;
1636  ckarg(6);
1637  strm=argv[4];
1638  if (isiostream(strm)) strm=strm->c.iostream.in;
1639  if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
1640  else fd=ckintval(strm);
1641  len=ckintval(argv[1]);
1642  if (isintvector(argv[5]))
1643  offset=((argv[5]->c.ivec.iv[0])<<16) + argv[5]->c.ivec.iv[1];
1644  else offset=ckintval(argv[5]);
1645  result=(eusinteger_t)mmap((caddr_t)ckintval(argv[0]), len,
1646  ckintval(argv[2]), ckintval(argv[3]), fd, offset);
1647  if (result== -1) return(makeint(-errno));
1648  else return((pointer)make_foreign_string(result, len));}
1649 
1650 pointer MUNMAP(ctx,n,argv)
1651 register context *ctx;
1652 int n; pointer argv[];
1653 { return(makeint(munmap((caddr_t)ckintval(argv[0]),ckintval(argv[1]))));}
1654 
1655 /*
1656 pointer VADVISE(ctx,n,argv)
1657 register context *ctx;
1658 int n; pointer argv[];
1659 { n=vadvise(ckintval(argv[0]));
1660  if (n==0) return(T); else return(makeint(errno));}
1661 */
1662 
1663 #endif
1664 
1665 /****************************************************************/
1666 /* network library routines
1667 /****************************************************************/
1668 #if !vxworks
1669 
1670 pointer GETHOSTNAME(ctx,n,argv)
1671 register context *ctx;
1672 int n; pointer argv[];
1673 { char buf[32]; int stat;
1674  stat=gethostname(buf,32);
1675  if (stat==0) return(makestring(buf,strlen(buf)));
1676  else return(makeint(errno));}
1677 
1678 pointer GETHOSTBYNAME(ctx,n,argv)
1679 register context *ctx;
1680 int n;
1681 register pointer *argv;
1682 { register struct hostent *hp;
1683  register pointer s;
1684 
1685  ckarg(1);
1686  hp=gethostbyname((char *)Getstring(argv[0])->c.str.chars);
1687  if (hp==NULL) return(makeint(-errno));
1688  s=cons(ctx,makeint(hp->h_addrtype),NIL);
1689  s=cons(ctx,makestring(hp->h_addr,hp->h_length),s);
1690  return(s);} /*list of 32bit address and address type*/
1691 
1692 pointer GETHOSTBYADDR(ctx,n,argv)
1693 register context *ctx;
1694 int n;
1695 pointer *argv;
1696 { pointer addr;
1697  struct hostent *host;
1698  ckarg(1);
1699  addr=Getstring(argv[0]);
1700  host=gethostbyaddr((char *)addr->c.str.chars, vecsize(addr), 2);
1701  if (host==NULL) return(makeint(-errno));
1702  else return(makestring(host->h_name, strlen(host->h_name)));}
1703 
1704 pointer GETNETBYNAME(ctx,n,argv)
1705 register context *ctx;
1706 int n;
1707 register pointer *argv;
1708 { struct netent *np;
1709  ckarg(1);
1710  np=getnetbyname((char *)Getstring(argv[0])->c.str.chars);
1711  if (np==NULL) return(makeint(-errno));
1712  return(cons(ctx,makeint(np->n_net),
1713  cons(ctx,makeint(np->n_addrtype),NIL)));}
1714 
1715 pointer GETPROTOBYNAME(ctx,n,argv)
1716 register context *ctx;
1717 int n;
1718 register pointer *argv;
1719 { struct protoent *pp;
1720  ckarg(1);
1721  pp=getprotobyname((char *)Getstring(argv[0])->c.str.chars);
1722  if (pp==NULL) return(makeint(-errno));
1723  return(makeint(pp->p_proto));}
1724 
1725 pointer GETSERVBYNAME(ctx,n,argv)
1726 register context *ctx;
1727 int n;
1728 register pointer *argv;
1729 { struct servent *sp;
1730  pointer s;
1731  byte *p;
1732  long int port;
1733 
1734  ckarg2(1,2);
1735  if (n==2 && argv[1]!=NIL) p=Getstring(argv[1])->c.str.chars;
1736  else p=NULL;
1737  sp=getservbyname((char *)Getstring(argv[0])->c.str.chars,(char *)p);
1738  if (sp==NULL) return(makeint(-errno));
1739  s=makestring(sp->s_proto,strlen(sp->s_proto));
1740  vpush(s);
1741  port = ntohs(sp->s_port);
1742  s=cons(ctx,makeint(port),cons(ctx,s,NIL));
1743  vpop();
1744  return(s);}
1745 
1746 /* Append by I.Hara for IPC */
1747 /* htons -- convert values between host and network byte order */
1748 pointer H2NS(ctx,n,argv)
1749 register context *ctx;
1750 int n;
1751 register pointer *argv;
1752 { int hostshort;
1753  unsigned short netshort;
1754  ckarg(1);
1755  hostshort=ckintval(argv[0]);
1756  netshort=htons((short)hostshort);
1757  return(makeint(netshort));}
1758 
1759 pointer N2HS(ctx,n,argv)
1760 register context *ctx;
1761 int n;
1762 register pointer *argv;
1763 { int hostshort;
1764  unsigned short netshort;
1765  ckarg(1);
1766  netshort=ckintval(argv[0]);
1767  hostshort=ntohs((short)netshort);
1768  return(makeint(hostshort));}
1769 
1770 #endif
1771 
1772 
1773 
1774 
1775 #ifdef DBM
1776 /* ndbm --- data base
1777  1988-May
1778  (c) T.Matsui
1779 */
1780 
1781 #if sun3 || sun4
1782 
1783 #include <ndbm.h>
1784 
1785 pointer DBM_OPEN(ctx,n,argv)
1786 register context *ctx;
1787 int n;
1788 register pointer argv[];
1789 { DBM *dbm;
1790  ckarg(3);
1791  dbm=dbm_open(Getstring(argv[0])->c.str.chars,
1792  ckintval(argv[1]),
1793  ckintval(argv[2]));
1794  return(makeint(dbm));}
1795 
1796 pointer DBM_CLOSE(ctx,n,argv)
1797 register context *ctx;
1798 int n;
1799 register pointer argv[];
1800 { ckarg(1);
1801  dbm_close(ckintval(argv[0]));
1802  return(T);}
1803 
1804 pointer DBM_FETCH(ctx,n,argv)
1805 register context *ctx;
1806 int n;
1807 register pointer argv[];
1808 { register pointer s;
1809  datum key,content;
1810  ckarg(2);
1811  s=Getstring(argv[1]);
1812  key.dptr=(char *)(s->c.str.chars);
1813  key.dsize=strlength(s);
1814  content=dbm_fetch(ckintval(argv[0]), key);
1815  if (content.dptr==NULL) return(NIL);
1816  return(makestring(content.dptr,content.dsize));}
1817 
1818 pointer DBM_STORE(ctx,n,argv)
1819 register context *ctx;
1820 int n;
1821 register pointer argv[];
1822 { register pointer s;
1823  datum key,content;
1824  ckarg(4);
1825  s=Getstring(argv[1]);
1826  key.dptr=(char *)s->c.str.chars;
1827  key.dsize=strlength(s);
1828  s=Getstring(argv[2]);
1829  content.dptr=(char *)s->c.str.chars;
1830  content.dsize=strlength(s);
1831  n=dbm_store(ckintval(argv[0]), key, content, ckintval(argv[3]));
1832  return((n==0)?T:NIL);}
1833 
1834 pointer DBM_DELETE(ctx,n,argv)
1835 register context *ctx;
1836 int n;
1837 register pointer argv[];
1838 { register pointer s;
1839  datum key;
1840  ckarg(2);
1841  s=Getstring(argv[1]);
1842  key.dptr=(char *)s->c.str.chars;
1843  key.dsize=strlength(s);
1844  n=dbm_delete(ckintval(argv[0]), key);
1845  return((n==0)?T:NIL);}
1846 
1847 pointer DBM_FIRSTKEY(ctx,n,argv)
1848 register context *ctx;
1849 int n;
1850 register pointer argv[];
1851 { datum key;
1852  ckarg(1);
1853  key=dbm_firstkey(ckintval(argv[0]), key);
1854  if (key.dptr==NULL) return(NIL);
1855  return(makestring(key.dptr,key.dsize));}
1856 
1857 pointer DBM_NEXTKEY(ctx,n,argv)
1858 register context *ctx;
1859 int n;
1860 register pointer argv[];
1861 { datum key;
1862  ckarg(1);
1863  key=dbm_nextkey(ckintval(argv[0]), key);
1864  if (key.dptr==NULL) return(NIL);
1865  return(makestring(key.dptr,key.dsize));}
1866 
1867 pointer DBM_ERROR(ctx,n,argv)
1868 register context *ctx;
1869 int n;
1870 register pointer argv[];
1871 { ckarg(1);
1872  n=dbm_error((DBM *)ckintval(argv[0]));
1873  return((n==0)?T:NIL);}
1874 
1875 pointer DBM_CLEARERR(ctx,n,argv)
1876 register context *ctx;
1877 int n;
1878 register pointer argv[];
1879 { ckarg(1);
1880  dbm_clearerr((DBM *)ckintval(argv[0]));
1881  return(T);}
1882 
1883 #endif /*sun3 || sun4*/
1884 #endif /*ifdef DBM*/
1885 
1886 
1887 /* initialization of unixcall functions*/
1888 unixcall(ctx,mod)
1889 register context *ctx;
1890 pointer mod;
1891 { pointer p=Spevalof(PACKAGE);
1892 
1893  Spevalof(PACKAGE)=unixpkg;
1894 
1895 /* common to unix and to vxworks */
1896  defun(ctx,"SIGADDSET",mod,SIGADDSET,NULL);
1897  defun(ctx,"SIGDELSET",mod,SIGDELSET,NULL);
1898  defun(ctx,"SIGPROCMASK",mod,SIGPROCMASK,NULL);
1899  defun(ctx,"KILL",mod,KILL,NULL);
1900  defun(ctx,"SIGNAL",mod,SIGNAL,NULL);
1901  defun(ctx,"EXIT",mod,EXIT,NULL);
1902  defun(ctx,"GETPID",mod,GETPID,NULL);
1903  defun(ctx,"UREAD",mod,UNIXREAD,NULL);
1904  defun(ctx,"WRITE",mod,UNIXWRITE,NULL);
1905  defun(ctx,"UCLOSE",mod,UNIXCLOSE,NULL);
1906  defun(ctx,"IOCTL",mod,IOCTL,NULL);
1907  defun(ctx,"LSEEK",mod,LSEEK,NULL);
1908  defun(ctx,"SBRK",mod,SBRK,NULL);
1909  defun(ctx,"MALLOC",mod,MALLOC,NULL);
1910  defun(ctx,"FREE",mod,FREE,NULL);
1911 
1912  defun(ctx,"SOCKET",mod,SOCKET,NULL);
1913  defun(ctx,"BIND",mod,BIND,NULL);
1914  defun(ctx,"CONNECT",mod,CONNECT,NULL);
1915  defun(ctx,"LISTEN",mod,LISTEN,NULL);
1916  defun(ctx,"ACCEPT",mod,ACCEPT,NULL);
1917  defun(ctx,"SENDTO",mod,SENDTO,NULL);
1918  defun(ctx,"RECVFROM",mod,RECVFROM,NULL);
1919 #if !Solaris2
1920  defun(ctx,"GETPEERNAME",mod,GETPEERNAME,NULL);
1921 #endif
1922 /* #endif /*socket*/
1923 
1924 /*not supported by vxworks*/
1925 #if !vxworks
1926  defun(ctx,"PTIMES",mod,PTIMES,NULL);
1927  defun(ctx,"RUNTIME",mod,RUNTIME,NULL);
1928  defun(ctx,"LOCALTIME",mod,LOCALTIME,NULL);
1929  defun(ctx,"ASCTIME",mod,ASCTIME,NULL);
1930  defun(ctx,"GETITIMER",mod,GETITIMER,NULL);
1931  defun(ctx,"SETITIMER",mod,SETITIMER,NULL);
1932 
1933 #if !Solaris2
1934  defun(ctx,"GETRUSAGE",mod,GETRUSAGE,NULL);
1935  defun(ctx,"GETPAGESIZE",mod,GETPAGESIZE,NULL);
1936 #endif
1937 
1938  defun(ctx,"GETTIMEOFDAY",mod,GETTIMEOFDAY,NULL);
1939  defun(ctx,"ALARM",mod,ALARM,NULL);
1940 
1941 #if sun3 || sun4 || news || sanyo || alpha
1942 #if !Solaris2
1943  defun(ctx,"UALARM",mod,UALARM,NULL);
1944 #endif
1945 #endif
1946 
1947  defun(ctx,"WAIT",mod,WAIT,NULL);
1948  defun(ctx,"FORK",mod,FORK,NULL);
1949 #if Solaris2
1950  defun(ctx,"FORK1",mod,FORK1,NULL);
1951 #endif
1952  defun(ctx,"GETPPID",mod,GETPPID,NULL);
1953  defun(ctx,"GETPGRP",mod,GETPGRP,NULL);
1954  defun(ctx,"SETPGRP",mod,SETPGRP,NULL);
1955  defun(ctx,"GETUID",mod,GETUID,NULL);
1956  defun(ctx,"GETEUID",mod,GETEUID,NULL);
1957  defun(ctx,"GETGID",mod,GETGID,NULL);
1958  defun(ctx,"GETEGID",mod,GETEGID,NULL);
1959  defun(ctx,"SETUID",mod,SETUID,NULL);
1960  defun(ctx,"SETGID",mod,SETGID,NULL);
1961  defun(ctx,"MKNOD",mod,MKNOD,NULL);
1962  defun(ctx,"MKDIR",mod,MKDIR,NULL);
1963  defun(ctx,"LOCKF",mod,LOCKF,NULL);
1964  defun(ctx,"FCNTL",mod,FCNTL,NULL);
1965 #if !Solaris2
1966  defun(ctx,"IOCTL_",mod,IOCTL_,NULL);
1967  defun(ctx,"IOCTL_R",mod,IOCTL_R,NULL);
1968  defun(ctx,"IOCTL_W",mod,IOCTL_W,NULL);
1969  defun(ctx,"IOCTL_WR",mod,IOCTL_WR,NULL);
1970 #endif
1971  defun(ctx,"DUP",mod,DUP,NULL);
1972  defun(ctx,"DUP2",mod,DUP2,NULL);
1973  defun(ctx,"SYSTEM",mod,SYSTEM,NULL);
1974  defun(ctx,"GETWD",mod,GETWD,NULL);
1975  defun(ctx,"GETENV",mod,GETENV,NULL);
1976  defun(ctx,"ENVIRON",mod,ENVIRON,NULL);
1977  defun(ctx,"SLEEP",mod,SLEEP,NULL);
1978  defun(ctx,"ERRNO",mod,ERRNO,NULL);
1979  defun(ctx,"SYSERRLIST",mod,SYSERRLIST,NULL);
1980  defun(ctx,"PAUSE",mod,PAUSE,NULL);
1981  defun(ctx,"ISATTY",mod,ISATTY,NULL);
1982  defun(ctx,"LINK",mod,LINK,NULL);
1983  defun(ctx,"UNLINK",mod,UNLINK,NULL);
1984  defun(ctx,"RMDIR",mod,RMDIR,NULL);
1985  defun(ctx,"RENAME",mod,RENAME,NULL);
1986  defun(ctx,"ACCESS",mod,ACCESS,NULL);
1987 /* defun(ctx,"FLOCK",mod,FLOCK,NULL); */
1988  defun(ctx,"STAT",mod,STAT,NULL);
1989  defun(ctx,"CHDIR",mod,CHDIR,NULL);
1990  defun(ctx,"CHMOD",mod,CHMOD,NULL);
1991  defun(ctx,"CHOWN",mod,CHOWN,NULL);
1992  defun(ctx,"PIPE",mod,PIPE,NULL);
1993  defun(ctx,"SELECT",mod,SELECT,NULL);
1994  defun(ctx,"SELECT-READ-FD",mod,SELECT_READ,NULL);
1995  defun(ctx,"READDIR",mod,DIRECTORY,NULL);
1996 
1997 #if !vxworks
1998  defun(ctx,"GETHOSTNAME",mod,GETHOSTNAME,NULL);
1999  defun(ctx,"GETHOSTBYNAME",mod,GETHOSTBYNAME,NULL);
2000  defun(ctx,"GETHOSTBYADDR",mod,GETHOSTBYADDR,NULL);
2001  defun(ctx,"GETNETBYNAME",mod,GETNETBYNAME,NULL);
2002  defun(ctx,"GETPROTOBYNAME",mod,GETPROTOBYNAME,NULL);
2003  defun(ctx,"GETSERVBYNAME",mod,GETSERVBYNAME,NULL);
2004 /* Append by I.Hara for IPC */
2005  defun(ctx,"HTONS",mod,H2NS,NULL);
2006  defun(ctx,"NTOHS",mod,N2HS,NULL);
2007 #endif
2008 
2009 #if sun3 || sun4 || vax || news || sanyo || (mips && !IRIX && !IRIX6) || i386 || alpha
2010  defun(ctx,"VFORK",mod,VFORK,NULL);
2011 #endif
2012  defun(ctx,"EXEC",mod,EXEC,NULL);
2013 #if !Solaris2
2014  defun(ctx,"GETPRIORITY",mod,GETPRIORITY,NULL);
2015  defun(ctx,"SETPRIORITY",mod,SETPRIORITY,NULL);
2016 #endif
2017 
2018 #if sun3 || sun4 || vax || mips || i386 || alpha
2019  defun(ctx,"PUTENV",mod,PUTENV,NULL);
2020 #endif
2021 #if sun3 || sun4 && !Solaris2 || Linux || alpha
2022  defun(ctx,"USLEEP",mod,USLEEP,NULL);
2023 #endif
2024 
2025 #if !news
2026  defun(ctx,"MSGGET",mod,MSGGET,NULL);
2027  defun(ctx,"MSGSND",mod,MSGSND,NULL);
2028  defun(ctx,"MSGRCV",mod,MSGRCV,NULL);
2029  defun(ctx,"MSGCTL",mod,MSGCTL,NULL);
2030 #endif
2031 
2032 #if sun3 || sun4 || news || alpha
2033  defun(ctx,"VALLOC",mod,VALLOC,NULL);
2034 #endif
2035 #if sun3 || sun4 || news || alpha || Linux
2036  defun(ctx,"MMAP",mod,MMAP,NULL);
2037  defun(ctx,"MUNMAP",mod,MUNMAP,NULL);
2038 /* defun(ctx,"VADVISE",mod,VADVISE,NULL); */
2039 #endif
2040 
2041 #if system5 || Linux
2042  defun(ctx,"UNAME",mod,UNAME,NULL);
2043 #endif
2044 
2045 #endif /*socket*/
2046 
2047 /*ndbm libraries*/
2048 #ifdef DBM
2049 #if sun3 || sun4
2050  defun(ctx,"DBM-OPEN",mod,DBM_OPEN,NULL);
2051  defun(ctx,"DBM-CLOSE",mod,DBM_CLOSE,NULL);
2052  defun(ctx,"DBM-FETCH",mod,DBM_FETCH,NULL);
2053  defun(ctx,"DBM-STORE",mod,DBM_STORE,NULL);
2054  defun(ctx,"DBM-DELETE",mod,DBM_DELETE,NULL);
2055  defun(ctx,"DBM-FIRSTKEY",mod,DBM_FIRSTKEY,NULL);
2056  defun(ctx,"DBM-NEXTKEY",mod,DBM_NEXTKEY,NULL);
2057  defun(ctx,"DBM-ERROR",mod,DBM_ERROR,NULL);
2058  defun(ctx,"DBM-CLEARERR",mod,DBM_CLEARERR,NULL);
2059 #endif
2060 
2061 #endif
2062 /* restore package*/ Spevalof(PACKAGE)=p;
2063 }
E_NOINTVECTOR
@ E_NOINTVECTOR
Definition: eus.h:999
numunion
Definition: eus.h:428
mkfilestream
pointer mkfilestream(context *, pointer, pointer, int, pointer)
Definition: makes.c:253
GETPROTOBYNAME
pointer GETPROTOBYNAME(context *, int, pointer *)
Getstring
pointer Getstring()
UALARM
pointer UALARM(context *ctx, int n, argv)
Definition: unixcall.old.c:430
buf
static char buf[CHAR_SIZE]
Definition: helpsub.c:23
IOCTL_
pointer IOCTL_(context *, int, pointer *)
NIL
pointer NIL
Definition: eus.c:110
CONNECT
pointer CONNECT(context *, int, pointer *)
l
long l
Definition: structsize.c:3
DUP
pointer DUP(context *, int, pointer *)
SBRK
pointer SBRK(context *, int, pointer *)
SETPGRP
pointer SETPGRP(context *, int, pointer *)
MMAP
pointer MMAP(context *, int, pointer *)
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
STAT
pointer STAT(context *, int, pointer *)
LOCALTIME
pointer LOCALTIME(context *ctx, n, argv)
Definition: unixcall.old.c:124
GETHOSTBYADDR
pointer GETHOSTBYADDR(context *, int, pointer *)
tzname
char * tzname[2]
GETUID
pointer GETUID(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:483
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
IOCTL
pointer IOCTL(context *, int, pointer *)
VFORK
pointer VFORK(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:567
s
short s
Definition: structsize.c:2
MSGSND
pointer MSGSND(context *, int, pointer *)
SIGDELSET
pointer SIGDELSET(context *ctx, int n, argv)
Definition: unixcall.old.c:297
PACKAGE
pointer PACKAGE
Definition: eus.c:110
GETITIMER
pointer GETITIMER(context *ctx, int n, argv)
Definition: unixcall.old.c:230
makevector
pointer makevector(pointer, int)
Definition: makes.c:417
UNIXREAD
pointer UNIXREAD(context *ctx, int n, argv)
Definition: unixcall.old.c:637
SETGID
pointer SETGID(context *ctx, int n, argv)
Definition: unixcall.old.c:516
GETPID
pointer GETPID(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:444
intval
#define intval(p)
Definition: sfttest.c:1
GETHOSTNAME
pointer GETHOSTNAME(context *, int, pointer *)
min
#define min(x, y)
Definition: rmflags.c:17
FCNTL
pointer FCNTL(context *, int, pointer *)
IOCTL_WR
pointer IOCTL_WR(context *, int, pointer *)
sys_nerr
int sys_nerr
QEXITHOOK
pointer QEXITHOOK
Definition: eus.c:122
ckfltval
float ckfltval()
T
pointer T
Definition: eus.c:110
SYSERRLIST
pointer SYSERRLIST(context *, int, pointer *)
pointer
struct cell * pointer
Definition: eus.h:165
MSGCTL
pointer MSGCTL(context *, int, pointer *)
E_MISMATCHARG
@ E_MISMATCHARG
Definition: eus.h:942
MKDIR
pointer MKDIR(context *, int, pointer *)
cell::cellunion::fstream
struct filestream fstream
Definition: eus.h:406
N2HS
pointer N2HS(context *, int, pointer *)
key
static void key(unsigned char c, int x, int y)
Definition: dinoshade.c:753
eus.h
makestring
pointer makestring(char *, int)
Definition: makes.c:147
ckarg
ckarg(2)
C_VECTOR
pointer C_VECTOR
Definition: eus.c:144
GETWD
pointer GETWD(context *, int, pointer *)
GETPGRP
pointer GETPGRP(context *ctx, int n, argv)
Definition: unixcall.old.c:459
bytesize
int bytesize(pointer)
RECVFROM
pointer RECVFROM(context *, int, pointer *)
ERRNO
pointer ERRNO(context *, int, pointer *)
MUNMAP
pointer MUNMAP(context *, int, pointer *)
E_NOSTRING
@ E_NOSTRING
Definition: eus.h:957
cell::cellunion::ivec
struct intvector ivec
Definition: eus.h:416
makebuffer
pointer makebuffer(int)
Definition: makes.c:140
SIGADDSET
pointer SIGADDSET(context *ctx, int n, argv)
Definition: unixcall.old.c:281
MKNOD
pointer MKNOD(context *, int, pointer *)
LSEEK
pointer LSEEK(context *, int, pointer *)
iostream::out
pointer out
Definition: eus.h:291
SYSTEM
pointer SYSTEM(context *, int, pointer *)
KILL
pointer KILL(context *ctx, int n, argv)
Definition: unixcall.old.c:334
string::chars
byte chars[1]
Definition: eus.h:212
cons
Definition: eus.h:195
mypid
eusinteger_t mypid
Definition: eus.c:38
cell::c
union cell::cellunion c
MSGRCV
pointer MSGRCV(context *, int, pointer *)
PAUSE
pointer PAUSE(context *, int, pointer *)
WAIT
pointer WAIT(context *ctx, int n, argv)
Definition: unixcall.old.c:412
E_ARRAYINDEX
@ E_ARRAYINDEX
Definition: eus.h:967
LINK
pointer LINK(context *, int, pointer *)
timezone
time_t timezone
UNIXCLOSE
pointer UNIXCLOSE(context *, int, pointer *)
EXIT
pointer EXIT(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:612
altzone
time_t altzone
Definition: unixcall.old.c:88
filestream::fname
pointer fname
Definition: eus.h:287
E_IODIRECTION
@ E_IODIRECTION
Definition: eus.h:955
NULL
#define NULL
Definition: transargv.c:8
SELECT
pointer SELECT(context *, int, pointer *)
ENVIRON
pointer ENVIRON(context *, int, pointer *)
stream::tail
pointer tail
Definition: eus.h:278
if
if(n==1)
Definition: unixcall.old.c:468
DBM_CLOSE
pointer DBM_CLOSE(context *ctx, int n, argv)
Definition: ndbm.c:21
ISATTY
pointer ISATTY(context *, int, pointer *)
BIND
pointer BIND(context *, int, pointer *)
SIGNAL
pointer SIGNAL(context *ctx, int n, argv)
Definition: unixcall.old.c:342
stream::count
pointer count
Definition: eus.h:277
vector::v
pointer v[1]
Definition: eus.h:301
GETTIMEOFDAY
pointer GETTIMEOFDAY(context *ctx, int n, argv)
Definition: unixcall.old.c:213
errno
int errno
eussigvec
pointer eussigvec[NSIG]
Definition: eus.c:182
GETEUID
pointer GETEUID(context *ctx, int n, argv)
Definition: unixcall.old.c:487
UNLINK
pointer UNLINK(context *, int, pointer *)
LISTEN
pointer LISTEN(context *, int, pointer *)
E_STREAM
@ E_STREAM
Definition: eus.h:954
RENAME
pointer RENAME(context *, int, pointer *)
get_string
byte * get_string()
unixpkg
pointer unixpkg
Definition: eus.c:109
K_IN
pointer K_IN
Definition: eus.c:130
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
PIPE
pointer PIPE(context *, int, pointer *)
filestream::buffer
pointer buffer
Definition: eus.h:283
DBM_CLEARERR
pointer DBM_CLEARERR(context *ctx, int n, argv)
Definition: ndbm.c:100
make_foreign_string
pointer make_foreign_string(eusinteger_t, int)
Definition: makes.c:157
FORK1
pointer FORK1(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:557
GETENV
pointer GETENV(context *, int, pointer *)
cell::cellunion::stream
struct stream stream
Definition: eus.h:405
DBM_ERROR
pointer DBM_ERROR(context *ctx, int n, argv)
Definition: ndbm.c:92
DBM_OPEN
pointer DBM_OPEN(context *ctx, int n, argv)
Definition: ndbm.c:10
E_NOVECTOR
@ E_NOVECTOR
Definition: eus.h:963
SETITIMER
pointer SETITIMER(context *ctx, int n, argv)
Definition: unixcall.old.c:246
E_NOINT
@ E_NOINT
Definition: eus.h:956
SETUID
pointer SETUID(context *ctx, int n, argv)
Definition: unixcall.old.c:508
GETSERVBYNAME
pointer GETSERVBYNAME(context *, int, pointer *)
filestream::fd
pointer fd
Definition: eus.h:286
DUP2
pointer DUP2(context *, int, pointer *)
makeflt
pointer makeflt()
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
count
int count
Definition: thrtest.c:11
MALLOC
pointer MALLOC(context *, int, pointer *)
GETGID
pointer GETGID(context *ctx, int n, argv)
Definition: unixcall.old.c:494
K_OUT
pointer K_OUT
Definition: eus.c:130
f
f
max
#define max(I1, I2)
Definition: eustags.c:134
UNIXWRITE
pointer UNIXWRITE(context *, int, pointer *)
IOCTL_W
pointer IOCTL_W(context *, int, pointer *)
cell
Definition: eus.h:381
checkbitvec
eusinteger_t * checkbitvec(pointer, long *)
eusinteger_t
long eusinteger_t
Definition: eus.h:19
ASCTIME
pointer ASCTIME(context *ctx, int n, argv)
Definition: unixcall.old.c:158
context::vsp
pointer * vsp
Definition: eus.h:525
CHMOD
pointer CHMOD(context *, int, pointer *)
iostream::in
pointer in
Definition: eus.h:291
unixcall
void unixcall(context *, pointer)
stream::direction
pointer direction
Definition: eus.h:275
SIGPROCMASK
pointer SIGPROCMASK(context *ctx, int n, argv)
Definition: unixcall.old.c:313
RUNTIME
pointer RUNTIME(context *ctx, int n, argv)
Definition: unixcall.old.c:115
LOCKF
pointer LOCKF(context *, int, pointer *)
SELECT_READ
pointer SELECT_READ(context *, int, pointer *)
GETRUSAGE
pointer GETRUSAGE(context *ctx, int n, argv)
Definition: unixcall.old.c:185
stacknlist
pointer stacknlist(context *, int)
Definition: makes.c:129
DBM_NEXTKEY
pointer DBM_NEXTKEY(context *ctx, int n, argv)
Definition: ndbm.c:82
DBM_DELETE
pointer DBM_DELETE(context *ctx, int n, argv)
Definition: ndbm.c:59
sock
static int sock
Definition: contrib/vxworks/vxwserv.c:207
SETPRIORITY
static pointer SETPRIORITY(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:590
DBM_FETCH
pointer DBM_FETCH(context *ctx, int n, argv)
Definition: ndbm.c:29
GETNETBYNAME
pointer GETNETBYNAME(context *, int, pointer *)
GETPEERNAME
pointer GETPEERNAME(context *, int, pointer *)
cell::cellunion::iostream
struct iostream iostream
Definition: eus.h:407
GETHOSTBYNAME
pointer GETHOSTBYNAME(context *, int, pointer *)
mkiostream
pointer mkiostream(context *, pointer, pointer)
Definition: makes.c:269
UNAME
pointer UNAME(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:527
SENDTO
pointer SENDTO(context *, int, pointer *)
E_USER
@ E_USER
Definition: eus.h:1006
GETPPID
pointer GETPPID(context *ctx, int n, argv)
Definition: unixcall.old.c:452
ufuncall
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1469
FORK
pointer FORK(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:548
CHDIR
pointer CHDIR(context *, int, pointer *)
ALARM
pointer ALARM(context *ctx, int n, argv)
Definition: unixcall.old.c:421
FREE
pointer FREE(context *, int, pointer *)
intvector::iv
eusinteger_t iv[1]
Definition: eus.h:305
ACCEPT
pointer ACCEPT(context *, int, pointer *)
RMDIR
pointer RMDIR(context *, int, pointer *)
IOCTL_R
pointer IOCTL_R(context *, int, pointer *)
DBM_STORE
pointer DBM_STORE(context *ctx, int n, argv)
Definition: ndbm.c:43
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
eusint
void eusint(int s, int code, int x, eusinteger_t addr)
Definition: eus.c:976
a
char a[26]
Definition: freq.c:4
DBM_FIRSTKEY
pointer DBM_FIRSTKEY(context *ctx, int n, argv)
Definition: ndbm.c:72
PTIMES
pointer PTIMES(context *ctx, int n, argv)
Definition: unixcall.old.c:99
H2NS
pointer H2NS(context *, int, pointer *)
ACCESS
pointer ACCESS(context *, int, pointer *)
SOCKET
pointer SOCKET(context *, int, pointer *)
GETEGID
pointer GETEGID(context *ctx, int n, argv)
Definition: unixcall.old.c:501
n
GLfloat n[6][3]
Definition: cube.c:15
MSGGET
pointer MSGGET(context *, int, pointer *)
GETPAGESIZE
pointer GETPAGESIZE(context *ctx, int n, argv)
Definition: unixcall.old.c:205
SLEEP
pointer SLEEP(context *, int, pointer *)
coerceintval
int coerceintval(pointer)
Definition: sequence.c:55
daylight
int daylight
CHOWN
pointer CHOWN(context *, int, pointer *)
USLEEP
pointer USLEEP(context *, int, pointer *)
cell::cellunion::str
struct string str
Definition: eus.h:402
rcsid
static char * rcsid
Definition: unixcall.old.c:13
EXEC
pointer EXEC(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:575
DIRECTORY
pointer DIRECTORY(context *, int, pointer *)
PUTENV
pointer PUTENV(context *, int, pointer *)
GETPRIORITY
static pointer GETPRIORITY(context *ctx, int n, pointer *argv)
Definition: unixcall.old.c:602


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