~ chicken-core (chicken-5) 28347b495e52e06f0f408e8b63ac347feaa8b0d3


commit 28347b495e52e06f0f408e8b63ac347feaa8b0d3
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Feb 12 15:09:36 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Feb 12 15:09:36 2010 +0100

    added ##sys#path-to-executable (untested)

diff --git a/chicken.h b/chicken.h
index bae4e99f..ccc7acc9 100644
--- a/chicken.h
+++ b/chicken.h
@@ -890,6 +890,7 @@ DECL_C_PROC_p0 (128,  1,0,0,0,0,0,0,0)
 # define C_trunc                    trunc
 # define C_fabs                     fabs
 # define C_modf                     modf
+# define C_readlink                 readlink
 # ifdef __linux__
 extern double round(double);
 extern double trunc(double);
@@ -1710,6 +1711,7 @@ C_fctexport C_word C_fcall C_i_foreign_unsigned_integer_argumentp(C_word x) C_re
 C_fctexport C_char *C_lookup_procedure_id(void *ptr);
 C_fctexport void *C_lookup_procedure_ptr(C_char *id);
 C_fctexport C_word C_dunload(C_word name);
+C_fctexport C_char *C_executable_path();
 
 #ifdef C_SIXTY_FOUR
 C_fctexport void C_ccall C_peek_signed_integer_32(C_word c, C_word closure, C_word k, C_word v, C_word index) C_noret;
diff --git a/library.scm b/library.scm
index fe823d0b..2f781ac0 100644
--- a/library.scm
+++ b/library.scm
@@ -3405,6 +3405,12 @@ EOF
 (define ##sys#pathname-directory-separator #\/) ; DEPRECATED
 
 
+;;; Access executable path
+
+(define ##sys#path-to-executable
+  (foreign-lambda c-string "C_executable_path"))
+
+
 ;;; Feature identifiers:
 
 (define ##sys#->feature-id
diff --git a/runtime.c b/runtime.c
index b225e15f..002ccc89 100644
--- a/runtime.c
+++ b/runtime.c
@@ -8728,7 +8728,39 @@ static C_regparm C_word C_fcall decode_literal2(C_word **ptr, C_char **str,
 }
 
 
-C_regparm C_word C_fcall C_decode_literal(C_word **ptr, C_char *str)
+C_regparm C_word C_fcall
+C_decode_literal(C_word **ptr, C_char *str)
 {
   return decode_literal2(ptr, &str, NULL);
 }
+
+
+C_char *
+C_executable_path()
+{
+#ifdef __linux__
+  char linkname[64]; /* /proc/<pid>/exe */
+  pid_t pid;
+  int ret;
+	
+  pid = C_getpid();
+  C_sprintf(linkname, "/proc/%i/exe", pid);
+  ret = C_readlink(linkname, buffer, STRING_BUFFER_SIZE - 1);
+
+  if(ret == -1 || ret >= STRING_BUFFER_SIZE - 1)
+    return NULL;
+	
+  buffer[ ret ] = 0;
+  return buffer;
+#elseif defined(_WIN32) && !defined(__CYGWIN__)
+  int n = GetModuleFileName(NULL, buffer, STRING_BUFFER_SIZE - 1);
+
+  if(n == 0 || n >= STRING_BUFFER_SIZE - 1)
+    return NULL;
+
+  buffer[ n ] = 0;
+  return buffer;
+#else
+  return NULL;
+#endif
+}
Trap