diff options
76 files changed, 8549 insertions, 0 deletions
diff --git a/.clang-format b/.clang-format new file mode 100644 index 0000000..8c67bcb --- /dev/null +++ b/.clang-format @@ -0,0 +1,65 @@ +--- +Language: Cpp +BasedOnStyle: LLVM +AccessModifierOffset: -4 +AlignAfterOpenBracket: true +AlignEscapedNewlinesLeft: false +AlignOperands: true +AlignTrailingComments: true +AllowAllParametersOfDeclarationOnNextLine: true +AllowShortBlocksOnASingleLine: false +AllowShortCaseLabelsOnASingleLine: false +AllowShortIfStatementsOnASingleLine: false +AllowShortLoopsOnASingleLine: false +AllowShortFunctionsOnASingleLine: All +AlwaysBreakAfterDefinitionReturnType: false +AlwaysBreakTemplateDeclarations: false +AlwaysBreakBeforeMultilineStrings: false +BreakBeforeBinaryOperators: None +BreakBeforeTernaryOperators: true +BreakConstructorInitializersBeforeComma: false +BinPackParameters: true +BinPackArguments: true +ColumnLimit: 80 +ConstructorInitializerAllOnOneLineOrOnePerLine: false +ConstructorInitializerIndentWidth: 4 +DerivePointerAlignment: false +ExperimentalAutoDetectBinPacking: false +IndentCaseLabels: false +IndentWrappedFunctionNames: false +IndentFunctionDeclarationAfterType: false +MaxEmptyLinesToKeep: 2 +KeepEmptyLinesAtTheStartOfBlocks: true +NamespaceIndentation: None +ObjCBlockIndentWidth: 2 +ObjCSpaceAfterProperty: false +ObjCSpaceBeforeProtocolList: true +PenaltyBreakBeforeFirstCallParameter: 19 +PenaltyBreakComment: 300 +PenaltyBreakString: 1000 +PenaltyBreakFirstLessLess: 120 +PenaltyExcessCharacter: 1000000 +PenaltyReturnTypeOnItsOwnLine: 60 +PointerAlignment: Right +SpacesBeforeTrailingComments: 1 +Cpp11BracedListStyle: true +Standard: Cpp11 +IndentWidth: 4 +TabWidth: 4 +UseTab: Never +BreakBeforeBraces: Attach +SpacesInParentheses: false +SpacesInSquareBrackets: false +SpacesInAngles: false +SpaceInEmptyParentheses: false +SpacesInCStyleCastParentheses: false +SpaceAfterCStyleCast: false +SpacesInContainerLiterals: true +SpaceBeforeAssignmentOperators: true +ContinuationIndentWidth: 4 +CommentPragmas: '^ IWYU pragma:' +ForEachMacros: [ foreach, Q_FOREACH, BOOST_FOREACH ] +SpaceBeforeParens: ControlStatements +DisableFormat: false +SortIncludes: false +... diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..5518465 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +test_c/acutest.h linguist-vendored diff --git a/.github/workflows/docs.yaml b/.github/workflows/docs.yaml new file mode 100644 index 0000000..35aa304 --- /dev/null +++ b/.github/workflows/docs.yaml @@ -0,0 +1,32 @@ +name: docs +on: + push: + branches: + - master +jobs: + docs: + runs-on: ubuntu-latest + steps: + - name: checkout repository + uses: actions/checkout@v2 + - name: install python + uses: actions/setup-python@v1 + with: + python-version: "3.10" + - name: install requirements.pip.dev.txt + run: | + python -m pip install --upgrade pip + pip install sphinx furo + - name: build docs + run: ./build-docs.sh + - name: create CNAME + if: github.repository == 'bozokopic/lisp16' + run: | + echo "lisp16.kopic.xyz" > build/docs/CNAME + - name: deploy + uses: peaceiris/actions-gh-pages@v3 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + publish_dir: ./build/docs + publish_branch: gh-pages + force_orphan: true diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ea36607 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/build +/compile_flags.txt @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU 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 <http://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: + + {project} Copyright (C) {year} {fullname} + 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 +<http://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 +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/README.rst b/README.rst new file mode 100644 index 0000000..531c9fa --- /dev/null +++ b/README.rst @@ -0,0 +1,112 @@ +lisp16 +====== + +Simple cross platform 16bit Lisp interpreter. + +* documentation - `<https://lisp16.kopic.xyz>`_ +* git repository - `<https://github.com/bozokopic/lisp16.git>`_ + + +About +----- + +This project is intended as case study of Lisp implementation with following +features: + + * cross platform compatibility + * support for 8bit/16bit architectures (microcontrollers) + * possibility of running on POSIX systems + * small platform compatibility layer + * reduced Lisp dialect mostly based on Scheme + * LISP-1 namespace + * tail call optimization + * macros + * tree walking interpreter + * possibility of multiple independent interpreter instances as part of + single process + * simple mark and sweep garbage collection + * API design taking into account possibility of usage with foreign + function interface + * intended for educational/testing purposes + * emphasis on source code functionality organization over binary size + or lines of code (or other kinds of optimization) + * accompanied documentation with implementation explanation + +Following features are considered out of scope for this project: + + * real-life production usage + * execution speed optimization + * virtual machine or machine code compilation + * rich standard library + + +Building and usage +------------------ + +8bit AVR microcontrollers +''''''''''''''''''''''''' + +Build targeting 8bit AVR microcontrollers (tested with ATmega328P) depends +on `avr-gcc` and associated `binutils`. + +Shell script:: + + $ ./build-avr8.sh + +produces ``build/avr8/lisp16.bin`` binary that can be written to +microcontroller's flash. + +After writing binary to flash, microcontroller will execute `lisp16` repl with +UART used as input/output port. + + +POSIX system +'''''''''''' + +Build targeting POSIX systems depends on C compiler (gcc with musl C library is +used by default) and implementation of `getchar`/`putchar` and `malloc`/`free` +functions (`malloc` can be replaced with static allocation in case multiple +interpreter instances are not needed). + +Shell script:: + + $ ./build-posix.sh + +produces ``build/posix/lisp16`` static binary. + +Execution of ``build/posix/lisp16`` starts `lisp16` repl `stdin`/`stdout` used +as input/output port. + + +Documentation +''''''''''''' + +Building of documentation depends on python with sphinx and furo modules +available. + +Shell script:: + + $ ./build-docs.sh + +produces ``build/docs`` folder containing documentation. + + +License +------- + +lisp16 - simple cross platform 16bit Lisp interpreter + +Copyright (C) 2022 Bozo Kopic + +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 <http://www.gnu.org/licenses/>. @@ -0,0 +1 @@ +0.1.0 diff --git a/build-avr8.sh b/build-avr8.sh new file mode 100755 index 0000000..fb590b1 --- /dev/null +++ b/build-avr8.sh @@ -0,0 +1,18 @@ +#!/bin/sh + +set -e + +cd $(dirname -- "$0") + +MCU=atmega328p +FREQ=16000000UL +ARCH=LSP_ARCH_AVR8 +CFLAGS="-Os" +SRC="src_c/arch/avr8.c src_c/*.c" +OUT_ELF=build/avr8/lisp16.elf +OUT_BIN=build/avr8/lisp16.bin + +mkdir -p build/avr8 + +avr-gcc -mmcu=$MCU -DF_CPU=$FREQ -DLSP_ARCH=$ARCH $CFLAGS -o $OUT_ELF $SRC +avr-objcopy -O binary -j .text -j .data $OUT_ELF $OUT_BIN diff --git a/build-docs.sh b/build-docs.sh new file mode 100755 index 0000000..5efccc5 --- /dev/null +++ b/build-docs.sh @@ -0,0 +1,12 @@ +#!/bin/sh + +set -e + +cd $(dirname -- "$0") + +PYTHON=${PYTHON:-python3} +SRC=docs +DST=build/docs + +mkdir -p $DST +$PYTHON -m sphinx -q -b html $SRC $DST diff --git a/build-posix.sh b/build-posix.sh new file mode 100755 index 0000000..6472b80 --- /dev/null +++ b/build-posix.sh @@ -0,0 +1,16 @@ +#!/bin/sh + +set -e + +cd $(dirname -- "$0") + +CC=${CC:-musl-gcc} +SRC="src_c/arch/posix.c src_c/*.c" +OUT=build/posix/lisp16 +ARCH=LSP_ARCH_POSIX +CFLAGS="-O2" +# CFLAGS="-O0 -ggdb" + +mkdir -p build/posix + +$CC -DLSP_ARCH=$ARCH $CFLAGS -o $OUT -static $SRC diff --git a/docs/apply.rst b/docs/apply.rst new file mode 100644 index 0000000..e45c31b --- /dev/null +++ b/docs/apply.rst @@ -0,0 +1,63 @@ +Function/syntax application +=========================== + +Builtin function/syntax application +----------------------------------- + +Data representing builtin function/syntax, together with type identification, +contains number representing index of builtin entry. As described in previous +chapters, each builtin entry contains function pointer: + +.. code-block:: c + + typedef lsp_status_t (*lsp_builtin_cb_t)(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); + +Application of builtin function/syntax calls provided native function +with arguments provided to function/syntax application. + +Only difference between builtin function and syntax application is in arguments +provided to application itself. In case of function application, these +arguments are previously evaluated and in case of syntax, they are provided +without previous evaluation. + + +User defined function/syntax application +---------------------------------------- + +Data representation of function/syntax references: + + * parent context + * argument name list + * function/syntax body + +During function/syntax application, new context is created as copy of +associated parent context. That context is used for evaluation of +function/syntax content. Prior to content evaluation, provided arguments +are added as new entries in context and are associated with symbols +from argument name list based on their position in list. Once context +is created and argument values are associated, function/syntax body is +evaluated. Evaluation of function/syntax body is sequential evaluation +of all available expression (from first to last) where value of last expression +is used as resulting value. + +In case of function application, result of last expression evaluation is +also value of function application itself. In case of syntax evaluation, +result of last expression is data that is additionally evaluated in context +from which syntax application was called. + + +Source code +----------- + +apply.h +''''''' + +.. literalinclude:: ../src_c/apply.h + :language: c + + +apply.c +''''''' + +.. literalinclude:: ../src_c/apply.c + :language: c diff --git a/docs/arch.rst b/docs/arch.rst new file mode 100644 index 0000000..9eededf --- /dev/null +++ b/docs/arch.rst @@ -0,0 +1,155 @@ +Architecture abstraction layer +============================== + +To enable easier targeting of different execution platforms and provide +decoupling from standard C library (or other dependencies), thin abstraction +layer is required. + + +Supported target platforms +-------------------------- + +Constant definition ``LSP_ARCH`` is used as identifier of desired target +platform. This definition should be set during C source preprocessing to +one of supported values: + + * ``LSP_ARCH_POSIX`` (POSIX target) + * ``LSP_ARCH_AVR8`` (8bit AVR target) + +Depending on value of this constant, different platform specific +implementations will be included. + + +C data types +------------ + +`arch.h` defines fixed length integers (``lsp_int8_t``, ``lsp_int16_t``, +``lsp_int32_t``, ``lsp_uint8_t``, ``lsp_uint16_t``, ``lsp_uint32_t``) +independent of target platform. If target has available standard C library, +this types are aliases to types defined by `stdint.h`. In case target doesn't +have standard C library available, these types should be defined by +appropriate C integer types (``char``, ``short``, ``int``, ``long``, ...). + +Additionally, ``lsp_bool_t`` is defined as alias to ``_Bool``. If ``_Bool`` +type is not available, ``lsp_uint8_t`` can be used. Care is taken not to depend +on specifics of integer to ``_Bool`` conversions so that other integer types +could be used as ``lsp_bool_t``. + + +Platform specific functions +--------------------------- + +Each platform abstraction layer implementation (`arch/*.c`) is responsible +for functions aliased with following names: + + * ``LSP_ARCH_INIT`` + + Function, called before any other function, responsible for + initialization of platform specific state. + + * ``LSP_ARCH_CREATE_MEM`` + + Function responsible for allocating memory that will represent + ``lsp_mem_t`` structure (described in following chapters) and it's + initialization. + + * ``LSP_ARCH_FREE_MEM`` + + Function responsible for freeing previously allocated memory. + + * ``LSP_ARCH_CREATE_IN_STREAM`` + + Function responsible for allocating memory that will represent + ``lsp_in_stream_t`` structure (described in following chapters) and + it's initialization. + + * ``LSP_ARCH_FREE_IN_STREAM`` + + Function responsible for freeing previously allocated memory. + + * ``LSP_ARCH_CREATE_OUT_STREAM`` + + Function responsible for allocating memory that will represent + ``lsp_out_stream_t`` structure (described in following chapters) and + it's initialization. + + * ``LSP_ARCH_FREE_OUT_STREAM`` + + Function responsible for freeing previously allocated memory. + +In case of memory constrained targets (e.g. ``LSP_ARCH_AVR8``), functions +responsible for allocating memory can return pointers to statically +preallocated memory instead of dynamically allocated. For this target +platforms, associated freeing functions don't implement any functionality. + + +Input stream +------------ + +During initialization of input stream, platform specific implementation +is responsible for providing function pointer with signature: + +.. code-block:: c + + typedef lsp_int16_t (*lsp_stream_getchar_t)(lsp_in_stream_t *s); + +Provided function is responsible for reading single character from input +stream (used by REPL). In case of POSIX, it's behavior corresponds to +``getchar`` provided by standard C library. + +Details of input stream implementation are available in following chapters. + + +Output stream +------------- + +During initialization of output stream, platform specific implementation +is responsible for providing function pointer with signature: + +.. code-block:: c + + typedef lsp_int16_t (*lsp_stream_putchar_t)(lsp_out_stream_t *s, lsp_int16_t v); + +Provided function is responsible for writing single character to output +stream (used by REPL). In case of POSIX, it's behavior corresponds to +``putchar`` provided by standard C library. + +Details of output stream implementation are available in following chapters. + + +Source code +----------- + +arch.h +'''''' + +.. literalinclude:: ../src_c/arch.h + :language: c + + +arch/avr8.h +''''''''''' + +.. literalinclude:: ../src_c/arch/avr8.h + :language: c + + +arch/avr8.c +''''''''''' + +.. literalinclude:: ../src_c/arch/avr8.c + :language: c + + +arch/posix.h +'''''''''''' + +.. literalinclude:: ../src_c/arch/posix.h + :language: c + + +arch/posix.c +'''''''''''' + +.. literalinclude:: ../src_c/arch/posix.c + :language: c diff --git a/docs/buff.rst b/docs/buff.rst new file mode 100644 index 0000000..b052483 --- /dev/null +++ b/docs/buff.rst @@ -0,0 +1,29 @@ +String buffer +============= + +While reading character data from input stream, buffer used for storing +string of arbitrary length is required. `lsp_buff_t` provides preallocated +limited temporary storage which is used as intermediary buffer in construction +of `string` data with arbitrary size. + +After initialization with `lsp_buff_init`, characters are added to buffer +with `lsp_buff_push` function. Once all characters are appended, single +`string` data containing all previously appended characters, can be obtained +with `lsp_buff_pop` function. + + +Source code +----------- + +buff.h +'''''' + +.. literalinclude:: ../src_c/buff.h + :language: c + + +buff.c +'''''' + +.. literalinclude:: ../src_c/buff.c + :language: c diff --git a/docs/builtin.rst b/docs/builtin.rst new file mode 100644 index 0000000..bb87f8c --- /dev/null +++ b/docs/builtin.rst @@ -0,0 +1,30 @@ +Builtin +======= + +Builtin functions and builtin syntaxes are represented with +`lsp_builtin_entry_t` structures. Each entry is defined with unique +name and function pointer: + +.. code-block:: c + + typedef lsp_status_t (*lsp_builtin_cb_t)(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); + +Associated function pointer is called during function/syntax application +(described in following chapters). + + +Source code +----------- + +builtin.h +''''''''' + +.. literalinclude:: ../src_c/builtin.h + :language: c + + +builtin.c +''''''''' + +.. literalinclude:: ../src_c/builtin.c + :language: c diff --git a/docs/cell.rst b/docs/cell.rst new file mode 100644 index 0000000..7e66897 --- /dev/null +++ b/docs/cell.rst @@ -0,0 +1,270 @@ +Data types +========== + +All data types are encoded as one or more consecutive 16bit words (cells). +Most significant bit of each 16bit word is reserved for memory manager usage +and remaining 15bits are used for identifying data types and encoding +data values. Most significant data bits of first word identifies +data type. Most significant bit is referenced as bit 15 and least significant +bit as bit 0. + +Implementation mostly uses static inline functions defined in header file, +instead of preprocessor definitions, to provide API more suitable for +foreign function interface. + + +Number +------ + +Data type representing signed integer values of arbitrary length. Although +encoding itself doesn't limit value size, to provide easier interface for +data manipulation, values are limited to signed integers represented with +32bit dual complement encoding. Single number is encoded with one or more +words: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 0 1 s v v v v v v v v v v v v | + +---------+---------------------------------+ + | n + 1 | m 1 v v v v v v v v v v v v v v | + +---------+---------------------------------+ + | ... | ... | + +---------+---------------------------------+ + | n + i | m 1 v v v v v v v v v v v v v v | + +---------+---------------------------------+ + | ... | ... | + +---------+---------------------------------+ + | n + m | m 0 v v v v v v v v v v v v v v | + +---------+---------------------------------+ + +where: + + * Bit 15 of each word (`m`) is reserved for memory management. + + * Bit 14 of first word (``0``) identifies number type. + + * Bit 13 of first word and bit 14 of other words represents "more follows". + Only in last word (`n + m`) is this bit set to ``0``. + + * Bit 12 of first word (`s`) identifies sign. + + * Rest of bits are used as dual complement encoded integer value where + word `n` contains most significant bits and word `n + m` contains + least significant bits. + + +Pair +---- + +Data type representing two addresses referencing word locations (usually +known as cons cell). Address values are limited to 14bit unsigned integers +which enables encoding of this type with two words: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 0 a a a a a a a a a a a a a | + +---------+---------------------------------+ + | n + 1 | m a b b b b b b b b b b b b b b | + +---------+---------------------------------+ + +where: + + * Bit 15 of each word (`m`) is reserved for memory management. + + * Bits 14 and 13 of first word (``10``) identify pair type. + + * 14 `a` bits encode first address value. + + * 14 `b` bits encode second address value. + + +String +------ + +Data type representing zero of more 8bit values. Single string is represented +with one or more words: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 1 0 0 s s s s s s s s s s s | + +---------+---------------------------------+ + | n + 1 | m a a a a a a a a b b b b b b b | + +---------+---------------------------------+ + | n + 2 | m b c c c c c c c c d d d d d d | + +---------+---------------------------------+ + | ... | ... | + +---------+---------------------------------+ + +where: + + * Bit 15 of each word (`m`) is reserved for memory management. + + * Bits 14, 13, 12 and 11 of first word (``1100``) identify string type. + + * 11 `s` bits represent string length (maximum string length is 2047). + + * Bits `a`, `b`, `c`, ... represent 8bit values. + +This encoding schema tries to optimize memory usage but at the same time +introduces significant overhead in manipulating string data. + + +Symbol +------ + +Symbols are used as human readable labels associated with data values. They +are encoded as 8bit characters similarly as string data: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 1 0 1 s s s s s s s s s s s | + +---------+---------------------------------+ + | n + 1 | m a a a a a a a a b b b b b b b | + +---------+---------------------------------+ + | n + 2 | m b c c c c c c c c d d d d d d | + +---------+---------------------------------+ + | ... | ... | + +---------+---------------------------------+ + +where: + + * Bit 15 of each word (`m`) is reserved for memory management. + + * Bits 14, 13, 12 and 11 of first word (``1101``) identify symbol type. + + * 11 `s` bits represent symbol length (maximum symbol length is 2047). + + * Bits `a`, `b`, `c`, ... represent 8bit character values. + + +Builtin function +---------------- + +Builtin functions are referenced by function's index and encoded with +single word: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 1 1 0 0 i i i i i i i i i i | + +---------+---------------------------------+ + +where: + + * Bit 15 (`m`) is reserved for memory management. + + * Bits 14, 13, 12, 11 and 10 (``11100``) identify builtin function type. + + * 10 `i` bits represent builtin function index. + + +Builtin syntax +-------------- + +Builtin syntaxes are referenced by syntax's index and encoded with +single word: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 1 1 0 1 i i i i i i i i i i | + +---------+---------------------------------+ + +where: + + * Bit 15 (`m`) is reserved for memory management. + + * Bits 14, 13, 12, 11 and 10 (``11101``) identify builtin syntax type. + + * 10 `i` bits represent builtin syntax index. + + +Function +-------- + +Functions are defined by parent context, list of argument names and function +body. Type identifier together with 14bit addressees of associated values are +encoded within 4 words: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 1 1 1 0 x x x x x x x x x x | + +---------+---------------------------------+ + | n + 1 | m x c c c c c c c c c c c c c c | + +---------+---------------------------------+ + | n + 2 | m x a a a a a a a a a a a a a a | + +---------+---------------------------------+ + | n + 3 | m x b b b b b b b b b b b b b b | + +---------+---------------------------------+ + +where: + + * Bit 15 of each word (`m`) is reserved for memory management. + + * Bits 14, 13, 12, 11 and 10 of first word (``11110``) identify function + type. + + * 14 `c` bits represent parent context address. + + * 14 `a` bits represent argument name list address. + + * 14 `b` bits represent body definition address. + + * `x` bits are not used. + + +Syntax +------ + +Syntaxes are defined by parent context, list of argument names and syntax +body. Type identifier together with 14bit addressees of associated values are +encoded within 4 words: + + +---------+---------------------------------+ + | address | data | + +=========+=================================+ + | n | m 1 1 1 1 0 x x x x x x x x x x | + +---------+---------------------------------+ + | n + 1 | m x c c c c c c c c c c c c c c | + +---------+---------------------------------+ + | n + 2 | m x a a a a a a a a a a a a a a | + +---------+---------------------------------+ + | n + 3 | m x b b b b b b b b b b b b b b | + +---------+---------------------------------+ + +where: + + * Bit 15 of each word (`m`) is reserved for memory management. + + * Bits 14, 13, 12, 11 and 10 of first word (``11110``) identify syntax + type. + + * 14 `c` bits represent parent context address. + + * 14 `a` bits represent argument name list address. + + * 14 `b` bits represent body definition address. + + * `x` bits are not used. + + +Source code +----------- + +cell.h +'''''' + +.. literalinclude:: ../src_c/cell.h + :language: c + + +cell.c +'''''' + +.. literalinclude:: ../src_c/cell.c + :language: c diff --git a/docs/conf.py b/docs/conf.py new file mode 100644 index 0000000..d9d0dc9 --- /dev/null +++ b/docs/conf.py @@ -0,0 +1,23 @@ +from pathlib import Path + +root_path = Path(__file__).parent.parent.resolve() + +extensions = ['sphinx.ext.todo'] + +version = (root_path / 'VERSION').read_text(encoding='utf-8').strip() +project = 'lisp16' +copyright = '2022, Bozo Kopic' +master_doc = 'index' + +html_theme = 'furo' +html_static_path = ['static'] +html_css_files = ['custom.css'] +html_use_index = False +html_show_sourcelink = False +html_show_sphinx = False +html_sidebars = {'**': ["sidebar/brand.html", + "sidebar/scroll-start.html", + "sidebar/navigation.html", + "sidebar/scroll-end.html"]} + +todo_include_todos = True diff --git a/docs/ctx.rst b/docs/ctx.rst new file mode 100644 index 0000000..7eaa6d2 --- /dev/null +++ b/docs/ctx.rst @@ -0,0 +1,53 @@ +Context +======= + +Context (also known as environment in some of Lisp implementations) +is association between symbols and their data values that apply to +specific evaluation scope. This implementation provides single +lexical context for evaluation of all names regarding of associated data +type (also known as Lisp-1 namespaces). + +Basic method of introducing new scope is function definition and application. +During function definition, new function is associated with scope in which +function itself is defined. Exact copy of current context as is in moment +of definition is used as functions parent scope. During function application +new context is created which inherit all associations that were available +in parent scope. + +Initial context, which is used as starting context, is initialized with +associations to builtin functions and syntaxes. + +Each context contains arbitrary number of mutable entries. Single entry +defines association where any kind of data is referenced by symbol. +Together with functions that add new entries (`lsp_ctx_add`) or obtain +data associated with provided symbol (`lsp_ctx_get`), context enables +modification of data referenced by provided symbol (`lsp_ctx_set`). +During entry modification, previous data instance itself is not changed, only +entry reference is modified to point to newly provided data instance. +If child context modifies existing entry in parent context, this modifications +will also be visible in parent context. + +Because of support for +`tail call optimization <https://en.wikipedia.org/wiki/Tail_call>`_, +implementation of context hierarchy relies on `lsp_ctx_copy` operation instead +of referencing parent context from child context. This method induces +additional overhead in context operation. Never the less, additional memory +allocation overhead is mostly neutralized by usage of immutable linked list +as basis for entry storage. + + +Source code +----------- + +ctx.h +''''' + +.. literalinclude:: ../src_c/ctx.h + :language: c + + +ctx.c +''''' + +.. literalinclude:: ../src_c/ctx.c + :language: c diff --git a/docs/env.rst b/docs/env.rst new file mode 100644 index 0000000..5a4a243 --- /dev/null +++ b/docs/env.rst @@ -0,0 +1,34 @@ +Environment +=========== + +Environment (not to be mixed with context) represent current state of +interpreter instance. It contains reference to memory, input stream and +output stream. To enable +`tail call optimization <https://en.wikipedia.org/wiki/Tail_call>`_, +environment is also used as storage for next expression evaluation. + +Main method responsible for environment evaluation is `lsp_env_resolve`. +This function implements evaluation loop (also known as trampoline), which +iteratively evaluates sequence of expressions. Evaluation of single expression +can result in direct data value (which is registered with +`lsp_env_set_result_value` function) or can be delegated to execution +of another expression (which is registered with `lsp_env_set_result_eval` +function). Evaluation loop (trampoline) repeats expression evaluation +until resulting data value is fully resolved. + + +Source code +----------- + +env.h +''''' + +.. literalinclude:: ../src_c/env.h + :language: c + + +env.c +''''' + +.. literalinclude:: ../src_c/env.c + :language: c diff --git a/docs/eval.rst b/docs/eval.rst new file mode 100644 index 0000000..1e66698 --- /dev/null +++ b/docs/eval.rst @@ -0,0 +1,48 @@ +Evaluation +========== + +Because Lisp code is represented with data structures, each data structure +can be used as interpreter instruction. Evaluation of data, when used as +interpreter expression, is defined according to data type: + + * number, string, builtin function, builtin syntax, function, syntax + + Data of this type evaluate to itself (expression consisting of + single instance of data evaluates to provided data instance). + + * symbol + + Symbols evaluate to data associated to provided symbol in + current evaluation context. If context entry associated with the symbol + is not available, evaluation error is signaled. + + * pair/list + + Lists evaluate to function/syntax application. As first step, + first element of list is evaluated. If first element evaluates + to function or builtin function, all remaining elements are also + evaluated and used as provided arguments. If first element evaluates + to syntax or builtin syntax, remaining list elements are not evaluated + and are used as provided arguments. After evaluation of first element + and possible argument evaluation (in case of functions), evaluation + is delegated to function/syntax application (described in following + chapters). If first list element doesn't evaluate to function/syntax, + evaluation error is signaled. Exception to this rule is empty + list which evaluates to itself. + + +Source code +----------- + +eval.h +'''''' + +.. literalinclude:: ../src_c/eval.h + :language: c + + +eval.c +'''''' + +.. literalinclude:: ../src_c/eval.c + :language: c diff --git a/docs/examples.rst b/docs/examples.rst new file mode 100644 index 0000000..7905ef4 --- /dev/null +++ b/docs/examples.rst @@ -0,0 +1,20 @@ +Examples +======== + +Examples are run using interpreter build for POSIX platform. Before +executing examples, interpreter is bootstrapped with `base-large.lsp` +extensions. + + +Factorial +--------- + +Simple implementation of factorials calculation. + +.. literalinclude:: ../examples/factorial.lsp + :language: scheme + +Example execution:: + + $ cat src_lsp/base-large.lsp examples/factorial.lsp | build/posix/lisp16 + 3628800 diff --git a/docs/extensions.rst b/docs/extensions.rst new file mode 100644 index 0000000..97eab1e --- /dev/null +++ b/docs/extensions.rst @@ -0,0 +1,28 @@ +Extensions +========== + +Base Lisp language, provided by interpreter with builtin functions/syntaxes, +is deliberately designed with limited set of functionality. + +To provide more usable development environment, additional extensions +written in Lisp are available. These extensions are implemented as set of +instructions that should be evaluated by interpreter immediately after +startup. After this bootstrapping evaluation finished, additional +functionalities are available as part of active context. + + +Source code +----------- + +base-small.lsp +'''''''''''''' + +.. literalinclude:: ../src_lsp/base-small.lsp + :language: scheme + + +base-large.lsp +'''''''''''''' + +.. literalinclude:: ../src_lsp/base-large.lsp + :language: scheme diff --git a/docs/function.rst b/docs/function.rst new file mode 100644 index 0000000..4f895a5 --- /dev/null +++ b/docs/function.rst @@ -0,0 +1,83 @@ +Builtin functions +================= + +In following examples, lines starting with ``>`` represent characters +provided to input stream. Lines without starting ``>`` character represent +evaluation results written to output stream. + +Available builtin functions: + + * `eval` + + * `apply` + + * `error` + + * `cons` + + * `set-car!` + + * `set-cdr!` + + * `number?` + + * `pair?` + + * `string?` + + * `symbol?` + + * `function?` + + * `syntax?` + + * `eq?` + + * `equal?` + + * `>` + + * `<` + + * `+` + + * `-` + + * `*` + + * `/` + + * `read` + + * `read-u8` + + * `peek-u8` + + * `write` + + * `write-u8` + + * `make-string` + + * `string-length` + + * `string-ref` + + * `string-set!` + + +Source code +----------- + +function.h +'''''''''' + +.. literalinclude:: ../src_c/function.h + :language: c + + +function.c +'''''''''' + +.. literalinclude:: ../src_c/function.c + :language: c diff --git a/docs/index.rst b/docs/index.rst new file mode 100644 index 0000000..11ca931 --- /dev/null +++ b/docs/index.rst @@ -0,0 +1,29 @@ +.. include:: ../README.rst + + +Content +------- + +.. toctree:: + :maxdepth: 1 + + introduction + arch + status + cell + mem + stream + buff + read + write + builtin + ctx + env + eval + apply + syntax + function + repl + main + extensions + examples diff --git a/docs/introduction.rst b/docs/introduction.rst new file mode 100644 index 0000000..e4d57be --- /dev/null +++ b/docs/introduction.rst @@ -0,0 +1,69 @@ +Introduction +============ + +Modern `microcontrollers <https://en.wikipedia.org/wiki/Microcontroller>`_ +provide powerful computational platforms in form of +affordable and widely usable integrated circuit packages. Although, execution +performance is often more than enough for execution of complex algorithms, +some of constraints can represent challenge in implementing certain kind of +applications. In case of interpreters for high level languages, amount of +available RAM is significant factor which should be taken into account during +design of interpreter and interpreted applications. This project explores +these and similar impacts by implementing Lisp interpreter capable of +interactive execution on 8bit/32bit microcontrollers. + +`Lisp <https://en.wikipedia.org/wiki/Lisp_(programming_language)>`_ is family +of high level programming languages/dialects characterized with +concise `homoiconic <https://en.wikipedia.org/wiki/Homoiconicity>`_ syntax. +`Scheme <https://en.wikipedia.org/wiki/Scheme_(programming_language)>`_, as one +of Lisp dialects, provides few powerful core functionalities which can be used +to extend language itself with wide variety of derived constructs applicable to +different programming paradigms and domains. Therefor, reduced core of Scheme, +with only few data types and builtin functions/syntaxes, can provide good base +system for execution of high level applications on embedded/constrain +platforms. + +One of characteristics of most Lisp implementations is support for interactive +programming based on +`REPL <https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop>`_. +If we take into account that microcontrollers usually provide wide range of +different I/O peripherals, REPL executing instructions on microcontroller can +represent exploratory environment for testing interaction with low level +peripheries not usually available on more powerful general purpose computing +platforms. Although, this kind of environment can be provided by splitting +functionality between microcontroller and more powerful general purpose +computer which communicates with microcontroller, that approach relies on +availability of general purpose computer. By executing interpreter as a whole +on microcontroller, more self sufficient interactive platform is available in +form of a single microcontroller. Interaction with interpreter running on +microcontroller can be based on full duplex +`UART <https://en.wikipedia.org/wiki/Universal_asynchronous_receiver-transmitter>`_ +communication. In this way, wide range of simple terminals can be used (even +those utilizing other microcontrollers). + +Because implementation of Lisp interpreter in C programming language doesn't +require a lot of dependencies specific to single target platform, +implementation can be based on thin abstraction layer that will provide +necessary interaction with host platform. This enables running implementation +based on same source code on different platforms, including more powerful +general purpose computers. Implementation targeting POSIX systems enables +easier testing and provides more developer friendly environment for exploring +interpreter characteristics. Usability of single code base for different +execution environments impacts some of API design decisions. Most notably, +interpreter uses memory locations referenced by additional pointer indirection +instead of statically allocated locations. This approach induces some penalties +in form of execution speed but at the same time provides API more suitable +for interaction with +`foreign function interface <https://en.wikipedia.org/wiki/Foreign_function_interface>`_ +and usage of multiple independent interpreter instances as part of single POSIX +process. + +Existence of this project is mostly motivated with educational and research +reasons. Therefore, significant emphasis is given on this documentation as +integrated part of project. Rest of documentation tries to explain and document +implementation in gradual bottom-up approach. It is advised to read this +documentation sequential in order because each chapter depends on explanations +available in previous chapters. Source code is organized to closely follow +documentation structure and its listing is available as part of each associated +chapter. Reader's knowledge of C programming language and related +platform/memory model is assumed. diff --git a/docs/main.rst b/docs/main.rst new file mode 100644 index 0000000..075cc1c --- /dev/null +++ b/docs/main.rst @@ -0,0 +1,15 @@ +Main +==== + +Implementation of `main` function is responsible for initialization of +required structures and calling REPL function. + + +Source code +----------- + +main.c +'''''' + +.. literalinclude:: ../src_c/main.c + :language: c diff --git a/docs/mem.rst b/docs/mem.rst new file mode 100644 index 0000000..20353db --- /dev/null +++ b/docs/mem.rst @@ -0,0 +1,126 @@ +Memory management +================= + +Functions declared in `mem.h` provide interface for usage of dynamically +allocated data. All other modules interact with dynamic data only through +these functions. + + +Memory layout +------------- + +State of memory management is represented with structure `lsp_mem_t`. It +contains continuous memory block of platform specific word count. +Addresses used for referencing each data correspond to this memory block +starting word index. Because addresses are represented with 14bit unsigned +integer values, usable memory for allocation of dynamic data is limited to +16384 words (32768 bytes). In case of memory constrained systems, this +size is even smaller. + + +Data allocation +--------------- + +Each word (event those which are not single data starting words) have +single bit dedicated for memory management usage. This most significant bit +represent words current usage state where ``0`` represents used word (word is +used for representing data content) and ``1`` represent unused word (word is +available for allocation of new data instance). + +During allocation of new data, all available words are searched for +continuous block of unused words which could be used to represent newly +allocated data content. If such word block could not be found, garbage +collection procedure is triggered, after which search for free block is +repeated. If search is not successful for the second time, allocation +of new data fails. If search is successful, address of newly allocated data +is remembered and used as starting address for future allocation searches. + +All `lsp_mem_create_*` functions, used for data allocation, add allocated +data to list of accessible root data. Management of accessible data is +possible with `lsp_mem_inc_ref` and `lsp_mem_dec_ref` which increase and +decrease references to root data. Once data is not part of root list or is not +referenced by other data which are part of root list, it is considered +not accessible and can be reclaimed by garbage collector. + +During memory initialization, often used data instances are preallocated and +available as part of `lsp_mem_t` structure (`nil`, `zero`, `one`, `quote`, +`quasiquote`, `unquote` and `unquote_splicing`). + + +Garbage collector +----------------- + +Garbage collector is based on variant of simple mark and sweep design. +Initially, all memory words are marked as free. Once words are used for data +representation, used words are immediately marked as non free. After +repeated allocation of new data instances, pool of available free words +is depleted and garbage procedure is started. + +As first step of garbage collection, all memory words are marked as free. +Then, words used for representation of root list are marked as non free by +usage of recursive function which, together with immediately used words, marks +all other referenced data words. Data types which reference other data are +`pair`, `function` and `syntax`. After all data directly and indirectly +referenced by root list is marked as used, garbage collection finishes +(all other words remain marked as unused). + + +Data usage +---------- + +Together with data allocation function, memory management functions include +interface for manipulation and usage of allocated data. These include +`lsp_mem_is_*` function for data type assertion and `lsp_mem_get_*` functions +for data content retrieval. This functions provide thin wrapper for `cell.h` +functions with mapping of data addresses to data words. + +All data types, except for `string` and `pair` are considered immutable - +data content is initialized during allocation and is not mutated afterwards. +In case of `string` and `pair` data, `lsp_mem_set_*` functions enable +in place modification of data instance content. In case of `string` data, +only content of preallocated size can be modified (size of string can not +change after allocation). + +All other parts of interpreter use only `lsp_mem_*` wrappers instead of +direct `lsp_cell_*` function usage. + + +Symbol reusability +------------------ + +Because symbols are immutable, memory usage optimization can be done during +symbol allocation. Each time new symbol should be allocated, content of +all memory words is searched for already allocated symbol with same content. +If such instance is found, reference to already existing symbol is returned +together with incrementing this reference in root list. This optimization +comes with cost of additional memory search during each symbol allocation. + + +Ownership conventions +--------------------- + +Since data availability is controlled with usage create function and +reference incrementation/decrementation, convention for memory ownership is +required. In case of this project, if not explicitly specified otherwise, +caller of function is owner of all input arguments and remains their owner +after function execution finished (function temporary borrows ownership +of input arguments). If function returns data, ownership of returned data +is passed to function caller. It is responsibility of function caller to +release data returned as result of function execution. + + +Source code +----------- + +mem.h +''''' + +.. literalinclude:: ../src_c/mem.h + :language: c + + +mem.c +''''' + +.. literalinclude:: ../src_c/mem.c + :language: c diff --git a/docs/read.rst b/docs/read.rst new file mode 100644 index 0000000..9d973f4 --- /dev/null +++ b/docs/read.rst @@ -0,0 +1,160 @@ +Data reader +=========== + +Data reader is responsible for reading from input stream and creating +data instances represented with input character sequences. In case of +Lisp, interpreter instructions are represented with data structures. Therefor, +parser for string representation of data is also parser form programming +language itself. Some of data types don't have string representation +(`builtin function`, `builtin syntax`, `function` and `syntax`) and +can not be produced by reader. + +Character ``;`` represents beginning of comment which spawns to the end of line +(until ``\n`` character is read). White space characters (`` ``, ``\n``, +``\r``, ``\t``) and comments are ignored by reader. Only significance of +white space characters is as a data delimiter. + + +Number +------ + +Numbers as encoded as sequence of decimal characters (``0`` to ``9``). +Start of number is detected by starting decimal character. + +Example of valid number representations:: + + 0 + 1 + 42 + + +String +------ + +String is represented with arbitrary number of characters enclosed between +``"`` (maximum string length is 2047). ``\`` is used as escape character +in representation of: + + ``\n``, ``\r``, ``\t``, ``\\``, ``\"`` + +Start of string is detected by ``"`` character. + +Example of valid string representations:: + + "" + "abc" + "\"" + + +Symbol +------ + +Symbol is represented with arbitrary sequence of characters. Sequence can not +include white space characters, ``(`` or ``)``. Sequence can not start with +decimal number character, ``"``, ``'``, ````` or ``,``. + +Example of valid symbol representations:: + + abc + - + +=/@ + symbol-123 + + +Pair/list +--------- + +Pair is represented with form:: + + (<first> . <second>) + +where ``<first>`` and ``<second>`` are arbitrary data representations +(including other pars/lists). + +Nested pairs of form:: + + (<el_1> . (<el_2> . (.... . <el_n>))) + +where ``<el_1>``, ``<el_2>``, ..., ``<el_n>`` is arbitrary data, can be +written as:: + + (<el_1> <el_2> ... . <el_n>) + +Special case of pair is empty list represented as:: + + () + +which can be recursively specified as:: + + (() . ()) + +Sequence of nested pairs with empty list as last element is called list:: + + (<el_1> . (<el_2> . (.... . (<el_n> . ())))) + +and can be written as:: + + (<el_1> <el_2> ... <el_n>) + +Example of valid pairs/lists representations:: + + () + (1 . 2) + (a . (1 . "b")) + (1 2 3 4) + ("abc" abc . 123) + + +Reader macros +------------- + +To enable more concise representation of complex forms, reader recognize +few builtin reader macros. These do not introduce new data types and are used +only as more convenient representation of other standard data forms: + + * quote + + Recognized by starting character ``'``. Forms:: + + '<data> + + are equivalent to:: + + (quote <data>) + + * quasiquote + + Recognized by starting character `````. Forms:: + + `<data> + + are equivalent to:: + + (quasiquote <data>) + + * unquote + + Recognized by starting character ``,``. Forms:: + + ,<data> + + are equivalent to:: + + (unquote <data>) + + +Source code +----------- + +read.h +'''''' + +.. literalinclude:: ../src_c/read.h + :language: c + + +read.c +'''''' + +.. literalinclude:: ../src_c/read.c + :language: c diff --git a/docs/repl.rst b/docs/repl.rst new file mode 100644 index 0000000..9046781 --- /dev/null +++ b/docs/repl.rst @@ -0,0 +1,40 @@ +REPL +==== + +REPL, as it's name suggest, is function implementing endless loop with +following actions: + + * read + + First step is reading data from input stream. + + * evaluate + + Data that was read from input stream represent expression that + should be evaluated by interpreter. + + * print + + Once evaluation finishes, result of evaluation is written to + output stream. In case resulting data is ``()``, print step is + skipped. + +This loop is stopped only in case closing of input or output stream is +detected. + + +Source code +----------- + +repl.h +'''''' + +.. literalinclude:: ../src_c/repl.h + :language: c + + +repl.c +'''''' + +.. literalinclude:: ../src_c/repl.c + :language: c diff --git a/docs/static/custom.css b/docs/static/custom.css new file mode 100644 index 0000000..dc6a004 --- /dev/null +++ b/docs/static/custom.css @@ -0,0 +1,22 @@ + +body > div > nav > div > div.wy-side-nav-search > div.version { + margin-bottom: 0px; +} + +dl { + padding: 5px; +} + +blockquote { + border-left: none; + font-style: normal; + padding: 0 0 0.5rem 0; + margin-block-start: 0.5em; + margin-block-end: 0.5em; + background: transparent; +} + +ol, ul { + margin-top: 0.5rem; + margin-bottom: 0.5rem; +} diff --git a/docs/status.rst b/docs/status.rst new file mode 100644 index 0000000..8ac3628 --- /dev/null +++ b/docs/status.rst @@ -0,0 +1,76 @@ +Result status codes +=================== + +This project adopts widely used convention of returning integer encoded status +codes as function results. + +Each function, that needs to notify it's execution status (success or error), +returns ``lsp_status_t`` (alias for ``lsp_int8_t``). + +Available status codes are: + + * ``LSP_SUCCESS`` + + Execution successful. + + * ``LSP_EOF`` + + End of file encountered during reading/writing. + + * ``LSP_ERR`` + + Generic error (unknown error). + + * ``LSP_ERR_MEM`` + + Memory error (usually out of memory). + + * ``LSP_ERR_CTX`` + + Context error (usually symbol resolution error). + + * ``LSP_ERR_READ`` + + Reader error. + + * ``LSP_ERR_WRITE`` + + Writer error. + + * ``LSP_ERR_EVAL`` + + Evaluation error. + + * ``LSP_ERR_APPLY`` + + Application error. + + * ``LSP_ERR_ARG_COUNT`` + + Invalid argument count. + + * ``LSP_ERR_ARG_TYPE`` + + Invalid argument type. + + * ``LSP_ERR_ARG_VALUE`` + + Invalid argument value. + + * ``LSP_ERR_USER`` + + Special status value representing beginning of user status codes. + +User has ability to raise user error with ``error`` builtin function. This +error is additionally described with integer value in range [0, 126] and +encoded as status code. + + +Source code +----------- + +status.h +'''''''' + +.. literalinclude:: ../src_c/status.h + :language: c diff --git a/docs/stream.rst b/docs/stream.rst new file mode 100644 index 0000000..7b90cec --- /dev/null +++ b/docs/stream.rst @@ -0,0 +1,54 @@ +Input/output stream +=================== + +To enable interaction with interpreter, basic input/output stream abstraction +is needed. This implementation uses platform specific functions defined +by architecture abstraction layer. + + +Input stream +------------ + +Input stream provides functionality of reading unsigned 8bit integers +representing input characters. Implementation utilized `lsp_stream_getchar_t` +function pointer provided during input stream initialization. Together with +`lsp_in_stream_read`, used for reading next available input character, input +stream contains single character buffer used for implementation of +`lsp_in_stream_peek` functionality. + + +Output stream +------------- + +Output stream provides functionality regarding writing character data. +It uses `lsp_stream_putchar_t` function pointer provided during output stream +initialization. Available functions include: + + * `lsp_out_stream_write` + + Write single character to output stream. + + * `lsp_out_stream_write_str` + + Write null terminated character sequence. + + * `lsp_out_stream_write_int` + + Write string representation of signed integer. + + +Source code +----------- + +stream.h +'''''''' + +.. literalinclude:: ../src_c/stream.h + :language: c + + +stream.c +'''''''' + +.. literalinclude:: ../src_c/stream.c + :language: c diff --git a/docs/syntax.rst b/docs/syntax.rst new file mode 100644 index 0000000..71bd35b --- /dev/null +++ b/docs/syntax.rst @@ -0,0 +1,116 @@ +Builtin syntaxes +================ + +This implementation includes minimal number of builtin syntaxes. All other +constructs should be defined as user defined syntaxes in Lisp itself. + +In following examples, lines starting with ``>`` represent characters +provided to input stream. Lines without starting ``>`` character represent +evaluation results written to output stream. + +Available builtin syntaxes are: + + * `lambda` + + Definition of new user defined function. + + Examples:: + + > ((lambda x x) 1 2 3) + (1 2 3) + + > ((lambda (x) x) 1) + 1 + + > ((lambda (x . y) y) 1 2 3) + (2 3) + + * `syntax` + + Definition of new user defined syntax. + + Examples:: + + > ((syntax x x) (lambda x x) 1 2 3) + (1 2 3) + + * `define` + + Add new symbol binding to current context. + + Examples:: + + > (define xyz 42) + > xyz + 42 + + * `set!` + + Change previously defined context entry. + + Examples:: + + > (define xyz 42) + > xyz + 42 + > (set! xyz 24) + > xyz + 24 + + * `begin` + + Evaluate multiple expressions and return result of last expression + evaluation. + + Examples:: + + > (begin 1 2 3) + 3 + + * `quote` + + Evaluates to provided argument. + + Examples:: + + > (quote (1 2 3)) + (1 2 3) + + > '(3 2 1) + (3 2 1) + + * `if` + + If first argument evaluates to `thruthy` value, `if` syntax returns + result of second argument evaluation. If first argument evaluates to + `falsy` value, result of third argument evaluation is returned or + ``()`` if third argument is not available. + + `Falsy` values are ``0``, ``()``, ``""`` and empty symbol. + + `Thruthy` values are all that are not `falsy`. + + Examples:: + + > (if 0 1 2) + 2 + + > (if "0" 1 2) + 1 + + +Source code +----------- + +syntax.h +'''''''' + +.. literalinclude:: ../src_c/syntax.h + :language: c + + +syntax.c +'''''''' + +.. literalinclude:: ../src_c/syntax.c + :language: c diff --git a/docs/write.rst b/docs/write.rst new file mode 100644 index 0000000..b90e2e1 --- /dev/null +++ b/docs/write.rst @@ -0,0 +1,27 @@ +Data writer +=========== + +Data writer enables serialization of data as string characters written +to output stream. Same encoding rules that apply to data reader also apply to +data writer. + +Additionally, data writer will provide informative representation of data +types which can not be parsed by data reader (`builtin function`, +`builtin syntax`, `function` and `syntax`). + + +Source code +----------- + +write.h +''''''' + +.. literalinclude:: ../src_c/write.h + :language: c + + +write.c +''''''' + +.. literalinclude:: ../src_c/write.c + :language: c diff --git a/examples/factorial.lsp b/examples/factorial.lsp new file mode 100644 index 0000000..a539a01 --- /dev/null +++ b/examples/factorial.lsp @@ -0,0 +1,6 @@ +(define (factorial x) + (if x + (* x (factorial (- x 1))) + 1)) + +(factorial 10) diff --git a/format.sh b/format.sh new file mode 100755 index 0000000..82ed3f5 --- /dev/null +++ b/format.sh @@ -0,0 +1,9 @@ +#!/bin/sh + +set -e + +cd $(dirname -- "$0") + +SRC="$(find src_c -name '*.c' -o -name '*.h') $(find test_c -name '*.c')" + +clang-format -style=file -i $SRC diff --git a/src_c/apply.c b/src_c/apply.c new file mode 100644 index 0000000..4dd8684 --- /dev/null +++ b/src_c/apply.c @@ -0,0 +1,140 @@ +#include "apply.h" +#include "ctx.h" +#include "eval.h" +#include "function.h" +#include "syntax.h" +#include "write.h" + + +static lsp_status_t create_ctx(lsp_env_t *e, lsp_addr_t parent_ctx, + lsp_addr_t arg_names, lsp_addr_t arg_values, + lsp_addr_t *result) { + lsp_status_t status = lsp_ctx_copy(e->m, parent_ctx, result); + if (status != LSP_SUCCESS) + return status; + + while (arg_names != e->m->nil) { + if (lsp_mem_is_symbol(e->m, arg_names)) { + status = lsp_ctx_add(e->m, *result, arg_names, arg_values); + arg_values = e->m->nil; + break; + } + + if (arg_values == e->m->nil) { + status = LSP_ERR_ARG_COUNT; + break; + } + + lsp_addr_t arg_name = lsp_mem_get_pair_first(e->m, arg_names); + lsp_addr_t arg_value = lsp_mem_get_pair_first(e->m, arg_values); + + if (!lsp_mem_is_symbol(e->m, arg_name)) { + status = LSP_ERR_ARG_TYPE; + break; + } + + status = lsp_ctx_add(e->m, *result, arg_name, arg_value); + if (status != LSP_SUCCESS) + break; + + arg_names = lsp_mem_get_pair_second(e->m, arg_names); + arg_values = lsp_mem_get_pair_second(e->m, arg_values); + } + + if (status == LSP_SUCCESS && arg_values != e->m->nil) + status = LSP_ERR_ARG_COUNT; + + if (status != LSP_SUCCESS) + lsp_mem_dec_ref(e->m, *result); + + return status; +} + + +static lsp_status_t apply_builtin_function(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t callable, + lsp_addr_t args) { + lsp_uint16_t index = lsp_mem_get_builtin_index(e->m, callable); + lsp_builtin_cb_t cb = lsp_functions[index].cb; + return cb(e, ctx, args); +} + + +static lsp_status_t apply_builtin_syntax(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t callable, lsp_addr_t args) { + lsp_uint16_t index = lsp_mem_get_builtin_index(e->m, callable); + lsp_builtin_cb_t cb = lsp_syntaxes[index].cb; + return cb(e, ctx, args); +} + + +static lsp_status_t apply_function(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t callable, lsp_addr_t args) { + lsp_addr_t parent_ctx = lsp_mem_get_function_parent_ctx(e->m, callable); + lsp_addr_t arg_names = lsp_mem_get_function_args(e->m, callable); + lsp_addr_t body = lsp_mem_get_function_body(e->m, callable); + + lsp_addr_t fn_ctx; + lsp_status_t status = create_ctx(e, parent_ctx, arg_names, args, &fn_ctx); + if (status != LSP_SUCCESS) + return status; + + status = lsp_syntax_begin(e, fn_ctx, body); + lsp_mem_dec_ref(e->m, fn_ctx); + return status; +} + + +static lsp_status_t apply_syntax(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t callable, lsp_addr_t args) { + lsp_addr_t parent_ctx = lsp_mem_get_syntax_parent_ctx(e->m, callable); + lsp_addr_t arg_names = lsp_mem_get_syntax_args(e->m, callable); + lsp_addr_t body = lsp_mem_get_syntax_body(e->m, callable); + + lsp_addr_t syntax_ctx; + lsp_status_t status = + create_ctx(e, parent_ctx, arg_names, args, &syntax_ctx); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result = e->m->nil; + while (body != e->m->nil) { + lsp_mem_dec_ref(e->m, result); + + lsp_addr_t value = lsp_mem_get_pair_first(e->m, body); + status = lsp_env_resolve(e, syntax_ctx, value, &result); + if (status != LSP_SUCCESS) + break; + + body = lsp_mem_get_pair_second(e->m, body); + } + + lsp_mem_dec_ref(e->m, syntax_ctx); + if (status != LSP_SUCCESS) + return status; + + // lsp_write(e->m, e->out, result); + // lsp_out_stream_write(e->out, '\n'); + + status = lsp_env_set_result_eval(e, ctx, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t callable, + lsp_addr_t args) { + if (lsp_mem_is_builtin_function(e->m, callable)) + return apply_builtin_function(e, ctx, callable, args); + + if (lsp_mem_is_builtin_syntax(e->m, callable)) + return apply_builtin_syntax(e, ctx, callable, args); + + if (lsp_mem_is_function(e->m, callable)) + return apply_function(e, ctx, callable, args); + + if (lsp_mem_is_syntax(e->m, callable)) + return apply_syntax(e, ctx, callable, args); + + return LSP_ERR_APPLY; +} diff --git a/src_c/apply.h b/src_c/apply.h new file mode 100644 index 0000000..ef4e1c2 --- /dev/null +++ b/src_c/apply.h @@ -0,0 +1,10 @@ +#ifndef LISP16_APPLY_H +#define LISP16_APPLY_H + +#include "env.h" + + +lsp_status_t lsp_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t callable, + lsp_addr_t args); + +#endif diff --git a/src_c/arch.h b/src_c/arch.h new file mode 100644 index 0000000..01ae8d9 --- /dev/null +++ b/src_c/arch.h @@ -0,0 +1,63 @@ +#ifndef LISP16_ARCH_H +#define LISP16_ARCH_H + +#define LSP_ARCH_POSIX 0 +#define LSP_ARCH_AVR8 1 +#define LSP_ARCH_STM32 2 + +#ifndef LSP_ARCH +#error LSP_ARCH not defined +#endif + +#if LSP_ARCH == LSP_ARCH_POSIX + +#include <stdint.h> +typedef _Bool lsp_bool_t; +typedef int8_t lsp_int8_t; +typedef int16_t lsp_int16_t; +typedef int32_t lsp_int32_t; +typedef uint8_t lsp_uint8_t; +typedef uint16_t lsp_uint16_t; +typedef uint32_t lsp_uint32_t; + +#elif LSP_ARCH == LSP_ARCH_AVR8 + +#include <stdint.h> +typedef _Bool lsp_bool_t; +typedef int8_t lsp_int8_t; +typedef int16_t lsp_int16_t; +typedef int32_t lsp_int32_t; +typedef uint8_t lsp_uint8_t; +typedef uint16_t lsp_uint16_t; +typedef uint32_t lsp_uint32_t; + +#elif LSP_ARCH == LSP_ARCH_STM32 + +#include <stdint.h> +typedef _Bool lsp_bool_t; +typedef int8_t lsp_int8_t; +typedef int16_t lsp_int16_t; +typedef int32_t lsp_int32_t; +typedef uint8_t lsp_uint8_t; +typedef uint16_t lsp_uint16_t; +typedef uint32_t lsp_uint32_t; + +#else + +#error unknown LSP_ARCH + +#endif + +#ifndef NULL +#define NULL ((void *)0) +#endif + +#ifndef true +#define true ((lsp_bool_t)1) +#endif + +#ifndef false +#define false ((lsp_bool_t)0) +#endif + +#endif diff --git a/src_c/arch/avr8.c b/src_c/arch/avr8.c new file mode 100644 index 0000000..cbc454b --- /dev/null +++ b/src_c/arch/avr8.c @@ -0,0 +1,63 @@ +#include "avr8.h" +#include <avr/io.h> + +#define MEM_SIZE 0x01c0 +#define UART_BAUD 9600 + + +static lsp_int16_t avr8_getchar(lsp_in_stream_t *s) { + while (!(UCSR0A & (1 << 7))) + ; + return UDR0; +} + + +static lsp_int16_t avr8_putchar(lsp_out_stream_t *s, lsp_int16_t c) { + while (!(UCSR0A & (1 << 5))) + ; + UDR0 = c; +} + + +static lsp_uint8_t avr8_mem[sizeof(lsp_mem_t) + MEM_SIZE * sizeof(lsp_cell_t)]; + +static lsp_in_stream_t avr8_in_stream; + +static lsp_out_stream_t avr8_out_stream; + + +void lsp_arch_avr8_init() { + UBRR0 = F_CPU / 16 / UART_BAUD - 1; + UCSR0B |= _BV(TXEN0) | _BV(RXEN0); +} + + +lsp_mem_t *lsp_arch_avr8_create_mem() { + lsp_mem_t *m = (void *)avr8_mem; + if (lsp_mem_init(m, MEM_SIZE) != LSP_SUCCESS) + return NULL; + return m; +} + + +void lsp_arch_avr8_free_mem(lsp_mem_t *m) {} + + +lsp_in_stream_t *lsp_arch_avr8_create_in_stream() { + lsp_in_stream_t *s = &avr8_in_stream; + lsp_in_stream_init(s, avr8_getchar); + return s; +} + + +void lsp_arch_avr8_free_in_stream(lsp_in_stream_t *s) {} + + +lsp_out_stream_t *lsp_arch_avr8_create_out_stream() { + lsp_out_stream_t *s = &avr8_out_stream; + lsp_out_stream_init(s, avr8_putchar); + return s; +} + + +void lsp_arch_avr8_free_out_stream(lsp_out_stream_t *s) {} diff --git a/src_c/arch/avr8.h b/src_c/arch/avr8.h new file mode 100644 index 0000000..351ee14 --- /dev/null +++ b/src_c/arch/avr8.h @@ -0,0 +1,30 @@ +#ifndef LISP16_ARCH_AVR8_H +#define LISP16_ARCH_AVR8_H + +#include "../mem.h" +#include "../stream.h" + +#define LSP_ARCH_INIT lsp_arch_avr8_init + +#define LSP_ARCH_CREATE_MEM lsp_arch_avr8_create_mem +#define LSP_ARCH_FREE_MEM lsp_arch_avr8_free_mem + +#define LSP_ARCH_CREATE_IN_STREAM lsp_arch_avr8_create_in_stream +#define LSP_ARCH_FREE_IN_STREAM lsp_arch_avr8_free_in_stream + +#define LSP_ARCH_CREATE_OUT_STREAM lsp_arch_avr8_create_out_stream +#define LSP_ARCH_FREE_OUT_STREAM lsp_arch_avr8_free_out_stream + + +void lsp_arch_avr8_init(); + +lsp_mem_t *lsp_arch_avr8_create_mem(); +void lsp_arch_avr8_free_mem(lsp_mem_t *m); + +lsp_in_stream_t *lsp_arch_avr8_create_in_stream(); +void lsp_arch_avr8_free_in_stream(lsp_in_stream_t *s); + +lsp_out_stream_t *lsp_arch_avr8_create_out_stream(); +void lsp_arch_avr8_free_out_stream(lsp_out_stream_t *s); + +#endif diff --git a/src_c/arch/posix.c b/src_c/arch/posix.c new file mode 100644 index 0000000..19e33a1 --- /dev/null +++ b/src_c/arch/posix.c @@ -0,0 +1,54 @@ +#include "posix.h" +#include <stdio.h> +#include <stdlib.h> + +#define MEM_SIZE 0x4000 + + +static lsp_int16_t posix_getchar(lsp_in_stream_t *s) { + int c = getchar(); + if (c == EOF) + return LSP_EOF; + return c; +} + + +static lsp_int16_t posix_putchar(lsp_out_stream_t *s, lsp_int16_t c) { + return putchar(c); +} + + +void lsp_arch_posix_init() {} + + +lsp_mem_t *lsp_arch_posix_create_mem() { + lsp_mem_t *m = malloc(sizeof(lsp_mem_t) + sizeof(lsp_cell_t) * MEM_SIZE); + if (lsp_mem_init(m, MEM_SIZE) != LSP_SUCCESS) { + free(m); + return NULL; + } + return m; +} + + +void lsp_arch_posix_free_mem(lsp_mem_t *m) { free(m); } + + +lsp_in_stream_t *lsp_arch_posix_create_in_stream() { + lsp_in_stream_t *s = malloc(sizeof(lsp_in_stream_t)); + lsp_in_stream_init(s, posix_getchar); + return s; +} + + +void lsp_arch_posix_free_in_stream(lsp_in_stream_t *s) { free(s); } + + +lsp_out_stream_t *lsp_arch_posix_create_out_stream() { + lsp_out_stream_t *s = malloc(sizeof(lsp_out_stream_t)); + lsp_out_stream_init(s, posix_putchar); + return s; +} + + +void lsp_arch_posix_free_out_stream(lsp_out_stream_t *s) { free(s); } diff --git a/src_c/arch/posix.h b/src_c/arch/posix.h new file mode 100644 index 0000000..5716c0a --- /dev/null +++ b/src_c/arch/posix.h @@ -0,0 +1,30 @@ +#ifndef LISP16_ARCH_POSIX_H +#define LISP16_ARCH_POSIX_H + +#include "../mem.h" +#include "../stream.h" + +#define LSP_ARCH_INIT lsp_arch_posix_init + +#define LSP_ARCH_CREATE_MEM lsp_arch_posix_create_mem +#define LSP_ARCH_FREE_MEM lsp_arch_posix_free_mem + +#define LSP_ARCH_CREATE_IN_STREAM lsp_arch_posix_create_in_stream +#define LSP_ARCH_FREE_IN_STREAM lsp_arch_posix_free_in_stream + +#define LSP_ARCH_CREATE_OUT_STREAM lsp_arch_posix_create_out_stream +#define LSP_ARCH_FREE_OUT_STREAM lsp_arch_posix_free_out_stream + + +void lsp_arch_posix_init(); + +lsp_mem_t *lsp_arch_posix_create_mem(); +void lsp_arch_posix_free_mem(lsp_mem_t *m); + +lsp_in_stream_t *lsp_arch_posix_create_in_stream(); +void lsp_arch_posix_free_in_stream(lsp_in_stream_t *s); + +lsp_out_stream_t *lsp_arch_posix_create_out_stream(); +void lsp_arch_posix_free_out_stream(lsp_out_stream_t *s); + +#endif diff --git a/src_c/buff.c b/src_c/buff.c new file mode 100644 index 0000000..e22eba8 --- /dev/null +++ b/src_c/buff.c @@ -0,0 +1,61 @@ +#include "buff.h" + + +static lsp_status_t update_str(lsp_buff_t *b) { + lsp_uint16_t value_len = + ((b->value == b->m->nil) ? 0 : lsp_mem_get_string_len(b->m, b->value)); + + lsp_addr_t value; + lsp_status_t status = + lsp_mem_create_string(b->m, value_len + b->buff_len, &value); + if (status != LSP_SUCCESS) + return status; + + for (lsp_uint16_t i = 0; i < value_len; ++i) + lsp_mem_set_string_data(b->m, value, i, + lsp_mem_get_string_data(b->m, b->value, i)); + + for (lsp_uint16_t i = 0; i < b->buff_len; ++i) + lsp_mem_set_string_data(b->m, value, i + value_len, b->buff[i]); + + lsp_mem_dec_ref(b->m, b->value); + b->value = value; + b->buff_len = 0; + return LSP_SUCCESS; +} + + +void lsp_buff_init(lsp_buff_t *b, lsp_mem_t *m) { + b->m = m; + b->value = m->nil; + b->buff_len = 0; +} + + +lsp_status_t lsp_buff_push(lsp_buff_t *b, lsp_uint8_t c) { + if (b->buff_len + 1 >= LSP_BUFF_SIZE) { + lsp_status_t status = update_str(b); + if (status != LSP_SUCCESS) + return status; + } + + b->buff[b->buff_len++] = c; + return LSP_SUCCESS; +} + + +lsp_status_t lsp_buff_pop(lsp_buff_t *b, lsp_addr_t *value) { + lsp_status_t status = update_str(b); + if (status != LSP_SUCCESS) + return status; + + *value = b->value; + b->value = b->m->nil; + return LSP_SUCCESS; +} + + +void lsp_buff_clear(lsp_buff_t *b) { + lsp_mem_dec_ref(b->m, b->value); + b->value = b->m->nil; +} diff --git a/src_c/buff.h b/src_c/buff.h new file mode 100644 index 0000000..d17694c --- /dev/null +++ b/src_c/buff.h @@ -0,0 +1,23 @@ +#ifndef LISP16_BUFF_H +#define LISP16_BUFF_H + +#include "mem.h" +#include "status.h" + +#define LSP_BUFF_SIZE 32 + + +typedef struct { + lsp_mem_t *m; + lsp_addr_t value; + lsp_uint8_t buff[LSP_BUFF_SIZE]; + lsp_uint8_t buff_len; +} lsp_buff_t; + + +void lsp_buff_init(lsp_buff_t *b, lsp_mem_t *m); +lsp_status_t lsp_buff_push(lsp_buff_t *b, lsp_uint8_t c); +lsp_status_t lsp_buff_pop(lsp_buff_t *b, lsp_addr_t *value); +void lsp_buff_clear(lsp_buff_t *b); + +#endif diff --git a/src_c/builtin.c b/src_c/builtin.c new file mode 100644 index 0000000..92e1fa8 --- /dev/null +++ b/src_c/builtin.c @@ -0,0 +1,65 @@ +#include "builtin.h" + + +lsp_status_t lsp_builtin_get_args_1(lsp_mem_t *m, lsp_addr_t args, + lsp_addr_t *arg1) { + if (args == m->nil) + return LSP_ERR_ARG_COUNT; + + *arg1 = lsp_mem_get_pair_first(m, args); + + args = lsp_mem_get_pair_second(m, args); + if (args != m->nil) + return LSP_ERR_ARG_COUNT; + + return LSP_SUCCESS; +} + + +lsp_status_t lsp_builtin_get_args_2(lsp_mem_t *m, lsp_addr_t args, + lsp_addr_t *arg1, lsp_addr_t *arg2) { + if (args == m->nil) + return LSP_ERR_ARG_COUNT; + + *arg1 = lsp_mem_get_pair_first(m, args); + + args = lsp_mem_get_pair_second(m, args); + if (args == m->nil) + return LSP_ERR_ARG_COUNT; + + *arg2 = lsp_mem_get_pair_first(m, args); + + args = lsp_mem_get_pair_second(m, args); + if (args != m->nil) + return LSP_ERR_ARG_COUNT; + + return LSP_SUCCESS; +} + + +lsp_status_t lsp_builtin_get_args_3(lsp_mem_t *m, lsp_addr_t args, + lsp_addr_t *arg1, lsp_addr_t *arg2, + lsp_addr_t *arg3) { + if (args == m->nil) + return LSP_ERR_ARG_COUNT; + + *arg1 = lsp_mem_get_pair_first(m, args); + + args = lsp_mem_get_pair_second(m, args); + if (args == m->nil) + return LSP_ERR_ARG_COUNT; + + *arg2 = lsp_mem_get_pair_first(m, args); + + args = lsp_mem_get_pair_second(m, args); + if (args == m->nil) + return LSP_ERR_ARG_COUNT; + + *arg3 = lsp_mem_get_pair_first(m, args); + + args = lsp_mem_get_pair_second(m, args); + if (args != m->nil) + return LSP_ERR_ARG_COUNT; + + return LSP_SUCCESS; +} diff --git a/src_c/builtin.h b/src_c/builtin.h new file mode 100644 index 0000000..af9fb51 --- /dev/null +++ b/src_c/builtin.h @@ -0,0 +1,24 @@ +#ifndef LISP16_BUILTIN_H +#define LISP16_BUILTIN_H + +#include "env.h" + + +typedef lsp_status_t (*lsp_builtin_cb_t)(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); + +typedef struct { + char *name; + lsp_builtin_cb_t cb; +} lsp_builtin_entry_t; + + +lsp_status_t lsp_builtin_get_args_1(lsp_mem_t *m, lsp_addr_t args, + lsp_addr_t *arg1); +lsp_status_t lsp_builtin_get_args_2(lsp_mem_t *m, lsp_addr_t args, + lsp_addr_t *arg1, lsp_addr_t *arg2); +lsp_status_t lsp_builtin_get_args_3(lsp_mem_t *m, lsp_addr_t args, + lsp_addr_t *arg1, lsp_addr_t *arg2, + lsp_addr_t *arg3); + +#endif diff --git a/src_c/cell.c b/src_c/cell.c new file mode 100644 index 0000000..66da137 --- /dev/null +++ b/src_c/cell.c @@ -0,0 +1,50 @@ +#include "cell.h" + + +lsp_uint16_t lsp_cell_get_size(lsp_cell_t *c) { + if (lsp_cell_is_number(c)) { + if (!(c[0] & 0x2000)) + return 1; + + for (lsp_uint8_t i = 1; true; ++i) { + if (!(c[i] & 0x4000)) + return i + 1; + } + + } else if (lsp_cell_is_pair(c)) { + return 2; + + } else if (lsp_cell_is_string_or_symbol(c)) { + return lsp_cell_get_string_symbol_size(*c & 0x07ff); + + } else if (lsp_cell_is_builtin(c)) { + return 1; + + } else if (lsp_cell_is_function_or_syntax(c)) { + return 4; + } + + return 0; +} + + +lsp_uint16_t lsp_cell_get_number_size(lsp_int32_t value) { + lsp_bool_t msb = ((value & 0x1000) ? true : false); + value >>= 13; + if (value == 0 || value == -1) + return 1 + ((msb && !value) ? 1 : 0); + + for (lsp_uint8_t i = 0; 1; ++i) { + msb = ((value & 0x4000) ? 1 : 0); + value >>= 15; + if (value == 0 || value == -1) + return i + 2 + ((msb && !value) ? 1 : 0); + } + + return 0; +} + + +lsp_uint16_t lsp_cell_get_string_symbol_size(lsp_uint16_t len) { + return (((lsp_uint32_t)len << 3) / 15) + ((len % 15) ? 1 : 0) + 1; +} diff --git a/src_c/cell.h b/src_c/cell.h new file mode 100644 index 0000000..b8ed7c0 --- /dev/null +++ b/src_c/cell.h @@ -0,0 +1,215 @@ +#ifndef LISP16_CELL_H +#define LISP16_CELL_H + +#include "arch.h" + + +typedef lsp_uint16_t lsp_cell_t; +typedef lsp_uint16_t lsp_addr_t; // 14 least significant bits used + + +lsp_uint16_t lsp_cell_get_size(lsp_cell_t *c); +lsp_uint16_t lsp_cell_get_number_size(lsp_int32_t value); +lsp_uint16_t lsp_cell_get_string_symbol_size(lsp_uint16_t len); + + +static inline lsp_bool_t lsp_cell_is_number(lsp_cell_t *c) { + return (*c & 0x4000) == 0x0000; +} + +static inline lsp_bool_t lsp_cell_is_pair(lsp_cell_t *c) { + return (*c & 0x6000) == 0x4000; +} + +static inline lsp_bool_t lsp_cell_is_string(lsp_cell_t *c) { + return (*c & 0x7800) == 0x6000; +} + +static inline lsp_bool_t lsp_cell_is_symbol(lsp_cell_t *c) { + return (*c & 0x7800) == 0x6800; +} + +static inline lsp_bool_t lsp_cell_is_builtin_function(lsp_cell_t *c) { + return (*c & 0x7c00) == 0x7000; +} + +static inline lsp_bool_t lsp_cell_is_builtin_syntax(lsp_cell_t *c) { + return (*c & 0x7c00) == 0x7400; +} + +static inline lsp_bool_t lsp_cell_is_function(lsp_cell_t *c) { + return (*c & 0x7c00) == 0x7800; +} + +static inline lsp_bool_t lsp_cell_is_syntax(lsp_cell_t *c) { + return (*c & 0x7c00) == 0x7c00; +} + +static inline lsp_bool_t lsp_cell_is_string_or_symbol(lsp_cell_t *c) { + return (*c & 0x7000) == 0x6000; +} + +static inline lsp_bool_t lsp_cell_is_builtin(lsp_cell_t *c) { + return (*c & 0x7800) == 0x7000; +} + +static inline lsp_bool_t lsp_cell_is_function_or_syntax(lsp_cell_t *c) { + return (*c & 0x7800) == 0x7800; +} + + +static inline void lsp_cell_set_number(lsp_cell_t *c, lsp_int32_t value) { + lsp_uint8_t size = lsp_cell_get_number_size(value); + for (lsp_uint8_t i = 0; i < size; ++i) { + lsp_uint8_t shift = (size - i - 1) * 14; + c[i] = (value >> shift) & (i ? 0x3fff : 0x1fff); + if (i != size - 1) + c[i] |= (i ? 0x4000 : 0x2000); + } +} + +static inline void lsp_cell_set_pair(lsp_cell_t *c, lsp_addr_t first, + lsp_addr_t second) { + c[0] = 0x4000 | ((first >> 1) & 0x1fff); + c[1] = ((first & 1) ? 0x4000 : 0) | (second & 0x3fff); +} + +static inline void lsp_cell_set_string(lsp_cell_t *c, lsp_uint16_t data_len) { + lsp_uint16_t size = lsp_cell_get_string_symbol_size(data_len); + c[0] = 0x6000 | (data_len & 0x07ff); + for (lsp_uint16_t i = 1; i < size; ++i) + c[i] = 0; +} + +static inline void lsp_cell_set_string_data(lsp_cell_t *c, lsp_uint16_t i, + lsp_uint8_t data_i) { + lsp_uint32_t bit_count = (lsp_uint32_t)i << 3; + lsp_uint16_t start_cell = bit_count / 15; + lsp_uint8_t bit_shift = bit_count % 15; + lsp_uint16_t mask = 0x7f80 >> bit_shift; + if (bit_shift < 8) { + c[1 + start_cell] = (c[1 + start_cell] & ~mask) | + ((lsp_uint16_t)data_i << (7 - bit_shift)); + } else { + c[1 + start_cell] = + (c[1 + start_cell] & ~mask) | (data_i >> (bit_shift - 7)); + bit_shift = 22 - bit_shift; + mask = (0xffff << bit_shift) & 0x7fff; + c[2 + start_cell] = (c[2 + start_cell] & ~mask) | + (((lsp_uint16_t)data_i << bit_shift) & mask); + } +} + +static inline void lsp_cell_set_symbol(lsp_cell_t *c, lsp_uint16_t name_len) { + lsp_uint16_t size = lsp_cell_get_string_symbol_size(name_len); + c[0] = 0x6800 | (name_len & 0x07ff); + for (lsp_uint16_t i = 1; i < size; ++i) + c[i] = 0; +} + +static inline void lsp_cell_set_symbol_name(lsp_cell_t *c, lsp_uint16_t i, + lsp_uint8_t name_i) { + lsp_cell_set_string_data(c, i, name_i); +} + +static inline void lsp_cell_set_builtin_function(lsp_cell_t *c, + lsp_uint16_t index) { + *c = 0x7000 | (index & 0x03ff); +} + +static inline void lsp_cell_set_builtin_syntax(lsp_cell_t *c, + lsp_uint16_t index) { + *c = 0x7400 | (index & 0x03ff); +} + +static inline void lsp_cell_set_function(lsp_cell_t *c, lsp_addr_t parent_ctx, + lsp_addr_t args, lsp_addr_t body) { + c[0] = 0x7800; + c[1] = parent_ctx & 0x3fff; + c[2] = args & 0x3fff; + c[3] = body & 0x3fff; +} + +static inline void lsp_cell_set_syntax(lsp_cell_t *c, lsp_addr_t parent_ctx, + lsp_addr_t args, lsp_addr_t body) { + c[0] = 0x7c00; + c[1] = parent_ctx & 0x3fff; + c[2] = args & 0x3fff; + c[3] = body & 0x3fff; +} + + +static inline lsp_int32_t lsp_cell_get_number(lsp_cell_t *c) { + lsp_int32_t v = ((c[0] & 0x1000) ? -1 : 0); + v = (v << 12) | (c[0] & 0x0fff); + if (!(c[0] & 0x2000)) + return v; + for (lsp_uint8_t i = 1; 1; ++i) { + v = (v << 14) | (c[1] & 0x3fff); + if (!(c[i] & 0x4000)) + return v; + } +} + +static inline lsp_addr_t lsp_cell_get_pair_first(lsp_cell_t *c) { + return ((c[0] & 0x1fff) << 1) + ((c[1] & 0x4000) ? 1 : 0); +} + +static inline lsp_addr_t lsp_cell_get_pair_second(lsp_cell_t *c) { + return c[1] & 0x3fff; +} + +static inline lsp_uint16_t lsp_cell_get_string_len(lsp_cell_t *c) { + return *c & 0x07ff; +} + +static inline lsp_uint8_t lsp_cell_get_string_data(lsp_cell_t *c, + lsp_uint16_t i) { + lsp_uint32_t bit_count = (lsp_uint32_t)i << 3; + lsp_uint16_t start_cell = bit_count / 15; + lsp_uint8_t start_bit = 14 - (bit_count % 15); + if (start_bit >= 7) + return (c[1 + start_cell] >> (start_bit - 7)) & 0xff; + return ((c[1 + start_cell] << (7 - start_bit)) | + ((c[2 + start_cell] & 0x7fff) >> (8 + start_bit))) & + 0xff; +} + +static inline lsp_uint16_t lsp_cell_get_symbol_len(lsp_cell_t *c) { + return lsp_cell_get_string_len(c); +} + +static inline lsp_uint8_t lsp_cell_get_symbol_name(lsp_cell_t *c, + lsp_uint16_t i) { + return lsp_cell_get_string_data(c, i); +} + +static inline lsp_uint16_t lsp_cell_get_builtin_index(lsp_cell_t *c) { + return *c & 0x03ff; +} + +static inline lsp_addr_t lsp_cell_get_function_parent_ctx(lsp_cell_t *c) { + return c[1] & 0x3fff; +} + +static inline lsp_addr_t lsp_cell_get_function_args(lsp_cell_t *c) { + return c[2] & 0x3fff; +} + +static inline lsp_addr_t lsp_cell_get_function_body(lsp_cell_t *c) { + return c[3] & 0x3fff; +} + +static inline lsp_addr_t lsp_cell_get_syntax_parent_ctx(lsp_cell_t *c) { + return lsp_cell_get_function_parent_ctx(c); +} + +static inline lsp_addr_t lsp_cell_get_syntax_args(lsp_cell_t *c) { + return lsp_cell_get_function_args(c); +} + +static inline lsp_addr_t lsp_cell_get_syntax_body(lsp_cell_t *c) { + return lsp_cell_get_function_body(c); +} + +#endif diff --git a/src_c/ctx.c b/src_c/ctx.c new file mode 100644 index 0000000..693ea53 --- /dev/null +++ b/src_c/ctx.c @@ -0,0 +1,231 @@ +#include "ctx.h" +#include "function.h" +#include "syntax.h" + + +static lsp_bool_t contains_symbol(lsp_mem_t *m, lsp_addr_t ctx, + lsp_addr_t symbol) { + while (ctx != m->nil) { + lsp_addr_t entry = lsp_mem_get_pair_first(m, ctx); + lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry); + + if (lsp_mem_eq(m, entry_symbol, symbol)) + return true; + + ctx = lsp_mem_get_pair_second(m, ctx); + } + + return false; +} + + +static lsp_status_t remove_symbol(lsp_mem_t *m, lsp_addr_t ctx, + lsp_addr_t symbol) { + lsp_addr_t list = lsp_mem_get_pair_first(m, ctx); + + lsp_addr_t result = m->nil; + lsp_addr_t result_last = m->nil; + lsp_status_t status = LSP_SUCCESS; + + while (list != m->nil) { + lsp_addr_t entry = lsp_mem_get_pair_first(m, list); + lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry); + list = lsp_mem_get_pair_second(m, list); + + if (lsp_mem_eq(m, entry_symbol, symbol)) { + if (result == m->nil) { + result = list; + status = lsp_mem_inc_ref(m, list); + + } else { + lsp_mem_set_pair_second(m, result_last, list); + } + + break; + } + + lsp_addr_t new_result_last; + status = lsp_mem_create_pair(m, entry, m->nil, &new_result_last); + if (status != LSP_SUCCESS) + break; + + if (result == m->nil) { + result = new_result_last; + + } else { + lsp_mem_set_pair_second(m, result_last, new_result_last); + lsp_mem_dec_ref(m, new_result_last); + } + + result_last = new_result_last; + } + + if (status == LSP_SUCCESS) + lsp_mem_set_pair_first(m, ctx, result); + + lsp_mem_dec_ref(m, result); + return status; +} + + +lsp_status_t lsp_ctx_create(lsp_mem_t *m, lsp_addr_t *ctx) { + lsp_addr_t list = m->nil; + lsp_addr_t list_last = m->nil; + lsp_status_t status = LSP_SUCCESS; + + for (uint8_t i = 0; status == LSP_SUCCESS && lsp_syntaxes[i].name; ++i) { + lsp_addr_t symbol; + status = + lsp_mem_create_symbol_from_char(m, lsp_syntaxes[i].name, &symbol); + if (status != LSP_SUCCESS) + break; + + lsp_addr_t value; + status = lsp_mem_create_builtin_syntax(m, i, &value); + if (status != LSP_SUCCESS) { + lsp_mem_dec_ref(m, symbol); + break; + } + + lsp_addr_t entry; + status = lsp_mem_create_pair(m, symbol, value, &entry); + lsp_mem_dec_ref(m, symbol); + lsp_mem_dec_ref(m, value); + if (status != LSP_SUCCESS) + break; + + lsp_addr_t new_list_last; + status = lsp_mem_create_pair(m, entry, m->nil, &new_list_last); + lsp_mem_dec_ref(m, entry); + if (status != LSP_SUCCESS) + break; + + if (list == m->nil) { + list = new_list_last; + + } else { + lsp_mem_set_pair_second(m, list_last, new_list_last); + lsp_mem_dec_ref(m, new_list_last); + } + + list_last = new_list_last; + } + + for (uint8_t i = 0; status == LSP_SUCCESS && lsp_functions[i].name; ++i) { + lsp_addr_t symbol; + status = + lsp_mem_create_symbol_from_char(m, lsp_functions[i].name, &symbol); + if (status != LSP_SUCCESS) + break; + + lsp_addr_t value; + status = lsp_mem_create_builtin_function(m, i, &value); + if (status != LSP_SUCCESS) { + lsp_mem_dec_ref(m, symbol); + break; + } + + lsp_addr_t entry; + status = lsp_mem_create_pair(m, symbol, value, &entry); + lsp_mem_dec_ref(m, symbol); + lsp_mem_dec_ref(m, value); + if (status != LSP_SUCCESS) + break; + + lsp_addr_t new_list_last; + status = lsp_mem_create_pair(m, entry, m->nil, &new_list_last); + lsp_mem_dec_ref(m, entry); + if (status != LSP_SUCCESS) + break; + + if (list == m->nil) { + list = new_list_last; + + } else { + lsp_mem_set_pair_second(m, list_last, new_list_last); + lsp_mem_dec_ref(m, new_list_last); + } + + list_last = new_list_last; + } + + if (status == LSP_SUCCESS) + status = lsp_mem_create_pair(m, list, m->nil, ctx); + + lsp_mem_dec_ref(m, list); + return status; +} + + +lsp_status_t lsp_ctx_copy(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t *result) { + lsp_addr_t list = lsp_mem_get_pair_first(m, ctx); + return lsp_mem_create_pair(m, list, m->nil, result); +} + + +lsp_status_t lsp_ctx_add(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol, + lsp_addr_t value) { + lsp_status_t status; + + if (contains_symbol(m, ctx, symbol)) { + status = remove_symbol(m, ctx, symbol); + if (status != LSP_SUCCESS) + return status; + } + + lsp_addr_t list = lsp_mem_get_pair_first(m, ctx); + + lsp_addr_t entry; + status = lsp_mem_create_pair(m, symbol, value, &entry); + if (status != LSP_SUCCESS) + return status; + + status = lsp_mem_create_pair(m, entry, list, &list); + lsp_mem_dec_ref(m, entry); + if (status != LSP_SUCCESS) + return status; + + lsp_mem_set_pair_first(m, ctx, list); + lsp_mem_dec_ref(m, list); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_ctx_set(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol, + lsp_addr_t value) { + lsp_addr_t list = lsp_mem_get_pair_first(m, ctx); + + while (list != m->nil) { + lsp_addr_t entry = lsp_mem_get_pair_first(m, list); + lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry); + + if (lsp_mem_eq(m, symbol, entry_symbol)) { + lsp_mem_set_pair_second(m, entry, value); + return LSP_SUCCESS; + } + + list = lsp_mem_get_pair_second(m, list); + } + + return LSP_ERR_CTX; +} + + +lsp_status_t lsp_ctx_get(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol, + lsp_addr_t *value) { + lsp_addr_t list = lsp_mem_get_pair_first(m, ctx); + + while (list != m->nil) { + lsp_addr_t entry = lsp_mem_get_pair_first(m, list); + lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry); + + if (lsp_mem_eq(m, symbol, entry_symbol)) { + *value = lsp_mem_get_pair_second(m, entry); + return lsp_mem_inc_ref(m, *value); + } + + list = lsp_mem_get_pair_second(m, list); + } + + return LSP_ERR_CTX; +} diff --git a/src_c/ctx.h b/src_c/ctx.h new file mode 100644 index 0000000..02740a0 --- /dev/null +++ b/src_c/ctx.h @@ -0,0 +1,16 @@ +#ifndef LISP16_CTX_H +#define LISP16_CTX_H + +#include "mem.h" + + +lsp_status_t lsp_ctx_create(lsp_mem_t *m, lsp_addr_t *ctx); +lsp_status_t lsp_ctx_copy(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t *result); +lsp_status_t lsp_ctx_add(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol, + lsp_addr_t value); +lsp_status_t lsp_ctx_set(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol, + lsp_addr_t value); +lsp_status_t lsp_ctx_get(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol, + lsp_addr_t *value); + +#endif diff --git a/src_c/env.c b/src_c/env.c new file mode 100644 index 0000000..13999d5 --- /dev/null +++ b/src_c/env.c @@ -0,0 +1,86 @@ +#include "env.h" +#include "ctx.h" +#include "eval.h" + + +static void init_result(lsp_env_t *e) { + e->result.is_value = true; + e->result.ctx = e->m->nil; + e->result.value = e->m->nil; +} + + +static void release_result(lsp_env_t *e) { + lsp_mem_dec_ref(e->m, e->result.ctx); + lsp_mem_dec_ref(e->m, e->result.value); + + init_result(e); +} + + +void lsp_env_init(lsp_env_t *e, lsp_mem_t *m, lsp_in_stream_t *in, + lsp_out_stream_t *out) { + e->m = m; + e->in = in; + e->out = out; + + init_result(e); +} + + +lsp_status_t lsp_env_set_result_value(lsp_env_t *e, lsp_addr_t value) { + release_result(e); + + lsp_status_t status = lsp_mem_inc_ref(e->m, value); + if (status != LSP_SUCCESS) + return status; + + e->result.is_value = true; + e->result.value = value; + return LSP_SUCCESS; +} + + +lsp_status_t lsp_env_set_result_eval(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t value) { + release_result(e); + + lsp_status_t status = lsp_mem_inc_ref(e->m, ctx); + if (status != LSP_SUCCESS) + return status; + + status = lsp_mem_inc_ref(e->m, value); + if (status != LSP_SUCCESS) { + lsp_mem_dec_ref(e->m, ctx); + return status; + } + + e->result.is_value = false; + e->result.ctx = ctx; + e->result.value = value; + return LSP_SUCCESS; +} + + +lsp_status_t lsp_env_resolve(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value, + lsp_addr_t *result) { + lsp_status_t status = lsp_env_set_result_eval(e, ctx, value); + if (status != LSP_SUCCESS) + return status; + + while (!e->result.is_value) { + lsp_addr_t eval_ctx = e->result.ctx; + lsp_addr_t eval_value = e->result.value; + init_result(e); + + status = lsp_eval(e, eval_ctx, eval_value); + lsp_mem_dec_ref(e->m, eval_ctx); + lsp_mem_dec_ref(e->m, eval_value); + if (status != LSP_SUCCESS) + return status; + } + + *result = e->result.value; + init_result(e); + return LSP_SUCCESS; +} diff --git a/src_c/env.h b/src_c/env.h new file mode 100644 index 0000000..026cd18 --- /dev/null +++ b/src_c/env.h @@ -0,0 +1,30 @@ +#ifndef LISP16_ENV_H +#define LISP16_ENV_H + +#include "mem.h" +#include "stream.h" + + +typedef struct { + lsp_mem_t *m; + lsp_in_stream_t *in; + lsp_out_stream_t *out; + + // internal + struct { + lsp_bool_t is_value; + lsp_addr_t ctx; + lsp_addr_t value; + } result; +} lsp_env_t; + + +void lsp_env_init(lsp_env_t *e, lsp_mem_t *m, lsp_in_stream_t *in, + lsp_out_stream_t *out); +lsp_status_t lsp_env_set_result_value(lsp_env_t *e, lsp_addr_t value); +lsp_status_t lsp_env_set_result_eval(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t value); +lsp_status_t lsp_env_resolve(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value, + lsp_addr_t *result); + +#endif diff --git a/src_c/eval.c b/src_c/eval.c new file mode 100644 index 0000000..e04537e --- /dev/null +++ b/src_c/eval.c @@ -0,0 +1,92 @@ +#include "eval.h" +#include "ctx.h" +#include "apply.h" + + +static lsp_status_t eval_args(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args, + lsp_addr_t *result) { + lsp_addr_t last = e->m->nil; + *result = e->m->nil; + lsp_status_t status; + + while (args != e->m->nil) { + lsp_addr_t arg = lsp_mem_get_pair_first(e->m, args); + status = lsp_env_resolve(e, ctx, arg, &arg); + if (status != LSP_SUCCESS) + goto error; + + lsp_addr_t new_last; + status = lsp_mem_create_pair(e->m, arg, e->m->nil, &new_last); + lsp_mem_dec_ref(e->m, arg); + if (status != LSP_SUCCESS) + goto error; + + if (*result == e->m->nil) { + *result = new_last; + + } else { + lsp_mem_set_pair_second(e->m, last, new_last); + lsp_mem_dec_ref(e->m, new_last); + } + + last = new_last; + args = lsp_mem_get_pair_second(e->m, args); + } + + return LSP_SUCCESS; + +error: + lsp_mem_dec_ref(e->m, *result); + return status; +} + + +lsp_status_t lsp_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value) { + lsp_status_t status = LSP_SUCCESS; + + if (lsp_mem_is_number(e->m, value) || lsp_mem_is_string(e->m, value) || + lsp_mem_is_builtin(e->m, value) || + lsp_mem_is_function_or_syntax(e->m, value)) + return lsp_env_set_result_value(e, value); + + if (lsp_mem_is_symbol(e->m, value)) { + lsp_addr_t result; + status = lsp_ctx_get(e->m, ctx, value, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; + } + + if (lsp_mem_is_pair(e->m, value)) { + if (value == e->m->nil) + return lsp_env_set_result_value(e, e->m->nil); + + lsp_addr_t callable = lsp_mem_get_pair_first(e->m, value); + lsp_addr_t args = lsp_mem_get_pair_second(e->m, value); + + status = lsp_env_resolve(e, ctx, callable, &callable); + if (status != LSP_SUCCESS) + return status; + + if (lsp_mem_is_builtin_function(e->m, callable) || + lsp_mem_is_function(e->m, callable)) { + status = eval_args(e, ctx, args, &args); + } else { + status = lsp_mem_inc_ref(e->m, args); + } + if (status != LSP_SUCCESS) { + lsp_mem_dec_ref(e->m, callable); + return status; + } + + status = lsp_apply(e, ctx, callable, args); + lsp_mem_dec_ref(e->m, callable); + lsp_mem_dec_ref(e->m, args); + return status; + } + + return LSP_ERR_EVAL; +} diff --git a/src_c/eval.h b/src_c/eval.h new file mode 100644 index 0000000..4f40270 --- /dev/null +++ b/src_c/eval.h @@ -0,0 +1,9 @@ +#ifndef LISP16_EVAL_H +#define LISP16_EVAL_H + +#include "env.h" + + +lsp_status_t lsp_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value); + +#endif diff --git a/src_c/function.c b/src_c/function.c new file mode 100644 index 0000000..075261a --- /dev/null +++ b/src_c/function.c @@ -0,0 +1,582 @@ +#include "function.h" +#include "apply.h" +#include "eval.h" +#include "read.h" +#include "write.h" + + +lsp_builtin_entry_t lsp_functions[] = { + {"eval", lsp_function_eval}, + {"apply", lsp_function_apply}, + {"error", lsp_function_error}, + {"cons", lsp_function_cons}, + {"set-car!", lsp_function_set_car}, + {"set-cdr!", lsp_function_set_cdr}, + {"number?", lsp_function_is_number}, + {"pair?", lsp_function_is_pair}, + {"string?", lsp_function_is_string}, + {"symbol?", lsp_function_is_symbol}, + {"function?", lsp_function_is_function}, + {"syntax?", lsp_function_is_syntax}, + {"eq?", lsp_function_eq}, + {"equal?", lsp_function_equal}, + {">", lsp_function_gt}, + {"<", lsp_function_lt}, + {"+", lsp_function_plus}, + {"-", lsp_function_minus}, + {"*", lsp_function_multiply}, + {"/", lsp_function_divide}, + {"read", lsp_function_read}, + {"read-u8", lsp_function_read_u8}, + {"peek-u8", lsp_function_peek_u8}, + {"write", lsp_function_write}, + {"write-u8", lsp_function_write_u8}, + {"make-string", lsp_function_make_string}, + {"string-length", lsp_function_string_length}, + {"string-ref", lsp_function_string_ref}, + {"string-set!", lsp_function_string_set}, + {NULL, NULL}}; + + +lsp_status_t lsp_function_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + return lsp_eval(e, ctx, value); +} + + +lsp_status_t lsp_function_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t callable; + lsp_addr_t arguments; + lsp_status_t status = + lsp_builtin_get_args_2(e->m, args, &callable, &arguments); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_builtin(e->m, callable) && + !lsp_mem_is_function_or_syntax(e->m, callable)) + return LSP_ERR_ARG_TYPE; + + return lsp_apply(e, ctx, callable, arguments); +} + + +lsp_status_t lsp_function_error(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_number(e->m, value)) + return LSP_ERR_ARG_TYPE; + + lsp_int32_t code = lsp_mem_get_number(e->m, value); + if (code < 0 || code > 126) + return LSP_ERR_ARG_VALUE; + + return LSP_ERR_USER + code; +} + + +lsp_status_t lsp_function_cons(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t first; + lsp_addr_t second; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &first, &second); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_pair(e->m, first, second, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_set_car(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t pair; + lsp_addr_t first; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &pair, &first); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_pair(e->m, pair)) + return LSP_ERR_ARG_TYPE; + + if (pair == e->m->nil) + return LSP_ERR_ARG_VALUE; + + lsp_mem_set_pair_first(e->m, pair, first); + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_function_set_cdr(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t pair; + lsp_addr_t second; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &pair, &second); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_pair(e->m, pair)) + return LSP_ERR_ARG_TYPE; + + if (pair == e->m->nil) + return LSP_ERR_ARG_VALUE; + + lsp_mem_set_pair_second(e->m, pair, second); + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_function_is_number(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_number = lsp_mem_is_number(e->m, value); + return lsp_env_set_result_value(e, (is_number ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_is_pair(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_pair = lsp_mem_is_pair(e->m, value); + return lsp_env_set_result_value(e, (is_pair ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_is_string(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_string = lsp_mem_is_string(e->m, value); + return lsp_env_set_result_value(e, (is_string ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_is_symbol(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_symbol = lsp_mem_is_symbol(e->m, value); + return lsp_env_set_result_value(e, (is_symbol ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_is_function(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_function = lsp_mem_is_function(e->m, value) || + lsp_mem_is_builtin_function(e->m, value); + return lsp_env_set_result_value(e, (is_function ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_is_syntax(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_syntax = lsp_mem_is_syntax(e->m, value) || + lsp_mem_is_builtin_syntax(e->m, value); + return lsp_env_set_result_value(e, (is_syntax ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_eq(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t first; + lsp_addr_t second; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &first, &second); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_eq = lsp_mem_eq(e->m, first, second); + return lsp_env_set_result_value(e, (is_eq ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_equal(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t first; + lsp_addr_t second; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &first, &second); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_equal = lsp_mem_equal(e->m, first, second); + return lsp_env_set_result_value(e, (is_equal ? e->m->one : e->m->zero)); +} + + +lsp_status_t lsp_function_gt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t last_value = e->m->nil; + + while (args != e->m->nil) { + lsp_addr_t value = lsp_mem_get_pair_first(e->m, args); + if (!lsp_mem_is_number(e->m, value)) + return LSP_ERR_ARG_TYPE; + + if (last_value != e->m->nil && lsp_mem_get_number(e->m, last_value) <= + lsp_mem_get_number(e->m, value)) + return lsp_env_set_result_value(e, e->m->zero); + + last_value = value; + args = lsp_mem_get_pair_second(e->m, args); + } + + return lsp_env_set_result_value(e, e->m->one); +} + + +lsp_status_t lsp_function_lt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t last_value = e->m->nil; + + while (args != e->m->nil) { + lsp_addr_t value = lsp_mem_get_pair_first(e->m, args); + if (!lsp_mem_is_number(e->m, value)) + return LSP_ERR_ARG_TYPE; + + if (last_value != e->m->nil && lsp_mem_get_number(e->m, last_value) >= + lsp_mem_get_number(e->m, value)) + return lsp_env_set_result_value(e, e->m->zero); + + last_value = value; + args = lsp_mem_get_pair_second(e->m, args); + } + + return lsp_env_set_result_value(e, e->m->one); +} + + +lsp_status_t lsp_function_plus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_int32_t value = 0; + + while (args != e->m->nil) { + lsp_addr_t i = lsp_mem_get_pair_first(e->m, args); + if (!lsp_mem_is_number(e->m, i)) + return LSP_ERR_ARG_TYPE; + + value += lsp_mem_get_number(e->m, i); + args = lsp_mem_get_pair_second(e->m, args); + } + + lsp_addr_t result; + lsp_status_t status = lsp_mem_create_number(e->m, value, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_minus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_int32_t value; + lsp_uint16_t counter = 0; + + while (args != e->m->nil) { + lsp_addr_t i = lsp_mem_get_pair_first(e->m, args); + if (!lsp_mem_is_number(e->m, i)) + return LSP_ERR_ARG_TYPE; + + if (++counter > 1) { + value -= lsp_mem_get_number(e->m, i); + } else { + value = lsp_mem_get_number(e->m, i); + } + + args = lsp_mem_get_pair_second(e->m, args); + } + + if (!counter) + return LSP_ERR_ARG_COUNT; + + if (counter < 2) + value = -value; + + lsp_addr_t result; + lsp_status_t status = lsp_mem_create_number(e->m, value, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_multiply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_int32_t value = 1; + + while (args != e->m->nil) { + lsp_addr_t i = lsp_mem_get_pair_first(e->m, args); + if (!lsp_mem_is_number(e->m, i)) + return LSP_ERR_ARG_TYPE; + + value *= lsp_mem_get_number(e->m, i); + args = lsp_mem_get_pair_second(e->m, args); + } + + lsp_addr_t result; + lsp_status_t status = lsp_mem_create_number(e->m, value, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_divide(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_int32_t value; + lsp_uint16_t counter = 0; + + while (args != e->m->nil) { + lsp_addr_t i = lsp_mem_get_pair_first(e->m, args); + if (!lsp_mem_is_number(e->m, i)) + return LSP_ERR_ARG_TYPE; + + if (++counter > 1) { + value /= lsp_mem_get_number(e->m, i); + } else { + value = lsp_mem_get_number(e->m, i); + } + + args = lsp_mem_get_pair_second(e->m, args); + } + + if (!counter) + return LSP_ERR_ARG_COUNT; + + if (counter < 2) + value = 1 / value; + + lsp_addr_t result; + lsp_status_t status = lsp_mem_create_number(e->m, value, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + + +lsp_status_t lsp_function_read(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args != e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t value; + lsp_status_t status = lsp_read(e->m, e->in, &value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, value); + lsp_mem_dec_ref(e->m, value); + return status; +} + + +lsp_status_t lsp_function_read_u8(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + if (args != e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_read(e->in, &c); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_number(e->m, c, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_peek_u8(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + if (args != e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_peek(e->in, &c); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_number(e->m, c, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_write(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_write(e->m, e->out, value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_function_write_u8(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_number(e->m, value)) + return LSP_ERR_ARG_TYPE; + + lsp_uint8_t c = lsp_mem_get_number(e->m, value); + status = lsp_out_stream_write(e->out, c); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_function_make_string(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_number(e->m, value)) + return LSP_ERR_ARG_TYPE; + + lsp_uint16_t str_len = lsp_mem_get_number(e->m, value); + + lsp_addr_t result; + status = lsp_mem_create_string(e->m, str_len, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_string_length(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t str; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &str); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_string(e->m, str)) + return LSP_ERR_ARG_TYPE; + + lsp_uint16_t str_len = lsp_mem_get_string_len(e->m, str); + + lsp_addr_t result; + status = lsp_mem_create_number(e->m, str_len, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_string_ref(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t str; + lsp_addr_t index; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &str, &index); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_string(e->m, str) || !lsp_mem_is_number(e->m, index)) + return LSP_ERR_ARG_TYPE; + + lsp_uint16_t i = lsp_mem_get_number(e->m, index); + lsp_uint16_t str_len = lsp_mem_get_string_len(e->m, str); + if (i >= str_len) + return LSP_ERR_ARG_VALUE; + + lsp_uint8_t c = lsp_mem_get_string_data(e->m, str, i); + + lsp_addr_t result; + status = lsp_mem_create_number(e->m, c, &result); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_function_string_set(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args) { + lsp_addr_t str; + lsp_addr_t index; + lsp_addr_t value; + lsp_status_t status = + lsp_builtin_get_args_3(e->m, args, &str, &index, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_string(e->m, str) || !lsp_mem_is_number(e->m, index) || + !lsp_mem_is_number(e->m, value)) + return LSP_ERR_ARG_TYPE; + + lsp_uint16_t i = lsp_mem_get_number(e->m, index); + lsp_uint16_t str_len = lsp_mem_get_string_len(e->m, str); + if (i >= str_len) + return LSP_ERR_ARG_VALUE; + + lsp_mem_set_string_data(e->m, str, i, lsp_mem_get_number(e->m, value)); + + return lsp_env_set_result_value(e, e->m->nil); +} diff --git a/src_c/function.h b/src_c/function.h new file mode 100644 index 0000000..ce249c4 --- /dev/null +++ b/src_c/function.h @@ -0,0 +1,54 @@ +#ifndef LISP16_FUNCTION_H +#define LISP16_FUNCTION_H + +#include "builtin.h" + + +extern lsp_builtin_entry_t lsp_functions[]; + +lsp_status_t lsp_function_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_error(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_cons(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_set_car(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_set_cdr(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_is_number(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_is_pair(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_is_string(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_is_symbol(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_is_function(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_is_syntax(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_eq(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_equal(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_gt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_lt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_plus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_minus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_multiply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_divide(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_read(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_read_u8(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_peek_u8(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_write(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_function_write_u8(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_make_string(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_string_length(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_string_ref(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); +lsp_status_t lsp_function_string_set(lsp_env_t *e, lsp_addr_t ctx, + lsp_addr_t args); + +#endif diff --git a/src_c/main.c b/src_c/main.c new file mode 100644 index 0000000..c09a38b --- /dev/null +++ b/src_c/main.c @@ -0,0 +1,55 @@ +#include "ctx.h" +#include "repl.h" + +#if LSP_ARCH == LSP_ARCH_POSIX +#include "arch/posix.h" +#elif LSP_ARCH == LSP_ARCH_AVR8 +#include "arch/avr8.h" +#elif LSP_ARCH == LSP_ARCH_STM32 +#include "arch/stm32.h" +#endif + + +int main() { + lsp_mem_t *m = NULL; + lsp_in_stream_t *in = NULL; + lsp_out_stream_t *out = NULL; + lsp_status_t status = LSP_ERR; + + LSP_ARCH_INIT(); + + m = LSP_ARCH_CREATE_MEM(); + if (!m) + goto cleanup; + + in = LSP_ARCH_CREATE_IN_STREAM(); + if (!in) + goto cleanup; + + out = LSP_ARCH_CREATE_OUT_STREAM(); + if (!out) + goto cleanup; + + lsp_env_t e; + lsp_env_init(&e, m, in, out); + + lsp_addr_t ctx; + status = lsp_ctx_create(m, &ctx); + if (status != LSP_SUCCESS) + goto cleanup; + + status = lsp_repl(&e, ctx); + lsp_mem_dec_ref(m, ctx); + +cleanup: + if (out) + LSP_ARCH_FREE_OUT_STREAM(out); + + if (in) + LSP_ARCH_FREE_IN_STREAM(in); + + if (m) + LSP_ARCH_FREE_MEM(m); + + return ((status == LSP_EOF) ? 0 : 1); +} diff --git a/src_c/mem.c b/src_c/mem.c new file mode 100644 index 0000000..31ca83d --- /dev/null +++ b/src_c/mem.c @@ -0,0 +1,478 @@ +#include "mem.h" + + +static inline lsp_bool_t get_mark(lsp_cell_t *c) { + return ((*c & 0x8000) ? true : false); +} + + +static inline void set_mark(lsp_cell_t *c, lsp_bool_t mark) { + if (mark) { + *c |= 0x8000; + } else { + *c &= 0x7fff; + } +} + + +static void restore(lsp_mem_t *m, lsp_addr_t addr) { + while (true) { + lsp_cell_t *c = m->cells + addr; + if (!get_mark(c)) + break; + + lsp_uint16_t c_size = lsp_cell_get_size(c); + for (lsp_uint16_t i = 0; i < c_size; ++i) + set_mark(c + i, false); + + if (lsp_cell_is_pair(c)) { + restore(m, lsp_cell_get_pair_first(c)); + addr = lsp_cell_get_pair_second(c); + + } else if (lsp_cell_is_function(c)) { + restore(m, lsp_cell_get_function_parent_ctx(c)); + restore(m, lsp_cell_get_function_args(c)); + addr = lsp_cell_get_function_body(c); + + } else if (lsp_cell_is_syntax(c)) { + restore(m, lsp_cell_get_syntax_parent_ctx(c)); + restore(m, lsp_cell_get_syntax_args(c)); + addr = lsp_cell_get_syntax_body(c); + } + } +} + + +static void mark_and_restore(lsp_mem_t *m) { + for (lsp_addr_t addr = 0; addr < m->size; ++addr) + set_mark(m->cells + addr, true); + + restore(m, m->nil); + restore(m, m->zero); + restore(m, m->one); + restore(m, m->quote); + restore(m, m->quasiquote); + restore(m, m->unquote); + restore(m, m->unquote_splicing); + restore(m, m->root); +} + + +static lsp_bool_t is_free_cell(lsp_mem_t *m, lsp_addr_t addr, lsp_uint16_t size, + lsp_addr_t *used_addr) { + for (lsp_addr_t i = addr; i < addr + size; ++i) { + if (!get_mark(m->cells + i)) { + *used_addr = i; + return false; + } + } + + return true; +} + + +static lsp_status_t find_free_cell(lsp_mem_t *m, lsp_uint16_t size, + lsp_addr_t *addr) { + if (!size) + return LSP_ERR_MEM; + + for (lsp_addr_t i = m->last_addr; i < m->size - size; ++i) { + if (is_free_cell(m, i, size, &i)) { + *addr = i; + m->last_addr = i; + return LSP_SUCCESS; + } + } + + for (lsp_addr_t i = 0; i < m->last_addr && i < m->size - size; ++i) { + if (is_free_cell(m, i, size, &i)) { + *addr = i; + m->last_addr = i; + return LSP_SUCCESS; + } + } + + return LSP_ERR_MEM; +} + + +static lsp_status_t find_free_cell_with_gc(lsp_mem_t *m, lsp_uint16_t size, + lsp_addr_t *addr) { + lsp_status_t status = find_free_cell(m, size, addr); + if (status == LSP_SUCCESS) + return LSP_SUCCESS; + + mark_and_restore(m); + + return find_free_cell(m, size, addr); +} + + +static lsp_status_t alloc_cell(lsp_mem_t *m, lsp_uint16_t size, + lsp_addr_t *addr) { + lsp_addr_t root; + lsp_status_t status = find_free_cell_with_gc(m, 2, &root); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_pair(m->cells + root, m->nil, m->root); + m->root = root; + + status = find_free_cell_with_gc(m, size, addr); + if (status != LSP_SUCCESS) { + m->root = lsp_cell_get_pair_second(m->cells + root); + return status; + } + + lsp_mem_set_pair_first(m, root, *addr); + return LSP_SUCCESS; +} + + +static lsp_bool_t is_symbol_from_string(lsp_mem_t *m, lsp_addr_t symbol, + lsp_addr_t str) { + lsp_uint16_t str_len = lsp_cell_get_string_len(m->cells + str); + if (lsp_mem_get_symbol_len(m, symbol) != str_len) + return false; + + for (lsp_uint16_t i = 0; i < str_len; ++i) + if (lsp_mem_get_symbol_name(m, symbol, i) != + lsp_mem_get_string_data(m, str, i)) + return false; + + return true; +} + + +static lsp_bool_t is_symbol_from_char(lsp_mem_t *m, lsp_addr_t symbol, + char *name, lsp_uint16_t name_len) { + if (lsp_mem_get_symbol_len(m, symbol) != name_len) + return false; + + for (lsp_uint16_t i = 0; i < name_len; ++i) + if (lsp_mem_get_symbol_name(m, symbol, i) != name[i]) + return false; + + return true; +} + + +static lsp_status_t find_symbol_from_string(lsp_mem_t *m, lsp_addr_t str, + lsp_addr_t *addr) { + for (lsp_addr_t i = 0; i < m->size; ++i) { + if (get_mark(m->cells + i)) + continue; + + if (lsp_cell_is_symbol(m->cells + i) && + is_symbol_from_string(m, i, str)) { + *addr = i; + return LSP_SUCCESS; + } + + i += lsp_cell_get_size(m->cells + i) - 1; + } + + return LSP_ERR; +} + + +static lsp_status_t find_symbol_from_char(lsp_mem_t *m, char *name, + lsp_uint16_t name_len, + lsp_addr_t *addr) { + for (lsp_addr_t i = 0; i < m->size; ++i) { + if (get_mark(m->cells + i)) + continue; + + if (lsp_cell_is_symbol(m->cells + i) && + is_symbol_from_char(m, i, name, name_len)) { + *addr = i; + return LSP_SUCCESS; + } + + i += lsp_cell_get_size(m->cells + i) - 1; + } + + return LSP_ERR; +} + + +lsp_status_t lsp_mem_init(lsp_mem_t *m, lsp_uint16_t size) { + m->size = size; + m->last_addr = 0; + + for (lsp_addr_t addr = 0; addr < size; ++addr) + set_mark(m->cells + addr, true); + + lsp_status_t status = find_free_cell(m, 2, &(m->nil)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_pair(m->cells + m->nil, m->nil, m->nil); + + status = find_free_cell(m, lsp_cell_get_number_size(0), &(m->zero)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_number(m->cells + m->zero, 0); + + status = find_free_cell(m, lsp_cell_get_number_size(1), &(m->one)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_number(m->cells + m->one, 1); + + status = find_free_cell(m, lsp_cell_get_string_symbol_size(5), &(m->quote)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_symbol(m->cells + m->quote, 5); + for (lsp_uint16_t i = 0; i < 5; ++i) + lsp_cell_set_symbol_name(m->cells + m->quote, i, ("quote")[i]); + + status = find_free_cell(m, lsp_cell_get_string_symbol_size(10), + &(m->quasiquote)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_symbol(m->cells + m->quasiquote, 10); + for (lsp_uint16_t i = 0; i < 10; ++i) + lsp_cell_set_symbol_name(m->cells + m->quasiquote, i, + ("quasiquote")[i]); + + status = + find_free_cell(m, lsp_cell_get_string_symbol_size(7), &(m->unquote)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_symbol(m->cells + m->unquote, 7); + for (lsp_uint16_t i = 0; i < 7; ++i) + lsp_cell_set_symbol_name(m->cells + m->unquote, i, ("unquote")[i]); + + status = find_free_cell(m, lsp_cell_get_string_symbol_size(16), + &(m->unquote_splicing)); + if (status != LSP_SUCCESS) + return status; + lsp_cell_set_symbol(m->cells + m->unquote_splicing, 16); + for (lsp_uint16_t i = 0; i < 16; ++i) + lsp_cell_set_symbol_name(m->cells + m->unquote_splicing, i, + ("unquote-splicing")[i]); + + m->root = m->nil; + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_inc_ref(lsp_mem_t *m, lsp_addr_t addr) { + if (addr == m->nil || addr == m->zero || addr == m->one || addr == m->quote) + return LSP_SUCCESS; + + lsp_addr_t root; + lsp_status_t status = find_free_cell_with_gc(m, 2, &root); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_pair(m->cells + root, addr, m->root); + m->root = root; + return LSP_SUCCESS; +} + + +void lsp_mem_dec_ref(lsp_mem_t *m, lsp_addr_t addr) { + if (addr == m->nil || addr == m->zero || addr == m->one || addr == m->quote) + return; + + lsp_addr_t curr_addr = m->root; + lsp_addr_t prev_addr = m->nil; + while (curr_addr != m->nil) { + lsp_addr_t first = lsp_cell_get_pair_first(m->cells + curr_addr); + lsp_addr_t second = lsp_cell_get_pair_second(m->cells + curr_addr); + + if (first == addr) { + if (prev_addr == m->nil) { + m->root = second; + + } else { + lsp_mem_set_pair_second(m, prev_addr, second); + } + + return; + } + + prev_addr = curr_addr; + curr_addr = second; + } +} + + +lsp_status_t lsp_mem_create_number(lsp_mem_t *m, lsp_int32_t value, + lsp_addr_t *addr) { + lsp_uint16_t size = lsp_cell_get_number_size(value); + lsp_status_t status = alloc_cell(m, size, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_number(m->cells + *addr, value); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_pair(lsp_mem_t *m, lsp_addr_t first, + lsp_addr_t second, lsp_addr_t *addr) { + lsp_status_t status = alloc_cell(m, 2, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_pair(m->cells + *addr, first, second); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_string(lsp_mem_t *m, lsp_uint16_t data_len, + lsp_addr_t *addr) { + lsp_uint16_t size = lsp_cell_get_string_symbol_size(data_len); + lsp_status_t status = alloc_cell(m, size, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_string(m->cells + *addr, data_len); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_symbol_from_string(lsp_mem_t *m, lsp_addr_t str, + lsp_addr_t *addr) { + if (find_symbol_from_string(m, str, addr) == LSP_SUCCESS) + return lsp_mem_inc_ref(m, *addr); + + lsp_uint16_t name_len = lsp_mem_get_string_len(m, str); + lsp_uint16_t size = lsp_cell_get_string_symbol_size(name_len); + lsp_status_t status = alloc_cell(m, size, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_symbol(m->cells + *addr, name_len); + for (lsp_uint16_t i = 0; i < name_len; ++i) + lsp_cell_set_symbol_name(m->cells + *addr, i, + lsp_mem_get_string_data(m, str, i)); + + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_symbol_from_char(lsp_mem_t *m, char *name, + lsp_addr_t *addr) { + lsp_uint16_t name_len = 0; + while (name[name_len]) + name_len++; + + if (find_symbol_from_char(m, name, name_len, addr) == LSP_SUCCESS) + return lsp_mem_inc_ref(m, *addr); + + lsp_uint16_t size = lsp_cell_get_string_symbol_size(name_len); + lsp_status_t status = alloc_cell(m, size, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_symbol(m->cells + *addr, name_len); + for (lsp_uint16_t i = 0; i < name_len; ++i) + lsp_cell_set_symbol_name(m->cells + *addr, i, name[i]); + + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_builtin_function(lsp_mem_t *m, lsp_uint16_t index, + lsp_addr_t *addr) { + lsp_status_t status = alloc_cell(m, 1, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_builtin_function(m->cells + *addr, index); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_builtin_syntax(lsp_mem_t *m, lsp_uint16_t index, + lsp_addr_t *addr) { + lsp_status_t status = alloc_cell(m, 1, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_builtin_syntax(m->cells + *addr, index); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_function(lsp_mem_t *m, lsp_addr_t parent_ctx, + lsp_addr_t args, lsp_addr_t body, + lsp_addr_t *addr) { + lsp_status_t status = alloc_cell(m, 4, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_function(m->cells + *addr, parent_ctx, args, body); + return LSP_SUCCESS; +} + + +lsp_status_t lsp_mem_create_syntax(lsp_mem_t *m, lsp_addr_t parent_ctx, + lsp_addr_t args, lsp_addr_t body, + lsp_addr_t *addr) { + lsp_status_t status = alloc_cell(m, 4, addr); + if (status != LSP_SUCCESS) + return status; + + lsp_cell_set_syntax(m->cells + *addr, parent_ctx, args, body); + return LSP_SUCCESS; +} + + +lsp_bool_t lsp_mem_eq(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2) { + if (a1 == a2) + return true; + + if (lsp_mem_is_number(m, a1)) { + if (!lsp_mem_is_number(m, a2)) + return false; + + return lsp_mem_get_number(m, a1) == lsp_mem_get_number(m, a2); + } + + return false; +} + + +lsp_bool_t lsp_mem_equal(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2) { + if (lsp_mem_eq(m, a1, a2)) + return true; + + if (lsp_mem_is_pair(m, a1)) { + if (!lsp_mem_is_pair(m, a2)) + return false; + + while (a1 != m->nil && a2 != m->nil) { + if (!lsp_mem_equal(m, lsp_mem_get_pair_first(m, a1), + lsp_mem_get_pair_first(m, a2))) + return false; + + a1 = lsp_mem_get_pair_second(m, a1); + a2 = lsp_mem_get_pair_second(m, a2); + } + + return a1 == a2; + } + + if (lsp_mem_is_string(m, a1)) { + if (!lsp_mem_is_string(m, a2)) + return false; + + lsp_uint16_t a1_len = lsp_mem_get_string_len(m, a1); + lsp_uint16_t a2_len = lsp_mem_get_string_len(m, a2); + if (a1_len != a2_len) + return false; + + for (lsp_uint16_t i = 0; i < a1_len; ++i) { + if (lsp_mem_get_string_data(m, a1, i) != + lsp_mem_get_string_data(m, a2, i)) + return false; + } + + return true; + } + + return false; +} diff --git a/src_c/mem.h b/src_c/mem.h new file mode 100644 index 0000000..7d72ba9 --- /dev/null +++ b/src_c/mem.h @@ -0,0 +1,189 @@ +#ifndef LISP16_MEM_H +#define LISP16_MEM_H + +#include "cell.h" +#include "status.h" + + +typedef struct { + lsp_addr_t nil; + lsp_addr_t zero; + lsp_addr_t one; + lsp_addr_t quote; + lsp_addr_t quasiquote; + lsp_addr_t unquote; + lsp_addr_t unquote_splicing; + + // internal + lsp_uint16_t size; + lsp_addr_t last_addr; + lsp_addr_t root; + lsp_cell_t cells[]; +} lsp_mem_t; + + +lsp_status_t lsp_mem_init(lsp_mem_t *m, lsp_uint16_t size); +lsp_status_t lsp_mem_inc_ref(lsp_mem_t *m, lsp_addr_t addr); +void lsp_mem_dec_ref(lsp_mem_t *m, lsp_addr_t addr); + +lsp_status_t lsp_mem_create_number(lsp_mem_t *m, lsp_int32_t value, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_pair(lsp_mem_t *m, lsp_addr_t first, + lsp_addr_t second, lsp_addr_t *addr); +lsp_status_t lsp_mem_create_string(lsp_mem_t *m, lsp_uint16_t data_len, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_symbol_from_string(lsp_mem_t *m, lsp_addr_t str, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_symbol_from_char(lsp_mem_t *m, char *name, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_builtin_function(lsp_mem_t *m, lsp_uint16_t index, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_builtin_syntax(lsp_mem_t *m, lsp_uint16_t index, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_function(lsp_mem_t *m, lsp_addr_t parent_ctx, + lsp_addr_t args, lsp_addr_t body, + lsp_addr_t *addr); +lsp_status_t lsp_mem_create_syntax(lsp_mem_t *m, lsp_addr_t parent_ctx, + lsp_addr_t args, lsp_addr_t body, + lsp_addr_t *addr); + +lsp_bool_t lsp_mem_eq(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2); +lsp_bool_t lsp_mem_equal(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2); + + +static inline lsp_bool_t lsp_mem_is_number(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_number(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_pair(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_pair(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_string(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_string(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_symbol(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_symbol(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_builtin_function(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_is_builtin_function(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_builtin_syntax(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_is_builtin_syntax(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_function(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_function(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_syntax(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_syntax(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_string_or_symbol(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_is_string_or_symbol(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_builtin(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_is_builtin(m->cells + addr); +} + +static inline lsp_bool_t lsp_mem_is_function_or_syntax(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_is_function_or_syntax(m->cells + addr); +} + + +static inline lsp_int32_t lsp_mem_get_number(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_get_number(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_pair_first(lsp_mem_t *m, lsp_addr_t addr) { + return lsp_cell_get_pair_first(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_pair_second(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_pair_second(m->cells + addr); +} + +static inline lsp_uint16_t lsp_mem_get_string_len(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_string_len(m->cells + addr); +} + +static inline lsp_uint8_t lsp_mem_get_string_data(lsp_mem_t *m, lsp_addr_t addr, + lsp_uint16_t i) { + return lsp_cell_get_string_data(m->cells + addr, i); +} + +static inline lsp_uint16_t lsp_mem_get_symbol_len(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_symbol_len(m->cells + addr); +} + +static inline lsp_uint8_t lsp_mem_get_symbol_name(lsp_mem_t *m, lsp_addr_t addr, + lsp_uint16_t i) { + return lsp_cell_get_symbol_name(m->cells + addr, i); +} + +static inline lsp_uint16_t lsp_mem_get_builtin_index(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_builtin_index(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_function_parent_ctx(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_function_parent_ctx(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_function_args(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_function_args(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_function_body(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_function_body(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_syntax_parent_ctx(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_syntax_parent_ctx(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_syntax_args(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_syntax_args(m->cells + addr); +} + +static inline lsp_addr_t lsp_mem_get_syntax_body(lsp_mem_t *m, + lsp_addr_t addr) { + return lsp_cell_get_syntax_body(m->cells + addr); +} + + +static inline void lsp_mem_set_pair_first(lsp_mem_t *m, lsp_addr_t addr, + lsp_addr_t first) { + lsp_cell_set_pair(m->cells + addr, first, + lsp_cell_get_pair_second(m->cells + addr)); +} + +static inline void lsp_mem_set_pair_second(lsp_mem_t *m, lsp_addr_t addr, + lsp_addr_t second) { + lsp_cell_set_pair(m->cells + addr, lsp_cell_get_pair_first(m->cells + addr), + second); +} + +static inline void lsp_mem_set_string_data(lsp_mem_t *m, lsp_addr_t addr, + lsp_uint16_t i, lsp_uint8_t data_i) { + lsp_cell_set_string_data(m->cells + addr, i, data_i); +} + +#endif diff --git a/src_c/read.c b/src_c/read.c new file mode 100644 index 0000000..82250f5 --- /dev/null +++ b/src_c/read.c @@ -0,0 +1,428 @@ +#include "read.h" +#include "buff.h" + + +static inline lsp_bool_t is_ws(lsp_uint8_t v) { + return (v == ' ') || (v == '\n') || (v == '\r') || (v == '\t'); +} + + +static inline lsp_bool_t is_comment_start(lsp_uint8_t v) { return v == ';'; } + + +static inline lsp_bool_t is_comment_stop(lsp_uint8_t v) { return v == '\n'; } + + +static inline lsp_bool_t is_digit(lsp_uint8_t v) { + return (v >= '0') && (v <= '9'); +} + + +static inline lsp_bool_t is_list_start(lsp_uint8_t v) { + return (v == '(') || (v == '[') || (v == '{'); +} + + +static inline lsp_bool_t is_list_stop(lsp_uint8_t v) { + return (v == ')') || (v == ']') || (v == '}'); +} + + +static inline lsp_bool_t is_str_start_stop(lsp_uint8_t v) { return v == '"'; } + + +static inline lsp_bool_t is_quote(lsp_uint8_t v) { return v == '\''; } + + +static inline lsp_bool_t is_quasiquote(lsp_uint8_t v) { return v == '`'; } + + +static inline lsp_bool_t is_unquote(lsp_uint8_t v) { return v == ','; } + + +static lsp_status_t skip_ws(lsp_in_stream_t *s) { + while (true) { + lsp_uint8_t v; + lsp_status_t status = lsp_in_stream_peek(s, &v); + if (status != LSP_SUCCESS) + return status; + + if (is_comment_start(v)) { + while (!is_comment_stop(v)) { + status = lsp_in_stream_read(s, &v); + if (status != LSP_SUCCESS) + return status; + } + + continue; + } + + if (!is_ws(v)) + return LSP_SUCCESS; + + lsp_in_stream_read(s, &v); + } +} + + +static lsp_status_t read_number(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_int32_t v = 0; + + while (true) { + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_peek(s, &c); + if (status != LSP_SUCCESS) + return status; + + if (is_ws(c) || is_list_start(c) || is_list_stop(c)) + break; + + if (!is_digit(c)) + return LSP_ERR_READ; + + status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + + v = (v * 10) + (c - '0'); + } + + if (v == 0) { + *addr = m->zero; + return LSP_SUCCESS; + } + + if (v == 1) { + *addr = m->one; + return LSP_SUCCESS; + } + + return lsp_mem_create_number(m, v, addr); +} + + +static lsp_status_t read_list(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + + lsp_uint8_t list_end; + if (c == '(') { + list_end = ')'; + } else if (c == '[') { + list_end = ']'; + } else if (c == '{') { + list_end = '}'; + } else { + return LSP_ERR_READ; + } + + lsp_bool_t read_rest = false; + lsp_bool_t read_stop = false; + lsp_addr_t rest = m->nil; + lsp_addr_t last = m->nil; + *addr = m->nil; + + while (true) { + status = skip_ws(s); + if (status != LSP_SUCCESS) + break; + + status = lsp_in_stream_peek(s, &c); + if (status != LSP_SUCCESS) + break; + + if (is_list_stop(c)) { + status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + break; + + if (c != list_end) { + status = LSP_ERR_READ; + break; + } + + lsp_mem_set_pair_second(m, last, rest); + lsp_mem_dec_ref(m, rest); + return LSP_SUCCESS; + } + + if (read_stop) { + status = LSP_ERR_READ; + break; + } + + lsp_addr_t el; + status = lsp_read(m, s, &el); + if (status != LSP_SUCCESS) + break; + + if (lsp_mem_is_symbol(m, el) && lsp_mem_get_symbol_len(m, el) == 1 && + lsp_mem_get_symbol_name(m, el, 0) == '.') { + lsp_mem_dec_ref(m, el); + + if (read_rest) { + status = LSP_ERR_READ; + break; + } + + read_rest = true; + continue; + } + + if (read_rest) { + rest = el; + read_stop = true; + continue; + } + + lsp_addr_t new_last; + status = lsp_mem_create_pair(m, el, m->nil, &new_last); + lsp_mem_dec_ref(m, el); + if (status != LSP_SUCCESS) + break; + + lsp_mem_set_pair_second(m, last, new_last); + last = new_last; + + if (*addr == m->nil) { + *addr = last; + } else { + lsp_mem_dec_ref(m, last); + } + } + + lsp_mem_dec_ref(m, *addr); + lsp_mem_dec_ref(m, rest); + return status; +} + + +static lsp_status_t read_string(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + + if (!is_str_start_stop(c)) + return LSP_ERR_READ; + + lsp_buff_t buff; + lsp_buff_init(&buff, m); + + lsp_bool_t read_escaped = false; + + while (true) { + status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + goto cleanup; + + if (read_escaped) { + if (c == 'n') { + status = lsp_buff_push(&buff, '\n'); + } else if (c == 'r') { + status = lsp_buff_push(&buff, '\r'); + } else if (c == 't') { + status = lsp_buff_push(&buff, '\t'); + } else if (c == '\\') { + status = lsp_buff_push(&buff, '\\'); + } else if (c == '"') { + status = lsp_buff_push(&buff, '"'); + } else { + status = LSP_ERR_READ; + } + + if (status != LSP_SUCCESS) + goto cleanup; + + read_escaped = false; + continue; + } + + if (c == '\\') { + read_escaped = true; + continue; + } + + if (is_str_start_stop(c)) + break; + + status = lsp_buff_push(&buff, c); + if (status != LSP_SUCCESS) + goto cleanup; + } + + status = lsp_buff_pop(&buff, addr); + +cleanup: + lsp_buff_clear(&buff); + return status; +} + + +static lsp_status_t read_quote(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + + if (!is_quote(c)) + return LSP_ERR_READ; + + lsp_addr_t value; + status = lsp_read(m, s, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t list; + status = lsp_mem_create_pair(m, value, m->nil, &list); + lsp_mem_dec_ref(m, value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_mem_create_pair(m, m->quote, list, addr); + lsp_mem_dec_ref(m, list); + return status; +} + + +static lsp_status_t read_quasiquote(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + + if (!is_quasiquote(c)) + return LSP_ERR_READ; + + lsp_addr_t value; + status = lsp_read(m, s, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t list; + status = lsp_mem_create_pair(m, value, m->nil, &list); + lsp_mem_dec_ref(m, value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_mem_create_pair(m, m->quasiquote, list, addr); + lsp_mem_dec_ref(m, list); + return status; +} + + +static lsp_status_t read_unquote(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_uint8_t c; + lsp_status_t status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + + if (!is_unquote(c)) + return LSP_ERR_READ; + + status = lsp_in_stream_peek(s, &c); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_splicing = (c == '@'); + if (is_splicing) { + status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + return status; + } + + lsp_addr_t value; + status = lsp_read(m, s, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t list; + status = lsp_mem_create_pair(m, value, m->nil, &list); + lsp_mem_dec_ref(m, value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_mem_create_pair( + m, (is_splicing ? m->unquote_splicing : m->unquote), list, addr); + lsp_mem_dec_ref(m, list); + return status; +} + + +static lsp_status_t read_symbol(lsp_mem_t *m, lsp_in_stream_t *s, + lsp_addr_t *addr) { + lsp_status_t status; + + lsp_buff_t buff; + lsp_buff_init(&buff, m); + + while (true) { + lsp_uint8_t c; + status = lsp_in_stream_peek(s, &c); + if (status != LSP_SUCCESS) + goto cleanup; + + if (is_ws(c) || is_list_start(c) || is_list_stop(c)) + break; + + status = lsp_in_stream_read(s, &c); + if (status != LSP_SUCCESS) + goto cleanup; + + status = lsp_buff_push(&buff, c); + if (status != LSP_SUCCESS) + goto cleanup; + } + + lsp_addr_t str; + status = lsp_buff_pop(&buff, &str); + if (status != LSP_SUCCESS) + goto cleanup; + + status = lsp_mem_create_symbol_from_string(m, str, addr); + lsp_mem_dec_ref(m, str); + +cleanup: + lsp_buff_clear(&buff); + return status; +} + + +lsp_status_t lsp_read(lsp_mem_t *m, lsp_in_stream_t *s, lsp_addr_t *addr) { + lsp_status_t status = skip_ws(s); + if (status != LSP_SUCCESS) + return status; + + lsp_uint8_t c; + status = lsp_in_stream_peek(s, &c); + if (status != LSP_SUCCESS) + return status; + + if (is_list_start(c)) + return read_list(m, s, addr); + + if (is_str_start_stop(c)) + return read_string(m, s, addr); + + if (is_digit(c)) + return read_number(m, s, addr); + + if (is_quote(c)) + return read_quote(m, s, addr); + + if (is_quasiquote(c)) + return read_quasiquote(m, s, addr); + + if (is_unquote(c)) + return read_unquote(m, s, addr); + + return read_symbol(m, s, addr); +} diff --git a/src_c/read.h b/src_c/read.h new file mode 100644 index 0000000..15bfb7d --- /dev/null +++ b/src_c/read.h @@ -0,0 +1,10 @@ +#ifndef LISP16_READ_H +#define LISP16_READ_H + +#include "mem.h" +#include "stream.h" + + +lsp_status_t lsp_read(lsp_mem_t *m, lsp_in_stream_t *s, lsp_addr_t *addr); + +#endif diff --git a/src_c/repl.c b/src_c/repl.c new file mode 100644 index 0000000..6563613 --- /dev/null +++ b/src_c/repl.c @@ -0,0 +1,104 @@ +#include "repl.h" +#include "ctx.h" +#include "write.h" +#include "read.h" +#include "eval.h" + + +static void log_status(lsp_out_stream_t *s, lsp_status_t status) { + if (status == LSP_SUCCESS) + return; + + lsp_out_stream_write_str(s, "error: "); + + if (status == LSP_ERR_MEM) { + lsp_out_stream_write_str(s, "no memory"); + + } else if (status == LSP_ERR_CTX) { + lsp_out_stream_write_str(s, "can't resolve symbol"); + + } else if (status == LSP_ERR_READ) { + lsp_out_stream_write_str(s, "reader error"); + + } else if (status == LSP_ERR_WRITE) { + lsp_out_stream_write_str(s, "writer error"); + + } else if (status == LSP_ERR_EVAL) { + lsp_out_stream_write_str(s, "evaluation error"); + + } else if (status == LSP_ERR_APPLY) { + lsp_out_stream_write_str(s, "application error"); + + } else if (status == LSP_ERR_ARG_COUNT) { + lsp_out_stream_write_str(s, "invalid argument count"); + + } else if (status == LSP_ERR_ARG_TYPE) { + lsp_out_stream_write_str(s, "invalid argument type"); + + } else if (status == LSP_ERR_ARG_VALUE) { + lsp_out_stream_write_str(s, "invalid argument value"); + + } else if (status >= LSP_ERR_USER) { + lsp_out_stream_write_str(s, "user error "); + lsp_out_stream_write_int(s, status - LSP_ERR_USER); + + } else { + lsp_out_stream_write_str(s, "other error"); + } + + lsp_out_stream_write(s, '\n'); +} + + +static lsp_status_t skip_line(lsp_in_stream_t *s) { + lsp_uint8_t c; + lsp_status_t status; + + do { + status = lsp_in_stream_read(s, &c); + } while (status == LSP_SUCCESS && c != '\n'); + + return status; +} + + +lsp_status_t lsp_repl(lsp_env_t *e, lsp_addr_t ctx) { + while (true) { + lsp_addr_t value; + lsp_status_t status = lsp_read(e->m, e->in, &value); + if (status == LSP_EOF) + return status; + if (status != LSP_SUCCESS) { + log_status(e->out, status); + + status = skip_line(e->in); + if (status != LSP_SUCCESS) + return status; + + continue; + } + + lsp_addr_t result; + status = lsp_env_resolve(e, ctx, value, &result); + lsp_mem_dec_ref(e->m, value); + if (status == LSP_EOF) + return status; + if (status != LSP_SUCCESS) { + log_status(e->out, status); + continue; + } + + if (result == e->m->nil) + continue; + + status = lsp_write(e->m, e->out, result); + lsp_mem_dec_ref(e->m, result); + if (status == LSP_EOF) + return status; + if (status != LSP_SUCCESS) { + log_status(e->out, status); + continue; + } + lsp_out_stream_write(e->out, '\n'); + } +} diff --git a/src_c/repl.h b/src_c/repl.h new file mode 100644 index 0000000..9c34070 --- /dev/null +++ b/src_c/repl.h @@ -0,0 +1,9 @@ +#ifndef LISP16_REPL_H +#define LISP16_REPL_H + +#include "env.h" + + +lsp_status_t lsp_repl(lsp_env_t *e, lsp_addr_t ctx); + +#endif diff --git a/src_c/status.h b/src_c/status.h new file mode 100644 index 0000000..c6332e9 --- /dev/null +++ b/src_c/status.h @@ -0,0 +1,25 @@ +#ifndef LSP_STATUS_H +#define LSP_STATUS_H + +#include "arch.h" + +#define LSP_STATUS(x) ((lsp_status_t)x) + +#define LSP_SUCCESS LSP_STATUS(0) +#define LSP_EOF LSP_STATUS(-1) +#define LSP_ERR LSP_STATUS(1) +#define LSP_ERR_MEM LSP_STATUS(2) +#define LSP_ERR_CTX LSP_STATUS(3) +#define LSP_ERR_READ LSP_STATUS(4) +#define LSP_ERR_WRITE LSP_STATUS(5) +#define LSP_ERR_EVAL LSP_STATUS(6) +#define LSP_ERR_APPLY LSP_STATUS(7) +#define LSP_ERR_ARG_COUNT LSP_STATUS(8) +#define LSP_ERR_ARG_TYPE LSP_STATUS(9) +#define LSP_ERR_ARG_VALUE LSP_STATUS(10) +#define LSP_ERR_USER LSP_STATUS(0x80) + + +typedef lsp_int8_t lsp_status_t; + +#endif diff --git a/src_c/stream.c b/src_c/stream.c new file mode 100644 index 0000000..37f5d3d --- /dev/null +++ b/src_c/stream.c @@ -0,0 +1,108 @@ +#include "stream.h" + + +static lsp_int16_t str_getchar(lsp_in_stream_t *s) { + lsp_str_stream_t *ss = (lsp_str_stream_t *)s; + + if (ss->pos >= lsp_mem_get_string_len(ss->m, ss->str)) + return LSP_EOF; + + return lsp_mem_get_string_data(ss->m, ss->str, ss->pos++); +} + + +void lsp_in_stream_init(lsp_in_stream_t *s, lsp_stream_getchar_t getchar) { + s->getchar = getchar; + s->next_available = false; +} + + +lsp_status_t lsp_in_stream_read(lsp_in_stream_t *s, lsp_uint8_t *v) { + if (s->next_available) { + s->next_available = false; + *v = s->next_value; + return s->next_status; + } + + lsp_int16_t c = s->getchar(s); + *v = c; + return ((c == LSP_EOF) ? LSP_EOF : LSP_SUCCESS); +} + + +lsp_status_t lsp_in_stream_peek(lsp_in_stream_t *s, lsp_uint8_t *v) { + if (s->next_available) { + *v = s->next_value; + return s->next_status; + } + + lsp_int16_t c = s->getchar(s); + s->next_available = true; + s->next_value = c; + s->next_status = ((c == LSP_EOF) ? LSP_EOF : LSP_SUCCESS); + + *v = s->next_value; + return s->next_status; +} + + +void lsp_out_stream_init(lsp_out_stream_t *s, lsp_stream_putchar_t putchar) { + s->putchar = putchar; +} + + +lsp_status_t lsp_out_stream_write(lsp_out_stream_t *s, lsp_uint8_t v) { + if (s->putchar(s, v) == LSP_EOF) + return LSP_EOF; + + return LSP_SUCCESS; +} + + +lsp_status_t lsp_out_stream_write_str(lsp_out_stream_t *s, char *str) { + while (*str) { + lsp_status_t status = lsp_out_stream_write(s, *(str++)); + if (status != LSP_SUCCESS) + return status; + } + + return LSP_SUCCESS; +} + + +lsp_status_t lsp_out_stream_write_int(lsp_out_stream_t *s, lsp_int32_t v) { + lsp_status_t status; + if (v < 0) { + v *= -1; + status = lsp_out_stream_write(s, '-'); + if (status != LSP_SUCCESS) + return status; + } + + lsp_uint8_t size = 0; + for (lsp_int32_t i = v; i; i /= 10) + size++; + if (size < 1) + size = 1; + + for (lsp_uint8_t i = 0; i < size; ++i) { + lsp_int32_t temp = v; + for (lsp_uint8_t j = i; j < size - 1; ++j) + temp /= 10; + + lsp_uint8_t digit = temp % 10; + status = lsp_out_stream_write(s, '0' + digit); + if (status != LSP_SUCCESS) + return status; + } + + return LSP_SUCCESS; +} + + +void lsp_str_stream_init(lsp_str_stream_t *s, lsp_mem_t *m, lsp_addr_t str) { + lsp_in_stream_init((lsp_in_stream_t *)s, str_getchar); + s->m = m; + s->str = str; + s->pos = 0; +} diff --git a/src_c/stream.h b/src_c/stream.h new file mode 100644 index 0000000..268f69b --- /dev/null +++ b/src_c/stream.h @@ -0,0 +1,46 @@ +#ifndef LISP16_STREAM_H +#define LISP16_STREAM_H + +#include "mem.h" + + +typedef struct lsp_in_stream_t lsp_in_stream_t; +typedef struct lsp_out_stream_t lsp_out_stream_t; +typedef lsp_int16_t (*lsp_stream_getchar_t)(lsp_in_stream_t *s); +typedef lsp_int16_t (*lsp_stream_putchar_t)(lsp_out_stream_t *s, lsp_int16_t v); + +struct lsp_in_stream_t { + // internal + lsp_stream_getchar_t getchar; + lsp_bool_t next_available; + lsp_uint8_t next_value; + lsp_status_t next_status; +}; + +struct lsp_out_stream_t { + // internal + lsp_stream_putchar_t putchar; +}; + +typedef struct { + lsp_in_stream_t base; + + // internal + lsp_mem_t *m; + lsp_addr_t str; + lsp_uint16_t pos; +} lsp_str_stream_t; + + +void lsp_in_stream_init(lsp_in_stream_t *s, lsp_stream_getchar_t getchar); +lsp_status_t lsp_in_stream_read(lsp_in_stream_t *s, lsp_uint8_t *v); +lsp_status_t lsp_in_stream_peek(lsp_in_stream_t *s, lsp_uint8_t *v); + +void lsp_out_stream_init(lsp_out_stream_t *s, lsp_stream_putchar_t putchar); +lsp_status_t lsp_out_stream_write(lsp_out_stream_t *s, lsp_uint8_t v); +lsp_status_t lsp_out_stream_write_str(lsp_out_stream_t *s, char *str); +lsp_status_t lsp_out_stream_write_int(lsp_out_stream_t *s, lsp_int32_t v); + +void lsp_str_stream_init(lsp_str_stream_t *s, lsp_mem_t *m, lsp_addr_t str); + +#endif diff --git a/src_c/syntax.c b/src_c/syntax.c new file mode 100644 index 0000000..5ec6c7e --- /dev/null +++ b/src_c/syntax.c @@ -0,0 +1,192 @@ +#include "syntax.h" +#include "ctx.h" +#include "eval.h" + + +lsp_builtin_entry_t lsp_syntaxes[] = { + {"lambda", lsp_syntax_lambda}, {"syntax", lsp_syntax_syntax}, + {"define", lsp_syntax_define}, {"set!", lsp_syntax_set}, + {"begin", lsp_syntax_begin}, {"quote", lsp_syntax_quote}, + {"if", lsp_syntax_if}, {NULL, NULL}}; + + +lsp_status_t lsp_syntax_lambda(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t fn_args = lsp_mem_get_pair_first(e->m, args); + lsp_addr_t fn_body = lsp_mem_get_pair_second(e->m, args); + + if (!lsp_mem_is_symbol(e->m, fn_args) && !lsp_mem_is_pair(e->m, fn_args)) + return LSP_ERR_ARG_TYPE; + + if (fn_body == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t ctx_copy; + lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_function(e->m, ctx_copy, fn_args, fn_body, &result); + lsp_mem_dec_ref(e->m, ctx_copy); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_syntax_syntax(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t syntax_args = lsp_mem_get_pair_first(e->m, args); + lsp_addr_t syntax_body = lsp_mem_get_pair_second(e->m, args); + + if (!lsp_mem_is_symbol(e->m, syntax_args) && + !lsp_mem_is_pair(e->m, syntax_args)) + return LSP_ERR_ARG_TYPE; + + if (syntax_body == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t ctx_copy; + lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy); + if (status != LSP_SUCCESS) + return status; + + lsp_addr_t result; + status = lsp_mem_create_syntax(e->m, ctx_copy, syntax_args, syntax_body, + &result); + lsp_mem_dec_ref(e->m, ctx_copy); + if (status != LSP_SUCCESS) + return status; + + status = lsp_env_set_result_value(e, result); + lsp_mem_dec_ref(e->m, result); + return status; +} + + +lsp_status_t lsp_syntax_define(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t symbol; + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_symbol(e->m, symbol)) + return LSP_ERR_ARG_TYPE; + + status = lsp_env_resolve(e, ctx, value, &value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_ctx_add(e->m, ctx, symbol, value); + lsp_mem_dec_ref(e->m, value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_syntax_set(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t symbol; + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_symbol(e->m, symbol)) + return LSP_ERR_ARG_TYPE; + + status = lsp_env_resolve(e, ctx, value, &value); + if (status != LSP_SUCCESS) + return status; + + status = lsp_ctx_set(e->m, ctx, symbol, value); + lsp_mem_dec_ref(e->m, value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, e->m->nil); +} + + +lsp_status_t lsp_syntax_begin(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + while (true) { + lsp_addr_t value = lsp_mem_get_pair_first(e->m, args); + lsp_addr_t next_args = lsp_mem_get_pair_second(e->m, args); + + if (next_args == e->m->nil) + return lsp_env_set_result_eval(e, ctx, value); + + lsp_status_t status = lsp_env_resolve(e, ctx, value, &value); + if (status != LSP_SUCCESS) + return status; + + lsp_mem_dec_ref(e->m, value); + args = next_args; + } +} + + +lsp_status_t lsp_syntax_quote(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + lsp_addr_t value; + lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value); + if (status != LSP_SUCCESS) + return status; + + return lsp_env_set_result_value(e, value); +} + + +lsp_status_t lsp_syntax_if(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) { + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t test = lsp_mem_get_pair_first(e->m, args); + + args = lsp_mem_get_pair_second(e->m, args); + if (args == e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_addr_t true_value = lsp_mem_get_pair_first(e->m, args); + + lsp_addr_t false_value; + args = lsp_mem_get_pair_second(e->m, args); + if (args == e->m->nil) { + false_value = e->m->nil; + + } else { + false_value = lsp_mem_get_pair_first(e->m, args); + args = lsp_mem_get_pair_second(e->m, args); + } + + if (args != e->m->nil) + return LSP_ERR_ARG_COUNT; + + lsp_status_t status = lsp_env_resolve(e, ctx, test, &test); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t is_false = (lsp_mem_is_number(e->m, test) && + lsp_mem_get_number(e->m, test) == 0) || + (lsp_mem_is_pair(e->m, test) && test == e->m->nil) || + (lsp_mem_is_string(e->m, test) && + lsp_mem_get_string_len(e->m, test) == 0) || + (lsp_mem_is_symbol(e->m, test) && + lsp_mem_get_symbol_len(e->m, test) == 0); + lsp_mem_dec_ref(e->m, test); + + return lsp_env_set_result_eval(e, ctx, + (is_false ? false_value : true_value)); +} diff --git a/src_c/syntax.h b/src_c/syntax.h new file mode 100644 index 0000000..55a6516 --- /dev/null +++ b/src_c/syntax.h @@ -0,0 +1,17 @@ +#ifndef LISP16_SYNTAX_H +#define LISP16_SYNTAX_H + +#include "builtin.h" + + +extern lsp_builtin_entry_t lsp_syntaxes[]; + +lsp_status_t lsp_syntax_lambda(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_syntax_syntax(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_syntax_define(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_syntax_set(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_syntax_begin(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_syntax_quote(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); +lsp_status_t lsp_syntax_if(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args); + +#endif diff --git a/src_c/write.c b/src_c/write.c new file mode 100644 index 0000000..2b18aeb --- /dev/null +++ b/src_c/write.c @@ -0,0 +1,174 @@ +#include "write.h" +#include "function.h" +#include "syntax.h" + + +static lsp_status_t write_number(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + return lsp_out_stream_write_int(s, lsp_mem_get_number(m, addr)); +} + + +static lsp_status_t write_pair(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_status_t status = lsp_out_stream_write(s, '('); + if (status != LSP_SUCCESS) + return status; + + lsp_bool_t write_space = false; + while (addr != m->nil) { + if (write_space) { + lsp_out_stream_write(s, ' '); + } else { + write_space = true; + } + + lsp_addr_t first = lsp_mem_get_pair_first(m, addr); + lsp_addr_t second = lsp_mem_get_pair_second(m, addr); + + status = lsp_write(m, s, first); + if (status != LSP_SUCCESS) + return status; + + if (!lsp_mem_is_pair(m, second)) { + status = lsp_out_stream_write_str(s, " . "); + if (status != LSP_SUCCESS) + return status; + + status = lsp_write(m, s, second); + if (status != LSP_SUCCESS) + return status; + + break; + } + + addr = second; + } + + return lsp_out_stream_write(s, ')'); +} + + +static lsp_status_t write_string(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_uint16_t len = lsp_mem_get_string_len(m, addr); + lsp_status_t status = lsp_out_stream_write(s, '"'); + + for (lsp_uint16_t i = 0; i < len; ++i) { + lsp_uint8_t c = lsp_mem_get_string_data(m, addr, i); + + if (c == '"') { + status = lsp_out_stream_write(s, '\\'); + if (status != LSP_SUCCESS) + return status; + } + + status = lsp_out_stream_write(s, c); + if (status != LSP_SUCCESS) + return status; + } + + return lsp_out_stream_write(s, '"'); +} + + +static lsp_status_t write_symbol(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_uint16_t len = lsp_mem_get_symbol_len(m, addr); + + for (lsp_uint16_t i = 0; i < len; ++i) { + lsp_uint8_t c = lsp_mem_get_symbol_name(m, addr, i); + lsp_status_t status = lsp_out_stream_write(s, c); + if (status != LSP_SUCCESS) + return status; + } + + return LSP_SUCCESS; +} + + +static lsp_status_t write_builtin_function(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_status_t status = lsp_out_stream_write_str(s, "#<builtin-function-"); + if (status != LSP_SUCCESS) + return status; + + status = lsp_out_stream_write_str( + s, lsp_functions[lsp_mem_get_builtin_index(m, addr)].name); + if (status != LSP_SUCCESS) + return status; + + return lsp_out_stream_write(s, '>'); +} + + +static lsp_status_t write_builtin_syntax(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_status_t status = lsp_out_stream_write_str(s, "#<builtin-syntax-"); + if (status != LSP_SUCCESS) + return status; + + status = lsp_out_stream_write_str( + s, lsp_syntaxes[lsp_mem_get_builtin_index(m, addr)].name); + if (status != LSP_SUCCESS) + return status; + + return lsp_out_stream_write(s, '>'); +} + + +static lsp_status_t write_function(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_status_t status = lsp_out_stream_write_str(s, "#<function-"); + if (status != LSP_SUCCESS) + return status; + + status = lsp_out_stream_write_int(s, addr); + if (status != LSP_SUCCESS) + return status; + + return lsp_out_stream_write(s, '>'); +} + + +static lsp_status_t write_syntax(lsp_mem_t *m, lsp_out_stream_t *s, + lsp_addr_t addr) { + lsp_status_t status = lsp_out_stream_write_str(s, "#<syntax-"); + if (status != LSP_SUCCESS) + return status; + + status = lsp_out_stream_write_int(s, addr); + if (status != LSP_SUCCESS) + return status; + + return lsp_out_stream_write(s, '>'); +} + + +lsp_status_t lsp_write(lsp_mem_t *m, lsp_out_stream_t *s, lsp_addr_t addr) { + if (lsp_mem_is_number(m, addr)) + return write_number(m, s, addr); + + if (lsp_mem_is_pair(m, addr)) + return write_pair(m, s, addr); + + if (lsp_mem_is_string(m, addr)) + return write_string(m, s, addr); + + if (lsp_mem_is_symbol(m, addr)) + return write_symbol(m, s, addr); + + if (lsp_mem_is_builtin_function(m, addr)) + return write_builtin_function(m, s, addr); + + if (lsp_mem_is_builtin_syntax(m, addr)) + return write_builtin_syntax(m, s, addr); + + if (lsp_mem_is_function(m, addr)) + return write_function(m, s, addr); + + if (lsp_mem_is_syntax(m, addr)) + return write_syntax(m, s, addr); + + return LSP_ERR_WRITE; +} diff --git a/src_c/write.h b/src_c/write.h new file mode 100644 index 0000000..5b7cff1 --- /dev/null +++ b/src_c/write.h @@ -0,0 +1,10 @@ +#ifndef LISP16_WRITE_H +#define LISP16_WRITE_H + +#include "mem.h" +#include "stream.h" + + +lsp_status_t lsp_write(lsp_mem_t *m, lsp_out_stream_t *s, lsp_addr_t addr); + +#endif diff --git a/src_lsp/base-large.lsp b/src_lsp/base-large.lsp new file mode 100644 index 0000000..e3666d7 --- /dev/null +++ b/src_lsp/base-large.lsp @@ -0,0 +1,117 @@ + +(define nil ()) +(define #f 0) +(define #t 1) + +(define list (lambda x x)) + +(define car + (lambda (x) + (apply (lambda (x . rest) x) x))) + +(define cdr + (lambda (x) + (apply (lambda (x . rest) rest) x))) + +((lambda (define*) + (set! define + (syntax (head . rest) + (if (pair? head) + (list begin + (list define* (car head) nil) + (list set! (car head) + (cons lambda (cons (cdr head) rest)))) + (cons define* (cons head rest)))))) + define) + +(define (cadr x) (car (cdr x))) +(define (caar x) (car (car x))) +(define (cdar x) (cdr (car x))) +(define (cadar x) (car (cdr (car x)))) + +(define define-syntax + (syntax (head . rest) + (list begin + (list define (car head) nil) + (list set! (car head) + (cons syntax (cons (cdr head) rest)))))) + +(define (not x) (if x #f #t)) + +(define-syntax (and . args) + (if args + (list if (car args) + (cons and (cdr args)) + #f) + #t)) + +(define-syntax (or . args) + (if args + (list if (car args) + #t + (cons or (cdr args))) + #f)) + +(define (= . args) + (if args + (if (number? (car args)) + (or (not (cdr args)) + (and (eq? (car args) (cadr args)) + (apply = (cdr args)))) + #f) + #t)) + +(define (<= . args) + (if args + (if (number? (car args)) + (if (cdr args) + (and (or (= (car args) (cadr args)) + (< (car args) (cadr args))) + (apply <= (cdr args))) + #t) + #f) + #t)) + +(define (>= . args) + (if args + (if (number? (car args)) + (if (cdr args) + (and (or (= (car args) (cadr args)) + (> (car args) (cadr args))) + (apply >= (cdr args))) + #t) + #f) + #t)) + +(define-syntax (when test . args) + (list if test + (cons begin args) + nil)) + +(define-syntax (cond . args) + (when args + (if (eq? (caar args) 'else) + (cons begin (cdar args)) + (list if (caar args) + (cons begin (cdar args)) + (cons cond (cdr args)))))) + +(define-syntax (let . args) + (define (let bindings . body) + (if bindings + (list + (list lambda (list (caar bindings)) + (apply let (cons (cdr bindings) body))) + (cadar bindings)) + (cons begin body))) + (apply let args)) + +(define (newline) (write-u8 10)) + +(define (write-string str) + (define len (string-length str)) + (define (write-from i) + (when (< i len) + (write-u8 (string-ref str i)) + (write-from (+ i 1)))) + (write-from 0)) diff --git a/src_lsp/base-small.lsp b/src_lsp/base-small.lsp new file mode 100644 index 0000000..f0e1e2c --- /dev/null +++ b/src_lsp/base-small.lsp @@ -0,0 +1,6 @@ + +(define nil ()) +(define #f 0) +(define #t 1) + +(define list (lambda x x)) @@ -0,0 +1,19 @@ +#!/bin/sh + +set -e + +cd $(dirname -- "$0") + +CC=${CC:-gcc} +SRC="src_c/arch/posix.c $(find src_c -maxdepth 1 -name '*.c' -a ! -name 'main.c')" +OUT=build/test +ARCH=LSP_ARCH_POSIX +CFLAGS="-O2" + +mkdir -p build/test + +for i in test_c/*.c; do + name=$(basename $i .c) + $CC -DLSP_ARCH=$ARCH $CFLAGS -o $OUT/$name $SRC $i + $OUT/$name +done diff --git a/test_c/acutest.h b/test_c/acutest.h new file mode 100644 index 0000000..20500ae --- /dev/null +++ b/test_c/acutest.h @@ -0,0 +1,1839 @@ +/* + * Acutest -- Another C/C++ Unit Test facility + * <https://github.com/mity/acutest> + * + * Copyright 2013-2020 Martin Mitas + * Copyright 2019 Garrett D'Amore + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS + * IN THE SOFTWARE. + */ + +#ifndef ACUTEST_H +#define ACUTEST_H + + +/************************ + *** Public interface *** + ************************/ + +/* By default, "acutest.h" provides the main program entry point (function + * main()). However, if the test suite is composed of multiple source files + * which include "acutest.h", then this causes a problem of multiple main() + * definitions. To avoid this problem, #define macro TEST_NO_MAIN in all + * compilation units but one. + */ + +/* Macro to specify list of unit tests in the suite. + * The unit test implementation MUST provide list of unit tests it implements + * with this macro: + * + * TEST_LIST = { + * { "test1_name", test1_func_ptr }, + * { "test2_name", test2_func_ptr }, + * ... + * { NULL, NULL } // zeroed record marking the end of the list + * }; + * + * The list specifies names of each test (must be unique) and pointer to + * a function implementing it. The function does not take any arguments + * and has no return values, i.e. every test function has to be compatible + * with this prototype: + * + * void test_func(void); + * + * Note the list has to be ended with a zeroed record. + */ +#define TEST_LIST const struct acutest_test_ acutest_list_[] + + +/* Macros for testing whether an unit test succeeds or fails. These macros + * can be used arbitrarily in functions implementing the unit tests. + * + * If any condition fails throughout execution of a test, the test fails. + * + * TEST_CHECK takes only one argument (the condition), TEST_CHECK_ allows + * also to specify an error message to print out if the condition fails. + * (It expects printf-like format string and its parameters). The macros + * return non-zero (condition passes) or 0 (condition fails). + * + * That can be useful when more conditions should be checked only if some + * preceding condition passes, as illustrated in this code snippet: + * + * SomeStruct* ptr = allocate_some_struct(); + * if(TEST_CHECK(ptr != NULL)) { + * TEST_CHECK(ptr->member1 < 100); + * TEST_CHECK(ptr->member2 > 200); + * } + */ +#define TEST_CHECK_(cond,...) acutest_check_((cond), __FILE__, __LINE__, __VA_ARGS__) +#define TEST_CHECK(cond) acutest_check_((cond), __FILE__, __LINE__, "%s", #cond) + + +/* These macros are the same as TEST_CHECK_ and TEST_CHECK except that if the + * condition fails, the currently executed unit test is immediately aborted. + * + * That is done either by calling abort() if the unit test is executed as a + * child process; or via longjmp() if the unit test is executed within the + * main Acutest process. + * + * As a side effect of such abortion, your unit tests may cause memory leaks, + * unflushed file descriptors, and other phenomena caused by the abortion. + * + * Therefore you should not use these as a general replacement for TEST_CHECK. + * Use it with some caution, especially if your test causes some other side + * effects to the outside world (e.g. communicating with some server, inserting + * into a database etc.). + */ +#define TEST_ASSERT_(cond,...) \ + do { \ + if(!acutest_check_((cond), __FILE__, __LINE__, __VA_ARGS__)) \ + acutest_abort_(); \ + } while(0) +#define TEST_ASSERT(cond) \ + do { \ + if(!acutest_check_((cond), __FILE__, __LINE__, "%s", #cond)) \ + acutest_abort_(); \ + } while(0) + + +#ifdef __cplusplus +/* Macros to verify that the code (the 1st argument) throws exception of given + * type (the 2nd argument). (Note these macros are only available in C++.) + * + * TEST_EXCEPTION_ is like TEST_EXCEPTION but accepts custom printf-like + * message. + * + * For example: + * + * TEST_EXCEPTION(function_that_throw(), ExpectedExceptionType); + * + * If the function_that_throw() throws ExpectedExceptionType, the check passes. + * If the function throws anything incompatible with ExpectedExceptionType + * (or if it does not thrown an exception at all), the check fails. + */ +#define TEST_EXCEPTION(code, exctype) \ + do { \ + bool exc_ok_ = false; \ + const char *msg_ = NULL; \ + try { \ + code; \ + msg_ = "No exception thrown."; \ + } catch(exctype const&) { \ + exc_ok_= true; \ + } catch(...) { \ + msg_ = "Unexpected exception thrown."; \ + } \ + acutest_check_(exc_ok_, __FILE__, __LINE__, #code " throws " #exctype);\ + if(msg_ != NULL) \ + acutest_message_("%s", msg_); \ + } while(0) +#define TEST_EXCEPTION_(code, exctype, ...) \ + do { \ + bool exc_ok_ = false; \ + const char *msg_ = NULL; \ + try { \ + code; \ + msg_ = "No exception thrown."; \ + } catch(exctype const&) { \ + exc_ok_= true; \ + } catch(...) { \ + msg_ = "Unexpected exception thrown."; \ + } \ + acutest_check_(exc_ok_, __FILE__, __LINE__, __VA_ARGS__); \ + if(msg_ != NULL) \ + acutest_message_("%s", msg_); \ + } while(0) +#endif /* #ifdef __cplusplus */ + + +/* Sometimes it is useful to split execution of more complex unit tests to some + * smaller parts and associate those parts with some names. + * + * This is especially handy if the given unit test is implemented as a loop + * over some vector of multiple testing inputs. Using these macros allow to use + * sort of subtitle for each iteration of the loop (e.g. outputting the input + * itself or a name associated to it), so that if any TEST_CHECK condition + * fails in the loop, it can be easily seen which iteration triggers the + * failure, without the need to manually output the iteration-specific data in + * every single TEST_CHECK inside the loop body. + * + * TEST_CASE allows to specify only single string as the name of the case, + * TEST_CASE_ provides all the power of printf-like string formatting. + * + * Note that the test cases cannot be nested. Starting a new test case ends + * implicitly the previous one. To end the test case explicitly (e.g. to end + * the last test case after exiting the loop), you may use TEST_CASE(NULL). + */ +#define TEST_CASE_(...) acutest_case_(__VA_ARGS__) +#define TEST_CASE(name) acutest_case_("%s", name) + + +/* Maximal output per TEST_CASE call. Longer messages are cut. + * You may define another limit prior including "acutest.h" + */ +#ifndef TEST_CASE_MAXSIZE + #define TEST_CASE_MAXSIZE 64 +#endif + + +/* printf-like macro for outputting an extra information about a failure. + * + * Intended use is to output some computed output versus the expected value, + * e.g. like this: + * + * if(!TEST_CHECK(produced == expected)) { + * TEST_MSG("Expected: %d", expected); + * TEST_MSG("Produced: %d", produced); + * } + * + * Note the message is only written down if the most recent use of any checking + * macro (like e.g. TEST_CHECK or TEST_EXCEPTION) in the current test failed. + * This means the above is equivalent to just this: + * + * TEST_CHECK(produced == expected); + * TEST_MSG("Expected: %d", expected); + * TEST_MSG("Produced: %d", produced); + * + * The macro can deal with multi-line output fairly well. It also automatically + * adds a final new-line if there is none present. + */ +#define TEST_MSG(...) acutest_message_(__VA_ARGS__) + + +/* Maximal output per TEST_MSG call. Longer messages are cut. + * You may define another limit prior including "acutest.h" + */ +#ifndef TEST_MSG_MAXSIZE + #define TEST_MSG_MAXSIZE 1024 +#endif + + +/* Macro for dumping a block of memory. + * + * Its intended use is very similar to what TEST_MSG is for, but instead of + * generating any printf-like message, this is for dumping raw block of a + * memory in a hexadecimal form: + * + * TEST_CHECK(size_produced == size_expected && + * memcmp(addr_produced, addr_expected, size_produced) == 0); + * TEST_DUMP("Expected:", addr_expected, size_expected); + * TEST_DUMP("Produced:", addr_produced, size_produced); + */ +#define TEST_DUMP(title, addr, size) acutest_dump_(title, addr, size) + +/* Maximal output per TEST_DUMP call (in bytes to dump). Longer blocks are cut. + * You may define another limit prior including "acutest.h" + */ +#ifndef TEST_DUMP_MAXSIZE + #define TEST_DUMP_MAXSIZE 1024 +#endif + + +/* Common test initialiation/clean-up + * + * In some test suites, it may be needed to perform some sort of the same + * initialization and/or clean-up in all the tests. + * + * Such test suites may use macros TEST_INIT and/or TEST_FINI prior including + * this header. The expansion of the macro is then used as a body of helper + * function called just before executing every single (TEST_INIT) or just after + * it ends (TEST_FINI). + * + * Examples of various ways how to use the macro TEST_INIT: + * + * #define TEST_INIT my_init_func(); + * #define TEST_INIT my_init_func() // Works even without the semicolon + * #define TEST_INIT setlocale(LC_ALL, NULL); + * #define TEST_INIT { setlocale(LC_ALL, NULL); my_init_func(); } + * + * TEST_FINI is to be used in the same way. + */ + + +/********************** + *** Implementation *** + **********************/ + +/* The unit test files should not rely on anything below. */ + +#include <ctype.h> +#include <stdarg.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <setjmp.h> + +#if defined(unix) || defined(__unix__) || defined(__unix) || defined(__APPLE__) + #define ACUTEST_UNIX_ 1 + #include <errno.h> + #include <libgen.h> + #include <unistd.h> + #include <sys/types.h> + #include <sys/wait.h> + #include <signal.h> + #include <time.h> + + #if defined CLOCK_PROCESS_CPUTIME_ID && defined CLOCK_MONOTONIC + #define ACUTEST_HAS_POSIX_TIMER_ 1 + #endif +#endif + +#if defined(_gnu_linux_) || defined(__linux__) + #define ACUTEST_LINUX_ 1 + #include <fcntl.h> + #include <sys/stat.h> +#endif + +#if defined(_WIN32) || defined(__WIN32__) || defined(__WINDOWS__) + #define ACUTEST_WIN_ 1 + #include <windows.h> + #include <io.h> +#endif + +#if defined(__APPLE__) + #define ACUTEST_MACOS_ + #include <assert.h> + #include <stdbool.h> + #include <sys/types.h> + #include <unistd.h> + #include <sys/sysctl.h> +#endif + +#ifdef __cplusplus + #include <exception> +#endif + +#ifdef __has_include + #if __has_include(<valgrind.h>) + #include <valgrind.h> + #endif +#endif + +/* Enable the use of the non-standard keyword __attribute__ to silence warnings under some compilers */ +#if defined(__GNUC__) || defined(__clang__) + #define ACUTEST_ATTRIBUTE_(attr) __attribute__((attr)) +#else + #define ACUTEST_ATTRIBUTE_(attr) +#endif + +/* Note our global private identifiers end with '_' to mitigate risk of clash + * with the unit tests implementation. */ + +#ifdef __cplusplus + extern "C" { +#endif + +#ifdef _MSC_VER + /* In the multi-platform code like ours, we cannot use the non-standard + * "safe" functions from Microsoft C lib like e.g. sprintf_s() instead of + * standard sprintf(). Hence, lets disable the warning C4996. */ + #pragma warning(push) + #pragma warning(disable: 4996) +#endif + + +struct acutest_test_ { + const char* name; + void (*func)(void); +}; + +struct acutest_test_data_ { + unsigned char flags; + double duration; +}; + +enum { + ACUTEST_FLAG_RUN_ = 1 << 0, + ACUTEST_FLAG_SUCCESS_ = 1 << 1, + ACUTEST_FLAG_FAILURE_ = 1 << 2, +}; + +extern const struct acutest_test_ acutest_list_[]; + +int acutest_check_(int cond, const char* file, int line, const char* fmt, ...); +void acutest_case_(const char* fmt, ...); +void acutest_message_(const char* fmt, ...); +void acutest_dump_(const char* title, const void* addr, size_t size); +void acutest_abort_(void) ACUTEST_ATTRIBUTE_(noreturn); + + +#ifndef TEST_NO_MAIN + +static char* acutest_argv0_ = NULL; +static size_t acutest_list_size_ = 0; +static struct acutest_test_data_* acutest_test_data_ = NULL; +static size_t acutest_count_ = 0; +static int acutest_no_exec_ = -1; +static int acutest_no_summary_ = 0; +static int acutest_tap_ = 0; +static int acutest_skip_mode_ = 0; +static int acutest_worker_ = 0; +static int acutest_worker_index_ = 0; +static int acutest_cond_failed_ = 0; +static int acutest_was_aborted_ = 0; +static FILE *acutest_xml_output_ = NULL; + +static int acutest_stat_failed_units_ = 0; +static int acutest_stat_run_units_ = 0; + +static const struct acutest_test_* acutest_current_test_ = NULL; +static int acutest_current_index_ = 0; +static char acutest_case_name_[TEST_CASE_MAXSIZE] = ""; +static int acutest_test_already_logged_ = 0; +static int acutest_case_already_logged_ = 0; +static int acutest_verbose_level_ = 2; +static int acutest_test_failures_ = 0; +static int acutest_colorize_ = 0; +static int acutest_timer_ = 0; + +static int acutest_abort_has_jmp_buf_ = 0; +static jmp_buf acutest_abort_jmp_buf_; + + +static void +acutest_cleanup_(void) +{ + free((void*) acutest_test_data_); +} + +static void ACUTEST_ATTRIBUTE_(noreturn) +acutest_exit_(int exit_code) +{ + acutest_cleanup_(); + exit(exit_code); +} + +#if defined ACUTEST_WIN_ + typedef LARGE_INTEGER acutest_timer_type_; + static LARGE_INTEGER acutest_timer_freq_; + static acutest_timer_type_ acutest_timer_start_; + static acutest_timer_type_ acutest_timer_end_; + + static void + acutest_timer_init_(void) + { + QueryPerformanceFrequency(´st_timer_freq_); + } + + static void + acutest_timer_get_time_(LARGE_INTEGER* ts) + { + QueryPerformanceCounter(ts); + } + + static double + acutest_timer_diff_(LARGE_INTEGER start, LARGE_INTEGER end) + { + double duration = (double)(end.QuadPart - start.QuadPart); + duration /= (double)acutest_timer_freq_.QuadPart; + return duration; + } + + static void + acutest_timer_print_diff_(void) + { + printf("%.6lf secs", acutest_timer_diff_(acutest_timer_start_, acutest_timer_end_)); + } +#elif defined ACUTEST_HAS_POSIX_TIMER_ + static clockid_t acutest_timer_id_; + typedef struct timespec acutest_timer_type_; + static acutest_timer_type_ acutest_timer_start_; + static acutest_timer_type_ acutest_timer_end_; + + static void + acutest_timer_init_(void) + { + if(acutest_timer_ == 1) + acutest_timer_id_ = CLOCK_MONOTONIC; + else if(acutest_timer_ == 2) + acutest_timer_id_ = CLOCK_PROCESS_CPUTIME_ID; + } + + static void + acutest_timer_get_time_(struct timespec* ts) + { + clock_gettime(acutest_timer_id_, ts); + } + + static double + acutest_timer_diff_(struct timespec start, struct timespec end) + { + double endns; + double startns; + + endns = end.tv_sec; + endns *= 1e9; + endns += end.tv_nsec; + + startns = start.tv_sec; + startns *= 1e9; + startns += start.tv_nsec; + + return ((endns - startns)/ 1e9); + } + + static void + acutest_timer_print_diff_(void) + { + printf("%.6lf secs", + acutest_timer_diff_(acutest_timer_start_, acutest_timer_end_)); + } +#else + typedef int acutest_timer_type_; + static acutest_timer_type_ acutest_timer_start_; + static acutest_timer_type_ acutest_timer_end_; + + void + acutest_timer_init_(void) + {} + + static void + acutest_timer_get_time_(int* ts) + { + (void) ts; + } + + static double + acutest_timer_diff_(int start, int end) + { + (void) start; + (void) end; + return 0.0; + } + + static void + acutest_timer_print_diff_(void) + {} +#endif + +#define ACUTEST_COLOR_DEFAULT_ 0 +#define ACUTEST_COLOR_GREEN_ 1 +#define ACUTEST_COLOR_RED_ 2 +#define ACUTEST_COLOR_DEFAULT_INTENSIVE_ 3 +#define ACUTEST_COLOR_GREEN_INTENSIVE_ 4 +#define ACUTEST_COLOR_RED_INTENSIVE_ 5 + +static int ACUTEST_ATTRIBUTE_(format (printf, 2, 3)) +acutest_colored_printf_(int color, const char* fmt, ...) +{ + va_list args; + char buffer[256]; + int n; + + va_start(args, fmt); + vsnprintf(buffer, sizeof(buffer), fmt, args); + va_end(args); + buffer[sizeof(buffer)-1] = '\0'; + + if(!acutest_colorize_) { + return printf("%s", buffer); + } + +#if defined ACUTEST_UNIX_ + { + const char* col_str; + switch(color) { + case ACUTEST_COLOR_GREEN_: col_str = "\033[0;32m"; break; + case ACUTEST_COLOR_RED_: col_str = "\033[0;31m"; break; + case ACUTEST_COLOR_GREEN_INTENSIVE_: col_str = "\033[1;32m"; break; + case ACUTEST_COLOR_RED_INTENSIVE_: col_str = "\033[1;31m"; break; + case ACUTEST_COLOR_DEFAULT_INTENSIVE_: col_str = "\033[1m"; break; + default: col_str = "\033[0m"; break; + } + printf("%s", col_str); + n = printf("%s", buffer); + printf("\033[0m"); + return n; + } +#elif defined ACUTEST_WIN_ + { + HANDLE h; + CONSOLE_SCREEN_BUFFER_INFO info; + WORD attr; + + h = GetStdHandle(STD_OUTPUT_HANDLE); + GetConsoleScreenBufferInfo(h, &info); + + switch(color) { + case ACUTEST_COLOR_GREEN_: attr = FOREGROUND_GREEN; break; + case ACUTEST_COLOR_RED_: attr = FOREGROUND_RED; break; + case ACUTEST_COLOR_GREEN_INTENSIVE_: attr = FOREGROUND_GREEN | FOREGROUND_INTENSITY; break; + case ACUTEST_COLOR_RED_INTENSIVE_: attr = FOREGROUND_RED | FOREGROUND_INTENSITY; break; + case ACUTEST_COLOR_DEFAULT_INTENSIVE_: attr = FOREGROUND_BLUE | FOREGROUND_GREEN | FOREGROUND_RED | FOREGROUND_INTENSITY; break; + default: attr = 0; break; + } + if(attr != 0) + SetConsoleTextAttribute(h, attr); + n = printf("%s", buffer); + SetConsoleTextAttribute(h, info.wAttributes); + return n; + } +#else + n = printf("%s", buffer); + return n; +#endif +} + +static void +acutest_begin_test_line_(const struct acutest_test_* test) +{ + if(!acutest_tap_) { + if(acutest_verbose_level_ >= 3) { + acutest_colored_printf_(ACUTEST_COLOR_DEFAULT_INTENSIVE_, "Test %s:\n", test->name); + acutest_test_already_logged_++; + } else if(acutest_verbose_level_ >= 1) { + int n; + char spaces[48]; + + n = acutest_colored_printf_(ACUTEST_COLOR_DEFAULT_INTENSIVE_, "Test %s... ", test->name); + memset(spaces, ' ', sizeof(spaces)); + if(n < (int) sizeof(spaces)) + printf("%.*s", (int) sizeof(spaces) - n, spaces); + } else { + acutest_test_already_logged_ = 1; + } + } +} + +static void +acutest_finish_test_line_(int result) +{ + if(acutest_tap_) { + const char* str = (result == 0) ? "ok" : "not ok"; + + printf("%s %d - %s\n", str, acutest_current_index_ + 1, acutest_current_test_->name); + + if(result == 0 && acutest_timer_) { + printf("# Duration: "); + acutest_timer_print_diff_(); + printf("\n"); + } + } else { + int color = (result == 0) ? ACUTEST_COLOR_GREEN_INTENSIVE_ : ACUTEST_COLOR_RED_INTENSIVE_; + const char* str = (result == 0) ? "OK" : "FAILED"; + printf("[ "); + acutest_colored_printf_(color, "%s", str); + printf(" ]"); + + if(result == 0 && acutest_timer_) { + printf(" "); + acutest_timer_print_diff_(); + } + + printf("\n"); + } +} + +static void +acutest_line_indent_(int level) +{ + static const char spaces[] = " "; + int n = level * 2; + + if(acutest_tap_ && n > 0) { + n--; + printf("#"); + } + + while(n > 16) { + printf("%s", spaces); + n -= 16; + } + printf("%.*s", n, spaces); +} + +int ACUTEST_ATTRIBUTE_(format (printf, 4, 5)) +acutest_check_(int cond, const char* file, int line, const char* fmt, ...) +{ + const char *result_str; + int result_color; + int verbose_level; + + if(cond) { + result_str = "ok"; + result_color = ACUTEST_COLOR_GREEN_; + verbose_level = 3; + } else { + if(!acutest_test_already_logged_ && acutest_current_test_ != NULL) + acutest_finish_test_line_(-1); + + result_str = "failed"; + result_color = ACUTEST_COLOR_RED_; + verbose_level = 2; + acutest_test_failures_++; + acutest_test_already_logged_++; + } + + if(acutest_verbose_level_ >= verbose_level) { + va_list args; + + if(!acutest_case_already_logged_ && acutest_case_name_[0]) { + acutest_line_indent_(1); + acutest_colored_printf_(ACUTEST_COLOR_DEFAULT_INTENSIVE_, "Case %s:\n", acutest_case_name_); + acutest_test_already_logged_++; + acutest_case_already_logged_++; + } + + acutest_line_indent_(acutest_case_name_[0] ? 2 : 1); + if(file != NULL) { +#ifdef ACUTEST_WIN_ + const char* lastsep1 = strrchr(file, '\\'); + const char* lastsep2 = strrchr(file, '/'); + if(lastsep1 == NULL) + lastsep1 = file-1; + if(lastsep2 == NULL) + lastsep2 = file-1; + file = (lastsep1 > lastsep2 ? lastsep1 : lastsep2) + 1; +#else + const char* lastsep = strrchr(file, '/'); + if(lastsep != NULL) + file = lastsep+1; +#endif + printf("%s:%d: Check ", file, line); + } + + va_start(args, fmt); + vprintf(fmt, args); + va_end(args); + + printf("... "); + acutest_colored_printf_(result_color, "%s", result_str); + printf("\n"); + acutest_test_already_logged_++; + } + + acutest_cond_failed_ = (cond == 0); + return !acutest_cond_failed_; +} + +void ACUTEST_ATTRIBUTE_(format (printf, 1, 2)) +acutest_case_(const char* fmt, ...) +{ + va_list args; + + if(acutest_verbose_level_ < 2) + return; + + if(acutest_case_name_[0]) { + acutest_case_already_logged_ = 0; + acutest_case_name_[0] = '\0'; + } + + if(fmt == NULL) + return; + + va_start(args, fmt); + vsnprintf(acutest_case_name_, sizeof(acutest_case_name_) - 1, fmt, args); + va_end(args); + acutest_case_name_[sizeof(acutest_case_name_) - 1] = '\0'; + + if(acutest_verbose_level_ >= 3) { + acutest_line_indent_(1); + acutest_colored_printf_(ACUTEST_COLOR_DEFAULT_INTENSIVE_, "Case %s:\n", acutest_case_name_); + acutest_test_already_logged_++; + acutest_case_already_logged_++; + } +} + +void ACUTEST_ATTRIBUTE_(format (printf, 1, 2)) +acutest_message_(const char* fmt, ...) +{ + char buffer[TEST_MSG_MAXSIZE]; + char* line_beg; + char* line_end; + va_list args; + + if(acutest_verbose_level_ < 2) + return; + + /* We allow extra message only when something is already wrong in the + * current test. */ + if(acutest_current_test_ == NULL || !acutest_cond_failed_) + return; + + va_start(args, fmt); + vsnprintf(buffer, TEST_MSG_MAXSIZE, fmt, args); + va_end(args); + buffer[TEST_MSG_MAXSIZE-1] = '\0'; + + line_beg = buffer; + while(1) { + line_end = strchr(line_beg, '\n'); + if(line_end == NULL) + break; + acutest_line_indent_(acutest_case_name_[0] ? 3 : 2); + printf("%.*s\n", (int)(line_end - line_beg), line_beg); + line_beg = line_end + 1; + } + if(line_beg[0] != '\0') { + acutest_line_indent_(acutest_case_name_[0] ? 3 : 2); + printf("%s\n", line_beg); + } +} + +void +acutest_dump_(const char* title, const void* addr, size_t size) +{ + static const size_t BYTES_PER_LINE = 16; + size_t line_beg; + size_t truncate = 0; + + if(acutest_verbose_level_ < 2) + return; + + /* We allow extra message only when something is already wrong in the + * current test. */ + if(acutest_current_test_ == NULL || !acutest_cond_failed_) + return; + + if(size > TEST_DUMP_MAXSIZE) { + truncate = size - TEST_DUMP_MAXSIZE; + size = TEST_DUMP_MAXSIZE; + } + + acutest_line_indent_(acutest_case_name_[0] ? 3 : 2); + printf((title[strlen(title)-1] == ':') ? "%s\n" : "%s:\n", title); + + for(line_beg = 0; line_beg < size; line_beg += BYTES_PER_LINE) { + size_t line_end = line_beg + BYTES_PER_LINE; + size_t off; + + acutest_line_indent_(acutest_case_name_[0] ? 4 : 3); + printf("%08lx: ", (unsigned long)line_beg); + for(off = line_beg; off < line_end; off++) { + if(off < size) + printf(" %02x", ((const unsigned char*)addr)[off]); + else + printf(" "); + } + + printf(" "); + for(off = line_beg; off < line_end; off++) { + unsigned char byte = ((const unsigned char*)addr)[off]; + if(off < size) + printf("%c", (iscntrl(byte) ? '.' : byte)); + else + break; + } + + printf("\n"); + } + + if(truncate > 0) { + acutest_line_indent_(acutest_case_name_[0] ? 4 : 3); + printf(" ... (and more %u bytes)\n", (unsigned) truncate); + } +} + +/* This is called just before each test */ +static void +acutest_init_(const char *test_name) +{ +#ifdef TEST_INIT + TEST_INIT + ; /* Allow for a single unterminated function call */ +#endif + + /* Suppress any warnings about unused variable. */ + (void) test_name; +} + +/* This is called after each test */ +static void +acutest_fini_(const char *test_name) +{ +#ifdef TEST_FINI + TEST_FINI + ; /* Allow for a single unterminated function call */ +#endif + + /* Suppress any warnings about unused variable. */ + (void) test_name; +} + +void +acutest_abort_(void) +{ + if(acutest_abort_has_jmp_buf_) { + longjmp(acutest_abort_jmp_buf_, 1); + } else { + if(acutest_current_test_ != NULL) + acutest_fini_(acutest_current_test_->name); + abort(); + } +} + +static void +acutest_list_names_(void) +{ + const struct acutest_test_* test; + + printf("Unit tests:\n"); + for(test = ´st_list_[0]; test->func != NULL; test++) + printf(" %s\n", test->name); +} + +static void +acutest_remember_(int i) +{ + if(acutest_test_data_[i].flags & ACUTEST_FLAG_RUN_) + return; + + acutest_test_data_[i].flags |= ACUTEST_FLAG_RUN_; + acutest_count_++; +} + +static void +acutest_set_success_(int i, int success) +{ + acutest_test_data_[i].flags |= success ? ACUTEST_FLAG_SUCCESS_ : ACUTEST_FLAG_FAILURE_; +} + +static void +acutest_set_duration_(int i, double duration) +{ + acutest_test_data_[i].duration = duration; +} + +static int +acutest_name_contains_word_(const char* name, const char* pattern) +{ + static const char word_delim[] = " \t-_/.,:;"; + const char* substr; + size_t pattern_len; + + pattern_len = strlen(pattern); + + substr = strstr(name, pattern); + while(substr != NULL) { + int starts_on_word_boundary = (substr == name || strchr(word_delim, substr[-1]) != NULL); + int ends_on_word_boundary = (substr[pattern_len] == '\0' || strchr(word_delim, substr[pattern_len]) != NULL); + + if(starts_on_word_boundary && ends_on_word_boundary) + return 1; + + substr = strstr(substr+1, pattern); + } + + return 0; +} + +static int +acutest_lookup_(const char* pattern) +{ + int i; + int n = 0; + + /* Try exact match. */ + for(i = 0; i < (int) acutest_list_size_; i++) { + if(strcmp(acutest_list_[i].name, pattern) == 0) { + acutest_remember_(i); + n++; + break; + } + } + if(n > 0) + return n; + + /* Try word match. */ + for(i = 0; i < (int) acutest_list_size_; i++) { + if(acutest_name_contains_word_(acutest_list_[i].name, pattern)) { + acutest_remember_(i); + n++; + } + } + if(n > 0) + return n; + + /* Try relaxed match. */ + for(i = 0; i < (int) acutest_list_size_; i++) { + if(strstr(acutest_list_[i].name, pattern) != NULL) { + acutest_remember_(i); + n++; + } + } + + return n; +} + + +/* Called if anything goes bad in Acutest, or if the unit test ends in other + * way then by normal returning from its function (e.g. exception or some + * abnormal child process termination). */ +static void ACUTEST_ATTRIBUTE_(format (printf, 1, 2)) +acutest_error_(const char* fmt, ...) +{ + if(acutest_verbose_level_ == 0) + return; + + if(acutest_verbose_level_ >= 2) { + va_list args; + + acutest_line_indent_(1); + if(acutest_verbose_level_ >= 3) + acutest_colored_printf_(ACUTEST_COLOR_RED_INTENSIVE_, "ERROR: "); + va_start(args, fmt); + vprintf(fmt, args); + va_end(args); + printf("\n"); + } + + if(acutest_verbose_level_ >= 3) { + printf("\n"); + } +} + +/* Call directly the given test unit function. */ +static int +acutest_do_run_(const struct acutest_test_* test, int index) +{ + int status = -1; + + acutest_was_aborted_ = 0; + acutest_current_test_ = test; + acutest_current_index_ = index; + acutest_test_failures_ = 0; + acutest_test_already_logged_ = 0; + acutest_cond_failed_ = 0; + +#ifdef __cplusplus + try { +#endif + acutest_init_(test->name); + acutest_begin_test_line_(test); + + /* This is good to do in case the test unit crashes. */ + fflush(stdout); + fflush(stderr); + + if(!acutest_worker_) { + acutest_abort_has_jmp_buf_ = 1; + if(setjmp(acutest_abort_jmp_buf_) != 0) { + acutest_was_aborted_ = 1; + goto aborted; + } + } + + acutest_timer_get_time_(´st_timer_start_); + test->func(); +aborted: + acutest_abort_has_jmp_buf_ = 0; + acutest_timer_get_time_(´st_timer_end_); + + if(acutest_verbose_level_ >= 3) { + acutest_line_indent_(1); + if(acutest_test_failures_ == 0) { + acutest_colored_printf_(ACUTEST_COLOR_GREEN_INTENSIVE_, "SUCCESS: "); + printf("All conditions have passed.\n"); + + if(acutest_timer_) { + acutest_line_indent_(1); + printf("Duration: "); + acutest_timer_print_diff_(); + printf("\n"); + } + } else { + acutest_colored_printf_(ACUTEST_COLOR_RED_INTENSIVE_, "FAILED: "); + if(!acutest_was_aborted_) { + printf("%d condition%s %s failed.\n", + acutest_test_failures_, + (acutest_test_failures_ == 1) ? "" : "s", + (acutest_test_failures_ == 1) ? "has" : "have"); + } else { + printf("Aborted.\n"); + } + } + printf("\n"); + } else if(acutest_verbose_level_ >= 1 && acutest_test_failures_ == 0) { + acutest_finish_test_line_(0); + } + + status = (acutest_test_failures_ == 0) ? 0 : -1; + +#ifdef __cplusplus + } catch(std::exception& e) { + const char* what = e.what(); + acutest_check_(0, NULL, 0, "Threw std::exception"); + if(what != NULL) + acutest_message_("std::exception::what(): %s", what); + + if(acutest_verbose_level_ >= 3) { + acutest_line_indent_(1); + acutest_colored_printf_(ACUTEST_COLOR_RED_INTENSIVE_, "FAILED: "); + printf("C++ exception.\n\n"); + } + } catch(...) { + acutest_check_(0, NULL, 0, "Threw an exception"); + + if(acutest_verbose_level_ >= 3) { + acutest_line_indent_(1); + acutest_colored_printf_(ACUTEST_COLOR_RED_INTENSIVE_, "FAILED: "); + printf("C++ exception.\n\n"); + } + } +#endif + + acutest_fini_(test->name); + acutest_case_(NULL); + acutest_current_test_ = NULL; + + return status; +} + +/* Trigger the unit test. If possible (and not suppressed) it starts a child + * process who calls acutest_do_run_(), otherwise it calls acutest_do_run_() + * directly. */ +static void +acutest_run_(const struct acutest_test_* test, int index, int master_index) +{ + int failed = 1; + acutest_timer_type_ start, end; + + acutest_current_test_ = test; + acutest_test_already_logged_ = 0; + acutest_timer_get_time_(&start); + + if(!acutest_no_exec_) { + +#if defined(ACUTEST_UNIX_) + + pid_t pid; + int exit_code; + + /* Make sure the child starts with empty I/O buffers. */ + fflush(stdout); + fflush(stderr); + + pid = fork(); + if(pid == (pid_t)-1) { + acutest_error_("Cannot fork. %s [%d]", strerror(errno), errno); + failed = 1; + } else if(pid == 0) { + /* Child: Do the test. */ + acutest_worker_ = 1; + failed = (acutest_do_run_(test, index) != 0); + acutest_exit_(failed ? 1 : 0); + } else { + /* Parent: Wait until child terminates and analyze its exit code. */ + waitpid(pid, &exit_code, 0); + if(WIFEXITED(exit_code)) { + switch(WEXITSTATUS(exit_code)) { + case 0: failed = 0; break; /* test has passed. */ + case 1: /* noop */ break; /* "normal" failure. */ + default: acutest_error_("Unexpected exit code [%d]", WEXITSTATUS(exit_code)); + } + } else if(WIFSIGNALED(exit_code)) { + char tmp[32]; + const char* signame; + switch(WTERMSIG(exit_code)) { + case SIGINT: signame = "SIGINT"; break; + case SIGHUP: signame = "SIGHUP"; break; + case SIGQUIT: signame = "SIGQUIT"; break; + case SIGABRT: signame = "SIGABRT"; break; + case SIGKILL: signame = "SIGKILL"; break; + case SIGSEGV: signame = "SIGSEGV"; break; + case SIGILL: signame = "SIGILL"; break; + case SIGTERM: signame = "SIGTERM"; break; + default: sprintf(tmp, "signal %d", WTERMSIG(exit_code)); signame = tmp; break; + } + acutest_error_("Test interrupted by %s.", signame); + } else { + acutest_error_("Test ended in an unexpected way [%d].", exit_code); + } + } + +#elif defined(ACUTEST_WIN_) + + char buffer[512] = {0}; + STARTUPINFOA startupInfo; + PROCESS_INFORMATION processInfo; + DWORD exitCode; + + /* Windows has no fork(). So we propagate all info into the child + * through a command line arguments. */ + _snprintf(buffer, sizeof(buffer)-1, + "%s --worker=%d %s --no-exec --no-summary %s --verbose=%d --color=%s -- \"%s\"", + acutest_argv0_, index, acutest_timer_ ? "--time" : "", + acutest_tap_ ? "--tap" : "", acutest_verbose_level_, + acutest_colorize_ ? "always" : "never", + test->name); + memset(&startupInfo, 0, sizeof(startupInfo)); + startupInfo.cb = sizeof(STARTUPINFO); + if(CreateProcessA(NULL, buffer, NULL, NULL, FALSE, 0, NULL, NULL, &startupInfo, &processInfo)) { + WaitForSingleObject(processInfo.hProcess, INFINITE); + GetExitCodeProcess(processInfo.hProcess, &exitCode); + CloseHandle(processInfo.hThread); + CloseHandle(processInfo.hProcess); + failed = (exitCode != 0); + if(exitCode > 1) { + switch(exitCode) { + case 3: acutest_error_("Aborted."); break; + case 0xC0000005: acutest_error_("Access violation."); break; + default: acutest_error_("Test ended in an unexpected way [%lu].", exitCode); break; + } + } + } else { + acutest_error_("Cannot create unit test subprocess [%ld].", GetLastError()); + failed = 1; + } + +#else + + /* A platform where we don't know how to run child process. */ + failed = (acutest_do_run_(test, index) != 0); + +#endif + + } else { + /* Child processes suppressed through --no-exec. */ + failed = (acutest_do_run_(test, index) != 0); + } + acutest_timer_get_time_(&end); + + acutest_current_test_ = NULL; + + acutest_stat_run_units_++; + if(failed) + acutest_stat_failed_units_++; + + acutest_set_success_(master_index, !failed); + acutest_set_duration_(master_index, acutest_timer_diff_(start, end)); +} + +#if defined(ACUTEST_WIN_) +/* Callback for SEH events. */ +static LONG CALLBACK +acutest_seh_exception_filter_(EXCEPTION_POINTERS *ptrs) +{ + acutest_check_(0, NULL, 0, "Unhandled SEH exception"); + acutest_message_("Exception code: 0x%08lx", ptrs->ExceptionRecord->ExceptionCode); + acutest_message_("Exception address: 0x%p", ptrs->ExceptionRecord->ExceptionAddress); + + fflush(stdout); + fflush(stderr); + + return EXCEPTION_EXECUTE_HANDLER; +} +#endif + + +#define ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ 0x0001 +#define ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_ 0x0002 + +#define ACUTEST_CMDLINE_OPTID_NONE_ 0 +#define ACUTEST_CMDLINE_OPTID_UNKNOWN_ (-0x7fffffff + 0) +#define ACUTEST_CMDLINE_OPTID_MISSINGARG_ (-0x7fffffff + 1) +#define ACUTEST_CMDLINE_OPTID_BOGUSARG_ (-0x7fffffff + 2) + +typedef struct acutest_test_CMDLINE_OPTION_ { + char shortname; + const char* longname; + int id; + unsigned flags; +} ACUTEST_CMDLINE_OPTION_; + +static int +acutest_cmdline_handle_short_opt_group_(const ACUTEST_CMDLINE_OPTION_* options, + const char* arggroup, + int (*callback)(int /*optval*/, const char* /*arg*/)) +{ + const ACUTEST_CMDLINE_OPTION_* opt; + int i; + int ret = 0; + + for(i = 0; arggroup[i] != '\0'; i++) { + for(opt = options; opt->id != 0; opt++) { + if(arggroup[i] == opt->shortname) + break; + } + + if(opt->id != 0 && !(opt->flags & ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_)) { + ret = callback(opt->id, NULL); + } else { + /* Unknown option. */ + char badoptname[3]; + badoptname[0] = '-'; + badoptname[1] = arggroup[i]; + badoptname[2] = '\0'; + ret = callback((opt->id != 0 ? ACUTEST_CMDLINE_OPTID_MISSINGARG_ : ACUTEST_CMDLINE_OPTID_UNKNOWN_), + badoptname); + } + + if(ret != 0) + break; + } + + return ret; +} + +#define ACUTEST_CMDLINE_AUXBUF_SIZE_ 32 + +static int +acutest_cmdline_read_(const ACUTEST_CMDLINE_OPTION_* options, int argc, char** argv, + int (*callback)(int /*optval*/, const char* /*arg*/)) +{ + + const ACUTEST_CMDLINE_OPTION_* opt; + char auxbuf[ACUTEST_CMDLINE_AUXBUF_SIZE_+1]; + int after_doubledash = 0; + int i = 1; + int ret = 0; + + auxbuf[ACUTEST_CMDLINE_AUXBUF_SIZE_] = '\0'; + + while(i < argc) { + if(after_doubledash || strcmp(argv[i], "-") == 0) { + /* Non-option argument. */ + ret = callback(ACUTEST_CMDLINE_OPTID_NONE_, argv[i]); + } else if(strcmp(argv[i], "--") == 0) { + /* End of options. All the remaining members are non-option arguments. */ + after_doubledash = 1; + } else if(argv[i][0] != '-') { + /* Non-option argument. */ + ret = callback(ACUTEST_CMDLINE_OPTID_NONE_, argv[i]); + } else { + for(opt = options; opt->id != 0; opt++) { + if(opt->longname != NULL && strncmp(argv[i], "--", 2) == 0) { + size_t len = strlen(opt->longname); + if(strncmp(argv[i]+2, opt->longname, len) == 0) { + /* Regular long option. */ + if(argv[i][2+len] == '\0') { + /* with no argument provided. */ + if(!(opt->flags & ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_)) + ret = callback(opt->id, NULL); + else + ret = callback(ACUTEST_CMDLINE_OPTID_MISSINGARG_, argv[i]); + break; + } else if(argv[i][2+len] == '=') { + /* with an argument provided. */ + if(opt->flags & (ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ | ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_)) { + ret = callback(opt->id, argv[i]+2+len+1); + } else { + sprintf(auxbuf, "--%s", opt->longname); + ret = callback(ACUTEST_CMDLINE_OPTID_BOGUSARG_, auxbuf); + } + break; + } else { + continue; + } + } + } else if(opt->shortname != '\0' && argv[i][0] == '-') { + if(argv[i][1] == opt->shortname) { + /* Regular short option. */ + if(opt->flags & ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_) { + if(argv[i][2] != '\0') + ret = callback(opt->id, argv[i]+2); + else if(i+1 < argc) + ret = callback(opt->id, argv[++i]); + else + ret = callback(ACUTEST_CMDLINE_OPTID_MISSINGARG_, argv[i]); + break; + } else { + ret = callback(opt->id, NULL); + + /* There might be more (argument-less) short options + * grouped together. */ + if(ret == 0 && argv[i][2] != '\0') + ret = acutest_cmdline_handle_short_opt_group_(options, argv[i]+2, callback); + break; + } + } + } + } + + if(opt->id == 0) { /* still not handled? */ + if(argv[i][0] != '-') { + /* Non-option argument. */ + ret = callback(ACUTEST_CMDLINE_OPTID_NONE_, argv[i]); + } else { + /* Unknown option. */ + char* badoptname = argv[i]; + + if(strncmp(badoptname, "--", 2) == 0) { + /* Strip any argument from the long option. */ + char* assignment = strchr(badoptname, '='); + if(assignment != NULL) { + size_t len = assignment - badoptname; + if(len > ACUTEST_CMDLINE_AUXBUF_SIZE_) + len = ACUTEST_CMDLINE_AUXBUF_SIZE_; + strncpy(auxbuf, badoptname, len); + auxbuf[len] = '\0'; + badoptname = auxbuf; + } + } + + ret = callback(ACUTEST_CMDLINE_OPTID_UNKNOWN_, badoptname); + } + } + } + + if(ret != 0) + return ret; + i++; + } + + return ret; +} + +static void +acutest_help_(void) +{ + printf("Usage: %s [options] [test...]\n", acutest_argv0_); + printf("\n"); + printf("Run the specified unit tests; or if the option '--skip' is used, run all\n"); + printf("tests in the suite but those listed. By default, if no tests are specified\n"); + printf("on the command line, all unit tests in the suite are run.\n"); + printf("\n"); + printf("Options:\n"); + printf(" -s, --skip Execute all unit tests but the listed ones\n"); + printf(" --exec[=WHEN] If supported, execute unit tests as child processes\n"); + printf(" (WHEN is one of 'auto', 'always', 'never')\n"); + printf(" -E, --no-exec Same as --exec=never\n"); +#if defined ACUTEST_WIN_ + printf(" -t, --time Measure test duration\n"); +#elif defined ACUTEST_HAS_POSIX_TIMER_ + printf(" -t, --time Measure test duration (real time)\n"); + printf(" --time=TIMER Measure test duration, using given timer\n"); + printf(" (TIMER is one of 'real', 'cpu')\n"); +#endif + printf(" --no-summary Suppress printing of test results summary\n"); + printf(" --tap Produce TAP-compliant output\n"); + printf(" (See https://testanything.org/)\n"); + printf(" -x, --xml-output=FILE Enable XUnit output to the given file\n"); + printf(" -l, --list List unit tests in the suite and exit\n"); + printf(" -v, --verbose Make output more verbose\n"); + printf(" --verbose=LEVEL Set verbose level to LEVEL:\n"); + printf(" 0 ... Be silent\n"); + printf(" 1 ... Output one line per test (and summary)\n"); + printf(" 2 ... As 1 and failed conditions (this is default)\n"); + printf(" 3 ... As 1 and all conditions (and extended summary)\n"); + printf(" -q, --quiet Same as --verbose=0\n"); + printf(" --color[=WHEN] Enable colorized output\n"); + printf(" (WHEN is one of 'auto', 'always', 'never')\n"); + printf(" --no-color Same as --color=never\n"); + printf(" -h, --help Display this help and exit\n"); + + if(acutest_list_size_ < 16) { + printf("\n"); + acutest_list_names_(); + } +} + +static const ACUTEST_CMDLINE_OPTION_ acutest_cmdline_options_[] = { + { 's', "skip", 's', 0 }, + { 0, "exec", 'e', ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ }, + { 'E', "no-exec", 'E', 0 }, +#if defined ACUTEST_WIN_ + { 't', "time", 't', 0 }, + { 0, "timer", 't', 0 }, /* kept for compatibility */ +#elif defined ACUTEST_HAS_POSIX_TIMER_ + { 't', "time", 't', ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ }, + { 0, "timer", 't', ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ }, /* kept for compatibility */ +#endif + { 0, "no-summary", 'S', 0 }, + { 0, "tap", 'T', 0 }, + { 'l', "list", 'l', 0 }, + { 'v', "verbose", 'v', ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ }, + { 'q', "quiet", 'q', 0 }, + { 0, "color", 'c', ACUTEST_CMDLINE_OPTFLAG_OPTIONALARG_ }, + { 0, "no-color", 'C', 0 }, + { 'h', "help", 'h', 0 }, + { 0, "worker", 'w', ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_ }, /* internal */ + { 'x', "xml-output", 'x', ACUTEST_CMDLINE_OPTFLAG_REQUIREDARG_ }, + { 0, NULL, 0, 0 } +}; + +static int +acutest_cmdline_callback_(int id, const char* arg) +{ + switch(id) { + case 's': + acutest_skip_mode_ = 1; + break; + + case 'e': + if(arg == NULL || strcmp(arg, "always") == 0) { + acutest_no_exec_ = 0; + } else if(strcmp(arg, "never") == 0) { + acutest_no_exec_ = 1; + } else if(strcmp(arg, "auto") == 0) { + /*noop*/ + } else { + fprintf(stderr, "%s: Unrecognized argument '%s' for option --exec.\n", acutest_argv0_, arg); + fprintf(stderr, "Try '%s --help' for more information.\n", acutest_argv0_); + acutest_exit_(2); + } + break; + + case 'E': + acutest_no_exec_ = 1; + break; + + case 't': +#if defined ACUTEST_WIN_ || defined ACUTEST_HAS_POSIX_TIMER_ + if(arg == NULL || strcmp(arg, "real") == 0) { + acutest_timer_ = 1; + #ifndef ACUTEST_WIN_ + } else if(strcmp(arg, "cpu") == 0) { + acutest_timer_ = 2; + #endif + } else { + fprintf(stderr, "%s: Unrecognized argument '%s' for option --time.\n", acutest_argv0_, arg); + fprintf(stderr, "Try '%s --help' for more information.\n", acutest_argv0_); + acutest_exit_(2); + } +#endif + break; + + case 'S': + acutest_no_summary_ = 1; + break; + + case 'T': + acutest_tap_ = 1; + break; + + case 'l': + acutest_list_names_(); + acutest_exit_(0); + break; + + case 'v': + acutest_verbose_level_ = (arg != NULL ? atoi(arg) : acutest_verbose_level_+1); + break; + + case 'q': + acutest_verbose_level_ = 0; + break; + + case 'c': + if(arg == NULL || strcmp(arg, "always") == 0) { + acutest_colorize_ = 1; + } else if(strcmp(arg, "never") == 0) { + acutest_colorize_ = 0; + } else if(strcmp(arg, "auto") == 0) { + /*noop*/ + } else { + fprintf(stderr, "%s: Unrecognized argument '%s' for option --color.\n", acutest_argv0_, arg); + fprintf(stderr, "Try '%s --help' for more information.\n", acutest_argv0_); + acutest_exit_(2); + } + break; + + case 'C': + acutest_colorize_ = 0; + break; + + case 'h': + acutest_help_(); + acutest_exit_(0); + break; + + case 'w': + acutest_worker_ = 1; + acutest_worker_index_ = atoi(arg); + break; + case 'x': + acutest_xml_output_ = fopen(arg, "w"); + if (!acutest_xml_output_) { + fprintf(stderr, "Unable to open '%s': %s\n", arg, strerror(errno)); + acutest_exit_(2); + } + break; + + case 0: + if(acutest_lookup_(arg) == 0) { + fprintf(stderr, "%s: Unrecognized unit test '%s'\n", acutest_argv0_, arg); + fprintf(stderr, "Try '%s --list' for list of unit tests.\n", acutest_argv0_); + acutest_exit_(2); + } + break; + + case ACUTEST_CMDLINE_OPTID_UNKNOWN_: + fprintf(stderr, "Unrecognized command line option '%s'.\n", arg); + fprintf(stderr, "Try '%s --help' for more information.\n", acutest_argv0_); + acutest_exit_(2); + break; + + case ACUTEST_CMDLINE_OPTID_MISSINGARG_: + fprintf(stderr, "The command line option '%s' requires an argument.\n", arg); + fprintf(stderr, "Try '%s --help' for more information.\n", acutest_argv0_); + acutest_exit_(2); + break; + + case ACUTEST_CMDLINE_OPTID_BOGUSARG_: + fprintf(stderr, "The command line option '%s' does not expect an argument.\n", arg); + fprintf(stderr, "Try '%s --help' for more information.\n", acutest_argv0_); + acutest_exit_(2); + break; + } + + return 0; +} + + +#ifdef ACUTEST_LINUX_ +static int +acutest_is_tracer_present_(void) +{ + /* Must be large enough so the line 'TracerPid: ${PID}' can fit in. */ + static const int OVERLAP = 32; + + char buf[512]; + int tracer_present = 0; + int fd; + size_t n_read = 0; + + fd = open("/proc/self/status", O_RDONLY); + if(fd == -1) + return 0; + + while(1) { + static const char pattern[] = "TracerPid:"; + const char* field; + + while(n_read < sizeof(buf) - 1) { + ssize_t n; + + n = read(fd, buf + n_read, sizeof(buf) - 1 - n_read); + if(n <= 0) + break; + n_read += n; + } + buf[n_read] = '\0'; + + field = strstr(buf, pattern); + if(field != NULL && field < buf + sizeof(buf) - OVERLAP) { + pid_t tracer_pid = (pid_t) atoi(field + sizeof(pattern) - 1); + tracer_present = (tracer_pid != 0); + break; + } + + if(n_read == sizeof(buf) - 1) { + /* Move the tail with the potentially incomplete line we're looking + * for to the beginning of the buffer. */ + memmove(buf, buf + sizeof(buf) - 1 - OVERLAP, OVERLAP); + n_read = OVERLAP; + } else { + break; + } + } + + close(fd); + return tracer_present; +} +#endif + +#ifdef ACUTEST_MACOS_ +static bool +acutest_AmIBeingDebugged(void) +{ + int junk; + int mib[4]; + struct kinfo_proc info; + size_t size; + + // Initialize the flags so that, if sysctl fails for some bizarre + // reason, we get a predictable result. + info.kp_proc.p_flag = 0; + + // Initialize mib, which tells sysctl the info we want, in this case + // we're looking for information about a specific process ID. + mib[0] = CTL_KERN; + mib[1] = KERN_PROC; + mib[2] = KERN_PROC_PID; + mib[3] = getpid(); + + // Call sysctl. + size = sizeof(info); + junk = sysctl(mib, sizeof(mib) / sizeof(*mib), &info, &size, NULL, 0); + assert(junk == 0); + + // We're being debugged if the P_TRACED flag is set. + return ( (info.kp_proc.p_flag & P_TRACED) != 0 ); +} +#endif + +int +main(int argc, char** argv) +{ + int i; + + acutest_argv0_ = argv[0]; + +#if defined ACUTEST_UNIX_ + acutest_colorize_ = isatty(STDOUT_FILENO); +#elif defined ACUTEST_WIN_ + #if defined _BORLANDC_ + acutest_colorize_ = isatty(_fileno(stdout)); + #else + acutest_colorize_ = _isatty(_fileno(stdout)); + #endif +#else + acutest_colorize_ = 0; +#endif + + /* Count all test units */ + acutest_list_size_ = 0; + for(i = 0; acutest_list_[i].func != NULL; i++) + acutest_list_size_++; + + acutest_test_data_ = (struct acutest_test_data_*)calloc(acutest_list_size_, sizeof(struct acutest_test_data_)); + if(acutest_test_data_ == NULL) { + fprintf(stderr, "Out of memory.\n"); + acutest_exit_(2); + } + + /* Parse options */ + acutest_cmdline_read_(acutest_cmdline_options_, argc, argv, acutest_cmdline_callback_); + + /* Initialize the proper timer. */ + acutest_timer_init_(); + +#if defined(ACUTEST_WIN_) + SetUnhandledExceptionFilter(acutest_seh_exception_filter_); +#ifdef _MSC_VER + _set_abort_behavior(0, _WRITE_ABORT_MSG); +#endif +#endif + + /* By default, we want to run all tests. */ + if(acutest_count_ == 0) { + for(i = 0; acutest_list_[i].func != NULL; i++) + acutest_remember_(i); + } + + /* Guess whether we want to run unit tests as child processes. */ + if(acutest_no_exec_ < 0) { + acutest_no_exec_ = 0; + + if(acutest_count_ <= 1) { + acutest_no_exec_ = 1; + } else { +#ifdef ACUTEST_WIN_ + if(IsDebuggerPresent()) + acutest_no_exec_ = 1; +#endif +#ifdef ACUTEST_LINUX_ + if(acutest_is_tracer_present_()) + acutest_no_exec_ = 1; +#endif +#ifdef ACUTEST_MACOS_ + if(acutest_AmIBeingDebugged()) + acutest_no_exec_ = 1; +#endif +#ifdef RUNNING_ON_VALGRIND + /* RUNNING_ON_VALGRIND is provided by optionally included <valgrind.h> */ + if(RUNNING_ON_VALGRIND) + acutest_no_exec_ = 1; +#endif + } + } + + if(acutest_tap_) { + /* TAP requires we know test result ("ok", "not ok") before we output + * anything about the test, and this gets problematic for larger verbose + * levels. */ + if(acutest_verbose_level_ > 2) + acutest_verbose_level_ = 2; + + /* TAP harness should provide some summary. */ + acutest_no_summary_ = 1; + + if(!acutest_worker_) + printf("1..%d\n", (int) acutest_count_); + } + + int index = acutest_worker_index_; + for(i = 0; acutest_list_[i].func != NULL; i++) { + int run = (acutest_test_data_[i].flags & ACUTEST_FLAG_RUN_); + if (acutest_skip_mode_) /* Run all tests except those listed. */ + run = !run; + if(run) + acutest_run_(´st_list_[i], index++, i); + } + + /* Write a summary */ + if(!acutest_no_summary_ && acutest_verbose_level_ >= 1) { + if(acutest_verbose_level_ >= 3) { + acutest_colored_printf_(ACUTEST_COLOR_DEFAULT_INTENSIVE_, "Summary:\n"); + + printf(" Count of all unit tests: %4d\n", (int) acutest_list_size_); + printf(" Count of run unit tests: %4d\n", acutest_stat_run_units_); + printf(" Count of failed unit tests: %4d\n", acutest_stat_failed_units_); + printf(" Count of skipped unit tests: %4d\n", (int) acutest_list_size_ - acutest_stat_run_units_); + } + + if(acutest_stat_failed_units_ == 0) { + acutest_colored_printf_(ACUTEST_COLOR_GREEN_INTENSIVE_, "SUCCESS:"); + printf(" All unit tests have passed.\n"); + } else { + acutest_colored_printf_(ACUTEST_COLOR_RED_INTENSIVE_, "FAILED:"); + printf(" %d of %d unit tests %s failed.\n", + acutest_stat_failed_units_, acutest_stat_run_units_, + (acutest_stat_failed_units_ == 1) ? "has" : "have"); + } + + if(acutest_verbose_level_ >= 3) + printf("\n"); + } + + if (acutest_xml_output_) { +#if defined ACUTEST_UNIX_ + char *suite_name = basename(argv[0]); +#elif defined ACUTEST_WIN_ + char suite_name[_MAX_FNAME]; + _splitpath(argv[0], NULL, NULL, suite_name, NULL); +#else + const char *suite_name = argv[0]; +#endif + fprintf(acutest_xml_output_, "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"); + fprintf(acutest_xml_output_, "<testsuite name=\"%s\" tests=\"%d\" errors=\"%d\" failures=\"%d\" skip=\"%d\">\n", + suite_name, (int)acutest_list_size_, acutest_stat_failed_units_, acutest_stat_failed_units_, + (int)acutest_list_size_ - acutest_stat_run_units_); + for(i = 0; acutest_list_[i].func != NULL; i++) { + struct acutest_test_data_ *details = ´st_test_data_[i]; + fprintf(acutest_xml_output_, " <testcase name=\"%s\" time=\"%.2f\">\n", acutest_list_[i].name, details->duration); + if (details->flags & ACUTEST_FLAG_FAILURE_) + fprintf(acutest_xml_output_, " <failure />\n"); + if (!(details->flags & ACUTEST_FLAG_FAILURE_) && !(details->flags & ACUTEST_FLAG_SUCCESS_)) + fprintf(acutest_xml_output_, " <skipped />\n"); + fprintf(acutest_xml_output_, " </testcase>\n"); + } + fprintf(acutest_xml_output_, "</testsuite>\n"); + fclose(acutest_xml_output_); + } + + acutest_cleanup_(); + + return (acutest_stat_failed_units_ == 0) ? 0 : 1; +} + + +#endif /* #ifndef TEST_NO_MAIN */ + +#ifdef _MSC_VER + #pragma warning(pop) +#endif + +#ifdef __cplusplus + } /* extern "C" */ +#endif + +#endif /* #ifndef ACUTEST_H */ diff --git a/test_c/cell.c b/test_c/cell.c new file mode 100644 index 0000000..fc1ac41 --- /dev/null +++ b/test_c/cell.c @@ -0,0 +1,239 @@ +#include "acutest.h" +#include "../src_c/cell.h" + + +void test_cell_number() { + lsp_cell_t c[4]; + + lsp_cell_set_number(c, 0); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(c[0] == 0x0000); + TEST_ASSERT(lsp_cell_get_number(c) == 0); + + lsp_cell_set_number(c, 1); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(c[0] == 0x0001); + TEST_ASSERT(lsp_cell_get_number(c) == 1); + + lsp_cell_set_number(c, 0x0fff); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(c[0] == 0x0fff); + TEST_ASSERT(lsp_cell_get_number(c) == 0x0fff); + + lsp_cell_set_number(c, 0x1fff); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(c[0] == 0x2000); + TEST_ASSERT(c[1] == 0x1fff); + TEST_ASSERT(lsp_cell_get_number(c) == 0x1fff); + + lsp_cell_set_number(c, 0xffff); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(c[0] == 0x2003); + TEST_ASSERT(c[1] == 0x3fff); + TEST_ASSERT(lsp_cell_get_number(c) == 0xffff); + + lsp_cell_set_number(c, 0x7fffffff); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 3); + TEST_ASSERT(c[0] == 0x2007); + TEST_ASSERT(c[1] == 0x7fff); + TEST_ASSERT(c[2] == 0x3fff); + TEST_ASSERT(lsp_cell_get_number(c) == 0x7fffffff); + + lsp_cell_set_number(c, -1); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(c[0] == 0x1fff); + TEST_ASSERT(lsp_cell_get_number(c) == -1); + + lsp_cell_set_number(c, -0x1000); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(c[0] == 0x1000); + TEST_ASSERT(lsp_cell_get_number(c) == -0x1000); + + lsp_cell_set_number(c, -0x2fff); + TEST_ASSERT(lsp_cell_is_number(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(c[0] == 0x3fff); + TEST_ASSERT(c[1] == 0x1001); + TEST_ASSERT(lsp_cell_get_number(c) == -0x2fff); + + c[0] = 0x4000; + TEST_ASSERT(!lsp_cell_is_number(c)); +} + + +void test_cell_pair() { + lsp_cell_t c[2]; + + lsp_cell_set_pair(c, 1, 2); + TEST_ASSERT(lsp_cell_is_pair(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(lsp_cell_get_pair_first(c) == 1); + TEST_ASSERT(lsp_cell_get_pair_second(c) == 2); + + lsp_cell_set_pair(c, 0x3fff, 0x0000); + TEST_ASSERT(lsp_cell_is_pair(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(lsp_cell_get_pair_first(c) == 0x3fff); + TEST_ASSERT(lsp_cell_get_pair_second(c) == 0x0000); + + lsp_cell_set_pair(c, 0x0000, 0x3fff); + TEST_ASSERT(lsp_cell_is_pair(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(lsp_cell_get_pair_first(c) == 0x0000); + TEST_ASSERT(lsp_cell_get_pair_second(c) == 0x3fff); +} + + +void test_cell_string() { + lsp_cell_t c[4]; + + lsp_cell_set_string(c, 0); + TEST_ASSERT(lsp_cell_is_string(c)); + TEST_ASSERT(lsp_cell_is_string_or_symbol(c)); + TEST_ASSERT(!lsp_cell_is_symbol(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(lsp_cell_get_string_len(c) == 0); + + lsp_cell_set_string(c, 1); + TEST_ASSERT(lsp_cell_is_string(c)); + TEST_ASSERT(lsp_cell_is_string_or_symbol(c)); + TEST_ASSERT(!lsp_cell_is_symbol(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(lsp_cell_get_string_len(c) == 1); + lsp_cell_set_string_data(c, 0, 0xff); + TEST_ASSERT(c[1] == 0x7f80); + TEST_ASSERT(lsp_cell_get_string_data(c, 0) == 0xff); + + lsp_cell_set_string(c, 2); + TEST_ASSERT(lsp_cell_is_string(c)); + TEST_ASSERT(lsp_cell_is_string_or_symbol(c)); + TEST_ASSERT(!lsp_cell_is_symbol(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 3); + TEST_ASSERT(lsp_cell_get_string_len(c) == 2); + lsp_cell_set_string_data(c, 0, 0x00); + lsp_cell_set_string_data(c, 1, 0xff); + TEST_ASSERT(c[1] == 0x7f); + TEST_ASSERT(c[2] == 0x4000); + TEST_ASSERT(lsp_cell_get_string_data(c, 0) == 0x00); + TEST_ASSERT(lsp_cell_get_string_data(c, 1) == 0xff); +} + + +void test_cell_symbol() { + lsp_cell_t c[4]; + + lsp_cell_set_symbol(c, 0); + TEST_ASSERT(lsp_cell_is_symbol(c)); + TEST_ASSERT(lsp_cell_is_string_or_symbol(c)); + TEST_ASSERT(!lsp_cell_is_string(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(lsp_cell_get_symbol_len(c) == 0); + + lsp_cell_set_symbol(c, 1); + TEST_ASSERT(lsp_cell_is_symbol(c)); + TEST_ASSERT(lsp_cell_is_string_or_symbol(c)); + TEST_ASSERT(!lsp_cell_is_string(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 2); + TEST_ASSERT(lsp_cell_get_symbol_len(c) == 1); + lsp_cell_set_symbol_name(c, 0, 0xff); + TEST_ASSERT(c[1] == 0x7f80); + TEST_ASSERT(lsp_cell_get_symbol_name(c, 0) == 0xff); + + lsp_cell_set_symbol(c, 2); + TEST_ASSERT(lsp_cell_is_symbol(c)); + TEST_ASSERT(lsp_cell_is_string_or_symbol(c)); + TEST_ASSERT(!lsp_cell_is_string(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 3); + TEST_ASSERT(lsp_cell_get_symbol_len(c) == 2); + lsp_cell_set_symbol_name(c, 0, 0x00); + lsp_cell_set_symbol_name(c, 1, 0xff); + TEST_ASSERT(c[1] == 0x7f); + TEST_ASSERT(c[2] == 0x4000); + TEST_ASSERT(lsp_cell_get_symbol_name(c, 0) == 0x00); + TEST_ASSERT(lsp_cell_get_symbol_name(c, 1) == 0xff); +} + + +void test_cell_builtin_function() { + lsp_cell_t c[1]; + + lsp_cell_set_builtin_function(c, 0); + TEST_ASSERT(lsp_cell_is_builtin_function(c)); + TEST_ASSERT(lsp_cell_is_builtin(c)); + TEST_ASSERT(!lsp_cell_is_builtin_syntax(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(lsp_cell_get_builtin_index(c) == 0); + + lsp_cell_set_builtin_function(c, 123); + TEST_ASSERT(lsp_cell_is_builtin_function(c)); + TEST_ASSERT(lsp_cell_is_builtin(c)); + TEST_ASSERT(!lsp_cell_is_builtin_syntax(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(lsp_cell_get_builtin_index(c) == 123); +} + + +void test_cell_builtin_syntax() { + lsp_cell_t c[1]; + + lsp_cell_set_builtin_syntax(c, 0); + TEST_ASSERT(lsp_cell_is_builtin_syntax(c)); + TEST_ASSERT(lsp_cell_is_builtin(c)); + TEST_ASSERT(!lsp_cell_is_builtin_function(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(lsp_cell_get_builtin_index(c) == 0); + + lsp_cell_set_builtin_syntax(c, 123); + TEST_ASSERT(lsp_cell_is_builtin_syntax(c)); + TEST_ASSERT(lsp_cell_is_builtin(c)); + TEST_ASSERT(!lsp_cell_is_builtin_function(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 1); + TEST_ASSERT(lsp_cell_get_builtin_index(c) == 123); +} + + +void test_cell_function() { + lsp_cell_t c[4]; + + lsp_cell_set_function(c, 1, 2, 3); + TEST_ASSERT(lsp_cell_is_function(c)); + TEST_ASSERT(lsp_cell_is_function_or_syntax(c)); + TEST_ASSERT(!lsp_cell_is_syntax(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 4); + TEST_ASSERT(lsp_cell_get_function_parent_ctx(c) == 1); + TEST_ASSERT(lsp_cell_get_function_args(c) == 2); + TEST_ASSERT(lsp_cell_get_function_body(c) == 3); +} + + +void test_cell_syntax() { + lsp_cell_t c[4]; + + lsp_cell_set_syntax(c, 1, 2, 3); + TEST_ASSERT(lsp_cell_is_syntax(c)); + TEST_ASSERT(lsp_cell_is_function_or_syntax(c)); + TEST_ASSERT(!lsp_cell_is_function(c)); + TEST_ASSERT(lsp_cell_get_size(c) == 4); + TEST_ASSERT(lsp_cell_get_syntax_parent_ctx(c) == 1); + TEST_ASSERT(lsp_cell_get_syntax_args(c) == 2); + TEST_ASSERT(lsp_cell_get_syntax_body(c) == 3); +} + + +TEST_LIST = {{"cell_number", test_cell_number}, + {"cell_pair", test_cell_pair}, + {"cell_string", test_cell_string}, + {"cell_symbol", test_cell_symbol}, + {"cell_builtin_function", test_cell_builtin_function}, + {"cell_builtin_syntax", test_cell_builtin_syntax}, + {"cell_function", test_cell_function}, + {"cell_syntax", test_cell_syntax}, + {NULL, NULL}}; diff --git a/test_c/mem.c b/test_c/mem.c new file mode 100644 index 0000000..930bfde --- /dev/null +++ b/test_c/mem.c @@ -0,0 +1,38 @@ +#include "acutest.h" +#include "../src_c/mem.h" + +#define MEM_SIZE 32 + + +lsp_int8_t data[sizeof(lsp_mem_t) + MEM_SIZE * sizeof(lsp_cell_t)]; + + +void test_mem_gc() { + lsp_mem_t *m = (void *)data; + lsp_mem_init(m, MEM_SIZE); + + for (lsp_int32_t i = 0; i < 10000; ++i) { + lsp_addr_t addr; + TEST_ASSERT(lsp_mem_create_number(m, i, &addr) == LSP_SUCCESS); + lsp_mem_dec_ref(m, addr); + } +} + + +void test_mem_no_gc() { + lsp_int32_t i; + lsp_mem_t *m = (void *)data; + lsp_mem_init(m, MEM_SIZE); + + for (i = 0; i < 10000; ++i) { + lsp_addr_t addr; + if (lsp_mem_create_number(m, i, &addr) != LSP_SUCCESS) + break; + } + + TEST_ASSERT(i > 1 && i < MEM_SIZE); +} + + +TEST_LIST = { + {"mem_gc", test_mem_gc}, {"mem_no_gc", test_mem_no_gc}, {NULL, NULL}}; |