port position-tracking clean-ups

Add `file-position*', which can return #f instead of raising
an exception when a port's position is unknown. Change
`make-input-port' and `make-output-port' to accept more
kinds of values as the initial position.

These changes make it possible to synchronize a port's
position with a `port-commit-peeked' action. It's ugly,
which I think reflect something broken about position
tracking in the port protocol (which seems difficult to fix
without breaking compaibility).

collects/racket/port.rkt

@@ -629,7 +629,12 @@
           (lambda (n evt target-evt) (port-commit-peeked n evt target-evt p)))
      location-proc
      count-lines!-proc
-     pos
+     (let ([delta (- pos (or (file-position* p) pos))])
+       (if (= delta 1)
+           p
+           (lambda () 
+             (define v (file-position* p))
+             (+ delta v))))
      (case-lambda
       [(mode) (file-stream-buffer-mode p mode)]
       [() (file-stream-buffer-mode p)]))))
@@ -660,7 +665,7 @@
           (lambda (n evt target-evt) (port-commit-peeked n evt target-evt p)))
      (lambda () (port-next-location p))
      (lambda () (port-count-lines! p))
-     (add1 (file-position p)))))
+     p)))
 
 ;; Not kill-safe.
 (define make-pipe-with-specials
@@ -1059,7 +1064,7 @@
                                       (lambda (v) (loop))))))))
        (lambda () (port-next-location port))
        (lambda () (port-count-lines! port))
-       (add1 (file-position port))))))
+       port))))
 
 (define special-filter-input-port
   (lambda (p filter [close? #t])
@@ -1093,7 +1098,7 @@
           (lambda (n evt target-evt) (port-commit-peeked n evt target-evt p)))
      (lambda () (port-next-location p))
      (lambda () (port-count-lines! p))
-     (add1 (file-position p)))))
+     p)))
 
 ;; ----------------------------------------
 
@@ -1938,7 +1943,7 @@
     (let ([new (transplant-output-port
                 p
                 (lambda () (port-next-location p))
-                (add1 (file-position p))
+                (add1 (or (file-position* p) 0))
                 close?
                 (lambda () (port-count-lines! p)))])
       (port-display-handler new (port-display-handler p))
@@ -1950,7 +1955,7 @@
     (let ([new (transplant-input-port
                 p
                 (lambda () (port-next-location p))
-                (add1 (file-position p))
+                (add1 (or (file-position* p) 0))
                 close?
                 (lambda () (port-count-lines! p)))])
       (port-read-handler new (port-read-handler p))

collects/racket/private/port.rkt

@@ -99,7 +99,12 @@
             (write-special-evt spec p)))
      location-proc
      count-lines!-proc
-     pos
+     (let ([delta (- pos (or (file-position* p) pos))])
+       (if (= delta 1)
+           p
+           (lambda ()
+             (define v (file-position* p))
+             (and v (+ delta v)))))
      (case-lambda
       [(mode) (file-stream-buffer-mode p mode)]
       [() (file-stream-buffer-mode p)]))))

collects/scribblings/reference/custom-ports.scrbl

@@ -39,7 +39,11 @@ written.
                                          #f)
                                         #f]
                           [count-lines! (-> any) void]
-                          [init-position exact-positive-integer? 1]
+                          [init-position (or/c exact-positive-integer?
+                                               port?
+                                               #f
+                                               (-> (or/c exact-positive-integer? #f)))
+                                         1]
                           [buffer-mode (or/c (case-> ((or/c 'block 'none) . -> . any)
                                                      (-> (or/c 'block 'none #f)))
                                              #f)
@@ -344,10 +348,15 @@ The arguments implement the port as follows:
     that is called if and when line counting is enabled for the port.
     The default procedure is @racket[void].}
 
-  @item{@racket[init-position] --- an exact, positive integer that
+  @item{@racket[init-position] --- normally an exact, positive integer
-    determines the position of the port's first item, used when line
+    that determines the position of the port's first item, which is
-    counting is @italic{not} enabled for the port. The default is
+    used by @racket[file-position] or when line counting is
-    @racket[1].}
+    @italic{not} enabled for the port. The default is @racket[1].  If
+    @racket[init-position] is @racket[#f], the port is treated as
+    having an unknown position. If @racket[init-position] is a port,
+    then the given port's position is always used for the new port's
+    position. If @racket[init-position] is a procedure, it is called
+    as needed to obtain the port's position.}
 
   @item{@racket[buffer-mode] --- either @racket[#f] (the default) or a
     procedure that accepts zero or one arguments. If
@@ -721,7 +730,11 @@ s
                                           #f)
                                          #f]
                            [count-lines! (-> any) void]
-                           [init-position exact-positive-integer? 1]
+                           [init-position (or/c exact-positive-integer?
+                                                port?
+                                                #f
+                                                (-> (or/c exact-positive-integer? #f)))
+                                          1]
                            [buffer-mode (or/c (case-> 
                                                ((or/c 'block 'line 'none) . -> . any)
                                                (-> (or/c 'block 'line 'none #f)))
@@ -988,10 +1001,15 @@ procedures.
     that is called if and when line counting is enabled for the port.
     The default procedure is @racket[void].}
 
-  @item{@racket[init-position] --- an exact, positive integer that
+  @item{@racket[init-position] --- normally an exact, positive integer
-    determines the position of the port's first output item, used when
+    that determines the position of the port's first item, which is
-    line counting is @italic{not} enabled for the port. The default is
+    used by @racket[file-position] or when line counting is
-    @racket[1].}
+    @italic{not} enabled for the port. The default is @racket[1].  If
+    @racket[init-position] is @racket[#f], the port is treated as
+    having an unknown position. If @racket[init-position] is a port,
+    then the given port's position is always used for the new port's
+    position. If @racket[init-position] is a procedure, it is called
+    as needed to obtain the port's position.}
 
   @item{@racket[buffer-mode] --- either @racket[#f] (the
     default) or a procedure that accepts zero or one arguments. If

collects/scribblings/reference/port-buffers.scrbl

@@ -112,3 +112,9 @@ is the same as the old position). However, although input and output
 ports produced by @racket[open-input-output-file] share the file
 position, setting the position via one port does not flush the other
 port's buffer.}
+
+@defproc[(file-position* [port port?]) (or/c exact-nonnegative-integer? #f)]{
+
+Like @racket[file-position] on a single argument, but returns
+@racket[#f] if the position is not known.}
+

collects/tests/racket/port.rktl

@@ -726,6 +726,7 @@
 (let ([check
        (lambda (in [d 0] [first-three-bytes #"123"] [char-len 3])
          (test d file-position in)
+         (test d file-position* in)
          (let-values ([(l c p) (port-next-location in)])
            (test p add1 d)
            (test first-three-bytes peek-bytes 3 0 in)
@@ -814,4 +815,19 @@
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(let* ([p (open-input-bytes #"123")]
+       [p2 (make-input-port
+            (object-name p)
+            p
+            p
+            void
+            #f #f #f void
+            #f)])
+  (test #f file-position* p2)
+  (test #\1 read-char p2)
+  (test #f file-position* p2)
+  (err/rt-test (file-position p2) exn:fail:filesystem?))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (report-errs)

collects/typed-racket/base-env/base-env.rkt

@@ -2155,6 +2155,7 @@
                                [(-Port (one-of/c 'none 'line 'block)) -Void])]
 [file-position (cl-> [(-Port) -Nat]
                      [(-Port -Integer) -Void])]
+[file-position* (-> -Port (Un -Nat (-val #f)))]
 
 ;Section 12.1.4
 [port-count-lines! (-> (Un -Input-Port -Output-Port) -Void)]

src/racket/include/mzwin.def

@@ -416,6 +416,7 @@ EXPORTS
  scheme_get_bytes
  scheme_get_ready_special
  scheme_tell
+ scheme_tell_can_redirect
  scheme_output_tell
  scheme_tell_line
  scheme_tell_column

src/racket/include/mzwin3m.def

@@ -431,6 +431,7 @@ EXPORTS
  scheme_get_bytes
  scheme_get_ready_special
  scheme_tell
+ scheme_tell_can_redirect
  scheme_output_tell
  scheme_tell_line
  scheme_tell_column

src/racket/include/racket.exp

@@ -433,6 +433,7 @@ scheme_get_char_string
 scheme_get_bytes
 scheme_get_ready_special
 scheme_tell
+scheme_tell_can_redirect
 scheme_output_tell
 scheme_tell_line
 scheme_tell_column

src/racket/include/racket3m.exp

@@ -439,6 +439,7 @@ scheme_get_char_string
 scheme_get_bytes
 scheme_get_ready_special
 scheme_tell
+scheme_tell_can_redirect
 scheme_output_tell
 scheme_tell_line
 scheme_tell_column

src/racket/include/scheme.h

@@ -1379,6 +1379,7 @@ struct Scheme_Port
   Scheme_Location_Fun location_fun;
   Scheme_Count_Lines_Fun count_lines_fun;
   Scheme_Buffer_Mode_Fun buffer_mode_fun;
+  Scheme_Object *position_redirect; /* for `file-position' */
 };
 
 struct Scheme_Input_Port

