;;;; mmcp.scm - A simple command line tool for copying files with or without mmapped I/O
;
; (taken directly from Richard Stevens' "Advanced Programming in the UNIX environment")


(declare (uses posix lolevel))


(define-foreign-variable bufsiz int "BUFSIZ")


(define (usage)
  (display "Usage: mmcp [-m] FILENAME1 FILENAME2\n")
  (exit 0) )

(define (copy file1 file2 mm)
  (let* ([size1 (file-size file1)]
	 [in (file-open file1 open/rdonly)]
	 [out (file-open file2 (bitwise-ior open/rdwr (bitwise-ior open/creat open/trunc)))] )
    (if mm
	(let ([flag (bitwise-ior map/file map/shared)])
	  (set-file-position! out (sub1 size1))
	  (file-write out "x")
	  (let ([src (map-file-to-memory #f size1 prot/read flag in 0)]
		[dst (map-file-to-memory #f size1 (bitwise-ior prot/read prot/write) flag out 0)] )
	    (move-memory! src dst size1) ) )
	(let ([buffer (make-string bufsiz)])
	  (let loop ([n size1])
	    (when (positive? n)
	      (let ([m (cadr (file-read in bufsiz buffer))])
		(file-write out buffer m)
		(loop (- n m)) ) ) ) ) ) ) )

(apply
 (case-lambda
  [(x y) 
   (if (string=? "-m" x)
       (usage)
       (copy x y #f) ) ]
  [(x y z) (copy y z (or (string=? "-m" x) (usage)))]
  [args (usage)] )
 (cdr (argv)) )

