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

@@ -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%

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

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,19 +703,53 @@ 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)) {
+      /* 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;
       }
     }
+  }
 
   b->Read(vbuf, MRED_FORMAT_STR_LEN);
   memcpy((char *)mf->read_format, vbuf, MRED_FORMAT_STR_LEN);

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;

src/mred/wxme/wx_media.cxx

@@ -3182,27 +3182,23 @@ 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);
+    if (!wxDetectWXMEFile(who, f, 1)) {
-    sbuffer[MRED_START_STR_LEN] = 0;
-    if ((n != MRED_START_STR_LEN) || strcmp(sbuffer, MRED_START_STR))
       *format = wxMEDIA_FF_TEXT;
-    else
+    } else {
       *format = wxMEDIA_FF_STD;
     }
+  }
 
   fileerr = FALSE;
 
   showErrors = TRUE;
 
   if (*format == wxMEDIA_FF_STD) {
-    n = scheme_get_byte_string(who, f, sbuffer, 0, MRED_START_STR_LEN, 0, 1, NULL);
+    if (!wxDetectWXMEFile(who, f, 1)) {
-    sbuffer[MRED_START_STR_LEN] = 0;
-    if ((n != MRED_START_STR_LEN) || strcmp(sbuffer, MRED_START_STR)){
       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);

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;
   }
 }
-

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')

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);
+  if (!wxDetectWXMEFile(who, f, 0)) {
-  buffer[MRED_START_STR_LEN] = 0;
-  if ((n != MRED_START_STR_LEN) || strcmp(buffer, MRED_START_STR)) {
     if (showErrors)
       wxmeError("insert-file in pasteboard%: not a MrEd editor<%> file");
     fileerr = TRUE;

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;

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

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

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

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

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;

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);

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);

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,7 +4648,7 @@ fd_byte_ready (Scheme_Input_Port *port)
   }
 }
 
-static long fd_get_string(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)
@@ -4656,31 +4656,8 @@ static long fd_get_string(Scheme_Input_Port *port,
   Scheme_FD *fip;
   long bc;
 
-  if (unless && scheme_unless_ready(unless))
-    return SCHEME_UNLESS_READY;
-
   fip = (Scheme_FD *)port->port_data;
 
-  if (fip->bufcount) {
-    if (size == 1) {
-      buffer[offset] = fip->buffer[fip->buffpos++];
-      --fip->bufcount;
-      return 1;
-    } else {
-      bc = ((size <= fip->bufcount)
-	    ? size
-	    : fip->bufcount);
-
-      memcpy(buffer + offset, fip->buffer + fip->buffpos, bc);
-      fip->buffpos += bc;
-      fip->bufcount -= bc;
-
-      return bc;
-    }
-  } else {
-    if ((nonblock == 2) && (fip->flush == MZ_FLUSH_ALWAYS))
-      return 0;
-
   while (1) {
     /* Loop until a read succeeds. */
     int none_avail = 0;
@@ -4904,6 +4881,45 @@ static long fd_get_string(Scheme_Input_Port *port,
       return 0;
     }
   }
+}
+
+static long fd_get_string(Scheme_Input_Port *port,
+			  char *buffer, long offset, long size,
+			  int nonblock,
+			  Scheme_Object *unless)
+{
+  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;
+
+  fip = (Scheme_FD *)port->port_data;
+
+  if (fip->bufcount) {
+    if (size == 1) {
+      buffer[offset] = fip->buffer[fip->buffpos++];
+      --fip->bufcount;
+      return 1;
+    } else {
+      bc = ((size <= fip->bufcount)
+	    ? size
+	    : fip->bufcount);
+
+      memcpy(buffer + offset, fip->buffer + fip->buffpos, bc);
+      fip->buffpos += bc;
+      fip->bufcount -= bc;
+
+      return bc;
+    }
+  } else {
+    if ((nonblock == 2) && (fip->flush == MZ_FLUSH_ALWAYS))
+      return 0;
+
+    return fd_get_string_slow(port, buffer, offset, size, nonblock, unless);
   }
 }
 

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))

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);
+  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);

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();

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);

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;

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)

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
 

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

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) {
+        v = scheme_try_plain_sema((Scheme_Object *)sema);
-	  if (sema->value > 0)
-	    --sema->value;
-	  v = 1;
-	} else
-	  v = 0;
       } else {
 	v = try_channel(sema, syncing, 0, NULL);
       }