suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

369.6: change WXME format to start with #reader, and fix 3m bug related to integers overlapping with pointers in a thread record

Browse Source 
svn: r5425
This commit is contained in:
Matthew Flatt 2007-01-22 03:47:32 +00:00
parent 42bf3cfbe0
commit 5fa4e9e5d1
26 changed files with 384 additions and 260 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/release-notes/mred/HISTORY
View File

@ -1,3 +1,8 @@
Version 369.6
WXME file format changed to include a #reader() prefix
Version 369.5
Mac OS X printer-dc% uses scaling specified by the current ps-setup%

3
doc/release-notes/mzscheme/HISTORY
View File

@ -1,3 +1,6 @@
Version 369.6
Default load handler enables #reader (even when not reading a module)
Version 369.5
print-struct defaults to #t instead of #f
Changed make-exn to automatically convert a mutable message string

43
src/mred/wxme/wx_mbuf.cxx
View File

@ -694,6 +694,7 @@ void wxMediaBuffer::SetSnipData(wxSnip *, wxBufferData *)
Bool wxWriteMediaVersion(wxMediaStreamOut *f, wxMediaStreamOutBase *b)
{
b->Write(MRED_READER_STR, MRED_READER_STR_LEN);
b->Write(MRED_START_STR, MRED_START_STR_LEN);
b->Write(MRED_FORMAT_STR, MRED_FORMAT_STR_LEN);
b->Write(MRED_VERSION_STR, MRED_VERSION_STR_LEN);
@ -702,17 +703,51 @@ Bool wxWriteMediaVersion(wxMediaStreamOut *f, wxMediaStreamOutBase *b)
return !b->Bad();
}
Bool wxDetectWXMEFile(const char *who, Scheme_Object *f, int peek)
{
char sbuffer[MRED_START_STR_LEN+MRED_READER_STR_LEN+1];
int n;
n = scheme_get_byte_string(who, f, sbuffer, 0, MRED_START_STR_LEN, 0, peek, NULL);
sbuffer[MRED_START_STR_LEN] = 0;
if ((n != MRED_START_STR_LEN) || strcmp(sbuffer, MRED_START_STR)) {
if (!strncmp(sbuffer, MRED_READER_STR, MRED_START_STR_LEN)) {
/* So far, it looks like the #reader prefix... */
if (peek)
n = scheme_get_byte_string(who, f, sbuffer, 0, MRED_READER_STR_LEN + MRED_START_STR_LEN, 0, 1, NULL);
else
n += scheme_get_byte_string(who, f, sbuffer XFORM_OK_PLUS MRED_START_STR_LEN, 0, MRED_READER_STR_LEN, 0, 0, NULL);
sbuffer[MRED_READER_STR_LEN + MRED_START_STR_LEN] = 0;
if ((n != (MRED_READER_STR_LEN + MRED_START_STR_LEN)) || strcmp(sbuffer, MRED_READER_STR MRED_START_STR))
return 0;
} else
return 0;
}
return 1;
}
Bool wxReadMediaVersion(wxMediaStreamIn *mf, wxMediaStreamInBase *b, Bool parseFormat, Bool showErrors)
{
char vbuf[MRED_FORMAT_STR_LEN + MRED_VERSION_STR_LEN + MRED_START_STR_LEN + 1];
char vbuf[MRED_READER_STR_LEN + MRED_FORMAT_STR_LEN + MRED_VERSION_STR_LEN + MRED_START_STR_LEN + 1];
if (parseFormat) {
memset(vbuf, 0, MRED_START_STR_LEN + 1);
b->Read(vbuf, MRED_START_STR_LEN);
if (strcmp(vbuf, MRED_START_STR)) {
if (showErrors)
wxmeError("insert-file in pasteboard%: not a MrEd editor<%> file");
return FALSE;
/* Maybe we have a #reader... prefix? */
b->Read(vbuf XFORM_OK_PLUS MRED_START_STR_LEN, MRED_READER_STR_LEN - MRED_START_STR_LEN);
if (!strcmp(vbuf, MRED_READER_STR)) {
/* Yes, so try reading start again. */
memset(vbuf, 0, MRED_START_STR_LEN + 1);
b->Read(vbuf, MRED_START_STR_LEN);
}
if (strcmp(vbuf, MRED_START_STR)) {
if (showErrors)
wxmeError("insert-file in pasteboard%: not a MrEd editor<%> file");
return FALSE;
}
}
}

1
src/mred/wxme/wx_medad.h
View File

@ -21,6 +21,7 @@ enum {
#define STD_STYLE "Standard"
extern int wxmeCheckFormatAndVersion(wxMediaStreamIn *s, wxMediaStreamInBase *b, Bool showErrors);
extern Bool wxDetectWXMEFile(const char *who, Scheme_Object *f, int peek);
class wxMediaAdmin;
class wxKeymap;

14
src/mred/wxme/wx_media.cxx
View File

@ -3182,17 +3182,15 @@ Bool wxMediaEdit::InsertFile(const char *who, Scheme_Object *f, char *WXUNUSED(f
{
long n;
const int BUF_SIZE = 1000;
char sbuffer[MRED_START_STR_LEN+1];
wxchar buffer[BUF_SIZE];
Bool fileerr;
if (*format == wxMEDIA_FF_GUESS) {
n = scheme_get_byte_string(who, f, sbuffer, 0, MRED_START_STR_LEN, 0, 1, NULL);
sbuffer[MRED_START_STR_LEN] = 0;
if ((n != MRED_START_STR_LEN) || strcmp(sbuffer, MRED_START_STR))
if (!wxDetectWXMEFile(who, f, 1)) {
*format = wxMEDIA_FF_TEXT;
else
} else {
*format = wxMEDIA_FF_STD;
}
}
fileerr = FALSE;
@ -3200,9 +3198,7 @@ Bool wxMediaEdit::InsertFile(const char *who, Scheme_Object *f, char *WXUNUSED(f
showErrors = TRUE;
if (*format == wxMEDIA_FF_STD) {
n = scheme_get_byte_string(who, f, sbuffer, 0, MRED_START_STR_LEN, 0, 1, NULL);
sbuffer[MRED_START_STR_LEN] = 0;
if ((n != MRED_START_STR_LEN) || strcmp(sbuffer, MRED_START_STR)){
if (!wxDetectWXMEFile(who, f, 1)) {
if (showErrors) {
char ebuf[256];
sprintf(ebuf, "%s: not a MrEd editor<%%> file", who);
@ -3213,7 +3209,7 @@ Bool wxMediaEdit::InsertFile(const char *who, Scheme_Object *f, char *WXUNUSED(f
wxMediaStreamInFileBase *b;
wxMediaStreamIn *mf;
scheme_get_byte_string(who, f, sbuffer, 0, MRED_START_STR_LEN, 0, 0, NULL);
wxDetectWXMEFile(who, f, 0);
b = new WXGC_PTRS wxMediaStreamInFileBase(f);
mf = new WXGC_PTRS wxMediaStreamIn(b);

13
src/mred/wxme/wx_medio.cxx
View File

@ -1513,17 +1513,20 @@ void wxMediaStreamOut::PrettyStart()
}
s = "#|\n This file is in PLT Scheme editor format.\n";
f->Write(s, strlen(s));
s = " Open this file in DrScheme version " MZSCHEME_WRITER_VERSION " or later to read it.\n";
f->Write(s, strlen(s));
s = "\n";
f->Write(s, strlen(s));
s = " Most likely, it was created by saving a program in DrScheme,\n";
f->Write(s, strlen(s));
s = " and it probably contains a program with non-text elements (such\n";
s = " and it probably contains a program with non-text elements\n";
f->Write(s, strlen(s));
s = " as pictures, comment boxes, or test-cases boxes).\n";
s = " (such as images or comment boxes).\n";
f->Write(s, strlen(s));
s = " Open this file in DrScheme to read its content.\n";
s = "\n";
f->Write(s, strlen(s));
s = " www.plt-scheme.org\n|#\n";
s = " http://www.plt-scheme.org\n|#\n";
f->Write(s, strlen(s));
col = 0;
}
}

4
src/mred/wxme/wx_medio.h
View File

@ -95,12 +95,16 @@ class wxMediaStreamOutStringBase : public wxMediaStreamOutBase
/*******************************************************************/
#define MRED_READER_STR "#reader(lib\"read.ss\"\"wxme\")"
#define MRED_READER_STR_LEN 27
#define MRED_START_STR_LEN 4
#define MRED_START_STR "WXME"
#define MRED_START_STR_LEN 4
#define MRED_FORMAT_STR "01"
#define MRED_FORMAT_STR_LEN 2
#define MRED_VERSION_STR "08"
#define MRED_VERSION_STR_LEN 2
#define MZSCHEME_WRITER_VERSION "370"
#define WXME_VERSION_ONE(f) (f->read_version[1] == '1')
#define WXME_VERSION_TWO(f) (f->read_version[1] == '2')

4
src/mred/wxme/wx_mpbrd.cxx
View File

@ -2575,9 +2575,7 @@ Bool wxMediaPasteboard::InsertFile(const char *who, Scheme_Object *f, const char
showErrors = TRUE;
n = scheme_get_byte_string(who, f, buffer, 0, MRED_START_STR_LEN, 0, 0, NULL);
buffer[MRED_START_STR_LEN] = 0;
if ((n != MRED_START_STR_LEN) || strcmp(buffer, MRED_START_STR)) {
if (!wxDetectWXMEFile(who, f, 0)) {
if (showErrors)
wxmeError("insert-file in pasteboard%: not a MrEd editor<%> file");
fileerr = TRUE;

5
src/mred/wxme/wx_style.cxx
View File

@ -1673,6 +1673,11 @@ wxStyleList *wxmbReadStylesFromFile(wxStyleList *styleList,
f->Get(&shiftIndex);
if (shiftIndex >= i) {
wxmeError("map-index-to-style: bad shift-style index");
return FALSE;
}
js = styleList->FindOrCreateJoinStyle(ssl->styleMap[baseIndex],
ssl->styleMap[shiftIndex]);
ssl->styleMap[i] = js;

1
src/mzscheme/include/mzscheme.exp
View File

@ -253,6 +253,7 @@ scheme_make_sema
scheme_post_sema
scheme_post_sema_all
scheme_wait_sema
scheme_try_plain_sema
scheme_char_constants
scheme_make_channel
scheme_make_channel_put_evt

1
src/mzscheme/include/mzscheme3m.exp
View File

@ -260,6 +260,7 @@ scheme_make_sema
scheme_post_sema
scheme_post_sema_all
scheme_wait_sema
scheme_try_plain_sema
scheme_char_constants
scheme_make_channel
scheme_make_channel_put_evt

1
src/mzscheme/include/mzwin.def
View File

@ -241,6 +241,7 @@ EXPORTS
scheme_post_sema
scheme_post_sema_all
scheme_wait_sema
scheme_try_plain_sema
scheme_char_constants
scheme_make_channel
scheme_make_channel_put_evt

1
src/mzscheme/include/mzwin3m.def
View File

@ -252,6 +252,7 @@ EXPORTS
scheme_post_sema
scheme_post_sema_all
scheme_wait_sema
scheme_try_plain_sema
scheme_char_constants
scheme_make_channel
scheme_make_channel_put_evt

2
src/mzscheme/include/scheme.h
View File

@ -1002,7 +1002,7 @@ typedef struct Scheme_Thread {
Scheme_Object **values_buffer;
int values_buffer_size;
union {
struct { /* used to be a union, but that confuses MZ_PRECISE_GC */
struct {
Scheme_Object *wait_expr;
} eval;

14
src/mzscheme/src/mzmark.c
View File

@ -1616,6 +1616,13 @@ static int thread_val_MARK(void *p) {
gcMARK(pr->tail_buffer);
gcMARK(pr->ku.eval.wait_expr);
gcMARK(pr->ku.apply.tail_rator);
gcMARK(pr->ku.apply.tail_rands);
gcMARK(pr->ku.multiple.array);
gcMARK(pr->ku.k.p1);
gcMARK(pr->ku.k.p2);
gcMARK(pr->ku.k.p3);
@ -1703,6 +1710,13 @@ static int thread_val_FIXUP(void *p) {
gcFIXUP(pr->tail_buffer);
gcFIXUP(pr->ku.eval.wait_expr);
gcFIXUP(pr->ku.apply.tail_rator);
gcFIXUP(pr->ku.apply.tail_rands);
gcFIXUP(pr->ku.multiple.array);
gcFIXUP(pr->ku.k.p1);
gcFIXUP(pr->ku.k.p2);
gcFIXUP(pr->ku.k.p3);

7
src/mzscheme/src/mzmarksrc.c
View File

@ -646,6 +646,13 @@ thread_val {
gcMARK(pr->tail_buffer);
gcMARK(pr->ku.eval.wait_expr);
gcMARK(pr->ku.apply.tail_rator);
gcMARK(pr->ku.apply.tail_rands);
gcMARK(pr->ku.multiple.array);
gcMARK(pr->ku.k.p1);
gcMARK(pr->ku.k.p2);
gcMARK(pr->ku.k.p3);

464
src/mzscheme/src/port.c
View File

@ -1746,7 +1746,7 @@ int scheme_unless_ready(Scheme_Object *unless)
return 1;
if (SCHEME_CDR(unless))
return scheme_wait_sema(SCHEME_CDR(unless), 1);
return scheme_try_plain_sema(SCHEME_CDR(unless));
return 0;
}
@ -4648,6 +4648,241 @@ fd_byte_ready (Scheme_Input_Port *port)
}
}
static long fd_get_string_slow(Scheme_Input_Port *port,
char *buffer, long offset, long size,
int nonblock,
Scheme_Object *unless)
{
Scheme_FD *fip;
long bc;
fip = (Scheme_FD *)port->port_data;
while (1) {
/* Loop until a read succeeds. */
int none_avail = 0;
int target_size, target_offset, ext_target;
char *target;
/* If no chars appear to be ready, go to sleep. */
while (!fd_byte_ready(port)) {
if (nonblock > 0)
return 0;
scheme_block_until_unless((Scheme_Ready_Fun)fd_byte_ready,
(Scheme_Needs_Wakeup_Fun)fd_need_wakeup,
(Scheme_Object *)port,
0.0, unless,
nonblock);
scheme_wait_input_allowed(port, nonblock);
if (scheme_unless_ready(unless))
return SCHEME_UNLESS_READY;
}
if (port->closed) {
/* Another thread closed the input port while we were waiting. */
/* Call scheme_getc to signal the error */
scheme_get_byte((Scheme_Object *)port);
}
/* Another thread might have filled the buffer, or
if SOME_FDS_ARE_NOT_SELECTABLE is set,
fd_byte_ready might have read one character. */
if (fip->bufcount) {
bc = ((size <= fip->bufcount)
? size
: fip->bufcount);
memcpy(buffer + offset, fip->buffer + fip->buffpos, bc);
fip->buffpos += bc;
fip->bufcount -= bc;
return bc;
}
if ((size >= MZPORT_FD_DIRECT_THRESHOLD) && (fip->flush != MZ_FLUSH_ALWAYS)) {
ext_target = 1;
target = buffer;
target_offset = offset;
target_size = size;
} else {
ext_target = 0;
target = (char *)fip->buffer;
target_offset = 0;
if (fip->flush == MZ_FLUSH_ALWAYS)
target_size = 1;
else
target_size = MZPORT_FD_BUFFSIZE;
}
#ifdef WINDOWS_FILE_HANDLES
if (!fip->th) {
/* We can read directly. This must be a regular file, where
reading never blocks. */
DWORD rgot, delta;
if (fip->textmode) {
ext_target = 0;
target = fip->buffer;
target_offset = 0;
if (fip->flush == MZ_FLUSH_ALWAYS)
target_size = 1;
else
target_size = MZPORT_FD_BUFFSIZE;
}
rgot = target_size;
/* Pending CR in text mode? */
if (fip->textmode == 2) {
delta = 1;
if (rgot > 1)
rgot--;
fip->buffer[0] = '\r';
} else
delta = 0;
if (ReadFile((HANDLE)fip->fd, target XFORM_OK_PLUS target_offset + delta, rgot, &rgot, NULL)) {
bc = rgot;
} else {
int errid;
bc = -1;
errid = GetLastError();
errno = errid;
}
/* bc == 0 and no err => EOF */
/* Finish text-mode handling: */
if (fip->textmode && (bc >= 0)) {
int i, j;
unsigned char *buf;
if (fip->textmode == 2) {
/* we had added a CR */
bc++;
fip->textmode = 1;
}
/* If bc is only 1, then we've reached the end, and
any leftover CR there should stay. */
if (bc > 1) {
/* Collapse CR-LF: */
buf = fip->buffer;
for (i = 0, j = 0; i < bc - 1; i++) {
if ((buf[i] == '\r')
&& (buf[i+1] == '\n')) {
buf[j++] = '\n';
i++;
} else
buf[j++] = buf[i];
}
if (i < bc) /* common case: didn't end with CRLF */
buf[j++] = buf[i];
bc = j;
/* Check for CR at end; if there, save it to maybe get a
LF on the next read: */
if (buf[bc - 1] == '\r') {
bc--;
fip->textmode = 2; /* 2 indicates a leftover CR */
}
}
}
} else {
ext_target = 0;
/* If we get this far, there's definitely data available.
Extract data made available by the reader thread. */
if (fip->th->eof) {
bc = 0;
if (fip->th->eof != INVALID_HANDLE_VALUE) {
ReleaseSemaphore(fip->th->eof, 1, NULL);
fip->th->eof = NULL;
}
} else if (fip->th->err) {
bc = -1;
errno = fip->th->err;
} else {
bc = fip->th->avail;
fip->th->avail = 0;
}
}
#else
# ifdef MAC_FILE_HANDLES
{
SInt32 cnt = target_size;
errno = FSRead(fip->fd, &cnt, target + target_offset);
if (!cnt && (errno != eofErr))
bc = -1;
else
bc = cnt;
}
# else
if (fip->regfile) {
do {
bc = read(fip->fd, target + target_offset, target_size);
} while ((bc == -1) && (errno == EINTR));
} else {
/* We use a non-blocking read here, even though we've waited
for input above, because an external process might have
gobbled the characters that we expected to get. */
int old_flags;
old_flags = fcntl(fip->fd, F_GETFL, 0);
fcntl(fip->fd, F_SETFL, old_flags | MZ_NONBLOCKING);
do {
bc = read(fip->fd, target + target_offset, target_size);
} while ((bc == -1) && errno == EINTR);
fcntl(fip->fd, F_SETFL, old_flags);
if ((bc == -1) && (errno == EAGAIN)) {
none_avail = 1;
bc = 0;
}
}
# endif
#endif
if (!none_avail) {
if (ext_target && (bc > 0)) {
return bc;
}
fip->bufcount = bc;
if (fip->bufcount < 0) {
fip->bufcount = 0;
fip->buffpos = 0;
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"error reading from stream port %V (" FILENAME_EXN_E ")",
port->name, errno);
return 0;
}
if (!fip->bufcount) {
fip->buffpos = 0;
return EOF;
} else {
bc = ((size <= fip->bufcount)
? size
: fip->bufcount);
memcpy(buffer + offset, fip->buffer, bc);
fip->buffpos = bc;
fip->bufcount -= bc;
return bc;
}
} else if (nonblock > 0) {
return 0;
}
}
}
static long fd_get_string(Scheme_Input_Port *port,
char *buffer, long offset, long size,
int nonblock,
@ -4656,6 +4891,9 @@ static long fd_get_string(Scheme_Input_Port *port,
Scheme_FD *fip;
long bc;
/* Buffer-reading fast path is designed to avoid GC,
and thus avoid MZ_PRECISE_GC instrumentation. */
if (unless && scheme_unless_ready(unless))
return SCHEME_UNLESS_READY;
@ -4681,229 +4919,7 @@ static long fd_get_string(Scheme_Input_Port *port,
if ((nonblock == 2) && (fip->flush == MZ_FLUSH_ALWAYS))
return 0;
while (1) {
/* Loop until a read succeeds. */
int none_avail = 0;
int target_size, target_offset, ext_target;
char *target;
/* If no chars appear to be ready, go to sleep. */
while (!fd_byte_ready(port)) {
if (nonblock > 0)
return 0;
scheme_block_until_unless((Scheme_Ready_Fun)fd_byte_ready,
(Scheme_Needs_Wakeup_Fun)fd_need_wakeup,
(Scheme_Object *)port,
0.0, unless,
nonblock);
scheme_wait_input_allowed(port, nonblock);
if (scheme_unless_ready(unless))
return SCHEME_UNLESS_READY;
}
if (port->closed) {
/* Another thread closed the input port while we were waiting. */
/* Call scheme_getc to signal the error */
scheme_get_byte((Scheme_Object *)port);
}
/* Another thread might have filled the buffer, or
if SOME_FDS_ARE_NOT_SELECTABLE is set,
fd_byte_ready might have read one character. */
if (fip->bufcount) {
bc = ((size <= fip->bufcount)
? size
: fip->bufcount);
memcpy(buffer + offset, fip->buffer + fip->buffpos, bc);
fip->buffpos += bc;
fip->bufcount -= bc;
return bc;
}
if ((size >= MZPORT_FD_DIRECT_THRESHOLD) && (fip->flush != MZ_FLUSH_ALWAYS)) {
ext_target = 1;
target = buffer;
target_offset = offset;
target_size = size;
} else {
ext_target = 0;
target = (char *)fip->buffer;
target_offset = 0;
if (fip->flush == MZ_FLUSH_ALWAYS)
target_size = 1;
else
target_size = MZPORT_FD_BUFFSIZE;
}
#ifdef WINDOWS_FILE_HANDLES
if (!fip->th) {
/* We can read directly. This must be a regular file, where
reading never blocks. */
DWORD rgot, delta;
if (fip->textmode) {
ext_target = 0;
target = fip->buffer;
target_offset = 0;
if (fip->flush == MZ_FLUSH_ALWAYS)
target_size = 1;
else
target_size = MZPORT_FD_BUFFSIZE;
}
rgot = target_size;
/* Pending CR in text mode? */
if (fip->textmode == 2) {
delta = 1;
if (rgot > 1)
rgot--;
fip->buffer[0] = '\r';
} else
delta = 0;
if (ReadFile((HANDLE)fip->fd, target XFORM_OK_PLUS target_offset + delta, rgot, &rgot, NULL)) {
bc = rgot;
} else {
int errid;
bc = -1;
errid = GetLastError();
errno = errid;
}
/* bc == 0 and no err => EOF */
/* Finish text-mode handling: */
if (fip->textmode && (bc >= 0)) {
int i, j;
unsigned char *buf;
if (fip->textmode == 2) {
/* we had added a CR */
bc++;
fip->textmode = 1;
}
/* If bc is only 1, then we've reached the end, and
any leftover CR there should stay. */
if (bc > 1) {
/* Collapse CR-LF: */
buf = fip->buffer;
for (i = 0, j = 0; i < bc - 1; i++) {
if ((buf[i] == '\r')
&& (buf[i+1] == '\n')) {
buf[j++] = '\n';
i++;
} else
buf[j++] = buf[i];
}
if (i < bc) /* common case: didn't end with CRLF */
buf[j++] = buf[i];
bc = j;
/* Check for CR at end; if there, save it to maybe get a
LF on the next read: */
if (buf[bc - 1] == '\r') {
bc--;
fip->textmode = 2; /* 2 indicates a leftover CR */
}
}
}
} else {
ext_target = 0;
/* If we get this far, there's definitely data available.
Extract data made available by the reader thread. */
if (fip->th->eof) {
bc = 0;
if (fip->th->eof != INVALID_HANDLE_VALUE) {
ReleaseSemaphore(fip->th->eof, 1, NULL);
fip->th->eof = NULL;
}
} else if (fip->th->err) {
bc = -1;
errno = fip->th->err;
} else {
bc = fip->th->avail;
fip->th->avail = 0;
}
}
#else
# ifdef MAC_FILE_HANDLES
{
SInt32 cnt = target_size;
errno = FSRead(fip->fd, &cnt, target + target_offset);
if (!cnt && (errno != eofErr))
bc = -1;
else
bc = cnt;
}
# else
if (fip->regfile) {
do {
bc = read(fip->fd, target + target_offset, target_size);
} while ((bc == -1) && (errno == EINTR));
} else {
/* We use a non-blocking read here, even though we've waited
for input above, because an external process might have
gobbled the characters that we expected to get. */
int old_flags;
old_flags = fcntl(fip->fd, F_GETFL, 0);
fcntl(fip->fd, F_SETFL, old_flags | MZ_NONBLOCKING);
do {
bc = read(fip->fd, target + target_offset, target_size);
} while ((bc == -1) && errno == EINTR);
fcntl(fip->fd, F_SETFL, old_flags);
if ((bc == -1) && (errno == EAGAIN)) {
none_avail = 1;
bc = 0;
}
}
# endif
#endif
if (!none_avail) {
if (ext_target && (bc > 0)) {
return bc;
}
fip->bufcount = bc;
if (fip->bufcount < 0) {
fip->bufcount = 0;
fip->buffpos = 0;
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"error reading from stream port %V (" FILENAME_EXN_E ")",
port->name, errno);
return 0;
}
if (!fip->bufcount) {
fip->buffpos = 0;
return EOF;
} else {
bc = ((size <= fip->bufcount)
? size
: fip->bufcount);
memcpy(buffer + offset, fip->buffer, bc);
fip->buffpos = bc;
fip->bufcount -= bc;
return bc;
}
} else if (nonblock > 0) {
return 0;
}
}
return fd_get_string_slow(port, buffer, offset, size, nonblock, unless);
}
}

22
src/mzscheme/src/portfun.c
View File

@ -784,7 +784,7 @@ Scheme_Port *scheme_port_record(Scheme_Object *port)
return (Scheme_Port *)scheme_output_port_record(port);
}
Scheme_Input_Port *scheme_input_port_record(Scheme_Object *port)
static MZ_INLINE Scheme_Input_Port *input_port_record_slow(Scheme_Object *port)
{
Scheme_Object *v;
@ -812,7 +812,16 @@ Scheme_Input_Port *scheme_input_port_record(Scheme_Object *port)
}
}
Scheme_Output_Port *scheme_output_port_record(Scheme_Object *port)
Scheme_Input_Port *scheme_input_port_record(Scheme_Object *port)
{
/* Avoid MZ_PRECISE_GC instrumentation in the common case: */
if (SCHEME_INPORTP(port))
return (Scheme_Input_Port *)port;
else
return input_port_record_slow(port);
}
static MZ_INLINE Scheme_Output_Port *output_port_record_slow(Scheme_Object *port)
{
Scheme_Object *v;
@ -840,6 +849,15 @@ Scheme_Output_Port *scheme_output_port_record(Scheme_Object *port)
}
}
Scheme_Output_Port *scheme_output_port_record(Scheme_Object *port)
{
/* Avoid MZ_PRECISE_GC instrumentation in the common case: */
if (SCHEME_OUTPORTP(port))
return (Scheme_Output_Port *)port;
else
return output_port_record_slow(port);
}
int scheme_is_input_port(Scheme_Object *port)
{
if (SCHEME_INPORTP(port))

8
src/mzscheme/src/read.c
View File

@ -1891,8 +1891,12 @@ _scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int h
params.can_read_box = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_CAN_READ_GRAPH);
params.can_read_graph = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_CAN_READ_READER);
params.can_read_reader = SCHEME_TRUEP(v);
if (crc) {
params.can_read_reader = 1;
} else {
v = scheme_get_param(config, MZCONFIG_CAN_READ_READER);
params.can_read_reader = SCHEME_TRUEP(v);
}
v = scheme_get_param(config, MZCONFIG_CASE_SENS);
params.case_sensitive = SCHEME_TRUEP(v);
v = scheme_get_param(config, MZCONFIG_SQUARE_BRACKETS_ARE_PARENS);

3
src/mzscheme/src/schemef.h
View File

@ -110,7 +110,7 @@ MZ_EXTERN int scheme_block_until_unless(Scheme_Ready_Fun f, Scheme_Needs_Wakeup_
int enable_break);
MZ_EXTERN void scheme_wait_input_allowed(Scheme_Input_Port *port, int nonblock);
MZ_EXTERN int scheme_unless_ready(Scheme_Object *unless);
XFORM_NONGCING MZ_EXTERN int scheme_unless_ready(Scheme_Object *unless);
MZ_EXTERN int scheme_in_main_thread(void);
@ -508,6 +508,7 @@ MZ_EXTERN Scheme_Object *scheme_make_sema(long v);
MZ_EXTERN void scheme_post_sema(Scheme_Object *o);
MZ_EXTERN void scheme_post_sema_all(Scheme_Object *o);
MZ_EXTERN int scheme_wait_sema(Scheme_Object *o, int just_try);
XFORM_NONGCING MZ_EXTERN int scheme_try_plain_sema(Scheme_Object *o);
MZ_EXTERN Scheme_Object **scheme_char_constants;
MZ_EXTERN Scheme_Object *scheme_make_channel();

1
src/mzscheme/src/schemex.h
View File

@ -419,6 +419,7 @@ Scheme_Object *(*scheme_make_sema)(long v);
void (*scheme_post_sema)(Scheme_Object *o);
void (*scheme_post_sema_all)(Scheme_Object *o);
int (*scheme_wait_sema)(Scheme_Object *o, int just_try);
int (*scheme_try_plain_sema)(Scheme_Object *o);
Scheme_Object **scheme_char_constants;
Scheme_Object *(*scheme_make_channel)();
Scheme_Object *(*scheme_make_channel_put_evt)(Scheme_Object *ch, Scheme_Object *v);

1
src/mzscheme/src/schemex.inc
View File

@ -284,6 +284,7 @@
scheme_extension_table->scheme_post_sema = scheme_post_sema;
scheme_extension_table->scheme_post_sema_all = scheme_post_sema_all;
scheme_extension_table->scheme_wait_sema = scheme_wait_sema;
scheme_extension_table->scheme_try_plain_sema = scheme_try_plain_sema;
scheme_extension_table->scheme_char_constants = scheme_char_constants;
scheme_extension_table->scheme_make_channel = scheme_make_channel;
scheme_extension_table->scheme_make_channel_put_evt = scheme_make_channel_put_evt;

1
src/mzscheme/src/schemexm.h
View File

@ -284,6 +284,7 @@
#define scheme_post_sema (scheme_extension_table->scheme_post_sema)
#define scheme_post_sema_all (scheme_extension_table->scheme_post_sema_all)
#define scheme_wait_sema (scheme_extension_table->scheme_wait_sema)
#define scheme_try_plain_sema (scheme_extension_table->scheme_try_plain_sema)
#define scheme_char_constants (scheme_extension_table->scheme_char_constants)
#define scheme_make_channel (scheme_extension_table->scheme_make_channel)
#define scheme_make_channel_put_evt (scheme_extension_table->scheme_make_channel_put_evt)

2
src/mzscheme/src/schminc.h
View File

@ -11,7 +11,7 @@
EXPECTED_PRIM_COUNT to the new value, and then USE_COMPILED_STARTUP
can be set to 1 again. */
#define USE_COMPILED_STARTUP 1
#define USE_COMPILED_STARTUP 0
#define EXPECTED_PRIM_COUNT 888

4
src/mzscheme/src/schvers.h
View File

@ -9,6 +9,6 @@
#define MZSCHEME_VERSION_MAJOR 369
#define MZSCHEME_VERSION_MINOR 5
#define MZSCHEME_VERSION_MINOR 6
#define MZSCHEME_VERSION "369.5" _MZ_SPECIAL_TAG
#define MZSCHEME_VERSION "369.6" _MZ_SPECIAL_TAG

19
src/mzscheme/src/sema.c
View File

@ -530,6 +530,18 @@ static int try_channel(Scheme_Sema *sema, Syncing *syncing, int pos, Scheme_Obje
}
}
int scheme_try_plain_sema(Scheme_Object *o)
{
Scheme_Sema *sema = (Scheme_Sema *)o;
if (sema->value) {
if (sema->value > 0)
--sema->value;
return 1;
} else
return 0;
}
int scheme_wait_semas_chs(int n, Scheme_Object **o, int just_try, Syncing *syncing)
/* When syncing is supplied, o can contain Scheme_Channel_Syncer
and never-evt values, and just_try must be 0. */
@ -542,12 +554,7 @@ int scheme_wait_semas_chs(int n, Scheme_Object **o, int just_try, Syncing *synci
Scheme_Sema *sema = semas[0];
if (just_try > 0) {
if (sema->so.type == scheme_sema_type) {
if (sema->value) {
if (sema->value > 0)
--sema->value;
v = 1;
} else
v = 0;
v = scheme_try_plain_sema((Scheme_Object *)sema);
} else {
v = try_channel(sema, syncing, 0, NULL);
}