Skip to content

Instantly share code, notes, and snippets.

@deplinenoise
Created June 5, 2011 08:13
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save deplinenoise/1008770 to your computer and use it in GitHub Desktop.
Save deplinenoise/1008770 to your computer and use it in GitHub Desktop.
R6RS bootblock checksummer
#! /usr/bin/env racket
#lang r6rs
(import (rnrs base (6))
(rnrs programs (6))
(rnrs io ports (6))
(rnrs io simple (6))
(rnrs arithmetic bitwise (6))
(rnrs bytevectors (6)))
(define (compute-checksum bootblock)
(let iter ([pos 0] [chksum 0])
(if (= pos 1024)
(bitwise-and (bitwise-not chksum) #xffffffff)
(let* ([word (bytevector-u32-ref bootblock pos (endianness big))]
[temp (bitwise-and (+ chksum word) #xffffffff)])
(iter (+ pos 4) (if (> chksum temp) (+ temp 1) temp))))))
(define (load-bootblock fn)
(let* ((port (open-file-input-port fn))
(output (make-bytevector 1024 0))
(data (get-bytevector-n! port output 0 1024)))
(close-port port)
output))
(define (checksum-file! input-fn output-fn)
(let ([bb (load-bootblock input-fn)])
(bytevector-u32-set! bb 4 (compute-checksum bb) (endianness big))
(let ([port (open-file-output-port output-fn (file-options no-fail))])
(put-bytevector port bb)
(close-port port))))
(let ([args (command-line)])
(if (> (length args) 2)
(checksum-file! (cadr args) (caddr args))
(begin (display "need two args") (newline))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment