X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11..fbf0c8c7b194202e01338f8b5324126bf73af4c9:/libguile/strports.c diff --git a/libguile/strports.c b/libguile/strports.c index 13b7ef8c6..0e48e0f7d 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -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 @@ -44,18 +44,22 @@ -#include "_scm.h" +#include "libguile/_scm.h" #include #ifdef HAVE_UNISTD_H #include #endif -#include "unif.h" -#include "eval.h" -#include "read.h" +#include "libguile/unif.h" +#include "libguile/eval.h" +#include "libguile/ports.h" +#include "libguile/read.h" +#include "libguile/root.h" +#include "libguile/strings.h" +#include "libguile/modules.h" -#include "strports.h" +#include "libguile/strports.h" #ifdef HAVE_STRING_H #include @@ -75,6 +79,10 @@ when rw_active is SCM_PORT_NEITHER. */ + +static scm_bits_t scm_tc16_strport; + + static int stfill_buffer (SCM port) { @@ -83,7 +91,7 @@ stfill_buffer (SCM port) if (pt->read_pos >= pt->read_end) return EOF; else - return scm_return_first (*pt->read_pos, port); + return scm_return_first_int (*pt->read_pos, port); } /* change the size of a port's string to new_size. this doesn't @@ -91,15 +99,23 @@ stfill_buffer (SCM port) static void st_resize_port (scm_port *pt, off_t new_size) { + SCM old_stream = SCM_PACK (pt->stream); + SCM new_stream = scm_makstr (new_size, 0); + unsigned long int old_size = SCM_STRING_LENGTH (old_stream); + unsigned long int min_size = min (old_size, new_size); + unsigned long int i; + off_t index = pt->write_pos - pt->write_buf; pt->write_buf_size = new_size; - scm_vector_set_length_x (pt->stream, SCM_MAKINUM (new_size)); + for (i = 0; i != min_size; ++i) + SCM_STRING_CHARS (new_stream) [i] = SCM_STRING_CHARS (old_stream) [i]; - /* reset buffer in case reallocation moved the string. */ + /* reset buffer. */ { - pt->read_buf = pt->write_buf = SCM_CHARS (pt->stream); + pt->stream = new_stream; + pt->read_buf = pt->write_buf = SCM_STRING_UCHARS (new_stream); pt->read_pos = pt->write_pos = pt->write_buf + index; pt->write_end = pt->write_buf + pt->write_buf_size; pt->read_end = pt->read_buf + pt->read_buf_size; @@ -130,7 +146,7 @@ st_flush (SCM port) } static void -st_write (SCM port, void *data, size_t size) +st_write (SCM port, const void *data, size_t size) { scm_port *pt = SCM_PTAB_ENTRY (port); const char *input = (char *) data; @@ -140,7 +156,7 @@ st_write (SCM port, void *data, size_t size) int space = pt->write_end - pt->write_pos; int write_len = (size > space) ? space : size; - strncpy (pt->write_pos, input, write_len); + strncpy ((char *) pt->write_pos, input, write_len); pt->write_pos += write_len; size -= write_len; input += write_len; @@ -157,7 +173,7 @@ st_end_input (SCM port, int offset) if (pt->read_pos - pt->read_buf < offset) scm_misc_error ("st_end_input", "negative position", SCM_EOL); - pt->write_pos = (unsigned char *) pt->read_pos = pt->read_pos - offset; + pt->write_pos = (unsigned char *) (pt->read_pos = pt->read_pos - offset); pt->rw_active = SCM_PORT_NEITHER; } @@ -207,7 +223,7 @@ st_seek (SCM port, off_t offset, int whence) if (target >= pt->write_buf_size) { - if (!(SCM_CAR (port) & SCM_WRTNG)) + if (!(SCM_CELL_WORD_0 (port) & SCM_WRTNG)) { if (target > pt->write_buf_size) { @@ -258,8 +274,8 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) int str_len; SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller); - SCM_ASSERT (SCM_NIMP(str) && SCM_ROSTRINGP(str), str, SCM_ARG1, caller); - str_len = SCM_ROLENGTH (str); + SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG1, caller); + str_len = SCM_STRING_LENGTH (str); if (SCM_INUM (pos) > str_len) scm_out_of_range (caller, pos); if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) @@ -267,10 +283,10 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) SCM_NEWCELL (z); SCM_DEFER_INTS; pt = scm_add_to_port_table (z); - SCM_SETCAR (z, scm_tc16_strport | modes); + SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); SCM_SETPTAB_ENTRY (z, pt); - SCM_SETSTREAM (z, str); - pt->write_buf = pt->read_buf = SCM_ROCHARS (str); + SCM_SETSTREAM (z, SCM_UNPACK (str)); + 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->write_end = pt->read_end = pt->read_buf + pt->read_buf_size; @@ -292,12 +308,14 @@ SCM scm_strport_to_string (SCM port) if (pt->rw_active == SCM_PORT_WRITE) st_flush (port); - return scm_makfromstr (pt->read_buf, pt->read_buf_size, 0); + return scm_makfromstr ((char *) pt->read_buf, pt->read_buf_size, 0); } -GUILE_PROC(scm_call_with_output_string, "call-with-output-string", 1, 0, 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" + "port. When the function returns, the string composed of the characters\n" + "written into the port is returned.") #define FUNC_NAME s_scm_call_with_output_string { SCM p; @@ -335,9 +353,11 @@ scm_strprint_obj (SCM obj) -GUILE_PROC(scm_call_with_input_string, "call-with-input-string", 2, 0, 0, +SCM_DEFINE (scm_call_with_input_string, "call-with-input-string", 2, 0, 0, (SCM str, SCM proc), -"") + "Calls the one-argument procedure @var{proc} with a newly created input\n" + "port from which @var{string}'s contents may be read. The value yielded\n" + "by the @var{proc} is returned.") #define FUNC_NAME s_scm_call_with_input_string { SCM p = scm_mkstrport(SCM_INUM0, str, SCM_OPN | SCM_RDNG, FUNC_NAME); @@ -374,19 +394,22 @@ scm_eval_0str (const char *expr) } -GUILE_PROC (scm_eval_string, "eval-string", 1, 0, 0, +SCM_DEFINE (scm_eval_string, "eval-string", 1, 0, 0, (SCM string), -"") + "Evaluate @var{string} as the text representation of a Scheme form\n" + "or forms, and return whatever value they produce.\n" + "Evaluation takes place in (interaction-environment).") #define FUNC_NAME s_scm_eval_string { SCM port = scm_mkstrport (SCM_INUM0, string, SCM_OPN | SCM_RDNG, "scm_eval_0str"); SCM form; SCM ans = SCM_UNSPECIFIED; + SCM module = scm_interaction_environment (); /* Read expressions from that port; ignore the values. */ while (!SCM_EOF_OBJECT_P (form = scm_read (port))) - ans = scm_eval_x (form); + ans = scm_eval_x (form, module); /* Don't close the port here; if we re-enter this function via a continuation, then the next time we enter it, we'll get an error. @@ -397,22 +420,33 @@ GUILE_PROC (scm_eval_string, "eval-string", 1, 0, 0, } #undef FUNC_NAME -void scm_make_stptob (void); /* Called from ports.c */ - -void +static scm_bits_t scm_make_stptob () { - long tc = scm_make_port_type ("string", stfill_buffer, st_write); + scm_bits_t tc = scm_make_port_type ("string", stfill_buffer, st_write); + scm_set_port_mark (tc, scm_markstream); scm_set_port_end_input (tc, st_end_input); scm_set_port_flush (tc, st_flush); scm_set_port_seek (tc, st_seek); scm_set_port_truncate (tc, st_truncate); + + return tc; } void scm_init_strports () { -#include "strports.x" + scm_tc16_strport = scm_make_stptob (); + +#ifndef SCM_MAGIC_SNARFER +#include "libguile/strports.x" +#endif } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/