src/racket/src/mzmark_type.inc

@@ -1565,6 +1565,7 @@ static int input_port_SIZE(void *p, struct NewGC *gc) {
 static int input_port_MARK(void *p, struct NewGC *gc) {
   Scheme_Input_Port *ip = (Scheme_Input_Port *)p;
   
+  gcMARK2(ip->p.position_redirect, gc);
   gcMARK2(ip->sub_type, gc);
   gcMARK2(ip->port_data, gc);
   gcMARK2(ip->name, gc);
@@ -1591,6 +1592,7 @@ static int input_port_MARK(void *p, struct NewGC *gc) {
 static int input_port_FIXUP(void *p, struct NewGC *gc) {
   Scheme_Input_Port *ip = (Scheme_Input_Port *)p;
   
+  gcFIXUP2(ip->p.position_redirect, gc);
   gcFIXUP2(ip->sub_type, gc);
   gcFIXUP2(ip->port_data, gc);
   gcFIXUP2(ip->name, gc);
@@ -1626,6 +1628,7 @@ static int output_port_SIZE(void *p, struct NewGC *gc) {
 static int output_port_MARK(void *p, struct NewGC *gc) {
   Scheme_Output_Port *op = (Scheme_Output_Port *)p;
 
+  gcMARK2(op->p.position_redirect, gc);
   gcMARK2(op->sub_type, gc);
   gcMARK2(op->port_data, gc);
   gcMARK2(op->name, gc);
@@ -1643,6 +1646,7 @@ static int output_port_MARK(void *p, struct NewGC *gc) {
 static int output_port_FIXUP(void *p, struct NewGC *gc) {
   Scheme_Output_Port *op = (Scheme_Output_Port *)p;
 
+  gcFIXUP2(op->p.position_redirect, gc);
   gcFIXUP2(op->sub_type, gc);
   gcFIXUP2(op->port_data, gc);
   gcFIXUP2(op->name, gc);

src/racket/src/mzmarksrc.c

@@ -599,6 +599,7 @@ input_port {
  mark:
   Scheme_Input_Port *ip = (Scheme_Input_Port *)p;
   
+  gcMARK2(ip->p.position_redirect, gc);
   gcMARK2(ip->sub_type, gc);
   gcMARK2(ip->port_data, gc);
   gcMARK2(ip->name, gc);
@@ -626,6 +627,7 @@ output_port {
  mark:
   Scheme_Output_Port *op = (Scheme_Output_Port *)p;
 
+  gcMARK2(op->p.position_redirect, gc);
   gcMARK2(op->sub_type, gc);
   gcMARK2(op->port_data, gc);
   gcMARK2(op->name, gc);

src/racket/src/port.c

@@ -3842,8 +3842,8 @@ static void check_input_port_lock(Scheme_Port *ip)
   }
 }
 
-intptr_t
+static intptr_t
-scheme_tell (Scheme_Object *port)
+do_tell (Scheme_Object *port, int not_via_loc)
 {
   Scheme_Port *ip;
   intptr_t pos;
@@ -3854,7 +3854,7 @@ scheme_tell (Scheme_Object *port)
   
   CHECK_IOPORT_CLOSED("get-file-position", ip);
 
-  if (!ip->count_lines || (ip->position < 0))
+  if (not_via_loc || !ip->count_lines || (ip->position < 0))
     pos = ip->position;
   else
     pos = ip->readpos;
@@ -3862,6 +3862,12 @@ scheme_tell (Scheme_Object *port)
   return pos;
 }
 
+intptr_t
+scheme_tell (Scheme_Object *port)
+{
+  return do_tell(port, 0);
+}
+
 intptr_t
 scheme_tell_line (Scheme_Object *port)
 {
@@ -3988,7 +3994,7 @@ scheme_tell_all (Scheme_Object *port, intptr_t *_line, intptr_t *_col, intptr_t
 
     line = scheme_tell_line(port);
     col = scheme_tell_column(port);
-    pos = scheme_tell(port);
+    pos = scheme_tell_can_redirect(port, 0);
 
     if (_line) *_line = line;
     if (_col) *_col = col;
@@ -3996,6 +4002,40 @@ scheme_tell_all (Scheme_Object *port, intptr_t *_line, intptr_t *_col, intptr_t
   }
 }
 
+intptr_t
+scheme_tell_can_redirect (Scheme_Object *port, int not_via_loc)
+{
+  Scheme_Port *ip;
+  Scheme_Object *v;
+
+  while (1) {
+    ip = scheme_port_record(port);
+    
+    if (ip->position_redirect) {
+      if (SCHEME_INPUT_PORTP(ip->position_redirect)
+          || SCHEME_OUTPUT_PORTP(ip->position_redirect)) {
+        SCHEME_USE_FUEL(1);
+        port = ip->position_redirect;
+      } else {
+        v = scheme_apply(ip->position_redirect, 0, NULL);
+        if (SCHEME_INTP(v) && (SCHEME_INT_VAL(v) >= 1))
+          return SCHEME_INT_VAL(v) - 1;
+        else if (SCHEME_FALSEP(v) || (SCHEME_BIGNUMP(v) && SCHEME_BIGPOS(v)))
+          return -1;
+        else {
+          Scheme_Object *a[1];
+          a[0] = v;
+          scheme_wrong_contract("file-position", "exact-positive-integer?", 0, -1, a);
+          return -1;
+        }
+      }
+    } else
+      break;
+  }
+
+  return do_tell(port, not_via_loc);
+}
+
 void scheme_set_port_location(int argc, Scheme_Object **argv)
 {
   Scheme_Port *ip;
@@ -5072,8 +5112,8 @@ static int win_seekable(int fd)
 }
 #endif
 
-Scheme_Object *
+static Scheme_Object *
-scheme_file_position(int argc, Scheme_Object *argv[])
+do_file_position(const char *who, int argc, Scheme_Object *argv[], int can_false)
 {
   FILE *f;
   Scheme_Indexed_String *is;
@@ -5084,7 +5124,7 @@ scheme_file_position(int argc, Scheme_Object *argv[])
   int wis;
 
   if (!SCHEME_OUTPUT_PORTP(argv[0]) && !SCHEME_INPUT_PORTP(argv[0]))
-    scheme_wrong_contract("file-position", "port?", 0, argc, argv);
+    scheme_wrong_contract(who, "port?", 0, argc, argv);
   if (argc == 2) {
     if (!SCHEME_EOFP(argv[1])) {
       int ok = 0;
@@ -5098,7 +5138,7 @@ scheme_file_position(int argc, Scheme_Object *argv[])
       }
       
       if (!ok)
-	scheme_wrong_contract("file-position", "(or/c exact-nonnegative-integer? eof-object?)", 1, argc, argv);
+	scheme_wrong_contract(who, "(or/c exact-nonnegative-integer? eof-object?)", 1, argc, argv);
     }
   }
 
@@ -5125,8 +5165,18 @@ scheme_file_position(int argc, Scheme_Object *argv[])
     } else if (SAME_OBJ(op->sub_type, scheme_string_output_port_type)) {
       is = (Scheme_Indexed_String *)op->port_data;
       wis = 1;
-    } else if (argc < 2)
+    } else if (argc < 2) {
-      return scheme_make_integer(scheme_output_tell(argv[0]));
+      intptr_t pos;
+      pos = scheme_tell_can_redirect(argv[0], 1);
+      if (pos < 0) {
+        if (can_false) return scheme_false;
+	scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
+			 "the port's current position is not known\n"
+                         "  port: %v",
+			 op);
+      } else
+        return scheme_make_integer(pos);
+    }
   } else {
     Scheme_Input_Port *ip;
 
@@ -5146,9 +5196,10 @@ scheme_file_position(int argc, Scheme_Object *argv[])
       is = (Scheme_Indexed_String *)ip->port_data;
     else if (argc < 2) {
       intptr_t pos;
-      pos = ip->p.position;
+      pos = scheme_tell_can_redirect((Scheme_Object *)ip, 1);
       if (pos < 0) {
-	scheme_raise_exn(MZEXN_FAIL,
+        if (can_false) return scheme_false;
+	scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
 			 "the port's current position is not known\n"
                          "  port: %v",
 			 ip);
@@ -5162,7 +5213,7 @@ scheme_file_position(int argc, Scheme_Object *argv[])
       && !had_fd
 #endif
       && !is)
-    scheme_contract_error("file-position",
+    scheme_contract_error(who,
                           "setting position allowed for file-stream and string ports only",
                           "port", 1, argv[0],
                           "position", 1, argv[1],
@@ -5186,7 +5237,7 @@ scheme_file_position(int argc, Scheme_Object *argv[])
     }
 
     if (nll < 0) {
-      scheme_contract_error("file-position",
+      scheme_contract_error(who,
                             "new position is too large",
                             "port", 1, argv[0],
                             "position", 1, argv[1],
@@ -5334,11 +5385,7 @@ scheme_file_position(int argc, Scheme_Object *argv[])
       pll = BIG_OFF_T_IZE(lseek)(fd, 0, 1);
 # endif
       if (pll < 0) {
-	if (SCHEME_INPUT_PORTP(argv[0])) {
+        pll = do_tell(argv[0], 0);
-	  pll = scheme_tell(argv[0]);
-	} else {
-	  pll = scheme_output_tell(argv[0]);
-	}
       } else {
 	if (SCHEME_INPUT_PORTP(argv[0])) {          
           Scheme_Input_Port *ip;
@@ -5373,6 +5420,18 @@ scheme_file_position(int argc, Scheme_Object *argv[])
   }
 }
 
+Scheme_Object *
+scheme_file_position(int argc, Scheme_Object *argv[])
+{
+  return do_file_position("file-position", argc, argv, 0);
+}
+
+Scheme_Object *
+scheme_file_position_star(int argc, Scheme_Object *argv[])
+{
+  return do_file_position("file-position*", argc, argv, 1);
+}
+
 intptr_t scheme_set_file_position(Scheme_Object *port, intptr_t pos)
 {
   if (pos >= 0) {

src/racket/src/portfun.c

@@ -314,6 +314,7 @@ scheme_init_port_fun(Scheme_Env *env)
   GLOBAL_NONCM_PRIM("port-print-handler",             port_print_handler,             1, 2, env);
   GLOBAL_NONCM_PRIM("flush-output",                   flush_output,                   0, 1, env);
   GLOBAL_NONCM_PRIM("file-position",                  scheme_file_position,           1, 2, env);
+  GLOBAL_NONCM_PRIM("file-position*",                 scheme_file_position_star,      1, 1, env);
   GLOBAL_NONCM_PRIM("file-stream-buffer-mode",        scheme_file_buffer,             1, 2, env);
   GLOBAL_NONCM_PRIM("port-try-file-lock?",            scheme_file_try_lock,           2, 2, env);
   GLOBAL_NONCM_PRIM("port-file-unlock",               scheme_file_unlock,             1, 1, env);
@@ -2270,12 +2271,16 @@ make_input_port(int argc, Scheme_Object *argv[])
     scheme_check_proc_arity2("make-input-port", 0, 6, argc, argv, 1); /* location */
   if (argc > 7)
     scheme_check_proc_arity("make-input-port", 0, 7, argc, argv); /* count-lines! */
-  if (argc > 8) { /* buffer-mode */
+  if (argc > 8) { /* position */
     if (!((SCHEME_INTP(argv[8]) && SCHEME_INT_VAL(argv[8]) > 0)
-	  || (SCHEME_BIGNUMP(argv[8]) && SCHEME_BIGPOS(argv[8]))))
+	  || (SCHEME_BIGNUMP(argv[8]) && SCHEME_BIGPOS(argv[8]))
-      scheme_wrong_contract("make-input-port", "exact-positive-integer?", 8, argc, argv);
+          || SCHEME_FALSEP(argv[8])
+          || scheme_check_proc_arity(NULL, 0, 8, argc, argv)
+          || SCHEME_INPUT_PORTP(argv[8])
+          || SCHEME_OUTPUT_PORTP(argv[8])))
+      scheme_wrong_contract("make-input-port", "(or/c exact-positive-integer? port? #f (-> (or/c exact-positive-integer? #f)))", 8, argc, argv);
   }
-  if (argc > 9) {
+  if (argc > 9) { /* buffer-mode */
     if (SCHEME_TRUEP(argv[9])
 	&& !scheme_check_proc_arity(NULL, 0, 9, argc, argv)
 	&& !scheme_check_proc_arity(NULL, 1, 9, argc, argv))
@@ -2362,8 +2367,12 @@ make_input_port(int argc, Scheme_Object *argv[])
   if (argc > 8) {
     if (SCHEME_INTP(argv[8]))
       ip->p.position = (SCHEME_INT_VAL(argv[8]) - 1);
-    else
+    else if (SCHEME_FALSEP(argv[8]) || SCHEME_BIGNUMP(argv[8]))
       ip->p.position = -1;
+    else {
+      ip->p.position = 0;
+      ip->p.position_redirect = argv[8];
+    }
   }
 
   if (uip->buffer_mode_proc)
@@ -2411,8 +2420,12 @@ make_output_port (int argc, Scheme_Object *argv[])
     scheme_check_proc_arity("make-output-port", 0, 8, argc, argv); /* count-lines! */
   if (argc > 9) {
     if (!((SCHEME_INTP(argv[9]) && SCHEME_INT_VAL(argv[9]) > 0)
-	  || (SCHEME_BIGNUMP(argv[9]) && SCHEME_BIGPOS(argv[9]))))
+	  || (SCHEME_BIGNUMP(argv[9]) && SCHEME_BIGPOS(argv[9]))
-      scheme_wrong_contract("make-output-port", "positive-exact-integer?", 9, argc, argv);
+          || SCHEME_FALSEP(argv[9])
+          || scheme_check_proc_arity(NULL, 0, 9, argc, argv)
+          || SCHEME_INPUT_PORTP(argv[9])
+          || SCHEME_OUTPUT_PORTP(argv[9])))
+      scheme_wrong_contract("make-output-port", "(or/c exact-positive-integer? port? #f (-> (or/c exact-positive-integer? #f)))", 9, argc, argv);
   }
   if (argc > 10) { /* buffer-mode */
     if (SCHEME_TRUEP(argv[10])
@@ -2490,12 +2503,16 @@ make_output_port (int argc, Scheme_Object *argv[])
     scheme_set_port_location_fun((Scheme_Port *)op, user_output_location);
   if (uop->count_lines_proc)
     scheme_set_port_count_lines_fun((Scheme_Port *)op, user_output_count_lines);
-
+  
   if (argc > 9) {
     if (SCHEME_INTP(argv[9]))
       op->p.position = (SCHEME_INT_VAL(argv[9]) - 1);
-    else
+    else if (SCHEME_FALSEP(argv[9]) && !SCHEME_BIGNUMP(argv[9]))
       op->p.position = -1;
+    else {
+      op->p.position = 0;
+      op->p.position_redirect = argv[9];
+    }
   }
 
   if (uop->buffer_mode_proc)

src/racket/src/schemef.h

@@ -822,6 +822,7 @@ MZ_EXTERN intptr_t scheme_get_char_string(const char *who,
 MZ_EXTERN intptr_t scheme_get_bytes(Scheme_Object *port, intptr_t size, char *buffer, int offset);
 MZ_EXTERN Scheme_Object *scheme_get_ready_special(Scheme_Object *port, Scheme_Object *stxsrc, int peek);
 MZ_EXTERN intptr_t scheme_tell(Scheme_Object *port);
+MZ_EXTERN intptr_t scheme_tell_can_redirect(Scheme_Object *port, int not_via_loc);
 MZ_EXTERN intptr_t scheme_output_tell(Scheme_Object *port);
 MZ_EXTERN intptr_t scheme_tell_line(Scheme_Object *port);
 MZ_EXTERN intptr_t scheme_tell_column(Scheme_Object *port);

src/racket/src/schemex.h

@@ -675,6 +675,7 @@ intptr_t (*scheme_get_char_string)(const char *who,
 intptr_t (*scheme_get_bytes)(Scheme_Object *port, intptr_t size, char *buffer, int offset);
 Scheme_Object *(*scheme_get_ready_special)(Scheme_Object *port, Scheme_Object *stxsrc, int peek);
 intptr_t (*scheme_tell)(Scheme_Object *port);
+intptr_t (*scheme_tell_can_redirect)(Scheme_Object *port, int not_via_loc);
 intptr_t (*scheme_output_tell)(Scheme_Object *port);
 intptr_t (*scheme_tell_line)(Scheme_Object *port);
 intptr_t (*scheme_tell_column)(Scheme_Object *port);

src/racket/src/schemex.inc

@@ -481,6 +481,7 @@
   scheme_extension_table->scheme_get_bytes = scheme_get_bytes;
   scheme_extension_table->scheme_get_ready_special = scheme_get_ready_special;
   scheme_extension_table->scheme_tell = scheme_tell;
+  scheme_extension_table->scheme_tell_can_redirect = scheme_tell_can_redirect;
   scheme_extension_table->scheme_output_tell = scheme_output_tell;
   scheme_extension_table->scheme_tell_line = scheme_tell_line;
   scheme_extension_table->scheme_tell_column = scheme_tell_column;

src/racket/src/schemexm.h

@@ -481,6 +481,7 @@
 #define scheme_get_bytes (scheme_extension_table->scheme_get_bytes)
 #define scheme_get_ready_special (scheme_extension_table->scheme_get_ready_special)
 #define scheme_tell (scheme_extension_table->scheme_tell)
+#define scheme_tell_can_redirect (scheme_extension_table->scheme_tell_can_redirect)
 #define scheme_output_tell (scheme_extension_table->scheme_output_tell)
 #define scheme_tell_line (scheme_extension_table->scheme_tell_line)
 #define scheme_tell_column (scheme_extension_table->scheme_tell_column)

src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1071
+#define EXPECTED_PRIM_COUNT 1072
 #define EXPECTED_UNSAFE_COUNT 79
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_FUTURES_COUNT 15

src/racket/src/schpriv.h

@@ -3578,6 +3578,7 @@ Scheme_Object *scheme_do_open_input_file(char *name, int offset, int argc, Schem
 Scheme_Object *scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv[], int and_read, 
                                           int internal, char **err, int *eerrno);
 Scheme_Object *scheme_file_position(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_file_position_star(int argc, Scheme_Object *argv[]);
 Scheme_Object *scheme_file_buffer(int argc, Scheme_Object *argv[]);
 Scheme_Object *scheme_file_identity(int argc, Scheme_Object *argv[]);
 Scheme_Object *scheme_file_try_lock(int argc, Scheme_Object **argv);

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.3.0.20"
+#define MZSCHEME_VERSION "5.3.0.21"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 20
+#define MZSCHEME_VERSION_W 21
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)