diff --git a/eval.c b/eval.c index a8592aeb..6351ad33 100644 --- a/eval.c +++ b/eval.c @@ -2134,6 +2134,10 @@ static sexp sexp_string_cmp (sexp ctx, sexp str1, sexp str2, sexp ci) { return sexp_make_integer(diff); } +#ifdef PLAN9 +#include "opt/plan9.c" +#endif + /*********************** standard environment *************************/ static struct sexp_struct core_forms[] = { diff --git a/opcodes.c b/opcodes.c index 68f1627d..492ebc6b 100644 --- a/opcodes.c +++ b/opcodes.c @@ -125,5 +125,24 @@ _FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string), #if USE_DEBUG _FN2(SEXP_PROCEDURE, SEXP_OPORT, "disasm", 0, sexp_disasm), #endif +#if PLAN9 +_FN0("random-integer", 0, sexp_rand), +_FN1(SEXP_FIXNUM, "random-seed", 0, sexp_srand), +_FN0("current-directory", 0, sexp_getwd), +_FN0("current-user", 0, sexp_getuser), +_FN0("system-name", 0, sexp_sysname), +_FN1(SEXP_IPORT, "port-fileno", 0, sexp_fileno), +_FN2(SEXP_FIXNUM, SEXP_STRING, "fileno->port", 0, sexp_fdopen), +_FN0("fork", 0, sexp_fork), +_FN2(SEXP_STRING, SEXP_PAIR, "exec", 0, sexp_exec), +_FN1(SEXP_STRING, "exits", 0, sexp_exits), +_FN2(SEXP_FIXNUM, SEXP_FIXNUM, "dup", 0, sexp_dup), +_FN0("pipe", 0, sexp_pipe), +_FN1(SEXP_FIXNUM, "sleep", 0, sexp_sleep), +_FN1(SEXP_STRING, "getenv", 0, sexp_getenv), +_FN1(SEXP_STRING, "change-directory", 0, sexp_chdir), +_FN0("wait", 0, sexp_wait), +_FN2(SEXP_FIXNUM, SEXP_STRING, "post-note", 0, sexp_postnote), +#endif }; diff --git a/opt/plan9.c b/opt/plan9.c new file mode 100644 index 00000000..3cc51097 --- /dev/null +++ b/opt/plan9.c @@ -0,0 +1,122 @@ +/* plan9.c -- extended Plan 9 system utils */ +/* Copyright (c) 2009 Alex Shinn. All rights reserved. */ +/* BSD-style license: http://synthcode.com/license.txt */ + +sexp sexp_rand (sexp ctx) { + return sexp_make_integer(rand()); +} + +sexp sexp_srand (sexp ctx, sexp seed) { + srand(sexp_unbox_integer(seed)); + return SEXP_VOID; +} + +sexp sexp_fdopen (sexp ctx, sexp fd, sexp mode) { + FILE *f; + if (! sexp_integerp(fd)) + return sexp_type_exception(ctx, "fdopen: not an integer", fd); + if (! sexp_stringp(mode)) + return sexp_type_exception(ctx, "fdopen: not a mode string", mode); + f = fdopen(sexp_unbox_integer(fd), sexp_string_data(mode)); + if (! f) + return sexp_user_exception(ctx, SEXP_FALSE, "fdopen failed", fd); + /* maybe use fd2path to get the name of the fd */ + if (sexp_string_data(mode)[0] == 'w') + return sexp_make_output_port(ctx, f, SEXP_FALSE); + else + return sexp_make_input_port(ctx, f, SEXP_FALSE); +} + +sexp sexp_fileno (sexp ctx, sexp port) { + if (! sexp_portp(port)) + return sexp_type_exception(ctx, "fileno: not a port", port); + return sexp_make_integer(fileno(sexp_port_stream(port))); +} + +sexp sexp_fork (sexp ctx) { + return sexp_make_integer(fork()); +} + +sexp sexp_exec (sexp ctx, sexp name, sexp args) { + int i, len = sexp_unbox_integer(sexp_length(ctx, args)); + char **argv = malloc((len+1)*sizeof(char*)); + for (i=0; i<len; i++, args=sexp_cdr(args)) + argv[i] = sexp_string_data(sexp_car(args)); + argv[len] = NULL; + exec(sexp_string_data(name), argv); + return SEXP_VOID; /* won't really return */ +} + +void sexp_exits (sexp ctx, sexp msg) { + exits(sexp_string_data(sexp_stringp(msg) + ? msg : sexp_write_to_string(ctx, msg))); +} + +sexp sexp_dup (sexp ctx, sexp oldfd, sexp newfd) { + return sexp_make_integer(dup(sexp_unbox_integer(oldfd), + sexp_unbox_integer(newfd))); +} + +sexp sexp_pipe (sexp ctx) { + int fds[2]; + pipe(fds); + return sexp_list2(ctx, sexp_make_integer(fds[0]), sexp_make_integer(fds[1])); +} + +sexp sexp_sleep (sexp ctx, sexp msecs) { + if (! sexp_integerp(msecs)) + return sexp_type_exception(ctx, "sleep: not an integer", msecs); + sleep(sexp_unbox_integer(msecs)); + return SEXP_VOID; +} + +sexp sexp_getenv (sexp ctx, sexp name) { + char *value; + if (! sexp_stringp(name)) + return sexp_type_exception(ctx, "getenv: not a string", name); + value = getenv(sexp_string_data(name)); + return ((! value) ? SEXP_FALSE : sexp_c_string(ctx, value, -1)); +} + +sexp sexp_getwd (sexp ctx) { + char buf[512]; + getwd(buf, 512); + return sexp_c_string(ctx, buf, -1); +} + +sexp sexp_chdir (sexp ctx, sexp path) { + if (! sexp_stringp(path)) + return sexp_type_exception(ctx, "chdir: not a string", path); + chdir(sexp_string_data(path)); + return SEXP_VOID; +} + +sexp sexp_getuser (sexp ctx) { + return sexp_c_string(ctx, getuser(), -1); +} + +sexp sexp_sysname (sexp ctx) { + return sexp_c_string(ctx, sysname(), -1); +} + +sexp sexp_wait (sexp ctx) { /* just return (pid msg) */ + Waitmsg *wmsg; + sexp res; + sexp_gc_var(ctx, msg, s_msg); + sexp_gc_preserve(ctx, msg, s_msg); + wmsg = wait(); + msg = sexp_c_string(ctx, wmsg->msg, -1); + res = sexp_list2(ctx, sexp_make_integer(wmsg->pid), msg); + sexp_gc_release(ctx, msg, s_msg); + return res; +} + +sexp sexp_postnote (sexp ctx, sexp pid, sexp note) { + if (! sexp_integerp(pid)) + return sexp_type_exception(ctx, "postnote: not an integer", pid); + if (! sexp_stringp(note)) + return sexp_type_exception(ctx, "postnote: not a string", note); + postnote(PNPROC, sexp_unbox_integer(pid), sexp_string_data(note)); + return SEXP_VOID; +} +