[Chicken-hackers] (program-filename)

[Alex Sandro Queiroz e Silva]

Hallo,

    I have modified my runtime to include a function that returns the 
file name of the running program. It uses the win32 function 
GetModuleFileName. I have attached the patch in case anyone else finds 
it useful.

Cheers,
-alex

Index: chicken.h
===================================================================
--- chicken.h   (revision 7113)
+++ chicken.h   (working copy)
@@ -1353,6 +1353,7 @@
 C_fctexport void C_ccall C_locative_ref(C_word c, C_word closure, C_word k, 
C_word loc) C_noret;
 C_fctexport void C_ccall C_call_with_cthulhu(C_word c, C_word self, C_word k, 
C_word proc) C_noret;
 C_fctexport void C_ccall C_copy_closure(C_word c, C_word closure, C_word k, 
C_word proc) C_noret;
+C_fctexport void C_ccall C_program_filename(C_word c, C_word closure, C_word 
k) C_noret;
 
 #if !defined(__GNUC__) && !defined(__INTEL_COMPILER)
 C_fctexport C_word *C_a_i(C_word **a, int n);
Index: library.scm
===================================================================
--- library.scm (revision 7113)
+++ library.scm (working copy)
@@ -4599,3 +4599,6 @@
          (if (memq prop props)
              (values prop (##sys#slot tl 0) nxt)
              (loop nxt) ) ) ) ) )
+
+(define program-filename (##core#primitive "C_program_filename"))
+
Index: runtime.c
===================================================================
--- runtime.c   (revision 7113)
+++ runtime.c   (working copy)
@@ -8963,3 +8963,25 @@
   if((((s ^ x1) & ~(s ^ x2)) >> 30) != 0) return C_SCHEME_FALSE;
   else return C_fix(s);
 }
+
+void C_ccall C_program_filename(C_word c, C_word closure, C_word k)
+{
+  int len;
+  C_word *a, s;
+  char tmp_buf[500];
+
+  if(c != 2) C_bad_argc(c, 2);
+
+#if defined(__MINGW32__) || defined(_WIN32) || defined(__WINNT__)
+  len = GetModuleFileName(NULL, tmp_buf, 500);
+  if(len == 0) {
+    C_kontinue(k, C_SCHEME_FALSE);
+  }
+  a = C_alloc(2 + C_bytestowords(len));
+  s = C_string2(&a, tmp_buf);
+  C_kontinue(k, s);
+#else
+  C_kontinue(k, C_SCHEME_FALSE);
+#endif
+}
+