-/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003 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
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
+#if HAVE_CONFIG_H
+# include <config.h>
+#endif
+
#include "libguile/_scm.h"
#include <stdio.h>
#include "libguile/strings.h"
#include "libguile/modules.h"
#include "libguile/validate.h"
+#include "libguile/deprecation.h"
#include "libguile/strports.h"
int space = pt->write_end - pt->write_pos;
int write_len = (size > space) ? space : size;
- strncpy ((char *) pt->write_pos, input, write_len);
+ memcpy ((char *) pt->write_pos, input, write_len);
pt->write_pos += write_len;
size -= write_len;
input += write_len;
scm_out_of_range (caller, pos);
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
- SCM_NEWCELL (z);
- SCM_DEFER_INTS;
- pt = scm_add_to_port_table (z);
- SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
- SCM_SETPTAB_ENTRY (z, pt);
+
+ scm_mutex_lock (&scm_i_port_table_mutex);
+ z = scm_new_port_table_entry (scm_tc16_strport);
+ pt = SCM_PTAB_ENTRY(z);
SCM_SETSTREAM (z, SCM_UNPACK (str));
+ SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
pt->write_buf = pt->read_buf = SCM_STRING_UCHARS (str);
pt->read_pos = pt->write_pos = pt->read_buf + SCM_INUM (pos);
pt->write_buf_size = pt->read_buf_size = str_len;
pt->rw_random = 1;
- SCM_ALLOW_INTS;
+ scm_mutex_unlock (&scm_i_port_table_mutex);
/* ensure write_pos is writable. */
if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
if (SCM_UNBNDP (printer))
scm_write (obj, port);
else
- scm_apply (printer, SCM_LIST2 (obj, port), SCM_EOL);
+ scm_call_2 (printer, obj, port);
return scm_strport_to_string (port);
}
#undef FUNC_NAME
-#if (SCM_DEBUG_DEPRECATED == 0)
-
-SCM
-scm_strprint_obj (SCM obj)
-{
- return scm_object_to_string (obj, SCM_UNDEFINED);
-}
-
-#endif /* (SCM_DEBUG_DEPRECATED == 0) */
-
SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0,
(SCM proc),
"Calls the one-argument procedure @var{proc} with a newly created output\n"
scm_make_string (SCM_INUM0, SCM_UNDEFINED),
SCM_OPN | SCM_WRTNG,
FUNC_NAME);
- scm_apply (proc, p, scm_listofnull);
+ scm_call_1 (proc, p);
- return scm_strport_to_string (p);
+ return scm_get_output_string (p);
}
#undef FUNC_NAME
#define FUNC_NAME s_scm_call_with_input_string
{
SCM p = scm_mkstrport(SCM_INUM0, string, SCM_OPN | SCM_RDNG, FUNC_NAME);
- return scm_apply (proc, p, scm_listofnull);
+ return scm_call_1 (proc, p);
}
#undef FUNC_NAME
/* Given a null-terminated string EXPR containing a Scheme expression
read it, and return it as an SCM value. */
SCM
-scm_read_0str (char *expr)
+scm_c_read_string (const char *expr)
{
SCM port = scm_mkstrport (SCM_INUM0,
scm_makfrom0str (expr),
SCM_OPN | SCM_RDNG,
- "scm_eval_0str");
+ "scm_c_read_string");
SCM form;
/* Read expressions from that port; ignore the values. */
/* Given a null-terminated string EXPR containing Scheme program text,
evaluate it, and return the result of the last expression evaluated. */
SCM
-scm_eval_0str (const char *expr)
+scm_c_eval_string (const char *expr)
{
return scm_eval_string (scm_makfrom0str (expr));
}
+SCM
+scm_c_eval_string_in_module (const char *expr, SCM module)
+{
+ return scm_eval_string_in_module (scm_makfrom0str (expr), module);
+}
+
+
static SCM
inner_eval_string (void *data)
{
return ans;
}
-SCM_DEFINE (scm_eval_string, "eval-string", 1, 0, 0,
- (SCM string),
+SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0,
+ (SCM string, SCM module),
"Evaluate @var{string} as the text representation of a Scheme\n"
"form or forms, and return whatever value they produce.\n"
- "Evaluation takes place in the environment returned by the\n"
- "procedure @code{interaction-environment}.")
-#define FUNC_NAME s_scm_eval_string
+ "Evaluation takes place in the given module, or the current\n"
+ "module when no module is given.\n"
+ "While the code is evaluated, the given module is made the\n"
+ "current one. The current module is restored when this\n"
+ "procedure returns.")
+#define FUNC_NAME s_scm_eval_string_in_module
{
SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG,
- "scm_eval_0str");
- return scm_c_call_with_current_module (scm_interaction_environment (),
+ FUNC_NAME);
+ if (SCM_UNBNDP (module))
+ module = scm_current_module ();
+ else
+ SCM_VALIDATE_MODULE (2, module);
+ return scm_c_call_with_current_module (module,
inner_eval_string, (void *)port);
}
#undef FUNC_NAME
+SCM
+scm_eval_string (SCM string)
+{
+ return scm_eval_string_in_module (string, SCM_UNDEFINED);
+}
+
static scm_t_bits
scm_make_stptob ()
{
{
scm_tc16_strport = scm_make_stptob ();
-#ifndef SCM_MAGIC_SNARFER
#include "libguile/strports.x"
-#endif
}
HCoop / bpt / guile.git / blobdiff