LispObj *
Lisp_Recomp(LispBuiltin *builtin)
/*
re-comp pattern &key nospec icase nosub newline
*/
{
re_cod *regex;
int cflags = 0;
LispObj *result;
LispObj *pattern, *nospec, *icase, *nosub, *newline;
newline = ARGUMENT(4);
nosub = ARGUMENT(3);
icase = ARGUMENT(2);
nospec = ARGUMENT(1);
pattern = ARGUMENT(0);
/* Don't generate an error if it is already a compiled regex. */
if (REGEXP(pattern))
return (pattern);
CHECK_STRING(pattern);
if (nospec != UNSPEC && nospec != NIL)
cflags |= RE_NOSPEC;
if (icase != UNSPEC && icase != NIL)
cflags |= RE_ICASE;
if (nosub != UNSPEC && nosub != NIL)
cflags |= RE_NOSUB;
if (newline != UNSPEC && newline != NIL)
cflags |= RE_NEWLINE;
regex = LispRecomp(builtin, THESTR(pattern), cflags);
result = LispNew(pattern, NIL);
result->type = LispRegex_t;
result->data.regex.regex = regex;
result->data.regex.pattern = pattern;
result->data.regex.options = cflags;
LispMused(regex);
return (result);
}
LispObj *
Lisp_Require(LispBuiltin *builtin)
/*
require module &optional pathname
*/
{
char filename[1024], *ext;
int len;
LispObj *obj, *module, *pathname;
pathname = ARGUMENT(1);
module = ARGUMENT(0);
CHECK_STRING(module);
if (pathname != UNSPEC) {
if (PATHNAMEP(pathname))
pathname = CAR(pathname->data.pathname);
else {
CHECK_STRING(pathname);
}
}
else
pathname = module;
for (obj = MOD; CONSP(obj); obj = CDR(obj)) {
if (strcmp(THESTR(CAR(obj)), THESTR(module)) == 0)
return (module);
}
if (THESTR(pathname)[0] != '/') {
#ifdef LISPDIR
snprintf(filename, sizeof(filename), "%s", LISPDIR);
#else
getcwd(filename, sizeof(filename));
#endif
}
else
filename[0] = '\0';
*(filename + sizeof(filename) - 5) = '\0'; /* make sure there is place for ext */
len = strlen(filename);
if (!len || filename[len - 1] != '/') {
strcat(filename, "/");
++len;
}
snprintf(filename + len, sizeof(filename) - len - 5, "%s", THESTR(pathname));
ext = filename + strlen(filename);
#ifdef SHARED_MODULES
strcpy(ext, ".so");
if (access(filename, R_OK) == 0) {
LispModule *lisp_module;
char data[64];
int len;
if (lisp__data.module == NULL) {
/* export our own symbols */
if (dlopen(NULL, RTLD_LAZY | RTLD_GLOBAL) == NULL)
LispDestroy("%s: ", STRFUN(builtin), dlerror());
}
lisp_module = (LispModule*)LispMalloc(sizeof(LispModule));
if ((lisp_module->handle =
dlopen(filename, RTLD_LAZY | RTLD_GLOBAL)) == NULL)
LispDestroy("%s: dlopen: %s", STRFUN(builtin), dlerror());
snprintf(data, sizeof(data), "%sLispModuleData", THESTR(module));
if ((lisp_module->data =
(LispModuleData*)dlsym(lisp_module->handle, data)) == NULL) {
dlclose(lisp_module->handle);
LispDestroy("%s: cannot find LispModuleData for %s",
STRFUN(builtin), STROBJ(module));
}
LispMused(lisp_module);
lisp_module->next = lisp__data.module;
lisp__data.module = lisp_module;
if (lisp_module->data->load)
(lisp_module->data->load)();
if (MOD == NIL)
MOD = CONS(module, NIL);
else {
RPLACD(MOD, CONS(CAR(MOD), CDR(MOD)));
RPLACA(MOD, module);
}
LispSetVar(lisp__data.modules, MOD);
return (module);
}
#endif
strcpy(ext, ".lsp");
(void)LispLoadFile(STRING(filename), 0, 0, 0);
return (module);
}
/* XXX Non standard functions below
*/
LispObj *
Lisp_MakePipe(LispBuiltin *builtin)
/*
make-pipe command-line &key :direction :element-type :external-format
*/
{
char *string;
LispObj *stream = NIL;
int flags, direction;
LispFile *error_file;
LispPipe *program;
int ifd[2];
int ofd[2];
int efd[2];
char *argv[4];
LispObj *command_line, *odirection, *element_type, *external_format;
external_format = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
command_line = ARGUMENT(0);
if (PATHNAMEP(command_line))
command_line = CAR(command_line->data.quote);
else if (!STRINGP(command_line))
LispDestroy("%s: %s is a bad pathname",
STRFUN(builtin), STROBJ(command_line));
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
if (external_format != UNSPEC) {
/* just check argument... */
if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
; /* do nothing */
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
}
string = THESTR(command_line);
program = LispMalloc(sizeof(LispPipe));
if (direction != DIR_PROBE) {
argv[0] = "sh";
argv[1] = "-c";
argv[2] = string;
argv[3] = NULL;
pipe(ifd);
pipe(ofd);
pipe(efd);
if ((program->pid = fork()) == 0) {
close(0);
close(1);
close(2);
dup2(ofd[0], 0);
dup2(ifd[1], 1);
dup2(efd[1], 2);
close(ifd[0]);
close(ifd[1]);
close(ofd[0]);
close(ofd[1]);
close(efd[0]);
close(efd[1]);
execve("/bin/sh", argv, environ);
exit(-1);
}
else if (program->pid < 0)
LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
close(ifd[1]);
program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
close(ofd[0]);
error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
close(efd[1]);
}
else {
program->pid = -1;
program->input = program->output = error_file = NULL;
}
flags = direction == DIR_PROBE ? 0 : STREAM_READ;
program->errorp = FILESTREAM(error_file, command_line, flags);
flags = 0;
if (direction != DIR_PROBE) {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = PIPESTREAM(program, command_line, flags);
LispMused(program);
return (stream);
}