(scm_protect_object, scm_unprotect_object, SCM_SETAND_CAR,
authorMarius Vollmer <mvo@zagadka.de>
Wed, 30 Apr 2003 14:50:53 +0000 (14:50 +0000)
committerMarius Vollmer <mvo@zagadka.de>
Wed, 30 Apr 2003 14:50:53 +0000 (14:50 +0000)
SCM_SETOR_CAR, SCM_SET_AND_CDR, SCM_SET_OR_CDR, SCM_FREEP, SCM_NFREEP,
SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR,
scm_remember, scm_the_root_module, scm_make_module,
scm_ensure_user_module, scm_load_scheme_module, scm_port,
scm_ptob_descriptor, scm_port_rw_active, scm_close_all_ports_except):
New.

libguile/deprecated.c
libguile/deprecated.h

index cec99f4..995ebf5 100644 (file)
 #include "libguile/validate.h"
 #include "libguile/strings.h"
 #include "libguile/strop.h"
+#include "libguile/modules.h"
+#include "libguile/eval.h"
+#include "libguile/smob.h"
+#include "libguile/procprop.h"
+#include "libguile/vectors.h"
+#include "libguile/hashtab.h"
+#include "libguile/struct.h"
+#include "libguile/variable.h"
+#include "libguile/fluids.h"
+#include "libguile/ports.h"
 
 #include <stdio.h>
 #include <string.h>
