fixed post-increment for one byte instructions

;emulator for the MSP430, written to help solve the final level in the Matasano/Square CTF at https://microcorruption.com/

;data structure plans:
;memory to be represented as a large array of bytes
;registers as a much smaller array of words

(ql:quickload "cl-utilities")

(use-package :cl-utilities) ;purely for split-sequence

(defvar *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))

(defvar *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))

(defvar *input*)

(defvar *console* "console:")

(defvar *err*)

(defvar *dep* nil)

(defvar *dep-table* 0)

(defvar *unlocked* nil)

(defun mem (idx)
  (elt *mem* idx))

(defun reg (idx)
  (elt *reg* idx))

(defun flag (idx)
  (ldb (byte 1 idx) (reg 2)))

(defun get-c ()
  (ldb (byte 1 0) (reg 2)))

(defun set-c (int)
  (setf (elt *reg* 2) (dpb int (byte 1 0) (reg 2))))

(defun get-z ()
  (ldb (byte 1 1) (reg 2)))

(defun set-z (int)
  (setf (elt *reg* 2) (dpb int (byte 1 1) (reg 2))))

(defun get-n ()
  (ldb (byte 1 2) (reg 2)))

(defun set-n (int)
  (setf (elt *reg* 2) (dpb int (byte 1 2) (reg 2))))

(defun get-v ()
  (ldb (byte 1 8) (reg 2)))

(defun set-v (int)
  (setf (elt *reg* 2) (dpb int (byte 1 8) (reg 2))))

(defun bytes-to-word (low high)
  (+ (* 256 high) low))

