From 5fa4e9e5d159121cac4dce0462bd766bb0e6fea9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 22 Jan 2007 03:47:32 +0000 Subject: [PATCH] 369.6: change WXME format to start with #reader, and fix 3m bug related to integers overlapping with pointers in a thread record svn: r5425 --- doc/release-notes/mred/HISTORY | 5 + doc/release-notes/mzscheme/HISTORY | 3 + src/mred/wxme/wx_mbuf.cxx | 43 ++- src/mred/wxme/wx_medad.h | 1 + src/mred/wxme/wx_media.cxx | 14 +- src/mred/wxme/wx_medio.cxx | 13 +- src/mred/wxme/wx_medio.h | 4 + src/mred/wxme/wx_mpbrd.cxx | 4 +- src/mred/wxme/wx_style.cxx | 5 + src/mzscheme/include/mzscheme.exp | 1 + src/mzscheme/include/mzscheme3m.exp | 1 + src/mzscheme/include/mzwin.def | 1 + src/mzscheme/include/mzwin3m.def | 1 + src/mzscheme/include/scheme.h | 2 +- src/mzscheme/src/mzmark.c | 14 + src/mzscheme/src/mzmarksrc.c | 7 + src/mzscheme/src/port.c | 464 ++++++++++++++-------------- src/mzscheme/src/portfun.c | 22 +- src/mzscheme/src/read.c | 8 +- src/mzscheme/src/schemef.h | 3 +- src/mzscheme/src/schemex.h | 1 + src/mzscheme/src/schemex.inc | 1 + src/mzscheme/src/schemexm.h | 1 + src/mzscheme/src/schminc.h | 2 +- src/mzscheme/src/schvers.h | 4 +- src/mzscheme/src/sema.c | 19 +- 26 files changed, 384 insertions(+), 260 deletions(-) diff --git a/doc/release-notes/mred/HISTORY b/doc/release-notes/mred/HISTORY index 5651883820..8d9755585f 100644 --- a/doc/release-notes/mred/HISTORY +++ b/doc/release-notes/mred/HISTORY @@ -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% diff --git a/doc/release-notes/mzscheme/HISTORY b/doc/release-notes/mzscheme/HISTORY index 67f3af7872..1b96290edb 100644 --- a/doc/release-notes/mzscheme/HISTORY +++ b/doc/release-notes/mzscheme/HISTORY @@ -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 diff --git a/src/mred/wxme/wx_mbuf.cxx b/src/mred/wxme/wx_mbuf.cxx index e8abd16308..08a56a78e2 100644 --- a/src/mred/wxme/wx_mbuf.cxx +++ b/src/mred/wxme/wx_mbuf.cxx @@ -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; + } } } diff --git a/src/mred/wxme/wx_medad.h b/src/mred/wxme/wx_medad.h index 93d31ac777..5b86f32d38 100644 --- a/src/mred/wxme/wx_medad.h +++ b/src/mred/wxme/wx_medad.h @@ -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; diff --git a/src/mred/wxme/wx_media.cxx b/src/mred/wxme/wx_media.cxx index 7adaab660c..5cf17760d5 100644 --- a/src/mred/wxme/wx_media.cxx +++ b/src/mred/wxme/wx_media.cxx @@ -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); diff --git a/src/mred/wxme/wx_medio.cxx b/src/mred/wxme/wx_medio.cxx index f89d4aca19..766e2e85e0 100644 --- a/src/mred/wxme/wx_medio.cxx +++ b/src/mred/wxme/wx_medio.cxx @@ -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; } } - diff --git a/src/mred/wxme/wx_medio.h b/src/mred/wxme/wx_medio.h index b6383c170b..053e670a2a 100644 --- a/src/mred/wxme/wx_medio.h +++ b/src/mred/wxme/wx_medio.h @@ -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') diff --git a/src/mred/wxme/wx_mpbrd.cxx b/src/mred/wxme/wx_mpbrd.cxx index 5fc2c9a482..a9bf3aefd9 100644 --- a/src/mred/wxme/wx_mpbrd.cxx +++ b/src/mred/wxme/wx_mpbrd.cxx @@ -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; diff --git a/src/mred/wxme/wx_style.cxx b/src/mred/wxme/wx_style.cxx index d7626e1cfc..9d16ac5646 100644 --- a/src/mred/wxme/wx_style.cxx +++ b/src/mred/wxme/wx_style.cxx @@ -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; diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index 9537e52247..cc00f5b42d 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/src/mzscheme/include/mzscheme.exp @@ -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 diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index cf534bc9a0..4e0e107397 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -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 diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index 2da54f92d7..a1dff25748 100644 --- a/src/mzscheme/include/mzwin.def +++ b/src/mzscheme/include/mzwin.def @@ -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 diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index 68dadd27b2..3cd3814de2 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -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 diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index d2d7a9193a..b045e51d10 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -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; diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 11aa4d0928..7808351577 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -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); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index 64ddcde82a..a0dbd4755e 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -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); diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c index 42d8f30c3f..248732ebf3 100644 --- a/src/mzscheme/src/port.c +++ b/src/mzscheme/src/port.c @@ -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); } } diff --git a/src/mzscheme/src/portfun.c b/src/mzscheme/src/portfun.c index f7a1f35664..d4c57ff849 100644 --- a/src/mzscheme/src/portfun.c +++ b/src/mzscheme/src/portfun.c @@ -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)) diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c index d5a2f05d42..dd778778c4 100644 --- a/src/mzscheme/src/read.c +++ b/src/mzscheme/src/read.c @@ -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); diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 283d411958..0be524bdc8 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -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(); diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index af6eef6f4e..63b1a24e7a 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -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); diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 8732a5bf4e..f0a70176fc 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -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; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index cd6b790a0a..eaffe40eb6 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -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) diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 4891c5f4f3..b320d6f98d 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -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 diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index e96a6f54af..b62c577f17 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -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 diff --git a/src/mzscheme/src/sema.c b/src/mzscheme/src/sema.c index ac3245fc3f..33515586cb 100644 --- a/src/mzscheme/src/sema.c +++ b/src/mzscheme/src/sema.c @@ -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); }