* Deprecated macros SCM_ROCHARS and SCM_ROUCHARS.
[bpt/guile.git] / libguile / load.c
index f435560..162d338 100644 (file)
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1998,1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1998,1999, 2000 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
 \f
 
 #include <stdio.h>
-#include "_scm.h"
-#include "libpath.h"
-#include "fports.h"
-#include "read.h"
-#include "eval.h"
-#include "throw.h"
-#include "alist.h"
-#include "dynwind.h"
-#include "root.h"
-#include "strings.h"
-
-#include "validate.h"
-#include "load.h"
+#include "libguile/_scm.h"
+#include "libguile/libpath.h"
+#include "libguile/fports.h"
+#include "libguile/read.h"
+#include "libguile/eval.h"
+#include "libguile/throw.h"
+#include "libguile/alist.h"
+#include "libguile/dynwind.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/modules.h"
+
+#include "libguile/validate.h"
+#include "libguile/load.h"
 
 #include <sys/types.h>
 #include <sys/stat.h>
@@ -88,13 +89,20 @@ swap_port (void *data)
 static SCM
 load (void *data)
 {
-  SCM port = (SCM) data, form;
+  SCM port = SCM_PACK (data);
   while (1)
     {
-      form = scm_read (port);
+      SCM form = scm_read (port);
       if (SCM_EOF_OBJECT_P (form))
        break;
-      scm_eval_x (form);
+      /* Ugh!  We need to re-check the environment for every form.
+       * We should change this in the new module system.
+       */
+      scm_i_eval_x (form,
+                   scm_module_system_booted_p
+                   ? (scm_top_level_env
+                      (SCM_MODULE_EVAL_CLOSURE (scm_selected_module ())))
+                   : SCM_EOL);
     }
   return SCM_UNSPECIFIED;
 }
@@ -110,13 +118,12 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
 #define FUNC_NAME s_scm_primitive_load
 {
   SCM hook = *scm_loc_load_hook;
-  SCM_VALIDATE_ROSTRING (1,filename);
-  SCM_ASSERT (hook == SCM_BOOL_F
-             || (scm_procedure_p (hook) == SCM_BOOL_T),
+  SCM_VALIDATE_STRING (1, filename);
+  SCM_ASSERT (SCM_FALSEP (hook) || (SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)),
              hook, "value of %load-hook is neither a procedure nor #f",
              FUNC_NAME);
 
-  if (hook != SCM_BOOL_F)
+  if (! SCM_FALSEP (hook))
     scm_apply (hook, scm_listify (filename, SCM_UNDEFINED), SCM_EOL);
 
   { /* scope */
@@ -127,7 +134,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
     scm_internal_dynamic_wind (swap_port,
                               load,
                               swap_port,
-                              (void *) port,
+                              (void *) SCM_UNPACK (port),
                               &save_port);
     scm_close_port (port);
   }
@@ -218,14 +225,14 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0,
            "")
 #define FUNC_NAME s_scm_parse_path
 {
-  SCM_ASSERT (SCM_FALSEP (path) || (SCM_ROSTRINGP (path)),
+  SCM_ASSERT (SCM_FALSEP (path) || (SCM_STRINGP (path)),
              path,
              SCM_ARG1, FUNC_NAME);
   if (SCM_UNBNDP (tail))
     tail = SCM_EOL;
   return (SCM_FALSEP (path)
          ? tail
-         : scm_internal_parse_path (SCM_ROCHARS (path), tail));
+         : scm_internal_parse_path (SCM_STRING_CHARS (path), tail));
 }
 #undef FUNC_NAME
 
@@ -269,14 +276,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
   size_t max_ext_len;          /* maximum length of any EXTENSIONS element */
 
   SCM_VALIDATE_LIST (1,path);
-  SCM_VALIDATE_ROSTRING (2,filename);
+  SCM_VALIDATE_STRING (2, filename);
   if (SCM_UNBNDP (extensions))
     extensions = SCM_EOL;
   else
     SCM_VALIDATE_LIST (3,extensions);
 
-  filename_chars = SCM_ROCHARS (filename);
-  filename_len = SCM_ROLENGTH (filename);
+  filename_chars = SCM_STRING_CHARS (filename);
+  filename_len = SCM_STRING_LENGTH (filename);
 
   /* If FILENAME is absolute, return it unchanged.  */
   if (filename_len >= 1 && filename_chars[0] == '/')
@@ -287,14 +294,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
     SCM walk;
 
     max_path_len = 0;
-    for (walk = path; SCM_NNULLP (walk); walk = SCM_CDR (walk))
+    for (walk = path; !SCM_NULLP (walk); walk = SCM_CDR (walk))
       {
        SCM elt = SCM_CAR (walk);
-       SCM_ASSERT (SCM_ROSTRINGP (elt), elt,
+       SCM_ASSERT (SCM_STRINGP (elt), elt,
                    "path is not a list of strings",
                    FUNC_NAME);
-       if (SCM_ROLENGTH (elt) > max_path_len)
-         max_path_len = SCM_ROLENGTH (elt);
+       if (SCM_STRING_LENGTH (elt) > max_path_len)
+         max_path_len = SCM_STRING_LENGTH (elt);
       }
   }
 
