From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 20 Dec 2004 04:38:49 +0000 (+0000)
Subject: Add new procedure channel-file-truncate.
X-Git-Tag: 20090517-FFI~1408
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b039b2dc797e6a63fed804285a99acf06e2c87d1;p=mit-scheme.git

Add new procedure channel-file-truncate.
---

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index f2af013b9..1c938bda6 100644
--- 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 bedc9969b..23e365937 100644
--- 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?