[MLton] cvs commit: Darwin now supports time profiling

Stephen Weeks sweeks@mlton.org
Tue, 28 Sep 2004 11:56:41 -0700


sweeks      04/09/28 11:56:40

  Modified:    include  c-chunk.h
               mlton/main main.fun
               runtime  gc.c platform.h
               runtime/platform darwin.c darwin.h freebsd.c linux.c
                        netbsd.c openbsd.c solaris.c
  Added:       runtime/platform getText.c
  Log:
  MAIL Darwin now supports time profiling
  
  Darwin's gcc didn't like the __attribute__ magic that I used to
  create profile labels in C, so I had to add a special #if in c-chunk.h
  just for Darwin.
  
  I abstracted out the code that provides the start and end of the text
  section into functions (getText{End,Start}) that must be provided by
  any platform with HAS_TIME_PROFILING.

Revision  Changes    Path
1.35      +13 -3     mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- c-chunk.h	27 Sep 2004 22:52:09 -0000	1.34
+++ c-chunk.h	28 Sep 2004 18:56:39 -0000	1.35
@@ -183,11 +183,21 @@
 		Return();							\
 	} while (0)								\
 
-#define DeclareProfileLabel(l)			\
-	void l() __attribute__ ((alias (#l "_internal")))
+//#if (defined __APPLE_CC__)
 
+#define DeclareProfileLabel(l)			\
+	void l()
 #define ProfileLabel(l)				\
-	__asm__ __volatile__ (#l "_internal:" : : )
+	__asm__ __volatile__ (".globl _" #l "\n_" #l ":" : : )
+
+//#else
+
+//#define DeclareProfileLabel(l)			\
+//	void l() __attribute__ ((alias (#l "_internal")))
+//#define ProfileLabel(l)				\
+//	__asm__ __volatile__ (#l "_internal:" : : )
+
+//#endif
 
 /* ------------------------------------------------- */
 /*                       Real                        */



1.68      +2 -1      mlton/mlton/main/main.fun

Index: main.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.fun,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -r1.67 -r1.68
--- main.fun	27 Sep 2004 22:52:11 -0000	1.67
+++ main.fun	28 Sep 2004 18:56:39 -0000	1.68
@@ -650,7 +650,8 @@
 				andalso not (keepDefUse))
       val _ =
 	 case targetOS of
-	    FreeBSD => ()
+	    Darwin => ()
+	  | FreeBSD => ()
 	  | Linux => ()
 	  | NetBSD => ()
 	  | OpenBSD => ()



1.208     +2 -6      mlton/runtime/gc.c

Index: gc.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/gc.c,v
retrieving revision 1.207
retrieving revision 1.208
diff -u -r1.207 -r1.208
--- gc.c	27 Sep 2004 22:52:11 -0000	1.207
+++ gc.c	28 Sep 2004 18:56:40 -0000	1.208
@@ -3835,10 +3835,6 @@
 	profileInc (s, 1, sourceSeqIndex);
 }
 
-/* To get the beginning and end of the text segment. */
-extern void	_start(void),
-		etext(void);
-
 static int compareProfileLabels (const void *v1, const void *v2) {
 	GC_profileLabel l1;
 	GC_profileLabel l2;
@@ -3870,8 +3866,8 @@
 			assert (s->sourceLabels[i-1].label
 				<= s->sourceLabels[i].label);
 	/* Initialize s->textSources. */
-	s->textEnd = (pointer)&etext;
-	s->textStart = (pointer)&_start;
+	s->textEnd = (pointer)(getTextEnd());
+	s->textStart = (pointer)(getTextStart());
 	if (ASSERT)
 		for (i = 0; i < s->sourceLabelsSize; ++i) {
 			pointer label;



1.7       +4 -0      mlton/runtime/platform.h

Index: platform.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- platform.h	27 Sep 2004 22:52:12 -0000	1.6
+++ platform.h	28 Sep 2004 18:56:40 -0000	1.7
@@ -80,6 +80,10 @@
 #error HAS_TIME_PROFILING not defined
 #endif
 
+/* If HAS_TIME_PROFILING, then you must define these. */
+void *getTextStart ();
+void *getTextEnd ();
+
 /* HAS_WEAK is true if the platform supports the weak attribute. */
 #ifndef HAS_WEAK
 #error HAS_WEAK not defined



1.2       +18 -0     mlton/runtime/platform/darwin.c

Index: darwin.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/darwin.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- darwin.c	27 Sep 2004 22:52:13 -0000	1.1
+++ darwin.c	28 Sep 2004 18:56:40 -0000	1.2
@@ -1,6 +1,24 @@
+#include <mach-o/dyld.h>
+#include <mach-o/getsect.h>  // for get_etext()
+#include <stdio.h>
+
 #include "platform.h"
 
 #include "mkdir2.c"
+
+void *getTextEnd () {
+	return (void*)(get_etext ());
+}
+
+void *getTextStart () {
+	unsigned long address;
+	void *module;
+	struct mach_header *mh;
+
+	_dyld_lookup_and_bind ("_main", &address, &module);
+	mh = _dyld_get_image_header_containing_address (address);
+	return mh;
+}
 
 void showMem () {
 	/* FIXME: this won't actually work. */



1.2       +1 -1      mlton/runtime/platform/darwin.h

Index: darwin.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/darwin.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- darwin.h	27 Sep 2004 22:52:13 -0000	1.1
+++ darwin.h	28 Sep 2004 18:56:40 -0000	1.2
@@ -28,7 +28,7 @@
 #define HAS_SPAWN FALSE
 #define HAS_MREMAP FALSE
 #define HAS_SIGALTSTACK TRUE
-#define HAS_TIME_PROFILING FALSE
+#define HAS_TIME_PROFILING TRUE
 #define HAS_WEAK 0
 #define USE_MMAP TRUE
 



1.3       +1 -0      mlton/runtime/platform/freebsd.c

Index: freebsd.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/freebsd.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- freebsd.c	26 Aug 2004 03:54:40 -0000	1.2
+++ freebsd.c	28 Sep 2004 18:56:40 -0000	1.3
@@ -1,5 +1,6 @@
 #include "platform.h"
 
+#include "getText.c"
 #include "mkdir2.c"
 
 void showMem () {



1.3       +1 -0      mlton/runtime/platform/linux.c

Index: linux.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/linux.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- linux.c	26 Aug 2004 03:54:40 -0000	1.2
+++ linux.c	28 Sep 2004 18:56:40 -0000	1.3
@@ -1,5 +1,6 @@
 #include "platform.h"
 
+#include "getText.c"
 #include "mkdir2.c"
 #include "showMem.linux.c"
 #include "ssmmap.c"



1.3       +1 -0      mlton/runtime/platform/netbsd.c

Index: netbsd.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/netbsd.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- netbsd.c	26 Aug 2004 03:54:40 -0000	1.2
+++ netbsd.c	28 Sep 2004 18:56:40 -0000	1.3
@@ -1,5 +1,6 @@
 #include "platform.h"
 
+#include "getText.c"
 #include "mkdir2.c"
 #include "showMem.linux.c"
 #include "ssmmap.c"



1.3       +1 -0      mlton/runtime/platform/openbsd.c

Index: openbsd.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/openbsd.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- openbsd.c	26 Aug 2004 03:54:40 -0000	1.2
+++ openbsd.c	28 Sep 2004 18:56:40 -0000	1.3
@@ -1,5 +1,6 @@
 #include "platform.h"
 
+#include "getText.c"
 #include "mkdir2.c"
 #include "showMem.linux.c"
 #include "ssmmap.c"



1.3       +1 -0      mlton/runtime/platform/solaris.c

Index: solaris.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/platform/solaris.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- solaris.c	26 Aug 2004 03:54:40 -0000	1.2
+++ solaris.c	28 Sep 2004 18:56:40 -0000	1.3
@@ -1,5 +1,6 @@
 #include "platform.h"
 
+#include "getText.c"
 #include "mkdir2.c"
 #include "ssmmap.c"
 #include "totalRam.sysconf.c"



1.1                  mlton/runtime/platform/getText.c

Index: getText.c
===================================================================
/* To get the beginning and end of the text segment. */
extern void _start(void);
extern void etext(void);

void *getTextStart () {
	return &_start;
}
void *getTextEnd () {
	return &etext;
}