Minor cleanup

Minor cleanup

(use-package :regexp)

(load "cl-fad/load.lisp" :verbose nil)

(defstruct rdata start-marker end-marker replacement-callback include-markers)

(setq project-file-extension "vcxproj")

(defun regexp-replace (string pat repl)
  (reduce #'(lambda (x y) (string-concat x repl y))
          (regexp:regexp-split pat string))
)

(defun file-string (path)
  (with-open-file (infile path :if-does-not-exist nil)
    (cond ((not (null infile))
            (format nil "~{~A~^~%~}"
              (loop
                for line = (read-line infile nil)
                while line
                collect line
              )
            )
          )
          (t nil) ; file not found
    )
  )
)

(defun write-file (file-name content)
  (with-open-file (outfile file-name
      :direction :output
      :if-exists :supersede
      :if-does-not-exist :create)
  (format outfile content)))

(defmacro get-next-substr-index (str &key start-marker end-marker start-index end-index include-markers (next-index 0))
  `(progn
    (let ((start-m (match ,start-marker ,str :start ,next-index))
         )
      (cond ((null start-m) nil)
            (t
              (setq ,start-index  (if include-markers
                                     (match-start start-m)
                                     (match-end start-m)
                                  )
              )
              (let ((end-m (match ,end-marker ,str :start (match-end start-m))))
                (cond ((null end-m) nil)
                      (t
                        (setq ,end-index  (if include-markers
                                             (match-end end-m)
                                             (match-start end-m)
                                          )
                        )
                        (match-end end-m)
                      )
                )
              )
            )
      )
    )
  )
)
(defun concat-string-list (s)
  (format nil "~{~A~}" s))

(defun parse-replace (str template)
    (concat-string-list
      (let ((sm (rdata-start-marker template))
            (em (rdata-end-marker template))
            (callback (rdata-replacement-callback template))
            (include-markers (rdata-include-markers template))
            )
           ;(write-line (format nil "Replacing: ~A to ~A" sm em))
           (loop  with index = 0
                  do (setq next-index (get-next-substr-index str :start-marker sm
                               :end-marker em
                               :start-index si
                               :end-index ei
                               :next-index index
                               :include-markers include-markers))
                  if (null next-index)
                    collect (progn ;(write-line (format nil "~A -> ~A" index (length str)))
                              (subseq str index)
                             )
                  while next-index
                  collect (subseq str index si)
                  collect (funcall callback (subseq str si ei))
                  collect (subseq str ei next-index)
                  do (progn ;(write-line (format nil "~A -> [~A ~A] -> ~A" index si ei next-index))
                        (setq index next-index)
                      )
           )
      )
    )
)

(defun apply-replacement-templates (str templates)
  (cond ((null templates) str)
        (t (apply-replacement-templates
            (parse-replace str (car templates))
            (cdr templates)
           )
        )
  )
)

(defun apply-parse-file (file-name-in file-name-out templates)
  (write-file file-name-out
    (apply-replacement-templates (file-string file-name-in) templates)
  )
)

(defun replace-all (string part replacement &key (test #'char=))
  "Returns a new string in which all the occurences of the part
is replaced with replacement."
  (with-output-to-string (out)
    (loop with part-length = (length part)
       for old-pos = 0 then (+ pos part-length)
       for pos = (search part string
                         :start2 old-pos
                         :test test)
       do (write-string string out
                        :start old-pos
                        :end (or pos (length string)))
       when pos do (write-string replacement out)
       while pos)))

(setq rdata-list nil)
(defun add-rdata (&rest args)
  (let ((rd (apply #'make-rdata args)))
    (setq rdata-list (cons rd rdata-list))
  )
)
(defun get-macro (key) (gethash key macro-hash))

(setq tp1 (make-rdata :start-marker "<data[^>]*>"
                     :end-marker "</data>"
                     :replacement-callback (lambda (str) "_123_")
                     :include-markers T))
(setq build-dir "[Cc]:[\\/]projects[\\/]orbbec[\\/]SenseKitSDK-0.1.0-win32[\\/]samples[\\/]build")
(setq lambda-path-to-sln-dir (lambda (str) (regexp-replace str build-dir "$(SolutionDir)")))
(setq lambda-remove (lambda (str) ""))

(add-rdata :start-marker "<AdditionalIncludeDirectories>"
           :end-marker "</AdditionalIncludeDirectories>"
           :replacement-callback (lambda (str) (replace-all str "\\$$(SolutionDir)" "$(SolutionDir)")))
(add-rdata :start-marker "<OutDir[^>]*>"
           :end-marker "</OutDir>"
           :replacement-callback lambda-path-to-sln-dir)
(add-rdata :start-marker "<ImportLibrary[^>]*>"
           :end-marker "</ImportLibrary>"
           :replacement-callback lambda-path-to-sln-dir)
(add-rdata :start-marker "<ProgramDataBaseFile[^>]*>"
           :end-marker "</ProgramDataBaseFile>"
           :replacement-callback lambda-path-to-sln-dir)
(add-rdata :start-marker "[^<>]*<ItemGroup[^>]*>[^<]*<CustomBuild[^>]*CMakeLists[.]txt[^>]*>"
           :end-marker "</CustomBuild>[^<]*</ItemGroup>"
           :replacement-callback lambda-remove
           :include-markers T)
(add-rdata :start-marker "[^<>]*<ItemGroup[^>]*>[^<]*<ProjectReference[^>]*ZERO_CHECK[.]vcxproj[^>]*>"
           :end-marker "</ProjectReference>[^<]*</ItemGroup>"
           :replacement-callback lambda-remove
           :include-markers T)

(defun mapc-directory-tree (fn directory)
  (dolist (entry (cl-fad:list-directory directory))
    (when (cl-fad:directory-pathname-p entry)
      (mapc-directory-tree fn entry))
    (funcall fn entry)))

(defun get-temp-filename (fn)
  (format nil "~A.tmp" fn))

(defun process-file (filename-in)
  (let ((filename-out (get-temp-filename filename-in)))
    (apply-parse-file filename-in filename-out rdata-list)
    (delete-file filename-in)
    (rename-file filename-out filename-in)
  )
)

(defun process (dir)
  (let ((target-directory (if (null dir)
                              (ext:cd)
                              dir)))
    (write-line (format nil "Base directory: ~A~%" target-directory))
    (mapc-directory-tree (lambda (x)
                           (when (equal (pathname-type x) project-file-extension)
                             (write-line (format nil "~A"
                                                 (enough-namestring x target-directory)
                                                 ))
                             (process-file (namestring x))))
                         target-directory)))

(defun _ () (load "parse-replace.cl" :verbose nil))

(when (>= (length *args*) 1)
  (let ((path (car *args*)))
    (process path)
  )
)

(use-package :regexp)

(load "cl-fad/load.lisp" :verbose nil)

(defstruct rdata start-marker end-marker replacement-callback include-markers)

(setq project-file-extension "vcxproj")

(defun regexp-replace (string pat repl)
  (reduce #'(lambda (x y) (string-concat x repl y))
          (regexp:regexp-split pat string))
)

(defun file-string (path)
  (with-open-file (infile path :if-does-not-exist nil)
    (cond ((not (null infile))
            (format nil "~{~A~^~%~}"
              (loop
                for line = (read-line infile nil)
                while line
                collect line
              )
            )
          )
          (t nil) ; file not found
    )
  )
)

(defun write-file (file-name content)
  (with-open-file (outfile file-name
      :direction :output
      :if-exists :supersede
      :if-does-not-exist :create)
  (format outfile content)))

(defmacro get-next-substr-index (str &key start-marker end-marker start-index end-index include-markers (next-index 0))
  `(progn
    (let ((start-m (match ,start-marker ,str :start ,next-index))
         )
      (cond ((null start-m) nil)
            (t
              (setq ,start-index  (if include-markers
                                     (match-start start-m)
                                     (match-end start-m)
                                  )
              )
              (let ((end-m (match ,end-marker ,str :start (match-end start-m))))
                (cond ((null end-m) nil)
                      (t
                        (setq ,end-index  (if include-markers
                                             (match-end end-m)
                                             (match-start end-m)
                                          )
                        )
                        (match-end end-m)
                      )
                )
              )
            )
      )
    )
  )
)
(defun concat-string-list (s)
  (format nil "~{~A~}" s))

