Permalink
Browse files

Applied changes based on official version of TinyScheme (CVS commit d…

…ated

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.
  • Loading branch information...
1 parent 57f44b8 commit bf3d355fd7a95b132473746374408edddd1990b4 Kevin Cozens committed Aug 4, 2009
View
@@ -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
@@ -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.
@@ -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
@@ -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 )
@@ -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
};
@@ -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 */

0 comments on commit bf3d355

Please sign in to comment.