X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/92c2555f6972b5fbc2236fe486e9432040b43812..7caa1b0780eda67bc7e50969c3a5436f3710d6d4:/libguile/strports.c diff --git a/libguile/strports.c b/libguile/strports.c index ef4a15838..107fedd01 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 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 @@ -39,8 +39,6 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ @@ -59,6 +57,7 @@ #include "libguile/strings.h" #include "libguile/modules.h" #include "libguile/validate.h" +#include "libguile/deprecation.h" #include "libguile/strports.h" @@ -156,7 +155,7 @@ st_write (SCM port, const void *data, size_t size) 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; @@ -280,12 +279,12 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) 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); + 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; @@ -305,10 +304,14 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) SCM scm_strport_to_string (SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); + SCM str; if (pt->rw_active == SCM_PORT_WRITE) st_flush (port); - return scm_makfromstr ((char *) pt->read_buf, pt->read_buf_size, 0); + + str = scm_mem2string ((char *) pt->read_buf, pt->read_buf_size); + scm_remember_upto_here_1 (port); + return str; } SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, @@ -329,22 +332,12 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, 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" @@ -358,7 +351,7 @@ SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, 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); } @@ -372,7 +365,7 @@ SCM_DEFINE (scm_call_with_input_string, "call-with-input-string", 2, 0, 0, #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 @@ -424,12 +417,12 @@ SCM_DEFINE (scm_get_output_string, "get-output-string", 1, 0, 0, /* 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. */ @@ -442,11 +435,18 @@ scm_read_0str (char *expr) /* 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) { @@ -466,21 +466,32 @@ 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 (); + 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 () { @@ -500,9 +511,7 @@ scm_init_strports () { scm_tc16_strport = scm_make_stptob (); -#ifndef SCM_MAGIC_SNARFER #include "libguile/strports.x" -#endif }