Applied changes based on official version of TinyScheme (CVS commit dated

2007/12/22 10:48) which makes string output ports conform to SRFI-6.
NOTE: SRFI-6 compliance is incomplete in official version of TinyScheme.
      (See SourceForge bug #2832150)

Also included two minor additions/corrections to old ChangeLog files.
This commit is contained in:
Kevin Cozens 2009-08-04 13:39:17 -04:00
parent 57f44b89e8
commit bf3d355fd7
6 changed files with 104 additions and 10 deletions

View File

@ -870,7 +870,7 @@
official version of TinyScheme which adds entry point for nested
calling. Part of making it more suitable for Scheme->C->Scheme
calling. See SourceForge bug #1599945. Updated usage information
using text from Manual.txt.
using text from Manual.txt. See SourceForge bug #1825395.
2008-09-11 Michael Natterer <mitch@gimp.org>

View File

@ -1249,12 +1249,12 @@
use gtk_widget_get_action() instead of g_object_get_data(),
which relies on the name of the data key.
2009-01-23 Kevin Cozens <kcozens@cvs.gimp.org>
2009-01-23 Kevin Cozens <kcozens@cvs.gnome.org>
* libgimpcolor/gimprgb-parse.c: Applied patch from Andreas Turtschan
to fix more RGB colour values. Fixes bug #568909.
2009-01-23 Kevin Cozens <kcozens@cvs.gimp.org>
2009-01-23 Kevin Cozens <kcozens@cvs.gnome.org>
* libgimpcolor/gimprgb-parse.c: Applied patch from Andreas Turtschan
to fix colour values for slategray and slategrey. Fixes bug #568839.
@ -1392,7 +1392,7 @@
* configure.in: require intltool >= 0.40.1. Looks like that was
the first version with support for the NC_ keyword.
2009-01-13 Kevin Cozens <kcozens@cvs.gimp.org>
2009-01-13 Kevin Cozens <kcozens@cvs.gnome.org>
* app/tools/gimpforegroundselecttool.c: Corrected spelling error
spotted by David Gowers.

View File

@ -182,7 +182,7 @@ Please read accompanying file COPYING.
with-input-from-file, with-output-from-file and
with-input-output-from-to-files, close-port and input-output-port?
(not R5RS).
String Ports: open-input-string, open-output-string,
String Ports: open-input-string, open-output-string, get-output-string,
open-input-output-string. Strings can be used with I/O routines.
Vectors

View File

@ -159,8 +159,9 @@
_OP_DEF(opexe_4, "open-input-output-file", 1, 1, TST_STRING, OP_OPEN_INOUTFILE )
#if USE_STRING_PORTS
_OP_DEF(opexe_4, "open-input-string", 1, 1, TST_STRING, OP_OPEN_INSTRING )
_OP_DEF(opexe_4, "open-output-string", 1, 1, TST_STRING, OP_OPEN_OUTSTRING )
_OP_DEF(opexe_4, "open-input-output-string", 1, 1, TST_STRING, OP_OPEN_INOUTSTRING )
_OP_DEF(opexe_4, "open-output-string", 0, 1, TST_STRING, OP_OPEN_OUTSTRING )
_OP_DEF(opexe_4, "get-output-string", 1, 1, TST_OUTPORT, OP_GET_OUTSTRING )
#endif
_OP_DEF(opexe_4, "close-input-port", 1, 1, TST_INPORT, OP_CLOSE_INPORT )
_OP_DEF(opexe_4, "close-output-port", 1, 1, TST_OUTPORT, OP_CLOSE_OUTPORT )

View File

@ -11,6 +11,7 @@ enum scheme_port_kind {
port_free=0,
port_file=1,
port_string=2,
port_srfi6=4,
port_input=16,
port_output=32
};

View File

@ -1463,6 +1463,37 @@ static pointer port_from_string(scheme *sc, char *start, char *past_the_end, int
return mk_port(sc,pt);
}
#define BLOCK_SIZE 256
static port *port_rep_from_scratch(scheme *sc) {
port *pt;
char *start;
pt=(port*)sc->malloc(sizeof(port));
if(pt==0) {
return 0;
}
start=sc->malloc(BLOCK_SIZE);
if(start==0) {
return 0;
}
memset(start,' ',BLOCK_SIZE-1);
start[BLOCK_SIZE-1]='\0';
pt->kind=port_string|port_output|port_srfi6;
pt->rep.string.start=start;
pt->rep.string.curr=start;
pt->rep.string.past_the_end=start+BLOCK_SIZE-1;
return pt;
}
static pointer port_from_scratch(scheme *sc) {
port *pt;
pt=port_rep_from_scratch(sc);
if(pt==0) {
return sc->NIL;
}
return mk_port(sc,pt);
}
static void port_close(scheme *sc, pointer p, int flag) {
port *pt=p->_object._port;
pt->kind&=~flag;
@ -1601,6 +1632,25 @@ static void backchar(scheme *sc, gunichar c) {
}
}
static int realloc_port_string(scheme *sc, port *p)
{
char *start=p->rep.string.start;
size_t new_size=p->rep.string.past_the_end-start+1+BLOCK_SIZE;
char *str=sc->malloc(new_size);
if(str) {
memset(str,' ',new_size-1);
str[new_size-1]='\0';
strcpy(str,start);
p->rep.string.start=str;
p->rep.string.past_the_end=str+new_size-1;
p->rep.string.curr-=start-str;
sc->free(start);
return 1;
} else {
return 0;
}
}
/* len is number of UTF-8 characters in string pointed to by chars */
static void putchars(scheme *sc, const char *chars, int char_cnt) {
int free_bytes; /* Space remaining in buffer (in bytes) */
@ -1628,13 +1678,20 @@ static void putchars(scheme *sc, const char *chars, int char_cnt) {
}
#endif
} else {
free_bytes = pt->rep.string.past_the_end - pt->rep.string.curr;
if (free_bytes > 0)
if (pt->rep.string.past_the_end != pt->rep.string.curr)
{
free_bytes = pt->rep.string.past_the_end - pt->rep.string.curr;
l = min(char_cnt, free_bytes);
memcpy(pt->rep.string.curr, chars, l);
pt->rep.string.curr += l;
}
else if(pt->kind&port_srfi6&&realloc_port_string(sc,pt))
{
free_bytes = pt->rep.string.past_the_end - pt->rep.string.curr;
l = min(char_cnt, free_bytes);
memcpy(pt->rep.string.curr, chars, char_cnt);
pt->rep.string.curr += l;
}
}
}
@ -3840,13 +3897,11 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
#if USE_STRING_PORTS
case OP_OPEN_INSTRING: /* open-input-string */
case OP_OPEN_OUTSTRING: /* open-output-string */
case OP_OPEN_INOUTSTRING: /* open-input-output-string */ {
int prop=0;
pointer p;
switch(op) {
case OP_OPEN_INSTRING: prop=port_input; break;
case OP_OPEN_OUTSTRING: prop=port_output; break;
case OP_OPEN_INOUTSTRING: prop=port_input|port_output; break;
default: break; /* Quiet the compiler */
}
@ -3857,6 +3912,43 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
}
s_return(sc,p);
}
case OP_OPEN_OUTSTRING: /* open-output-string */ {
pointer p;
if(car(sc->args)==sc->NIL) {
p=port_from_scratch(sc);
if(p==sc->NIL) {
s_return(sc,sc->F);
}
} else {
p=port_from_string(sc, strvalue(car(sc->args)),
strvalue(car(sc->args))+strlength(car(sc->args)),
port_output);
if(p==sc->NIL) {
s_return(sc,sc->F);
}
}
s_return(sc,p);
}
case OP_GET_OUTSTRING: /* get-output-string */ {
port *p;
if ((p=car(sc->args)->_object._port)->kind&port_string) {
off_t size;
char *str;
size=p->rep.string.curr-p->rep.string.start+1;
if(str=sc->malloc(size)) {
pointer s;
memcpy(str,p->rep.string.start,size-1);
str[size-1]='\0';
s=mk_string(sc,str);
sc->free(str);
s_return(sc,s);
}
}
s_return(sc,sc->F);
}
#endif
case OP_CLOSE_INPORT: /* close-input-port */