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}