300.3

svn: r1698

collects/mzlib/cm.ss

@@ -138,7 +138,12 @@
 	       (lambda (out)
 		 (with-handlers ((exn:fail?
 				  (lambda (ex) (compilation-failure mode path zo-name #f (exn-message ex)))))
-		   (write code out))
+		   (parameterize ([current-write-relative-directory
+				   (let-values ([(base name dir?) (split-path path)])
+				     (if (eq? base 'relative)
+					 (current-directory)
+					 (path->complete-path base (current-directory))))])
+		     (write code out)))
 		 ;; redundant, but close as early as possible:
 		 (close-output-port out)
 		 ;; Note that we check time and write .deps before returning from with-compile-output...

collects/mzlib/compile.ss

@@ -33,25 +33,26 @@
 			      (raise exn))])
 	     (let ([out (open-output-file dest 'truncate/replace)]
 		   [ok? #f])
-	       (parameterize ([current-load-relative-directory
+	       (let ([dir (let-values ([(base name dir?) (split-path src)])
-			       (let-values ([(base name dir?) (split-path src)])
+			    (if (eq? base 'relative)
-				 (if (eq? base 'relative)
+				(current-directory)
-				     (current-directory)
+				(path->complete-path base (current-directory))))])
-				     (path->complete-path base (current-directory))))])
+		 (parameterize ([current-load-relative-directory dir]
-		 (dynamic-wind
+				[current-write-relative-directory dir])
-		     void
+		   (dynamic-wind
-		     (lambda ()
+		       void
-		       (let loop ()
+		       (lambda ()
-			 (let ([r (read-syntax src in)])
+			 (let loop ()
-			   (unless (eof-object? r)
+			   (let ([r (read-syntax src in)])
-			     (write (compile-syntax (filter (namespace-syntax-introduce r))) out)
+			     (unless (eof-object? r)
-			     (loop))))
+			       (write (compile-syntax (filter (namespace-syntax-introduce r))) out)
-		       (set! ok? #t))
+			       (loop))))
-		     (lambda () 
+			 (set! ok? #t))
-		       (close-output-port out)
+		       (lambda () 
-		       (unless ok?
+			 (close-output-port out)
-			 (with-handlers ([void void])
+			 (unless ok?
-			   (delete-file dest)))))))))
+			   (with-handlers ([void void])
+			     (delete-file dest))))))))))
 	 (lambda () (close-input-port in))))
       dest])))
 

src/mzscheme/include/scheme.h

@@ -1075,6 +1075,7 @@ enum {
   MZCONFIG_USE_COMPILED_KIND,
 
   MZCONFIG_LOAD_DIRECTORY,
+  MZCONFIG_WRITE_DIRECTORY,
 
   MZCONFIG_COLLECTION_PATHS,
 

src/mzscheme/src/error.c

@@ -1947,6 +1947,7 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
       max_cnt = 0x7FFFFFFF;
 
     if (max_cnt) {
+      int orig_max_cnt = max_cnt;
       w = scheme_get_param(config, MZCONFIG_ERROR_PRINT_WIDTH);
       if (SCHEME_INTP(w))
 	print_width = SCHEME_INT_VAL(w);
@@ -1955,16 +1956,53 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
       l = scheme_get_stack_trace(((Scheme_Structure *)argv[1])->slots[1]);
       while (!SCHEME_NULLP(l)) {
 	if (!max_cnt) {
-	  scheme_write_byte_string("  at ...\n", 9, port);
+	  scheme_write_byte_string("...\n", 4, port);
 	  break;
 	} else {
-	  scheme_write_byte_string("  at ", 5, port);
+	  Scheme_Object *name, *loc;
-	  scheme_display_w_max(SCHEME_CAR(l), port, print_width);
+	  
+	  if (max_cnt == orig_max_cnt) {
+	    /* Starting label: */
+	    scheme_write_byte_string("\n === context ===\n", 18, port);
+	  }
+
+	  name = SCHEME_CAR(l);
+	  loc = SCHEME_CDR(name);
+	  name = SCHEME_CAR(name);
+
+	  if (SCHEME_TRUEP(loc)) {
+	    Scheme_Structure *sloc = (Scheme_Structure *)loc;
+	    scheme_display_w_max(sloc->slots[0], port, print_width);
+	    if (SCHEME_TRUEP(sloc->slots[1])) {
+	      /* Line + column */
+	      scheme_write_byte_string(":", 1, port);
+	      scheme_display_w_max(sloc->slots[1], port, print_width);
+	      scheme_write_byte_string(":", 1, port);
+	      scheme_display_w_max(sloc->slots[2], port, print_width);
+	    } else {
+	      /* Position */
+	      scheme_write_byte_string("::", 2, port);
+	      scheme_display_w_max(sloc->slots[3], port, print_width);
+	    }
+
+	    if (SCHEME_TRUEP(name)) {
+	      scheme_write_byte_string(": ", 2, port);
+	    }
+	  }
+
+	  if (SCHEME_TRUEP(name)) {
+	    scheme_display_w_max(name, port, print_width);
+	  }
 	  scheme_write_byte_string("\n", 1, port);
 	  l = SCHEME_CDR(l);
 	  --max_cnt;
 	}
       }
+
+      if (max_cnt != orig_max_cnt) {
+	/* Extra ending newline */
+	scheme_write_byte_string("\n", 1, port);
+      }
     }
   }
 

src/mzscheme/src/file.c

@@ -3758,6 +3758,60 @@ char *scheme_find_completion(char *fn)
   return SCHEME_PATH_VAL(f);
 }
 
