static Tree evalCase(Tree rules, Tree env)
{
Tree pm;
if (!getPMProperty(rules, env, pm)) {
Automaton* a = make_pattern_matcher(evalRuleList(rules, env));
pm = boxPatternMatcher(a, 0, listn(len(rules), pushEnvBarrier(env)), rules, gGlobal->nil);
setPMProperty(rules, env, pm);
}
return pm;
}
static Tree listn (int n, Tree e)
{
return (n<= 0) ? gGlobal->nil : cons(e, listn(n-1,e));
}
void init_fd_functions(void)
{
define_constant("fd-close",
make_raw_method("fd-close", list1(obj_FixnumClass),
false, obj_False, false,
list2(obj_BooleanClass, obj_ObjectClass),
obj_False, fd_close));
define_method("fd-error-string", list1(obj_FixnumClass), false,
obj_False, false, obj_ObjectClass, fd_error_str);
define_constant("fd-input-available?",
make_raw_method("fd-input-available?",
list1(obj_FixnumClass),
false, obj_False, false,
list2(obj_BooleanClass, obj_ObjectClass),
obj_False, fd_input_available));
define_constant("fd-open",
make_raw_method("fd-open",
list2(obj_ByteStringClass,
obj_FixnumClass),
false, obj_False, false,
list2(obj_ObjectClass, obj_ObjectClass),
obj_False, fd_open));
define_constant("fd-read",
make_raw_method("fd-read",
listn(4, obj_FixnumClass,
obj_BufferClass,
obj_FixnumClass,
obj_FixnumClass),
false, obj_False, false,
list2(obj_ObjectClass, obj_ObjectClass),
obj_False, fd_read));
define_constant("fd-seek",
make_raw_method("fd-seek",
list3(obj_FixnumClass,
obj_FixnumClass,
obj_FixnumClass),
false, obj_False, false,
list2(obj_ObjectClass, obj_ObjectClass),
obj_False, fd_seek));
define_constant("fd-sync-output",
make_raw_method("fd-sync-output",
list1(obj_FixnumClass),
false, obj_False, false,
list2(obj_BooleanClass, obj_ObjectClass),
obj_False, fd_sync_output));
define_constant("fd-write",
make_raw_method("fd-write",
listn(4, obj_FixnumClass,
obj_BufferClass,
obj_FixnumClass,
obj_FixnumClass),
false, obj_False, false,
list2(obj_ObjectClass, obj_ObjectClass),
obj_False, fd_write));
define_constant("fd-exec",
make_raw_method("fd-exec",
list1(obj_ByteStringClass),
false, obj_False, false,
list2(obj_ObjectClass, obj_ObjectClass),
obj_False, fd_exec));
define_function("file-write-date", list1(obj_ByteStringClass), false,
obj_False, false, obj_ObjectClass, file_write_date);
define_constant("SEEK_SET", make_fixnum(SEEK_SET));
define_constant("SEEK_CUR", make_fixnum(SEEK_CUR));
define_constant("SEEK_END", make_fixnum(SEEK_END));
define_constant("O_RDONLY", make_fixnum(O_RDONLY));
define_constant("O_WRONLY", make_fixnum(O_WRONLY));
define_constant("O_RDWR", make_fixnum(O_RDWR));
define_constant("O_APPEND", make_fixnum(O_APPEND));
define_constant("O_CREAT", make_fixnum(O_CREAT));
define_constant("O_EXCL", make_fixnum(O_EXCL));
define_constant("O_TRUNC", make_fixnum(O_TRUNC));
#ifndef _WIN32
define_constant("O_NONBLOCK", make_fixnum(O_NONBLOCK));
#endif
/* This compendium of error numbers comes from Tcl. */
#ifdef E2BIG
define_constant("E2BIG", make_fixnum(E2BIG));
#endif
#ifdef EACCES
define_constant("EACCES", make_fixnum(EACCES));
#endif
#ifdef EADDRINUSE
define_constant("EADDRINUSE", make_fixnum(EADDRINUSE));
#endif
#ifdef EADDRNOTAVAIL
define_constant("EADDRNOTAVAIL", make_fixnum(EADDRNOTAVAIL));
#endif
#ifdef EADV
define_constant("EADV", make_fixnum(EADV));
#endif
#ifdef EAFNOSUPPORT
define_constant("EAFNOSUPPORT", make_fixnum(EAFNOSUPPORT));
#endif
#ifdef EAGAIN
define_constant("EAGAIN", make_fixnum(EAGAIN));
#endif
#ifdef EALIGN
define_constant("EALIGN", make_fixnum(EALIGN));
#endif
#ifdef EALREADY
define_constant("EALREADY", make_fixnum(EALREADY));
#endif
#ifdef EBADE
define_constant("EBADE", make_fixnum(EBADE));
#endif
#ifdef EBADF
define_constant("EBADF", make_fixnum(EBADF));
#endif
#ifdef EBADFD
define_constant("EBADFD", make_fixnum(EBADFD));
#endif
#ifdef EBADMSG
define_constant("EBADMSG", make_fixnum(EBADMSG));
#endif
#ifdef EBADR
define_constant("EBADR", make_fixnum(EBADR));
#endif
#ifdef EBADRPC
define_constant("EBADRPC", make_fixnum(EBADRPC));
#endif
#ifdef EBADRQC
define_constant("EBADRQC", make_fixnum(EBADRQC));
#endif
#ifdef EBADSLT
define_constant("EBADSLT", make_fixnum(EBADSLT));
#endif
#ifdef EBFONT
define_constant("EBFONT", make_fixnum(EBFONT));
#endif
#ifdef EBUSY
define_constant("EBUSY", make_fixnum(EBUSY));
#endif
#ifdef ECHILD
define_constant("ECHILD", make_fixnum(ECHILD));
#endif
#ifdef ECHRNG
define_constant("ECHRNG", make_fixnum(ECHRNG));
#endif
#ifdef ECOMM
define_constant("ECOMM", make_fixnum(ECOMM));
#endif
#ifdef ECONNABORTED
define_constant("ECONNABORTED", make_fixnum(ECONNABORTED));
#endif
#ifdef ECONNREFUSED
define_constant("ECONNREFUSED", make_fixnum(ECONNREFUSED));
#endif
#ifdef ECONNRESET
define_constant("ECONNRESET", make_fixnum(ECONNRESET));
#endif
#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
define_constant("EDEADLK", make_fixnum(EDEADLK));
#endif
#ifdef EDEADLOCK
define_constant("EDEADLOCK", make_fixnum(EDEADLOCK));
#endif
#ifdef EDESTADDRREQ
define_constant("EDESTADDRREQ", make_fixnum(EDESTADDRREQ));
#endif
#ifdef EDIRTY
define_constant("EDIRTY", make_fixnum(EDIRTY));
#endif
#ifdef EDOM
define_constant("EDOM", make_fixnum(EDOM));
#endif
#ifdef EDOTDOT
define_constant("EDOTDOT", make_fixnum(EDOTDOT));
#endif
#ifdef EDQUOT
define_constant("EDQUOT", make_fixnum(EDQUOT));
#endif
#ifdef EDUPPKG
define_constant("EDUPPKG", make_fixnum(EDUPPKG));
#endif
#ifdef EEXIST
define_constant("EEXIST", make_fixnum(EEXIST));
#endif
#ifdef EFAULT
define_constant("EFAULT", make_fixnum(EFAULT));
#endif
#ifdef EFBIG
define_constant("EFBIG", make_fixnum(EFBIG));
#endif
#ifdef EHOSTDOWN
define_constant("EHOSTDOWN", make_fixnum(EHOSTDOWN));
#endif
#ifdef EHOSTUNREACH
define_constant("EHOSTUNREACH", make_fixnum(EHOSTUNREACH));
#endif
#ifdef EIDRM
define_constant("EIDRM", make_fixnum(EIDRM));
#endif
#ifdef EINIT
define_constant("EINIT", make_fixnum(EINIT));
#endif
#ifdef EINPROGRESS
define_constant("EINPROGRESS", make_fixnum(EINPROGRESS));
#endif
#ifdef EINTR
define_constant("EINTR", make_fixnum(EINTR));
#endif
#ifdef EINVAL
define_constant("EINVAL", make_fixnum(EINVAL));
#endif
#ifdef EIO
define_constant("EIO", make_fixnum(EIO));
#endif
#ifdef EISCONN
define_constant("EISCONN", make_fixnum(EISCONN));
#endif
#ifdef EISDIR
define_constant("EISDIR", make_fixnum(EISDIR));
#endif
#ifdef EISNAME
define_constant("EISNAM", make_fixnum(EISNAM));
#endif
#ifdef ELBIN
define_constant("ELBIN", make_fixnum(ELBIN));
#endif
#ifdef EL2HLT
define_constant("EL2HLT", make_fixnum(EL2HLT));
#endif
#ifdef EL2NSYNC
define_constant("EL2NSYNC", make_fixnum(EL2NSYNC));
#endif
#ifdef EL3HLT
define_constant("EL3HLT", make_fixnum(EL3HLT));
#endif
#ifdef EL3RST
define_constant("EL3RST", make_fixnum(EL3RST));
#endif
#ifdef ELIBACC
define_constant("ELIBACC", make_fixnum(ELIBACC));
#endif
#ifdef ELIBBAD
define_constant("ELIBBAD", make_fixnum(ELIBBAD));
#endif
#ifdef ELIBEXEC
define_constant("ELIBEXEC", make_fixnum(ELIBEXEC));
#endif
#ifdef ELIBMAX
define_constant("ELIBMAX", make_fixnum(ELIBMAX));
#endif
#ifdef ELIBSCN
define_constant("ELIBSCN", make_fixnum(ELIBSCN));
#endif
#ifdef ELNRNG
define_constant("ELNRNG", make_fixnum(ELNRNG));
#endif
#ifdef ELOOP
define_constant("ELOOP", make_fixnum(ELOOP));
#endif
#ifdef EMFILE
define_constant("EMFILE", make_fixnum(EMFILE));
#endif
#ifdef EMLINK
define_constant("EMLINK", make_fixnum(EMLINK));
#endif
#ifdef EMSGSIZE
define_constant("EMSGSIZE", make_fixnum(EMSGSIZE));
#endif
#ifdef EMULTIHOP
define_constant("EMULTIHOP", make_fixnum(EMULTIHOP));
#endif
#ifdef ENAMETOOLONG
define_constant("ENAMETOOLONG", make_fixnum(ENAMETOOLONG));
#endif
#ifdef ENAVAIL
define_constant("ENAVAIL", make_fixnum(ENAVAIL));
#endif
#ifdef ENET
define_constant("ENET", make_fixnum(ENET));
#endif
#ifdef ENETDOWN
define_constant("ENETDOWN", make_fixnum(ENETDOWN));
#endif
#ifdef ENETRESET
define_constant("ENETRESET", make_fixnum(ENETRESET));
#endif
#ifdef ENETUNREACH
define_constant("ENETUNREACH", make_fixnum(ENETUNREACH));
#endif
#ifdef ENFILE
define_constant("ENFILE", make_fixnum(ENFILE));
#endif
#ifdef ENOANO
define_constant("ENOANO", make_fixnum(ENOANO));
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
define_constant("ENOBUFS", make_fixnum(ENOBUFS));
#endif
#ifdef ENOCSI
define_constant("ENOCSI", make_fixnum(ENOCSI));
#endif
#ifdef ENODATA
define_constant("ENODATA", make_fixnum(ENODATA));
#endif
#ifdef ENODEV
define_constant("ENODEV", make_fixnum(ENODEV));
#endif
#ifdef ENOENT
define_constant("ENOENT", make_fixnum(ENOENT));
#endif
#ifdef ENOEXEC
define_constant("ENOEXEC", make_fixnum(ENOEXEC));
#endif
#ifdef ENOLCK
define_constant("ENOLCK", make_fixnum(ENOLCK));
#endif
#ifdef ENOLINK
define_constant("ENOLINK", make_fixnum(ENOLINK));
#endif
#ifdef ENOMEM
define_constant("ENOMEM", make_fixnum(ENOMEM));
#endif
#ifdef ENOMSG
define_constant("ENOMSG", make_fixnum(ENOMSG));
#endif
#ifdef ENONET
define_constant("ENONET", make_fixnum(ENONET));
#endif
#ifdef ENOPKG
define_constant("ENOPKG", make_fixnum(ENOPKG));
#endif
#ifdef ENOPROTOOPT
define_constant("ENOPROTOOPT", make_fixnum(ENOPROTOOPT));
#endif
#ifdef ENOSPC
define_constant("ENOSPC", make_fixnum(ENOSPC));
#endif
#ifdef ENOSR
define_constant("ENOSR", make_fixnum(ENOSR));
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
define_constant("ENOSTR", make_fixnum(ENOSTR));
#endif
#ifdef ENOSYM
define_constant("ENOSYM", make_fixnum(ENOSYM));
#endif
#ifdef ENOSYS
define_constant("ENOSYS", make_fixnum(ENOSYS));
#endif
#ifdef ENOTBLK
define_constant("ENOTBLK", make_fixnum(ENOTBLK));
#endif
#ifdef ENOTCONN
define_constant("ENOTCONN", make_fixnum(ENOTCONN));
#endif
#ifdef ENOTDIR
define_constant("ENOTDIR", make_fixnum(ENOTDIR));
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
define_constant("ENOTEMPTY", make_fixnum(ENOTEMPTY));
#endif
#ifdef ENOTNAM
define_constant("ENOTNAM", make_fixnum(ENOTNAM));
#endif
#ifdef ENOTSOCK
define_constant("ENOTSOCK", make_fixnum(ENOTSOCK));
#endif
#ifdef ENOTTY
define_constant("ENOTTY", make_fixnum(ENOTTY));
#endif
#ifdef ENOTUNIQ
define_constant("ENOTUNIQ", make_fixnum(ENOTUNIQ));
#endif
#ifdef ENXIO
define_constant("ENXIO", make_fixnum(ENXIO));
#endif
#ifdef EOPNOTSUPP
define_constant("EOPNOTSUPP", make_fixnum(EOPNOTSUPP));
#endif
#ifdef EPERM
define_constant("EPERM", make_fixnum(EPERM));
#endif
#ifdef EPFNOSUPPORT
define_constant("EPFNOSUPPORT", make_fixnum(EPFNOSUPPORT));
#endif
#ifdef EPIPE
define_constant("EPIPE", make_fixnum(EPIPE));
#endif
#ifdef EPROCLIM
define_constant("EPROCLIM", make_fixnum(EPROCLIM));
#endif
#ifdef EPROCUNAVAIL
define_constant("EPROCUNAVAIL", make_fixnum(EPROCUNAVAIL));
#endif
#ifdef EPROGMISMATCH
define_constant("EPROGMISMATCH", make_fixnum(EPROGMISMATCH));
#endif
#ifdef EPROGUNAVAIL
define_constant("EPROGUNAVAIL", make_fixnum(EPROGUNAVAIL));
#endif
#ifdef EPROTO
define_constant("EPROTO", make_fixnum(EPROTO));
#endif
#ifdef EPROTONOSUPPORT
define_constant("EPROTONOSUPPORT", make_fixnum(EPROTONOSUPPORT));
#endif
#ifdef EPROTOTYPE
define_constant("EPROTOTYPE", make_fixnum(EPROTOTYPE));
#endif
#ifdef ERANGE
define_constant("ERANGE", make_fixnum(ERANGE));
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
define_constant("EREFUSED", make_fixnum(EREFUSED));
#endif
#ifdef EREMCHG
define_constant("EREMCHG", make_fixnum(EREMCHG));
#endif
#ifdef EREMDEV
define_constant("EREMDEV", make_fixnum(EREMDEV));
#endif
#ifdef EREMOTE
define_constant("EREMOTE", make_fixnum(EREMOTE));
#endif
#ifdef EREMOTEIO
define_constant("EREMOTEIO", make_fixnum(EREMOTEIO));
#endif
#ifdef EREMOTERELEASE
define_constant("EREMOTERELEASE", make_fixnum(EREMOTERELEASE));
#endif
#ifdef EROFS
define_constant("EROFS", make_fixnum(EROFS));
#endif
#ifdef ERPCMISMATCH
define_constant("ERPCMISMATCH", make_fixnum(ERPCMISMATCH));
#endif
#ifdef ERREMOTE
define_constant("ERREMOTE", make_fixnum(ERREMOTE));
#endif
#ifdef ESHUTDOWN
define_constant("ESHUTDOWN", make_fixnum(ESHUTDOWN));
#endif
#ifdef ESOCKTNOSUPPORT
define_constant("ESOCKTNOSUPPORT", make_fixnum(ESOCKTNOSUPPORT));
#endif
#ifdef ESPIPE
define_constant("ESPIPE", make_fixnum(ESPIPE));
#endif
#ifdef ESRCH
define_constant("ESRCH", make_fixnum(ESRCH));
#endif
#ifdef ESRMNT
define_constant("ESRMNT", make_fixnum(ESRMNT));
#endif
#ifdef ESTALE
define_constant("ESTALE", make_fixnum(ESTALE));
#endif
#ifdef ESUCCESS
define_constant("ESUCCESS", make_fixnum(ESUCCESS));
#endif
#ifdef ETIME
define_constant("ETIME", make_fixnum(ETIME));
#endif
#ifdef ETIMEDOUT
define_constant("ETIMEDOUT", make_fixnum(ETIMEDOUT));
#endif
#ifdef ETOOMANYREFS
define_constant("ETOOMANYREFS", make_fixnum(ETOOMANYREFS));
#endif
#ifdef ETXTBSY
define_constant("ETXTBSY", make_fixnum(ETXTBSY));
#endif
#ifdef EUCLEAN
define_constant("EUCLEAN", make_fixnum(EUCLEAN));
#endif
#ifdef EUNATCH
define_constant("EUNATCH", make_fixnum(EUNATCH));
#endif
#ifdef EUSERS
define_constant("EUSERS", make_fixnum(EUSERS));
#endif
#ifdef EVERSION
define_constant("EVERSION", make_fixnum(EVERSION));
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
define_constant("EWOULDBLOCK", make_fixnum(EWOULDBLOCK));
#endif
#ifdef EXDEV
define_constant("EXDEV", make_fixnum(EXDEV));
#endif
#ifdef EXFULL
define_constant("EXFULL", make_fixnum(EXFULL));
#endif
#ifdef _WIN32
win32_inits();
#endif
#if 0
#ifdef _WIN32
if (isatty(0)) { /* If stdin is a tty and not redirected */
stdin_buffer_empty = CreateEvent(NULL, true, true, NULL);
stdin_buffer_not_empty = CreateEvent(NULL, true, false, NULL);
/* These are nameless "manual reset" events */
InitializeCriticalSection(&stdin_buffer_mutex);
{
DWORD thread_id;
HANDLE thread_handle;
thread_handle
= CreateThread(NULL, 0,
(LPTHREAD_START_ROUTINE) stdin_producer,
NULL, 0, &thread_id);
if (thread_handle == NULL)
lose("Can't create stdin_producer thread");
}
}
#endif
#endif
}