@@ -326,14 +333,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
     SCM walk;
 
     max_ext_len = 0;
-    for (walk = extensions; SCM_NNULLP (walk); walk = SCM_CDR (walk))
+    for (walk = extensions; !SCM_NULLP (walk); walk = SCM_CDR (walk))
       {
        SCM elt = SCM_CAR (walk);
-       SCM_ASSERT (SCM_ROSTRINGP (elt), elt,
+       SCM_ASSERT (SCM_STRINGP (elt), elt,
                    "extension list is not a list of strings",
                    FUNC_NAME);
-       if (SCM_ROLENGTH (elt) > max_ext_len)
-         max_ext_len = SCM_ROLENGTH (elt);
+       if (SCM_STRING_LENGTH (elt) > max_ext_len)
+         max_ext_len = SCM_STRING_LENGTH (elt);
       }
   }
 
@@ -350,15 +357,15 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
 
     /* Try every path element.  At this point, we know the path is a
        proper list of strings.  */
-    for (; SCM_NNULLP (path); path = SCM_CDR (path))
+    for (; !SCM_NULLP (path); path = SCM_CDR (path))
       {
        int len;
        SCM dir = SCM_CAR (path);
        SCM exts;
 
        /* Concatenate the path name and the filename. */
-       len = SCM_ROLENGTH (dir);
-       memcpy (buf, SCM_ROCHARS (dir), len);
+       len = SCM_STRING_LENGTH (dir);
+       memcpy (buf, SCM_STRING_CHARS (dir), len);
        if (len >= 1 && buf[len - 1] != '/')
          buf[len++] = '/';
        memcpy (buf + len, filename_chars, filename_len);
@@ -366,14 +373,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
 
        /* Try every extension.  At this point, we know the extension
           list is a proper, nonempty list of strings.  */
-       for (exts = extensions; SCM_NNULLP (exts); exts = SCM_CDR (exts))
+       for (exts = extensions; !SCM_NULLP (exts); exts = SCM_CDR (exts))
          {
            SCM ext = SCM_CAR (exts);
-           int ext_len = SCM_ROLENGTH (ext);
+           int ext_len = SCM_STRING_LENGTH (ext);
            struct stat mode;
 
            /* Concatenate the extension. */
-           memcpy (buf + len, SCM_ROCHARS (ext), ext_len);
+           memcpy (buf + len, SCM_STRING_CHARS (ext), ext_len);
            buf[len + ext_len] = '\0';
            
            /* If the file exists at all, we should return it.  If the
@@ -413,7 +420,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
 {
   SCM path = *scm_loc_load_path;
   SCM exts = *scm_loc_load_extensions;
-  SCM_VALIDATE_ROSTRING (1,filename);
+  SCM_VALIDATE_STRING (1, filename);
 
   SCM_ASSERT (scm_ilength (path) >= 0, path, "load path is not a proper list",
              FUNC_NAME);
@@ -434,14 +441,14 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
 {
   SCM full_filename;
 
-  SCM_VALIDATE_ROSTRING (1,filename);
+  SCM_VALIDATE_STRING (1, filename);
 
   full_filename = scm_sys_search_load_path (filename);
 
   if (SCM_FALSEP (full_filename))
     {
-      int absolute = (SCM_ROLENGTH (filename) >= 1
-                     && SCM_ROCHARS (filename)[0] == '/');
+      int absolute = (SCM_STRING_LENGTH (filename) >= 1
+                     && SCM_STRING_CHARS (filename)[0] == '/');
       SCM_MISC_ERROR ((absolute
                       ? "Unable to load file ~S"
                       : "Unable to find file ~S in load path"),
@@ -452,9 +459,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-/* The following function seems trivial - and indeed it is.  Its
- * existence is motivated by its ability to evaluate expressions
- * without copying them first (as is done in "eval").
+#if SCM_DEBUG_DEPRECATED == 0
+
+/* Eval now copies source properties, so this function is no longer required.
  */
 
 SCM_SYMBOL (scm_end_of_file_key, "end-of-file");
@@ -470,10 +477,12 @@ SCM_DEFINE (scm_read_and_eval_x, "read-and-eval!", 0, 1, 0,
   SCM form = scm_read (port);
   if (SCM_EOF_OBJECT_P (form))
     scm_ithrow (scm_end_of_file_key, SCM_EOL, 1);
-  return scm_eval_x (form);
+  return scm_eval_x (form, scm_selected_module ());
 }
 #undef FUNC_NAME
 
+#endif
+
 \f
 /* Information about the build environment.  */
 
@@ -508,5 +517,13 @@ scm_init_load ()
 
   init_build_info ();
 
-#include "load.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/load.x"
+#endif
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/