fixed kernel warning

fixed kernel warning

#define _FLOAT float

static inline int iDiv(int v, int d)
{
	int r = (int)((float)v / d + 0.00001f);
	return(r);
}

static inline int iMod(int v, int u, int d)
{
	int r = v - mul24((int)u, (int)d);
	return(r);
}

static inline void ReduceKernel(__local _FLOAT * lcl_mem, int sum_stride, int unit_id, int unit_len)
{
    _FLOAT sum = 0;
    int lcl_offset = unit_id * unit_len;
    for(int i = 0; i < unit_len; i += sum_stride)
    {
        sum += lcl_mem[lcl_offset + i];
    }
    lcl_mem[lcl_offset] = sum;
}

__attribute__((reqd_work_group_size(MLO_CONVBWD_GROUP_SZ0,MLO_CONVBWD_GROUP_SZ1,1)))
__kernel void MIOpenConvBwdB(
       const __global _FLOAT * top_df,
       __global _FLOAT * bias_df
	   )
{
    int lid = (int) get_local_id(0);
    int output_map = get_group_id(1);

    __local _FLOAT lcl_sum[MLO_CONVBWDB_LCL_MEMSZ];
    _FLOAT sum = 0;

    for (int j = lid; j < MLO_WK_SIZE * MLO_OUT_BATCH_SZ; j += MLO_CONVBWD_GROUP_SZ0)
    {
        int map_id = iDiv(j, MLO_WK_SIZE);
        int read_id = iMod(j, map_id, MLO_WK_SIZE);
        int glb_top_df_offset = output_map * MLO_OUT_CHANNEL_STRIDE + (map_id * MLO_OUT_BATCH_STRIDE) + (read_id * MLO_CONVBWDB_UNITSIZE);
#if MLO_N_PIX_OFF
        if (read_id == MLO_WK_SIZE - 1)
        {
        for (int k = 0; k < MLO_N_PIX_OFF; k++)
            sum += top_df[glb_top_df_offset + k];
        }
#else
        for (int k = 0; k < MLO_CONVBWDB_UNITSIZE; k++)
            sum += top_df[glb_top_df_offset + k];
#endif
    }
    lcl_sum[lid] = sum;

    barrier(CLK_LOCAL_MEM_FENCE);

    // Reduction over a work-grp: 256 -> 64 -> 16 -> 1
    if(lid < (MLO_CONVBWD_GROUP_SZ0 >> 2))
    {
        ReduceKernel(lcl_sum, 1, lid, 4);
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    if(lid < (MLO_CONVBWD_GROUP_SZ0 >> 4))
    {
        ReduceKernel(lcl_sum, 4, lid, 16);
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    if(lid == 0)
    {
        ReduceKernel(lcl_sum, 16, lid, 256);
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    bias_df[output_map] = lcl_sum[0];
}

#define _FLOAT float

static inline int iDiv(int v, int d)
{
	int r = (int)((float)v / d + 0.00001f);
	return(r);
}

static inline int iMod(int v, int u, int d)
{
	int r = v - mul24((int)u, (int)d);
	return(r);
}

static inline void ReduceKernel(__local _FLOAT * lcl_mem, int sum_stride, int unit_id, int unit_len)
{
    _FLOAT sum = 0;
    int lcl_offset = unit_id * unit_len;
    for(int i = 0; i < unit_len; i += sum_stride)
    {
        sum += lcl_mem[lcl_offset + i];
    }
    lcl_mem[lcl_offset] = sum;
}

__attribute__((reqd_work_group_size(MLO_CONVBWD_GROUP_SZ0,MLO_CONVBWD_GROUP_SZ1,1)))
__kernel void MIOpenConvBwdB(
       const __global _FLOAT * top_df,
       __global _FLOAT * bias_df
	   )
{
    int lid = (int) get_local_id(0);
    int output_map = get_group_id(1);

    __local _FLOAT lcl_sum[MLO_CONVBWDB_LCL_MEMSZ];
    _FLOAT sum = 0;

    for (int j = lid; j < MLO_WK_SIZE * MLO_OUT_BATCH_SZ; j += MLO_CONVBWD_GROUP_SZ0)
    {
        int map_id = iDiv(j, MLO_WK_SIZE);
        int read_id = iMod(j, map_id, MLO_WK_SIZE);
        int glb_top_df_offset = output_map * MLO_OUT_CHANNEL_STRIDE + (map_id * MLO_OUT_BATCH_STRIDE) + (read_id * MLO_CONVBWDB_UNITSIZE);
#if MLO_N_PIX_OFF
        if (read_id == MLO_WK_SIZE - 1)
        {
        for (int j = 0; j < MLO_N_PIX_OFF; j++)
            sum += top_df[glb_top_df_offset + j];
        }
#else
        for (int j = 0; j < MLO_CONVBWDB_UNITSIZE; j++)
            sum += top_df[glb_top_df_offset + j];
#endif
    }
    lcl_sum[lid] = sum;

    barrier(CLK_LOCAL_MEM_FENCE);

    // Reduction over a work-grp: 256 -> 64 -> 16 -> 1
    if(lid < (MLO_CONVBWD_GROUP_SZ0 >> 2))
    {
        ReduceKernel(lcl_sum, 1, lid, 4);
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    if(lid < (MLO_CONVBWD_GROUP_SZ0 >> 4))
    {
        ReduceKernel(lcl_sum, 4, lid, 16);
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    if(lid == 0)
    {
        ReduceKernel(lcl_sum, 16, lid, 256);
    }
    barrier(CLK_LOCAL_MEM_FENCE);

    bias_df[output_map] = lcl_sum[0];
}


Replace loop with iterate

Replace loop with iterate

Removed last instances of loop, replaced with equivalent iterate uses

;this file is a re-write of my solutions to www.cryptopals.com, trying out cl21 and apps hungarian notation

(eval-when (:execute)
  (ql-dist:install-dist "http://dists.cl21.org/cl21.txt"))

(eval-when (:compile-toplevel :execute)
  (ql:quickload :cl21)
  (ql:quickload :cl-test-more)
  (ql:quickload "ironclad")
  (ql:quickload "hunchentoot")
  (ql:quickload :drakma)
  (ql:quickload :iterate))

(in-package :cl21-user)
(defpackage cryptopals
  (:use :cl21
	:cl-test-more
	:iterate)
  (:shadowing-import-from :iterate :until)
  (:shadowing-import-from :iterate :while))
(in-package :cryptopals)

#|prefixes:
bv  -  byte vector
in  -  int
s   -  string
hs  -  hex string (eg, "12ef" for #x12ef)
hc  -  hex char
b64 -  base64 encoded data, represented as a string
cb  -  count of bytes
by  -  byte
?   -  boolean predicate

|#

;some utility functions
(defun bv-make (cb-length &optional by-initial-element)
  (if by-initial-element
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element by-initial-element)
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element 0)))

(defun bv-rand (cb-length)
  (ironclad:make-random-salt cb-length))

(defun bv-pad (bv padded-len)
  (concatenate 'vector (bv-make (- padded-len (length bv))) bv))

(defun bv-from-in (in)
   (iterate (for i first in then (/ (- i (mod i 256)) 256))
	    (while (>= i 1))
	    (with res = #())
	    (after-each (push (mod i 256) res))
	    (after-each (print i))
	    (finally (return (nreverse res)))))

(defun bv-from-s (s)
  (map-to 'vector #'char-code s))

(defun bv-from-hs (hs)
  (let ((nibbles (map-to 'vector #'in-from-hc hs)))
    (let ((pairs (nreverse (subdivide (nreverse nibbles) 2)))) ;to handle odd lengths correctly
      (map-to 'vector (lm (pair) (+ (* 16 (second pair)) (first pair)))
	      pairs))))

(defun in-combine-bytes (high low bit-len)
  (+ (* high (expt 2 bit-len)) low))

(defun in-from-bv (bv)
  (reduce (lm (x y) (in-combine-bytes x y 8)) bv))

(defun in-from-s (s)
  (in-from-bv (bv-from-s s)))

(defun in-from-hc (hc)
  (let ((index "0123456789abcdef")
	(hc-dc (char-downcase hc)))
    (position hc-dc index)))

(defun in-from-hs (hs)
  (in-from-bv (bv-from-hs hs)))

(defun s-from-in (in)
  (s-from-bv (bv-from-in in)))

(defun s-from-bv (bv)
  (map-to 'string #'code-char bv))

(defun s-from-hs (hs)
  (s-from-bv (bv-from-hs hs)))

(defun s-from-seq (seq)
  (with-output-to-string (s)
    (doeach (x seq)
      (princ x s))))

(defun s-make (len &optional (c-initial-element #\a))
  (map-to 'string #'code-char (bv-make len (char-code c-initial-element))))

(defun hs-from-by (by)
  (let ((index "0123456789abcdef")
	(high (floor (/ by 16)))
	(low (mod by 16)))
    (format nil "~{~A~}" (list (getf index high) (getf index low)))))

(defun hs-from-bv (bv)
  (reduce (lm (x y) (concatenate 'string x y))
	  (map-to 'list #'hs-from-by bv)))

(defun hs-from-in (in)
  (hs-from-bv (bv-from-in in)))

(defun hs-from-s (s)
  (hs-from-bv (bv-from-s s)))

;conversion function tests
(ok (equalp (bv-pad #(1 2) 3) #(0 1 2))
    "bv-pad")
(ok (equalp (bv-from-in 258) #(1 2))
    "bv-from-in 1")
(ok (equalp (bv-from-in 123) #(123))
    "bv-from-in 2")
(ok (equalp (bv-from-s "ab") #((char-code #\a) (char-code #\b)))
    "bv-from-s")
(is (in-from-bv #(1 2)) 258)
(is (in-from-hc #\a) 10)
(is (in-from-hs "BC614e") 12345678)
(is (s-from-seq '(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (s-from-seq #(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (hs-from-by 255) "ff")
(is (hs-from-bv #(255 0)) "ff00")
(is (s-from-in (+ (* 97 256) 98)) "ab")

;set 1

;1. Convert hex to base64 encoding.  Base64 will be represented as a string in all future cases in this file

(defun mod-remainder (num div)
  (if (= (mod num div) 0)
      0
      (- div (mod num div))))

(defun b64c-from-6bits (n)
  (let ((base64-index "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
        (getf base64-index n)))

(defun b64-from-3bytes (bv)
  (let ((len-pad (mod-remainder (length bv) 3)))
    (let ((in-padded (in-from-bv (concatenate 'vector bv (bv-make len-pad))))
	  (s-padding (s-from-bv (bv-make len-pad 61))))
	(iterate (for offset in '(0 6 12 18))
		 (for cur-bits = (ldb (byte 6 offset) in-padded))
		 (collecting (b64c-from-6bits cur-bits) into l-res)
		 (finally (return (concatenate 'string
					       (subseq (s-from-seq (nreverse l-res))
						       0
						       (- 4 len-pad))
					       s-padding)))))))

(defun b64-from-bv (bv)
  (s-from-seq (map #'b64-from-3bytes (subdivide bv 3))))

(defun b64-from-hs (hs)
  (b64-from-bv (bv-from-hs hs)))

(defun b64-from-s (s)
  (b64-from-bv (bv-from-s s)))

(defun b64-from-in (in)
  (b64-from-bv (bv-from-in in)))

(is (b64-from-s "l pleasure.") "bCBwbGVhc3VyZS4=")

(defun 6bits-from-b64c (b64c)
  (position b64c "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))

(defun 3bv-from-b64 (b64)
  (let ((len-pad 0))
    (cond ((equalp (getf b64 2) #\=) (setf len-pad 2))
	  ((equalp (getf b64 3) #\=) (setf len-pad 1)))
    (let ((b64-padding (s-make len-pad #\A))
	  (b64-without-pad (subseq b64 0 (- 4 len-pad))))
      (let ((in-total (reduce (lm (high low) (in-combine-bytes high low 6))
			      (map-to 'vector #'6bits-from-b64c (concatenate 'string b64-without-pad b64-padding)))))
	(subseq (bv-pad (bv-from-in in-total) 3) 0 (- 3 len-pad))))))

(defun bv-from-b64 (b64)
  (reduce #'append (map-to 'vector #'3bv-from-b64 (subdivide b64 4))))

(defun in-from-b64 (b64)
  (in-from-bv (bv-from-b64 b64)))

(defun s-from-b64 (b64)
  (s-from-bv (bv-from-b64 b64)))

(defun hs-from-b64 (b64)
  (hs-from-bv (bv-from-b64 b64)))

(defun bv-from-b64-file (file-name)
  (bv-from-b64 (remove #\Newline (remove #\Return (read-file-into-string file-name)))))

(is (b64-from-hs "49276d206b696c6c696e6720796f757220627261696e206c696b65206120706f69736f6e6f7573206d757368726f6f6d")
    "SSdtIGtpbGxpbmcgeW91ciBicmFpbiBsaWtlIGEgcG9pc29ub3VzIG11c2hyb29t")

;2. Fixed XOR

;(int-to-hex-string (hex-string-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965"))

;output: "746865206b696420646f6e277420706c6179"

(defun bv-xor (bv1 bv2)
  (map-to 'vector #'logxor bv1 bv2))

(defun hs-xor (hs1 hs2)
  (hs-from-bv (bv-xor (bv-from-hs hs1) (bv-from-hs hs2))))

(defun s-xor (s1 s2)
  (s-from-bv (bv-xor (bv-from-s s1) (bv-from-s s2))))

(defun int-xor (&rest ints)
  (apply #'logxor ints))

(is (hs-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965")
    "746865206b696420646f6e277420706c6179")

;3. Single-character XOR Cipher:

;frequency table derived from http://www.data-compression.com/english.html
(defvar *frequency-table* #H(#\a .0651738 #\b .0124248 #\c .0217339 #\d .0349835 #\e .1041442 #\f .0197881 #\g .0158610 #\h .049288 #\i .0558094 #\j .0009033 #\k .0050529 #\l .0331490 #\m .0202124 #\n .0564513 #\o .0596302 #\p .0137645 #\q .0008606 #\r .0497563 #\s .0515760 #\t .0729357 #\u .0225134 #\v .0082903 #\w .0171272 #\x .0013692 #\y .0145984 #\z .0007836 #\  .1918182 #\newline .01 #\Return .01 #\' .01 #\. .01 #\" .01 #\, .01 #\0 .001 #\1 .001 #\2 .001 #\3 .001 #\4 .001 #\5 .001 #\6 .001 #\7 .001 #\8 .001 #\9 .001))

#|
;frequency table derived from Vanilla Ice lyrics
(defvar *frequency-table* #H(#\! 1/3101 #\1 1/3101 #\0 1/3101 #\. 2/3101 #\5 1/3101 #\z 3/3101 #\q 2/3101 #\j 13/3101 #\- 2/3101 #\x 4/3101 #\u 62/3101 #\? 3/3101 #\f 29/3101 #\m 66/3101 #\w 6/443 #\d 11/443 #\n 137/3101 #\h 109/3101 #\g 51/3101 #\r 78/3101 #\a 204/3101 #\b 76/3101 #\c 107/3101 #\k 47/3101 #\s 110/3101 #\' 33/3101 #\t 173/3101 #\e 257/3101 #\l 151/3101 #\Newline 110/3101 #\p 47/3101 #\i 207/3101 #\v 36/3101 #\  526/3101 #\, 72/3101 #\o 179/3101 #\y 82/3101))
|#

(defun ft-from-string (s)
  (let ((ft #H()))
    (doeach (chr s)
      (inc-hash ft (char-downcase chr)))
    (ft-normalize-hash ft)))

(defun ft-from-file (file)
  (let ((s (read-file-into-string file)))
    (ft-from-string s)))

(defun ft-from-bv (bv)
  (ft-from-string (s-from-bv bv)))

(defun inc-hash (table key)
  (let ((?-exists (nth-value 1 (getf table key))))
    (if ?-exists
        (incf (getf table key))
      (setf (getf table key) 1))))

(defun ft-normalize-hash (ft)
  (let ((sum (reduce #'+ (map-to 'list #'cdr ft))))
    (doeach ((key val) ft)
      (setf (getf ft key) (/ val sum)))
    ft))

(defun fl-frequency-compare (ft-test ft-ref)
  (let ((res 0))
    (doeach ((key val) ft-test res)
      (if (getf ft-ref key)
	  (incf res (expt (abs (- val (getf ft-ref key))) 5))
	  (incf res 100)))))

(defun bv-xor-with-byte (bv by)
  (map (lm (x) (logxor x by)) bv))

(defun xor-crack (bv-ciphertext ft-ref)
  (let ((res (list "default result" 0 1000)))
    (doeach (x (iota 256) res)
      (let ((cand (fl-frequency-compare (ft-from-bv (bv-xor-with-byte bv-ciphertext x))
					ft-ref)))
	(if (< cand (nth res 2))
	    (setf res (list (s-from-bv (bv-xor-with-byte bv-ciphertext x)) x cand)))))))

(is (nth (xor-crack (bv-from-hs "1b37373331363f78151b7f2b783431333d78397828372d363c78373e783a393b3736") *frequency-table*) 0)
    "Cooking MC's like a pound of bacon")

;4. Detect single-character XOR

(defun slist-from-file (file-name)
  (let ((s-file (read-file-into-string file-name)))
    (split #\newline s-file)))

(defun xor-find-crack (slist-cipher ft-ref)
  (let ((res (list "default result" 0 1000)) ;must match the layout of the output from xor-crack above
	(slist-plain (map (lm (x) (xor-crack (bv-from-hs x) ft-ref)) slist-cipher)))
    (doeach (x slist-plain res)
      (if (< (nth x 2) (nth res 2))
		 (setf res x)))))

(defun file-xor-find-crack (file-name ft-ref)
  (nth (xor-find-crack (slist-from-file file-name) ft-ref) 0))

(ok (equalp (file-xor-find-crack "/home/adminuser/4.txt" *frequency-table*)
	    "Now that the party is jumping\n")
    "file-xor-find-crack")

;5. Repeating-key XOR Cipher

(defun repeated-key-xor (bv-plain bv-key)
  (let ((bv-split (subdivide bv-plain (length bv-key))))
    (apply #'append (map-to 'list (lm (x) (bv-xor x bv-key)) bv-split))))

(is (hs-from-bv (repeated-key-xor (bv-from-s "Burning 'em, if you ain't quick and nimble I go crazy when I hear a cymbal")
				  (bv-from-s "ICE")))
    "0b3637272a2b2e63622c2e69692a23693a2a3c6324202d623d63343c2a26226324272765272a282b2f20690a652e2c652a3124333a653e2b2027630c692b20283165286326302e27282f")

;6. Break repeating-key XOR:

;(file-xor-crack "c:\\temp\\xor.txt" dict)

;outputs "Terminator X: Bring the noise" as the key, and some terrible vanila ice song as the plain text.

(defun in-bit-distance (in1 in2)
  (expt (logcount (logxor in1 in2)) 1))

(defun fl-bit-distance (bv1 bv2)
  (/ (reduce #'+ (map-to 'vector #'in-bit-distance bv1 bv2))
     (length bv1)))

(is (fl-bit-distance (bv-from-s "this is a test") (bv-from-s "wokka wokka!!!")) 37/14)

(is (fl-bit-distance #(2 4 8) #(3 5 9)) 1)
(is (fl-bit-distance #(2 4) #(3 5)) 1)

(defun map-pairs (fn seq)
  ;todo:  make this a generic function or something, so that the output type matches the
  ;       input type, instead of always outputing a list
  (iterate (repeat (- (length seq) 1))
	   (for elem first (first seq) then (first rest))
	   (for rest first (subseq seq 1) then (subseq rest 1))
	   (appending (map-to 'list (lm (x) (funcall fn x elem)) rest))))

(is (map-pairs #'+ '(1 2 3 4)) '(3 4 5 5 6 7))
(is (map-pairs #'+ #(1 2 3 4)) '(3 4 5 5 6 7))

(defun fact (in)
  (reduce #'* (iota in :start 1)))

(is (fact 1) 1)
(is (fact 5) 120)

(defun n-choose-r (n r)
  (/ (fact n) (* (fact r) (fact (- n r)))))

(is (n-choose-r 6 2) 15)

(defun lst-xor-block-size (bv-cipher max-size)
  (let ((lens (iota max-size :start 1)))
    (let ((cands (map (lm (x) (xor-block-size-helper bv-cipher x))
		      lens)))
      (take 15 (sort cands (lm (pair1 pair2) (< (cdr pair1) (cdr pair2))))))))

(defun xor-block-size-helper (bv-cipher len)
  (let ((blocks (subdivide bv-cipher len)))
    (cons len
	  (/ (reduce #'+ (map-pairs #'fl-bit-distance blocks))
	     (n-choose-r (length blocks) 2)))))

(defun lst-block-transpose (bv block-len)
  (let ((res '())
	(blocks (subdivide bv block-len)))
    (doeach (i (iota block-len) res)
      (push (map-to 'vector (lm (x) (if (< i (length x)) (elt x i) 0)) blocks) res))
    (nreverse res)))

(ok (equalp (lst-block-transpose #(1 2 3 4 5 6 7 8) 2)
	    (list (vector 1 3 5 7) (vector 2 4 6 8)))
    "lst-block-transpose")

(defun bv-find-repeat-key (bv-cipher)
 (let* ((block-lens (map #'car (lst-xor-block-size bv-cipher 50)))
	(transposes (map (lm (x) (lst-block-transpose bv-cipher x)) block-lens)))
    (let* ((lst-keys (map (lm (transpose) (map-to 'vector (lm (bv) (elt (xor-crack bv *frequency-table*) 1))
						 transpose))
			  transposes))
	   (lst-bvs (map (lm (key) (repeated-key-xor bv-cipher key))
			 lst-keys)))
      (car (sort lst-bvs (lm (bv1 bv2) (< (fl-frequency-compare (ft-from-bv bv1) *frequency-table*)
					  (fl-frequency-compare (ft-from-bv bv2) *frequency-table*))))))))

(defun s-file-find-repeat-key (filename)
  (s-from-bv (bv-find-repeat-key (bv-from-b64-file filename))))

(eval-when (:execute)
  (print (s-file-find-repeat-key "c:\\temp\\xor.txt")))

(eval-when (:execute)
  (print (s-file-find-repeat-key "/home/adminuser/6.txt")))

;7. AES in ECB mode:

(defun bv-AES-encrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:encrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun bv-AES-decrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:decrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun s-AES-encrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-encrypt bv-msg bv-key))))

(defun s-AES-decrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-decrypt bv-msg bv-key))))

(defun bv-file-aes-encrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-encrypt bv-msg bv-key)))

(defun bv-file-aes-decrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-decrypt bv-msg bv-key)))

(defun s-file-aes-encrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-encrypt file-name bv-key))))

(defun s-file-aes-decrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-decrypt file-name bv-key))))

(eval-when (:execute)
  (print (s-from-bv (bv-aes-decrypt (bv-from-b64-file "/home/adminuser/7.txt") (bv-from-s "YELLOW SUBMARINE")))))

;8. Detect AES in ECB mode

;this is easy.  The only distinguishing fact about ECB is that identical blocks give identical encryption, so look for identical blocks

(defun bv-find-duplicate-blocks (lst-bvs cb-len)
  (let ((lst-blocks (map (lm (bv) (subdivide bv cb-len)) lst-bvs))
	(res #()))
    (doeach (blocks lst-blocks res)
      (if (not (= (reduce #'+ (map-pairs #'fl-bit-distance blocks)) 0))
	  (setf res (apply #'concatenate 'vector blocks))))))

(defun bv-file-find-duplicate-blocks (file-name cb-len)
  (let* ((lst-hs (split #\newline (read-file-into-string file-name)))
	 (lst-bvs (map #'bv-from-hs lst-hs)))
    (bv-find-duplicate-blocks lst-bvs cb-len)))

(eval-when (:execute)
  (print (bv-file-find-duplicate-blocks "/home/adminuser/8.txt" 16)))

;problems from set 2

;9. Implement PKCS#7 padding

(defun bv-pkcs7-pad (bv cb-block-len)
  ;gives a full block of padding for even multiples of the block length
  (let ((cb-padding-len (- cb-block-len (mod (length bv) cb-block-len))))
    (concatenate 'vector bv (make-array cb-padding-len :initial-element cb-padding-len))))

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20)
	    #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 4 4 4 4))
    "bv-pkcs7-pad 1")

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 16)
	       #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16))
    "bv-pkcs7-pad 2")

;this is nominally challenge 15, but using it makes #13 easier to implement, so I'm writing it now
(defun bv-pkcs7-unpad (bv cb-block-len)
  ;returns nil for invalid padding
  (iterate (for i from 1)
	   (until (equalp (subseq bv (- (length bv) i)) (bv-make i i)))
	   (until (> i cb-block-len))
	   (finally (if (<= i cb-block-len)
			(return (subseq bv 0 (- (length bv) i)))
			(return 'nil)))))

(ok (equalp (bv-pkcs7-unpad (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20) 20)
	    (bv-from-s "YELLOW SUBMARINE"))
    "bv-pkcs7-unpad 1")

(ok (equalp (bv-pkcs7-unpad #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) 16)
	    'nil)
    "bv-pkcs7-unpad 2")

(defun bv-aes-pkcs7-encrypt (bv-msg bv-key)
  (bv-aes-encrypt (bv-pkcs7-pad bv-msg 16) bv-key))

(defun bv-aes-pkcs7-decrypt (bv-msg bv-key)
  (bv-aes-decrypt (bv-pkcs7-unpad bv-msg 16) bv-key))

;10. Implement CBC Mode

(defun bv-aes-cbc-encrypt (bv-msg bv-iv bv-key)
  (let* ((bv-padded (bv-pkcs7-pad bv-msg 16))
	 (blocks (subdivide bv-padded 16))
	 (res (iterate (for next in blocks)
		       (for prev previous ctext first bv-iv)
		       (for ctext = (bv-aes-encrypt (bv-xor prev next) bv-key))
		       (collecting ctext))))
    (apply #'concatenate 'vector res)))

(defun bv-aes-cbc-decrypt (bv-msg bv-iv bv-key)
  (let* ((blocks (subdivide bv-msg 16))
	 (res (iterate (for next in blocks)
		       (for prev previous next first bv-iv)
		       (collecting (bv-xor (bv-aes-decrypt next bv-key) prev)))))
    (bv-pkcs7-unpad (apply #'concatenate 'vector res) 16)))

(defun bv-file-aes-cbc-encrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-encrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-encrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-encrypt file-name bv-iv bv-key))))

(defun bv-file-aes-cbc-decrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-decrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-decrypt file-name bv-iv bv-key))))

(ok (equalp (let ((bv-msg (bv-make 48 65))
		  (bv-key (bv-rand 16))
		  (bv-iv (bv-rand 16)))
	      (bv-aes-cbc-decrypt (bv-aes-cbc-encrypt bv-msg bv-iv bv-key) bv-iv bv-key))
	    (bv-make 48 65))
    "bv-aes-cbc-encrypt/decrypt")

;11. An ECB/CBC detection oracle

;This is also easy:  just send a long repeated string as input, check for repeats in the output

(defun ch11-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand (+ 5 (random 6))))
	(bv-post-pad (bv-rand (+ 5 (random 6)))))
    (let ((bv-iv (bv-rand 16))
	  (bv-key (bv-rand 16))
	  (bv-padded (concatenate 'vector bv-pre-pad bv-msg bv-post-pad)))
      (if (= (random 2) 0)
	  (progn (print "cbc")
		 (bv-aes-cbc-encrypt bv-padded bv-iv bv-key))
	  (progn (print "ecb")
		 (bv-aes-encrypt bv-padded bv-key))))))

(defun ?-duplicate-blocks (blocks)
  (some (lm (x) (= x 0)) (map-pairs #'fl-bit-distance blocks)))

(defun ch11-crack ()
  (let* ((bv-msg (bv-make 48 65))
	 (bv-res (coerce (ch11-oracle bv-msg) '(and common-lisp:vector (not simple-array))))
	 (blocks (subdivide bv-res 16)))
    (if (?-duplicate-blocks blocks)
	"ecb"
	"cbc")))

(print (ch11-crack))

;12. Byte-at-a-time ECB decryption (Simple)

(defun ch12-oracle (bv-msg)
  (let ((bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (concatenate 'vector bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch12-crack ()
  (let ((bv-res #()))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix first (bv-make 15) then (concatenate 'vector (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (concatenate 'vector bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch12-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch12-crack)))

;13.  ECB cut-and-paste

(defun ch13-parse (s-cookie)
  (let* ((s-pairs (split #\& s-cookie))
	 ;map doesn't work here, seems to give a list with slightly incorrect structure
	 (s-keys-vals (iterate (for s in s-pairs)
			       (appending (split #\= s)))))
    (apply #'hash-table #'equal s-keys-vals)))

(defun ch13-make-profile (s-email)
  (let ((s-stripped (remove #\= (remove #\& s-email))))
    #"email=${s-stripped}&uid=10&role=user"))

(is (ch13-make-profile "foo@bar.com") "email=foo@bar.com&uid=10&role=user")

(defun ch13-test (bv-ctext bv-key)
  (let* ((s-cookie (s-from-bv (bv-pkcs7-unpad (bv-aes-decrypt bv-ctext bv-key) 16)))
	 (profile-table (ch13-parse s-cookie)))
    (if (equal (getf profile-table "role") "admin")
	"victory"
	"failure")))

(is (ch13-test (bv-aes-encrypt (bv-pkcs7-pad (bv-from-s "email=foo@bar.com&uid=10&role=admin") 16)
			       (bv-make 16)) (bv-make 16))
    "victory")

(defun ch13-enc-profile (s-email bv-key)
  (bv-aes-pkcs7-encrypt (bv-from-s (ch13-make-profile s-email)) bv-key))

(defun ch13-crack ()
  (let ((bv-key (bv-rand 16)))
    (let ((bv-padding (last (subdivide (ch13-enc-profile "fo@ba.com" bv-key) 16))) ;encryption of 16 16's
	  (bv-email (subseq (ch13-enc-profile "bcobu@foo.com" bv-key) 0 32))
	  (bv-admin (elt (subdivide (ch13-enc-profile "foo@bar.coadmin" bv-key) 16) 1)))
      (ch13-test (concatenate 'vector bv-email bv-admin bv-padding) bv-key))))

(is (ch13-crack)
    "victory")

;14. Byte-at-a-time ECB decryption (Harder)

;this is identical to #12, except that there's an initial step where we find the length of the 'random' prefix
(defvar *ch14-prefix-len* (+ 5 (random 6)))

(defun ch14-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand *ch14-prefix-len*))
	(bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (concatenate 'vector bv-pre-pad bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch14-prefix-len ()
  (iterate (for i from 0 to 16)
	   (for bv-oracle-output = (ch14-oracle (concatenate 'vector (bv-rand i) (bv-make 32))))
	   (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
	   (finally (return i))))

(defun ch14-crack ()
  (let ((bv-res #())
	(cb-prefix-len (ch14-prefix-len)))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix first (bv-make (+ cb-prefix-len 15)) then (concatenate 'vector (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (concatenate 'vector bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch14-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch14-crack)))

;15. PKCS#7 padding validation

;implementing above under #9, because it's used in #13

;16. CBC bitflipping attacks

(defun ch16-encrypt (s-userdata bv-iv bv-key)
  (let ((s-stripped (remove #\= (remove #\; s-userdata)))
	(s-pre "comment1=cooking%20MCs;userdata=")
	(s-post ";comment2=%20like%20a%20pound%20of%20bacon"))
    (let ((bv-msg (bv-from-s (concatenate 'string s-pre s-stripped s-post))))
      (bv-aes-cbc-encrypt bv-msg bv-iv bv-key))))

(defun ch16-check (bv-ctext bv-iv bv-key)
  (let ((s-ptext (s-from-bv (bv-aes-cbc-decrypt bv-ctext bv-iv bv-key))))
    (search";admin=true;" s-ptext)))

(defun ch16-crack ()
  (let* ((bv-userdata (bv-make 16 65))
	 (bv-iv (bv-rand 16))
	 (bv-key (bv-rand 16))
	 (bv-ctext (ch16-encrypt (s-from-bv bv-userdata) bv-iv bv-key))
	 (bv-target (bv-from-s "a;admin=true;aaa"))
	 (bv-edit (bv-xor (bv-xor bv-userdata bv-target) (subseq bv-ctext 16 32))))
    (ch16-check bv-ctext bv-iv bv-key)
    (ch16-check (concatenate 'vector (subseq bv-ctext 0 16) bv-edit (subseq bv-ctext 32))
		bv-iv
		bv-key)))

(ok (ch16-crack) "Challenge 16")

;problems from set 3

;17. CBC padding oracle

(defun ch17-encrypt (bv-iv bv-key)
  (let ((lst-secrets (list "MDAwMDAwTm93IHRoYXQgdGhlIHBhcnR5IGlzIGp1bXBpbmc="
			   "MDAwMDAxV2l0aCB0aGUgYmFzcyBraWNrZWQgaW4gYW5kIHRoZSBWZWdhJ3MgYXJlIHB1bXBpbic="
			   "MDAwMDAyUXVpY2sgdG8gdGhlIHBvaW50LCB0byB0aGUgcG9pbnQsIG5vIGZha2luZw=="
			   "MDAwMDAzQ29va2luZyBNQydzIGxpa2UgYSBwb3VuZCBvZiBiYWNvbg=="
			   "MDAwMDA0QnVybmluZyAnZW0sIGlmIHlvdSBhaW4ndCBxdWljayBhbmQgbmltYmxl"
			   "MDAwMDA1SSBnbyBjcmF6eSB3aGVuIEkgaGVhciBhIGN5bWJhbA=="
			   "MDAwMDA2QW5kIGEgaGlnaCBoYXQgd2l0aCBhIHNvdXBlZCB1cCB0ZW1wbw=="
			   "MDAwMDA3SSdtIG9uIGEgcm9sbCwgaXQncyB0aW1lIHRvIGdvIHNvbG8="
			   "MDAwMDA4b2xsaW4nIGluIG15IGZpdmUgcG9pbnQgb2g="
			   "MDAwMDA5aXRoIG15IHJhZy10b3AgZG93biBzbyBteSBoYWlyIGNhbiBibG93")))
    (let ((bv-secret (bv-from-b64 (elt lst-secrets (random (length lst-secrets))))))
      (bv-aes-cbc-encrypt bv-secret bv-iv bv-key))))

(defun ch17-oracle (bv-msg bv-iv bv-key)
  (let ((res (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))
    (if res
	t
	'nil)))

;this file is a re-write of my solutions to www.cryptopals.com, trying out cl21 and apps hungarian notation

(eval-when (:execute)
  (ql-dist:install-dist "http://dists.cl21.org/cl21.txt"))

(eval-when (:compile-toplevel :execute)
  (ql:quickload :cl21)
  (ql:quickload :cl-test-more)
  (ql:quickload "ironclad")
  (ql:quickload "hunchentoot")
  (ql:quickload :drakma)
  (ql:quickload :iterate))

(in-package :cl21-user)
(defpackage cryptopals
  (:use :cl21
	:cl-test-more
	:iterate)
  (:shadowing-import-from :iterate :until)
  (:shadowing-import-from :iterate :while))
(in-package :cryptopals)

#|prefixes:
bv  -  byte vector
in  -  int
s   -  string
hs  -  hex string (eg, "12ef" for #x12ef)
hc  -  hex char
b64 -  base64 encoded data, represented as a string
cb  -  count of bytes
by  -  byte
?   -  boolean predicate

|#

;some utility functions
(defun bv-make (cb-length &optional by-initial-element)
  (if by-initial-element
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element by-initial-element)
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element 0)))

(defun bv-rand (cb-length)
  (ironclad:make-random-salt cb-length))

(defun bv-pad (bv padded-len)
  (concatenate 'vector (bv-make (- padded-len (length bv))) bv))

(defun bv-from-in (in)
   (loop for i = in then (/ (- i (mod i 256)) 256)
       while (>= i 1)
       with res = #()
       do (push (mod i 256) res)
       finally (return (nreverse res))))

(defun bv-from-s (s)
  (map-to 'vector #'char-code s))

(defun bv-from-hs (hs)
  (let ((nibbles (map-to 'vector #'in-from-hc hs)))
    (let ((pairs (nreverse (subdivide (nreverse nibbles) 2)))) ;to handle odd lengths correctly
      (map-to 'vector (lm (pair) (+ (* 16 (second pair)) (first pair)))
	      pairs))))

(defun in-combine-bytes (high low bit-len)
  (+ (* high (expt 2 bit-len)) low))

(defun in-from-bv (bv)
  (reduce (lm (x y) (in-combine-bytes x y 8)) bv))

(defun in-from-s (s)
  (in-from-bv (bv-from-s s)))

(defun in-from-hc (hc)
  (let ((index "0123456789abcdef")
	(hc-dc (char-downcase hc)))
    (position hc-dc index)))

(defun in-from-hs (hs)
  (in-from-bv (bv-from-hs hs)))

(defun s-from-in (in)
  (s-from-bv (bv-from-in in)))

(defun s-from-bv (bv)
  (map-to 'string #'code-char bv))

(defun s-from-hs (hs)
  (s-from-bv (bv-from-hs hs)))

(defun s-from-seq (seq)
  (with-output-to-string (s)
    (doeach (x seq)
      (princ x s))))

(defun s-make (len &optional (c-initial-element #\a))
  (map-to 'string #'code-char (bv-make len (char-code c-initial-element))))

(defun hs-from-by (by)
  (let ((index "0123456789abcdef")
	(high (floor (/ by 16)))
	(low (mod by 16)))
    (format nil "~{~A~}" (list (getf index high) (getf index low)))))

(defun hs-from-bv (bv)
  (reduce (lm (x y) (concatenate 'string x y))
	  (map-to 'list #'hs-from-by bv)))

(defun hs-from-in (in)
  (hs-from-bv (bv-from-in in)))

(defun hs-from-s (s)
  (hs-from-bv (bv-from-s s)))

;conversion function tests
(ok (equalp (bv-pad #(1 2) 3) #(0 1 2))
    "bv-pad")
(ok (equalp (bv-from-in 258) #(1 2))
    "bv-from-in 1")
(ok (equalp (bv-from-in 123) #(123))
    "bv-from-in 2")
(ok (equalp (bv-from-s "ab") #((char-code #\a) (char-code #\b)))
    "bv-from-s")
(is (in-from-bv #(1 2)) 258)
(is (in-from-hc #\a) 10)
(is (in-from-hs "BC614e") 12345678)
(is (s-from-seq '(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (s-from-seq #(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (hs-from-by 255) "ff")
(is (hs-from-bv #(255 0)) "ff00")
(is (s-from-in (+ (* 97 256) 98)) "ab")

;set 1

;1. Convert hex to base64 encoding.  Base64 will be represented as a string in all future cases in this file

(defun mod-remainder (num div)
  (if (= (mod num div) 0)
      0
      (- div (mod num div))))

(defun b64c-from-6bits (n)
  (let ((base64-index "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
        (getf base64-index n)))

(defun b64-from-3bytes (bv)
  (let ((len-pad (mod-remainder (length bv) 3)))
    (let ((in-padded (in-from-bv (concatenate 'vector bv (bv-make len-pad))))
	  (s-padding (s-from-bv (bv-make len-pad 61))))
	(loop for offset in '(0 6 12 18)
	   for cur-bits = (ldb (byte 6 offset) in-padded)
	   collecting (b64c-from-6bits cur-bits) into l-res
	   finally (return (concatenate 'string
					(subseq (s-from-seq (nreverse l-res))
						0
						(- 4 len-pad))
					s-padding))))))

(defun b64-from-bv (bv)
  (s-from-seq (map #'b64-from-3bytes (subdivide bv 3))))

(defun b64-from-hs (hs)
  (b64-from-bv (bv-from-hs hs)))

(defun b64-from-s (s)
  (b64-from-bv (bv-from-s s)))

(defun b64-from-in (in)
  (b64-from-bv (bv-from-in in)))

(is (b64-from-s "l pleasure.") "bCBwbGVhc3VyZS4=")

(defun 6bits-from-b64c (b64c)
  (position b64c "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))

(defun 3bv-from-b64 (b64)
  (let ((len-pad 0))
    (cond ((equalp (getf b64 2) #\=) (setf len-pad 2))
	  ((equalp (getf b64 3) #\=) (setf len-pad 1)))
    (let ((b64-padding (s-make len-pad #\A))
	  (b64-without-pad (subseq b64 0 (- 4 len-pad))))
      (let ((in-total (reduce (lm (high low) (in-combine-bytes high low 6))
			      (map-to 'vector #'6bits-from-b64c (concatenate 'string b64-without-pad b64-padding)))))
	(subseq (bv-pad (bv-from-in in-total) 3) 0 (- 3 len-pad))))))

(defun bv-from-b64 (b64)
  (reduce #'append (map-to 'vector #'3bv-from-b64 (subdivide b64 4))))

(defun in-from-b64 (b64)
  (in-from-bv (bv-from-b64 b64)))

(defun s-from-b64 (b64)
  (s-from-bv (bv-from-b64 b64)))

(defun hs-from-b64 (b64)
  (hs-from-bv (bv-from-b64 b64)))

(defun bv-from-b64-file (file-name)
  (bv-from-b64 (remove #\Newline (remove #\Return (read-file-into-string file-name)))))

(is (b64-from-hs "49276d206b696c6c696e6720796f757220627261696e206c696b65206120706f69736f6e6f7573206d757368726f6f6d")
    "SSdtIGtpbGxpbmcgeW91ciBicmFpbiBsaWtlIGEgcG9pc29ub3VzIG11c2hyb29t")

;2. Fixed XOR

;(int-to-hex-string (hex-string-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965"))

;output: "746865206b696420646f6e277420706c6179"

(defun bv-xor (bv1 bv2)
  (map-to 'vector #'logxor bv1 bv2))

(defun hs-xor (hs1 hs2)
  (hs-from-bv (bv-xor (bv-from-hs hs1) (bv-from-hs hs2))))

(defun s-xor (s1 s2)
  (s-from-bv (bv-xor (bv-from-s s1) (bv-from-s s2))))

(defun int-xor (&rest ints)
  (apply #'logxor ints))

(is (hs-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965")
    "746865206b696420646f6e277420706c6179")

;3. Single-character XOR Cipher:

;frequency table derived from http://www.data-compression.com/english.html
(defvar *frequency-table* #H(#\a .0651738 #\b .0124248 #\c .0217339 #\d .0349835 #\e .1041442 #\f .0197881 #\g .0158610 #\h .049288 #\i .0558094 #\j .0009033 #\k .0050529 #\l .0331490 #\m .0202124 #\n .0564513 #\o .0596302 #\p .0137645 #\q .0008606 #\r .0497563 #\s .0515760 #\t .0729357 #\u .0225134 #\v .0082903 #\w .0171272 #\x .0013692 #\y .0145984 #\z .0007836 #\  .1918182 #\newline .01 #\Return .01 #\' .01 #\. .01 #\" .01 #\, .01 #\0 .001 #\1 .001 #\2 .001 #\3 .001 #\4 .001 #\5 .001 #\6 .001 #\7 .001 #\8 .001 #\9 .001))

#|
;frequency table derived from Vanilla Ice lyrics
(defvar *frequency-table* #H(#\! 1/3101 #\1 1/3101 #\0 1/3101 #\. 2/3101 #\5 1/3101 #\z 3/3101 #\q 2/3101 #\j 13/3101 #\- 2/3101 #\x 4/3101 #\u 62/3101 #\? 3/3101 #\f 29/3101 #\m 66/3101 #\w 6/443 #\d 11/443 #\n 137/3101 #\h 109/3101 #\g 51/3101 #\r 78/3101 #\a 204/3101 #\b 76/3101 #\c 107/3101 #\k 47/3101 #\s 110/3101 #\' 33/3101 #\t 173/3101 #\e 257/3101 #\l 151/3101 #\Newline 110/3101 #\p 47/3101 #\i 207/3101 #\v 36/3101 #\  526/3101 #\, 72/3101 #\o 179/3101 #\y 82/3101))
|#

(defun ft-from-string (s)
  (let ((ft #H()))
    (doeach (chr s)
      (inc-hash ft (char-downcase chr)))
    (ft-normalize-hash ft)))

(defun ft-from-file (file)
  (let ((s (read-file-into-string file)))
    (ft-from-string s)))

(defun ft-from-bv (bv)
  (ft-from-string (s-from-bv bv)))

(defun inc-hash (table key)
  (let ((?-exists (nth-value 1 (getf table key))))
    (if ?-exists
        (incf (getf table key))
      (setf (getf table key) 1))))

(defun ft-normalize-hash (ft)
  (let ((sum (reduce #'+ (map-to 'list #'cdr ft))))
    (doeach ((key val) ft)
      (setf (getf ft key) (/ val sum)))
    ft))

(defun fl-frequency-compare (ft-test ft-ref)
  (let ((res 0))
    (doeach ((key val) ft-test res)
      (if (getf ft-ref key)
	  (incf res (expt (abs (- val (getf ft-ref key))) 5))
	  (incf res 100)))))

(defun bv-xor-with-byte (bv by)
  (map (lm (x) (logxor x by)) bv))

(defun xor-crack (bv-ciphertext ft-ref)
  (let ((res (list "default result" 0 1000)))
    (doeach (x (iota 256) res)
      (let ((cand (fl-frequency-compare (ft-from-bv (bv-xor-with-byte bv-ciphertext x))
					ft-ref)))
	(if (< cand (nth res 2))
	    (setf res (list (s-from-bv (bv-xor-with-byte bv-ciphertext x)) x cand)))))))

(is (nth (xor-crack (bv-from-hs "1b37373331363f78151b7f2b783431333d78397828372d363c78373e783a393b3736") *frequency-table*) 0)
    "Cooking MC's like a pound of bacon")

;4. Detect single-character XOR

(defun slist-from-file (file-name)
  (let ((s-file (read-file-into-string file-name)))
    (split #\newline s-file)))

(defun xor-find-crack (slist-cipher ft-ref)
  (let ((res (list "default result" 0 1000)) ;must match the layout of the output from xor-crack above
	(slist-plain (map (lm (x) (xor-crack (bv-from-hs x) ft-ref)) slist-cipher)))
    (doeach (x slist-plain res)
      (if (< (nth x 2) (nth res 2))
		 (setf res x)))))

(defun file-xor-find-crack (file-name ft-ref)
  (nth (xor-find-crack (slist-from-file file-name) ft-ref) 0))

(ok (equalp (file-xor-find-crack "/home/adminuser/4.txt" *frequency-table*)
	    "Now that the party is jumping\n")
    "file-xor-find-crack")

;5. Repeating-key XOR Cipher

(defun repeated-key-xor (bv-plain bv-key)
  (let ((bv-split (subdivide bv-plain (length bv-key))))
    (apply #'append (map-to 'list (lm (x) (bv-xor x bv-key)) bv-split))))

(is (hs-from-bv (repeated-key-xor (bv-from-s "Burning 'em, if you ain't quick and nimble I go crazy when I hear a cymbal")
				  (bv-from-s "ICE")))
    "0b3637272a2b2e63622c2e69692a23693a2a3c6324202d623d63343c2a26226324272765272a282b2f20690a652e2c652a3124333a653e2b2027630c692b20283165286326302e27282f")

;6. Break repeating-key XOR:

;(file-xor-crack "c:\\temp\\xor.txt" dict)

;outputs "Terminator X: Bring the noise" as the key, and some terrible vanila ice song as the plain text.

(defun in-bit-distance (in1 in2)
  (expt (logcount (logxor in1 in2)) 1))

(defun fl-bit-distance (bv1 bv2)
  (/ (reduce #'+ (map-to 'vector #'in-bit-distance bv1 bv2))
     (length bv1)))

(is (fl-bit-distance (bv-from-s "this is a test") (bv-from-s "wokka wokka!!!")) 37/14)

(is (fl-bit-distance #(2 4 8) #(3 5 9)) 1)
(is (fl-bit-distance #(2 4) #(3 5)) 1)

(defun map-pairs (fn seq)
  ;todo:  make this a generic function or something, so that the output type matches the
  ;       input type, instead of always outputing a list
  (loop repeat (- (length seq) 1)
     for elem = (first seq) then (first rest)
     for rest = (subseq seq 1) then (subseq rest 1)
     appending (map-to 'list (lm (x) (funcall fn x elem)) rest)))

(is (map-pairs #'+ '(1 2 3 4)) '(3 4 5 5 6 7))
(is (map-pairs #'+ #(1 2 3 4)) '(3 4 5 5 6 7))

(defun fact (in)
  (reduce #'* (iota in :start 1)))

(is (fact 1) 1)
(is (fact 5) 120)

(defun n-choose-r (n r)
  (/ (fact n) (* (fact r) (fact (- n r)))))

(is (n-choose-r 6 2) 15)

(defun lst-xor-block-size (bv-cipher max-size)
  (let ((lens (iota max-size :start 1)))
    (let ((cands (map (lm (x) (xor-block-size-helper bv-cipher x))
		      lens)))
      (take 15 (sort cands (lm (pair1 pair2) (< (cdr pair1) (cdr pair2))))))))

(defun xor-block-size-helper (bv-cipher len)
  (let ((blocks (subdivide bv-cipher len)))
    (cons len
	  (/ (reduce #'+ (map-pairs #'fl-bit-distance blocks))
	     (n-choose-r (length blocks) 2)))))

(defun lst-block-transpose (bv block-len)
  (let ((res '())
	(blocks (subdivide bv block-len)))
    (doeach (i (iota block-len) res)
      (push (map-to 'vector (lm (x) (if (< i (length x)) (elt x i) 0)) blocks) res))
    (nreverse res)))

(ok (equalp (lst-block-transpose #(1 2 3 4 5 6 7 8) 2)
	    (list (vector 1 3 5 7) (vector 2 4 6 8)))
    "lst-block-transpose")

(defun bv-find-repeat-key (bv-cipher)
 (let* ((block-lens (map #'car (lst-xor-block-size bv-cipher 50)))
	(transposes (map (lm (x) (lst-block-transpose bv-cipher x)) block-lens)))
    (let* ((lst-keys (map (lm (transpose) (map-to 'vector (lm (bv) (elt (xor-crack bv *frequency-table*) 1))
						 transpose))
			  transposes))
	   (lst-bvs (map (lm (key) (repeated-key-xor bv-cipher key))
			 lst-keys)))
      (car (sort lst-bvs (lm (bv1 bv2) (< (fl-frequency-compare (ft-from-bv bv1) *frequency-table*)
					  (fl-frequency-compare (ft-from-bv bv2) *frequency-table*))))))))

(defun s-file-find-repeat-key (filename)
  (s-from-bv (bv-find-repeat-key (bv-from-b64-file filename))))

(eval-when (:execute)
  (print (s-file-find-repeat-key "c:\\temp\\xor.txt")))

(eval-when (:execute)
  (print (s-file-find-repeat-key "/home/adminuser/6.txt")))

;7. AES in ECB mode:

(defun bv-AES-encrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:encrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun bv-AES-decrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:decrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun s-AES-encrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-encrypt bv-msg bv-key))))

(defun s-AES-decrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-decrypt bv-msg bv-key))))

(defun bv-file-aes-encrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-encrypt bv-msg bv-key)))

(defun bv-file-aes-decrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-decrypt bv-msg bv-key)))

(defun s-file-aes-encrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-encrypt file-name bv-key))))

(defun s-file-aes-decrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-decrypt file-name bv-key))))

(eval-when (:execute)
  (print (s-from-bv (bv-aes-decrypt (bv-from-b64-file "/home/adminuser/7.txt") (bv-from-s "YELLOW SUBMARINE")))))

;8. Detect AES in ECB mode

;this is easy.  The only distinguishing fact about ECB is that identical blocks give identical encryption, so look for identical blocks

(defun bv-find-duplicate-blocks (lst-bvs cb-len)
  (let ((lst-blocks (map (lm (bv) (subdivide bv cb-len)) lst-bvs))
	(res #()))
    (doeach (blocks lst-blocks res)
      (if (not (= (reduce #'+ (map-pairs #'fl-bit-distance blocks)) 0))
	  (setf res (apply #'concatenate 'vector blocks))))))

(defun bv-file-find-duplicate-blocks (file-name cb-len)
  (let* ((lst-hs (split #\newline (read-file-into-string file-name)))
	 (lst-bvs (map #'bv-from-hs lst-hs)))
    (bv-find-duplicate-blocks lst-bvs cb-len)))

(eval-when (:execute)
  (print (bv-file-find-duplicate-blocks "/home/adminuser/8.txt" 16)))

;problems from set 2

;9. Implement PKCS#7 padding

(defun bv-pkcs7-pad (bv cb-block-len)
  ;gives a full block of padding for even multiples of the block length
  (let ((cb-padding-len (- cb-block-len (mod (length bv) cb-block-len))))
    (concatenate 'vector bv (make-array cb-padding-len :initial-element cb-padding-len))))

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20)
	    #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 4 4 4 4))
    "bv-pkcs7-pad 1")

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 16)
	       #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16))
    "bv-pkcs7-pad 2")

;this is nominally challenge 15, but using it makes #13 easier to implement, so I'm writing it now
(defun bv-pkcs7-unpad (bv cb-block-len)
  ;returns nil for invalid padding
  (iterate (for i from 1)
	   (until (equalp (subseq bv (- (length bv) i)) (bv-make i i)))
	   (until (> i cb-block-len))
	   (finally (if (<= i cb-block-len)
			(return (subseq bv 0 (- (length bv) i)))
			(return 'nil)))))

(ok (equalp (bv-pkcs7-unpad (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20) 20)
	    (bv-from-s "YELLOW SUBMARINE"))
    "bv-pkcs7-unpad 1")

(ok (equalp (bv-pkcs7-unpad #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) 16)
	    'nil)
    "bv-pkcs7-unpad 2")

(defun bv-aes-pkcs7-encrypt (bv-msg bv-key)
  (bv-aes-encrypt (bv-pkcs7-pad bv-msg 16) bv-key))

(defun bv-aes-pkcs7-decrypt (bv-msg bv-key)
  (bv-aes-decrypt (bv-pkcs7-unpad bv-msg 16) bv-key))

;10. Implement CBC Mode

(defun bv-aes-cbc-encrypt (bv-msg bv-iv bv-key)
  (let* ((bv-padded (bv-pkcs7-pad bv-msg 16))
	 (blocks (subdivide bv-padded 16))
	 (res (iterate (for next in blocks)
		       (for prev previous ctext initially bv-iv)
		       (for ctext = (bv-aes-encrypt (bv-xor prev next) bv-key))
		       (collecting ctext))))
    (apply #'concatenate 'vector res)))

(defun bv-aes-cbc-decrypt (bv-msg bv-iv bv-key)
  (let* ((blocks (subdivide bv-msg 16))
	 (res (iterate (for next in blocks)
		       (for prev previous next initially bv-iv)
		       (collecting (bv-xor (bv-aes-decrypt next bv-key) prev)))))
    (bv-pkcs7-unpad (apply #'concatenate 'vector res) 16)))

(defun bv-file-aes-cbc-encrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-encrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-encrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-encrypt file-name bv-iv bv-key))))

(defun bv-file-aes-cbc-decrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-decrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-decrypt file-name bv-iv bv-key))))

(ok (equalp (let ((bv-msg (bv-make 48 65))
		  (bv-key (bv-rand 16))
		  (bv-iv (bv-rand 16)))
	      (bv-aes-cbc-decrypt (bv-aes-cbc-encrypt bv-msg bv-iv bv-key) bv-iv bv-key))
	    (bv-make 48 65))
    "bv-aes-cbc-encrypt/decrypt")

;11. An ECB/CBC detection oracle

;This is also easy:  just send a long repeated string as input, check for repeats in the output

(defun ch11-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand (+ 5 (random 6))))
	(bv-post-pad (bv-rand (+ 5 (random 6)))))
    (let ((bv-iv (bv-rand 16))
	  (bv-key (bv-rand 16))
	  (bv-padded (concatenate 'vector bv-pre-pad bv-msg bv-post-pad)))
      (if (= (random 2) 0)
	  (progn (print "cbc")
		 (bv-aes-cbc-encrypt bv-padded bv-iv bv-key))
	  (progn (print "ecb")
		 (bv-aes-encrypt bv-padded bv-key))))))

(defun ?-duplicate-blocks (blocks)
  (some (lm (x) (= x 0)) (map-pairs #'fl-bit-distance blocks)))

(defun ch11-crack ()
  (let* ((bv-msg (bv-make 48 65))
	 (bv-res (coerce (ch11-oracle bv-msg) '(and common-lisp:vector (not simple-array))))
	 (blocks (subdivide bv-res 16)))
    (if (?-duplicate-blocks blocks)
	"ecb"
	"cbc")))

(print (ch11-crack))

;12. Byte-at-a-time ECB decryption (Simple)

(defun ch12-oracle (bv-msg)
  (let ((bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (concatenate 'vector bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch12-crack ()
  (let ((bv-res #()))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix initially (bv-make 15) then (concatenate 'vector (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (concatenate 'vector bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch12-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch12-crack)))

;13.  ECB cut-and-paste

(defun ch13-parse (s-cookie)
  (let* ((s-pairs (split #\& s-cookie))
	 ;map doesn't work here, seems to give a list with slightly incorrect structure
	 (s-keys-vals (iterate (for s in s-pairs)
			       (appending (split #\= s)))))
    (apply #'hash-table #'equal s-keys-vals)))

(defun ch13-make-profile (s-email)
  (let ((s-stripped (remove #\= (remove #\& s-email))))
    #"email=${s-stripped}&uid=10&role=user"))

(is (ch13-make-profile "foo@bar.com") "email=foo@bar.com&uid=10&role=user")

(defun ch13-test (bv-ctext bv-key)
  (let* ((s-cookie (s-from-bv (bv-pkcs7-unpad (bv-aes-decrypt bv-ctext bv-key) 16)))
	 (profile-table (ch13-parse s-cookie)))
    (if (equal (getf profile-table "role") "admin")
	"victory"
	"failure")))

(is (ch13-test (bv-aes-encrypt (bv-pkcs7-pad (bv-from-s "email=foo@bar.com&uid=10&role=admin") 16)
			       (bv-make 16)) (bv-make 16))
    "victory")

(defun ch13-enc-profile (s-email bv-key)
  (bv-aes-pkcs7-encrypt (bv-from-s (ch13-make-profile s-email)) bv-key))

(defun ch13-crack ()
  (let ((bv-key (bv-rand 16)))
    (let ((bv-padding (last (subdivide (ch13-enc-profile "fo@ba.com" bv-key) 16))) ;encryption of 16 16's
	  (bv-email (subseq (ch13-enc-profile "bcobu@foo.com" bv-key) 0 32))
	  (bv-admin (elt (subdivide (ch13-enc-profile "foo@bar.coadmin" bv-key) 16) 1)))
      (ch13-test (concatenate 'vector bv-email bv-admin bv-padding) bv-key))))

(is (ch13-crack)
    "victory")

;14. Byte-at-a-time ECB decryption (Harder)

;this is identical to #12, except that there's an initial step where we find the length of the 'random' prefix
(defvar *ch14-prefix-len* (+ 5 (random 6)))

(defun ch14-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand *ch14-prefix-len*))
	(bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (concatenate 'vector bv-pre-pad bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch14-prefix-len ()
  (iterate (for i from 0 to 16)
	   (for bv-oracle-output = (ch14-oracle (concatenate 'vector (bv-rand i) (bv-make 32))))
	   (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
	   (finally (return i))))

(defun ch14-crack ()
  (let ((bv-res #())
	(cb-prefix-len (ch14-prefix-len)))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix initially (bv-make (+ cb-prefix-len 15)) then (concatenate 'vector (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (concatenate 'vector bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch14-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch14-crack)))

;15. PKCS#7 padding validation

;implementing above under #9, because it's used in #13

;16. CBC bitflipping attacks

(defun ch16-encrypt (s-userdata bv-iv bv-key)
  (let ((s-stripped (remove #\= (remove #\; s-userdata)))
	(s-pre "comment1=cooking%20MCs;userdata=")
	(s-post ";comment2=%20like%20a%20pound%20of%20bacon"))
    (let ((bv-msg (bv-from-s (concatenate 'string s-pre s-stripped s-post))))
      (bv-aes-cbc-encrypt bv-msg bv-iv bv-key))))

(defun ch16-check (bv-ctext bv-iv bv-key)
  (let ((s-ptext (s-from-bv (bv-aes-cbc-decrypt bv-ctext bv-iv bv-key))))
    (search";admin=true;" s-ptext)))

(defun ch16-crack ()
  (let* ((bv-userdata (bv-make 16 65))
	 (bv-iv (bv-rand 16))
	 (bv-key (bv-rand 16))
	 (bv-ctext (ch16-encrypt (s-from-bv bv-userdata) bv-iv bv-key))
	 (bv-target (bv-from-s "a;admin=true;aaa"))
	 (bv-edit (bv-xor (bv-xor bv-userdata bv-target) (subseq bv-ctext 16 32))))
    (ch16-check bv-ctext bv-iv bv-key)
    (ch16-check (concatenate 'vector (subseq bv-ctext 0 16) bv-edit (subseq bv-ctext 32))
		bv-iv
		bv-key)))

(ok (ch16-crack) "Challenge 16")


messing with ppm more

messing with ppm more

<? if not solver.usePLM then return end ?>

real min3(real x, real y, real z) {
	return min(min(x, y), z);
}

real minmod(real a, real b) {
	if (a * b < 0) return 0;
	return fabs(a) < fabs(b) ? a : b;
}

kernel void calcLR(
	global <?=eqn.consLR_t?>* ULRBuf,
	const global <?=eqn.cons_t?>* UBuf,
	real dt
) {
	SETBOUNDS(1,1);
	const global <?=eqn.cons_t?>* U = UBuf + index;
	real3 x = cell_x(i);

	//TODO skip this lr stuff if we're doing piecewise-constant
	//...and just use the original buffers
	<? for side=0,solver.dim-1 do ?>{
		const int side = <?=side?>;

		//cell-centered index for a particular side...
		int indexForSide = side + dim * index;
		global <?=eqn.consLR_t?>* ULR = ULRBuf + indexForSide;

		//piecewise-linear

<? if solver.usePLM == 'plm-cons' then ?>
/*
#1: slope based on conservative variables
----------------------------------------

phi(x) = minmod(x) = clamp(r, 0, 1)

dUL = U_i - U_i-1
dUR = U_i+1 - U_i
sigma = phi( dUL / dUR ) * dUR

dF = F(U_i+1/2) - F(U_i-1/2)

dx = (x_i+1/2 - x_i-1/2)
U_i-1/2,R = U_i - 1/2 (sigma - dt/dx dF)
U_i+1/2,L = U_i + 1/2 (sigma + dt/dx dF)

Hydrodynamics II slope-limiters (4.4.2) and MUSCL-Hancock (6.6)
and https://en.wikipedia.org/wiki/MUSCL_scheme
works for euler Sod 1D with oscillations
works for euler Sod 2D
works for mhd Brio-Wu 1D with oscillations
works for maxwell with oscillations
works for adm1d_v1 freeflow with oscillations (fails for mirror)
*/

		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;
		<?=eqn.cons_t?> dUL, dUR;
		for (int j = 0; j < numIntStates; ++j) {
			dUL.ptr[j] = U->ptr[j] - UL->ptr[j];
			dUR.ptr[j] = UR->ptr[j] - U->ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dUL.ptr[j] = dUR.ptr[j] = 0;
		}

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		<?=eqn.cons_t?> UHalfL, UHalfR;
		for (int j = 0; j < numIntStates; ++j) {
			//Hydrodynamics II slope-limiters (4.4.2) and MUSCL-Hancock (6.6)
			//https://en.wikipedia.org/wiki/MUSCL_scheme

/*
minmod(r) = max(0, min(r, 1))
superbee(r) = max(0, max(
					min(1, 2*r),
					min(2, r)
				))

minmod2(a,b) = a * b < 0
		? 0
		: (|a| < |b| ? a : b)

a = u[i+1] - u[i]
b = u[i] - u[i-1]
r = a / b = (u[i+1] - u[i]) / (u[i] - u[i-1])

minmod2(a,b) = minmod2(rb, b) = |b| minmod2(r sgn b, sgn b)
TODO oops I forgot r can be negative, and so this sgn b < 0 case is bad ...
for sgn b < 0:
	minmod2(a,b) = |b| minmod2(-r, -1) = 0
for sgn b >= 0:
	minmod2(a,b) = |b| minmod2(r, 1) =
		|b| * (r * 1 < 0 ? 0
						: (|r| < 1 ? r : 1))
	minmod2(a,b) = |b| sgn r * max(0, min(|r|, 1))
	minmod2(a,b) = |b| sgn r * minmod(|r|)
*/
#if 1
			real r = dUR.ptr[j] == 0 ? 0 : (dUL.ptr[j] / dUR.ptr[j]);
			real phi = slopeLimiter(r);	//works good with minmod, bad with superbee
			real sigma = phi * dUR.ptr[j];
#else
			real sigma = minmod(minmod(fabs(dUL.ptr[j]),
                                    fabs(dUR.ptr[j])),
                             fabs(.5 * (dUL.ptr[j] - dUR.ptr[j]))
			) * sign(dUL.ptr[j] - dUR.ptr[j]);
#endif
			//q^n_i-1/2,R = q^n_i - 1/2 dx sigma	(Hydrodynamics II 6.58)
			UHalfL.ptr[j] = U->ptr[j] - .5 * sigma;

			//q^n_i+1/2,L = q^n_i + 1/2 dx sigma	(Hydrodynamics II 6.59)
			UHalfR.ptr[j] = U->ptr[j] + .5 * sigma;
		}
		for (int j = numIntStates; j < numStates; ++j) {
			UHalfL.ptr[j] = UHalfR.ptr[j] = U->ptr[j];
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		<?=eqn.cons_t?> FHalfL = fluxFromCons_<?=side?>(UHalfL, xIntL);
		<?=eqn.cons_t?> FHalfR = fluxFromCons_<?=side?>(UHalfR, xIntR);

		for (int j = 0; j < numIntStates; ++j) {
			real dF = FHalfR.ptr[j] - FHalfL.ptr[j];

			//U-cell-L = q^n+1/2_i-1/2,R (Hydrodynamics II 6.62)
			// = q^n_i-1/2,R + 1/2 dt/dx (f_k(q^n_i+1/2,L) - f_k(q_i-1/2,R))
			ULR->L.ptr[j] = UHalfL.ptr[j] + .5 * dt_dx * dF;

			//U-cell R = q^n+1/2_i+1/2,L (Hydrodynamics II 6.63)
			// = q^n_i+1/2,L + 1/2 dt/dx (f_k(q^n_i+1/2,L) - f_k(q_i-1/2,R))
			ULR->R.ptr[j] = UHalfR.ptr[j] + .5 * dt_dx * dF;
		}
		for (int j = numIntStates; j < numStates; ++j) {
			ULR->L.ptr[j] = ULR->R.ptr[j] = U->ptr[j];
		}

<? elseif solver.usePLM == 'plm-eig' then ?>
/*
#2: next step, project into eigenspace
----------------------------------------

evL, evR, wave = eigensystem(dF/dU at i)

dULe = evL( U_i - U_i-1 )
dURe = evL( U_i+1 - U_i )
dUCe = evL( (U_i+1 - U_i-1)/2 )
dUMe_j = step(dULe_j * dURe_j) * sign(dUCe_j) * 2 * min(|dULe_j|, |dURe_j|, |dUCe_j|)

aL = step(wave_j) dUMe_j (1 - wave_j dt/dx)
aR = step(-wave_j) dUMe_j (1 + wave_j dt/dx)

U_i-1/2,R = U_i - evR 1/2 aR
U_i+1/2,L = U_i + evR 1/2 aL

based on https://arxiv.org/pdf/0804.0402v1.pdf
and Trangenstein "Numeric Simulation of Hyperbolic Conservation Laws" section 6.2.5
except I'm projecting the differences in conservative values instead of primitive values.
This also needs modular slope limiter support.
works for Euler 1D Sod
euler 2D Sod this gets strange behavior and slowly diverges.
works for MHD Brio-Wu
works for maxwell
works for adm1d_v1
*/

		//1) calc delta q's ... l r c (eqn 36)
		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;
		<?=eqn.cons_t?> dUL, dUR, dUC;
		for (int j = 0; j < numIntStates; ++j) {
			dUL.ptr[j] = U->ptr[j] - UL->ptr[j];
			dUR.ptr[j] = UR->ptr[j] - U->ptr[j];
			dUC.ptr[j] = .5 * (UR->ptr[j] - UL->ptr[j]);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dUL.ptr[j] = dUR.ptr[j] = dUC.ptr[j] = 0;
		}

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		//calc eigen values and vectors at cell center
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);

		real dULEig[numWaves], dUREig[numWaves], dUCEig[numWaves];
		eigen_leftTransform_<?=side?>___(dULEig, &eig, dUL.ptr, xIntL);
		eigen_leftTransform_<?=side?>___(dUREig, &eig, dUR.ptr, xIntR);
		eigen_leftTransform_<?=side?>___(dUCEig, &eig, dUC.ptr, x);

		//MUSCL slope of characteristic variables
		//TODO make this based on the choice of slope limiter
		real dUMEig[numWaves];
		for (int j = 0; j < numWaves; ++j) {
			//dUMEig[j] = minmod(minmod(2. * dULEig[j], 2. * dUREig[j]), dUCEig[j]);
			dUMEig[j] = dULEig[j] * dUREig[j] < 0 ? 0 : (
				(dUCEig[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dULEig[j]),
					fabs(dUREig[j]),
					fabs(dUCEig[j]))
			);
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		<?=eqn:eigenWaveCodePrefix(side, '&eig', 'x')?>

		// slopes in characteristic space
		real aL[numWaves], aR[numWaves];
		<? for j=0,eqn.numWaves-1 do ?>{
			const int j = <?=j?>;
			real wave_j = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
			aL[j] = wave_j < 0 ? 0 : dUMEig[j] * .5 * (1. - wave_j * dt_dx);
			aR[j] = wave_j > 0 ? 0 : dUMEig[j] * .5 * (1. + wave_j * dt_dx);
		}<? end ?>

		//convert back to conservation variable space
		<?=eqn.cons_t?> sL, sR;
		eigen_rightTransform_<?=side?>___(sL.ptr, &eig, aL, x);
		eigen_rightTransform_<?=side?>___(sR.ptr, &eig, aR, x);

		for (int j = 0; j < numIntStates; ++j) {
			ULR->L.ptr[j] = U->ptr[j] - sR.ptr[j];
			ULR->R.ptr[j] = U->ptr[j] + sL.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			ULR->L.ptr[j] = ULR->R.ptr[j] = U->ptr[j];
		}

<? elseif solver.usePLM == 'plm-eig-prim' or solver.usePLM == 'plm-eig-prim-ref' then ?>
/*
#3a: next step, convert to primitives
----------------------------------------

evL, evR, wave = eigensystem(dF/dU at i)

W_i = W(U_i)

dWLe = evL dU/dW ( W_i - W_i-1 )
dWRe = evL dU/dW ( W_i+1 - W_i )
dWCe = evL dU/dW ( (W_i+1 - W_i-1)/2 )
dWMe_j = step(dWL_j * dWRe_j) * sign(dWCe_j) * 2 * min(|dWLe_j|, |dWRe_j|, |dWCe_j|)

aL = step(wave_j) dWMe_j (1 - wave_j dt/dx)
aR = step(-wave_j) dWMe_j (1 + wave_j dt/dx)

U_i-1/2,R = U(W_i - 1/2 dW/dU evR aR)
U_i+1/2,L = U(W_i + 1/2 dW/dU evR aL)

#3b: next step, subtract out reference state
----------------------------------------

evL, evR, wave = eigensystem(dF/dU at i)

W_i = W(U_i)

dWLe = evL dU/dW ( W_i - W_i-1 )
dWRe = evL dU/dW ( W_i+1 - W_i )
dWCe = evL dU/dW ( (W_i+1 - W_i-1)/2 )
dWMe_j = step(dWL_j * dWRe_j) * sign(dWCe_j) * 2 * min(|dWLe_j|, |dWRe_j|, |dWCe_j|)

aL = step(wave_j) dWMe_j dt/dx (max(wave) - wave_j)
aR = step(-wave_j) dWMe_j dt/dx (wave_j - min(wave))

U_i-1/2,R = U( W_i - 1/2 dW/dU evR (aR + (1 + dt/dx min(wave)) dWMe) )
U_i+1/2,L = U( W_i + 1/2 dW/dU evR (aL + (1 - dt/dx max(wave)) dWMe) )

based on Trangenstein, Athena, etc, except working on primitives like it says to
*/

		real3 xL = x; xL.s<?=side?> -= grid_dx<?=side?>;
		real3 xR = x; xR.s<?=side?> += grid_dx<?=side?>;

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;

		//1) calc delta q's ... l r c (eqn 36)
		<?=eqn.prim_t?> W = primFromCons(*U, x);
		<?=eqn.prim_t?> WL = primFromCons(*UL, xL);
		<?=eqn.prim_t?> WR = primFromCons(*UR, xR);
		<?=eqn.prim_t?> dWL, dWR, dWC;
		for (int j = 0; j < numIntStates; ++j) {
			dWL.ptr[j] = W.ptr[j] - WL.ptr[j];
			dWR.ptr[j] = WR.ptr[j] - W.ptr[j];
			dWC.ptr[j] = .5 * (WR.ptr[j] - WL.ptr[j]);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dWL.ptr[j] = dWR.ptr[j] = dWC.ptr[j] = 0.;
		}

		//calc eigen values and vectors at cell center
		//TODO calculate the eigenstate wrt W instead of U - to save some computations
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);

		//apply dU/dW before applying left/right eigenvectors so the eigenvectors are of the flux wrt primitives
		//RW = dW/dU RU, LW = LU dU/dW
		<?=eqn.cons_t?> tmp;

		apply_dU_dW(&tmp, &W, &dWL, xIntL); real dWLEig[numWaves]; eigen_leftTransform_<?=side?>___(dWLEig, &eig, tmp.ptr, xIntL);
		apply_dU_dW(&tmp, &W, &dWR, xIntR); real dWREig[numWaves]; eigen_leftTransform_<?=side?>___(dWREig, &eig, tmp.ptr, xIntR);
		apply_dU_dW(&tmp, &W, &dWC, x); real dWCEig[numWaves]; eigen_leftTransform_<?=side?>___(dWCEig, &eig, tmp.ptr, x);

		//MUSCL slope of characteristic variables
		real dWMEig[numWaves];
		for (int j = 0; j < numWaves; ++j) {
			dWMEig[j] = dWLEig[j] * dWREig[j] < 0 ? 0 : (
				(dWCEig[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dWLEig[j]),
					fabs(dWREig[j]),
					fabs(dWCEig[j])
				)
			);
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		<?=eqn:eigenWaveCodePrefix(side, '&eig', 'x')?>

<? 	if solver.usePLM == 'plm-eig-prim' then ?>
		//without reference state

		// calculate left and right slopes in characteristic space
 		real aL[numWaves], aR[numWaves];
 		<? for j=0,eqn.numWaves-1 do ?>{
			const int j = <?=j?>;
			real wave_j = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
			aL[j] = wave_j < 0 ? 0 : dWMEig[j] * .5 * (1. - wave_j * dt_dx);
			aR[j] = wave_j > 0 ? 0 : dWMEig[j] * .5 * (1. + wave_j * dt_dx);
		}<? end ?>

		// transform slopes back to conserved variable space
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aL, xIntL); <?=eqn.prim_t?> sL; apply_dW_dU(&sL, &W, &tmp, xIntL);
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aR, xIntR); <?=eqn.prim_t?> sR; apply_dW_dU(&sR, &W, &tmp, xIntR);

		// linearly extrapolate the slopes forward and backward from the cell center
 		<?=eqn.prim_t?> W2L, W2R;
 		for (int j = 0; j < numIntStates; ++j) {
			W2L.ptr[j] = W.ptr[j] - sR.ptr[j];
			W2R.ptr[j] = W.ptr[j] + sL.ptr[j];
 		}
		for (int j = numIntStates; j < numStates; ++j) {
			W2L.ptr[j] = W2R.ptr[j] = W.ptr[j];
		}
		ULR->L = consFromPrim(W2L, xIntL);
		ULR->R = consFromPrim(W2R, xIntR);

<?	elseif solver.usePLM == 'plm-eig-prim-ref' then ?>
		//with reference state

		//min and max waves
		//TODO use calcCellMinMaxEigenvalues ... except based on eigen_t
		// so something like calcEigenMinMaxWaves ...
		real waveMin = min(0., <?=eqn:eigenWaveCode(side, '&eig', 'x', 0)?>);
		real waveMax = max(0., <?=eqn:eigenWaveCode(side, '&eig', 'x', eqn.numWaves-1)?>);

		//limited slope in primitive variable space
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, dWMEig, x);
		<?=eqn.prim_t?> dWM;
		apply_dW_dU(&dWM, &W, &tmp, x);

		//left and right reference states
		<?=eqn.prim_t?> WLRef, WRRef;
		for (int j = 0; j < numIntStates; ++j) {
			WLRef.ptr[j] = W.ptr[j] + .5 * (1. - dt_dx * waveMax) * dWM.ptr[j];
			WRRef.ptr[j] = W.ptr[j] - .5 * (1. + dt_dx * waveMin) * dWM.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			WLRef.ptr[j] = WRRef.ptr[j] = 0;
		}

		// calculate left and right slopes in characteristic space
		real aL[numWaves], aR[numWaves];
		<? for j=0,eqn.numWaves-1 do ?>{
			const int j = <?=j?>;
			real wave_j = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
			aL[j] = wave_j < 0 ? 0 : (dWMEig[j] * dt_dx * (waveMax - wave_j));
			aR[j] = wave_j > 0 ? 0 : (dWMEig[j] * dt_dx * (waveMin - wave_j));
		}<? end ?>

		// transform slopes back to conserved variable space
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aL, xIntL); <?=eqn.prim_t?> sL; apply_dW_dU(&sL, &W, &tmp, xIntL);
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aR, xIntR); <?=eqn.prim_t?> sR; apply_dW_dU(&sR, &W, &tmp, xIntR);

		// linearly extrapolate the slopes forward and backward from the cell center
		<?=eqn.prim_t?> W2L, W2R;
		for (int j = 0; j < numIntStates; ++j) {
			W2R.ptr[j] = WRRef.ptr[j] + .5 * sR.ptr[j];
			W2L.ptr[j] = WLRef.ptr[j] + .5 * sL.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			W2R.ptr[j] = W2L.ptr[j] = W.ptr[j];
		}
		//TODO fix the x's
		ULR->L = consFromPrim(W2R, xIntR);
		ULR->R = consFromPrim(W2L, xIntL);

<? 	end	-- solver.usePLM
elseif solver.usePLM == 'plm-athena' then
?>
		//based on Athena

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		real3 xL = x; xL.s<?=side?> -= grid_dx<?=side?>;
		real3 xR = x; xR.s<?=side?> += grid_dx<?=side?>;

		//calc eigen values and vectors at cell center
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		//1) calc delta q's ... l r c (eqn 36)
		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;

		<?=eqn.prim_t?> W = primFromCons(*U, x);
		<?=eqn.prim_t?> WL = primFromCons(*UL, xL);
		<?=eqn.prim_t?> WR = primFromCons(*UR, xR);

		<?=eqn.prim_t?> dWL, dWR, dWC, dWG;
		for (int j = 0; j < numIntStates; ++j) {
			dWL.ptr[j] = W.ptr[j] - WL.ptr[j];
			dWR.ptr[j] = WR.ptr[j] - W.ptr[j];
			dWC.ptr[j] = .5 * (WR.ptr[j] - WL.ptr[j]);
			dWG.ptr[j] = (dWL.ptr[j] * dWR.ptr[j]) <= 0. ? 0. : (
				2. * dWL.ptr[j] * dWR.ptr[j] / (dWL.ptr[j] + dWR.ptr[j])
			);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dWL.ptr[j] = dWR.ptr[j] = dWC.ptr[j] = dWG.ptr[j] = 0.;
		}

		real dal[numWaves], dar[numWaves], dac[numWaves], dag[numWaves];
		eigen_leftTransform_<?=side?>___(dal, &eig, dWL.ptr, xIntL);
		eigen_leftTransform_<?=side?>___(dar, &eig, dWR.ptr, xIntR);
		eigen_leftTransform_<?=side?>___(dac, &eig, dWC.ptr, x);
		eigen_leftTransform_<?=side?>___(dag, &eig, dWG.ptr, x);

		real da[numWaves];
		for (int j = 0; j < numWaves; ++j) {
			da[j] = 0;
			if (dal[j] * dar[j] > 0) {
				real lim_slope1 = min(fabs(dal[j]), fabs(dar[j]));
				real lim_slope2 = min(fabs(dac[j]), fabs(dag[j]));
				da[j] = sign(dac[j]) * min(2. * lim_slope1, lim_slope2);
			}
		}

		<?=eqn.prim_t?> dWm;
		eigen_rightTransform_<?=side?>___(dWm.ptr, &eig, da, x);

		<?=eqn.prim_t?> Wlv, Wrv;
		for (int j = 0; j < numIntStates; ++j) {
			Wlv.ptr[j] = W.ptr[j] - .5 * dWm.ptr[j];
			Wrv.ptr[j] = W.ptr[j] + .5 * dWm.ptr[j];
			real C = Wrv.ptr[j] + Wlv.ptr[j];

			Wlv.ptr[j] = max(min(W.ptr[j], WL.ptr[j]), Wlv.ptr[j]);
			Wlv.ptr[j] = min(max(W.ptr[j], WL.ptr[j]), Wlv.ptr[j]);
			Wrv.ptr[j] = C - Wlv.ptr[j];

			Wrv.ptr[j] = max(min(W.ptr[j],WR.ptr[j]),Wrv.ptr[j]);
			Wrv.ptr[j] = min(max(W.ptr[j],WR.ptr[j]),Wrv.ptr[j]);
			Wlv.ptr[j] = C - Wrv.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			Wlv.ptr[j] = W.ptr[j];
			Wrv.ptr[j] = W.ptr[j];
		}

		ULR->L = consFromPrim(Wlv, xIntL);
		ULR->R = consFromPrim(Wrv, xIntR);

<? elseif solver.usePLM == 'ppm-experimental' then ?>
//here's my attempt at Trangenstein section 5.12 PPM
//with help from Zingale's ppm code

		real3 xL = x; xL.s<?=side?> -= grid_dx<?=side?>;
		real3 xR = x; xR.s<?=side?> += grid_dx<?=side?>;

		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;

		//1984 Collela & Woodward eqn 1.7
		<?=eqn.prim_t?> W = primFromCons(*U, x);
		<?=eqn.prim_t?> WL = primFromCons(*UL, xL);
		<?=eqn.prim_t?> WR = primFromCons(*UR, xR);
		<?=eqn.prim_t?> WR2 = primFromCons(*UR, xR);
		<?=eqn.prim_t?> dWL, dWR, dWR2, dWCL, dWCR;
		for (int j = 0; j < numIntStates; ++j) {
			dWL.ptr[j] = W.ptr[j] - WL.ptr[j];
			dWR.ptr[j] = WR.ptr[j] - W.ptr[j];
			dWR2.ptr[j] = WR2.ptr[j] - WR.ptr[j];
			dWCL.ptr[j] = .5 * (WR.ptr[j] - WL.ptr[j]);
			dWCR.ptr[j] = .5 * (WR2.ptr[j] - W.ptr[j]);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dWL.ptr[j] = dWR.ptr[j] = dWR2.ptr[j] = dWCL.ptr[j] = dWCR.ptr[j] = 0.;
		}

		//slope limiter
		//1984 Collela & Woodward eqn 1.8
		real dWML[numStates];
		for (int j = 0; j < numStates; ++j) {
			dWML[j] = dWL.ptr[j] * dWR.ptr[j] < 0 ? 0 : (
				(dWCL.ptr[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dWL.ptr[j]),
					fabs(dWR.ptr[j]),
					fabs(dWCL.ptr[j])
				)
			);
		}
		real dWMR[numStates];
		for (int j = 0; j < numStates; ++j) {
			dWMR[j] = dWR.ptr[j] * dWR2.ptr[j] < 0 ? 0 : (
				(dWCR.ptr[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dWR.ptr[j]),
					fabs(dWR2.ptr[j]),
					fabs(dWCR.ptr[j])
				)
			);
		}

		//1984 Collela & Woodward eqn 1.6
		<?=eqn.prim_t?> Wp, Wm;
		for (int j = 0; j < numStates; ++j) {
			Wp.ptr[j] = Wm.ptr[j] = .5 * dWR.ptr[j] - 1./6. * (dWMR[j] - dWML[j]);
		}

		//1984 Collela & Woodward eqn 1.10
		for (int j = 0; j < numStates; ++j) {
			real dWp = Wp.ptr[j] - W.ptr[j];
			real dWm = W.ptr[j] - Wm.ptr[j];
			real dWpm = Wp.ptr[j] - Wm.ptr[j];
			real avgWpm = .5 * (Wp.ptr[j] + Wm.ptr[j]);
			if (dWp * dWm <= 0) {
				Wp.ptr[j] = Wm.ptr[j] = W.ptr[j];
			} else if (dWpm * (W.ptr[j] - avgWpm) > dWpm * dWpm / 6.) {
				Wm.ptr[j] = 3. * W.ptr[j] - 2. * Wp.ptr[j];
			} else if (-dWpm * dWpm / 6. > dWpm * (W.ptr[j] - avgWpm)) {
				Wp.ptr[j] = 3. * W.ptr[j] - 2. * Wm.ptr[j];
			}
		}

		for (int j = 0; j < numStates; ++j) {
			Wm.ptr[j] = .5 * (W.ptr[j] +  Wm.ptr[j]);
			Wp.ptr[j] = .5 * (W.ptr[j] +  Wp.ptr[j]);
		}

		//1984 Collela & Woodward eqn 1.5
		real W6[numStates];
		for (int j = 0; j < numStates; ++j) {
			W6[j] = 6. * W.ptr[j] - 3. * (Wp.ptr[j] + Wm.ptr[j]);
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		//calc eigen values and vectors at cell center
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);
		<?=eqn:eigenWaveCodePrefix(side, '&eig', 'x')?>

		real eval[numWaves];
<? for j=0,eqn.numWaves-1 do
?>		eval[<?=j?>] = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
<? end
?>

		<?=eqn.prim_t?> Ip, Im;
		for (int j = 0; j < numWaves; ++j) {
			real sigma = fabs(eval[j]) * dt_dx;
			if (eval[j] >= 0.) {
				Ip.ptr[j] = Wp.ptr[j] - .5 * sigma * (Wp.ptr[j] - Wm.ptr[j] - (1. - 2./3.*sigma) * W6[j]);
			} else {
				Ip.ptr[j] = W.ptr[j];
			}
			if (eval[j] <= 0.) {
				Im.ptr[j] = Wm.ptr[j] + .5 * sigma * (Wp.ptr[j] - Wm.ptr[j] + (1. - 2./3.*sigma) * W6[j]);
			} else {
				Im.ptr[j] = W.ptr[j];
			}
		}

		real waveMin = <?=eqn:eigenWaveCode(side, '&eig', 'x', 0)?>;
		real waveMax = <?=eqn:eigenWaveCode(side, '&eig', 'x', eqn.numWaves-1)?>;
		<?=eqn.prim_t?> Wref_xp = waveMax >= 0 ? Ip : W;
		<?=eqn.prim_t?> Wref_xm = waveMin <= 0 ? Im : W;

		<?=eqn.prim_t?> Wref_xm_minus_Im, Wref_xp_minus_Ip;
		for (int j = 0; j < numWaves; ++j) {
			Wref_xm_minus_Im.ptr[j] = Wref_xm.ptr[j] - Im.ptr[j];
			Wref_xp_minus_Ip.ptr[j] = Wref_xp.ptr[j] - Ip.ptr[j];
		}

		real beta_xm[numWaves];
		real beta_xp[numWaves];
		eigen_leftTransform_<?=side?>___(beta_xm, &eig, Wref_xm_minus_Im.ptr, x);
		eigen_leftTransform_<?=side?>___(beta_xp, &eig, Wref_xp_minus_Ip.ptr, x);
		for (int j = 0; j < numWaves; ++j) {
			beta_xp[j] = max(0., beta_xp[j]);
			beta_xm[j] = min(0., beta_xm[j]);
		}

		<?=eqn.prim_t?> WresL, WresR;
		eigen_rightTransform_<?=side?>___(WresL.ptr, &eig, beta_xp, x);
		eigen_rightTransform_<?=side?>___(WresR.ptr, &eig, beta_xm, x);
		for (int j = 0; j < numStates; ++j) {
			WresL.ptr[j] = Wref_xp.ptr[j] - WresL.ptr[j];
			WresR.ptr[j] = Wref_xm.ptr[j] - WresR.ptr[j];
		}

		ULR->L = consFromPrim(WresR, x);
		ULR->R = consFromPrim(WresR, x);

<? end ?>

	}<? end ?>
}

<? if not solver.usePLM then return end ?>

real min3(real x, real y, real z) {
	return min(min(x, y), z);
}

real minmod(real a, real b) {
	if (a * b < 0) return 0;
	return fabs(a) < fabs(b) ? a : b;
}

kernel void calcLR(
	global <?=eqn.consLR_t?>* ULRBuf,
	const global <?=eqn.cons_t?>* UBuf,
	real dt
) {
	SETBOUNDS(1,1);
	const global <?=eqn.cons_t?>* U = UBuf + index;
	real3 x = cell_x(i);

	//TODO skip this lr stuff if we're doing piecewise-constant
	//...and just use the original buffers
	<? for side=0,solver.dim-1 do ?>{
		const int side = <?=side?>;

		//cell-centered index for a particular side...
		int indexForSide = side + dim * index;
		global <?=eqn.consLR_t?>* ULR = ULRBuf + indexForSide;

		//piecewise-linear

<? if solver.usePLM == 'plm-cons' then ?>
/*
#1: slope based on conservative variables
----------------------------------------

phi(x) = minmod(x) = clamp(r, 0, 1)

dUL = U_i - U_i-1
dUR = U_i+1 - U_i
sigma = phi( dUL / dUR ) * dUR

dF = F(U_i+1/2) - F(U_i-1/2)

dx = (x_i+1/2 - x_i-1/2)
U_i-1/2,R = U_i - 1/2 (sigma - dt/dx dF)
U_i+1/2,L = U_i + 1/2 (sigma + dt/dx dF)

Hydrodynamics II slope-limiters (4.4.2) and MUSCL-Hancock (6.6)
and https://en.wikipedia.org/wiki/MUSCL_scheme
works for euler Sod 1D with oscillations
works for euler Sod 2D
works for mhd Brio-Wu 1D with oscillations
works for maxwell with oscillations
works for adm1d_v1 freeflow with oscillations (fails for mirror)
*/

		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;
		<?=eqn.cons_t?> dUL, dUR;
		for (int j = 0; j < numIntStates; ++j) {
			dUL.ptr[j] = U->ptr[j] - UL->ptr[j];
			dUR.ptr[j] = UR->ptr[j] - U->ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dUL.ptr[j] = dUR.ptr[j] = 0;
		}

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		<?=eqn.cons_t?> UHalfL, UHalfR;
		for (int j = 0; j < numIntStates; ++j) {
			//Hydrodynamics II slope-limiters (4.4.2) and MUSCL-Hancock (6.6)
			//https://en.wikipedia.org/wiki/MUSCL_scheme

/*
minmod(r) = max(0, min(r, 1))
superbee(r) = max(0, max(
					min(1, 2*r),
					min(2, r)
				))

minmod2(a,b) = a * b < 0
		? 0
		: (|a| < |b| ? a : b)

a = u[i+1] - u[i]
b = u[i] - u[i-1]
r = a / b = (u[i+1] - u[i]) / (u[i] - u[i-1])

minmod2(a,b) = minmod2(rb, b) = |b| minmod2(r sgn b, sgn b)
TODO oops I forgot r can be negative, and so this sgn b < 0 case is bad ...
for sgn b < 0:
	minmod2(a,b) = |b| minmod2(-r, -1) = 0
for sgn b >= 0:
	minmod2(a,b) = |b| minmod2(r, 1) =
		|b| * (r * 1 < 0 ? 0
						: (|r| < 1 ? r : 1))
	minmod2(a,b) = |b| sgn r * max(0, min(|r|, 1))
	minmod2(a,b) = |b| sgn r * minmod(|r|)
*/
#if 1
			real r = dUR.ptr[j] == 0 ? 0 : (dUL.ptr[j] / dUR.ptr[j]);
			real phi = slopeLimiter(r);	//works good with minmod, bad with superbee
			real sigma = phi * dUR.ptr[j];
#else
			real sigma = minmod(minmod(fabs(dUL.ptr[j]),
                                    fabs(dUR.ptr[j])),
                             fabs(.5 * (dUL.ptr[j] - dUR.ptr[j]))
			) * sign(dUL.ptr[j] - dUR.ptr[j]);
#endif
			//q^n_i-1/2,R = q^n_i - 1/2 dx sigma	(Hydrodynamics II 6.58)
			UHalfL.ptr[j] = U->ptr[j] - .5 * sigma;

			//q^n_i+1/2,L = q^n_i + 1/2 dx sigma	(Hydrodynamics II 6.59)
			UHalfR.ptr[j] = U->ptr[j] + .5 * sigma;
		}
		for (int j = numIntStates; j < numStates; ++j) {
			UHalfL.ptr[j] = UHalfR.ptr[j] = U->ptr[j];
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		<?=eqn.cons_t?> FHalfL = fluxFromCons_<?=side?>(UHalfL, xIntL);
		<?=eqn.cons_t?> FHalfR = fluxFromCons_<?=side?>(UHalfR, xIntR);

		for (int j = 0; j < numIntStates; ++j) {
			real dF = FHalfR.ptr[j] - FHalfL.ptr[j];

			//U-cell-L = q^n+1/2_i-1/2,R (Hydrodynamics II 6.62)
			// = q^n_i-1/2,R + 1/2 dt/dx (f_k(q^n_i+1/2,L) - f_k(q_i-1/2,R))
			ULR->L.ptr[j] = UHalfL.ptr[j] + .5 * dt_dx * dF;

			//U-cell R = q^n+1/2_i+1/2,L (Hydrodynamics II 6.63)
			// = q^n_i+1/2,L + 1/2 dt/dx (f_k(q^n_i+1/2,L) - f_k(q_i-1/2,R))
			ULR->R.ptr[j] = UHalfR.ptr[j] + .5 * dt_dx * dF;
		}
		for (int j = numIntStates; j < numStates; ++j) {
			ULR->L.ptr[j] = ULR->R.ptr[j] = U->ptr[j];
		}

<? elseif solver.usePLM == 'plm-eig' then ?>
/*
#2: next step, project into eigenspace
----------------------------------------

evL, evR, wave = eigensystem(dF/dU at i)

dULe = evL( U_i - U_i-1 )
dURe = evL( U_i+1 - U_i )
dUCe = evL( (U_i+1 - U_i-1)/2 )
dUMe_j = step(dULe_j * dURe_j) * sign(dUCe_j) * 2 * min(|dULe_j|, |dURe_j|, |dUCe_j|)

aL = step(wave_j) dUMe_j (1 - wave_j dt/dx)
aR = step(-wave_j) dUMe_j (1 + wave_j dt/dx)

U_i-1/2,R = U_i - evR 1/2 aR
U_i+1/2,L = U_i + evR 1/2 aL

based on https://arxiv.org/pdf/0804.0402v1.pdf
and Trangenstein "Numeric Simulation of Hyperbolic Conservation Laws" section 6.2.5
except I'm projecting the differences in conservative values instead of primitive values.
This also needs modular slope limiter support.
works for Euler 1D Sod
euler 2D Sod this gets strange behavior and slowly diverges.
works for MHD Brio-Wu
works for maxwell
works for adm1d_v1
*/

		//1) calc delta q's ... l r c (eqn 36)
		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;
		<?=eqn.cons_t?> dUL, dUR, dUC;
		for (int j = 0; j < numIntStates; ++j) {
			dUL.ptr[j] = U->ptr[j] - UL->ptr[j];
			dUR.ptr[j] = UR->ptr[j] - U->ptr[j];
			dUC.ptr[j] = .5 * (UR->ptr[j] - UL->ptr[j]);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dUL.ptr[j] = dUR.ptr[j] = dUC.ptr[j] = 0;
		}

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		//calc eigen values and vectors at cell center
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);

		real dULEig[numWaves], dUREig[numWaves], dUCEig[numWaves];
		eigen_leftTransform_<?=side?>___(dULEig, &eig, dUL.ptr, xIntL);
		eigen_leftTransform_<?=side?>___(dUREig, &eig, dUR.ptr, xIntR);
		eigen_leftTransform_<?=side?>___(dUCEig, &eig, dUC.ptr, x);

		//MUSCL slope of characteristic variables
		//TODO make this based on the choice of slope limiter
		real dUMEig[numWaves];
		for (int j = 0; j < numWaves; ++j) {
			//dUMEig[j] = minmod(minmod(2. * dULEig[j], 2. * dUREig[j]), dUCEig[j]);
			dUMEig[j] = dULEig[j] * dUREig[j] < 0 ? 0 : (
				(dUCEig[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dULEig[j]),
					fabs(dUREig[j]),
					fabs(dUCEig[j]))
			);
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		<?=eqn:eigenWaveCodePrefix(side, '&eig', 'x')?>

		// slopes in characteristic space
		real aL[numWaves], aR[numWaves];
		<? for j=0,eqn.numWaves-1 do ?>{
			const int j = <?=j?>;
			real wave_j = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
			aL[j] = wave_j < 0 ? 0 : dUMEig[j] * .5 * (1. - wave_j * dt_dx);
			aR[j] = wave_j > 0 ? 0 : dUMEig[j] * .5 * (1. + wave_j * dt_dx);
		}<? end ?>

		//convert back to conservation variable space
		<?=eqn.cons_t?> sL, sR;
		eigen_rightTransform_<?=side?>___(sL.ptr, &eig, aL, x);
		eigen_rightTransform_<?=side?>___(sR.ptr, &eig, aR, x);

		for (int j = 0; j < numIntStates; ++j) {
			ULR->L.ptr[j] = U->ptr[j] - sR.ptr[j];
			ULR->R.ptr[j] = U->ptr[j] + sL.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			ULR->L.ptr[j] = ULR->R.ptr[j] = U->ptr[j];
		}

<? elseif solver.usePLM == 'plm-eig-prim' or solver.usePLM == 'plm-eig-prim-ref' then ?>
/*
#3a: next step, convert to primitives
----------------------------------------

evL, evR, wave = eigensystem(dF/dU at i)

W_i = W(U_i)

dWLe = evL dU/dW ( W_i - W_i-1 )
dWRe = evL dU/dW ( W_i+1 - W_i )
dWCe = evL dU/dW ( (W_i+1 - W_i-1)/2 )
dWMe_j = step(dWL_j * dWRe_j) * sign(dWCe_j) * 2 * min(|dWLe_j|, |dWRe_j|, |dWCe_j|)

aL = step(wave_j) dWMe_j (1 - wave_j dt/dx)
aR = step(-wave_j) dWMe_j (1 + wave_j dt/dx)

U_i-1/2,R = U(W_i - 1/2 dW/dU evR aR)
U_i+1/2,L = U(W_i + 1/2 dW/dU evR aL)

#3b: next step, subtract out reference state
----------------------------------------

evL, evR, wave = eigensystem(dF/dU at i)

W_i = W(U_i)

dWLe = evL dU/dW ( W_i - W_i-1 )
dWRe = evL dU/dW ( W_i+1 - W_i )
dWCe = evL dU/dW ( (W_i+1 - W_i-1)/2 )
dWMe_j = step(dWL_j * dWRe_j) * sign(dWCe_j) * 2 * min(|dWLe_j|, |dWRe_j|, |dWCe_j|)

aL = step(wave_j) dWMe_j dt/dx (max(wave) - wave_j)
aR = step(-wave_j) dWMe_j dt/dx (wave_j - min(wave))

U_i-1/2,R = U( W_i - 1/2 dW/dU evR (aR + (1 + dt/dx min(wave)) dWMe) )
U_i+1/2,L = U( W_i + 1/2 dW/dU evR (aL + (1 - dt/dx max(wave)) dWMe) )

based on Trangenstein, Athena, etc, except working on primitives like it says to
*/

		real3 xL = x; xL.s<?=side?> -= grid_dx<?=side?>;
		real3 xR = x; xR.s<?=side?> += grid_dx<?=side?>;

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;

		//1) calc delta q's ... l r c (eqn 36)
		<?=eqn.prim_t?> W = primFromCons(*U, x);
		<?=eqn.prim_t?> WL = primFromCons(*UL, xL);
		<?=eqn.prim_t?> WR = primFromCons(*UR, xR);
		<?=eqn.prim_t?> dWL, dWR, dWC;
		for (int j = 0; j < numIntStates; ++j) {
			dWL.ptr[j] = W.ptr[j] - WL.ptr[j];
			dWR.ptr[j] = WR.ptr[j] - W.ptr[j];
			dWC.ptr[j] = .5 * (WR.ptr[j] - WL.ptr[j]);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dWL.ptr[j] = dWR.ptr[j] = dWC.ptr[j] = 0.;
		}

		//calc eigen values and vectors at cell center
		//TODO calculate the eigenstate wrt W instead of U - to save some computations
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);

		//apply dU/dW before applying left/right eigenvectors so the eigenvectors are of the flux wrt primitives
		//RW = dW/dU RU, LW = LU dU/dW
		<?=eqn.cons_t?> tmp;

		apply_dU_dW(&tmp, &W, &dWL, xIntL); real dWLEig[numWaves]; eigen_leftTransform_<?=side?>___(dWLEig, &eig, tmp.ptr, xIntL);
		apply_dU_dW(&tmp, &W, &dWR, xIntR); real dWREig[numWaves]; eigen_leftTransform_<?=side?>___(dWREig, &eig, tmp.ptr, xIntR);
		apply_dU_dW(&tmp, &W, &dWC, x); real dWCEig[numWaves]; eigen_leftTransform_<?=side?>___(dWCEig, &eig, tmp.ptr, x);

		//MUSCL slope of characteristic variables
		real dWMEig[numWaves];
		for (int j = 0; j < numWaves; ++j) {
			dWMEig[j] = dWLEig[j] * dWREig[j] < 0 ? 0 : (
				(dWCEig[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dWLEig[j]),
					fabs(dWREig[j]),
					fabs(dWCEig[j])
				)
			);
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		<?=eqn:eigenWaveCodePrefix(side, '&eig', 'x')?>

<? 	if solver.usePLM == 'plm-eig-prim' then ?>
		//without reference state

		// calculate left and right slopes in characteristic space
 		real aL[numWaves], aR[numWaves];
 		<? for j=0,eqn.numWaves-1 do ?>{
			const int j = <?=j?>;
			real wave_j = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
			aL[j] = wave_j < 0 ? 0 : dWMEig[j] * .5 * (1. - wave_j * dt_dx);
			aR[j] = wave_j > 0 ? 0 : dWMEig[j] * .5 * (1. + wave_j * dt_dx);
		}<? end ?>

		// transform slopes back to conserved variable space
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aL, xIntL); <?=eqn.prim_t?> sL; apply_dW_dU(&sL, &W, &tmp, xIntL);
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aR, xIntR); <?=eqn.prim_t?> sR; apply_dW_dU(&sR, &W, &tmp, xIntR);

		// linearly extrapolate the slopes forward and backward from the cell center
 		<?=eqn.prim_t?> W2L, W2R;
 		for (int j = 0; j < numIntStates; ++j) {
			W2L.ptr[j] = W.ptr[j] - sR.ptr[j];
			W2R.ptr[j] = W.ptr[j] + sL.ptr[j];
 		}
		for (int j = numIntStates; j < numStates; ++j) {
			W2L.ptr[j] = W2R.ptr[j] = W.ptr[j];
		}
		ULR->L = consFromPrim(W2L, xIntL);
		ULR->R = consFromPrim(W2R, xIntR);

<?	elseif solver.usePLM == 'plm-eig-prim-ref' then ?>
		//with reference state

		//min and max waves
		//TODO use calcCellMinMaxEigenvalues ... except based on eigen_t
		// so something like calcEigenMinMaxWaves ...
		real waveMin = min(0., <?=eqn:eigenWaveCode(side, '&eig', 'x', 0)?>);
		real waveMax = max(0., <?=eqn:eigenWaveCode(side, '&eig', 'x', eqn.numWaves-1)?>);

		//limited slope in primitive variable space
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, dWMEig, x);
		<?=eqn.prim_t?> dWM;
		apply_dW_dU(&dWM, &W, &tmp, x);

		//left and right reference states
		<?=eqn.prim_t?> WLRef, WRRef;
		for (int j = 0; j < numIntStates; ++j) {
			WLRef.ptr[j] = W.ptr[j] + .5 * (1. - dt_dx * waveMax) * dWM.ptr[j];
			WRRef.ptr[j] = W.ptr[j] - .5 * (1. + dt_dx * waveMin) * dWM.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			WLRef.ptr[j] = WRRef.ptr[j] = 0;
		}

		// calculate left and right slopes in characteristic space
		real aL[numWaves], aR[numWaves];
		<? for j=0,eqn.numWaves-1 do ?>{
			const int j = <?=j?>;
			real wave_j = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
			aL[j] = wave_j < 0 ? 0 : (dWMEig[j] * dt_dx * (waveMax - wave_j));
			aR[j] = wave_j > 0 ? 0 : (dWMEig[j] * dt_dx * (waveMin - wave_j));
		}<? end ?>

		// transform slopes back to conserved variable space
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aL, xIntL); <?=eqn.prim_t?> sL; apply_dW_dU(&sL, &W, &tmp, xIntL);
		eigen_rightTransform_<?=side?>___(tmp.ptr, &eig, aR, xIntR); <?=eqn.prim_t?> sR; apply_dW_dU(&sR, &W, &tmp, xIntR);

		// linearly extrapolate the slopes forward and backward from the cell center
		<?=eqn.prim_t?> W2L, W2R;
		for (int j = 0; j < numIntStates; ++j) {
			W2R.ptr[j] = WRRef.ptr[j] + .5 * sR.ptr[j];
			W2L.ptr[j] = WLRef.ptr[j] + .5 * sL.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			W2R.ptr[j] = W2L.ptr[j] = W.ptr[j];
		}
		//TODO fix the x's
		ULR->L = consFromPrim(W2R, xIntR);
		ULR->R = consFromPrim(W2L, xIntL);

<? 	end	-- solver.usePLM
elseif solver.usePLM == 'plm-athena' then
?>
		//based on Athena

		real3 xIntL = x; xIntL.s<?=side?> -= .5 * grid_dx<?=side?>;
		real3 xIntR = x; xIntR.s<?=side?> += .5 * grid_dx<?=side?>;

		real3 xL = x; xL.s<?=side?> -= grid_dx<?=side?>;
		real3 xR = x; xR.s<?=side?> += grid_dx<?=side?>;

		//calc eigen values and vectors at cell center
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		//1) calc delta q's ... l r c (eqn 36)
		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;

		<?=eqn.prim_t?> W = primFromCons(*U, x);
		<?=eqn.prim_t?> WL = primFromCons(*UL, xL);
		<?=eqn.prim_t?> WR = primFromCons(*UR, xR);

		<?=eqn.prim_t?> dWL, dWR, dWC, dWG;
		for (int j = 0; j < numIntStates; ++j) {
			dWL.ptr[j] = W.ptr[j] - WL.ptr[j];
			dWR.ptr[j] = WR.ptr[j] - W.ptr[j];
			dWC.ptr[j] = .5 * (WR.ptr[j] - WL.ptr[j]);
			dWG.ptr[j] = (dWL.ptr[j] * dWR.ptr[j]) <= 0. ? 0. : (
				2. * dWL.ptr[j] * dWR.ptr[j] / (dWL.ptr[j] + dWR.ptr[j])
			);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dWL.ptr[j] = dWR.ptr[j] = dWC.ptr[j] = dWG.ptr[j] = 0.;
		}

		real dal[numWaves], dar[numWaves], dac[numWaves], dag[numWaves];
		eigen_leftTransform_<?=side?>___(dal, &eig, dWL.ptr, xIntL);
		eigen_leftTransform_<?=side?>___(dar, &eig, dWR.ptr, xIntR);
		eigen_leftTransform_<?=side?>___(dac, &eig, dWC.ptr, x);
		eigen_leftTransform_<?=side?>___(dag, &eig, dWG.ptr, x);

		real da[numWaves];
		for (int j = 0; j < numWaves; ++j) {
			da[j] = 0;
			if (dal[j] * dar[j] > 0) {
				real lim_slope1 = min(fabs(dal[j]), fabs(dar[j]));
				real lim_slope2 = min(fabs(dac[j]), fabs(dag[j]));
				da[j] = sign(dac[j]) * min(2. * lim_slope1, lim_slope2);
			}
		}

		<?=eqn.prim_t?> dWm;
		eigen_rightTransform_<?=side?>___(dWm.ptr, &eig, da, x);

		<?=eqn.prim_t?> Wlv, Wrv;
		for (int j = 0; j < numIntStates; ++j) {
			Wlv.ptr[j] = W.ptr[j] - .5 * dWm.ptr[j];
			Wrv.ptr[j] = W.ptr[j] + .5 * dWm.ptr[j];
			real C = Wrv.ptr[j] + Wlv.ptr[j];

			Wlv.ptr[j] = max(min(W.ptr[j], WL.ptr[j]), Wlv.ptr[j]);
			Wlv.ptr[j] = min(max(W.ptr[j], WL.ptr[j]), Wlv.ptr[j]);
			Wrv.ptr[j] = C - Wlv.ptr[j];

			Wrv.ptr[j] = max(min(W.ptr[j],WR.ptr[j]),Wrv.ptr[j]);
			Wrv.ptr[j] = min(max(W.ptr[j],WR.ptr[j]),Wrv.ptr[j]);
			Wlv.ptr[j] = C - Wrv.ptr[j];
		}
		for (int j = numIntStates; j < numStates; ++j) {
			Wlv.ptr[j] = W.ptr[j];
			Wrv.ptr[j] = W.ptr[j];
		}

		ULR->L = consFromPrim(Wlv, xIntL);
		ULR->R = consFromPrim(Wrv, xIntR);

<? elseif solver.usePLM == 'ppm-experimental' then ?>
//here's my attempt at Trangenstein section 5.12 PPM
//with help from Zingale's ppm code

		real3 xL = x; xL.s<?=side?> -= grid_dx<?=side?>;
		real3 xR = x; xR.s<?=side?> += grid_dx<?=side?>;

		const global <?=eqn.cons_t?>* UL = U - stepsize.s<?=side?>;
		const global <?=eqn.cons_t?>* UR = U + stepsize.s<?=side?>;

		//1984 Collela & Woodward eqn 1.7
		<?=eqn.prim_t?> W = primFromCons(*U, x);
		<?=eqn.prim_t?> WL = primFromCons(*UL, xL);
		<?=eqn.prim_t?> WR = primFromCons(*UR, xR);
		<?=eqn.prim_t?> WR2 = primFromCons(*UR, xR);
		<?=eqn.prim_t?> dWL, dWR, dWR2, dWCL, dWCR;
		for (int j = 0; j < numIntStates; ++j) {
			dWL.ptr[j] = W.ptr[j] - WL.ptr[j];
			dWR.ptr[j] = WR.ptr[j] - W.ptr[j];
			dWR2.ptr[j] = WR2.ptr[j] - WR.ptr[j];
			dWCL.ptr[j] = .5 * (WR.ptr[j] - WL.ptr[j]);
			dWCR.ptr[j] = .5 * (WR2.ptr[j] - W.ptr[j]);
		}
		for (int j = numIntStates; j < numStates; ++j) {
			dWL.ptr[j] = dWR.ptr[j] = dWR2.ptr[j] = dWCL.ptr[j] = dWCR.ptr[j] = 0.;
		}

		//slope limiter
		//1984 Collela & Woodward eqn 1.8
		real dWML[numStates];
		for (int j = 0; j < numStates; ++j) {
			dWML[j] = dWL.ptr[j] * dWR.ptr[j] < 0 ? 0 : (
				(dWCL.ptr[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dWL.ptr[j]),
					fabs(dWR.ptr[j]),
					fabs(dWCL.ptr[j])
				)
			);
		}
		real dWMR[numStates];
		for (int j = 0; j < numStates; ++j) {
			dWMR[j] = dWR.ptr[j] * dWR2.ptr[j] < 0 ? 0 : (
				(dWCR.ptr[j] >= 0. ? 1. : -1.)
				* 2. * min3(
					fabs(dWR.ptr[j]),
					fabs(dWR2.ptr[j]),
					fabs(dWCR.ptr[j])
				)
			);
		}

		//1984 Collela & Woodward eqn 1.6
		<?=eqn.prim_t?> Wp, Wm;
		for (int j = 0; j < numStates; ++j) {
			Wp.ptr[j] = Wm.ptr[j] = .5 * dWR.ptr[j] - 1./6. * (dWMR[j] - dWML[j]);
		}

		//1984 Collela & Woodward eqn 1.10
		for (int j = 0; j < numStates; ++j) {
			real dWp = Wp.ptr[j] - W.ptr[j];
			real dWm = W.ptr[j] - Wm.ptr[j];
			real dWpm = Wp.ptr[j] - Wm.ptr[j];
			real avgWpm = .5 * (Wp.ptr[j] + Wm.ptr[j]);
			if (dWp * dWm <= 0) {
				Wp.ptr[j] = Wm.ptr[j] = W.ptr[j];
			} else if (dWpm * (W.ptr[j] - avgWpm) > dWpm * dWpm / 6.) {
				Wm.ptr[j] = 3. * W.ptr[j] - 2. * Wp.ptr[j];
			} else if (-dWpm * dWpm / 6. > dWpm * (W.ptr[j] - avgWpm)) {
				Wp.ptr[j] = 3. * W.ptr[j] - 2. * Wm.ptr[j];
			}
		}

		for (int j = 0; j < numStates; ++j) {
			Wm.ptr[j] = .5 * (W.ptr[j] +  Wm.ptr[j]);
			Wp.ptr[j] = .5 * (W.ptr[j] +  Wp.ptr[j]);
		}

		//1984 Collela & Woodward eqn 1.5
		real W6[numStates];
		for (int j = 0; j < numStates; ++j) {
			W6[j] = 6. * W.ptr[j] - 3. * (Wp.ptr[j] + Wm.ptr[j]);
		}

		real dx = dx<?=side?>_at(i);
		real dt_dx = dt / dx;

		//calc eigen values and vectors at cell center
		<?=eqn.eigen_t?> eig = eigen_forCell_<?=side?>(U, x);
		<?=eqn:eigenWaveCodePrefix(side, '&eig', 'x')?>

		real eval[numWaves];
<? for j=0,eqn.numWaves-1 do
?>		eval[<?=j?>] = <?=eqn:eigenWaveCode(side, '&eig', 'x', j)?>;
<? end
?>

		<?=eqn.prim_t?> Ip, Im;
		for (int j = 0; j < numWaves; ++j) {
			real sigma = fabs(eval[j]) * dt_dx;
			if (eval[j] >= 0.) {
				Ip.ptr[j] = Wp.ptr[j] - .5 * sigma * (Wp.ptr[j] - Wm.ptr[j] - (1. - 2./3.*sigma) * W6[j]);
			} else {
				Ip.ptr[j] = W.ptr[j];
			}
			if (eval[j] <= 0.) {
				Im.ptr[j] = Wm.ptr[j] + .5 * sigma * (Wp.ptr[j] - Wm.ptr[j] + (1. - 2./3.*sigma) * W6[j]);
			} else {
				Im.ptr[j] = W.ptr[j];
			}
		}

		real waveMin = <?=eqn:eigenWaveCode(side, '&eig', 'x', 0)?>;
		real waveMax = <?=eqn:eigenWaveCode(side, '&eig', 'x', eqn.numWaves-1)?>;
		<?=eqn.prim_t?> Wref_xp = waveMax >= 0 ? Ip : W;
		<?=eqn.prim_t?> Wref_xm = waveMin <= 0 ? Im : W;

		<?=eqn.prim_t?> Wref_xm_minus_Im, Wref_xp_minus_Ip;
		for (int j = 0; j < numWaves; ++j) {
			Wref_xm_minus_Im.ptr[j] = Wref_xm.ptr[j] - Im.ptr[j];
			Wref_xp_minus_Ip.ptr[j] = Wref_xp.ptr[j] - Ip.ptr[j];
		}

		real beta_xm[numWaves];
		real beta_xp[numWaves];
		eigen_leftTransform_<?=side?>___(beta_xm, &eig, Wref_xm_minus_Im.ptr, x);
		eigen_leftTransform_<?=side?>___(beta_xp, &eig, Wref_xp_minus_Ip.ptr, x);
		for (int j = 0; j < numWaves; ++j) {
			beta_xp[j] = max(0., beta_xp[j]);
			beta_xm[j] = min(0., beta_xm[j]);
		}

		<?=eqn.prim_t?> WresL, WresR;
		eigen_rightTransform_<?=side?>___(WresL.ptr, &eig, beta_xp, x);
		eigen_rightTransform_<?=side?>___(WresR.ptr, &eig, beta_xm, x);
		for (int j = 0; j < numStates; ++j) {
			WresL.ptr[j] = Wref_xp.ptr[j] - WresL.ptr[j];
			WresR.ptr[j] = Wref_xm.ptr[j] - WresR.ptr[j];
		}

		ULR->L = consFromPrim(WresL, x);
		ULR->R = consFromPrim(WresR, x);

<? end ?>

	}<? end ?>
}