(defun parse-replace (str template)
    (concat-string-list
      (let ((sm (rdata-start-marker template))
            (em (rdata-end-marker template))
            (callback (rdata-replacement-callback template))
            (include-markers (rdata-include-markers template))
            )
           (write-line (format nil "Replacing: ~A to ~A" sm em))
           (loop  with index = 0
                  do (setq next-index (get-next-substr-index str :start-marker sm
                               :end-marker em
                               :start-index si
                               :end-index ei
                               :next-index index
                               :include-markers include-markers))
                  if (null next-index)
                    collect (progn (write-line (format nil "~A -> ~A" index (length str)))
                              (subseq str index)
                             )
                  while next-index
                  ;collect (subseq str index next-index)
                  collect (subseq str index si)
                  collect (funcall callback (subseq str si ei))
                  collect (subseq str ei next-index)
                  do (progn (write-line (format nil "~A -> [~A ~A] -> ~A" index si ei next-index))
                        (setq index next-index)
                      )
           )
      )
    )
)

(defun apply-replacement-templates (str templates)
  (cond ((null templates) str)
        (t (apply-replacement-templates
            (parse-replace str (car templates))
            (cdr templates)
           )
        )
  )
)

(defun apply-parse-file (file-name-in file-name-out templates)
  (write-file file-name-out
    (apply-replacement-templates (file-string file-name-in) templates)
  )
)

