OpenCL 1.0.1.3 → 1.0.2.2
raw patch · 16 files changed
+1373/−1223 lines, 16 filessetup-changed
Files
- LICENSE +24/−655
- OpenCL.cabal +30/−13
- README.org +37/−0
- Setup.hs +31/−0
- examples/example01.hs +75/−0
- examples/example02.hs +108/−0
- examples/example03.hs +98/−0
- examples/example04.hs +80/−0
- src/System/GPU/OpenCL.hs +30/−14
- src/System/GPU/OpenCL/CommandQueue.chs +99/−90
- src/System/GPU/OpenCL/Context.chs +54/−41
- src/System/GPU/OpenCL/Event.chs +49/−25
- src/System/GPU/OpenCL/Memory.chs +86/−43
- src/System/GPU/OpenCL/Program.chs +253/−177
- src/System/GPU/OpenCL/Query.chs +266/−135
- src/System/GPU/OpenCL/Types.chs +53/−30
LICENSE view
@@ -1,661 +1,30 @@- GNU AFFERO GENERAL PUBLIC LICENSE- Version 3, 19 November 2007-- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.-- Preamble-- The GNU Affero General Public License is a free, copyleft license for-software and other kinds of works, specifically designed to ensure-cooperation with the community in the case of network server software.-- The licenses for most software and other practical works are designed-to take away your freedom to share and change the works. By contrast,-our General Public Licenses are intended to guarantee your freedom to-share and change all versions of a program--to make sure it remains free-software for all its users.-- When we speak of free software, we are referring to freedom, not-price. Our General Public Licenses are designed to make sure that you-have the freedom to distribute copies of free software (and charge for-them if you wish), that you receive source code or can get it if you-want it, that you can change the software or use pieces of it in new-free programs, and that you know you can do these things.-- Developers that use our General Public Licenses protect your rights-with two steps: (1) assert copyright on the software, and (2) offer-you this License which gives you legal permission to copy, distribute-and/or modify the software.-- A secondary benefit of defending all users' freedom is that-improvements made in alternate versions of the program, if they-receive widespread use, become available for other developers to-incorporate. Many developers of free software are heartened and-encouraged by the resulting cooperation. However, in the case of-software used on network servers, this result may fail to come about.-The GNU General Public License permits making a modified version and-letting the public access it on a server without ever releasing its-source code to the public.-- The GNU Affero General Public License is designed specifically to-ensure that, in such cases, the modified source code becomes available-to the community. It requires the operator of a network server to-provide the source code of the modified version running there to the-users of that server. Therefore, public use of a modified version, on-a publicly accessible server, gives the public access to the source-code of the modified version.-- An older license, called the Affero General Public License and-published by Affero, was designed to accomplish similar goals. This is-a different license, not a version of the Affero GPL, but Affero has-released a new version of the Affero GPL which permits relicensing under-this license.-- The precise terms and conditions for copying, distribution and-modification follow.-- TERMS AND CONDITIONS-- 0. Definitions.-- "This License" refers to version 3 of the GNU Affero General Public License.-- "Copyright" also means copyright-like laws that apply to other kinds of-works, such as semiconductor masks.-- "The Program" refers to any copyrightable work licensed under this-License. Each licensee is addressed as "you". "Licensees" and-"recipients" may be individuals or organizations.-- To "modify" a work means to copy from or adapt all or part of the work-in a fashion requiring copyright permission, other than the making of an-exact copy. The resulting work is called a "modified version" of the-earlier work or a work "based on" the earlier work.-- A "covered work" means either the unmodified Program or a work based-on the Program.-- To "propagate" a work means to do anything with it that, without-permission, would make you directly or secondarily liable for-infringement under applicable copyright law, except executing it on a-computer or modifying a private copy. Propagation includes copying,-distribution (with or without modification), making available to the-public, and in some countries other activities as well.-- To "convey" a work means any kind of propagation that enables other-parties to make or receive copies. Mere interaction with a user through-a computer network, with no transfer of a copy, is not conveying.-- An interactive user interface displays "Appropriate Legal Notices"-to the extent that it includes a convenient and prominently visible-feature that (1) displays an appropriate copyright notice, and (2)-tells the user that there is no warranty for the work (except to the-extent that warranties are provided), that licensees may convey the-work under this License, and how to view a copy of this License. If-the interface presents a list of user commands or options, such as a-menu, a prominent item in the list meets this criterion.-- 1. Source Code.-- The "source code" for a work means the preferred form of the work-for making modifications to it. "Object code" means any non-source-form of a work.-- A "Standard Interface" means an interface that either is an official-standard defined by a recognized standards body, or, in the case of-interfaces specified for a particular programming language, one that-is widely used among developers working in that language.-- The "System Libraries" of an executable work include anything, other-than the work as a whole, that (a) is included in the normal form of-packaging a Major Component, but which is not part of that Major-Component, and (b) serves only to enable use of the work with that-Major Component, or to implement a Standard Interface for which an-implementation is available to the public in source code form. A-"Major Component", in this context, means a major essential component-(kernel, window system, and so on) of the specific operating system-(if any) on which the executable work runs, or a compiler used to-produce the work, or an object code interpreter used to run it.-- The "Corresponding Source" for a work in object code form means all-the source code needed to generate, install, and (for an executable-work) run the object code and to modify the work, including scripts to-control those activities. However, it does not include the work's-System Libraries, or general-purpose tools or generally available free-programs which are used unmodified in performing those activities but-which are not part of the work. For example, Corresponding Source-includes interface definition files associated with source files for-the work, and the source code for shared libraries and dynamically-linked subprograms that the work is specifically designed to require,-such as by intimate data communication or control flow between those-subprograms and other parts of the work.-- The Corresponding Source need not include anything that users-can regenerate automatically from other parts of the Corresponding-Source.-- The Corresponding Source for a work in source code form is that-same work.-- 2. Basic Permissions.-- All rights granted under this License are granted for the term of-copyright on the Program, and are irrevocable provided the stated-conditions are met. This License explicitly affirms your unlimited-permission to run the unmodified Program. The output from running a-covered work is covered by this License only if the output, given its-content, constitutes a covered work. This License acknowledges your-rights of fair use or other equivalent, as provided by copyright law.-- You may make, run and propagate covered works that you do not-convey, without conditions so long as your license otherwise remains-in force. You may convey covered works to others for the sole purpose-of having them make modifications exclusively for you, or provide you-with facilities for running those works, provided that you comply with-the terms of this License in conveying all material for which you do-not control copyright. Those thus making or running the covered works-for you must do so exclusively on your behalf, under your direction-and control, on terms that prohibit them from making any copies of-your copyrighted material outside their relationship with you.-- Conveying under any other circumstances is permitted solely under-the conditions stated below. Sublicensing is not allowed; section 10-makes it unnecessary.-- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.-- No covered work shall be deemed part of an effective technological-measure under any applicable law fulfilling obligations under article-11 of the WIPO copyright treaty adopted on 20 December 1996, or-similar laws prohibiting or restricting circumvention of such-measures.-- When you convey a covered work, you waive any legal power to forbid-circumvention of technological measures to the extent such circumvention-is effected by exercising rights under this License with respect to-the covered work, and you disclaim any intention to limit operation or-modification of the work as a means of enforcing, against the work's-users, your or third parties' legal rights to forbid circumvention of-technological measures.-- 4. Conveying Verbatim Copies.-- You may convey verbatim copies of the Program's source code as you-receive it, in any medium, provided that you conspicuously and-appropriately publish on each copy an appropriate copyright notice;-keep intact all notices stating that this License and any-non-permissive terms added in accord with section 7 apply to the code;-keep intact all notices of the absence of any warranty; and give all-recipients a copy of this License along with the Program.-- You may charge any price or no price for each copy that you convey,-and you may offer support or warranty protection for a fee.-- 5. Conveying Modified Source Versions.-- You may convey a work based on the Program, or the modifications to-produce it from the Program, in the form of source code under the-terms of section 4, provided that you also meet all of these conditions:-- a) The work must carry prominent notices stating that you modified- it, and giving a relevant date.-- b) The work must carry prominent notices stating that it is- released under this License and any conditions added under section- 7. This requirement modifies the requirement in section 4 to- "keep intact all notices".-- c) You must license the entire work, as a whole, under this- License to anyone who comes into possession of a copy. This- License will therefore apply, along with any applicable section 7- additional terms, to the whole of the work, and all its parts,- regardless of how they are packaged. This License gives no- permission to license the work in any other way, but it does not- invalidate such permission if you have separately received it.-- d) If the work has interactive user interfaces, each must display- Appropriate Legal Notices; however, if the Program has interactive- interfaces that do not display Appropriate Legal Notices, your- work need not make them do so.-- A compilation of a covered work with other separate and independent-works, which are not by their nature extensions of the covered work,-and which are not combined with it such as to form a larger program,-in or on a volume of a storage or distribution medium, is called an-"aggregate" if the compilation and its resulting copyright are not-used to limit the access or legal rights of the compilation's users-beyond what the individual works permit. Inclusion of a covered work-in an aggregate does not cause this License to apply to the other-parts of the aggregate.-- 6. Conveying Non-Source Forms.-- You may convey a covered work in object code form under the terms-of sections 4 and 5, provided that you also convey the-machine-readable Corresponding Source under the terms of this License,-in one of these ways:-- a) Convey the object code in, or embodied in, a physical product- (including a physical distribution medium), accompanied by the- Corresponding Source fixed on a durable physical medium- customarily used for software interchange.-- b) Convey the object code in, or embodied in, a physical product- (including a physical distribution medium), accompanied by a- written offer, valid for at least three years and valid for as- long as you offer spare parts or customer support for that product- model, to give anyone who possesses the object code either (1) a- copy of the Corresponding Source for all the software in the- product that is covered by this License, on a durable physical- medium customarily used for software interchange, for a price no- more than your reasonable cost of physically performing this- conveying of source, or (2) access to copy the- Corresponding Source from a network server at no charge.-- c) Convey individual copies of the object code with a copy of the- written offer to provide the Corresponding Source. This- alternative is allowed only occasionally and noncommercially, and- only if you received the object code with such an offer, in accord- with subsection 6b.-- d) Convey the object code by offering access from a designated- place (gratis or for a charge), and offer equivalent access to the- Corresponding Source in the same way through the same place at no- further charge. You need not require recipients to copy the- Corresponding Source along with the object code. If the place to- copy the object code is a network server, the Corresponding Source- may be on a different server (operated by you or a third party)- that supports equivalent copying facilities, provided you maintain- clear directions next to the object code saying where to find the- Corresponding Source. Regardless of what server hosts the- Corresponding Source, you remain obligated to ensure that it is- available for as long as needed to satisfy these requirements.-- e) Convey the object code using peer-to-peer transmission, provided- you inform other peers where the object code and Corresponding- Source of the work are being offered to the general public at no- charge under subsection 6d.-- A separable portion of the object code, whose source code is excluded-from the Corresponding Source as a System Library, need not be-included in conveying the object code work.-- A "User Product" is either (1) a "consumer product", which means any-tangible personal property which is normally used for personal, family,-or household purposes, or (2) anything designed or sold for incorporation-into a dwelling. In determining whether a product is a consumer product,-doubtful cases shall be resolved in favor of coverage. For a particular-product received by a particular user, "normally used" refers to a-typical or common use of that class of product, regardless of the status-of the particular user or of the way in which the particular user-actually uses, or expects or is expected to use, the product. A product-is a consumer product regardless of whether the product has substantial-commercial, industrial or non-consumer uses, unless such uses represent-the only significant mode of use of the product.-- "Installation Information" for a User Product means any methods,-procedures, authorization keys, or other information required to install-and execute modified versions of a covered work in that User Product from-a modified version of its Corresponding Source. The information must-suffice to ensure that the continued functioning of the modified object-code is in no case prevented or interfered with solely because-modification has been made.-- If you convey an object code work under this section in, or with, or-specifically for use in, a User Product, and the conveying occurs as-part of a transaction in which the right of possession and use of the-User Product is transferred to the recipient in perpetuity or for a-fixed term (regardless of how the transaction is characterized), the-Corresponding Source conveyed under this section must be accompanied-by the Installation Information. But this requirement does not apply-if neither you nor any third party retains the ability to install-modified object code on the User Product (for example, the work has-been installed in ROM).-- The requirement to provide Installation Information does not include a-requirement to continue to provide support service, warranty, or updates-for a work that has been modified or installed by the recipient, or for-the User Product in which it has been modified or installed. Access to a-network may be denied when the modification itself materially and-adversely affects the operation of the network or violates the rules and-protocols for communication across the network.-- Corresponding Source conveyed, and Installation Information provided,-in accord with this section must be in a format that is publicly-documented (and with an implementation available to the public in-source code form), and must require no special password or key for-unpacking, reading or copying.-- 7. Additional Terms.-- "Additional permissions" are terms that supplement the terms of this-License by making exceptions from one or more of its conditions.-Additional permissions that are applicable to the entire Program shall-be treated as though they were included in this License, to the extent-that they are valid under applicable law. If additional permissions-apply only to part of the Program, that part may be used separately-under those permissions, but the entire Program remains governed by-this License without regard to the additional permissions.-- When you convey a copy of a covered work, you may at your option-remove any additional permissions from that copy, or from any part of-it. (Additional permissions may be written to require their own-removal in certain cases when you modify the work.) You may place-additional permissions on material, added by you to a covered work,-for which you have or can give appropriate copyright permission.-- Notwithstanding any other provision of this License, for material you-add to a covered work, you may (if authorized by the copyright holders of-that material) supplement the terms of this License with terms:-- a) Disclaiming warranty or limiting liability differently from the- terms of sections 15 and 16 of this License; or-- b) Requiring preservation of specified reasonable legal notices or- author attributions in that material or in the Appropriate Legal- Notices displayed by works containing it; or-- c) Prohibiting misrepresentation of the origin of that material, or- requiring that modified versions of such material be marked in- reasonable ways as different from the original version; or-- d) Limiting the use for publicity purposes of names of licensors or- authors of the material; or-- e) Declining to grant rights under trademark law for use of some- trade names, trademarks, or service marks; or-- f) Requiring indemnification of licensors and authors of that- material by anyone who conveys the material (or modified versions of- it) with contractual assumptions of liability to the recipient, for- any liability that these contractual assumptions directly impose on- those licensors and authors.-- All other non-permissive additional terms are considered "further-restrictions" within the meaning of section 10. If the Program as you-received it, or any part of it, contains a notice stating that it is-governed by this License along with a term that is a further-restriction, you may remove that term. If a license document contains-a further restriction but permits relicensing or conveying under this-License, you may add to a covered work material governed by the terms-of that license document, provided that the further restriction does-not survive such relicensing or conveying.-- If you add terms to a covered work in accord with this section, you-must place, in the relevant source files, a statement of the-additional terms that apply to those files, or a notice indicating-where to find the applicable terms.-- Additional terms, permissive or non-permissive, may be stated in the-form of a separately written license, or stated as exceptions;-the above requirements apply either way.-- 8. Termination.-- You may not propagate or modify a covered work except as expressly-provided under this License. Any attempt otherwise to propagate or-modify it is void, and will automatically terminate your rights under-this License (including any patent licenses granted under the third-paragraph of section 11).-- However, if you cease all violation of this License, then your-license from a particular copyright holder is reinstated (a)-provisionally, unless and until the copyright holder explicitly and-finally terminates your license, and (b) permanently, if the copyright-holder fails to notify you of the violation by some reasonable means-prior to 60 days after the cessation.-- Moreover, your license from a particular copyright holder is-reinstated permanently if the copyright holder notifies you of the-violation by some reasonable means, this is the first time you have-received notice of violation of this License (for any work) from that-copyright holder, and you cure the violation prior to 30 days after-your receipt of the notice.-- Termination of your rights under this section does not terminate the-licenses of parties who have received copies or rights from you under-this License. If your rights have been terminated and not permanently-reinstated, you do not qualify to receive new licenses for the same-material under section 10.-- 9. Acceptance Not Required for Having Copies.-- You are not required to accept this License in order to receive or-run a copy of the Program. Ancillary propagation of a covered work-occurring solely as a consequence of using peer-to-peer transmission-to receive a copy likewise does not require acceptance. However,-nothing other than this License grants you permission to propagate or-modify any covered work. These actions infringe copyright if you do-not accept this License. Therefore, by modifying or propagating a-covered work, you indicate your acceptance of this License to do so.-- 10. Automatic Licensing of Downstream Recipients.-- Each time you convey a covered work, the recipient automatically-receives a license from the original licensors, to run, modify and-propagate that work, subject to this License. You are not responsible-for enforcing compliance by third parties with this License.-- An "entity transaction" is a transaction transferring control of an-organization, or substantially all assets of one, or subdividing an-organization, or merging organizations. If propagation of a covered-work results from an entity transaction, each party to that-transaction who receives a copy of the work also receives whatever-licenses to the work the party's predecessor in interest had or could-give under the previous paragraph, plus a right to possession of the-Corresponding Source of the work from the predecessor in interest, if-the predecessor has it or can get it with reasonable efforts.-- You may not impose any further restrictions on the exercise of the-rights granted or affirmed under this License. For example, you may-not impose a license fee, royalty, or other charge for exercise of-rights granted under this License, and you may not initiate litigation-(including a cross-claim or counterclaim in a lawsuit) alleging that-any patent claim is infringed by making, using, selling, offering for-sale, or importing the Program or any portion of it.-- 11. Patents.-- A "contributor" is a copyright holder who authorizes use under this-License of the Program or a work on which the Program is based. The-work thus licensed is called the contributor's "contributor version".-- A contributor's "essential patent claims" are all patent claims-owned or controlled by the contributor, whether already acquired or-hereafter acquired, that would be infringed by some manner, permitted-by this License, of making, using, or selling its contributor version,-but do not include claims that would be infringed only as a-consequence of further modification of the contributor version. For-purposes of this definition, "control" includes the right to grant-patent sublicenses in a manner consistent with the requirements of-this License.-- Each contributor grants you a non-exclusive, worldwide, royalty-free-patent license under the contributor's essential patent claims, to-make, use, sell, offer for sale, import and otherwise run, modify and-propagate the contents of its contributor version.-- In the following three paragraphs, a "patent license" is any express-agreement or commitment, however denominated, not to enforce a patent-(such as an express permission to practice a patent or covenant not to-sue for patent infringement). To "grant" such a patent license to a-party means to make such an agreement or commitment not to enforce a-patent against the party.-- If you convey a covered work, knowingly relying on a patent license,-and the Corresponding Source of the work is not available for anyone-to copy, free of charge and under the terms of this License, through a-publicly available network server or other readily accessible means,-then you must either (1) cause the Corresponding Source to be so-available, or (2) arrange to deprive yourself of the benefit of the-patent license for this particular work, or (3) arrange, in a manner-consistent with the requirements of this License, to extend the patent-license to downstream recipients. "Knowingly relying" means you have-actual knowledge that, but for the patent license, your conveying the-covered work in a country, or your recipient's use of the covered work-in a country, would infringe one or more identifiable patents in that-country that you have reason to believe are valid.-- If, pursuant to or in connection with a single transaction or-arrangement, you convey, or propagate by procuring conveyance of, a-covered work, and grant a patent license to some of the parties-receiving the covered work authorizing them to use, propagate, modify-or convey a specific copy of the covered work, then the patent license-you grant is automatically extended to all recipients of the covered-work and works based on it.-- A patent license is "discriminatory" if it does not include within-the scope of its coverage, prohibits the exercise of, or is-conditioned on the non-exercise of one or more of the rights that are-specifically granted under this License. You may not convey a covered-work if you are a party to an arrangement with a third party that is-in the business of distributing software, under which you make payment-to the third party based on the extent of your activity of conveying-the work, and under which the third party grants, to any of the-parties who would receive the covered work from you, a discriminatory-patent license (a) in connection with copies of the covered work-conveyed by you (or copies made from those copies), or (b) primarily-for and in connection with specific products or compilations that-contain the covered work, unless you entered into that arrangement,-or that patent license was granted, prior to 28 March 2007.-- Nothing in this License shall be construed as excluding or limiting-any implied license or other defenses to infringement that may-otherwise be available to you under applicable patent law.-- 12. No Surrender of Others' Freedom.-- If conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License. If you cannot convey a-covered work so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you may-not convey it at all. For example, if you agree to terms that obligate you-to collect a royalty for further conveying from those to whom you convey-the Program, the only way you could satisfy both those terms and this-License would be to refrain entirely from conveying the Program.-- 13. Remote Network Interaction; Use with the GNU General Public License.-- Notwithstanding any other provision of this License, if you modify the-Program, your modified version must prominently offer all users-interacting with it remotely through a computer network (if your version-supports such interaction) an opportunity to receive the Corresponding-Source of your version by providing access to the Corresponding Source-from a network server at no charge, through some standard or customary-means of facilitating copying of software. This Corresponding Source-shall include the Corresponding Source for any work covered by version 3-of the GNU General Public License that is incorporated pursuant to the-following paragraph.-- Notwithstanding any other provision of this License, you have-permission to link or combine any covered work with a work licensed-under version 3 of the GNU General Public License into a single-combined work, and to convey the resulting work. The terms of this-License will continue to apply to the part which is the covered work,-but the work with which it is combined will remain governed by version-3 of the GNU General Public License.-- 14. Revised Versions of this License.-- The Free Software Foundation may publish revised and/or new versions of-the GNU Affero General Public License from time to time. Such new versions-will be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.-- Each version is given a distinguishing version number. If the-Program specifies that a certain numbered version of the GNU Affero General-Public License "or any later version" applies to it, you have the-option of following the terms and conditions either of that numbered-version or of any later version published by the Free Software-Foundation. If the Program does not specify a version number of the-GNU Affero General Public License, you may choose any version ever published-by the Free Software Foundation.-- If the Program specifies that a proxy can decide which future-versions of the GNU Affero General Public License can be used, that proxy's-public statement of acceptance of a version permanently authorizes you-to choose that version for the Program.-- Later license versions may give you additional or different-permissions. However, no additional obligations are imposed on any-author or copyright holder as a result of your choosing to follow a-later version.-- 15. Disclaimer of Warranty.-- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.-- 16. Limitation of Liability.-- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF-SUCH DAMAGES.-- 17. Interpretation of Sections 15 and 16.-- If the disclaimer of warranty and limitation of liability provided-above cannot be given local legal effect according to their terms,-reviewing courts shall apply local law that most closely approximates-an absolute waiver of all civil liability in connection with the-Program, unless a warranty or assumption of liability accompanies a-copy of the Program in return for a fee.-- END OF TERMS AND CONDITIONS-- How to Apply These Terms to Your New Programs-- If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these terms.-- To do so, attach the following notices to the program. It is safest-to attach them to the start of each source file to most effectively-state the exclusion of warranty; and each file should have at least-the "copyright" line and a pointer to where the full notice is found.-- <one line to give the program's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>+Copyright (c) 2011 Luis Cabellos, - This program is free software: you can redistribute it and/or modify- it under the terms of the GNU Affero General Public License as published by- the Free Software Foundation, either version 3 of the License, or- (at your option) any later version.+All rights reserved. - This program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU Affero General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: - You should have received a copy of the GNU Affero General Public License- along with this program. If not, see <http://www.gnu.org/licenses/>.+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer. -Also add information on how to contact you by electronic and paper mail.+ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution. - If your software can interact with users remotely through a computer-network, you should also make sure that it provides a way for users to-get its source. For example, if your program is a web application, its-interface could display a "Source" link that leads users to an archive-of the code. There are many ways you could offer source, and different-solutions will be better for different programs; see section 13 for the-specific requirements.+ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission. - You should also get your employer (if you work as a programmer) or school,-if any, to sign a "copyright disclaimer" for the program, if necessary.-For more information on this, and how to apply and follow the GNU AGPL, see-<http://www.gnu.org/licenses/>.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
OpenCL.cabal view
@@ -1,6 +1,6 @@ Name: OpenCL-Version: 1.0.1.3-License: GPL+Version: 1.0.2.2+License: BSD3 License-File: LICENSE Author: Luis Cabellos Copyright: (c) 2011 Luis Cabellos@@ -10,21 +10,21 @@ Maintainer: Luis Cabellos Homepage: https://github.com/zhensydow/opencl Synopsis: Haskell high-level wrapper for OpenCL-Description: Haskell FFI binding to OpenCL library. It includes high-level wrappers to help development. Based on OpenCLRaw package. bug-reports: https://github.com/zhensydow/opencl/issues Cabal-Version: >=1.8 Tested-With: GHC--source-repository this- type: git- location: https://zhensydow@github.com/zhensydow/opencl.git- tag: 1.0.1.3- branch: master+Description: + Haskell FFI binding to OpenCL library. It includes high-level wrappers to+ help development. Based on OpenCLRaw package.+ .+ Most of the functions can throw a 'CLError' Exception. Using the module+ 'Control.Exception' helps to work with this package Exceptions. -source-repository head- type: git- location: https://zhensydow@github.com/zhensydow/opencl.git- branch: develop+Extra-source-files: README.org + examples/example01.hs+ examples/example02.hs+ examples/example03.hs+ examples/example04.hs Library Build-tools: c2hs@@ -41,3 +41,20 @@ System.GPU.OpenCL.Program Other-Modules: System.GPU.OpenCL.Types++ if os(windows)+ cpp-options: "-DCALLCONV=stdcall"+ else+ cpp-options: "-DCALLCONV=ccall"+ extra-libraries: OpenCL++source-repository this+ type: git+ location: https://zhensydow@github.com/zhensydow/opencl.git+ tag: 1.0.2.2+ branch: master++source-repository head+ type: git+ location: https://zhensydow@github.com/zhensydow/opencl.git+ branch: develop
+ README.org view
@@ -0,0 +1,37 @@+* Introduction+OpenCL highlevel wrapper for Haskell.++Based on Jeff Heard OpenCLRaw.++* Install the package++ Requisite: c2hs installed.++ In order to install the package. You need the CL/cl.h include file in a knowed+ path. With the usual commands to install as a user library:+ + : runhaskell Setup configure --user+ : runhaskell Setup build+ : runhaskell Setup install++ The programs that use the library, need to link against OpenCL++** Optional Requisites+ Some OpenCL libraries required also numa libs. E.g, on Ubuntu 11.04:+ + : install libnuma1 libnuma-dev++** Example+ + There is an simple working example in the examples folder. You can create an+ executable using:++ : ghc --make -lOpenCL examples/example01.hs++** Executing on ghci++ It's possible to execute the command line interface of ghc linking with+ OpenCL, e.g:++ : ghci -lOpenCL examples/example01.hs+
Setup.hs view
@@ -1,2 +1,33 @@+{- Copyright (c) 2011 Luis Cabellos,++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-} import Distribution.Simple main = defaultMain
+ examples/example01.hs view
@@ -0,0 +1,75 @@+{- Copyright (c) 2011 Luis Cabellos,++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+import System.GPU.OpenCL+import Foreign( castPtr, nullPtr, sizeOf )+import Foreign.C.Types( CFloat )+import Foreign.Marshal.Array( newArray, peekArray )++programSource :: String+programSource = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id];\n}"++main :: IO ()+main = do+ -- Initialize OpenCL+ (platform:_) <- clGetPlatformIDs+ (dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL+ context <- clCreateContext [dev] print+ q <- clCreateCommandQueue context dev []+ + -- Initialize Kernel+ program <- clCreateProgramWithSource context programSource+ clBuildProgram program [dev] ""+ kernel <- clCreateKernel program "duparray"+ + -- Initialize parameters+ let original = [0 .. 20] :: [CFloat]+ elemSize = sizeOf (0 :: CFloat)+ vecSize = elemSize * length original+ putStrLn $ "Original array = " ++ show original+ input <- newArray original++ mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input) + mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)++ clSetKernelArg kernel 0 mem_in+ clSetKernelArg kernel 1 mem_out+ + -- Execute Kernel+ eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []+ + -- Get Result+ eventRead <- clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]+ + result <- peekArray (length original) input+ putStrLn $ "Result array = " ++ show result++ return ()
+ examples/example02.hs view
@@ -0,0 +1,108 @@+{- Copyright (c) 2011 Luis Cabellos,++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+import System.GPU.OpenCL +import Foreign( castPtr, nullPtr, sizeOf )+import Foreign.C.Types( CFloat )+import Foreign.Marshal.Array( peekArray, withArray )+import Data.List( foldl' )+import Control.Monad( forM_, forM )++programSource :: String+programSource = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id] + id;\n}"++sumres :: Num a => (a,a,a) -> (a,a,a) -> (a,a,a)+sumres (t1,t2,t3) (u1,u2,u3) = (t1+u1,t2+u2,t3+u3)++main :: IO ()+main = do+ -- Initialize OpenCL+ (platform:_) <- clGetPlatformIDs+ (dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL+ context <- clCreateContext [dev] print+ q <- clCreateCommandQueue context dev [CL_QUEUE_PROFILING_ENABLE]+ + -- Initialize Kernel+ program <- clCreateProgramWithSource context programSource+ clBuildProgram program [dev] ""+ kernel <- clCreateKernel program "duparray"+ + -- run tests+ forM_ [100,200..30000] $ \s -> do+ let original = [0 .. s] :: [CFloat]+ n = 50 :: Double+ res <- forM [0..n] $ \_ -> do+ (t1,t2,t3,_) <- executeArray original context q kernel+ return (t1,t2,t3)+ + let (t1,t2,t3) = foldl' sumres (0,0,0) res+ + putStrLn $ show s ++ "\t" ++ show (fromIntegral t1/n) ++ "\t" ++ show (fromIntegral t2/n) ++ "\t" ++ show (fromIntegral t3/n)++ return ()++executeArray :: [CFloat] -> CLContext -> CLCommandQueue -> CLKernel -> IO (CLulong, CLulong, CLulong, [CFloat])+executeArray original ctx q krn = withArray original $ \input -> do+ mem_in <- clCreateBuffer ctx [CL_MEM_READ_ONLY] (vecSize, nullPtr) + mem_out <- clCreateBuffer ctx [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)++ clSetKernelArg krn 0 mem_in+ clSetKernelArg krn 1 mem_out+ + -- Put Input+ eventWrite <- clEnqueueWriteBuffer q mem_in True 0 vecSize (castPtr input) []+ + -- Execute Kernel+ eventExec <- clEnqueueNDRangeKernel q krn [length original] [1] [eventWrite]+ + -- Get Result+ eventRead <- clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]+ + _ <- clWaitForEvents [eventRead]+ + t_start0 <- clGetEventProfilingInfo eventWrite CL_PROFILING_COMMAND_START+ t_end0 <- clGetEventProfilingInfo eventWrite CL_PROFILING_COMMAND_END+ let t_write = t_end0 - t_start0+ + t_start1 <- clGetEventProfilingInfo eventExec CL_PROFILING_COMMAND_START+ t_end1 <- clGetEventProfilingInfo eventExec CL_PROFILING_COMMAND_END+ let t_exec = t_end1 - t_start1+ + t_start2 <- clGetEventProfilingInfo eventRead CL_PROFILING_COMMAND_START+ t_end2 <- clGetEventProfilingInfo eventRead CL_PROFILING_COMMAND_END+ let t_read = t_end2 - t_start2+ + result <- peekArray (length original) input+ + return (t_write,t_exec,t_read,result)+ where+ elemSize = sizeOf (0 :: CFloat)+ vecSize = elemSize * length original
+ examples/example03.hs view
@@ -0,0 +1,98 @@+{- Copyright (c) 2011 Luis Cabellos,++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+import System.GPU.OpenCL +import Foreign( castPtr, nullPtr, sizeOf )+import Foreign.C.Types( CFloat )+import Foreign.Marshal.Array( newArray, peekArray )++programSource1 :: String+programSource1 = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id];\n}"++programSource2 :: String+programSource2 = "__kernel void triparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 3*in[id];\n}"++main :: IO ()+main = do+ -- Initialize OpenCL+ (platform:_) <- clGetPlatformIDs+ (dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL+ context <- clCreateContext [dev] print+ q <- clCreateCommandQueue context dev []+ + -- Initialize Kernels+ program1 <- clCreateProgramWithSource context programSource1+ clBuildProgram program1 [dev] ""+ kernel1 <- clCreateKernel program1 "duparray"+ kernel3 <- clCreateKernel program1 "duparray"+ + program2 <- clCreateProgramWithSource context programSource2+ clBuildProgram program2 [dev] ""+ kernel2 <- clCreateKernel program2 "triparray"+ + -- Initialize parameters+ let original = [0 .. 10] :: [CFloat]+ elemSize = sizeOf (0 :: CFloat)+ vecSize = elemSize * length original+ putStrLn $ "Original array = " ++ show original+ input <- newArray original++ mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input) + mem_mid <- clCreateBuffer context [CL_MEM_READ_WRITE] (vecSize, nullPtr)+ mem_out1 <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)+ mem_out2 <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)++ clSetKernelArg kernel1 0 mem_in+ clSetKernelArg kernel1 1 mem_mid+ + clSetKernelArg kernel2 0 mem_mid+ clSetKernelArg kernel2 1 mem_out1+ + clSetKernelArg kernel3 0 mem_mid+ clSetKernelArg kernel3 1 mem_out2+ + -- Execute Kernels+ eventExec1 <- clEnqueueNDRangeKernel q kernel1 [length original] [1] []+ eventExec2 <- clEnqueueNDRangeKernel q kernel2 [length original] [1] [eventExec1]+ eventExec3 <- clEnqueueNDRangeKernel q kernel3 [length original] [1] [eventExec1]+ + -- Get Result+ eventRead <- clEnqueueReadBuffer q mem_out1 True 0 vecSize (castPtr input) [eventExec2,eventExec3]+ + result <- peekArray (length original) input+ putStrLn $ "Result array 1 = " ++ show result++ eventRead <- clEnqueueReadBuffer q mem_out2 True 0 vecSize (castPtr input) [eventExec2,eventExec3]+ + result <- peekArray (length original) input+ putStrLn $ "Result array 2 = " ++ show result++ return ()
+ examples/example04.hs view
@@ -0,0 +1,80 @@+{- Copyright (c) 2011 Luis Cabellos,++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+import System.GPU.OpenCL+import Foreign( castPtr, nullPtr, sizeOf )+import Foreign.C.Types( CFloat )+import Foreign.Marshal.Array( newArray, peekArray )++programSource :: String+programSource = "__kernel void duparray(__global float *in, __global float *out ){\n int id = get_global_id(0);\n out[id] = 2*in[id];\n}"++main :: IO ()+main = do+ -- Initialize OpenCL+ (platform:_) <- clGetPlatformIDs+ (dev:_) <- clGetDeviceIDs platform CL_DEVICE_TYPE_ALL+ context <- clCreateContext [dev] print+ q <- clCreateCommandQueue context dev []+ + -- Compile and get binaries+ program <- clCreateProgramWithSource context programSource+ clBuildProgram program [dev] ""+ bins <- clGetProgramBinaries program+ + -- Create kernel from binaries+ (program2,_) <- clCreateProgramWithBinary context [dev] bins+ clBuildProgram program2 [dev] ""+ kernel <- clCreateKernel program2 "duparray"+ + -- Initialize parameters+ let original = [0 .. 20] :: [CFloat]+ elemSize = sizeOf (0 :: CFloat)+ vecSize = elemSize * length original+ putStrLn $ "Original array = " ++ show original+ input <- newArray original++ mem_in <- clCreateBuffer context [CL_MEM_READ_ONLY, CL_MEM_COPY_HOST_PTR] (vecSize, castPtr input) + mem_out <- clCreateBuffer context [CL_MEM_WRITE_ONLY] (vecSize, nullPtr)++ clSetKernelArg kernel 0 mem_in+ clSetKernelArg kernel 1 mem_out+ + -- Execute Kernel+ eventExec <- clEnqueueNDRangeKernel q kernel [length original] [1] []+ + -- Get Result+ eventRead <- clEnqueueReadBuffer q mem_out True 0 vecSize (castPtr input) [eventExec]+ + result <- peekArray (length original) input+ putStrLn $ "Result array = " ++ show result++ return ()
src/System/GPU/OpenCL.hs view
@@ -1,19 +1,34 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- -----------------------------------------------------------------------------+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-} module System.GPU.OpenCL( -- * Basic Types CLError(..), CLint, CLuint, CLulong,@@ -23,7 +38,8 @@ module System.GPU.OpenCL.CommandQueue, module System.GPU.OpenCL.Memory, module System.GPU.OpenCL.Event,- module System.GPU.OpenCL.Program )+ module System.GPU.OpenCL.Program+ ) where -- -----------------------------------------------------------------------------
src/System/GPU/OpenCL/CommandQueue.chs view
@@ -1,20 +1,35 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-} module System.GPU.OpenCL.CommandQueue( -- * Types CLCommandQueue, CLCommandQueueProperty(..), @@ -37,41 +52,41 @@ import Foreign.C.Types import System.GPU.OpenCL.Types( CLint, CLbool, CLuint, CLCommandQueueProperty_, CLCommandQueueInfo_, - CLError(..), CLCommandQueue, CLDeviceID, CLContext, CLCommandQueueProperty(..), + CLCommandQueue, CLDeviceID, CLContext, CLCommandQueueProperty(..), CLEvent, CLMem, CLKernel,- wrapCheckSuccess, wrapPError, wrapGetInfo, getCLValue, getEnumCL,+ whenSuccess, wrapCheckSuccess, wrapPError, wrapGetInfo, getCLValue, bitmaskToCommandQueueProperties, bitmaskFromFlags ) #include <CL/cl.h> -- ------------------------------------------------------------------------------foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue :: +foreign import CALLCONV "clCreateCommandQueue" raw_clCreateCommandQueue :: CLContext -> CLDeviceID -> CLCommandQueueProperty_ -> Ptr CLint -> IO CLCommandQueue-foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue :: +foreign import CALLCONV "clRetainCommandQueue" raw_clRetainCommandQueue :: CLCommandQueue -> IO CLint-foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue :: +foreign import CALLCONV "clReleaseCommandQueue" raw_clReleaseCommandQueue :: CLCommandQueue -> IO CLint-foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: +foreign import CALLCONV "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: CLCommandQueue -> CLCommandQueueInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint-foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: +foreign import CALLCONV "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: CLCommandQueue -> CLCommandQueueProperty_ -> CLbool -> Ptr CLCommandQueueProperty_ -> IO CLint-foreign import ccall "clEnqueueReadBuffer" raw_clEnqueueReadBuffer ::+foreign import CALLCONV "clEnqueueReadBuffer" raw_clEnqueueReadBuffer :: CLCommandQueue -> CLMem -> CLbool -> CSize -> CSize -> Ptr () -> CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint-foreign import ccall "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer ::+foreign import CALLCONV "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer :: CLCommandQueue -> CLMem -> CLbool -> CSize -> CSize -> Ptr () -> CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint-foreign import ccall "clEnqueueNDRangeKernel" raw_clEnqueueNDRangeKernel :: +foreign import CALLCONV "clEnqueueNDRangeKernel" raw_clEnqueueNDRangeKernel :: CLCommandQueue -> CLKernel -> CLuint -> Ptr CSize -> Ptr CSize -> Ptr CSize -> CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint-foreign import ccall "clEnqueueTask" raw_clEnqueueTask :: +foreign import CALLCONV "clEnqueueTask" raw_clEnqueueTask :: CLCommandQueue -> CLKernel -> CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint-foreign import ccall "clEnqueueMarker" raw_clEnqueueMarker :: +foreign import CALLCONV "clEnqueueMarker" raw_clEnqueueMarker :: CLCommandQueue -> Ptr CLEvent -> IO CLint -foreign import ccall "clEnqueueWaitForEvents" raw_clEnqueueWaitForEvents :: +foreign import CALLCONV "clEnqueueWaitForEvents" raw_clEnqueueWaitForEvents :: CLCommandQueue -> CLuint -> Ptr CLEvent -> IO CLint-foreign import ccall "clEnqueueBarrier" raw_clEnqueueBarrier :: +foreign import CALLCONV "clEnqueueBarrier" raw_clEnqueueBarrier :: CLCommandQueue -> IO CLint -foreign import ccall "clFlush" raw_clFlush ::+foreign import CALLCONV "clFlush" raw_clFlush :: CLCommandQueue -> IO CLint-foreign import ccall "clFinish" raw_clFinish ::+foreign import CALLCONV "clFinish" raw_clFinish :: CLCommandQueue -> IO CLint -- -----------------------------------------------------------------------------@@ -124,7 +139,7 @@ complete before reads or writes to the memory object(s) occur. -} clCreateCommandQueue :: CLContext -> CLDeviceID -> [CLCommandQueueProperty] - -> IO (Either CLError CLCommandQueue)+ -> IO CLCommandQueue clCreateCommandQueue ctx did xs = wrapPError $ \perr -> do raw_clCreateCommandQueue ctx did props perr where@@ -162,7 +177,9 @@ {#enum CLCommandQueueInfo {upcaseFirstLetter} #} -- | Return the context specified when the command-queue is created.-clGetCommandQueueContext :: CLCommandQueue -> IO (Either CLError CLContext)+--+-- This function execute OpenCL clGetCommandQueueInfo with 'CL_QUEUE_CONTEXT'.+clGetCommandQueueContext :: CLCommandQueue -> IO CLContext clGetCommandQueueContext cq = wrapGetInfo (\(dat :: Ptr CLContext) -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id where @@ -170,7 +187,9 @@ size = fromIntegral $ sizeOf (nullPtr::CLContext) -- | Return the device specified when the command-queue is created.-clGetCommandQueueDevice :: CLCommandQueue -> IO (Either CLError CLDeviceID)+--+-- This function execute OpenCL clGetCommandQueueInfo with 'CL_QUEUE_DEVICE'.+clGetCommandQueueDevice :: CLCommandQueue -> IO CLDeviceID clGetCommandQueueDevice cq = wrapGetInfo (\(dat :: Ptr CLDeviceID) -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id where @@ -181,7 +200,10 @@ -- The reference count returned should be considered immediately stale. It is -- unsuitable for general use in applications. This feature is provided for -- identifying memory leaks.-clGetCommandQueueReferenceCount :: CLCommandQueue -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetCommandQueueInfo with+-- 'CL_QUEUE_REFERENCE_COUNT'.+clGetCommandQueueReferenceCount :: CLCommandQueue -> IO CLuint clGetCommandQueueReferenceCount cq = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) id where @@ -192,7 +214,10 @@ -- | Return the currently specified properties for the command-queue. These -- properties are specified by the properties argument in 'clCreateCommandQueue' -- , and can be changed by 'clSetCommandQueueProperty'.-clGetCommandQueueProperties :: CLCommandQueue -> IO (Either CLError [CLCommandQueueProperty])+--+-- This function execute OpenCL clGetCommandQueueInfo with+-- 'CL_QUEUE_PROPERTIES'.+clGetCommandQueueProperties :: CLCommandQueue -> IO [CLCommandQueueProperty] clGetCommandQueueProperties cq = wrapGetInfo (\(dat :: Ptr CLCommandQueueProperty_) -> raw_clGetCommandQueueInfo cq infoid size (castPtr dat)) bitmaskToCommandQueueProperties where @@ -219,30 +244,24 @@ device becomes unavailable. -} clSetCommandQueueProperty :: CLCommandQueue -> [CLCommandQueueProperty] -> Bool - -> IO (Either CLError [CLCommandQueueProperty])-clSetCommandQueueProperty cq xs val = alloca $ \(dat :: Ptr CLCommandQueueProperty_) -> do- errcode <- raw_clSetCommandQueueProperty cq props (fromBool val) dat- if errcode == getCLValue CL_SUCCESS- then fmap (Right . bitmaskToCommandQueueProperties) $ peek dat- else return . Left . getEnumCL $ errcode+ -> IO [CLCommandQueueProperty]+clSetCommandQueueProperty cq xs val = alloca + $ \(dat :: Ptr CLCommandQueueProperty_) + -> whenSuccess (f dat)+ $ fmap bitmaskToCommandQueueProperties $ peek dat where+ f = raw_clSetCommandQueueProperty cq props (fromBool val) props = bitmaskFromFlags xs -- ----------------------------------------------------------------------------- clEnqueue :: (CLuint -> Ptr CLEvent -> Ptr CLEvent -> IO CLint) -> [CLEvent] - -> IO (Either CLError CLEvent)-clEnqueue f [] = alloca $ \event -> do- errcode <- f 0 nullPtr event- if errcode == getCLValue CL_SUCCESS- then fmap Right $ peek event- else return . Left . getEnumCL $ errcode+ -> IO CLEvent+clEnqueue f [] = alloca $ \event -> whenSuccess (f 0 nullPtr event)+ $ peek event clEnqueue f events = allocaArray nevents $ \pevents -> do pokeArray pevents events- alloca $ \event -> do- errcode <- f cnevents pevents event- if errcode == getCLValue CL_SUCCESS- then fmap Right $ peek event- else return . Left . getEnumCL $ errcode+ alloca $ \event -> whenSuccess (f cnevents pevents event)+ $ peek event where nevents = length events cnevents = fromIntegral nevents@@ -264,7 +283,7 @@ finished execution Errors 'clEnqueueReadBuffer' returns the event if the function is executed-successfully. Otherwise, it returns one of the following errors:+successfully. It can throw the following 'CLError' exceptions: * 'CL_INVALID_COMMAND_QUEUE' if command_queue is not a valid command-queue. @@ -289,7 +308,7 @@ by the OpenCL implementation on the host. -} clEnqueueReadBuffer :: Integral a => CLCommandQueue -> CLMem -> Bool -> a -> a- -> Ptr () -> [CLEvent] -> IO (Either CLError CLEvent)+ -> Ptr () -> [CLEvent] -> IO CLEvent clEnqueueReadBuffer cq mem check off size dat = clEnqueue (raw_clEnqueueReadBuffer cq mem (fromBool check) (fromIntegral off) (fromIntegral size) dat) {-| Enqueue commands to write to a buffer object from host memory.Calling@@ -308,7 +327,7 @@ has finished execution. 'clEnqueueWriteBuffer' returns the Event if the function is executed-successfully. Otherwise, it returns one of the following errors:+successfully. It can throw the following 'CLError' exceptions: * 'CL_INVALID_COMMAND_QUEUE' if command_queue is not a valid command-queue. @@ -333,7 +352,7 @@ by the OpenCL implementation on the host. -} clEnqueueWriteBuffer :: Integral a => CLCommandQueue -> CLMem -> Bool -> a -> a- -> Ptr () -> [CLEvent] -> IO (Either CLError CLEvent)+ -> Ptr () -> [CLEvent] -> IO CLEvent clEnqueueWriteBuffer cq mem check off size dat = clEnqueue (raw_clEnqueueWriteBuffer cq mem (fromBool check) (fromIntegral off) (fromIntegral size) dat) -- -----------------------------------------------------------------------------@@ -346,8 +365,8 @@ using the value given by local_work_size. The starting local ID is always (0, 0, ... 0). -Returns the event if the kernel execution was successfully queued. Otherwise, it-returns one of the following errors:+Returns the event if the kernel execution was successfully queued. It can throw+the following 'CLError' exceptions: * 'CL_INVALID_PROGRAM_EXECUTABLE' if there is no successfully built program executable available for device associated with command_queue.@@ -402,7 +421,8 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clEnqueueNDRangeKernel :: Integral a => CLCommandQueue -> CLKernel -> [a] -> [a] -> [CLEvent] -> IO (Either CLError CLEvent)+clEnqueueNDRangeKernel :: Integral a => CLCommandQueue -> CLKernel -> [a] -> [a] + -> [CLEvent] -> IO CLEvent clEnqueueNDRangeKernel cq krn gws lws events = withArray (map fromIntegral gws) $ \pgws -> withArray (map fromIntegral lws) $ \plws -> do clEnqueue (raw_clEnqueueNDRangeKernel cq krn num nullPtr pgws plws) events where@@ -415,8 +435,8 @@ = 1, global_work_offset = [], global_work_size[0] set to 1, and local_work_size[0] set to 1. -Returns the evens if the kernel execution was successfully queued, or one of the-errors below:+Returns the evens if the kernel execution was successfully queued. It can throw+the following 'CLError' exceptions: * 'CL_INVALID_PROGRAM_EXECUTABLE' if there is no successfully built program executable available for device associated with command_queue.@@ -446,30 +466,27 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clEnqueueTask :: CLCommandQueue -> CLKernel -> [CLEvent] - -> IO (Either CLError CLEvent)+clEnqueueTask :: CLCommandQueue -> CLKernel -> [CLEvent] -> IO CLEvent clEnqueueTask cq krn = clEnqueue (raw_clEnqueueTask cq krn) -- ----------------------------------------------------------------------------- -- | Enqueues a marker command to command_queue. The marker command returns an -- event which can be used to queue a wait on this marker event i.e. wait for -- all commands queued before the marker command to complete. Returns the event--- if the function is successfully executed. It returns+-- if the function is successfully executed. It throw the 'CLError' exception -- 'CL_INVALID_COMMAND_QUEUE' if command_queue is not a valid command-queue and--- returns 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources+-- throw 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources -- required by the OpenCL implementation on the host.-clEnqueueMarker :: CLCommandQueue -> IO (Either CLError CLEvent)-clEnqueueMarker cq = alloca $ \event -> do- errcode <- raw_clEnqueueMarker cq event- if errcode == getCLValue CL_SUCCESS- then fmap Right $ peek event- else return . Left . getEnumCL $ errcode+clEnqueueMarker :: CLCommandQueue -> IO CLEvent+clEnqueueMarker cq = alloca $ \event + -> whenSuccess (raw_clEnqueueMarker cq event)+ $ peek event {-| Enqueues a wait for a specific event or a list of events to complete before any future commands queued in the command-queue are executed. The context associated with events in event_list and command_queue must be the same. -Returns one of the errors below when fails:+It can throw the following 'CLError' exceptions: * 'CL_INVALID_COMMAND_QUEUE' if command_queue is not a valid command-queue. @@ -484,34 +501,26 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clEnqueueWaitForEvents :: CLCommandQueue -> [CLEvent] -> IO (Either CLError ())-clEnqueueWaitForEvents cq [] = do- errcode <- raw_clEnqueueWaitForEvents cq 0 nullPtr- if errcode == getCLValue CL_SUCCESS- then return $ Right ()- else return . Left . getEnumCL $ errcode+clEnqueueWaitForEvents :: CLCommandQueue -> [CLEvent] -> IO ()+clEnqueueWaitForEvents cq [] = whenSuccess + (raw_clEnqueueWaitForEvents cq 0 nullPtr)+ $ return () clEnqueueWaitForEvents cq events = allocaArray nevents $ \pevents -> do pokeArray pevents events- errcode <- raw_clEnqueueWaitForEvents cq cnevents pevents- if errcode == getCLValue CL_SUCCESS- then return $ Right ()- else return . Left . getEnumCL $ errcode+ whenSuccess (raw_clEnqueueWaitForEvents cq cnevents pevents)+ $ return () where nevents = length events cnevents = fromIntegral nevents -- | 'clEnqueueBarrier' is a synchronization point that ensures that all queued -- commands in command_queue have finished execution before the next batch of--- commands can begin execution. It returns 'CL_INVALID_COMMAND_QUEUE' if--- command_queue is not a valid command-queue and returns+-- commands can begin execution. It throws 'CL_INVALID_COMMAND_QUEUE' if+-- command_queue is not a valid command-queue and throws -- 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required -- by the OpenCL implementation on the host.-clEnqueueBarrier :: CLCommandQueue -> IO (Either CLError ())-clEnqueueBarrier cq = do- errcode <- raw_clEnqueueBarrier cq- if errcode == getCLValue CL_SUCCESS- then return $ Right ()- else return . Left . getEnumCL $ errcode+clEnqueueBarrier :: CLCommandQueue -> IO ()+clEnqueueBarrier cq = whenSuccess (raw_clEnqueueBarrier cq) $ return () -- ----------------------------------------------------------------------------- {-| Issues all previously queued OpenCL commands in a command-queue to the
src/System/GPU/OpenCL/Context.chs view
@@ -1,20 +1,35 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-} module System.GPU.OpenCL.Context( -- * Types CLContext,@@ -32,26 +47,26 @@ import Foreign.Storable( sizeOf ) import System.GPU.OpenCL.Types( CLuint, CLint, CLDeviceType_, CLContextInfo_, CLContextProperty_, CLDeviceID, - CLContext, CLDeviceType, CLError(..), bitmaskFromFlags, getCLValue, getEnumCL, - wrapCheckSuccess, wrapPError, wrapGetInfo )+ CLContext, CLDeviceType, bitmaskFromFlags, getCLValue,+ whenSuccess, wrapCheckSuccess, wrapPError, wrapGetInfo ) #include <CL/cl.h> -- ----------------------------------------------------------------------------- type ContextCallback = CString -> Ptr () -> CSize -> Ptr () -> IO ()-foreign import ccall "wrapper" wrapContextCallback :: +foreign import CALLCONV "wrapper" wrapContextCallback :: ContextCallback -> IO (FunPtr ContextCallback)-foreign import ccall "clCreateContext" raw_clCreateContext ::+foreign import CALLCONV "clCreateContext" raw_clCreateContext :: Ptr CLContextProperty_ -> CLuint -> Ptr CLDeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO CLContext-foreign import ccall "clCreateContextFromType" raw_clCreateContextFromType :: +foreign import CALLCONV "clCreateContextFromType" raw_clCreateContextFromType :: Ptr CLContextProperty_ -> CLDeviceType_ -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO CLContext-foreign import ccall "clRetainContext" raw_clRetainContext :: +foreign import CALLCONV "clRetainContext" raw_clRetainContext :: CLContext -> IO CLint-foreign import ccall "clReleaseContext" raw_clReleaseContext :: +foreign import CALLCONV "clReleaseContext" raw_clReleaseContext :: CLContext -> IO CLint-foreign import ccall "clGetContextInfo" raw_clGetContextInfo :: +foreign import CALLCONV "clGetContextInfo" raw_clGetContextInfo :: CLContext -> CLContextInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint -- -----------------------------------------------------------------------------@@ -63,8 +78,7 @@ -- the OpenCL runtime for managing objects such as command-queues, memory, -- program and kernel objects and for executing kernels on one or more devices -- specified in the context.-clCreateContext :: [CLDeviceID] -> (String -> IO ()) - -> IO (Either CLError CLContext)+clCreateContext :: [CLDeviceID] -> (String -> IO ()) -> IO CLContext clCreateContext devs f = allocaArray ndevs $ \pdevs -> do pokeArray pdevs devs wrapPError $ \perr -> do@@ -77,7 +91,7 @@ -- | Create an OpenCL context from a device type that identifies the specific -- device(s) to use. clCreateContextFromType :: [CLDeviceType] -> (String -> IO ()) - -> IO (Either CLError CLContext)+ -> IO CLContext clCreateContextFromType xs f = wrapPError $ \perr -> do fptr <- wrapContextCallback $ mkContextCallback f raw_clCreateContextFromType nullPtr types fptr nullPtr perr@@ -105,12 +119,10 @@ clReleaseContext :: CLContext -> IO Bool clReleaseContext ctx = wrapCheckSuccess $ raw_clReleaseContext ctx -getContextInfoSize :: CLContext -> CLContextInfo_ -> IO (Either CLError CSize)+getContextInfoSize :: CLContext -> CLContextInfo_ -> IO CSize getContextInfoSize ctx infoid = alloca $ \(value_size :: Ptr CSize) -> do- errcode <- raw_clGetContextInfo ctx infoid 0 nullPtr value_size- if errcode == getCLValue CL_SUCCESS- then fmap Right $ peek value_size- else return . Left . getEnumCL $ errcode+ whenSuccess (raw_clGetContextInfo ctx infoid 0 nullPtr value_size)+ $ peek value_size #c enum CLContextInfo {@@ -124,7 +136,9 @@ -- | Return the context reference count. The reference count returned should be -- considered immediately stale. It is unsuitable for general use in -- applications. This feature is provided for identifying memory leaks.-clGetContextReferenceCount :: CLContext -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetContextInfo with 'CL_CONTEXT_REFERENCE_COUNT'.+clGetContextReferenceCount :: CLContext -> IO CLuint clGetContextReferenceCount ctx = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetContextInfo ctx infoid size (castPtr dat)) id where @@ -132,17 +146,16 @@ size = fromIntegral $ sizeOf (0::CLuint) -- | Return the list of devices in context.-clGetContextDevices :: CLContext -> IO (Either CLError [CLDeviceID])+--+-- This function execute OpenCL clGetContextInfo with 'CL_CONTEXT_DEVICES'.+clGetContextDevices :: CLContext -> IO [CLDeviceID] clGetContextDevices ctx = do- val <- getContextInfoSize ctx infoid- case val of- Left err -> return . Left $ err- Right size -> let n = (fromIntegral size) `div` elemSize- in allocaArray n $ \(buff :: Ptr CLDeviceID) -> do- errcode <- raw_clGetContextInfo ctx infoid size (castPtr buff) nullPtr- if errcode == getCLValue CL_SUCCESS- then fmap Right $ peekArray n buff- else return . Left . getEnumCL $ errcode+ size <- getContextInfoSize ctx infoid+ let n = (fromIntegral size) `div` elemSize + + allocaArray n $ \(buff :: Ptr CLDeviceID) -> do+ whenSuccess (raw_clGetContextInfo ctx infoid size (castPtr buff) nullPtr)+ $ peekArray n buff where infoid = getCLValue CL_CONTEXT_DEVICES elemSize = sizeOf (nullPtr :: CLDeviceID)
src/System/GPU/OpenCL/Event.chs view
@@ -1,20 +1,35 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-} module System.GPU.OpenCL.Event( -- * Types CLEvent, CLCommandType(..), CLProfilingInfo(..), CLCommandExecutionStatus(..),@@ -28,7 +43,7 @@ import Foreign import Foreign.C.Types import System.GPU.OpenCL.Types( - CLEvent, CLint, CLuint, CLulong, CLEventInfo_, CLProfilingInfo_, CLError(..),+ CLEvent, CLint, CLuint, CLulong, CLEventInfo_, CLProfilingInfo_, CLCommandQueue, CLCommandType(..), CLCommandType_, CLCommandExecutionStatus(..), CLProfilingInfo(..), getCommandExecutionStatus, getCLValue, getEnumCL, wrapCheckSuccess, wrapGetInfo )@@ -36,15 +51,15 @@ #include <CL/cl.h> -- ------------------------------------------------------------------------------foreign import ccall "clWaitForEvents" raw_clWaitForEvents :: +foreign import CALLCONV "clWaitForEvents" raw_clWaitForEvents :: CLuint -> Ptr CLEvent -> IO CLint-foreign import ccall "clGetEventInfo" raw_clGetEventInfo :: +foreign import CALLCONV "clGetEventInfo" raw_clGetEventInfo :: CLEvent -> CLEventInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint-foreign import ccall "clRetainEvent" raw_clRetainEvent :: +foreign import CALLCONV "clRetainEvent" raw_clRetainEvent :: CLEvent -> IO CLint -foreign import ccall "clReleaseEvent" raw_clReleaseEvent :: +foreign import CALLCONV "clReleaseEvent" raw_clReleaseEvent :: CLEvent -> IO CLint -foreign import ccall "clGetEventProfilingInfo" raw_clGetEventProfilingInfo :: +foreign import CALLCONV "clGetEventProfilingInfo" raw_clGetEventProfilingInfo :: CLEvent -> CLProfilingInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint -- -----------------------------------------------------------------------------@@ -92,7 +107,9 @@ -- | Return the command-queue associated with event.-clGetEventCommandQueue :: CLEvent -> IO (Either CLError CLCommandQueue)+--+-- This function execute OpenCL clGetEventInfo with 'CL_EVENT_COMMAND_QUEUE'.+clGetEventCommandQueue :: CLEvent -> IO CLCommandQueue clGetEventCommandQueue ev = wrapGetInfo (\(dat :: Ptr CLCommandQueue) -> raw_clGetEventInfo ev infoid size (castPtr dat)) id where @@ -100,7 +117,9 @@ size = fromIntegral $ sizeOf (nullPtr::CLCommandQueue) -- | Return the command associated with event.-clGetEventCommandType :: CLEvent -> IO (Either CLError CLCommandType)+--+-- This function execute OpenCL clGetEventInfo with 'CL_EVENT_COMMAND_TYPE'.+clGetEventCommandType :: CLEvent -> IO CLCommandType clGetEventCommandType ev = wrapGetInfo (\(dat :: Ptr CLCommandType_) -> raw_clGetEventInfo ev infoid size (castPtr dat)) getEnumCL where @@ -110,7 +129,9 @@ -- | Return the event reference count. The reference count returned should be -- considered immediately stale. It is unsuitable for general use in applications. -- This feature is provided for identifying memory leaks.-clGetEventReferenceCount :: CLEvent -> IO (Either CLError CLint)+--+-- This function execute OpenCL clGetEventInfo with 'CL_EVENT_REFERENCE_COUNT'.+clGetEventReferenceCount :: CLEvent -> IO CLint clGetEventReferenceCount ev = wrapGetInfo (\(dat :: Ptr CLint) -> raw_clGetEventInfo ev infoid size (castPtr dat)) id where @@ -118,7 +139,10 @@ size = fromIntegral $ sizeOf (0::CLint) -- | Return the execution status of the command identified by event.-clGetEventCommandExecutionStatus :: CLEvent -> IO (Either CLError CLCommandExecutionStatus)+--+-- This function execute OpenCL clGetEventInfo with+-- 'CL_EVENT_COMMAND_EXECUTION_STATUS'.+clGetEventCommandExecutionStatus :: CLEvent -> IO CLCommandExecutionStatus clGetEventCommandExecutionStatus ev = wrapGetInfo (\(dat :: Ptr CLint) -> raw_clGetEventInfo ev infoid size (castPtr dat)) getCommandExecutionStatus where @@ -148,7 +172,7 @@ (because the command identified by event has not completed), or if event is a not a valid event object. -} -clGetEventProfilingInfo :: CLEvent -> CLProfilingInfo -> IO (Either CLError CLulong)+clGetEventProfilingInfo :: CLEvent -> CLProfilingInfo -> IO CLulong clGetEventProfilingInfo ev prof = wrapGetInfo (\(dat :: Ptr CLulong) -> raw_clGetEventProfilingInfo ev infoid size (castPtr dat)) id where
src/System/GPU/OpenCL/Memory.chs view
@@ -1,20 +1,35 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-} module System.GPU.OpenCL.Memory( -- * Types CLMem, CLSampler, CLMemFlag(..), CLMemObjectType(..), CLAddressingMode(..), @@ -33,7 +48,7 @@ import Foreign import Foreign.C.Types import System.GPU.OpenCL.Types( - CLMem, CLContext, CLSampler, CLint, CLuint, CLbool, CLMemFlags_, CLError(..), + CLMem, CLContext, CLSampler, CLint, CLuint, CLbool, CLMemFlags_, CLMemInfo_, CLAddressingMode_, CLFilterMode_, CLSamplerInfo_, CLAddressingMode(..), CLFilterMode(..), CLMemFlag(..), CLMemObjectType_, CLMemObjectType(..), @@ -43,37 +58,37 @@ #include <CL/cl.h> -- ------------------------------------------------------------------------------foreign import ccall "clCreateBuffer" raw_clCreateBuffer :: +foreign import CALLCONV "clCreateBuffer" raw_clCreateBuffer :: CLContext -> CLMemFlags_ -> CSize -> Ptr () -> Ptr CLint -> IO CLMem---foreign import ccall "clCreateImage2D" raw_clCreateImage2D :: +--foreign import CALLCONV "clCreateImage2D" raw_clCreateImage2D :: -- CLContext -> CLMemFlags_ -> CLImageFormat_p -> CSize -> CSize -> CSize -- -> Ptr () -> Ptr CLint -> IO CLMem---foreign import ccall "clCreateImage3D" raw_clCreateImage3D :: +--foreign import CALLCONV "clCreateImage3D" raw_clCreateImage3D :: -- CLContext -> CLMemFlags_-> CLImageFormat_p -> CSize -> CSize -> CSize -> CSize -- -> CSize -> Ptr () -> Ptr CLint -> IO CLMem-foreign import ccall "clRetainMemObject" raw_clRetainMemObject :: +foreign import CALLCONV "clRetainMemObject" raw_clRetainMemObject :: CLMem -> IO CLint-foreign import ccall "clReleaseMemObject" raw_clReleaseMemObject :: +foreign import CALLCONV "clReleaseMemObject" raw_clReleaseMemObject :: CLMem -> IO CLint---foreign import ccall "clGetSupportedImageFormats" raw_clGetSupportedImageFormats :: +--foreign import CALLCONV "clGetSupportedImageFormats" raw_clGetSupportedImageFormats :: -- CLContext -> CLMemFlags_ -> CLMemObjectType_ -> CLuint -> CLImageFormat_p -- -> Ptr CLuint -> IO CLint-foreign import ccall "clGetMemObjectInfo" raw_clGetMemObjectInfo :: +foreign import CALLCONV "clGetMemObjectInfo" raw_clGetMemObjectInfo :: CLMem -> CLMemInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint---foreign import ccall "clGetImageInfo" raw_clGetImageInfo :: +--foreign import CALLCONV "clGetImageInfo" raw_clGetImageInfo :: -- CLMem -> CLImageInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint-foreign import ccall "clCreateSampler" raw_clCreateSampler :: +foreign import CALLCONV "clCreateSampler" raw_clCreateSampler :: CLContext -> CLbool -> CLAddressingMode_ -> CLFilterMode_ -> Ptr CLint -> IO CLSampler-foreign import ccall "clRetainSampler" raw_clRetainSampler :: +foreign import CALLCONV "clRetainSampler" raw_clRetainSampler :: CLSampler -> IO CLint-foreign import ccall "clReleaseSampler" raw_clReleaseSampler :: +foreign import CALLCONV "clReleaseSampler" raw_clReleaseSampler :: CLSampler -> IO CLint-foreign import ccall "clGetSamplerInfo" raw_clGetSamplerInfo :: +foreign import CALLCONV "clGetSamplerInfo" raw_clGetSamplerInfo :: CLSampler -> CLSamplerInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint -- ----------------------------------------------------------------------------- {-| Creates a buffer object. Returns a valid non-zero buffer object if the-buffer object is created successfully. Otherwise, it returns: +buffer object is created successfully. Otherwise, it throws the 'CLError': * 'CL_INVALID_CONTEXT' if context is not a valid context. @@ -92,7 +107,7 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clCreateBuffer :: Integral a => CLContext -> [CLMemFlag] -> (a, Ptr ()) -> IO (Either CLError CLMem)+clCreateBuffer :: Integral a => CLContext -> [CLMemFlag] -> (a, Ptr ()) -> IO CLMem clCreateBuffer ctx xs (sbuff,buff) = wrapPError $ \perr -> do raw_clCreateBuffer ctx flags (fromIntegral sbuff) buff perr where@@ -128,7 +143,9 @@ {#enum CLMemInfo {upcaseFirstLetter} #} -- | Returns the mem object type.-clGetMemType :: CLMem -> IO (Either CLError CLMemObjectType)+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_TYPE'.+clGetMemType :: CLMem -> IO CLMemObjectType clGetMemType mem = wrapGetInfo (\(dat :: Ptr CLMemObjectType_) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) getEnumCL where @@ -136,7 +153,9 @@ size = fromIntegral $ sizeOf (0::CLMemObjectType_) -- | Return the flags argument value specified when memobj was created.-clGetMemFlags :: CLMem -> IO (Either CLError [CLMemFlag])+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_FLAGS'.+clGetMemFlags :: CLMem -> IO [CLMemFlag] clGetMemFlags mem = wrapGetInfo (\(dat :: Ptr CLMemFlags_) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) bitmaskToMemFlags where @@ -144,7 +163,9 @@ size = fromIntegral $ sizeOf (0::CLMemFlags_) -- | Return actual size of memobj in bytes.-clGetMemSize :: CLMem -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_SIZE'.+clGetMemSize :: CLMem -> IO CSize clGetMemSize mem = wrapGetInfo (\(dat :: Ptr CSize) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id where @@ -152,7 +173,9 @@ size = fromIntegral $ sizeOf (0::CSize) -- | Return the host_ptr argument value specified when memobj is created.-clGetMemHostPtr :: CLMem -> IO (Either CLError (Ptr ()))+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_HOST_PTR'.+clGetMemHostPtr :: CLMem -> IO (Ptr ()) clGetMemHostPtr mem = wrapGetInfo (\(dat :: Ptr (Ptr ())) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id where @@ -162,7 +185,9 @@ -- | Map count. The map count returned should be considered immediately -- stale. It is unsuitable for general use in applications. This feature is -- provided for debugging.-clGetMemMapCount :: CLMem -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_MAP_COUNT'.+clGetMemMapCount :: CLMem -> IO CLuint clGetMemMapCount mem = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id where @@ -172,7 +197,9 @@ -- | Return memobj reference count. The reference count returned should be -- considered immediately stale. It is unsuitable for general use in -- applications. This feature is provided for identifying memory leaks.-clGetMemReferenceCount :: CLMem -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_REFERENCE_COUNT'.+clGetMemReferenceCount :: CLMem -> IO CLuint clGetMemReferenceCount mem = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id where @@ -180,7 +207,9 @@ size = fromIntegral $ sizeOf (0 :: CLuint) -- | Return context specified when memory object is created.-clGetMemContext :: CLMem -> IO (Either CLError CLContext)+--+-- This function execute OpenCL clGetMemObjectInfo with 'CL_MEM_CONTEXT'.+clGetMemContext :: CLMem -> IO CLContext clGetMemContext mem = wrapGetInfo (\(dat :: Ptr CLContext) -> raw_clGetMemObjectInfo mem infoid size (castPtr dat)) id where @@ -197,7 +226,7 @@ functions. Returns a valid non-zero sampler object if the sampler object is created-successfully. Otherwise, it returns one of the following error values:+successfully. Otherwise, it throws one of the following 'CLError' exceptions: * 'CL_INVALID_CONTEXT' if context is not a valid context. @@ -211,7 +240,8 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clCreateSampler :: CLContext -> Bool -> CLAddressingMode -> CLFilterMode -> IO (Either CLError CLSampler)+clCreateSampler :: CLContext -> Bool -> CLAddressingMode -> CLFilterMode + -> IO CLSampler clCreateSampler ctx norm am fm = wrapPError $ \perr -> do raw_clCreateSampler ctx (fromBool norm) (getCLValue am) (getCLValue fm) perr @@ -243,7 +273,10 @@ -- | Return the sampler reference count. The reference count returned should be -- considered immediately stale. It is unsuitable for general use in -- applications. This feature is provided for identifying memory leaks.-clGetSamplerReferenceCount :: CLSampler -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetSamplerInfo with+-- 'CL_SAMPLER_REFERENCE_COUNT'.+clGetSamplerReferenceCount :: CLSampler -> IO CLuint clGetSamplerReferenceCount sam = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetSamplerInfo sam infoid size (castPtr dat)) id where @@ -251,7 +284,9 @@ size = fromIntegral $ sizeOf (0 :: CLuint) -- | Return the context specified when the sampler is created.-clGetSamplerContext :: CLSampler -> IO (Either CLError CLContext)+--+-- This function execute OpenCL clGetSamplerInfo with 'CL_SAMPLER_CONTEXT'.+clGetSamplerContext :: CLSampler -> IO CLContext clGetSamplerContext sam = wrapGetInfo (\(dat :: Ptr CLContext) -> raw_clGetSamplerInfo sam infoid size (castPtr dat)) id where @@ -259,7 +294,10 @@ size = fromIntegral $ sizeOf (nullPtr :: CLContext) -- | Return the value specified by addressing_mode argument to clCreateSampler.-clGetSamplerAddressingMode :: CLSampler -> IO (Either CLError CLAddressingMode)+--+-- This function execute OpenCL clGetSamplerInfo with+-- 'CL_SAMPLER_ADDRESSING_MODE'.+clGetSamplerAddressingMode :: CLSampler -> IO CLAddressingMode clGetSamplerAddressingMode sam = wrapGetInfo (\(dat :: Ptr CLAddressingMode_) -> raw_clGetSamplerInfo sam infoid size (castPtr dat)) getEnumCL where @@ -267,7 +305,9 @@ size = fromIntegral $ sizeOf (0 :: CLAddressingMode_) -- | Return the value specified by filter_mode argument to clCreateSampler.-clGetSamplerFilterMode :: CLSampler -> IO (Either CLError CLFilterMode)+--+-- This function execute OpenCL clGetSamplerInfo with 'CL_SAMPLER_FILTER_MODE'.+clGetSamplerFilterMode :: CLSampler -> IO CLFilterMode clGetSamplerFilterMode sam = wrapGetInfo (\(dat :: Ptr CLFilterMode_) -> raw_clGetSamplerInfo sam infoid size (castPtr dat)) getEnumCL where @@ -276,7 +316,10 @@ -- | Return the value specified by normalized_coords argument to -- clCreateSampler.-clGetSamplerNormalizedCoords :: CLSampler -> IO (Either CLError Bool)+--+-- This function execute OpenCL clGetSamplerInfo with+-- 'CL_SAMPLER_NORMALIZED_COORDS'.+clGetSamplerNormalizedCoords :: CLSampler -> IO Bool clGetSamplerNormalizedCoords sam = wrapGetInfo (\(dat :: Ptr CLbool) -> raw_clGetSamplerInfo sam infoid size (castPtr dat)) (/=0) where
src/System/GPU/OpenCL/Program.chs view
@@ -1,29 +1,45 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-} module System.GPU.OpenCL.Program( -- * Types CLProgram, CLBuildStatus(..), CLKernel, -- * Program Functions- clCreateProgramWithSource, clRetainProgram, clReleaseProgram, - clUnloadCompiler, clBuildProgram, clGetProgramReferenceCount, - clGetProgramContext, clGetProgramNumDevices, clGetProgramDevices,- clGetProgramSource, clGetProgramBinarySizes, clGetProgramBinaries, - clGetProgramBuildStatus, clGetProgramBuildOptions, clGetProgramBuildLog,+ clCreateProgramWithSource, clCreateProgramWithBinary, clRetainProgram, + clReleaseProgram, clUnloadCompiler, clBuildProgram, + clGetProgramReferenceCount, clGetProgramContext, clGetProgramNumDevices, + clGetProgramDevices, clGetProgramSource, clGetProgramBinarySizes, + clGetProgramBinaries, clGetProgramBuildStatus, clGetProgramBuildOptions, + clGetProgramBuildLog, -- * Kernel Functions clCreateKernel, clCreateKernelsInProgram, clRetainKernel, clReleaseKernel, clSetKernelArg, clGetKernelFunctionName, clGetKernelNumArgs, @@ -33,49 +49,49 @@ ) where -- ------------------------------------------------------------------------------import Control.Monad( zipWithM )+import Control.Monad( zipWithM, forM ) import Foreign import Foreign.C.Types import Foreign.C.String( CString, withCString, newCString, peekCString ) import System.GPU.OpenCL.Types( - CLint, CLuint, CLulong, CLProgram, CLContext, CLKernel, CLDeviceID, - CLError(..), CLProgramInfo_, CLBuildStatus(..), CLBuildStatus_, - CLProgramBuildInfo_, CLKernelInfo_, CLKernelWorkGroupInfo_, wrapCheckSuccess, - wrapPError, wrapGetInfo, getCLValue, getEnumCL )+ CLint, CLuint, CLulong, CLProgram, CLContext, CLKernel, CLDeviceID, CLError,+ CLProgramInfo_, CLBuildStatus(..), CLBuildStatus_, CLProgramBuildInfo_, + CLKernelInfo_, CLKernelWorkGroupInfo_, wrapCheckSuccess, + whenSuccess, wrapPError, wrapGetInfo, getCLValue, getEnumCL ) #include <CL/cl.h> -- ----------------------------------------------------------------------------- type BuildCallback = CLProgram -> Ptr () -> IO ()-foreign import ccall "clCreateProgramWithSource" raw_clCreateProgramWithSource :: +foreign import CALLCONV "clCreateProgramWithSource" raw_clCreateProgramWithSource :: CLContext -> CLuint -> Ptr CString -> Ptr CSize -> Ptr CLint -> IO CLProgram---foreign import ccall "clCreateProgramWithBinary" raw_clCreateProgramWithBinary :: --- CLContext -> CLuint -> Ptr CLDeviceID -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CLint -> Ptr CLint -> IO CLProgram-foreign import ccall "clRetainProgram" raw_clRetainProgram :: +foreign import CALLCONV "clCreateProgramWithBinary" raw_clCreateProgramWithBinary :: + CLContext -> CLuint -> Ptr CLDeviceID -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CLint -> Ptr CLint -> IO CLProgram+foreign import CALLCONV "clRetainProgram" raw_clRetainProgram :: CLProgram -> IO CLint-foreign import ccall "clReleaseProgram" raw_clReleaseProgram :: +foreign import CALLCONV "clReleaseProgram" raw_clReleaseProgram :: CLProgram -> IO CLint-foreign import ccall "clBuildProgram" raw_clBuildProgram :: +foreign import CALLCONV "clBuildProgram" raw_clBuildProgram :: CLProgram -> CLuint -> Ptr CLDeviceID -> CString -> FunPtr BuildCallback -> Ptr () -> IO CLint-foreign import ccall "clUnloadCompiler" raw_clUnloadCompiler :: +foreign import CALLCONV "clUnloadCompiler" raw_clUnloadCompiler :: IO CLint-foreign import ccall "clGetProgramInfo" raw_clGetProgramInfo :: +foreign import CALLCONV "clGetProgramInfo" raw_clGetProgramInfo :: CLProgram -> CLProgramInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint-foreign import ccall "clGetProgramBuildInfo" raw_clGetProgramBuildInfo :: +foreign import CALLCONV "clGetProgramBuildInfo" raw_clGetProgramBuildInfo :: CLProgram -> CLDeviceID -> CLProgramBuildInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint-foreign import ccall "clCreateKernel" raw_clCreateKernel :: +foreign import CALLCONV "clCreateKernel" raw_clCreateKernel :: CLProgram -> CString -> Ptr CLint -> IO CLKernel -foreign import ccall "clCreateKernelsInProgram" raw_clCreateKernelsInProgram :: +foreign import CALLCONV "clCreateKernelsInProgram" raw_clCreateKernelsInProgram :: CLProgram -> CLuint -> Ptr CLKernel -> Ptr CLuint -> IO CLint -foreign import ccall "clRetainKernel" raw_clRetainKernel :: +foreign import CALLCONV "clRetainKernel" raw_clRetainKernel :: CLKernel -> IO CLint -foreign import ccall "clReleaseKernel" raw_clReleaseKernel :: +foreign import CALLCONV "clReleaseKernel" raw_clReleaseKernel :: CLKernel -> IO CLint -foreign import ccall "clSetKernelArg" raw_clSetKernelArg :: +foreign import CALLCONV "clSetKernelArg" raw_clSetKernelArg :: CLKernel -> CLuint -> CSize -> Ptr () -> IO CLint-foreign import ccall "clGetKernelInfo" raw_clGetKernelInfo :: +foreign import CALLCONV "clGetKernelInfo" raw_clGetKernelInfo :: CLKernel -> CLKernelInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint-foreign import ccall "clGetKernelWorkGroupInfo" raw_clGetKernelWorkGroupInfo :: +foreign import CALLCONV "clGetKernelWorkGroupInfo" raw_clGetKernelWorkGroupInfo :: CLKernel -> CLDeviceID -> CLKernelWorkGroupInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint -- -----------------------------------------------------------------------------@@ -102,15 +118,15 @@ OpenCL compiler for the appropriate target device(s). 'clCreateProgramWithSource' returns a valid non-zero program object if the-program object is created successfully. Otherwise, it returns one of the-following error values:+program object is created successfully. Otherwise, it throws one of the+following 'CLError' exceptions: * 'CL_INVALID_CONTEXT' if context is not a valid context. * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clCreateProgramWithSource :: CLContext -> String -> IO (Either CLError CLProgram)+clCreateProgramWithSource :: CLContext -> String -> IO CLProgram clCreateProgramWithSource ctx source = wrapPError $ \perr -> do let strings = lines source count = fromIntegral $ length strings@@ -120,6 +136,71 @@ mapM_ free cstrings return prog +{-| Creates a program object for a context, and loads specified binary data into+the program object.++The program binaries specified by binaries contain the bits that describe the+program executable that will be run on the device(s) associated with+context. The program binary can consist of either or both of device-specific+executable(s), and/or implementation-specific intermediate representation (IR)+which will be converted to the device-specific executable.++OpenCL allows applications to create a program object using the program+source or binary and build appropriate program executables. This allows+applications to determine whether they want to use the pre-built offline binary+or load and compile the program source and use the executable compiled/linked+online as the program executable. This can be very useful as it allows+applications to load and build program executables online on its first instance+for appropriate OpenCL devices in the system. These executables can now be+queried and cached by the application. Future instances of the application+launching will no longer need to compile and build the program executables. The+cached executables can be read and loaded by the application, which can help+significantly reduce the application initialization time.++Returns a valid non-zero program object and a list of 'CLError' values whether+the program binary for each device specified in device_list was loaded+successfully or not. It is list of the same length the list of devices with+'CL_SUCCESS' if binary was successfully loaded for device specified by same+position; otherwise returns 'CL_INVALID_VALUE' if length of binary is zero or+'CL_INVALID_BINARY' if program binary is not a valid binary+for the specified device.++The function can throw on of the following 'CLError' exceptions:++ * 'CL_INVALID_CONTEXT' if context is not a valid context. ++ * 'CL_INVALID_VALUE' if the device list is empty; or if lengths or binaries are+empty.++ * 'CL_INVALID_DEVICE' if OpenCL devices listed in the device list are not in+the list of devices associated with context.++ * 'CL_INVALID_BINARY' if an invalid program binary was encountered for any+device.++ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required+by the OpenCL implementation on the host. +-} +clCreateProgramWithBinary :: CLContext -> [CLDeviceID] -> [[Word8]] + -> IO (CLProgram, [CLError])+clCreateProgramWithBinary ctx devs bins = wrapPError $ \perr -> do withArray+devs $ \pdevs -> do withArray lbins $ \plbins -> do buffs <- forM bins $ \bs ->+do buff <- mallocArray (length bs) :: IO (Ptr Word8) pokeArray buff bs return+buff++ ret <- withArray buffs $ \(pbuffs :: Ptr (Ptr Word8)) -> do+ allocaArray ndevs $ \(perrs :: Ptr CLint) -> do+ prog <- raw_clCreateProgramWithBinary ctx (fromIntegral ndevs) pdevs plbins pbuffs perrs perr+ errs <- peekArray ndevs perrs+ return (prog, map getEnumCL errs)+ + mapM_ free buffs+ return ret+ + where+ lbins = map (fromIntegral . length) bins :: [CSize]+ ndevs = length devs+ -- | Increments the program reference count. 'clRetainProgram' returns 'True' if -- the function is executed successfully. It returns 'False' if program is not a -- valid program object.@@ -255,7 +336,7 @@ [-Werror] Make all warnings into errors. -clBuildProgram returns the following errors when fails:+clBuildProgram can throw the following 'CLError' exceptions when fails: * 'CL_INVALID_PROGRAM' if program is not a valid program object. @@ -286,14 +367,12 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clBuildProgram :: CLProgram -> [CLDeviceID] -> String -> IO (Either CLError ())+clBuildProgram :: CLProgram -> [CLDeviceID] -> String -> IO () clBuildProgram prg devs opts = allocaArray ndevs $ \pdevs -> do pokeArray pdevs devs withCString opts $ \copts -> do- errcode <- raw_clBuildProgram prg cndevs pdevs copts nullFunPtr nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then return $ Right ()- else return . Left . toEnum . fromIntegral $ errcode+ whenSuccess (raw_clBuildProgram prg cndevs pdevs copts nullFunPtr nullPtr)+ $ return () where ndevs = length devs cndevs = fromIntegral ndevs@@ -311,17 +390,18 @@ #endc {#enum CLProgramInfo {upcaseFirstLetter} #} -getProgramInfoSize :: CLProgram -> CLProgramInfo_ -> IO (Either CLError CSize)+getProgramInfoSize :: CLProgram -> CLProgramInfo_ -> IO CSize getProgramInfoSize prg infoid = alloca $ \(value_size :: Ptr CSize) -> do- errcode <- raw_clGetProgramInfo prg infoid 0 nullPtr value_size- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peek value_size- else return . Left . toEnum . fromIntegral $ errcode+ whenSuccess (raw_clGetProgramInfo prg infoid 0 nullPtr value_size)+ $ peek value_size -- | Return the program reference count. The reference count returned should be -- considered immediately stale. It is unsuitable for general use in -- applications. This feature is provided for identifying memory leaks.-clGetProgramReferenceCount :: CLProgram -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetProgramInfo with+-- 'CL_PROGRAM_REFERENCE_COUNT'.+clGetProgramReferenceCount :: CLProgram -> IO CLuint clGetProgramReferenceCount prg = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetProgramInfo prg infoid size (castPtr dat)) id where @@ -329,7 +409,9 @@ size = fromIntegral $ sizeOf (0::CLuint) -- | Return the context specified when the program object is created.-clGetProgramContext :: CLProgram -> IO (Either CLError CLContext)+--+-- This function execute OpenCL clGetProgramInfo with 'CL_PROGRAM_CONTEXT'.+clGetProgramContext :: CLProgram -> IO CLContext clGetProgramContext prg = wrapGetInfo (\(dat :: Ptr CLContext) -> raw_clGetProgramInfo prg infoid size (castPtr dat)) id where @@ -337,7 +419,9 @@ size = fromIntegral $ sizeOf (nullPtr::CLContext) -- | Return the number of devices associated with program.-clGetProgramNumDevices :: CLProgram -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetProgramInfo with 'CL_PROGRAM_NUM_DEVICES'.+clGetProgramNumDevices :: CLProgram -> IO CLuint clGetProgramNumDevices prg = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetProgramInfo prg infoid size (castPtr dat)) id where @@ -348,16 +432,14 @@ -- the devices associated with context on which the program object has been -- created or can be a subset of devices that are specified when a progam object -- is created using 'clCreateProgramWithBinary'.-clGetProgramDevices :: CLProgram -> IO (Either CLError [CLDeviceID])+--+-- This function execute OpenCL clGetProgramInfo with 'CL_PROGRAM_DEVICES'.+clGetProgramDevices :: CLProgram -> IO [CLDeviceID] clGetProgramDevices prg = do- sval <- getProgramInfoSize prg infoid- case sval of- Left err -> return . Left $ err- Right size -> allocaArray (numElems size) $ \(buff :: Ptr CLDeviceID) -> do- errcode <- raw_clGetProgramInfo prg infoid size (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekArray (numElems size) buff- else return . Left . toEnum . fromIntegral $ errcode+ size <- getProgramInfoSize prg infoid+ allocaArray (numElems size) $ \(buff :: Ptr CLDeviceID) -> do+ whenSuccess (raw_clGetProgramInfo prg infoid size (castPtr buff) nullPtr)+ $ peekArray (numElems size) buff where infoid = getCLValue CL_PROGRAM_DEVICES numElems s = (fromIntegral s) `div` elemSize@@ -369,16 +451,14 @@ -- terminator. The concatenation strips any nulls in the original source -- strings. The actual number of characters that represents the program source -- code including the null terminator is returned in param_value_size_ret.-clGetProgramSource :: CLProgram -> IO (Either CLError String)+--+-- This function execute OpenCL clGetProgramInfo with 'CL_PROGRAM_SOURCE'.+clGetProgramSource :: CLProgram -> IO String clGetProgramSource prg = do- sval <- getProgramInfoSize prg infoid- case sval of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: CString) -> do- errcode <- raw_clGetProgramInfo prg infoid n (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekCString buff- else return . Left . toEnum . fromIntegral $ errcode+ n <- getProgramInfoSize prg infoid+ allocaArray (fromIntegral n) $ \(buff :: CString) -> do+ whenSuccess (raw_clGetProgramInfo prg infoid n (castPtr buff) nullPtr)+ $ peekCString buff where infoid = getCLValue CL_PROGRAM_SOURCE @@ -386,16 +466,14 @@ -- each device associated with program. The size of the array is the number of -- devices associated with program. If a binary is not available for a -- device(s), a size of zero is returned.-clGetProgramBinarySizes :: CLProgram -> IO (Either CLError [CSize])+--+-- This function execute OpenCL clGetProgramInfo with 'CL_PROGRAM_BINARY_SIZES'.+clGetProgramBinarySizes :: CLProgram -> IO [CSize] clGetProgramBinarySizes prg = do- sval <- getProgramInfoSize prg infoid- case sval of- Left err -> return . Left $ err- Right size -> allocaArray (numElems size) $ \(buff :: Ptr CSize) -> do- errcode <- raw_clGetProgramInfo prg infoid size (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekArray (numElems size) buff- else return . Left . toEnum . fromIntegral $ errcode+ size <- getProgramInfoSize prg infoid+ allocaArray (numElems size) $ \(buff :: Ptr CSize) -> do+ whenSuccess (raw_clGetProgramInfo prg infoid size (castPtr buff) nullPtr)+ $ peekArray (numElems size) buff where infoid = getCLValue CL_PROGRAM_BINARY_SIZES numElems s = (fromIntegral s) `div` elemSize@@ -415,25 +493,20 @@ 'clGetProgramDevices' query to get the list of devices. There is a one-to-one correspondence between the array of data returned by 'clGetProgramBinaries' and array of devices returned by 'clGetProgramDevices'. ++This function execute OpenCL clGetProgramInfo with 'CL_PROGRAM_BINARIES'. -}-clGetProgramBinaries :: CLProgram -> IO (Either CLError [[Word8]])+clGetProgramBinaries :: CLProgram -> IO [[Word8]] clGetProgramBinaries prg = do- sval <- clGetProgramBinarySizes prg- case sval of- Left err -> return . Left $ err- Right sizes -> do- let numElems = length sizes- size = fromIntegral $ numElems * elemSize- buffers <- (mapM (mallocArray.fromIntegral) sizes) :: IO [Ptr Word8]- ret <- withArray buffers $ \(parray :: Ptr (Ptr Word8)) -> do- errcode <- raw_clGetProgramInfo prg infoid size (castPtr parray) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then do- vals <- zipWithM peekArray (map fromIntegral sizes) buffers- return . Right $ vals- else return . Left . toEnum . fromIntegral $ errcode- mapM_ free buffers- return ret+ sizes <- clGetProgramBinarySizes prg+ let numElems = length sizes+ size = fromIntegral $ numElems * elemSize+ buffers <- (mapM (mallocArray.fromIntegral) sizes) :: IO [Ptr Word8]+ ret <- withArray buffers $ \(parray :: Ptr (Ptr Word8)) -> do+ whenSuccess (raw_clGetProgramInfo prg infoid size (castPtr parray) nullPtr)+ $ zipWithM peekArray (map fromIntegral sizes) buffers+ mapM_ free buffers+ return ret where infoid = getCLValue CL_PROGRAM_BINARIES elemSize = sizeOf (nullPtr::Ptr Word8)@@ -448,16 +521,17 @@ #endc {#enum CLProgramBuildInfo {upcaseFirstLetter} #} -getProgramBuildInfoSize :: CLProgram -> CLDeviceID -> CLProgramInfo_ -> IO (Either CLError CSize)-getProgramBuildInfoSize prg device infoid = alloca $ \(value_size :: Ptr CSize) -> do- errcode <- raw_clGetProgramBuildInfo prg device infoid 0 nullPtr value_size- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peek value_size- else return . Left . toEnum . fromIntegral $ errcode+getProgramBuildInfoSize :: CLProgram -> CLDeviceID -> CLProgramInfo_ -> IO CSize+getProgramBuildInfoSize prg device infoid = alloca $ \(val :: Ptr CSize) -> do+ whenSuccess (raw_clGetProgramBuildInfo prg device infoid 0 nullPtr val)+ $ peek val -- | Returns the build status of program for a specific device as given by -- device.-clGetProgramBuildStatus :: CLProgram -> CLDeviceID -> IO (Either CLError CLBuildStatus)+--+-- This function execute OpenCL clGetProgramBuildInfo with+-- 'CL_PROGRAM_BUILD_STATUS'.+clGetProgramBuildStatus :: CLProgram -> CLDeviceID -> IO CLBuildStatus clGetProgramBuildStatus prg device = wrapGetInfo (\(dat :: Ptr CLBuildStatus_) -> raw_clGetProgramBuildInfo prg device infoid size (castPtr dat)) getEnumCL where @@ -467,31 +541,29 @@ -- | Return the build options specified by the options argument in -- clBuildProgram for device. If build status of program for device is -- 'CL_BUILD_NONE', an empty string is returned.-clGetProgramBuildOptions :: CLProgram -> CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetProgramBuildInfo with+-- 'CL_PROGRAM_BUILD_OPTIONS'.+clGetProgramBuildOptions :: CLProgram -> CLDeviceID -> IO String clGetProgramBuildOptions prg device = do- sval <- getProgramBuildInfoSize prg device infoid- case sval of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: CString) -> do- errcode <- raw_clGetProgramBuildInfo prg device infoid n (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekCString buff- else return . Left . toEnum . fromIntegral $ errcode+ n <- getProgramBuildInfoSize prg device infoid+ allocaArray (fromIntegral n) $ \(buff :: CString) -> do+ whenSuccess (raw_clGetProgramBuildInfo prg device infoid n (castPtr buff) nullPtr)+ $ peekCString buff where infoid = getCLValue CL_PROGRAM_BUILD_OPTIONS -- | Return the build log when 'clBuildProgram' was called for device. If build -- status of program for device is 'CL_BUILD_NONE', an empty string is returned.-clGetProgramBuildLog :: CLProgram -> CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetProgramBuildInfo with+-- 'CL_PROGRAM_BUILD_LOG'.+clGetProgramBuildLog :: CLProgram -> CLDeviceID -> IO String clGetProgramBuildLog prg device = do- sval <- getProgramBuildInfoSize prg device infoid- case sval of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: CString) -> do- errcode <- raw_clGetProgramBuildInfo prg device infoid n (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekCString buff- else return . Left . toEnum . fromIntegral $ errcode+ n <- getProgramBuildInfoSize prg device infoid+ allocaArray (fromIntegral n) $ \(buff :: CString) -> do+ whenSuccess (raw_clGetProgramBuildInfo prg device infoid n (castPtr buff) nullPtr)+ $ peekCString buff where infoid = getCLValue CL_PROGRAM_BUILD_LOG @@ -503,7 +575,8 @@ function. 'clCreateKernel' returns a valid non-zero kernel object if the kernel object is-created successfully. Otherwise, it returns one of the following error values:+created successfully. Otherwise, it throws one of the following 'CLError'+exceptions: * 'CL_INVALID_PROGRAM' if program is not a valid program object. @@ -520,7 +593,7 @@ * 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clCreateKernel :: CLProgram -> String -> IO (Either CLError CLKernel)+clCreateKernel :: CLProgram -> String -> IO CLKernel clCreateKernel prg name = withCString name $ \cname -> wrapPError $ \perr -> do raw_clCreateKernel prg cname perr @@ -542,27 +615,20 @@ kernels declared in the program object. 'clCreateKernelsInProgram' will return the kernel objects if the kernel objects-were successfully allocated, returns 'CL_INVALID_PROGRAM' if program is not a-valid program object, returns 'CL_INVALID_PROGRAM_EXECUTABLE' if there is no-successfully built executable for any device in program and returns+were successfully allocated, throws 'CL_INVALID_PROGRAM' if program is not a+valid program object, throws 'CL_INVALID_PROGRAM_EXECUTABLE' if there is no+successfully built executable for any device in program and throws 'CL_OUT_OF_HOST_MEMORY' if there is a failure to allocate resources required by the OpenCL implementation on the host. -}-clCreateKernelsInProgram :: CLProgram -> IO (Either CLError [CLKernel])+clCreateKernelsInProgram :: CLProgram -> IO [CLKernel] clCreateKernelsInProgram prg = do- nks <- alloca $ \pn -> do- errcode <- raw_clCreateKernelsInProgram prg 0 nullPtr pn- if errcode == (getCLValue CL_SUCCESS)- then peek pn >>= (return . Right)- else return $ Left errcode- - case nks of- Left err -> return . Left . getEnumCL $ err- Right n -> allocaArray (fromIntegral n) $ \pks -> do- errcode <- raw_clCreateKernelsInProgram prg n pks nullPtr- if errcode == (getCLValue CL_SUCCESS)- then peekArray (fromIntegral n) pks >>= (return . Right)- else return . Left .getEnumCL $ errcode+ n <- alloca $ \pn -> do+ whenSuccess (raw_clCreateKernelsInProgram prg 0 nullPtr pn)+ $ peek pn + allocaArray (fromIntegral n) $ \pks -> do+ whenSuccess (raw_clCreateKernelsInProgram prg n pks nullPtr)+ $ peekArray (fromIntegral n) pks -- | Increments the program program reference count. 'clRetainKernel' returns -- 'True' if the function is executed successfully. 'clCreateKernel' or@@ -592,7 +658,7 @@ when he may safely release user allocated resources associated with OpenCL objects such as the CLMem backing store used with 'CL_MEM_USE_HOST_PTR'. -'clSetKernelArg' returns returns one of the following errors when fails:+'clSetKernelArg' throws one of the following 'CLError' exceptions when fails: * 'CL_INVALID_KERNEL' if kernel is not a valid kernel object. @@ -613,12 +679,10 @@ declared with the __local qualifier or if the argument is a sampler and arg_size != sizeof(cl_sampler). -}-clSetKernelArg :: Storable a => CLKernel -> CLuint -> a -> IO (Either CLError ())+clSetKernelArg :: Storable a => CLKernel -> CLuint -> a -> IO () clSetKernelArg krn idx val = with val $ \pval -> do- errcode <- raw_clSetKernelArg krn idx (fromIntegral . sizeOf $ val) (castPtr pval)- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then return $ Right ()- else return . Left . toEnum . fromIntegral $ errcode+ whenSuccess (raw_clSetKernelArg krn idx (fromIntegral . sizeOf $ val) (castPtr pval))+ $ return () #c enum CLKernelInfo {@@ -631,29 +695,27 @@ #endc {#enum CLKernelInfo {upcaseFirstLetter} #} -getKernelInfoSize :: CLKernel -> CLKernelInfo_ -> IO (Either CLError CSize)-getKernelInfoSize krn infoid = alloca $ \(value_size :: Ptr CSize) -> do- errcode <- raw_clGetKernelInfo krn infoid 0 nullPtr value_size- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peek value_size- else return . Left . toEnum . fromIntegral $ errcode+getKernelInfoSize :: CLKernel -> CLKernelInfo_ -> IO CSize+getKernelInfoSize krn infoid = alloca $ \(val :: Ptr CSize) -> do+ whenSuccess (raw_clGetKernelInfo krn infoid 0 nullPtr val)+ $ peek val -- | Return the kernel function name.-clGetKernelFunctionName :: CLKernel -> IO (Either CLError String)+--+-- This function execute OpenCL clGetKernelInfo with 'CL_KERNEL_FUNCTION_NAME'.+clGetKernelFunctionName :: CLKernel -> IO String clGetKernelFunctionName krn = do- sval <- getKernelInfoSize krn infoid- case sval of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: CString) -> do- errcode <- raw_clGetKernelInfo krn infoid n (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekCString buff- else return . Left . toEnum . fromIntegral $ errcode+ n <- getKernelInfoSize krn infoid+ allocaArray (fromIntegral n) $ \(buff :: CString) -> do+ whenSuccess (raw_clGetKernelInfo krn infoid n (castPtr buff) nullPtr)+ $ peekCString buff where infoid = getCLValue CL_KERNEL_FUNCTION_NAME -- | Return the number of arguments to kernel.-clGetKernelNumArgs :: CLKernel -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetKernelInfo with 'CL_KERNEL_NUM_ARGS'.+clGetKernelNumArgs :: CLKernel -> IO CLuint clGetKernelNumArgs krn = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetKernelInfo krn infoid size (castPtr dat)) id where @@ -663,7 +725,10 @@ -- | Return the kernel reference count. The reference count returned should be -- considered immediately stale. It is unsuitable for general use in -- applications. This feature is provided for identifying memory leaks.-clGetKernelReferenceCount :: CLKernel -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetKernelInfo with+-- 'CL_KERNEL_REFERENCE_COUNT'.+clGetKernelReferenceCount :: CLKernel -> IO CLuint clGetKernelReferenceCount krn = wrapGetInfo (\(dat :: Ptr CLuint) -> raw_clGetKernelInfo krn infoid size (castPtr dat)) id where @@ -671,7 +736,9 @@ size = fromIntegral $ sizeOf (0::CLuint) -- | Return the context associated with kernel.-clGetKernelContext :: CLKernel -> IO (Either CLError CLContext)+--+-- This function execute OpenCL clGetKernelInfo with 'CL_KERNEL_CONTEXT'.+clGetKernelContext :: CLKernel -> IO CLContext clGetKernelContext krn = wrapGetInfo (\(dat :: Ptr CLContext) -> raw_clGetKernelInfo krn infoid size (castPtr dat)) id where @@ -679,7 +746,9 @@ size = fromIntegral $ sizeOf (nullPtr::CLContext) -- | Return the program object associated with kernel.-clGetKernelProgram :: CLKernel -> IO (Either CLError CLProgram)+--+-- This function execute OpenCL clGetKernelInfo with 'CL_KERNEL_PROGRAM'.+clGetKernelProgram :: CLKernel -> IO CLProgram clGetKernelProgram krn = wrapGetInfo (\(dat :: Ptr CLProgram) -> raw_clGetKernelInfo krn infoid size (castPtr dat)) id where @@ -701,7 +770,10 @@ -- device. The OpenCL implementation uses the resource requirements of the -- kernel (register usage etc.) to determine what this work-group size should -- be.-clGetKernelWorkGroupSize :: CLKernel -> CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetKernelWorkGroupInfo with+-- 'CL_KERNEL_WORK_GROUP_SIZE'.+clGetKernelWorkGroupSize :: CLKernel -> CLDeviceID -> IO CSize clGetKernelWorkGroupSize krn device = wrapGetInfo (\(dat :: Ptr CSize) -> raw_clGetKernelWorkGroupInfo krn device infoid size (castPtr dat)) id where@@ -712,13 +784,14 @@ -- oup_size(X, Y, Z))) qualifier. See Function Qualifiers. If the work-group -- size is not specified using the above attribute qualifier (0, 0, 0) is -- returned.-clGetKernelCompileWorkGroupSize :: CLKernel -> CLDeviceID -> IO (Either CLError [CSize])+--+-- This function execute OpenCL clGetKernelWorkGroupInfo with+-- 'CL_KERNEL_COMPILE_WORK_GROUP_SIZE'.+clGetKernelCompileWorkGroupSize :: CLKernel -> CLDeviceID -> IO [CSize] clGetKernelCompileWorkGroupSize krn device = do allocaArray num $ \(buff :: Ptr CSize) -> do- errcode <- raw_clGetKernelWorkGroupInfo krn device infoid size (castPtr buff) nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS)- then fmap Right $ peekArray num buff- else return . Left . toEnum . fromIntegral $ errcode+ whenSuccess (raw_clGetKernelWorkGroupInfo krn device infoid size (castPtr buff) nullPtr)+ $ peekArray num buff where infoid = getCLValue CL_KERNEL_COMPILE_WORK_GROUP_SIZE num = 3@@ -736,7 +809,10 @@ -- If the local memory size, for any pointer argument to the kernel declared -- with the __local address qualifier, is not specified, its size is assumed to -- be 0.-clGetKernelLocalMemSize :: CLKernel -> CLDeviceID -> IO (Either CLError CLulong)+--+-- This function execute OpenCL clGetKernelWorkGroupInfo with+-- 'CL_KERNEL_LOCAL_MEM_SIZE'.+clGetKernelLocalMemSize :: CLKernel -> CLDeviceID -> IO CLulong clGetKernelLocalMemSize krn device = wrapGetInfo (\(dat :: Ptr CLulong) -> raw_clGetKernelWorkGroupInfo krn device infoid size (castPtr dat)) id where
src/System/GPU/OpenCL/Query.chs view
@@ -1,20 +1,35 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- ------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-} module System.GPU.OpenCL.Query( -- * Types CLPlatformInfo(..), CLPlatformID, CLDeviceID, CLDeviceType(..),@@ -55,7 +70,7 @@ import Foreign.C.Types( CSize ) import Foreign.Storable( sizeOf ) import System.GPU.OpenCL.Types( - CLbool, CLint, CLuint, CLulong, CLPlatformInfo_, CLDeviceType_, CLError(..),+ CLbool, CLint, CLuint, CLulong, CLPlatformInfo_, CLDeviceType_, CLDeviceInfo_, CLDeviceFPConfig(..), CLDeviceExecCapability(..), CLDeviceLocalMemType(..), CLDeviceMemCacheType(..), CLPlatformInfo(..), CLPlatformID, CLDeviceID, CLDeviceType(..), CLCommandQueueProperty, @@ -63,54 +78,50 @@ whenSuccess, bitmaskToFPConfig, bitmaskToExecCapability ) -- ------------------------------------------------------------------------------foreign import ccall "clGetPlatformIDs" raw_clGetPlatformIDs :: +foreign import CALLCONV "clGetPlatformIDs" raw_clGetPlatformIDs :: CLuint -> Ptr CLPlatformID -> Ptr CLuint -> IO CLint-foreign import ccall "clGetPlatformInfo" raw_clGetPlatformInfo :: +foreign import CALLCONV "clGetPlatformInfo" raw_clGetPlatformInfo :: CLPlatformID -> CLPlatformInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint -foreign import ccall "clGetDeviceIDs" raw_clGetDeviceIDs :: +foreign import CALLCONV "clGetDeviceIDs" raw_clGetDeviceIDs :: CLPlatformID -> CLDeviceType_ -> CLuint -> Ptr CLDeviceID -> Ptr CLuint -> IO CLint-foreign import ccall "clGetDeviceInfo" raw_clGetDeviceInfo :: +foreign import CALLCONV "clGetDeviceInfo" raw_clGetDeviceInfo :: CLDeviceID -> CLDeviceInfo_ -> CSize -> Ptr () -> Ptr CSize -> IO CLint #include <CL/cl.h> -- ------------------------------------------------------------------------------getNumPlatforms :: IO (Either CLError CLuint)+getNumPlatforms :: IO CLuint getNumPlatforms = alloca $ \(num_platforms :: Ptr CLuint) -> do whenSuccess (raw_clGetPlatformIDs 0 nullPtr num_platforms) $ peek num_platforms -- | Obtain the list of platforms available. Returns the list if the function -- is executed successfully. Otherwise it returns the empty list.-clGetPlatformIDs :: IO (Either CLError [CLPlatformID])+clGetPlatformIDs :: IO [CLPlatformID] clGetPlatformIDs = do nplats <- getNumPlatforms- case nplats of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(plats :: Ptr CLPlatformID) -> do- whenSuccess (raw_clGetPlatformIDs n plats nullPtr) - $ peekArray (fromIntegral n) plats+ allocaArray (fromIntegral nplats) $ \(plats :: Ptr CLPlatformID) -> do+ whenSuccess (raw_clGetPlatformIDs nplats plats nullPtr) + $ peekArray (fromIntegral nplats) plats -getPlatformInfoSize :: CLPlatformID -> CLuint -> IO (Either CLError CSize)+getPlatformInfoSize :: CLPlatformID -> CLuint -> IO CSize getPlatformInfoSize platform infoid = alloca $ \(value_size :: Ptr CSize) -> do whenSuccess (raw_clGetPlatformInfo platform infoid 0 nullPtr value_size) $ peek value_size -- | Get specific information about the OpenCL platform. It returns Nothing if -- platform is not a valid platform.-clGetPlatformInfo :: CLPlatformID -> CLPlatformInfo -> IO (Either CLError String)+clGetPlatformInfo :: CLPlatformID -> CLPlatformInfo -> IO String clGetPlatformInfo platform infoid = do sval <- getPlatformInfoSize platform infocl- case sval of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: CString) -> do- whenSuccess (raw_clGetPlatformInfo platform infocl n (castPtr buff) nullPtr)- $ peekCString buff+ allocaArray (fromIntegral sval) $ \(buff :: CString) -> do+ whenSuccess (raw_clGetPlatformInfo platform infocl sval (castPtr buff) nullPtr)+ $ peekCString buff where infocl = getCLValue infoid -- ------------------------------------------------------------------------------getNumDevices :: CLPlatformID -> CLDeviceType_ -> IO (Either CLError CLuint)+getNumDevices :: CLPlatformID -> CLDeviceType_ -> IO CLuint getNumDevices platform dtype = alloca $ \(num_devices :: Ptr CLuint) -> do whenSuccess (raw_clGetDeviceIDs platform dtype 0 nullPtr num_devices) $ peek num_devices@@ -119,65 +130,59 @@ -- the function is executed successfully. Otherwise it returns the empty list -- if platform is not a valid platform or no OpenCL devices that matched -- device_type were found.-clGetDeviceIDs :: CLPlatformID -> CLDeviceType -> IO (Either CLError [CLDeviceID])+clGetDeviceIDs :: CLPlatformID -> CLDeviceType -> IO [CLDeviceID] clGetDeviceIDs platform dtype = do ndevs <- getNumDevices platform dval- case ndevs of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(devs :: Ptr CLDeviceID) -> do- whenSuccess (raw_clGetDeviceIDs platform dval n devs nullPtr)- $ peekArray (fromIntegral n) devs+ allocaArray (fromIntegral ndevs) $ \(devs :: Ptr CLDeviceID) -> do+ whenSuccess (raw_clGetDeviceIDs platform dval ndevs devs nullPtr)+ $ peekArray (fromIntegral ndevs) devs where dval = getCLValue dtype -getDeviceInfoSize :: CLDeviceID -> CLDeviceInfo_ -> IO (Either CLError CSize)+getDeviceInfoSize :: CLDeviceID -> CLDeviceInfo_ -> IO CSize getDeviceInfoSize device infoid = alloca $ \(value_size :: Ptr CSize) -> do whenSuccess (raw_clGetDeviceInfo device infoid 0 nullPtr value_size) $ peek value_size -getDeviceInfoString :: CLDeviceInfo_ -> CLDeviceID -> IO (Either CLError String)+getDeviceInfoString :: CLDeviceInfo_ -> CLDeviceID -> IO String getDeviceInfoString infoid device = do- sval <- getDeviceInfoSize device infoid- case sval of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: CString) -> do- whenSuccess (raw_clGetDeviceInfo device infoid n (castPtr buff) nullPtr)- $ peekCString buff+ n <- getDeviceInfoSize device infoid+ allocaArray (fromIntegral n) $ \(buff :: CString) -> do+ whenSuccess (raw_clGetDeviceInfo device infoid n (castPtr buff) nullPtr)+ $ peekCString buff -getDeviceInfoUint :: CLDeviceInfo_ -> CLDeviceID -> IO (Either CLError CLuint)+getDeviceInfoUint :: CLDeviceInfo_ -> CLDeviceID -> IO CLuint getDeviceInfoUint infoid device = alloca $ \(dat :: Ptr CLuint) -> do whenSuccess (raw_clGetDeviceInfo device infoid size (castPtr dat) nullPtr) $ peek dat where size = fromIntegral $ sizeOf (0::CLuint) -getDeviceInfoUlong :: CLDeviceInfo_ -> CLDeviceID -> IO (Either CLError CLulong)+getDeviceInfoUlong :: CLDeviceInfo_ -> CLDeviceID -> IO CLulong getDeviceInfoUlong infoid device = alloca $ \(dat :: Ptr CLulong) -> do whenSuccess (raw_clGetDeviceInfo device infoid size (castPtr dat) nullPtr) $ peek dat where size = fromIntegral $ sizeOf (0::CLulong) -getDeviceInfoSizet :: CLDeviceInfo_ -> CLDeviceID -> IO (Either CLError CSize)+getDeviceInfoSizet :: CLDeviceInfo_ -> CLDeviceID -> IO CSize getDeviceInfoSizet infoid device = alloca $ \(dat :: Ptr CSize) -> do whenSuccess (raw_clGetDeviceInfo device infoid size (castPtr dat) nullPtr) $ peek dat where size = fromIntegral $ sizeOf (0::CSize) -getDeviceInfoBool :: CLDeviceInfo_ -> CLDeviceID -> IO (Either CLError Bool)+getDeviceInfoBool :: CLDeviceInfo_ -> CLDeviceID -> IO Bool getDeviceInfoBool infoid device = alloca $ \(dat :: Ptr CLbool) -> do whenSuccess (raw_clGetDeviceInfo device infoid size (castPtr dat) nullPtr) $ peek dat >>= return . (/=0) where size = fromIntegral $ sizeOf (0::CLbool) -getDeviceInfoFP :: CLDeviceInfo_ -> CLDeviceID -> IO (Either CLError [CLDeviceFPConfig])+getDeviceInfoFP :: CLDeviceInfo_ -> CLDeviceID -> IO [CLDeviceFPConfig] getDeviceInfoFP infoid device = do- val <- getDeviceInfoUlong infoid device- case val of- Left err -> return . Left $ err- Right flags -> return . Right . bitmaskToFPConfig $ flags+ flags <- getDeviceInfoUlong infoid device+ return . bitmaskToFPConfig $ flags #c enum CLDeviceInfo {@@ -247,18 +252,25 @@ -- | The default compute device address space size specified as an unsigned -- integer value in bits. Currently supported values are 32 or 64 bits.-clGetDeviceAddressBits :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_ADDRESS_BITS'.+clGetDeviceAddressBits :: CLDeviceID -> IO CLuint clGetDeviceAddressBits = getDeviceInfoUint . getCLValue $ CL_DEVICE_ADDRESS_BITS -- | Is 'True' if the device is available and 'False' if the device is not -- available.-clGetDeviceAvailable :: CLDeviceID -> IO (Either CLError Bool)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_AVAILABLE'.+clGetDeviceAvailable :: CLDeviceID -> IO Bool clGetDeviceAvailable = getDeviceInfoBool . getCLValue $ CL_DEVICE_AVAILABLE -- | Is 'False' if the implementation does not have a compiler available to -- compile the program source. Is 'True' if the compiler is available. This can -- be 'False' for the embededed platform profile only.-clGetDeviceCompilerAvailable :: CLDeviceID -> IO (Either CLError Bool)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_COMPILER_AVAILABLE'.+clGetDeviceCompilerAvailable :: CLDeviceID -> IO Bool clGetDeviceCompilerAvailable = getDeviceInfoBool . getCLValue $ CL_DEVICE_COMPILER_AVAILABLE -- | Describes the OPTIONAL double precision floating-point capability of the @@ -267,30 +279,39 @@ -- The mandated minimum double precision floating-point capability is -- 'CL_FP_FMA' | 'CL_FP_ROUND_TO_NEAREST' | 'CL_FP_ROUND_TO_ZERO' | -- 'CL_FP_ROUND_TO_INF' | 'CL_FP_INF_NAN' | 'CL_FP_DENORM'.-clGetDeviceDoubleFPConfig :: CLDeviceID -> IO (Either CLError [CLDeviceFPConfig])+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_DOUBLE_FP_CONFIG'.+clGetDeviceDoubleFPConfig :: CLDeviceID -> IO [CLDeviceFPConfig] clGetDeviceDoubleFPConfig = getDeviceInfoFP . getCLValue $ CL_DEVICE_DOUBLE_FP_CONFIG -- | Is 'True' if the OpenCL device is a little endian device and 'False' -- otherwise.-clGetDeviceEndianLittle :: CLDeviceID -> IO (Either CLError Bool)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_ENDIAN_LITTLE'.+clGetDeviceEndianLittle :: CLDeviceID -> IO Bool clGetDeviceEndianLittle = getDeviceInfoBool . getCLValue $ CL_DEVICE_ENDIAN_LITTLE -- | Is 'True' if the device implements error correction for the memories, -- caches, registers etc. in the device. Is 'False' if the device does not -- implement error correction. This can be a requirement for certain clients of -- OpenCL.-clGetDeviceErrorCorrectionSupport :: CLDeviceID -> IO (Either CLError Bool)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_ERROR_CORRECTION_SUPPORT'.+clGetDeviceErrorCorrectionSupport :: CLDeviceID -> IO Bool clGetDeviceErrorCorrectionSupport = getDeviceInfoBool . getCLValue $ CL_DEVICE_ERROR_CORRECTION_SUPPORT -- | Describes the execution capabilities of the device. This is a list that -- describes one or more of the 'CLDeviceExecCapability' values. -- The mandated minimum capability is 'CL_EXEC_KERNEL'.-clGetDeviceExecutionCapabilities :: CLDeviceID -> IO (Either CLError [CLDeviceExecCapability])+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_EXECUTION_CAPABILITIES'.+clGetDeviceExecutionCapabilities :: CLDeviceID -> IO [CLDeviceExecCapability] clGetDeviceExecutionCapabilities device = do- val <- getDeviceInfoUlong (getCLValue CL_DEVICE_EXECUTION_CAPABILITIES) device- case val of- Left err -> return . Left $ err- Right flags -> return . Right . bitmaskToExecCapability $ flags+ flags <- getDeviceInfoUlong (getCLValue CL_DEVICE_EXECUTION_CAPABILITIES) device+ return . bitmaskToExecCapability $ flags -- | Returns a space separated list of extension names (the extension names -- themselves do not contain any spaces). The list of extension names returned @@ -317,28 +338,40 @@ -- * cl_khr_byte_addressable_store -- -- * cl_khr_fp16-clGetDeviceExtensions :: CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_EXTENSIONS'.+clGetDeviceExtensions :: CLDeviceID -> IO String clGetDeviceExtensions = getDeviceInfoString . getCLValue $ CL_DEVICE_EXTENSIONS -- | Size of global memory cache in bytes.-clGetDeviceGlobalMemCacheSize :: CLDeviceID -> IO (Either CLError CLulong)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_GLOBAL_MEM_CACHE_SIZE'.+clGetDeviceGlobalMemCacheSize :: CLDeviceID -> IO CLulong clGetDeviceGlobalMemCacheSize = getDeviceInfoUlong . getCLValue $ CL_DEVICE_GLOBAL_MEM_CACHE_SIZE -- | Type of global memory cache supported. Valid values are: 'CL_NONE', -- 'CL_READ_ONLY_CACHE', and 'CL_READ_WRITE_CACHE'.-clGetDeviceGlobalMemCacheType :: CLDeviceID -> IO (Either CLError CLDeviceMemCacheType)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_GLOBAL_MEM_CACHE_TYPE'.+clGetDeviceGlobalMemCacheType :: CLDeviceID -> IO CLDeviceMemCacheType clGetDeviceGlobalMemCacheType device = do- val <- getDeviceInfoUint (getCLValue CL_DEVICE_GLOBAL_MEM_CACHE_TYPE) device - case val of- Left err -> return . Left $ err- Right typ -> return . Right . getEnumCL $ typ+ typ <- getDeviceInfoUint (getCLValue CL_DEVICE_GLOBAL_MEM_CACHE_TYPE) device + return . getEnumCL $ typ -- | Size of global memory cache line in bytes.-clGetDeviceGlobalMemCachelineSize :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE'.+clGetDeviceGlobalMemCachelineSize :: CLDeviceID -> IO CLuint clGetDeviceGlobalMemCachelineSize = getDeviceInfoUint . getCLValue $ CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE -- | Size of global device memory in bytes.-clGetDeviceGlobalMemSize :: CLDeviceID -> IO (Either CLError CLulong)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_GLOBAL_MEM_SIZE'.+clGetDeviceGlobalMemSize :: CLDeviceID -> IO CLulong clGetDeviceGlobalMemSize = getDeviceInfoUlong . getCLValue $ CL_DEVICE_GLOBAL_MEM_SIZE -- | Describes the OPTIONAL half precision floating-point capability of the @@ -347,138 +380,201 @@ -- The required minimum half precision floating-point capability as implemented -- by this extension is 'CL_FP_ROUND_TO_ZERO' | 'CL_FP_ROUND_TO_INF' | -- 'CL_FP_INF_NAN'.-clGetDeviceHalfFPConfig :: CLDeviceID -> IO (Either CLError [CLDeviceFPConfig])+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_HALF_FP_CONFIG'.+clGetDeviceHalfFPConfig :: CLDeviceID -> IO [CLDeviceFPConfig] clGetDeviceHalfFPConfig = getDeviceInfoFP . getCLValue $ CL_DEVICE_HALF_FP_CONFIG -- | Is 'True' if images are supported by the OpenCL device and 'False' otherwise.-clGetDeviceImageSupport :: CLDeviceID -> IO (Either CLError Bool)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_IMAGE_SUPPORT'.+clGetDeviceImageSupport :: CLDeviceID -> IO Bool clGetDeviceImageSupport = getDeviceInfoBool . getCLValue $ CL_DEVICE_IMAGE_SUPPORT -- | Max height of 2D image in pixels. The minimum value is 8192 if -- 'clGetDeviceImageSupport' is 'True'.-clGetDeviceImage2DMaxHeight :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_IMAGE2D_MAX_HEIGHT'.+clGetDeviceImage2DMaxHeight :: CLDeviceID -> IO CSize clGetDeviceImage2DMaxHeight = getDeviceInfoSizet . getCLValue $ CL_DEVICE_IMAGE2D_MAX_HEIGHT -- | Max width of 2D image in pixels. The minimum value is 8192 if -- 'clGetDeviceImageSupport' is 'True'.-clGetDeviceImage2DMaxWidth :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_IMAGE2D_MAX_WIDTH'.+clGetDeviceImage2DMaxWidth :: CLDeviceID -> IO CSize clGetDeviceImage2DMaxWidth = getDeviceInfoSizet . getCLValue $ CL_DEVICE_IMAGE2D_MAX_WIDTH -- | Max depth of 3D image in pixels. The minimum value is 2048 if -- 'clGetDeviceImageSupport' is 'True'.-clGetDeviceImage3DMaxDepth :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_IMAGE3D_MAX_DEPTH'.+clGetDeviceImage3DMaxDepth :: CLDeviceID -> IO CSize clGetDeviceImage3DMaxDepth = getDeviceInfoSizet . getCLValue $ CL_DEVICE_IMAGE3D_MAX_DEPTH -- | Max height of 3D image in pixels. The minimum value is 2048 if -- 'clGetDeviceImageSupport' is 'True'.-clGetDeviceImage3DMaxHeight :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_IMAGE3D_MAX_HEIGHT'.+clGetDeviceImage3DMaxHeight :: CLDeviceID -> IO CSize clGetDeviceImage3DMaxHeight = getDeviceInfoSizet . getCLValue $ CL_DEVICE_IMAGE3D_MAX_HEIGHT -- | Max width of 3D image in pixels. The minimum value is 2048 if -- 'clGetDeviceImageSupport' is 'True'.-clGetDeviceImage3DMaxWidth :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_IMAGE3D_MAX_WIDTH'.+clGetDeviceImage3DMaxWidth :: CLDeviceID -> IO CSize clGetDeviceImage3DMaxWidth = getDeviceInfoSizet . getCLValue $ CL_DEVICE_IMAGE3D_MAX_WIDTH -- | Size of local memory arena in bytes. The minimum value is 16 KB.-clGetDeviceLocalMemSize :: CLDeviceID -> IO (Either CLError CLulong)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_LOCAL_MEM_SIZE'.+clGetDeviceLocalMemSize :: CLDeviceID -> IO CLulong clGetDeviceLocalMemSize = getDeviceInfoUlong . getCLValue $ CL_DEVICE_LOCAL_MEM_SIZE -- | Type of local memory supported. This can be set to 'CL_LOCAL' implying -- dedicated local memory storage such as SRAM, or 'CL_GLOBAL'.-clGetDeviceLocalMemType :: CLDeviceID -> IO (Either CLError CLDeviceLocalMemType)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_LOCAL_MEM_TYPE'.+clGetDeviceLocalMemType :: CLDeviceID -> IO CLDeviceLocalMemType clGetDeviceLocalMemType device = do- val <- getDeviceInfoUint (getCLValue CL_DEVICE_LOCAL_MEM_TYPE) device - case val of- Left err -> return . Left $ err- Right typ -> return . Right . getEnumCL $ typ+ typ <- getDeviceInfoUint (getCLValue CL_DEVICE_LOCAL_MEM_TYPE) device + return . getEnumCL $ typ -- | Maximum configured clock frequency of the device in MHz.-clGetDeviceMaxClockFrequency :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_CLOCK_FREQUENCY'.+clGetDeviceMaxClockFrequency :: CLDeviceID -> IO CLuint clGetDeviceMaxClockFrequency = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_CLOCK_FREQUENCY -- | The number of parallel compute cores on the OpenCL device. The minimum -- value is 1.-clGetDeviceMaxComputeUnits :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_COMPUTE_UNITS'.+clGetDeviceMaxComputeUnits :: CLDeviceID -> IO CLuint clGetDeviceMaxComputeUnits = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_COMPUTE_UNITS -- | Max number of arguments declared with the __constant qualifier in a kernel. -- The minimum value is 8.-clGetDeviceMaxConstantArgs :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_CONSTANT_ARGS'.+clGetDeviceMaxConstantArgs :: CLDeviceID -> IO CLuint clGetDeviceMaxConstantArgs = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_CONSTANT_ARGS -- | Max size in bytes of a constant buffer allocation. The minimum value is -- 64 KB.-clGetDeviceMaxConstantBufferSize :: CLDeviceID -> IO (Either CLError CLulong)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE'.+clGetDeviceMaxConstantBufferSize :: CLDeviceID -> IO CLulong clGetDeviceMaxConstantBufferSize = getDeviceInfoUlong . getCLValue $ CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE -- | Max size of memory object allocation in bytes. The minimum value is max -- (1/4th of 'clGetDeviceGlobalMemSize', 128*1024*1024)-clGetDeviceMaxMemAllocSize :: CLDeviceID -> IO (Either CLError CLulong)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_MAX_MEM_ALLOC_SIZE'.+clGetDeviceMaxMemAllocSize :: CLDeviceID -> IO CLulong clGetDeviceMaxMemAllocSize = getDeviceInfoUlong . getCLValue $ CL_DEVICE_MAX_MEM_ALLOC_SIZE -- | Max size in bytes of the arguments that can be passed to a kernel. The -- minimum value is 256.-clGetDeviceMaxParameterSize :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_PARAMETER_SIZE'.+clGetDeviceMaxParameterSize :: CLDeviceID -> IO CSize clGetDeviceMaxParameterSize = getDeviceInfoSizet . getCLValue $ CL_DEVICE_MAX_PARAMETER_SIZE -- | Max number of simultaneous image objects that can be read by a kernel. The -- minimum value is 128 if 'clGetDeviceImageSupport' is 'True'.-clGetDeviceMaxReadImageArgs :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_READ_IMAGE_ARGS'.+clGetDeviceMaxReadImageArgs :: CLDeviceID -> IO CLuint clGetDeviceMaxReadImageArgs = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_READ_IMAGE_ARGS -- | Maximum number of samplers that can be used in a kernel. The minimum value -- is 16 if 'clGetDeviceImageSupport' is 'True'. (Also see sampler type.)-clGetDeviceMaxSamplers :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_MAX_SAMPLERS'.+clGetDeviceMaxSamplers :: CLDeviceID -> IO CLuint clGetDeviceMaxSamplers = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_SAMPLERS -- | Maximum number of work-items in a work-group executing a kernel using the -- data parallel execution model. (Refer to 'clEnqueueNDRangeKernel'). The -- minimum value is 1.-clGetDeviceMaxWorkGroupSize :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_WORK_GROUP_SIZE'.+clGetDeviceMaxWorkGroupSize :: CLDeviceID -> IO CSize clGetDeviceMaxWorkGroupSize = getDeviceInfoSizet . getCLValue $ CL_DEVICE_MAX_WORK_GROUP_SIZE -- | Maximum dimensions that specify the global and local work-item IDs used by -- the data parallel execution model. (Refer to 'clEnqueueNDRangeKernel'). -- The minimum value is 3.-clGetDeviceMaxWorkItemDimensions :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS'.+clGetDeviceMaxWorkItemDimensions :: CLDeviceID -> IO CLuint clGetDeviceMaxWorkItemDimensions = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS -- | Maximum number of work-items that can be specified in each dimension of the -- work-group to 'clEnqueueNDRangeKernel'. -- Returns n entries, where n is the value returned by the query for -- clDeviceMaxWorkItemDimensions. The minimum value is (1, 1, 1).-clGetDeviceMaxWorkItemSizes :: CLDeviceID -> IO (Either CLError [CSize])+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_WORK_ITEM_SIZES'.+clGetDeviceMaxWorkItemSizes :: CLDeviceID -> IO [CSize] clGetDeviceMaxWorkItemSizes device = do- val <- clGetDeviceMaxWorkItemDimensions device- case val of- Left err -> return . Left $ err- Right n -> allocaArray (fromIntegral n) $ \(buff :: Ptr CSize) -> do- whenSuccess (raw_clGetDeviceInfo device infoid (size n) (castPtr buff) nullPtr)- $ peekArray (fromIntegral n) buff+ n <- clGetDeviceMaxWorkItemDimensions device+ allocaArray (fromIntegral n) $ \(buff :: Ptr CSize) -> do+ whenSuccess (raw_clGetDeviceInfo device infoid (size n) (castPtr buff) nullPtr)+ $ peekArray (fromIntegral n) buff where infoid = getCLValue CL_DEVICE_MAX_WORK_ITEM_SIZES size n = fromIntegral $ (fromIntegral n) * (sizeOf (0::CSize)) -- | Max number of simultaneous image objects that can be written to by a -- kernel. The minimum value is 8 if 'clGetDeviceImageSupport' is 'True'.-clGetDeviceMaxWriteImageArgs :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MAX_WRITE_IMAGE_ARGS'.+clGetDeviceMaxWriteImageArgs :: CLDeviceID -> IO CLuint clGetDeviceMaxWriteImageArgs = getDeviceInfoUint . getCLValue $ CL_DEVICE_MAX_WRITE_IMAGE_ARGS -- | Describes the alignment in bits of the base address of any allocated -- memory object.-clGetDeviceMemBaseAddrAlign :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MEM_BASE_ADDR_ALIGN'.+clGetDeviceMemBaseAddrAlign :: CLDeviceID -> IO CLuint clGetDeviceMemBaseAddrAlign = getDeviceInfoUint . getCLValue $ CL_DEVICE_MEM_BASE_ADDR_ALIGN -- | The smallest alignment in bytes which can be used for any data type.-clGetDeviceMinDataTypeAlignSize :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE'.+clGetDeviceMinDataTypeAlignSize :: CLDeviceID -> IO CLuint clGetDeviceMinDataTypeAlignSize = getDeviceInfoUint . getCLValue $ CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE -- | Device name string.-clGetDeviceName :: CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_NAME'.+clGetDeviceName :: CLDeviceID -> IO String clGetDeviceName = getDeviceInfoString . getCLValue $ CL_DEVICE_NAME -- | The platform associated with this device.-clGetDevicePlatform :: CLDeviceID -> IO (Either CLError CLPlatformID)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_PLATFORM'.+clGetDevicePlatform :: CLDeviceID -> IO CLPlatformID clGetDevicePlatform device = alloca $ \(dat :: Ptr CLPlatformID) -> do whenSuccess (raw_clGetDeviceInfo device infoid size (castPtr dat) nullPtr) $ peek dat@@ -489,31 +585,46 @@ -- | Preferred native vector width size for built-in char types that can be put -- into vectors. The vector width is defined as the number of scalar elements -- that can be stored in the vector.-clGetDevicePreferredVectorWidthChar :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR'.+clGetDevicePreferredVectorWidthChar :: CLDeviceID -> IO CLuint clGetDevicePreferredVectorWidthChar = getDeviceInfoUint . getCLValue $ CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR -- | Preferred native vector width size for built-in short types that can be put -- into vectors. The vector width is defined as the number of scalar elements -- that can be stored in the vector.-clGetDevicePreferredVectorWidthShort :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT'.+clGetDevicePreferredVectorWidthShort :: CLDeviceID -> IO CLuint clGetDevicePreferredVectorWidthShort = getDeviceInfoUint . getCLValue $ CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT -- | Preferred native vector width size for built-in int types that can be put -- into vectors. The vector width is defined as the number of scalar elements -- that can be stored in the vector.-clGetDevicePreferredVectorWidthInt :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT'.+clGetDevicePreferredVectorWidthInt :: CLDeviceID -> IO CLuint clGetDevicePreferredVectorWidthInt = getDeviceInfoUint . getCLValue $ CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT -- | Preferred native vector width size for built-in long types that can be put -- into vectors. The vector width is defined as the number of scalar elements -- that can be stored in the vector.-clGetDevicePreferredVectorWidthLong :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG'.+clGetDevicePreferredVectorWidthLong :: CLDeviceID -> IO CLuint clGetDevicePreferredVectorWidthLong = getDeviceInfoUint . getCLValue $ CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG -- | Preferred native vector width size for built-in float types that can be put -- into vectors. The vector width is defined as the number of scalar elements -- that can be stored in the vector.-clGetDevicePreferredVectorWidthFloat :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT'.+clGetDevicePreferredVectorWidthFloat :: CLDeviceID -> IO CLuint clGetDevicePreferredVectorWidthFloat = getDeviceInfoUint . getCLValue $ CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT -- | Preferred native vector width size for built-in double types that can be put @@ -521,7 +632,10 @@ -- that can be stored in the vector. -- | If the cl_khr_fp64 extension is not supported, -- 'clGetDevicePreferredVectorWidthDouble' must return 0.-clGetDevicePreferredVectorWidthDouble :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE'.+clGetDevicePreferredVectorWidthDouble :: CLDeviceID -> IO CLuint clGetDevicePreferredVectorWidthDouble = getDeviceInfoUint . getCLValue $ CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE -- | OpenCL profile string. Returns the profile name supported by the device @@ -532,59 +646,76 @@ -- any extensions to be supported). -- -- * EMBEDDED_PROFILE - if the device supports the OpenCL embedded profile.-clGetDeviceProfile :: CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_PROFILE'.+clGetDeviceProfile :: CLDeviceID -> IO String clGetDeviceProfile = getDeviceInfoString . getCLValue $ CL_DEVICE_PROFILE -- | Describes the resolution of device timer. This is measured in nanoseconds.-clGetDeviceProfilingTimerResolution :: CLDeviceID -> IO (Either CLError CSize)+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_PROFILING_TIMER_RESOLUTION'.+clGetDeviceProfilingTimerResolution :: CLDeviceID -> IO CSize clGetDeviceProfilingTimerResolution = getDeviceInfoSizet . getCLValue $ CL_DEVICE_PROFILING_TIMER_RESOLUTION -- | Describes the command-queue properties supported by the device. This is a -- list that describes one or more of the CLCommandQueueProperty values. -- These properties are described in the table for 'clCreateCommandQueue'. -- The mandated minimum capability is 'CL_QUEUE_PROFILING_ENABLE'.-clGetDeviceQueueProperties :: CLDeviceID -> IO (Either CLError [CLCommandQueueProperty])+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_QUEUE_PROPERTIES'.+clGetDeviceQueueProperties :: CLDeviceID -> IO [CLCommandQueueProperty] clGetDeviceQueueProperties device = do- val <- getDeviceInfoUlong (getCLValue CL_DEVICE_QUEUE_PROPERTIES) device- case val of- Left err -> return . Left $ err- Right flags -> return . Right . bitmaskToCommandQueueProperties $ flags+ flags <- getDeviceInfoUlong (getCLValue CL_DEVICE_QUEUE_PROPERTIES) device+ return . bitmaskToCommandQueueProperties $ flags -- | Describes single precision floating-point capability of the device. This is -- a bit-field that describes one or more of the 'CLDeviceFPConfig' values. -- The mandated minimum floating-point capability is 'CL_FP_ROUND_TO_NEAREST' | -- 'CL_FP_INF_NAN'.-clGetDeviceSingleFPConfig :: CLDeviceID -> IO (Either CLError [CLDeviceFPConfig])+--+-- This function execute OpenCL clGetDeviceInfo with+-- 'CL_DEVICE_SINGLE_FP_CONFIG'.+clGetDeviceSingleFPConfig :: CLDeviceID -> IO [CLDeviceFPConfig] clGetDeviceSingleFPConfig = getDeviceInfoFP . getCLValue $ CL_DEVICE_SINGLE_FP_CONFIG -- | The OpenCL device type. Currently supported values are one of or a -- combination of: 'CL_DEVICE_TYPE_CPU', 'CL_DEVICE_TYPE_GPU', -- 'CL_DEVICE_TYPE_ACCELERATOR', or 'CL_DEVICE_TYPE_DEFAULT'.-clGetDeviceType :: CLDeviceID -> IO (Either CLError [CLDeviceType])+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_TYPE'.+clGetDeviceType :: CLDeviceID -> IO [CLDeviceType] clGetDeviceType device = do- val <- getDeviceInfoUlong (getCLValue CL_DEVICE_TYPE) device- case val of- Left err -> return . Left $ err- Right flags -> return . Right . bitmaskToDeviceTypes $ flags+ flags <- getDeviceInfoUlong (getCLValue CL_DEVICE_TYPE) device+ return . bitmaskToDeviceTypes $ flags -- | Vendor name string.-clGetDeviceVendor :: CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_VENDOR'.+clGetDeviceVendor :: CLDeviceID -> IO String clGetDeviceVendor = getDeviceInfoString . getCLValue $ CL_DEVICE_VENDOR -- | A unique device vendor identifier. An example of a unique device identifier -- could be the PCIe ID.-clGetDeviceVendorID :: CLDeviceID -> IO (Either CLError CLuint)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_VENDOR_ID'.+clGetDeviceVendorID :: CLDeviceID -> IO CLuint clGetDeviceVendorID = getDeviceInfoUint . getCLValue $ CL_DEVICE_VENDOR_ID -- | OpenCL version string. Returns the OpenCL version supported by the device. -- This version string has the following format: -- /OpenCL major_version.minor_version vendor-specific information/ -- The major_version.minor_version value returned will be 1.0.-clGetDeviceVersion :: CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DEVICE_VERSION'.+clGetDeviceVersion :: CLDeviceID -> IO String clGetDeviceVersion = getDeviceInfoString . getCLValue $ CL_DEVICE_VERSION -- | OpenCL software driver version string in the form major_number.minor_number.-clGetDeviceDriverVersion :: CLDeviceID -> IO (Either CLError String)+--+-- This function execute OpenCL clGetDeviceInfo with 'CL_DRIVER_VERSION'.+clGetDeviceDriverVersion :: CLDeviceID -> IO String clGetDeviceDriverVersion = getDeviceInfoString . getCLValue $ CL_DRIVER_VERSION -- -----------------------------------------------------------------------------
src/System/GPU/OpenCL/Types.chs view
@@ -1,19 +1,35 @@--- -------------------------------------------------------------------------------- This file is part of Haskell-Opencl.+{- Copyright (c) 2011 Luis Cabellos, --- Haskell-Opencl is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- (at your option) any later version.+All rights reserved. --- Haskell-Opencl is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: --- You should have received a copy of the GNU General Public License--- along with Haskell-Opencl. If not, see <http://www.gnu.org/licenses/>.--- -----------------------------------------------------------------------------+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}+{-# LANGUAGE DeriveDataTypeable #-} module System.GPU.OpenCL.Types( -- * Symple CL Types CLbool, CLint, CLuint, CLulong, CLProgram, CLEvent, CLMem, CLPlatformID, @@ -32,15 +48,17 @@ CLBuildStatus(..), CLAddressingMode(..), CLFilterMode(..), -- * Functions wrapPError, wrapCheckSuccess, wrapGetInfo, whenSuccess, getCLValue, - getEnumCL, bitmaskToFlags, getCommandExecutionStatus, bitmaskToDeviceTypes, - bitmaskFromFlags, bitmaskToCommandQueueProperties, bitmaskToFPConfig, - bitmaskToExecCapability, bitmaskToMemFlags )+ throwCLError, getEnumCL, bitmaskToFlags, getCommandExecutionStatus, + bitmaskToDeviceTypes, bitmaskFromFlags, bitmaskToCommandQueueProperties, + bitmaskToFPConfig, bitmaskToExecCapability, bitmaskToMemFlags ) where -- ----------------------------------------------------------------------------- import Foreign import Foreign.C.Types import Data.List( foldl' )+import Data.Typeable( Typeable(..) )+import Control.Exception( Exception(..), throw ) #include <CL/cl.h> @@ -299,33 +317,38 @@ * 'CL_SUCCESS', Indicates that the function executed successfully. -}-{#enum CLError {upcaseFirstLetter} deriving( Show, Eq ) #}+{#enum CLError {upcaseFirstLetter} deriving( Show, Eq, Typeable ) #} -wrapPError :: (Ptr CLint -> IO a) -> IO (Either CLError a)+instance Exception CLError++throwCLError :: CLint -> IO a+throwCLError = throw . (getEnumCL :: CLint -> CLError)++wrapPError :: (Ptr CLint -> IO a) -> IO a wrapPError f = alloca $ \perr -> do v <- f perr- errcode <- peek perr >>= return . toEnum . fromIntegral+ errcode <- peek perr >>= return . getEnumCL if errcode == CL_SUCCESS- then return $ Right v- else return $ Left errcode+ then return v+ else throw errcode wrapCheckSuccess :: IO CLint -> IO Bool-wrapCheckSuccess f = f >>= return . (==CL_SUCCESS) . toEnum . fromIntegral+wrapCheckSuccess f = f >>= return . (==CL_SUCCESS) . getEnumCL -wrapGetInfo :: Storable a => (Ptr a -> Ptr CSize -> IO CLint) -> (a -> b) - -> IO (Either CLError b)+wrapGetInfo :: Storable a + => (Ptr a -> Ptr CSize -> IO CLint) -> (a -> b) -> IO b wrapGetInfo fget fconvert= alloca $ \dat -> do errcode <- fget dat nullPtr- if errcode == (fromIntegral . fromEnum $ CL_SUCCESS )- then fmap (Right . fconvert) $ peek dat- else return . Left . toEnum . fromIntegral $ errcode+ if errcode == getCLValue CL_SUCCESS+ then fmap fconvert $ peek dat+ else throwCLError errcode -whenSuccess :: IO CLint -> IO a -> IO (Either CLError a)+whenSuccess :: IO CLint -> IO a -> IO a whenSuccess fcheck fval = do errcode <- fcheck if errcode == getCLValue CL_SUCCESS- then fval >>= return . Right- else return . Left . getEnumCL $ errcode+ then fval+ else throwCLError errcode -- ----------------------------------------------------------------------------- #c