Add new procedure channel-file-truncate.

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index f2af013b94c472dc9fffc3c84d696593a26c34e0..1c938bda64cf671632eca1b4a73a0019f053451b 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.79 2004/02/16 05:36:50 cph Exp $
+$Id: io.scm,v 14.80 2004/12/20 04:38:37 cph Exp $
 
 Copyright 1986,1987,1988,1990,1991,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1998,1999,2000,2001 Massachusetts Institute of Technology
@@ -309,6 +309,9 @@ USA.
   ((ucode-primitive file-set-position 2) (channel-descriptor channel)
                                         position))
 
+(define (channel-file-truncate channel length)
+  ((ucode-primitive file-truncate 2) (channel-descriptor channel) length))
+
 (define (make-pipe)
   (without-interrupts
    (lambda ()

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index bedc9969b4c89695b3c83d65dd2346380d5eed0b..23e365937a5b776fb379456c8912cc3d3265b61b 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.522 2004/12/13 03:22:21 cph Exp $
+$Id: runtime.pkg,v 14.523 2004/12/20 04:38:49 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -2590,6 +2590,7 @@ USA.
          channel-file-length
          channel-file-position
          channel-file-set-position
+         channel-file-truncate
          channel-has-input?
          channel-nonblocking
          channel-open?