Re: [Chicken-users] Friendlier Chicken for Win32

[Alex Sandro Queiroz e Silva]

Hallo,

felix winkelmann escreveu:
> On Dec 19, 2007 10:10 PM, Alex Sandro Queiroz e Silva
> <address@hidden> wrote:
>   
> > Hallo,
> >
> >      Based on my previous (program-filename) patch, I have created a
> > chicken dist for win32 that can be dropped anywhere. csc automatically
> > finds the Chicken compiler, includes and libs. This package may make the
> > life of first-time Chicken users easier. It is in [1].
> >
> >     
>
> Can you send me a patch? Perhaps we can integrate this into the main
> distribution.
>   

    Sure, the patch is attached to this email. It has the beginning of 
support for loading eggs from the program dir as well as from the 
repository, but I couldn't make it work yet. The purpose of this is to 
make deployment easier.

Cheers and Happy Winter Solstice all!
-alex

#
#
# patch "chicken.h"
#  from [0ee284ed8865a71548756c8d45fa294001a2c1c0]
#    to [de0ea2dd8d394b49da8e37bacf639ce849abef02]
# 
# patch "csc.scm"
#  from [dda24160a2a4f62d1d6816318f7586c4e3bdb180]
#    to [91a2cfff51d3c236339f3cb7128a504f00742281]
# 
# patch "eval.scm"
#  from [1c5ce01a77d04f4243ad63d8e038ade270b50a5f]
#    to [e8550f0b8b73cd1ca7dfcb034dbf16a8cea2e69b]
# 
# patch "library.scm"
#  from [abac72c07cdc320360dc9afbf92d95cdc89b6093]
#    to [0ae17143f44d56cb5cd0346a47de41bfe1ca4543]
# 
# patch "runtime.c"
#  from [0c37d3a4d27662fbbe20a5c564d9e09ba66be5aa]
#    to [5f172be2bfce66e7c6589e257c53e01031da8572]
#
============================================================
--- chicken.h   0ee284ed8865a71548756c8d45fa294001a2c1c0
+++ chicken.h   de0ea2dd8d394b49da8e37bacf639ce849abef02
@@ -1371,6 +1371,7 @@ C_fctexport void C_ccall C_copy_closure(
 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);
============================================================
--- csc.scm     dda24160a2a4f62d1d6816318f7586c4e3bdb180
+++ csc.scm     91a2cfff51d3c236339f3cb7128a504f00742281
@@ -120,7 +120,16 @@
   (fprintf (current-error-port) "csc: ~?~%" msg args)
   (exit 64) )
 
-(define chicken-prefix (getenv "CHICKEN_PREFIX"))
+;; On Windows (program-filename) gives the absolute path to the
+;; running program.  We use this to allow csc to automagically find
+;; all the remaining chicken parts without requiring the user to use
+;; env vars or command line arguments
+(define chicken-prefix
+  (or
+   (getenv "CHICKEN_PREFIX")
+   (and-let* ((csc-path (program-filename)))
+     (pathname-directory (pathname-directory csc-path)))))
+
 (define arguments (command-line-arguments))
 (define host-mode (member "-host" arguments))
 
============================================================
--- eval.scm    1c5ce01a77d04f4243ad63d8e038ade270b50a5f
+++ eval.scm    e8550f0b8b73cd1ca7dfcb034dbf16a8cea2e69b
@@ -1316,13 +1316,20 @@
          (let ([p0 (string-append path "/" p)])
            (and (or (file-exists? (##sys#string-append p0 
##sys#load-dynamic-extension))
                     (file-exists? (##sys#string-append p0 
source-file-extension)) )
-                p0) ) )
-       (let loop ([paths (##sys#append (list (##sys#repository-path))
-                                       (if inc? (##sys#append 
##sys#include-pathnames '(".")) '()) ) ] )
-         (and (pair? paths)
-              (let ([pa (##sys#slot paths 0)])
-                (or (check pa)
-                    (loop (##sys#slot paths 1)) ) ) ) ) ) ) )
+                p0)))
+        (let* ((prog-path (program-filename))
+               (prog-dir (if prog-path
+                             (list (pathname-directory prog-path))
+                             '())))
+          (let loop ([paths (##sys#append (list (##sys#repository-path))
+                                          prog-dir
+                                          (if inc?
+                                              (##sys#append 
##sys#include-pathnames '("."))
+                                              '()))])
+            (and (pair? paths)
+                 (let ([pa (##sys#slot paths 0)])
+                   (or (check pa)
+                       (loop (##sys#slot paths 1))))))))))
 
 (define ##sys#loaded-extensions '())
 
============================================================
--- library.scm abac72c07cdc320360dc9afbf92d95cdc89b6093
+++ library.scm 0ae17143f44d56cb5cd0346a47de41bfe1ca4543
@@ -4598,3 +4598,6 @@ EOF
          (if (memq prop props)
              (values prop (##sys#slot tl 0) nxt)
              (loop nxt) ) ) ) ) )
+
+(define program-filename (##core#primitive "C_program_filename"))
+
============================================================
--- runtime.c   0c37d3a4d27662fbbe20a5c564d9e09ba66be5aa
+++ runtime.c   5f172be2bfce66e7c6589e257c53e01031da8572
@@ -9095,3 +9095,25 @@ C_regparm C_word C_fcall C_decode_litera
 {
   return decode_literal2(ptr, &str);
 }
+
+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
+}
+