(defun mod+ (&rest args)
  (mod (reduce #'+ args) 65536))

(defun mod* (&rest args)
  (mod (reduce #'* args) 65536))

(defun get-mem (idx)
  ;;(print "get-mem")
  ;(format t "~4,'0x" idx)
  ;(print (bytes-to-word (mem idx) (mem (+ idx 1))))
  (bytes-to-word (mem idx) (mem (+ idx 1))))

(defun set-mem (idx int b-w)
  ;(print "set-mem")
 ;(format t "~4,'0x" (get-mem idx))
  ;(print "idx")
 ;(format t "~4,'0x" idx)
  (let* ((low (mod int 256))
	 (high (/ (- int low) 256)))
    (if (= b-w 0)
	(setf (elt *mem* idx) low)
	(setf (elt *mem* idx) low
	      (elt *mem* (+ idx 1)) high)))
  ;;(print "res")
  ;(format t "~4,'0x" (get-mem idx))
  t)

(defun mem-fun (idx)
  (function (lambda (int b-w) (set-mem idx int b-w))))

(defun set-reg (idx int)
  (setf (elt *reg* idx) int))
;  (let ((low (ldb (byte 8 0) int))
;	(high (ldb (byte 8 8) int)))
;    (setf (elt *reg* idx) (+ (dpb low (byte 8 8) 0)
;			     (dpb high (byte 8 0) 0)))))

(defun reg-fun (idx)
  (function (lambda (int b-w)
    (set-reg idx (trim-bw int b-w)))))

(defun get-reg (idx)
  (elt *reg* idx))
;  (let ((val (reg idx)))
;    (let ((low (ldb (byte 8 0) val))
;	  (high (ldb (byte 8 8) val)))
;      (+ (dpb low (byte 8 8) 0)
;	 (dpb high (byte 8 0) 0)))))

(defun inc-reg (idx)
  (incf (elt *reg* idx) 2))
;  (set-reg idx (+ 2 (get-reg idx))))

(defun dec-reg (idx)
  (incf (elt *reg* idx) -2))
;  (set-reg idx (+ -2 (get-reg idx))))

(defun dep-set (page val)
  (setf *dep-table* (dpb val (byte 1 page) *dep-table*)))

(defun dep-check (page)
  (ldb (byte 1 page) *dep-table*))

(defun nullp (val b-w)
  (if (= (trim-bw val b-w) 0)
      1
      0))

(defun negp (val b-w)
  (ldb (byte 1 (+ b-w 7)) val))

(defun trim-bw (val b-w)
  (ldb (byte (+ b-w 8) 0) val))

(defun main ()
  (setf *reg* (make-array 16 :element-type '(unsigned-byte 16)))
  (set-reg 0 #x4400)
  (loop ;repeat 1000000
     while (emu-step)
       do (if *unlocked*
	      (return-from main "victory"))))

(defun emu-step ()
  (let* ((pc (get-reg 0))
	 (bytes (subseq *mem* pc (+ pc 6))))
    ;(print bytes)
    ;(print "PC")
   ;(format t "~4,'0x" pc)
    ;(print "sp")
   ;(format t "~4,'0x" (get-reg 1))
    ;(print "sr")
   ;(format t "~4,'0x" (get-reg 2))
    (cond ((oddp pc) (progn (setf *err* "PC unalligned")
			    (return-from emu-step nil)))
	  ((= (ldb (byte 1 4) (get-reg 2)) 1) (progn (setf *err* "cpu-off set")
						 (return-from emu-step nil)))
	  ((= pc 16) (int-handler (ldb (byte 7 8) (get-reg 2))))
	  ((= (bytes-to-word (elt bytes 0) (elt bytes 1)) 0)
	   (progn (setf *err* "zero instruction")
			    (return-from emu-step nil)))
	  (t (instruction-decode bytes)))
    ))

(defun int-handler (type)
  ;(print "interrupt")
  ;(print (subseq *mem* (get-reg 1) (+ 16 (get-reg 1))))
  (let ((arg1 (get-mem (+ 8 (get-reg 1))))
	(arg2 (get-mem (+ 10 (get-reg 1)))))
    (cond ((= type 0) (setf *console* (concatenate 'string *console*
						   (list (code-char (ldb (byte 8 0) arg1))))))
	  ((= type 2) (getsn arg1 arg2))
	  ((= type 3) (dep-set arg1 arg2))
	  ((= type 4) (set-reg 15 (random 65536 (make-random-state t))))
	  ((= type #x7d) (set-mem arg2 0 0)) ;assume password is always false
	  ((= type #x7e) t) ;assume passsword is always false
	  ((= type #x7f) (setf *unlocked* t)))
    (set-reg 0 (get-mem (get-reg 1)))
    (inc-reg 1)))

(defun getsn (start num)
  ;(print "getsn")
  ;(format t "~4,'0x" start)
  ;(print num)
  ;(print (car *input*))
  (let ((cur-input (car *input*)))
    (loop for i from 0 to (- (/ (length cur-input) 2) 1)
       while (<= i num)
       for char = (hex-string-to-int (subseq cur-input (* i 2) (* (+ i 1) 2)))
       do (set-mem (+ start i) char 0)))
  (setf *input* (cdr *input*)))

(defun instruction-decode (bytes)
  ;bytes to be an arry of 6 bytes, to allow for the longest possible instruction
  ;this is the entry point into the instruction decoding, will eventually call the
  ;appropriate function
  (let ((instn (bytes-to-word (elt bytes 0) (elt bytes 1)))
	(data1 (bytes-to-word (elt bytes 2) (elt bytes 3)))
	(data2 (bytes-to-word (elt bytes 4) (elt bytes 5))))
    (cond ((= (ldb (byte 4 12) instn) 1) (single-decode instn data1))
	  ((= (ldb (byte 3 13) instn) 1) (jump-decode instn))
	  ((>= (ldb (byte 4 12) instn) 4) (double-decode instn data1 data2)))))

(defun address-decode (ad dest data b-w)
  ;(print ad)
  ;(print dest)
 ;(format t "~4,'0x"  data)
  ;decodes an address for a single operand instruction
  ;returns an integer representing the current value and a function that sets the new value
  (if (or (= dest 2) (= dest 3))
      (if (= dest 2)
	  (cond ((= ad 0) (values (get-reg dest)
				  (reg-fun dest))) ;register mode
		((= ad 1) (progn (inc-reg 0)
				 (values (get-mem data)
					 (mem-fun data))));absolute mode
		((= ad 2) (values 4 4)) ;represents a constant, can't set things
		((= ad 3) (values 8 8)) ;as above
		(t 'nil))
	  (cond ((= ad 0) (values 0 0)) ;dest = 3
		((= ad 1) (values 1 1))
		((= ad 2) (values 2 2))
		((= ad 3) (values 65535 65535))
		(t 'nil)))
      (cond ((= ad 0) (values (get-reg dest)
			      (reg-fun dest))) ;register mode
	    ((= ad 1) (let ((idx (mod+ (get-reg dest) data)))
			(inc-reg 0)
			(values (get-mem idx)
				(mem-fun idx)))) ;index mode
	    ((= ad 2) (values (get-mem (get-reg dest))
			      (mem-fun (get-reg dest)))) ;indirect mode
	    ((= ad 3) (progn (addr-increment dest b-w)
			     (values (get-mem (- (get-reg dest) (if (= dest 0)
								    2
								    (+ 1 (/ b-w 8)))))
				     (mem-fun (- (get-reg dest) (if (= dest 0)
								    2
								    (+ 1 (/ b-w 8)))))))) ;indirect mode with increment
	    (t 'nil))))

(defun addr-increment (idx b-w)
  (if (= 0 idx)
      (incf (elt *reg* idx) 2)
      (incf (elt *reg* idx) (+ 1 (/ b-w 8)))))

(defun single-decode (instn data)
  ;(print "single-op")
  (inc-reg 0)
  ;decodes and calls a single operand instruction
  (let ((opcode (ldb (byte 3 7) instn))
	(ad (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (value set-fun)
	(address-decode ad dest data b-w)
      ;(print value)
      ;(print set-fun)
      (cond ((= opcode 0) (rrc value set-fun b-w))
	    ((= opcode 1) (swpb value set-fun))
	    ((= opcode 2) (rra value set-fun b-w))
	    ((= opcode 3)  (sxt value set-fun))
	    ((= opcode 4) (psh value set-fun b-w))
	    ((= opcode 5) (call value set-fun))
	    (t 'nil)))))
	      ;RETI isn't implemented because it's not in the CTF

(defun rrc (value set-fun b-w)
  ;(print "rrc")
  (let ((carry (ldb (byte 1 0) value))
	(tmp (ash (trim-bw value b-w) -1)))
    (let ((res (dpb (get-c) (byte 1 (+ b-w 7)) tmp)))
      (funcall set-fun res b-w)
      (set-v 0)
      (set-c carry)
      (if (= (negp res b-w) 1)
	  (set-n 1))
      (if (= (nullp res b-w) 0)
	  (set-z 0)))))

(defun swpb (value set-fun)
  ;(print "swpb")
  (let ((low (ldb (byte 8 8) value))
	(high (ldb (byte 8 0) value)))
    (funcall set-fun (+ (* 256 high) low) 8)))

(defun rra (value set-fun b-w)
  ;(print "rra")
  (let ((res (ash (trim-bw value b-w) -1)))
    (funcall set-fun res b-w)
    (if (= (negp res b-w) 1)
	(set-n 1))
    (set-v 0)
    (set-z 0)))

(defun sxt (value set-fun)
;(print "sxt")
  (let ((res (dpb (* 255 (ldb (byte 1 7) value)) (byte 8 8) value)))
    (funcall set-fun res 8)
    (set-c (if (= res 0)
	       0
	       1))
    (set-v 0)
    (set-n (negp res 8))
    (set-z (nullp res 8))))

(defun psh (value set-fun b-w)
  ;(print "psh")
  ;(format t "~4,'0x" value)
  (dec-reg 1)
  (set-mem (get-reg 1) value b-w))

(defun call (value set-fun)
  ;(print "call")
  ;(format t "~4,'0x" value)
  (psh (get-reg 0) nil 8)
  (set-reg 0 value))

(defun jump-decode (instn)
  ;(print "jump")
  ;(format t "~4,'0x" instn)
  ;(print (get-reg 2))
  (let ((type (ldb (byte 3 10) instn))
	(offset (ldb (byte 10 0) instn))
	(z (flag 1))
	(c (flag 0))
	(n (flag 2))
	(v (flag 8)))
    (cond ((= type 0) (if (= z 0)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 1) (if (= z 1)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 2) (if (= c 0)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 3) (if (= c 1) (jmp offset)
			  (inc-reg 0)))
	  ((= type 4) (if (= n 1) (jmp offset)
			  (inc-reg 0)))
	  ((= type 5) (if (= n v) (jmp offset)
			  (inc-reg 0)))
	  ((= type 6) (if (/= n v) (jmp offset)
			  (inc-reg 0)))
	  ((= type 7) (jmp offset)))))

(defun jmp (offset)
  ;(print offset)
  ;(print (ldb (byte 9 0) offset))
  ;(print (* (ldb (byte 1 9) offset) 1024))
  ;(print (- (* 2 (- (ldb (byte 9 0) offset)
;		    (* (ldb (byte 1 9) offset) 512)))))
  (set-reg 0 (+ (get-reg 0) 2
		(* 2 (- (ldb (byte 9 0) offset)
			(* (ldb (byte 1 9) offset) 512)))))
  t)

(defun double-decode (instn data1 data2)
  ;(print "double-op")
  (inc-reg 0)
  (let ((opcode (ldb (byte 4 12) instn))
	(source (ldb (byte 4 8) instn))
	(ad (ldb (byte 1 7) instn))
	(as (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (source-val source-fun)
	(address-decode as source data1 b-w)
      (multiple-value-bind (dest-val dest-fun)
	  (address-decode ad dest (if (= (ldb (byte 1 0) as) 1)
				      data2    ;use the second extension word if
				      data1)
			  b-w)  ;the first was used in the source
;      (let* ((source-lst (multiple-value-list (address-decode as source data1)))
;	     (source-val (car source-lst)))
;	;(print source-lst)
	;(print "source")
	;(format t "~4,'0x" source-val)
	;(print "dest")
	;(format t "~4,'0x" dest-val)
	(cond ((= opcode 4) (mov source-val dest-fun b-w))
	      ((= opcode 5) (add source-val dest-val dest-fun b-w))
	      ((= opcode 6) (addc source-val dest-val dest-fun b-w))
	      ((= opcode 7) (subc source-val dest-val dest-fun b-w))
	      ((= opcode 8) (sub source-val dest-val dest-fun b-w))
	      ((= opcode 9) (cmp source-val dest-val b-w))
	      ((= opcode 10) (dadd source-val dest-val dest-fun b-w))
	      ((= opcode 11) (emu-bit source-val dest-val b-w))
	      ((= opcode 12) (bic source-val dest-val dest-fun b-w))
	      ((= opcode 13) (bis source-val dest-val dest-fun b-w))
	      ((= opcode 14) (xor source-val dest-val dest-fun b-w))
	      ((= opcode 15) (emu-and source-val dest-val dest-fun b-w))
	      (t 'nil))))))

(defun mov (val dest-fun b-w)
  ;(print "mov")
 ;(format t "~4,'0x"  val)
;  (print dest-fun)
  ;(print b-w)
  (funcall dest-fun val b-w))

(defun add-flags (res b-w)
  (set-c (ldb (byte 1 (+ b-w 8)) res))
  (set-v 0)
  (set-n (negp res b-w))
  (set-z (nullp res b-w)))

(defun add (source-val dest-val dest-fun b-w)
  ;(print "add")
  ;(print "source")
 ;(format t "~4,'0x" source-val)
  ;(print "dest")
 ;(format t "~4,'0x" dest-val)
  ;(print b-w)
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun addc (source-val dest-val dest-fun b-w)
  ;(print "addc")
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w) (get-c))))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun subc (source-val dest-val dest-fun b-w)
  ;(print "subc")
  (let ((res (+ (trim-bw dest-val b-w) (lognot (trim-bw source-val b-w)) (get-c) 1))) ;random +1 for bug compat
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun sub (source-val dest-val dest-fun b-w)
  ;(print "sub")
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun cmp (source-val dest-val b-w)
  ;(print "cmp")
  ;(format t "~4,'0x"  source-val)
  ;(format t "~4,'0x"  dest-val)
  ;(print b-w)
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w)))
  ;(print (get-reg 2)))

(eval-when (:execute)
  (let ((source-val 0)
	(dest-val 0)
	(b-w 8))
    (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1))))))
      ;(print res))))

(defun dadd (source-val dest-val dest-fun b-w)
  ;(print "dadd")
  (let ((trim-s (trim-bw source-val b-w))
	(trim-d (trim-bw dest-val b-w)))
    (let ((res (loop for i in (list 0 4 8 12)
		  for c = 0 then (if (>= tmp 10)
				     1
				     0)
		  for tmp = (+ (ldb (byte 4 i) trim-s)
			       (ldb (byte 4 i) trim-d)
			       c)
		  for tmp2 = (if (>= tmp 10)
				 (- tmp 10)
				 tmp)
		  for val = tmp2 then (dpb tmp2 (byte 4 i) val)
		  finally (progn (set-c c)
				 (if (ldb (byte 1 3) tmp)
				     (set-n 1))
				 (return val)))))
      (funcall dest-fun res b-w))))

(defun emu-bit (source-val dest-val b-w)
  ;(print "emu-bit")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun bic (source-val dest-val dest-fun b-w)
  ;(print "bic")
  (let ((res (logand (lognot (trim-bw source-val b-w)) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)))

(defun bis (source-val dest-val dest-fun b-w)
  ;(print "bis")
  (funcall dest-fun (logior (trim-bw source-val b-w) (trim-bw dest-val b-w)) b-w))

(defun xor (source-val dest-val dest-fun b-w)
  ;(print "xor")
  (let ((res (logxor (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun emu-and (source-val dest-val dest-fun b-w)
  ;(print "emu-and")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

;start of file importing code
(defun hex-char-to-int (chr)
  (let ((hex-index "0123456789abcdef")
        (int-index #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
    (elt int-index (position chr hex-index))))

(defun hex-string-to-int (str)
  (if (equal str "")
      0
      (let ((down-str (string-downcase str)))
	(loop for i from 0 to (- (length str) 1)
	   for res = (hex-char-to-int (elt down-str i)) then (+ (* res 16) (hex-char-to-int (elt down-str i)))
	   finally (return res)))))

(defun import-file (file)
  (setf *mem* (make-array 65536 :element-type '(unsigned-byte 8)))
  (with-open-file (in file)
    (loop for line = (read-line in nil)
       while line
       do (if (not (equal #\* (elt line 8)))
	      (let* ((split-line (split-sequence #\: line))
		     (offset (hex-string-to-int (car split-line)))
		     (blocks (subseq (split-sequence #\space (cadr split-line)) 3 11)))
		(loop for i from 0 to 7
		   for block = (elt blocks i)
		   do (set-mem (+ offset (* i 2)) (block-val block) 8)))))))

(defun block-val (str)
  (hex-string-to-int
   (concatenate 'string (subseq str 2 4) (subseq str 0 2))))

(defun reset ()
  (setf *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))
  (setf *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))
  (setf *err* "null")
  (setf *console* "console:")
  (setf *unlocked* nil))

(defun run-level (file-name input)
  (reset)
  (print "start of run")
  (import-file file-name)
  (setf *input* input)
  (main)
  (print file-name)
  (print *console*)
  (print "error:")
  (print *err*)
  (print "unlocked?")
  (print *unlocked*))

;emulator for the MSP430, written to help solve the final level in the Matasano/Square CTF at https://microcorruption.com/

;data structure plans:
;memory to be represented as a large array of bytes
;registers as a much smaller array of words

(ql:quickload "cl-utilities")

(use-package :cl-utilities) ;purely for split-sequence

(defvar *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))

(defvar *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))

(defvar *input*)

(defvar *console* "console:")

(defvar *err*)

(defvar *dep* nil)

(defvar *dep-table* 0)

(defvar *unlocked* nil)

(defun mem (idx)
  (elt *mem* idx))

(defun reg (idx)
  (elt *reg* idx))

(defun flag (idx)
  (ldb (byte 1 idx) (reg 2)))

(defun get-c ()
  (ldb (byte 1 0) (reg 2)))

(defun set-c (int)
  (setf (elt *reg* 2) (dpb int (byte 1 0) (reg 2))))

(defun get-z ()
  (ldb (byte 1 1) (reg 2)))

(defun set-z (int)
  (setf (elt *reg* 2) (dpb int (byte 1 1) (reg 2))))

(defun get-n ()
  (ldb (byte 1 2) (reg 2)))

(defun set-n (int)
  (setf (elt *reg* 2) (dpb int (byte 1 2) (reg 2))))

(defun get-v ()
  (ldb (byte 1 8) (reg 2)))

(defun set-v (int)
  (setf (elt *reg* 2) (dpb int (byte 1 8) (reg 2))))

(defun bytes-to-word (low high)
  (+ (* 256 high) low))

(defun mod+ (&rest args)
  (mod (reduce #'+ args) 65536))

(defun mod* (&rest args)
  (mod (reduce #'* args) 65536))

(defun get-mem (idx)
  ;;(print "get-mem")
  ;(format t "~4,'0x" idx)
  ;(print (bytes-to-word (mem idx) (mem (+ idx 1))))
  (bytes-to-word (mem idx) (mem (+ idx 1))))

(defun set-mem (idx int b-w)
  ;(print "set-mem")
  ;(format t "~4,'0x" (get-mem idx))
  ;(print "idx")
  ;(format t "~4,'0x" idx)
  (let* ((low (mod int 256))
	 (high (/ (- int low) 256)))
    (if (= b-w 0)
	(setf (elt *mem* idx) low)
	(setf (elt *mem* idx) low
	      (elt *mem* (+ idx 1)) high)))
  ;(print "res")
  ;(format t "~4,'0x" (get-mem idx))
  t)

(defun mem-fun (idx)
  (function (lambda (int b-w) (set-mem idx int b-w))))

(defun set-reg (idx int)
  (setf (elt *reg* idx) int))

(defun reg-fun (idx)
  (function (lambda (int b-w) (setf (elt *reg* idx) (trim-bw int b-w)))))

(defun dep-set (page val)
  (setf *dep-table* (dpb val (byte 1 page) *dep-table*)))

(defun dep-check (page)
  (ldb (byte 1 page) *dep-table*))

(defun nullp (val b-w)
  (if (= (trim-bw val b-w) 0)
      1
      0))

(defun negp (val b-w)
  (ldb (byte 1 (+ b-w 7)) val))

(defun trim-bw (val b-w)
  (ldb (byte (+ b-w 8) 0) val))

(defun main ()
  (setf *reg* (make-array 16 :element-type '(unsigned-byte 16)))
  (set-reg 0 #x4400)
  (loop ;repeat 10000
     while (emu-step)
       do (if *unlocked*
	      (return-from main "victory"))))

(defun emu-step ()
  (let* ((pc (reg 0))
	 (bytes (subseq *mem* pc (+ pc 6))))
    ;(print bytes)
    ;(print "PC")
    ;(format t "~4,'0x" pc)
    ;(print "sp")
    ;(format t "~4,'0x" (reg 1))
    (cond ((oddp pc) (progn (setf *err* "PC unalligned")
			    (return-from emu-step nil)))
	  ((= (ldb (byte 1 4) (reg 2)) 1) (progn (setf *err* "cpu-off set")
						 (return-from emu-step nil)))
	  ((= pc 16) (int-handler (ldb (byte 7 8) (reg 2))))
	  ((= (bytes-to-word (elt bytes 0) (elt bytes 1)) 0)
	   (progn (setf *err* "zero instruction")
			    (return-from emu-step nil)))
	  (t (instruction-decode bytes)))
    ))

(defun int-handler (type)
  ;(print "interrupt")
  ;(print (subseq *mem* (reg 1) (+ 16 (reg 1))))
  (let ((arg1 (get-mem (+ 8 (reg 1))))
	(arg2 (get-mem (+ 10 (reg 1)))))
    (cond ((= type 0) (setf *console* (concatenate 'string *console*
						   (list (code-char (ldb (byte 8 0) arg1))))))
	  ((= type 2) (getsn arg1 arg2))
	  ((= type 3) (dep-set arg1 arg2))
	  ((= type 4) (set-reg 15 (random 65536 (make-random-state t))))
	  ((= type #x7d) (set-mem arg2 0 0)) ;assume password is always false
	  ((= type #x7e) t) ;assume passsword is always false
	  ((= type #x7f) (setf *unlocked* t)))
    (set-reg 0 (get-mem (reg 1)))
    (incf (elt *reg* 1) 2)))

(defun getsn (start num)
  ;(print "getsn")
  ;(format t "~4,'0x" start)
  ;(print num)
  ;(print (car *input*))
  (let ((cur-input (car *input*)))
    (loop for i from 0 to (- (/ (length cur-input) 2) 1)
       while (<= i num)
       for char = (hex-string-to-int (subseq cur-input (* i 2) (* (+ i 1) 2)))
       do (set-mem (+ start i) char 0)))
  (setf *input* (cdr *input*)))

(defun instruction-decode (bytes)
  ;bytes to be an arry of 6 bytes, to allow for the longest possible instruction
  ;this is the entry point into the instruction decoding, will eventually call the
  ;appropriate function
  (let ((instn (bytes-to-word (elt bytes 0) (elt bytes 1)))
	(data1 (bytes-to-word (elt bytes 2) (elt bytes 3)))
	(data2 (bytes-to-word (elt bytes 4) (elt bytes 5))))
    (cond ((= (ldb (byte 4 12) instn) 1) (single-decode instn data1))
	  ((= (ldb (byte 3 13) instn) 1) (jump-decode instn))
	  ((>= (ldb (byte 4 12) instn) 4) (double-decode instn data1 data2)))))

(defun address-decode (ad dest data)
 ;(print ad)
  ;(print dest)
  ;(format t "~4,'0x"  data)
  ;decodes an address for a single operand instruction
  ;returns an integer representing the current value and a function that sets the new value
  (if (or (= dest 2) (= dest 3))
      (if (= dest 2)
	  (cond ((= ad 0) (values (reg dest)
				  (reg-fun dest))) ;register mode
		((= ad 1) (progn (incf (elt *reg* 0) 2)
				 (values (get-mem data)
					 (mem-fun data))));absolute mode
		((= ad 2) (values 4 4)) ;represents a constant, can't set things
		((= ad 3) (values 8 8)) ;as above
		(t 'nil))
	  (cond ((= ad 0) (values 0 0))
		((= ad 1) (values 1 1))
		((= ad 2) (values 2 2))
		((= ad 3) (values 65535 65535))
		(t 'nil)))
      (cond ((= ad 0) (values (reg dest)
			      (reg-fun dest))) ;register mode
	    ((= ad 1) (let ((idx (mod+ (reg dest) data)))
			(incf (elt *reg* 0) 2)
			(values (get-mem idx)
				(mem-fun idx)))) ;index mode
	    ((= ad 2) (values (get-mem (reg dest))
			      (mem-fun (reg dest)))) ;indirect mode
	    ((= ad 3) (progn (incf (elt *reg* dest) 2)
			     (values (get-mem (- (reg dest) 2))
				     (mem-fun (- (reg dest) 2))))) ;indirect mode with increment
	    (t 'nil))))

(defun single-decode (instn data)
  ;(print "single-op")
  (incf (elt *reg* 0) 2)
  ;decodes and calls a single operand instruction
  (let ((opcode (ldb (byte 3 7) instn))
	(ad (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (value set-fun)
	(address-decode ad dest data)
      ;(print value)
      ;(print set-fun)
      (cond ((= opcode 0) (rrc value set-fun b-w))
	    ((= opcode 1) (swpb value set-fun))
	    ((= opcode 2) (rra value set-fun b-w))
	    ((= opcode 3)  (sxt value set-fun))
	    ((= opcode 4) (psh value set-fun b-w))
	    ((= opcode 5) (call value set-fun))
	    (t 'nil)))))
	      ;RETI isn't implemented because it's not in the CTF

(defun rrc (value set-fun b-w)
  ;(print "rrc")
  (let ((carry (ldb (byte 1 0) value))
	(tmp (ash (trim-bw value b-w) -1)))
    (let ((res (dpb (get-c) (byte 1 (+ b-w 7)) tmp)))
      (funcall set-fun res b-w)
      (set-v 0)
      (set-c carry)
      (if (= (negp res b-w) 1)
	  (set-n 1))
      (if (= (nullp res b-w) 0)
	  (set-z 0)))))

(defun swpb (value set-fun)
  ;(print "swpb")
  (let ((low (ldb (byte 8 8) value))
	(high (ldb (byte 8 0) value)))
    (funcall set-fun (+ (* 256 high) low) 8)))

(defun rra (value set-fun b-w)
  ;(print "rra")
  (let ((res (ash (trim-bw value b-w) -1)))
    (funcall set-fun res b-w)
    (if (= (negp res b-w) 1)
	(set-n 1))
    (set-v 0)
    (set-z 0)))

(defun sxt (value set-fun)
;(print "sxt")
  (let ((res (dpb (* 255 (ldb (byte 1 7) value)) (byte 8 8) value)))
    (funcall set-fun res 8)
    (set-c (if (= res 0)
	       0
	       1))
    (set-v 0)
    (set-n (negp res 8))
    (set-z (nullp res 8))))

(defun psh (value set-fun b-w)
  ;(print "psh")
  ;(format t "~4,'0x" value)
  (incf (elt *reg* 1) -2)
  (set-mem (reg 1) value b-w))

(defun call (value set-fun)
  ;(print "call")
  ;(format t "~4,'0x" value)
  (psh (+ (reg 0) 0) nil 8)
  (setf (elt *reg* 0) value))

(defun jump-decode (instn)
  ;(print "jump")
  ;(format t "~4,'0x" instn)
  ;(print (reg 2))
  (let ((type (ldb (byte 3 10) instn))
	(offset (ldb (byte 10 0) instn))
	(z (flag 1))
	(c (flag 0))
	(n (flag 2))
	(v (flag 8)))
    (cond ((= type 0) (if (= z 0)
			  (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 1) (if (= z 1)
			  (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 2) (if (= c 0)
			  (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 3) (if (= c 1) (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 4) (if (= n 1) (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 5) (if (= n v) (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 6) (if (/= n v) (jmp offset)
			  (incf (elt *reg* 0) 2)))
	  ((= type 7) (jmp offset)))))

(defun jmp (offset)
  ;(print offset)
  ;(print (ldb (byte 9 0) offset))
  ;(print (* (ldb (byte 1 9) offset) 1024))
  ;(print (- (* 2 (- (ldb (byte 9 0) offset)
;		    (* (ldb (byte 1 9) offset) 512)))))
  (setf (elt *reg* 0) (+ (reg 0) 2
			 (* 2 (- (ldb (byte 9 0) offset)
				 (* (ldb (byte 1 9) offset) 512)))))
  t)

(defun double-decode (instn data1 data2)
  ;(print "double-op")
  (incf (elt *reg* 0) 2)
  (let ((opcode (ldb (byte 4 12) instn))
	(source (ldb (byte 4 8) instn))
	(ad (ldb (byte 1 7) instn))
	(as (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (source-val source-fun)
	(address-decode as source data1)
      (multiple-value-bind (dest-val dest-fun)
	  (address-decode ad dest (if (= (ldb (byte 1 0) as) 1)
				      data2    ;use the second extension word if
				      data1))  ;the first was used in the source
;      (let* ((source-lst (multiple-value-list (address-decode as source data1)))
;	     (source-val (car source-lst)))
;	;(print source-lst)
	;(print "source")
	;(format t "~4,'0x" source-val)
	;(print "dest")
	;(format t "~4,'0x" dest-val)
	(cond ((= opcode 4) (mov source-val dest-fun b-w))
	      ((= opcode 5) (add source-val dest-val dest-fun b-w))
	      ((= opcode 6) (addc source-val dest-val dest-fun b-w))
	      ((= opcode 7) (subc source-val dest-val dest-fun b-w))
	      ((= opcode 8) (sub source-val dest-val dest-fun b-w))
	      ((= opcode 9) (cmp source-val dest-val b-w))
	      ((= opcode 10) (dadd source-val dest-val dest-fun b-w))
	      ((= opcode 11) (emu-bit source-val dest-val b-w))
	      ((= opcode 12) (bic source-val dest-val dest-fun b-w))
	      ((= opcode 13) (bis source-val dest-val dest-fun b-w))
	      ((= opcode 14) (xor source-val dest-val dest-fun b-w))
	      ((= opcode 15) (emu-and source-val dest-val dest-fun b-w))
	      (t 'nil))))))

(defun mov (val dest-fun b-w)
  ;(print "mov")
  ;(format t "~4,'0x"  val)
;  ;(print dest-fun)
;  ;(print b-w)
  (funcall dest-fun val b-w))

(defun add-flags (res b-w)
  (set-c (ldb (byte 1 (+ b-w 8)) res))
  (set-v 0)
  (set-n (negp res b-w))
  (set-z (nullp res b-w)))

(defun add (source-val dest-val dest-fun b-w)
  ;(print "add")
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (add-flags res b-w)))

(defun addc (source-val dest-val dest-fun b-w)
  ;(print "addc")
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w) (get-c))))
    (funcall dest-fun res b-w)
    (add-flags res b-w)))

(defun subc (source-val dest-val dest-fun b-w)
  ;(print "subc")
  (let ((res (+ (trim-bw dest-val b-w) (lognot (trim-bw source-val b-w)) (get-c) 1))) ;random +1 for bug compat
    (funcall dest-fun res b-w)
    (add-flags res b-w)))

(defun sub (source-val dest-val dest-fun b-w)
  ;(print "sub")
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (funcall dest-fun res b-w)
    (add-flags res b-w)))

(defun cmp (source-val dest-val b-w)
  ;(print "cmp")
  ;(format t "~4,'0x"  source-val)
  ;(format t "~4,'0x"  dest-val)
  ;(print b-w)
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w)))
  ;(print (reg 2)))

(eval-when (:execute)
  (let ((source-val 0)
	(dest-val 0)
	(b-w 8))
    (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1))))))
      ;(print res))))

(defun dadd (source-val dest-val dest-fun b-w)
  ;(print "dadd")
  (let ((trim-s (trim-bw source-val b-w))
	(trim-d (trim-bw dest-val b-w)))
    (let ((res (loop for i in (list 0 4 8 12)
		  for c = 0 then (if (>= tmp 10)
				     1
				     0)
		  for tmp = (+ (ldb (byte 4 i) trim-s)
			       (ldb (byte 4 i) trim-d)
			       c)
		  for tmp2 = (if (>= tmp 10)
				 (- tmp 10)
				 tmp)
		  for val = tmp2 then (dpb tmp2 (byte 4 i) val)
		  finally (progn (set-c c)
				 (if (ldb (byte 1 3) tmp)
				     (set-n 1))
				 (return val)))))
      (funcall dest-fun res b-w))))

(defun emu-bit (source-val dest-val b-w)
  ;(print "emu-bit")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun bic (source-val dest-val dest-fun b-w)
  ;(print "bic")
  (let ((res (logand (lognot (trim-bw source-val b-w)) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)))

(defun bis (source-val dest-val dest-fun b-w)
  ;(print "bis")
  (funcall dest-fun (logior (trim-bw source-val b-w) (trim-bw dest-val b-w)) b-w))

(defun xor (source-val dest-val dest-fun b-w)
  ;(print "xor")
  (let ((res (logxor (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun emu-and (source-val dest-val dest-fun b-w)
  ;(print "emu-and")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

;start of file importing code
(defun hex-char-to-int (chr)
  (let ((hex-index "0123456789abcdef")
        (int-index #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
    (elt int-index (position chr hex-index))))

(defun hex-string-to-int (str)
  (if (equal str "")
      0
      (let ((down-str (string-downcase str)))
	(loop for i from 0 to (- (length str) 1)
	   for res = (hex-char-to-int (elt down-str i)) then (+ (* res 16) (hex-char-to-int (elt down-str i)))
	   finally (return res)))))

(defun import-file (file)
  (setf *mem* (make-array 65536 :element-type '(unsigned-byte 8)))
  (with-open-file (in file)
    (loop for line = (read-line in nil)
       while line
       do (if (not (equal #\* (elt line 8)))
	      (let* ((split-line (split-sequence #\: line))
		     (offset (hex-string-to-int (car split-line)))
		     (blocks (subseq (split-sequence #\space (cadr split-line)) 3 11)))
		(loop for i from 0 to 7
		   for block = (elt blocks i)
		   do (set-mem (+ offset (* i 2)) (block-val block) 8)))))))

(defun block-val (str)
  (hex-string-to-int
   (concatenate 'string (subseq str 2 4) (subseq str 0 2))))

(defun reset ()
  (setf *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))
  (setf *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))
  (setf *err* "null")
  (setf *console* "console:")
  (setf *unlocked* nil))

(defun run-level (file-name input)
  (reset)
  (print "start of run")
  (import-file file-name)
  (setf *input* input)
  (main)
  (print file-name)
  (print *console*)
  (print "error:")
  (print *err*)
  (print "unlocked?")
  (print *unlocked*))


fixed bug in NBH calculation

fixed bug in NBH calculation

/*  Copyright 2014 Aaron Boxer

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include "ocl_platform.cl"

/*

BPC Scan Pattern

Xx4 stripes

The stripes are scanned from top to bottom, and the columns within a
stripe are scanned from left to right.

*/

#define BOUNDARY 1
#define TWICE_BOUNDARY 2
#define STATE_BUFFER_SIZE 1156
#define STATE_BUFFER_STRIDE 34

// bit numbers (0 based indices)
#define INPUT_SIGN_BITPOS  15

#define NBH_BITPOS         0x2
#define RLC_BITPOS         0x4
#define PIXEL_START_BITPOS 0xA
#define PIXEL_END_BITPOS   0x18
#define SIGN_BITPOS        0x19

#define SIGMA_NEW			 0x1		  //0
#define SIGMA_OLD			 0x10		  //1
#define NBH					 0x20		  //2
#define RLC					 0x80		  //4
#define RLC_D_POSITION		 0x380        //6-9
#define PIXEL				 0x7FFF0000   //10-24
#define SIGN				 0x2000000    //25

#define INPUT_TO_SIGN_SHIFT 10

//#define AMD

CONSTANT sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE  | CLK_FILTER_NEAREST;

#define CURRENT_BIT(pix) (((pix)>>(bp))&1)

void KERNEL run(read_only image2d_t R,
						 read_only image2d_t G,
						 read_only image2d_t B,
						 read_only image2d_t A , const unsigned int  width, const unsigned int height) {

	// Red channel

	////////////////////////////////////////////////////////////////////////////////////////
	//0.  calculate max bits

	// between one and 32 - zero value indicates that this code block is identically zero
	LOCAL int maxBitsScratch[CODEBLOCKX];

	// state buffer
	LOCAL int state[STATE_BUFFER_SIZE];

	int2 posIn = (int2)(getLocalId(0) + getGlobalId(0)*CODEBLOCKX,  getGlobalId(1)*CODEBLOCKY);
	int maxVal = -2147483647-1;
	int index = BOUNDARY + getLocalId(0);

	state[getLocalId(0)] = 0;
	//initialize pixels, and calculate column max
	for (int i = BOUNDARY; i < CODEBLOCKY + BOUNDARY; ++i) {
	    int pixel = read_imagei(R, sampler, posIn).x;
		state[index] = (abs(pixel) << PIXEL_START_BITPOS) | ((pixel << INPUT_TO_SIGN_SHIFT) & SIGN);
		maxVal = max(maxVal, pixel);
		index += STATE_BUFFER_STRIDE;
		posIn.y++;
	}
	state[index] = 0;

	//initialize full boundary columns
	if (getLocalId(0) == 0 || getLocalId(0) == CODEBLOCKX-1) {
	    int delta = -1 + (getLocalId(0)/(CODEBLOCKX-1))*2; // -1 or +1
		int index = BOUNDARY + getLocalId(0) + delta;
		 for (int i = 0; i < CODEBLOCKY+ TWICE_BOUNDARY; ++i) {
		     state[index] = 0;
			 index += STATE_BUFFER_STRIDE;
		 }
	}

	int maxBits = 32 - clz(maxVal);
	maxBitsScratch[getLocalId(0)] =maxBits;
	localMemoryFence();

#ifdef AMD
	if (getLocalId(0) == 0) {
	    int4 mx = (int4)(maxBits);

        LOCAL int* scratchPtr = maxBitsScratch;
		for(int i=0; i < CODEBLOCKX; i+=4) {
			mx = max(mx,(int4)(maxBitsScratch[i],maxBitsScratch[i+1],maxBitsScratch[i+2],maxBitsScratch[i+3]));
		}
		maxBits = mx.x;
		maxBits = max(maxBits, mx.y);
		maxBits = max(maxBits, mx.z);
		maxBits = max(maxBits, mx.w);
		maxBitsScratch[0] = maxBits;
	}

	localMemoryFence();
	if (maxBitsScratch[0] == 0)
		return;
	//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

	/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
	// 1. CUP on MSB

	/*
	Algorithm 13 Clean-up pass on the MSB
	1: set sigmanew := bit value
	2: set rlcNbh :=  SUM(sigmanew) of preceding column and upper position
	3: if rlcNbh = 0 and y-dimension of current position is a multiple of 4
	then
	4: execute RLC operation
	5: end if
	6: if rlcNbh = 1 then
	7: execute ZC operation
	8: end if
	9: if sigmanew = 1 then
	10: execute SC operation
	11: end if
	*/

	int bp = (maxBitsScratch[0] -1) + PIXEL_START_BITPOS;

	//set sigma new
	index = BOUNDARY + getLocalId(0);
	for (int i = BOUNDARY; i < CODEBLOCKY+ BOUNDARY; ++i) {
	     int val = state[index];
		 state[index] = val | CURRENT_BIT(val);	//set sigma new
		 index += STATE_BUFFER_STRIDE;
	}
	localMemoryFence();
#else
   int bp = 12;
#endif

	// set rlcNbh, and run CUP coding
	index = BOUNDARY + getLocalId(0);
	int y = 0;
	for (int i = BOUNDARY; i < CODEBLOCKY+BOUNDARY; ++i) {
		 int val = state[index];
		 int currentBit = CURRENT_BIT(val);
	     int valLU = CURRENT_BIT(state[index-1-STATE_BUFFER_STRIDE]);
		 int valLM = CURRENT_BIT(state[index-1]);
		 int valLL = CURRENT_BIT(state[index-1+STATE_BUFFER_STRIDE]);
		 int valMU = CURRENT_BIT(state[index-STATE_BUFFER_STRIDE]);
		 int nbh = (valLU + valLM + valLL + valMU);
		 nbh = ((nbh | (~nbh + 1)) >> 27) * NBH;  // NBH if non-zero, otherwise zero
		 val |= nbh;							  // set rlc

		 if (nbh == 0 && ((y&3) == 0) ) {
			//RLC

		 } else {
			//ZC

		 }
		 if (currentBit) {
			//SC

		 }
		 index += STATE_BUFFER_STRIDE;
		 y++;
	}
	localMemoryFence();

}

/*  Copyright 2014 Aaron Boxer

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include "ocl_platform.cl"

/*

BPC Scan Pattern

Xx4 stripes

The stripes are scanned from top to bottom, and the columns within a
stripe are scanned from left to right.

*/

#define BOUNDARY 1
#define TWICE_BOUNDARY 2
#define STATE_BUFFER_SIZE 1156
#define STATE_BUFFER_STRIDE 34

// bit numbers (0 based indices)
#define INPUT_SIGN_BITPOS  15

#define RLC_BITPOS         0x4
#define PIXEL_START_BITPOS 0xA
#define PIXEL_END_BITPOS   0x18
#define SIGN_BITPOS        0x19

#define SIGMA_NEW			 0x1		  //0
#define SIGMA_OLD			 0x10		  //1
#define NBH					 0x20		  //2
#define RLC					 0x80		  //4
#define RLC_D_POSITION		 0x380        //6-9
#define PIXEL				 0x7FFF0000   //10-24
#define SIGN				 0x2000000    //25

//#define AMD

CONSTANT sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE  | CLK_FILTER_NEAREST;

#define CURRENT_BIT(pix) (((pix)>>(bp))&1)

void KERNEL run(read_only image2d_t R,
						 read_only image2d_t G,
						 read_only image2d_t B,
						 read_only image2d_t A , const unsigned int  width, const unsigned int height) {

	// Red channel

	////////////////////////////////////////////////////////////////////////////////////////
	//0.  calculate max bits

	// between one and 32 - zero value indicates that this code block is identically zero
	LOCAL int maxBitsScratch[CODEBLOCKX];

	// state buffer
	LOCAL int state[STATE_BUFFER_SIZE];

	int2 posIn = (int2)(getLocalId(0) + getGlobalId(0)*CODEBLOCKX,  getGlobalId(1)*CODEBLOCKY);
	int maxVal = -2147483647-1;
	int index = BOUNDARY + getLocalId(0);

	state[getLocalId(0)] = 0;
	//initialize pixels, and calculate column max
	for (int i = BOUNDARY; i < CODEBLOCKY + BOUNDARY; ++i) {
	    int pixel = read_imagei(R, sampler, posIn).x;
		state[index] = (abs(pixel) << PIXEL_START_BITPOS) | ((pixel >> INPUT_SIGN_BITPOS) << SIGN_BITPOS);
		maxVal = max(maxVal, pixel);
		index += STATE_BUFFER_STRIDE;
		posIn.y++;
	}
	state[index] = 0;

	//initialize full boundary columns
	if (getLocalId(0) == 0 || getLocalId(0) == CODEBLOCKX-1) {
	    int delta = -1 + (getLocalId(0)/(CODEBLOCKX-1))*2; // -1 or +1
		int index = BOUNDARY + getLocalId(0) + delta;
		 for (int i = 0; i < CODEBLOCKY+ TWICE_BOUNDARY; ++i) {
		     state[index] = 0;
			 index += STATE_BUFFER_STRIDE;
		 }
	}

	int maxBits = 32 - clz(maxVal);
	maxBitsScratch[getLocalId(0)] =maxBits;
	localMemoryFence();

#ifdef AMD
	if (getLocalId(0) == 0) {
	    int4 mx = (int4)(maxBits);

        LOCAL int* scratchPtr = maxBitsScratch;
		for(int i=0; i < CODEBLOCKX; i+=4) {
			mx = max(mx,(int4)(maxBitsScratch[i],maxBitsScratch[i+1],maxBitsScratch[i+2],maxBitsScratch[i+3]));
		}
		maxBits = mx.x;
		maxBits = max(maxBits, mx.y);
		maxBits = max(maxBits, mx.z);
		maxBits = max(maxBits, mx.w);
		maxBitsScratch[0] = maxBits;
	}

	localMemoryFence();
	if (maxBitsScratch[0] == 0)
		return;
	//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

	/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
	// 1. CUP on MSB

	/*
	Algorithm 13 Clean-up pass on the MSB
	1: set sigmanew := bit value
	2: set rlcNbh :=  SUM(sigmanew) of preceding column and upper position
	3: if rlcNbh = 0 and y-dimension of current position is a multiple of 4
	then
	4: execute RLC operation
	5: end if
	6: if rlcNbh = 1 then
	7: execute ZC operation
	8: end if
	9: if sigmanew = 1 then
	10: execute SC operation
	11: end if
	*/

	int bp = (maxBitsScratch[0] -1) + PIXEL_START_BITPOS;

	//set sigma new
	index = BOUNDARY + getLocalId(0);
	for (int i = BOUNDARY; i < CODEBLOCKY+ BOUNDARY; ++i) {
	     int val = state[index];
		 state[index] = val | CURRENT_BIT(val);	//set sigma new
		 index += STATE_BUFFER_STRIDE;
	}
	localMemoryFence();
#else
   int bp = 12;
#endif

	// set rlcNbh, and run CUP coding
	index = BOUNDARY + getLocalId(0);
	int y = 0;
	for (int i = BOUNDARY; i < CODEBLOCKY+BOUNDARY; ++i) {
		 int val = state[index];
		 int currentBit = CURRENT_BIT(val);
	     int valLU = CURRENT_BIT(state[index-1-STATE_BUFFER_STRIDE]);
		 int valLM = CURRENT_BIT(state[index-1]);
		 int valLL = CURRENT_BIT(state[index-1+STATE_BUFFER_STRIDE]);
		 int valMU = CURRENT_BIT(state[index-STATE_BUFFER_STRIDE]);
		 int rlc = (valLU + valLM + valLL + valMU);
		 rlc = ((rlc | (~rlc + 1)) >> 27) & RLC;  // RLC if non-zero, otherwise zero
		 val |= rlc;							  // set rlc

		 if (rlc == 0 && ((y&3) == 0) ) {
			//RLC

		 } else {
			//ZC

		 }
		 if (currentBit) {
			//SC

		 }
		 index += STATE_BUFFER_STRIDE;
		 y++;
	}
	localMemoryFence();

}


Delete prngcl_ranlux.cl

Delete prngcl_ranlux.cl

/******************************************************************************
 * @file     prngcl_ranlux.cl
 * @author   Vadim Demchik <vadimdi@yahoo.com>
 * @version  1.0
 *
 * @brief    [PRNGCL library]
 *           contains OpenCL implementation of RANLUX pseudo-random number generator
 *
 *
 * @section  CREDITS
 *
 *   Martin Luscher,
 *   "A portable high-quality random number generator for lattice field theory simulations",
 *   Computer Physics Communications, 79 (1994), 100--110.
 *
 *   F. James,
 *   "RANLUX: A Fortran implementation of the high-quality pseudorandom number generator of Luscher",
 *   Computer Physics Communications, 79 (1994), 111--114.
 *
 *
 * @section  LICENSE
 *
 * Copyright (c) 2013, Vadim Demchik
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without modification,
 * are permitted provided that the following conditions are met:
 *
 *    Redistributions of source code must retain the above copyright notice,
 *      this list of conditions and the following disclaimer.
 *
 *    Redistributions in binary form must reproduce the above copyright notice,
 *      this list of conditions and the following disclaimer in the documentation
 *      and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *****************************************************************************/

#ifndef PRNGCL_RANLUX_CL
#define PRNGCL_RANLUX_CL

#include "prngcl_common.cl"

#define RL_min    (1.0/16777216.0)
#define RL_max    (16777215.0/16777216.0)
#define RL_k      (5.9604644775390625E-8) // 1/2^24

#define RL_zero     0.0f
#define RL_icons    2147483563
#define RL_itwo24   16777216 // 1<<24
#define RL_twom24   0.000000059604644775390625f
#define RL_twom12   0.000244140625f
#define RL_twom24sq RL_twom24*RL_twom24

#ifndef RL_skip
#define RL_skip     223
#endif

#define RL_skip_24 (RL_skip / 24)
#if RL_skip == 97
#define RL_RANLUX2
#define RL_skip_4   0
#define RL_skip_1   0
#endif
#if RL_skip == 223
#define RL_RANLUX3
#define RL_skip_4   0
#define RL_skip_1   0
#endif
#if RL_skip == 389
#define RL_RANLUX4
#define RL_skip_4   0
#define RL_skip_1   0
#endif
#ifndef RL_skip_4
#define RL_skip_4  ((RL_skip - RL_skip_24 * 24) / 4)
#endif
#ifndef RL_skip_1
#define RL_skip_1  (RL_skip % 4)
#endif

//________________________________________________________________________________________________________ RANLUX PRNG
__attribute__((always_inline)) int4
rlseedint(int RL_jseed)
{
	int4 RL_output_int;
		int k = RL_jseed / 53668;
		RL_jseed = 40014 * (RL_jseed - k * 53668) - k * 12211;
		if (RL_jseed < 0) {RL_jseed = RL_jseed + RL_icons;}
		RL_output_int.x = RL_jseed;

		k = RL_jseed / 53668;
		RL_jseed = 40014 * (RL_jseed - k * 53668) - k * 12211;
		if (RL_jseed < 0) {RL_jseed = RL_jseed + RL_icons;}
		RL_output_int.y = RL_jseed;

		k = RL_jseed / 53668;
		RL_jseed = 40014 * (RL_jseed - k * 53668) - k * 12211;
		if (RL_jseed < 0) {RL_jseed = RL_jseed + RL_icons;}
		RL_output_int.z = RL_jseed;

		k = RL_jseed / 53668;
		RL_jseed = 40014 * (RL_jseed - k * 53668) - k * 12211;
		if (RL_jseed < 0) {RL_jseed = RL_jseed + RL_icons;}
		RL_output_int.w = RL_jseed;

    return RL_output_int;
}

__attribute__((always_inline)) float4
rlseedint2(int4 RL_temp)
{
	float4 RL_output_int;
	float4 RL_tmp = (float4) (RL_twom24,RL_twom24,RL_twom24,RL_twom24);
		RL_output_int.x = ((float) (RL_temp.x % RL_itwo24));
		RL_output_int.y = ((float) (RL_temp.y % RL_itwo24));
		RL_output_int.z = ((float) (RL_temp.z % RL_itwo24));
		RL_output_int.w = ((float) (RL_temp.w % RL_itwo24));
	RL_output_int = RL_output_int * RL_tmp;
    return RL_output_int;
}

__kernel void
ranlux_init(const __global uint * seeds, __global float4 * seedtable)
{
    int RL_jseed = (int) seeds[GID];
	int4		RL_temp1 = rlseedint(RL_jseed);
	seedtable[GID + 0 * GID_SIZE] = rlseedint2(RL_temp1);
				RL_temp1 = rlseedint(RL_temp1.w);
	seedtable[GID + 1 * GID_SIZE] = rlseedint2(RL_temp1);
				RL_temp1 = rlseedint(RL_temp1.w);
	seedtable[GID + 2 * GID_SIZE] = rlseedint2(RL_temp1);
				RL_temp1 = rlseedint(RL_temp1.w);
	seedtable[GID + 3 * GID_SIZE] = rlseedint2(RL_temp1);
				RL_temp1 = rlseedint(RL_temp1.w);
	seedtable[GID + 4 * GID_SIZE] = rlseedint2(RL_temp1);
				RL_temp1 = rlseedint(RL_temp1.w);
	float4		RL_temp2 = rlseedint2(RL_temp1);
	seedtable[GID + 5 * GID_SIZE] = RL_temp2;
	float4		RL_carin = (float4) (23.0f, 9.0f, 6.0f, 0.0f);
	if (RL_temp2.w == 0) {RL_carin.w = RL_twom24;}
	seedtable[GID + 6 * GID_SIZE] = RL_carin; // RL_i24, RL_j24, RL_in24, RL_carry
}

__attribute__((always_inline)) float4
rlproducefloat4(float4 * RL_seeds_i24, const float4 RL_seeds_j24, const float RL_seeds_j24P, float * RL_carry)
{
	float RL_c = *RL_carry;
	float4 RL_output_int = RL_seeds_j24 - (*RL_seeds_i24).wzyx;
	RL_output_int.x = RL_output_int.x - RL_c;
		if (RL_output_int.x < 0.0f) { RL_output_int.x = RL_output_int.x + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }
	RL_output_int.y = RL_output_int.y - RL_c;
		if (RL_output_int.y < 0.0f) { RL_output_int.y = RL_output_int.y + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }
	RL_output_int.z = RL_output_int.z - RL_c;
		if (RL_output_int.z < 0.0f) { RL_output_int.z = RL_output_int.z + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }
	RL_output_int.w = RL_output_int.w - RL_c;
		if (RL_output_int.w < 0.0f) { RL_output_int.w = RL_output_int.w + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }

	*RL_seeds_i24 = RL_output_int.wzyx;

    float4 RL_temporary = RL_seeds_j24.yzwx;
    RL_temporary.w = RL_seeds_j24P;

	float4 RL_output_int2 = select(RL_output_int, (RL_output_int + RL_twom24 * RL_temporary), RL_output_int < (float4) RL_twom12);
			RL_output_int = select(RL_output_int2, RL_twom24sq, RL_output_int2 == (float4) 0.0f);

	*RL_carry = RL_c;
	return RL_output_int;
}

__attribute__((always_inline)) void
rlproduceupd4(float4 * RL_seeds_i24, const float4 RL_seeds_j24, float * RL_carry)
{
	float RL_c = *RL_carry;
	float4 RL_output_int = RL_seeds_j24 - (*RL_seeds_i24).wzyx;
	RL_output_int.x = RL_output_int.x - RL_c;
		if (RL_output_int.x < 0.0f) { RL_output_int.x = RL_output_int.x + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }
	RL_output_int.y = RL_output_int.y - RL_c;
		if (RL_output_int.y < 0.0f) { RL_output_int.y = RL_output_int.y + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }
	RL_output_int.z = RL_output_int.z - RL_c;
		if (RL_output_int.z < 0.0f) { RL_output_int.z = RL_output_int.z + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }
	RL_output_int.w = RL_output_int.w - RL_c;
		if (RL_output_int.w < 0.0f) { RL_output_int.w = RL_output_int.w + 1.0f; RL_c = RL_twom24; } else { RL_c = 0.0f; }

	*RL_seeds_i24 = RL_output_int.wzyx;
	*RL_carry = RL_c;
}

__attribute__((always_inline)) float4
rl_step(float4* RL_seed0,float4* RL_seed1,float4* RL_seed2,float4* RL_seed3,
        float4* RL_seed4,float4* RL_seed5,float4* RL_carin)
{
	float4 RL_seeds_j24, uni, RL_seed_temp, RL_seed_temp2;
 	float RL_carry = (*RL_carin).w;
		if ((*RL_carin).z >= 6.0f) {
			for (int t=0; t<RL_skip_24; t++) {
				RL_seeds_j24.xy = (*RL_seed2).yx;
				RL_seeds_j24.zw = (*RL_seed1).wz;
					rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed1).yx;
				RL_seeds_j24.zw = (*RL_seed0).wz;
					rlproduceupd4(RL_seed4,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed0).yx;
				RL_seeds_j24.zw = (*RL_seed5).wz;
					rlproduceupd4(RL_seed3,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed5).yx;
				RL_seeds_j24.zw = (*RL_seed4).wz;
					rlproduceupd4(RL_seed2,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed4).yx;
				RL_seeds_j24.zw = (*RL_seed3).wz;
					rlproduceupd4(RL_seed1,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed3).yx;
				RL_seeds_j24.zw = (*RL_seed2).wz;
					rlproduceupd4(RL_seed0,RL_seeds_j24,&RL_carry);
			}
#if RL_skip_4 == 1
				RL_seeds_j24.xy = (*RL_seed2).yx;
				RL_seeds_j24.zw = (*RL_seed1).wz;
					rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
                RL_seed_temp = (*RL_seed5);    // 5->4, 4->3, 3->2, 2->1, 1->0, 0->5
                (*RL_seed5) = (*RL_seed4);
                (*RL_seed4) = (*RL_seed3);
                (*RL_seed3) = (*RL_seed2);
                (*RL_seed2) = (*RL_seed1);
                (*RL_seed1) = (*RL_seed0);
                (*RL_seed0) = RL_seed_temp;
#elif RL_skip_4 == 2
				RL_seeds_j24.xy = (*RL_seed2).yx;
				RL_seeds_j24.zw = (*RL_seed1).wz;
					rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed1).yx;
				RL_seeds_j24.zw = (*RL_seed0).wz;
					rlproduceupd4(RL_seed4,RL_seeds_j24,&RL_carry);
                RL_seed_temp = (*RL_seed5);    // 5->3, 4->2, 3->1, 2->0, 1->5, 0->4
                (*RL_seed5) = (*RL_seed3);
                (*RL_seed3) = (*RL_seed1);
                (*RL_seed1) = RL_seed_temp;
                RL_seed_temp = (*RL_seed2);
                (*RL_seed2) = (*RL_seed0);
                (*RL_seed0) = (*RL_seed4);
                (*RL_seed4) = RL_seed_temp;
#elif RL_skip_4 == 3
				RL_seeds_j24.xy = (*RL_seed2).yx;
				RL_seeds_j24.zw = (*RL_seed1).wz;
					rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed1).yx;
				RL_seeds_j24.zw = (*RL_seed0).wz;
					rlproduceupd4(RL_seed4,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed0).yx;
				RL_seeds_j24.zw = (*RL_seed5).wz;
					rlproduceupd4(RL_seed3,RL_seeds_j24,&RL_carry);
                RL_seed_temp = (*RL_seed5);    // 5->2, 4->1, 3->0, 2->5, 1->4, 0->3
                (*RL_seed5) = (*RL_seed2);
                (*RL_seed2) = RL_seed_temp;
                RL_seed_temp = (*RL_seed4);
                (*RL_seed4) = (*RL_seed1);
                (*RL_seed1) = RL_seed_temp;
                RL_seed_temp = (*RL_seed3);
                (*RL_seed3) = (*RL_seed0);
                (*RL_seed0) = RL_seed_temp;
#elif RL_skip_4 == 4
				RL_seeds_j24.xy = (*RL_seed2).yx;
				RL_seeds_j24.zw = (*RL_seed1).wz;
					rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed1).yx;
				RL_seeds_j24.zw = (*RL_seed0).wz;
					rlproduceupd4(RL_seed4,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed0).yx;
				RL_seeds_j24.zw = (*RL_seed5).wz;
					rlproduceupd4(RL_seed3,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed5).yx;
				RL_seeds_j24.zw = (*RL_seed4).wz;
					rlproduceupd4(RL_seed2,RL_seeds_j24,&RL_carry);
                RL_seed_temp = (*RL_seed5);    // 5->1, 4->0, 3->5, 2->4, 1->3, 0->2
                (*RL_seed5) = (*RL_seed1);
                (*RL_seed1) = (*RL_seed3);
                (*RL_seed3) = RL_seed_temp;
                RL_seed_temp = (*RL_seed4);
                (*RL_seed4) = (*RL_seed0);
                (*RL_seed0) = (*RL_seed2);
                (*RL_seed2) = RL_seed_temp;
#elif RL_skip_4 == 5
				RL_seeds_j24.xy = (*RL_seed2).yx;
				RL_seeds_j24.zw = (*RL_seed1).wz;
					rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed1).yx;
				RL_seeds_j24.zw = (*RL_seed0).wz;
					rlproduceupd4(RL_seed4,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed0).yx;
				RL_seeds_j24.zw = (*RL_seed5).wz;
					rlproduceupd4(RL_seed3,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed5).yx;
				RL_seeds_j24.zw = (*RL_seed4).wz;
					rlproduceupd4(RL_seed2,RL_seeds_j24,&RL_carry);
				RL_seeds_j24.xy = (*RL_seed4).yx;
				RL_seeds_j24.zw = (*RL_seed3).wz;
					rlproduceupd4(RL_seed1,RL_seeds_j24,&RL_carry);
                RL_seed_temp = (*RL_seed5);    // 5->0, 4->5, 3->4, 2->3, 1->2, 0->1
                (*RL_seed5) = (*RL_seed0);
                (*RL_seed0) = (*RL_seed1);
                (*RL_seed1) = (*RL_seed2);
                (*RL_seed2) = (*RL_seed3);
                (*RL_seed3) = (*RL_seed4);
                (*RL_seed4) = RL_seed_temp;
#endif
#if RL_skip_1 == 1
                float RL_output_int = (*RL_seed2).y - (*RL_seed5).w;
                RL_output_int = RL_output_int - RL_carry;
                    if (RL_output_int < 0.0f) { RL_output_int = RL_output_int + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                (*RL_seed5).w = RL_output_int;

                RL_seed_temp = (*RL_seed5);
                (*RL_seed5).yzw = (*RL_seed5).xyz;
                (*RL_seed5).x = (*RL_seed4).w;
                (*RL_seed4).yzw = (*RL_seed4).xyz;
                (*RL_seed4).x = (*RL_seed3).w;
                (*RL_seed3).yzw = (*RL_seed3).xyz;
                (*RL_seed3).x = (*RL_seed2).w;
                (*RL_seed2).yzw = (*RL_seed2).xyz;
                (*RL_seed2).x = (*RL_seed1).w;
                (*RL_seed1).yzw = (*RL_seed1).xyz;
                (*RL_seed1).x = (*RL_seed0).w;
                (*RL_seed0).yzw = (*RL_seed0).xyz;
                (*RL_seed0).x = RL_seed_temp.w;
#elif RL_skip_1 == 2
                float4 RL_output_int;
                RL_output_int.xy = (*RL_seed2).yx - (*RL_seed5).wz;
                RL_output_int.x = RL_output_int.x - RL_carry;
                    if (RL_output_int.x < 0.0f) { RL_output_int.x = RL_output_int.x + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                RL_output_int.y = RL_output_int.y - RL_carry;
                    if (RL_output_int.y < 0.0f) { RL_output_int.y = RL_output_int.y + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }

                (*RL_seed5).zw = RL_output_int.yx;

                RL_seed_temp = (*RL_seed5);
                (*RL_seed5).zw = (*RL_seed5).xy;
                (*RL_seed5).xy = (*RL_seed4).zw;
                (*RL_seed4).zw = (*RL_seed4).xy;
                (*RL_seed4).xy = (*RL_seed3).zw;
                (*RL_seed3).zw = (*RL_seed3).xy;
                (*RL_seed3).xy = (*RL_seed2).zw;
                (*RL_seed2).zw = (*RL_seed2).xy;
                (*RL_seed2).xy = (*RL_seed1).zw;
                (*RL_seed1).zw = (*RL_seed1).xy;
                (*RL_seed1).xy = (*RL_seed0).zw;
                (*RL_seed0).zw = (*RL_seed0).xy;
                (*RL_seed0).xy = RL_seed_temp.zw;
#elif RL_skip_1 == 3
                float4 RL_output_int;
                RL_output_int.xy = (*RL_seed2).yx - (*RL_seed5).wz;
                RL_output_int.z = (*RL_seed1).w - (*RL_seed5).y;
                RL_output_int.x = RL_output_int.x - RL_carry;
                    if (RL_output_int.x < 0.0f) { RL_output_int.x = RL_output_int.x + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                RL_output_int.y = RL_output_int.y - RL_carry;
                    if (RL_output_int.y < 0.0f) { RL_output_int.y = RL_output_int.y + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                RL_output_int.z = RL_output_int.z - RL_carry;
                    if (RL_output_int.z < 0.0f) { RL_output_int.z = RL_output_int.z + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }

                (*RL_seed5).yzw = RL_output_int.zyx;

                RL_seed_temp = (*RL_seed5);
                (*RL_seed5).w = (*RL_seed5).x;
                (*RL_seed5).xyz = (*RL_seed4).yzw;
                (*RL_seed4).w = (*RL_seed4).x;
                (*RL_seed4).xyz = (*RL_seed3).yzw;
                (*RL_seed3).w = (*RL_seed3).x;
                (*RL_seed3).xyz = (*RL_seed2).yzw;
                (*RL_seed2).w = (*RL_seed2).x;
                (*RL_seed2).xyz = (*RL_seed1).yzw;
                (*RL_seed1).w = (*RL_seed1).x;
                (*RL_seed1).xyz = (*RL_seed0).yzw;
                (*RL_seed0).w = (*RL_seed0).x;
                (*RL_seed0).xyz = RL_seed_temp.yzw;
#endif
#ifdef RL_RANLUX2
                float RL_output_int = (*RL_seed2).y - (*RL_seed5).w;
                RL_output_int = RL_output_int - RL_carry;
                    if (RL_output_int < 0.0f) { RL_output_int = RL_output_int + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                (*RL_seed5).w = RL_output_int;

                RL_seed_temp = (*RL_seed5);
                (*RL_seed5).yzw = (*RL_seed5).xyz;
                (*RL_seed5).x = (*RL_seed4).w;
                (*RL_seed4).yzw = (*RL_seed4).xyz;
                (*RL_seed4).x = (*RL_seed3).w;
                (*RL_seed3).yzw = (*RL_seed3).xyz;
                (*RL_seed3).x = (*RL_seed2).w;
                (*RL_seed2).yzw = (*RL_seed2).xyz;
                (*RL_seed2).x = (*RL_seed1).w;
                (*RL_seed1).yzw = (*RL_seed1).xyz;
                (*RL_seed1).x = (*RL_seed0).w;
                (*RL_seed0).yzw = (*RL_seed0).xyz;
                (*RL_seed0).x = RL_seed_temp.w;
#endif
#ifdef RL_RANLUX3
                RL_seeds_j24.xy = (*RL_seed2).yx;
                RL_seeds_j24.zw = (*RL_seed1).wz;
                    rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
                float4 RL_output_int;
                RL_output_int.xy = (*RL_seed1).yx - (*RL_seed4).wz;
                RL_output_int.z = (*RL_seed0).w - (*RL_seed4).y;
                RL_output_int.x = RL_output_int.x - RL_carry;
                    if (RL_output_int.x < 0.0f) { RL_output_int.x = RL_output_int.x + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                RL_output_int.y = RL_output_int.y - RL_carry;
                    if (RL_output_int.y < 0.0f) { RL_output_int.y = RL_output_int.y + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }
                RL_output_int.z = RL_output_int.z - RL_carry;
                    if (RL_output_int.z < 0.0f) { RL_output_int.z = RL_output_int.z + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }

                RL_seed_temp.xyz  = RL_output_int.zyx;
                RL_seed_temp.w    = (*RL_seed5).x;
                RL_seed_temp2.xyz = (*RL_seed5).yzw;
                RL_seed_temp2.w   = (*RL_seed0).x;

                (*RL_seed5).w   = (*RL_seed4).x;
                (*RL_seed5).xyz = (*RL_seed3).yzw;
                (*RL_seed4).w   = (*RL_seed3).x;
                (*RL_seed4).xyz = (*RL_seed2).yzw;
                (*RL_seed3).w   = (*RL_seed2).x;
                (*RL_seed3).xyz = (*RL_seed1).yzw;
                (*RL_seed2).w   = (*RL_seed1).x;
                (*RL_seed2).xyz = (*RL_seed0).yzw;
                (*RL_seed1)  = RL_seed_temp2;
                (*RL_seed0)  = RL_seed_temp;
#endif
#ifdef RL_RANLUX4
                RL_seeds_j24.xy = (*RL_seed2).yx;
                RL_seeds_j24.zw = (*RL_seed1).wz;
                    rlproduceupd4(RL_seed5,RL_seeds_j24,&RL_carry);
                float RL_output_int = (*RL_seed1).y - (*RL_seed4).w;
                RL_output_int = RL_output_int - RL_carry;
                    if (RL_output_int < 0.0f) { RL_output_int = RL_output_int + 1.0f; RL_carry = RL_twom24; } else { RL_carry = 0.0f; }

                RL_seed_temp  = (*RL_seed5);
                RL_seed_temp2.x = RL_output_int;

                (*RL_seed5).yzw = (*RL_seed4).xyz;
                (*RL_seed5).x   = (*RL_seed3).w;
                (*RL_seed4).yzw = (*RL_seed3).xyz;
                (*RL_seed4).x   = (*RL_seed2).w;
                (*RL_seed3).yzw = (*RL_seed2).xyz;
                (*RL_seed3).x   = (*RL_seed1).w;
                (*RL_seed2).yzw = (*RL_seed1).xyz;
                (*RL_seed2).x   = (*RL_seed0).w;
                (*RL_seed1).yzw = (*RL_seed0).xyz;
                (*RL_seed1).x   = RL_seed_temp.w;
                (*RL_seed0).yzw = RL_seed_temp.xyz;
                (*RL_seed0).x   = RL_seed_temp2.x;
#endif
            (*RL_carin).z = 0.0f;
		}
        if ((*RL_carin).z < 1.0f) {
			RL_seeds_j24.xy = (*RL_seed2).yx;
			RL_seeds_j24.zw = (*RL_seed1).wz;
				uni = rlproducefloat4(RL_seed5,RL_seeds_j24,(*RL_seed1).y,&RL_carry);
			(*RL_carin).z = 1.0f;
		} else if ((*RL_carin).z == 1.0f) {
			RL_seeds_j24.xy = (*RL_seed1).yx;
			RL_seeds_j24.zw = (*RL_seed0).wz;
				uni = rlproducefloat4(RL_seed4,RL_seeds_j24,(*RL_seed0).y,&RL_carry);
			(*RL_carin).z = 2.0f;
		} else if ((*RL_carin).z == 2.0f) {
			RL_seeds_j24.xy = (*RL_seed0).yx;
			RL_seeds_j24.zw = (*RL_seed5).wz;
				uni = rlproducefloat4(RL_seed3,RL_seeds_j24,(*RL_seed5).y,&RL_carry);
			(*RL_carin).z = 3.0f;
		} else if ((*RL_carin).z == 3.0f) {
			RL_seeds_j24.xy = (*RL_seed5).yx;
			RL_seeds_j24.zw = (*RL_seed4).wz;
				uni = rlproducefloat4(RL_seed2,RL_seeds_j24,(*RL_seed4).y,&RL_carry);
			(*RL_carin).z = 4.0f;
		} else if ((*RL_carin).z == 4.0f) {
			RL_seeds_j24.xy = (*RL_seed4).yx;
			RL_seeds_j24.zw = (*RL_seed3).wz;
				uni = rlproducefloat4(RL_seed1,RL_seeds_j24,(*RL_seed3).y,&RL_carry);
			(*RL_carin).z = 5.0f;
		} else if ((*RL_carin).z == 5.0f) {
			RL_seeds_j24.xy = (*RL_seed3).yx;
			RL_seeds_j24.zw = (*RL_seed2).wz;
				uni = rlproducefloat4(RL_seed0,RL_seeds_j24,(*RL_seed2).y,&RL_carry);
			(*RL_carin).z = 6.0f;
		}
	(*RL_carin).w = RL_carry;
    return uni;
}

#ifdef PRECISION_DOUBLE  // if double precision is defined
__attribute__((always_inline)) hgpu_double4
rl_step_double(float4* RL_seed0,float4* RL_seed1,float4* RL_seed2,float4* RL_seed3,
               float4* RL_seed4,float4* RL_seed5,float4* RL_carin)
{
    hgpu_double4 rnd_double;
    float4 rnd1, rnd2;
    bool flag = true;
    while (flag) {
        rnd1 = rl_step(RL_seed0,RL_seed1,RL_seed2,RL_seed3,RL_seed4,RL_seed5,RL_carin);
        if ((rnd1.x>RL_min) && (rnd1.x<RL_max) &&
            (rnd1.y>RL_min) && (rnd1.y<RL_max) &&
            (rnd1.z>RL_min) && (rnd1.z<RL_max) &&
            (rnd1.w>RL_min) && (rnd1.w<RL_max)) {
            rnd2 = rl_step(RL_seed0,RL_seed1,RL_seed2,RL_seed3,RL_seed4,RL_seed5,RL_carin);
            rnd_double = hgpu_float4_to_double4_2(rnd1,rnd2,RL_min,RL_max,RL_k);
            flag = false;
        }
    }
    return rnd_double;
}
#endif

__kernel void
ranlux(__global float4 * seedtable,__global hgpu_float4 * prns, const uint samples)
{
    uint giddst = GID;
		float4 RL_seed0 = seedtable[GID + 0 * GID_SIZE];
		float4 RL_seed1 = seedtable[GID + 1 * GID_SIZE];
		float4 RL_seed2 = seedtable[GID + 2 * GID_SIZE];
		float4 RL_seed3 = seedtable[GID + 3 * GID_SIZE];
		float4 RL_seed4 = seedtable[GID + 4 * GID_SIZE];
		float4 RL_seed5 = seedtable[GID + 5 * GID_SIZE];
		float4 RL_carin = seedtable[GID + 6 * GID_SIZE];    // RL_i24, RL_j24, RL_in24, RL_carry

	for (int i=0; i<samples; i++) {
#ifdef PRECISION_DOUBLE // if double precision is defined
        hgpu_double4 result = rl_step_double(&RL_seed0,&RL_seed1,&RL_seed2,&RL_seed3,&RL_seed4,&RL_seed5,&RL_carin);
        prns[giddst] = result;
#else
        float4 uni = rl_step(&RL_seed0,&RL_seed1,&RL_seed2,&RL_seed3,&RL_seed4,&RL_seed5,&RL_carin);
		prns[giddst] = uni;
#endif
		giddst += GID_SIZE;
	}

	seedtable[GID + 0 * GID_SIZE] = RL_seed0;
	seedtable[GID + 1 * GID_SIZE] = RL_seed1;
	seedtable[GID + 2 * GID_SIZE] = RL_seed2;
	seedtable[GID + 3 * GID_SIZE] = RL_seed3;
	seedtable[GID + 4 * GID_SIZE] = RL_seed4;
	seedtable[GID + 5 * GID_SIZE] = RL_seed5;
	seedtable[GID + 6 * GID_SIZE] = RL_carin;
}

#endif


Avoid (technically) undefined operation

Avoid (technically) undefined operation

/* OpenCL built-in library: add_sat()

   Copyright (c) 2011 Universidad Rey Juan Carlos

   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
   in the Software without restriction, including without limitation the rights
   to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
   copies of the Software, and to permit persons to whom the Software is
   furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be included in
   all copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
   AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
   THE SOFTWARE.
*/

#include "templates.h"

// Available SSE2 builtins:
//    char     __builtin_ia32_paddsb128
//    short    __builtin_ia32_paddsw128
//    uchar    __builtin_ia32_paddusb128
//    ushort   __builtin_ia32_paddusw128
// Other types don't seem to be supported.

// This could probably also be optimised (i.e. the ?: operators eliminated)
DEFINE_EXPR_G_GG(add_sat,
                 (sgtype)-1 < (sgtype)0 ?
                 /* signed */
                 ({
                   int bits = CHAR_BIT * sizeof(sgtype);
                   gtype min = (sgtype)1 << (sgtype)(bits-1);
                   gtype max = min - (sgtype)1;
                   (a^b) < (gtype)0 ?
                     /* different signs: no overflow/underflow */
                     a+b :
                     a >= (gtype)0 ?
                     /* a and b positive: can overflow */
                     (a > max-b ? max : a+b) :
                     /* a and b negative: can underflow */
                     (a < min-b ? min : a+b);
                 }) :
                 /* unsigned */
                 ({
                   gtype max = ~(gtype)0;
                   a > max-b ? max : a+b;
                 }))

/* OpenCL built-in library: add_sat()

   Copyright (c) 2011 Universidad Rey Juan Carlos

   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
   in the Software without restriction, including without limitation the rights
   to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
   copies of the Software, and to permit persons to whom the Software is
   furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be included in
   all copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
   AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
   THE SOFTWARE.
*/

#include "templates.h"

// Available SSE2 builtins:
//    char     __builtin_ia32_paddsb128
//    short    __builtin_ia32_paddsw128
//    uchar    __builtin_ia32_paddusb128
//    ushort   __builtin_ia32_paddusw128
// Other types don't seem to be supported.

// This could probably also be optimised (i.e. the ?: operators eliminated)
DEFINE_EXPR_G_GG(add_sat,
                 (sgtype)-1 < (sgtype)0 ?
                 /* signed */
                 ({
                   int bits = CHAR_BIT * sizeof(sgtype);
                   gtype min = (sgtype)1 << (sgtype)(bits-1);
                   gtype max = min - (sgtype)1;
                   (a^b) < (gtype)0 ?
                     /* different signs: no overflow/underflow */
                     a+b :
                     a >= (gtype)0 ?
                     /* a and b positive: can overflow */
                     (a > max-b ? max : a+b) :
                     /* a and b negative: can underflow */
                     (a < min-b ? min : a+b);
                 }) :
                 /* unsigned */
                 ({
                   gtype max = (sgtype)-1;
                   a > max-b ? max : a+b;
                 }))