├── .github └── FUNDING.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── project.clj ├── src ├── clojure │ └── uncomplicate │ │ └── clojurecl │ │ ├── core.clj │ │ ├── info.clj │ │ ├── internal │ │ ├── constants.clj │ │ ├── impl.clj │ │ ├── protocols.clj │ │ └── utils.clj │ │ └── toolbox.clj ├── java │ └── org │ │ └── jocl │ │ └── JOCLAccessor.java └── opencl │ └── uncomplicate │ └── clojurecl │ └── kernels │ └── reduction.cl └── test ├── clojure └── uncomplicate │ └── clojurecl │ ├── core_test.clj │ ├── examples │ ├── jocl │ │ └── hello_test.clj │ └── openclinaction │ │ ├── ch04.clj │ │ ├── ch05.clj │ │ ├── ch07.clj │ │ ├── ch10.clj │ │ └── ch11.clj │ ├── toolbox_test.clj │ └── utils_test.clj └── opencl ├── core_test.cl ├── examples ├── jocl │ └── hello-kernel.cl └── openclinaction │ ├── ch04 │ ├── double-test.cl │ ├── hello-kernel.cl │ └── vector-bytes.cl │ ├── ch05 │ ├── id-check.cl │ ├── mad-test.cl │ ├── mod-round.cl │ ├── op-test.cl │ ├── polar-rect.cl │ ├── select-test.cl │ └── shuffle-test.cl │ ├── ch07 │ ├── profile-items.cl │ ├── profile-read.cl │ └── user-event.cl │ ├── ch10 │ └── reduction.cl │ └── ch11 │ ├── kafka.txt │ └── string-search.cl └── toolbox_test.cl /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: draganrocks 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 13 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | /.lein-* 10 | /.nrepl-port 11 | doc 12 | docs 13 | hs_*.log 14 | .#* 15 | .DS_Store 16 | *.o 17 | *.so 18 | */nrepl-port 19 | */target 20 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # [ClojureCL](http://clojurecl.uncomplicate.org) - notable changes between versions 2 | 3 | ## 0.14.0 4 | 5 | * Use common Wrapper. 6 | 7 | ## 0.13.0 8 | 9 | * Use built-in work group reduction provided by the platform instead of custom implementation 10 | (prior to rocm, the built impl was much slower). 11 | 12 | ## 0.12.0 13 | 14 | * default-platform prefers a platform with 2.0+ GPU devices. 15 | 16 | ## 0.11.0 17 | 18 | * Support ROCm OpenCL implementation. 19 | 20 | ## 0.10.0 21 | 22 | ### Breaking Changes 23 | 24 | * enq-nd! renamed to enq-kernel! 25 | * XXX* methods moved to internal implementation namespace. 26 | * OpenCL 1 functions moved from legacy namespace to core. 27 | * Wrapped/Wrappable protocols introduced. 28 | 29 | ### Enhancements 30 | 31 | * JOCL objects are now wrapped to protect them from (accidental) repeated memory releases. 32 | * Improved info. 33 | 34 | ## 0.9.0 35 | 36 | * Simplified toolbox enq-reduce for 2D reductions 37 | * Enhanced error info details. 38 | * Removed vertigo dependency. 39 | 40 | ## 0.8.0 41 | 42 | * Updated to Java 9 modules. Requires add-open jvm argument. 43 | * Clojure dep updated to 1.9.0 44 | 45 | ## 0.7.2 46 | 47 | * Fixed vertigo dependency. 48 | 49 | ## 0.7.0 50 | 51 | * In info method, when device does not support specific information, exception cause is displayed instead of the ex-info object. 52 | * Added legacy? method to core. 53 | 54 | ## 0.6.5 55 | 56 | with-default-1 tries to get the best device, same as with-default 57 | 58 | ## 0.6.4 59 | 60 | Fixed https://github.com/uncomplicate/clojurecl/issues/12 61 | 62 | ## 0.6.3 63 | 64 | Fix core namespace imports in legacy.clj. 65 | 66 | ## 0.6.2 67 | 68 | Fixed https://github.com/uncomplicate/clojurecl/issues/10 69 | 70 | ## 0.6.1 71 | 72 | Bugfixes: 73 | 74 | Fixed https://github.com/uncomplicate/clojurecl/issues/9 75 | 76 | ## 0.6.0 77 | 78 | * Added support for OS X 79 | * Toolbox enq-reduce improved and simplified 80 | 81 | ## 0.5.0 82 | 83 | New features 84 | * Now uses Realeaseable functions from uncomplicate/commons 85 | 86 | ## 0.4.0 87 | 88 | New features 89 | * sort-by-open-cl function orders devices by the version of OpenCL that they support. 90 | * with-default function sorts devices before taking first. 91 | 92 | ## 0.3.0 93 | 94 | New features 95 | 96 | * New namespace for useful kernel helpers named toolbox 97 | * specialized work-size-Xd functions 98 | 99 | Bugfixes 100 | 101 | * map-buffer now correctly returns an empty ByteBuffer when reqested size is 0. 102 | 103 | ## 0.2.0 104 | 105 | New features 106 | 107 | * set-args! now accept optional index to start from. 108 | 109 | Breaking changes 110 | 111 | * *opencl-2* setting removed. A new namespace legacy has been created to 112 | contain things required in older versions of OpenCL, but unsupported in the current 113 | version. Legacy function command-queue-1 introduced to support cases when you 114 | need to support pre-2.0 platforms. For code that already targeted OpenCL 2.0, 115 | nothing needs to be changed. Other code needs to replace all 116 | calls to command-queue to the calls of command-queue-1 and with-default to 117 | with-default-1. 118 | 119 | Bugfixes: 120 | 121 | * Fixed a possible buffer overflow in enq-map-buffer when offset is greater than 0. 122 | 123 | ## 0.1.2 124 | 125 | New features: 126 | 127 | * implemented enq-fill! function 128 | 129 | Bugfixes: 130 | 131 | * Primitive arrays now return Mem/size in bytes instead of count of elements 132 | 133 | ## 0.1.1 134 | 135 | Bugfixes: 136 | 137 | * Moved dependency to vertigo from :dev to main classpath in project.clj 138 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | nEXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [New books available for subscription](https://aiprobook.com) 2 | 3 | Deep Learning for Programmers 4 | 5 | Numerical Linear Algebra for Programmers 6 | 7 | # ClojureCL 8 | 9 | [Adopt your pet function](https://dragan.rocks/articles/18/Patreon-Announcement-Adopt-a-Function) and [become a patron](https://patreon.com/draganrocks). 10 | 11 | ClojureCL is a Clojure library for parallell computations with OpenCL. It supports the latest OpenCL 2.0 version and uses fast hand-writen JNI bindings provided by [Marco Hutter's JOCL.org](http://www.jocl.org) for communication with vendor's OpenCL platform drivers. 12 | 13 | ## How to use it 14 | 15 | Read the documentation at [ClojureCL Web Site](https://clojurecl.uncomplicate.org). 16 | 17 | ## License 18 | 19 | Copyright © 2015-2018 Dragan Djuric 20 | 21 | Distributed under the Eclipse Public License either version 1.0 or (at your option) any later version. 22 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (defproject uncomplicate/clojurecl "0.16.0" 10 | :description "ClojureCL is a Clojure library for parallel computations with OpenCL." 11 | :url "https://github.com/uncomplicate/clojurecl" 12 | :scm {:name "git" 13 | :url "https://github.com/uncomplicate/clojurecl"} 14 | :license {:name "Eclipse Public License" 15 | :url "http://www.eclipse.org/legal/epl-v10.html"} 16 | :dependencies [[org.clojure/clojure "1.11.3"] 17 | [org.jocl/jocl "2.0.5"] 18 | [org.clojure/core.async "1.6.681"] 19 | [uncomplicate/commons "0.15.0"] 20 | [uncomplicate/fluokitten "0.10.0"]] 21 | 22 | :codox {:metadata {:doc/formt a:markdown} 23 | :src-dir-uri "http://github.com/uncomplicate/clojurecl/blob/master/" 24 | :src-linenum-anchor-prefix "L" 25 | :output-path "docs/codox" 26 | :namespaces [uncomplicate.clojurecl.core 27 | uncomplicate.clojurecl.info 28 | uncomplicate.clojurecl.toolbox 29 | uncomplicate.clojurecl.internal.protocols 30 | uncomplicate.clojurecl.internal.constants 31 | uncomplicate.clojurecl.internal.utils]} 32 | 33 | :profiles {:dev {:plugins [[lein-midje "3.2.1"] 34 | [lein-codox "0.10.8"]] 35 | :global-vars {*warn-on-reflection* true 36 | *assert* true 37 | *unchecked-math* :warn-on-boxed 38 | *print-length* 128} 39 | :dependencies [[midje "1.10.10"]] 40 | :jvm-opts ^:replace ["-Dclojure.compiler.direct-linking=true" 41 | "--add-opens=java.base/jdk.internal.ref=ALL-UNNAMED" 42 | "--add-opens=java.base/sun.nio.ch=ALL-UNNAMED"]}} 43 | 44 | :javac-options ["-target" "1.8" "-source" "1.8" "-Xlint:-options"] 45 | 46 | :source-paths ["src/clojure" "src/opencl"] 47 | :test-paths ["test/clojure" "test/opencl"] 48 | :java-source-paths ["src/java"]) 49 | -------------------------------------------------------------------------------- /src/clojure/uncomplicate/clojurecl/info.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | uncomplicate.clojurecl.info 11 | "Info functions for all OpenCL objects (platforms, devices, etc...). 12 | 13 | The OpenCL standard defines info functions for all cl structures. Typically 14 | in OpenCL C, you would have a reference to an object representing, for example, 15 | platform, and then call a dedicated info function, in this case 16 | [`clGetPlatformInfo`](http://www.jocl.org/doc/org/jocl/CL.html#clGetPlatformInfo-org.jocl.cl_platform_id-int-long-org.jocl.Pointer-long:A-) 17 | with a parameter param_name that specifies which of the several available 18 | informations you want about that object. If you need all information, then you 19 | need to call this function as many times as different kinds of information there is. 20 | 21 | ClojureCL provides many conveniences for obtaining information about cl objects: 22 | 23 | 1. **There is a universal, high-level, [[info]] function** that works for all kinds 24 | of cl objects (platform, context, device, memory, etc.) and displays all available 25 | information. This function also accepts a keyword argument for returning 26 | only a specific kind of information, not all information. The information 27 | will be converted from low-level C enums to a Clojre-friendly format that 28 | uses keywords, sequences, sets, etc. It will release all additional cl objects 29 | that it has to use to obtain information. If there is an OpenCL error in obtaining 30 | the information, which may happen if the driver does not support that kind of 31 | information, the [ExceptionInfo](http://clojuredocs.org/clojure.core/ex-info) 32 | will be returned as a result for that particular information, instead of 33 | raising an exception. This function is useful in when the information 34 | is going to be displayed to the user. 35 | 36 | 2. For each information kind, there is a dedicated, low-level, function that 37 | returns the raw, unconverted information. If the result is a cl object that 38 | needs to be released after use, it is the responsibility of the caller to 39 | call the [[core/release]] function. If the information is not supported, 40 | the exception is raised. These functions are convenient in the parts 41 | of the program where the returned info is used by other parts of the program, 42 | for example to calculate some parameters for an algorithm. 43 | 44 | 3. Some information is not only about the objects, for example program, but 45 | about the specific use of that object, for example a program build. In that 46 | case, aditional X-info function is provided, for example [[build-info]]. 47 | 48 | Most keywords in the [[info]] function are exactly the same as the corresponding 49 | low-level function name, except in a few cases where that would produce a clash 50 | with some other functionality. You can check the available keywords in 51 | the documentation of appropriate positional methods: 52 | [[->PlatformInfo]], [[->DeviceInfo]], [[->CommandQueueInfo]], [[->ContextInfo]], 53 | [[->KernelInfo]], [[->KernelArgInfo]], [[->ProgramInfo]], [[->ProgramBuildinfo]], 54 | [[->EventInfo]], [[->Profilinginfo]], [[->MemObjectInfo]], etc... 55 | 56 | ###Cheat Sheet 57 | 58 | #### Low-level info functions grouped by resource type: 59 | 60 | * [`cl_platform_id`](http://www.jocl.org/doc/org/jocl/cl_platform_id.html) info: 61 | [[version]], [[icd-suffix-khr]], [[profile]], [[name-info]], [[vendor]], 62 | [[extensions]] 63 | 64 | * [`cl_device_id`] (http://www.jocl.org/doc/org/jocl/cl_device_id.html) info: 65 | [[address-bits]], [[available]], [[built-in-kernels]], [[compiler-available]], 66 | [[double-fp-config]], [[endian-little]], [[error-correction-support]], 67 | [[execution-capabilities]], [[global-mem-cache-size]], [[global-=mem-cache-type]], 68 | [[global-mem-cacheline-size]], [[global-mem-size]], 69 | [[global-variable-preferred-total-size]], [[image2d-max-height]], 70 | [[image2d-max-width]], [[image3d-max-depth]], [[image3d-max-height]], 71 | [[image3d-max-width]], [[image-base-address-alignment]], [[image-max-array-size]], 72 | [[image-max-array-size]], [[image-max-buffer-size]], [[image-pitch-alignment]], 73 | [[image-support]], [[linker-available]], [[local-mem-size]], [[local-mem-type]], 74 | [[max-clock-frequency]], [[max-compute-units]], [[max-constant-args]], 75 | [[max-constant-buffer-size]], [[max-global-variable-size]], [[max-mem-aloc-size]], 76 | [[max-on-device-events]], [[max-on-device-queues]], [[max-parameter-size]], 77 | [[max-pipe-args]], [[max-read-image-args]], [[max-read-write-image-args]], 78 | [[max-samplers]], [[max-work-group-size]], [[max-work-item-dimensions]], 79 | [[max-work-item-sizes]], [[max-write-image-args]], [[mem-base-addr-align]], 80 | [[native-vector-width-char]], [[native-vector-width-short]], 81 | [[native-vector-width-int]], [[native-vector-width-long]], 82 | [[native-vector-width-float]], [[native-vector-width-double]], 83 | [[native-vector-width-half]], [[opencl-c-version]], [[parent-device]], 84 | [[partition-affinity-domain]], [[partition-max-sub-devices]], 85 | [[partition-properties]], [[partition-type]],[[pipe-max-active-reservations]], 86 | [[pipe-max-packet-size]], [[platform]], [[preferred-global-atomic-alignment]], 87 | [[preferred-interop-user-sync]], [[preferred-local-atomic-alignment]], 88 | [[preferred-platform-atomic-alignment]], [[preferred-vector-width-char]], 89 | [[preferred-vector-width-short]], [[preferred-vector-width-int]], 90 | [[preferred-vector-width-long]], [[preferred-vector-width-float]], 91 | [[preferred-vector-width-double]], [[preferred-vector-width-half]], 92 | [[printf-buffer-size]], [[profiling-timer-resolution]], [[queue-on-device-max-size]], 93 | [[queue-on-device-properties]], [[queue-on-host-properties]], 94 | [[single-fp-config]], [[spir-versions]], [[svm-capabilities]], 95 | [[device-type]], [[vendor-id]], [[device-version]], 96 | [[driver-version]], [[extensions]], [[name-info]], [[profile]], [[vendor]], 97 | [[reference-count]] 98 | 99 | * [`cl_context`] (http://www.jocl.org/doc/org/jocl/cl_context.html) info: 100 | [[num-devices-in-context]], [[devices-in-context]], [[properties]], 101 | [[reference-count]] 102 | 103 | * [`cl_command_queue`] (http://www.jocl.org/doc/org/jocl/cl_command_queue.html) info: 104 | [[queue-context]], [[queue-device]], [[queue-size]], [[properties]], 105 | [[reference-count]] 106 | 107 | * [`cl_event`] (http://www.jocl.org/doc/org/jocl/cl_event.html) info: 108 | [[event-command-queue]], [[event-context]], [[command-type]], [[execution-status]], 109 | [[reference-count]] 110 | 111 | * profiling event info: **[[profiling-info]]**, 112 | [[queued]], [[submit]], [[start]], [[end]] 113 | 114 | * [`cl_kernel`] (http://www.jocl.org/doc/org/jocl/cl_kernel.html) info: 115 | [[function-name]], [[num-args]], [[kernel-context]], [[kernel-program]], 116 | [[attributes]], [[reference-count]] 117 | 118 | * kernel argument info: **[[arg-info]]** 119 | [[arg-address-qualifier]], [[arg-access-qualifier]], [[arg-type-name]], 120 | [[arg-type-qualifier]], [[arg-name]] 121 | 122 | * [`cl_mem`] (http://www.jocl.org/doc/org/jocl/cl_mem.html) info: 123 | [[mem-type]], [[flags]], [[mem-size]], [[map-count]], [[mem-context]], 124 | [[associated-memobject]], [[offset]], [[uses-svm-pointer]], [[reference-count]] 125 | 126 | * [`cl_program`] (http://www.jocl.org/doc/org/jocl/cl_program.html) info: 127 | [[program-context]], [[program-num-devices]], [[program-devices]], 128 | [[program-source]], [[binary-sizes]], [[binaries]], [[program-num-kernels]], 129 | [[kernel-names]], [[reference-count]] 130 | 131 | * program build info: **[[build-info]]**, 132 | [[build-status]], [[build-options]], [[build-log]], [[binary-type]], 133 | [[global-variable-total-size]] 134 | 135 | #### Hihg-level info and keywords (in a few cases different than low-level function names) 136 | 137 | [[->PlatformInfo]], [[->DeviceInfo]], [[->CommandQueueInfo]], [[->ContextInfo]], 138 | [[->KernelInfo]], [[->KernelArgInfo]], [[->ProgramInfo]], [[->ProgramBuildinfo]], 139 | [[->EventInfo]], [[->Profilinginfo]], [[->MemObjectInfo]], 140 | " 141 | (:require [clojure.string :as str] 142 | [uncomplicate.commons 143 | [core :refer [Info info]] 144 | [utils :refer [unmask unmask1 direct-buffer]]] 145 | [uncomplicate.fluokitten.core :refer [fmap extract]] 146 | [uncomplicate.clojurecl.internal 147 | [constants :refer :all] 148 | [protocols :refer [wrap]] 149 | [utils :refer :all] 150 | [impl :refer :all]]) 151 | (:import [java.nio ByteBuffer IntBuffer LongBuffer] 152 | [org.jocl CL cl_platform_id cl_device_id cl_context cl_command_queue 153 | cl_program cl_kernel cl_sampler cl_event cl_device_partition_property 154 | cl_mem Sizeof Pointer] 155 | [uncomplicate.clojurecl.internal.impl CLDevice CLContext CLCommandQueue CLProgram 156 | CLKernel CLEvent CLBuffer])) 157 | 158 | (defn ^:private get-array [^ByteBuffer buf] 159 | (if (= Sizeof/size_t 8) 160 | (let [b (.asLongBuffer buf) 161 | res (long-array (.capacity b))] 162 | (.get b res) 163 | res) 164 | (let [b (.asIntBuffer buf) 165 | res (int-array (.capacity b))] 166 | (.get b res) 167 | res))) 168 | 169 | ;; =================== Info* utility macros =============================== 170 | 171 | (defmacro ^:private info-count* 172 | ([method clobject info sizeof] 173 | `(/ (info-count* ~method ~clobject ~info) ~sizeof)) 174 | ([method clobject info] 175 | `(long (let [res# (long-array 1) 176 | err# (~method ~clobject ~info 0 nil res#)] 177 | (with-check err# (aget res# 0)))))) 178 | 179 | (defmacro ^:private info-string* [method clobject info] 180 | `(let [size# (info-count* ~method ~clobject ~info) 181 | res# (byte-array size#) 182 | err# (~method ~clobject ~info (alength res#) (Pointer/to res#) nil)] 183 | (with-check err# (String. res# 0 (max 0 (dec size#)))))) 184 | 185 | (defn ^:private to-set [s] 186 | (if (str/blank? s) 187 | #{} 188 | (apply hash-set (str/split s #" ")))) 189 | 190 | (defn ^:private to-native-pointer [^"[Lorg.jocl.NativePointerObject;" np] 191 | (Pointer/to np)) 192 | 193 | (defmacro ^:private info-native* [method clobject info type size] 194 | `(let [bytesize# (info-count* ~method ~clobject ~info) 195 | res# (make-array ~type (/ bytesize# ~size)) 196 | err# (~method ~clobject ~info bytesize# (~to-native-pointer res#) nil)] 197 | (with-check err# res#))) 198 | 199 | (defn ^:private pointer-to-buffer [^ByteBuffer b] 200 | (Pointer/toBuffer b)) 201 | 202 | (defmacro ^:private info-size* 203 | ([method clobject info num] 204 | `(let [res# (direct-buffer (* Sizeof/size_t (long ~num))) 205 | err# (~method ~clobject ~info (* Sizeof/size_t (long ~num)) (~pointer-to-buffer res#) nil)] 206 | (with-check err# 207 | (vec (get-array res#))))) 208 | ([method clobject info] 209 | `(first (info-size* ~method ~clobject ~info 1)))) 210 | 211 | (defmacro ^:private info-long* 212 | ([method clobject info num] 213 | `(let [res# (long-array ~num) 214 | err# (~method ~clobject ~info (* Sizeof/cl_long (long ~num)) (Pointer/to res#) nil)] 215 | (with-check err# res#))) 216 | ([method clobject info] 217 | `(aget (longs (info-long* ~method ~clobject ~info 1)) 0))) 218 | 219 | (defmacro ^:private info-int* 220 | ([method clobject info num] 221 | `(let [res# (int-array ~num) 222 | err# (~method ~clobject ~info (* Sizeof/cl_int (long ~num)) (Pointer/to res#) nil)] 223 | (with-check err# res#))) 224 | ([method clobject info] 225 | `(aget (ints (info-int* ~method ~clobject ~info 1)) 0))) 226 | 227 | (defmacro ^:private info-bool* [method clobject info] 228 | `(not= 0 (info-int* ~method ~clobject ~info))) 229 | 230 | ;; =================== Protocols ================================== 231 | 232 | (defprotocol InfoExtensions 233 | (extensions [this])) 234 | 235 | (defprotocol InfoName 236 | (name-info [this])) 237 | 238 | (defprotocol InfoProfile 239 | (profile [this])) 240 | 241 | (defprotocol InfoVendor 242 | (vendor [this])) 243 | 244 | (defprotocol InfoReferenceCount 245 | (reference-count [this])) 246 | 247 | (defprotocol InfoProperties 248 | (properties [this])) 249 | 250 | ;; =================== Platform =================================== 251 | 252 | (defn version [platform] 253 | (info-string* CL/clGetPlatformInfo platform CL/CL_PLATFORM_VERSION)) 254 | 255 | (defn icd-suffix-khr [platform] 256 | (info-string* CL/clGetPlatformInfo platform CL/CL_PLATFORM_ICD_SUFFIX_KHR)) 257 | 258 | (defrecord PlatformInfo [profile version name vendor extensions icd-suffix-khr]) 259 | 260 | (extend-type cl_platform_id 261 | Info 262 | (info 263 | ([p info-type] 264 | (maybe 265 | (case info-type 266 | :profile (profile p) 267 | :version (version p) 268 | :name (name-info p) 269 | :vendor (vendor p) 270 | :extensions (extensions p) 271 | :icd-suffix-khr (icd-suffix-khr p) 272 | nil))) 273 | ([p] 274 | (->PlatformInfo (maybe (profile p)) 275 | (maybe (version p)) 276 | (maybe (name-info p)) 277 | (maybe (vendor p)) 278 | (maybe (extensions p)) 279 | (maybe (icd-suffix-khr p))))) 280 | InfoExtensions 281 | (extensions [p] 282 | (to-set (info-string* CL/clGetPlatformInfo p CL/CL_PLATFORM_EXTENSIONS))) 283 | InfoName 284 | (name-info [p] 285 | (info-string* CL/clGetPlatformInfo p CL/CL_PLATFORM_NAME)) 286 | InfoProfile 287 | (profile [p] 288 | (info-string* CL/clGetPlatformInfo p CL/CL_PLATFORM_PROFILE)) 289 | InfoVendor 290 | (vendor [p] 291 | (info-string* CL/clGetPlatformInfo p CL/CL_PLATFORM_VENDOR))) 292 | 293 | ;; =================== Device ============================================== 294 | 295 | (defn address-bits ^long [device] 296 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_ADDRESS_BITS)) 297 | 298 | (defn available [device] 299 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_AVAILABLE)) 300 | 301 | (defn built-in-kernels [device] 302 | (to-set (info-string* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_BUILT_IN_KERNELS))) 303 | 304 | (defn compiler-available [device] 305 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_COMPILER_AVAILABLE)) 306 | 307 | (defn double-fp-config ^long [device] 308 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_DOUBLE_FP_CONFIG)) 309 | 310 | (defn endian-little [device] 311 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_ENDIAN_LITTLE)) 312 | 313 | (defn error-correction-support [device] 314 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_ERROR_CORRECTION_SUPPORT)) 315 | 316 | (defn execution-capabilities ^long [device] 317 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_EXECUTION_CAPABILITIES)) 318 | 319 | (defn global-mem-cache-size ^long [device] 320 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_GLOBAL_MEM_CACHE_SIZE)) 321 | 322 | (defn global-mem-cache-type ^long [device] 323 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_GLOBAL_MEM_CACHE_TYPE)) 324 | 325 | (defn global-mem-cacheline-size ^long [device] 326 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE)) 327 | 328 | (defn global-mem-size ^long [device] 329 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_GLOBAL_MEM_SIZE)) 330 | 331 | (defn global-variable-preferred-total-size ^long [device] 332 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_GLOBAL_VARIABLE_PREFERRED_TOTAL_SIZE)) 333 | 334 | (defn image2d-max-height ^long [device] 335 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE2D_MAX_HEIGHT)) 336 | 337 | (defn image2d-max-width ^long [device] 338 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE2D_MAX_WIDTH)) 339 | 340 | (defn image3d-max-depth ^long [device] 341 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE3D_MAX_DEPTH)) 342 | 343 | (defn image3d-max-height ^long [device] 344 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE3D_MAX_HEIGHT)) 345 | 346 | (defn image3d-max-width ^long [device] 347 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE3D_MAX_WIDTH)) 348 | 349 | (defn image-base-address-alignment ^long [device] 350 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE_BASE_ADDRESS_ALIGNMENT)) 351 | 352 | (defn image-max-array-size ^long [device] 353 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE_MAX_ARRAY_SIZE)) 354 | 355 | (defn image-max-buffer-size ^long [device] 356 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE_MAX_BUFFER_SIZE)) 357 | 358 | (defn image-pitch-alignment ^long [device] 359 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE_PITCH_ALIGNMENT)) 360 | 361 | (defn image-support [device] 362 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_IMAGE_SUPPORT)) 363 | 364 | (defn linker-available [device] 365 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_LINKER_AVAILABLE)) 366 | 367 | (defn local-mem-size ^long [device] 368 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_LOCAL_MEM_SIZE)) 369 | 370 | (defn local-mem-type ^long [device] 371 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_LOCAL_MEM_TYPE)) 372 | 373 | (defn max-clock-frequency ^long [device] 374 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_CLOCK_FREQUENCY)) 375 | 376 | (defn max-compute-units ^long [device] 377 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_COMPUTE_UNITS)) 378 | 379 | (defn max-constant-args ^long [device] 380 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_CONSTANT_ARGS)) 381 | 382 | (defn max-constant-buffer-size ^long [device] 383 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE)) 384 | 385 | (defn max-global-variable-size ^long [device] 386 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_GLOBAL_VARIABLE_SIZE)) 387 | 388 | (defn max-mem-aloc-size ^long [device] 389 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_MEM_ALLOC_SIZE)) 390 | 391 | (defn max-on-device-events ^long [device] 392 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_ON_DEVICE_EVENTS)) 393 | 394 | (defn max-on-device-queues ^long [device] 395 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_ON_DEVICE_QUEUES)) 396 | 397 | (defn max-parameter-size ^long [device] 398 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_PARAMETER_SIZE)) 399 | 400 | (defn max-pipe-args ^long [device] 401 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_PIPE_ARGS)) 402 | 403 | (defn max-read-image-args ^long [device] 404 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_READ_IMAGE_ARGS)) 405 | 406 | (defn max-read-write-image-args ^long [device] 407 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_READ_WRITE_IMAGE_ARGS)) 408 | 409 | (defn max-samplers ^long [device] 410 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_SAMPLERS)) 411 | 412 | (defn max-work-group-size ^long [device] 413 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_WORK_GROUP_SIZE)) 414 | 415 | (defn max-work-item-dimensions ^long [device] 416 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS)) 417 | 418 | (defn max-work-item-sizes [device] 419 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_WORK_ITEM_SIZES 420 | (max-work-item-dimensions device))) 421 | 422 | (defn max-write-image-args ^long [device] 423 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MAX_WRITE_IMAGE_ARGS)) 424 | 425 | (defn mem-base-addr-align ^long [device] 426 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_MEM_BASE_ADDR_ALIGN)) 427 | 428 | (defn native-vector-width-char ^long [device] 429 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_CHAR)) 430 | 431 | (defn native-vector-width-short ^long [device] 432 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_SHORT)) 433 | 434 | (defn native-vector-width-int ^long [device] 435 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_INT)) 436 | 437 | (defn native-vector-width-long ^long [device] 438 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_LONG)) 439 | 440 | (defn native-vector-width-float ^long [device] 441 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_FLOAT)) 442 | 443 | (defn native-vector-width-double ^long [device] 444 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_DOUBLE)) 445 | 446 | (defn native-vector-width-half ^long [device] 447 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_NATIVE_VECTOR_WIDTH_HALF)) 448 | 449 | (defn opencl-c-version [device] 450 | (let [info (str/split (info-string* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_OPENCL_C_VERSION) 451 | #" ")] 452 | {:version (Double/parseDouble (get info 2 0)) 453 | :vendor-specific-info (get info 3)})) 454 | 455 | (defn parent-device [device] 456 | (let [device (extract device) 457 | id (info-long* CL/clGetDeviceInfo device CL/CL_DEVICE_PARENT_DEVICE)] 458 | (if (= 0 id) 459 | nil 460 | (let [parent (cl_device_id.) 461 | err (CL/clGetDeviceInfo device CL/CL_DEVICE_PARENT_DEVICE Sizeof/cl_device_id 462 | (Pointer/to parent) nil)] 463 | (with-check err (wrap parent)))))) 464 | 465 | (defn partition-affinity-domain ^long [device] 466 | (info-long* CL/clGetDeviceInfo (extract device) 467 | CL/CL_DEVICE_PARTITION_AFFINITY_DOMAIN)) 468 | 469 | (defn partition-max-sub-devices ^long [device] 470 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PARTITION_MAX_SUB_DEVICES)) 471 | 472 | (defn partition-properties [device] 473 | (let [device (extract device)] 474 | (info-long* CL/clGetDeviceInfo device CL/CL_DEVICE_PARTITION_PROPERTIES 475 | (info-count* CL/clGetDeviceInfo device CL/CL_DEVICE_PARTITION_PROPERTIES 476 | Sizeof/cl_long)))) 477 | 478 | ;;TODO 479 | (defn partition-type [device] 480 | (let [device (extract device)] 481 | (info-long* CL/clGetDeviceInfo device CL/CL_DEVICE_PARTITION_TYPE 482 | (info-count* CL/clGetDeviceInfo device CL/CL_DEVICE_PARTITION_TYPE Sizeof/cl_long))) ) 483 | 484 | (defn pipe-max-active-reservations ^long [device] 485 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PIPE_MAX_ACTIVE_RESERVATIONS)) 486 | 487 | (defn pipe-max-packet-size ^long [device] 488 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PIPE_MAX_PACKET_SIZE)) 489 | 490 | (defn platform [device] 491 | (let [p (cl_platform_id.) 492 | err (CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PLATFORM Sizeof/cl_platform_id 493 | (Pointer/to p) nil)] 494 | (with-check err p))) 495 | 496 | (defn preferred-global-atomic-alignment ^long [device] 497 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_GLOBAL_ATOMIC_ALIGNMENT)) 498 | 499 | (defn preferred-interop-user-sync [device] 500 | (info-bool* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_INTEROP_USER_SYNC)) 501 | 502 | (defn preferred-local-atomic-alignment ^long [device] 503 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_LOCAL_ATOMIC_ALIGNMENT)) 504 | 505 | (defn preferred-platform-atomic-alignment ^long [device] 506 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_PLATFORM_ATOMIC_ALIGNMENT)) 507 | 508 | (defn preferred-vector-width-char ^long [device] 509 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR)) 510 | 511 | (defn preferred-vector-width-short ^long [device] 512 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT)) 513 | 514 | (defn preferred-vector-width-int ^long [device] 515 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT)) 516 | 517 | (defn preferred-vector-width-long ^long [device] 518 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG)) 519 | 520 | (defn preferred-vector-width-float ^long [device] 521 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT)) 522 | 523 | (defn preferred-vector-width-double ^long [device] 524 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE)) 525 | 526 | (defn preferred-vector-width-half ^long [device] 527 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PREFERRED_VECTOR_WIDTH_HALF)) 528 | 529 | (defn printf-buffer-size ^long [device] 530 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PRINTF_BUFFER_SIZE)) 531 | 532 | (defn profiling-timer-resolution ^long [device] 533 | (info-size* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_PROFILING_TIMER_RESOLUTION)) 534 | 535 | (defn queue-on-device-max-size ^long [device] 536 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_QUEUE_ON_DEVICE_MAX_SIZE)) 537 | 538 | (defn queue-on-device-preferred-size ^long [device] 539 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_QUEUE_ON_DEVICE_PREFERRED_SIZE)) 540 | 541 | (defn queue-on-device-properties ^long [device] 542 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_QUEUE_ON_DEVICE_PROPERTIES)) 543 | 544 | (defn queue-on-host-properties ^long [device] 545 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_QUEUE_ON_HOST_PROPERTIES)) 546 | 547 | (defn single-fp-config ^long [device] 548 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_SINGLE_FP_CONFIG)) 549 | 550 | (defn spir-versions [device] 551 | (apply hash-set 552 | (map #(if (clojure.string/blank? %) 0 (Double/parseDouble %)) 553 | (str/split (info-string* CL/clGetDeviceInfo (extract device) CL_DEVICE_SPIR_VERSIONS) 554 | #" ")))) 555 | 556 | (defn svm-capabilities ^long [device] 557 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_SVM_CAPABILITIES)) 558 | 559 | (defn device-type ^long [device] 560 | (info-long* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_TYPE)) 561 | 562 | (defn vendor-id ^long [device] 563 | (info-int* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_VENDOR_ID)) 564 | 565 | (defn device-version [device] 566 | (info-string* CL/clGetDeviceInfo (extract device) CL/CL_DEVICE_VERSION)) 567 | 568 | (defn driver-version [device] 569 | (info-string* CL/clGetDeviceInfo (extract device) CL/CL_DRIVER_VERSION)) 570 | 571 | (defrecord DeviceInfo [address-bits 572 | available 573 | built-in-kernels 574 | compiler-available 575 | double-fp-config 576 | endian-little 577 | error-correction-support 578 | execution-capabilities 579 | extensions 580 | global-mem-cache-size 581 | global-mem-cache-type 582 | global-mem-cacheline-size 583 | global-mem-size 584 | global-variable-preferred-total-size 585 | image2d-max-height 586 | image2d-max-width 587 | image3d-max-depth 588 | image3d-max-height 589 | image3d-max-width 590 | image-base-address-alignment 591 | image-max-array-size 592 | image-max-buffer-size 593 | image-pitch-alignment 594 | image-support 595 | linker-available 596 | local-mem-size 597 | local-mem-type 598 | max-clock-frequency 599 | max-compute-units 600 | max-constant-args 601 | max-constant-buffer-size 602 | max-global-variable-size 603 | max-mem-aloc-size 604 | max-on-device-events 605 | max-on-device-queues 606 | max-parameter-size 607 | max-pipe-args 608 | max-read-image-args 609 | max-read-write-image-args 610 | max-samplers 611 | max-work-group-size 612 | max-work-item-dimensions 613 | max-work-item-sizes 614 | max-write-image-args 615 | mem-base-addr-align 616 | name 617 | native-vector-width-char 618 | native-vector-width-short 619 | native-vector-width-int 620 | native-vector-width-long 621 | native-vector-width-double 622 | native-vector-width-float 623 | native-vector-width-half 624 | opencl-c-version 625 | parent-device 626 | partition-affinity-domain 627 | partition-max-sub-devices 628 | partition-properties 629 | partition-type 630 | pipe-max-active-reservations 631 | pipe-max-packet-size 632 | platform 633 | preferred-global-atomic-alignment 634 | preferred-interop-user-sync 635 | preferred-local-atomic-alignment 636 | preferred-platform-atomic-alignment 637 | preferred-vector-width-char 638 | preferred-vector-width-short 639 | preferred-vector-width-int 640 | preferred-vector-width-long 641 | preferred-vector-width-double 642 | preferred-vector-width-float 643 | preferred-vector-width-half 644 | printf-buffer-size 645 | profile 646 | profiling-timer-resolution 647 | queue-on-device-max-size 648 | queue-on-device-preferred-size 649 | queue-on-device-properties 650 | queue-on-host-properties 651 | reference-count 652 | single-fp-config 653 | spir-versions 654 | svm-capabilities 655 | device-type 656 | vendor 657 | vendor-id 658 | device-version 659 | driver-version]) 660 | 661 | (extend-type CLDevice 662 | Info 663 | (info 664 | ([d info-type] 665 | (maybe 666 | (case info-type 667 | :address-bits (address-bits d) 668 | :available (available d) 669 | :built-in-kernels (built-in-kernels d) 670 | :compiler-available (compiler-available d) 671 | :double-fp-config (set (unmask cl-device-fp-config (double-fp-config d))) 672 | :endian-little (endian-little d) 673 | :error-correction-support (error-correction-support d) 674 | :execution-capabilities (set (unmask cl-device-exec-capabilities (execution-capabilities d))) 675 | :extensions (extensions d) 676 | :global-mem-cache-size (global-mem-cache-size d) 677 | :global-mem-cache-type (unmask1 cl-device-mem-cache-type (global-mem-cache-type d)) 678 | :global-mem-cacheline-size (global-mem-cacheline-size d) 679 | :global-mem-size (global-mem-size d) 680 | :global-variable-preferred-total-size (global-variable-preferred-total-size d) 681 | :image2d-max-height (image2d-max-height d) 682 | :image2d-max-width (image2d-max-width d) 683 | :image3d-max-depth (image3d-max-depth d) 684 | :image3d-max-height (image3d-max-height d) 685 | :image3d-max-width (image3d-max-width d) 686 | :image-base-address-alignment (image-base-address-alignment d) 687 | :image-max-array-size (image-max-array-size d) 688 | :image-max-buffer-size (image-max-buffer-size d) 689 | :image-pitch-alignment (image-pitch-alignment d) 690 | :image-support (image-support d) 691 | :linker-available (linker-available d) 692 | :local-mem-size (local-mem-size d) 693 | :local-mem-type (unmask1 cl-local-mem-type (local-mem-type d)) 694 | :max-clock-frequency (max-clock-frequency d) 695 | :max-compute-units (max-compute-units d) 696 | :max-constant-args (max-constant-args d) 697 | :max-constant-buffer-size (max-constant-buffer-size d) 698 | :max-global-variable-size (max-global-variable-size d) 699 | :max-mem-alloc-size (max-mem-aloc-size d) 700 | :max-on-device-events (max-on-device-events d) 701 | :max-parameter-queues (max-on-device-queues d) 702 | :max-parameter-size (max-parameter-size d) 703 | :max-pipe-args (max-pipe-args d) 704 | :max-read-image-args (max-read-image-args d) 705 | :max-read-write-image-args (max-read-write-image-args d) 706 | :max-samplers (max-samplers d) 707 | :max-work-group-size (max-work-group-size d) 708 | :max-work-item-dimensions (max-work-item-dimensions d) 709 | :max-work-item-sizes (max-work-item-sizes d) 710 | :max-write-image-args (max-write-image-args d) 711 | :mem-base-addr-align (mem-base-addr-align d) 712 | :name (name-info d) 713 | :native-vector-width-char (native-vector-width-char d) 714 | :native-vector-width-short (native-vector-width-short d) 715 | :native-vector-width-int (native-vector-width-int d) 716 | :native-vector-width-long (native-vector-width-long d) 717 | :native-vector-width-double (native-vector-width-double d) 718 | :native-vector-width-float (native-vector-width-float d) 719 | :native-vector-width-half (native-vector-width-half d) 720 | :opencl-c-version (opencl-c-version d) 721 | :parent-device (if-let [pd (parent-device d)] (name-info pd) nil) 722 | :partition-affinity-domain (set (unmask cl-device-affinity-domain (partition-affinity-domain d))) 723 | :partition-max-sub-devices (partition-max-sub-devices d) 724 | :partition-properties (map dec-device-partition-property (partition-properties d)) 725 | :partition-type (map dec-device-partition-property (partition-type d)) 726 | :pipe-max-active-reservations (pipe-max-active-reservations d) 727 | :pipe-max-packet-size (pipe-max-packet-size d) 728 | :platform (platform d) 729 | :preferred-global-atomic-alignment (preferred-global-atomic-alignment d) 730 | :preferred-interop-user-sync (preferred-interop-user-sync d) 731 | :preferred-local-atomic-alignment (preferred-local-atomic-alignment d) 732 | :preferred-platform-atomic-alignment (preferred-platform-atomic-alignment d) 733 | :preferred-vector-width-char (preferred-vector-width-char d) 734 | :preferred-vector-width-short (preferred-vector-width-short d) 735 | :preferred-vector-width-int (preferred-vector-width-int d) 736 | :preferred-vector-width-long (preferred-vector-width-long d) 737 | :preferred-vector-width-double (preferred-vector-width-double d) 738 | :preferred-vector-width-float (preferred-vector-width-float d) 739 | :preferred-vector-width-half (preferred-vector-width-half d) 740 | :printf-buffer-size (printf-buffer-size d) 741 | :profile (profile d) 742 | :profiling-timer-resolution (profiling-timer-resolution d) 743 | :queue-on-device-max-size (queue-on-device-max-size d) 744 | :queue-on-device-preferred-size (queue-on-device-preferred-size d) 745 | :queue-on-device-properties (set (unmask cl-command-queue-properties (queue-on-device-properties d))) 746 | :queue-on-host-properties (set (unmask cl-command-queue-properties (queue-on-host-properties d))) 747 | :reference-count (reference-count d) 748 | :single-fp-config (set (unmask cl-device-fp-config (single-fp-config d))) 749 | :spir-versions (spir-versions d) 750 | :svm-capabilities (set (unmask cl-device-svm-capabilities (svm-capabilities d))) 751 | :device-type (unmask1 cl-device-type (device-type d)) 752 | :vendor (vendor d) 753 | :vendor-id (vendor-id d) 754 | :device-version (device-version d) 755 | :driver-version (driver-version d) 756 | nil))) 757 | ([d] 758 | (->DeviceInfo 759 | (maybe (address-bits d)) 760 | (maybe (available d)) 761 | (maybe (built-in-kernels d)) 762 | (maybe (compiler-available d)) 763 | (maybe (set (unmask cl-device-fp-config (double-fp-config d)))) 764 | (maybe (endian-little d)) 765 | (maybe (error-correction-support d)) 766 | (maybe (set (unmask cl-device-exec-capabilities (execution-capabilities d)))) 767 | (maybe (extensions d)) 768 | (maybe (global-mem-cache-size d)) 769 | (maybe (unmask1 cl-device-mem-cache-type (global-mem-cache-type d))) 770 | (maybe (global-mem-cacheline-size d)) 771 | (maybe (global-mem-size d)) 772 | (maybe (global-variable-preferred-total-size d)) 773 | (maybe (image2d-max-height d)) 774 | (maybe (image2d-max-width d)) 775 | (maybe (image3d-max-depth d)) 776 | (maybe (image3d-max-height d)) 777 | (maybe (image3d-max-width d)) 778 | (maybe (image-base-address-alignment d)) 779 | (maybe (image-max-array-size d)) 780 | (maybe (image-max-buffer-size d)) 781 | (maybe (image-pitch-alignment d)) 782 | (maybe (image-support d)) 783 | (maybe (linker-available d)) 784 | (maybe (local-mem-size d)) 785 | (maybe (unmask1 cl-local-mem-type (local-mem-type d))) 786 | (maybe (max-clock-frequency d)) 787 | (maybe (max-compute-units d)) 788 | (maybe (max-constant-args d)) 789 | (maybe (max-constant-buffer-size d)) 790 | (maybe (max-global-variable-size d)) 791 | (maybe (max-mem-aloc-size d)) 792 | (maybe (max-on-device-events d)) 793 | (maybe (max-on-device-queues d)) 794 | (maybe (max-parameter-size d)) 795 | (maybe (max-pipe-args d)) 796 | (maybe (max-read-image-args d)) 797 | (maybe (max-read-write-image-args d)) 798 | (maybe (max-samplers d)) 799 | (maybe (max-work-group-size d)) 800 | (maybe (max-work-item-dimensions d)) 801 | (maybe (max-work-item-sizes d)) 802 | (maybe (max-write-image-args d)) 803 | (maybe (mem-base-addr-align d)) 804 | (maybe (name-info d)) 805 | (maybe (native-vector-width-char d)) 806 | (maybe (native-vector-width-short d)) 807 | (maybe (native-vector-width-int d)) 808 | (maybe (native-vector-width-long d)) 809 | (maybe (native-vector-width-double d)) 810 | (maybe (native-vector-width-float d)) 811 | (maybe (native-vector-width-half d)) 812 | (maybe (opencl-c-version d)) 813 | (maybe (if-let [pd (parent-device d)] (name-info pd) nil)) 814 | (maybe (set (unmask cl-device-affinity-domain (partition-affinity-domain d)))) 815 | (maybe (partition-max-sub-devices d)) 816 | (maybe (map dec-device-partition-property (partition-properties d))) 817 | (maybe (map dec-device-partition-property (partition-type d))) 818 | (maybe (pipe-max-active-reservations d)) 819 | (maybe (pipe-max-packet-size d)) 820 | (maybe (platform d)) 821 | (maybe (preferred-global-atomic-alignment d)) 822 | (maybe (preferred-interop-user-sync d)) 823 | (maybe (preferred-local-atomic-alignment d)) 824 | (maybe (preferred-platform-atomic-alignment d)) 825 | (maybe (preferred-vector-width-char d)) 826 | (maybe (preferred-vector-width-short d)) 827 | (maybe (preferred-vector-width-int d)) 828 | (maybe (preferred-vector-width-long d)) 829 | (maybe (preferred-vector-width-double d)) 830 | (maybe (preferred-vector-width-float d)) 831 | (maybe (preferred-vector-width-half d)) 832 | (maybe (printf-buffer-size d)) 833 | (maybe (profile d)) 834 | (maybe (profiling-timer-resolution d)) 835 | (maybe (queue-on-device-max-size d)) 836 | (maybe (queue-on-device-preferred-size d)) 837 | (maybe (set (unmask cl-command-queue-properties (queue-on-device-properties d)))) 838 | (maybe (set (unmask cl-command-queue-properties (queue-on-host-properties d)))) 839 | (maybe (reference-count d)) 840 | (maybe (set (unmask cl-device-fp-config (single-fp-config d)))) 841 | (maybe (spir-versions d)) 842 | (maybe (set (unmask cl-device-svm-capabilities (svm-capabilities d)))) 843 | (maybe (unmask1 cl-device-type (device-type d))) 844 | (maybe (vendor d)) 845 | (maybe (vendor-id d)) 846 | (maybe (device-version d)) 847 | (maybe (driver-version d))))) 848 | InfoExtensions 849 | (extensions [d] 850 | (to-set (info-string* CL/clGetDeviceInfo (extract d) CL/CL_DEVICE_EXTENSIONS))) 851 | InfoName 852 | (name-info [d] 853 | (info-string* CL/clGetDeviceInfo (extract d) CL/CL_DEVICE_NAME)) 854 | InfoProfile 855 | (profile [d] 856 | (info-string* CL/clGetDeviceInfo (extract d) CL/CL_DEVICE_PROFILE)) 857 | InfoVendor 858 | (vendor [d] 859 | (info-string* CL/clGetDeviceInfo (extract d) CL/CL_DEVICE_VENDOR)) 860 | InfoReferenceCount 861 | (reference-count [d] 862 | (info-int* CL/clGetDeviceInfo (extract d) CL/CL_DEVICE_REFERENCE_COUNT))) 863 | 864 | ;; =================== Context ============================================= 865 | 866 | (defn num-devices-in-context ^long [context] 867 | (info-int* CL/clGetContextInfo (extract context) CL/CL_CONTEXT_NUM_DEVICES)) 868 | 869 | (defn devices-in-context [context] 870 | (fmap wrap (vec (info-native* CL/clGetContextInfo (extract context) CL/CL_CONTEXT_DEVICES 871 | cl_device_id Sizeof/cl_device_id)))) 872 | 873 | (defrecord ContextInfo [num-devices reference-count devices properties]) 874 | 875 | (extend-type CLContext 876 | Info 877 | (info 878 | ([c info-type] 879 | (maybe 880 | (case info-type 881 | :num-devices (num-devices-in-context c) 882 | :reference-count (reference-count c) 883 | :devices (fmap name-info (devices-in-context c)) 884 | :properties (map dec-context-properties (remove zero? (properties c))) 885 | nil))) 886 | ([c] 887 | (->ContextInfo (maybe (num-devices-in-context c)) 888 | (maybe (reference-count c)) 889 | (maybe (fmap name-info (devices-in-context c))) 890 | (maybe (map dec-context-properties (remove zero? (properties c))))))) 891 | InfoProperties 892 | (properties [c] 893 | (info-long* CL/clGetContextInfo (extract c) CL/CL_CONTEXT_PROPERTIES 894 | (info-count* CL/clGetContextInfo (extract c) CL/CL_CONTEXT_PROPERTIES Sizeof/cl_long))) 895 | InfoReferenceCount 896 | (reference-count [c] 897 | (info-int* CL/clGetContextInfo (extract c) CL/CL_CONTEXT_REFERENCE_COUNT))) 898 | 899 | ;; =================== Command Queue ======================================= 900 | 901 | (defn queue-context [queue] 902 | (let [c (cl_context.) 903 | err (CL/clGetCommandQueueInfo (extract queue) CL/CL_QUEUE_CONTEXT Sizeof/cl_context 904 | (Pointer/to c) nil)] 905 | (with-check err (wrap c)))) 906 | 907 | (defn queue-device [queue] 908 | (let [d (cl_device_id.) 909 | err (CL/clGetCommandQueueInfo (extract queue) CL/CL_QUEUE_DEVICE Sizeof/cl_device_id 910 | (Pointer/to d) nil)] 911 | (with-check err (wrap d)))) 912 | 913 | (defn queue-size ^long [queue] 914 | (info-int* CL/clGetCommandQueueInfo (extract queue) CL/CL_QUEUE_SIZE)) 915 | 916 | (defrecord CommandQueueInfo [context device reference-count properties size]) 917 | 918 | (extend-type CLCommandQueue 919 | Info 920 | (info 921 | ([cq info-type] 922 | (maybe 923 | (case info-type 924 | :context (str (queue-context cq)) 925 | :device (name-info (queue-device cq)) 926 | :reference-count (reference-count cq) 927 | :properties (set (unmask cl-command-queue-properties (properties cq))) 928 | :size (queue-size cq) 929 | nil))) 930 | ([cq] 931 | (->CommandQueueInfo (maybe (str (queue-context cq))) 932 | (maybe (name-info (queue-device cq))) 933 | (maybe (reference-count cq)) 934 | (maybe (set (unmask cl-command-queue-properties (properties cq)))) 935 | (maybe (queue-size cq))))) 936 | InfoReferenceCount 937 | (reference-count [cq] 938 | (info-int* CL/clGetCommandQueueInfo (extract cq) CL/CL_QUEUE_REFERENCE_COUNT)) 939 | InfoProperties 940 | (properties [cq] 941 | (info-long* CL/clGetCommandQueueInfo (extract cq) CL/CL_QUEUE_PROPERTIES))) 942 | 943 | ;; =================== Event =============================================== 944 | 945 | (defn event-command-queue [event] 946 | (let [cq (cl_command_queue.) 947 | err (CL/clGetEventInfo (extract event) CL/CL_EVENT_COMMAND_QUEUE Sizeof/cl_command_queue 948 | (Pointer/to cq) nil)] 949 | (with-check err (wrap cq)))) 950 | 951 | (defn event-context [event] 952 | (let [c (cl_context.) 953 | err (CL/clGetEventInfo (extract event) CL/CL_EVENT_CONTEXT Sizeof/cl_context (Pointer/to c) nil)] 954 | (with-check err (wrap c)))) 955 | 956 | (defn command-type [event] 957 | (info-int* CL/clGetEventInfo (extract event) CL/CL_EVENT_COMMAND_TYPE)) 958 | 959 | (defn execution-status [event] 960 | (info-int* CL/clGetEventInfo (extract event) CL/CL_EVENT_COMMAND_EXECUTION_STATUS)) 961 | 962 | (defrecord EventInfo [command-queue context command-type execution-status reference-count]) 963 | 964 | (extend-type CLEvent 965 | Info 966 | (info 967 | ([e info-type] 968 | (maybe 969 | (case info-type 970 | :command-queue (str (event-command-queue e)) 971 | :context (str (event-context e)) 972 | :command-type (dec-command-type (command-type e)) 973 | :execution-status (dec-command-execution-status (execution-status e)) 974 | :reference-count (reference-count e) 975 | nil))) 976 | ([e] 977 | (->EventInfo (maybe (str (event-command-queue e))) 978 | (maybe (str (event-context e))) 979 | (maybe (dec-command-type (command-type e))) 980 | (maybe (dec-command-execution-status (execution-status e))) 981 | (maybe (reference-count e))))) 982 | InfoReferenceCount 983 | (reference-count [e] 984 | (info-int* CL/clGetEventInfo (extract e) CL/CL_EVENT_REFERENCE_COUNT))) 985 | 986 | ;; =================== Event Profiling ===================================== 987 | 988 | (defn queued ^long [event] 989 | (info-long* CL/clGetEventProfilingInfo (extract event) CL/CL_PROFILING_COMMAND_QUEUED)) 990 | 991 | (defn submit ^long [event] 992 | (info-long* CL/clGetEventProfilingInfo (extract event) CL/CL_PROFILING_COMMAND_SUBMIT)) 993 | 994 | (defn start ^long [event] 995 | (info-long* CL/clGetEventProfilingInfo (extract event) CL/CL_PROFILING_COMMAND_START)) 996 | 997 | (defn end ^long [event] 998 | (info-long* CL/clGetEventProfilingInfo (extract event) CL/CL_PROFILING_COMMAND_END)) 999 | 1000 | (defrecord ProfilingInfo [^long queued ^long submit ^long start ^long end]) 1001 | 1002 | (defn profiling-info 1003 | (^long [event info] 1004 | (case info 1005 | :queued (queued event) 1006 | :submit (submit event) 1007 | :start (start event) 1008 | :end (end event) 1009 | nil)) 1010 | 1011 | ([event] 1012 | (->ProfilingInfo (queued event) (submit event) (start event) (end event)))) 1013 | 1014 | (defn durations [^ProfilingInfo pi] 1015 | (->ProfilingInfo 0 1016 | (- (.submit pi) (.queued pi)) 1017 | (- (.start pi) (.submit pi)) 1018 | (- (.end pi) (.start pi)))) 1019 | 1020 | ;; ===================== Image ================================================ 1021 | 1022 | ;; TODO 1023 | 1024 | ;; ===================== Kernel =============================================== 1025 | 1026 | (defn function-name [kernel] 1027 | (info-string* CL/clGetKernelInfo (extract kernel) CL/CL_KERNEL_FUNCTION_NAME)) 1028 | 1029 | (defn num-args ^long [kernel] 1030 | (info-int* CL/clGetKernelInfo (extract kernel) CL/CL_KERNEL_NUM_ARGS)) 1031 | 1032 | (defn kernel-context [kernel] 1033 | (let [c (cl_context.) 1034 | err (CL/clGetKernelInfo (extract kernel) CL/CL_KERNEL_CONTEXT Sizeof/cl_context (Pointer/to c) nil)] 1035 | (with-check err (wrap c)))) 1036 | 1037 | (defn kernel-program [kernel] 1038 | (let [p (cl_program.) 1039 | err (CL/clGetKernelInfo (extract kernel) CL/CL_KERNEL_PROGRAM Sizeof/cl_program (Pointer/to p) nil)] 1040 | (with-check err (wrap p)))) 1041 | 1042 | (defn attributes [kernel] 1043 | (to-set (info-string* CL/clGetKernelInfo (extract kernel) CL/CL_KERNEL_ATTRIBUTES))) 1044 | 1045 | (defrecord KernelInfo [function-name num-args reference-count context program attributes]) 1046 | 1047 | (extend-type CLKernel 1048 | Info 1049 | (info 1050 | ([k info-type] 1051 | (maybe 1052 | (case info-type 1053 | :function-name (function-name k) 1054 | :num-args (num-args k) 1055 | :reference-count (reference-count k) 1056 | :context (str (kernel-context k)) 1057 | :program (str (kernel-program k)) 1058 | :attributes (attributes k) 1059 | nil))) 1060 | ([k] 1061 | (->KernelInfo (maybe (function-name k)) 1062 | (maybe (num-args k)) 1063 | (maybe (reference-count k)) 1064 | (maybe (str (kernel-context k))) 1065 | (maybe (str (kernel-program k))) 1066 | (maybe (attributes k))))) 1067 | InfoReferenceCount 1068 | (reference-count [k] 1069 | (info-int* CL/clGetKernelInfo (extract k) CL/CL_KERNEL_REFERENCE_COUNT))) 1070 | 1071 | ;; ===================== Kernel Arg =========================================== 1072 | 1073 | ;; -- Kernel Arg Info has special utility functions with one more parameter. -- 1074 | 1075 | (defmacro ^:private arg-info-string* [kernel arg info] 1076 | `(let [cnt# (long-array 1) 1077 | kernel# (extract ~kernel) 1078 | err# (CL/clGetKernelArgInfo kernel# ~arg ~info 0 nil cnt#)] 1079 | (with-check err# 1080 | (let [res# (byte-array (aget cnt# 0)) 1081 | err# (CL/clGetKernelArgInfo kernel# ~arg ~info (alength res#) (Pointer/to res#) nil)] 1082 | (with-check err# 1083 | (String. res# 0 (max 0 (dec (alength res#))))))))) 1084 | 1085 | (defmacro ^:private arg-info-long* [kernel arg info] 1086 | `(let [res# (long-array 1) 1087 | err# (CL/clGetKernelArgInfo (extract ~kernel) ~arg ~info Sizeof/cl_long (Pointer/to res#) nil)] 1088 | (with-check err# (aget res# 0)))) 1089 | 1090 | ;; ----------- Kernel Arg Info functions ------------------------------------- 1091 | 1092 | (defn arg-address-qualifier ^long [kernel arg] 1093 | (arg-info-long* kernel arg CL/CL_KERNEL_ARG_ADDRESS_QUALIFIER)) 1094 | 1095 | (defn arg-access-qualifier ^long [kernel arg] 1096 | (arg-info-long* kernel arg CL/CL_KERNEL_ARG_ACCESS_QUALIFIER)) 1097 | 1098 | (defn arg-type-name ^long [kernel arg] 1099 | (arg-info-string* kernel arg CL/CL_KERNEL_ARG_TYPE_NAME)) 1100 | 1101 | (defn arg-type-qualifier ^long [kernel arg] 1102 | (arg-info-long* kernel arg CL/CL_KERNEL_ARG_TYPE_QUALIFIER)) 1103 | 1104 | (defn arg-name [kernel arg] 1105 | (arg-info-string* kernel arg CL/CL_KERNEL_ARG_NAME)) 1106 | 1107 | (defrecord KernelArgInfo [address-qualifier access-qualifier type-name type-qualifier name]) 1108 | 1109 | (defn arg-info 1110 | ([kernel arg info-type] 1111 | (maybe 1112 | (case info-type 1113 | :address-qualifier (dec-kernel-arg-address-qualifier (arg-address-qualifier kernel arg)) 1114 | :access-qualifier (dec-kernel-arg-access-qualifier (arg-access-qualifier kernel arg)) 1115 | :type-name (arg-type-name kernel arg) 1116 | :type-qualifier (set (unmask cl-kernel-arg-type-qualifier (arg-type-qualifier kernel arg))) 1117 | :name (arg-name kernel arg) 1118 | nil))) 1119 | ([kernel arg] 1120 | (->KernelArgInfo (maybe (dec-kernel-arg-address-qualifier (arg-address-qualifier kernel arg))) 1121 | (maybe (dec-kernel-arg-access-qualifier (arg-access-qualifier kernel arg))) 1122 | (maybe (arg-type-name kernel arg)) 1123 | (maybe (set (unmask cl-kernel-arg-type-qualifier (arg-type-qualifier kernel arg)))) 1124 | (maybe (arg-name kernel arg)))) 1125 | ([kernel] 1126 | (map (partial arg-info kernel) (range (num-args kernel)) ))) 1127 | 1128 | ;; ===================== Kernel Sub Group ===================================== 1129 | 1130 | ;; TODO 1131 | 1132 | ;; ===================== Kernel Work Group ==================================== 1133 | 1134 | ;; TODO 1135 | 1136 | ;; ===================== Mem Object =========================================== 1137 | 1138 | (defn mem-type ^long [mo] 1139 | (info-int* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_TYPE)) 1140 | 1141 | (defn flags ^long [mo] 1142 | (info-long* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_FLAGS)) 1143 | 1144 | (defn mem-size ^long [mo] 1145 | (info-size* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_SIZE)) 1146 | 1147 | ;;TODO see what to do with these voids, and whether they make sense with Java. 1148 | ;;(defn mem-host-ptr [mo] 1149 | ;; (info-long* CL/clGetMemObjectInfo mo CL/CL_MEM_HOST_PTR)) 1150 | 1151 | (defn map-count ^long [mo] 1152 | (info-int* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_MAP_COUNT)) 1153 | 1154 | (defn ^:private aget-first-np [^objects npa] 1155 | (aget npa 0)) 1156 | 1157 | (defn mem-context [mo] 1158 | (wrap (aget-first-np (info-native* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_CONTEXT 1159 | cl_context Sizeof/cl_context)))) 1160 | 1161 | (defn associated-memobject [mo] 1162 | (aget-first-np (info-native* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_ASSOCIATED_MEMOBJECT 1163 | cl_mem Sizeof/cl_mem))) 1164 | 1165 | (defn offset ^long [mo] 1166 | (info-size* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_OFFSET)) 1167 | 1168 | (defn uses-svm-pointer [mo] 1169 | (info-bool* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_USES_SVM_POINTER)) 1170 | 1171 | (defrecord MemObjectInfo [type flags size map-count reference-count context associated-memobject 1172 | offset uses-svm-pointer]) 1173 | 1174 | (extend-type CLBuffer 1175 | Info 1176 | (info 1177 | ([mo info-type] 1178 | (maybe 1179 | (case info-type 1180 | :type (dec-mem-object-type (mem-type mo)) 1181 | :flags (set (unmask cl-mem-flags (flags mo))) 1182 | :size (mem-size mo) 1183 | :map-count (map-count mo) 1184 | :reference-count (reference-count mo) 1185 | :context (str (mem-context mo)) 1186 | :associated-memobject (if-let [mo (associated-memobject mo)] (str mo) nil) 1187 | :offset (offset mo) 1188 | :uses-svm-pointer (uses-svm-pointer mo) 1189 | nil))) 1190 | ([mo] 1191 | (->MemObjectInfo (maybe (dec-mem-object-type (mem-type mo))) 1192 | (maybe (set (unmask cl-mem-flags (flags mo)))) 1193 | (maybe (mem-size mo)) 1194 | (maybe (map-count mo)) 1195 | (maybe (reference-count mo)) 1196 | (maybe (str (mem-context mo))) 1197 | (maybe (if-let [mo (associated-memobject mo)] (str mo) nil)) 1198 | (maybe (offset mo)) 1199 | (maybe (uses-svm-pointer mo))))) 1200 | InfoReferenceCount 1201 | (reference-count [mo] 1202 | (info-int* CL/clGetMemObjectInfo (extract mo) CL/CL_MEM_REFERENCE_COUNT))) 1203 | 1204 | ;; ===================== Pipe ================================================= 1205 | 1206 | ;; TODO 1207 | 1208 | ;; ===================== Program Build ======================================== 1209 | 1210 | ;; -- Program Build Info has special utility functions with one more param ---- 1211 | 1212 | (defmacro ^:private pb-info-string* [program device info] 1213 | `(let [cnt# (long-array 1) 1214 | program# (extract ~program) 1215 | err# (CL/clGetProgramBuildInfo program# (extract ~device) ~info 0 nil cnt#)] 1216 | (with-check err# 1217 | (let [res# (byte-array (aget cnt# 0)) 1218 | err# (CL/clGetProgramBuildInfo program# (extract ~device) ~info 1219 | (alength res#) (Pointer/to res#) nil)] 1220 | (with-check err# 1221 | (String. res# 0 (max 0 (dec (alength res#))))))))) 1222 | 1223 | (defmacro ^:private pb-info-int* [program device info] 1224 | `(let [res# (int-array 1) 1225 | err# (CL/clGetProgramBuildInfo (extract ~program) (extract ~device) 1226 | ~info Sizeof/cl_int (Pointer/to res#) nil)] 1227 | (with-check err# (aget res# 0)))) 1228 | 1229 | (let [pointer-to-buffer (fn [^ByteBuffer b] (Pointer/to b))] 1230 | (defmacro ^:private pb-info-size* [program device info] 1231 | `(let [res# (direct-buffer Sizeof/size_t) 1232 | err# (CL/clGetProgramBuildInfo (extract ~program) (extract ~device) ~info Sizeof/size_t 1233 | (~pointer-to-buffer res#) nil)] 1234 | (with-check err# 1235 | (first (seq (get-array res#))))))) 1236 | 1237 | ;; -- Program Build Info functions -------------------------------------------- 1238 | 1239 | (defn build-status ^long [program device] 1240 | (pb-info-int* program device CL/CL_PROGRAM_BUILD_STATUS)) 1241 | 1242 | (defn build-options [program device] 1243 | (pb-info-string* program device CL/CL_PROGRAM_BUILD_OPTIONS)) 1244 | 1245 | (defn build-log [program device] 1246 | (pb-info-string* program device CL/CL_PROGRAM_BUILD_LOG)) 1247 | 1248 | (defn binary-type ^long [program device] 1249 | (pb-info-int* program device CL/CL_PROGRAM_BINARY_TYPE)) 1250 | 1251 | (defn global-variable-total-size ^long [program device] 1252 | (pb-info-size* program device CL/CL_PROGRAM_BUILD_GLOBAL_VARIABLE_TOTAL_SIZE)) 1253 | 1254 | (defrecord ProgramBuildInfo [build-status build-options build-log binary-type global-variable-total-size]) 1255 | 1256 | (defn build-info 1257 | ([program device info-type] 1258 | (maybe 1259 | (case info-type 1260 | :status (dec-build-status (build-status program device)) 1261 | :options (build-options program device) 1262 | :log (build-log program device) 1263 | :binary-type (dec-program-binary-type (binary-type program device)) 1264 | :global-variable-total-size (global-variable-total-size program device)))) 1265 | ([program device] 1266 | (->ProgramBuildInfo (maybe (dec-build-status (build-status program device))) 1267 | (maybe (build-options program device)) 1268 | (maybe (build-log program device)) 1269 | (maybe (dec-program-binary-type (binary-type program device))) 1270 | (maybe (global-variable-total-size program device))))) 1271 | 1272 | ;; ===================== Program ============================================== 1273 | 1274 | (defn program-context [p] 1275 | (wrap (aget-first-np (info-native* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_CONTEXT 1276 | cl_context Sizeof/cl_context)))) 1277 | 1278 | (defn program-num-devices ^long [p] 1279 | (info-int* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_NUM_DEVICES)) 1280 | 1281 | (defn program-devices [p] 1282 | (fmap wrap (vec (info-native* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_DEVICES 1283 | cl_device_id Sizeof/cl_device_id)))) 1284 | 1285 | (defn program-source [p] 1286 | (info-string* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_SOURCE)) 1287 | 1288 | (defn binary-sizes [p] 1289 | (info-size* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_BINARY_SIZES (program-num-devices p))) 1290 | 1291 | (defn binaries [p] 1292 | (let [result-buffers (map direct-buffer (binary-sizes p)) 1293 | pointer (to-native-pointer (into-array Pointer (map pointer-to-buffer result-buffers))) 1294 | err (CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_BINARIES 1295 | (* (count result-buffers) Sizeof/POINTER) pointer nil)] 1296 | (with-check err result-buffers))) 1297 | 1298 | (defn program-num-kernels ^long [p] 1299 | (if (some pos? (binary-sizes p)) 1300 | (info-size* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_NUM_KERNELS) 1301 | 0)) 1302 | 1303 | (defn kernel-names [p] 1304 | (if (some pos? (binary-sizes p)) 1305 | (to-set (info-string* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_KERNEL_NAMES)) 1306 | #{})) 1307 | 1308 | (defrecord ProgramInfo [reference-count context num-devices devices source 1309 | binary-sizes binaries num-kernels kernel-names]) 1310 | 1311 | (extend-type CLProgram 1312 | Info 1313 | (info 1314 | ([p info-type] 1315 | (maybe 1316 | (case info-type 1317 | :reference-count (reference-count p) 1318 | :context (str (program-context p)) 1319 | :num-devices (program-num-devices p) 1320 | :devices (fmap name-info (program-devices p)) 1321 | :source (program-source p) 1322 | :binary-sizes (binary-sizes p) 1323 | :binaries (program-num-devices p) 1324 | :num-kernels (program-num-kernels p) 1325 | :kernel-names (kernel-names p) 1326 | nil))) 1327 | ([p] 1328 | (->ProgramInfo (maybe (reference-count p)) 1329 | (maybe (str (program-context p))) 1330 | (maybe (program-num-devices p)) 1331 | (maybe (fmap name-info (program-devices p))) 1332 | (maybe (program-source p)) 1333 | (maybe (binary-sizes p)) 1334 | (maybe (program-num-devices p)) 1335 | (maybe (program-num-kernels p)) 1336 | (maybe (kernel-names p))))) 1337 | InfoReferenceCount 1338 | (reference-count [p] 1339 | (info-int* CL/clGetProgramInfo (extract p) CL/CL_PROGRAM_REFERENCE_COUNT))) 1340 | 1341 | ;; ===================== Sampler ============================================== 1342 | 1343 | ;; TODO 1344 | 1345 | ;; ===================== GL Context =========================================== 1346 | 1347 | ;; TODO 1348 | ;; ===================== GL Object ============================================ 1349 | 1350 | ;; TODO 1351 | 1352 | ;; ===================== GL Texture =========================================== 1353 | 1354 | ;; TODO 1355 | 1356 | ;; ============================================================================ 1357 | -------------------------------------------------------------------------------- /src/clojure/uncomplicate/clojurecl/internal/constants.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | uncomplicate.clojurecl.internal.constants 11 | "Defines constants and mappings from/to OpenCL constants. 12 | 13 | OpenCL API defines and uses numerous int/long C-style constants as arguments 14 | in functions calls, mostly for configuring various options. Clojure uses keywords 15 | as an user friendly alternative. ClojureCL's `core` namespace contains primitive 16 | functions suffixed with `*`, which still accept the low level constants 17 | defined in `org.jocl.CL` Java class, but the preferred, easier, and natural way 18 | is to use keywords. Another benefit of that method is that you can easily view 19 | available options by printing an appropriate hash-map from this namespace. 20 | 21 | Most mappings are two-way. Hashmaps that convert keywords to number codes 22 | are named `cl-something-clish`, while functions that convert numbers to keywords 23 | are named `dec-something-clish`. You can see which keywords are available for 24 | a certain property by evaluate appropriate `cl-something-clish` hashmap. 25 | All hashmaps and functions contain brief doc and a web link to appropriate 26 | online OpenCL documentation with detailed explanations 27 | 28 | Also see the summary at 29 | http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/enums.html" 30 | (:import org.jocl.CL)) 31 | 32 | ;; ===== OpenCL defines this, but JOCL 0.2.0 still misses it. 33 | (def ^{:no-doc true :const true} 34 | CL_DEVICE_SPIR_VERSIONS 0x40E0) 35 | 36 | (def ^{:no-doc true :const true} 37 | CL_TERMINATE_CAPABILITY_KHR 0x200F) 38 | 39 | ;; ============= Error Codes =================================================== 40 | 41 | (defn dec-error 42 | "Decodes OpenCL error code to a meaningful string. 43 | If called with a number that is not recognized as an existing OpenCL error, 44 | returns `\"UNKNOWN OpenCL ERROR!\"` 45 | 46 | Also see the discussion at 47 | http://streamcomputing.eu/blog/2013-04-28/opencl-1-2-error-codes/" 48 | [^long code] 49 | (case code 50 | 0 "CL_SUCCESS" 51 | -1 "CL_DEVICE_NOT_FOUND" 52 | -2 "CL_DEVICE_NOT_AVAILABLE" 53 | -3 "CL_COMPILER_NOT_AVAILABLE" 54 | -4 "CL_MEM_OBJECT_ALLOCATION_FAILURE" 55 | -5 "CL_OUT_OF_RESOURCES" 56 | -6 "CL_OUT_OF_HOST_MEMORY" 57 | -7 "CL_PROFILING_INFO_NOT_AVAILABLE" 58 | -8 "CL_MEM_COPY_OVERLAP" 59 | -9 "CL_IMAGE_FORMAT_MISMATCH" 60 | -10 "CL_IMAGE_FORMAT_NOT_SUPPORTED" 61 | -11 "CL_BUILD_PROGRAM_FAILURE" 62 | -12 "CL_MAP_FAILURE" 63 | -13 "CL_MISALIGNED_SUB_BUFFER_OFFSET" 64 | -14 "CL_EXEC_STATUS_ERROR_FOR_EVENTS_IN_WAIT_LIST" 65 | -15 "CL_COMPILE_PROGRAM_FAILURE" 66 | -16 "CL_LINKER_NOT_AVAILABLE" 67 | -17 "CL_LINK_PROGRAM_FAILURE" 68 | -18 "CL_DEVICE_PARTITION_FAILED" 69 | -19 "CL_KERNEL_ARG_INFO_NOT_AVAILABLE" 70 | -30 "CL_INVALID_VALUE" 71 | -31 "CL_INVALID_DEVICE_TYPE" 72 | -32 "CL_INVALID_PLATFORM" 73 | -33 "CL_INVALID_DEVICE" 74 | -34 "CL_INVALID_CONTEXT" 75 | -35 "CL_INVALID_QUEUE_PROPERTIES" 76 | -36 "CL_INVALID_COMMAND_QUEUE" 77 | -37 "CL_INVALID_HOST_PTR" 78 | -38 "CL_INVALID_MEM_OBJECT" 79 | -39 "CL_INVALID_IMAGE_FORMAT_DESCRIPTOR" 80 | -40 "CL_INVALID_IMAGE_SIZE" 81 | -41 "CL_INVALID_SAMPLER" 82 | -42 "CL_INVALID_BINARY" 83 | -43 "CL_INVALID_BUILD_OPTIONS" 84 | -44 "CL_INVALID_PROGRAM" 85 | -45 "CL_INVALID_PROGRAM_EXECUTABLE" 86 | -46 "CL_INVALID_KERNEL_NAME" 87 | -47 "CL_INVALID_KERNEL_DEFINITION" 88 | -48 "CL_INVALID_KERNEL" 89 | -49 "CL_INVALID_ARG_INDEX" 90 | -50 "CL_INVALID_ARG_VALUE" 91 | -51 "CL_INVALID_ARG_SIZE" 92 | -52 "CL_INVALID_KERNEL_ARGS" 93 | -53 "CL_INVALID_WORK_DIMENSION" 94 | -54 "CL_INVALID_WORK_GROUP_SIZE" 95 | -55 "CL_INVALID_WORK_ITEM_SIZE" 96 | -56 "CL_INVALID_GLOBAL_OFFSET" 97 | -57 "CL_INVALID_EVENT_WAIT_LIST" 98 | -58 "CL_INVALID_EVENT" 99 | -59 "CL_INVALID_OPERATION" 100 | -60 "CL_INVALID_GL_OBJECT" 101 | -61 "CL_INVALID_BUFFER_SIZE" 102 | -62 "CL_INVALID_MIP_LEVEL" 103 | -63 "CL_INVALID_GLOBAL_WORK_SIZE" 104 | -64 "CL_INVALID_PROPERTY" 105 | -65 "CL_INVALID_IMAGE_DESCRIPTOR" 106 | -66 "CL_INVALID_COMPILER_OPTIONS" 107 | -67 "CL_INVALID_LINKER_OPTIONS" 108 | -68 "CL_INVALID_DEVICE_PARTITION_COUNT" 109 | -69 "CL_INVALID_PIPE_SIZE" 110 | -70 "CL_INVALID_DEVICE_QUEUE" 111 | -16384 "CL_JOCL_INTERNAL_ERROR" 112 | -1000 "CL_INVALID_GL_SHAREGROUP_REFERENCE_KHR" 113 | -1001 "CL_PLATFORM_NOT_FOUND_KHR" 114 | "UNKNOWN OpenCL ERROR!")) 115 | 116 | ;; ==================== Keyword mapping ====================================== 117 | 118 | (def ^{:doc "Types of OpenCL devices defined in OpenCL standard. 119 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceIDs.html" 120 | :const true} 121 | cl-device-type 122 | {:gpu CL/CL_DEVICE_TYPE_GPU 123 | :cpu CL/CL_DEVICE_TYPE_CPU 124 | :default CL/CL_DEVICE_TYPE_DEFAULT 125 | :accelerator CL/CL_DEVICE_TYPE_ACCELERATOR 126 | :custom CL/CL_DEVICE_TYPE_CUSTOM 127 | :all CL/CL_DEVICE_TYPE_ALL}) 128 | 129 | (def ^{:doc "Floating point capabilities of the device defined in OpenCL standard. 130 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 131 | :const true} 132 | cl-device-fp-config 133 | {:denorm CL/CL_FP_DENORM 134 | :inf-nan CL/CL_FP_INF_NAN 135 | :round-to-nearest CL/CL_FP_ROUND_TO_NEAREST 136 | :round-to-zero CL/CL_FP_ROUND_TO_ZERO 137 | :round-to-inf CL/CL_FP_ROUND_TO_INF 138 | :fma CL/CL_FP_FMA 139 | :correctly-rounded-divide-sqrt CL/CL_FP_CORRECTLY_ROUNDED_DIVIDE_SQRT 140 | :soft-float CL/CL_FP_SOFT_FLOAT}) 141 | 142 | (def 143 | ^{:doc "Types of global memory cache defined in OpenCL standard. 144 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html"} 145 | cl-device-mem-cache-type 146 | {:none CL/CL_NONE 147 | :read-only CL/CL_READ_ONLY_CACHE 148 | :read-write CL/CL_READ_WRITE_CACHE}) 149 | 150 | (def ^{:doc "Types of local memory defined in OpenCL standard. 151 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 152 | :const true} 153 | cl-local-mem-type 154 | {:local CL/CL_LOCAL 155 | :global CL/CL_GLOBAL 156 | :none CL/CL_NONE}) 157 | 158 | (def ^{:doc "The execution capabilities of the device defined in OpenCL standard. 159 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 160 | :const true} 161 | cl-device-exec-capabilities 162 | {:kernel CL/CL_EXEC_KERNEL 163 | :native-kernel CL/CL_EXEC_NATIVE_KERNEL}) 164 | 165 | (def ^{:doc "On device command-queue properties defined in OpenCL standard. 166 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 167 | :const true} 168 | cl-command-queue-properties 169 | {:out-of-order-exec-mode CL/CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE 170 | :profiling CL/CL_QUEUE_PROFILING_ENABLE 171 | :queue-on-device CL/CL_QUEUE_ON_DEVICE 172 | :queue-on-device-default CL/CL_QUEUE_ON_DEVICE_DEFAULT}) 173 | 174 | (def ^{:doc "Context properties defined in OpenCL standard. 175 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 176 | :const true} 177 | cl-context-properties 178 | {:platform CL/CL_CONTEXT_PLATFORM 179 | :interop-user-sync CL/CL_CONTEXT_INTEROP_USER_SYNC 180 | :gl-context-khr CL/CL_GL_CONTEXT_KHR 181 | :cgl-sharegroup-khr CL/CL_CGL_SHAREGROUP_KHR 182 | :egl-display-khr CL/CL_EGL_DISPLAY_KHR 183 | :glx-display-khr CL/CL_GLX_DISPLAY_KHR 184 | :wgl-hdc-khr CL/CL_WGL_HDC_KHR}) 185 | 186 | (defn dec-context-properties 187 | "Converts `cl_context_properties` code from number to keyword. 188 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 189 | [^long code] 190 | (case code 191 | 0x1004 :platform 192 | 0x1005 :interop-user-sync 193 | code)) 194 | 195 | (defn dec-device-partition-property 196 | "Converts `cl_device_partition_property` code from number to keyword. 197 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 198 | [^long code] 199 | (case code 200 | 0x1086 :equally 201 | 0x1087 :by-counts 202 | 0x0 :by-counts-list-end 203 | 0x1088 :by-affinity-domain 204 | code)) 205 | 206 | (def ^{:doc "Affinity domains for partitioning the device defined in OpenCL standard. 207 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 208 | :const true} 209 | cl-device-affinity-domain 210 | {:numa CL/CL_DEVICE_AFFINITY_DOMAIN_NUMA 211 | :l1-cache CL/CL_DEVICE_AFFINITY_DOMAIN_L1_CACHE 212 | :l2-cache CL/CL_DEVICE_AFFINITY_DOMAIN_L2_CACHE 213 | :l3-cache CL/CL_DEVICE_AFFINITY_DOMAIN_L3_CACHE 214 | :l4-cache CL/CL_DEVICE_AFFINITY_DOMAIN_L4_CACHE 215 | :next-partitionable CL/CL_DEVICE_AFFINITY_DOMAIN_NEXT_PARTITIONABLE}) 216 | 217 | (def ^{:doc "Context properties defined in OpenCL standard. 218 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceInfo.html" 219 | :const true} 220 | cl-device-svm-capabilities 221 | {:coarse-grain-buffer CL/CL_DEVICE_SVM_COARSE_GRAIN_BUFFER 222 | :fine-grain-buffer CL/CL_DEVICE_SVM_FINE_GRAIN_BUFFER 223 | :fine-grain-system CL/CL_DEVICE_SVM_FINE_GRAIN_SYSTEM 224 | :atomics CL/CL_DEVICE_SVM_ATOMICS}) 225 | 226 | (def ^{:doc "Memory allocation and usage information defined in OpenCL standard. 227 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clCreateBuffer.html" 228 | :const true} 229 | cl-mem-flags 230 | {:read-write CL/CL_MEM_READ_WRITE 231 | :write-only CL/CL_MEM_WRITE_ONLY 232 | :read-only CL/CL_MEM_READ_ONLY 233 | :use-host-ptr CL/CL_MEM_USE_HOST_PTR 234 | :alloc-host-ptr CL/CL_MEM_ALLOC_HOST_PTR 235 | :copy-host-ptr CL/CL_MEM_COPY_HOST_PTR 236 | :host-write-only CL/CL_MEM_HOST_WRITE_ONLY 237 | :host-read-only CL/CL_MEM_HOST_READ_ONLY 238 | :host-no-access CL/CL_MEM_HOST_NO_ACCESS}) 239 | 240 | (def ^{:doc "Memory allocation and usage information defined in OpenCL standard. 241 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clSVMAlloc.html" 242 | :const true} 243 | cl-svm-mem-flags 244 | {:read-write CL/CL_MEM_READ_WRITE 245 | :write-only CL/CL_MEM_WRITE_ONLY 246 | :read-only CL/CL_MEM_READ_ONLY 247 | :fine-grain-buffer CL/CL_MEM_SVM_FINE_GRAIN_BUFFER 248 | :atomics CL/CL_MEM_SVM_ATOMICS}) 249 | 250 | (defn dec-mem-object-type 251 | "Converts `cl_mem_object_type` code from number to keyword. 252 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetMemObjectInfo.html" 253 | [^long code] 254 | (case code 255 | 0x10F0 :buffer 256 | 0x10F1 :image2d 257 | 0x10F2 :image3d 258 | 0x10F3 :image2d-array 259 | 0x10F4 :image1d 260 | 0x10F5 :image1d-array 261 | 0x10F6 :image1d-buffer 262 | 0x10F7 :pipe 263 | code)) 264 | 265 | (def ^{:doc "Map flags used in enqueuing buffer mapping defined in OpenCL standard. 266 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clEnqueueMapBuffer.html" 267 | :const true} 268 | cl-map-flags 269 | {:read CL/CL_MAP_READ 270 | :write CL/CL_MAP_WRITE 271 | :write-invalidate-region CL/CL_MAP_WRITE_INVALIDATE_REGION}) 272 | 273 | (defn dec-program-binary-type 274 | "Converts `cl_program_binary_type` code from number to keyword. 275 | See https://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetProgramBuildInfo.html" 276 | [^long code] 277 | (case code 278 | 0x0 :none 279 | 0x1 :compiled-object 280 | 0x2 :library 281 | 0x4 :executable 282 | 0x40E1 :intermediate 283 | code)) 284 | 285 | (defn dec-build-status 286 | "Converts `cl_program_build_status` code from number to keyword. 287 | See https://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetProgramBuildInfo.html" 288 | [^long code] 289 | (case code 290 | 0 :success 291 | -1 :none 292 | -2 :error 293 | -3 :in-progress 294 | code)) 295 | 296 | (defn 297 | dec-kernel-arg-address-qualifier 298 | "Converts `cl_kernel_arg_address_qualifier` code from number to keyword. 299 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetKernelArgInfo.html" 300 | [^long code] 301 | (case code 302 | 0x119B :global 303 | 0x119C :local 304 | 0x119D :constant 305 | 0x119E :private 306 | code)) 307 | 308 | (defn dec-kernel-arg-access-qualifier 309 | "Converts `cl_kernel_arg_access_qualifier` code from number to keyword. 310 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetKernelArgInfo.html" 311 | [^long code] 312 | (case code 313 | 0x11A0 :read-only 314 | 0x11A1 :write-only 315 | 0x11A2 :read-write 316 | 0x11A3 :none 317 | code)) 318 | 319 | (def ^{:doc "Type quilifiers specified for the argument, defined in OpenCL standard. 320 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetKernelArgInfo.html" 321 | :const true} 322 | cl-kernel-arg-type-qualifier 323 | {:const CL/CL_KERNEL_ARG_TYPE_CONST 324 | :restrict CL/CL_KERNEL_ARG_TYPE_RESTRICT 325 | :volatile CL/CL_KERNEL_ARG_TYPE_VOLATILE 326 | :pipe CL/CL_KERNEL_ARG_TYPE_PIPE 327 | :none CL/CL_KERNEL_ARG_TYPE_NONE}) 328 | 329 | (defn dec-command-type 330 | "Converts `cl_event_command_type` code from number to keyword. 331 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetEventInfo.html" 332 | [^long code] 333 | (case code 334 | 0x11F0 :ndrange-kernel 335 | 0x11F1 :task 336 | 0x11F2 :native-kernel 337 | 0x11F3 :read-buffer 338 | 0x11F4 :write-buffer 339 | 0x11F5 :copy-buffer 340 | 0x11F6 :read-image 341 | 0x11F7 :write-image 342 | 0x11F8 :copy-image 343 | 0x11F9 :copy-image-to-buffer 344 | 0x11FA :copy-buffer-to-image 345 | 0x11FB :map-buffer 346 | 0x11FC :map-image 347 | 0x11FD :unmap-mem-object 348 | 0x11FE :marker 349 | 0x11FF :acquire-gl-objects 350 | 0x1200 :release-gl-objects 351 | 0x1201 :read-buffer-rect 352 | 0x1202 :write-buffer-rect 353 | 0x1203 :copy-buffer-rect 354 | 0x1204 :user 355 | 0x1205 :barrier 356 | 0x1206 :migrate-mem-objects 357 | 0x1207 :fill-buffer 358 | 0x1208 :fill-image 359 | 0x1209 :svm-free 360 | 0x120A :svm-memcpy 361 | 0x120B :svm-memfill 362 | 0x120C :svm-map 363 | 0x120D :svm-unmap 364 | 0x200D :gl-fence-sync-object-khr 365 | code)) 366 | 367 | (defn dec-command-execution-status 368 | "Converts `cl_event_command_execution_status` code from number to keyword. 369 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetEventInfo.html" 370 | [^long code] 371 | (case code 372 | 0x0 :complete 373 | 0x1 :running 374 | 0x2 :submitted 375 | 0x3 :queued 376 | code)) 377 | 378 | (def 379 | ^{:doc "Execution statuses of commands, defined in OpenCL standard. 380 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetEventInfo.html"} 381 | cl-command-execution-status 382 | {:complete CL/CL_COMPLETE 383 | :running CL/CL_RUNNING 384 | :submitted CL/CL_SUBMITTED 385 | :queued CL/CL_QUEUED}) 386 | -------------------------------------------------------------------------------- /src/clojure/uncomplicate/clojurecl/internal/impl.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | uncomplicate.clojurecl.internal.impl 11 | (:require [uncomplicate.commons 12 | [core :refer [Releaseable release Info info]] 13 | [utils :refer [dragan-says-ex]]] 14 | [uncomplicate.fluokitten.protocols :refer [Comonad extract]] 15 | [uncomplicate.clojurecl.internal 16 | [protocols :refer :all] 17 | [constants :refer :all] 18 | [utils :refer [with-check with-check-arr]]] 19 | [clojure.core.async :refer [go >!]]) 20 | (:import [java.nio ByteBuffer ByteOrder] 21 | clojure.lang.IDeref 22 | [org.jocl CL NativePointerObject cl_device_id cl_mem 23 | cl_context cl_command_queue cl_mem cl_program cl_kernel cl_sampler 24 | cl_event cl_buffer_region cl_queue_properties cl_platform_id 25 | Sizeof Pointer CreateContextFunction EventCallbackFunction 26 | BuildProgramFunction JOCLAccessor])) 27 | 28 | ;; =============== Release CL Resources ================================== 29 | 30 | (defn native-pointer ^long [npo] 31 | (if npo (JOCLAccessor/getNativePointer npo) 0)) 32 | 33 | (extend-type NativePointerObject 34 | Releaseable 35 | (release [this] 36 | (dragan-says-ex "It is not allowed to use and release raw JOCL objects. Use safe wrappers." 37 | {:this this}))) 38 | 39 | (defmacro ^:private deftype-wrapper [name release-method] 40 | (let [name-str (str name)] 41 | `(deftype ~name [ref#] 42 | Object 43 | (hashCode [this#] 44 | (hash (deref ref#))) 45 | (equals [this# other#] 46 | (= (deref ref#) (extract other#))) 47 | (toString [this#] 48 | (format "#%s[0x%s]" ~name-str (Long/toHexString (native-pointer (deref ref#))))) 49 | Comonad 50 | (extract [this#] 51 | (deref ref#)) 52 | Releaseable 53 | (release [this#] 54 | (locking ref# 55 | (when-let [d# (deref ref#)] 56 | (locking d# 57 | (with-check (~release-method d#) (vreset! ref# nil))))) 58 | true)))) 59 | 60 | (deftype-wrapper CLDevice CL/clReleaseDevice) 61 | (deftype-wrapper CLContext CL/clReleaseContext) 62 | (deftype-wrapper CLCommandQueue CL/clReleaseCommandQueue) 63 | (deftype-wrapper CLEvent CL/clReleaseEvent) 64 | (deftype-wrapper CLKernel CL/clReleaseKernel) 65 | (deftype-wrapper CLProgram CL/clReleaseProgram) 66 | (deftype-wrapper CLSampler CL/clReleaseSampler) 67 | 68 | (extend-type cl_platform_id 69 | Releaseable 70 | (release [_] 71 | true) 72 | Wrappable 73 | (wrap [this] 74 | this) 75 | Comonad 76 | (extract [this] 77 | this)) 78 | 79 | (extend-type cl_command_queue 80 | Info 81 | (info [this] 82 | (info (wrap this))) 83 | Wrappable 84 | (wrap [queue] 85 | (->CLCommandQueue (volatile! queue)))) 86 | 87 | (extend-type cl_context 88 | Info 89 | (info [this] 90 | (info (wrap this))) 91 | Wrappable 92 | (wrap [ctx] 93 | (->CLContext (volatile! ctx)))) 94 | 95 | (extend-type cl_device_id 96 | Info 97 | (info [this] 98 | (info (wrap this))) 99 | Wrappable 100 | (wrap [dev] 101 | (->CLDevice (volatile! dev)))) 102 | 103 | (extend-type cl_event 104 | Info 105 | (info [this] 106 | (info (wrap this))) 107 | Wrappable 108 | (wrap [event] 109 | (->CLEvent (volatile! event)))) 110 | 111 | (extend-type cl_kernel 112 | Info 113 | (info [this] 114 | (info (wrap this))) 115 | Wrappable 116 | (wrap [kernel] 117 | (->CLKernel (volatile! kernel)))) 118 | 119 | (extend-type cl_program 120 | Info 121 | (info [this] 122 | (info (wrap this))) 123 | Wrappable 124 | (wrap [program] 125 | (->CLProgram (volatile! program)))) 126 | 127 | (extend-type cl_sampler 128 | Info 129 | (info [this] 130 | (info (wrap this))) 131 | Wrappable 132 | (wrap [sampler] 133 | (->CLSampler (volatile! sampler)))) 134 | 135 | ;; =============== Device ========================================== 136 | 137 | (defn num-devices* 138 | "Queries `platform` for the number of devices of `device-type`s. Device types 139 | are given as a bitfield, where each type is defined in the OpenCL standard. 140 | Available device types are accessible through `org.jocl.CL/CL_DEVICE_TYPE_X` 141 | constants. If there are no such devices, returns 0. 142 | 143 | NOTE: You should prefer a higher-level [[num-devices]] function, unless you 144 | already have a `device-type` in a long number form in your code. 145 | 146 | When called with an invalid platform, throws [ExceptionInfo] 147 | (http://clojuredocs.org/clojure.core/ex-info). 148 | 149 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceIDs.html 150 | and http://www.jocl.org/doc/org/jocl/CL.html#clGetDeviceIDs-int-org.jocl.cl_device_id:A-int:A- 151 | " 152 | ^long [platform ^long device-type] 153 | (let [res (int-array 1) 154 | err (CL/clGetDeviceIDs platform device-type 0 nil res)] 155 | (if (= CL/CL_DEVICE_NOT_FOUND err) 156 | 0 157 | (with-check err 158 | {:platform (info platform) :device-type device-type} 159 | (aget res 0))))) 160 | 161 | (defn devices* 162 | "Queries `platform` for the devices of `device-type`s, and returns them as an 163 | array of `cl_device_id`s. The types are given as a bitfield, where each type 164 | is a number constant defined in the OpenCL standard. 165 | Available device types are accessible through `org.jocl.CL/CL_DEVICE_TYPE_X` 166 | constants. If there are no such devices, returns a zero-length array. 167 | 168 | Root level devices do not need to be explicitly released. 169 | 170 | NOTE: You should prefer a higher-level [[devices]] function, unless you 171 | already have a `device-type` in a long number form in your code, and/or you 172 | want to get resulting devices in an array rather than in a vector. 173 | 174 | When called with an invalid platform, throws [ExceptionInfo] 175 | (http://clojuredocs.org/clojure.core/ex-info). 176 | 177 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clGetDeviceIDs.html 178 | and http://www.jocl.org/doc/org/jocl/CL.html#clGetDeviceIDs-int-org.jocl.cl_device_id:A-int:A- 179 | " 180 | [platform ^long device-type] 181 | (let [num-devices (num-devices* platform device-type) 182 | res (make-array cl_device_id num-devices)] 183 | (if (< 0 num-devices) 184 | (let [err (CL/clGetDeviceIDs platform device-type num-devices res nil)] 185 | (with-check err 186 | {:platform (info platform) :device-type device-type} 187 | res)) 188 | res))) 189 | 190 | ;; ========================= Context =========================================== 191 | 192 | (defrecord CreateContextInfo [errinfo private-info data]) 193 | 194 | (deftype CreateContextCallback [ch] 195 | CreateContextFunction 196 | (function [this errinfo private-info cb data] 197 | (go (>! ch (->CreateContextInfo errinfo private-info data))))) 198 | 199 | (defn context* 200 | "Creates `CLContext` for an array of `device`s, with optional 201 | `cl_context_properties`, error reporting core.async channel `ch` 202 | and user data that should accompany the error report. 203 | 204 | If `devices` is empty, throws `ExceptionInfo`. 205 | 206 | **Needs to be released after use.** 207 | 208 | This is a low-level alternative to [[context]]. 209 | 210 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clCreateContext.html 211 | See throws `Illegalargumentexception`http://www.jocl.org/doc/org/jocl/CL.html#clCreateContext-org.jocl.cl_context_properties-int-org.jocl.cl_device_id:A-org.jocl.CreateContextFunction-java.lang.Object-int:A- 212 | " 213 | [^objects devices properties ch user-data] 214 | (let [err (int-array 1) 215 | res (CL/clCreateContext properties 216 | (alength devices) devices 217 | (if ch (->CreateContextCallback ch) nil) 218 | user-data err)] 219 | (with-check-arr err 220 | {:devices (map info devices)} 221 | res))) 222 | 223 | ;; =========================== Memory ========================================= 224 | 225 | (deftype CLBuffer [cl ^Pointer cl* ^long s] 226 | Object 227 | (hashCode [this] 228 | (hash @cl)) 229 | (equals [this other] 230 | (= @cl (extract other))) 231 | (toString [this] 232 | (format "#CLBuffer[0x%s]" (Long/toHexString (native-pointer @cl)))) 233 | Comonad 234 | (extract [_] 235 | @cl) 236 | Releaseable 237 | (release [this] 238 | (locking cl 239 | (when-let [c @cl] 240 | (locking c 241 | (with-check (CL/clReleaseMemObject c) 242 | (do 243 | (vreset! cl nil) 244 | (vreset! cl* nil)))))) 245 | true) 246 | Mem 247 | (ptr [_] 248 | @cl*) 249 | (size [_] 250 | s) 251 | CLMem 252 | (enq-copy* [this queue dst src-offset dst-offset size wait-events ev] 253 | (with-check 254 | (CL/clEnqueueCopyBuffer queue @cl (extract dst) src-offset dst-offset size 255 | (if wait-events (alength ^objects wait-events) 0) 256 | wait-events ev) 257 | queue)) 258 | (enq-fill* [this queue pattern offset multiplier wait-events ev] 259 | (with-check 260 | (CL/clEnqueueFillBuffer queue @cl (ptr pattern) (size pattern) 261 | offset (* ^long (size pattern) ^long multiplier) 262 | (if wait-events (alength ^objects wait-events) 0) 263 | wait-events ev) 264 | queue)) 265 | Argument 266 | (set-arg [this kernel n] 267 | (with-check (CL/clSetKernelArg kernel n Sizeof/cl_mem @cl*) 268 | {:kernel (info kernel) :n n :arg (info this)} 269 | kernel))) 270 | 271 | (deftype SVMBuffer [ctx svm* ^long s] 272 | Object 273 | (hashCode [this] 274 | (hash @svm*)) 275 | (equals [this other] 276 | (= @svm* (extract other))) 277 | (toString [this] 278 | (str @svm*)) 279 | Comonad 280 | (extract [_] 281 | @svm*) 282 | Releaseable 283 | (release [this] 284 | (locking svm* 285 | (when-let [ss @svm*] 286 | (locking ss 287 | (CL/clSVMFree ctx ss) 288 | (vreset! svm* nil)))) 289 | true) 290 | Mem 291 | (ptr [_] 292 | @svm*) 293 | (size [_] 294 | s) 295 | SVMMem 296 | (byte-buffer [this] 297 | (byte-buffer this 0 s)) 298 | (byte-buffer [_ offset size] 299 | (.order (.getByteBuffer ^Pointer @svm* offset size) (ByteOrder/nativeOrder))) 300 | Argument 301 | (set-arg [this kernel n] 302 | (with-check (CL/clSetKernelArgSVMPointer kernel n @svm*) 303 | {:kernel (info kernel) :n n :arg (info this)} 304 | kernel))) 305 | 306 | (defn cl-buffer* 307 | "Creates a cl buffer object in `ctx`, given `size` in bytes and a bitfield 308 | `flags` describing memory allocation usage. 309 | 310 | Flags defined by the OpenCL standard are available as constants in the 311 | [org.jocl.CL](http://www.jocl.org/doc/org/jocl/CL.html) class. 312 | 313 | **Needs to be released after use.** 314 | 315 | This is a low-level alternative to [[cl-buffer]] 316 | If `ctx` is nil or the buffer size is invalid, throws `ExceptionInfo`. 317 | 318 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clCreateBuffer.html, 319 | http://www.jocl.org/doc/org/jocl/CL.html#clCreateBuffer-org.jocl.cl_context-long-long-org.jocl.Pointer-int:A- 320 | 321 | Example: 322 | 323 | (cl-buffer* ctx 24 CL/CL_MEM_READ_ONLY) 324 | " 325 | ([^cl_context ctx ^long size ^long flags] 326 | (let [err (int-array 1) 327 | res (CL/clCreateBuffer ctx flags size nil err)] 328 | (with-check-arr err 329 | {:ctx (info ctx) :size size} 330 | (->CLBuffer (volatile! res) (volatile! (Pointer/to ^cl_mem res)) size))))) 331 | 332 | (defn cl-sub-buffer* 333 | "Creates a cl buffer object ([[CLBuffer]]) that shares data with an existing 334 | buffer object. 335 | 336 | * `buffer` has to be a valid `cl_mem` buffer object. 337 | * `flags` is a bitfield that specifies allocation usage (see [[cl-buffer*]]). 338 | * `create-type` is a type of buffer object to be created (in OpenCL 2.0, only 339 | `CL/CL_BUFFER_CREATE_TYPE_REGION` is supported). 340 | * `region` is a `cl_buffer_region` that specifies offset and size 341 | of the subbuffer. 342 | 343 | **Needs to be released after use.** 344 | 345 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clCreateBuffer.html, 346 | http://www.jocl.org/doc/org/jocl/CL.html#clCreateBuffer-org.jocl.cl_context-long-long-org.jocl.Pointer-int:A- 347 | 348 | Examples: 349 | 350 | (def cl-buff (cl-buffer ctx 32 :write-only)) 351 | (def region (cl_buffer_region. 8 16)) 352 | (cl-sub-buffer* cl-buff CL/CL_MEM_READ_WRITE CL/CL_BUFFER_CREATE_TYPE_REGION region) 353 | (cl-sub-buffer* cl-buff CL/CL_MEM_READ_ONLY region) 354 | " 355 | ([^cl_mem buffer ^long flags ^long create-type ^cl_buffer_region region] 356 | (let [err (int-array 1) 357 | res (CL/clCreateSubBuffer buffer flags (int create-type) region err)] 358 | (with-check-arr err (->CLBuffer (volatile! res) (volatile! (Pointer/to ^cl_mem res)) 359 | (.size region))))) 360 | ([^cl_mem buffer ^long flags region] 361 | (cl-sub-buffer* buffer flags CL/CL_BUFFER_CREATE_TYPE_REGION region))) 362 | 363 | (defn svm-buffer* 364 | "Creates a svm buffer object in `ctx`, given `size` in bytes, bitfield 365 | `flags` describing memory allocation usage, and alignment size. 366 | 367 | Flags defined by the OpenCL standard are available as constants in the 368 | [org.jocl.CL](http://www.jocl.org/doc/org/jocl/CL.html) class. 369 | 370 | **Needs to be released after use.** 371 | 372 | This is a low-level alternative to [[svm-buffer!]] 373 | If `ctx` is nil or the buffer size is invalid, throws `IllegalArgumentException`. 374 | 375 | See http://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clSVMAlloc.html, 376 | http://www.jocl.org/doc/org/jocl/CL.html#clSVMAlloc-org.jocl.cl_context-long-long-int- 377 | 378 | Example: 379 | 380 | (svm-buffer* ctx 24 (bit-or CL/CL_MEM_SVM_FINE_GRAIN_BUFFER CL/CL_MEM_SVM_ATOMICS) 0) 381 | " 382 | [^cl_context ctx ^long size ^long flags ^long alignment] 383 | (if (and ctx (< 0 size)) 384 | (let [err (int-array 1) 385 | res (CL/clSVMAlloc ctx flags size alignment)] 386 | (with-check-arr err (->SVMBuffer ctx (volatile! res) size))) 387 | (dragan-says-ex "To create a svm buffer, you must provide a context and a positive size."))) 388 | 389 | (defmacro ^:private extend-number [type] 390 | `(extend-type ~type 391 | Argument 392 | (set-arg [this# kernel# n#] 393 | (with-check (CL/clSetKernelArg kernel# n# this# nil) 394 | {:kernel (info kernel#) :n n# :arg (info this#)} 395 | kernel#)))) 396 | 397 | (extend-number Double) 398 | (extend-number Float) 399 | (extend-number Long) 400 | (extend-number Integer) 401 | (extend-number Byte) 402 | (extend-number Short) 403 | (extend-number Character) 404 | 405 | (defmacro ^:private extend-mem-array [type atype bytes] 406 | `(extend-type ~type 407 | Mem 408 | (ptr [this#] 409 | (Pointer/to (~atype this#))) 410 | (size [this#] 411 | (* ~bytes (alength (~atype this#)))) 412 | Argument 413 | (set-arg [this# kernel# n#] 414 | (with-check 415 | (CL/clSetKernelArg kernel# n# (* ~bytes (alength (~atype this#))) (Pointer/to (~atype this#))) 416 | {:kernel (info kernel#) :n n# :arg (info this#)} 417 | kernel#)))) 418 | 419 | (extend-mem-array (Class/forName "[F") floats Float/BYTES) 420 | (extend-mem-array (Class/forName "[D") doubles Double/BYTES) 421 | (extend-mem-array (Class/forName "[I") ints Integer/BYTES) 422 | (extend-mem-array (Class/forName "[J") longs Long/BYTES) 423 | (extend-mem-array (Class/forName "[B") bytes Byte/BYTES) 424 | (extend-mem-array (Class/forName "[S") shorts Short/BYTES) 425 | (extend-mem-array (Class/forName "[C") chars Character/BYTES) 426 | 427 | (extend-type ByteBuffer 428 | Mem 429 | (ptr [this] 430 | (Pointer/toBuffer this)) 431 | (size [this] 432 | (.capacity ^ByteBuffer this))) 433 | 434 | ;; ============== Events ========================================== 435 | 436 | (defrecord EventCallbackInfo [status data]) 437 | 438 | (deftype EventCallback [ch] 439 | EventCallbackFunction 440 | (function [this ev status data] 441 | (go (>! ch (->EventCallbackInfo (dec-command-execution-status status) data))))) 442 | 443 | (defn set-event-callback* 444 | "Registers a callback function for an event and a specific command 445 | execution status. Returns the channel. MUST be called AFTER the event is 446 | used in the enqueue operation. 447 | 448 | If called without `callback-type` and `data`, registers [`CL/CL_COMPLETE`] 449 | (http://www.jocl.org/doc/org/jocl/CL.html#CL_COMPLETE) status. 450 | 451 | See [[event-callback]], [[register]], [[event]]. 452 | See https://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clSetEventCallback.html, 453 | http://www.jocl.org/doc/org/jocl/CL.html#clSetEventCallback-org.jocl.cl_event-int-org.jocl.EventCallbackFunction-java.lang.Object- 454 | 455 | Example: 456 | 457 | (set-event-callback* (user-event) (event-callback) CL/CL_COMPLETE :my-data) 458 | (set-event-callback* (user-event) (event-callback)) 459 | " 460 | ([^cl_event e ^EventCallback callback ^long callback-type data] 461 | (with-check (CL/clSetEventCallback e callback-type callback data) (.ch callback))) 462 | ([^cl_event e ^EventCallback callback] 463 | (set-event-callback* e callback CL/CL_COMPLETE nil))) 464 | 465 | ;; ============= Program ========================================== 466 | 467 | (deftype BuildCallback [ch] 468 | BuildProgramFunction 469 | (function [this program data] 470 | (go (>! ch (if data data :no-user-data))))) 471 | 472 | ;; ============== Command Queue =============================== 473 | 474 | (defn command-queue* 475 | "Creates a host or device command queue on a specific device. 476 | 477 | ** If you need to support OpenCL 1.2 platforms, you MUST use the alternative 478 | [[command-queue-1*]] function. Otherwise, you will get an 479 | UnsupportedOperationException erorr. What is important is the version of the 480 | platform, not the devices. This function is for platforms (regardless of the 481 | devices) supporting OpenCL 2.0 and higher. ** 482 | 483 | Arguments are: 484 | 485 | * `ctx` - the `cl_context` for the queue; 486 | * `device` - the `cl_device_id` for the queue; 487 | * `size` - the size of the (on device) queue; 488 | * `properties` - long bitmask containing properties, defined by the OpenCL 489 | standard are available as constants in the org.jocl.CL class. 490 | 491 | This is a low-level version of [[command-queue]]. 492 | 493 | If called with invalid context or device, throws `ExceptionInfo`. 494 | 495 | See https://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clCreateCommandQueueWithProperties.html, 496 | http://www.jocl.org/doc/org/jocl/CL.html#clCreateCommandQueueWithProperties-org.jocl.cl_context-org.jocl.cl_device_id-org.jocl.cl_queue_properties-int:A- 497 | 498 | Examples: 499 | (command-queue* ctx dev 524288 (bit-or CL/CL_QUEUE_PROFILING_ENABLED 500 | CL/CL_QUEUE_ON_DEVICE)) 501 | (command-queue* ctx dev CL/CL_QUEUE_PROFILING_ENABLED) 502 | " 503 | ([^cl_context ctx ^cl_device_id device ^long properties] 504 | (command-queue* ctx device 0 properties)) 505 | ([^cl_context ctx ^cl_device_id device ^long size ^long properties] 506 | (let [err (int-array 1) 507 | props (let [clqp (cl_queue_properties.)] 508 | (when (< 0 properties) (.addProperty clqp CL/CL_QUEUE_PROPERTIES properties)) 509 | (when (< 0 size) (.addProperty clqp CL/CL_QUEUE_SIZE size)) 510 | clqp) 511 | res (CL/clCreateCommandQueueWithProperties ctx device props err)] 512 | (with-check-arr err {:device (info device)} res)))) 513 | 514 | (defn command-queue-1* 515 | "Creates a host or device command queue on a specific device. 516 | 517 | ** If you need to support legacy OpenCL 1.2 or earlier platforms, 518 | you MUST use this function instead of [command-queue*], which is for 519 | OpenCL 2.0 and higher. What is important is the version of the platform, 520 | not the devices.** 521 | 522 | Arguments are: 523 | 524 | * `ctx` - the `cl_context` for the queue; 525 | * `device` - the `cl_device_id` for the queue; 526 | * `size` - the size of the (on device) queue; 527 | * `properties` - long bitmask containing properties, defined by the OpenCL 528 | standard are available as constants in the org.jocl.CL class. 529 | 530 | This is a low-level version of [[command-queue-1]]. 531 | 532 | If called with invalid context or device, throws `ExceptionInfo`. 533 | 534 | See https://www.khronos.org/registry/cl/sdk/1.2/docs/man/xhtml/clCreateCommandQueue.html, 535 | http://www.jocl.org/doc/org/jocl/CL.html#clCreateCommandQueue-org.jocl.cl_context-org.jocl.cl_device_id-long-int:A- 536 | 537 | Examples: 538 | (command-queue-1* ctx dev 524288 (bit-or CL/CL_QUEUE_PROFILING_ENABLED 539 | CL/CL_QUEUE_ON_DEVICE)) 540 | (command-queue-1* ctx dev CL/CL_QUEUE_PROFILING_ENABLED) 541 | " 542 | ([ctx device ^long properties] 543 | (command-queue-1* ctx device 0 properties)) 544 | ([ctx device ^long size ^long properties] 545 | (let [err (int-array 1) 546 | res (CL/clCreateCommandQueue ctx device properties err)] 547 | (with-check-arr err res)))) 548 | 549 | (defn enq-map-buffer* 550 | "Enqueues a command to map a region of the cl buffer into the host 551 | address space. Returns the mapped `java.nio.ByteBuffer`. The result 552 | must be unmapped by calling [[enq-unmap!]] for the effects of working 553 | with the mapping byte buffer to be transfered back to the device memory. 554 | 555 | Arguments: 556 | 557 | * `queue` (optional): the `cl_command_queue` that maps the object. 558 | If omitted, [[*command-queue*]] will be used. 559 | * `cl`: the [[CLMem]] that is going to be mapped to. 560 | * `blocking`: whether the operation is blocking (CL/CL_TRUE) or non-blocking 561 | (CL/CL_FALSE). 562 | * `offset`: integer value of the memory offset in bytes. 563 | * `req-size`: integer value of the requested size in bytes (if larger than 564 | the available data, it will be shrinked.). 565 | * `flags`: a bitfield that indicates whether the memory is mapped for reading 566 | (`CL/CL_MAP_READ`), writing (`CL/CL_MAP_WRITE`) or both 567 | `(bit-or CL/CL_MAP_READ CL/CL_MAP_WRITE)`. 568 | * `wait-events` (optional): [[events]] array specifying the events (if any) 569 | that need to complete before this operation. 570 | * `event` (optional): if specified, the `cl_event` object tied to 571 | the execution of this operation. 572 | 573 | This is a low-level version of [[enq-map-buffer!]]. 574 | 575 | See https://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clEnqueueMapBuffer.html, 576 | http://www.jocl.org/doc/org/jocl/CL.html#clEnqueueMapBuffer-org.jocl.cl_command_queue-org.jocl.cl_mem-boolean-long-long-long-int-org.jocl.cl_event:A-org.jocl.cl_event-int:A- 577 | 578 | Examples: 579 | 580 | (enq-map-buffer* queue cl-data true 0 CL/CL_WRITE (events ev-nd) ev-map) 581 | " 582 | ^ByteBuffer [queue cl blocking offset req-size flags ^objects wait-events event] 583 | (if (< 0 ^long req-size) 584 | (let [err (int-array 1) 585 | res (CL/clEnqueueMapBuffer queue (extract cl) blocking flags offset 586 | (min ^long req-size (- ^long (size cl) ^long offset)) 587 | (if wait-events (alength wait-events) 0) 588 | wait-events event err)] 589 | (with-check-arr err (.order res (ByteOrder/nativeOrder)))) 590 | (ByteBuffer/allocateDirect 0))) 591 | 592 | (defn enq-svm-map* 593 | "Enqueues a command that will allow the host to update a region of a SVM buffer. 594 | . Returns the mapped `java.nio.ByteBuffer` (which is the same byte buffer that is 595 | already accessible through `(byte-buffer svm)`). Together with [[enq-svm-unmap!]], 596 | works as a synchronization point. 597 | 598 | Arguments: 599 | 600 | * `queue` (optional): the `cl_command_queue` that maps the object. 601 | If omitted, [[*command-queue*]] will be used. 602 | * `svm`: the [[SVMMem]] that is going to be mapped to. 603 | * `blocking`: whether the operation is blocking (CL/CL_TRUE) or non-blocking 604 | (CL/CL_FALSE). 605 | * `flags`: a bitfield that indicates whether the memory is mapped for reading 606 | (`CL/CL_MAP_READ`), writing (`CL/CL_MAP_WRITE`), both 607 | `(bit-or CL/CL_MAP_READ CL/CL_MAP_WRITE)` or `CL_MAP_WRITE_INVALIDATE_REGION`. 608 | * `wait-events` (optional): [[events]] array specifying the events (if any) 609 | that need to complete before this operation. 610 | * `event` (optional): if specified, the `cl_event` object tied to 611 | the execution of this operation. 612 | 613 | This is a low-level version of [[enq-svm-map!]]. 614 | 615 | See https://www.khronos.org/registry/cl/sdk/2.0/docs/man/xhtml/clEnqueueSVMMap.html, 616 | http://www.jocl.org/doc/org/jocl/CL.html#clEnqueueSVMMap-org.jocl.cl_command_queue-boolean-long-org.jocl.Pointer-long-int-org.jocl.cl_event:A-org.jocl.cl_event- 617 | 618 | Examples: 619 | 620 | (enq-svm-map* queue svm-data false 0 CL/CL_WRITE (events ev-nd) ev-map) 621 | " 622 | [queue svm blocking flags ^objects wait-events event] 623 | (with-check 624 | (CL/clEnqueueSVMMap queue blocking flags (ptr svm) (size svm) 625 | (if wait-events (alength wait-events) 0) 626 | wait-events event) 627 | (byte-buffer svm))) 628 | -------------------------------------------------------------------------------- /src/clojure/uncomplicate/clojurecl/internal/protocols.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | uncomplicate.clojurecl.internal.protocols) 11 | 12 | (defprotocol Wrappable 13 | (wrap [this])) 14 | 15 | (defprotocol Mem 16 | "An object that represents memory that participates in OpenCL operations. 17 | It can be on the device ([[CLMem]]), or on the host. Built-in implementations: 18 | cl buffer, Java primitive arrays and `ByteBuffer`s." 19 | (ptr [this] 20 | "JOCL `Pointer` to this object.") 21 | (size [this] 22 | "Memory size of this cl or host object in bytes.")) 23 | 24 | (defprotocol CLMem 25 | "A wrapper for `cl_mem` objects, that also holds a `Pointer` to the cl mem 26 | object, context that created it, and size in bytes. It is useful in many 27 | functions that need that (redundant in Java) data because of the C background 28 | of OpenCL functions." 29 | (enq-copy* [this queue dst src-offset dst-offset cb wait-events ev] 30 | "A specific implementation for copying this `cl-mem` object to another cl mem.") 31 | (enq-fill* [this queue pattern offset multiplier wait-events ev] 32 | "A specific implementation for filling this `cl-mem` object.")) 33 | 34 | (defprotocol SVMMem 35 | "A wrapper for SVM Buffer objects, that also holds a context that created it, 36 | `Pointer`, size in bytes, and can create a `ByteBuffer`. It is useful in many 37 | functions that need that (redundant in Java) data because of the C background 38 | of OpenCL functions." 39 | (byte-buffer [this] [this offset size] 40 | "Creates a Java `ByteBuffer` for this SVM memory.") 41 | (enq-svm-copy [this]));;TODO 42 | 43 | (defprotocol Argument 44 | "Object that can be argument in OpenCL kernels. Built-in implementations: 45 | [[CLBuffer]], java numbers, primitive arrays and `ByteBuffer`s." 46 | (set-arg [arg kernel n] 47 | "Specific implementation of setting the kernel arguments.")) 48 | -------------------------------------------------------------------------------- /src/clojure/uncomplicate/clojurecl/internal/utils.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | uncomplicate.clojurecl.internal.utils 11 | "Utility functions used as helpers in other ClojureCL namespaces. 12 | The user of the ClojureCL library would probably not need to use 13 | any of the functions defined here." 14 | (:require [uncomplicate.commons.utils :as cu] 15 | [uncomplicate.clojurecl.internal.constants :refer [dec-error]]) 16 | (:import clojure.lang.ExceptionInfo)) 17 | 18 | 19 | ;; ========== Error handling ====================================== 20 | 21 | (defn error 22 | "Converts an OpenCL error code to an [ExceptionInfo] 23 | (http://clojuredocs.org/clojure.core/ex-info) 24 | with richer, user-friendly information. 25 | 26 | Accepts a long `err-code` that should be one of the codes defined in 27 | OpenCL standard, and an optional `details` argument that could be 28 | anything that you think is informative. 29 | 30 | See the available codes in the source of [[constants/dec-error]]. 31 | Also see the discussion about 32 | [OpenCL error codes](http://streamcomputing.eu/blog/2013-04-28/opencl-1-2-error-codes/). 33 | 34 | Examples: 35 | 36 | (error 0) => an ExceptionInfo instance 37 | (error -5 {:comment \"Why here?\"\"}) => an ExceptionInfo instance 38 | " 39 | ([^long err-code details] 40 | (let [err (dec-error err-code)] 41 | (ex-info (format "OpenCL error: %s." err) 42 | {:name err :code err-code :type :opencl-error :details details}))) 43 | ([err-code] 44 | (error err-code nil))) 45 | 46 | (defmacro with-check 47 | "Evaluates `form` if `status` is not zero (`CL_SUCCESS`), otherwise throws 48 | an appropriate `ExceptionInfo` with decoded informative details. 49 | It helps fith JOCL methods that return error codes directly, while 50 | returning computation results through side-effects in arguments. 51 | 52 | Example: 53 | 54 | (with-check (some-jocl-call-that-returns-error-code) result) 55 | " 56 | ([status form] 57 | `(cu/with-check error ~status ~form)) 58 | ([status details form] 59 | `(let [status# ~status] 60 | (if (= 0 status#) 61 | ~form 62 | (throw (error status# ~details)))))) 63 | 64 | (defmacro with-check-arr 65 | "Evaluates `form` if the integer in the `status` primitive int array is `0`, 66 | Otherwise throws an exception corresponding to the error code. 67 | Similar to [[with-check]], but with the error code being held in an array instead 68 | of being a primitive number. It helps with JOCL methods that return results 69 | directly, and signal errors through side-effects in a primitive array argument. 70 | 71 | (let [err (int-array 1) 72 | res (some-jocl-call err)] 73 | (with-checl-arr err res)) 74 | " 75 | ([status form] 76 | `(with-check (aget (ints ~status) 0) ~form)) 77 | ([status details form] 78 | `(with-check (aget (ints ~status) 0) ~details ~form))) 79 | 80 | (defmacro maybe 81 | "Evaluates form in try/catch block; if an OpenCL-related exception is caught, 82 | substitutes the result with the [ExceptionInfo](http://clojuredocs.org/clojure.core/ex-info) 83 | object. 84 | Non-OpenCL exceptions are rethrown. Useful when we do not want to let a minor 85 | OpenCL error due to a driver incompatibility with the standard 86 | or an unimplemented feature in the actual driver crash the application. 87 | An [ExceptionInfo](http://clojuredocs.org/clojure.core/ex-info) object will be 88 | put in the place of the expected result." 89 | [form] 90 | `(try ~form 91 | (catch ExceptionInfo ex-info# 92 | (if (= :opencl-error (:type (ex-data ex-info#))) 93 | (:name (ex-data ex-info#)) 94 | (throw ex-info#))))) 95 | -------------------------------------------------------------------------------- /src/clojure/uncomplicate/clojurecl/toolbox.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:author "Dragan Djuric"} 10 | uncomplicate.clojurecl.toolbox 11 | "Various helpers that are not needed by ClojureCL itself, 12 | but may be very helpful in applications. See Neanderthal and Bayadera libraries 13 | for the examples of how to use them." 14 | (:require [uncomplicate.commons 15 | [core :refer [wrap-int]] 16 | [utils :refer [count-groups]]] 17 | [uncomplicate.clojurecl.core :refer :all])) 18 | 19 | (defn enq-reduce! 20 | ([queue main-kernel reduction-kernel n local-n] 21 | (loop [queue (enq-kernel! queue main-kernel (work-size-1d n local-n)) 22 | global-size (count-groups local-n n)] 23 | (if (= 1 global-size) 24 | queue 25 | (recur (enq-kernel! queue reduction-kernel (work-size-1d global-size local-n)) 26 | (count-groups local-n global-size))))) 27 | ([queue main-kernel reduction-kernel m n local-m local-n] 28 | (if (or (< 1 (long local-n)) (<= (long local-n) (long n))) 29 | (loop [queue (enq-kernel! queue main-kernel (work-size-2d m n local-m local-n)) 30 | global-size (count-groups local-n n)] 31 | (if (= 1 global-size) 32 | queue 33 | (recur (enq-kernel! queue reduction-kernel (work-size-2d m global-size local-m local-n)) 34 | (count-groups local-n global-size)))) 35 | (throw (IllegalArgumentException. 36 | (format "local-n %d would cause infinite recursion for n:%d." local-n n)))))) 37 | 38 | (defn enq-read-int ^long [queue cl-buf] 39 | (let [res (int-array 1)] 40 | (enq-read! queue cl-buf res) 41 | (aget res 0))) 42 | 43 | (defn enq-read-long ^long [queue cl-buf] 44 | (let [res (long-array 1)] 45 | (enq-read! queue cl-buf res) 46 | (aget res 0))) 47 | 48 | (defn enq-read-double ^double [queue cl-buf] 49 | (let [res (double-array 1)] 50 | (enq-read! queue cl-buf res) 51 | (aget res 0))) 52 | 53 | (defn enq-read-float ^double [queue cl-buf] 54 | (let [res (float-array 1)] 55 | (enq-read! queue cl-buf res) 56 | (aget res 0))) 57 | 58 | (defn decent-platform 59 | ([platforms] 60 | (decent-platform platforms :gpu)) 61 | ([platforms device-type] 62 | (first (filter #(< 0 (num-devices % device-type)) (remove legacy? platforms))))) 63 | -------------------------------------------------------------------------------- /src/java/org/jocl/JOCLAccessor.java: -------------------------------------------------------------------------------- 1 | // Copyright (c) Dragan Djuric. All rights reserved. 2 | // The use and distribution terms for this software are covered by the 3 | // Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | // which can be found in the file LICENSE at the root of this distribution. 5 | // By using this software in any fashion, you are agreeing to be bound by 6 | // the terms of this license. 7 | // You must not remove this notice, or any other, from this software. 8 | 9 | package org.jocl; 10 | 11 | public class JOCLAccessor { 12 | 13 | public static long getNativePointer (NativePointerObject npo) { 14 | return npo.getNativePointer(); 15 | }; 16 | } 17 | -------------------------------------------------------------------------------- /src/opencl/uncomplicate/clojurecl/kernels/reduction.cl: -------------------------------------------------------------------------------- 1 | #ifndef REAL 2 | #define REAL float 3 | #endif 4 | 5 | #ifndef ACCUMULATOR 6 | #define ACCUMULATOR float 7 | #endif 8 | 9 | #ifndef WGS 10 | #define WGS 256 11 | #endif 12 | 13 | // ================= Sum reduction ============================================= 14 | 15 | inline ACCUMULATOR work_group_reduction_sum (ACCUMULATOR* lacc, const ACCUMULATOR value) { 16 | 17 | const uint local_id = get_local_id(0); 18 | 19 | //__local ACCUMULATOR lacc[WGS]; 20 | lacc[local_id] = value; 21 | 22 | work_group_barrier(CLK_LOCAL_MEM_FENCE); 23 | 24 | ACCUMULATOR pacc = value; 25 | uint i = get_local_size(0); 26 | while (i > 0) { 27 | const bool include_odd = (i > ((i >> 1) << 1)) && (local_id == ((i >> 1) - 1)); 28 | i >>= 1; 29 | if (include_odd) { 30 | pacc += lacc[local_id + i + 1]; 31 | } 32 | if (local_id < i) { 33 | pacc += lacc[local_id + i]; 34 | lacc[local_id] = pacc; 35 | } 36 | work_group_barrier(CLK_LOCAL_MEM_FENCE); 37 | } 38 | 39 | return lacc[0]; 40 | } 41 | 42 | inline ACCUMULATOR work_group_reduction_sum_2 (ACCUMULATOR* lacc, const REAL value) { 43 | 44 | const uint local_row = get_local_id(0); 45 | const uint local_col = get_local_id(1); 46 | const uint local_m = get_local_size(0); 47 | 48 | //__local ACCUMULATOR lacc[WGS]; 49 | lacc[local_row + local_col * local_m] = value; 50 | 51 | work_group_barrier(CLK_LOCAL_MEM_FENCE); 52 | 53 | ACCUMULATOR pacc = value; 54 | uint i = get_local_size(1); 55 | while (i > 0) { 56 | const bool include_odd = (i > ((i >> 1) << 1)) && (local_col == ((i >> 1) - 1)); 57 | i >>= 1; 58 | if (include_odd) { 59 | pacc += lacc[local_row + (local_col + i + 1) * local_m]; 60 | } 61 | if (local_col < i) { 62 | pacc += lacc[local_row + (local_col + i) * local_m]; 63 | lacc[local_row + local_col * local_m] = pacc; 64 | } 65 | work_group_barrier(CLK_LOCAL_MEM_FENCE); 66 | } 67 | 68 | return lacc[local_row]; 69 | 70 | } 71 | 72 | __kernel void sum_reduction (__global ACCUMULATOR* acc) { 73 | const ACCUMULATOR sum = work_group_reduce_add(acc[get_global_id(0)]); 74 | if (get_local_id(0) == 0) { 75 | acc[get_group_id(0)] = sum; 76 | } 77 | } 78 | 79 | __kernel void sum_reduce (__global ACCUMULATOR* acc, __global const REAL* x) { 80 | const ACCUMULATOR sum = work_group_reduce_add(x[get_global_id(0)]); 81 | if (get_local_id(0) == 0) { 82 | acc[get_group_id(0)] = sum; 83 | } 84 | } 85 | 86 | 87 | __kernel void sum_reduction_horizontal (__global ACCUMULATOR* acc) { 88 | const uint i = get_global_size(0) * get_global_id(1) + get_global_id(0); 89 | const uint iacc = get_global_size(0) * get_group_id(1) + get_global_id(0); 90 | __local ACCUMULATOR lacc[WGS]; 91 | const ACCUMULATOR sum = work_group_reduction_sum_2(lacc, acc[i]); 92 | if (get_local_id(1) == 0) { 93 | acc[iacc] = sum; 94 | } 95 | } 96 | 97 | __kernel void sum_reduction_vertical (__global ACCUMULATOR* acc) { 98 | const uint i = get_global_size(1) * get_global_id(0) + get_global_id(1); 99 | const uint iacc = get_global_size(0) * get_group_id(1) + get_global_id(0); 100 | __local ACCUMULATOR lacc[WGS]; 101 | const ACCUMULATOR sum = work_group_reduction_sum_2(lacc, acc[i]); 102 | if (get_local_id(1) == 0) { 103 | acc[iacc] = sum; 104 | } 105 | } 106 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/core_test.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.core-test 10 | (:require [midje.sweet :refer :all] 11 | [uncomplicate.commons 12 | [core :refer [release with-release info]] 13 | [utils :refer [direct-buffer put-float! get-float]]] 14 | [uncomplicate.fluokitten.core :refer [fmap extract]] 15 | [uncomplicate.clojurecl 16 | [core :refer :all] 17 | [info :refer [reference-count mem-base-addr-align opencl-c-version queue-context]] 18 | [toolbox :refer [decent-platform]]] 19 | [uncomplicate.clojurecl.internal 20 | [protocols :refer [size ptr byte-buffer wrap]] 21 | [impl :refer :all]] 22 | [clojure.core.async :refer [go >! true 32 | 33 | (count (platforms)) => (num-platforms) 34 | 35 | (let [p (first (platforms))] 36 | (with-platform p (platform-info)) => (info p))) 37 | 38 | ;; ================== Device tests ======================== 39 | (facts 40 | "num-devices tests." 41 | 42 | (let [p (decent-platform (platforms))] 43 | (num-devices* p CL/CL_DEVICE_TYPE_ALL) => (num-devices p :all) 44 | 45 | (< 0 (num-devices p :all)) => true 46 | ;;(< 0 (num-devices p :cpu)) => true 47 | (< 0 (num-devices p :gpu)) => true 48 | 49 | (num-devices p :cpu :gpu :accelerator :custom) => (num-devices p :all) 50 | 51 | (+ (num-devices p :cpu) (num-devices p :gpu) 52 | (num-devices p :accelerator) #_(num-devices p :custom));;Default Nvidia no longer supports :custom 53 | => (num-devices p :all) 54 | 55 | (num-devices p) => (num-devices p :all) 56 | (with-platform p 57 | (num-devices :all) => (num-devices p :all) 58 | (num-devices) => (num-devices p :all)) 59 | 60 | ;;(num-devices nil :all) => (throws ExceptionInfo) ;;Some platforms just use first p 61 | (num-devices p :unknown-device) => (throws NullPointerException))) 62 | 63 | (facts 64 | "devices tests" 65 | 66 | (let [p (decent-platform (platforms))] 67 | ;;(vec (devices* p CL/CL_DEVICE_TYPE_ALL)) => (devices p :all) 68 | 69 | (count (devices p :all)) => (num-devices p :all) 70 | 71 | (devices p :gpu :cpu) => (concat (devices p :gpu) (devices p :cpu)) 72 | ;; (devices p :custom) => [] 73 | 74 | ;; (type (first (devices p :cpu))) => uncomplicate.clojurecl.internal.impl.CLDevice 75 | 76 | (with-platform p 77 | (devices :all) => (devices p :all) 78 | (devices :gpu) => (devices p :gpu) 79 | (devices) => (devices p :all)) 80 | 81 | ;;(devices nil :all) => (throws ExceptionInfo);;Some platforms just use first p 82 | (devices p :unknown-device) => (throws NullPointerException))) 83 | 84 | (facts 85 | "Root level devices resource management." 86 | 87 | (let [p (decent-platform (platforms)) 88 | da (first (devices p)) 89 | db (first (devices p))] 90 | (reference-count da) => 1 91 | (reference-count db) => 1)) 92 | 93 | ;; ================== Context tests ======================== 94 | 95 | (set! *warn-on-reflection* false) 96 | (facts 97 | "CreateContextCallback tests" 98 | (let [ch (chan)] 99 | (->CreateContextCallback ch) =not=> nil 100 | (do (.function (->CreateContextCallback ch) "Some error" 101 | (Pointer/to (int-array 1)) Integer/BYTES :some-data) 102 | (:errinfo ( "Some error"))) 103 | (set! *warn-on-reflection* true) 104 | 105 | (let [p (decent-platform (platforms))] 106 | (with-platform p 107 | (with-release [devs (devices p) 108 | dev (first (filter #(<= 2.0 (double (:version (opencl-c-version %)))) devs))] 109 | 110 | (facts 111 | "context-properties tests" 112 | (context-properties {:platform p}) =not=> nil) 113 | 114 | (facts 115 | "context tests" 116 | 117 | (let [adevs (devices* p CL/CL_DEVICE_TYPE_ALL) 118 | props (context-properties {:platform p})] 119 | 120 | (let [ctx (wrap (context* adevs nil nil nil))] 121 | (reference-count ctx) => 1 122 | (release ctx) => true) 123 | 124 | (let [ctx (wrap (context* adevs props nil nil))] 125 | (reference-count ctx) => 1 126 | (release ctx) => true) 127 | 128 | ;; TODO I am not sure how this CreateContextFunction mechanism work. 129 | ;; It is implemented, but I do not know how to raise an error that 130 | ;; shoud then reported through the channel. Test it later.) 131 | 132 | (let [ch (chan) 133 | ctx (wrap (context* adevs props ch :some-data))] 134 | (reference-count ctx) => 1 135 | (command-queue ctx nil) => (throws ExceptionInfo)) 136 | 137 | (context* nil nil nil nil) => (throws NullPointerException) 138 | (context* (make-array cl_device_id 0) nil nil nil) => (throws ExceptionInfo) 139 | 140 | (let [ctx (context)] 141 | (reference-count ctx) => 1 142 | (release ctx) => true) 143 | 144 | (context nil) => (throws ExceptionInfo) 145 | 146 | (let [ctx (context [dev])] 147 | (reference-count ctx) => 1 148 | (release ctx) => true) 149 | 150 | (release (context devs)) => true 151 | (release (context devs {:platform p} (chan) :some-data)) => true)) 152 | 153 | (facts 154 | "queue tests" 155 | (with-release [ctx (context devs) 156 | cl-data (cl-buffer ctx Float/BYTES :read-write)] 157 | (let [queue (command-queue ctx dev)] 158 | (reference-count queue) => 1 159 | (queue-context queue) => ctx 160 | (info queue :properties) => #{} 161 | (release queue) => true) 162 | 163 | (let [queue (wrap (command-queue* (extract ctx) (extract dev) 0))] 164 | (reference-count queue) => 1 165 | (queue-context queue) => ctx 166 | (info queue :properties) => #{} 167 | (type (info queue :size)) => String 168 | (release queue) => true) 169 | 170 | (let [queue (wrap (command-queue* (extract ctx) (extract dev) 0 5))] 171 | (reference-count queue) => 1 172 | (queue-context queue) => ctx 173 | (info queue :properties) => #{:queue-on-device :out-of-order-exec-mode} 174 | (info queue :size) => (info dev :queue-on-device-preferred-size) 175 | (release queue) => true) 176 | 177 | (with-context (context devs) 178 | (let [queue (command-queue dev)] 179 | (reference-count queue) => 1 180 | (queue-context queue) => *context* 181 | (info queue :properties) => #{} 182 | (release queue) => true)) 183 | 184 | (let [queue (command-queue ctx dev :queue-on-device :out-of-order-exec-mode :profiling)] 185 | (reference-count queue) => 1 186 | (queue-context queue) => ctx 187 | (info queue :properties) => #{:profiling :out-of-order-exec-mode 188 | :queue-on-device} 189 | (release queue) => true) 190 | 191 | (let [queue (command-queue ctx dev 524288 :queue-on-device :out-of-order-exec-mode :profiling)] 192 | (reference-count queue) => 1 193 | (queue-context queue) => ctx 194 | (info queue :properties) => #{:profiling :out-of-order-exec-mode :queue-on-device} 195 | (info queue :size) => 524288 196 | (release queue) => true) 197 | 198 | (command-queue ctx nil) => (throws ExceptionInfo) 199 | (command-queue nil dev) => (throws ExceptionInfo) 200 | (command-queue ctx dev :my-prop) => (throws NullPointerException)))))) 201 | 202 | (with-default 203 | 204 | (facts 205 | "cl-buffer and cl-sub-buffer reading/writing tests." 206 | (let [alignment (mem-base-addr-align 207 | (first (filter #(<= 2.0 (double (:version (opencl-c-version %)))) 208 | (devices (decent-platform (platforms))))))] 209 | (with-release [cl-buf (cl-buffer (* 4 alignment Float/BYTES)) 210 | cl-subbuf (cl-sub-buffer cl-buf (* alignment Float/BYTES) (* alignment Float/BYTES))] 211 | (cl-buffer? cl-subbuf) => true 212 | (let [data-arr (float-array (range (* 4 alignment))) 213 | buf-arr (float-array (* 4 alignment)) 214 | subbuf-arr (float-array alignment)] 215 | (enq-write! cl-buf data-arr) 216 | (enq-read! cl-buf buf-arr) 217 | (enq-read! cl-subbuf subbuf-arr) 218 | (vec buf-arr) => (vec data-arr) 219 | (vec subbuf-arr) => (map float (range alignment (* 2 alignment))))))) 220 | 221 | (facts 222 | "Event tests." 223 | (event) =not=> nil 224 | (host-event nil) => (throws ExceptionInfo) 225 | (host-event) =not=> nil 226 | 227 | (alength (events (host-event) (host-event))) => 2 228 | (alength ^objects (apply events (for [n (range 10)] (host-event)))) => 10) 229 | 230 | (facts 231 | "EventCallback tests" 232 | (let [ch (chan) 233 | ev (host-event) 234 | call-event-fun (fn [^EventCallbackFunction f] (.function f (extract ev) CL/CL_QUEUED ev))] 235 | (->EventCallback ch) =not=> nil 236 | (do (call-event-fun (->EventCallback ch)) 237 | (:data ( ev)) 238 | 239 | (with-release [cl-buf (cl-buffer Float/BYTES) 240 | cpu-buf (put-float! (direct-buffer Float/BYTES) 0 1.0)] 241 | (let [ev (event) 242 | notifications (chan) 243 | follow (register notifications)] 244 | (enq-write! *command-queue* cl-buf cpu-buf ev) 245 | (follow ev) 246 | (:data ( ev))) 247 | 248 | (let [src (slurp "test/opencl/core_test.cl") 249 | cnt 8 250 | data (float cnt) 251 | notifications (chan) 252 | follow (register notifications)] 253 | 254 | (facts 255 | "Program tests" 256 | (with-release [program (build-program! (program-with-source [src]))] 257 | program =not=> nil 258 | (info program :source) => src)) 259 | 260 | (with-release [program (build-program! (program-with-source [src]) nil "-cl-std=CL2.0" 261 | notifications :my-data)] 262 | (facts 263 | "Program build tests." 264 | program =not=> nil 265 | (info program :source) => src 266 | ( :my-data) 267 | 268 | ;; TODO Some procedures might crash JVM if called on 269 | ;; unprepared objects (kernels of unbuilt program). 270 | ;; Solve and test such cases systematically in info.clj 271 | ;; in a similar way as kernels check for program binaries first. 272 | 273 | (facts 274 | (info (program-with-source [src])) =not=> nil) 275 | 276 | (with-release [dumb-kernel (kernel program "dumb_kernel") 277 | all-kernels (kernel program) 278 | cl-data (cl-buffer (* cnt Float/BYTES)) 279 | cl-copy-data (cl-buffer (size cl-data))] 280 | (facts 281 | "Kernel tests" 282 | (num-kernels program) => 1 283 | 284 | (info dumb-kernel :name) => (info (first all-kernels) :name) 285 | (kernel nil) => (throws ExceptionInfo) 286 | 287 | (set-arg! dumb-kernel 0 nil) => (throws IllegalArgumentException) 288 | 289 | (set-arg! dumb-kernel 0 cl-data) => dumb-kernel 290 | (set-arg! dumb-kernel 1 Integer/BYTES) => dumb-kernel 291 | (set-arg! dumb-kernel 2 (int-array [42])) => dumb-kernel 292 | 293 | (set-args! dumb-kernel cl-data Integer/BYTES) => dumb-kernel) 294 | 295 | (let [wsize (work-size [cnt]) 296 | data (float-array (range cnt)) 297 | copy-data (float-array cnt)] 298 | (facts 299 | "enq-kernel!, enq-read!, enq-write!, enq-copy! enq-fill tests" 300 | (enq-write! cl-data data) => *command-queue* 301 | (enq-kernel! dumb-kernel wsize) => *command-queue* 302 | (enq-read! cl-data data) => *command-queue* 303 | (vec data) => [84.0 86.0 88.0 90.0 92.0 94.0 96.0 98.0] 304 | (enq-copy! cl-data cl-copy-data) => *command-queue* 305 | (enq-read! cl-copy-data copy-data) => *command-queue* 306 | (vec copy-data) => (vec data) 307 | (enq-fill! cl-data (float-array [1 2 3 4])) => *command-queue* 308 | (enq-read! cl-data data) => *command-queue* 309 | (vec data) => [1.0 2.0 3.0 4.0 1.0 2.0 3.0 4.0])))))) 310 | 311 | (let [cnt 8 312 | src (slurp "test/opencl/core_test.cl") 313 | data (let [d (direct-buffer (* 8 Float/BYTES))] 314 | (dotimes [n cnt] 315 | (put-float! d n n)) 316 | d) 317 | notifications (chan) 318 | follow (register notifications) 319 | ev-nd1 (event) 320 | ev-nd2 (event) 321 | ev-read (event) 322 | ev-write (event) 323 | wsize (work-size [8])] 324 | 325 | (with-release [devs (devices (decent-platform (platforms))) 326 | ctx (context devs) 327 | queue1 (command-queue ctx (first devs)) 328 | queue2 (command-queue ctx (first devs)) 329 | cl-data (cl-buffer ctx (* cnt Float/BYTES) :read-write) 330 | program (build-program! (program-with-source ctx [src])) 331 | dumb-kernel (kernel program "dumb_kernel")] 332 | 333 | (facts 334 | "wait-events tests" 335 | (set-args! dumb-kernel cl-data Integer/BYTES (int-array [42])) 336 | (enq-write! queue1 cl-data data ev-write) 337 | (enq-kernel! queue1 dumb-kernel wsize (events ev-write) ev-nd1) 338 | (enq-kernel! queue2 dumb-kernel wsize (events ev-write ev-nd1) ev-nd2) 339 | (enq-read! queue1 cl-data data (events ev-nd2) ev-read) 340 | (follow ev-read) 341 | 342 | (:data ( ev-read 343 | 344 | (vec (let [res (float-array cnt)] (.get (.asFloatBuffer ^ByteBuffer data) res) res)) 345 | => [168.0 171.0 174.0 177.0 180.0 183.0 186.0 189.0] 346 | 347 | (let [mapped-read (enq-map-buffer! queue1 cl-data :read) 348 | mapped-write (enq-map-buffer! queue1 cl-data :write)] 349 | (get-float mapped-read 1) => 171.0 350 | (get-float mapped-write 1) => 171.0 351 | (do (put-float! mapped-write 1 100.0) (get-float mapped-write 1)) => 100.0 352 | (get-float ^ByteBuffer mapped-read 1) => 100.0 353 | (do (put-float! mapped-read 1 100.0) (get-float mapped-read 1)) => 100.0 354 | (enq-unmap! queue1 cl-data mapped-read) => queue1 355 | (enq-unmap! queue1 cl-data mapped-write) => queue1))) 356 | 357 | (with-release [dev (first (filter #(= 2.0 (:version (opencl-c-version %))) 358 | (devices (decent-platform (platforms)) :gpu))) 359 | ctx (context [dev]) 360 | queue (command-queue ctx dev) 361 | svm (svm-buffer ctx (* cnt Float/BYTES) 0) 362 | program (build-program! (program-with-source ctx [src]) "-cl-std=CL2.0" nil) 363 | dumb-kernel (kernel program "dumb_kernel")] 364 | (facts 365 | "SVM tests" ;; ONLY BASIC TESTS, since i do not have an APU, and 366 | ;; my current platform (AMD) only supports OpenCL 1.2 for the CPU. 367 | (ptr svm) =not=> nil 368 | (set-args! dumb-kernel svm Integer/BYTES (int-array [42])) => dumb-kernel 369 | (enq-svm-map! queue svm :write) 370 | (put-float! (byte-buffer svm) 1 42.0) 371 | (get-float (byte-buffer svm) 1) => 42.0 372 | (enq-svm-unmap! queue svm) => queue 373 | (enq-kernel! queue dumb-kernel wsize) => queue 374 | (enq-svm-map! queue svm :read) 375 | (get-float (byte-buffer svm) 1) => 127.0 376 | (enq-svm-unmap! queue svm) => queue 377 | 378 | (svm-buffer* nil 4 0) => (throws IllegalArgumentException) 379 | (svm-buffer* (extract ctx) 0 0) => (throws IllegalArgumentException) 380 | (svm-buffer ctx 4 0 :invalid-flag) => (throws NullPointerException)))) 381 | 382 | (with-default-1 383 | (facts "Legacy bindings" 384 | *context* => truthy 385 | *command-queue* => truthy)) 386 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/examples/jocl/hello_test.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.examples.jocl.hello-test 10 | (:require [midje.sweet :refer :all] 11 | [uncomplicate.commons 12 | [core :refer [with-release]] 13 | [utils :refer [put-float! get-float]]] 14 | [uncomplicate.clojurecl.core :refer :all] 15 | [uncomplicate.clojurecl.toolbox :refer [decent-platform]])) 16 | 17 | (def program-source (slurp "test/opencl/examples/jocl/hello-kernel.cl")) 18 | 19 | (let [n 100 20 | bytesize (* (long n) Float/BYTES) 21 | src-array-a (float-array (range n)) 22 | src-array-b (float-array (range n)) 23 | dest-array (float-array n) 24 | work-sizes (work-size [n] [1])] 25 | (with-release [devs (devices (decent-platform (platforms))) 26 | dev (first devs) 27 | ctx (context devs) 28 | cqueue (command-queue ctx dev) 29 | mem-objects [(cl-buffer ctx bytesize :read-only) 30 | (cl-buffer ctx bytesize :read-only) 31 | (cl-buffer ctx bytesize :write-only)] 32 | prog (build-program! (program-with-source ctx [program-source])) 33 | sample-kernel (kernel prog "sampleKernel")] 34 | 35 | (facts 36 | 37 | (apply set-args! sample-kernel mem-objects) => sample-kernel 38 | 39 | (-> cqueue 40 | (enq-write! (mem-objects 0) src-array-a) 41 | (enq-write! (mem-objects 1) src-array-b) 42 | (enq-kernel! sample-kernel work-sizes) 43 | (enq-read! (mem-objects 2) dest-array)) 44 | => cqueue 45 | 46 | (finish! cqueue) 47 | (seq dest-array) => (map float (range 0 200 2))) 48 | 49 | (with-release [mem-object-a (cl-buffer ctx bytesize :read-only) 50 | mem-object-b (cl-buffer ctx bytesize :read-only) 51 | mem-object-dest (cl-buffer ctx bytesize :read-only)] 52 | 53 | (let [src-buffer-a (enq-map-buffer! cqueue mem-object-a :write)] 54 | (put-float! src-buffer-a 0 46) 55 | (put-float! src-buffer-a 1 100) 56 | (enq-unmap! cqueue mem-object-a src-buffer-a)) 57 | 58 | (let [src-buffer-b (enq-map-buffer! cqueue mem-object-b :write)] 59 | (put-float! src-buffer-b 0 56) 60 | (put-float! src-buffer-b 1 200) 61 | (enq-unmap! cqueue mem-object-b src-buffer-b)) 62 | 63 | (facts 64 | (set-arg! sample-kernel 0 mem-object-a) => sample-kernel 65 | (set-arg! sample-kernel 1 mem-object-b) => sample-kernel 66 | (set-arg! sample-kernel 2 mem-object-dest) => sample-kernel 67 | 68 | (enq-kernel! cqueue sample-kernel work-sizes) => cqueue 69 | 70 | (let [dest-buffer (enq-map-buffer! cqueue mem-object-dest :read)] 71 | (get-float dest-buffer 0) => 102.0 72 | (get-float dest-buffer 1) => 300.0 73 | (enq-unmap! cqueue mem-object-dest dest-buffer) => cqueue))))) 74 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/examples/openclinaction/ch04.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.examples.openclinaction.ch04 10 | (:require [midje.sweet :refer :all] 11 | [clojure.java.io :as io] 12 | [clojure.core.async :refer [chan hello-kernel 40 | (enq-kernel! cqueue hello-kernel work-sizes) => cqueue 41 | (enq-read! cqueue cl-msg host-msg read-complete) => cqueue 42 | (follow read-complete host-msg) => notifications 43 | (let [data ^java.nio.ByteBuffer (:data ( "Hello kernel!!!\0"))) 48 | 49 | (facts 50 | "Section 4.2, Page 72." 51 | (let [host-a (float-array [10]) 52 | host-b (float-array [2]) 53 | host-out (float-array 1) 54 | work-sizes (work-size [1]) 55 | program-source 56 | (slurp (io/resource "examples/openclinaction/ch04/double-test.cl"))] 57 | (with-release [cl-a (cl-buffer ctx (* 2 Float/BYTES) :read-only) 58 | cl-b (cl-buffer ctx (* 2 Float/BYTES) :read-only) 59 | cl-out (cl-buffer ctx (* 2 Float/BYTES) :write-only) 60 | prog (build-program! (program-with-source ctx [program-source]) 61 | (if (contains? (info dev :extensions) 62 | "cl_khr_fp64") 63 | "-DFP_64" 64 | "") 65 | notifications) 66 | double-test (kernel prog "double_test")] 67 | 68 | (set-args! double-test cl-a cl-b cl-out) => double-test 69 | (enq-write! cqueue cl-a host-a) => cqueue 70 | (enq-write! cqueue cl-b host-b) => cqueue 71 | (enq-kernel! cqueue double-test work-sizes) => cqueue 72 | (enq-read! cqueue cl-out host-out) => cqueue 73 | (seq host-out) => (map / host-a host-b)))) 74 | 75 | (facts 76 | "Section 4.3, Page 77." 77 | (println "Single FP Config: " (info dev :single-fp-config))) 78 | 79 | (facts 80 | "Section 4.4.1, Page 79." 81 | (println "Preferred vector widths: " 82 | (select-keys (info dev) [:preferred-vector-width-char 83 | :preferred-vector-width-short 84 | :preferred-vector-width-int 85 | :preferred-vector-width-long 86 | :preferred-vector-width-float 87 | :preferred-vector-width-double 88 | :preferred-vector-width-long]))) 89 | 90 | (facts 91 | "Section 4.4.4, Page 85." 92 | (let [host-data (byte-array 16) 93 | work-sizes (work-size [1]) 94 | program-source 95 | (slurp (io/resource "examples/openclinaction/ch04/vector-bytes.cl"))] 96 | (with-release [cl-data (cl-buffer ctx 16 :write-only) 97 | prog (build-program! (program-with-source ctx [program-source])) 98 | vector-bytes (kernel prog "vector_bytes")] 99 | 100 | (set-args! vector-bytes cl-data) => vector-bytes 101 | (enq-write! cqueue cl-data host-data) => cqueue 102 | (enq-kernel! cqueue vector-bytes work-sizes) => cqueue 103 | (enq-read! cqueue cl-data host-data) => cqueue 104 | (seq host-data) => (if (endian-little dev) 105 | [3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12] 106 | (range 16))))))) 107 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/examples/openclinaction/ch05.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.examples.openclinaction.ch05 10 | (:require [midje.sweet :refer :all] 11 | [clojure.java.io :as io] 12 | [uncomplicate.commons.core :refer [with-release info]] 13 | [uncomplicate.clojurecl 14 | [core :refer :all] 15 | [toolbox :refer [decent-platform]]])) 16 | 17 | (with-release [dev (first (devices (decent-platform (platforms)))) 18 | ctx (context [dev]) 19 | cqueue (command-queue ctx dev)] 20 | 21 | (facts 22 | "Listing 5.1, Page 96." 23 | (let [host-output (int-array 4) 24 | work-sizes (work-size [1]) 25 | program-source 26 | (slurp (io/resource "examples/openclinaction/ch05/op-test.cl"))] 27 | (with-release [cl-output (cl-buffer ctx (* 4 Integer/BYTES) :write-only) 28 | prog (build-program! (program-with-source ctx [program-source])) 29 | op-test-kernel (kernel prog "op_test")] 30 | 31 | (set-args! op-test-kernel cl-output) => op-test-kernel 32 | (enq-kernel! cqueue op-test-kernel work-sizes) => cqueue 33 | (enq-read! cqueue cl-output host-output) => cqueue 34 | (vec host-output) => [-1 0 0 4]))) 35 | 36 | (facts 37 | "Listing 5.2, Page 100." 38 | (let [host-output (float-array 24) 39 | work-sizes (work-size [6 4] [3 2] [3 5]) 40 | program-source 41 | (slurp (io/resource "examples/openclinaction/ch05/id-check.cl"))] 42 | (with-release [cl-output (cl-buffer ctx (* 24 Float/BYTES) :write-only) 43 | prog (build-program! (program-with-source ctx [program-source])) 44 | id-check-kernel (kernel prog "id_check")] 45 | 46 | (set-args! id-check-kernel cl-output) => id-check-kernel 47 | (enq-kernel! cqueue id-check-kernel work-sizes) => cqueue 48 | (enq-read! cqueue cl-output host-output) => cqueue 49 | (seq host-output) 50 | => (just (roughly 35.0) (roughly 45.1) (roughly 55.2) 51 | (roughly 65.0) (roughly 75.1) (roughly 85.2) 52 | (roughly 36.01) (roughly 46.109997) (roughly 56.21) 53 | (roughly 66.01) (roughly 76.11) (roughly 86.21) 54 | (roughly 37.0) (roughly 47.1) (roughly 57.2) 55 | (roughly 67.0) (roughly 77.1) (roughly 87.2) 56 | (roughly 38.01) (roughly 48.109997) (roughly 58.21) 57 | (roughly 68.01) (roughly 78.11) (roughly 88.21))))) 58 | 59 | (facts 60 | "Listing 5.3, Page 104." 61 | (let [host-mod-input (float-array [317 23]) 62 | host-mod-output (float-array 2) 63 | host-round-input (float-array [6.5 -3.5 3.5 6.5]) 64 | host-round-output (float-array 20) 65 | work-sizes (work-size [1]) 66 | program-source 67 | (slurp (io/resource "examples/openclinaction/ch05/mod-round.cl"))] 68 | (with-release [cl-mod-input (cl-buffer ctx (* 2 Float/BYTES) :read-only) 69 | cl-mod-output (cl-buffer ctx (* 2 Float/BYTES) :write-only) 70 | cl-round-input (cl-buffer ctx (* 20 Float/BYTES) :read-only) 71 | cl-round-output (cl-buffer ctx (* 20 Float/BYTES) :write-only) 72 | prog (build-program! (program-with-source ctx [program-source])) 73 | mod-round-kernel (kernel prog "mod_round")] 74 | 75 | (set-args! mod-round-kernel cl-mod-input cl-mod-output 76 | cl-round-input cl-round-output) 77 | => mod-round-kernel 78 | (enq-write! cqueue cl-mod-input host-mod-input) => cqueue 79 | (enq-write! cqueue cl-round-input host-round-input) => cqueue 80 | (enq-kernel! cqueue mod-round-kernel work-sizes) => cqueue 81 | (enq-read! cqueue cl-mod-output host-mod-output) => cqueue 82 | (enq-read! cqueue cl-round-output host-round-output) => cqueue 83 | (seq host-mod-output) => '(18.0 -5.0) 84 | (vec host-round-output) => [6.0 -4.0 4.0 6.0 85 | 7.0 -4.0 4.0 7.0 86 | 7.0 -3.0 4.0 7.0 87 | 6.0 -4.0 3.0 6.0 88 | 6.0 -3.0 3.0 6.0]))) 89 | 90 | (facts 91 | "Listing 5.4, Page 108." 92 | (let [rvals (float-array [2 1 3 4]) 93 | angles (float-array [(* (double 3/8) Math/PI) (* (double 3/4) Math/PI) 94 | (* (double 4/3) Math/PI) (* (double 11/6) Math/PI)]) 95 | xcoords (float-array 4) 96 | ycoords (float-array 4) 97 | work-sizes (work-size [1]) 98 | program-source 99 | (slurp (io/resource "examples/openclinaction/ch05/polar-rect.cl"))] 100 | (with-release [cl-rvals (cl-buffer ctx (* 4 Float/BYTES) :read-only) 101 | cl-angles (cl-buffer ctx (* 4 Float/BYTES) :read-only) 102 | cl-xcoords (cl-buffer ctx (* 4 Float/BYTES) :write-only) 103 | cl-ycoords (cl-buffer ctx (* 4 Float/BYTES) :write-only) 104 | prog (build-program! (program-with-source ctx [program-source])) 105 | polar-rect-kernel (kernel prog "polar_rect")] 106 | 107 | (set-args! polar-rect-kernel cl-rvals cl-angles cl-xcoords cl-ycoords) 108 | => polar-rect-kernel 109 | (enq-write! cqueue cl-rvals rvals) => cqueue 110 | (enq-write! cqueue cl-angles angles) => cqueue 111 | (enq-kernel! cqueue polar-rect-kernel work-sizes) => cqueue 112 | (enq-read! cqueue cl-xcoords xcoords) => cqueue 113 | (enq-read! cqueue cl-ycoords ycoords) => cqueue 114 | (seq xcoords) => (just (roughly 0.76536685) (roughly -0.70710677) 115 | (roughly -1.4999998) (roughly 3.4641013)) 116 | (seq ycoords) => (just (roughly 1.847759) (roughly 0.70710677) 117 | (roughly -2.5980763) (roughly -2.0000007))))) 118 | 119 | (facts 120 | "Listing 5.5, Page 112." 121 | (let [output (int-array 2) 122 | work-sizes (work-size [1]) 123 | program-source 124 | (slurp (io/resource "examples/openclinaction/ch05/mad-test.cl"))] 125 | (with-release [cl-output (cl-buffer ctx (* 2 Integer/BYTES) :write-only) 126 | prog (build-program! (program-with-source ctx [program-source])) 127 | mad-test-kernel (kernel prog "mad_test")] 128 | 129 | (set-args! mad-test-kernel cl-output) => mad-test-kernel 130 | (enq-kernel! cqueue mad-test-kernel work-sizes) => cqueue 131 | (enq-read! cqueue cl-output output) => cqueue 132 | (vec output) => [-396694989 1118792]))) 133 | 134 | (facts 135 | "Listing 5.6, Page 116." 136 | (let [s1 (float-array 4) 137 | s2 (byte-array 2) 138 | work-sizes (work-size [1]) 139 | program-source 140 | (slurp (io/resource "examples/openclinaction/ch05/select-test.cl"))] 141 | (with-release [cl-s1 (cl-buffer ctx (* 4 Float/BYTES) :write-only) 142 | cl-s2 (cl-buffer ctx 8 :write-only) 143 | prog (build-program! (program-with-source ctx [program-source])) 144 | select-test-kernel (kernel prog "select_test")] 145 | 146 | (set-args! select-test-kernel cl-s1 cl-s2) => select-test-kernel 147 | (enq-kernel! cqueue select-test-kernel work-sizes) => cqueue 148 | (enq-read! cqueue cl-s1 s1) => cqueue 149 | (enq-read! cqueue cl-s2 s2) => cqueue 150 | (vec s1) => [1.25 0.5 1.75 1.0] 151 | (vec s2) => [2r00100111 2r00011011])))) 152 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/examples/openclinaction/ch07.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.examples.openclinaction.ch07 10 | (:require [midje.sweet :refer :all] 11 | [clojure.java.io :as io] 12 | [clojure.core.async :refer [ user-event-kernel 41 | (enq-kernel! cqueue user-event-kernel work-sizes (events user-event) kernel-event) 42 | => cqueue 43 | (enq-read! cqueue cl-v v (events kernel-event) read-event) => cqueue 44 | (follow read-event) => notifications 45 | (set-status! user-event) => user-event 46 | (:data ( read-event)))) 47 | 48 | (facts 49 | "Listing 7.6. Page 155." 50 | (let [program-source 51 | (slurp (io/resource "examples/openclinaction/ch07/profile-read.cl")) 52 | bytesize (Math/pow 2 20) 53 | notifications (chan) 54 | follow (register notifications) 55 | data (direct-buffer bytesize) 56 | num (int-array [(/ (long bytesize) 16)]) 57 | work-sizes (work-size [1])] 58 | (with-release [cl-data (cl-buffer ctx bytesize :write-only) 59 | prog (build-program! (program-with-source ctx [program-source])) 60 | profile-read (kernel prog "profile_read") 61 | profile-event (event)] 62 | (facts 63 | (set-args! profile-read cl-data num) => profile-read 64 | 65 | (enq-kernel! cqueue profile-read work-sizes) 66 | (enq-read! cqueue cl-data data profile-event) 67 | (follow profile-event) 68 | 69 | (< 10000 70 | (-> ( true)))) 73 | 74 | (facts 75 | "Listing 7.7. Page 157." 76 | (let [program-source 77 | (slurp (io/resource "examples/openclinaction/ch07/profile-items.cl")) 78 | num-ints 65536 79 | data (int-array (range num-ints)) 80 | notifications (chan) 81 | follow (register notifications) 82 | work-sizes (work-size [512] [1])] 83 | (with-release [cl-x (cl-buffer ctx (* num-ints Integer/BYTES 4) :write-only) 84 | prog (build-program! (program-with-source ctx [program-source])) 85 | profile-items (kernel prog "profile_items") 86 | profile-event (event)] 87 | (facts 88 | (set-args! profile-items cl-x (int-array [num-ints])) => profile-items 89 | (enq-kernel! cqueue profile-items work-sizes nil profile-event) 90 | (follow profile-event) 91 | 92 | (< 10000 93 | (-> ( true))))) 96 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/examples/openclinaction/ch10.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.examples.openclinaction.ch10 10 | (:require [midje.sweet :refer :all] 11 | [clojure.java.io :as io] 12 | [clojure.core.async :refer [chan naive-reduction 57 | (enq-write! cqueue cl-data data) => cqueue 58 | (enq-kernel! cqueue naive-reduction (work-size [1]) nil profile-event) 59 | => cqueue 60 | (follow profile-event) => notifications 61 | (enq-read! cqueue cl-output output) => cqueue 62 | (finish! cqueue) => cqueue 63 | (println "Naive reduction time:" 64 | (-> ( num-items 66 | ;; ============= Scalar reduction ==================================== 67 | (set-args! reduction-scalar cl-data cl-partial-sums cl-partial-output) 68 | => reduction-scalar 69 | (enq-kernel! cqueue reduction-scalar 70 | (work-size [num-items] [workgroup-size]) 71 | nil profile-event) 72 | (follow profile-event) 73 | (enq-read! cqueue cl-partial-output partial-output) 74 | (finish! cqueue) 75 | (println "Scalar reduction time:" 76 | (-> ( workgroup-size 78 | ;; =============== Vector reduction ================================== 79 | (set-args! reduction-vector cl-data cl-partial-sums cl-partial-output) 80 | => reduction-vector 81 | (enq-kernel! cqueue reduction-vector 82 | (work-size [(/ num-items 4)] [workgroup-size]) 83 | nil profile-event1) 84 | (follow profile-event1) 85 | (set-args! reduction-vector cl-partial-output cl-partial-sums cl-partial-output) 86 | => reduction-vector 87 | (enq-kernel! cqueue reduction-vector 88 | (work-size [(/ num-items 4 workgroup-size 4)] [workgroup-size]) 89 | nil profile-event2) 90 | (follow profile-event2) 91 | (enq-read! cqueue cl-partial-output partial-output) 92 | (finish! cqueue) 93 | (println "Vector reduction time:" 94 | (-> ( ( num-items))))) 97 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/examples/openclinaction/ch11.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.examples.openclinaction.ch11 10 | (:require [midje.sweet :refer :all] 11 | [clojure.java.io :as io] 12 | [clojure.core.async :refer [chan string-search 50 | (enq-write! cqueue cl-text kafka) => cqueue 51 | (enq-write! cqueue cl-result result) => cqueue 52 | (enq-kernel! cqueue string-search work-size) => cqueue 53 | (enq-read! cqueue cl-result result) => cqueue 54 | (finish! cqueue) => cqueue 55 | (vec result) => [330 237 110 116]))))) 56 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/toolbox_test.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.toolbox-test 10 | (:require [midje.sweet :refer :all] 11 | [uncomplicate.commons 12 | [core :refer [release with-release]] 13 | [utils :refer [direct-buffer count-groups]]] 14 | [uncomplicate.clojurecl 15 | [core :refer :all] 16 | [info :refer :all] 17 | [toolbox :refer :all]]) 18 | (:import java.nio.ByteBuffer)) 19 | 20 | (let [cnt-m 311 21 | cnt-n 9011 22 | cnt (* cnt-m cnt-n) 23 | program-source [(slurp "src/opencl/uncomplicate/clojurecl/kernels/reduction.cl") 24 | (slurp "test/opencl/toolbox_test.cl")]] 25 | 26 | (with-release [dev (first (devices (decent-platform (platforms)))) 27 | ctx (context [dev]) 28 | queue (command-queue ctx dev) 29 | wgs (max-work-group-size dev) 30 | program (build-program! (program-with-source ctx program-source) 31 | (format "-cl-std=CL2.0 -DREAL=float -DACCUMULATOR=double -DWGS=%d" wgs) 32 | nil) 33 | data (let [d (direct-buffer (* cnt Float/BYTES))] 34 | (dotimes [n cnt] 35 | (.putFloat ^ByteBuffer d (* n Float/BYTES) (float n))) 36 | d) 37 | cl-data (cl-buffer ctx (* cnt Float/BYTES) :read-only)] 38 | 39 | (enq-write! queue cl-data data) 40 | 41 | (let [acc-size (* Double/BYTES (max 1 (count-groups (max-work-group-size dev) cnt)))] 42 | (with-release [sum-reduction-kernel (kernel program "sum_reduction") 43 | sum-reduce-kernel (kernel program "sum_reduce") 44 | cl-acc (cl-buffer ctx acc-size :read-write)] 45 | 46 | (facts 47 | "Test 1D reduction." 48 | (set-arg! sum-reduction-kernel 0 cl-acc) 49 | (set-args! sum-reduce-kernel cl-acc cl-data) 50 | (enq-reduce! queue sum-reduce-kernel sum-reduction-kernel cnt wgs) 51 | (enq-read-double queue cl-acc) => 3926780329408.0))) 52 | 53 | (let [wgs-m 4 54 | wgs-n 32 55 | acc-size (* Double/BYTES (max 1 (* cnt-m (count-groups wgs-n cnt-n)))) 56 | res (double-array cnt-m)] 57 | (with-release [sum-reduction-horizontal (kernel program "sum_reduction_horizontal") 58 | sum-reduce-horizontal (kernel program "sum_reduce_horizontal") 59 | cl-acc (cl-buffer ctx acc-size :read-write)] 60 | 61 | (facts 62 | (set-arg! sum-reduction-horizontal 0 cl-acc) 63 | (set-args! sum-reduce-horizontal cl-acc cl-data) 64 | (enq-reduce! queue sum-reduce-horizontal sum-reduction-horizontal cnt-m cnt-n wgs-m wgs-n) 65 | (enq-read! queue cl-acc res) 66 | (apply + (seq res)) => (roughly 3.92678032941E12)))) 67 | 68 | (let [wgs-m 32 69 | wgs-n 4 70 | acc-size (* Double/BYTES (max 1 (* cnt-n (count-groups wgs-m cnt-m)))) 71 | res (double-array cnt-n)] 72 | (with-release [sum-reduction-vertical (kernel program "sum_reduction_vertical") 73 | sum-reduce-vertical (kernel program "sum_reduce_vertical") 74 | cl-acc (cl-buffer ctx acc-size :read-write)] 75 | 76 | (facts 77 | (set-arg! sum-reduction-vertical 0 cl-acc) 78 | (set-args! sum-reduce-vertical cl-acc cl-data) 79 | (enq-reduce! queue sum-reduce-vertical sum-reduction-vertical cnt-n cnt-m wgs-n wgs-m) 80 | (enq-read! queue cl-acc res) 81 | (apply + (seq res)) => (roughly 3.92678032941E12)))))) 82 | -------------------------------------------------------------------------------- /test/clojure/uncomplicate/clojurecl/utils_test.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Dragan Djuric. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) or later 4 | ;; which can be found in the file LICENSE at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns uncomplicate.clojurecl.utils-test 10 | (:require [midje.sweet :refer :all] 11 | [uncomplicate.clojurecl.internal.utils :refer :all])) 12 | 13 | (facts 14 | "error tests" 15 | 16 | (ex-data (error 0)) 17 | => {:code 0, :details nil, :name "CL_SUCCESS", :type :opencl-error} 18 | 19 | (ex-data (error 43)) 20 | => {:code 43, :details nil, :name "UNKNOWN OpenCL ERROR!", :type :opencl-error} 21 | 22 | (ex-data (error 0 "Additional details")) 23 | => {:code 0, :details "Additional details", :name "CL_SUCCESS", :type :opencl-error}) 24 | 25 | (facts 26 | "with-check tests" 27 | (let [f (fn [x] (if x 0 -1))] 28 | (with-check (f 1) :success) => :success 29 | (with-check (f false) :success) => (throws clojure.lang.ExceptionInfo))) 30 | 31 | (facts 32 | "with-check-arr tests" 33 | (let [f (fn [x ^ints err] 34 | (do (aset err 0 (if x 0 -1)) 35 | x)) 36 | err (int-array 1)] 37 | (let [res (f :success err)] (with-check-arr err res) => :success) 38 | (let [res (f false err)] (with-check-arr err res))) => (throws clojure.lang.ExceptionInfo)) 39 | 40 | (facts 41 | "maybe tests" 42 | (ex-data (maybe (throw (ex-info "Test Exception" {:data :test})))) 43 | => (throws clojure.lang.ExceptionInfo) 44 | 45 | (:type (ex-data (error -1 nil))) => :opencl-error) 46 | -------------------------------------------------------------------------------- /test/opencl/core_test.cl: -------------------------------------------------------------------------------- 1 | __kernel void dumb_kernel(__global float *data, __local int* n, int m) { 2 | int gid = get_global_id(0); 3 | data[gid] = data [gid] + (float)gid + 2.0f * m; 4 | } 5 | -------------------------------------------------------------------------------- /test/opencl/examples/jocl/hello-kernel.cl: -------------------------------------------------------------------------------- 1 | __kernel void sampleKernel(__global const float *a, 2 | __global const float *b, 3 | __global float *c) { 4 | int gid = get_global_id(0); 5 | c[gid] = a[gid] + b[gid]; 6 | } 7 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch04/double-test.cl: -------------------------------------------------------------------------------- 1 | #ifdef FP_64 2 | #pragma OPENCL EXTENSION cl_khr_fp64: enable 3 | #endif 4 | 5 | __kernel void double_test(__global float* a, 6 | __global float* b, 7 | __global float* out) { 8 | #ifdef FP_64 9 | double c = (double)(*a / *b); 10 | *out = (float)c; 11 | #else 12 | *out = *a * *b; 13 | #endif 14 | } 15 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch04/hello-kernel.cl: -------------------------------------------------------------------------------- 1 | __kernel void hello_kernel(__global char16 *msg) { 2 | *msg = (char16)('H', 'e', 'l', 'l', 'o', ' ', 3 | 'k', 'e', 'r', 'n', 'e', 'l', '!', '!', '!', '\0'); 4 | } 5 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch04/vector-bytes.cl: -------------------------------------------------------------------------------- 1 | __kernel void vector_bytes(__global uchar16 *test) { 2 | 3 | uint4 vec = (uint4) (0x00010203, 0x04050607, 0x08090A0B, 0x0C0D0E0F); 4 | uchar *p = (uchar*)&vec; 5 | *test = (uchar16)(*p, *(p+1), *(p+2), *(p+3), *(p+4), *(p+5), *(p+6), 6 | *(p+7), *(p+8), *(p+9), *(p+10), *(p+11), *(p+12), 7 | *(p+13), *(p+14), *(p+15)); 8 | } 9 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/id-check.cl: -------------------------------------------------------------------------------- 1 | __kernel void id_check (__global float *output) { 2 | 3 | size_t gid0 = get_global_id(0); 4 | size_t gid1 = get_global_id(1); 5 | size_t gsize0 = get_global_size(0); 6 | size_t offset0 = get_global_offset(0); 7 | size_t offset1 = get_global_offset(1); 8 | size_t lid0 = get_local_id(0); 9 | size_t lid1 = get_local_id(1); 10 | 11 | int index0 = gid0 - offset0; 12 | int index1 = gid1 - offset1; 13 | int index = index1 * gsize0 + index0; 14 | 15 | output[index] = gid0 * 10.0f + gid1 * 1.0f + lid0 * 0.1f + lid1 * 0.01f; 16 | } 17 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/mad-test.cl: -------------------------------------------------------------------------------- 1 | __kernel void mad_test (__global uint *result) { 2 | uint a = 0x123456; 3 | uint b = 0x112233; 4 | uint c = 0x111111; 5 | result[0] = mad24(a, b, c); 6 | result[1] = mad_hi(a, b, c); 7 | } 8 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/mod-round.cl: -------------------------------------------------------------------------------- 1 | __kernel void mod_round (__global float *mod_input, 2 | __global float *mod_output, 3 | __global float4 *round_input, 4 | __global float4 *round_output) { 5 | mod_output[0] = fmod(mod_input[0], mod_input[1]); 6 | mod_output[1] = remainder(mod_input[0], mod_input[1]); 7 | 8 | round_output[0] = rint(*round_input); 9 | round_output[1] = round(*round_input); 10 | round_output[2] = ceil(*round_input); 11 | round_output[3] = floor(*round_input); 12 | round_output[4] = trunc(*round_input); 13 | } 14 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/op-test.cl: -------------------------------------------------------------------------------- 1 | __kernel void op_test(__global int4 *output) { 2 | 3 | int4 vec = (int4) (1, 2, 3, 4); 4 | vec += 4; 5 | if (vec.s2 == 7) 6 | vec &= (int4)(-1, -1, 0, -1); 7 | vec.s01 = vec.s23 < 7; 8 | while (vec.s3 > 7 && (vec.s0 < 16 || vec.s1 < 16)) 9 | vec.s3 >>= 1; 10 | 11 | *output = vec; 12 | } 13 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/polar-rect.cl: -------------------------------------------------------------------------------- 1 | __kernel void polar_rect (__global float4 *rvals, 2 | __global float4 *angles, 3 | __global float4 *xcoords, 4 | __global float4 *ycoords) { 5 | *ycoords = sincos(*angles, xcoords); 6 | *xcoords *= *rvals; 7 | *ycoords *= *rvals; 8 | } 9 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/select-test.cl: -------------------------------------------------------------------------------- 1 | __kernel void select_test (__global float4 *s1, 2 | __global uchar2 *s2) { 3 | int4 mask1 = (int4)(-1, 0, -1, 0); 4 | float4 input1 = (float4)(0.25f, 0.5f, 0.75f, 1.0f); 5 | float4 input2 = (float4)(1.25f, 1.5f, 1.75f, 2.0f); 6 | *s1 = select(input1, input2, mask1); 7 | 8 | uchar2 mask2 = (uchar2)(0xAA, 0x55); 9 | uchar2 input3 = (uchar2)(0x0F, 0x0F); 10 | uchar2 input4 = (uchar2)(0x33, 0x33); 11 | *s2 = bitselect(input3, input4, mask2); 12 | } 13 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch05/shuffle-test.cl: -------------------------------------------------------------------------------- 1 | __kernel void shuffle_test (__global float8 *s1, 2 | __global char16 *s2) { 3 | 4 | uint8 mask1 = (uint8) (1, 2, 0, 1, 3, 1, 2, 3); 5 | float4 input = (float4) (0.25f, 0.5f, 0.75f, 1.0f); 6 | *s1 = shuffle(input, mask1); 7 | 8 | uchar16 mask2 = (uchar16) (6, 10, 5, 2, 8, 0, 9, 14, 9 | 7, 5, 12, 3, 11, 15, 1, 13); 10 | char8 input1 = (char8)('l', 'o', 'f', 'c', 'a', 'u', 's', 'f'); 11 | char8 input2 = (char8)('f', 'e', 'h', 't', 'n', 'n', '2', 'i'); 12 | *s2 = shuffle2(input1, input2, mask2); 13 | 14 | } 15 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch07/profile-items.cl: -------------------------------------------------------------------------------- 1 | __kernel void profile_items (__global int4 *x, int num_ints) { 2 | 3 | int num_vectors = num_ints/(4 * get_global_size(0)); 4 | x += get_global_id(0) * num_vectors; 5 | for (int i = 0; i < num_vectors; i++){ 6 | x[i] += 1; 7 | x[i] *= 2; 8 | x[i] /= 3; 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch07/profile-read.cl: -------------------------------------------------------------------------------- 1 | __kernel void profile_read (__global char16 *c, 2 | int num) { 3 | 4 | for (int i=0; i < num; i++) { 5 | c[i] = (char16)(5); 6 | } 7 | 8 | } 9 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch07/user-event.cl: -------------------------------------------------------------------------------- 1 | __kernel void user_event(__global float4 *v) { 2 | 3 | *v *= -1.0f; 4 | } 5 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch10/reduction.cl: -------------------------------------------------------------------------------- 1 | __kernel void naive_reduction(__global float* data, __global float* output) { 2 | float sum = 0.0; 3 | if (get_global_id(0) == 0) { 4 | for (int i = 0; i < 1048576; i++) { 5 | sum += data[i]; 6 | } 7 | } 8 | *output = sum; 9 | } 10 | 11 | __kernel void reduction_scalar(__global float* data, 12 | __local float* partial_sums, 13 | __global float* output) { 14 | 15 | 16 | int lid = get_local_id(0); 17 | int gsize = get_local_size(0); 18 | 19 | partial_sums[lid] = data[get_global_id(0)]; 20 | barrier(CLK_LOCAL_MEM_FENCE); 21 | 22 | for (int i = gsize/2; i > 0; i >>= 1) { 23 | if (lid < i) { 24 | partial_sums[lid] += partial_sums[lid + i]; 25 | } 26 | barrier(CLK_LOCAL_MEM_FENCE); 27 | } 28 | 29 | if(lid == 0) { 30 | output[get_group_id(0)] = partial_sums[0]; 31 | } 32 | } 33 | 34 | __kernel void reduction_vector(__global float4* data, 35 | __local float4* partial_sums, 36 | __global float* output) { 37 | 38 | int lid = get_local_id(0); 39 | int group_size = get_local_size(0); 40 | 41 | partial_sums[lid] = data[get_global_id(0)]; 42 | barrier(CLK_LOCAL_MEM_FENCE); 43 | 44 | for(int i = group_size/2; i>0; i >>= 1) { 45 | if(lid < i) { 46 | partial_sums[lid] += partial_sums[lid + i]; 47 | } 48 | barrier(CLK_LOCAL_MEM_FENCE); 49 | } 50 | 51 | if(lid == 0) { 52 | output[get_group_id(0)] = dot (partial_sums[0], (float4)(1.0f)); 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /test/opencl/examples/openclinaction/ch11/string-search.cl: -------------------------------------------------------------------------------- 1 | __kernel void string_search (char16 pattern, __global char* text, 2 | int chars_per_item, __local int* local_result, 3 | __global int* global_result) { 4 | 5 | char16 text_vector, check_vector; 6 | 7 | local_result[0] = 0; 8 | local_result[1] = 0; 9 | local_result[2] = 0; 10 | local_result[3] = 0; 11 | 12 | work_group_barrier(CLK_LOCAL_MEM_FENCE); 13 | 14 | int item_offset = get_global_id(0) * chars_per_item; 15 | 16 | for (int i = item_offset; i < item_offset + chars_per_item; i++) { 17 | text_vector = vload16(0, text + i); 18 | 19 | check_vector = text_vector == pattern; 20 | 21 | if (all(check_vector.s0123)) 22 | atomic_inc(local_result); 23 | if (all(check_vector.s4567)) 24 | atomic_inc(local_result + 1); 25 | if (all(check_vector.s89AB)) 26 | atomic_inc(local_result + 2); 27 | if (all(check_vector.sCDEF)) 28 | atomic_inc(local_result + 3); 29 | 30 | } 31 | 32 | work_group_barrier(CLK_GLOBAL_MEM_FENCE); 33 | 34 | if(get_local_id(0) == 0) { 35 | atomic_add(global_result, local_result[0]); 36 | atomic_add(global_result + 1, local_result[1]); 37 | atomic_add(global_result + 2, local_result[2]); 38 | atomic_add(global_result + 3, local_result[3]); 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /test/opencl/toolbox_test.cl: -------------------------------------------------------------------------------- 1 | __kernel void sum_reduce_horizontal (__global ACCUMULATOR* acc, __global REAL* data) { 2 | const uint i = get_global_size(0) * get_global_id(1) + get_global_id(0); 3 | const uint iacc = get_global_size(0) * get_group_id(1) + get_global_id(0); 4 | __local ACCUMULATOR lacc[WGS]; 5 | const ACCUMULATOR sum = work_group_reduction_sum_2(lacc, data[i]); 6 | if (get_local_id(1) == 0) { 7 | acc[iacc] = sum; 8 | } 9 | } 10 | 11 | __kernel void sum_reduce_vertical (__global ACCUMULATOR* acc, __global REAL* data) { 12 | const uint i = get_global_size(1) * get_global_id(0) + get_global_id(1); 13 | const uint iacc = get_global_size(0) * get_group_id(1) + get_global_id(0); 14 | __local ACCUMULATOR lacc[WGS]; 15 | const ACCUMULATOR sum = work_group_reduction_sum_2(lacc, data[i]); 16 | if (get_local_id(1) == 0) { 17 | acc[iacc] = sum; 18 | } 19 | } 20 | --------------------------------------------------------------------------------