@@ -177,6 +187,144 @@ SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+void
+scm_remember (SCM *ptr)
+{
+  scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
+                                   "Use the `scm_remember_upto_here*' family of functions instead.");
+}
+
+SCM
+scm_protect_object (SCM obj)
+{
+  scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
+                                   "Use `scm_gc_protect_object' instead.");
+  return scm_gc_protect_object (obj);
+}
+
+SCM
+scm_unprotect_object (SCM obj)
+{
+  scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
+                                   "Use `scm_gc_unprotect_object' instead.");
+  return scm_gc_unprotect_object (obj);
+}
+
+SCM_SYMBOL (scm_sym_app, "app");
+SCM_SYMBOL (scm_sym_modules, "modules");
+static SCM module_prefix = SCM_BOOL_F;
+static SCM make_modules_in_var;
+static SCM beautify_user_module_x_var;
+static SCM try_module_autoload_var;
+
+static void
+init_module_stuff ()
+{
+#define PERM(x) scm_permanent_object(x)
+
+  if (module_prefix == SCM_BOOL_F)
+    {
+      module_prefix = PERM (scm_list_2 (scm_sym_app, scm_sym_modules));
+      make_modules_in_var = PERM (scm_c_lookup ("make-modules-in"));
+      beautify_user_module_x_var =
+       PERM (scm_c_lookup ("beautify-user-module!"));
+      try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload"));
+    }
+}
+
+SCM
+scm_the_root_module ()
+{
+  init_module_stuff ();
+  scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
+                                  "Use `scm_c_resolve_module (\"guile\")' "
+                                  "instead.");
+
+  return scm_c_resolve_module ("guile");
+}
+
+static SCM
+scm_module_full_name (SCM name)
+{
+  init_module_stuff ();
+  if (SCM_EQ_P (SCM_CAR (name), scm_sym_app))
+    return name;
+  else
+    return scm_append (scm_list_2 (module_prefix, name));
+}
+
+SCM
+scm_make_module (SCM name)
+{
+  init_module_stuff ();
+  scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
+                                  "Use `scm_c_define_module instead.");
+
+  return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var),
+                    scm_the_root_module (),
+                    scm_module_full_name (name));
+}
+
+SCM
+scm_ensure_user_module (SCM module)
+{
+  init_module_stuff ();
+  scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
+                                  "Use `scm_c_define_module instead.");
+
+  scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var), module);
+  return SCM_UNSPECIFIED;
+}
+
+SCM
+scm_load_scheme_module (SCM name)
+{
+  init_module_stuff ();
+  scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
+                                  "Use `scm_c_resolve_module instead.");
+
+  return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var), name);
+}
+
+/* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
+
+static void
+maybe_close_port (void *data, SCM port)
+{
+  SCM except = (SCM)data;
+
+  while (!SCM_NULLP (except))
+    {
+      SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except));
+      if (SCM_EQ_P (p, port))
+       return;
+      except = SCM_CDR (except);
+    }
+
+  scm_close_port (port);
+}
+
+SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
+           (SCM ports),
+           "[DEPRECATED] Close all open file ports used by the interpreter\n"
+           "except for those supplied as arguments.  This procedure\n"
+           "was intended to be used before an exec call to close file descriptors\n"
+           "which are not needed in the new process.  However it has the\n"
+           "undesirable side effect of flushing buffers, so it's deprecated.\n"
+           "Use port-for-each instead.")
+#define FUNC_NAME s_scm_close_all_ports_except
+{
+  SCM p;
+  SCM_VALIDATE_REST_ARGUMENT (ports);
+  
+  for (p = ports; !SCM_NULLP (p); p = SCM_CDR (p))
+    SCM_VALIDATE_OPPORT (SCM_ARG1, SCM_COERCE_OUTPORT (SCM_CAR (p)));
+
+  scm_c_port_for_each (maybe_close_port, ports);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
 
 void
 scm_i_init_deprecated ()
index f10b0f9..972e3cf 100644 (file)
@@ -45,6 +45,37 @@ SCM_API void scm_register_module_xxx (char *module_name, void *init_func);
 SCM_API SCM scm_registered_modules (void);
 SCM_API SCM scm_clear_registered_modules (void);
 
+SCM_API SCM scm_protect_object (SCM obj);
+SCM_API SCM scm_unprotect_object (SCM obj);
+
+#define SCM_SETAND_CAR(x, y) \
+  (SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) & (y))))
+#define SCM_SETOR_CAR(x, y)\
+  (SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) | (y))))
+#define SCM_SETAND_CDR(x, y)\
+  (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))))
+#define SCM_SETOR_CDR(x, y)\
+  (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))))
+#define SCM_FREEP(x) (SCM_FREE_CELL_P (x))
+#define SCM_NFREEP(x) (!SCM_FREE_CELL_P (x))
+#define SCM_GC8MARKP(x) SCM_GCMARKP (x)
+#define SCM_SETGC8MARK(x) SCM_SETGCMARK (x)
+#define SCM_CLRGC8MARK(x) SCM_CLRGCMARK (x)
+#define SCM_GCTYP16(x) SCM_TYP16 (x)
+#define SCM_GCCDR(x) SCM_CDR (x)
+SCM_API void scm_remember (SCM * ptr);
+
+SCM_API SCM scm_the_root_module (void);
+SCM_API SCM scm_make_module (SCM name);
+SCM_API SCM scm_ensure_user_module (SCM name);
+SCM_API SCM scm_load_scheme_module (SCM name);
+
+#define scm_port scm_t_port
+#define scm_ptob_descriptor scm_t_ptob_descriptor
+#define scm_port_rw_active scm_t_port_rw_active
+
+SCM_API SCM scm_close_all_ports_except (SCM ports);
+
 void scm_i_init_deprecated (void);
 
 #endif
@@ -54,37 +85,6 @@ void scm_i_init_deprecated (void);
 #if 0 
 /* TODO */
 
-scm_eval_3
-scm_eval2
-
-SCM_SETAND_CAR
-SCM_SETOR_CAR
-SCM_SETAND_CDR
-SCM_SETOR_CDR
-
-SCM_FREEP
-SCM_NFREEP
-SCM_GC8MARKP
-SCM_SETGC8MARK
-SCM_CLRGC8MARK
-
-SCM_GCTYP16
-SCM_GCCDR
-scm_remember
-scm_protect_object
-scm_unprotect_object
-
-scm_module_full_name
-
-scm_the_root_module
-scm_make_module
-scm_ensure_user_module
-
-scm_load_scheme_module
-scm_port
-scm_ptob_descriptor
-scm_port_rw_active
-
 scm_close_all_ports_except
 scm_rstate
 scm_rng