New file "ntprm.scm" has Win32 primitive interface, which is now

different from the DOS primitive interface.

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index 86a330eac923101cf2952f94c11073d685342474..01045b5e3ee3e1ed5cd15de1e31fd70bc4807fca 100644 (file)
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.34 1995/10/27 08:00:18 cph Exp $
+$Id: dosprm.scm,v 1.35 1995/10/28 01:14:16 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -298,33 +298,61 @@ MIT in each case. |#
     (add-event-receiver! event:after-restart reset!)))
 \f
 (define (dos/fs-drive-type pathname)
-  (cons (nt-volume-info/file-system-name (nt-volume-info pathname)) ""))
+  pathname
+  (cons "FAT" ""))
 
 (define (dos/fs-long-filenames? pathname)
-  ;; 32 is random -- FAT is 12 and everything else is much larger.
-  (> (nt-volume-info/max-component-length (nt-volume-info pathname)) 32))
-
-(define (nt-volume-info pathname)
-  (let ((root
-        (pathname-new-directory
-         (directory-pathname (merge-pathnames pathname))
-         '(ABSOLUTE))))
-    (let ((info
-          ((ucode-primitive nt-get-volume-information 1)
-           (->namestring root))))
-      (if (not info)
-         (error "Error reading volume information:" root))
-      info)))
-
-(define-structure (nt-volume-info (type vector)
-                                 (constructor #f)
-                                 (conc-name nt-volume-info/))
-  (name #f read-only #t)
-  (serial-number #f read-only #t)
-  (max-component-length #f read-only #t)
-  (file-system-flags #f read-only #t)
-  (file-system-name #f read-only #t))
-
+  pathname
+  #f)
+
+(define (copy-file from to)
+  (let ((input-filename (->namestring (merge-pathnames from)))
+       (output-filename (->namestring (merge-pathnames to))))
+    (let ((input-channel false)
+         (output-channel false))
+      (dynamic-wind
+       (lambda ()
+        (set! input-channel (file-open-input-channel input-filename))
+        (set! output-channel
+              (begin
+                ((ucode-primitive file-remove-link 1) output-filename)
+                (file-open-output-channel output-filename)))
+        unspecific)
+       (lambda ()
+        (let ((source-length (channel-file-length input-channel))
+              (buffer-length 8192))
+          (if (zero? source-length)
+              0
+              (let* ((buffer (make-string buffer-length))
+                     (transfer
+                      (lambda (length)
+                        (let ((n-read
+                               (channel-read-block input-channel
+                                                   buffer
+                                                   0
+                                                   length)))
+                          (if (positive? n-read)
+                              (channel-write-block output-channel
+                                                   buffer
+                                                   0
+                                                   n-read))
+                          n-read))))
+                (let loop ((source-length source-length))
+                  (if (< source-length buffer-length)
+                      (transfer source-length)
+                      (let ((n-read (transfer buffer-length)))
+                        (if (= n-read buffer-length)
+                            (+ (loop (- source-length buffer-length))
+                               buffer-length)
+                            n-read))))))))
+       (lambda ()
+        (if output-channel (channel-close output-channel))
+        (if input-channel (channel-close input-channel)))))
+    (set-file-times! output-filename
+                    #f
+                    (file-modification-time input-filename))
+    (set-file-modes! output-filename (file-modes input-filename))))
+\f
 (define (select-internal console? handles block?)
   (let* ((nt/qs-allinput #xff)
         (select
@@ -346,10 +374,7 @@ MIT in each case. |#
 (define console-channel-descriptor)
 
 (define (cache-console-channel-descriptor!)
-  (set! console-channel-descriptor
-       (if (eq? 'DOS microcode-id/operating-system)
-           -1
-           ((ucode-primitive get-handle 1) 1)))
+  (set! console-channel-descriptor -1)
   unspecific)
 
 (define (select-descriptor descriptor block?)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index b7c177f248dcf633eb12c3d96068bd7b8792b104..17515fe44ed59d4ba0b8ba7e3a119b8e49dedfc2 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.264 1995/09/11 19:05:39 cph Exp $
+$Id: runtime.pkg,v 14.265 1995/10/28 01:12:35 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -54,7 +54,8 @@ MIT in each case. |#
     (else))
   (file-case os-type
     ((unix) "unxprm")
-    ((dos nt) "dosprm")
+    ((dos) "dosprm")
+    ((nt) "ntprm")
     ((os/2) "os2prm")
     (else)))