Created
May 8, 2018 09:21
-
-
Save tonyg/ea1325fd55299631626f734358e24b98 to your computer and use it in GitHub Desktop.
Test to help pin down slowness of execution due to TR-inserted contracts (?)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket | |
;; Example to pin down influence of contract checks at a typed/untyped | |
;; boundary on execution speed in the `bitsyntax` package. | |
;; | |
;; TO RUN: | |
;; - install the `bitsyntax` package. | |
;; - run this program. | |
;; - modify the file `bitstring.rkt` in the `bitsyntax` package to have | |
;; ".../no-check" at the end of its `#lang`. | |
;; - rerun the program. | |
;; | |
;; Example output, with "#lang typed/racket/base" (the current default) in bitstring.rkt: | |
;; | |
;; 1000 checksums over a 1024-byte packet in 3344 ms gives 299.04306220095697 checksums/sec | |
;; | |
;; Example output, with "#lang typed/racket/base/no-check" in bitstring.rkt: | |
;; | |
;; 1000 checksums over a 1024-byte packet in 169 ms gives 5917.159763313609 checksums/sec | |
;; | |
;; The untyped variant is ~20x faster than the typed variant. | |
;;--------------------------------------------------------------------------- | |
;; Contents of "checksum.rkt" from the netstack example in Syndicate | |
(provide ones-complement-sum16 ip-checksum) | |
(require bitsyntax) | |
(define (ones-complement-+16 a b) | |
(define c (+ a b)) | |
(bitwise-and #xffff (+ (arithmetic-shift c -16) c))) | |
(define (ones-complement-sum16 bs) | |
(bit-string-case bs | |
([ (n :: integer bytes 2) (rest :: binary) ] | |
(ones-complement-+16 n (ones-complement-sum16 rest))) | |
([ odd-byte ] | |
(arithmetic-shift odd-byte 8)) | |
([ ] | |
0))) | |
(define (ones-complement-negate16-safely x) | |
(define r (bitwise-and #xffff (bitwise-not x))) | |
(if (= r 0) #xffff r)) | |
(define (ip-checksum offset blob #:pseudo-header [pseudo-header #""]) | |
(bit-string-case blob | |
([ (prefix :: binary bytes offset) | |
(:: binary bytes 2) | |
(suffix :: binary) ] | |
(define result (ones-complement-+16 | |
(ones-complement-sum16 pseudo-header) | |
(ones-complement-+16 (ones-complement-sum16 prefix) | |
(ones-complement-sum16 suffix)))) | |
(define checksum (ones-complement-negate16-safely result)) | |
(define final-packet (bit-string (prefix :: binary) | |
(checksum :: integer bytes 2) | |
(suffix :: binary))) | |
final-packet))) | |
;;--------------------------------------------------------------------------- | |
(define dummy-packet (make-bytes 1024 #x5a)) | |
(define N 1000) | |
(define-values (_results cpu-ms _wall-ms gc-ms) | |
(time-apply (lambda () (for [(i N)] | |
(ip-checksum 10 dummy-packet))) | |
'())) | |
(let ((delta (- cpu-ms gc-ms))) | |
(printf "~a checksums over a ~a-byte packet in ~a ms gives ~a checksums/sec\n" | |
N | |
(bytes-length dummy-packet) | |
delta | |
(/ N (/ delta 1000.0)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment