Fix self name and build hog too
[apc.git] / ml_apc.c
blob933bba33b7dc3a27c40e17c9a6d828d7b87ff35e
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>
9 #include <math.h>
10 #include <stdio.h>
11 #include <stdarg.h>
13 enum {
14 LINUX_TAG,
15 WINDOWS_TAG,
16 SOLARIS_TAG,
17 MACOSX_TAG
20 #ifdef _MSC_VER
21 #define vsnprintf _vsnprintf
22 #endif
24 static void failwith_fmt (const char *fmt, ...) Noreturn;
25 static void failwith_fmt (const char *fmt, ...)
27 va_list ap;
28 char buf[1024];
30 va_start (ap, fmt);
31 vsnprintf (buf, sizeof (buf), fmt, ap);
32 va_end (ap);
34 failwith (buf);
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>
48 CAMLprim value ml_sysinfo (value unit_v)
50 CAMLparam1 (unit_v);
51 CAMLlocal2 (res_v, loads_v);
52 struct sysinfo si;
54 if (sysinfo (&si)) {
55 failwith_fmt ("sysinfo: %s", strerror (errno));
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]));
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));
74 CAMLreturn (res_v);
77 CAMLprim value ml_get_nprocs (value unit_v)
79 CAMLparam1 (unit_v);
80 int nprocs;
82 nprocs = get_nprocs ();
83 if (nprocs <= 0) {
84 failwith_fmt ("get_nprocs: %s", strerror (errno));
87 CAMLreturn (Val_int (nprocs));
90 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
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;
102 buf = alloca (n);
103 if (!buf) {
104 failwith_fmt ("alloca failed");
107 m = read (fd, buf, n);
108 if (n - m) {
109 failwith_fmt ("read [n=%zu, m=%zi]: %s", n, m, strerror (errno));
112 res_v = caml_alloc (nprocs * Double_wosize, Double_array_tag);
113 for (i = 0; i < nprocs; ++i) {
114 double d;
116 d = buf[i].tv_sec + buf[i].tv_usec * 1e-6;
117 Store_double_field (res_v, i, d);
119 CAMLreturn (res_v);
122 CAMLprim value ml_os_type (value unit_v)
124 CAMLparam1 (unit_v);
125 CAMLreturn (Val_int (LINUX_TAG));
128 #elif defined _WIN32
130 #pragma warning (disable:4152 4127 4189)
131 #define WIN32_LEAN_AND_MEAN
132 #include <windows.h>
134 #define DDKFASTAPI __fastcall
135 #define NTSTATUS long
136 #define BOOLEAN int
138 /* Following (mildly modified) structure definitions, macros, enums,
139 etc are taken from binutils w32api (http://sourceware.org/binutils/)
140 Headers claim:
143 * ntpoapi.h
144 * ntddk.h
146 * This file is part of the w32api package.
148 * Contributors:
149 * Created by Casper S. Hornstrup <chorns@users.sourceforge.net>
151 * THIS SOFTWARE IS NOT COPYRIGHTED
153 * This source code is offered for use in the public domain. You may
154 * use, modify or distribute it freely.
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.
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;
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;
186 typedef long (__stdcall *QuerySystemInformationProc)
187 (SYSTEM_INFORMATION_CLASS, PVOID, ULONG, PULONG);
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;
201 static double gettime (void)
203 FILETIME ft;
204 uint64 tmp;
206 GetSystemTimeAsFileTime (&ft);
207 tmp = ft.dwHighDateTime;
208 tmp <<= 32;
209 tmp |= ft.dwLowDateTime;
210 return tmp * 1e-7;
213 static void init (void)
215 if (!glob.hmod) {
216 glob.hmod = LoadLibrary ("ntdll.dll");
217 if (!glob.hmod) {
218 failwith_fmt ("could not load ntdll.dll: %#lx", GetLastError ());
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 ());
228 glob.prevtime = gettime ();
232 static void qsi (int c, PVOID buf, ULONG size)
234 ULONG retsize = 0;
235 long status;
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);
243 if (retsize != size) {
244 fprintf (stderr, "class=%d status=%ld size=%d retsize=%d\n",
245 c, status, size, retsize);
247 #ifdef DEBUG
248 printf ("class=%d status=%ld size=%d retsize=%d\n",
249 c, status, size, retsize);
250 #endif
253 CAMLprim value ml_waitalrm (value unit_v)
255 CAMLparam1 (unit_v);
257 failwith ("waitalrm not supported on Windows");
258 CAMLreturn (Val_unit);
261 static void pmc (int nproc, double *clocksp, double *unhaltedp)
263 unsigned int h1, l1, h2, l2, p;
264 uint64 tmp;
265 DWORD prevmask;
267 prevmask = SetThreadAffinityMask (GetCurrentThread (), 1 << nproc);
268 if (!prevmask) {
269 failwith_fmt ("SetThreadAffinityMask failed: %ld\n", GetLastError ());
272 #ifndef _MSC_VER
273 #error Not yet written
274 #endif
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;
291 tmp = h1;
292 tmp <<= 32;
293 tmp |= l1;
294 *clocksp = tmp;
296 tmp = h2;
297 tmp <<= 32;
298 tmp |= l2;
299 *unhaltedp = tmp;
300 /* printf ("[%d] = %f %f %x\n", p >> 24, *clocksp, *unhaltedp, prevmask); */
303 static void get_nprocs (void)
305 SYSTEM_BASIC_INFORMATION sbi;
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);
315 CAMLprim value ml_get_nprocs (value unit_v)
317 CAMLparam1 (unit_v);
319 get_nprocs ();
320 CAMLreturn (Val_int (glob.nprocs));
323 CAMLprim value ml_windows_processor_times (value nprocs_v)
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;
332 buf = _alloca (n);
333 if (!buf) {
334 failwith_fmt ("alloca: %s", strerror (errno));
337 qsi (8, buf, n);
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;
344 Store_double_field (res_v, j, d); j += 1;
346 d = b->KernelTime.QuadPart * 1e-7 - d;
347 Store_double_field (res_v, j, d); j += 1;
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;
353 CAMLreturn (res_v);
356 CAMLprim value ml_get_hz (value unit_v)
358 CAMLparam1 (unit_v);
359 CAMLreturn (Val_int (100));
362 CAMLprim value ml_nice (value nice_v)
364 CAMLparam1 (nice_v);
365 int niceval = Int_val (nice_v);
367 failwith_fmt ("nice: not implemented on Windows");
368 CAMLreturn (Val_unit);
371 CAMLprim value ml_seticon (value data_v)
373 CAMLparam1 (data_v);
374 CAMLreturn (Val_unit);
377 CAMLprim value ml_delay (value secs_v)
379 CAMLparam1 (secs_v);
380 DWORD millis = (DWORD) (Double_val (secs_v) * 1e4);
382 caml_enter_blocking_section ();
384 Sleep (millis);
386 caml_leave_blocking_section ();
387 CAMLreturn (Val_unit);
390 CAMLprim value ml_os_type (value unit_v)
392 CAMLparam1 (unit_v);
393 OSVERSIONINFO ovi;
395 ovi.dwOSVersionInfoSize = sizeof (ovi);
396 if (!GetVersionEx (&ovi)) {
397 failwith_fmt ("Could not get version information: %#lx",
398 GetLastError ());
401 if (ovi.dwPlatformId != VER_PLATFORM_WIN32_NT) {
402 caml_failwith ("Only NT family of Windows is supported by APC");
405 CAMLreturn (Val_int (WINDOWS_TAG));
408 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
410 CAMLparam2 (fd_v, nprocs_v);
411 CAMLlocal1 (res_v);
412 double now, delta;
413 int i;
415 now = gettime ();
416 delta = now - glob.prevtime;
417 glob.prevtime = now;
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;
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);
434 CAMLreturn (res_v);
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>
449 static long get_nprocs (void)
451 long nprocs = sysconf (_SC_NPROCESSORS_CONF);
452 if (nprocs <= 0) {
453 failwith_fmt ("sysconf (_SC_NPROCESSORS_CONF) = %ld: %s",
454 nprocs, strerror (errno));
456 return nprocs;
459 CAMLprim value ml_get_nprocs (value unit_v)
461 CAMLparam1 (unit_v);
462 CAMLreturn (Val_int (get_nprocs ()));
465 CAMLprim value ml_solaris_kstat (value nprocs_v)
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;
475 kc = kstat_open ();
476 if (!kc) {
477 failwith_fmt ("kstat_open failed: %s", strerror (errno));
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;
485 i += 1;
486 if (i > nprocs) {
487 failwith_fmt ("number of processors changed?");
490 if (kstat_read (kc, ksp, 0) == -1) {
491 failwith_fmt ("kstat_read (update) failed: %s", strerror (errno));
494 if (kstat_read (kc, ksp, &cstat) == -1) {
495 failwith_fmt ("kstat_read (read) failed: %s", strerror (errno));
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;
505 kstat_close (kc);
506 CAMLreturn (res_v);
509 CAMLprim value ml_os_type (value unit_v)
511 CAMLparam1 (unit_v);
512 CAMLreturn (Val_int (SOLARIS_TAG));
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>
521 CAMLprim value ml_seticon (value data_v)
523 CAMLparam1 (data_v);
524 CAMLreturn (Val_unit);
527 static long get_nprocs (void)
529 int n, err;
530 size_t size;
531 int mib[] = { CTL_HW, HW_NCPU };
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));
538 return n;
541 CAMLprim value ml_get_nprocs (value unit_v)
543 CAMLparam1 (unit_v);
544 CAMLreturn (Val_int (get_nprocs ()));
547 CAMLprim value ml_macosx_host_processor_info (value nprocs_v)
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;
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));
567 if (nprocs1 != nprocs){
568 failwith_fmt ("host_processor_info claims CPUs=%d expected %d",
569 nprocs1, nprocs);
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;
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));
586 CAMLreturn (res_v);
589 CAMLprim value ml_os_type (value unit_v)
591 CAMLparam1 (unit_v);
592 CAMLreturn (Val_int (MACOSX_TAG));
594 #else
595 #error This operating system is not supported
596 #endif
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>
604 #include <GL/glx.h>
606 struct X11State {
607 Display *dpy;
608 Window id;
609 Atom property;
610 int error;
613 CAMLprim value ml_seticon (value data_v)
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;
622 if (!s->error) {
623 if (!s->dpy) {
624 s->dpy = XOpenDisplay (NULL);
625 if (!s->dpy) {
626 goto err0;
628 else {
629 /* "tiny bit" hackish */
630 s->id = glXGetCurrentDrawable ();
631 if (s->id == None) {
632 goto err1;
635 s->property = XInternAtom (s->dpy, "_NET_WM_ICON", False);
636 if (s->property == None){
637 goto err1;
640 #ifdef DEBUG
641 printf ("id = %#x, property = %d\n",
642 (int) s->id, (int) s->property);
643 #endif
647 else {
648 CAMLreturn (Val_unit);
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);
656 CAMLreturn (Val_unit);
658 err1:
659 XCloseDisplay (s->dpy);
660 err0:
661 s->error = 1;
662 CAMLreturn (Val_unit);
664 #endif
666 #ifndef _WIN32
667 CAMLprim value ml_waitalrm (value unit_v)
669 CAMLparam1 (unit_v);
670 sigset_t set;
671 int signr, ret, errno_code;
673 sigemptyset (&set);
674 sigaddset (&set, SIGALRM);
676 caml_enter_blocking_section ();
678 ret = sigwait (&set, &signr);
679 errno_code = errno;
681 caml_leave_blocking_section ();
683 if (ret) {
684 failwith_fmt ("sigwait: %s", strerror (errno_code));
686 CAMLreturn (Val_unit);
689 CAMLprim value ml_get_hz (value unit_v)
691 CAMLparam1 (unit_v);
692 long clk_tck;
694 clk_tck = sysconf (_SC_CLK_TCK);
695 if (clk_tck <= 0) {
696 failwith_fmt ("sysconf (SC_CLK_TCK): %s", strerror (errno));
698 CAMLreturn (Val_int (clk_tck));
701 CAMLprim value ml_delay (value secs_v)
703 CAMLparam1 (secs_v);
704 failwith ("delay is not implemented on non-Windows");
705 CAMLreturn (Val_unit);
708 CAMLprim value ml_nice (value nice_v)
710 CAMLparam1 (nice_v);
711 int niceval = Int_val (nice_v);
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));
723 CAMLreturn (Val_unit);
725 #endif
727 #ifndef _WIN32
728 CAMLprim value ml_windows_processor_times (value nprocs_v)
730 CAMLparam1 (nprocs_v);
731 failwith ("ml_windows_processor_times is not implemented on non-Windows");
732 CAMLreturn (Val_unit);
734 #endif
736 #ifndef __sun__
737 CAMLprim value ml_solaris_kstat (value nprocs_v)
739 CAMLparam1 (nprocs_v);
740 failwith ("ml_solaris_kstat is not implemented on non-Solaris");
741 CAMLreturn (Val_unit);
743 #endif
745 #ifndef __APPLE__
746 CAMLprim value ml_macosx_host_processor_info (value nprocs_v)
748 CAMLparam1 (nprocs_v);
749 failwith ("ml_macosx_host_processor_info is not implemented on non-MacOSX");
750 CAMLreturn (Val_unit);
752 #endif
754 #ifndef __linux__
755 CAMLprim value ml_sysinfo (value unit_v)
757 CAMLparam1 (unit_v);
758 CAMLlocal2 (res_v, loads_v);
759 long nprocs;
761 #ifdef _WIN32
762 nprocs = glob.nprocs;
763 #else
764 nprocs = get_nprocs ();
765 #endif
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));
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);
783 CAMLreturn (res_v);
786 #ifndef _WIN32
787 CAMLprim value ml_idletimeofday (value fd_v, value nprocs_v)
789 CAMLparam2 (fd_v, nprocs_v);
790 failwith_fmt ("idletimeofday is not implemented on non-Linux/Win32");
791 CAMLreturn (Val_unit);
793 #endif
794 #endif
796 CAMLprim value ml_fixwindow (value window_v)
798 CAMLparam1 (window_v);
799 CAMLreturn (Val_unit);
802 CAMLprim value ml_testpmc (value unit_v)
804 CAMLparam1 (unit_v);
805 int pmcok = 1;
807 #ifdef _WIN32
809 /* Shrug */
810 #if 0
811 __try {
812 _asm {
813 pushad;
814 rdpmc;
815 popad;
818 __except () {
819 pmcok = 0;
820 MessageBox (NULL,
821 "Requested PMC based sampling is not available",
822 "Warning",
823 MB_OK | MB_ICONWARNING);
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
835 #endif
837 CAMLreturn (Val_bool (pmcok));