diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,661 +1,30 @@ - GNU AFFERO GENERAL PUBLIC LICENSE - Version 3, 19 November 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - 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. - - - Copyright (C) +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 . + * 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 -. +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. diff --git a/OpenCL.cabal b/OpenCL.cabal --- a/OpenCL.cabal +++ b/OpenCL.cabal @@ -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 diff --git a/README.org b/README.org new file mode 100644 --- /dev/null +++ b/README.org @@ -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 + diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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 diff --git a/examples/example01.hs b/examples/example01.hs new file mode 100644 --- /dev/null +++ b/examples/example01.hs @@ -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 () diff --git a/examples/example02.hs b/examples/example02.hs new file mode 100644 --- /dev/null +++ b/examples/example02.hs @@ -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 diff --git a/examples/example03.hs b/examples/example03.hs new file mode 100644 --- /dev/null +++ b/examples/example03.hs @@ -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 () diff --git a/examples/example04.hs b/examples/example04.hs new file mode 100644 --- /dev/null +++ b/examples/example04.hs @@ -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 () diff --git a/src/System/GPU/OpenCL.hs b/src/System/GPU/OpenCL.hs --- a/src/System/GPU/OpenCL.hs +++ b/src/System/GPU/OpenCL.hs @@ -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 . --- ----------------------------------------------------------------------------- + * 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 -- ----------------------------------------------------------------------------- diff --git a/src/System/GPU/OpenCL/CommandQueue.chs b/src/System/GPU/OpenCL/CommandQueue.chs --- a/src/System/GPU/OpenCL/CommandQueue.chs +++ b/src/System/GPU/OpenCL/CommandQueue.chs @@ -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 . --- ----------------------------------------------------------------------------- -{-# 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 -- ----------------------------------------------------------------------------- -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 diff --git a/src/System/GPU/OpenCL/Context.chs b/src/System/GPU/OpenCL/Context.chs --- a/src/System/GPU/OpenCL/Context.chs +++ b/src/System/GPU/OpenCL/Context.chs @@ -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 . --- ----------------------------------------------------------------------------- -{-# 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 -- ----------------------------------------------------------------------------- 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) diff --git a/src/System/GPU/OpenCL/Event.chs b/src/System/GPU/OpenCL/Event.chs --- a/src/System/GPU/OpenCL/Event.chs +++ b/src/System/GPU/OpenCL/Event.chs @@ -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 . --- ----------------------------------------------------------------------------- -{-# 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 -- ----------------------------------------------------------------------------- -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 diff --git a/src/System/GPU/OpenCL/Memory.chs b/src/System/GPU/OpenCL/Memory.chs --- a/src/System/GPU/OpenCL/Memory.chs +++ b/src/System/GPU/OpenCL/Memory.chs @@ -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 . --- ----------------------------------------------------------------------------- -{-# 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 -- ----------------------------------------------------------------------------- -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 diff --git a/src/System/GPU/OpenCL/Program.chs b/src/System/GPU/OpenCL/Program.chs --- a/src/System/GPU/OpenCL/Program.chs +++ b/src/System/GPU/OpenCL/Program.chs @@ -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 . --- ----------------------------------------------------------------------------- -{-# 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 -- ----------------------------------------------------------------------------- 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 diff --git a/src/System/GPU/OpenCL/Query.chs b/src/System/GPU/OpenCL/Query.chs --- a/src/System/GPU/OpenCL/Query.chs +++ b/src/System/GPU/OpenCL/Query.chs @@ -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 . --- ----------------------------------------------------------------------------- -{-# 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 -- ----------------------------------------------------------------------------- -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 -- ----------------------------------------------------------------------------- diff --git a/src/System/GPU/OpenCL/Types.chs b/src/System/GPU/OpenCL/Types.chs --- a/src/System/GPU/OpenCL/Types.chs +++ b/src/System/GPU/OpenCL/Types.chs @@ -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 . --- ----------------------------------------------------------------------------- + * 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 @@ -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