+static Scheme_Object *explode_path(Scheme_Object *p)
+{
+  Scheme_Object *l = scheme_null, *base, *name;
+  int isdir;
+
+  while (1) {
+    name = scheme_split_path(SCHEME_PATH_VAL(p), SCHEME_PATH_LEN(p), &base, &isdir);
+    l = scheme_make_pair(name, l);
+
+    if (!SCHEME_PATHP(base)) {
+      l = scheme_make_pair(base, l);
+      return l;
+    }
+    p = base;
+  }
+}
+
+Scheme_Object *scheme_extract_relative_to(Scheme_Object *obj, Scheme_Object *dir)
+{
+  Scheme_Object *de, *oe;
+
+  de = explode_path(dir);
+  oe = explode_path(obj);
+
+  while (SCHEME_PAIRP(de)
+	 && SCHEME_PAIRP(oe)) {
+    if (!scheme_equal(SCHEME_CAR(de), SCHEME_CAR(oe)))
+      return obj;
+    de = SCHEME_CDR(de);
+    oe = SCHEME_CDR(oe);
+  }
+
+  if (SCHEME_NULLP(de)) {
+    Scheme_Object *a[2];
+   
+    if (SCHEME_NULLP(oe)) {
+      a[0] = same_symbol;
+      obj = scheme_build_path(1, a);
+    } else {
+      obj = SCHEME_CAR(oe);
+      oe = SCHEME_CDR(oe);
+    }
+
+    while (SCHEME_PAIRP(oe)) {
+      a[0] = obj;
+      a[1] = SCHEME_CAR(oe);
+      obj = scheme_build_path(2, a);
+      oe = SCHEME_CDR(oe);
+    }
+  }
+
+  return obj;
+}
+
 static Scheme_Object *filesystem_root_list(int argc, Scheme_Object *argv[])
 {
   Scheme_Object *first = scheme_null;

src/mzscheme/src/fun.c

@@ -765,6 +765,39 @@ Scheme_Object *scheme_source_to_name(Scheme_Object *code)
   return NULL;
 }
 
+Scheme_Object *combine_name_with_srcloc(Scheme_Object *name, Scheme_Object *code, int src_based_name)
+{
+  Scheme_Stx *cstx = (Scheme_Stx *)code;
+
+  if (((cstx->srcloc->col >= 0) || (cstx->srcloc->pos >= 0))
+      && cstx->srcloc->src) {
+    Scheme_Object *vec;
+    vec = scheme_make_vector(7, NULL);
+    SCHEME_VEC_ELS(vec)[0] = name;
+    SCHEME_VEC_ELS(vec)[1] = cstx->srcloc->src;
+    if (cstx->srcloc->line >= 0) {
+      SCHEME_VEC_ELS(vec)[2] = scheme_make_integer(cstx->srcloc->line);
+      SCHEME_VEC_ELS(vec)[3] = scheme_make_integer(cstx->srcloc->col-1);
+    } else {
+      SCHEME_VEC_ELS(vec)[2] = scheme_false;
+      SCHEME_VEC_ELS(vec)[3] = scheme_false;
+    }
+    if (cstx->srcloc->pos >= 0)
+      SCHEME_VEC_ELS(vec)[4] = scheme_make_integer(cstx->srcloc->pos);
+    else
+      SCHEME_VEC_ELS(vec)[4] = scheme_false;
+    if (cstx->srcloc->span >= 0)
+      SCHEME_VEC_ELS(vec)[5] = scheme_make_integer(cstx->srcloc->span);
+    else
+      SCHEME_VEC_ELS(vec)[5] = scheme_false;
+    SCHEME_VEC_ELS(vec)[6] = (src_based_name ? scheme_true : scheme_false);
+    
+    return vec;
+  }
+
+  return name;
+}
+
 Scheme_Object *
 scheme_make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
 				Scheme_Compile_Info *rec, int drec)
