unixcall.old.c
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* unixcall.c
00003 /*      1986-Jul-6      original for Ustation
00004 /*      1986-Dec        process id's, file changes, syserrlist
00005 /*      1987-Feb        dup,isatty
00006 /*      1987-Apr        getwd,stat,time
00007 /*      1988-Jan,Feb    socket, select
00008 /*      1988-Dec        ioctl           
00009 /*      1990-Mar        VxWorks
00010 /*      Copyright(c) 1988 MATSUI Toshihiro, Electrotechnical Laboratory.
00011 /****************************************************************/
00012 
00013 static char *rcsid="@(#)$Id$";
00014 
00015 /* SunOS's gettimeofday used to accept only one argument.
00016 #ifdef Solaris2
00017 #define _SVID_GETTOD
00018 #endif
00019 */
00020 
00021 #include "eus.h"
00022 
00023 #if vxworks
00024 #define NSIG NUM_SIGNALS
00025 #define SIG_DFL 0
00026 #include <sigLib.h>
00027 #include <socket.h>
00028 #include <in.h>
00029 #else
00030 #include <sys/types.h>
00031 #include <sys/times.h>
00032 #include <sys/stat.h>
00033 #include <signal.h>
00034 #include <sys/ioctl.h>
00035 #include <sys/time.h>
00036 #include <sys/socket.h>
00037 #include <sys/un.h>
00038 #include <netinet/in.h>
00039 #include <netdb.h>
00040 #include <sys/mman.h>
00041 #include <string.h>
00042 #endif
00043 
00044 /*SONY/news doesn't have message queu ipc facilities*/
00045 #if !vxworks
00046 #include <sys/ipc.h>
00047 #include <sys/msg.h>
00048 #endif
00049 
00050 #if SunOS4_1 || (mips && !IRIX && !IRIX6)
00051 /* Sun likes to change ioccom constants frequently. */
00052 #define IOC_VOID   _IOC_VOID
00053 #define IOC_IN     _IOC_IN
00054 #define IOC_OUT    _IOC_OUT
00055 #define IOC_INOUT  _IOC_INOUT
00056 #endif
00057 
00058 #if Linux
00059 #define IOC_VOID 0
00060 #endif
00061 
00062 #if Solaris2 || Linux || alpha
00063 #include <errno.h>
00064 #include <dirent.h>
00065 #else
00066 extern int errno;
00067 #endif
00068 
00069 #if Linux
00070 #define IOC_VOID 0
00071 #endif
00072 
00073 
00074 #if alpha
00075 #include <sys/utsname.h>
00076 #include <sys/types.h>
00077 #include <sys/ipc.h>
00078 #include <sys/msg.h>
00079 #endif
00080 
00081 #if system5 || Linux
00082 #include <sys/utsname.h>
00083 #endif
00084 
00085 extern int sys_nerr;
00086 /*extern char *sys_errlist[];*/
00087 extern char *tzname[2];
00088 extern time_t timezone, altzone;        /*long*/
00089 extern int daylight;
00090 
00091 extern pointer eussigvec[NSIG];
00092 
00093 extern int coerceintval(pointer);
00094 
00095 
00096 /***************** times and status *****************/
00097 
00098 #if !vxworks
00099 pointer PTIMES(ctx,n,argv)
00100 register context *ctx;
00101 int n;
00102 pointer argv[];
00103 { struct tms buffer;
00104   register pointer t;
00105   long et;
00106   ckarg(0);
00107   et=times(&buffer);
00108   t=cons(ctx,makeint(buffer.tms_cstime),NIL);
00109   t=cons(ctx,makeint(buffer.tms_cutime),t);
00110   t=cons(ctx,makeint(buffer.tms_stime),t);
00111   t=cons(ctx,makeint(buffer.tms_utime),t);
00112   t=cons(ctx,mkbigint(et),t);
00113   return(t);}
00114 
00115 pointer RUNTIME(ctx,n,argv)
00116 register context *ctx;
00117 int n;
00118 pointer argv[];
00119 { struct tms buffer;
00120   ckarg(0);
00121   times(&buffer);
00122   return(makeint(buffer.tms_utime+buffer.tms_stime));}
00123 
00124 pointer LOCALTIME(ctx,n,argv)
00125 register context *ctx;
00126 pointer argv[];
00127 { long clock;
00128   struct tm *tms;
00129   pointer timevec;
00130   pointer *tv;
00131   pointer tz0, tz1, tz;
00132 
00133   if (n==1) clock=coerceintval(argv[0]);
00134   else clock=time(0);
00135   tms=localtime((time_t *)&clock);
00136   timevec=makevector(C_VECTOR,10);
00137   vpush(timevec);
00138   tz0=makestring(tzname[0],strlen(tzname[0]));
00139   vpush(tz0);
00140   tz1=makestring(tzname[1],strlen(tzname[1]));
00141   vpush(tz1);
00142   tz=cons(ctx, tz1, NIL);
00143   tz=cons(ctx, tz0, tz);
00144   tv=timevec->c.vec.v;
00145   tv[0]=makeint(tms->tm_sec); 
00146   tv[1]=makeint(tms->tm_min);
00147   tv[2]=makeint(tms->tm_hour);
00148   tv[3]=makeint(tms->tm_mday);
00149   tv[4]=makeint(tms->tm_mon); 
00150   tv[5]=makeint(tms->tm_year);
00151   tv[6]=makeint(tms->tm_wday);
00152   tv[7]=makeint(tms->tm_yday);
00153   tv[8]=(tms->tm_isdst>0)?T:NIL;
00154   tv[9]=tz;
00155   vpop(); vpop(); vpop();
00156   return(timevec);}
00157 
00158 pointer ASCTIME(ctx,n,argv)
00159 register context *ctx;
00160 int n;
00161 register pointer argv[];
00162 { register char *at;
00163   struct tm tms1, *tms;
00164   pointer a=argv[0];
00165   int i;
00166 
00167   ckarg(1);
00168   if (isintvector(argv[0])) tms=(struct tm *)a->c.ivec.iv;
00169   else if (isvector(a)) {
00170     tms1.tm_sec=ckintval(a->c.vec.v[0]);
00171     tms1.tm_min=ckintval(a->c.vec.v[1]);
00172     tms1.tm_hour=ckintval(a->c.vec.v[2]);
00173     tms1.tm_mday=ckintval(a->c.vec.v[3]);
00174     tms1.tm_mon=ckintval(a->c.vec.v[4]);
00175     tms1.tm_year=ckintval(a->c.vec.v[5]);
00176     tms1.tm_wday=ckintval(a->c.vec.v[6]);
00177     /* tms1.tm_yday=ckintval(a->c.vec.v[7]); */
00178     tms1.tm_isdst=(a->c.vec.v[8]==NIL)?0:1;
00179     tms= &tms1; }
00180   else error(E_NOINTVECTOR);
00181   at=asctime(tms);
00182   return(makestring(at,strlen(at)));}
00183 
00184 #if !Solaris2
00185 pointer GETRUSAGE(ctx,n,argv)
00186 register context *ctx;
00187 int n; pointer argv[];
00188 { register int who,i;
00189   long rusage[18];
00190   float utime,stime;
00191   register pointer r=NIL;
00192   numunion nu;
00193 
00194   ckarg(1); who=ckintval(argv[0]);
00195   getrusage(who,rusage);
00196   utime=rusage[0]+rusage[1]*1.0e-6;
00197   stime=rusage[2]+rusage[3]*1.0e-6;
00198   for (i=17; i>=4; i--) r=cons(ctx,makeint(rusage[i]),r);
00199   r=cons(ctx,makeflt(stime),r); r=cons(ctx,makeflt(utime),r);
00200   /*(utime stime maxrss ixrss idrss isrss page-reclaims page-faults swap
00201         inblock outblock msgsnd msgrcv nsignals
00202         voluntary-context-switch involuntary-context-switch) */
00203   return(r);}
00204 
00205 pointer GETPAGESIZE(ctx,n,argv)
00206 register context *ctx;
00207 int n; pointer argv[];
00208 { ckarg(0);
00209   return(makeint(getpagesize())); }
00210 
00211 #endif
00212 
00213 pointer GETTIMEOFDAY(ctx,n,argv)
00214 register context *ctx;
00215 int n;
00216 register pointer argv[];
00217 { struct timeval /*{long tv_sec, tv_usec;}*/ tm;
00218   float ftime;
00219   pointer p;
00220 
00221   /* (sec usec timezone daylight) */
00222   /* timezone is seconds west to the GMT */
00223   gettimeofday(&tm, 0);
00224   p=cons(ctx, makeint(daylight), NIL);
00225   p=cons(ctx, makeint(timezone),p);
00226   p=cons(ctx, mkbigint(tm.tv_usec), p);
00227   p=cons(ctx, mkbigint(tm.tv_sec), p);
00228   return(p);}
00229 
00230 pointer GETITIMER(ctx,n,argv)
00231 register context *ctx;
00232 int n;
00233 register pointer argv[];
00234 { int stat;
00235   struct itimerval tmval;
00236   float interval,value;
00237   numunion nu;
00238   ckarg(1);
00239   stat=getitimer(ckintval(argv[0]), &tmval);
00240   if (stat<0) return(NIL);
00241   interval=tmval.it_interval.tv_sec + ( tmval.it_interval.tv_usec*1.0E-6);
00242   value=tmval.it_value.tv_sec + (tmval.it_value.tv_usec*1.0E-6);
00243   return(cons(ctx,makeflt(value),
00244          cons(ctx,makeflt(interval),NIL)));}
00245 
00246 pointer SETITIMER(ctx,n,argv)
00247 register context *ctx;
00248 int n;
00249 register pointer argv[];
00250 { int stat;
00251   pointer result=NIL;
00252   struct itimerval tmval,oldtmval;
00253   float interval,value;
00254   numunion nu;
00255 
00256   ckarg(3);
00257   value=ckfltval(argv[1]); interval=ckfltval(argv[2]);
00258   tmval.it_value.tv_sec=value;
00259   tmval.it_value.tv_usec=(value-tmval.it_value.tv_sec)*1.0E6;
00260   tmval.it_interval.tv_sec=interval;
00261   tmval.it_interval.tv_usec=(interval-tmval.it_interval.tv_sec)*1.0E6;
00262   stat=setitimer(ckintval(argv[0]), &tmval, &oldtmval);
00263   if (stat<0) return(result);
00264   interval=oldtmval.it_interval.tv_sec + (oldtmval.it_interval.tv_usec*1.0E-6);
00265   value=oldtmval.it_value.tv_sec + (oldtmval.it_value.tv_usec*1.0E-6);
00266   return(cons(ctx,makeflt(interval),
00267          cons(ctx,makeflt(value),result)));}
00268 #endif /* ! vxworks */
00269 
00270 /****************************************************************/
00271 /* signal handling
00272 /****************************************************************/
00273 
00274 #ifdef SIGADDSET
00275 #undef SIGADDSET
00276 #endif
00277 #ifdef SIGDELSET
00278 #undef SIGDELSET
00279 #endif
00280 
00281 pointer SIGADDSET(ctx,n,argv)
00282 register context *ctx;
00283 int n;
00284 register pointer argv[];
00285 { int signum;
00286   sigset_t *set;
00287   ckarg(2);
00288   signum=ckintval(argv[1]);
00289   if (isvector(argv[0]) &&
00290         ((elmtypeof(argv[0])==ELM_INT) || (elmtypeof(argv[0])==ELM_BIT))) {
00291     set=(sigset_t *)argv[0]->c.ivec.iv;
00292     sigaddset(set, signum);
00293     return(argv[0]);}
00294   else error(E_USER,(pointer)"integer/bit vector expected for sigaddset");
00295   }
00296 
00297 pointer SIGDELSET(ctx,n,argv)
00298 register context *ctx;
00299 int n;
00300 register pointer argv[];
00301 { int signum;
00302   sigset_t *set;
00303   ckarg(2);
00304   signum=ckintval(argv[1]);
00305   if (isvector(argv[0]) &&
00306         ((elmtypeof(argv[0])==ELM_INT) || (elmtypeof(argv[0])==ELM_BIT))) {
00307     set=(sigset_t *)argv[0]->c.ivec.iv;
00308     sigdelset(set, signum);
00309     return(argv[0]);}
00310   else error(E_USER,(pointer)"integer/bit vector expected for sigaddset");
00311   }
00312 
00313 pointer SIGPROCMASK(ctx,n,argv)
00314 context *ctx;
00315 int n;
00316 pointer argv[];
00317 { sigset_t *set, *oset;
00318   int how, stat;
00319   ckarg2(2,3);
00320   how=ckintval(argv[0]);
00321   if (isvector(argv[1]) &&
00322         ((elmtypeof(argv[1])==ELM_INT) || (elmtypeof(argv[1])==ELM_BIT))) {
00323     set=(sigset_t *)argv[1]->c.ivec.iv;
00324     if (isvector(argv[2]) &&
00325         ((elmtypeof(argv[2])==ELM_INT) || (elmtypeof(argv[2])==ELM_BIT))) 
00326       oset=(sigset_t *)argv[2]->c.ivec.iv;
00327     else oset=(sigset_t *)0;
00328     stat=sigprocmask(how, set, oset);
00329     if (stat==0) return(T); else return(makeint(-errno));
00330     }
00331   else error(E_USER,(pointer)"integer/bit vector expected for sigprocmask");
00332   }
00333 
00334 pointer KILL(ctx,n,argv)
00335 register context *ctx;
00336 int n;
00337 register pointer argv[];
00338 { ckarg(2);
00339   return(makeint(kill(ckintval(argv[0]),ckintval(argv[1]))));}
00340 
00341 #if Solaris2 || Linux || IRIX || IRIX6
00342 pointer SIGNAL(ctx,n,argv)
00343 register context *ctx;
00344 int n;
00345 pointer argv[];
00346 { register int s,i;eusinteger_t f;
00347   struct sigaction sv;
00348   register pointer a=argv[1],oldval;
00349   extern void eusint(); 
00350 
00351   ckarg2(1,3);
00352   s=min(ckintval(argv[0]),NSIG-1);
00353   oldval=eussigvec[s];
00354   if (n==1) return(oldval);
00355   if (isint(a)) { f=max(1,intval(a)); eussigvec[s]=NIL;}
00356   else { f=(eusinteger_t)eusint; eussigvec[s]=a;}
00357   sv.sa_handler= (void (*)())f;
00358 #if Linux 
00359 
00360 #if LIB6
00361   for (i=0; i< _SIGSET_NWORDS; i++)   sv.sa_mask.__val[i]=0; 
00362 #else
00363   /* old type sigmask */
00364   sv.sa_mask=0;
00365 #endif 
00366 /*LIB6*/
00367 
00368 #elif (IRIX || IRIX6) && !IRIX6_2
00369   for (i=0; i<4; i++)   sv.sa_mask.sigbits[i]=0;
00370 #else
00371   for (i=0; i<4; i++)   sv.sa_mask.__sigbits[i]=0;
00372 #endif
00373 
00374   if (n==3) sv.sa_flags= ckintval(argv[2]);
00375   else sv.sa_flags=0;
00376   /* printf("signal %d flag=%d\n", s, sv.sa_flags); */
00377   s=sigaction(s,&sv,0);
00378   if (s== -1) return(makeint(-errno)); else return(oldval);
00379   }
00380 
00381 #else
00382 pointer SIGNAL(ctx,n,argv)
00383 register context *ctx;
00384 int n;
00385 pointer argv[];
00386 { register int s;eusinteger_t f;
00387   struct sigvec sv;
00388   register pointer a=argv[1],oldval;
00389   extern void eusint();
00390 
00391   ckarg2(1,3);
00392   s=min(ckintval(argv[0]),NSIG-1);
00393   oldval=eussigvec[s];
00394   if (n==1) return(oldval);
00395   if (isint(a)) { f=max(1,intval(a)); eussigvec[s]=NIL;}
00396   else { f=(eusinteger_t)eusint; eussigvec[s]=a;}/* ???? */
00397   sv.sv_handler=(void (*)())f;
00398   sv.sv_mask=0; /*sigmask(s)???;*/
00399 /*news doesn't have system5 compatible signal handling option*/
00400 #if sun3 || sun4  || mips || alpha
00401   if (n==3) sv.sv_flags=ckintval(argv[2]);
00402   else sv.sv_flags=0;
00403 #endif
00404   s=sigvec(s,&sv,0);
00405   if (s== -1) return(makeint(-errno)); else return(oldval);
00406   }
00407 
00408 #endif
00409 
00410 #if !vxworks
00411 
00412 pointer WAIT(ctx,n,argv)
00413 register context *ctx;
00414 int n;
00415 pointer argv[];
00416 { int completion=0, stat;
00417   stat = wait(&completion);
00418   return(cons(ctx,makeint(stat),
00419          cons(ctx,makeint(completion),NIL)));}
00420 
00421 pointer ALARM(ctx,n,argv)
00422 register context *ctx;
00423 int n; pointer argv[];
00424 { ckarg(1);
00425   return(makeint(alarm(ckintval(argv[0]))));}
00426 
00427 
00428 #if sun3 || sun4 || news || sanyo  || alpha
00429 #if !Solaris2
00430 pointer UALARM(ctx,n,argv)
00431 register context *ctx;
00432 int n; pointer argv[];
00433 { ckarg(2);
00434   return(makeint(ualarm(ckintval(argv[0]), ckintval(argv[1]))));}
00435 #endif
00436 #endif
00437 
00438 #endif 
00439 
00440 /**********************************************/
00441 /* process, user, and group identification 
00442 /**********************************************/
00443 
00444 pointer GETPID(ctx,n,argv)
00445 register context *ctx;
00446 int n;
00447 pointer *argv;  /* unused argument */
00448 { ckarg(0);
00449   return(makeint(getpid()));}
00450 
00451 #if !vxworks
00452 pointer GETPPID(ctx,n,argv)
00453 register context *ctx;
00454 int n;
00455 pointer argv[];
00456 { ckarg(0);
00457   return(makeint(getppid()));}
00458 
00459 pointer GETPGRP(ctx,n,argv)
00460 register context *ctx;
00461 int n;
00462 pointer argv[];
00463 #if system5 | Linux
00464 { ckarg(0);
00465   return(makeint(getpgrp()));}
00466 #else
00467 { int pid;
00468   if (n==1) pid=ckintval(argv[0]);
00469   else pid=getpid();
00470   return(makeint(getpgrp(pid)));}
00471 #endif
00472 
00473 pointer SETPGRP(context *ctx, int n, pointer *argv)
00474 #if system5 | Linux
00475 { ckarg(0);
00476   return(makeint(setpgrp()));}
00477 #else
00478 { int pid;
00479   ckarg(2);
00480   return(makeint(setpgrp(ckintval(argv[0]),ckintval(argv[1]))));}
00481 #endif
00482 
00483 pointer GETUID(context *ctx, int n, pointer *argv)
00484 { ckarg(0);
00485   return(makeint(getuid()));}
00486 
00487 pointer GETEUID(ctx,n,argv)
00488 register context *ctx;
00489 int n;
00490 pointer argv[];
00491 { ckarg(0);
00492   return(makeint(geteuid()));}
00493 
00494 pointer GETGID(ctx,n,argv)
00495 register context *ctx;
00496 int n;
00497 pointer argv[];
00498 { ckarg(0);
00499   return(makeint(getgid()));}
00500 
00501 pointer GETEGID(ctx,n,argv)
00502 register context *ctx;
00503 int n;
00504 pointer argv[];
00505 { ckarg(0);
00506   return(makeint(getegid()));}
00507 
00508 pointer SETUID(ctx,n,argv)
00509 register context *ctx;
00510 int n;
00511 pointer argv[];
00512 { ckarg(1);
00513   n=setuid(ckintval(argv[0]));
00514   if (n<0) return(makeint(errno)); else return(T);}
00515 
00516 pointer SETGID(ctx,n,argv)
00517 register context *ctx;
00518 int n;
00519 pointer argv[];
00520 { ckarg(1);
00521   n=setgid(ckintval(argv[0]));
00522   if (n<0) return(makeint(errno)); else return(T);}
00523 
00524 #endif 
00526 #if system5 || Linux
00527 pointer UNAME(ctx,n,argv)
00528 register context *ctx;
00529 int n;
00530 pointer *argv;
00531 { struct utsname u;
00532   pointer s;
00533   ckarg(0);
00534   uname(&u);
00535   vpush(makestring(u.sysname,strlen(u.sysname)));
00536   vpush(makestring(u.nodename,strlen(u.nodename)));
00537   vpush(makestring(u.release,strlen(u.release)));
00538   vpush(makestring(u.version,strlen(u.version)));
00539   vpush(makestring(u.machine,strlen(u.machine)));
00540   s=stacknlist(ctx,5);
00541   return(s);}
00542 #endif
00543 
00544 /****************************************************************/
00545 /* process creation and deletion 
00546 /****************************************************************/
00547 #if !vxworks
00548 pointer FORK(ctx,n,argv)
00549 register context *ctx;
00550 int n;
00551 pointer *argv;
00552 { ckarg(0);
00553   return(makeint(fork()));
00554   }
00555 
00556 #if Solaris2
00557 pointer FORK1(ctx,n,argv)
00558 register context *ctx;
00559 int n;
00560 pointer *argv;
00561 { ckarg(0);
00562   return(makeint(fork1()));
00563   }
00564 #endif
00565 
00566 #if sun3 || sun4 || vax || news || sanyo || (mips && !IRIX && !IRIX6) || i386 || alpha
00567 pointer VFORK(ctx,n,argv)
00568 register context *ctx;
00569 int n;
00570 pointer *argv;
00571 { ckarg(0);
00572   return(makeint(vfork()));} 
00573 #endif
00574 
00575 pointer EXEC(ctx,n,argv)
00576 register context *ctx;
00577 int n;
00578 pointer *argv;
00579 { byte *exeargv[512];
00580   int i=0,stat;
00581   if (n>512) error(E_MISMATCHARG);
00582   while (i<n) {
00583     exeargv[i]=Getstring(argv[i])->c.str.chars;
00584     i++;}
00585   exeargv[i]=0;
00586   stat=execvp(exeargv[0],(char **)exeargv);
00587   return(makeint(-errno));}       
00588 
00589 #if !Solaris2
00590 static pointer SETPRIORITY(ctx,n,argv)
00591 register context *ctx;
00592 int n;
00593 pointer *argv;
00594 /* (SETPRIORITY which who priority)
00595         which 0:process,  1:process-group,  2:user
00596         who   0:self, others pid, pgrp-id user-id */ 
00597 { ckarg(3);
00598   return(makeint(setpriority(ckintval(argv[0]),
00599                              ckintval(argv[1]),
00600                              ckintval(argv[2]))));}
00601 
00602 static pointer GETPRIORITY(ctx,n,argv)
00603 register context *ctx;
00604 int n;
00605 pointer *argv;
00606 /* (GETPRIORITY which who) */
00607 { ckarg(2);
00608   return(makeint(getpriority(ckintval(argv[0]), ckintval(argv[1]))));}
00609 #endif  
00610 #endif  
00612 pointer EXIT(ctx,n,argv)
00613 register context *ctx;
00614 int n;
00615 pointer *argv;
00616 { pointer exithook=speval(QEXITHOOK);
00617 /*
00618   Exit function can not finish threads which create in Euslisp 
00619 on SunOS 4.1. So we use thr_exit function on SunOS 4.1.
00620 */
00621 #if SunOS4_1 /* changed by H.Nakagaki at 28-Jun-1995 */
00622   if (n==0) thr_exit(0);
00623   else thr_exit(ckintval(argv[0]));
00624 #else
00625     if (exithook != NIL) {
00626       ufuncall(ctx,exithook,exithook,(pointer)(ctx->vsp),0,0);}
00627   if (n==0) exit(0);
00628   else exit(ckintval(argv[0]));
00629 #endif
00630 }
00631 
00632 
00633 /****************************************************************/
00634 /* unix raw I/O and file systems
00635 /****************************************************************/
00636 
00637 pointer UNIXREAD(ctx,n,argv)
00638 register context *ctx;
00639 int n;
00640 pointer argv[];
00641 /* (unix:read stream [length]) */
00642 /* (unix:read fd buffer [length [offset]]) */
00643 #if (WORD_SIZE == 64)
00644 { register int fd,offset=0;
00645   register long int size;
00646 #else
00647 { register int fd,size,offset=0;
00648 #endif
00649   register pointer strm,buf,count;
00650   byte *bufp;
00651   
00652   ckarg2(1,4);
00653   strm=argv[0];
00654   if (isiostream(strm)) strm=strm->c.iostream.in;
00655   if (isfilestream(strm)) {
00656     if (strm->c.stream.direction!=K_IN) error(E_IODIRECTION);
00657     if (isint(strm->c.fstream.fname)) error(E_STREAM);
00658     buf=strm->c.fstream.buffer;
00659     bufp=buf->c.str.chars;
00660     fd=intval(strm->c.fstream.fd);
00661     if (n==2) size=min(strlength(buf),ckintval(argv[1]));
00662     else size=strlength(buf);}
00663   else if (isint(strm)) {
00664     fd=intval(strm);
00665     buf=argv[1];
00666     if (isvector(buf) && (elmtypeof(buf)==ELM_FOREIGN)) 
00667       bufp=buf->c.foreign.chars;
00668     else if (isstring(buf)) bufp=buf->c.str.chars;
00669     else error(E_NOSTRING);
00670     if (n>=3) size=min(strlength(buf),ckintval(argv[2]));
00671     else size=strlength(buf);
00672     if (n==4) offset=ckintval(argv[3]);}
00673   else error(E_STREAM);
00674   size=read(fd, &bufp[offset],size);
00675   count=makeint(size);
00676   if (isstream(strm)) {
00677     strm->c.stream.count=0; strm->c.stream.tail=count;}
00678   if (size<0) return(makeint(-errno));
00679   else return(count);}
00680 
00681 pointer UNIXWRITE(ctx,n,argv)
00682 register context *ctx;
00683 register int n;
00684 pointer *argv;
00685 /* (unix:write fd string [count]) 
00686    (unix:write stream string [count]) */
00687 { register pointer strm,buf;
00688   register int size,fd;
00689   byte *bufp;
00690   ckarg2(2,3);
00691   strm=argv[0];
00692   if (isiostream(strm)) strm=strm->c.iostream.out;
00693   if (isfilestream(strm)) {
00694     if (strm->c.stream.direction!=K_OUT) error(E_IODIRECTION);
00695     if (isint(strm->c.fstream.fname)) error(E_STREAM);
00696     fd=intval(strm->c.fstream.fd);}
00697   else if (isint(strm)) fd=intval(strm);
00698   else error(E_STREAM);
00699   buf=argv[1];
00700   if (isvector(buf) && (elmtypeof(buf)==ELM_FOREIGN)) 
00701     bufp=buf->c.foreign.chars;
00702   else if (isstring(buf)) bufp=buf->c.str.chars;
00703   else error(E_NOSTRING);
00704   size=strlength(buf);
00705   if (n==3) size=min(size,ckintval(argv[2])); 
00706   size=write(fd,bufp,size);
00707   return(makeint(size));}
00708 
00709 
00710 pointer UNIXCLOSE(ctx,n,argv)
00711 register context *ctx;
00712 int n;
00713 pointer argv[];
00714 { ckarg(1);
00715   if (close(ckintval(argv[0]))==0) return(T); else return(makeint(errno));}
00716 
00717 
00718 pointer LOCKF(ctx,n,argv)
00719 register context *ctx;
00720 int n;
00721 pointer argv[];
00722 { register pointer a=argv[0];
00723   int fd,func,size,result;
00724   ckarg2(2,3);
00725   if (isiostream(a)) a=a->c.iostream.out;
00726   if (isfilestream(a)) fd=intval(a->c.fstream.fd);
00727   else if (isint(argv[0])) fd=intval(argv[0]);
00728   else error(E_STREAM);
00729   func= ckintval(argv[1]);
00730   if (n==3) size=ckintval(argv[2]);
00731   else size=0;
00732   result=lockf(fd,func,size);
00733   return(makeint(result));}
00734 
00735 pointer FCNTL(ctx,n,argv)
00736 register context *ctx;
00737 int n;
00738 pointer argv[];
00739 { register pointer a=argv[0]; int fd,result;
00740   ckarg(3);
00741   if (isiostream(a)) a=a->c.iostream.in;
00742   if (isfilestream(a)) fd=intval(a->c.fstream.fd);
00743   else if (isint(argv[0])) fd=intval(argv[0]);
00744   else error(E_STREAM);
00745   result=fcntl(fd,ckintval(argv[1]),ckintval(argv[2]));
00746   return(makeint(result));}
00747 
00748 
00749 pointer IOCTL(ctx,n,argv)
00750 register context *ctx;
00751 int n;
00752 register pointer argv[];
00753 { register pointer strm;
00754   eusinteger_t ctlarg;
00755   int request;
00756   int fd;
00757   ckarg(3);
00758   strm=argv[0];
00759   if (isiostream(strm)) strm=strm->c.iostream.out;
00760   if (isfilestream(strm)) {
00761     fd=intval(strm->c.fstream.fd);
00762     if (isint(strm->c.fstream.fname)) error(E_STREAM);}
00763   else fd=ckintval(argv[0]);
00764   if (isint(argv[1]))  request=ckintval(argv[1]);
00765   else if (isflt(argv[1])) error(E_NOINT);
00766   else request=argv[1]->c.ivec.iv[0];
00767   if (isstring(argv[2])) ctlarg=(eusinteger_t)(argv[2]->c.str.chars);/* ???? */
00768   else ctlarg=ckintval(argv[2]);
00769   return(makeint(ioctl(fd,request,ctlarg)));
00770   }
00771 
00772 
00773 #if !vxworks && !Solaris2
00774 int bytesize(p)
00775 pointer p;
00776 { register int s=vecsize(p);
00777   switch (elmtypeof(p)) {
00778     case ELM_BIT: return((s+7)/8);
00779     case ELM_BYTE: case ELM_CHAR: case ELM_FOREIGN: return(s);
00780     case ELM_FLOAT: return(s*sizeof(float));
00781     case ELM_INT: return(s*sizeof(int));
00782     default: return(s*sizeof(pointer));}}
00783 
00784 #if Linux_ppc
00785 #define IOC_IN   _IOC_READ
00786 #define IOC_OUT  _IOC_WRITE
00787 #define IOC_INOUT  (IOC_IN | IOC_OUT)
00788 #endif
00789 
00790 
00791 pointer IOCTL_(ctx,n,argv)
00792 register context *ctx;
00793 /* (UNIX:IOCTL_ stream command1 command2) */
00794 /* equivalent to C's ioctl(dev, _IO(command1, command2), addr) */
00795 int n;
00796 register pointer argv[];
00797 { register pointer strm;
00798   int size=0,x,y,fd;
00799   eusinteger_t addr;
00800   ckarg(3);
00801   strm=argv[0];
00802   if (isiostream(strm)) strm=strm->c.iostream.out;
00803   if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
00804   else fd=ckintval(strm);
00805   if (isint(strm->c.fstream.fname)) error(E_STREAM);
00806   x=ckintval(argv[1]); y=ckintval(argv[2]);
00807 #if alpha || Linux_ppc
00808   if (ioctl(fd,_IO(x, y), addr))
00809 #else
00810   if (ioctl(fd,IOC_VOID | (size<<16) | (x<<8) | y, addr))
00811 #endif
00812      return(makeint(-errno));
00813   else return(T);  }
00814 
00815 pointer IOCTL_R(ctx,n,argv)
00816 register context *ctx;
00817 /* (UNIX:IOCTL_R stream x y buffer [size]) */
00818 /* equivalent to C's ioctl(dev, _IORN(size, x, y), addr) */
00819 int n;
00820 register pointer argv[];
00821 { register pointer strm;
00822   int size,x,y,fd;
00823   eusinteger_t addr;
00824   ckarg2(4,5);
00825   strm=argv[0];
00826   if (isiostream(strm)) strm=strm->c.iostream.out;
00827   if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
00828   else fd=ckintval(strm);
00829   if (isint(strm->c.fstream.fname)) error(E_STREAM);
00830   x=ckintval(argv[1]); y=ckintval(argv[2]);
00831   if (isstring(argv[3]) || isintvector(argv[3]))
00832         addr=(eusinteger_t)(argv[3]->c.str.chars);/* ???? */
00833   else error(E_NOSTRING);
00834   if (n==5) size=ckintval(argv[4]);
00835   else size=bytesize(argv[3]);
00836 #if alpha
00837   if (ioctl(fd,_IOC(IOC_OUT, x, y, size), addr))
00838 #else
00839   if (ioctl(fd,IOC_OUT | (size<<16) | (x<<8) | y, addr))
00840 #endif
00841     return(makeint(-errno));
00842   else return(T);  }
00843 
00844 pointer IOCTL_W(ctx,n,argv)
00845 register context *ctx;
00846 /* (UNIX:IOCTL_W stream x y buffer [size]) */
00847 /* equivalent to C's ioctl(dev, _IOWN(size, x, y), addr) */
00848 int n;
00849 register pointer argv[];
00850 { register pointer strm;
00851   int size,x,y,fd;
00852   eusinteger_t addr;
00853   ckarg2(4,5);
00854   strm=argv[0];
00855   if (isiostream(strm)) strm=strm->c.iostream.out;
00856   if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
00857   else fd=ckintval(strm);
00858   if (isint(strm->c.fstream.fname)) error(E_STREAM);
00859   x=ckintval(argv[1]); y=ckintval(argv[2]);
00860   if (isstring(argv[3]) || isintvector(argv[3]))
00861         addr=(eusinteger_t)(argv[3]->c.str.chars);/* ???? */
00862   else error(E_NOSTRING);
00863   if (n==5) size=ckintval(argv[4]);
00864   else size=bytesize(argv[3]);
00865 #if alpha || Linux_ppc
00866   if (ioctl(fd,_IOC(IOC_IN, x, y, size), addr))
00867 #else
00868   if (ioctl(fd,IOC_IN | (size<<16) | (x<<8) | y, addr))
00869 #endif
00870     return(makeint(-errno));
00871   else return(T);  }
00872 
00873 pointer IOCTL_WR(ctx,n,argv)
00874 register context *ctx;
00875 /* (UNIX:IOCTL_WR stream x y buffer [size]) */
00876 /* equivalent to C's ioctl(dev, _IOWRN(size, x, y), addr) */
00877 int n;
00878 register pointer argv[];
00879 { register pointer strm=argv[0];
00880   int size,x,y,fd;
00881   eusinteger_t addr;
00882 
00883   ckarg2(4,5);
00884   if (isiostream(strm)) strm=strm->c.iostream.out;
00885   if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
00886   else fd=ckintval(strm);
00887   if (isint(strm->c.fstream.fname)) error(E_STREAM);
00888   x=ckintval(argv[1]); y=ckintval(argv[2]);
00889   if (isstring(argv[3]) || isintvector(argv[3]))
00890         addr=(eusinteger_t)(argv[3]->c.str.chars);
00891   else error(E_NOSTRING);
00892   if (n==5) size=ckintval(argv[4]);
00893   else size=bytesize(argv[3]);
00894 #if alpha || Linux_ppc
00895   if (ioctl(fd,_IOC(IOC_INOUT, x, y, size), addr))
00896 #else
00897   if (ioctl(fd,IOC_INOUT | (size <<16) | (x<<8) | y, addr))
00898 #endif
00899     return(makeint(-errno)) ;
00900   else return(T);  }
00901 
00902 #endif /*vxworks*/
00903 
00904 /* DUP and DUP2 work only for numeric fd, not for stream obj.*/
00905 #if !vxworks
00906 
00907 pointer DUP(ctx,n,argv)
00908 register context *ctx;
00909 int n;
00910 pointer *argv;
00911 { int newfd,oldfd;
00912   ckarg(1);
00913   oldfd=ckintval(argv[0]);
00914   newfd=dup(oldfd);
00915   return(makeint(newfd));}
00916 
00917 pointer DUP2(ctx,n,argv)
00918 register context *ctx;
00919 int n;
00920 pointer *argv;
00921 { int newfd,oldfd,stat;
00922   ckarg(2);
00923   newfd=ckintval(argv[0]);
00924   oldfd=ckintval(argv[1]);
00925   stat=dup2(newfd,oldfd);
00926   return(makeint(stat));}
00927 
00928 pointer MKNOD(ctx,n,argv)
00929 register context *ctx;
00930 int n;
00931 pointer *argv;
00932 { int stat;
00933   ckarg(2);
00934   stat=mknod((char *)Getstring(argv[0])->c.str.chars,ckintval(argv[1]),0);
00935   if (stat<0) return(makeint(-errno));
00936   else return(T);}
00937 
00938 pointer MKDIR(ctx, n, argv)
00939 register context *ctx;
00940 int n;
00941 pointer *argv;
00942 { int stat, mode;
00943   ckarg2(1,2);
00944   if (n==2) mode=ckintval(argv[1]); else mode=0775;
00945   stat=mkdir((char *)Getstring(argv[0])->c.str.chars,mode);
00946   if (stat<0) return(makeint(-errno));
00947   else return(T);}
00948 
00949 pointer LINK(ctx,n,argv)
00950 register context *ctx;
00951 int n;
00952 pointer argv[];
00953 { int stat;
00954   ckarg(2);
00955   stat=link(Getstring(argv[0])->c.str.chars,Getstring(argv[1])->c.str.chars);
00956   if (stat<0) return(makeint(-errno)); else return(T);}
00957 
00958 pointer UNLINK(ctx,n,argv)
00959 register context *ctx;
00960 int n;
00961 pointer argv[];
00962 { pointer s;
00963   int stat;
00964   ckarg(1);
00965   s=Getstring(argv[0]);
00966   stat=unlink(s->c.str.chars);
00967   if (stat<0) return(makeint(-errno));
00968   else return(T);}
00969 
00970 pointer RMDIR(ctx,n,argv)
00971 register context *ctx;
00972 int n;
00973 pointer argv[];
00974 { pointer s;
00975   int stat;
00976   ckarg(1);
00977   s=Getstring(argv[0]);
00978   stat=rmdir(s->c.str.chars);
00979   if (stat<0) return(makeint(-errno));
00980   else return(T);}
00981 
00982 pointer RENAME(ctx,n,argv)      /*(rename from to)*/
00983 register context *ctx;
00984 int n;
00985 register pointer argv[];
00986 { byte *from, *to;
00987   int stat;
00988   ckarg(2);
00989   from =(byte *)get_string(argv[0]);
00990   to =(byte *)get_string(argv[1]);
00991   stat=rename((char *)from,(char *) to);
00992   if (stat<0) return(makeint(-errno));
00993   else return(T);}
00994 
00995 pointer ACCESS(ctx,n,argv)
00996 register context *ctx;
00997 int n;
00998 pointer *argv;
00999 { pointer path;
01000   int mode,stat;
01001   ckarg2(1,2);
01002   path=Getstring(argv[0]);
01003   if (n==2) mode=ckintval(argv[1]); else mode=0;
01004   stat=access(path->c.str.chars,mode);
01005   if (stat==0) return(T); else return(makeint(-errno));}
01006 
01007 /*
01008 pointer FLOCK(ctx,n,argv)
01009 register context *ctx;
01010 int n;
01011 pointer argv[];
01012 { int fd=ckintval(argv[0]), op=ckintval(argv[1]), stat;
01013   ckarg(2);
01014   stat=flock(fd,op);
01015   if (stat==0) return(T); else return(makeint(-errno));}
01016 */
01017 
01018 pointer STAT(ctx,n,argv)
01019 register context *ctx;
01020 int n;
01021 pointer *argv;
01022 { register pointer a;
01023   struct stat s;
01024   ckarg(1);
01025   if (stat((char *)Getstring(argv[0])->c.str.chars, &s)<0) return(makeint(-errno));
01026   a=cons(ctx,mkbigint(s.st_ctime),NIL);
01027   a=cons(ctx,mkbigint(s.st_mtime),a);
01028   a=cons(ctx,mkbigint(s.st_atime),a);
01029   a=cons(ctx,makeint(s.st_size),a);
01030   a=cons(ctx,makeint(s.st_gid),a);
01031   a=cons(ctx,makeint(s.st_uid),a);
01032   a=cons(ctx,makeint(s.st_nlink),a);
01033   a=cons(ctx,makeint(s.st_rdev),a);
01034   a=cons(ctx,makeint(s.st_dev),a);
01035   a=cons(ctx,makeint(s.st_ino),a);
01036   a=cons(ctx,makeint(s.st_mode),a);
01037   return(a);}
01038 #endif /* !vxworks*/
01039 
01040 #if Solaris2 || linux || alpha
01041 /*
01042   Usage: (unix::directory "directory_name")
01043   Return: a reverse list of file names in "directory_name" dir.
01044 */
01045 
01046 pointer DIRECTORY(ctx, n, argv)
01047 register context *ctx;
01048 int n;
01049 pointer argv[];
01050 { register pointer a;
01051   register char *str;
01052   byte *s;
01053   DIR *dirp;
01054   struct dirent *direntp;
01055   int flag=0;
01056 
01057   ckarg2(0,1);
01058   if (n==1)  s=get_string(argv[0]); else s=(byte *)".";
01059   dirp = opendir((char *)s);
01060   while ( (direntp = readdir( dirp )) != NULL ){
01061      str=direntp->d_name; 
01062      if(flag) a=cons(ctx,makestring(str,strlen(str)),a);
01063      else { a=cons(ctx,makestring(str,strlen(str)),NIL); flag++;}
01064    }
01065    closedir(dirp);
01066    return (a);
01067 }
01068 #else
01069 pointer DIRECTORY(ctx, n, argv)
01070 register context *ctx;
01071 int n;
01072 pointer argv[];
01073 {
01074    printf("Not Implemented!");
01075    return (NIL);
01076 }
01077 #endif
01078 
01079 pointer LSEEK(ctx,n,argv)
01080 register context *ctx;
01081 int n;
01082 pointer *argv;
01083 { pointer strm,fd;
01084   int whence;
01085   ckarg2(2,3);
01086   if (n==3) whence=ckintval(argv[2]); else whence=0;
01087   strm=argv[0];
01088   if (isiostream(strm)) strm=strm->c.iostream.out;
01089   if (isfilestream(strm)){
01090      fd=strm->c.fstream.fd;
01091      if (isint(strm->c.fstream.fname)) error(E_STREAM);}
01092   else fd=strm;
01093   if (!isint(fd)) error(E_STREAM);
01094   return(makeint(lseek(intval(fd),ckintval(argv[1]),whence)));  }
01095 
01096 #if !vxworks
01097 /*change current working directory*/
01098 pointer CHDIR(ctx,n,argv)
01099 register context *ctx;
01100 int n;
01101 pointer argv[];
01102 { register int stat;
01103   ckarg(1);
01104   stat=chdir(Getstring(argv[0])->c.str.chars);
01105   if (stat<0) return(makeint(-errno)); else return(T);}
01106 
01107 /*change file access mode*/
01108 pointer CHMOD(ctx,n,argv)
01109 register context *ctx;
01110 int n;
01111 pointer *argv;
01112 { byte *path;
01113   int mode,stat;
01114   ckarg(2);
01115   path=Getstring(argv[0])->c.str.chars;
01116   mode=ckintval(argv[1]);
01117   stat=chmod((char *)path,mode);
01118   if (stat==0) return(T); else return(makeint(errno));}
01119 
01120 /*change file owner*/
01121 pointer CHOWN(ctx,n,argv)
01122 register context *ctx;
01123 int n;
01124 pointer *argv;
01125 { byte *path;
01126   int owner,newowner,stat;
01127   ckarg(3);
01128   path=Getstring(argv[0])->c.str.chars;
01129   owner=ckintval(argv[1]);
01130   newowner=ckintval(argv[2]);
01131   stat=chown(path,owner,newowner);
01132   if (stat==0) return(T); else return(makeint(errno));}
01133 
01134 /*create two pipes*/
01135 pointer PIPE(ctx,n,argv)
01136 register context *ctx;
01137 int n;
01138 pointer *argv;
01139 { int pfd[2],stat,size;
01140   register pointer instream,outstream;
01141 
01142   ckarg2(0,1);
01143   if (n==1) size=ckintval(argv[0]); else size=128;
01144   stat=pipe(pfd);
01145   if (stat<0) return(makeint(-errno));
01146   instream=mkfilestream(ctx,K_IN,makebuffer(size),pfd[0],NIL); /*no file named*/
01147   vpush(instream);
01148   outstream=mkfilestream(ctx,K_OUT,makebuffer(size),pfd[1],NIL);
01149   return((pointer)mkiostream(ctx,vpop(),outstream));
01150   }
01151 
01152 
01153 /* message queu operations */
01154 #if !news
01155 pointer MSGGET(ctx,n,argv)
01156 register context *ctx;
01157 int n;
01158 pointer argv[];
01159 { register int key,qid,mode;
01160   ckarg2(1,2);
01161   key=ckintval(argv[0]);
01162   if (n==2) mode=ckintval(argv[1]); else mode=0666;
01163   qid=msgget(key,IPC_CREAT | (mode & 0777));
01164   return(makeint(qid));}
01165 
01166 pointer MSGRCV(ctx,n,argv)
01167 register context *ctx;
01168 int n;
01169 pointer *argv;
01170 { register int qid,mtype,flag,stat;
01171   register pointer buf,lsave;
01172   ckarg2(2,4);
01173   qid=ckintval(argv[0]);
01174   buf=argv[1];
01175   if (!isstring(buf)) error(E_NOSTRING);
01176   if (n>=3) mtype=ckintval(argv[2]); else mtype=0;
01177   if (n==4) if (argv[3]==NIL) flag=0; else flag=IPC_NOWAIT;
01178   else flag=0;
01179   lsave=buf->c.str.length;
01180   buf->c.str.length=(pointer)(eusinteger_t)mtype;/* ???? */
01181   rcv_again:
01182   stat=msgrcv(qid,&buf->c.str.length,intval(lsave),mtype,flag);
01183   if (stat<0) { breakck; goto rcv_again;}
01184   mtype=(int)(eusinteger_t)(buf->c.str.length);/* ???? */
01185   buf->c.str.length=lsave;
01186   if (stat<0) return(makeint(-errno));
01187   else return(cons(ctx,makeint(mtype),cons(ctx,makeint(stat),NIL)));}
01188   
01189 pointer MSGSND(ctx,n,argv)
01190 register context *ctx;
01191 int n;
01192 pointer *argv;
01193 { register int qid,msize,mtype,flag,stat;
01194   register pointer buf,lsave;
01195   ckarg2(2,5);
01196   qid=ckintval(argv[0]);
01197   buf=argv[1];
01198   if (!isstring(buf)) error(E_NOSTRING);
01199   lsave=buf->c.str.length;
01200   if (n>=3) {
01201     msize=ckintval(argv[2]);
01202     if (msize>intval(lsave) || msize<0) error(E_ARRAYINDEX);}
01203   else msize=intval(lsave);
01204   if (n>=4) mtype=ckintval(argv[3]); else mtype=mypid;
01205   if (n==5) if (argv[4]==NIL) flag=0; else flag=IPC_NOWAIT;
01206   else flag=0;
01207   buf->c.str.length=(pointer)(eusinteger_t)mtype;
01208   stat=msgsnd(qid,(struct msgbuf *)&buf->c.str.length,msize,flag);
01209   buf->c.str.length=lsave;
01210   if (stat<0) return(makeint(-errno));
01211   else return(makeint(stat));}
01212 
01213 pointer MSGCTL(ctx,n,argv)
01214 register context *ctx;
01215 int n;
01216 pointer argv[];
01217 { int qid,cmnd,stat;
01218   byte *buf;
01219   ckarg2(2,3);
01220   qid=ckintval(argv[0]); cmnd=ckintval(argv[1]);
01221   if (n==3) buf=get_string(argv[2]);
01222   else buf=NULL;
01223   stat=msgctl(qid,cmnd,(struct msqid_ds *)buf);
01224   if (stat==(int)NULL) return(T); else  return(makeint(-errno));}
01225 #endif
01226 #endif 
01227 
01228 /****************************************************************/
01229 /* UNIX subroutines
01230 /****************************************************************/
01231 
01232 pointer SYSTEM(ctx,n,argv)
01233 register context *ctx;
01234 int n;
01235 register pointer argv[];
01236 { int stat;
01237   eusinteger_t s;
01238 /*  extern int eusint(); */
01239   extern void eusint(); /* ???? */
01240 
01241   s=(eusinteger_t)signal(SIGCHLD,SIG_DFL);/* ???? */
01242   if (n==0) stat=system("csh");
01243   else if (isstring(argv[0])) stat=system((char *)argv[0]->c.str.chars);
01244   else { signal(SIGCHLD,(void (*)())s); error(E_NOSTRING);}
01245   signal(SIGCHLD,(void (*)())s);
01246   return(makeint(stat));}
01247 
01248 pointer GETWD(ctx,n,argv)
01249 register context *ctx;
01250 int n;
01251 pointer argv[];
01252 { char buf[256];
01253   ckarg(0);
01254 #if Solaris2 || Linux
01255   getcwd(buf,256);
01256 #else
01257   getwd(buf);
01258 #endif
01259   return(makestring(buf,strlen(buf)));}
01260 
01261 pointer GETENV(ctx,n,argv)
01262 register context *ctx;
01263 int n;
01264 pointer *argv;
01265 { register char *envval;
01266   ckarg(1);
01267   envval=(char *)getenv((char *)Getstring(argv[0])->c.str.chars);
01268   if (envval) return(makestring(envval,strlen(envval)));
01269   else return(NIL);}
01270 
01271 #if sun3 || sun4 || vax || mips || i386 || alpha
01272 pointer PUTENV(ctx,n,argv)
01273 register context *ctx;
01274 int n;
01275 pointer argv[];
01276 { 
01277   char *b;
01278   pointer a=argv[0];
01279   ckarg(1);
01280   if (!isstring(a)) error(E_NOSTRING);
01281   b= (char *)malloc(vecsize(a)+1);
01282   strcpy(b, (char *)a->c.str.chars);
01283   putenv(b);
01284   return(makeint((eusinteger_t)b));}
01285 #endif
01286 
01287 pointer ENVIRON(context *ctx, int n, pointer argv[])
01288 { extern char **environ;
01289   char  *b;
01290   int  count=0;
01291   ckarg(0);
01292   while (b=environ[count++]) {
01293     vpush(makestring(b, strlen(b)));}
01294   return(stacknlist(ctx, count-1)); }
01295 
01296 pointer SLEEP(ctx,n,argv)
01297 register context *ctx;
01298 int n;
01299 pointer *argv;
01300 { ckarg(1);
01301   sleep(ckintval(argv[0]));
01302   return(T);}
01303 
01304 #if sun3 || sun4 && !Solaris2 || Linux || alpha
01305 pointer USLEEP(ctx,n,argv)
01306 register context *ctx;
01307 int n;
01308 pointer *argv;
01309 { ckarg(1);
01310   usleep(ckintval(argv[0]));
01311   return(T);}
01312 #endif
01313 
01314 pointer ERRNO(ctx,n,argv)
01315 context *ctx;
01316 int n;
01317 pointer argv[];
01318 { 
01319   return(makeint(errno));
01320   }
01321 
01322 pointer SYSERRLIST(ctx,n,argv)
01323 register context *ctx;
01324 register int n;
01325 pointer argv[];
01326 { char *errstr;
01327   ckarg(1);
01328   n=ckintval(argv[0]);
01329   if (0<=n && n<sys_nerr) {
01330     errstr=strerror(n);
01331     /* return(makestring(sys_errlist[n],strlen(sys_errlist[n]))); */
01332     return(makestring(errstr, strlen(errstr))); }
01333   else error(E_ARRAYINDEX);}
01334 
01335 pointer PAUSE(ctx,n,argv)
01336 register context *ctx;
01337 int n;
01338 pointer argv[];
01339 { ckarg(0);
01340   return(makeint(pause()));}
01341 
01342 pointer ISATTY(ctx,n,argv)
01343 register context *ctx;
01344 int n;
01345 pointer argv[];
01346 { pointer a;
01347   int fd;
01348   ckarg(1);
01349   a=argv[0];
01350   if (isiostream(a)) a=a->c.iostream.in;
01351   if (isfilestream(a)) fd=intval(a->c.fstream.fd);
01352   else fd=ckintval(a);
01353   if (isatty(fd)) return(T); else return(NIL);}
01354 
01355 
01356 /****************************************************************/
01357 /* functions for  I P C (interprocess communication)
01358 /* using sockets
01359 /*      1988-Jan        socket for internet
01360 /*      1988-Feb        select system call
01361 /****************************************************************/
01362 
01363 pointer SOCKET(ctx,n,argv)
01364 register context *ctx;
01365 int n;
01366 pointer argv[];
01367 { int proto,s;
01368   ckarg2(2,3);
01369   if (n==3) proto=ckintval(argv[2]);
01370   else proto=0;
01371   s=socket(ckintval(argv[0]),ckintval(argv[1]),proto);
01372   if (s<0) return(makeint(-errno));
01373   else return(makeint(s)); }
01374 
01375 pointer BIND(ctx,n,argv)        /*bind ipc socket to real path name*/
01376 register context *ctx;
01377 int n;
01378 register pointer argv[];
01379 { int s,l;
01380   pointer sockname;
01381   struct sockaddr *sa;
01382 
01383   ckarg(2);
01384   s=ckintval(argv[0]);  /*socket id*/
01385   if (!isstring(argv[1])) error(E_USER,(pointer)"socket address expected");
01386   sa= (struct sockaddr *)(argv[1]->c.str.chars);
01387   if (sa->sa_family==AF_UNIX) l=strlen(sa->sa_data)+2;
01388   else l=sizeof(struct sockaddr_in);
01389   s=(int)bind(s, sa, l);
01390   if (s) return(makeint(-errno)); else return(makeint(0));}
01391   
01392 pointer CONNECT(ctx,n,argv)
01393 register context *ctx;
01394 int n;
01395 pointer argv[];
01396 { int s,l;
01397   struct sockaddr *sa;
01398   ckarg(2);
01399   s=ckintval(argv[0]);          /*socket id*/
01400   if (!isstring(argv[1])) error(E_USER,(pointer)"socket address expected");
01401   sa= (struct sockaddr *)(argv[1]->c.str.chars);
01402   if (sa->sa_family==AF_UNIX) l=strlen(sa->sa_data)+2;
01403   else l=sizeof(struct sockaddr_in);
01404   s=(int)connect(s, sa, l);
01405   breakck;
01406   if (s) return(makeint(-errno)); else return(makeint(0));
01407 }
01408 
01409 pointer LISTEN(ctx,n,argv)
01410 register context *ctx;
01411 int n;
01412 pointer argv[];
01413 { int backlog,stat;
01414   ckarg2(1,2);
01415   if (n==2) backlog=ckintval(argv[1]);
01416   else backlog=3;
01417   stat=listen(ckintval(argv[0]),backlog);
01418   if (stat<0) return(makeint(-errno)); else return(makeint(0));}
01419 
01420 pointer ACCEPT(ctx,n,argv)
01421 register context *ctx;
01422 int n;
01423 pointer argv[];
01424 { int ns,len,s;
01425   pointer sockname;
01426 #if vxworks
01427   struct sockaddr sockun;
01428 #else 
01429   struct sockaddr_un sockun;
01430 #endif
01431 
01432   ckarg(1);
01433   len=sizeof(sockun);
01434   s=ckintval(argv[0]);
01435   ns=accept(s, (struct sockaddr *)&sockun, &len);
01436   if (ns<0) return(makeint(-errno));
01437   sockname=makestring((char *)&sockun,len);
01438   return(cons(ctx,makeint(ns),cons(ctx,sockname,NIL)));}
01439 
01440 /* non-connected (datagram) socket communication */
01441 /* Address must be bound to a socket at the receiver side. */
01442 /* Sender specifies the address when it calls SENDTO. */
01443 pointer SENDTO(ctx,n,argv)
01444 register context *ctx;
01445 int n;
01446 pointer argv[];
01447 /* unix: sendto(sock,msg,len,flags,to,tolen) */
01448 /* eus:  (SENDTO sock addr msg [len [flags]]) */
01449 { int len, sock, flags, stat;
01450   pointer msg, addr;
01451   ckarg2(3,5);
01452   sock=ckintval(argv[0]);
01453   addr=(pointer)Getstring(argv[1]);
01454   msg=(pointer)Getstring(argv[2]);
01455   if (n>=4) len=ckintval(argv[3]); else len=vecsize(msg);
01456   if (n>=5) flags=ckintval(argv[4]); else flags=0;
01457   stat=sendto(sock, (char *)msg->c.str.chars, len, flags,
01458                 (struct sockaddr *)addr->c.str.chars, vecsize(addr));
01459   if (stat<0) stat= -errno;
01460   /* returns the number of bytes actually sent*/
01461   return(makeint(stat));}
01462 
01463 pointer RECVFROM(ctx,n,argv)
01464 register context *ctx;
01465 int n;
01466 pointer argv[];
01467 /* unix: recvfrom(s,buf,len,flags,from,fromlen) */
01468 /* eus:  (RECVFROM sock [msg [from [flags]]])
01469          no address is required since it has already bound to
01470          the socket */
01471 { int len=2000, sock, flags, stat, addrlen;
01472   unsigned char buf[2000], *bufp=buf, *addrp=NULL;
01473   pointer msg, addr;
01474   ckarg2(1,4);
01475   sock=ckintval(argv[0]);
01476   if (n>=2) {
01477     msg=argv[1];
01478     if (isstring(msg))  msg=(pointer)Getstring(argv[1]); /*message buffer*/
01479     else msg=makebuffer(ckintval(argv[1]));
01480     bufp=msg->c.str.chars;
01481     len=vecsize(msg);}
01482   if (n>=3) {
01483     addr=Getstring(argv[2]);
01484     addrlen=vecsize(addr);
01485     addrp=addr->c.str.chars;}
01486   if (n>=4) flags=ckintval(argv[3]); else flags=0;
01487   stat=recvfrom(sock, (char *)bufp, len, flags, (struct sockaddr *)addrp, &addrlen);
01488   if (stat<0) return(makeint(-errno));
01489   /* if the result is negative, it indicates error number,
01490      otherwise, the actual length of the message is returned. */
01491   if (n<2) return(makestring((char *)bufp,stat));
01492   else return(makeint(stat));}
01493 
01494 #if !Solaris2
01495 pointer GETPEERNAME(ctx,n,argv)
01496 register context *ctx;
01497 int n;
01498 pointer argv[];
01499 { char name[128];
01500   int namelen, stat;
01501   ckarg(1);
01502   stat=getpeername(ckintval(argv[0]), (struct sockaddr *)name, &namelen);
01503   if (stat<0) return(makeint(-errno));
01504   else return(makestring(name,namelen));}
01505 #endif 
01507 #if !vxworks 
01508 
01509 eusinteger_t *checkbitvec(pointer a, long *size)
01510 { if (a==NIL) { *size=0; return(0);}
01511   if (!isvector(a)) error(E_NOVECTOR);
01512   switch(elmtypeof(a)) {
01513   case ELM_BIT: *size=vecsize(a); return(a->c.ivec.iv);
01514   case ELM_INT: *size=vecsize(a) * WORD_SIZE; return(a->c.ivec.iv);
01515   case ELM_BYTE: case ELM_CHAR:
01516                 *size=vecsize(a) * 8; return(a->c.ivec.iv);
01517   case ELM_FOREIGN: *size=vecsize(a) * 8; return((eusinteger_t *)a->c.foreign.chars);
01518   default: error(E_USER,(pointer)"bit-vector expected");
01519   }
01520 }
01521 
01522 pointer SELECT(ctx,n,argv)
01523 register context *ctx;
01524 int n;
01525 register pointer argv[];
01526 { register pointer a=argv[0];
01527   long i, maxwidth, width,size0, size1, size2;
01528   fd_set *readfds, *writefds, *exceptfds;
01529   float timeout;
01530   struct timeval to;
01531   numunion nu;
01532 
01533   ckarg(4);
01534   readfds=(fd_set *)checkbitvec(argv[0], &size0);
01535   writefds=(fd_set *)checkbitvec(argv[1], &size1);
01536   exceptfds=(fd_set *)checkbitvec(argv[2], &size2);
01537   maxwidth=min(256, max(max(size0, size1), size2)); 
01538 
01539 /*  printf("SELECT: readfds=%x\n", readfds);
01540   printf("SELECT: writefds=%x\n", writefds);
01541   printf("SELECT: exceptfds=%x\n", exceptfds); */
01542 
01543   /* find the highest numbered fd */
01544   width=0;
01545   for (i=0; i<maxwidth; i++) {
01546     if (readfds && FD_ISSET(i, readfds)) width=i;
01547     if (writefds && FD_ISSET(i, writefds)) width=i;
01548     if (exceptfds && FD_ISSET(i, exceptfds)) width=i;}
01549   width = width + 1;
01550 
01551   timeout=ckfltval(argv[3]);
01552   if (timeout==0.0)
01553     i=select(width, readfds, writefds, exceptfds,0);
01554   else {
01555     to.tv_sec=timeout;
01556     timeout=timeout-to.tv_sec;
01557     timeout=timeout*1000000;
01558     to.tv_usec=timeout;
01559     i=select(width, readfds, writefds, exceptfds,&to);}
01560   if (i<0) return(makeint(-errno));
01561   else return(makeint(i)); }
01562 
01563 pointer SELECT_READ(ctx,n,argv)
01564 register context *ctx;
01565 int n;
01566 pointer argv[];
01567 { struct timeval to;
01568   float timeout;
01569   long i, size, width, fds;
01570   fd_set *fdvec;
01571   numunion nu;
01572 
01573   ckarg(2);
01574   if (isint(argv[0])) {
01575     fds=intval(argv[0]);
01576     fdvec=(fd_set *)&fds;
01577     size=30;    }
01578   else fdvec=(fd_set *)checkbitvec(argv[0], &size);
01579   size=min(256,size);
01580   for (i=0; i<size; i++) if (FD_ISSET(i, fdvec)) width=i;
01581   width = width+1;
01582      
01583   timeout=ckfltval(argv[1]);
01584   if (timeout==0.0) n=select(width, fdvec, 0, 0, 0);
01585   else {
01586     to.tv_sec=timeout;
01587     timeout=timeout-to.tv_sec;
01588     timeout=timeout*1000000;
01589     to.tv_usec=timeout;
01590     n=select(width, fdvec, 0, 0, &to);}
01591   if (n<0) return(makeint(-errno));
01592   if (isint(argv[0])) {
01593     /*fds=fdvec-> __fds_bits[0];*/
01594     /* fds_bits should be __fds_bits on some operating systems */
01595     return(makeint(fds)); }
01596   else return(argv[0]); }
01597 
01598 #endif /* !vxworks */
01599 
01600 
01601 /****************************************************************/
01602 /* physical memory allocator
01603 /*      1988-Jul
01604 /****************************************************************/
01605 pointer SBRK(ctx,n,argv)
01606 register context *ctx;
01607 int n; pointer argv[];
01608 { return(makeint(sbrk(ckintval(argv[0]))));}
01609 
01610 pointer MALLOC(ctx,n,argv)
01611 register context *ctx;
01612 int n; pointer argv[];
01613 { return(makeint(malloc(ckintval(argv[0]))));}
01614 
01615 pointer FREE(ctx,n,argv)
01616 register context *ctx;
01617 int n; pointer argv[];
01618 { free((void *)ckintval(argv[0]));
01619   return(makeint(1));}
01620 
01621 #if sun3 || sun4 || news || alpha
01622 pointer VALLOC(ctx,n,argv)
01623 register context *ctx;
01624 int n; pointer argv[];
01625 { return(makeint(valloc(ckintval(argv[0]))));}
01626 #endif
01627 
01628 #if sun3 || sun4 || news || alpha || Linux
01629 
01630 pointer MMAP(ctx,n,argv)
01631 register context *ctx;
01632 int n; register pointer argv[];
01633 { int fd;
01634   eusinteger_t offset,result,len;
01635   pointer strm;
01636   ckarg(6);
01637   strm=argv[4];
01638   if (isiostream(strm)) strm=strm->c.iostream.in;
01639   if (isfilestream(strm)) fd=intval(strm->c.fstream.fd);
01640   else fd=ckintval(strm);
01641   len=ckintval(argv[1]);
01642   if (isintvector(argv[5])) 
01643     offset=((argv[5]->c.ivec.iv[0])<<16) + argv[5]->c.ivec.iv[1];
01644   else offset=ckintval(argv[5]);
01645   result=(eusinteger_t)mmap((caddr_t)ckintval(argv[0]), len,
01646                 ckintval(argv[2]), ckintval(argv[3]), fd, offset);
01647   if (result== -1) return(makeint(-errno));
01648   else return((pointer)make_foreign_string(result, len));}
01649 
01650 pointer MUNMAP(ctx,n,argv)
01651 register context *ctx;
01652 int n; pointer argv[];
01653 { return(makeint(munmap((caddr_t)ckintval(argv[0]),ckintval(argv[1]))));}
01654 
01655 /*
01656 pointer VADVISE(ctx,n,argv)
01657 register context *ctx;
01658 int n; pointer argv[];
01659 { n=vadvise(ckintval(argv[0]));
01660   if (n==0) return(T); else return(makeint(errno));}
01661 */
01662 
01663 #endif
01664 
01665 /****************************************************************/
01666 /* network library routines
01667 /****************************************************************/
01668 #if !vxworks
01669 
01670 pointer GETHOSTNAME(ctx,n,argv)
01671 register context *ctx;
01672 int n; pointer argv[];
01673 { char buf[32]; int stat;
01674   stat=gethostname(buf,32);
01675   if (stat==0) return(makestring(buf,strlen(buf)));
01676   else return(makeint(errno));}
01677 
01678 pointer GETHOSTBYNAME(ctx,n,argv)
01679 register context *ctx;
01680 int n;
01681 register pointer *argv;
01682 { register struct hostent *hp;
01683   register pointer s;
01684 
01685   ckarg(1);
01686   hp=gethostbyname((char *)Getstring(argv[0])->c.str.chars);
01687   if (hp==NULL) return(makeint(-errno));
01688   s=cons(ctx,makeint(hp->h_addrtype),NIL);
01689   s=cons(ctx,makestring(hp->h_addr,hp->h_length),s);
01690   return(s);}   /*list of 32bit address and address type*/
01691   
01692 pointer GETHOSTBYADDR(ctx,n,argv)
01693 register context *ctx;
01694 int n;
01695 pointer *argv;
01696 { pointer addr;
01697   struct hostent *host;
01698   ckarg(1);
01699   addr=Getstring(argv[0]);
01700   host=gethostbyaddr((char *)addr->c.str.chars, vecsize(addr), 2);
01701   if (host==NULL) return(makeint(-errno));
01702   else return(makestring(host->h_name, strlen(host->h_name)));}
01703 
01704 pointer GETNETBYNAME(ctx,n,argv)
01705 register context *ctx;
01706 int n;
01707 register pointer *argv;
01708 { struct netent *np;
01709   ckarg(1);
01710   np=getnetbyname((char *)Getstring(argv[0])->c.str.chars);
01711   if (np==NULL) return(makeint(-errno));
01712   return(cons(ctx,makeint(np->n_net),
01713               cons(ctx,makeint(np->n_addrtype),NIL)));}
01714   
01715 pointer GETPROTOBYNAME(ctx,n,argv)
01716 register context *ctx;
01717 int n;
01718 register pointer *argv;
01719 { struct protoent *pp;
01720   ckarg(1);
01721   pp=getprotobyname((char *)Getstring(argv[0])->c.str.chars);
01722   if (pp==NULL) return(makeint(-errno));
01723   return(makeint(pp->p_proto));}
01724 
01725 pointer GETSERVBYNAME(ctx,n,argv)
01726 register context *ctx;
01727 int n;
01728 register pointer *argv;
01729 { struct servent *sp;
01730   pointer s;
01731   byte *p;
01732   long int port;
01733   
01734   ckarg2(1,2);
01735   if (n==2 && argv[1]!=NIL)  p=Getstring(argv[1])->c.str.chars;
01736   else p=NULL;
01737   sp=getservbyname((char *)Getstring(argv[0])->c.str.chars,(char *)p);
01738   if (sp==NULL) return(makeint(-errno));
01739   s=makestring(sp->s_proto,strlen(sp->s_proto));
01740   vpush(s);
01741   port = ntohs(sp->s_port);
01742   s=cons(ctx,makeint(port),cons(ctx,s,NIL));
01743   vpop();
01744   return(s);}
01745 
01746 /* Append by I.Hara for IPC */
01747 /* htons -- convert values between host and network byte order */
01748 pointer H2NS(ctx,n,argv)
01749 register context *ctx;
01750 int n;
01751 register pointer *argv;
01752 { int hostshort;
01753   unsigned short netshort;
01754   ckarg(1);
01755   hostshort=ckintval(argv[0]);
01756   netshort=htons((short)hostshort);
01757   return(makeint(netshort));}
01758 
01759 pointer N2HS(ctx,n,argv)
01760 register context *ctx;
01761 int n;
01762 register pointer *argv;
01763 { int hostshort;
01764   unsigned short netshort;
01765   ckarg(1);
01766   netshort=ckintval(argv[0]);
01767   hostshort=ntohs((short)netshort);
01768   return(makeint(hostshort));}
01769 
01770 #endif
01771 
01772 
01773 
01774 
01775 #ifdef DBM
01776 /* ndbm --- data base 
01777         1988-May
01778         (c) T.Matsui
01779 */
01780 
01781 #if sun3 || sun4
01782 
01783 #include <ndbm.h>
01784 
01785 pointer DBM_OPEN(ctx,n,argv)
01786 register context *ctx;
01787 int n;
01788 register pointer argv[];
01789 { DBM *dbm;
01790   ckarg(3);
01791   dbm=dbm_open(Getstring(argv[0])->c.str.chars,
01792                ckintval(argv[1]),
01793                ckintval(argv[2]));
01794   return(makeint(dbm));}
01795 
01796 pointer DBM_CLOSE(ctx,n,argv)
01797 register context *ctx;
01798 int n;
01799 register pointer argv[];
01800 { ckarg(1);
01801   dbm_close(ckintval(argv[0]));
01802   return(T);}
01803 
01804 pointer DBM_FETCH(ctx,n,argv)
01805 register context *ctx;
01806 int n;
01807 register pointer argv[];
01808 { register pointer s;
01809   datum key,content;
01810   ckarg(2);
01811   s=Getstring(argv[1]);
01812   key.dptr=(char *)(s->c.str.chars);
01813   key.dsize=strlength(s);
01814   content=dbm_fetch(ckintval(argv[0]), key);
01815   if (content.dptr==NULL) return(NIL);
01816   return(makestring(content.dptr,content.dsize));}
01817 
01818 pointer DBM_STORE(ctx,n,argv)
01819 register context *ctx;
01820 int n;
01821 register pointer argv[];
01822 { register pointer s;
01823   datum key,content;
01824   ckarg(4);
01825   s=Getstring(argv[1]);
01826   key.dptr=(char *)s->c.str.chars;
01827   key.dsize=strlength(s);
01828   s=Getstring(argv[2]);
01829   content.dptr=(char *)s->c.str.chars;
01830   content.dsize=strlength(s);
01831   n=dbm_store(ckintval(argv[0]), key, content, ckintval(argv[3]));
01832   return((n==0)?T:NIL);}
01833 
01834 pointer DBM_DELETE(ctx,n,argv)
01835 register context *ctx;
01836 int n;
01837 register pointer argv[];
01838 { register pointer s;
01839   datum key;
01840   ckarg(2);
01841   s=Getstring(argv[1]);
01842   key.dptr=(char *)s->c.str.chars;
01843   key.dsize=strlength(s);
01844   n=dbm_delete(ckintval(argv[0]), key);
01845   return((n==0)?T:NIL);}
01846 
01847 pointer DBM_FIRSTKEY(ctx,n,argv)
01848 register context *ctx;
01849 int n;
01850 register pointer argv[];
01851 { datum key;
01852   ckarg(1);
01853   key=dbm_firstkey(ckintval(argv[0]), key);
01854   if (key.dptr==NULL) return(NIL);
01855   return(makestring(key.dptr,key.dsize));}
01856 
01857 pointer DBM_NEXTKEY(ctx,n,argv)
01858 register context *ctx;
01859 int n;
01860 register pointer argv[];
01861 { datum key;
01862   ckarg(1);
01863   key=dbm_nextkey(ckintval(argv[0]), key);
01864   if (key.dptr==NULL) return(NIL);
01865   return(makestring(key.dptr,key.dsize));}
01866 
01867 pointer DBM_ERROR(ctx,n,argv)
01868 register context *ctx;
01869 int n;
01870 register pointer argv[];
01871 { ckarg(1);
01872   n=dbm_error((DBM *)ckintval(argv[0]));
01873   return((n==0)?T:NIL);}
01874 
01875 pointer DBM_CLEARERR(ctx,n,argv)
01876 register context *ctx;
01877 int n;
01878 register pointer argv[];
01879 { ckarg(1);
01880   dbm_clearerr((DBM *)ckintval(argv[0]));
01881   return(T);}
01882 
01883 #endif  /*sun3 || sun4*/
01884 #endif  /*ifdef DBM*/
01885 
01886 
01887 /* initialization of unixcall functions*/
01888 unixcall(ctx,mod)
01889 register context *ctx;
01890 pointer mod;
01891 { pointer p=Spevalof(PACKAGE);
01892 
01893   Spevalof(PACKAGE)=unixpkg;
01894 
01895 /* common to unix and to vxworks */
01896   defun(ctx,"SIGADDSET",mod,SIGADDSET,NULL);
01897   defun(ctx,"SIGDELSET",mod,SIGDELSET,NULL);
01898   defun(ctx,"SIGPROCMASK",mod,SIGPROCMASK,NULL);
01899   defun(ctx,"KILL",mod,KILL,NULL);
01900   defun(ctx,"SIGNAL",mod,SIGNAL,NULL);
01901   defun(ctx,"EXIT",mod,EXIT,NULL);
01902   defun(ctx,"GETPID",mod,GETPID,NULL);
01903   defun(ctx,"UREAD",mod,UNIXREAD,NULL);
01904   defun(ctx,"WRITE",mod,UNIXWRITE,NULL);
01905   defun(ctx,"UCLOSE",mod,UNIXCLOSE,NULL);
01906   defun(ctx,"IOCTL",mod,IOCTL,NULL);
01907   defun(ctx,"LSEEK",mod,LSEEK,NULL);
01908   defun(ctx,"SBRK",mod,SBRK,NULL);
01909   defun(ctx,"MALLOC",mod,MALLOC,NULL);
01910   defun(ctx,"FREE",mod,FREE,NULL);
01911 
01912   defun(ctx,"SOCKET",mod,SOCKET,NULL);
01913   defun(ctx,"BIND",mod,BIND,NULL);
01914   defun(ctx,"CONNECT",mod,CONNECT,NULL);
01915   defun(ctx,"LISTEN",mod,LISTEN,NULL);
01916   defun(ctx,"ACCEPT",mod,ACCEPT,NULL);
01917   defun(ctx,"SENDTO",mod,SENDTO,NULL);
01918   defun(ctx,"RECVFROM",mod,RECVFROM,NULL);
01919 #if !Solaris2
01920   defun(ctx,"GETPEERNAME",mod,GETPEERNAME,NULL);
01921 #endif
01922 /* #endif /*socket*/
01923 
01924 /*not supported by vxworks*/
01925 #if !vxworks
01926   defun(ctx,"PTIMES",mod,PTIMES,NULL);
01927   defun(ctx,"RUNTIME",mod,RUNTIME,NULL);
01928   defun(ctx,"LOCALTIME",mod,LOCALTIME,NULL);
01929   defun(ctx,"ASCTIME",mod,ASCTIME,NULL);
01930   defun(ctx,"GETITIMER",mod,GETITIMER,NULL);
01931   defun(ctx,"SETITIMER",mod,SETITIMER,NULL);
01932 
01933 #if !Solaris2
01934   defun(ctx,"GETRUSAGE",mod,GETRUSAGE,NULL);
01935   defun(ctx,"GETPAGESIZE",mod,GETPAGESIZE,NULL);
01936 #endif
01937 
01938   defun(ctx,"GETTIMEOFDAY",mod,GETTIMEOFDAY,NULL);
01939   defun(ctx,"ALARM",mod,ALARM,NULL);
01940 
01941 #if sun3 || sun4 || news || sanyo || alpha
01942 #if !Solaris2
01943   defun(ctx,"UALARM",mod,UALARM,NULL);
01944 #endif
01945 #endif
01946 
01947   defun(ctx,"WAIT",mod,WAIT,NULL);
01948   defun(ctx,"FORK",mod,FORK,NULL);
01949 #if Solaris2
01950   defun(ctx,"FORK1",mod,FORK1,NULL);
01951 #endif
01952   defun(ctx,"GETPPID",mod,GETPPID,NULL);
01953   defun(ctx,"GETPGRP",mod,GETPGRP,NULL);
01954   defun(ctx,"SETPGRP",mod,SETPGRP,NULL);
01955   defun(ctx,"GETUID",mod,GETUID,NULL);
01956   defun(ctx,"GETEUID",mod,GETEUID,NULL);
01957   defun(ctx,"GETGID",mod,GETGID,NULL);
01958   defun(ctx,"GETEGID",mod,GETEGID,NULL);
01959   defun(ctx,"SETUID",mod,SETUID,NULL);
01960   defun(ctx,"SETGID",mod,SETGID,NULL);
01961   defun(ctx,"MKNOD",mod,MKNOD,NULL);
01962   defun(ctx,"MKDIR",mod,MKDIR,NULL);
01963   defun(ctx,"LOCKF",mod,LOCKF,NULL);
01964   defun(ctx,"FCNTL",mod,FCNTL,NULL);
01965 #if !Solaris2
01966   defun(ctx,"IOCTL_",mod,IOCTL_,NULL);
01967   defun(ctx,"IOCTL_R",mod,IOCTL_R,NULL);
01968   defun(ctx,"IOCTL_W",mod,IOCTL_W,NULL);
01969   defun(ctx,"IOCTL_WR",mod,IOCTL_WR,NULL);
01970 #endif
01971   defun(ctx,"DUP",mod,DUP,NULL);
01972   defun(ctx,"DUP2",mod,DUP2,NULL);
01973   defun(ctx,"SYSTEM",mod,SYSTEM,NULL);
01974   defun(ctx,"GETWD",mod,GETWD,NULL);
01975   defun(ctx,"GETENV",mod,GETENV,NULL);
01976   defun(ctx,"ENVIRON",mod,ENVIRON,NULL);
01977   defun(ctx,"SLEEP",mod,SLEEP,NULL);
01978   defun(ctx,"ERRNO",mod,ERRNO,NULL);
01979   defun(ctx,"SYSERRLIST",mod,SYSERRLIST,NULL);
01980   defun(ctx,"PAUSE",mod,PAUSE,NULL);
01981   defun(ctx,"ISATTY",mod,ISATTY,NULL);
01982   defun(ctx,"LINK",mod,LINK,NULL);
01983   defun(ctx,"UNLINK",mod,UNLINK,NULL);
01984   defun(ctx,"RMDIR",mod,RMDIR,NULL);
01985   defun(ctx,"RENAME",mod,RENAME,NULL);
01986   defun(ctx,"ACCESS",mod,ACCESS,NULL);
01987 /*   defun(ctx,"FLOCK",mod,FLOCK,NULL); */
01988   defun(ctx,"STAT",mod,STAT,NULL);
01989   defun(ctx,"CHDIR",mod,CHDIR,NULL);
01990   defun(ctx,"CHMOD",mod,CHMOD,NULL);
01991   defun(ctx,"CHOWN",mod,CHOWN,NULL);
01992   defun(ctx,"PIPE",mod,PIPE,NULL);
01993   defun(ctx,"SELECT",mod,SELECT,NULL);
01994   defun(ctx,"SELECT-READ-FD",mod,SELECT_READ,NULL);
01995   defun(ctx,"READDIR",mod,DIRECTORY,NULL);
01996 
01997 #if !vxworks
01998   defun(ctx,"GETHOSTNAME",mod,GETHOSTNAME,NULL);
01999   defun(ctx,"GETHOSTBYNAME",mod,GETHOSTBYNAME,NULL);
02000   defun(ctx,"GETHOSTBYADDR",mod,GETHOSTBYADDR,NULL);
02001   defun(ctx,"GETNETBYNAME",mod,GETNETBYNAME,NULL);
02002   defun(ctx,"GETPROTOBYNAME",mod,GETPROTOBYNAME,NULL);
02003   defun(ctx,"GETSERVBYNAME",mod,GETSERVBYNAME,NULL);
02004 /* Append by I.Hara for IPC */
02005   defun(ctx,"HTONS",mod,H2NS,NULL);
02006   defun(ctx,"NTOHS",mod,N2HS,NULL);
02007 #endif
02008 
02009 #if sun3 || sun4 || vax || news || sanyo || (mips && !IRIX && !IRIX6) || i386 || alpha
02010   defun(ctx,"VFORK",mod,VFORK,NULL);
02011 #endif
02012   defun(ctx,"EXEC",mod,EXEC,NULL);
02013 #if !Solaris2
02014   defun(ctx,"GETPRIORITY",mod,GETPRIORITY,NULL);
02015   defun(ctx,"SETPRIORITY",mod,SETPRIORITY,NULL);
02016 #endif
02017 
02018 #if sun3 || sun4 || vax || mips || i386 || alpha
02019   defun(ctx,"PUTENV",mod,PUTENV,NULL);
02020 #endif
02021 #if sun3 || sun4 && !Solaris2 || Linux || alpha
02022   defun(ctx,"USLEEP",mod,USLEEP,NULL);
02023 #endif
02024 
02025 #if !news
02026   defun(ctx,"MSGGET",mod,MSGGET,NULL);
02027   defun(ctx,"MSGSND",mod,MSGSND,NULL);
02028   defun(ctx,"MSGRCV",mod,MSGRCV,NULL);
02029   defun(ctx,"MSGCTL",mod,MSGCTL,NULL);
02030 #endif
02031 
02032 #if sun3 || sun4 || news || alpha
02033   defun(ctx,"VALLOC",mod,VALLOC,NULL);
02034 #endif
02035 #if sun3 || sun4 || news || alpha || Linux
02036   defun(ctx,"MMAP",mod,MMAP,NULL);
02037   defun(ctx,"MUNMAP",mod,MUNMAP,NULL);
02038 /*  defun(ctx,"VADVISE",mod,VADVISE,NULL); */
02039 #endif
02040 
02041 #if system5 || Linux
02042   defun(ctx,"UNAME",mod,UNAME,NULL);
02043 #endif
02044 
02045 #endif /*socket*/
02046 
02047 /*ndbm libraries*/
02048 #ifdef DBM
02049 #if sun3 || sun4
02050   defun(ctx,"DBM-OPEN",mod,DBM_OPEN,NULL);
02051   defun(ctx,"DBM-CLOSE",mod,DBM_CLOSE,NULL);
02052   defun(ctx,"DBM-FETCH",mod,DBM_FETCH,NULL);
02053   defun(ctx,"DBM-STORE",mod,DBM_STORE,NULL);
02054   defun(ctx,"DBM-DELETE",mod,DBM_DELETE,NULL);
02055   defun(ctx,"DBM-FIRSTKEY",mod,DBM_FIRSTKEY,NULL);
02056   defun(ctx,"DBM-NEXTKEY",mod,DBM_NEXTKEY,NULL);
02057   defun(ctx,"DBM-ERROR",mod,DBM_ERROR,NULL);
02058   defun(ctx,"DBM-CLEARERR",mod,DBM_CLEARERR,NULL);
02059 #endif
02060 
02061 #endif
02062 /* restore package*/  Spevalof(PACKAGE)=p;
02063 }


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 18:05:53