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