anchor.diff: -
  -
  -(defpackage #:device 
  +;;;; Copyright (c) Frank James 2015 <frank.a.james@gmail.com>
  +;;;; This code is licensed under the MIT license.
  +
  +;;; This file defines an API for operating on block devices (Windows only).
  +;;; Can be used to perform direct I/O on physical disks. Usually best to ensure the disk is "offline".
  +;;; At the moment all the I/O is synchronous, we could add OVERLAPPED calls but 
  +;;; it adds a lot of complexity and there's no need for it right now.
  +
  +(defpackage #:pounds.device 
     (:use #:cl #:cffi)
     (:export #:open-device
  -	   #:close-device
  -	   #:read-block
  -	   #:write-block
  -	   #:clear-block))
  -
  -(in-package #:device)
  +           #:close-device
  +           #:read-block
  +           #:write-block
  +           #:clear-block
  +           #:move-block))
  +
  +(in-package #:pounds.device)
  +
  +
  +#+(or win32 windows)
  +(progn
   
   ;; access 
   ;;#define GENERIC_READ                     (0x80000000L)
  
positive.code:   handle 
    geometry
    bytes
    size)
  
  
  
negative.code: 
  (defun clear-block (device block &optional (value 0))
    (declare (type device device)
             (type integer block)
             (type (unsigned-byte 8) value))
    (let ((length (device-bytes device))
          (offset (* block (device-bytes device))))
      (with-foreign-objects ((buffer :uint8 length)
                             (nbytes :uint32)
                             (overlapped '(:struct pounds::overlapped)))
        ;; initialize the buffer with the constant value 
        (do ((i 0 (1+ i)))
            ((= i length))
          (setf (mem-aref buffer :uint8 i) value))
        ;; write to the file 
        (multiple-value-bind (offset-low offset-high) (pounds::split-offset offset)
          (setf (foreign-slot-value overlapped '(:struct pounds::overlapped)
                                    'pounds::offset)
                offset-low
                (foreign-slot-value overlapped '(:struct pounds::overlapped)
                                    'pounds::offset-high)
                offset-high))
        (let ((res (pounds::%write-file (device-handle device)
                                buffer
                                length
                                nbytes
                                overlapped)))
          (unless res 
            (pounds::get-last-error))))))
  
  (defun move-block (device new-block old-block)
    (declare (type device device)
             (type integer new-block old-block))
    (let ((length (device-bytes device)))
      (with-foreign-objects ((buffer :uint8 length)
                             (nbytes :uint32)
                             (overlapped '(:struct pounds::overlapped)))
        ;; start by reading the old block
        (let ((offset (* old-block length)))
          (multiple-value-bind (offset-low offset-high) (pounds::split-offset offset)
            (setf (foreign-slot-value overlapped '(:struct pounds::overlapped)
                                      'pounds::offset)
                  offset-low
                  (foreign-slot-value overlapped '(:struct pounds::overlapped)
                                      'pounds::offset-high)
                  offset-high)
            (let ((res (pounds::%read-file (device-handle device)
                                   buffer 
                                   length 
                                   nbytes
                                   overlapped)))
              (unless res
                (pounds::get-last-error)))))
        ;; now write it back out to the new location
        (let ((offset (* new-block length)))
          (multiple-value-bind (offset-low offset-high) (pounds::split-offset offset)
            (setf (foreign-slot-value overlapped '(:struct pounds::overlapped)
                                      'pounds::offset)
                  offset-low
                  (foreign-slot-value overlapped '(:struct pounds::overlapped)
                                      'pounds::offset-high)
                  offset-high)
            (let ((res (pounds::%write-file (device-handle device)
                                    buffer 
                                    length 
                                    nbytes
                                    overlapped)))
              (unless res
                (pounds::get-last-error))))))))
  
  ) ;; Windows 
  
  #-(or win32 windows) 
  (progn
  
  (defstruct device
    fd 
    bytes 
    size)
  
  (defun open-device (path)
    nil)
  
  (defun close-device (device)
    nil)
  
  (defun read-block (device block sequence &key (start 0) end)
    nil)
  
  (defun write-block (device block sequence &key (start 0) end)
    nil)
  
  (defun clear-block (device block &optional (value 0))
    nil)
  
  (defun move-block (device new-block old-block)
    nil)
  
  
  ) ;; non-Windows
  
  
  