1/* BEGIN LICENSE BLOCK
2 * Version: CMPL 1.1
3 *
4 * The contents of this file are subject to the Cisco-style Mozilla Public
5 * License Version 1.1 (the "License"); you may not use this file except
6 * in compliance with the License.  You may obtain a copy of the License
7 * at www.eclipse-clp.org/license.
8 *
9 * Software distributed under the License is distributed on an "AS IS"
10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11 * the License for the specific language governing rights and limitations
12 * under the License.
13 *
14 * The Original Code is  The ECLiPSe Constraint Logic Programming System.
15 * The Initial Developer of the Original Code is  Cisco Systems, Inc.
16 * Portions created by the Initial Developer are
17 * Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
18 *
19 * Contributor(s):
20 *
21 * END LICENSE BLOCK */
22
23/*
24  VERSION	$Id: bip_misc.c,v 1.10 2013/04/17 01:34:21 jschimpf Exp $
25 */
26
27/****************************************************************************
28 *
29 *		SEPIA Built-in Predicates: Miscellaneous
30 *
31 *
32 *****************************************************************************/
33
34
35#include "config.h"
36
37#include <sys/types.h>
38#include <sys/stat.h>
39#include <time.h>
40#include <errno.h>
41#include <stdio.h>
42#include <math.h>
43
44#ifndef _WIN32
45#include <sys/time.h>
46#include <sys/times.h>
47#include <pwd.h>
48extern void	endpwent(void);
49#include <grp.h>
50extern void	endgrent(void);
51#else
52#include <windows.h>
53#include <process.h>
54#endif
55
56#include <signal.h>
57
58#ifdef HAVE_UNISTD_H
59#include <unistd.h>
60#else
61unsigned int	alarm();
62#endif
63
64#ifndef ACCESS_IN_UNISTD
65#include <sys/file.h>
66#endif
67
68#ifdef HAVE_SYS_SYSTEMINFO_H
69#include <sys/systeminfo.h>
70#endif
71
72#ifdef HAVE_STRING_H
73#include <string.h>
74#endif
75
76#ifdef STDC_HEADERS
77#include <stdlib.h>
78#else
79extern char	*getenv();
80extern void	exit();
81# ifdef HAVE_RANDOM
82#  if (SIZEOF_LONG == 8)
83    extern int	random();
84#  else
85    extern long	random();
86#  endif
87# endif
88#endif
89
90
91#include "sepia.h"
92#include "types.h"
93#include "embed.h"
94#include "error.h"
95#include "mem.h"
96#include "dict.h"
97#include "emu_export.h"
98#include "os_support.h"
99
100extern int      p_wm_get();
101extern int      p_wm_get_ids();
102extern int      p_wm_set();
103extern int      p_wm_interface();
104extern double   elapsed_session_time();
105extern int      p_worker_stat_reset();
106extern int      p_worker_stat();
107
108static int p_date(value v, type t),
109	p_all_times(value vuser, type tuser, value vsys, type tsys, value vreal, type treal),
110	p_argc(value v0, type t0),
111	p_argv(value v0, type t0, value v1, type t1),
112	p_cd(value v, type t),
113	p_expand_filename(value vin, type tin, value vout, type tout, value vopt, type topt),
114	p_os_file_name(value vecl, type tecl, value vos, type tos),
115	p_getcwd(value sval, type stag),
116	p_getenv(value v0, type t0, value v1, type t1),
117	p_get_sys_flag(value vf, type tf, value vv, type tv),
118	p_kill(value pv, type pt, value sv, type st),
119	p_local_time(value vy, type ty, value vm, type tm, value vd, type td, value vh, type th, value vmin, type tmin, value vsec, type tsec, value vdst, type tdst, value vunixtime, type tunixtime),
120	p_local_time_string(value vunixtime, type tunixtime, value vformat, type tformat, value vs, type ts),
121	p_pathname(value sval, type stag, value pathval, type pathtag, value vfile, type tfile),
122	p_frandom(value v, type t),
123	p_random(value v, type t),
124	p_seed(value v, type t),
125	p_sleep(value v, type t),
126	p_setenv(value v0, type t0, value v1, type t1),
127	p_suffix(value sval, type stag, value sufval, type suftag),
128	p_session_time(value vtime, type ttime),
129	p_get_hr_time(value vtime, type ttime),
130	p_set_timer(value vtimer, type ttimer, value vinterv, type tinterv),
131	p_get_timer(value vtimer, type ttimer, value vinterv, type tinterv),
132	p_start_timer(value vtimer, type ttimer, value vfirst, type tfirst, value vinterv, type tinterv),
133	p_stop_timer(value vtimer, type ttimer, value vremain, type tremain, value vinterv, type tinterv),
134	p_cputime(value val, type tag),
135	p_alarm(value v, type t),
136#ifdef _WIN32
137	p_system(value v, type t),
138#endif
139	p_sys_file_flag(value fv, type ft, value nv, type nt, value vv, type vt);
140
141static void
142	_fseed(uint32),
143	_post_alarm(long int);
144
145
146int	p_heap_stat(value vwhat, type twhat, value vval, type tval);
147
148static dident	d_virtual,
149		d_version,
150		d_profile;
151
152/*
153 * Static variables
154 */
155
156static dident	d_hostid_ = D_UNKNOWN;	/* cache for hostid atom */
157
158static int32	seed;	/* for random generator */
159
160#ifdef _WIN32
161static LARGE_INTEGER ticks_per_sec_;
162static int have_perf_counter_ = 0;
163#endif
164
165
166void
167bip_misc_init(int flags)
168{
169    if (flags & INIT_SHARED)
170    {
171	(void) built_in(in_dict("argc",1),	p_argc,	B_UNSAFE|U_SIMPLE);
172	(void) built_in(in_dict("argv",2),	p_argv,	B_UNSAFE|U_SIMPLE);
173	(void) built_in(in_dict("getenv",2),	p_getenv, B_UNSAFE|U_SIMPLE);
174	(void) built_in(in_dict("setenv",2),	p_setenv, B_UNSAFE|U_SIMPLE);
175	(void) built_in(in_dict("date",1), 	p_date,	B_UNSAFE|U_SIMPLE);
176	(void) built_in(in_dict("local_time",8),  p_local_time,	B_UNSAFE|U_GROUND);
177	(void) built_in(in_dict("local_time_string",3),  p_local_time_string,	B_UNSAFE|U_SIMPLE);
178	(void) local_built_in(in_dict("expand_filename",3),
179				p_expand_filename,	B_UNSAFE|U_SIMPLE);
180	built_in(in_dict("os_file_name",2), 	p_os_file_name, B_UNSAFE|U_GROUND)
181		-> mode = BoundArg(1, NONVAR) | BoundArg(2, NONVAR);
182	(void) built_in(in_dict("random",1), 	p_random, B_UNSAFE|U_SIMPLE);
183	(void) built_in(in_dict("frandom",1), 	p_frandom, B_UNSAFE|U_SIMPLE);
184	(void) built_in(in_dict("seed",1),	p_seed, 	B_SAFE);
185	(void) built_in(in_dict("sleep",1), 	p_sleep, 	B_UNSAFE);
186	(void) built_in(in_dict("kill", 2), 	p_kill, 	B_SAFE);
187	(void) built_in(in_dict("suffix", 2), 	p_suffix, B_UNSAFE|U_SIMPLE);
188	built_in(in_dict("pathname", 3), 	p_pathname, B_UNSAFE|U_GROUND)
189	    -> mode = BoundArg(2, CONSTANT) | BoundArg(3, CONSTANT);
190	(void) built_in(in_dict("getcwd", 1), 	p_getcwd,  B_UNSAFE|U_SIMPLE);
191	(void) built_in(in_dict("cd", 1),		p_cd, 	B_SAFE);
192	(void) built_in(in_dict("get_hr_time", 1), p_get_hr_time, 	B_UNSAFE|U_SIMPLE);
193	(void) built_in(in_dict("set_timer", 2), p_set_timer, 	B_SAFE);
194	(void) built_in(in_dict("get_timer", 2),
195				p_get_timer,		B_UNSAFE|U_SIMPLE);
196	(void) exported_built_in(in_dict("start_timer", 3), p_start_timer,	B_SAFE);
197	exported_built_in(in_dict("stop_timer", 3),
198				p_stop_timer,		B_UNSAFE|U_GROUND)
199	    -> mode = BoundArg(2, CONSTANT) | BoundArg(3, CONSTANT);
200	(void) local_built_in(in_dict("wm_get", 1), p_wm_get, B_UNSAFE|U_GROUND);
201	(void) local_built_in(in_dict("wm_get_ids", 2), p_wm_get_ids, B_UNSAFE|U_GROUND);
202	(void) local_built_in(in_dict("wm_set", 3), p_wm_set, B_UNSAFE|U_SIMPLE);
203	(void) local_built_in(in_dict("wm_interface", 1), p_wm_interface,
204			B_UNSAFE|U_SIMPLE);
205	(void) local_built_in(in_dict("session_time", 1), p_session_time,
206		B_UNSAFE|U_SIMPLE);
207	local_built_in(in_dict("all_times", 3), p_all_times, B_UNSAFE|U_GROUND)
208	    -> mode = BoundArg(1, CONSTANT) | BoundArg(2, CONSTANT) |
209		    BoundArg(3, CONSTANT);
210	(void) local_built_in(in_dict("heap_stat", 2),
211				p_heap_stat,		B_UNSAFE|U_SIMPLE);
212	(void) local_built_in(in_dict("get_sys_flag", 2),
213				p_get_sys_flag,		B_UNSAFE|U_SIMPLE);
214	(void) local_built_in(in_dict("sys_file_flag", 3),
215				p_sys_file_flag,	B_UNSAFE|U_SIMPLE);
216	(void) exported_built_in(in_dict("worker_statistics_reset", 1),
217			p_worker_stat_reset, B_SAFE);
218	(void) exported_built_in(in_dict("worker_statistics", 2), p_worker_stat,
219		B_UNSAFE|U_GROUND);
220	(void) built_in(in_dict("cputime",1), p_cputime, B_UNSAFE|U_SIMPLE);
221	(void) built_in(in_dict("alarm",1), p_alarm, B_UNSAFE);
222#ifdef _WIN32
223	(void) local_built_in(in_dict("_system", 1), p_system, B_SAFE);
224#endif
225    }
226
227    if (flags & INIT_PRIVATE)
228    {
229	d_virtual = in_dict("virtual", 0);
230	d_profile = in_dict("profile", 0);
231	d_version = in_dict(ec_version, 0);
232    }
233
234    if (flags & INIT_PROCESS)
235    {
236	/* initialize random generators */
237	int rand_init = ec_unix_time() * getpid();
238	_fseed((uint32) rand_init);
239#ifdef HAVE_RANDOM
240	srandom((unsigned) rand_init);
241#else
242	srand((unsigned) rand_init);
243#endif
244#ifdef _WIN32
245	if (QueryPerformanceFrequency(&ticks_per_sec_))
246	    have_perf_counter_ = 1;
247#endif
248    }
249}
250
251
252/*	argc/1
253 *	unifies its argument with the number of argument of the call to sepia.
254 */
255
256static int
257p_argc(value v0, type t0)
258{
259    Check_Output_Integer(t0);
260    Return_Unify_Integer(v0,t0,ec_options.Argc);
261}
262
263/*	argv/2
264 *	first argument must be an integer in the range [0..Argc[
265 *	unify the second with the specified arg of the call to sepia.
266 */
267
268static int
269p_argv(value v0, type t0, value v1, type t1)
270{
271    pword result;
272
273    if (IsInteger(t0))
274    {
275	if (v0.nint >= 0)	/* get one argument */
276	{
277	    Check_Output_String(t1);
278	    if (v0.nint >= ec_options.Argc) { Bip_Error(RANGE_ERROR); }
279	    Make_String(&result, ec_options.Argv[v0.nint]);
280	}
281	else	/* shift arguments: argv(NegPos, NShift) */
282	{
283	    int i,j;
284	    Check_Integer(t1);
285	    i = -v0.nint;
286	    j = i + v1.nint;
287	    if (j < i || i >= ec_options.Argc || j > ec_options.Argc)
288	    	{ Bip_Error(RANGE_ERROR); }
289	    while (j < ec_options.Argc)
290	    	ec_options.Argv[i++] = ec_options.Argv[j++];
291	    ec_options.Argc = i;
292	    Succeed_;
293	}
294    }
295    else if (IsAtom(t0))
296    {
297	int	i;
298	pword	*car, *cdr;
299	Check_Output_List(t1);
300	if (v0.did != d_.all) { Bip_Error(RANGE_ERROR); }
301	cdr = &result;
302	for (i=0; i<ec_options.Argc; i++)
303	{
304	    car = TG;
305	    Push_List_Frame();
306	    Make_List(cdr, car);
307	    Make_String(car, ec_options.Argv[i]);
308	    cdr = car + 1;
309	}
310	Make_Nil(cdr);
311    }
312    else { Bip_Error(TYPE_ERROR); }
313
314    Return_Unify_Pw(v1, t1, result.val, result.tag);
315}
316
317/*
318 *	getenv/2
319 * unifies its second argument with the value associated with the first
320 * argument in the environment list (using getenv(3))
321 */
322
323#define	TENTATIVE_SIZE 1024
324
325static int
326p_getenv(value v0, type t0, value v1, type t1)
327{
328    int size, buf_size;
329    char *name;
330    value v;
331
332    Get_Name(v0,t0,name)
333    Check_Output_String(t1)
334    v.ptr = TG;
335    size = TENTATIVE_SIZE;
336    do {
337	TG = v.ptr;
338	Push_Buffer(size);
339	buf_size = size;
340	if (!ec_env_lookup(name, StringStart(v), &size))
341	{
342	    Fail_;
343	}
344    } while (size > buf_size);
345
346    Trim_Buffer(v.ptr, size);
347    Return_Unify_String(v1, t1, v.ptr)
348}
349
350
351/*
352 * setenv(+Name, +Value)
353 */
354
355static int
356p_setenv(value v0, type t0, value v1, type t1)
357{
358    char *name, *new_value;
359    pword *old_tg = TG;
360
361    Get_Name(v0, t0, name);
362
363    /* For the value, allow numbers, strings and atoms */
364    if (IsNumber(t1))
365    {
366	/* convert integer to temporary string */
367	int len = tag_desc[TagType(t1)].string_size(v1, t1, 1);
368	value v_tmp;
369	v_tmp.ptr = TG;
370	Push_Buffer(len+1);		/* make integer string buffer */
371	len = tag_desc[TagType(t1)].to_string(v1, t1, StringStart(v_tmp), 1);
372	Trim_Buffer(v_tmp.ptr, len+1);
373	new_value = StringStart(v_tmp);
374    }
375    else
376    {
377	Get_Name(v1, t1, new_value);
378    }
379
380#ifdef _WIN32
381    if (!SetEnvironmentVariable(name, new_value))
382    {
383	Set_Sys_Errno(GetLastError(),ERRNO_WIN32);
384	Bip_Error(SYS_ERROR);
385    }
386#else
387#ifdef HAVE_PUTENV
388   {
389	/*
390	 * With putenv(), the "name=value" string becomes part of the
391	 * environment.  We use malloc to allocate the string, as it needs
392         * to persist after ECLiPSe ends. We check to see that the
393	 * environment variable is not already set to the same value to avoid
394         * multiple copies
395	 */
396	int len = strlen(name) + 2 + strlen(new_value); /* "name=value\0" */
397	char *envstring;
398
399	if (strchr(name, '='))	/* emulate setenv() behaviour */
400	{
401	    Set_Sys_Errno(EINVAL, ERRNO_UNIX);
402	    Bip_Error(SYS_ERROR);
403	}
404	/* check if the environment variable is already set to new_value */
405	envstring = getenv(name);
406	if (!envstring || strcmp(envstring, new_value))
407	{
408	    /* the memory associated with envstring is leaked! */
409	    envstring = (char *)malloc(len);
410	    strcat(strcat(strcpy(envstring, name), "="), new_value);
411	    if (putenv(envstring))
412	    {
413		free(envstring);
414		Set_Errno
415		Bip_Error(SYS_ERROR);
416	    }
417	}
418   }
419#else
420    /* setenv() copies the strings, old strings are leaked! */
421    if (setenv(name, new_value, 1))
422    {
423	Set_Errno
424	Bip_Error(SYS_ERROR);
425    }
426#endif
427#endif
428
429    TG = old_tg;	/* pop any temporary buffers */
430    Succeed_;
431}
432
433
434/*
435 * unsetenv(+Name)	not sufficiently portable
436 */
437
438#if 0
439static int
440p_unsetenv(value v0, type t0)
441{
442    char *name;
443    Get_Name(v0, t0, name);
444#ifdef _WIN32
445    if (SetEnvironmentVariable(name, 0))
446    {
447	Set_Sys_Errno(GetLastError(),ERRNO_WIN32);
448	Bip_Error(SYS_ERROR);
449    }
450#else
451    unsetenv(name);
452#endif
453    Succeed_;
454}
455#endif
456
457
458/*	date/1
459 *	binds its argument to a string holding
460 *	the date and time of the form:
461 *	Sun Sep 16 01:03:52 1987\n\0
462 *	with fixed field sizes (total: 26 characters)
463 */
464static int
465p_date(value v, type t)
466{
467    char buf[50];
468    value val;
469
470    Check_Output_String(t)
471    (void) ec_date_string(buf);
472    Cstring_To_Prolog(buf, val);
473    Return_Unify_String(v, t, val.ptr);
474}
475
476
477static int
478p_local_time(value vy, type ty, value vm, type tm, value vd, type td, value vh, type th, value vmin, type tmin, value vsec, type tsec, value vdst, type tdst, value vunixtime, type tunixtime)
479{
480    time_t time_utc;
481    struct tm time_here;
482    Prepare_Requests;
483
484    if (IsRef(tunixtime))
485    {
486	Check_Integer(ty);
487	Check_Integer(tm);
488	Check_Integer(td);
489	Check_Integer(th);
490	Check_Integer(tmin);
491	Check_Integer(tsec);
492	Check_Output_Integer(tdst);
493	time_here.tm_year = vy.nint - 1900;
494	time_here.tm_mon = vm.nint - 1;
495	time_here.tm_mday = vd.nint;
496	time_here.tm_hour = vh.nint;
497	time_here.tm_min = vmin.nint;
498	time_here.tm_sec = vsec.nint;
499	time_here.tm_isdst = IsRef(tdst) ? -1 : vdst.nint ? 1 : 0;
500
501	time_utc = mktime(&time_here);
502	if (time_utc == (time_t) -1)
503	    { Fail_; }
504
505	Request_Unify_Integer(vunixtime, tunixtime, time_utc);
506    }
507    else
508    {
509	Check_Integer(tunixtime)
510	time_utc = (time_t) vunixtime.nint;
511
512#ifdef HAVE_LOCALTIME_R
513	localtime_r(&time_utc, &time_here);
514#else
515	time_here = *localtime(&time_utc);
516#endif
517    }
518    Request_Unify_Integer(vy, ty, time_here.tm_year + 1900);
519    Request_Unify_Integer(vm, tm, time_here.tm_mon + 1);
520    Request_Unify_Integer(vd, td, time_here.tm_mday);
521    Request_Unify_Integer(vh, th, time_here.tm_hour);
522    Request_Unify_Integer(vmin, tmin, time_here.tm_min);
523    Request_Unify_Integer(vsec, tsec, time_here.tm_sec);
524    Request_Unify_Integer(vdst, tdst, time_here.tm_isdst ? 1 : 0);
525    Return_Unify;
526}
527
528
529static int
530p_local_time_string(value vunixtime, type tunixtime, value vformat, type tformat, value vs, type ts)
531{
532    pword *pw;
533    time_t time_utc;
534    struct tm time_here;
535    value vres;
536    char *s, *format;
537    int fmtlen, len, max;
538
539    Check_Integer(tunixtime);
540    Error_If_Ref(tformat);
541    if (IsString(tformat)) {
542	format = StringStart(vformat);
543	fmtlen = StringLength(vformat);
544    } else if (IsAtom(tformat)) {
545	format = DidName(vformat.did);
546	fmtlen = DidLength(vformat.did);
547    } else if (IsNil(tformat)) {
548	format = DidName(d_.nil);
549	fmtlen = DidLength(d_.nil);
550    } else {
551	Bip_Error(TYPE_ERROR)
552    }
553    Check_Output_String(ts);
554
555    time_utc = (time_t) vunixtime.nint;
556#ifdef HAVE_LOCALTIME_R
557    localtime_r(&time_utc, &time_here);
558#else
559    time_here = *localtime(&time_utc);
560#endif
561
562    /* guess a max length for the buffer */
563    max = fmtlen > 100 ? fmtlen * 10 : 1000;
564    pw = TG;
565    for (;;)
566    {
567	Push_Buffer(max+1);
568	len = strftime((char *) BufferStart(pw), max+1, format, &time_here);
569	if (len > 0  ||  fmtlen == 0)
570	{
571	    Trim_Buffer(pw, len+1);
572	    break;
573	}
574	TG = pw;	/* pop the old buffer */
575	max *= 2;
576    }
577    Return_Unify_String(vs, ts, pw);
578}
579
580
581/*
582 * Floating point random generator. This is taken from random2.c
583 * by John Burton, available from the net. Part of original comment:
584 *
585 * PMMMLCG - Prime Modulus M Multiplicative Linear Congruential Generator   *
586 *  Modified version of the Random number generator proposed by             *
587 *  Park & Miller in "Random Number Generators: Good Ones Are Hard to Find" *
588 *  CACM October 1988, Vol 31, No. 10                                       *
589 *   - Modifications proposed by Park to provide better statistical         *
590 *     properties (i.e. more "random" - less correlation between sets of    *
591 *     generated numbers                                                    *
592 *   - generator is of the form                                             *
593 *         x = ( x * A) % M                                                 *
594 *   - Choice of A & M can radically modify the properties of the generator *
595 *     the current values were chosen after followup work to the original   *
596 *     paper mentioned above.                                               *
597 *   - The generator has a period of 2^31 - 1 with numbers generated in the *
598 *     range of 0 < x < M                                                   *
599 *   - The generator can run on any machine with a 32-bit integer, without  *
600 *     overflow.                                                            *
601 */
602
603#define RND_A	48271
604#define RND_M	2147483647
605#define RND_Q	(RND_M / RND_A)
606#define RND_R	(RND_M % RND_A)
607
608static void
609_fseed(uint32 n)
610{
611    int32 seed0 = n % RND_M;
612    seed = (seed0==0) ? 1 : seed0;	/* seed must be in range 1..2147483646 */
613}
614
615static double
616frandom(void)
617{
618    int32 lo,hi,test;
619    static double temp = 1.0 / (double)RND_M;
620
621    hi = seed / RND_Q;
622    lo = seed % RND_Q;
623    test = RND_A * lo - RND_R * hi;
624    seed = (test > 0) ? (test) : (test + RND_M);
625    return( (double)seed * temp);
626}
627
628static int
629p_frandom(value v, type t)
630{
631    double f = frandom();
632    Check_Output_Float(t);
633    Return_Unify_Float(v, t, f); /* may use several times its arguments */
634}
635
636
637/*
638 * p_random()	random/1
639 * Binds it argument to a random integer.
640 */
641static int
642p_random(value v, type t)
643{
644    long n;
645#ifdef HAVE_RANDOM
646    n = random();		  /* use n, because the following macro */
647#else
648    n = (rand() << 16) | rand(); /* make a long out of the short(?)*/
649    if (n < 0)
650	n = -n;
651#endif
652    Check_Output_Integer(t)
653    Return_Unify_Integer(v,t,n); /* may use several times its arguments */
654}
655
656/*
657 * p_seed()	seed/1
658 * Sets the seed for random/1. The argument must be an int.
659 */
660static int
661p_seed(value v, type t)
662{
663	Check_Integer(t);
664#ifdef HAVE_RANDOM
665	srandom((unsigned) v.nint);
666#else
667	srand((unsigned) v.nint);
668#endif
669	_fseed((uint32) v.nint);		/* for frandom() */
670	Succeed_;
671}
672
673
674/*
675 * p_sleep()	sleep/1
676 *
677 * Suspends the process for the given (integer) number of seconds.
678 */
679static int
680p_sleep(value v, type t)
681{
682    if (IsInteger(t))
683	(void) ec_sleep((double) v.nint);
684    else if (IsDouble(t))
685	(void) ec_sleep(Dbl(v));
686    else
687	{ Bip_Error(TYPE_ERROR); }
688    return(PSUCCEED);
689}
690
691/*
692 * Get the suffix of a filename (extension).
693 */
694static int
695p_suffix(value sval, type stag, value sufval, type suftag)
696{
697	char		*p;
698	char		*suffix;
699	char		c;
700	value		v;
701
702	Get_Name(sval, stag, p);
703	suffix = 0;
704
705	while (c = *++p)	/* omit the (posible) leading '.' */
706		if (c == '/')
707		{
708			suffix = 0;
709			if (*(p + 1))	/* idem */
710				p++;
711		}
712		else if (c == '.')
713			suffix = p;
714	if (!suffix)
715		suffix = p;
716
717	if (IsString(suftag))
718	{
719		Succeed_If(!strcmp(suffix, StringStart(sufval)));
720	}
721	else if (IsRef(suftag))
722	{
723		Cstring_To_Prolog(suffix, v);
724                Return_Unify_String(sufval,suftag,v.ptr);
725	}
726	Bip_Error(TYPE_ERROR);
727}
728
729/*
730 * Split the pathname into parent path and simple file name.
731 */
732static int
733p_pathname(value sval, type stag, value pathval, type pathtag, value vfile, type tfile)
734{
735	char		*path;
736	char		*p, *d, *f, *e;
737	char		c;
738	char		fullname[MAX_PATH_LEN];
739	value		v;
740	value		vf;
741	Prepare_Requests;
742
743	Get_Name(sval, stag, path);
744	Check_Output_String(pathtag);
745	Check_Output_String(tfile);
746	d = e = f = expand_filename(path, fullname, EXPAND_SYNTACTIC);
747
748	if (*e == '/') {
749	    ++e;
750	    if ((c = *e) == '/') {
751		++e;
752		while ((c = *e) && c != '/')	/* skip drive/share spec */
753		    ++e;
754		f = e;
755		if (!c) {
756		    /* dir="//share", file="/" */
757		    *e++ = '/';
758		    *e = '\0';
759		}
760	    } else if (c) {
761		f = e;
762	    }
763	    /* else dir="", file="/" */
764	}
765
766	while (c = *e)
767	{
768	    ++e;
769	    if (c == '/') f = e;	/* remember last slash */
770	}
771
772	Make_Stack_String(f-d, v, p);	/* copy directory part */
773	while (d < f)
774		*p++ = *d++;
775	*p = '\0';
776
777	Make_Stack_String(e-f, vf, p);	/* copy filename part */
778	while (f < e)
779		*p++ = *f++;
780	*p = '\0';
781
782        Request_Unify_String(pathval,pathtag,v.ptr);
783        Request_Unify_String(vfile, tfile, vf.ptr);
784	Return_Unify;
785}
786
787
788/*
789 * expand_filename(+NameIn, ?NameOut, Option)
790 *
791 * Various expansions on a file name, depending on options.
792 */
793
794static int
795p_expand_filename(value vin, type tin, value vout, type tout, value vopt, type topt)
796{
797    char *in, out[MAX_PATH_LEN];
798    value v;
799    Check_Integer(topt);
800    Get_Name(vin, tin, in);
801    Check_Output_String(tout);
802    (void) expand_filename(in, out, vopt.nint);
803    Cstring_To_Prolog(out, v);
804    Return_Unify_String(vout, tout, v.ptr);
805}
806
807
808static int
809p_os_file_name(value vecl, type tecl, value vos, type tos)
810{
811    char *in, out[MAX_PATH_LEN];
812    pword pw;
813
814    if (IsRef(tos))			/* internal -> external */
815    {
816	Get_Name(vecl, tecl, in);
817	(void) os_filename(in, out);
818	if (IsAtom(tecl))
819	    { Make_Atom(&pw, enter_dict(out,0)); }
820	else
821	    { Make_String(&pw, out); }
822	Return_Unify_Pw(vos, tos, pw.val, pw.tag);
823    }
824    else				/* external -> internal */
825    {
826	Get_Name(vos, tos, in);
827	(void) canonical_filename(in, out);
828	if (IsAtom(tos))
829	    { Make_Atom(&pw, enter_dict(out,0)); }
830	else
831	    { Make_String(&pw, out); }
832	if (!IsRef(tecl) && DifferType(tecl,tos))
833	    { Bip_Error(TYPE_ERROR); }
834	Return_Unify_Pw(vecl, tecl, pw.val, pw.tag);
835    }
836}
837
838
839/*
840 * getcwd/1
841 */
842static int
843p_getcwd(value sval, type stag)
844{
845	value	v;
846	char	*s;
847	char	buf[MAX_PATH_LEN];
848	int	len;
849
850	Check_Output_String(stag);
851	v.ptr = TG;
852	Push_Buffer(MAX_PATH_LEN);
853	len = ec_get_cwd(StringStart(v), MAX_PATH_LEN);
854	Trim_Buffer(v.ptr, len+1);
855	Return_Unify_String(sval, stag, v.ptr);
856}
857
858
859static int
860p_cd(value v, type t)
861{
862    char   *name;
863    Get_Name(v,t,name)
864    if (ec_set_cwd(name)) {
865	Bip_Error(SYS_ERROR);
866    }
867    Succeed_;
868}
869
870
871static int
872p_all_times(value vuser, type tuser, value vsys, type tsys, value vreal, type treal)
873{
874    double user, sys, elapsed;
875    Prepare_Requests
876    if (all_times(&user, &sys, &elapsed))
877    {
878	Set_Errno
879	Bip_Error(SYS_ERROR)
880    }
881    Request_Unify_Float(vuser, tuser, user);
882    Request_Unify_Float(vsys, tsys, sys);
883    Request_Unify_Float(vreal, treal, elapsed);
884    Return_Unify;
885}
886
887static int
888p_session_time(value vtime, type ttime)
889{
890    double elapsed, dummy;
891
892    if (ec_options.parallel_worker)
893    	elapsed = elapsed_session_time();
894    else
895	(void) all_times(&dummy, &dummy, &elapsed);
896
897    Return_Unify_Float(vtime, ttime, elapsed);
898}
899
900
901static int
902p_get_sys_flag(value vf, type tf, value vv, type tv)
903{
904    extern dident	d_hostarch_;
905    pword		pw;
906
907    Check_Integer(tf);
908    switch (vf.nint)
909    {
910    case 1:	/* hostid */
911
912	if (d_hostid_ == D_UNKNOWN)
913	{
914	    /* get the hostid and cache it for future calls */
915	    char buf[257];
916	    int len = ec_gethostid(buf, 257);
917	    if (len > 0)
918		d_hostid_ = enter_dict_n(buf, len, 0);
919	    else
920		d_hostid_ = enter_dict_n("?", 1, 0);
921	    Set_Did_Stability(d_hostid_, DICT_PERMANENT);
922	}
923	pw.tag.kernel = TSTRG;
924	pw.val.ptr = DidString(d_hostid_);
925	break;
926
927
928    case 2:	/* hostname */
929	{
930	    int len;
931	    pw.tag.kernel = TSTRG;
932	    pw.val.ptr = TG;
933	    Push_Buffer(257);
934	    len = ec_gethostname(StringStart(pw.val), 257);
935	    if (len < 0) {
936		len = 1;
937		*StringStart(pw.val) = '?';
938	    }
939	    Trim_Buffer(pw.val.ptr, len+1);
940	    break;
941	}
942
943    case 3:	/* pid */
944	pw.val.nint = getpid();
945	pw.tag.kernel = TINT;
946	break;
947
948    case 4:	/* ppid */
949#ifdef _WIN32
950	pw.val.nint = 0;
951#else
952	pw.val.nint = getppid();
953#endif
954	pw.tag.kernel = TINT;
955	break;
956
957    case 5:	/* unix_time */
958	pw.val.nint = ec_unix_time();
959	pw.tag.kernel = TINT;
960	break;
961
962    case 6:	/* local_size */
963	pw.val.nint = ((char *) SP_ORIG - (char *) B_ORIG) / 1024;
964	pw.tag.kernel = TINT;
965	break;
966
967    case 7:	/* global_size */
968	pw.val.nint = ((char *) TT_ORIG - (char *) TG_ORIG) / 1024;
969	pw.tag.kernel = TINT;
970	break;
971
972    case 8:	/* hostarch */
973	pw.tag.kernel = TSTRG;
974	pw.val.ptr = DidString(d_hostarch_);
975	break;
976
977    case 9:	/* object suffix */
978	Make_String(&pw, OBJECT_SUFFIX_STRING);
979	break;
980
981    case 10:	/* worker number */
982	pw.val.nint = ec_options.parallel_worker;
983	pw.tag.kernel = TINT;
984	break;
985
986    case 11:	/* current version */
987	Make_Atom(&pw, d_version);
988	break;
989
990    case 12:	/* default_language option */
991	Make_Atom(&pw, in_dict(
992	    ec_options.default_language ? ec_options.default_language : "", 0));
993	break;
994
995    default:
996	Bip_Error(RANGE_ERROR);
997    }
998    Return_Unify_Pw(vv, tv, pw.val, pw.tag);
999}
1000
1001static int
1002p_cputime(value val, type tag)
1003{
1004	Check_Output_Float(tag);
1005	Return_Unify_Float(val, tag, ((double) (user_time())) / clock_hz);
1006}
1007
1008static void
1009_post_alarm(long int n)
1010{
1011    if (ec_post_event_int(n) != PSUCCEED)
1012    {
1013	p_fprintf(current_err_, "ECLiPSe: Could not post alarm event");
1014	ec_flush(current_err_);
1015    }
1016}
1017
1018static int
1019p_alarm(value v, type t)
1020{
1021    Check_Integer(t);
1022#ifdef USE_TIMER_THREAD
1023    if (!ec_set_alarm((double) v.nint, 0.0, _post_alarm, ec_sigalrm, 0, 0))
1024    	{ Bip_Error(SYS_ERROR); }
1025#else
1026    (void) alarm((unsigned) v.nint);
1027#endif
1028    Succeed_;
1029}
1030
1031
1032/*
1033 * Return time in seconds with a high resolution, but undefined epoch.
1034 * Only good to measure the difference between two time points.
1035 * This is currently real time on Unix and Windows, not cputime.
1036 */
1037
1038static int
1039p_get_hr_time(value v, type t)
1040{
1041    double seconds;
1042#ifdef _WIN32
1043    LARGE_INTEGER ticks;
1044    if (!have_perf_counter_)
1045	return p_session_time(v, t);
1046
1047    if (!QueryPerformanceCounter(&ticks))
1048    {
1049	Set_Sys_Errno(GetLastError(),ERRNO_WIN32);
1050	Bip_Error(SYS_ERROR);
1051    }
1052    seconds = (double)ticks.QuadPart/(double)ticks_per_sec_.QuadPart;
1053#else
1054    struct timeval ticks;
1055    if (gettimeofday(&ticks, NULL))
1056    	{ Bip_Error(SYS_ERROR); }
1057    seconds = ticks.tv_sec + ticks.tv_usec/1000000.0;
1058#endif
1059    Return_Unify_Float(v, t, seconds);
1060}
1061
1062
1063/*
1064 * start_timer(+Timer, +TimeToFirstSignal, +TimeBetweenSignals)
1065 * stop_timer(+Timer, -RemainingTimeToNext, -TimeBetweenSignals)
1066 * obsolete:
1067 * set_timer(+Timer, +TimeBetweenInterrupts)
1068 * get_timer(+Timer, -TimeBetweenInterrupts) fail if it was off
1069 *
1070 * Generate one (or a sequence of) signals, occuring in
1071 * intervals specified by the arguments.
1072 * Time is given in seconds.
1073 */
1074
1075#ifndef HAVE_SETITIMER
1076#define ITIMER_REAL     0
1077#define ITIMER_VIRTUAL  0       /* do the same as ITIMER_REAL */
1078#define ITIMER_PROF     0       /* do the same as ITIMER_REAL */
1079#endif
1080
1081static int
1082p_start_timer(value vtimer, type ttimer, value vfirst, type tfirst, value vinterv, type tinterv)
1083{
1084    int timer;
1085
1086    Check_Atom(ttimer)
1087    if (vtimer.did == d_.real0)
1088        timer = ITIMER_REAL;
1089    else if (vtimer.did == d_virtual)
1090        timer = ITIMER_VIRTUAL;
1091    else if (vtimer.did == d_profile)
1092        timer = ITIMER_PROF;
1093    else {
1094        Bip_Error(RANGE_ERROR)
1095    }
1096
1097#ifdef USE_TIMER_THREAD
1098    if (timer == ITIMER_REAL)   /* or any timer ifndef HAVE_SETITIMER */
1099    {
1100        double first, interv;
1101
1102        if (IsInteger(tfirst))
1103            first = (double) vfirst.nint;
1104        else if (IsDouble(tfirst))
1105            first = Dbl(vfirst);
1106        else if (IsRef(tfirst))
1107            { Bip_Error(INSTANTIATION_FAULT); }
1108        else
1109            { Bip_Error(TYPE_ERROR); }
1110
1111        if (IsInteger(tinterv))
1112            interv = (double) vinterv.nint;
1113        else if (IsDouble(tinterv))
1114            interv = Dbl(vinterv);
1115        else if (IsRef(tinterv))
1116            { Bip_Error(INSTANTIATION_FAULT); }
1117        else
1118            { Bip_Error(TYPE_ERROR); }
1119
1120        if (!ec_set_alarm(first, interv, _post_alarm, ec_sigalrm, 0, 0))
1121            { Bip_Error(SYS_ERROR); }
1122        Succeed_
1123    }
1124#endif
1125
1126#ifdef HAVE_SETITIMER
1127    {
1128	struct itimerval	desc;
1129
1130	if (IsInteger(tinterv))
1131	{
1132	    desc.it_interval.tv_sec = vinterv.nint;
1133	    desc.it_interval.tv_usec = 0;
1134	}
1135	else if (IsDouble(tinterv))
1136	{
1137	    double interv = Dbl(vinterv);
1138	    desc.it_interval.tv_sec = (long) interv;
1139	    desc.it_interval.tv_usec =
1140		(long) ((interv - floor(interv)) * 1000000.0);
1141	    if (desc.it_interval.tv_sec == 0
1142		    && desc.it_interval.tv_usec == 0
1143		    && interv > 0.0)
1144		desc.it_interval.tv_usec = 1;
1145	    else if (desc.it_interval.tv_usec > 999999)
1146		desc.it_interval.tv_usec = 999999;
1147	    /* the limit is taken from the solaris manual */
1148	    if (desc.it_interval.tv_sec > 100000000)
1149		desc.it_interval.tv_sec = 100000000;
1150	}
1151	else if (IsRef(tinterv))
1152	    { Bip_Error(INSTANTIATION_FAULT); }
1153	else
1154	    { Bip_Error(TYPE_ERROR); }
1155
1156	if (IsInteger(tfirst))
1157	{
1158	    desc.it_value.tv_sec = vfirst.nint;
1159	    desc.it_value.tv_usec = 0;
1160	}
1161	else if (IsDouble(tfirst))
1162	{
1163	    double first = Dbl(vfirst);
1164	    desc.it_value.tv_sec = (long) first;
1165	    desc.it_value.tv_usec =
1166		(long) ((first - floor(first)) * 1000000.0);
1167	    if (desc.it_value.tv_sec == 0
1168		    && desc.it_value.tv_usec == 0
1169		    && first > 0.0)
1170		desc.it_value.tv_usec = 1;
1171	    else if (desc.it_value.tv_usec > 999999)
1172		desc.it_value.tv_usec = 999999;
1173	    /* the limit is taken from the solaris manual */
1174	    if (desc.it_value.tv_sec > 100000000)
1175		desc.it_value.tv_sec = 100000000;
1176	}
1177	else if (IsRef(tfirst))
1178	    { Bip_Error(INSTANTIATION_FAULT); }
1179	else
1180	    { Bip_Error(TYPE_ERROR); }
1181
1182	if (setitimer(timer, &desc, (struct itimerval *) 0) < 0) {
1183	    Set_Errno;
1184	    Bip_Error(SYS_ERROR);
1185	}
1186	Succeed_
1187    }
1188
1189#else
1190    Bip_Error(UNIMPLEMENTED);
1191#endif
1192}
1193
1194static int
1195p_set_timer(value vtimer, type ttimer, value vinterv, type tinterv)
1196{
1197    return p_start_timer(vtimer, ttimer, vinterv, tinterv, vinterv, tinterv);
1198}
1199
1200static int
1201p_get_timer(value vtimer, type ttimer, value vinterv, type tinterv)
1202{
1203    int timer;
1204
1205    Check_Atom(ttimer)
1206    if (vtimer.did == d_.real0)
1207        timer = ITIMER_REAL;
1208    else if (vtimer.did == d_virtual)
1209        timer = ITIMER_VIRTUAL;
1210    else if (vtimer.did == d_profile)
1211        timer = ITIMER_PROF;
1212    else {
1213        Bip_Error(RANGE_ERROR)
1214    }
1215
1216#ifdef USE_TIMER_THREAD
1217    if (timer == ITIMER_REAL)   /* or any timer ifndef HAVE_SETITIMER */
1218    {
1219        double	remain, old_interv;
1220
1221        Check_Output_Float(tinterv)
1222        if (!ec_set_alarm(0.0, 0.0, _post_alarm, ec_sigalrm, &remain, &old_interv))
1223            { Bip_Error(SYS_ERROR); }
1224        if (!ec_set_alarm(remain, old_interv, _post_alarm, ec_sigalrm, 0, 0))
1225            { Bip_Error(SYS_ERROR); }
1226        if (old_interv == 0)
1227           { Fail_; }
1228        Return_Unify_Float(vinterv, tinterv, old_interv)
1229    }
1230#endif
1231
1232#ifdef HAVE_SETITIMER
1233    {
1234	struct itimerval	desc;
1235
1236	Check_Output_Float(tinterv)
1237	if (getitimer(timer, &desc) < 0) {
1238	    Set_Errno;
1239	    Bip_Error(SYS_ERROR);
1240	}
1241	if (desc.it_interval.tv_sec == 0 &&
1242	    desc.it_interval.tv_usec == 0) {
1243	    Fail_;
1244	}
1245	Return_Unify_Float(vinterv, tinterv,
1246		desc.it_interval.tv_sec + desc.it_interval.tv_usec/1000000.0)
1247    }
1248
1249#else
1250    Bip_Error(UNIMPLEMENTED);
1251#endif
1252}
1253
1254
1255/*
1256 * stop_timer/3 switches the timer off and gets the current state
1257 * It doesn't fail like get_timer/2
1258 */
1259
1260static int
1261p_stop_timer(value vtimer, type ttimer, value vremain, type tremain, value vinterv, type tinterv)
1262{
1263    int timer;
1264    Prepare_Requests
1265
1266    Check_Output_Float(tremain)
1267    Check_Output_Float(tinterv)
1268    Check_Atom(ttimer)
1269    if (vtimer.did == d_.real0)
1270        timer = ITIMER_REAL;
1271    else if (vtimer.did == d_virtual)
1272        timer = ITIMER_VIRTUAL;
1273    else if (vtimer.did == d_profile)
1274        timer = ITIMER_PROF;
1275    else {
1276        Bip_Error(RANGE_ERROR)
1277    }
1278
1279#ifdef USE_TIMER_THREAD
1280    if (timer == ITIMER_REAL)   /* or any timer ifndef HAVE_SETITIMER */
1281    {
1282        double	remain, old_interv;
1283        if (!ec_set_alarm(0.0, 0.0, _post_alarm, ec_sigalrm, &remain, &old_interv))
1284            { Bip_Error(SYS_ERROR); }
1285        Request_Unify_Float(vinterv, tinterv, old_interv)
1286        Request_Unify_Float(vremain, tremain, remain)
1287        Return_Unify
1288    }
1289#endif
1290
1291#ifdef HAVE_SETITIMER
1292    {
1293	struct itimerval old, new;
1294
1295	new.it_interval.tv_sec = 0;
1296	new.it_interval.tv_usec = 0;
1297	new.it_value.tv_sec = 0;
1298	new.it_value.tv_usec = 0;
1299	if (setitimer(timer, &new, &old) < 0) {
1300	    Set_Errno;
1301	    Bip_Error(SYS_ERROR);
1302	}
1303	Request_Unify_Float(vinterv, tinterv,
1304		old.it_interval.tv_sec + old.it_interval.tv_usec/1000000.0)
1305	Request_Unify_Float(vremain, tremain,
1306		old.it_value.tv_sec + old.it_value.tv_usec/1000000.0)
1307        Return_Unify
1308    }
1309
1310#else
1311    Bip_Error(UNIMPLEMENTED);
1312#endif
1313}
1314
1315
1316static int
1317p_kill(value vpid, type tpid, value vsig, type tsig)
1318{
1319    extern int ec_signalnum(value vsig, type tsig);
1320    int sig = ec_signalnum(vsig, tsig);
1321    if (sig < 0) {
1322	if (IsInteger(tsig) && vsig.nint == 0) {
1323	    sig = 0;	/* allow pseudo-signal 0 for existence testing */
1324	} else {
1325	    Bip_Error(sig);
1326	}
1327    }
1328    Check_Integer(tpid);
1329
1330#ifdef _WIN32
1331    /* Allow a few special cases: own process, and pseudo-SIGTERM */
1332    if (vpid.nint == 0 || vpid.nint == getpid()) {	/* this process */
1333	if (sig != 0  &&  raise(sig)  &&  errno == EINVAL)
1334	    { Bip_Error(RANGE_ERROR); }
1335	Succeed_;
1336
1337    } else if (sig == 0) {			/* existence check only */
1338	HANDLE phandle = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, vpid.nint);
1339	if (phandle) {
1340	    CloseHandle(phandle);
1341	    Succeed_;
1342	}
1343	Fail_;
1344
1345    } else if (sig == SIGTERM) {		 /* other process */
1346	HANDLE phandle = OpenProcess(PROCESS_TERMINATE, FALSE, vpid.nint);
1347	if (phandle && TerminateProcess(phandle, 256)) {
1348	    CloseHandle(phandle);
1349	    Succeed_;
1350	}
1351	Set_Sys_Errno(GetLastError(),ERRNO_WIN32);
1352	Bip_Error(SYS_ERROR);
1353    }
1354    Bip_Error(UNIMPLEMENTED);
1355#else
1356    if (kill((int) vpid.nint, sig) < 0)
1357    {
1358	if (sig == 0 && errno == ESRCH)
1359	{
1360	    Fail_;		/* just checking for process existence */
1361	}
1362	else
1363	{
1364	    Set_Errno;
1365	    Bip_Error(SYS_ERROR);
1366	}
1367    }
1368    Succeed_;
1369#endif
1370}
1371
1372
1373#ifdef _WIN32
1374static int
1375p_system(value v, type t)
1376{
1377    int res;
1378    char *command;
1379    Get_Name(v, t, command);
1380    res = system(command);
1381    if (res == -1)
1382    {
1383	Set_Errno;
1384	Bip_Error(SYS_ERROR);
1385    }
1386    Succeed_If(res == 0);
1387}
1388#endif
1389
1390/*ARGSUSED*/
1391static int
1392p_sys_file_flag(value fv, type ft, value nv, type nt, value vv, type vt)
1393{
1394    struct_stat		buf;
1395    char		*name;
1396    char		*str;
1397    value		val;
1398    int			acc;
1399
1400    /* CAUTION: this low-level primitive expects a file name
1401     * that is expanded to at least EXPAND_STANDARD! */
1402
1403    Get_Name(fv, ft, name);
1404    if (nv.nint <= 16) {
1405	if (ec_stat(name, &buf) == -1)
1406	{
1407	    errno = 0;
1408	    Fail_;
1409	}
1410    }
1411    switch (nv.nint)
1412    {
1413    case 0:
1414	Return_Unify_Integer(vv, vt, buf.st_mode);
1415
1416    case 1:
1417	Return_Unify_Integer(vv, vt, buf.st_ino);
1418
1419    case 2:
1420	Return_Unify_Integer(vv, vt, buf.st_nlink);
1421
1422    case 3:
1423	Return_Unify_Integer(vv, vt, buf.st_uid);
1424
1425    case 4:
1426	Return_Unify_Integer(vv, vt, buf.st_gid);
1427
1428    case 5:
1429	Return_Unify_Integer(vv, vt, buf.st_size);
1430
1431    case 6:
1432	if (buf.st_atime < 0) { Fail_; }	/* for Windows pseudo-files */
1433	Return_Unify_Integer(vv, vt, buf.st_atime);
1434
1435    case 7:
1436	if (buf.st_mtime < 0) { Fail_; }	/* for Windows pseudo-files */
1437	Return_Unify_Integer(vv, vt, buf.st_mtime);
1438
1439    case 8:
1440	if (buf.st_ctime < 0) { Fail_; }	/* for Windows pseudo-files */
1441	Return_Unify_Integer(vv, vt, buf.st_ctime);
1442
1443    case 9:
1444	Return_Unify_Integer(vv, vt, buf.st_dev);
1445
1446#ifdef HAVE_ST_BLKSIZE
1447    case 10:
1448	Return_Unify_Integer(vv, vt, buf.st_blocks);
1449
1450    case 11:
1451	Return_Unify_Integer(vv, vt, buf.st_blksize);
1452#endif
1453
1454    case 12:
1455	if (buf.st_atime < 0) { Fail_; }	/* for Windows pseudo-files */
1456	str = ctime(&buf.st_atime);
1457	Cstring_To_Prolog(str, val);
1458	Return_Unify_String(vv, vt, val.ptr);
1459
1460    case 13:
1461	if (buf.st_mtime < 0) { Fail_; }	/* for Windows pseudo-files */
1462	str = ctime(&buf.st_mtime);
1463	Cstring_To_Prolog(str, val);
1464	Return_Unify_String(vv, vt, val.ptr);
1465
1466    case 14:
1467	if (buf.st_ctime < 0) { Fail_; }	/* for Windows pseudo-files */
1468	str = ctime(&buf.st_ctime);
1469	Cstring_To_Prolog(str, val);
1470	Return_Unify_String(vv, vt, val.ptr);
1471
1472#ifndef _WIN32
1473    case 15:
1474    {
1475	struct passwd	*pwd;
1476	pwd = getpwuid(buf.st_uid);
1477	if (!pwd) {
1478	    Fail_;
1479	}
1480	endpwent();
1481	Cstring_To_Prolog(pwd->pw_name, val);
1482	Return_Unify_String(vv, vt, val.ptr);
1483    }
1484
1485    case 16:
1486    {
1487	struct group	*grp;
1488	grp = getgrgid(buf.st_gid);
1489	if (!grp) {
1490	    Fail_;
1491	}
1492	endgrent();
1493	Cstring_To_Prolog(grp->gr_name, val);
1494	Return_Unify_String(vv, vt, val.ptr);
1495    }
1496#endif
1497
1498    case 17:
1499	acc = R_OK;
1500	goto _access_;
1501
1502    case 18:
1503	acc = W_OK;
1504	goto _access_;
1505
1506    case 19:
1507	acc = X_OK;
1508_access_:
1509	if (!ec_access(name, acc)) {
1510	    Return_Unify_Atom(vv, vt, d_.on)
1511	} else {
1512	    errno = 0;
1513	    Return_Unify_Atom(vv, vt, d_.off)
1514	}
1515
1516    default:
1517	Fail_;
1518    }
1519}