diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | LICENSE | 674 | ||||
| -rw-r--r-- | README.org | 46 | ||||
| -rw-r--r-- | TODO.org | 135 | ||||
| -rw-r--r-- | opencl.asd | 28 | ||||
| -rw-r--r-- | src/bindings.lisp | 832 | ||||
| -rw-r--r-- | src/command-queue.lisp | 38 | ||||
| -rw-r--r-- | src/constants.lisp | 558 | ||||
| -rw-r--r-- | src/context.lisp | 49 | ||||
| -rw-r--r-- | src/deprecated.lisp | 4 | ||||
| -rw-r--r-- | src/device.lisp | 176 | ||||
| -rw-r--r-- | src/enqueue.lisp | 77 | ||||
| -rw-r--r-- | src/event.lisp | 26 | ||||
| -rw-r--r-- | src/extensions.lisp | 0 | ||||
| -rw-r--r-- | src/flush.lisp | 7 | ||||
| -rw-r--r-- | src/kernel.lisp | 61 | ||||
| -rw-r--r-- | src/memory.lisp | 89 | ||||
| -rw-r--r-- | src/opencl.lisp | 109 | ||||
| -rw-r--r-- | src/package.lisp | 247 | ||||
| -rw-r--r-- | src/platform.lisp | 24 | ||||
| -rw-r--r-- | src/profiling.lisp | 11 | ||||
| -rw-r--r-- | src/program.lisp | 83 | ||||
| -rw-r--r-- | src/sampler.lisp | 27 | ||||
| -rw-r--r-- | src/types.lisp | 630 | ||||
| -rw-r--r-- | t/test.cl | 10 | ||||
| -rw-r--r-- | t/test.lisp | 51 |
26 files changed, 3994 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8058655 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +scrap.c +notes.org @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is 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. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + 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. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + 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 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. Use with the GNU Affero General Public License. + + 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 Affero 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 special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU 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 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 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 General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + 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 GPL, see +<https://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<https://www.gnu.org/licenses/why-not-lgpl.html>. diff --git a/README.org b/README.org new file mode 100644 index 0000000..60fa6f4 --- /dev/null +++ b/README.org @@ -0,0 +1,46 @@ +#+title: cl-opencl +#+author: Thomas Albers Raviola + +cl-opencl aims to provide a lispy set of bindings for programming with OpenCL +from common lisp. + +While for most functions a high-level alternative is provided to avoid +interacting directly with ~cffi~, by the very nature of OpenCL some functions +still require direct manipulation of ~cffi:pointers~. For these some kind of +high-level convenience function is still provided (with ~&optional~ or ~&key~ +arguments) but use of ~cffi~ is nonetheless needed. + +A package with raw bindings to the OpenCL API is also provided for situations +that require it. + +*NOTE*: This library is still in early development and it may be subject to +changes. A list with the progress and some of the future ideas is included as +~TODO.org~ + +* Name + +cl-opencl is not a unique name, there are many other libraries with this name, +some of them still mantained. Ideally I would like to rename it. + +* Why another OpenCL library for Common Lisp + +This is not the first time someone writes a set of bindings for OpenCL, but I've +some future plans that could benefit from having a library under my direct +control in terms of development decisions. In particular, a set of libraries for +numeric and scientific computations. + +* Website + +[[https://thomaslabs.org]] + +* Thanks + +Throughout the development some of my decisions were inspired by the following +projects: + +[[https://github.com/3b/cl-opencl-3b][3b/cl-opencl-3b]] +[[https://github.com/inducer/pyopencl][inducer/pyopencl]] + +* License + +cl-opencl is distributed unded the terms of the GPL-3.0 license (see ~LICENSE~). diff --git a/TODO.org b/TODO.org new file mode 100644 index 0000000..670aa2b --- /dev/null +++ b/TODO.org @@ -0,0 +1,135 @@ +#+title: Things yet missing +#+author: Thomas Albers Raviola + +* [60/114] Bindings progress +- [2/2] Platform API + - [X] clGetPlatformIDs + - [X] clGetPlatformInfo +- [7/8] Device APIs + - [X] clGetDeviceIDs + - [X] clGetDeviceInfo + - [ ] clCreateSubDevices + - [X] clRetainDevice + - [X] clReleaseDevice + - [X] clSetDefaultDeviceCommandQueue + - [X] clGetDeviceAndHostTimer + - [X] clGetHostTimer +- [5/6] Context APIs + - [X] clCreateContext + - [X] clCreateContextFromType + - [X] clRetainContext + - [X] clReleaseContext + - [X] clGetContextInfo + - [ ] clSetContextDestructorCallback +- [4/4] Command Queue APIs + - [X] clCreateCommandQueueWithProperties + - [X] clRetainCommandQueue + - [X] clReleaseCommandQueue + - [X] clGetCommandQueueInfo +- [8/13] Memory Object APIs + - [X] clCreateBuffer + - [ ] clCreateSubBuffer + - [ ] clCreateImage + - [X] clCreatePipe + - [ ] clCreateBufferWithProperties + - [ ] clCreateImageWithProperties + - [X] clRetainMemObject + - [X] clReleaseMemObject + - [X] clGetSupportedImageFormats + - [X] clGetMemObjectInfo + - [X] clGetImageInfo + - [X] clGetPipeInfo + - [ ] clSetMemObjectDestructorCallback +- [2/2] SVM Allocation APIs + - [X] clSVMAlloc + - [X] clSVMFree +- [4/4] Sampler APIs + - [X] clCreateSamplerWithProperties + - [X] clRetainSampler + - [X] clReleaseSampler + - [X] clGetSamplerInfo +- [6/14] Program Object APIs + - [X] clCreateProgramWithSource + - [ ] clCreateProgramWithBinary + - [ ] clCreateProgramWithBuiltInKernels + - [ ] clCreateProgramWithIL + - [X] clRetainProgram + - [X] clReleaseProgram + - [X] clBuildProgram + - [ ] clCompileProgram + - [X] clLinkProgram + - [ ] clSetProgramReleaseCallback + - [ ] clSetProgramSpecializationConstant + - [X] clUnloadPlatformCompiler + - [ ] clGetProgramInfo + - [ ] clGetProgramBuildInfo +- [6/12] Kernel Object APIs + - [X] clCreateKernel + - [X] clCreateKernelsInProgram + - [X] clCloneKernel + - [X] clRetainKernel + - [X] clReleaseKernel + - [ ] clSetKernelArg + - [ ] clSetKernelArgSVMPointer + - [ ] clSetKernelExecInfo + - [X] clGetKernelInfo + - [ ] clGetKernelArgInfo + - [ ] clGetKernelWorkGroupInfo + - [ ] clGetKernelSubGroupInfo +- [6/7] Event Object APIs + - [X] clWaitForEvents + - [X] clGetEventInfo + - [X] clCreateUserEvent + - [X] clRetainEvent + - [X] clReleaseEvent + - [X] clSetUserEventStatus + - [ ] clSetEventCallback +- [1/1] Profiling APIs + - [X] clGetEventProfilingInfo +- [2/2] Flush and Finish APIs + - [X] clFlush + - [X] clFinish +- [7/27] Enqueued Commands APIs + - [ ] clEnqueueReadBuffer + - [ ] clEnqueueReadBufferRect + - [ ] clEnqueueWriteBuffer + - [ ] clEnqueueWriteBufferRect + - [ ] clEnqueueFillBuffer + - [ ] clEnqueueCopyBuffer + - [ ] clEnqueueCopyBufferRect + - [ ] clEnqueueReadImage + - [ ] clEnqueueWriteImage + - [ ] clEnqueueFillImage + - [ ] clEnqueueCopyImage + - [ ] clEnqueueCopyImageToBuffer + - [ ] clEnqueueCopyBufferToImage + - [ ] clEnqueueMapBuffer + - [ ] clEnqueueMapImage + - [ ] clEnqueueUnmapMemObject + - [ ] clEnqueueMigrateMemObjects + - [X] clEnqueueNDRangeKernel + - [ ] clEnqueueNativeKernel + - [ ] clEnqueueMarkerWithWaitList + - [ ] clEnqueueBarrierWithWaitList + - [X] clEnqueueSVMFree + - [X] clEnqueueSVMMemcpy + - [X] clEnqueueSVMMemfill + - [X] clEnqueueSVMMap + - [X] clEnqueueSVMUnmap + - [X] clEnqueueSVMMigrateMem +- [0/1] Extension function access + - [ ] clGetExtensionFunctionAddressForPlatform +- [0/1] Deprecated OpenCL 1.0 APIs + - [ ] clSetCommandQueueProperty +- [0/7] Deprecated OpenCL 1.1 APIs + - [ ] clCreateImage2D + - [ ] clCreateImage3D + - [ ] clEnqueueMarker + - [ ] clEnqueueWaitForEvents + - [ ] clEnqueueBarrier + - [ ] clUnloadCompiler + - [ ] clGetExtensionFunctionAddress +- [0/3] Deprecated OpenCL 2.0 APIs + - [ ] clCreateCommandQueue + - [ ] clCreateSampler + - [ ] clEnqueueTask diff --git a/opencl.asd b/opencl.asd new file mode 100644 index 0000000..e8bf214 --- /dev/null +++ b/opencl.asd @@ -0,0 +1,28 @@ +(asdf:defsystem #:opencl + :description "Bindings for opencl" + :author ("Thomas Guillermo Albers Raviola") + :license "GPL-3.0" + :version "0.1.0" + :serial t + :depends-on (:cffi + :alexandria) + :pathname "src" + :components ((:file "package") + (:file "types") + (:file "constants") + (:file "bindings") + (:file "opencl") + (:file "deprecated") + (:file "platform") + (:file "device") + (:file "context") + (:file "command-queue") + (:file "memory") + (:file "sampler") + (:file "program") + (:file "kernel") + (:file "event") + (:file "profiling") + (:file "flush") + (:file "enqueue") + (:file "extensions"))) diff --git a/src/bindings.lisp b/src/bindings.lisp new file mode 100644 index 0000000..0cc08ba --- /dev/null +++ b/src/bindings.lisp @@ -0,0 +1,832 @@ +(in-package #:ocl-ffi) + +;;; Platform API + +(cffi:defcfun ("clGetPlatformIDs" %get-platform-ids) cl-error-code + (num-entries cl-uint) + (platforms cl-platform-id) + (num-platforms (:pointer cl-uint))) + +(cffi:defcfun ("clGetPlatformInfo" %get-platform-info) cl-error-code + (platform cl-platform-id) + (param-name cl-platform-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +;;; Device APIs + +(cffi:defcfun ("clGetDeviceIDs" %get-device-ids) cl-error-code + (platform cl-platform-id) + (device-type cl-device-type) + (num-entries cl-uint) + (devices (:pointer cl-device-id)) + (num-devices (:pointer cl-uint))) + +(cffi:defcfun ("clGetDeviceInfo" %get-device-info) cl-error-code + (device cl-device-id) + (param-name cl-device-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clCreateSubDevices" %create-sub-devices) cl-int + (in-device cl-device-id) + (properties (:pointer cl-device-partition-property)) + (num-devices cl-uint) + (out-devices (:pointer cl-device-id)) + (num-devices-ret (:pointer cl-uint))) + +(cffi:defcfun ("clRetainDevice" %retain-device) cl-error-code + (device cl-device-id)) + +(cffi:defcfun ("clReleaseDevice" %release-device) cl-error-code + (device cl-device-id)) + +(cffi:defcfun ("clSetDefaultDeviceCommandQueue" %set-default-device-command-queue) cl-int + (context cl-context) + (device cl-device-id) + (command-queue cl-command-queue)) + +(cffi:defcfun ("clGetDeviceAndHostTimer" %get-device-and-host-timer) cl-int + (device cl-device-id) + (device-timestamp (:pointer cl-ulong)) + (host-timestamp (:pointer cl-ulong))) + +(cffi:defcfun ("clGetHostTimer" %get-host-timer) cl-int + (device cl-device-id) + (host-timestamp (:pointer cl-ulong))) + +;;; Context APIs + +(cffi:defcfun ("clCreateContext" %create-context) cl-context + (properties (:pointer cl-context-properties)) + (num-devices cl-uint) + (devices (:pointer cl-device-id)) + (pfn-notify :pointer) + (user-data (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateContextFromType" %create-context-from-type) cl-context + (device-type cl-device-type) + (pfn-notify :pointer) + (user-data (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainContext" %retain-context) cl-error-code + (context cl-context)) + +(cffi:defcfun ("clReleaseContext" %release-context) cl-error-code + (context cl-context)) + +(cffi:defcfun ("clGetContextInfo" %get-context-info) cl-int + (context cl-context) + (param-name cl-context-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clSetContextDestructorCallback" set-context-destructor-callback) cl-int + (context cl-context) + (pfn-notify :pointer) + (user-data (:pointer :void))) + +;;; Command Queue APIs + +(cffi:defcfun ("clCreateCommandQueueWithProperties" %create-command-queue-with-properties) cl-command-queue + (context cl-context) + (device cl-device-id) + (properties (:pointer cl-queue-properties)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainCommandQueue" %retain-command-queue) cl-error-code + (command-queue cl-command-queue)) + +(cffi:defcfun ("clReleaseCommandQueue" %release-command-queue) cl-error-code + (command-queue cl-command-queue)) + +(cffi:defcfun ("clGetCommandQueueInfo" %get-command-queue-info) cl-int + (command-queue cl-command-queue) + (param-name cl-command-queue-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +;;; Memory Object APIs + +(cffi:defcfun ("clCreateBuffer" %create-buffer) cl-mem + (context cl-context) + (flags cl-mem-flags) + (size :size) + (host-ptr (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateSubBuffer" create-sub-buffer) cl-mem + (buffer cl-mem) + (flags cl-mem-flags) + (size :size) + (host-ptr (:pointer :void)) + (buffer-create-type cl-buffer-create-type) + (buffer-create-info (:pointer :void)) + (errcode-ret (:pointer :int))) + +(cffi:defcfun ("clCreateImage" create-image) cl-mem + (context cl-context) + (flags cl-mem-flags) + (image-format (:pointer (:struct cl-image-format))) + (image-desc (:pointer (:struct cl-image-desc))) + (host-ptr (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreatePipe" %create-pipe) cl-mem + (context cl-context) + (flags cl-mem-flags) + (pipe-packet-size cl-uint) + (pipe-max-packets cl-uint) + (properties (:pointer cl-pipe-properties)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateBufferWithProperties" create-buffer-with-properties) cl-mem + (context cl-context) + (properties (:pointer cl-mem-properties)) + (flags cl-mem-flags) + (size :size) + (host-ptr (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateImageWithProperties" create-image-with-properties) cl-mem + (context cl-context) + (properties (:pointer cl-mem-properties)) + (flags cl-mem-flags) + (image-format (:pointer (:struct cl-image-format))) + (image-desc (:pointer (:struct cl-image-desc))) + (host-ptr (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainMemObject" %retain-mem-object) cl-error-code + (memobj cl-mem)) + +(cffi:defcfun ("clReleaseMemObject" %release-mem-object) cl-error-code + (memobj cl-mem)) + +(cffi:defcfun ("clGetSupportedImageFormats" %get-supported-image-formats) cl-error-code + (context cl-context) + (flags cl-mem-flags) + (image-type cl-mem-object-type) + (num-entries cl-uint) + (image-formats (:pointer (:struct cl-image-format))) + (num-image-formats (:pointer cl-uint))) + +(cffi:defcfun ("clGetMemObjectInfo" %get-mem-object-info) cl-int + (memobj cl-mem) + (param-name cl-mem-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetImageInfo" %get-image-info) cl-int + (image cl-mem) + (param-name cl-image-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetPipeInfo" %get-pipe-info) cl-int + (pipe cl-mem) + (param-name cl-pipe-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clSetMemObjectDestructorCallback" set-mem-object-destructor-callback) cl-int + (memobj cl-mem) + (pfn-notify :pointer) + (user-data (:pointer :void))) + +;;; SVM Allocation APIs + +(cffi:defcfun ("clSVMAlloc" svm-alloc) (:pointer :void) + (context cl-context) + (flags cl-svm-mem-flags) + (size :size) + (aligment cl-uint)) + +(cffi:defcfun ("clSVMFree" svm-free) :void + (context cl-context) + (svm-pointer (:pointer :void))) + +;;; Sampler APIs + +(cffi:defcfun ("clCreateSamplerWithProperties" %create-sampler-with-properties) cl-sampler + (context cl-context) + (sampler-properties (:pointer cl-sampler-properties)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainSampler" %retain-sampler) cl-int + (sampler cl-sampler)) + +(cffi:defcfun ("clReleaseSampler" %release-sampler) cl-int + (sampler cl-sampler)) + +(cffi:defcfun ("clGetSamplerInfo" %get-sampler-info) cl-int + (sampler cl-sampler) + (param-name cl-sampler-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +;;; Program Object APIs + +(cffi:defcfun ("clCreateProgramWithSource" %create-program-with-source) cl-program + (context cl-context) + (count cl-uint) + (strings (:pointer (:pointer :char))) + (lengths (:pointer :size)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateProgramWithBinary" create-program-with-binary) cl-program + (context cl-context) + (num-devices cl-uint) + (device-list (:pointer cl-device-id)) + (lengths (:pointer :size)) + (binaries (:pointer (:pointer :unsigned-char))) + (binary-status (:pointer cl-int)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateProgramWithBuiltInKernels" create-program-with-built-in-kernels) cl-program + (context cl-context) + (num-devices cl-uint) + (device-list (:pointer cl-device-id)) + (kernel-names (:pointer :char)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateProgramWithIL" create-program-with-il) cl-program + (context cl-context) + (il (:pointer :void)) + (length :size) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainProgram" %retain-program) cl-error-code + (program cl-program)) + +(cffi:defcfun ("clReleaseProgram" %release-program) cl-error-code + (program cl-program)) + +(cffi:defcfun ("clBuildProgram" %build-program) cl-error-code + (program cl-program) + (num-devices cl-uint) + (device-list (:pointer cl-device-id)) + (options :string) + (pfn-notify :pointer) + (user-data (:pointer :void))) + +(cffi:defcfun ("clCompileProgram" %compile-program) cl-error-code + (program cl-program) + (num-devices cl-uint) + (device-list (:pointer cl-device-id)) + (options (:pointer :char)) + (num-input-headers cl-uint) + (input-headers (:pointer cl-program)) + (header-include-names (:pointer (:pointer :char))) + (pfn-notify :pointer) + (user-data (:pointer :void))) + +(cffi:defcfun ("clLinkProgram" %link-program) cl-program + (context cl-context) + (num-devices cl-uint) + (device-list (:pointer cl-device-id)) + (options (:pointer :char)) + (num-input-programs cl-uint) + (input-programs (:pointer cl-program)) + (pfn-notify :pointer) + (user-data (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clSetProgramReleaseCallback" set-program-release-callback) cl-int + (program cl-program) + (pfn-notify :pointer) + (user-data (:pointer :void))) + +(cffi:defcfun ("clSetProgramSpecializationConstant" set-program-specialization-constant) cl-int + (program cl-program) + (spec-id cl-uint) + (spec-size :size) + (spec-value (:pointer :void))) + +(cffi:defcfun ("clUnloadPlatformCompiler" %unload-platform-compiler) cl-error-code + (platform cl-platform-id)) + +(cffi:defcfun ("clGetProgramInfo" %get-program-info) cl-int + (program cl-program) + (param-name cl-program-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetProgramBuildInfo" %get-program-build-info) cl-int + (program cl-program) + (device cl-device-id) + (param-name cl-program-build-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +;;; Kernel Object APIs + +(cffi:defcfun ("clCreateKernel" %create-kernel) cl-kernel + (program cl-program) + (kernel-name :string) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateKernelsInProgram" %create-kernels-in-program) cl-error-code + (program cl-program) + (num-kernels cl-uint) + (kernels (:pointer cl-kernel)) + (num-kernels-ret (:pointer cl-uint))) + +(cffi:defcfun ("clCloneKernel" %clone-kernel) cl-kernel + (source-kernel cl-kernel) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainKernel" %retain-kernel) cl-error-code + (kernel cl-kernel)) + +(cffi:defcfun ("clReleaseKernel" %release-kernel) cl-error-code + (kernel cl-kernel)) + +(cffi:defcfun ("clSetKernelArg" %set-kernel-arg) cl-error-code + (kernel cl-kernel) + (arg-index cl-uint) + (arg-size :size) + (arg-value (:pointer :void))) + +(cffi:defcfun ("clSetKernelArgSVMPointer" set-kernel-arg-svm-pointer) cl-int + (kernel cl-kernel) + (arg-index cl-uint) + (arg-value (:pointer :void))) + +(cffi:defcfun ("clSetKernelExecInfo" set-kernel-exec-info) cl-int + (kernel cl-kernel) + (param-name cl-kernel-exec-info) + (param-value-size :size) + (param-value (:pointer :void))) + +(cffi:defcfun ("clGetKernelInfo" %get-kernel-info) cl-int + (kernel cl-kernel) + (param-name cl-kernel-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetKernelArgInfo" %get-kernel-arg-info) cl-int + (kernel cl-kernel) + (arg-indx cl-uint) + (param-name cl-kernel-arg-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetKernelWorkGroupInfo" %get-kernel-work-group-info) cl-int + (kernel cl-kernel) + (device cl-device-id) + (param-name cl-kernel-work-group-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clGetKernelSubGroupInfo" %get-kernel-sub-group-info) cl-int + (kernel cl-kernel) + (device cl-device-id) + (param-name cl-kernel-sub-group-info) + (input-value-size :size) + (input-value (:pointer :void)) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +;;; Event Object APIs + +(cffi:defcfun ("clWaitForEvents" %wait-for-events) cl-error-code + (num-events cl-uint) + (event-list (:pointer cl-event))) + +(cffi:defcfun ("clGetEventInfo" %get-event-info) cl-error-code + (event cl-event) + (param-name cl-event-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +(cffi:defcfun ("clCreateUserEvent" %create-user-event) cl-event + (context cl-context) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clRetainEvent" %retain-event) cl-error-code + (event cl-event)) + +(cffi:defcfun ("clReleaseEvent" %release-event) cl-error-code + (event cl-event)) + +(cffi:defcfun ("clSetUserEventStatus" %set-user-event-status) cl-error-code + (event cl-event) + (execution-status cl-int)) + +(cffi:defcfun ("clSetEventCallback" set-event-callback) cl-int + (event cl-event) + (command-exec-callback-type cl-int) + (pfn-notify :pointer) + (user-data (:pointer :void))) + +;;; Profiling APIs + +(cffi:defcfun ("clGetEventProfilingInfo" %get-event-profiling-info) cl-error-code + (event cl-event) + (param-name cl-profiling-info) + (param-value-size :size) + (param-value (:pointer :void)) + (param-value-size-ret (:pointer :size))) + +;;; Flush and Finish APIs + +(cffi:defcfun ("clFlush" %flush) cl-error-code + (command-queue cl-command-queue)) + +(cffi:defcfun ("clFinish" %finish) cl-error-code + (command-queue cl-command-queue)) + +;;; Enqueued Commands APIs + +(cffi:defcfun ("clEnqueueReadBuffer" %enqueue-read-buffer) cl-error-code + (command-queue cl-command-queue) + (buffer cl-mem) + (blocking-read cl-bool) + (offset :size) + (size :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueReadBufferRect" enqueue-read-buffer-rect) cl-int + (command-queue cl-command-queue) + (buffer cl-mem) + (blocking-read cl-bool) + (buffer-origin (:pointer :size)) + (host-origin (:pointer :size)) + (region (:pointer :size)) + (buffer-row-pitch :size) + (buffer-slice-pitch :size) + (host-row-pitch :size) + (host-slice-pitch :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWriteBuffer" enqueue-write-buffer) cl-int + (command-queue cl-command-queue) + (buffer cl-mem) + (blocking-write cl-bool) + (offset :size) + (size :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWriteBufferRect" enqueue-write-buffer-rect) cl-int + (command-queue cl-command-queue) + (buffer cl-mem) + (blocking-write cl-bool) + (buffer-origin (:pointer :size)) + (host-origin (:pointer :size)) + (region (:pointer :size)) + (buffer-row-pitch :size) + (buffer-slice-pitch :size) + (host-row-pitch :size) + (host-slice-pitch :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueFillBuffer" enqueue-fill-buffer) cl-int + (command-queue cl-command-queue) + (buffer cl-mem) + (pattern (:pointer :void)) + (pattern-size :size) + (offset :size) + (size :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyBuffer" enqueue-copy-buffer) cl-int + (command-queue cl-command-queue) + (src-buffer cl-mem) + (dst-buffer cl-mem) + (src-offset :size) + (dst-offset :size) + (size :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyBufferRect" enqueue-copy-buffer-rect) cl-int + (command-queue cl-command-queue) + (src-buffer cl-mem) + (dst-buffer cl-mem) + (src-origin (:pointer :size)) + (dst-origin (:pointer :size)) + (region (:pointer :size)) + (src-row-pitch :size) + (src-slice-pitch :size) + (dst-row-pitch :size) + (dst-slice-pitch :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueReadImage" enqueue-read-image) cl-int + (command-queue cl-command-queue) + (image cl-mem) + (blocking-read cl-bool) + (origin (:pointer :size)) + (region (:pointer :size)) + (row-pitch :size) + (slice-pitch :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWriteImage" enqueue-write-image) cl-int + (command-queue cl-command-queue) + (image cl-mem) + (blocking-write cl-bool) + (origin (:pointer :size)) + (region (:pointer :size)) + (input-row-pitch :size) + (input-slice-pitch :size) + (ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueFillImage" enqueue-fill-image) cl-int + (command-queue cl-command-queue) + (image cl-mem) + (fill-color (:pointer :void)) + (origin (:pointer :size)) + (region (:pointer :size)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyImage" enqueue-copy-image) cl-int + (command-queue cl-command-queue) + (src-image cl-mem) + (dst-image cl-mem) + (src-origin (:pointer :size)) + (dst-origin (:pointer :size)) + (region (:pointer :size)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyImageToBuffer" enqueue-copy-image-to-buffer) cl-int + (command-queue cl-command-queue) + (src-image cl-mem) + (dst-buffer cl-mem) + (src-origin (:pointer :size)) + (region (:pointer :size)) + (dst-offset :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueCopyBufferToImage" enqueue-copy-buffer-to-image) cl-int + (command-queue cl-command-queue) + (src-buffer cl-mem) + (dst-image cl-mem) + (src-offset :size) + (dst-origin (:pointer :size)) + (region (:pointer :size)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueMapBuffer" enqueue-map-buffer) (:pointer :void) + (command-queue cl-command-queue) + (buffer cl-mem) + (blocking-map cl-bool) + (map-flags cl-map-flags) + (offset :size) + (size :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueMapImage" enqueue-map-image) (:pointer :void) + (command-queue cl-command-queue) + (image cl-mem) + (blocking-map cl-bool) + (map-flags cl-map-flags) + (origin (:pointer :size)) + (region (:pointer :size)) + (image-row-pitch (:pointer :size)) + (image-slice-pitch (:pointer :size)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueUnmapMemObject" enqueue-unmap-mem-object) cl-int + (command-queue cl-command-queue) + (memobj cl-mem) + (mapped-ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueMigrateMemObjects" enqueue-migrate-mem-objects) cl-int + (command-queue cl-command-queue) + (num-mem-objects cl-uint) + (mem-objects (:pointer cl-mem)) + (flags cl-mem-migration-flags) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueNDRangeKernel" %enqueue-nd-range-kernel) cl-error-code + (command-queue cl-command-queue) + (kernel cl-kernel) + (work-dim cl-uint) + (global-work-offset (:pointer :size)) + (global-work-size (:pointer :size)) + (local-work-size (:pointer :size)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueNativeKernel" enqueue-native-kernel) cl-int + (command-queue cl-command-queue) + (user-func :pointer) + (args (:pointer :void)) + (cb-args :size) + (num-mem-objects cl-uint) + (mem-list (:pointer cl-mem)) + (args-mem-loc (:pointer (:pointer :void))) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueMarkerWithWaitList" enqueue-marker-with-wait-list) cl-int + (command-queue cl-command-queue) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueBarrierWithWaitList" enqueue-barrier-with-wait-list) cl-int + (command-queue cl-command-queue) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMFree" %enqueue-svm-free) cl-error-code + (command-queue cl-command-queue) + (num-svm-pointers cl-uint) + (svm-pointers (:pointer (:pointer :void))) + (pfn-free-func :pointer) + (user-data :pointer) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMemcpy" %enqueue-svm-memcpy) cl-error-code + (command-queue cl-command-queue) + (blocking-copy cl-bool) + (dst-ptr (:pointer :void)) + (src-ptr (:pointer :void)) + (size :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMemfill" %enqueue-svm-memfill) cl-error-code + (command-queue cl-command-queue) + (svm-ptr (:pointer :void)) + (pattern (:pointer :void)) + (pattern-size :size) + (size :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMap" %enqueue-svm-map) cl-error-code + (command-queue cl-command-queue) + (blocking-map cl-bool) + (flags cl-map-flags) + (svm-ptr (:pointer :void)) + (size :size) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMUnmap" %enqueue-svm-unmap) cl-error-code + (command-queue cl-command-queue) + (svm-ptr (:pointer :void)) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueSVMMigrateMem" %enqueue-svm-migrate-mem) cl-error-code + (command-queue cl-command-queue) + (num-svm-pointers cl-uint) + (svm-pointers (:pointer (:pointer :void))) + (sizes (:pointer :size)) + (flags cl-mem-migration-flags) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) + +;;; Extension function access + +(cffi:defcfun ("clGetExtensionFunctionAddressForPlatform" + get-extension-function-address-for-platform) + (:pointer :void) + (platform cl-platform-id) + (func-name :string)) + +;;; Deprecated OpenCL 1.0 APIs + +(cffi:defcfun ("clSetCommandQueueProperty" set-command-queue-property) cl-int + (command-queue cl-command-queue) + (properties cl-command-queue-properties) + (enable cl-bool) + (old-properties (:pointer cl-command-queue-properties))) + +;;; Deprecated OpenCL 1.1 APIs + +(cffi:defcfun ("clCreateImage2D" create-image-2d) cl-mem + (context cl-context) + (flags cl-mem-flags) + (image-format (:pointer (:struct cl-image-format))) + (image-width :size) + (image-height :size) + (image-row-pitch :size) + (host-ptr (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateImage3D" create-image-3d) cl-mem + (context cl-context) + (flags cl-mem-flags) + (image-format (:pointer (:struct cl-image-format))) + (image-width :size) + (image-height :size) + (image-depth :size) + (image-row-pitch :size) + (image-slice-pitch :size) + (host-ptr (:pointer :void)) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueMarker" enqueue-marker) cl-int + (command-queue cl-command-queue) + (event (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueWaitForEvents" %enqueue-wait-for-events) cl-error-code + (command-queue cl-command-queue) + (num-events cl-uint) + (event-list (:pointer cl-event))) + +(cffi:defcfun ("clEnqueueBarrier" enqueue-barrier) cl-int + (command-queue cl-command-queue)) + +(cffi:defcfun ("clUnloadCompiler" unload-compiler) cl-int) + +(cffi:defcfun ("clGetExtensionFunctionAddress" get-extension-function-address) (:pointer :void) + (func-name :string)) + +;;; Deprecated OpenCL 2.0 APIs + +(cffi:defcfun ("clCreateCommandQueue" %create-command-queue) cl-command-queue + (context cl-context) + (device cl-device-id) + (properties cl-command-queue-properties) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clCreateSampler" create-sampler) cl-sampler + (context cl-context) + (normalized-coords cl-bool) + (addressing-mode cl-addressing-mode) + (filter-mode cl-filter-mode) + (errcode-ret (:pointer cl-int))) + +(cffi:defcfun ("clEnqueueTask" enqueue-task) cl-int + (command-queue cl-command-queue) + (kernel cl-kernel) + (num-events-in-wait-list cl-uint) + (event-wait-list (:pointer cl-event)) + (event (:pointer cl-event))) diff --git a/src/command-queue.lisp b/src/command-queue.lisp new file mode 100644 index 0000000..ec9f89c --- /dev/null +++ b/src/command-queue.lisp @@ -0,0 +1,38 @@ +(in-package #:ocl) + +(defun create-command-queue-with-properties (context device &key queue-properties queue-size) + (let ((properties '(0))) + (when queue-properties + (push (cffi:foreign-bitfield-value 'cl-command-queue-properties queue-properties) properties) + (push :queue-properties properties)) + (when queue-size + (push queue-size properties) + (push :queue-size properties)) + (with-foreign-sequence (c-properties properties 'cl-queue-properties) + (check-error-arg (%create-command-queue-with-properties context device c-properties))))) + +(defun retain-command-queue (command-queue) + (check-error (%retain-command-queue command-queue))) + +(defun release-command-queue (command-queue) + (check-error (%release-command-queue command-queue))) + +(defparameter +command-queue-info-type-alist+ + '((:queue-context . cl-context) + (:queue-device . cl-device-id) + (:queue-reference-count . cl-uint) + (:queue-properties . cl-command-queue-properties) + (:queue-properties-array . (:pointer cl-queue-properties)) + (:queue-size . cl-uint) + (:queue-device-default . cl-command-queue))) + +(wrap-get-info-function get-command-queue-info %get-command-queue-info + +command-queue-info-type-alist+) + +(defmacro with-command-queue ((queue context device &key queue-properties queue-size) &body body) + `(let ((,queue (create-command-queue-with-properties ,context ,device + :queue-properties ,queue-properties + :queue-size ,queue-size))) + (unwind-protect + (progn ,@body) + (release-command-queue ,queue)))) diff --git a/src/constants.lisp b/src/constants.lisp new file mode 100644 index 0000000..58da3f2 --- /dev/null +++ b/src/constants.lisp @@ -0,0 +1,558 @@ +(in-package #:ocl) + +;;; Error Codes +;; (defconstant +success+ 0) +;; (defconstant +device-not-found+ -1) +;; (defconstant +device-not-available+ -2) +;; (defconstant +compiler-not-available+ -3) +;; (defconstant +mem-object-allocation-failure+ -4) +;; (defconstant +out-of-resources+ -5) +;; (defconstant +out-of-host-memory+ -6) +;; (defconstant +profiling-info-not-available+ -7) +;; (defconstant +mem-copy-overlap+ -8) +;; (defconstant +image-format-mismatch+ -9) +;; (defconstant +image-format-not-supported+ -10) +;; (defconstant +build-program-failure+ -11) +;; (defconstant +map-failure+ -12) +;; (defconstant +misaligned-sub-buffer-offset+ -13) +;; (defconstant +exec-status-error-for-events-in-wait-list+ -14) +;; (defconstant +compile-program-failure+ -15) +;; (defconstant +linker-not-available+ -16) +;; (defconstant +link-program-failure+ -17) +;; (defconstant +device-partition-failed+ -18) +;; (defconstant +kernel-arg-info-not-available+ -19) +;; (defconstant +invalid-value+ -30) +;; (defconstant +invalid-device-type+ -31) +;; (defconstant +invalid-platform+ -32) +;; (defconstant +invalid-device+ -33) +;; (defconstant +invalid-context+ -34) +;; (defconstant +invalid-queue-properties+ -35) +;; (defconstant +invalid-command-queue+ -36) +;; (defconstant +invalid-host-ptr+ -37) +;; (defconstant +invalid-mem-object+ -38) +;; (defconstant +invalid-image-format-descriptor+ -39) +;; (defconstant +invalid-image-size+ -40) +;; (defconstant +invalid-sampler+ -41) +;; (defconstant +invalid-binary+ -42) +;; (defconstant +invalid-build-options+ -43) +;; (defconstant +invalid-program+ -44) +;; (defconstant +invalid-program-executable+ -45) +;; (defconstant +invalid-kernel-name+ -46) +;; (defconstant +invalid-kernel-definition+ -47) +;; (defconstant +invalid-kernel+ -48) +;; (defconstant +invalid-arg-index+ -49) +;; (defconstant +invalid-arg-value+ -50) +;; (defconstant +invalid-arg-size+ -51) +;; (defconstant +invalid-kernel-args+ -52) +;; (defconstant +invalid-work-dimension+ -53) +;; (defconstant +invalid-work-group-size+ -54) +;; (defconstant +invalid-work-item-size+ -55) +;; (defconstant +invalid-global-offset+ -56) +;; (defconstant +invalid-event-wait-list+ -57) +;; (defconstant +invalid-event+ -58) +;; (defconstant +invalid-operation+ -59) +;; (defconstant +invalid-gl-object+ -60) +;; (defconstant +invalid-buffer-size+ -61) +;; (defconstant +invalid-mip-level+ -62) +;; (defconstant +invalid-global-work-size+ -63) +;; (defconstant +invalid-property+ -64) +;; (defconstant +invalid-image-descriptor+ -65) +;; (defconstant +invalid-compiler-options+ -66) +;; (defconstant +invalid-linker-options+ -67) +;; (defconstant +invalid-device-partition-count+ -68) +;; (defconstant +invalid-pipe-size+ -69) +;; (defconstant +invalid-device-queue+ -70) +;; (defconstant +invalid-spec-id+ -71) +;; (defconstant +max-size-restriction-exceeded+ -72) + +;;; cl-bool +;; (defconstant +false+ 0) +;; (defconstant +true+ 1) +;; (defconstant +blocking+ +true+) +;; (defconstant +non-blocking+ +false+) + + +;;; cl-platform-info +;; (defconstant +platform-profile+ #x0900) +;; (defconstant +platform-version+ #x0901) +;; (defconstant +platform-name+ #x0902) +;; (defconstant +platform-vendor+ #x0903) +;; (defconstant +platform-extensions+ #x0904) +;; (defconstant +platform-host-timer-resolution+ #x0905) +;; (defconstant +platform-numeric-version+ #x0906) +;; (defconstant +platform-extensions-with-version+ #x0907) + +;;; cl-device-type - bitfield +;; (defconstant +device-type-default+ #x1) +;; (defconstant +device-type-cpu+ #x2) +;; (defconstant +device-type-gpu+ #x4) +;; (defconstant +device-type-accelerator+ #x8) +;; (defconstant +device-type-custom+ #x10) +;; (defconstant +device-type-all+ #xffffffff) + +;;; cl-device-info +;; (defconstant +device-type+ #x1000) +;; (defconstant +device-vendor-id+ #x1001) +;; (defconstant +device-max-compute-units+ #x1002) +;; (defconstant +device-max-work-item-dimensions+ #x1003) +;; (defconstant +device-max-work-group-size+ #x1004) +;; (defconstant +device-max-work-item-sizes+ #x1005) +;; (defconstant +device-preferred-vector-width-char+ #x1006) +;; (defconstant +device-preferred-vector-width-short+ #x1007) +;; (defconstant +device-preferred-vector-width-int+ #x1008) +;; (defconstant +device-preferred-vector-width-long+ #x1009) +;; (defconstant +device-preferred-vector-width-float+ #x100a) +;; (defconstant +device-preferred-vector-width-double+ #x100b) +;; (defconstant +device-max-clock-frequency+ #x100c) +;; (defconstant +device-address-bits+ #x100d) +;; (defconstant +device-max-read-image-args+ #x100e) +;; (defconstant +device-max-write-image-args+ #x100f) +;; (defconstant +device-max-mem-alloc-size+ #x1010) +;; (defconstant +device-image2d-max-width+ #x1011) +;; (defconstant +device-image2d-max-height+ #x1012) +;; (defconstant +device-image3d-max-width+ #x1013) +;; (defconstant +device-image3d-max-height+ #x1014) +;; (defconstant +device-image3d-max-depth+ #x1015) +;; (defconstant +device-image-support+ #x1016) +;; (defconstant +device-max-parameter-size+ #x1017) +;; (defconstant +device-max-samplers+ #x1018) +;; (defconstant +device-mem-base-addr-align+ #x1019) +;; (defconstant +device-min-data-type-align-size+ #x101a) +;; (defconstant +device-single-fp-config+ #x101b) +;; (defconstant +device-global-mem-cache-type+ #x101c) +;; (defconstant +device-global-mem-cacheline-size+ #x101d) +;; (defconstant +device-global-mem-cache-size+ #x101e) +;; (defconstant +device-global-mem-size+ #x101f) +;; (defconstant +device-max-constant-buffer-size+ #x1020) +;; (defconstant +device-max-constant-args+ #x1021) +;; (defconstant +device-local-mem-type+ #x1022) +;; (defconstant +device-local-mem-size+ #x1023) +;; (defconstant +device-error-correction-support+ #x1024) +;; (defconstant +device-profiling-timer-resolution+ #x1025) +;; (defconstant +device-endian-little+ #x1026) +;; (defconstant +device-available+ #x1027) +;; (defconstant +device-compiler-available+ #x1028) +;; (defconstant +device-execution-capabilities+ #x1029) +;; (defconstant +device-queue-properties+ #x102a) +;; (defconstant +device-queue-on-host-properties+ #x102a) +;; (defconstant +device-name+ #x102b) +;; (defconstant +device-vendor+ #x102c) +;; (defconstant +driver-version+ #x102d) +;; (defconstant +device-profile+ #x102e) +;; (defconstant +device-version+ #x102f) +;; (defconstant +device-extensions+ #x1030) +;; (defconstant +device-platform+ #x1031) +;; (defconstant +device-double-fp-config+ #x1032) +;; (defconstant +device-preferred-vector-width-half+ #x1034) +;; (defconstant +device-host-unified-memory+ #x1035) +;; (defconstant +device-native-vector-width-char+ #x1036) +;; (defconstant +device-native-vector-width-short+ #x1037) +;; (defconstant +device-native-vector-width-int+ #x1038) +;; (defconstant +device-native-vector-width-long+ #x1039) +;; (defconstant +device-native-vector-width-float+ #x103a) +;; (defconstant +device-native-vector-width-double+ #x103b) +;; (defconstant +device-native-vector-width-half+ #x103c) +;; (defconstant +device-opencl-c-version+ #x103d) +;; (defconstant +device-linker-available+ #x103e) +;; (defconstant +device-built-in-kernels+ #x103f) +;; (defconstant +device-image-max-buffer-size+ #x1040) +;; (defconstant +device-image-max-array-size+ #x1041) +;; (defconstant +device-parent-device+ #x1042) +;; (defconstant +device-partition-max-sub-devices+ #x1043) +;; (defconstant +device-partition-properties+ #x1044) +;; (defconstant +device-partition-affinity-domain+ #x1045) +;; (defconstant +device-partition-type+ #x1046) +;; (defconstant +device-reference-count+ #x1047) +;; (defconstant +device-preferred-interop-user-sync+ #x1048) +;; (defconstant +device-printf-buffer-size+ #x1049) +;; (defconstant +device-image-pitch-alignment+ #x104a) +;; (defconstant +device-image-base-address-alignment+ #x104b) +;; (defconstant +device-max-read-write-image-args+ #x104c) +;; (defconstant +device-max-global-variable-size+ #x104d) +;; (defconstant +device-queue-on-device-properties+ #x104e) +;; (defconstant +device-queue-on-device-preferred-size+ #x104f) +;; (defconstant +device-queue-on-device-max-size+ #x1050) +;; (defconstant +device-max-on-device-queues+ #x1051) +;; (defconstant +device-max-on-device-events+ #x1052) +;; (defconstant +device-svm-capabilities+ #x1053) +;; (defconstant +device-global-variable-preferred-total-size+ #x1054) +;; (defconstant +device-max-pipe-args+ #x1055) +;; (defconstant +device-pipe-max-active-reservations+ #x1056) +;; (defconstant +device-pipe-max-packet-size+ #x1057) +;; (defconstant +device-preferred-platform-atomic-alignment+ #x1058) +;; (defconstant +device-preferred-global-atomic-alignment+ #x1059) +;; (defconstant +device-preferred-local-atomic-alignment+ #x105a) +;; (defconstant +device-il-version+ #x105b) +;; (defconstant +device-max-num-sub-groups+ #x105c) +;; (defconstant +device-sub-group-independent-forward-progress+ #x105d) +;; (defconstant +device-numeric-version+ #x105e) +;; (defconstant +device-extensions-with-version+ #x1060) +;; (defconstant +device-ils-with-version+ #x1061) +;; (defconstant +device-built-in-kernels-with-version+ #x1062) +;; (defconstant +device-atomic-memory-capabilities+ #x1063) +;; (defconstant +device-atomic-fence-capabilities+ #x1064) +;; (defconstant +device-non-uniform-work-group-support+ #x1065) +;; (defconstant +device-opencl-c-all-versions+ #x1066) +;; (defconstant +device-preferred-work-group-size-multiple+ #x1067) +;; (defconstant +device-work-group-collective-functions-support+ #x1068) +;; (defconstant +device-generic-address-space-support+ #x1069) +;; (defconstant +device-opencl-c-features+ #x106f) +;; (defconstant +device-device-enqueue-capabilities+ #x1070) +;; (defconstant +device-pipe-support+ #x1071) +;; (defconstant +device-latest-conformance-version-passed+ #x1072) + +;;; cl-device-fp-config - bitfield +;; (defconstant +fp-denorm+ #x1) +;; (defconstant +fp-inf-nan+ #x2) +;; (defconstant +fp-round-to-nearest+ #x4) +;; (defconstant +fp-round-to-zero+ #x8) +;; (defconstant +fp-round-to-inf+ #x10) +;; (defconstant +fp-fma+ #x20) +;; (defconstant +fp-soft-float+ #x40) +;; (defconstant +fp-correctly-rounded-divide-sqrt+ #x80) + +;;; cl-device-mem-cache-type +;; (defconstant +none+ #x0) +;; (defconstant +read-only-cache+ #x1) +;; (defconstant +read-write-cache+ #x2) + +;;; cl-device-local-mem-type +;; (defconstant +local+ #x1) +;; (defconstant +global+ #x2) + +;;; cl-device-exec-capabilities - bitfield +;; (defconstant +exec-kernel+ #x1) +;; (defconstant +exec-native-kernel+ #x2) + +;;; cl-command-queue-properties - bitfield +;; (defconstant +queue-out-of-order-exec-mode-enable+ #x1) +;; (defconstant +queue-profiling-enable+ #x2) +;; (defconstant +queue-on-device+ #x4) +;; (defconstant +queue-on-device-default+ #x8) + +;;; cl-context-info +;; (defconstant +context-reference-count+ #x1080) +;; (defconstant +context-devices+ #x1081) +;; (defconstant +context-properties+ #x1082) +;; (defconstant +context-num-devices+ #x1083) + +;;; cl-context-properties +;; (defconstant +context-platform+ #x1084) +;; (defconstant +context-interop-user-sync+ #x1085) + +;;; cl-device-partition-property +(defconstant +device-partition-equally+ #x1086) +(defconstant +device-partition-by-counts+ #x1087) +(defconstant +device-partition-by-counts-list-end+ #x0) +(defconstant +device-partition-by-affinity-domain+ #x1088) + + +;;; cl-device-affinity-domain +;; (defconstant +device-affinity-domain-numa+ #x1) +;; (defconstant +device-affinity-domain-l4-cache+ #x2) +;; (defconstant +device-affinity-domain-l3-cache+ #x4) +;; (defconstant +device-affinity-domain-l2-cache+ #x8) +;; (defconstant +device-affinity-domain-l1-cache+ #x10) +;; (defconstant +device-affinity-domain-next-partitionable+ #x20) + +;;; cl-device-svm-capabilities +;; (defconstant +device-svm-coarse-grain-buffer+ #x1) +;; (defconstant +device-svm-fine-grain-buffer+ #x2) +;; (defconstant +device-svm-fine-grain-system+ #x4) +;; (defconstant +device-svm-atomics+ #x8) + +;;; cl-command-queue-info +;; (defconstant +queue-context+ #x1090) +;; (defconstant +queue-device+ #x1091) +;; (defconstant +queue-reference-count+ #x1092) +;; (defconstant +queue-properties+ #x1093) +;; (defconstant +queue-size+ #x1094) +;; (defconstant +queue-device-default+ #x1095) +;; (defconstant +queue-properties-array+ #x1098) + +;;; cl-mem-flags and cl-svm-mem-flags - bitfield +(defconstant +mem-read-write+ #x1) +(defconstant +mem-write-only+ #x2) +(defconstant +mem-read-only+ #x4) +(defconstant +mem-use-host-ptr+ #x8) +(defconstant +mem-alloc-host-ptr+ #x10) +(defconstant +mem-copy-host-ptr+ #x20) +(defconstant +mem-host-write-only+ #x80) +(defconstant +mem-host-read-only+ #x100) +(defconstant +mem-host-no-access+ #x200) +(defconstant +mem-svm-fine-grain-buffer+ #x400) +(defconstant +mem-svm-atomics+ #x800) +(defconstant +mem-kernel-read-and-write+ #x1000) + + +;;; cl-mem-migration-flags - bitfield +;; (defconstant +migrate-mem-object-host+ #x1) +;; (defconstant +migrate-mem-object-content-undefined+ #x2) + +;;; cl-channel-order +;; (defconstant +r+ #x10b0) +;; (defconstant +a+ #x10b1) +;; (defconstant +rg+ #x10b2) +;; (defconstant +ra+ #x10b3) +;; (defconstant +rgb+ #x10b4) +;; (defconstant +rgba+ #x10b5) +;; (defconstant +bgra+ #x10b6) +;; (defconstant +argb+ #x10b7) +;; (defconstant +intensity+ #x10b8) +;; (defconstant +luminance+ #x10b9) +;; (defconstant +rx+ #x10ba) +;; (defconstant +rgx+ #x10bb) +;; (defconstant +rgbx+ #x10bc) +;; (defconstant +depth+ #x10bd) +;; (defconstant +depth-stencil+ #x10be) +;; (defconstant +srgb+ #x10bf) +;; (defconstant +srgbx+ #x10c0) +;; (defconstant +srgba+ #x10c1) +;; (defconstant +sbgra+ #x10c2) +;; (defconstant +abgr+ #x10c3) + +;;; cl-channel-type +;; (defconstant +snorm-int8+ #x10d0) +;; (defconstant +snorm-int16+ #x10d1) +;; (defconstant +unorm-int8+ #x10d2) +;; (defconstant +unorm-int16+ #x10d3) +;; (defconstant +unorm-short-565+ #x10d4) +;; (defconstant +unorm-short-555+ #x10d5) +;; (defconstant +unorm-int-101010+ #x10d6) +;; (defconstant +signed-int8+ #x10d7) +;; (defconstant +signed-int16+ #x10d8) +;; (defconstant +signed-int32+ #x10d9) +;; (defconstant +unsigned-int8+ #x10da) +;; (defconstant +unsigned-int16+ #x10db) +;; (defconstant +unsigned-int32+ #x10dc) +;; (defconstant +half-float+ #x10dd) +;; (defconstant +float+ #x10de) +;; (defconstant +unorm-int24+ #x10df) +;; (defconstant +unorm-int-101010-2+ #x10e0) + +;;; cl-mem-object-type +;; (defconstant +mem-object-buffer+ #x10f0) +;; (defconstant +mem-object-image2d+ #x10f1) +;; (defconstant +mem-object-image3d+ #x10f2) +;; (defconstant +mem-object-image2d-array+ #x10f3) +;; (defconstant +mem-object-image1d+ #x10f4) +;; (defconstant +mem-object-image1d-array+ #x10f5) +;; (defconstant +mem-object-image1d-buffer+ #x10f6) +;; (defconstant +mem-object-pipe+ #x10f7) + +;;; cl-mem-info +;; (defconstant +mem-type+ #x1100) +;; (defconstant +mem-flags+ #x1101) +;; (defconstant +mem-size+ #x1102) +;; (defconstant +mem-host-ptr+ #x1103) +;; (defconstant +mem-map-count+ #x1104) +;; (defconstant +mem-reference-count+ #x1105) +;; (defconstant +mem-context+ #x1106) +;; (defconstant +mem-associated-memobject+ #x1107) +;; (defconstant +mem-offset+ #x1108) +;; (defconstant +mem-uses-svm-pointer+ #x1109) +;; (defconstant +mem-properties+ #x110a) + +;;; cl-image-info +;; (defconstant +image-format+ #x1110) +;; (defconstant +image-element-size+ #x1111) +;; (defconstant +image-row-pitch+ #x1112) +;; (defconstant +image-slice-pitch+ #x1113) +;; (defconstant +image-width+ #x1114) +;; (defconstant +image-height+ #x1115) +;; (defconstant +image-depth+ #x1116) +;; (defconstant +image-array-size+ #x1117) +;; (defconstant +image-buffer+ #x1118) +;; (defconstant +image-num-mip-levels+ #x1119) +;; (defconstant +image-num-samples+ #x111a) + +;;; cl-pipe-info +;; (defconstant +pipe-packet-size+ #x1120) +;; (defconstant +pipe-max-packets+ #x1121) +;; (defconstant +pipe-properties+ #x1122) + +;;; cl-addressing-mode +;; (defconstant +address-none+ #x1130) +;; (defconstant +address-clamp-to-edge+ #x1131) +;; (defconstant +address-clamp+ #x1132) +;; (defconstant +address-repeat+ #x1133) +;; (defconstant +address-mirrored-repeat+ #x1134) + +;;; cl-filter-mode +;; (defconstant +filter-nearest+ #x1140) +;; (defconstant +filter-linear+ #x1141) + +;;; cl-sampler-info +;; (defconstant +sampler-reference-count+ #x1150) +;; (defconstant +sampler-context+ #x1151) +;; (defconstant +sampler-normalized-coords+ #x1152) +;; (defconstant +sampler-addressing-mode+ #x1153) +;; (defconstant +sampler-filter-mode+ #x1154) +;; (defconstant +sampler-mip-filter-mode+ #x1155) +;; (defconstant +sampler-lod-min+ #x1156) +;; (defconstant +sampler-lod-max+ #x1157) +;; (defconstant +sampler-properties+ #x1158) + + +;;; cl-map-flags - bitfield +;; (defconstant +map-read+ #x1) +;; (defconstant +map-write+ #x2) +;; (defconstant +map-write-invalidate-region+ #x4) + +;;; cl-program-info +;; (defconstant +program-reference-count+ #x1160) +;; (defconstant +program-context+ #x1161) +;; (defconstant +program-num-devices+ #x1162) +;; (defconstant +program-devices+ #x1163) +;; (defconstant +program-source+ #x1164) +;; (defconstant +program-binary-sizes+ #x1165) +;; (defconstant +program-binaries+ #x1166) +;; (defconstant +program-num-kernels+ #x1167) +;; (defconstant +program-kernel-names+ #x1168) +;; (defconstant +program-il+ #x1169) +;; (defconstant +program-scope-global-ctors-present+ #x116a) +;; (defconstant +program-scope-global-dtors-present+ #x116b) + +;;; cl-program-build-info +;; (defconstant +program-build-status+ #x1181) +;; (defconstant +program-build-options+ #x1182) +;; (defconstant +program-build-log+ #x1183) +;; (defconstant +program-binary-type+ #x1184) +;; (defconstant +program-build-global-variable-total-size+ #x1185) + +;;; cl-program-binary-type +;; (defconstant +program-binary-type-none+ #x0) +;; (defconstant +program-binary-type-compiled-object+ #x1) +;; (defconstant +program-binary-type-library+ #x2) +;; (defconstant +program-binary-type-executable+ #x4) + +;;; cl-build-status +;; (defconstant +build-success+ 0) +;; (defconstant +build-none+ -1) +;; (defconstant +build-error+ -2) +;; (defconstant +build-in-progress+ -3) + +;; cl-kernel-info +;; (defconstant +kernel-function-name+ #x1190) +;; (defconstant +kernel-num-args+ #x1191) +;; (defconstant +kernel-reference-count+ #x1192) +;; (defconstant +kernel-context+ #x1193) +;; (defconstant +kernel-program+ #x1194) +;; (defconstant +kernel-attributes+ #x1195) + +;;; cl-kernel-arg-info +;; (defconstant +kernel-arg-address-qualifier+ #x1196) +;; (defconstant +kernel-arg-access-qualifier+ #x1197) +;; (defconstant +kernel-arg-type-name+ #x1198) +;; (defconstant +kernel-arg-type-qualifier+ #x1199) +;; (defconstant +kernel-arg-name+ #x119a) + +;;; cl-kernel-arg-address-qualifier +;; (defconstant +kernel-arg-address-global+ #x119b) +;; (defconstant +kernel-arg-address-local+ #x119c) +;; (defconstant +kernel-arg-address-constant+ #x119d) +;; (defconstant +kernel-arg-address-private+ #x119e) + +;;; cl-kernel-arg-access-qualifier +;; (defconstant +kernel-arg-access-read-only+ #x11a0) +;; (defconstant +kernel-arg-access-write-only+ #x11a1) +;; (defconstant +kernel-arg-access-read-write+ #x11a2) +;; (defconstant +kernel-arg-access-none+ #x11a3) + +;;; cl-kernel-arg-type-qualifier +;; (defconstant +kernel-arg-type-none+ #x0) +;; (defconstant +kernel-arg-type-const+ #x1) +;; (defconstant +kernel-arg-type-restrict+ #x2) +;; (defconstant +kernel-arg-type-volatile+ #x4) +;; (defconstant +kernel-arg-type-pipe+ #x8) + +;;; cl-kernel-work-group-info +;; (defconstant +kernel-work-group-size+ #x11b0) +;; (defconstant +kernel-compile-work-group-size+ #x11b1) +;; (defconstant +kernel-local-mem-size+ #x11b2) +;; (defconstant +kernel-preferred-work-group-size-multiple+ #x11b3) +;; (defconstant +kernel-private-mem-size+ #x11b4) +;; (defconstant +kernel-global-work-size+ #x11b5) + +;;; cl-kernel-sub-group-info +;; (defconstant +kernel-max-sub-group-size-for-ndrange+ #x2033) +;; (defconstant +kernel-sub-group-count-for-ndrange+ #x2034) +;; (defconstant +kernel-local-size-for-sub-group-count+ #x11b8) +;; (defconstant +kernel-max-num-sub-groups+ #x11b9) +;; (defconstant +kernel-compile-num-sub-groups+ #x11ba) + +;;; cl-kernel-exec-info +;; (defconstant +kernel-exec-info-svm-ptrs+ #x11b6) +;; (defconstant +kernel-exec-info-svm-fine-grain-system+ #x11b7) + +;;; cl-event-info +;; (defconstant +event-command-queue+ #x11d0) +;; (defconstant +event-command-type+ #x11d1) +;; (defconstant +event-reference-count+ #x11d2) +;; (defconstant +event-command-execution-status+ #x11d3) +;; (defconstant +event-context+ #x11d4) + +;;; cl-command-type +;; (defconstant +command-ndrange-kernel+ #x11f0) +;; (defconstant +command-task+ #x11f1) +;; (defconstant +command-native-kernel+ #x11f2) +;; (defconstant +command-read-buffer+ #x11f3) +;; (defconstant +command-write-buffer+ #x11f4) +;; (defconstant +command-copy-buffer+ #x11f5) +;; (defconstant +command-read-image+ #x11f6) +;; (defconstant +command-write-image+ #x11f7) +;; (defconstant +command-copy-image+ #x11f8) +;; (defconstant +command-copy-image-to-buffer+ #x11f9) +;; (defconstant +command-copy-buffer-to-image+ #x11fa) +;; (defconstant +command-map-buffer+ #x11fb) +;; (defconstant +command-map-image+ #x11fc) +;; (defconstant +command-unmap-mem-object+ #x11fd) +;; (defconstant +command-marker+ #x11fe) +;; (defconstant +command-acquire-gl-objects+ #x11ff) +;; (defconstant +command-release-gl-objects+ #x1200) +;; (defconstant +command-read-buffer-rect+ #x1201) +;; (defconstant +command-write-buffer-rect+ #x1202) +;; (defconstant +command-copy-buffer-rect+ #x1203) +;; (defconstant +command-user+ #x1204) +;; (defconstant +command-barrier+ #x1205) +;; (defconstant +command-migrate-mem-objects+ #x1206) +;; (defconstant +command-fill-buffer+ #x1207) +;; (defconstant +command-fill-image+ #x1208) +;; (defconstant +command-svm-free+ #x1209) +;; (defconstant +command-svm-memcpy+ #x120a) +;; (defconstant +command-svm-memfill+ #x120b) +;; (defconstant +command-svm-map+ #x120c) +;; (defconstant +command-svm-unmap+ #x120d) +;; (defconstant +command-svm-migrate-mem+ #x120e) + +;;; command execution status +;; (defconstant +complete+ #x0) +;; (defconstant +running+ #x1) +;; (defconstant +submitted+ #x2) +;; (defconstant +queued+ #x3) + +;;; cl-buffer-create-type +;;(defconstant +buffer-create-type-region+ #x1220) + +;;; cl-profiling-info +;; (defconstant +profiling-command-queued+ #x1280) +;; (defconstant +profiling-command-submit+ #x1281) +;; (defconstant +profiling-command-start+ #x1282) +;; (defconstant +profiling-command-end+ #x1283) +;; (defconstant +profiling-command-complete+ #x1284) + +;;; cl-device-atomic-capabilities - bitfield +;; (defconstant +device-atomic-order-relaxed+ #x01) +;; (defconstant +device-atomic-order-acq-rel+ #x02) +;; (defconstant +device-atomic-order-seq-cst+ #x04) +;; (defconstant +device-atomic-scope-work-item+ #x08) +;; (defconstant +device-atomic-scope-work-group+ #x10) +;; (defconstant +device-atomic-scope-device+ #x20) +;; (defconstant +device-atomic-scope-all-devices+ #x40) + +;;; cl-device-device-enqueue-capabilities - bitfield +;; (defconstant +device-queue-supported+ #x1) +;; (defconstant +device-queue-replaceable-default+ #x2) + +;;; cl-khronos-vendor-id +;; (defconstant +khronos-vendor-id-codeplay+ #x10004) diff --git a/src/context.lisp b/src/context.lisp new file mode 100644 index 0000000..45dc9b3 --- /dev/null +++ b/src/context.lisp @@ -0,0 +1,49 @@ +(in-package #:ocl) + +(defun create-context (devices &key platform iterop-user-sync-p) + (let ((properties '(0))) + (when iterop-user-sync-p + (push 1 properties) + (push :context-interop-user-sync properties)) + (when platform + (push (cffi:pointer-address platform) properties) + (push :context-platform properties)) + (with-foreign-sequences ((c-properties properties 'cl-context-properties) + (c-devices devices 'cl-device-id num-devices)) + (check-error-arg + (%create-context c-properties num-devices c-devices (cffi:null-pointer) + (cffi:null-pointer)))))) + +(defun create-context-from-type (device-type &key platform iterop-user-sync-p + (pfn-notify (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (let ((properties '(0))) + (when iterop-user-sync-p + (push 1 properties) + (push :context-interop-user-sync properties)) + (when platform + (push (cffi:pointer-address platform) properties) + (push :context-platform properties)) + (with-foreign-sequences ((c-properties properties 'cl-context-properties)) + (check-error-arg + (%create-context-from-type c-properties device-type pfn-notify user-data))))) + +(defun retain-context (context) + (check-error (%retain-context context))) + +(defun release-context (context) + (check-error (%release-context context))) + +(defparameter +context-info-type-alist+ + '((:context-reference-count . cl-uint) + (:context-num-devices . cl-uint) + (:context-devices . (:pointer cl-device-id)) + (:context-properties . (:pointer cl-context-properties)))) + +(wrap-get-info-function get-context-info %get-context-info +context-info-type-alist+) + +(defmacro with-context ((context devices &rest options) &body body) + `(let ((,context (create-context ,devices ,@options))) + (unwind-protect + (progn ,@body) + (release-context ,context)))) diff --git a/src/deprecated.lisp b/src/deprecated.lisp new file mode 100644 index 0000000..ea835fe --- /dev/null +++ b/src/deprecated.lisp @@ -0,0 +1,4 @@ +(in-package #:ocl) + +(defun create-command-queue (context device properties) + (check-error-arg (%create-command-queue context device properties))) diff --git a/src/device.lisp b/src/device.lisp new file mode 100644 index 0000000..830ee82 --- /dev/null +++ b/src/device.lisp @@ -0,0 +1,176 @@ +(in-package #:ocl) + +(defun get-device-ids (platform device-type) + (let (num-devices) + (cffi:with-foreign-object (c-num-devices 'cl-uint) + (check-error (%get-device-ids platform device-type 0 (cffi:null-pointer) c-num-devices)) + (setf num-devices (cffi:mem-ref c-num-devices 'cl-uint))) + (cffi:with-foreign-object (c-devices 'cl-device-id num-devices) + (check-error (%get-device-ids platform device-type num-devices c-devices (cffi:null-pointer))) + (loop :for i :below num-devices + :collect (cffi:mem-aref c-devices 'cl-device-id i))))) + +(defparameter +device-info-type-alist+ + '((:device-type . cl-device-type) + (:device-vendor-id . cl-uint) + (:device-max-compute-units . cl-uint) + (:device-max-work-item-dimensions . cl-uint) + (:device-max-work-group-size . :size) + (:device-max-work-item-sizes . (:pointer :size)) + (:device-preferred-vector-width-char . cl-uint) + (:device-preferred-vector-width-short . cl-uint) + (:device-preferred-vector-width-int . cl-uint) + (:device-preferred-vector-width-long . cl-uint) + (:device-preferred-vector-width-float . cl-uint) + (:device-preferred-vector-width-double . cl-uint) + (:device-max-clock-frequency . cl-uint) + (:device-address-bits . cl-uint) + (:device-max-read-image-args . cl-uint) + (:device-max-write-image-args . cl-uint) + (:device-max-mem-alloc-size . cl-ulong) + (:device-image2d-max-width . :size) + (:device-image2d-max-height . :size) + (:device-image3d-max-width . :size) + (:device-image3d-max-height . :size) + (:device-image3d-max-depth . :size) + (:device-image-support . cl-bool) + (:device-max-parameter-size . :size) + (:device-max-samplers . cl-uint) + (:device-mem-base-addr-align . cl-uint) + (:device-min-data-type-align-size . cl-uint) + (:device-single-fp-config . cl-device-fp-config) + (:device-global-mem-cache-type . cl-device-mem-cache-type) + (:device-global-mem-cacheline-size . cl-uint) + (:device-global-mem-cache-size . cl-ulong) + (:device-global-mem-size . cl-ulong) + (:device-max-constant-buffer-size . cl-ulong) + (:device-max-constant-args . cl-uint) + (:device-local-mem-type . cl-device-local-mem-type) + (:device-local-mem-size . cl-ulong) + (:device-error-correction-support . cl-bool) + (:device-profiling-timer-resolution . :size) + (:device-endian-little . cl-bool) + (:device-available . cl-bool) + (:device-compiler-available . cl-bool) + (:device-execution-capabilities . cl-device-exec-capabilities) + (:device-queue-properties . cl-command-queue-properties) + (:device-queue-on-host-properties . cl-command-queue-properties) + (:device-name . :string) + (:device-vendor . :string) + (:driver-version . :string) + (:device-profile . :string) + (:device-version . :string) + (:device-extensions . :string) + (:device-platform . cl-platform-id) + (:device-double-fp-config . cl-device-fp-config) + (:device-preferred-vector-width-half . cl-uint) + (:device-host-unified-memory . cl-bool) + (:device-native-vector-width-char . cl-uint) + (:device-native-vector-width-short . cl-uint) + (:device-native-vector-width-int . cl-uint) + (:device-native-vector-width-long . cl-uint) + (:device-native-vector-width-float . cl-uint) + (:device-native-vector-width-double . cl-uint) + (:device-native-vector-width-half . cl-uint) + (:device-opencl-c-version . :string) + (:device-linker-available . cl-bool) + (:device-built-in-kernels . :string) + (:device-image-max-buffer-size . :size) + (:device-image-max-array-size . :size) + (:device-parent-device . cl-device-id) + (:device-partition-max-sub-devices . cl-uint) + (:device-partition-properties . (:pointer cl-device-partition-property)) + (:device-partition-affinity-domain . cl-device-affinity-domain) + (:device-partition-type . (:pointer cl-device-partition-property)) + (:device-reference-count . cl-uint) + (:device-preferred-interop-user-sync . cl-bool) + (:device-printf-buffer-size . :size) + (:device-image-pitch-alignment . cl-uint) + (:device-image-base-address-alignment . cl-uint) + (:device-max-read-write-image-args . cl-uint) + (:device-max-global-variable-size . :size) + (:device-queue-on-device-properties . cl-command-queue-properties) + (:device-queue-on-device-preferred-size . cl-uint) + (:device-queue-on-device-max-size . cl-uint) + (:device-max-on-device-queues . cl-uint) + (:device-max-on-device-events . cl-uint) + (:device-svm-capabilities . cl-device-svm-capabilities) + (:device-global-variable-preferred-total-size . :size) + (:device-max-pipe-args . cl-uint) + (:device-pipe-max-active-reservations . cl-uint) + (:device-pipe-max-packet-size . cl-uint) + (:device-preferred-platform-atomic-alignment . cl-uint) + (:device-preferred-global-atomic-alignment . cl-uint) + (:device-preferred-local-atomic-alignment . cl-uint) + (:device-il-version . :string) + (:device-max-num-sub-groups . cl-uint) + (:device-sub-group-independent-forward-progress . cl-bool) + (:device-numeric-version . cl-version) + (:device-extensions-with-version . (:pointer cl-name-version)) + (:device-ils-with-version . (:pointer cl-name-version)) + (:device-built-in-kernels-with-version . (:pointer cl-name-version)) + (:device-atomic-memory-capabilities . cl-device-atomic-capabilities) + (:device-atomic-fence-capabilities . cl-device-atomic-capabilities) + (:device-non-uniform-work-group-support . cl-bool) + (:device-opencl-c-all-versions . (:pointer cl-name-version)) + (:device-preferred-work-group-size-multiple . :size) + (:device-work-group-collective-functions-support . cl-bool) + (:device-generic-address-space-support . cl-bool) + (:device-opencl-c-features . (:pointer cl-name-version)) + (:device-device-enqueue-capabilities . cl-device-device-enqueue-capabilities) + (:device-pipe-support . cl-bool) + (:device-latest-conformance-version-passed . :string))) + +(wrap-get-info-function get-device-info %get-device-info +device-info-type-alist+) + +;; (defun get-device-info (device param-name) +;; (let ((type (assoc-value +device-info-type-alist+ param-name)) +;; (return-size nil) +;; (error-code nil) +;; (return-value nil)) +;; (cffi:with-foreign-object (c-return-size :size) +;; (setf error-code (%get-device-info device param-name 0 (cffi:null-pointer) c-return-size)) +;; (unless (eq error-code :success) +;; (error 'opencl-error :code error-code)) +;; (setf return-size (cffi:mem-ref c-return-size :size))) +;; (cond ((vector-type-p type) +;; (let ((count (/ return-size (cffi:foreign-type-size (second type))))) +;; (cffi:with-foreign-object (c-value type count) +;; (setf error-code (%get-device-info device param-name return-size c-value (cffi:null-pointer))) +;; (setf return-value (loop :for i :below count :collect (cffi:mem-aref c-value type i))) ))) +;; ((string-type-p type) +;; (setf return-value +;; (cffi:with-foreign-pointer-as-string (c-string return-size) +;; (setf error-code (%get-device-info device param-name return-size c-string (cffi:null-pointer)))))) +;; (t +;; (cffi:with-foreign-object (c-value type) +;; (setf error-code (%get-device-info device param-name (cffi:foreign-type-size type) +;; c-value (cffi:null-pointer))) +;; (setf return-value (cffi:mem-ref c-value type))))) +;; (unless (eq error-code :success) +;; (error 'opencl-error :code error-code)) +;; return-value)) + +;; (defun create-sub-devices (in-device properties) +;; (check-error (%create-sub-devices in-device ))) + +(defun retain-device (device) + (check-error (%retain-device device))) + +(defun release-device (device) + (check-error (%release-device device))) + +(defun set-default-device-command-queue (context device command-queue) + (check-error (%set-default-device-command-queue context device command-queue))) + +(defun get-device-and-host-timer (device) + (cffi:with-foreign-objects ((device-timestamp 'cl-ulong) + (host-timestamp 'cl-ulong)) + (check-error (%get-device-and-host-timer device device-timestamp host-timestamp)) + (values (cffi:mem-ref device-timestamp 'cl-ulong) + (cffi:mem-ref host-timestamp 'cl-ulong)))) + +(defun get-host-timer (device) + (cffi:with-foreign-object (host-timestamp 'cl-ulong) + (check-error (%get-host-timer device host-timestamp)) + (cffi:mem-ref host-timestamp 'cl-ulong))) diff --git a/src/enqueue.lisp b/src/enqueue.lisp new file mode 100644 index 0000000..d26f1c3 --- /dev/null +++ b/src/enqueue.lisp @@ -0,0 +1,77 @@ +(in-package #:ocl) + +;; once-only really needed? +;; gensym really needed? +(defmacro wrap-enqueue (form event-wait-list) + "" + (let ((num-events-in-wait-list (gensym "NUM-EVENTS-IN-WAIT-LIST")) + (c-event-wait-list (gensym "C-EVENT-WAIT-LIST")) + (c-event (gensym "C-EVENT")) + (i (gensym "I"))) + (alexandria:once-only (event-wait-list) + `(let ((,num-events-in-wait-list (length ,event-wait-list))) + (cffi:with-foreign-object (,c-event 'cl-event) + (if (zerop ,num-events-in-wait-list) + (check-error (,@form 0 (cffi:null-pointer) ,c-event)) + (cffi:with-foreign-object (,c-event-wait-list 'cl-event ,num-events-in-wait-list) + (dotimes (,i ,num-events-in-wait-list) + (setf (cffi:mem-aref ,c-event-wait-list 'cl-event ,i) (elt ,event-wait-list ,i))) + (check-error (,@form ,num-events-in-wait-list ,c-event-wait-list ,c-event)) + (cffi:mem-ref ,c-event 'cl-event)))))))) + +(defun enqueue-read-buffer (command-queue buffer blocking-read offset size ptr &optional event-wait-list) + (wrap-enqueue (%enqueue-read-buffer command-queue buffer (if blocking-read :true :false) offset size ptr) + event-wait-list)) + +;; TODO: Check dimensions? +(defun enqueue-nd-range-kernel (queue kernel global-work-offset global-work-size + local-work-size &optional event-wait-list) + (setf global-work-offset (alexandria:ensure-list global-work-offset) + global-work-size (alexandria:ensure-list global-work-size) + local-work-size (alexandria:ensure-list local-work-size)) + ;; (assert (length global-work-size) ...) + (let ((work-dim (length global-work-size))) + (with-foreign-sequences ((c-global-work-offset global-work-offset :size) + (c-global-work-size global-work-size :size) + (c-local-work-size local-work-size :size)) + (wrap-enqueue (%enqueue-nd-range-kernel queue kernel work-dim + c-global-work-offset c-global-work-size + c-local-work-size) + event-wait-list)))) + +(defun enqueue-svm-free (command-queue svm-pointers &optional event-wait-list + (pfn-free-func (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (with-foreign-sequence (c-svm-pointers svm-pointers '(:pointer :void) num-svm-pointers) + (wrap-enqueue + (%enqueue-svm-free command-queue num-svm-pointers c-svm-pointers + pfn-free-func user-data) + event-wait-list))) + +(defun enqueue-svm-memcpy (command-queue blocking-copy-p dst-ptr src-ptr size + &optional event-wait-list) + (wrap-enqueue + (%enqueue-svm-memcpy command-queue (if blocking-copy-p :true :false) dst-ptr src-ptr size) + event-wait-list)) + +(defun enqueue-svm-memfill (command-queue svm-ptr pattern pattern-size size + &optional event-wait-list) + (wrap-enqueue + (%enqueue-svm-memfill command-queue svm-ptr pattern pattern-size size) + event-wait-list)) + +(defun enqueue-svm-map (command-queue blocking-map-p flags svm-ptr size + &optional event-wait-list) + (wrap-enqueue + (%enqueue-svm-map command-queue (if blocking-map-p :true :false) flags svm-ptr size) + event-wait-list)) + +(defun enqueue-svm-unmap (command-queue svm-ptr &optional event-wait-list) + (wrap-enqueue (%enqueue-svm-unmap command-queue svm-ptr) event-wait-list)) + +(defun enqueue-svm-migrate-mem (command-queue svm-pointers sizes flags &optional event-wait-list) + (assert (or (emptyp sizes) (length= svm-pointers sizes))) + (with-foreign-sequences ((c-svm-pointers svm-pointers '(:pointer :void) num-svm-pointers) + (c-sizes sizes :size)) + (wrap-enqueue (%enqueue-svm-migrate-mem command-queue num-svm-pointers c-svm-pointers c-sizes flags) + event-wait-list))) diff --git a/src/event.lisp b/src/event.lisp new file mode 100644 index 0000000..fb6e98a --- /dev/null +++ b/src/event.lisp @@ -0,0 +1,26 @@ +(in-package #:ocl) + +(defun wait-for-events (event-list) + (with-foreign-sequence (c-event-list event-list 'cl-event num-events) + (check-error (%wait-for-events num-events c-event-list)))) + +(defun create-user-event (context) + (check-error-arg (%create-user-event context))) + +(defparameter +event-info-type-alist+ + '((:event-command-queue . cl-command-queue) + (:event-context . cl-context) + (:event-command-type . cl-command-type) + (:event-command-execution-status . cl-int) + (:event-reference-count . cl-uint))) + +(wrap-get-info-function get-event-info %get-event-info +event-info-type-alist+) + +(defun retain-event (event) + (check-error (%retain-event event))) + +(defun release-event (event) + (check-error (%release-event event))) + +(defun set-user-event-status (event execution-status) + (check-error (%set-user-event-status event execution-status))) diff --git a/src/extensions.lisp b/src/extensions.lisp new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/src/extensions.lisp diff --git a/src/flush.lisp b/src/flush.lisp new file mode 100644 index 0000000..4ab282b --- /dev/null +++ b/src/flush.lisp @@ -0,0 +1,7 @@ +(in-package #:ocl) + +(defun flush (command-queue) + (check-error (%flush command-queue))) + +(defun finish (command-queue) + (check-error (%finish command-queue))) diff --git a/src/kernel.lisp b/src/kernel.lisp new file mode 100644 index 0000000..65bc066 --- /dev/null +++ b/src/kernel.lisp @@ -0,0 +1,61 @@ +(in-package #:ocl) + +(defun create-kernel (program kernel-name) + (check-error-arg (%create-kernel program kernel-name))) + +(get-cl-objects create-kernels-in-program (program) + %create-kernels-in-program 'cl-kernel) + +(defun clone-kernel (source-kernel) + (check-error-arg (%clone-kernel source-kernel))) + +(defun retain-kernel (kernel) + (check-error (%retain-kernel kernel))) + +(defun release-kernel (kernel) + (check-error (%release-kernel kernel))) + +(defmacro with-kernel ((kernel program name) &body body) + `(let ((,kernel (create-kernel ,program ,name))) + (unwind-protect + (progn ,@body) + (release-kernel ,kernel)))) + +(defun set-kernel-arg (kernel arg-index arg-type arg-value) + (cffi:with-foreign-pointer (value (cffi:foreign-type-size arg-type) size) + (setf (cffi:mem-ref value arg-type) arg-value) + (check-error (%set-kernel-arg kernel arg-index size value)))) + +(defparameter +kernel-info-type-alist+ + '((:kernel-function-name . :string) + (:kernel-num-args . cl-uint) + (:kernel-reference-count . cl-uint) + (:kernel-context . cl-context) + (:kernel-program . cl-program) + (:kernel-attributes . :string))) + +(wrap-get-info-function get-kernel-info %get-kernel-info +kernel-info-type-alist+) + +(defparameter +kernel-arg-info-type-alist+ + '((:kernel-arg-address-qualifier . cl-kernel-arg-address-qualifier) + (:kernel-arg-access-qualifier . cl-kernel-arg-access-qualifier) + (:kernel-arg-type-name . :string) + (:kernel-arg-type-qualifier . cl-kernel-arg-type-qualifier) + (:kernel-arg-name . :string))) + +;; %get-kernel-arg-info + +(defparameter +kernel-work-group-info-type-alist+ + '((:kernel-global-work-size . (:pointer :size)) + (:kernel-work-group-size . :size) + (:kernel-compile-work-group-size . (:pointer :size)) + (:kernel-local-mem-size . cl-ulong) + (:kernel-preferred-work-group-size-multiple . :size) + (:kernel-private-mem-size . cl-ulong))) + +;; %get-kernel-work-group-info + +;; (defparameter +kernel-sub-group-info-type-alist+ +;; '(())) + +;; %get-kernel-sub-group-info diff --git a/src/memory.lisp b/src/memory.lisp new file mode 100644 index 0000000..f6ab419 --- /dev/null +++ b/src/memory.lisp @@ -0,0 +1,89 @@ +(in-package #:ocl) + +(defun create-buffer (context flags size &optional (host-ptr (cffi:null-pointer))) + (check-error-arg (%create-buffer context flags size host-ptr))) + +;; TODO: Support multi-dimensional arrays? row-major? +(defun create-buffer-from-array (context flags array) + (let* ((length (length array)) + (c-type (array-foreign-type array)) + (size (* length (cffi:foreign-type-size c-type)))) + (cffi:with-foreign-array (c-array array (list :array c-type length)) + (check-error-arg (%create-buffer context flags size c-array))))) + +(defun create-pipe (context flags packet-size max-packets &key properties) + (declare (ignorable properties)) + (check-error-arg + (%create-pipe context flags packet-size max-packets (cffi:null-pointer)))) + +(defun retain-mem-object (memobj) + (check-error (%retain-mem-object memobj))) + +(defun release-mem-object (memobj) + (check-error (%release-mem-object memobj))) + +(get-cl-objects get-supported-image-formats (context flags image-type) + %get-supported-image-formats 'cl-image-format) + +(defparameter +mem-object-info-type-alist+ + '((:mem-type . cl-mem-object-type) + (:mem-flags . cl-mem-flags) + (:mem-size . :size) + (:mem-host-ptr . (:pointer :void)) + (:mem-map-count . cl-uint) + (:mem-reference-count . cl-uint) + (:mem-context . cl-context) + (:mem-associated-memobject . cl-mem) + (:mem-offset . :size) + (:mem-uses-svm-pointer . cl-bool) + (:mem-properties . (:pointer cl-mem-properties)))) + +(wrap-get-info-function get-mem-object-info %get-mem-object-info + +mem-object-info-type-alist+) + +(defparameter +image-info-type-alist+ + '((:image-format . cl-image-format) + (:image-element-size . :size) + (:image-row-pitch . :size) + (:image-slice-pitch . :size) + (:image-width . :size) + (:image-height . :size) + (:image-depth . :size) + (:image-array-size . :size) + (:image-buffer . cl-mem) + (:image-num-mip-levels . cl-uint) + (:image-num-samples . cl-uint))) + +(wrap-get-info-function get-image-info %get-image-info +image-info-type-alist+) + +(defparameter +pipe-info-type-alist+ + '((:pipe-packet-size . cl-uint) + (:pipe-max-packets . cl-uint) + (:pipe-properties . (:pointer cl-pipe-properties)))) + +(wrap-get-info-function get-pipe-info %get-pipe-info +pipe-info-type-alist+) + +(defmacro with-mem-object ()) + +(defmacro with-buffer ((buffer context flags size &optional host-ptr) &body body) + `(let ((,buffer (create-buffer ,context ,flags ,size ,(if host-ptr host-ptr '(cffi:null-pointer))))) + (unwind-protect + (progn ,@body) + (release-mem-object ,buffer)))) + +(defmacro with-buffer-from-array ((buffer context flags array) &body body) + `(let ((,buffer (create-buffer-from-array ,context ,flags ,array))) + (unwind-protect + (progn ,@body) + (release-mem-object ,buffer)))) + +(defmacro with-buffers-from-arrays ()) + +(defun copy-buffer-to-array (queue buffer array) + (let* ((length (length array)) + (c-type (array-foreign-type array)) + (size (* length (cffi:foreign-type-size c-type)))) + (cffi:with-foreign-object (c-array c-type length) + (enqueue-read-buffer queue buffer t 0 size c-array) + (dotimes (i length) + (setf (aref array i) (cffi:mem-aref c-array c-type i)))))) diff --git a/src/opencl.lisp b/src/opencl.lisp new file mode 100644 index 0000000..ca95928 --- /dev/null +++ b/src/opencl.lisp @@ -0,0 +1,109 @@ +(in-package #:ocl) + +(defmacro define-get-info ()) + +(define-condition opencl-error () + ((code :initarg :code + :reader opencl-error-code)) + (:report (lambda (condition stream) + (format stream "OPENCL-ERROR: ~A~%" (opencl-error-code condition))))) + +(defmacro check-error (error-code) + (alexandria:once-only (error-code) + `(unless (eq ,error-code :success) + (error 'opencl-error :code ,error-code)))) + +;; TODO: Finish me +(defun array-foreign-type (array) + "Returns the most appropiate foreign type to store ARRAY" + (case (array-element-type array) + (single-float :float) + (double-float :double) + (t nil))) + +(defun array-foreign-size (array) + "Returns the size in bytes required to store a foreign version of ARRAY" + (reduce #'* (array-dimensions array) + :initial-value (cffi:foreign-type-size (array-foreign-type array)))) + +(defmacro check-error-arg (form) + (let ((value (gensym "VALUE")) + (error-code (gensym "ERROR-CODE")) + (c-error-code (gensym "C-ERROR-CODE"))) + `(cffi:with-foreign-object (,c-error-code 'cl-error-code) + (let* ((,value (,@form ,c-error-code)) + (,error-code (cffi:mem-ref ,c-error-code 'cl-error-code))) + (if (eq ,error-code :success) + ,value + (error 'opencl-error :code ,error-code)))))) + +(defmacro with-foreign-arrays (bindings &body body) + (if (null bindings) + `(progn ,@body) + `(cffi:with-foreign-array ,(first bindings) + (with-foreign-arrays ,(rest bindings) + ,@body)))) + +(defmacro with-foreign-sequence ((var lisp-sequence type &optional length) &body body) + "Like CFFI:WITH-FOREIGN-ARRAY but works also for lists" + (unless length (setf length (gensym "LENGTH"))) + (alexandria:once-only (lisp-sequence type) + `(let ((,length (length ,lisp-sequence))) + (cffi:with-foreign-object (,var ,type ,length) + (dotimes (i ,length) + (setf (cffi:mem-aref ,var ,type i) (elt ,lisp-sequence i))) + ,@body)))) + +(defmacro with-foreign-sequences (bindings &body body) + (if bindings + `(with-foreign-sequence ,(first bindings) + (with-foreign-sequences ,(rest bindings) + ,@body)) + `(progn ,@body))) + +(defun vector-type-p (type) + (and (consp type) (eq (car type) :pointer))) + +(defun string-type-p (type) + (eq type :string)) + +(defmacro wrap-get-info-function (name low-level-name type-alist) + "" + ;; FIXME? This is a top level form, no call to GENSYM is needed, right? + `(defun ,name (object param-name) + (let ((type (assoc-value ,type-alist param-name)) + (return-size nil) + (error-code nil) + (return-value nil)) + (cffi:with-foreign-object (c-return-size :size) + (setf error-code (,low-level-name object param-name 0 (cffi:null-pointer) c-return-size)) + (check-error error-code) + (setf return-size (cffi:mem-ref c-return-size :size))) + (cond ((vector-type-p type) + (let ((count (/ return-size (cffi:foreign-type-size (second type))))) + (cffi:with-foreign-object (c-value type count) + (setf error-code (,low-level-name object param-name return-size c-value (cffi:null-pointer))) + (setf return-value (loop :for i :below count :collect (cffi:mem-aref c-value type i)))))) + ((string-type-p type) + (setf return-value + (cffi:with-foreign-pointer-as-string (c-string return-size) + (setf error-code (,low-level-name object param-name return-size c-string (cffi:null-pointer)))))) + (t + (cffi:with-foreign-object (c-value type) + (setf error-code (,low-level-name object param-name (cffi:foreign-type-size type) + c-value (cffi:null-pointer))) + (setf return-value (cffi:mem-ref c-value type))))) + (check-error error-code) + return-value))) + +(defmacro get-cl-objects (name (&rest args) low-level-name type) + (assert (every #'symbolp args) nil "ARGS must be a list of only symbols") + `(defun ,name (,@args) + (let (n) + (cffi:with-foreign-object (cn 'cl-uint) + (check-error (,low-level-name ,@args 0 (cffi:null-pointer) cn)) + (setf n (cffi:mem-ref cn 'cl-uint))) + (cffi:with-foreign-object (c-objects ,type n) + (check-error (,low-level-name ,@args n c-objects (cffi:null-pointer))) + (loop :for i :below n + :collect (cffi:mem-aref c-objects ,type i)))))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..ce8dc38 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,247 @@ +(defpackage #:ocl-ffi + (:use #:cl) + (:export + ;; Platform APIs + %get-platform-ids + %get-platform-info + + ;; Device APIs + %get-device-ids + %get-device-info + %create-sub-devices + %retain-device + %release-device + %set-default-device-command-queue + %get-device-and-host-timer + %get-host-timer + + ;; Context APIs + %create-context + %create-context-from-type + %retain-context + %release-context + %get-context-info + set-context-destructor-callback + + ;; Command Queue APIs + %create-command-queue-with-properties + %retain-command-queue + %release-command-queue + %get-command-queue-info + + ;; Memory Object APIs + %create-buffer + create-sub-buffer + create-image + %create-pipe + create-buffer-with-properties + create-image-with-properties + %retain-mem-object + %release-mem-object + %get-supported-image-formats + %get-mem-object-info + %get-image-info + %get-pipe-info + set-mem-object-destructor-callback + + ;; SVM Allocation APIs + svm-alloc + svm-free + + ;; Sampler APIs + %create-sampler-with-properties + %retain-sampler + %release-sampler + %get-sampler-info + + ;; Program Object APIs + %create-program-with-source + create-program-with-binary + create-program-with-built-in-kernels + create-program-with-il + %retain-program + %release-program + %build-program + %compile-program + %link-program + set-program-release-callback + set-program-specialization-constant + %unload-platform-compiler + %get-program-info + %get-program-build-info + + ;; Kernel Object APIs + %create-kernel + %create-kernels-in-program + %clone-kernel + %retain-kernel + %release-kernel + %set-kernel-arg + set-kernel-arg-svm-pointer + set-kernel-exec-info + %get-kernel-info + %get-kernel-arg-info + %get-kernel-work-group-info + %get-kernel-sub-group-info + + ;; Event Object APIs + %wait-for-events + %get-event-info + %create-user-event + %retain-event + %release-event + %set-user-event-status + set-event-callback + + ;; Profiling APIs + %get-event-profiling-info + + ;; Flush and Finish APIs + %flush + %finish + + ;; Enqueued Commands APIs + %enqueue-read-buffer + enqueue-read-buffer-rect + enqueue-write-buffer + enqueue-write-buffer-rect + enqueue-fill-buffer + enqueue-copy-buffer + enqueue-copy-buffer-rect + enqueue-read-image + enqueue-write-image + enqueue-fill-image + enqueue-copy-image + enqueue-copy-image-to-buffer + enqueue-copy-buffer-to-image + enqueue-map-buffer + enqueue-map-image + enqueue-unmap-mem-object + enqueue-migrate-mem-objects + %enqueue-nd-range-kernel + enqueue-native-kernel + enqueue-marker-with-wait-list + enqueue-barrier-with-wait-list + %enqueue-svm-free + %enqueue-svm-memcpy + %enqueue-svm-memfill + %enqueue-svm-map + %enqueue-svm-unmap + %enqueue-svm-migrate-mem + + ;; Extension function access + get-extension-function-address-for-platform + + ;; Deprecated OpenCL 1.0 APIs + set-command-queue-property + + ;; Deprecated OpenCL 1.1 APIs + create-image-2d + create-image-3d + enqueue-marker + %enqueue-wait-for-events + enqueue-barrier + unload-compiler + get-extension-function-address + + ;; Deprecated OpenCL 2.0 APIs + %create-command-queue + create-sampler + enqueue-task + + ;; Types + cl-char + cl-uchar + cl-short + cl-ushort + cl-int + cl-uint + cl-long + cl-ulong + + cl-half + cl-float + cl-double + + cl-platform-id + cl-device-id + cl-context + cl-command-queue + cl-mem + cl-program + cl-kernel + cl-event + cl-sampler + + cl-error-code + cl-bool + cl-bitfield + cl-properties + + cl-platform-info + cl-device-info + + cl-device-mem-cache-type + cl-device-local-mem-type + cl-context-info + cl-command-queue-info + cl-channel-order + cl-channel-type + cl-mem-object-type + cl-mem-info + cl-image-info + cl-pipe-info + cl-addressing-mode + cl-filter-mode + cl-sampler-info + cl-program-info + cl-program-build-info + cl-build-status + cl-kernel-info + cl-kernel-arg-info + cl-kernel-arg-address-qualifier + cl-kernel-arg-access-qualifier + cl-kernel-work-group-info + cl-kernel-sub-group-info + cl-kernel-exec-info + cl-event-info + cl-command-type + cl-buffer-create-type + cl-profiling-info + cl-khronos-vendor-id + cl-device-type + cl-device-fp-config + cl-device-exec-capabilities + cl-device-svm-capabilities + cl-command-queue-properties + cl-device-affinity-domain + cl-mem-flags + cl-svm-mem-flags + cl-mem-migration-flags + cl-program-binary-type + cl-map-flags + cl-kernel-arg-type-qualifier + cl-device-atomic-capabilities + cl-device-device-enqueue-capabilities + cl-mem-properties + cl-queue-properties + cl-device-partition-property + cl-context-properties + cl-pipe-properties + cl-sampler-properties + cl-version + cl-image-format + cl-buffer-region + cl-name-version + cl-image-desc)) + +(defpackage #:ocl + (:use #:cl #:alexandria #:ocl-ffi)) + +(in-package #:ocl) + +(cffi:define-foreign-library libopencl + (:unix (:or "libOpenCL.so" "/gnu/store/i70jq190cpc45crbnrw8g8lgb4djyi9r-opencl-icd-loader-2021.06.30/lib/libOpenCL.so")) + (t (:default "libOpenCL"))) + +(cffi:use-foreign-library libopencl) diff --git a/src/platform.lisp b/src/platform.lisp new file mode 100644 index 0000000..1b976f4 --- /dev/null +++ b/src/platform.lisp @@ -0,0 +1,24 @@ +(in-package #:ocl) + +(defun get-platform-ids () + (let ((num-platforms nil)) + (cffi:with-foreign-object (c-num-platforms 'cl-uint) + (check-error (%get-platform-ids 0 (cffi:null-pointer) c-num-platforms)) + (setf num-platforms (cffi:mem-ref c-num-platforms 'cl-uint))) + (cffi:with-foreign-object (c-platforms 'cl-platform-id num-platforms) + (check-error (%get-platform-ids num-platforms c-platforms (cffi:null-pointer))) + (loop :for i :below num-platforms + :collect (cffi:mem-aref c-platforms 'cl-platform-id i))))) + +(defparameter +platform-info-type-alist+ + '((:platform-profile . :string) + (:platform-version . :string) + (:platform-numeric-version . cl-version) + (:platform-name . :string) + (:platform-vendor . :string) + (:platform-extensions . :string) + (:platform-extensions-with-version . (:pointer cl-name-version)) + (:platform-host-timer-resolution . cl-ulong))) + +(wrap-get-info-function get-platform-info %get-platform-info + +platform-info-type-alist+) diff --git a/src/profiling.lisp b/src/profiling.lisp new file mode 100644 index 0000000..2d186d6 --- /dev/null +++ b/src/profiling.lisp @@ -0,0 +1,11 @@ +(in-package #:ocl) + +(defparameter +event-profiling-info-type-alist+ + '((:profiling-command-queued . cl-ulong) + (:profiling-command-submit . cl-ulong) + (:profiling-command-start . cl-ulong) + (:profiling-command-end . cl-ulong) + (:profiling-command-complete . cl-ulong))) + +(wrap-get-info-function get-event-profiling-info %get-event-profiling-info + +event-profiling-info-type-alist+) diff --git a/src/program.lisp b/src/program.lisp new file mode 100644 index 0000000..4f27a25 --- /dev/null +++ b/src/program.lisp @@ -0,0 +1,83 @@ +(in-package #:ocl) + +(defun create-program-with-source (context list-of-strings) + (setf list-of-strings (alexandria:ensure-list list-of-strings)) + (let ((num-strings (length list-of-strings))) + (cffi:with-foreign-object (c-strings :pointer num-strings) + (dotimes (i num-strings) + (setf (cffi:mem-aref c-strings :pointer i) + (cffi:foreign-string-alloc (elt list-of-strings i)))) + (unwind-protect + (check-error-arg (%create-program-with-source context num-strings c-strings (cffi:null-pointer))) + (dotimes (i num-strings) + (cffi:foreign-string-free (cffi:mem-aref c-strings :pointer i))))))) + +(defun retain-program (program) + (check-error (%retain-program program))) + +(defun release-program (program) + (%release-program program)) + +(defun build-program (program device-list &key (options (cffi:null-pointer)) + (pfn-notify (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (setf device-list (alexandria:ensure-list device-list)) + (with-foreign-sequence (c-devices device-list 'cl-device-id num-devices) + (check-error (%build-program program num-devices c-devices options + pfn-notify user-data)))) + +;; (defun compile-program (program device-list +;; &key (options (cffi:null-pointer)) +;; input-headers +;; header-include-names +;; (pfn-notify (cffi:null-pointer)) +;; (user-data (cffi:null-pointer))) +;; (with-foreign-sequence ((c-device-list device-list 'cl-device-id num-devices) +;; (c-input-headers input-headers 'cl-program num-input-headers)) +;; (check-error (%compile-program program num-devices c-device-list options +;; num-input-headers c-input-headers +;; pfn-notify user-data)))) + +(defun link-program (context device-list input-programs &key (options (cffi:null-pointer)) + (pfn-notify (cffi:null-pointer)) + (user-data (cffi:null-pointer))) + (assert (not (emptyp input-programs))) + (with-foreign-sequences ((c-device-list device-list 'cl-device-id num-devices) + (c-input-programs input-programs 'cl-program num-input-programs)) + (check-error-arg (%link-program context num-devices c-device-list options + num-input-programs c-input-programs + pfn-notify user-data)))) + +(defun unload-platform-compiler (platform) + (check-error (%unload-platform-compiler platform))) + +(defparameter +program-info-type-alist+ + '((:program-reference-count . cl-uint) + (:program-context . cl-context) + (:program-num-devices . cl-uint) + (:program-devices . (:pointer cl-device-id)) + (:program-source . :string) + (:program-il . (:pointer :char)) + (:program-binary-sizes . (:pointer :size)) + (:program-binaries . (:pointer (:pointer :char))) + (:program-num-kernels . :size) + (:program-kernel-names . (:pointer :char)) + (:program-scope-global-ctors-present . cl-bool) + (:program-scope-global-dtors-present . cl-bool))) + +;; %get-program-info + +(defparameter +program-build-info-type-alist+ + '((:program-build-status . cl-build-status) + (:program-build-options . :string) + (:program-build-log . :string) + (:program-binary-type . cl-program-binary-type) + (:program-build-global-variable-total-size . :size))) + +;; %get-program-build-info + +(defmacro with-program-from-source ((program context list-of-strings) &body body) + `(let ((,program (create-program-with-source ,context ,list-of-strings))) + (unwind-protect + (progn ,@body) + (release-program ,program)))) diff --git a/src/sampler.lisp b/src/sampler.lisp new file mode 100644 index 0000000..5521ed7 --- /dev/null +++ b/src/sampler.lisp @@ -0,0 +1,27 @@ +(in-package #:ocl) + +(defun create-sampler-with-properties (context &key (normalized-coords-p t) + (addressing-mode :address-clamp) + (filter-mode :filter-nearest)) + (let ((properties `(:sampler-normalized-coords ,normalized-coords-p + :sampler-addressing-mode ,addressing-mode + :sampler-filter-mode ,filter-mode + 0))) + (with-foreign-sequence (c-properties properties 'cl-sampler-properties) + (check-error-arg (%create-sampler-with-properties context sampler-properties))))) + +(defun retain-sampler (sampler) + (check-error (%retain-sampler sampler))) + +(defun release-sampler (sampler) + (check-error (%release-sampler sampler))) + +(defparameter +sampler-info-type-alist+ + '((:sampler-reference-count . cl-uint) + (:sampler-context . cl-context) + (:sampler-normalized-coords . cl-bool) + (:sampler-addressing-mode . cl-addressing-mode) + (:sampler-filter-mode . cl-filter-mode) + (:sampler-properties . (:pointer cl-sampler-properties)))) + +(wrap-get-info-function get-sampler-info %get-sampler-info +sampler-info-type-alist+) diff --git a/src/types.lisp b/src/types.lisp new file mode 100644 index 0000000..20a4882 --- /dev/null +++ b/src/types.lisp @@ -0,0 +1,630 @@ +(in-package #:ocl-ffi) + +(cffi:defctype cl-char :int8) +(cffi:defctype cl-uchar :uint8) +(cffi:defctype cl-short :int16) +(cffi:defctype cl-ushort :uint16) +(cffi:defctype cl-int :int32) +(cffi:defctype cl-uint :uint32) +(cffi:defctype cl-long :int64) +(cffi:defctype cl-ulong :uint64) + +(cffi:defctype cl-half :uint16) +(cffi:defctype cl-float :float) +(cffi:defctype cl-double :double) + +(cffi:defctype cl-platform-id :pointer) +(cffi:defctype cl-device-id :pointer) +(cffi:defctype cl-context :pointer) +(cffi:defctype cl-command-queue :pointer) +(cffi:defctype cl-mem :pointer) +(cffi:defctype cl-program :pointer) +(cffi:defctype cl-kernel :pointer) +(cffi:defctype cl-event :pointer) +(cffi:defctype cl-sampler :pointer) + +;;; Error Codes +(cffi:defcenum (cl-error-code cl-int) + (:complete 0) + (:running 1) + (:submitted 2) + (:queued 3) + (:success 0) + (:device-not-found -1) + (:device-not-available -2) + (:compiler-not-available -3) + (:mem-object-allocation-failure -4) + (:out-of-resources -5) + (:out-of-host-memory -6) + (:profiling-info-not-available -7) + (:mem-copy-overlap -8) + (:image-format-mismatch -9) + (:image-format-not-supported -10) + (:build-program-failure -11) + (:map-failure -12) + (:misaligned-sub-buffer-offset -13) + (:exec-status-error-for-events-in-wait-list -14) + (:compile-program-failure -15) + (:linker-not-available -16) + (:link-program-failure -17) + (:device-partition-failed -18) + (:kernel-arg-info-not-available -19) + (:invalid-value -30) + (:invalid-device-type -31) + (:invalid-platform -32) + (:invalid-device -33) + (:invalid-context -34) + (:invalid-queue-properties -35) + (:invalid-command-queue -36) + (:invalid-host-ptr -37) + (:invalid-mem-object -38) + (:invalid-image-format-descriptor -39) + (:invalid-image-size -40) + (:invalid-sampler -41) + (:invalid-binary -42) + (:invalid-build-options -43) + (:invalid-program -44) + (:invalid-program-executable -45) + (:invalid-kernel-name -46) + (:invalid-kernel-definition -47) + (:invalid-kernel -48) + (:invalid-arg-index -49) + (:invalid-arg-value -50) + (:invalid-arg-size -51) + (:invalid-kernel-args -52) + (:invalid-work-dimension -53) + (:invalid-work-group-size -54) + (:invalid-work-item-size -55) + (:invalid-global-offset -56) + (:invalid-event-wait-list -57) + (:invalid-event -58) + (:invalid-operation -59) + (:invalid-gl-object -60) + (:invalid-buffer-size -61) + (:invalid-mip-level -62) + (:invalid-global-work-size -63) + (:invalid-property -64) + (:invalid-image-descriptor -65) + (:invalid-compiler-options -66) + (:invalid-linker-options -67) + (:invalid-device-partition-count -68) + (:invalid-pipe-size -69) + (:invalid-device-queue -70) + (:invalid-spec-id -71) + (:max-size-restriction-exceeded -72)) + +(cffi:defcenum (cl-bool cl-uint) + (:false 0) + (:true 1) + (:blocking 1) + (:non-blocking 0)) + +(cffi:defctype cl-bitfield cl-ulong) +(cffi:defctype cl-properties cl-ulong) + +(cffi:defcenum (cl-platform-info cl-uint) + (:platform-profile #x0900) + (:platform-version #x0901) + (:platform-name #x0902) + (:platform-vendor #x0903) + (:platform-extensions #x0904) + (:platform-host-timer-resolution #x0905) + (:platform-numeric-version #x0906) + (:platform-extensions-with-version #x0907)) + +(cffi:defcenum (cl-device-info cl-uint) + (:device-type #x1000) + (:device-vendor-id #x1001) + (:device-max-compute-units #x1002) + (:device-max-work-item-dimensions #x1003) + (:device-max-work-group-size #x1004) + (:device-max-work-item-sizes #x1005) + (:device-preferred-vector-width-char #x1006) + (:device-preferred-vector-width-short #x1007) + (:device-preferred-vector-width-int #x1008) + (:device-preferred-vector-width-long #x1009) + (:device-preferred-vector-width-float #x100a) + (:device-preferred-vector-width-double #x100b) + (:device-max-clock-frequency #x100c) + (:device-address-bits #x100d) + (:device-max-read-image-args #x100e) + (:device-max-write-image-args #x100f) + (:device-max-mem-alloc-size #x1010) + (:device-image2d-max-width #x1011) + (:device-image2d-max-height #x1012) + (:device-image3d-max-width #x1013) + (:device-image3d-max-height #x1014) + (:device-image3d-max-depth #x1015) + (:device-image-support #x1016) + (:device-max-parameter-size #x1017) + (:device-max-samplers #x1018) + (:device-mem-base-addr-align #x1019) + (:device-min-data-type-align-size #x101a) + (:device-single-fp-config #x101b) + (:device-global-mem-cache-type #x101c) + (:device-global-mem-cacheline-size #x101d) + (:device-global-mem-cache-size #x101e) + (:device-global-mem-size #x101f) + (:device-max-constant-buffer-size #x1020) + (:device-max-constant-args #x1021) + (:device-local-mem-type #x1022) + (:device-local-mem-size #x1023) + (:device-error-correction-support #x1024) + (:device-profiling-timer-resolution #x1025) + (:device-endian-little #x1026) + (:device-available #x1027) + (:device-compiler-available #x1028) + (:device-execution-capabilities #x1029) + (:device-queue-properties #x102a) + (:device-queue-on-host-properties #x102a) + (:device-name #x102b) + (:device-vendor #x102c) + (:driver-version #x102d) + (:device-profile #x102e) + (:device-version #x102f) + (:device-extensions #x1030) + (:device-platform #x1031) + (:device-double-fp-config #x1032) + (:device-preferred-vector-width-half #x1034) + (:device-host-unified-memory #x1035) + (:device-native-vector-width-char #x1036) + (:device-native-vector-width-short #x1037) + (:device-native-vector-width-int #x1038) + (:device-native-vector-width-long #x1039) + (:device-native-vector-width-float #x103a) + (:device-native-vector-width-double #x103b) + (:device-native-vector-width-half #x103c) + (:device-opencl-c-version #x103d) + (:device-linker-available #x103e) + (:device-built-in-kernels #x103f) + (:device-image-max-buffer-size #x1040) + (:device-image-max-array-size #x1041) + (:device-parent-device #x1042) + (:device-partition-max-sub-devices #x1043) + (:device-partition-properties #x1044) + (:device-partition-affinity-domain #x1045) + (:device-partition-type #x1046) + (:device-reference-count #x1047) + (:device-preferred-interop-user-sync #x1048) + (:device-printf-buffer-size #x1049) + (:device-image-pitch-alignment #x104a) + (:device-image-base-address-alignment #x104b) + (:device-max-read-write-image-args #x104c) + (:device-max-global-variable-size #x104d) + (:device-queue-on-device-properties #x104e) + (:device-queue-on-device-preferred-size #x104f) + (:device-queue-on-device-max-size #x1050) + (:device-max-on-device-queues #x1051) + (:device-max-on-device-events #x1052) + (:device-svm-capabilities #x1053) + (:device-global-variable-preferred-total-size #x1054) + (:device-max-pipe-args #x1055) + (:device-pipe-max-active-reservations #x1056) + (:device-pipe-max-packet-size #x1057) + (:device-preferred-platform-atomic-alignment #x1058) + (:device-preferred-global-atomic-alignment #x1059) + (:device-preferred-local-atomic-alignment #x105a) + (:device-il-version #x105b) + (:device-max-num-sub-groups #x105c) + (:device-sub-group-independent-forward-progress #x105d) + (:device-numeric-version #x105e) + (:device-extensions-with-version #x1060) + (:device-ils-with-version #x1061) + (:device-built-in-kernels-with-version #x1062) + (:device-atomic-memory-capabilities #x1063) + (:device-atomic-fence-capabilities #x1064) + (:device-non-uniform-work-group-support #x1065) + (:device-opencl-c-all-versions #x1066) + (:device-preferred-work-group-size-multiple #x1067) + (:device-work-group-collective-functions-support #x1068) + (:device-generic-address-space-support #x1069) + (:device-opencl-c-features #x106f) + (:device-device-enqueue-capabilities #x1070) + (:device-pipe-support #x1071) + (:device-latest-conformance-version-passed #x1072)) + +(cffi:defcenum (cl-device-mem-cache-type cl-uint) + (:none #x0) + (:read-only-cache #x1) + (:read-write-cache #x2)) + +(cffi:defcenum (cl-device-local-mem-type cl-uint) + (:local #x1) + (:global #x2)) + + +(cffi:defcenum (cl-context-info cl-uint) + (:context-reference-count #x1080) + (:context-devices #x1081) + (:context-properties #x1082) + (:context-num-devices #x1083)) + +(cffi:defcenum (cl-command-queue-info cl-uint) + (:queue-context #x1090) + (:queue-device #x1091) + (:queue-reference-count #x1092) + (:queue-properties #x1093) + (:queue-size #x1094) + (:queue-device-default #x1095) + (:queue-properties-array #x1098)) + +(cffi:defcenum (cl-channel-order cl-uint) + (:r #x10b0) + (:a #x10b1) + (:rg #x10b2) + (:ra #x10b3) + (:rgb #x10b4) + (:rgba #x10b5) + (:bgra #x10b6) + (:argb #x10b7) + (:intensity #x10b8) + (:luminance #x10b9) + (:rx #x10ba) + (:rgx #x10bb) + (:rgbx #x10bc) + (:depth #x10bd) + (:depth-stencil #x10be) + (:srgb #x10bf) + (:srgbx #x10c0) + (:srgba #x10c1) + (:sbgra #x10c2) + (:abgr #x10c3)) + +(cffi:defcenum (cl-channel-type cl-uint) + (:snorm-int8 #x10d0) + (:snorm-int16 #x10d1) + (:unorm-int8 #x10d2) + (:unorm-int16 #x10d3) + (:unorm-short-565 #x10d4) + (:unorm-short-555 #x10d5) + (:unorm-int-101010 #x10d6) + (:signed-int8 #x10d7) + (:signed-int16 #x10d8) + (:signed-int32 #x10d9) + (:unsigned-int8 #x10da) + (:unsigned-int16 #x10db) + (:unsigned-int32 #x10dc) + (:half-float #x10dd) + (:float #x10de) + (:unorm-int24 #x10df) + (:unorm-int-101010-2 #x10e0)) + +(cffi:defcenum (cl-mem-object-type cl-uint) + (:mem-object-buffer #x10f0) + (:mem-object-image2d #x10f1) + (:mem-object-image3d #x10f2) + (:mem-object-image2d-array #x10f3) + (:mem-object-image1d #x10f4) + (:mem-object-image1d-array #x10f5) + (:mem-object-image1d-buffer #x10f6) + (:mem-object-pipe #x10f7)) + +(cffi:defcenum (cl-mem-info cl-uint) + (:mem-type #x1100) + (:mem-flags #x1101) + (:mem-size #x1102) + (:mem-host-ptr #x1103) + (:mem-map-count #x1104) + (:mem-reference-count #x1105) + (:mem-context #x1106) + (:mem-associated-memobject #x1107) + (:mem-offset #x1108) + (:mem-uses-svm-pointer #x1109) + (:mem-properties #x110a)) + +(cffi:defcenum (cl-image-info cl-uint) + (:image-format #x1110) + (:image-element-size #x1111) + (:image-row-pitch #x1112) + (:image-slice-pitch #x1113) + (:image-width #x1114) + (:image-height #x1115) + (:image-depth #x1116) + (:image-array-size #x1117) + (:image-buffer #x1118) + (:image-num-mip-levels #x1119) + (:image-num-samples #x111a)) + +(cffi:defcenum (cl-pipe-info cl-uint) + (:pipe-packet-size #x1120) + (:pipe-max-packets #x1121) + (:pipe-properties #x1122)) + +(cffi:defcenum (cl-addressing-mode cl-uint) + (:address-none #x1130) + (:address-clamp-to-edge #x1131) + (:address-clamp #x1132) + (:address-repeat #x1133) + (:address-mirrored-repeat #x1134)) + +(cffi:defcenum (cl-filter-mode cl-uint) + (:filter-nearest #x1140) + (:filter-linear #x1141)) + +(cffi:defcenum (cl-sampler-info cl-uint) + (:sampler-reference-count #x1150) + (:sampler-context #x1151) + (:sampler-normalized-coords #x1152) + (:sampler-addressing-mode #x1153) + (:sampler-filter-mode #x1154) + (:sampler-mip-filter-mode #x1155) + (:sampler-lod-min #x1156) + (:sampler-lod-max #x1157) + (:sampler-properties #x1158)) + +(cffi:defcenum (cl-program-info cl-uint) + (:program-reference-count #x1160) + (:program-context #x1161) + (:program-num-devices #x1162) + (:program-devices #x1163) + (:program-source #x1164) + (:program-binary-sizes #x1165) + (:program-binaries #x1166) + (:program-num-kernels #x1167) + (:program-kernel-names #x1168) + (:program-il #x1169) + (:program-scope-global-ctors-present #x116a) + (:program-scope-global-dtors-present #x116b)) + +(cffi:defcenum (cl-program-build-info cl-uint) + (:program-build-status #x1181) + (:program-build-options #x1182) + (:program-build-log #x1183) + (:program-binary-type #x1184) + (:program-build-global-variable-total-size #x1185)) + +(cffi:defcenum (cl-build-status cl-int) + (:build-success 0) + (:build-none -1) + (:build-error -2) + (:build-in-progress -3)) + +(cffi:defcenum (cl-kernel-info cl-uint) + (:kernel-function-name #x1190) + (:kernel-num-args #x1191) + (:kernel-reference-count #x1192) + (:kernel-context #x1193) + (:kernel-program #x1194) + (:kernel-attributes #x1195)) + +(cffi:defcenum (cl-kernel-arg-info cl-uint) + (:kernel-arg-address-qualifier #x1196) + (:kernel-arg-access-qualifier #x1197) + (:kernel-arg-type-name #x1198) + (:kernel-arg-type-qualifier #x1199) + (:kernel-arg-name #x119a)) + +(cffi:defcenum (cl-kernel-arg-address-qualifier cl-uint) + (:kernel-arg-address-global #x119b) + (:kernel-arg-address-local #x119c) + (:kernel-arg-address-constant #x119d) + (:kernel-arg-address-private #x119e)) + +(cffi:defcenum (cl-kernel-arg-access-qualifier cl-uint) + (:kernel-arg-access-read-only #x11a0) + (:kernel-arg-access-write-only #x11a1) + (:kernel-arg-access-read-write #x11a2) + (:kernel-arg-access-none #x11a3)) + +(cffi:defcenum (cl-kernel-work-group-info cl-uint) + (:kernel-work-group-size #x11b0) + (:kernel-compile-work-group-size #x11b1) + (:kernel-local-mem-size #x11b2) + (:kernel-preferred-work-group-size-multiple #x11b3) + (:kernel-private-mem-size #x11b4) + (:kernel-global-work-size #x11b5)) + +(cffi:defcenum (cl-kernel-sub-group-info cl-uint) + (:kernel-max-sub-group-size-for-ndrange #x2033) + (:kernel-sub-group-count-for-ndrange #x2034) + (:kernel-local-size-for-sub-group-count #x11b8) + (:kernel-max-num-sub-groups #x11b9) + (:kernel-compile-num-sub-groups #x11ba)) + +(cffi:defcenum (cl-kernel-exec-info cl-uint) + (:kernel-exec-info-svm-ptrs #x11b6) + (:kernel-exec-info-svm-fine-grain-system #x11b7)) + + +(cffi:defcenum (cl-event-info cl-uint) + (:event-command-queue #x11d0) + (:event-command-type #x11d1) + (:event-reference-count #x11d2) + (:event-command-execution-status #x11d3) + (:event-context #x11d4)) + +(cffi:defcenum (cl-command-type cl-uint) + (:command-ndrange-kernel #x11f0) + (:command-task #x11f1) + (:command-native-kernel #x11f2) + (:command-read-buffer #x11f3) + (:command-write-buffer #x11f4) + (:command-copy-buffer #x11f5) + (:command-read-image #x11f6) + (:command-write-image #x11f7) + (:command-copy-image #x11f8) + (:command-copy-image-to-buffer #x11f9) + (:command-copy-buffer-to-image #x11fa) + (:command-map-buffer #x11fb) + (:command-map-image #x11fc) + (:command-unmap-mem-object #x11fd) + (:command-marker #x11fe) + (:command-acquire-gl-objects #x11ff) + (:command-release-gl-objects #x1200) + (:command-read-buffer-rect #x1201) + (:command-write-buffer-rect #x1202) + (:command-copy-buffer-rect #x1203) + (:command-user #x1204) + (:command-barrier #x1205) + (:command-migrate-mem-objects #x1206) + (:command-fill-buffer #x1207) + (:command-fill-image #x1208) + (:command-svm-free #x1209) + (:command-svm-memcpy #x120a) + (:command-svm-memfill #x120b) + (:command-svm-map #x120c) + (:command-svm-unmap #x120d) + (:command-svm-migrate-mem #x120e)) + +(defconstant +complete+ #x0) +(defconstant +running+ #x1) +(defconstant +submitted+ #x2) +(defconstant +queued+ #x3) + +(cffi:defcenum (cl-buffer-create-type cl-uint) + (:buffer-create-type-region #x1220)) + +(cffi:defcenum (cl-profiling-info cl-uint) + (:profiling-command-queued #x1280) + (:profiling-command-submit #x1281) + (:profiling-command-start #x1282) + (:profiling-command-end #x1283) + (:profiling-command-complete #x1284)) + +(cffi:defcenum (cl-khronos-vendor-id cl-uint) + (:khronos-vendor-id-codeplay #x10004)) + +(cffi:defbitfield (cl-device-type cl-bitfield) + :device-type-default + :device-type-cpu + :device-type-gpu + :device-type-accelerator + :device-type-custom + (:device-type-all #xffffffff)) + +(cffi:defbitfield (cl-device-fp-config cl-bitfield) + :fp-denorm + :fp-inf-nan + :fp-round-to-nearest + :fp-round-to-zero + :fp-round-to-inf + :fp-fma + :fp-soft-float + :fp-correctly-rounded-divide-sqrt) + +(cffi:defbitfield (cl-device-exec-capabilities cl-bitfield) + :exec-kernel + :exec-native-kernel) + +(cffi:defbitfield (cl-device-svm-capabilities cl-bitfield) + :device-svm-coarse-grain-buffer + :device-svm-fine-grain-buffer + :device-svm-fine-grain-system + :device-svm-atomics) + +(cffi:defbitfield (cl-command-queue-properties cl-bitfield) + :queue-out-of-order-exec-mode-enable + :queue-profiling-enable + :queue-on-device + :queue-on-device-default) + +(cffi:defbitfield (cl-device-affinity-domain cl-bitfield) + :device-affinity-domain-numa + :device-affinity-domain-l4-cache + :device-affinity-domain-l3-cache + :device-affinity-domain-l2-cache + :device-affinity-domain-l1-cache + :device-affinity-domain-next-partitionable) + +(cffi:defbitfield (cl-mem-flags cl-bitfield) + :mem-read-write + :mem-write-only + :mem-read-only + :mem-use-host-ptr + :mem-alloc-host-ptr + :mem-copy-host-ptr + (:mem-host-write-only #x80) + :mem-host-read-only + :mem-host-no-access + :mem-svm-fine-grain-buffer + :mem-svm-atomics + :mem-kernel-read-and-write) + +(cffi:defbitfield (cl-svm-mem-flags cl-bitfield) + :mem-read-write + :mem-write-only + :mem-read-only + :mem-use-host-ptr + :mem-alloc-host-ptr + :mem-copy-host-ptr + (:mem-host-write-only #x80) + :mem-host-read-only + :mem-host-no-access + :mem-svm-fine-grain-buffer + :mem-svm-atomics + :mem-kernel-read-and-write) + + +(cffi:defbitfield (cl-mem-migration-flags cl-bitfield) + :migrate-mem-object-host + :migrate-mem-object-content-undefined) + +(cffi:defbitfield (cl-program-binary-type cl-uint) + :program-binary-type-none + :program-binary-type-compiled-object + :program-binary-type-library + :program-binary-type-executable) + +(cffi:defbitfield (cl-map-flags cl-bitfield) + :map-read + :map-write + :map-write-invalidate-region) + +(cffi:defbitfield (cl-kernel-arg-type-qualifier cl-bitfield) + (:kernel-arg-type-none+ #x0) + :kernel-arg-type-const + :kernel-arg-type-restrict + :kernel-arg-type-volatile + :kernel-arg-type-pipe) + +(cffi:defbitfield (cl-device-atomic-capabilities cl-bitfield) + :device-atomic-order-relaxed + :device-atomic-order-acq-rel + :device-atomic-order-seq-cst + :device-atomic-scope-work-item + :device-atomic-scope-work-group + :device-atomic-scope-device + :device-atomic-scope-all-devices) + +(cffi:defbitfield (cl-device-device-enqueue-capabilities cl-bitfield) + :device-queue-supported + :device-queue-replaceable-default) + +(cffi:defctype cl-mem-properties cl-properties) +(cffi:defctype cl-queue-properties cl-properties) +(cffi:defctype cl-device-partition-property :intptr) + +(cffi:defcenum (cl-context-properties :intptr :allow-undeclared-values t) + (:context-platform #x1084) + (:context-interop-user-sync #x1085)) + +(cffi:defctype cl-pipe-properties :intptr) +(cffi:defctype cl-sampler-properties cl-properties) + +(cffi:defctype cl-version cl-uint) + +(cffi:defcstruct cl-image-format + (image-channel-order cl-channel-order) + (image-channel-data-type cl-channel-type)) + +(cffi:defcstruct cl-buffer-region + (origin :size) + (size :size)) + +(cffi:defcstruct cl-name-version + (version cl-version) + ;; +name-version-max-name-size+ 64 + (name :char :count 64)) + +(cffi:defcstruct cl-image-desc + (image-type cl-mem-object-type) + (image-width :size) + (image-height :size) + (image-depth :size) + (image-array-size :size) + (image-row-pitch :size) + (image-slice-pitch :size) + (num-mip-levels cl-uint) + (num-samples cl-uint) + ;; Anon union buffer / mem_object + (buffer cl-mem)) diff --git a/t/test.cl b/t/test.cl new file mode 100644 index 0000000..89ed7eb --- /dev/null +++ b/t/test.cl @@ -0,0 +1,10 @@ +kernel void vecAdd(global float *a, + global float *b, + global float *c, + const unsigned int n) +{ + int id = get_global_id(0); + if(id < n) { + c[id] = a[id] + b[id]; + } +} diff --git a/t/test.lisp b/t/test.lisp new file mode 100644 index 0000000..98e9a89 --- /dev/null +++ b/t/test.lisp @@ -0,0 +1,51 @@ +(asdf:load-systems :slynk :opencl :alexandria) + +(in-package #:ocl) + +;; (slynk:create-server) + +(defun print-platform (platform) + (loop :for info :in '(:platform-profile + :platform-version + :platform-name + :platform-vendor + :platform-extensions + :platform-host-timer-resolution) + :do + (format t "~A: ~A~%" info (get-platform-info platform info)))) + +(defun main (context kernel queue) + (let* ((a (make-array 3 :element-type 'single-float :initial-contents '(1.0 2.0 3.0))) + (b (make-array 3 :element-type 'single-float :initial-contents '(2.0 2.0 3.0))) + (c (make-array 3 :element-type 'single-float)) + (size (* (cffi:foreign-type-size :float) 3))) + (with-buffer-from-array (a-buffer context '(:mem-copy-host-ptr :mem-read-only) a) + (with-buffer-from-array (b-buffer context '(:mem-copy-host-ptr :mem-read-only) b) + (with-buffer (c-buffer context :mem-write-only size) + + (set-kernel-arg kernel 0 'cl-mem a-buffer) + (set-kernel-arg kernel 1 'cl-mem b-buffer) + (set-kernel-arg kernel 2 'cl-mem c-buffer) + (set-kernel-arg kernel 3 :unsigned-int 3) + + (enqueue-nd-range-kernel queue kernel 0 3 1) + + (finish queue) + + (copy-buffer-to-array queue c-buffer c) + + (dotimes (i 3) + (format t "~A~%" (aref c i)))))))) + +(let ((platforms (get-platform-ids))) + (format t "~&Found ~A OpenCL platforms!~%" (length platforms)) + (print-platform (first platforms)) + (let ((devices (get-device-ids (first platforms) :device-type-cpu))) + (format t "Found ~A devices!~%Type: ~A~%" (length devices) + (get-device-info (first devices) :device-type)) + (with-context (context devices :platform (first platforms)) + (with-program-from-source (program context (alexandria:read-file-into-string "test.cl")) + (build-program program (first devices)) + (with-command-queue (queue context (first devices)) + (with-kernel (kernel program "vecAdd") + (main context kernel queue))))))) |