ml_apc.c

   1 #include <caml/fail.h>
   2 #include <caml/alloc.h>
   3 #include <caml/memory.h>
   4 #include <caml/custom.h>
   5 #include <caml/signals.h>
   6 #include <caml/mlvalues.h>
   7 #include <caml/bigarray.h>
   8
   9 #include <math.h>
  10 #include <stdio.h>
  11 #include <stdarg.h>
  12
  13 enum {
  14     LINUX_TAG,
  15     WINDOWS_TAG,
  16     SOLARIS_TAG,
  17     MACOSX_TAG
  18 };
  19
  20 #ifdef _MSC_VER
  21 #define vsnprintf _vsnprintf
  22 #endif
  23
  24 static void failwith_fmt (const char *fmt, ...) Noreturn;
  25 static void failwith_fmt (const char *fmt, ...)
  26 {
  27     va_list ap;
  28     char buf[1024];
  29
  30     va_start (ap, fmt);
  31     vsnprintf (buf, sizeof (buf), fmt, ap);
  32     va_end (ap);
  33
  34     failwith (buf);
  35 }
  36
  37 #if defined __linux__
  38 #define _GNU_SOURCE
  39 #include <alloca.h>
  40 #include <unistd.h>
  41 #include <sys/time.h>
  42 #include <sys/time.h>
  43 #include <sys/sysinfo.h>
  44 #include <signal.h>
  45 #include <string.h>
  46 #include <errno.h>
  47
  48 CAMLprim value ml_sysinfo (value unit_v)
  49 {
  50     CAMLparam1 (unit_v);
  51     CAMLlocal2 (res_v, loads_v);
  52     struct sysinfo si;
  53
  54     if (sysinfo (&si)) {
  55         failwith_fmt ("sysinfo: %s", strerror (errno));
  56     }
  57
  58     loads_v = caml_alloc_tuple (3);
  59     Store_field (loads_v, 0, caml_copy_int64 (si.loads[0]));
  60     Store_field (loads_v, 1, caml_copy_int64 (si.loads[1]));
  61     Store_field (loads_v, 2, caml_copy_int64 (si.loads[2]));
  62
  63     res_v = caml_alloc_tuple (9);
  64     Store_field (res_v, 0, caml_copy_int64 (si.uptime));
  65     Store_field (res_v, 1, loads_v);
  66     Store_field (res_v, 2, caml_copy_int64 (si.totalram));
  67     Store_field (res_v, 3, caml_copy_int64 (si.freeram));
  68     Store_field (res_v, 4, caml_copy_int64 (si.sharedram));
  69     Store_field (res_v, 5, caml_copy_int64 (si.bufferram));
  70     Store_field (res_v, 6, caml_copy_int64 (si.totalswap));
  71     Store_field (res_v, 7, caml_copy_int64 (si.freeswap));
  72     Store_field (res_v, 8, caml_copy_int64 (si.procs));
  73
  74     CAMLreturn (res_v);
  75 }
  76
  77 CAMLprim value ml_get_nprocs (value unit_v)
  78 {
  79     CAMLparam1 (unit_v);
  80     int nprocs;
  81
  82     nprocs = get_nprocs ();
  83     if (nprocs <= 0) {
  84         failwith_fmt ("get_nprocs: %s", strerror (errno));
  85     }
  86
  87     CAMLreturn (Val_int (nprocs));
  88 }
  89
  90 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
  91 {
  92     CAMLparam2 (fd_v, nprocs_v);
  93     CAMLlocal1 (res_v);
  94     struct timeval tv;
  95     int fd = Int_val (fd_v);
  96     int nprocs = Int_val (nprocs_v);
  97     size_t n = nprocs * sizeof (tv);
  98     ssize_t m;
  99     struct timeval *buf;
 100     int i;
 101
 102     buf = alloca (n);
 103     if (!buf) {
 104         failwith_fmt ("alloca: %s", strerror (errno));
 105     }
 106
 107     m = read (fd, buf, n);
 108     if (n - m) {
 109         failwith_fmt ("read [n=%zu, m=%zi]: %s", n, m, strerror (errno));
 110     }
 111
 112     res_v = caml_alloc (nprocs * Double_wosize, Double_array_tag);
 113     for (i = 0; i < nprocs; ++i) {
 114         double d;
 115
 116         d = buf[i].tv_sec + buf[i].tv_usec * 1e-6;
 117         Store_double_field (res_v, i, d);
 118     }
 119     CAMLreturn (res_v);
 120 }
 121
 122 CAMLprim value ml_os_type (value unit_v)
 123 {
 124     CAMLparam1 (unit_v);
 125     CAMLreturn (Val_int (LINUX_TAG));
 126 }
 127
 128 #elif defined _WIN32
 129
 130 #pragma warning (disable:4152 4127 4189)
 131 #define WIN32_LEAN_AND_MEAN
 132 #include <windows.h>
 133
 134 #define DDKFASTAPI __fastcall
 135 #define NTSTATUS long
 136 #define BOOLEAN int
 137
 138 /* Following (mildly modified) structure definitions, macros, enums,
 139    etc are taken from binutils w32api (http://sourceware.org/binutils/)
 140    Headers claim:
 141  */
 142 /*
 143  * ntpoapi.h
 144  * ntddk.h
 145  ...
 146  * This file is part of the w32api package.
 147  *
 148  * Contributors:
 149  *   Created by Casper S. Hornstrup <chorns@users.sourceforge.net>
 150  *
 151  * THIS SOFTWARE IS NOT COPYRIGHTED
 152  *
 153  * This source code is offered for use in the public domain. You may
 154  * use, modify or distribute it freely.
 155  *
 156  * This code is distributed in the hope that it will be useful but
 157  * WITHOUT ANY WARRANTY. ALL WARRANTIES, EXPRESS OR IMPLIED ARE HEREBY
 158  * DISCLAIMED. This includes but is not limited to warranties of
 159  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 160  *
 161  */
 162
 163 typedef struct _SYSTEM_BASIC_INFORMATION {
 164     ULONG  Unknown;
 165     ULONG  MaximumIncrement;
 166     ULONG  PhysicalPageSize;
 167     ULONG  NumberOfPhysicalPages;
 168     ULONG  LowestPhysicalPage;
 169     ULONG  HighestPhysicalPage;
 170     ULONG  AllocationGranularity;
 171     ULONG  LowestUserAddress;
 172     ULONG  HighestUserAddress;
 173     ULONG  ActiveProcessors;
 174     UCHAR  NumberProcessors;
 175 } SYSTEM_BASIC_INFORMATION, *PSYSTEM_BASIC_INFORMATION;
 176
 177 typedef struct _SYSTEM_PROCESSOR_TIMES {
 178     LARGE_INTEGER  IdleTime;
 179     LARGE_INTEGER  KernelTime;
 180     LARGE_INTEGER  UserTime;
 181     LARGE_INTEGER  DpcTime;
 182     LARGE_INTEGER  InterruptTime;
 183     ULONG  InterruptCount;
 184 } SYSTEM_PROCESSOR_TIMES, *PSYSTEM_PROCESSOR_TIMES;
 185
 186 typedef long (__stdcall *QuerySystemInformationProc)
 187     (SYSTEM_INFORMATION_CLASS, PVOID, ULONG, PULONG);
 188
 189 static struct {
 190     HMODULE hmod;
 191     QuerySystemInformationProc QuerySystemInformation;
 192     ULONG nprocs;
 193     double prevtime;
 194     struct {
 195         double clocks;
 196         double unhalted;
 197         double total;
 198     } prev[64];
 199 } glob;
 200
 201 static double gettime (void)
 202 {
 203     FILETIME ft;
 204     uint64 tmp;
 205
 206     GetSystemTimeAsFileTime (&ft);
 207     tmp = ft.dwHighDateTime;
 208     tmp <<= 32;
 209     tmp |= ft.dwLowDateTime;
 210     return tmp * 1e-7;
 211 }
 212
 213 static void init (void)
 214 {
 215     if (!glob.hmod) {
 216         glob.hmod = LoadLibrary ("ntdll.dll");
 217         if (!glob.hmod) {
 218             failwith_fmt ("could not load ntdll.dll: %#lx", GetLastError ());
 219         }
 220
 221         *(void **) &glob.QuerySystemInformation =
 222             GetProcAddress (glob.hmod, "ZwQuerySystemInformation");
 223         if (!glob.QuerySystemInformation) {
 224             failwith_fmt (
 225                 "could not obtain ZwQuerySystemInformation entry point: %#lx",
 226                 GetLastError ());
 227         }
 228         glob.prevtime = gettime ();
 229     }
 230 }
 231
 232 static void qsi (int c, PVOID buf, ULONG size)
 233 {
 234     ULONG retsize = 0;
 235     long status;
 236
 237     init ();
 238     status = glob.QuerySystemInformation (c, buf, size, &retsize);
 239     if (status < 0) {
 240         failwith_fmt ("could not query system information %ld retsize %ld",
 241                       c, retsize);
 242     }
 243     if (retsize != size) {
 244         fprintf (stderr, "class=%d status=%ld size=%d retsize=%d\n",
 245                  c, status, size, retsize);
 246     }
 247 #ifdef DEBUG
 248     printf ("class=%d status=%ld size=%d retsize=%d\n",
 249             c, status, size, retsize);
 250 #endif
 251 }
 252
 253 CAMLprim value ml_waitalrm (value unit_v)
 254 {
 255     CAMLparam1 (unit_v);
 256
 257     failwith ("waitalrm not supported on Windows");
 258     CAMLreturn (Val_unit);
 259 }
 260
 261 static void pmc (int nproc, double *clocksp, double *unhaltedp)
 262 {
 263     unsigned int h1, l1, h2, l2, p;
 264     uint64 tmp;
 265     DWORD prevmask;
 266
 267     prevmask = SetThreadAffinityMask (GetCurrentThread (), 1 << nproc);
 268     if (!prevmask) {
 269         failwith_fmt ("SetThreadAffinityMask failed: %ld\n", GetLastError ());
 270     }
 271
 272 #ifndef _MSC_VER
 273 #error Not yet written
 274 #endif
 275
 276     _asm {
 277         pushad;
 278         mov eax, 1;
 279         cpuid;
 280         mov p, ebx;
 281         rdtsc;
 282         mov l1, eax;
 283         mov h1, edx;
 284         xor ecx, ecx;
 285         rdpmc;
 286         mov l2, eax;
 287         mov h2, edx;
 288         popad;
 289     }
 290
 291     tmp = h1;
 292     tmp <<= 32;
 293     tmp |= l1;
 294     *clocksp = tmp;
 295
 296     tmp = h2;
 297     tmp <<= 32;
 298     tmp |= l2;
 299     *unhaltedp = tmp;
 300     /* printf ("[%d] = %f %f %x\n", p >> 24, *clocksp, *unhaltedp, prevmask); */
 301 }
 302
 303 static void get_nprocs (void)
 304 {
 305     SYSTEM_BASIC_INFORMATION sbi;
 306
 307     qsi (0, &sbi, sizeof (sbi));
 308     glob.nprocs = sbi.NumberProcessors;
 309     if (glob.nprocs > 64) {
 310         failwith_fmt ("Hmm... the future is now, but i'm not ready %d",
 311                       glob.nprocs);
 312     }
 313 }
 314
 315 CAMLprim value ml_get_nprocs (value unit_v)
 316 {
 317     CAMLparam1 (unit_v);
 318
 319     get_nprocs ();
 320     CAMLreturn (Val_int (glob.nprocs));
 321 }
 322
 323 CAMLprim value ml_windows_processor_times (value nprocs_v)
 324 {
 325     CAMLparam1 (nprocs_v);
 326     CAMLlocal1 (res_v);
 327     int nprocs = Int_val (nprocs_v);
 328     PSYSTEM_PROCESSOR_TIMES buf, b;
 329     size_t n = nprocs * sizeof (*buf);
 330     int i, j;
 331
 332     buf = _alloca (n);
 333     if (!buf) {
 334         failwith_fmt ("alloca: %s", strerror (errno));
 335     }
 336
 337     qsi (8, buf, n);
 338
 339     res_v = caml_alloc (nprocs * 5 * Double_wosize, Double_array_tag);
 340     b = buf;
 341     for (i = 0, j = 0; i < nprocs; ++i, ++b) {
 342         double d = b->IdleTime.QuadPart * 1e-7;
 343
 344         Store_double_field (res_v, j, d); j += 1;
 345
 346         d = b->KernelTime.QuadPart * 1e-7 - d;
 347         Store_double_field (res_v, j, d); j += 1;
 348
 349         Store_double_field (res_v, j, b->UserTime.QuadPart * 1e-7); j += 1;
 350         Store_double_field (res_v, j, b->DpcTime.QuadPart * 1e-7); j += 1;
 351         Store_double_field (res_v, j, b->InterruptTime.QuadPart * 1e-7); j += 1;
 352     }
 353     CAMLreturn (res_v);
 354 }
 355
 356 CAMLprim value ml_get_hz (value unit_v)
 357 {
 358     CAMLparam1 (unit_v);
 359     CAMLreturn (Val_int (100));
 360 }
 361
 362 CAMLprim value ml_nice (value nice_v)
 363 {
 364     CAMLparam1 (nice_v);
 365     int niceval = Int_val (nice_v);
 366
 367     failwith_fmt ("nice: not implemented on Windows");
 368     CAMLreturn (Val_unit);
 369 }
 370
 371 CAMLprim value ml_seticon (value data_v)
 372 {
 373     CAMLparam1 (data_v);
 374     CAMLreturn (Val_unit);
 375 }
 376
 377 CAMLprim value ml_delay (value secs_v)
 378 {
 379     CAMLparam1 (secs_v);
 380     DWORD millis = (DWORD) (Double_val (secs_v) * 1e4);
 381
 382     caml_enter_blocking_section ();
 383     {
 384         Sleep (millis);
 385     }
 386     caml_leave_blocking_section ();
 387     CAMLreturn (Val_unit);
 388 }
 389
 390 CAMLprim value ml_os_type (value unit_v)
 391 {
 392     CAMLparam1 (unit_v);
 393     OSVERSIONINFO ovi;
 394
 395     ovi.dwOSVersionInfoSize = sizeof (ovi);
 396     if (!GetVersionEx (&ovi)) {
 397         failwith_fmt ("Could not get version information: %#lx",
 398                       GetLastError ());
 399     }
 400
 401     if (ovi.dwPlatformId != VER_PLATFORM_WIN32_NT) {
 402         caml_failwith ("Only NT family of Windows is supported by APC");
 403     }
 404
 405     CAMLreturn (Val_int (WINDOWS_TAG));
 406 }
 407
 408 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
 409 {
 410     CAMLparam2 (fd_v, nprocs_v);
 411     CAMLlocal1 (res_v);
 412     double now, delta;
 413     int i;
 414
 415     now = gettime ();
 416     delta = now - glob.prevtime;
 417     glob.prevtime = now;
 418
 419     res_v = caml_alloc (glob.nprocs * Double_wosize, Double_array_tag);
 420     for (i = 0; i < glob.nprocs; ++i) {
 421         double d;
 422         double clocks, unhalted;
 423         double dc, du;
 424
 425         pmc (i, &clocks, &unhalted);
 426         dc = clocks - glob.prev[i].clocks;
 427         du = unhalted - glob.prev[i].unhalted;
 428         d = delta * (1.0 - du / dc);
 429         glob.prev[i].clocks = clocks;
 430         glob.prev[i].unhalted = unhalted;
 431         glob.prev[i].total += d;
 432         Store_double_field (res_v, i, glob.prev[i].total);
 433     }
 434     CAMLreturn (res_v);
 435 }
 436 #elif defined __sun__
 437 #define _POSIX_PTHREAD_SEMANTICS
 438 #include <alloca.h>
 439 #include <unistd.h>
 440 #include <sys/time.h>
 441 #include <sys/time.h>
 442 #include <sys/sysinfo.h>
 443 #include <kstat.h>
 444 #include <sys/stat.h>
 445 #include <signal.h>
 446 #include <string.h>
 447 #include <errno.h>
 448
 449 static long get_nprocs (void)
 450 {
 451     long nprocs = sysconf (_SC_NPROCESSORS_CONF);
 452     if (nprocs <= 0) {
 453         failwith_fmt ("sysconf (_SC_NPROCESSORS_CONF) = %ld: %s",
 454                       nprocs, strerror (errno));
 455     }
 456     return nprocs;
 457 }
 458
 459 CAMLprim value ml_get_nprocs (value unit_v)
 460 {
 461     CAMLparam1 (unit_v);
 462     CAMLreturn (Val_int (get_nprocs ()));
 463 }
 464
 465 CAMLprim value ml_solaris_kstat (value nprocs_v)
 466 {
 467     /* Based on lib/cpustat.cc from sinfo package by Juergen Rinas */
 468     CAMLparam1 (nprocs_v);
 469     CAMLlocal1 (res_v);
 470     int i = 0, j = 0;
 471     int nprocs = Int_val (nprocs_v);
 472     struct kstat_ctl *kc;
 473     kstat_t *ksp;
 474
 475     kc = kstat_open ();
 476     if (!kc) {
 477         failwith_fmt ("kstat_open failed: %s", strerror (errno));
 478     }
 479
 480     res_v = caml_alloc (nprocs * 4 * Double_wosize, Double_array_tag);
 481     for (ksp = kc->kc_chain; ksp; ksp = ksp->ks_next) {
 482         if (!strncmp (ksp->ks_name, "cpu_stat", 8)) {
 483             cpu_stat_t cstat;
 484
 485             i += 1;
 486             if (i > nprocs) {
 487                 failwith_fmt ("number of processors changed?");
 488             }
 489
 490             if (kstat_read (kc, ksp, 0) == -1) {
 491                 failwith_fmt ("kstat_read (update) failed: %s", strerror (errno));
 492             }
 493
 494             if (kstat_read (kc, ksp, &cstat) == -1) {
 495                 failwith_fmt ("kstat_read (read) failed: %s", strerror (errno));
 496             }
 497
 498             Store_double_field (res_v, j, cstat.cpu_sysinfo.cpu[0]); j += 1;
 499             Store_double_field (res_v, j, cstat.cpu_sysinfo.cpu[1]); j += 1;
 500             Store_double_field (res_v, j, cstat.cpu_sysinfo.cpu[2]); j += 1;
 501             Store_double_field (res_v, j, cstat.cpu_sysinfo.cpu[3]); j += 1;
 502         }
 503     }
 504
 505     kstat_close (kc);
 506     CAMLreturn (res_v);
 507 }
 508
 509 CAMLprim value ml_os_type (value unit_v)
 510 {
 511     CAMLparam1 (unit_v);
 512     CAMLreturn (Val_int (SOLARIS_TAG));
 513 }
 514 #elif defined __APPLE__
 515 #include <mach/mach.h>
 516 #include <sys/sysctl.h>
 517 #include <unistd.h>
 518 #include <errno.h>
 519 #include <string.h>
 520
 521 CAMLprim value ml_seticon (value data_v)
 522 {
 523     CAMLparam1 (data_v);
 524     CAMLreturn (Val_unit);
 525 }
 526
 527 static long get_nprocs (void)
 528 {
 529     int n, err;
 530     size_t size;
 531     int mib[] = { CTL_HW, HW_NCPU };
 532
 533     size = sizeof (int);
 534     err = sysctl (mib, 2, &n, &size, NULL, 0);
 535     if (err < 0) {
 536         failwith_fmt ("sysctl (HW_NCPU) failed: %s", strerror (errno));
 537     }
 538     return n;
 539 }
 540
 541 CAMLprim value ml_get_nprocs (value unit_v)
 542 {
 543     CAMLparam1 (unit_v);
 544     CAMLreturn (Val_int (get_nprocs ()));
 545 }
 546
 547 CAMLprim value ml_macosx_host_processor_info (value nprocs_v)
 548 {
 549     CAMLparam1 (nprocs_v);
 550     CAMLlocal1 (res_v);
 551     int i, j = 0;
 552     int nprocs = Int_val (nprocs_v);
 553     unsigned int nprocs1;
 554     kern_return_t kr;
 555     processor_cpu_load_info_t cpu_load, c;
 556     mach_msg_type_number_t cpu_msg_count;
 557
 558     kr = host_processor_info (mach_host_self (), PROCESSOR_CPU_LOAD_INFO,
 559                               &nprocs1,
 560                               (processor_info_array_t *) &cpu_load,
 561                               &cpu_msg_count);
 562     if (kr != KERN_SUCCESS) {
 563         failwith_fmt ("host_processor_info failed: %s",
 564                       mach_error_string (kr));
 565     }
 566
 567     if (nprocs1 != nprocs){
 568         failwith_fmt ("host_processor_info claims CPUs=%d expected %d",
 569                       nprocs1, nprocs);
 570     }
 571
 572     res_v = caml_alloc (nprocs * 4 * Double_wosize, Double_array_tag);
 573     c = cpu_load;
 574     for (i = 0; i < nprocs; ++i, ++c) {
 575         Store_double_field (res_v, j, c->cpu_ticks[CPU_STATE_IDLE]); j += 1;
 576         Store_double_field (res_v, j, c->cpu_ticks[CPU_STATE_USER]); j += 1;
 577         Store_double_field (res_v, j, c->cpu_ticks[CPU_STATE_SYSTEM]); j += 1;
 578         Store_double_field (res_v, j, c->cpu_ticks[CPU_STATE_NICE]); j += 1;
 579     }
 580
 581     kr = vm_deallocate (mach_task_self (), (vm_address_t) cpu_load,
 582                         cpu_msg_count * sizeof (*cpu_load));
 583     if (kr != KERN_SUCCESS) {
 584         failwith_fmt ("vm_deallocate failed: %s", mach_error_string (kr));
 585     }
 586     CAMLreturn (res_v);
 587 }
 588
 589 CAMLprim value ml_os_type (value unit_v)
 590 {
 591     CAMLparam1 (unit_v);
 592     CAMLreturn (Val_int (MACOSX_TAG));
 593 }
 594 #else
 595 #error This operating system is not supported
 596 #endif
 597
 598 #if defined __linux__ || defined __sun__
 599 #include <X11/X.h>
 600 #include <X11/Xmd.h>
 601 #include <X11/Xlib.h>
 602 #include <X11/Xatom.h>
 603
 604 #include <GL/glx.h>
 605
 606 struct X11State {
 607     Display *dpy;
 608     Window id;
 609     Atom property;
 610     int error;
 611 };
 612
 613 CAMLprim value ml_seticon (value data_v)
 614 {
 615     CAMLparam1 (data_v);
 616     static struct X11State static_state;
 617     struct X11State *s = &static_state;
 618     void *ptr = String_val (data_v);
 619     CARD32 *p = ptr;
 620     unsigned char *data = ptr;
 621
 622     if (!s->error) {
 623         if (!s->dpy) {
 624             s->dpy = XOpenDisplay (NULL);
 625             if (!s->dpy) {
 626                 goto err0;
 627             }
 628             else {
 629                 /* "tiny bit" hackish */
 630                 s->id = glXGetCurrentDrawable ();
 631                 if (s->id == None) {
 632                     goto err1;
 633                 }
 634
 635                 s->property = XInternAtom (s->dpy, "_NET_WM_ICON", False);
 636                 if (s->property == None){
 637                     goto err1;
 638                 }
 639
 640 #ifdef DEBUG
 641                 printf ("id = %#x, property = %d\n",
 642                         (int) s->id, (int) s->property);
 643 #endif
 644             }
 645         }
 646     }
 647     else {
 648         CAMLreturn (Val_unit);
 649     }
 650
 651     p[0] = 32;
 652     p[1] = 32;
 653     XChangeProperty (s->dpy, s->id, s->property, XA_CARDINAL,
 654                      32, PropModeReplace, data, 32 * 32 + 2);
 655
 656     CAMLreturn (Val_unit);
 657
 658  err1:
 659     XCloseDisplay (s->dpy);
 660  err0:
 661     s->error = 1;
 662     CAMLreturn (Val_unit);
 663 }
 664 #endif
 665
 666 #ifndef _WIN32
 667 CAMLprim value ml_waitalrm (value unit_v)
 668 {
 669     CAMLparam1 (unit_v);
 670     sigset_t set;
 671     int signr, ret, errno_code;
 672
 673     sigemptyset (&set);
 674     sigaddset (&set, SIGALRM);
 675
 676     caml_enter_blocking_section ();
 677     {
 678         ret = sigwait (&set, &signr);
 679         errno_code = errno;
 680     }
 681     caml_leave_blocking_section ();
 682
 683     if (ret) {
 684         failwith_fmt ("sigwait: %s", strerror (errno_code));
 685     }
 686     CAMLreturn (Val_unit);
 687 }
 688
 689 CAMLprim value ml_get_hz (value unit_v)
 690 {
 691     CAMLparam1 (unit_v);
 692     long clk_tck;
 693
 694     clk_tck = sysconf (_SC_CLK_TCK);
 695     if (clk_tck <= 0) {
 696         failwith_fmt ("sysconf (SC_CLK_TCK): %s", strerror (errno));
 697     }
 698     CAMLreturn (Val_int (clk_tck));
 699 }
 700
 701 CAMLprim value ml_delay (value secs_v)
 702 {
 703     CAMLparam1 (secs_v);
 704     failwith ("delay is not implemented on non-Windows");
 705     CAMLreturn (Val_unit);
 706 }
 707
 708 CAMLprim value ml_nice (value nice_v)
 709 {
 710     CAMLparam1 (nice_v);
 711     int niceval = Int_val (nice_v);
 712
 713 #ifdef __linux__
 714     errno = 0;
 715 #endif
 716     if (nice (niceval) < 0) {
 717 #ifdef __linux__
 718         if (errno)
 719 #endif
 720             failwith_fmt ("nice %d: %s", niceval, strerror (errno));
 721     }
 722
 723     CAMLreturn (Val_unit);
 724 }
 725 #endif
 726
 727 #ifndef _WIN32
 728 CAMLprim value ml_windows_processor_times (value nprocs_v)
 729 {
 730     CAMLparam1 (nprocs_v);
 731     failwith ("ml_windows_processor_times is not implemented on non-Windows");
 732     CAMLreturn (Val_unit);
 733 }
 734 #endif
 735
 736 #ifndef __sun__
 737 CAMLprim value ml_solaris_kstat (value nprocs_v)
 738 {
 739     CAMLparam1 (nprocs_v);
 740     failwith ("ml_solaris_kstat is not implemented on non-Solaris");
 741     CAMLreturn (Val_unit);
 742 }
 743 #endif
 744
 745 #ifndef __APPLE__
 746 CAMLprim value ml_macosx_host_processor_info (value nprocs_v)
 747 {
 748     CAMLparam1 (nprocs_v);
 749     failwith ("ml_macosx_host_processor_info is not implemented on non-MacOSX");
 750     CAMLreturn (Val_unit);
 751 }
 752 #endif
 753
 754 #ifndef __linux__
 755 CAMLprim value ml_sysinfo (value unit_v)
 756 {
 757     CAMLparam1 (unit_v);
 758     CAMLlocal2 (res_v, loads_v);
 759     long nprocs;
 760
 761 #ifdef _WIN32
 762     nprocs = glob.nprocs;
 763 #else
 764     nprocs = get_nprocs ();
 765 #endif
 766
 767     loads_v = caml_alloc_tuple (3);
 768     Store_field (loads_v, 0, caml_copy_int64 (0));
 769     Store_field (loads_v, 1, caml_copy_int64 (0));
 770     Store_field (loads_v, 2, caml_copy_int64 (0));
 771
 772     res_v = caml_alloc_tuple (9);
 773     Store_field (res_v, 0, 0);
 774     Store_field (res_v, 1, loads_v);
 775     Store_field (res_v, 2, 0);
 776     Store_field (res_v, 3, 0);
 777     Store_field (res_v, 4, 0);
 778     Store_field (res_v, 5, 0);
 779     Store_field (res_v, 6, 0);
 780     Store_field (res_v, 7, 0);
 781     Store_field (res_v, 8, nprocs);
 782
 783     CAMLreturn (res_v);
 784 }
 785
 786 #ifndef _WIN32
 787 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
 788 {
 789     CAMLparam2 (fd_v, nprocs_v);
 790     failwith_fmt ("idletimeofday is not implemented on non-Linux/Win32");
 791     CAMLreturn (Val_unit);
 792 }
 793 #endif
 794 #endif
 795
 796 CAMLprim value ml_fixwindow (value window_v)
 797 {
 798     CAMLparam1 (window_v);
 799     CAMLreturn (Val_unit);
 800 }
 801
 802 CAMLprim value ml_testpmc (value unit_v)
 803 {
 804     CAMLparam1 (unit_v);
 805     int pmcok = 1;
 806
 807 #ifdef _WIN32
 808
 809     /* Shrug */
 810 #if 0
 811     __try {
 812         _asm {
 813             pushad;
 814             rdpmc;
 815             popad;
 816         }
 817     }
 818     __except () {
 819         pmcok = 0;
 820         MessageBox (NULL,
 821                     "Requested PMC based sampling is not available",
 822                     "Warning",
 823                     MB_OK | MB_ICONWARNING);
 824     }
 825 #else
 826     int response = MessageBox (
 827         NULL,
 828         "Requested PMC based sampling might cause the application to crash.\n"
 829         "Continue trying to use PMC?",
 830         "Warning",
 831         MB_YESNO | MB_ICONWARNING);
 832     pmcok = response == IDYES;
 833 #endif
 834
 835 #endif
 836
 837     CAMLreturn (Val_bool (pmcok));
 838 }