@@ -823,13 +856,18 @@ scheme_make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
 
   name = scheme_stx_property(code, scheme_inferred_name_symbol, NULL);
   if (name && SCHEME_SYMBOLP(name)) {
+    name = combine_name_with_srcloc(name, code, 0);
     data->name = name;
   } else {
-    data->name = rec[drec].value_name;
+    name = rec[drec].value_name;
-    if (!data->name || SCHEME_FALSEP(data->name)) {
+    if (!name || SCHEME_FALSEP(name)) {
       name = scheme_source_to_name(code);
-      data->name= name;
+      if (name)
+	name = combine_name_with_srcloc(name, code, 1);
+    } else {
+      name = combine_name_with_srcloc(name, code, 0);
     }
+    data->name = name;
   }
 
   scheme_compile_rec_done_local(rec, drec);
@@ -1891,12 +1929,16 @@ const char *scheme_get_proc_name(Scheme_Object *p, int *len, int for_error)
 
     data = SCHEME_COMPILED_CLOS_CODE(p);
     if (data->name) {
+      Scheme_Object *name;
+      name = data->name;
+      if (SCHEME_VECTORP(name))
+	name = SCHEME_VEC_ELS(name)[0];
       if (for_error < 0) {
-	s = (char *)data->name;
+	s = (char *)name;
 	*len = -1;
       } else {
-	*len = SCHEME_SYM_LEN(data->name);
+	*len = SCHEME_SYM_LEN(name);
-	s = scheme_symbol_val(data->name);
+	s = scheme_symbol_val(name);
       }
     } else
       return NULL;
@@ -3148,7 +3190,7 @@ extract_cc_markses(int argc, Scheme_Object *argv[])
 Scheme_Object *
 scheme_get_stack_trace(Scheme_Object *mark_set)
 {
-  Scheme_Object *l, *n, *m;
+  Scheme_Object *l, *n, *m, *name, *loc;
   Scheme_Object *a[2];
 
   a[0] = mark_set;
@@ -3163,7 +3205,7 @@ scheme_get_stack_trace(Scheme_Object *mark_set)
   for (n = l; SCHEME_PAIRP(n); ) { 
     m = SCHEME_CDR(n);
     if (SCHEME_NULLP(m))
-	break;
+      break;
     if (SCHEME_CAR(m)) {
       n = m;
     } else {
@@ -3171,6 +3213,25 @@ scheme_get_stack_trace(Scheme_Object *mark_set)
     }
   }
 
+  /* Make srclocs */
+  for (n = l; SCHEME_PAIRP(n); n = SCHEME_CDR(n)) { 
+    name = SCHEME_CAR(n);
+    if (SCHEME_VECTORP(name)) {
+      loc = scheme_make_location(SCHEME_VEC_ELS(name)[1],
+				 SCHEME_VEC_ELS(name)[2],
+				 SCHEME_VEC_ELS(name)[3],
+				 SCHEME_VEC_ELS(name)[4],
+				 SCHEME_VEC_ELS(name)[5]);
+      if (SCHEME_TRUEP(SCHEME_VEC_ELS(name)[6]))
+	name = scheme_make_pair(scheme_false, loc);
+      else
+	name = scheme_make_pair(SCHEME_VEC_ELS(name)[0], loc);
+    } else {
+      name = scheme_make_pair(name, scheme_false);
+    }
+    SCHEME_CAR(n) = name;
+  }
+
   return l;
 }
 
@@ -4034,13 +4095,32 @@ scheme_default_prompt_read_handler(int argc, Scheme_Object *argv[])
 static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
 {
   Scheme_Closure_Data *data;
+  Scheme_Object *name;
 
   data = (Scheme_Closure_Data *)obj;
 
+  if (data->name) {
+    name = data->name;
+    if (SCHEME_VECTORP(name)) {
+      /* We can only save marshalable src names, which includes
+	 paths, symbols, and strings: */
+      Scheme_Object *src;
+      src = SCHEME_VEC_ELS(name)[1];
+      if (!SCHEME_PATHP(src)
+	  && !SCHEME_PATHP(src)
+	  && !SCHEME_SYMBOLP(src)) {
+	/* Just keep the name */
+	name = SCHEME_VEC_ELS(name)[0];
+      }
+    }
+  } else {
+    name = scheme_null;
+  }
+
   return CONS(scheme_make_integer(SCHEME_CLOSURE_DATA_FLAGS(data)),
 	      CONS(scheme_make_integer(data->num_params),
 		   CONS(scheme_make_integer(data->max_let_depth),
-			CONS(data->name ? data->name : scheme_null,
+			CONS(name,
 			     CONS(scheme_make_svector(data->closure_size,
 						      data->closure_map),
 				  scheme_protect_quote(data->code))))));

src/mzscheme/src/portfun.c

@@ -99,6 +99,7 @@ static Scheme_Object *write_byte (int, Scheme_Object *[]);
 static Scheme_Object *load (int, Scheme_Object *[]);
 static Scheme_Object *current_load (int, Scheme_Object *[]);
 static Scheme_Object *current_load_directory(int argc, Scheme_Object *argv[]);
+static Scheme_Object *current_write_directory(int argc, Scheme_Object *argv[]);
 static Scheme_Object *default_load (int, Scheme_Object *[]);
 static Scheme_Object *transcript_on(int, Scheme_Object *[]);
 static Scheme_Object *transcript_off(int, Scheme_Object *[]);
@@ -650,6 +651,11 @@ scheme_init_port_fun(Scheme_Env *env)
 						       "current-load-relative-directory",
 						       MZCONFIG_LOAD_DIRECTORY),
 			     env);
+  scheme_add_global_constant("current-write-relative-directory",
+			     scheme_register_parameter(current_write_directory,
+						       "current-write-relative-directory",
+						       MZCONFIG_WRITE_DIRECTORY),
+			     env);
 
   scheme_add_global_constant ("transcript-on",
 			      scheme_make_prim_w_arity(transcript_on,
@@ -4348,7 +4354,7 @@ current_load(int argc, Scheme_Object *argv[])
 			     2, NULL, NULL, 0);
 }
 
-static Scheme_Object *abs_directory_p(int argc, Scheme_Object **argv)
+static Scheme_Object *abs_directory_p(const char *name, int argc, Scheme_Object **argv)
 {
   Scheme_Object *d = argv[0];
 
@@ -4367,10 +4373,11 @@ static Scheme_Object *abs_directory_p(int argc, Scheme_Object **argv)
 
     if (!scheme_is_complete_path(s, len))
       scheme_raise_exn(MZEXN_FAIL_CONTRACT,
-		       "current-load-relative-directory: not a complete path: \"%q\"",
+		       "%s: not a complete path: \"%q\"",
+		       name,
 		       s);
 
-    expanded = scheme_expand_string_filename(d, "current-load-relative-directory", NULL,
+    expanded = scheme_expand_string_filename(d, name, NULL,
 					     SCHEME_GUARD_FILE_EXISTS);
     ed = scheme_make_sized_path(expanded, strlen(expanded), 1);
 
@@ -4380,13 +4387,32 @@ static Scheme_Object *abs_directory_p(int argc, Scheme_Object **argv)
   return scheme_false;
 }
 
+static Scheme_Object *lr_abs_directory_p(int argc, Scheme_Object **argv)
+{
+  return abs_directory_p("current-load-relative-directory", argc, argv);
+}
+
 static Scheme_Object *
 current_load_directory(int argc, Scheme_Object *argv[])
 {
   return scheme_param_config("current-load-relative-directory",
 			     scheme_make_integer(MZCONFIG_LOAD_DIRECTORY),
 			     argc, argv,
-			     -1, abs_directory_p, "path, string, or #f", 1);
+			     -1, lr_abs_directory_p, "path, string, or #f", 1);
+}
+
+static Scheme_Object *wr_abs_directory_p(int argc, Scheme_Object **argv)
+{
+  return abs_directory_p("current-write-relative-directory", argc, argv);
+}
+
+static Scheme_Object *
+current_write_directory(int argc, Scheme_Object *argv[])
+{
+  return scheme_param_config("current-write-relative-directory",
+			     scheme_make_integer(MZCONFIG_WRITE_DIRECTORY),
+			     argc, argv,
+			     -1, wr_abs_directory_p, "path, string, or #f", 1);
 }
 
 Scheme_Object *scheme_load(const char *file)

src/mzscheme/src/print.c

@@ -1588,7 +1588,39 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
     }
   else if (SCHEME_PATHP(obj))
     {
-      if (compact || !pp->print_unreadable) {
+      if (compact) {
+	/* Needed for srclocs in procedure names */
+	Scheme_Object *idx;
+	int l;
+	
+	idx = scheme_hash_get(symtab, obj);
+	if (idx) {
+	  print_compact(pp, CPT_SYMREF);
+	  l = SCHEME_INT_VAL(idx);
+	  print_compact_number(pp, l);
+	} else {
+	  Scheme_Object *dir;
+
+	  /* Hash before making relative */
+	  idx = scheme_make_integer(symtab->count);
+	  scheme_hash_set(symtab, obj, idx);
+	  
+	  dir = scheme_get_param(scheme_current_config(),
+				 MZCONFIG_WRITE_DIRECTORY);
+	  if (SCHEME_PATHP(dir)) {
+	    obj = scheme_extract_relative_to(obj, dir);
+	  }
+
+	  print_compact(pp, CPT_PATH);
+
+	  l = SCHEME_PATH_LEN(obj);
+	  print_compact_number(pp, l);
+	  print_this_string(pp, SCHEME_PATH_VAL(obj), 0, l);
+
+	  l = SCHEME_INT_VAL(idx);
+	  print_compact_number(pp, l);
+	}
+      } else if (!pp->print_unreadable) {
 	cannot_print(pp, notdisplay, obj, ht, compact);
       } else {
 	if (notdisplay)

src/mzscheme/src/read.c

@@ -4136,6 +4136,29 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
 	port->symtab[l] = v;
       }
       break;
+    case CPT_PATH:
+      {
+	l = read_compact_number(port);
+	RANGE_CHECK_GETS(l);
+	s = read_compact_chars(port, buffer, BLK_BUF_SIZE, l);
+	v = scheme_make_sized_path(s, l, l < BLK_BUF_SIZE);
+	l = read_compact_number(port); /* symtab index */
+
+	if (scheme_is_relative_path(SCHEME_PATH_VAL(v), SCHEME_PATH_LEN(v))) {
+	  /* Resolve relative path using the current load-relative directory: */
+	  Scheme_Object *dir;
+	  dir = scheme_get_param(scheme_current_config(), MZCONFIG_LOAD_DIRECTORY);
+	  if (SCHEME_PATHP(dir)) {
+	    Scheme_Object *a[2];
+	    a[0] = dir;
+	    a[1] = v;
+	    v = scheme_build_path(2, a);
+	  }
+	}
+
+	port->symtab[l] = v;
+      }
+      break;
     case CPT_SMALL_LOCAL_START:
     case CPT_SMALL_LOCAL_UNBOX_START:
       {

src/mzscheme/src/schcpt.h

@@ -1,6 +1,6 @@
 
 enum {
-  CPT_ESCAPE,
+  CPT_ESCAPE, /* 0 */
   CPT_SYMBOL,
   CPT_SYMREF,
   CPT_WEIRD_SYMBOL,
@@ -10,7 +10,7 @@ enum {
   CPT_CHAR,
   CPT_INT,
   CPT_NULL,
-  CPT_TRUE,
+  CPT_TRUE, /* 10 */
   CPT_FALSE,
   CPT_VOID,
   CPT_BOX,
@@ -20,7 +20,7 @@ enum {
   CPT_HASH_TABLE,
   CPT_STX,
   CPT_GSTX,
-  CPT_MARSHALLED,
+  CPT_MARSHALLED, /* 20 */
   CPT_QUOTE,
   CPT_REFERENCE,
   CPT_LOCAL,
@@ -30,40 +30,40 @@ enum {
   CPT_LET_ONE,
   CPT_BRANCH,
   CPT_MODULE_INDEX,
-  CPT_MODULE_VAR,
+  CPT_MODULE_VAR, /* 30 */
+  CPT_PATH,
   _CPT_COUNT_
 };
 
-#define CPT_SMALL_NUMBER_START 31
+#define CPT_SMALL_NUMBER_START 32
-#define CPT_SMALL_NUMBER_END   45
+#define CPT_SMALL_NUMBER_END   60
 
-#define CPT_SMALL_SYMBOL_START 45
+#define CPT_SMALL_SYMBOL_START 60
-#define CPT_SMALL_SYMBOL_END   65
+#define CPT_SMALL_SYMBOL_END   80
 
-#define CPT_SMALL_MARSHALLED_START 65
+#define CPT_SMALL_MARSHALLED_START 80
-#define CPT_SMALL_MARSHALLED_END 77
+#define CPT_SMALL_MARSHALLED_END 92
 
-#define _SMALL_LIST_MAX_ 50
+#define _SMALL_LIST_MAX_ 65
 
-#define CPT_SMALL_PROPER_LIST_START 77
+#define CPT_SMALL_PROPER_LIST_START 92
 #define CPT_SMALL_PROPER_LIST_END  (CPT_SMALL_PROPER_LIST_START + _SMALL_LIST_MAX_) 
 
 #define CPT_SMALL_LIST_START CPT_SMALL_PROPER_LIST_END
 #define CPT_SMALL_LIST_END   (CPT_SMALL_LIST_START + _SMALL_LIST_MAX_)
 
-#define CPT_SMALL_LOCAL_START 177
+#define CPT_SMALL_LOCAL_START 192
-#define CPT_SMALL_LOCAL_END 192
+#define CPT_SMALL_LOCAL_END 207
-#define CPT_SMALL_LOCAL_UNBOX_START 192
+#define CPT_SMALL_LOCAL_UNBOX_START 207
-#define CPT_SMALL_LOCAL_UNBOX_END 207
+#define CPT_SMALL_LOCAL_UNBOX_END 222
 
-#define CPT_SMALL_SVECTOR_START 207
+#define CPT_SMALL_SVECTOR_START 222
-#define CPT_SMALL_SVECTOR_END 232
+#define CPT_SMALL_SVECTOR_END 247
 
-#define CPT_SMALL_APPLICATION_START 232
+#define CPT_SMALL_APPLICATION_START 247
-#define CPT_SMALL_APPLICATION_END 240
+#define CPT_SMALL_APPLICATION_END 255
-#define CPT_SMALL_APPLICATION2 233
+#define CPT_SMALL_APPLICATION2 248
-#define CPT_SMALL_APPLICATION3 234
+#define CPT_SMALL_APPLICATION3 249
 
 #define CPT_BETWEEN(x, s) ((x >= CPT_ ## s ## _START) && (x < CPT_ ## s ## _END))
 #define CPT_RANGE(s) (CPT_ ## s ## _END - CPT_ ## s ## _START)
-

src/mzscheme/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 851
+#define EXPECTED_PRIM_COUNT 852
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

src/mzscheme/src/schpriv.h

@@ -2114,6 +2114,8 @@ char *scheme_get_exec_path(void);
 
 Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd);
 
+Scheme_Object *scheme_extract_relative_to(Scheme_Object *obj, Scheme_Object *dir);
+
 #ifdef DOS_FILE_SYSTEM
 # define WIDE_PATH(s) scheme_convert_to_wchar(s, 0)
 # define WIDE_PATH_COPY(s) scheme_convert_to_wchar(s, 1)

src/mzscheme/src/schvers.h

@@ -9,6 +9,6 @@
 
 
 #define MZSCHEME_VERSION_MAJOR 300
-#define MZSCHEME_VERSION_MINOR 2
+#define MZSCHEME_VERSION_MINOR 3
 
-#define MZSCHEME_VERSION "300.2" _MZ_SPECIAL_TAG
+#define MZSCHEME_VERSION "300.3" _MZ_SPECIAL_TAG