(defun replace-all (string part replacement &key (test #'char=))
  "Returns a new string in which all the occurences of the part
is replaced with replacement."
  (with-output-to-string (out)
    (loop with part-length = (length part)
       for old-pos = 0 then (+ pos part-length)
       for pos = (search part string
                         :start2 old-pos
                         :test test)
       do (write-string string out
                        :start old-pos
                        :end (or pos (length string)))
       when pos do (write-string replacement out)
       while pos)))

(setq rdata-list nil)
(defun add-rdata (&rest args)
  (let ((rd (apply #'make-rdata args)))
    (setq rdata-list (cons rd rdata-list))
  )
)
(defun get-macro (key) (gethash key macro-hash))

(setq tp1 (make-rdata :start-marker "<data[^>]*>"
                     :end-marker "</data>"
                     :replacement-callback (lambda (str) "_123_")
                     :include-markers T))
(setq build-dir "C:[\\/]projects[\\/]orbbec[\\/]SenseKitSDK-0.1.0-win32[\\/]samples[\\/]build")
(setq lambda-path-to-sln-dir (lambda (str) (regexp-replace str build-dir "$(SolutionDir)")))
(setq lambda-remove (lambda (str) ""))

(add-rdata :start-marker "<AdditionalIncludeDirectories>"
           :end-marker "</AdditionalIncludeDirectories>"
           :replacement-callback (lambda (str) (replace-all str "\\$$(SolutionDir)" "$(SolutionDir)")))
(add-rdata :start-marker "<OutDir[^>]*>"
           :end-marker "</OutDir>"
           :replacement-callback lambda-path-to-sln-dir)
(add-rdata :start-marker "<ImportLibrary[^>]*>"
           :end-marker "</ImportLibrary>"
           :replacement-callback lambda-path-to-sln-dir)
(add-rdata :start-marker "<ProgramDataBaseFile[^>]*>"
           :end-marker "</ProgramDataBaseFile>"
           :replacement-callback lambda-path-to-sln-dir)
(add-rdata :start-marker "[^<>]*<ItemGroup[^>]*>[^<]*<CustomBuild[^>]*CMakeLists[.]txt[^>]*>"
           :end-marker "</CustomBuild>[^<]*</ItemGroup>"
           :replacement-callback lambda-remove
           :include-markers T)
(add-rdata :start-marker "[^<>]*<ItemGroup[^>]*>[^<]*<ProjectReference[^>]*ZERO_CHECK[.]vcxproj[^>]*>"
           :end-marker "</ProjectReference>[^<]*</ItemGroup>"
           :replacement-callback lambda-remove
           :include-markers T)

(setq f1 "abc <data>123</data> fdsa <data-type>9090</data> lala")
(setq fni "DepthReader.vcxproj")
(setq fno "DepthReader.vcxproj.out")

(defun mapc-directory-tree (fn directory)
  (dolist (entry (cl-fad:list-directory directory))
    (when (cl-fad:directory-pathname-p entry)
      (mapc-directory-tree fn entry))
    (funcall fn entry)))

(defun get-temp-filename (fn)
  (format nil "~A.tmp" fn))

(defun process-file (filename-in)
  (let ((filename-out (get-temp-filename filename-in)))
    (apply-parse-file filename-in filename-out rdata-list)
    (delete-file filename-in)
    (rename-file filename-out filename-in)
  )
)

(defun process (dir)
  (let ((target-directory (if (null dir)
                              (ext:cd)
                              dir)))
    (write-line (format nil "Base directory: ~A~%" target-directory))
    (mapc-directory-tree (lambda (x)
                           (when (equal (pathname-type x) project-file-extension)
                             (write-line (format nil "~A"
                                                 (enough-namestring x target-directory)
                                                 ))
                             (process-file (namestring x))))
                         target-directory)))

(defun _ () (load "parse-replace.cl" :verbose nil))

(defun t1 ()
  (write-line (parse-replace f1 tp1))
)
(defun t2 ()
  (apply-parse-file fni fno rdata-list)
)

(when (>= (length *args*) 2)
  (setq path (car *args*))
  (setq template-file (cdr *args*))
  (parse-replace (file-string path) template-file)
)

(process "files")


plexfix: email is the default now

plexfix: email is the default now

Since I can't pass arguments from Transmission, emailing is the
default.  -m now means "don't email".

;; plexfix :: fix filenames for Plex Media Server
;;
;; TODO:
;;  - handle rar files

(eval-when (compile eval load)
  ;;(require :anydate)
  (require :list2)
  (require :acldns)
  (require :smtp)
  (require :osi)
  (require :shell)
  (require :autozoom)
  (require :tget-utils "utils.fasl"))

(defpackage :cl-user
  (:use #:common-lisp
	#:excl
	#:excl.osi
	#:excl.shell
	#:net.post-office))

(in-package :cl-user)

(defvar *debug* nil)
(defvar *no-execute* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun plexfix (stream filename)
  (if* (not (probe-file filename))
     then (.error "~a does not exist." filename)
   elseif (file-directory-p filename)
     then (let ((files (directory (pathname-as-directory filename))))
	    (if* (member "rar" files :key #'pathname-type :test #'string=)
	       then (.error "Can't handle rar files yet: ~a." filename)
	       else (dolist (file files)
		      ;; handle mp4 and mkv files, for now, warn of the
		      ;; rest, ignoring some known files
		      (if* (member (pathname-type file) '("mp4" "mkv")
				   :test #'string=)
			 then (plexfix-1 stream file)
		       elseif (member (pathname-type file)
				      '("nfo" "txt" "srt")
				      :test #'string=)
			 thenret
			 else (format stream "Unknown file:~a.~%" file)))))
     else (plexfix-1 stream filename)))

(defun plexfix-1 (stream filename &aux new-name type)
  (multiple-value-bind (series-name season episode pms-fail year month day)
      (parse-name-season-and-episode (file-namestring filename)
				     :episode-required t
				     :junk-allowed t)
    (when (not pms-fail) (return-from plexfix-1 nil))

    ;; PMS will not see this file, so make a symlink for it that it will
    ;; see.
    (setq type (pathname-type filename))
    (setq new-name
      (if* year
	 then ;; date-based name
	      (format nil "~a.~d.~2,'0d.~2,'0d.~a"
		      series-name year month day type)
	 else (format nil "~a.S~2,'0dE~2,'0d.~a"
		      series-name season episode type)))
    (with-verbosity 1
      (format stream "OLD name: ~a~%" filename)
      (format stream "NEW name: ~a~%" new-name))

    (if* *no-execute*
       then (format stream "Would symlink ~a ~a~%" filename new-name)
       else (symlink filename new-name))

    ;; Look for .srt file with the same name, and make a symlink for that,
    ;; too.  The Roku can't use subtitles unless the file has the same
    ;; name!
    (let ((srt (merge-pathnames (make-pathname :type "srt")
				filename))
	  new-srt)
      (when (probe-file srt)
	(with-verbosity 1
	  (format stream "Making link for srt file, too.~%"))
	(setq new-srt (merge-pathnames (make-pathname :type "srt") new-name))
	(if* *no-execute*
	   then (format stream "Would symlink ~a ~a~%" srt new-srt)
	   else (symlink srt new-srt))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-condition plexfix (error) ())

(defun .error (format-string &rest format-arguments)
  ;; This separates known tget errors from unexpected program errors.  All
  ;; calls to error in this code should be to this function.  Any calls to
  ;; error or cerror cause a stack trace.
  (error 'plexfix :format-control format-string
	 :format-arguments format-arguments))

(defun user::main (&aux (stream t))
  (flet
      ((send-output ()
	 (ignore-errors
	  (when (not (eq 't stream))
	    (send-letter "192.168.0.1"
			 (sys:getenv "USER")
			 (sys:getenv "USER")
			 (get-output-stream-string stream)
			 :subject "plexfix"))))
       (doit (&aux torrent-dir torrent-name)
	 (system:with-command-line-arguments
	     (("d" :short debug)
	      ("m" :short no-email)
	      ("n" :short no-execute)
	      ("q" :short quiet)
	      ("v" :short verbose :allow-multiple-options))
	     (rest)
	   (if* (and (null rest)
		     (setq torrent-dir (sys:getenv "TR_TORRENT_DIR"))
		     (setq torrent-name (sys:getenv "TR_TORRENT_NAME")))
	      then ;; called from Transmission
		   (setq rest
		     (list (format nil "~a~a" torrent-dir torrent-name)))
	    elseif (or (null rest) (/= 1 (length rest)))
	      then (.error "usage: plexfix file."))
	   (when debug (setq *debug* t))
	   (when no-execute (setq *no-execute* t))
	   (setq *verbose* (or verbose
			       (when quiet 0)
			       1))
	   (when (and (not debug) (not no-email))
	     (setq stream (make-string-output-stream)))
	   (plexfix stream (car rest)))))

    (if* *debug* ;; -d on command line doesn't effect this test!
       then (format t ";;;NOTE: debugging mode is on~%")
	    (doit)
       else (top-level.debug:with-auto-zoom-and-exit (*standard-output*)
	      (handler-case (doit)
		(plexfix (c)
		  ;; 'plexfix errors don't get a backtrace, since those are
		  ;; expected or, at least, planned for.  The unexpected
		  ;; ones get the zoom.
		  (format stream "~&~a~&" c)
		  (send-output)
		  (exit 1 :quiet t)))))
    (send-output)
    (exit 0 :quiet t)))

;; plexfix :: fix filenames for Plex Media Server
;;
;; TODO:
;;  - handle rar files

(eval-when (compile eval load)
  ;;(require :anydate)
  (require :list2)
  (require :acldns)
  (require :smtp)
  (require :osi)
  (require :shell)
  (require :autozoom)
  (require :tget-utils "utils.fasl"))

(defpackage :cl-user
  (:use #:common-lisp
	#:excl
	#:excl.osi
	#:excl.shell
	#:net.post-office))

(in-package :cl-user)

(defvar *debug* nil)
(defvar *no-execute* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun plexfix (stream filename)
  (if* (not (probe-file filename))
     then (.error "~a does not exist." filename)
   elseif (file-directory-p filename)
     then (let ((files (directory (pathname-as-directory filename))))
	    (if* (member "rar" files :key #'pathname-type :test #'string=)
	       then (.error "Can't handle rar files yet: ~a." filename)
	       else (dolist (file files)
		      ;; handle mp4 and mkv files, for now, warn of the
		      ;; rest, ignoring some known files
		      (if* (member (pathname-type file) '("mp4" "mkv")
				   :test #'string=)
			 then (plexfix-1 stream file)
		       elseif (member (pathname-type file)
				      '("nfo" "txt" "srt")
				      :test #'string=)
			 thenret
			 else (format stream "Unknown file:~a.~%" file)))))
     else (plexfix-1 stream filename)))

(defun plexfix-1 (stream filename &aux new-name type)
  (multiple-value-bind (series-name season episode pms-fail year month day)
      (parse-name-season-and-episode (file-namestring filename)
				     :episode-required t
				     :junk-allowed t)
    (when (not pms-fail) (return-from plexfix-1 nil))

    ;; PMS will not see this file, so make a symlink for it that it will
    ;; see.
    (setq type (pathname-type filename))
    (setq new-name
      (if* year
	 then ;; date-based name
	      (format nil "~a.~d.~2,'0d.~2,'0d.~a"
		      series-name year month day type)
	 else (format nil "~a.S~2,'0dE~2,'0d.~a"
		      series-name season episode type)))
    (with-verbosity 2
      (format stream "OLD name: ~a~%" filename)
      (format stream "NEW name: ~a~%" new-name))

    (if* *no-execute*
       then (format stream "Would symlink ~a ~a~%" filename new-name)
       else (symlink filename new-name))

    ;; Look for .srt file with the same name, and make a symlink for that,
    ;; too.  The Roku can't use subtitles unless the file has the same
    ;; name!
    (let ((srt (merge-pathnames (make-pathname :type "srt")
				filename))
	  new-srt)
      (when (probe-file srt)
	(with-verbosity 1
	  (format stream "Making link for srt file, too.~%"))
	(setq new-srt (merge-pathnames (make-pathname :type "srt") new-name))
	(if* *no-execute*
	   then (format stream "Would symlink ~a ~a~%" srt new-srt)
	   else (symlink srt new-srt))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-condition plexfix (error) ())

(defun .error (format-string &rest format-arguments)
  ;; This separates known tget errors from unexpected program errors.  All
  ;; calls to error in this code should be to this function.  Any calls to
  ;; error or cerror cause a stack trace.
  (error 'plexfix :format-control format-string
	 :format-arguments format-arguments))

(defun user::main (&aux (stream t))
  (flet
      ((send-output ()
	 (ignore-errors
	  (when (not (eq 't stream))
	    (send-letter "192.168.0.1"
			 (sys:getenv "USER")
			 (sys:getenv "USER")
			 (get-output-stream-string stream)
			 :subject "plexfix"))))
       (doit (&aux torrent-dir torrent-name)
	 (system:with-command-line-arguments
	     (("d" :short debug)
	      ("m" :short email :required-companion)
	      ("n" :short no-execute)
	      ("q" :short quiet)
	      ("v" :short verbose :allow-multiple-options))
	     (rest)
	   (if* (and (null rest)
		     (setq torrent-dir (sys:getenv "TR_TORRENT_DIR"))
		     (setq torrent-name (sys:getenv "TR_TORRENT_NAME")))
	      then ;; called from Transmission
		   (setq rest
		     (list (format nil "~a~a" torrent-dir torrent-name)))
	    elseif (or (null rest) (/= 1 (length rest)))
	      then (.error "usage: plexfix file."))
	   (when debug (setq *debug* t))
	   (when no-execute (setq *no-execute* t))
	   (setq *verbose* (or verbose
			       (when quiet 0)
			       1))
	   (when (and (not debug) email)
	     (setq stream (make-string-output-stream)))
	   (plexfix stream (car rest)))))

    (if* *debug* ;; -d on command line doesn't effect this test!
       then (format t ";;;NOTE: debugging mode is on~%")
	    (doit)
       else (top-level.debug:with-auto-zoom-and-exit (*standard-output*)
	      (handler-case (doit)
		(plexfix (c)
		  ;; 'plexfix errors don't get a backtrace, since those are
		  ;; expected or, at least, planned for.  The unexpected
		  ;; ones get the zoom.
		  (format stream "~&~a~&" c)
		  (send-output)
		  (exit 1 :quiet t)))))
    (send-output)
    (exit 0 :quiet t)))


changed iDiv to integer math

changed iDiv to integer math

/*******************************************************************************
 *
 * MIT License
 *
 * Copyright (c) 2017 Advanced Micro Devices, Inc.
 *
 * 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.
 *
 *******************************************************************************/
#define PPCAT_NX(A, B) A##B
#define PPCAT(A, B) PPCAT_NX(A, B)
#define TWO 2
#define FOUR 4
#define EIGHT 8

#if MIOPEN_USE_FP16 == 1
#pragma OPENCL EXTENSION cl_khr_fp16 : enable
#define _FLOAT half
#ifndef HALF_MAX
#define MAX_VAL 65504 /* max value */
#else
#define MAX_VAL HALF_MAX
#endif
#endif
#if MIOPEN_USE_FP32 == 1
#define _FLOAT float
#ifndef FLT_MAX
#define MAX_VAL 3.402823466e+38F /* max value */
#else
#define MAX_VAL FLT_MAX
#endif
#endif

#define _FLOAT2 PPCAT(_FLOAT, TWO)
#define _FLOAT4 PPCAT(_FLOAT, FOUR)
#define _FLOAT8 PPCAT(_FLOAT, EIGHT)

__attribute__((always_inline)) uint iDiv(uint v, uint d)
{
    uint r = v / d;
    return (r);
}

__attribute__((always_inline)) uint iMod(uint v, uint u, uint d)
{
    uint r = v - mul24(u, d);
    return (r);
}

#define MLO_OUT_CHANNEL_STRIDE_ALIGNED (MLO_OUT_CHANNEL_STRIDE / MLO_WRITE_UNIT)
#define MLO_OUT_STRIDE_ALIGNED (MLO_OUT_STRIDE / MLO_WRITE_UNIT)

#define MLO_IN_CHANNEL_STRIDE_ALIGNED (MLO_IN0_CHANNEL_STRIDE / MLO_WRITE_UNIT)
#define MLO_IN_STRIDE_ALIGNED (MLO_IN0_STRIDE / MLO_WRITE_UNIT)

__attribute__((reqd_work_group_size(MLO_GRP0_SZ0, MLO_GRP0_SZ1, MLO_GRP0_SZ2))) __kernel void
SubSample(const __global _FLOAT* __restrict in, __global _FLOAT* __restrict out)
{
    uint stack_pos = get_global_id(0);
    uint batch_id  = get_global_id(1);
    uint map_id    = iDiv(stack_pos, MLO_OUT_CHANNEL_STRIDE_ALIGNED);
    uint pix_pos   = iMod(stack_pos, map_id, MLO_OUT_CHANNEL_STRIDE_ALIGNED);
    uint out_y     = iDiv(pix_pos, MLO_OUT_STRIDE_ALIGNED);
    uint out_x     = iMod(pix_pos, out_y, MLO_OUT_STRIDE_ALIGNED) * MLO_WRITE_UNIT;

    uint out_off = batch_id * MLO_IN_BATCH_STRIDE + stack_pos * MLO_WRITE_UNIT;
    uint in_y    = out_y * MLO_FILTER0_STRIDE1;
    uint in_x    = out_x * MLO_FILTER0_STRIDE0;
    uint in_off  = batch_id * MLO_IN0_BATCH_STRIDE + map_id * MLO_IN0_CHANNEL_STRIDE +
                  in_y * MLO_IN0_STRIDE + in_x;

    const __global _FLOAT* in_ptr = &in[in_off];
    __global _FLOAT* out_ptr      = &out[out_off];

    for(uint i = 0; i < MLO_WRITE_UNIT; ++i, in_ptr += MLO_FILTER0_STRIDE0, out_ptr++)
    {
        *out_ptr = *in_ptr;
    }
}

__attribute__((reqd_work_group_size(MLO_GRP0_SZ0, MLO_GRP0_SZ1, MLO_GRP0_SZ2))) __kernel void
UpSample(const __global _FLOAT* __restrict in, __global _FLOAT* __restrict out)
{
    uint stack_pos = get_global_id(0);
    uint batch_id  = get_global_id(1);
    uint map_id    = iDiv(stack_pos, MLO_IN_CHANNEL_STRIDE_ALIGNED);
    uint pix_pos   = iMod(stack_pos, map_id, MLO_IN_CHANNEL_STRIDE_ALIGNED);
    uint in_y      = iDiv(pix_pos, MLO_IN_STRIDE_ALIGNED);
    uint in_x      = iMod(pix_pos, in_y, MLO_IN_STRIDE_ALIGNED) * MLO_WRITE_UNIT;

    uint in_off  = batch_id * MLO_IN_BATCH_STRIDE + stack_pos * MLO_WRITE_UNIT;
    uint out_y   = in_y * MLO_FILTER0_STRIDE1;
    uint out_x   = in_x * MLO_FILTER0_STRIDE0;
    uint out_off = batch_id * MLO_IN0_BATCH_STRIDE + map_id * MLO_OUT_CHANNEL_STRIDE +
                   out_y * MLO_OUT_STRIDE + out_x;

    const __global _FLOAT* in_ptr = &in[in_off];
    __global _FLOAT* out_ptr      = &out[out_off];

    for(uint i = 0; i < MLO_WRITE_UNIT; ++i, in_ptr++, out_ptr += MLO_FILTER0_STRIDE0)
    {
        *out_ptr = *in_ptr;
    }
}

/*******************************************************************************
 *
 * MIT License
 *
 * Copyright (c) 2017 Advanced Micro Devices, Inc.
 *
 * 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.
 *
 *******************************************************************************/
#define PPCAT_NX(A, B) A##B
#define PPCAT(A, B) PPCAT_NX(A, B)
#define TWO 2
#define FOUR 4
#define EIGHT 8

#if MIOPEN_USE_FP16 == 1
#pragma OPENCL EXTENSION cl_khr_fp16 : enable
#define _FLOAT half
#ifndef HALF_MAX
#define MAX_VAL 65504 /* max value */
#else
#define MAX_VAL HALF_MAX
#endif
#endif
#if MIOPEN_USE_FP32 == 1
#define _FLOAT float
#ifndef FLT_MAX
#define MAX_VAL 3.402823466e+38F /* max value */
#else
#define MAX_VAL FLT_MAX
#endif
#endif

#define _FLOAT2 PPCAT(_FLOAT, TWO)
#define _FLOAT4 PPCAT(_FLOAT, FOUR)
#define _FLOAT8 PPCAT(_FLOAT, EIGHT)

__attribute__((always_inline)) uint iDiv(uint v, uint d)
{
    uint r = (uint)((float)v * (1.f / (float)d) + 0.0000000001f);
    return (r);
}

__attribute__((always_inline)) uint iMod(uint v, uint u, uint d)
{
    uint r = v - mul24(u, d);
    return (r);
}

#define MLO_OUT_CHANNEL_STRIDE_ALIGNED (MLO_OUT_CHANNEL_STRIDE / MLO_WRITE_UNIT)
#define MLO_OUT_STRIDE_ALIGNED (MLO_OUT_STRIDE / MLO_WRITE_UNIT)

#define MLO_IN_CHANNEL_STRIDE_ALIGNED (MLO_IN0_CHANNEL_STRIDE / MLO_WRITE_UNIT)
#define MLO_IN_STRIDE_ALIGNED (MLO_IN0_STRIDE / MLO_WRITE_UNIT)

__attribute__((reqd_work_group_size(MLO_GRP0_SZ0, MLO_GRP0_SZ1, MLO_GRP0_SZ2))) __kernel void
SubSample(const __global _FLOAT* __restrict in, __global _FLOAT* __restrict out)
{
    uint stack_pos = get_global_id(0);
    uint batch_id  = get_global_id(1);
    uint map_id    = iDiv(stack_pos, MLO_OUT_CHANNEL_STRIDE_ALIGNED);
    uint pix_pos   = iMod(stack_pos, map_id, MLO_OUT_CHANNEL_STRIDE_ALIGNED);
    uint out_y     = iDiv(pix_pos, MLO_OUT_STRIDE_ALIGNED);
    uint out_x     = iMod(pix_pos, out_y, MLO_OUT_STRIDE_ALIGNED) * MLO_WRITE_UNIT;

    uint out_off = batch_id * MLO_IN_BATCH_STRIDE + stack_pos * MLO_WRITE_UNIT;
    uint in_y    = out_y * MLO_FILTER0_STRIDE1;
    uint in_x    = out_x * MLO_FILTER0_STRIDE0;
    uint in_off  = batch_id * MLO_IN0_BATCH_STRIDE + map_id * MLO_IN0_CHANNEL_STRIDE +
                  in_y * MLO_IN0_STRIDE + in_x;

    const __global _FLOAT* in_ptr = &in[in_off];
    __global _FLOAT* out_ptr      = &out[out_off];

    for(uint i = 0; i < MLO_WRITE_UNIT; ++i, in_ptr += MLO_FILTER0_STRIDE0, out_ptr++)
    {
        *out_ptr = *in_ptr;
    }
}

__attribute__((reqd_work_group_size(MLO_GRP0_SZ0, MLO_GRP0_SZ1, MLO_GRP0_SZ2))) __kernel void
UpSample(const __global _FLOAT* __restrict in, __global _FLOAT* __restrict out)
{
    uint stack_pos = get_global_id(0);
    uint batch_id  = get_global_id(1);
    uint map_id    = iDiv(stack_pos, MLO_IN_CHANNEL_STRIDE_ALIGNED);
    uint pix_pos   = iMod(stack_pos, map_id, MLO_IN_CHANNEL_STRIDE_ALIGNED);
    uint in_y      = iDiv(pix_pos, MLO_IN_STRIDE_ALIGNED);
    uint in_x      = iMod(pix_pos, in_y, MLO_IN_STRIDE_ALIGNED) * MLO_WRITE_UNIT;

    uint in_off  = batch_id * MLO_IN_BATCH_STRIDE + stack_pos * MLO_WRITE_UNIT;
    uint out_y   = in_y * MLO_FILTER0_STRIDE1;
    uint out_x   = in_x * MLO_FILTER0_STRIDE0;
    uint out_off = batch_id * MLO_IN0_BATCH_STRIDE + map_id * MLO_OUT_CHANNEL_STRIDE +
                   out_y * MLO_OUT_STRIDE + out_x;

    const __global _FLOAT* in_ptr = &in[in_off];
    __global _FLOAT* out_ptr      = &out[out_off];

    for(uint i = 0; i < MLO_WRITE_UNIT; ++i, in_ptr++, out_ptr += MLO_FILTER0_STRIDE0)
    {
        *out_ptr = *in_ptr;
    }
}


abs.cl: Add type cases to potentially improve code

/* OpenCL built-in library: abs()

   Copyright (c) 2011 Erik Schnetter <eschnetter@perimeterinstitute.ca>
                      Perimeter Institute for Theoretical Physics

   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"

#define __builtin_abshh(a)   ((uchar )(a>=(char )0 ? a : (char )-a))
#define __builtin_absh(a)    ((ushort)(a>=(short)0 ? a : (short)-a))
#define __builtin_absl(a)    ((ulong )(a>=(long )0 ? a : (long )-a))
#define __builtin_absuhh(a)  a
#define __builtin_absuh(a)   a
#define __builtin_absu(a)    a
#define __builtin_absul(a)   a

DEFINE_BUILTIN_UG_G(abs)

/* OpenCL built-in library: abs()

   Copyright (c) 2011 Erik Schnetter <eschnetter@perimeterinstitute.ca>
                      Perimeter Institute for Theoretical Physics

   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"

#define __builtin_abshh(a)   ((uchar )(a>=(char )0 ? a : -a))
#define __builtin_absh(a)    ((ushort)(a>=(short)0 ? a : -a))
#define __builtin_absl(a)    ((ulong )(a>=(long )0 ? a : -a))
#define __builtin_absuhh(a)  a
#define __builtin_absuh(a)   a
#define __builtin_absu(a)    a
#define __builtin_absul(a)   a

DEFINE_BUILTIN_UG_G(abs)


sixtracklib/opencl: fix bug in OpenCL generic particle tracking functions with type/signature for the success_flag

#ifndef SIXTRACKLIB_OPENCL_IMPL_MANAGED_TRACK_PARTICLES_KERNEL_OPENCL_CL__
#define SIXTRACKLIB_OPENCL_IMPL_MANAGED_TRACK_PARTICLES_KERNEL_OPENCL_CL__

#if !defined( SIXTRL_NO_INCLUDES )
    #include "sixtracklib/_impl/definitions.h"
    #include "sixtracklib/common/impl/managed_buffer_minimal.h"
    #include "sixtracklib/common/impl/managed_buffer_remap.h"
    #include "sixtracklib/common/impl/particles_defines.h"
    #include "sixtracklib/common/particles.h"
    #include "sixtracklib/common/track.h"
#endif /* !defined( SIXTRL_NO_INCLUDES ) */

#pragma OPENCL_EXTENSION cl_khr_int32_extended_atomics

__kernel void NS(Remap_particles_beam_elements_buffers_opencl)(
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT particles_buf,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT beam_elements_buf,
    SIXTRL_BUFFER_DATAPTR_DEC int* SIXTRL_RESTRICT ptr_success_flag )
{
    typedef NS(buffer_size_t) buf_size_t;

    size_t const global_id                     = get_global_id( 0 );
    size_t const global_size                   = get_global_size( 0 );

    size_t const gid_to_remap_particles_buffer     = ( size_t )0u;
    size_t const gid_to_remap_beam_elements_buffer = ( global_size > 1u )
        ? ( gid_to_remap_particles_buffer + 1u )
        : ( gid_to_remap_particles_buffer );

    if( global_id <= gid_to_remap_beam_elements_buffer )
    {
        buf_size_t const slot_size = ( buf_size_t )8u;
        int success_flag = ( int )0u;

        if( global_id == gid_to_remap_particles_buffer )
        {
            if( ( particles_buf != SIXTRL_NULLPTR ) &&
                ( beam_elements_buf != particles_buf ) )
            {
                if( 0 != NS(ManagedBuffer_remap)( particles_buf, slot_size ) )
                {
                    success_flag |= -2;
                }
            }
            else
            {
                success_flag |= -1;
            }
        }

        if( global_id == gid_to_remap_beam_elements_buffer )
        {
            if( ( beam_elements_buf != SIXTRL_NULLPTR ) &&
                ( particles_buf != beam_elements_buf ) )
            {
                if( 0 != NS(ManagedBuffer_remap)(
                        beam_elements_buf, slot_size ) )
                {
                    success_flag |= -4;
                }
            }
            else
            {
                success_flag |= -1;
            }
        }

        if( ( success_flag != 0 ) && ( ptr_success_flag != SIXTRL_NULLPTR ) )
        {

            atomic_or( ptr_success_flag, success_flag );
        }
    }

    return;
}

__kernel void NS(Track_particles_beam_elements_opencl)(
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT particles_buf,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT beam_elements_buf,
    SIXTRL_UINT64_T const num_turns,
    SIXTRL_BUFFER_DATAPTR_DEC int* SIXTRL_RESTRICT ptr_success_flag )
{
    typedef NS(buffer_size_t) buf_size_t;
    typedef SIXTRL_BUFFER_OBJ_ARGPTR_DEC  NS(Object)*        obj_iter_t;
    typedef SIXTRL_BUFFER_OBJ_ARGPTR_DEC  NS(Object) const*  obj_const_iter_t;
    typedef SIXTRL_BUFFER_DATAPTR_DEC     NS(Particles)*     ptr_particles_t;

    int success_flag = ( int )0u;
    buf_size_t const slot_size = ( buf_size_t )8u;

    if( ( !NS(ManagedBuffer_needs_remapping( particles_buf,     slot_size ) ) ) &&
        ( !NS(ManagedBuffer_needs_remapping( beam_elements_buf, slot_size ) ) ) )
    {
        size_t const stride             = get_local_size( 0 );
        size_t global_particle_id       = get_global_id( 0 );
        size_t object_begin_particle_id = ( size_t )0u;

        obj_iter_t part_block_it  = NS(ManagedBuffer_get_objects_index_begin)(
                particles_buf, slot_size );

        obj_iter_t part_block_end =
            NS(ManagedBuffer_get_objects_index_end)( particles_buf, slot_size );

        obj_const_iter_t be_begin =
            NS(ManagedBuffer_get_const_objects_index_begin)(
                beam_elements_buf, slot_size );

        obj_const_iter_t be_end   =
            NS(ManagedBuffer_get_const_objects_index_end)(
                beam_elements_buf, slot_size );

        for( ; part_block_it != part_block_end ; ++part_block_it )
        {
            ptr_particles_t particles = ( ptr_particles_t )(
                uintptr_t )NS(Object_get_begin_addr)( part_block_it );

            size_t const object_end_particle_id = object_begin_particle_id +
                NS(Particles_get_num_of_particles)( particles );

            SIXTRL_ASSERT( NS(Object_get_type_id)( part_block_it ) ==
                           NS(OBJECT_TYPE_PARTICLE) );

            if( ( global_particle_id <  object_end_particle_id   ) &&
                ( global_particle_id >= object_begin_particle_id ) )
            {
                size_t const particle_id =
                    global_particle_id - object_begin_particle_id;

                SIXTRL_UINT64_T turn = ( SIXTRL_UINT64_T )0u;

                SIXTRL_ASSERT( particle_id <
                    NS(Particles_get_num_of_particles)( particles ) );

                for( ; turn < num_turns ; ++turn )
                {
                    success_flag |= NS(Track_particle_beam_elements)(
                        particles, particle_id, be_begin, be_end );
                }
            }

            object_begin_particle_id = object_end_particle_id;
        }
    }
    else
    {
        if( NS(ManagedBuffer_needs_remapping( particles_buf, slot_size ) ) )
        {
            success_flag |= -2;
        }

        if( NS(ManagedBuffer_needs_remapping( beam_elements_buf, slot_size ) ) )
        {
            success_flag |= -4;
        }
    }

    if( ( success_flag != 0 ) && ( ptr_success_flag != SIXTRL_NULLPTR ) )
    {

        atomic_or( ptr_success_flag, success_flag );
    }

    return;
}

#endif /* SIXTRACKLIB_OPENCL_IMPL_MANAGED_TRACK_PARTICLES_KERNEL_OPENCL_CL__ */
/* end: sixtracklib/opencl/impl/track_particles_kernel.cl */

#ifndef SIXTRACKLIB_OPENCL_IMPL_MANAGED_TRACK_PARTICLES_KERNEL_OPENCL_CL__
#define SIXTRACKLIB_OPENCL_IMPL_MANAGED_TRACK_PARTICLES_KERNEL_OPENCL_CL__

#if !defined( SIXTRL_NO_INCLUDES )
    #include "sixtracklib/_impl/definitions.h"
    #include "sixtracklib/common/impl/managed_buffer_minimal.h"
    #include "sixtracklib/common/impl/managed_buffer_remap.h"
    #include "sixtracklib/common/impl/particles_defines.h"
    #include "sixtracklib/common/particles.h"
    #include "sixtracklib/common/track.h"
#endif /* !defined( SIXTRL_NO_INCLUDES ) */

#pragma OPENCL_EXTENSION cl_khr_int32_extended_atomics

__kernel void NS(Remap_particles_beam_elements_buffers_opencl)(
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT particles_buf,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT beam_elements_buf,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT ptr_success_flag )
{
    typedef NS(buffer_size_t) buf_size_t;

    size_t const global_id                     = get_global_id( 0 );
    size_t const global_size                   = get_global_size( 0 );

    size_t const gid_to_remap_particles_buffer     = ( size_t )0u;
    size_t const gid_to_remap_beam_elements_buffer = ( global_size > 1u )
        ? ( gid_to_remap_particles_buffer + 1u )
        : ( gid_to_remap_particles_buffer );

    if( global_id <= gid_to_remap_beam_elements_buffer )
    {
        buf_size_t const slot_size = ( buf_size_t )8u;
        long int success_flag = ( long int )0u;

        if( global_id == gid_to_remap_particles_buffer )
        {
            if( ( particles_buf != SIXTRL_NULLPTR ) &&
                ( beam_elements_buf != particles_buf ) )
            {
                if( 0 != NS(ManagedBuffer_remap)( particles_buf, slot_size ) )
                {
                    success_flag |= -2;
                }
            }
            else
            {
                success_flag |= -1;
            }
        }

        if( global_id == gid_to_remap_beam_elements_buffer )
        {
            if( ( beam_elements_buf != SIXTRL_NULLPTR ) &&
                ( particles_buf != beam_elements_buf ) )
            {
                if( 0 != NS(ManagedBuffer_remap)(
                        beam_elements_buf, slot_size ) )
                {
                    success_flag |= -4;
                }
            }
            else
            {
                success_flag |= -1;
            }
        }

        if( ( success_flag != 0 ) && ( ptr_success_flag != SIXTRL_NULLPTR ) )
        {

            atomic_or( ptr_success_flag, success_flag );
        }
    }

    return;
}

__kernel void NS(Track_particles_beam_elements_opencl)(
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT particles_buf,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT beam_elements_buf,
    SIXTRL_UINT64_T const num_turns,
    SIXTRL_BUFFER_DATAPTR_DEC unsigned char* SIXTRL_RESTRICT ptr_success_flag )
{
    typedef NS(buffer_size_t) buf_size_t;
    typedef SIXTRL_BUFFER_OBJ_ARGPTR_DEC  NS(Object)*        obj_iter_t;
    typedef SIXTRL_BUFFER_OBJ_ARGPTR_DEC  NS(Object) const*  obj_const_iter_t;
    typedef SIXTRL_BUFFER_DATAPTR_DEC     NS(Particles)*     ptr_particles_t;

    long int success_flag      = ( long int )0u;
    buf_size_t const slot_size = ( buf_size_t )8u;

    if( ( !NS(ManagedBuffer_needs_remapping( particles_buf,     slot_size ) ) ) &&
        ( !NS(ManagedBuffer_needs_remapping( beam_elements_buf, slot_size ) ) ) )
    {
        size_t const stride             = get_local_size( 0 );
        size_t global_particle_id       = get_global_id( 0 );
        size_t object_begin_particle_id = ( size_t )0u;

        obj_iter_t part_block_it  = NS(ManagedBuffer_get_objects_index_begin)(
                particles_buf, slot_size );

        obj_iter_t part_block_end =
            NS(ManagedBuffer_get_objects_index_end)( particles_buf, slot_size );

        obj_const_iter_t be_begin =
            NS(ManagedBuffer_get_const_objects_index_begin)(
                beam_elements_buf, slot_size );

        obj_const_iter_t be_end   =
            NS(ManagedBuffer_get_const_objects_index_end)(
                beam_elements_buf, slot_size );

        for( ; part_block_it != part_block_end ; ++part_block_it )
        {
            ptr_particles_t particles = ( ptr_particles_t )(
                uintptr_t )NS(Object_get_begin_addr)( part_block_it );

            size_t const object_end_particle_id = object_begin_particle_id +
                NS(Particles_get_num_of_particles)( particles );

            SIXTRL_ASSERT( NS(Object_get_type_id)( part_block_it ) ==
                           NS(OBJECT_TYPE_PARTICLE) );

            if( ( global_particle_id <  object_end_particle_id   ) &&
                ( global_particle_id >= object_begin_particle_id ) )
            {
                size_t const particle_id =
                    global_particle_id - object_begin_particle_id;

                SIXTRL_UINT64_T turn = ( SIXTRL_UINT64_T )0u;

                SIXTRL_ASSERT( particle_id <
                    NS(Particles_get_num_of_particles)( particles ) );

                for( ; turn < num_turns ; ++turn )
                {
                    success_flag |= NS(Track_particle_beam_elements)(
                        particles, particle_id, be_begin, be_end );
                }
            }

            object_begin_particle_id = object_end_particle_id;
        }
    }
    else
    {
        if( NS(ManagedBuffer_needs_remapping( particles_buf, slot_size ) ) )
        {
            success_flag |= -2;
        }

        if( NS(ManagedBuffer_needs_remapping( beam_elements_buf, slot_size ) ) )
        {
            success_flag |= -4;
        }
    }

    if( ( success_flag != 0 ) && ( ptr_success_flag != SIXTRL_NULLPTR ) )
    {

        atomic_or( ptr_success_flag, success_flag );
    }

    return;
}

#endif /* SIXTRACKLIB_OPENCL_IMPL_MANAGED_TRACK_PARTICLES_KERNEL_OPENCL_CL__ */
/* end: sixtracklib/opencl/impl/track_particles_kernel.cl */


Fix isnan definition for vector results

Fix isnan definition for vector results

Vector true is -1, not 1, which means we need to use the relational unary
macro instead of the normal unary builtin one.

Signed-off-by: Aaron Watry <awatry@gmail.com>
Reviewed-by: Tom Stellard <thomas.stellard@amd.com>

git-svn-id: e7f1ab7c2a259259587475a3e7520e757882f167@213316 91177308-0d34-0410-b5e6-96231b3b80d8

#include <clc/clc.h>
#include "relational.h"

_CLC_DEFINE_RELATIONAL_UNARY(int, isnan, __builtin_isnan, float)

#ifdef cl_khr_fp64

#pragma OPENCL EXTENSION cl_khr_fp64 : enable

// The scalar version of isnan(double) returns an int, but the vector versions
// return long.
_CLC_DEF _CLC_OVERLOAD int isnan(double x) {
  return __builtin_isnan(x);
}

_CLC_DEFINE_RELATIONAL_UNARY_VEC_ALL(long, isnan, double)

#endif

#include <clc/clc.h>
#include "../clcmacro.h"

_CLC_DEFINE_UNARY_BUILTIN(int, isnan, __builtin_isnan, float)

#ifdef cl_khr_fp64

#pragma OPENCL EXTENSION cl_khr_fp64 : enable

// The scalar version of isnan(double) returns an int, but the vector versions
// return long.
_CLC_DEF _CLC_OVERLOAD int isnan(double x) {
  return __builtin_isnan(x);
}

_CLC_UNARY_VECTORIZE(_CLC_OVERLOAD _CLC_DEF, long, isnan, double)

#endif