static Lisp_Object
read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
Lisp_Object initial, Lisp_Object predicate)
{
return CALLN (Ffuncall, intern ("read-file-name"),
callint_message, Qnil, default_filename,
mustmatch, initial, predicate);
}
static Lisp_Object
read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
Lisp_Object initial, Lisp_Object predicate)
{
struct gcpro gcpro1;
GCPRO1 (default_filename);
RETURN_UNGCPRO (CALLN (Ffuncall, intern ("read-file-name"),
callint_message, Qnil, default_filename,
mustmatch, initial, predicate));
}
static void
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
/* FIXME: This modifies typically pure hash-cons'd data, so its
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
else
{
AUTO_STRING (format, "No docstring slot for %s");
CALLN (Fmessage, format,
(SYMBOLP (obj)
? SYMBOL_NAME (obj)
: build_string ("<anonymous>")));
}
}
}
static time_t
get_boot_time (void)
{
#if defined (BOOT_TIME)
int counter;
#endif
if (boot_time_initialized)
return boot_time;
boot_time_initialized = 1;
#if defined (CTL_KERN) && defined (KERN_BOOTTIME)
{
int mib[2];
size_t size;
struct timeval boottime_val;
mib[0] = CTL_KERN;
mib[1] = KERN_BOOTTIME;
size = sizeof (boottime_val);
if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
{
boot_time = boottime_val.tv_sec;
return boot_time;
}
}
#endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */
if (BOOT_TIME_FILE)
{
struct stat st;
if (stat (BOOT_TIME_FILE, &st) == 0)
{
boot_time = st.st_mtime;
return boot_time;
}
}
#if defined (BOOT_TIME)
#ifndef CANNOT_DUMP
/* The utmp routines maintain static state.
Don't touch that state unless we are initialized,
since it might not survive dumping. */
if (! initialized)
return boot_time;
#endif /* not CANNOT_DUMP */
/* Try to get boot time from utmp before wtmp,
since utmp is typically much smaller than wtmp.
Passing a null pointer causes get_boot_time_1
to inspect the default file, namely utmp. */
get_boot_time_1 (0, 0);
if (boot_time)
return boot_time;
/* Try to get boot time from the current wtmp file. */
get_boot_time_1 (WTMP_FILE, 1);
/* If we did not find a boot time in wtmp, look at wtmp, and so on. */
for (counter = 0; counter < 20 && ! boot_time; counter++)
{
char cmd_string[sizeof WTMP_FILE ".19.gz"];
Lisp_Object tempname, filename;
bool delete_flag = 0;
filename = Qnil;
tempname = make_formatted_string
(cmd_string, "%s.%d", WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
filename = tempname;
else
{
tempname = make_formatted_string (cmd_string, "%s.%d.gz",
WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
{
/* The utmp functions on mescaline.gnu.org accept only
file names up to 8 characters long. Choose a 2
character long prefix, and call make_temp_file with
second arg non-zero, so that it will add not more
than 6 characters to the prefix. */
filename = Fexpand_file_name (build_string ("wt"),
Vtemporary_file_directory);
filename = make_temp_name (filename, 1);
CALLN (Fcall_process, build_string ("gzip"), Qnil,
list2 (QCfile, filename), Qnil,
build_string ("-cd"), tempname);
delete_flag = 1;
}
}
if (! NILP (filename))
{
get_boot_time_1 (SSDATA (filename), 1);
if (delete_flag)
unlink (SSDATA (filename));
}
}
return boot_time;
#else
return 0;
#endif
}
