├── .gitignore ├── LICENSE ├── README.md ├── examples ├── script │ ├── README │ ├── index.html │ ├── index.js │ └── package.json ├── todomvc │ ├── README │ ├── index.f │ ├── index.html │ ├── index.js │ ├── package.json │ └── vendor │ │ └── index.css └── webpack │ ├── README │ ├── index.html │ ├── index.js │ ├── package.json │ └── webpack.config.js ├── kernel ├── __init__.py ├── __main__.py ├── asm_ops.py ├── assembler.py ├── binaryen_module.py ├── build_binaryen_ext.py ├── code_words.py ├── forth │ ├── core.f │ └── vdom.f ├── forth_interpreter.py ├── memory_layout.py └── vendor │ └── binaryen-c.h ├── package.json ├── repl ├── index.html ├── repl.css └── repl.js ├── setup.py ├── src └── index.js └── webpack.config.js /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | node_modules 3 | /wasm_forth.egg-info 4 | /_binaryen_c.abi3.so 5 | /.eggs 6 | /.vscode 7 | /build 8 | /env 9 | __pycache__ 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | WASM Forth 2 | ========== 3 | 4 | A Forth implementation compiling to WebAssembly. 5 | 6 | It includes an ANS Forth standard environment containing all the CORE words. 7 | The system has a fixed amount of memory available, currently 128 MB. 8 | 9 | Interaction with Javascript at the moment is limited to textual input (using `WasmForth.source`) 10 | and output (through the `write` configuration parameter passed to `WasmForth.boot`). 11 | 12 | Using the included (optional) virtual DOM library it's possible to 13 | write interactive web apps. See the code in `examples/todomvc/` for an 14 | example TODO list web app fully implemented in Forth. 15 | 16 | Installation 17 | ============ 18 | 19 | $ npm install wasm-forth 20 | 21 | Usage 22 | ===== 23 | 24 | The following code instantiates the interpreter and runs a program that prints "Hello, World!" to the console: 25 | 26 | import * as WasmForth from 'wasm-forth'; 27 | import wasmURL from 'wasm-forth/dist/kernel.wasm'; 28 | import coreURL from 'wasm-forth/dist/core.f'; 29 | import vdomURL from 'wasm-forth/dist/vdom.f'; 30 | 31 | WasmForth.boot({ 32 | wasmURL, 33 | sources: [coreURL, vdomURL], 34 | write: (text) => { 35 | console.log(text); 36 | } 37 | }).then(() => { 38 | WasmForth.source(': HELLO S" Hello, World!" TYPE ; HELLO\n'); 39 | }); 40 | 41 | `WasmForth.boot({ ... })` initializes the system and returns a Promise. Once resolved, it's possible to 42 | interpret forth code by passing it to `WasmForth.source(string)`. Note that the string passed must end with a newline. 43 | 44 | `WasmForth.boot` accepts a configuration object with 3 required parameters: 45 | 46 | - `wasmURL`: URL where to fetch the "kernel.wasm" included in the NPM package. 47 | - `sources`: a list of URLs where to fetch the forth "core.f" included in the NPM package. 48 | - `write`: a function that will be called when the forth code needs to output text. 49 | 50 | If you're using webpack, you can use the file-loader (https://github.com/webpack-contrib/file-loader) 51 | plugin to distribute `kernel.wasm`, `core.f` and `vdom.f`. 52 | 53 | You can also use this library without a module bundler by loading it in a 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /examples/script/index.js: -------------------------------------------------------------------------------- 1 | WasmForth.boot({ 2 | wasmURL: 'node_modules/wasm-forth/dist/kernel.wasm', 3 | sources: ['node_modules/wasm-forth/dist/core.f', 'node_modules/wasm-forth/dist/vdom.f'], 4 | write: (text) => { 5 | document.getElementById('content').textContent += text; 6 | } 7 | }).then(() => { 8 | WasmForth.source(': HELLO S" Hello, World!" TYPE ; HELLO\n'); 9 | }); 10 | -------------------------------------------------------------------------------- /examples/script/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "example", 3 | "version": "1.0.0", 4 | "description": "", 5 | "main": "index.js", 6 | "author": "", 7 | "license": "GPL-3.0", 8 | "dependencies": { 9 | "wasm-forth": "^2.0.0" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /examples/todomvc/README: -------------------------------------------------------------------------------- 1 | To run this example: 2 | 3 | $ npm install 4 | $ python3 -m http.server 8080 5 | 6 | then open the browser at http://localhost:8080 7 | -------------------------------------------------------------------------------- /examples/todomvc/index.f: -------------------------------------------------------------------------------- 1 | 1 QUIET ! 2 | 3 | VARIABLE first-render TRUE first-render ! 4 | 5 | ( each todo has: 4 byte length [excluding flags], 1 byte completed flag, 1 byte editing flag, 1 byte show remove button 1 byte focus editing, string content ) 6 | 1 MB buffer todos 7 | 8 | 1025 buffer todo-temp 0 todo-temp ! 9 | 1025 buffer item-temp 0 item-temp ! 10 | 11 | : completed ( addr -- flag ) CELL+ C@ ; 12 | : set-completed ( flag addr -- ) CELL+ C! ; 13 | 14 | : editing ( addr -- flag ) CELL+ 1+ C@ ; 15 | : set-editing ( flag addr -- ) CELL+ 1+ C! ; 16 | 17 | : show-remove ( addr -- flag ) CELL+ 2 + C@ ; 18 | : set-show-remove ( flag addr -- ) CELL+ 2 + C! ; 19 | 20 | : focus ( addr -- flag ) CELL+ 3 + C@ ; 21 | : set-focus ( flag addr -- ) CELL+ 3 + C! ; 22 | 23 | : text-addr ( addr -- addr1 ) 2 CELLS + ; 24 | : todo-text ( addr -- addr1 u ) text-addr & @ ; 25 | : todo-text-len @ ; 26 | 27 | : bytes-to-end ( addr -- n ) todos buf-next @ SWAP - ; 28 | : eof-todo ( addr -- addr1 ) todo-text + ; 29 | : no-space-to-replace? ( u addr -- flag ) 30 | DUP eof-todo bytes-to-end + + 2 CELLS + todos buf-end > ; 31 | : set-todo-text ( c-addr u addr -- ) 32 | 2DUP no-space-to-replace? IF abort-task" no space left to set todo text" THEN 33 | 2DUP + 2 CELLS + >R 34 | DUP eof-todo DUP bytes-to-end R> 2DUP + >R SWAP MOVE ( make space ) 35 | R> todos buf-next ! 36 | 2DUP ! ( set text length ) 37 | 2 CELLS + SWAP MOVE ; ( copy text ) 38 | : add-empty-todo ( -- addr ) todos buf-next @ 0 todos ,buf 0 todos ,buf ; 39 | : remove-todo ( addr -- ) 40 | DUP eof-todo SWAP OVER bytes-to-end 2DUP + >R MOVE 41 | R> todos buf-next ! ; 42 | : next-todo-offset ( addr1 -- u ) @ 2 CELLS + ; 43 | : next-todo ( addr -- addr1 ) DUP next-todo-offset + ; 44 | : remove-completed ( -- ) 45 | todos BEGIN DUP todos buf-next @ < WHILE DUP completed IF DUP remove-todo ELSE next-todo THEN REPEAT DROP ; 46 | : each-todo ( xt -- ) 47 | todos buf-next @ todos = IF DROP EXIT THEN 48 | todos buf-next @ todos DO I SWAP DUP >R EXECUTE R> I next-todo-offset +LOOP DROP ; 49 | : inc-count ( n addr -- n2 ) DROP 1+ ; 50 | : count-todos ( -- u ) 51 | 0 ['] inc-count each-todo ; 52 | : inc-completed ( n addr -- n2 ) completed IF 1+ THEN ; 53 | : count-completed ( -- u ) 0 ['] inc-completed each-todo ; 54 | : inc-not-completed ( n addr -- n2 ) completed 0= IF 1+ THEN ; 55 | : count-left ( -- u ) 0 ['] inc-not-completed each-todo ; 56 | 57 | : .todo ( addr -- ) todo-text TYPE ; 58 | : .todos ( -- ) ['] .todo each-todo ; 59 | 60 | : is-checked ( flag1 addr -- flag2 ) completed AND ; 61 | : toggle-all-state ( -- flag ) 62 | TRUE ['] is-checked each-todo ; 63 | 64 | : checked ( -- flag ) S" target.checked" 0 0 EVT-ATTR ; 65 | : key-code ( -- x ) S" keyCode" 0 0 EVT-ATTR ; 66 | 67 | : clear-completed ( -- ) remove-completed repaint ; 68 | 69 | : temp-str ( addr -- c-addr u ) CELL+ & @ ; 70 | 71 | : save-todo-temp ( -- ) S" target.value" todo-temp CELL+ 1024 EVT-ATTR todo-temp ! ; 72 | : reset-todo-temp ( -- ) 0 todo-temp ! ; 73 | : todo-tmp-str ( -- c-addr u ) todo-temp temp-str ; 74 | 75 | : set-item-temp ( addr -- ) todo-text TUCK item-temp CELL+ SWAP CMOVE item-temp ! ; 76 | : item-tmp-str ( -- c-addr u ) item-temp temp-str ; 77 | 78 | : on-todo-input ( -- ) save-todo-temp ; 79 | : on-todo-action ( -- ) 80 | key-code 13 = IF todo-tmp-str trim DUP 0= IF 2DROP EXIT THEN add-empty-todo set-todo-text reset-todo-temp THEN repaint ; 81 | : set-completed' ( flag addr -- flag ) OVER /top set-completed ; 82 | : on-toggle-all ( -- ) 83 | checked ['] set-completed' each-todo DROP 84 | repaint ; 85 | : on-item-checked ( data -- ) checked SWAP set-completed repaint ; 86 | : on-todo-item-enter ( addr -- ) TRUE SWAP set-show-remove repaint ; 87 | : on-todo-item-leave ( addr -- ) 0 SWAP set-show-remove repaint ; 88 | : on-item-start-editing ( addr -- ) 89 | DUP set-item-temp 90 | TRUE OVER set-editing 91 | TRUE OVER set-focus 92 | repaint 93 | 0 SWAP set-focus 94 | repaint ; 95 | : on-remove-todo ( addr -- ) remove-todo repaint ; 96 | : trim-item ( addr -- ) 97 | DUP todo-text trim ROT set-todo-text ; 98 | : on-item-blur ( addr -- ) 99 | DUP trim-item DUP todo-text-len 0= IF remove-todo ELSE 0 SWAP set-editing THEN repaint ; 100 | 101 | : on-item-input ( addr -- ) 102 | HERE S" target.value" HERE 1024 EVT-ATTR ROT set-todo-text repaint ; 103 | : on-item-action ( addr -- ) 104 | key-code 13 = IF on-item-blur EXIT THEN 105 | key-code 27 = IF item-tmp-str ROT set-todo-text repaint EXIT THEN ( reset from temp ) 106 | DROP ; 107 | 108 | : todo-header ( -- ) 109 |
S" header" =class 110 |

S" todos" text

111 | 112 | S" new-todo" =class 113 | S" What needs to be done?" =placeholder 114 | first-render @ IF empty-attr =focus THEN 115 | ['] on-todo-input =oninput 116 | ['] on-todo-action =onkeydown 117 | todo-tmp-str to-rbuf =input-value 118 | 119 |
; 120 | 121 | : todo-item ( addr -- ) 122 | >R 123 |
  • 124 | R@ bind on-todo-item-enter =onmouseenter 125 | R@ bind on-todo-item-leave =onmouseleave 126 | R@ editing IF R@ completed IF S" completed editing" ELSE S" editing" THEN 127 | ELSE R@ completed IF S" completed" ELSE S" " THEN 128 | THEN =class 129 |
    S" view" =class 130 | 131 | S" toggle" =class 132 | S" checkbox" =type 133 | R@ completed IF empty-attr =checked THEN 134 | R@ bind on-item-checked =onchange 135 | 136 | 139 | R@ show-remove IF THEN 140 |
    141 | 142 | S" edit" =class 143 | R@ todo-text to-rbuf =input-value 144 | R@ focus IF empty-attr =focus THEN 145 | R@ bind on-item-blur =onblur 146 | R@ bind on-item-start-editing =onfocus 147 | R@ bind on-item-input =oninput 148 | R@ bind on-item-action =onkeydown 149 | 150 |
    • 151 | R> DROP ; 152 | 153 | : render-todos ( -- ) 154 | count-todos 0= IF EXIT THEN 155 |
    S" main" =class 156 | 157 | S" toggle-all" =id 158 | S" toggle-all" =class 159 | S" checkbox" =type 160 | toggle-all-state IF S" checked" =checked THEN 161 | ['] on-toggle-all =onchange 162 | 163 | 164 |
      S" todo-list" =class 165 | ['] todo-item each-todo 166 |
    167 |
    ; 168 | 169 | : items-left ( n-left -- ) 170 | >R 171 | 172 | R@ fmt-int text S" " text 173 | R> 1 = IF S" item left" ELSE S" items left" THEN text 174 | ; 175 | : clear-completed-btn ( -- ) 176 | ; 179 | : todo-footer ( n-completed n-left -- ) 180 | count-todos 0= IF 2DROP EXIT THEN 181 | 2>R 182 |
    S" footer" =class 183 | R> items-left 184 | R> 0 > IF clear-completed-btn THEN 185 |
    ; 186 | 187 | : todo-app ( -- ) 188 |
    S" todoapp" =class 189 | todo-header 190 | render-todos 191 | count-completed count-left todo-footer 192 |
    ; 193 | 194 | : footer-info ( -- ) 195 | ; 199 | 200 | : app
    todo-app footer-info
    0 first-render ! ; 201 | 202 | repaint-with app 203 | repaint 204 | 205 | 0 QUIET ! 206 | -------------------------------------------------------------------------------- /examples/todomvc/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | TodoMVC 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /examples/todomvc/index.js: -------------------------------------------------------------------------------- 1 | WasmForth.boot({ 2 | wasmURL: 'node_modules/wasm-forth/dist/kernel.wasm', 3 | sources: ['node_modules/wasm-forth/dist/core.f', 'node_modules/wasm-forth/dist/vdom.f', 'index.f'], 4 | write: msg => console.log(msg) 5 | }); 6 | -------------------------------------------------------------------------------- /examples/todomvc/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "example", 3 | "version": "1.0.0", 4 | "description": "", 5 | "main": "index.js", 6 | "author": "", 7 | "license": "GPL-3.0", 8 | "dependencies": { 9 | "wasm-forth": "^2.0.0" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /examples/todomvc/vendor/index.css: -------------------------------------------------------------------------------- 1 | /* 2 | * Copied from https://github.com/tastejs/todomvc/ 3 | */ 4 | 5 | html, 6 | body { 7 | margin: 0; 8 | padding: 0; 9 | } 10 | 11 | button { 12 | margin: 0; 13 | padding: 0; 14 | border: 0; 15 | background: none; 16 | font-size: 100%; 17 | vertical-align: baseline; 18 | font-family: inherit; 19 | font-weight: inherit; 20 | color: inherit; 21 | -webkit-appearance: none; 22 | appearance: none; 23 | -webkit-font-smoothing: antialiased; 24 | -moz-osx-font-smoothing: grayscale; 25 | } 26 | 27 | body { 28 | font: 14px 'Helvetica Neue', Helvetica, Arial, sans-serif; 29 | line-height: 1.4em; 30 | background: #f5f5f5; 31 | color: #4d4d4d; 32 | min-width: 230px; 33 | max-width: 550px; 34 | margin: 0 auto; 35 | -webkit-font-smoothing: antialiased; 36 | -moz-osx-font-smoothing: grayscale; 37 | font-weight: 300; 38 | } 39 | 40 | :focus { 41 | outline: 0; 42 | } 43 | 44 | .hidden { 45 | display: none; 46 | } 47 | 48 | .todoapp { 49 | background: #fff; 50 | margin: 130px 0 40px 0; 51 | position: relative; 52 | box-shadow: 0 2px 4px 0 rgba(0, 0, 0, 0.2), 53 | 0 25px 50px 0 rgba(0, 0, 0, 0.1); 54 | } 55 | 56 | .todoapp input::-webkit-input-placeholder { 57 | font-style: italic; 58 | font-weight: 300; 59 | color: #e6e6e6; 60 | } 61 | 62 | .todoapp input::-moz-placeholder { 63 | font-style: italic; 64 | font-weight: 300; 65 | color: #e6e6e6; 66 | } 67 | 68 | .todoapp input::input-placeholder { 69 | font-style: italic; 70 | font-weight: 300; 71 | color: #e6e6e6; 72 | } 73 | 74 | .todoapp h1 { 75 | position: absolute; 76 | top: -155px; 77 | width: 100%; 78 | font-size: 100px; 79 | font-weight: 100; 80 | text-align: center; 81 | color: rgba(175, 47, 47, 0.15); 82 | -webkit-text-rendering: optimizeLegibility; 83 | -moz-text-rendering: optimizeLegibility; 84 | text-rendering: optimizeLegibility; 85 | } 86 | 87 | .new-todo, 88 | .edit { 89 | position: relative; 90 | margin: 0; 91 | width: 100%; 92 | font-size: 24px; 93 | font-family: inherit; 94 | font-weight: inherit; 95 | line-height: 1.4em; 96 | border: 0; 97 | color: inherit; 98 | padding: 6px; 99 | border: 1px solid #999; 100 | box-shadow: inset 0 -1px 5px 0 rgba(0, 0, 0, 0.2); 101 | box-sizing: border-box; 102 | -webkit-font-smoothing: antialiased; 103 | -moz-osx-font-smoothing: grayscale; 104 | } 105 | 106 | .new-todo { 107 | padding: 16px 16px 16px 60px; 108 | border: none; 109 | background: rgba(0, 0, 0, 0.003); 110 | box-shadow: inset 0 -2px 1px rgba(0,0,0,0.03); 111 | } 112 | 113 | .main { 114 | position: relative; 115 | z-index: 2; 116 | border-top: 1px solid #e6e6e6; 117 | } 118 | 119 | .toggle-all { 120 | width: 1px; 121 | height: 1px; 122 | border: none; /* Mobile Safari */ 123 | opacity: 0; 124 | position: absolute; 125 | right: 100%; 126 | bottom: 100%; 127 | } 128 | 129 | .toggle-all + label { 130 | width: 60px; 131 | height: 34px; 132 | font-size: 0; 133 | position: absolute; 134 | top: -52px; 135 | left: -13px; 136 | -webkit-transform: rotate(90deg); 137 | transform: rotate(90deg); 138 | } 139 | 140 | .toggle-all + label:before { 141 | content: '❯'; 142 | font-size: 22px; 143 | color: #e6e6e6; 144 | padding: 10px 27px 10px 27px; 145 | } 146 | 147 | .toggle-all:checked + label:before { 148 | color: #737373; 149 | } 150 | 151 | .todo-list { 152 | margin: 0; 153 | padding: 0; 154 | list-style: none; 155 | } 156 | 157 | .todo-list li { 158 | position: relative; 159 | font-size: 24px; 160 | border-bottom: 1px solid #ededed; 161 | } 162 | 163 | .todo-list li:last-child { 164 | border-bottom: none; 165 | } 166 | 167 | .todo-list li.editing { 168 | border-bottom: none; 169 | padding: 0; 170 | } 171 | 172 | .todo-list li.editing .edit { 173 | display: block; 174 | width: calc(100% - 43px); 175 | padding: 12px 16px; 176 | margin: 0 0 0 43px; 177 | } 178 | 179 | .todo-list li.editing .view { 180 | display: none; 181 | } 182 | 183 | .todo-list li .toggle { 184 | text-align: center; 185 | width: 40px; 186 | /* auto, since non-WebKit browsers doesn't support input styling */ 187 | height: auto; 188 | position: absolute; 189 | top: 0; 190 | bottom: 0; 191 | margin: auto 0; 192 | border: none; /* Mobile Safari */ 193 | -webkit-appearance: none; 194 | appearance: none; 195 | } 196 | 197 | .todo-list li .toggle { 198 | opacity: 0; 199 | } 200 | 201 | .todo-list li .toggle + label { 202 | /* 203 | Firefox requires `#` to be escaped - https://bugzilla.mozilla.org/show_bug.cgi?id=922433 204 | IE and Edge requires *everything* to be escaped to render, so we do that instead of just the `#` - https://developer.microsoft.com/en-us/microsoft-edge/platform/issues/7157459/ 205 | */ 206 | background-image: url('data:image/svg+xml;utf8,%3Csvg%20xmlns%3D%22http%3A//www.w3.org/2000/svg%22%20width%3D%2240%22%20height%3D%2240%22%20viewBox%3D%22-10%20-18%20100%20135%22%3E%3Ccircle%20cx%3D%2250%22%20cy%3D%2250%22%20r%3D%2250%22%20fill%3D%22none%22%20stroke%3D%22%23ededed%22%20stroke-width%3D%223%22/%3E%3C/svg%3E'); 207 | background-repeat: no-repeat; 208 | background-position: center left; 209 | } 210 | 211 | .todo-list li .toggle:checked + label { 212 | background-image: url('data:image/svg+xml;utf8,%3Csvg%20xmlns%3D%22http%3A//www.w3.org/2000/svg%22%20width%3D%2240%22%20height%3D%2240%22%20viewBox%3D%22-10%20-18%20100%20135%22%3E%3Ccircle%20cx%3D%2250%22%20cy%3D%2250%22%20r%3D%2250%22%20fill%3D%22none%22%20stroke%3D%22%23bddad5%22%20stroke-width%3D%223%22/%3E%3Cpath%20fill%3D%22%235dc2af%22%20d%3D%22M72%2025L42%2071%2027%2056l-4%204%2020%2020%2034-52z%22/%3E%3C/svg%3E'); 213 | } 214 | 215 | .todo-list li label { 216 | word-break: break-all; 217 | padding: 15px 15px 15px 60px; 218 | display: block; 219 | line-height: 1.2; 220 | transition: color 0.4s; 221 | } 222 | 223 | .todo-list li.completed label { 224 | color: #d9d9d9; 225 | text-decoration: line-through; 226 | } 227 | 228 | .todo-list li .destroy { 229 | display: none; 230 | position: absolute; 231 | top: 0; 232 | right: 10px; 233 | bottom: 0; 234 | width: 40px; 235 | height: 40px; 236 | margin: auto 0; 237 | font-size: 30px; 238 | color: #cc9a9a; 239 | margin-bottom: 11px; 240 | transition: color 0.2s ease-out; 241 | } 242 | 243 | .todo-list li .destroy:hover { 244 | color: #af5b5e; 245 | } 246 | 247 | .todo-list li .destroy:after { 248 | content: '×'; 249 | } 250 | 251 | .todo-list li:hover .destroy { 252 | display: block; 253 | } 254 | 255 | .todo-list li .edit { 256 | display: none; 257 | } 258 | 259 | .todo-list li.editing:last-child { 260 | margin-bottom: -1px; 261 | } 262 | 263 | .footer { 264 | color: #777; 265 | padding: 10px 15px; 266 | height: 20px; 267 | text-align: center; 268 | border-top: 1px solid #e6e6e6; 269 | } 270 | 271 | .footer:before { 272 | content: ''; 273 | position: absolute; 274 | right: 0; 275 | bottom: 0; 276 | left: 0; 277 | height: 50px; 278 | overflow: hidden; 279 | box-shadow: 0 1px 1px rgba(0, 0, 0, 0.2), 280 | 0 8px 0 -3px #f6f6f6, 281 | 0 9px 1px -3px rgba(0, 0, 0, 0.2), 282 | 0 16px 0 -6px #f6f6f6, 283 | 0 17px 2px -6px rgba(0, 0, 0, 0.2); 284 | } 285 | 286 | .todo-count { 287 | float: left; 288 | text-align: left; 289 | } 290 | 291 | .todo-count strong { 292 | font-weight: 300; 293 | } 294 | 295 | .filters { 296 | margin: 0; 297 | padding: 0; 298 | list-style: none; 299 | position: absolute; 300 | right: 0; 301 | left: 0; 302 | } 303 | 304 | .filters li { 305 | display: inline; 306 | } 307 | 308 | .filters li a { 309 | color: inherit; 310 | margin: 3px; 311 | padding: 3px 7px; 312 | text-decoration: none; 313 | border: 1px solid transparent; 314 | border-radius: 3px; 315 | } 316 | 317 | .filters li a:hover { 318 | border-color: rgba(175, 47, 47, 0.1); 319 | } 320 | 321 | .filters li a.selected { 322 | border-color: rgba(175, 47, 47, 0.2); 323 | } 324 | 325 | .clear-completed, 326 | html .clear-completed:active { 327 | float: right; 328 | position: relative; 329 | line-height: 20px; 330 | text-decoration: none; 331 | cursor: pointer; 332 | } 333 | 334 | .clear-completed:hover { 335 | text-decoration: underline; 336 | } 337 | 338 | .info { 339 | margin: 65px auto 0; 340 | color: #bfbfbf; 341 | font-size: 10px; 342 | text-shadow: 0 1px 0 rgba(255, 255, 255, 0.5); 343 | text-align: center; 344 | } 345 | 346 | .info p { 347 | line-height: 1; 348 | } 349 | 350 | .info a { 351 | color: inherit; 352 | text-decoration: none; 353 | font-weight: 400; 354 | } 355 | 356 | .info a:hover { 357 | text-decoration: underline; 358 | } 359 | 360 | /* 361 | Hack to remove background from Mobile Safari. 362 | Can't use it globally since it destroys checkboxes in Firefox 363 | */ 364 | @media screen and (-webkit-min-device-pixel-ratio:0) { 365 | .toggle-all, 366 | .todo-list li .toggle { 367 | background: none; 368 | } 369 | 370 | .todo-list li .toggle { 371 | height: 40px; 372 | } 373 | } 374 | 375 | @media (max-width: 430px) { 376 | .footer { 377 | height: 50px; 378 | } 379 | 380 | .filters { 381 | bottom: 10px; 382 | } 383 | } 384 | -------------------------------------------------------------------------------- /examples/webpack/README: -------------------------------------------------------------------------------- 1 | To run this example: 2 | 3 | $ npm install 4 | $ npm run build 5 | $ python3 -m http.server 8080 6 | 7 | then open the browser at http://localhost:8080 8 | -------------------------------------------------------------------------------- /examples/webpack/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Example 6 | 7 | 8 |
    9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /examples/webpack/index.js: -------------------------------------------------------------------------------- 1 | import * as WasmForth from 'wasm-forth'; 2 | import wasmURL from 'wasm-forth/dist/kernel.wasm'; 3 | import coreURL from 'wasm-forth/dist/core.f'; 4 | import vdomURL from 'wasm-forth/dist/vdom.f'; 5 | 6 | WasmForth.boot({ 7 | wasmURL, 8 | sources: [coreURL, vdomURL], 9 | write: (text) => { 10 | document.getElementById('content').textContent += text; 11 | } 12 | }).then(() => { 13 | WasmForth.source(': HELLO S" Hello, World!" TYPE ; HELLO\n'); 14 | }); 15 | -------------------------------------------------------------------------------- /examples/webpack/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "example", 3 | "version": "1.0.0", 4 | "description": "", 5 | "main": "index.js", 6 | "author": "", 7 | "license": "GPL-3.0", 8 | "scripts": { 9 | "build": "webpack" 10 | }, 11 | "dependencies": { 12 | "wasm-forth": "^2.0.0" 13 | }, 14 | "devDependencies": { 15 | "file-loader": "^1.1.6", 16 | "webpack": "^3.10.0" 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /examples/webpack/webpack.config.js: -------------------------------------------------------------------------------- 1 | let path = require('path'); 2 | 3 | module.exports = { 4 | entry: { 5 | main: './index.js' 6 | }, 7 | output: { 8 | path: path.resolve(__dirname, 'dist'), 9 | filename: 'index.js', 10 | publicPath: 'dist/' 11 | }, 12 | module: { 13 | rules: [ 14 | { 15 | test : /\.(f|wasm)$/, 16 | loader : 'file-loader' 17 | } 18 | ] 19 | } 20 | }; 21 | -------------------------------------------------------------------------------- /kernel/__init__.py: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stefano/wasm-forth/a83428b2e4a95c59bcd447be616e243a2d7e0b10/kernel/__init__.py -------------------------------------------------------------------------------- /kernel/__main__.py: -------------------------------------------------------------------------------- 1 | import shutil 2 | import sys 3 | import os 4 | 5 | import assembler 6 | 7 | 8 | BASE_PATH = os.path.abspath(os.path.dirname(__file__)) 9 | DIST_PATH = os.path.join(BASE_PATH, '../dist') 10 | 11 | if not os.path.exists(DIST_PATH): 12 | os.makedirs(DIST_PATH) 13 | 14 | assembler.build_kernel(os.path.join(DIST_PATH, 'kernel.wasm')) 15 | for file_name in ('core.f', 'vdom.f'): 16 | shutil.copy( 17 | os.path.join(BASE_PATH, os.path.join('forth', file_name)), 18 | os.path.join(DIST_PATH, file_name), 19 | ) 20 | 21 | if len(sys.argv) > 1 and sys.argv[1] == '--demo-repl': 22 | import http.server 23 | import socketserver 24 | 25 | REPL_DIST_PATH = os.path.join(BASE_PATH, '../repl/dist/') 26 | 27 | if not os.path.exists(REPL_DIST_PATH): 28 | os.makedirs(REPL_DIST_PATH) 29 | 30 | for file_name in ('core.f', 'vdom.f'): 31 | shutil.copy( 32 | os.path.join(BASE_PATH, 'forth', file_name), 33 | os.path.join(REPL_DIST_PATH, file_name), 34 | ) 35 | shutil.copy( 36 | os.path.join(DIST_PATH, 'kernel.wasm'), 37 | os.path.join(REPL_DIST_PATH, 'kernel.wasm'), 38 | ) 39 | 40 | os.chdir(os.path.join(BASE_PATH, '..', 'repl')) 41 | 42 | socketserver.TCPServer.allow_reuse_address = True 43 | with socketserver.TCPServer(('', 8080), http.server.SimpleHTTPRequestHandler) as httpd: 44 | print('Open your browser at http://localhost:8080/') 45 | httpd.serve_forever() 46 | -------------------------------------------------------------------------------- /kernel/asm_ops.py: -------------------------------------------------------------------------------- 1 | """ 2 | Utilities to make it easier to write webassembly opcodes. 3 | """ 4 | 5 | from _binaryen_c import ffi, lib 6 | 7 | from binaryen_module import module, retain_gc 8 | from memory_layout import * 9 | 10 | 11 | # Control flow 12 | 13 | 14 | def block(*instrs, label=None): 15 | if label is None: 16 | label = ffi.NULL 17 | else: 18 | label = label.encode('ascii') 19 | 20 | instrs_array = ffi.new('BinaryenExpressionRef[]', _flatten(instrs)) 21 | 22 | return lib.BinaryenBlock( 23 | module, 24 | label, 25 | instrs_array, 26 | len(instrs_array), 27 | lib.BinaryenNone(), 28 | ) 29 | 30 | retain_gc.append(instrs_array) 31 | 32 | 33 | def _flatten(lst, res=None): 34 | if res is None: 35 | res = [] 36 | 37 | for item in lst: 38 | if isinstance(item, (list, tuple)): 39 | _flatten(item, res) 40 | else: 41 | res.append(item) 42 | 43 | return res 44 | 45 | 46 | def loop(label, expr): 47 | return lib.BinaryenLoop( 48 | module, 49 | label.encode('ascii'), 50 | expr, 51 | ) 52 | 53 | 54 | def switch(labels, default_label, cond_expr): 55 | labels_array_elems = [ffi.new('char[]', label.encode('ascii')) for label in labels] 56 | labels_array = ffi.new('char*[]', labels_array_elems) 57 | 58 | retain_gc(labels_array_elems, labels_array) 59 | 60 | return lib.BinaryenSwitch(module, labels_array, len(labels_array), default_label.encode('ascii'), cond_expr, ffi.NULL) 61 | 62 | 63 | def jmp(label, cond_expr=ffi.NULL): 64 | return lib.BinaryenBreak(module, label.encode('ascii'), cond_expr, ffi.NULL) 65 | 66 | 67 | # Function calls 68 | 69 | 70 | def call_iiin(label, expr1, expr2, expr3): 71 | params = ffi.new('BinaryenExpressionRef[3]', [expr1, expr2, expr3]) 72 | 73 | retain_gc(params) 74 | 75 | return lib.BinaryenCall(module, label.encode('ascii'), params, 3, lib.BinaryenNone()) 76 | 77 | 78 | def call_iin(label, expr1, expr2): 79 | params = ffi.new('BinaryenExpressionRef[2]', [expr1, expr2]) 80 | 81 | retain_gc(params) 82 | 83 | return lib.BinaryenCall(module, label.encode('ascii'), params, 2, lib.BinaryenNone()) 84 | 85 | 86 | def call_iiii_i(label, expr1, expr2, expr3, expr4): 87 | params = ffi.new('BinaryenExpressionRef[4]', [expr1, expr2, expr3, expr4]) 88 | 89 | retain_gc(params) 90 | 91 | return lib.BinaryenCall(module, label.encode('ascii'), params, 4, lib.BinaryenInt32()) 92 | 93 | 94 | # Memory access 95 | 96 | 97 | def get_reg(reg): 98 | return lib.BinaryenGetLocal(module, reg, CELL_TYPE) 99 | 100 | 101 | def get_double_reg(reg): 102 | return lib.BinaryenGetLocal(module, reg, DOUBLE_CELL_TYPE) 103 | 104 | 105 | def set_reg(reg, expr): 106 | return lib.BinaryenSetLocal(module, reg, expr) 107 | 108 | 109 | def load_cell(addr_expr, cells_offset=0): 110 | return lib.BinaryenLoad( 111 | module, 112 | CELL_SIZE, 113 | 0, 114 | cells_offset * CELL_SIZE, 115 | 0, 116 | CELL_TYPE, 117 | addr_expr, 118 | ) 119 | 120 | 121 | def load_double_cell(addr_expr, cells_offset=0): 122 | return lib.BinaryenLoad( 123 | module, 124 | CELL_SIZE * 2, 125 | 0, 126 | cells_offset * CELL_SIZE, 127 | 0, 128 | DOUBLE_CELL_TYPE, 129 | addr_expr, 130 | ) 131 | 132 | 133 | def store_cell(addr_expr, value_expr, cells_offset=0): 134 | return lib.BinaryenStore( 135 | module, 136 | CELL_SIZE, 137 | cells_offset * CELL_SIZE, 138 | 0, 139 | addr_expr, 140 | value_expr, 141 | CELL_TYPE, 142 | ) 143 | 144 | 145 | def store_double_cell(addr_expr, value_expr, cells_offset=0): 146 | return lib.BinaryenStore( 147 | module, 148 | CELL_SIZE * 2, 149 | cells_offset * CELL_SIZE, 150 | 0, 151 | addr_expr, 152 | value_expr, 153 | DOUBLE_CELL_TYPE, 154 | ) 155 | 156 | 157 | def load_byte(addr_expr): 158 | return lib.BinaryenLoad( 159 | module, 160 | 1, 161 | 0, 162 | 0, 163 | 0, 164 | CELL_TYPE, 165 | addr_expr, 166 | ) 167 | 168 | 169 | def store_byte(addr_expr, value_expr): 170 | return lib.BinaryenStore( 171 | module, 172 | 1, 173 | 0, 174 | 0, 175 | addr_expr, 176 | value_expr, 177 | CELL_TYPE, # NOTE: there is no 'byte' type in webassembly 178 | ) 179 | 180 | 181 | # Stack helpers 182 | 183 | 184 | def invert_double_cell(expr): 185 | """forth wants low | hi, but wasm is little endian (i.e. the 186 | reverse). Cells are already stored in little-endian, so we can get 187 | a proper 64 bit number by rotating by 32 bits. 188 | 189 | """ 190 | return lib.BinaryenBinary(module, lib.BinaryenRotRInt64(), expr, lib.BinaryenConst(module, lib.BinaryenLiteralInt64(32))) 191 | 192 | 193 | def peek(stack_reg, cells_offset): 194 | return load_cell(get_reg(stack_reg), cells_offset) 195 | 196 | 197 | def peek_double(stack_reg, cells_offset): 198 | return invert_double_cell(load_double_cell(get_reg(stack_reg), cells_offset)) 199 | 200 | 201 | def put(stack_reg, cells_offset, expr): 202 | return store_cell(get_reg(stack_reg), expr, cells_offset) 203 | 204 | 205 | def put_double(stack_reg, cells_offset, expr): 206 | return store_double_cell(get_reg(stack_reg), invert_double_cell(expr), cells_offset) 207 | 208 | 209 | def inc(reg, n_cells): 210 | return set_reg(reg, add_cell_size(reg, n_cells)) 211 | 212 | 213 | def drop(reg, n_cells): 214 | return inc(reg, n_cells) 215 | 216 | 217 | def push(stack_reg, expr): 218 | """ 219 | NOTE: the stack size is already incremented by 1 cell when expr is evaluated. 220 | """ 221 | 222 | return [ 223 | inc(stack_reg, -1), 224 | put(stack_reg, 0, expr), 225 | ] 226 | 227 | 228 | def add_cell_size(reg, n_cells): 229 | if n_cells == 0: 230 | return get_reg(reg) 231 | 232 | return add( 233 | get_reg(reg), 234 | const_cell(n_cells * CELL_SIZE), 235 | ) 236 | 237 | 238 | def cmp_neg(cmp_op): 239 | # NOT: cmp_op MUST be the reverse of the desired one! 240 | return [ 241 | put( 242 | SP, 243 | 1, 244 | sub( 245 | cmp_op( 246 | peek(SP, 1), 247 | peek(SP, 0), 248 | ), 249 | const_cell(1), 250 | ), 251 | ), 252 | drop(SP, 1), 253 | ] 254 | 255 | 256 | def cmp_neg_zero(cmp_op): 257 | # NOT: cmp_op MUST be the reverse of the desired one! 258 | return [ 259 | put( 260 | SP, 261 | 0, 262 | sub( 263 | cmp_op( 264 | peek(SP, 0), 265 | const_cell(0), 266 | ), 267 | const_cell(1), 268 | ), 269 | ), 270 | ] 271 | 272 | 273 | def op_on_tos(op, rhs_expr, stack_reg=SP): 274 | """ 275 | Applies X = op(X, rhs_expr), where X is the top of the stack. 276 | """ 277 | 278 | return put(stack_reg, 0, op(peek(stack_reg, 0), rhs_expr)) 279 | 280 | 281 | def bin_op(op): 282 | return [ 283 | put(SP, 1, op(peek(SP, 1), peek(SP, 0))), 284 | drop(SP, 1), 285 | ] 286 | 287 | 288 | def bin_op_32_32_64(op): 289 | return put_double(SP, 0, op(peek(SP, 1), peek(SP, 0))) 290 | 291 | 292 | def bin_op_64_32_64(op): 293 | return [ 294 | put_double(SP, 1, op(peek_double(SP, 1), peek(SP, 0))), 295 | drop(SP, 1), 296 | ] 297 | 298 | 299 | # Constants 300 | 301 | 302 | def const_cell(value): 303 | return lib.BinaryenConst(module, lib.BinaryenLiteralInt32(value)) 304 | 305 | 306 | def const_double_cell(value): 307 | return lib.BinaryenConst(module, lib.BinaryenLiteralInt64(value)) 308 | 309 | 310 | # Type conversions 311 | 312 | 313 | def u_32_to_64(expr): 314 | return lib.BinaryenUnary(module, lib.BinaryenExtendUInt32(), expr) 315 | 316 | 317 | def u_64_to_32(expr): 318 | return lib.BinaryenUnary(module, lib.BinaryenWrapInt64(), expr) 319 | 320 | 321 | def s_32_to_64(expr): 322 | return lib.BinaryenUnary(module, lib.BinaryenExtendSInt32(), expr) 323 | 324 | 325 | def s_64_to_32(expr): 326 | return lib.BinaryenUnary(module, lib.BinaryenWrapInt64(), expr) 327 | 328 | 329 | # Comparisons 330 | 331 | 332 | def eqz(expr): 333 | return lib.BinaryenUnary(module, lib.BinaryenEqZInt32(), expr) 334 | 335 | 336 | def eq(expr1, expr2): 337 | return lib.BinaryenBinary(module, lib.BinaryenEqInt32(), expr1, expr2) 338 | 339 | 340 | def ne(expr1, expr2): 341 | return lib.BinaryenBinary(module, lib.BinaryenNeInt32(), expr1, expr2) 342 | 343 | 344 | def ge_s(expr1, expr2): 345 | return lib.BinaryenBinary(module, lib.BinaryenGeSInt32(), expr1, expr2) 346 | 347 | 348 | def ge_u(expr1, expr2): 349 | return lib.BinaryenBinary(module, lib.BinaryenGeUInt32(), expr1, expr2) 350 | 351 | 352 | def le_s(expr1, expr2): 353 | return lib.BinaryenBinary(module, lib.BinaryenLeSInt32(), expr1, expr2) 354 | 355 | 356 | def le_u(expr1, expr2): 357 | return lib.BinaryenBinary(module, lib.BinaryenLeUInt32(), expr1, expr2) 358 | 359 | 360 | def l_s(expr1, expr2): 361 | return lib.BinaryenBinary(module, lib.BinaryenLtSInt32(), expr1, expr2) 362 | 363 | 364 | # Math/bit-ops 365 | 366 | 367 | def add(expr1, expr2): 368 | return lib.BinaryenBinary(module, lib.BinaryenAddInt32(), expr1, expr2) 369 | 370 | 371 | def add_64_32(expr1, expr2): 372 | return lib.BinaryenBinary(module, lib.BinaryenAddInt64(), expr1, u_32_to_64(expr2)) 373 | 374 | 375 | def add_64(expr1, expr2): 376 | return lib.BinaryenBinary(module, lib.BinaryenAddInt64(), expr1, expr2) 377 | 378 | 379 | def sub(expr1, expr2): 380 | return lib.BinaryenBinary(module, lib.BinaryenSubInt32(), expr1, expr2) 381 | 382 | 383 | def mul(expr1, expr2): 384 | return lib.BinaryenBinary(module, lib.BinaryenMulInt32(), expr1, expr2) 385 | 386 | 387 | def mul_32_32_64(expr1, expr2): 388 | return lib.BinaryenBinary(module, lib.BinaryenMulInt64(), s_32_to_64(expr1), s_32_to_64(expr2)) 389 | 390 | 391 | def mul_64(expr1, expr2): 392 | return lib.BinaryenBinary(module, lib.BinaryenMulInt64(), expr1, expr2) 393 | 394 | 395 | def umul_32_32_64(expr1, expr2): 396 | return lib.BinaryenBinary(module, lib.BinaryenMulInt64(), u_32_to_64(expr1), u_32_to_64(expr2)) 397 | 398 | 399 | def div(expr1, expr2): 400 | return lib.BinaryenBinary(module, lib.BinaryenDivSInt32(), expr1, expr2) 401 | 402 | 403 | def rem(expr1, expr2): 404 | return lib.BinaryenBinary(module, lib.BinaryenRemSInt32(), expr1, expr2) 405 | 406 | 407 | def div_64_32_32(expr1, expr2): 408 | return s_64_to_32(lib.BinaryenBinary(module, lib.BinaryenDivSInt64(), expr1, s_32_to_64(expr2))) 409 | 410 | 411 | def udiv_64_32_32(expr1, expr2): 412 | return u_64_to_32(lib.BinaryenBinary(module, lib.BinaryenDivUInt64(), expr1, u_32_to_64(expr2))) 413 | 414 | 415 | def udiv_64_32_64(expr1, expr2): 416 | return lib.BinaryenBinary(module, lib.BinaryenDivUInt64(), expr1, u_32_to_64(expr2)) 417 | 418 | 419 | def rem_64_32_32(expr1, expr2): 420 | return s_64_to_32(lib.BinaryenBinary(module, lib.BinaryenRemSInt64(), expr1, s_32_to_64(expr2))) 421 | 422 | 423 | def urem_64_32_32(expr1, expr2): 424 | return u_64_to_32(lib.BinaryenBinary(module, lib.BinaryenRemUInt64(), expr1, u_32_to_64(expr2))) 425 | 426 | 427 | def ls(expr1, expr2): 428 | return lib.BinaryenBinary(module, lib.BinaryenShlInt32(), expr1, expr2) 429 | 430 | 431 | def a_rs(expr1, expr2): 432 | return lib.BinaryenBinary(module, lib.BinaryenShrSInt32(), expr1, expr2) 433 | 434 | 435 | def l_rs(expr1, expr2): 436 | return lib.BinaryenBinary(module, lib.BinaryenShrUInt32(), expr1, expr2) 437 | 438 | 439 | def bit_and(expr1, expr2): 440 | return lib.BinaryenBinary(module, lib.BinaryenAndInt32(), expr1, expr2) 441 | 442 | 443 | def bit_or(expr1, expr2): 444 | return lib.BinaryenBinary(module, lib.BinaryenOrInt32(), expr1, expr2) 445 | 446 | 447 | def bit_xor(expr1, expr2): 448 | return lib.BinaryenBinary(module, lib.BinaryenXorInt32(), expr1, expr2) 449 | -------------------------------------------------------------------------------- /kernel/assembler.py: -------------------------------------------------------------------------------- 1 | from _binaryen_c import ffi, lib 2 | 3 | from asm_ops import * 4 | from binaryen_module import module, retain_gc, release_gc 5 | from code_words import load_registers, CODE_WORDS 6 | from forth_interpreter import FORTH_CONSTANTS, FORTH_VARIABLES, FORTH_COL_DEFS 7 | from memory_layout import * 8 | 9 | 10 | def build_kernel(output_file): 11 | """ 12 | Builds the basic forth kernel, with just enough primitives to run an interpreter, 13 | and saves it to a WASM file. 14 | """ 15 | 16 | assemble() 17 | save_kernel(output_file) 18 | destroy() 19 | 20 | 21 | def assemble(): 22 | """ 23 | Assembles the forth kernel into the global binaryen module. 24 | """ 25 | 26 | add_imports() 27 | add_exports() 28 | add_initial_memory() 29 | add_interpreter() 30 | 31 | 32 | def add_imports(): 33 | """ 34 | Add FFI imports to the module (io.read and io.write). 35 | """ 36 | 37 | iii_params = ffi.new('BinaryenType[3]', [CELL_TYPE] * 3) 38 | iiin = lib.BinaryenAddFunctionType(module, b'iiin', lib.BinaryenNone(), iii_params, 3) 39 | 40 | ii_params = ffi.new('BinaryenType[2]', [CELL_TYPE] * 2) 41 | iin = lib.BinaryenAddFunctionType(module, b'iin', lib.BinaryenNone(), ii_params, 2) 42 | 43 | iiii_params = ffi.new('BinaryenType[4]', [CELL_TYPE] * 4) 44 | iiii_i = lib.BinaryenAddFunctionType(module, b'iiiii', lib.BinaryenInt32(), iiii_params, 4) 45 | 46 | lib.BinaryenAddFunctionImport(module, b'read', b'io', b'read', iiin) 47 | lib.BinaryenAddFunctionImport(module, b'write', b'io', b'write', iin) 48 | lib.BinaryenAddFunctionImport(module, b'patchBody', b'io', b'patchBody', iin) 49 | lib.BinaryenAddFunctionImport(module, b'evtAttr', b'io', b'evtAttr', iiii_i) 50 | 51 | retain_gc(iiii_params) 52 | retain_gc(iii_params) 53 | retain_gc(ii_params) 54 | 55 | 56 | def add_exports(): 57 | """ 58 | Exports the interpreter entry point. 59 | """ 60 | 61 | lib.BinaryenAddExport(module, b'exec', b'exec') 62 | 63 | 64 | def add_initial_memory(): 65 | """ 66 | Initializes the memory with compiled forth constants, variables and column definition. 67 | """ 68 | 69 | forth_words_addrs = {} 70 | dictionary_bytes = [] 71 | last_name_addr = 0 72 | last_name_addr = add_code_primitives_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr) 73 | last_name_addr = add_forth_constants_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr) 74 | last_name_addr = add_forth_variables_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr) 75 | last_name_addr = add_forth_col_defs_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr) 76 | 77 | # set LATEST to last_name_addr 78 | replace_forth_variable_value(dictionary_bytes, forth_words_addrs, 'LATEST', last_name_addr) 79 | # set HERE to HERE_INITIAL + len(dictionary_bytes) 80 | replace_forth_variable_value(dictionary_bytes, forth_words_addrs, '\'HERE', HERE_INITIAL + len(dictionary_bytes)) 81 | 82 | # main task saved registers initial values, will be loaded into registers when the interpreter first boots 83 | reg_initial_bytes = [] 84 | append_cell(reg_initial_bytes, MAIN_TASK_BASE_VALUE + IP_INITIAL_OFFSET) 85 | append_cell(reg_initial_bytes, MAIN_TASK_BASE_VALUE + SP_INITIAL_OFFSET) 86 | append_cell(reg_initial_bytes, MAIN_TASK_BASE_VALUE + RS_INITIAL_OFFSET) 87 | 88 | # address of first forth word to run 89 | ip_initial_bytes = [] 90 | append_cell(ip_initial_bytes, forth_words_addrs['ABORT']) 91 | 92 | dictionary_data = ffi.new('char[]', bytes(dictionary_bytes)) 93 | reg_initial_data = ffi.new('char[]', bytes(reg_initial_bytes)) 94 | ip_initial_data = ffi.new('char[]', bytes(ip_initial_bytes)) 95 | 96 | segment_contents = ffi.new('char*[]', [reg_initial_data, ip_initial_data, dictionary_data]) 97 | segment_offsets = ffi.new('BinaryenExpressionRef[]', [const_cell(MAIN_TASK_BASE_VALUE), 98 | const_cell(MAIN_TASK_BASE_VALUE + IP_INITIAL_OFFSET), 99 | const_cell(HERE_INITIAL)]) 100 | segment_sizes = ffi.new('BinaryenIndex[]', [len(reg_initial_bytes), len(ip_initial_bytes), len(dictionary_bytes)]) 101 | segments_passive = ffi.new('char[]', bytes([0, 0, 0])) 102 | 103 | # memory size is given in number of 64 KB pages, 104 | # in this case we use a fixed 128 MB size 105 | lib.BinaryenSetMemory(module, 2048, 2048, b'mem', segment_contents, segments_passive, segment_offsets, segment_sizes, 3, 0) 106 | 107 | retain_gc(dictionary_data, reg_initial_data, segment_contents, segment_offsets, segment_sizes, segments_passive) 108 | 109 | 110 | def add_interpreter(): 111 | """ 112 | Adds the interpreter function to the global module. 113 | """ 114 | 115 | ii_params = ffi.new('BinaryenType[2]', [CELL_TYPE, CELL_TYPE]) 116 | iin = lib.BinaryenAddFunctionType(module, b't_iin', lib.BinaryenNone(), ii_params, len(ii_params)) 117 | 118 | registers = ffi.new('BinaryenType[]', 8) 119 | registers[IP - 2] = CELL_TYPE 120 | registers[W - 2] = CELL_TYPE 121 | registers[SP - 2] = CELL_TYPE 122 | registers[RS - 2] = CELL_TYPE 123 | registers[SCRATCH_1 - 2] = CELL_TYPE 124 | registers[SCRATCH_2 - 2] = CELL_TYPE 125 | registers[SCRATCH_3 - 2] = CELL_TYPE 126 | registers[SCRATCH_DOUBLE_1 - 2] = DOUBLE_CELL_TYPE 127 | 128 | exec_body = block( 129 | load_registers(), 130 | assemble_interpreter(), 131 | label='entry', 132 | ) 133 | lib.BinaryenAddFunction(module, b'exec', iin, registers, len(registers), exec_body) 134 | 135 | retain_gc(ii_params, registers) 136 | 137 | 138 | def assemble_interpreter(): 139 | # main interpreter switch to execute code words 140 | interpreter_body = switch( 141 | [label for label, _ in CODE_WORDS], 142 | # memory addresses in the dictionary are always greater than 143 | # primitive indexes (because of how far into the memory the 144 | # dictionary starts). If a code index is not found, we assume 145 | # it's a custom initiation code defined using DOES>, so we 146 | # execute (dodoes) to run it. 147 | '(dodoes)', 148 | load_cell(get_reg(W)), 149 | ) 150 | 151 | for label, instrs in CODE_WORDS: 152 | interpreter_body = block(block(interpreter_body, label=label), instrs) 153 | 154 | interpreter_body = block( 155 | set_reg(W, load_cell(get_reg(IP))), 156 | inc(IP, 1), 157 | loop('interpreter_switch', interpreter_body), 158 | ) 159 | 160 | return loop('next', interpreter_body) 161 | 162 | 163 | def add_code_primitives_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr): 164 | for code_addr, (label, _) in enumerate(CODE_WORDS): 165 | last_name_addr = append_dict_header(dictionary_bytes, forth_words_addrs, last_name_addr, label) 166 | 167 | append_cell(dictionary_bytes, code_addr) 168 | 169 | return last_name_addr 170 | 171 | 172 | def add_forth_constants_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr): 173 | doconst_addr = find_code_primitive_addr('(doconst)') 174 | 175 | for label, initial_value in FORTH_CONSTANTS: 176 | last_name_addr = append_dict_header(dictionary_bytes, forth_words_addrs, last_name_addr, label) 177 | 178 | append_cell(dictionary_bytes, doconst_addr) 179 | append_cell(dictionary_bytes, initial_value) 180 | 181 | return last_name_addr 182 | 183 | 184 | def add_forth_variables_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr): 185 | dovar_addr = find_code_primitive_addr('(dovar)') 186 | 187 | for label, initial_value in FORTH_VARIABLES: 188 | last_name_addr = append_dict_header(dictionary_bytes, forth_words_addrs, last_name_addr, label) 189 | 190 | append_cell(dictionary_bytes, dovar_addr) 191 | # variable values can be a byte-string or a single-cell integer 192 | if isinstance(initial_value, bytes): 193 | append_aligned_bytes(dictionary_bytes, initial_value) 194 | else: 195 | append_cell(dictionary_bytes, initial_value) 196 | 197 | return last_name_addr 198 | 199 | 200 | def replace_forth_variable_value(dictionary_bytes, forth_words_addrs, label, new_value): 201 | replace_cell(dictionary_bytes, forth_words_addrs[label] + CELL_SIZE - HERE_INITIAL, new_value) 202 | 203 | 204 | def add_forth_col_defs_dict_entries(dictionary_bytes, forth_words_addrs, last_name_addr): 205 | docol_addr = find_code_primitive_addr('(docol)') 206 | 207 | for label, words, immediate in FORTH_COL_DEFS: 208 | last_name_addr = append_dict_header(dictionary_bytes, forth_words_addrs, last_name_addr, label, immediate) 209 | 210 | append_cell(dictionary_bytes, docol_addr) 211 | 212 | # compile the body 213 | for word in words: 214 | if isinstance(word, int): 215 | append_cell(dictionary_bytes, word) 216 | else: 217 | assert word in forth_words_addrs, 'word {} not defined'.format(word) 218 | append_cell(dictionary_bytes, forth_words_addrs[word]) 219 | 220 | append_cell(dictionary_bytes, forth_words_addrs['EXIT']) 221 | 222 | return last_name_addr 223 | 224 | 225 | def find_code_primitive_addr(primitive_label): 226 | for code_addr, (label, _) in enumerate(CODE_WORDS): 227 | if label == primitive_label: 228 | return code_addr 229 | else: 230 | raise Exception('The {} code primitive must be defined'.format(primitive_label)) 231 | 232 | 233 | def append_dict_header(dictionary_bytes, forth_words_addrs, last_name_addr, label, immediate=False): 234 | """ 235 | Appends the header for a definition entry in the forth dictionary. 236 | Adds the address of the code word to forth_words_addrs, and returns the 237 | address where the (length, name) pair starts. 238 | 239 | Header structure: 240 | - 4 bytes pointer to previous entry 241 | - 1 byte of flags (1 = immediate word, 0 = non-immediate word) 242 | - 1 byte of label length 243 | - 4-byte aligned label bytes (max 30) 244 | """ 245 | 246 | assert len(label) < 31 247 | 248 | append_cell(dictionary_bytes, last_name_addr) # pointer to previous entry 249 | 250 | dictionary_bytes.append(int(immediate)) # 1 byte of flags: 1 = IMMEDIATE, 0 = normal 251 | 252 | last_name_addr = HERE_INITIAL + len(dictionary_bytes) 253 | 254 | dictionary_bytes.append(len(label)) # 1 byte of label length (high-bit can be set to 1 to hide the word) 255 | append_aligned_bytes(dictionary_bytes, label.encode('ascii')) 256 | 257 | forth_words_addrs[label] = HERE_INITIAL + len(dictionary_bytes) 258 | 259 | return last_name_addr 260 | 261 | 262 | def append_aligned_bytes(dictionary_bytes, value): 263 | dictionary_bytes.extend(value) 264 | append_padding(dictionary_bytes) 265 | 266 | 267 | def append_padding(dictionary_bytes): 268 | """pad to CELL_SIZE boundary""" 269 | 270 | size = len(dictionary_bytes) 271 | padded_size = ((CELL_SIZE - (size & (CELL_SIZE - 1))) & (CELL_SIZE - 1)) + size 272 | dictionary_bytes.extend([0] * (padded_size - size)) 273 | 274 | 275 | def append_cell(dictionary_bytes, value): 276 | # webassembly uses little endian 277 | dictionary_bytes.append(value & 0xFF) 278 | dictionary_bytes.append((value >> 8) & 0xFF) 279 | dictionary_bytes.append((value >> 16) & 0xFF) 280 | dictionary_bytes.append((value >> 24) & 0xFF) 281 | 282 | 283 | def replace_cell(dictionary_bytes, offset, value): 284 | # webassembly uses little endian 285 | dictionary_bytes[offset] = value & 0xFF 286 | dictionary_bytes[offset + 1] = (value >> 8) & 0xFF 287 | dictionary_bytes[offset + 2] = (value >> 16) & 0xFF 288 | dictionary_bytes[offset + 3] = (value >> 24) & 0xFF 289 | 290 | 291 | def print_debug(): 292 | lib.BinaryenModulePrint(module) 293 | 294 | 295 | def save_kernel(output_file): 296 | """ 297 | Saves the global module to a file. 298 | """ 299 | 300 | assert lib.BinaryenModuleValidate(module) == 1 301 | 302 | size = 1024 303 | while True: 304 | buf = ffi.new('char[]', size) 305 | written_size = lib.BinaryenModuleWrite(module, buf, size) 306 | if written_size < size: 307 | with open(output_file, 'w+b') as out: 308 | out.write(ffi.buffer(buf, written_size)) 309 | break 310 | size *= 2 311 | 312 | 313 | def destroy(): 314 | """ 315 | Frees memory allocated to build to the global module. 316 | """ 317 | 318 | lib.BinaryenModuleDispose(module) 319 | release_gc() 320 | -------------------------------------------------------------------------------- /kernel/binaryen_module.py: -------------------------------------------------------------------------------- 1 | from _binaryen_c import lib 2 | 3 | _no_gc = [] 4 | module = lib.BinaryenModuleCreate() 5 | 6 | 7 | def retain_gc(*items): 8 | _no_gc.extend(items) 9 | 10 | 11 | def release_gc(): 12 | global _no_gc 13 | _no_gc = [] 14 | -------------------------------------------------------------------------------- /kernel/build_binaryen_ext.py: -------------------------------------------------------------------------------- 1 | from os import path 2 | 3 | from cffi import FFI 4 | 5 | 6 | ffibuilder = FFI() 7 | 8 | base_path = path.abspath(path.dirname(__file__)) 9 | header_path = path.join(base_path, 'vendor/binaryen-c.h') 10 | 11 | with open(header_path, 'r') as header_file: 12 | source = header_file.read() 13 | ffibuilder.set_source( 14 | '_binaryen_c', 15 | r""" 16 | #include 17 | #include 18 | {}""".format(source), 19 | libraries=['binaryen'], 20 | library_dirs=['vendor'], 21 | ) 22 | ffibuilder.cdef(source) 23 | 24 | 25 | if __name__ == '__main__': 26 | ffibuilder.compile(verbose=True) 27 | -------------------------------------------------------------------------------- /kernel/code_words.py: -------------------------------------------------------------------------------- 1 | """ 2 | Basic Forth words defined directly in WebAssembly. 3 | """ 4 | 5 | from asm_ops import * 6 | 7 | 8 | def store_registers(): 9 | """ 10 | Store registers into the memory, so the interpeter can be restarted, 11 | similar to a context switch. 12 | """ 13 | 14 | # NOTE: it's not necessary to store/reload register W, its value 15 | # will be refreshed from the IP 16 | return [ 17 | store_cell(_register_mem_addr(IP_MEM_OFFSET), get_reg(IP)), 18 | store_cell(_register_mem_addr(SP_MEM_OFFSET), get_reg(SP)), 19 | store_cell(_register_mem_addr(RS_MEM_OFFSET), get_reg(RS)), 20 | ] 21 | 22 | 23 | def load_registers(): 24 | """ 25 | Load registers from the memory, to restart the interpeter, 26 | similar to a context switch. 27 | """ 28 | 29 | return [ 30 | set_reg(IP, load_cell(_register_mem_addr(IP_MEM_OFFSET))), 31 | set_reg(SP, load_cell(_register_mem_addr(SP_MEM_OFFSET))), 32 | set_reg(RS, load_cell(_register_mem_addr(RS_MEM_OFFSET))), 33 | ] 34 | 35 | 36 | def _register_mem_addr(offset): 37 | return add(get_reg(TASK_BASE_PARAM), const_cell(offset)) 38 | 39 | 40 | def _branch(): 41 | """ 42 | Branch to the instruction indicated by the byte offset stored in the next cell 43 | pointed by IP 44 | """ 45 | 46 | return [ 47 | # relative jump to offset, bytes offset calculated and stored 48 | # after the current codeword 49 | set_reg( 50 | IP, 51 | add( 52 | get_reg(IP), 53 | # note: offset in bytes, user must manually skip the address 54 | load_cell(get_reg(IP)), 55 | ), 56 | ), 57 | jmp('next'), 58 | ] 59 | 60 | 61 | def _call_iin_sync(name): 62 | return [ 63 | call_iin(name, peek(SP, 1), peek(SP, 0)), 64 | drop(SP, 2), 65 | ] 66 | 67 | 68 | def _call_iiii_i_sync(name): 69 | return [ 70 | put(SP, 3, call_iiii_i(name, peek(SP, 3), peek(SP, 2), peek(SP, 1), peek(SP, 0))), 71 | drop(SP, 3), 72 | ] 73 | 74 | 75 | def _call_iiin_async(name): 76 | return [ 77 | # store in temporary registers, so we can drop 78 | # from the stack before executing the FFI call 79 | set_reg(SCRATCH_1, peek(SP, 1)), 80 | set_reg(SCRATCH_2, peek(SP, 0)), 81 | drop(SP, 2), 82 | # store before the FFI call, so it can re-enter the interpeter asynchronously 83 | store_registers(), 84 | call_iiin(name, get_reg(TASK_BASE_PARAM), get_reg(SCRATCH_1), get_reg(SCRATCH_2)), 85 | # quit, it's responsibility of the FFI call to restart the 86 | # interpreter in a future next event loop cycle 87 | jmp('entry'), 88 | ] 89 | 90 | 91 | CODE_WORDS = [ 92 | # Initiation codes (non-standard words) 93 | ('(docol)', [ # ( R: -- c-addr ) 94 | push(RS, get_reg(IP)), 95 | set_reg(IP, add_cell_size(W, 1)), 96 | jmp('next'), 97 | ]), 98 | ('(doconst)', [ # ( -- x ) 99 | push(SP, load_cell(get_reg(W), 1)), 100 | jmp('next'), 101 | ]), 102 | ('(dovar)', [ # ( -- a-addr ) 103 | push(SP, add_cell_size(W, 1)), 104 | jmp('next'), 105 | ]), 106 | ('(dodoes)', [ # ( -- a-addr ) 107 | push(RS, get_reg(IP)), 108 | push(SP, add_cell_size(W, 1)), 109 | # see the switch in assemble_interpreter, the cell pointed by 110 | # W contains the address to execute compiled in by (DOES>) 111 | set_reg(IP, load_cell(get_reg(W))), 112 | jmp('next'), 113 | ]), 114 | # FFI (non-standard words, async) 115 | # these quit the interpreter. The called foreign function must then re-enter it. Return value is obtained using 'task-param'. 116 | ('READ', [ # ( c-addr u1 -- ) 117 | _call_iiin_async('read'), 118 | ]), 119 | # FFI (sync) 120 | ('WRITE', [ # ( c-addr u1 -- ) 121 | _call_iin_sync('write'), 122 | jmp('next'), 123 | ]), 124 | ('PATCH-BODY', [ # ( addr u1 -- ) 125 | _call_iin_sync('patchBody'), 126 | jmp('next'), 127 | ]), 128 | ('EVT-ATTR', [ # ( addr1 u1 addr2 u2 -- u3 ) 129 | _call_iiii_i_sync('evtAttr'), 130 | jmp('next'), 131 | ]), 132 | # Non-standard extensions, useful to implement the interpreter 133 | ('task-base', [ # ( -- addr ) 134 | push(SP, get_reg(TASK_BASE_PARAM)), 135 | jmp('next'), 136 | ]), 137 | ('task-base!', [ # ( addr -- ) 138 | set_reg(TASK_BASE_PARAM, peek(SP, 0)), 139 | drop(SP, 1), 140 | jmp('next'), 141 | ]), 142 | ('task-param', [ # ( -- x ) 143 | push(SP, get_reg(TASK_PARAM)), 144 | jmp('next'), 145 | ]), 146 | ('lit', [ # ( -- x ) 147 | # load literal value kept in next cell, which is now pointed by IP 148 | push(SP, load_cell(get_reg(IP))), 149 | inc(IP, 1), 150 | jmp('next'), 151 | ]), 152 | ('RP!', [ # ( a-addr -- ) 153 | set_reg(RS, peek(SP, 0)), 154 | drop(SP, 1), 155 | jmp('next'), 156 | ]), 157 | ('RP@', [ # ( -- a-addr ) 158 | inc(SP, -1), 159 | put(SP, 0, get_reg(RS)), 160 | jmp('next'), 161 | ]), 162 | ('SP!', [ # ( a-addr -- ) 163 | set_reg(SP, peek(SP, 0)), 164 | jmp('next'), 165 | ]), 166 | ('SP@', [ # ( -- a-addr ) 167 | # returns address of stack top on top of the stack, 168 | # counting the newly added address 169 | inc(SP, -1), 170 | put(SP, 0, get_reg(SP)), 171 | jmp('next'), 172 | ]), 173 | ('SKIP', [ # ( c-addr1 u1 c -- c-addr2 u2 ) 174 | set_reg(SCRATCH_1, peek(SP, 0)), # c 175 | set_reg(SCRATCH_2, peek(SP, 1)), # u1 176 | set_reg(SCRATCH_3, peek(SP, 2)), # c-addr1 177 | drop(SP, 1), 178 | loop( 179 | 'SKIP-loop', 180 | block( 181 | jmp( 182 | 'SKIP-loop-done', 183 | cond_expr=le_s(get_reg(SCRATCH_2), const_cell(0)), 184 | ), 185 | jmp( 186 | 'SKIP-loop-done', 187 | cond_expr=ne(load_byte(get_reg(SCRATCH_3)), get_reg(SCRATCH_1)), 188 | ), 189 | set_reg(SCRATCH_2, sub(get_reg(SCRATCH_2), const_cell(1))), 190 | set_reg(SCRATCH_3, add(get_reg(SCRATCH_3), const_cell(1))), 191 | jmp('SKIP-loop'), 192 | label='SKIP-loop-done', 193 | ), 194 | ), 195 | put(SP, 0, get_reg(SCRATCH_2)), 196 | put(SP, 1, get_reg(SCRATCH_3)), 197 | jmp('next'), 198 | ]), 199 | ('SCAN', [ # ( c-addr1 u1 c -- c-addr2 u2 ) 200 | set_reg(SCRATCH_1, peek(SP, 0)), # c 201 | set_reg(SCRATCH_2, peek(SP, 1)), # u1 202 | set_reg(SCRATCH_3, peek(SP, 2)), # c-addr1 203 | drop(SP, 1), 204 | loop( 205 | 'SCAN-loop', 206 | block( 207 | jmp( 208 | 'SCAN-loop-done', 209 | cond_expr=le_s(get_reg(SCRATCH_2), const_cell(0)), 210 | ), 211 | jmp( 212 | 'SCAN-loop-done', 213 | cond_expr=eq(load_byte(get_reg(SCRATCH_3)), get_reg(SCRATCH_1)), 214 | ), 215 | set_reg(SCRATCH_2, sub(get_reg(SCRATCH_2), const_cell(1))), 216 | set_reg(SCRATCH_3, add(get_reg(SCRATCH_3), const_cell(1))), 217 | jmp('SCAN-loop'), 218 | label='SCAN-loop-done', 219 | ), 220 | ), 221 | put(SP, 0, get_reg(SCRATCH_2)), 222 | put(SP, 1, get_reg(SCRATCH_3)), 223 | jmp('next'), 224 | ]), 225 | ('EQ-COUNTED', [ # ( c-addr1 c-addr2 -- flag ) 226 | set_reg(SCRATCH_1, load_byte(peek(SP, 0))), # n1 227 | set_reg(SCRATCH_2, load_byte(peek(SP, 1))), # n2 228 | block( 229 | jmp('eq-counted-if', cond_expr=eq(get_reg(SCRATCH_1), get_reg(SCRATCH_2))), 230 | put(SP, 1, const_cell(0)), 231 | drop(SP, 1), 232 | jmp('next'), 233 | label='eq-counted-if', 234 | ), 235 | loop( 236 | 'eq-counted-loop', 237 | block( 238 | block( 239 | jmp( 240 | 'eq-counted-ok', 241 | cond_expr=le_s(get_reg(SCRATCH_1), const_cell(0)), 242 | ), 243 | jmp( 244 | 'eq-counted-loop-fail', 245 | cond_expr=ne( 246 | load_byte(add(peek(SP, 0), get_reg(SCRATCH_1))), 247 | load_byte(add(peek(SP, 1), get_reg(SCRATCH_1))), 248 | ), 249 | ), 250 | set_reg(SCRATCH_1, sub(get_reg(SCRATCH_1), const_cell(1))), 251 | jmp('eq-counted-loop'), 252 | label='eq-counted-loop-fail', 253 | ), 254 | put(SP, 1, const_cell(0)), 255 | drop(SP, 1), 256 | jmp('next'), 257 | label='eq-counted-ok', 258 | ), 259 | ), 260 | put(SP, 1, const_cell(-1)), 261 | drop(SP, 1), 262 | jmp('next'), 263 | ]), 264 | # Branching/looping (non-standard words) 265 | ('branch', [ # ( -- ) 266 | _branch(), 267 | ]), 268 | ('?branch', [ # ( x -- ) 269 | block( 270 | jmp('?branch-if', cond_expr=ne(peek(SP, 0), const_cell(0))), 271 | drop(SP, 1), 272 | _branch(), 273 | label='?branch-if', 274 | ), 275 | drop(SP, 1), 276 | inc(IP, 1), # if false, skip the address 277 | jmp('next'), 278 | ]), 279 | ('(do)', [ # ( limit index -- R: -- loop-end-addr limit index ) 280 | inc(RS, -3), 281 | # copy limit and index in one go 282 | store_double_cell(get_reg(RS), load_double_cell(get_reg(SP))), 283 | put(RS, 2, load_cell(get_reg(IP))), # the loop end address, stored in the next cell 284 | inc(IP, 1), # skip the loop-end-addr 285 | drop(SP, 2), 286 | jmp('next'), 287 | ]), 288 | ('(loop)', [ # ( R: loop-end-addr limit index1 -- | loop-end-addr limit index2 ) 289 | op_on_tos(add, const_cell(1), stack_reg=RS), 290 | block( 291 | jmp('(loop)-if', l_s(peek(RS, 0), peek(RS, 1))), 292 | drop(RS, 3), 293 | inc(IP, 1), # skip the address 294 | jmp('next'), 295 | label='(loop)-if', 296 | ), 297 | _branch(), 298 | ]), 299 | ('(+loop)', [ # ( n -- R: loop-end-addr limit index1 -- | loop-end-addr limit index2 ) 300 | op_on_tos(add, peek(SP, 0), stack_reg=RS), 301 | drop(SP, 1), 302 | block( 303 | jmp('(+loop)-if', l_s(peek(RS, 0), peek(RS, 1))), 304 | drop(RS, 3), 305 | inc(IP, 1), # skip the address 306 | jmp('next'), 307 | label='(+loop)-if', 308 | ), 309 | _branch(), 310 | ]), 311 | 312 | # Core words 313 | 314 | # Stack manipulation 315 | ('>R', [ # ( x -- R: -- x ) 316 | push(RS, peek(SP, 0)), 317 | drop(SP, 1), 318 | jmp('next'), 319 | ]), 320 | ('R>', [ # ( -- x R: x -- ) 321 | push(SP, peek(RS, 0)), 322 | drop(RS, 1), 323 | jmp('next'), 324 | ]), 325 | ('R@', [ # ( -- x R: x -- x ) 326 | push(SP, peek(RS, 0)), 327 | jmp('next'), 328 | ]), 329 | ('DROP', [ # ( x -- ) 330 | drop(SP, 1), 331 | jmp('next'), 332 | ]), 333 | ('DUP', [ # ( x -- x x ) 334 | push(SP, peek(SP, 1)), 335 | jmp('next'), 336 | ]), 337 | ('2DUP', [ # ( x1 x2 -- x1 x2 x1 x2 ) 338 | inc(SP, -2), 339 | store_double_cell(get_reg(SP), load_double_cell(get_reg(SP), 2)), 340 | jmp('next'), 341 | ]), 342 | ('SWAP', [ # ( x1 x2 -- x2 x1 ) 343 | set_reg(SCRATCH_1, peek(SP, 0)), 344 | put(SP, 0, peek(SP, 1)), 345 | put(SP, 1, get_reg(SCRATCH_1)), 346 | jmp('next'), 347 | ]), 348 | ('OVER', [ # ( x1 x2 -- x1 x2 x1 ) 349 | push(SP, peek(SP, 2)), 350 | jmp('next'), 351 | ]), 352 | ('ROT', [ # ( x1 x2 x3 -- x2 x3 x1 ) 353 | set_reg(SCRATCH_1, peek(SP, 2)), 354 | put(SP, 2, peek(SP, 1)), 355 | put(SP, 1, peek(SP, 0)), 356 | put(SP, 0, get_reg(SCRATCH_1)), 357 | jmp('next'), 358 | ]), 359 | ('NIP', [ # ( x1 x2 -- x2 ) 360 | put(SP, 1, peek(SP, 0)), 361 | drop(SP, 1), 362 | jmp('next'), 363 | ]), 364 | ('TUCK', [ # ( x1 x2 -- x2 x1 x2 ) 365 | inc(SP, -1), 366 | put(SP, 0, peek(SP, 1)), 367 | put(SP, 1, peek(SP, 2)), 368 | put(SP, 2, peek(SP, 0)), 369 | jmp('next'), 370 | ]), 371 | ('2DROP', [ # ( x x -- ) 372 | drop(SP, 2), 373 | jmp('next'), 374 | ]), 375 | ('2OVER', [ # ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 ) 376 | inc(SP, -2), 377 | store_double_cell(get_reg(SP), load_double_cell(get_reg(SP), 4)), 378 | jmp('next'), 379 | ]), 380 | ('2SWAP', [ # ( x1 x2 x3 x4 -- x3 x4 x1 x2 ) 381 | set_reg(SCRATCH_DOUBLE_1, load_double_cell(get_reg(SP))), 382 | store_double_cell(get_reg(SP), load_double_cell(get_reg(SP), 2)), 383 | store_double_cell(get_reg(SP), get_double_reg(SCRATCH_DOUBLE_1), 2), 384 | jmp('next'), 385 | ]), 386 | # Memory access 387 | ('@', [ # ( a-addr -- x ) 388 | put(SP, 0, load_cell(peek(SP, 0))), 389 | jmp('next'), 390 | ]), 391 | ('!', [ # ( x a-addr -- ) 392 | store_cell(peek(SP, 0), peek(SP, 1)), 393 | drop(SP, 2), 394 | jmp('next'), 395 | ]), 396 | ('+!', [ # ( n1|u1 a-addr -- ) 397 | store_cell( 398 | peek(SP, 0), 399 | add( 400 | load_cell(peek(SP, 0)), 401 | peek(SP, 1), 402 | ), 403 | ), 404 | drop(SP, 2), 405 | jmp('next'), 406 | ]), 407 | ('C@', [ # ( a-addr -- x ) 408 | put(SP, 0, load_byte(peek(SP, 0))), 409 | jmp('next'), 410 | ]), 411 | ('C!', [ # ( c c-addr -- ) 412 | store_byte(peek(SP, 0), peek(SP, 1)), 413 | drop(SP, 2), 414 | jmp('next'), 415 | ]), 416 | ('CMOVE', [ # ( c-addr1 c-addr2 u -- ) 417 | set_reg(SCRATCH_1, peek(SP, 2)), # c-addr-1 418 | set_reg(SCRATCH_2, add(get_reg(SCRATCH_1), peek(SP, 0))), # c-addr-1 + u 419 | set_reg(SCRATCH_3, peek(SP, 1)), # c-addr-2 420 | loop( 421 | 'cmove-loop', 422 | block( 423 | jmp( 424 | 'cmove-loop-done', 425 | cond_expr=le_s(get_reg(SCRATCH_2), get_reg(SCRATCH_1)), 426 | ), 427 | store_byte(get_reg(SCRATCH_3), load_byte(get_reg(SCRATCH_1))), 428 | set_reg(SCRATCH_1, add(get_reg(SCRATCH_1), const_cell(1))), 429 | set_reg(SCRATCH_3, add(get_reg(SCRATCH_3), const_cell(1))), 430 | jmp('cmove-loop'), 431 | label='cmove-loop-done', 432 | ), 433 | ), 434 | drop(SP, 3), 435 | jmp('next'), 436 | ]), 437 | ('CMOVE>', [ # ( c-addr1 c-addr2 u -- ) 438 | set_reg(SCRATCH_2, peek(SP, 0)), # u 439 | set_reg(SCRATCH_1, peek(SP, 2)), # c-addr-1 440 | set_reg(SCRATCH_3, sub(add(get_reg(SCRATCH_2), peek(SP, 1)), const_cell(1))), # c-addr-2 + u - 1 441 | set_reg(SCRATCH_2, sub(add(get_reg(SCRATCH_2), get_reg(SCRATCH_1)), const_cell(1))), # c-addr-1 + u - 1 442 | loop( 443 | 'cmove>-loop', 444 | block( 445 | jmp( 446 | 'cmove>-loop-done', 447 | cond_expr=l_s(get_reg(SCRATCH_2), get_reg(SCRATCH_1)), 448 | ), 449 | store_byte(get_reg(SCRATCH_3), load_byte(get_reg(SCRATCH_2))), 450 | set_reg(SCRATCH_2, sub(get_reg(SCRATCH_2), const_cell(1))), 451 | set_reg(SCRATCH_3, sub(get_reg(SCRATCH_3), const_cell(1))), 452 | jmp('cmove>-loop'), 453 | label='cmove>-loop-done', 454 | ), 455 | ), 456 | drop(SP, 3), 457 | jmp('next'), 458 | ]), 459 | # Loops 460 | ('I', [ # ( -- n|u R: loop-sys1 -- loop-sys1 ) 461 | push(SP, peek(RS, 0)), 462 | jmp('next'), 463 | ]), 464 | ('J', [ # ( -- n|u R: loop-sys1 loop-sys2 -- loop-sys1 loop-sys2 ) 465 | push(SP, peek(RS, 3)), # a do-loop has 3 control parameters 466 | jmp('next'), 467 | ]), 468 | ('UNLOOP', [ # ( R: loop-end-addr sys1 sys2 -- ) 469 | drop(RS, 3), 470 | jmp('next'), 471 | ]), 472 | ('LEAVE', [ # ( loop-end-addr limit index -- ) 473 | set_reg(IP, peek(RS, 2)), 474 | drop(RS, 3), 475 | jmp('next'), 476 | ]), 477 | # Control 478 | ('EXECUTE', [ # ( i*x xt -- j*x ) 479 | set_reg(W, peek(SP, 0)), 480 | drop(SP, 1), 481 | jmp('interpreter_switch'), 482 | ]), 483 | ('EXIT', [ 484 | set_reg(IP, load_cell(get_reg(RS))), 485 | drop(RS, 1), 486 | jmp('next'), 487 | ]), 488 | ('BYE', [ 489 | jmp('entry'), 490 | ]), 491 | # Type conversions 492 | ('S>D', [ # ( n -- d ) 493 | inc(SP, -1), 494 | put_double(SP, 0, s_32_to_64(peek(SP, 1))), 495 | jmp('next'), 496 | ]), 497 | ('D>S', [ # ( d -- n ) 498 | put(SP, 1, s_64_to_32(peek_double(SP, 0))), 499 | drop(SP, 1), 500 | jmp('next'), 501 | ]), 502 | # Comparisons 503 | ('=', [ # ( x1 x2 -- flag ) 504 | cmp_neg(ne), 505 | jmp('next'), 506 | ]), 507 | ('<>', [ # ( x1 x2 -- x3 ) 508 | cmp_neg(eq), 509 | jmp('next'), 510 | ]), 511 | ('<', [ # ( n1 n2 -- flag ) 512 | cmp_neg(ge_s), 513 | jmp('next'), 514 | ]), 515 | ('>', [ # ( n1 n2 -- flag ) 516 | cmp_neg(le_s), 517 | jmp('next'), 518 | ]), 519 | ('U<', [ # ( u1 u2 -- flag ) 520 | cmp_neg(ge_u), 521 | jmp('next'), 522 | ]), 523 | ('U>', [ # ( u1 u2 -- flag ) 524 | cmp_neg(le_u), 525 | jmp('next'), 526 | ]), 527 | ('0<', [ # ( n -- flag ) 528 | cmp_neg_zero(ge_s), 529 | jmp('next'), 530 | ]), 531 | ('0=', [ # ( n -- flag ) 532 | cmp_neg_zero(ne), 533 | jmp('next'), 534 | ]), 535 | # Bitwise operations 536 | ('INVERT', [ # ( x1 -- x2 ) 537 | op_on_tos(bit_xor, const_cell(-1)), 538 | jmp('next'), 539 | ]), 540 | ('AND', [ # ( x1 x2 -- x3 ) 541 | bin_op(bit_and), 542 | jmp('next'), 543 | ]), 544 | ('OR', [ # ( x1 x2 -- x3 ) 545 | bin_op(bit_or), 546 | jmp('next'), 547 | ]), 548 | ('XOR', [ # ( x1 x2 -- x3 ) 549 | bin_op(bit_xor), 550 | jmp('next'), 551 | ]), 552 | ('LSHIFT', [ # ( x1 u -- x2 ) 553 | bin_op(ls), 554 | jmp('next'), 555 | ]), 556 | ('RSHIFT', [ # ( x1 u -- x2 ) 557 | bin_op(l_rs), 558 | jmp('next'), 559 | ]), 560 | # Single-cell math 561 | ('NEGATE', [ # ( x1 -- x2 ) 562 | op_on_tos(mul, const_cell(-1)), 563 | jmp('next'), 564 | ]), 565 | ('+', [ # ( n1|u1 n2|u2 -- n3|u3 ) 566 | bin_op(add), 567 | jmp('next'), 568 | ]), 569 | ('-', [ # ( n1|u1 n2|u2 -- n3|u3 ) 570 | bin_op(sub), 571 | jmp('next'), 572 | ]), 573 | ('*', [ # ( n1 n2 -- n3 ) 574 | bin_op(mul), 575 | jmp('next'), 576 | ]), 577 | ('/MOD', [ # ( n1 n2 -- n_rem n_quot ) 578 | set_reg(SCRATCH_1, div(peek(SP, 1), peek(SP, 0))), 579 | put(SP, 1, rem(peek(SP, 1), peek(SP, 0))), 580 | put(SP, 0, get_reg(SCRATCH_1)), 581 | jmp('next'), 582 | ]), 583 | ('1+', [ # ( n1|u1 -- n2|u2 ) 584 | op_on_tos(add, const_cell(1)), 585 | jmp('next'), 586 | ]), 587 | ('1-', [ # ( n1|u1 -- n2|u2 ) 588 | op_on_tos(add, const_cell(-1)), 589 | jmp('next'), 590 | ]), 591 | ('2*', [ # ( x1 -- x2 ) 592 | op_on_tos(ls, const_cell(1)), 593 | jmp('next'), 594 | ]), 595 | ('2/', [ # ( x1 -- x2 ) 596 | op_on_tos(a_rs, const_cell(1)), 597 | jmp('next'), 598 | ]), 599 | # Mixed math 600 | ('M*', [ # ( n1 n2 -- d ) 601 | bin_op_32_32_64(mul_32_32_64), 602 | jmp('next'), 603 | ]), 604 | ('UM*', [ # ( u1 u2 -- ud ) 605 | bin_op_32_32_64(umul_32_32_64), 606 | jmp('next'), 607 | ]), 608 | ('SM/REM', [ # ( d1 n1 -- n_rem n_quot ) 609 | set_reg(SCRATCH_1, div_64_32_32(peek_double(SP, 1), peek(SP, 0))), 610 | put(SP, 2, rem_64_32_32(peek_double(SP, 1), peek(SP, 0))), 611 | put(SP, 1, get_reg(SCRATCH_1)), 612 | drop(SP, 1), 613 | jmp('next'), 614 | ]), 615 | ('UM/MOD', [ # ( ud u1 -- u_rem u_quot ) 616 | set_reg(SCRATCH_1, udiv_64_32_32(peek_double(SP, 1), peek(SP, 0))), 617 | put(SP, 1, urem_64_32_32(peek_double(SP, 1), peek(SP, 0))), 618 | put(SP, 2, get_reg(SCRATCH_1)), 619 | drop(SP, 1), 620 | jmp('next'), 621 | ]), 622 | ('UD/MOD', [ # ( ud1 u1 -- ud_quot u_rem ) 623 | set_reg(SCRATCH_DOUBLE_1, udiv_64_32_64(peek_double(SP, 1), peek(SP, 0))), 624 | put(SP, 0, urem_64_32_32(peek_double(SP, 1), peek(SP, 0))), 625 | put_double(SP, 1, get_double_reg(SCRATCH_DOUBLE_1)), 626 | jmp('next'), 627 | ]), 628 | # Double-cell math 629 | ('DNEGATE', [ # ( d1 -- d2 ) 630 | put_double(SP, 0, mul_64(peek_double(SP, 0), const_double_cell(-1))), 631 | jmp('next'), 632 | ]), 633 | ('D+', [ # ( d1|ud1 d2|ud2 -- d3|ud3 ) 634 | put_double(SP, 2, add_64(peek_double(SP, 2), peek_double(SP, 0))), 635 | drop(SP, 2), 636 | jmp('next'), 637 | ]), 638 | ('D*', [ # ( d1|ud1 d2|ud2 -- d3|ud3 ) 639 | put_double(SP, 2, mul_64(peek_double(SP, 2), peek_double(SP, 0))), 640 | drop(SP, 2), 641 | jmp('next'), 642 | ]), 643 | ] 644 | -------------------------------------------------------------------------------- /kernel/forth/core.f: -------------------------------------------------------------------------------- 1 | 1 QUIET ! 2 | 3 | : IMMEDIATE 1 LATEST @ 1- C! ; 4 | 5 | : ( SOURCE >IN @ /STRING 41 SCAN DROP CHAR+ SOURCE DROP - >IN ! ; IMMEDIATE 6 | 7 | : CELLS ( n1 -- n2 ) 8 | 0 CELL+ * ; 9 | 10 | : NFA>CFA ( c-addr1 -- c-addr2 ) 11 | ( 127 AND to unsmudge the length in case the definition is hidden ) 12 | DUP C@ 127 AND + 1+ ALIGNED ; 13 | 14 | : DOES> ( R: ret -- ) 15 | R> LATEST @ NFA>CFA ! ; 16 | 17 | : CREATE ( "name" -- ) 18 | HEADER lit (dovar) @ , ; 19 | 20 | : VARIABLE ( "name" -- ) 21 | CREATE 0 CELL+ ALLOT ; 22 | 23 | : CONSTANT ( x "name" -- ) 24 | HEADER lit (doconst) @ , , ; 25 | 26 | : EMBED-STR ( "ccc" -- ) 27 | SOURCE >IN @ /STRING OVER >R 34 SCAN DROP 28 | R@ - 29 | DUP CHAR+ >IN +! 30 | DUP , 31 | R> HERE ROT DUP >R CMOVE 32 | R> ALIGNED ALLOT ; 33 | 34 | : GET-EMBEDDED-STR ( -- a-addr u ) 35 | R> DUP DUP @ + ALIGNED CELL+ >R ( skip the characters when executing ) 36 | DUP CELL+ SWAP @ ; 37 | 38 | : S" ( "ccc" -- ) 39 | lit GET-EMBEDDED-STR , EMBED-STR ; IMMEDIATE 40 | 41 | : ." ( "ccc" -- ) 42 | lit GET-EMBEDDED-STR , EMBED-STR lit WRITE , ; IMMEDIATE 43 | 44 | : IF ( compilation: C: -- orig, runtime: x -- ) 45 | lit ?branch , HERE 0 , ( placeholder, filled in by THEN/ELSE ) 46 | ; IMMEDIATE 47 | 48 | : PATCH-IF ( orig -- ) 49 | HERE OVER - SWAP ! 50 | ; 51 | 52 | : ELSE ( compilation: C: orig1 -- orig2, runtime: -- ) 53 | lit branch , HERE 0 , SWAP PATCH-IF 54 | ; IMMEDIATE 55 | 56 | : THEN ( compilation: C: orig --, runtime: -- ) 57 | PATCH-IF 58 | ; IMMEDIATE 59 | 60 | : ' ( "name" -- xt ) 61 | BL WORD FIND 0= IF ." word to compile not found: " COUNT WRITE ABORT THEN 62 | ; 63 | 64 | : ['] ( compilation: "name" --, runtime: -- xt ) 65 | lit lit , ' , ; IMMEDIATE 66 | 67 | : POSTPONE ( compilation: "name" -- ) 68 | BL WORD FIND DUP 69 | 0= IF ." word to postpone not found: " OVER COUNT WRITE ABORT THEN 70 | SWAP lit lit , , 71 | 1 = IF ['] EXECUTE , ELSE ['] , , THEN ; IMMEDIATE 72 | 73 | : DO ( compilation: C: -- loop-addr, runtime: n1|u1 n2|u2 -- R: -- loop-end-addr limit index ) 74 | ['] (do) , 0 , ( will be patched by LOOP/+LOOP ) 75 | HERE 76 | ; IMMEDIATE 77 | 78 | : PATCH-DO ( do-sys -- ) 79 | HERE SWAP 1 CELLS - ! ( patch the paren-do-paren introduced by DO ) 80 | ; 81 | 82 | : LOOP ( compilation: C: do-sys --, runtime: R: loop-sys1 -- | loop-sys2 ) 83 | ['] (loop) , DUP HERE - , 84 | PATCH-DO 85 | ; IMMEDIATE 86 | 87 | : +LOOP ( compilation: C: do-sys --, runtime: n -- R: loop-sys1 -- | loop-sys2 ) 88 | ['] (+loop) , DUP HERE - , 89 | PATCH-DO 90 | ; IMMEDIATE 91 | 92 | : BEGIN ( compilation: C: -- dest, runtime: -- ) 93 | HERE 94 | ; IMMEDIATE 95 | 96 | : UNTIL ( compilation: C: dest -- , runtime: x -- ) 97 | ['] ?branch , HERE - , 98 | ; IMMEDIATE 99 | 100 | : WHILE ( compilation: C: dest -- orig dest, runtime: x -- ) 101 | ['] ?branch , HERE SWAP 0 , ( placeholder, patched by REPEAT ) 102 | ; IMMEDIATE 103 | 104 | : REPEAT ( compilation: orig dest --, runtime: -- ) 105 | ['] branch , HERE - , 106 | HERE OVER - SWAP ! ( patch WHILE ?branch offset ) 107 | ; IMMEDIATE 108 | 109 | : AGAIN ( compilation: dest --, runtime: -- ) 110 | ['] branch , HERE - , ; IMMEDIATE 111 | 112 | : [ ( -- ) 113 | 0 STATE ! ; IMMEDIATE 114 | 115 | : ] ( -- ) 116 | 1 STATE ! ; 117 | 118 | : CHAR ( "name" -- char ) 119 | BL WORD 1+ C@ ; 120 | 121 | : [CHAR] ( compilation: "name" --, runtime: -- c ) 122 | CHAR ['] lit , , ; IMMEDIATE 123 | 124 | VARIABLE #SIZE 125 | 1024 CONSTANT #MAX-SIZE 126 | 127 | : #NEXT-FREE-SPACE ( -- c-addr ) 128 | HERE #MAX-SIZE + #SIZE @ - ; 129 | 130 | : <# ( -- ) 131 | 0 #SIZE ! ; 132 | 133 | : HOLD ( char -- ) 134 | #NEXT-FREE-SPACE C! 1 #SIZE +! ; 135 | 136 | : SIGN ( n -- ) 137 | 0 < IF [CHAR] - HOLD THEN ; 138 | 139 | : # ( ud1 -- ud2 ) 140 | BASE @ UD/MOD DUP 10 < IF 48 ELSE 65 THEN + HOLD ; 141 | 142 | : #S ( ud1 -- ud2 ) 143 | BEGIN # 2DUP 0= SWAP 0= AND UNTIL ; 144 | 145 | : #> ( xd -- c-addr u ) 146 | 2DROP #NEXT-FREE-SPACE 1+ #SIZE @ ; 147 | 148 | : */MOD ( n1 n2 n3 -- n4 n5 ) 149 | >R M* R> SM/REM ; 150 | 151 | : */ ( n1 n2 n3 -- n4 ) 152 | */MOD SWAP DROP ; 153 | 154 | : FM/MOD ( d1 n1 -- n2 n3 ) 155 | ( note: the sign is in the high cell ) 156 | 2DUP 0 < SWAP 0 < XOR IF DUP >R SM/REM 1- SWAP R> + SWAP ELSE SM/REM THEN ; 157 | 158 | : ABS ( n -- u ) 159 | DUP 0 < IF 0 SWAP - THEN ; 160 | 161 | : TYPE ( c-addr u -- ) 162 | WRITE ; 163 | 164 | : . ( n -- ) 165 | DUP ABS S>D <# BL HOLD #S ROT SIGN #> TYPE ; 166 | 167 | : U. ( u -- ) 168 | 0 <# BL HOLD #S #> TYPE ; 169 | 170 | : 2! ( x1 x2 a-addr -- ) 171 | SWAP OVER ! CELL+ ! ; 172 | 173 | : 2@ ( a-addr -- x1 x2 ) 174 | DUP CELL+ @ SWAP @ ; 175 | 176 | : >BODY ( xt -- a-addr ) 177 | CELL+ ; 178 | 179 | : (ABORT") ( i*x x1 c-addr u -- | i*x R: j*x -- | j*x ) 180 | ROT IF TYPE ABORT ELSE 2DROP THEN ; 181 | 182 | : ABORT" ( compilation: "ccc" --, runtime: i*x x1 -- | i*x R: j*x -- | j*x ) 183 | ['] GET-EMBEDDED-STR , EMBED-STR ['] (ABORT") , ; IMMEDIATE 184 | 185 | : ALIGN ( -- ) 186 | HERE ALIGNED HERE - ALLOT ; 187 | 188 | : CHARS ( n1 -- n2 ) ; 189 | 190 | : EMIT ( x -- ) 191 | PAD C! PAD 1 TYPE ; 192 | 193 | : CR ( -- ) 194 | 10 EMIT ; 195 | 196 | : S= ( c-addr1 u1 c-addr2 u2 -- flag ) 197 | ROT 2DUP = 198 | IF 199 | DROP 200 | 0 DO 2DUP I + C@ SWAP I + C@ = INVERT IF UNLOOP 2DROP 0 EXIT THEN LOOP 201 | 2DROP 0 1- 202 | ELSE 203 | 2DROP 2DROP 0 204 | THEN 205 | ; 206 | 207 | : TRUE ( -- true ) 208 | 0 1- ; 209 | 210 | : ENVIRONMENT? ( c-addr u -- false | i*x true ) 211 | 2DUP S" /COUNTED-STRING" S= IF 2DROP 127 TRUE EXIT THEN 212 | 2DUP S" /HOLD" S= IF 2DROP #MAX-SIZE TRUE EXIT THEN 213 | 2DUP S" /PAD" S= IF 2DROP 4096 TRUE EXIT THEN 214 | 2DUP S" ADDRESS-UNIT-BITS" S= IF 2DROP 8 TRUE EXIT THEN 215 | 2DUP S" CORE" S= IF 2DROP TRUE TRUE EXIT THEN 216 | 2DUP S" CORE-EXT" S= IF 2DROP 0 TRUE EXIT THEN 217 | 2DUP S" FLOORED" S= IF 2DROP 0 TRUE EXIT THEN 218 | 2DUP S" MAX-CHAR" S= IF 2DROP TRUE TRUE EXIT THEN 219 | 2DUP S" MAX-D" S= IF 2DROP 0 INVERT DUP 1 RSHIFT TRUE EXIT THEN 220 | 2DUP S" MAX-N" S= IF 2DROP 1 31 LSHIFT 1- TRUE EXIT THEN 221 | 2DUP S" MAX-U" S= IF 2DROP 0 INVERT TRUE EXIT THEN 222 | 2DUP S" MAX-UD" S= IF 2DROP 0 INVERT DUP TRUE EXIT THEN 223 | 2DUP S" RETURN-STACK-CELLS" S= IF 2DROP 1024 TRUE EXIT THEN 224 | 2DUP S" STACK-CELLS" S= IF 2DROP 1024 TRUE EXIT THEN 225 | 2DROP 0 226 | ; 227 | 228 | : EVALUATE ( i*x c-addr u -- j*x ) 229 | SOURCE-ID @ >R 230 | IN-BUF @ >R 231 | IN-BUF-EOL @ >R 232 | IN-BUF-SIZE @ >R 233 | >IN @ >R 234 | 235 | -1 SOURCE-ID ! 236 | 0 >IN ! 237 | IN-BUF-EOL ! 238 | IN-BUF ! 239 | 240 | INTERPRET 241 | 242 | R> >IN ! 243 | R> IN-BUF-SIZE ! 244 | R> IN-BUF-EOL ! 245 | R> IN-BUF ! 246 | R> SOURCE-ID ! ; 247 | 248 | : KEY ( -- char ) 249 | >IN @ IN-BUF-EOL @ > IF LINE 2DROP 0 >IN ! THEN 250 | IN-BUF @ >IN @ + C@ 1 >IN +! ; 251 | 252 | : LITERAL ( compilation: x --, runtime: -- x ) 253 | ['] lit , , ; IMMEDIATE 254 | 255 | : MAX ( n1 n2 -- n3 ) 256 | 2DUP < IF SWAP THEN DROP ; 257 | 258 | : MIN ( n1 n2 -- n3 ) 259 | 2DUP > IF SWAP THEN DROP ; 260 | 261 | : MOD ( n1 n2 -- n3 ) 262 | /MOD DROP ; 263 | 264 | : MOVE ( addr1 addr2 u -- ) 265 | >R 2DUP < IF R> CMOVE> ELSE R> CMOVE THEN ; 266 | 267 | : RECURSE ( compilation: -- ) 268 | LATEST @ NFA>CFA , ; IMMEDIATE 269 | 270 | : SPACE ( -- ) 271 | BL EMIT ; 272 | 273 | : SPACES ( n -- ) 274 | 0 SWAP DO SPACE LOOP ; 275 | 276 | : >= ( n1 n2 -- flag ) 277 | < INVERT ; 278 | 279 | : ACCEPT ( c-addr +n1 -- +n2 ) 280 | >IN @ IN-BUF-EOL @ >= IF LINE 2DROP 0 >IN ! THEN 281 | IN-BUF-EOL @ >IN @ - MIN >R ( c-addr R: n2 ) 282 | IN-BUF @ >IN @ + SWAP R@ MOVE 283 | R@ >IN +! 284 | R> ; 285 | 286 | : ?DUP ( x -- 0 | x x ) 287 | DUP 0= IF DUP THEN ; 288 | 289 | : FILL ( c-addr u c -- ) 290 | ROT ROT 0 DO 2DUP I + C! LOOP 2DROP ; 291 | 292 | ( core extension words ) 293 | 294 | ( NOTE: #TIB, .(, .R, :NONAME, ?DO, C" not implemented ) 295 | 296 | : 0<> ( x -- flag ) 297 | 0= INVERT ; 298 | 299 | : 0> ( x -- flag ) 300 | 0 > ; 301 | 302 | : 2>R ( x1 x2 -- R: -- x1 x2 ) 303 | R> ROT >R SWAP >R >R ; 304 | 305 | : 2R> ( -- x1 x2 R: x1 x2 -- ) 306 | R> R> R> SWAP ROT >R ; 307 | 308 | : 2R@ ( -- x1 x2 R: x1 x2 -- x1 x2 ) 309 | R> R> R> 2DUP >R >R ROT >R SWAP ; 310 | 311 | : <> ( x1 x2 - flag ) 312 | = INVERT ; 313 | 314 | ( non-standard utilities ) 315 | 316 | : SP0 ( -- addr ) 10 1024 * CELL+ task-base + ; 317 | : sl ( -- n ) SP@ CELL+ SP0 SWAP - 0 CELL+ /MOD SWAP DROP ; 318 | : .NOSPACE ( n -- ) DUP ABS S>D <# #S ROT SIGN #> TYPE ; 319 | : .sl ( -- ) S" <" TYPE sl .NOSPACE S" > " TYPE ; 320 | : PEEK ( u -- x ) 1+ CELLS SP0 SWAP - @ ; 321 | : .sitem ( u -- ) PEEK . ; 322 | : .s ( -- ) .sl sl 0 > IF sl 0 DO I .sitem LOOP THEN ; 323 | 324 | ( setup cooperative multi tasking ) 325 | 326 | 11 1024 * CONSTANT task-size 327 | 5 1024 * CELL+ CONSTANT task-rs-offset 328 | 3 CELLS CONSTANT task-ip-initial-offset 329 | 0 CONSTANT ip-mem-offset 330 | 331 | VARIABLE task-free-block 0 task-free-block ! 332 | 333 | : find-free-block ( -- addr flag ) 334 | task-free-block @ DUP 0= IF 0 EXIT THEN 335 | DUP @ task-free-block ! 1 ; 336 | : create-block ( -- addr ) HERE task-size ALLOT ; 337 | : alloc-block ( -- addr ) find-free-block 0= IF DROP create-block THEN ; 338 | : release-block ( addr -- ) task-free-block @ OVER ! task-free-block ! ; 339 | 340 | : end-task ( -- ) task-base release-block BYE ; 341 | : new-task ( xt -- ) 342 | alloc-block task-base! 343 | >R RESET-SP R> 344 | task-base task-rs-offset + RP! 345 | EXECUTE end-task ; 346 | : start-task ( -- ) task-param new-task ; 347 | 348 | : ready ( -- ) ." Ready" CR 0 QUIET ! RESET-SP 0 (QUIT) ; 349 | : setup-tasks ( -- ) 350 | ( must be within word definition, or an async FFI call from the interpreter will mess it up ) 351 | task-base task-ip-initial-offset + task-base ip-mem-offset + ! 352 | ( start-task is the new main task ) 353 | ['] start-task task-base task-ip-initial-offset + ! 354 | ( run interpreter in new task ) 355 | ['] ready new-task ; 356 | 357 | : (abort-task") ( c-str u -- ) TYPE end-task ; 358 | : abort-task" ( compilation: "quote" --, runtime: -- ) 359 | ['] GET-EMBEDDED-STR , EMBED-STR ['] (abort-task") , ; IMMEDIATE 360 | 361 | setup-tasks ( must be last, since it calls ABORT which empties the I/O buffers ) 362 | -------------------------------------------------------------------------------- /kernel/forth/vdom.f: -------------------------------------------------------------------------------- 1 | 1 QUIET ! 2 | 3 | ( utils ) 4 | 5 | : MB 1024 * 1024 * ; 6 | 7 | : 2exec ( x w1 w2 -- x1 x2 ) 2>R DUP R> EXECUTE SWAP R> EXECUTE SWAP ; 8 | : 2exec1 ( x1 x2 w -- x3 x4 ) DUP >R EXECUTE SWAP R> EXECUTE SWAP ; 9 | : exec-under ( x1 x2 w -- x3 x2 ) SWAP >R EXECUTE R> ; 10 | 11 | : compile-push-word ( "name" -- ) lit lit , ' , ; 12 | : /top compile-push-word ['] exec-under , ; IMMEDIATE 13 | : 2& compile-push-word ['] 2exec1 , ; IMMEDIATE 14 | : pop-here ( -- x ) HERE -1 CELLS + @ -1 CELLS 'HERE +! ; 15 | : & pop-here lit lit , , compile-push-word ['] 2exec , ; IMMEDIATE 16 | 17 | : emit" 34 EMIT ; 18 | 19 | : buffer ( "name" size -- ) CELLS CREATE DUP HERE + 2 CELLS + , HERE CELL+ , ALLOT DOES> 2 CELLS + ; 20 | : buf-next ( buf -- addr ) -1 CELLS + ; 21 | : buf-cell-rel ( n buf -- addr ) buf-next @ SWAP CELLS + @ ; 22 | : buf-end ( buf -- u ) -2 CELLS + @ ; 23 | : buf-reset ( buf -- ) DUP buf-next ! ; 24 | : buf-assert-space ( n-bytes buf -- ) buf-end & buf-next @ ROT + < IF abort-task" buffer out of space" THEN ; 25 | : ,buf ( x buf -- ) 1 CELLS OVER buf-assert-space TUCK buf-next @ ! buf-next 1 CELLS SWAP +! ; 26 | : buf-empty? ( buf -- flag ) DUP buf-next @ = ; 27 | : .buffer ( buf -- ) 28 | DUP buf-empty? IF DROP ." empty" EXIT THEN 29 | DUP buf-next @ SWAP DO I @ . 1 CELLS +LOOP ; 30 | 31 | : -ROT ( x1 x2 x3 -- x3 x1 x2 ) ROT ROT ; 32 | : 2@ ( addr1 addr2 -- x1 x2 ) @ SWAP @ SWAP ; 33 | : idiv /MOD SWAP DROP ; 34 | : swap-vars ( a1 a2 -- ) 2DUP 2@ >R SWAP ! R> SWAP ! ; 35 | 36 | : word-cstr ( "name" --, E: -- c-addr ) CREATE LATEST @ , DOES> @ ; 37 | 38 | : last-char ( addr u -- c ) + 1- C@ ; 39 | : trim ( addr u -- addr1 u1 ) BL SKIP BEGIN 2DUP last-char BL = OVER 0 > AND WHILE 1- REPEAT ; 40 | 41 | ( merge sort ) 42 | 43 | VARIABLE sort-cell-size 44 | 45 | : sort-cells ( n1 -- n2 ) sort-cell-size @ * ; 46 | : sort-cell+ ( n1 -- n2 ) sort-cell-size @ + ; 47 | : sort-cell-cp ( addr1 addr2 -- ) sort-cell-size @ CMOVE ; 48 | : sort-cell-aligned ( u1 -- u2 ) 49 | sort-cell-size @ /MOD SWAP 0 > IF 1+ THEN sort-cell-size @ * ; 50 | 51 | 1 31 LSHIFT 1- CONSTANT max-int 52 | : /2-aligned 1 RSHIFT sort-cell-aligned ; 53 | 54 | : cp ( to end start -- to-end ) 55 | DO I @ OVER ! CELL+ 1 CELLS +LOOP max-int OVER ! 1 CELLS sort-cell-aligned + ; 56 | : prepare ( end mid mid start -- buf-mid buf-start ) 57 | HERE -ROT cp DUP >R -ROT cp DROP R> HERE ; 58 | : split ( end start -- end mid mid start ) 59 | 2DUP SWAP OVER - /2-aligned + DUP ROT ; 60 | : merge ( end start -- ) 61 | 2DUP split prepare 62 | 2SWAP DO 2DUP 2@ < IF SWAP THEN DUP I sort-cell-cp sort-cell+ sort-cell-size @ +LOOP 2DROP ; 63 | : merge-sort ( end start -- ) 64 | 2DUP - 2 sort-cells < IF 2DROP EXIT THEN 65 | 2DUP split RECURSE RECURSE merge ; 66 | : sort ( addr n -- ) sort-cells OVER + SWAP merge-sort ; 67 | 68 | ( DOM VM ) 69 | 70 | word-cstr text-node-type 71 | word-cstr text-attr-type 72 | 73 | 1 MB buffer ops 74 | 75 | : push-op ( arg op -- ) ops ,buf ops ,buf ; 76 | : prev-op ( -- op ) ops buf-empty? IF 0 ELSE -2 ops buf-cell-rel @ THEN ; 77 | : rm-attr ( type -- ) 1 push-op ; 78 | : set-attr ( addr -- ) DUP @ text-attr-type = IF 10 push-op ELSE 2 push-op THEN ; 79 | : mk-node ( type -- ) DUP text-node-type = IF 9 push-op ELSE 3 push-op THEN ; ( note: this won't advance the position ) 80 | : skip-node ( -- ) prev-op 4 = IF 1 -1 ops buf-cell-rel +! ELSE 1 4 push-op THEN ; 81 | : rm-node ( -- ) 0 5 push-op ; 82 | : enter-node ( -- ) 0 6 push-op ; 83 | : leave-node ( -- ) prev-op 6 = IF -2 CELLS ops buf-next +! ELSE 0 7 push-op THEN ; 84 | : stop ( -- ) 0 8 push-op ; 85 | 86 | ( node & attr structures ) 87 | 88 | ( buffers for use by client code, to keep any non-static strings/event handlers/etc referenced by the vdom ) 89 | 1 MB buffer render-buf-1 90 | 1 MB buffer render-buf-2 91 | VARIABLE render-buf-n render-buf-1 render-buf-n ! 92 | VARIABLE render-buf-c render-buf-2 render-buf-c ! 93 | 94 | : render-buf ( -- buf ) render-buf-n @ ; 95 | : ,rbuf ( x -- ) render-buf ,buf ; 96 | : to-rbuf ( addr1 u -- addr2 u ) 97 | DUP render-buf buf-assert-space 98 | render-buf buf-next @ >R TUCK R@ SWAP CMOVE DUP render-buf buf-next +! R> SWAP ; 99 | 100 | 1 MB buffer dom-buf-1 101 | 1 MB buffer dom-buf-2 102 | VARIABLE dom-n dom-buf-1 dom-n ! 103 | VARIABLE dom-c dom-buf-2 dom-c ! 104 | 105 | : reset-ndom-bufs ( -- ) dom-n @ buf-reset render-buf buf-reset ; 106 | : swap-diff-buffers ( -- ) 107 | dom-n dom-c swap-vars 108 | render-buf-n render-buf-c swap-vars ; 109 | : ndom-here ( -- addr ) dom-n @ buf-next ; 110 | : cdom-here ( -- addr ) dom-c @ buf-next ; 111 | : ,ndom ( n -- ) dom-n @ ,buf ; 112 | 113 | 3 CELLS CONSTANT attr-size 114 | : attr-end-sentinel ( -- ) max-int ,ndom 0 ,ndom 0 ,ndom ; 115 | 116 | 3 CELLS CONSTANT node-header-size 117 | : node-start ( type -- node ) ndom-here @ SWAP ,ndom attr-size ,ndom 0 ,ndom attr-end-sentinel ; 118 | 119 | : empty-node ( -- node ) 0 node-start ; 120 | 121 | : node-type ( node -- x ) @ ; 122 | : node-attr-size-cell ( node -- addr ) 1 CELLS + ; 123 | : node-attr-size ( node -- n ) node-attr-size-cell @ ; 124 | : node-children-size-cell ( node -- addr ) 2 CELLS + ; 125 | : node-children-size ( node -- n ) node-children-size-cell @ ; 126 | 127 | : cur-node-size ( node -- node n ) ndom-here @ OVER - ; 128 | : node-end ( node -- ) 129 | empty-node DROP 130 | cur-node-size node-header-size - OVER node-attr-size - SWAP node-children-size-cell ! ; 131 | 132 | : first-child ( node-addr -- addr ) DUP node-attr-size + node-header-size + ; 133 | : next-child ( node-addr -- addr2 ) 134 | DUP DUP node-attr-size SWAP node-children-size node-header-size + + + ; 135 | : node-n-attrs ( node-addr -- n ) node-attr-size attr-size idiv 1- ; ( don't count sentinel ) 136 | : attr-start ( node-addr -- attr-addr ) node-header-size + ; 137 | : attr-len-cell ( addr1 -- addr2 ) CELL+ ; 138 | : attr-str-cell ( addr1 -- addr2 ) 2 CELLS + ; 139 | : attr-type ( addr1 -- x ) @ ; 140 | : attr-len ( addr1 -- x ) attr-len-cell @ ; 141 | : attr-str ( addr1 -- x ) attr-str-cell @ ; 142 | : inc-attr-size ( node -- node ) attr-size OVER node-attr-size-cell +! ; 143 | : !attr ( node attr-type value-addr value-len -- node ) 144 | attr-size NEGATE ndom-here +! ( remove previous sentinel ) 145 | ROT ,ndom ,ndom ,ndom attr-end-sentinel inc-attr-size ; 146 | 147 | : text ( addr n -- ) 148 | text-node-type node-start text-attr-type 2SWAP !attr node-end ; 149 | 150 | : reset-ndom ( -- ) reset-ndom-bufs empty-node DROP reset-ndom-bufs ; 151 | 152 | ( diffing ) 153 | 154 | : sort-attrs ( node-addr -- ) 155 | attr-size sort-cell-size ! 156 | attr-start & node-n-attrs sort ; ( don't sort sentinel ) 157 | : rem-cur-attr ( cur-attr1 next-attr1 -- cur-attr1 next-attr1 ) OVER rm-attr ; 158 | : add-next-attr ( cur-attr1 next-attr1 -- cur-attr1 next-attr1 ) DUP set-attr ; 159 | : attrs-more? ( addr -- flag ) @ max-int <> ; 160 | : is-attr-xt? ( addr -- flag ) attr-len max-int = ; 161 | : attr-value-diff ( cur-attr1 next-attr1 -- cur-attr1 next-attr1 ) 162 | 2DUP 2DUP 2& attr-len = -ROT 2& attr-str = AND IF EXIT THEN 163 | add-next-attr ; 164 | : inc-attr ( addr1 -- addr2 ) DUP attrs-more? IF attr-size + THEN ; 165 | : attr-diff-1 ( cur-attr1 next-attr1 -- cur-attr2 next-attr2 ) 166 | 2DUP 2& attr-type = IF attr-value-diff 2& inc-attr ELSE 167 | 2DUP 2& attr-type < IF rem-cur-attr /top inc-attr ELSE ( note: sentinel is max-int ) 168 | add-next-attr inc-attr 169 | THEN THEN ; 170 | : attr-diff ( cur-node next-node -- ) 171 | 2DUP sort-attrs sort-attrs 172 | 2& attr-start BEGIN 2DUP 2& attrs-more? OR WHILE attr-diff-1 REPEAT 2DROP ; 173 | 174 | : first-children ( cur-node next-node -- cur-node1 next-node1 ) 2& first-child ; 175 | : next-children ( cur-node next-node -- cur-node1 next-node1 ) 2& next-child ; 176 | : next-child-next next-child ; 177 | : next-child-cur /top next-child ; 178 | 179 | : is-child? ( parent-node node -- flag ) SWAP next-child < ; 180 | : end-node? ( node -- flag ) @ 0= ; 181 | : create-attrs ( node -- ) 182 | attr-start BEGIN DUP attrs-more? WHILE DUP set-attr attr-size + REPEAT DROP ; 183 | : create-tree ( node -- ) 184 | DUP node-type mk-node 185 | DUP create-attrs 186 | first-child enter-node BEGIN DUP end-node? INVERT WHILE DUP RECURSE next-child REPEAT leave-node skip-node 187 | DROP ; 188 | : node-diff ( cur-node1 next-node1 -- cur-node2 next-node2 ) 189 | 2DUP 2& end-node? AND IF leave-node skip-node next-children ELSE 190 | 2DUP 2& node-type = IF 2DUP attr-diff enter-node first-children ELSE 191 | DUP end-node? IF rm-node next-child-cur ELSE 192 | DUP create-tree next-child-next THEN THEN THEN ; 193 | : more-nodes? ( cur-node next-node -- flag ) 194 | ndom-here @ < SWAP cdom-here @ < OR ; 195 | : nodes-diff ( cur-node next-node -- ) 196 | BEGIN 2DUP more-nodes? WHILE node-diff REPEAT 2DROP ; 197 | : diff ( -- ) 198 | ops buf-reset dom-c @ dom-n @ nodes-diff stop swap-diff-buffers ; 199 | 200 | : render ( xt -- ) 201 | reset-ndom EXECUTE diff ops 0 PATCH-BODY ; 202 | 203 | : def-tag CREATE LATEST @ , DOES> @ node-start ; 204 | : closed-by CREATE DOES> DROP node-end ; 205 | 206 | : def-attr CREATE LATEST @ , DOES> @ -ROT !attr ; 207 | 208 | : def-event CREATE LATEST @ , DOES> @ SWAP -1 !attr ; 209 | 210 | : (bind) ( data xt1 -- xt2 ) 211 | render-buf buf-next @ >R SWAP 212 | lit (docol) @ ,rbuf lit lit ,rbuf ,rbuf ,rbuf lit EXIT ,rbuf R> ; 213 | : bind ( "name" -- ) compile-push-word ['] (bind) , ; IMMEDIATE 214 | 215 | : empty-attr ( -- c-addr u ) S" " ; 216 | : fmt-int ( n -- addr u ) S>D <# #S #> to-rbuf ; 217 | 218 | VARIABLE render-xt 219 | : repaint ( -- ) render-xt @ render ; 220 | : repaint-with ( "name" -- ) ' render-xt ! ; 221 | 222 | ( define a few common tags/attrs/events ) 223 | 224 | def-tag
    closed-by
    225 | def-tag
    closed-by
    226 | def-tag 227 | def-tag
      closed-by
    228 | def-tag
  • closed-by
    • 229 | def-tag closed-by 230 | def-tag closed-by 231 | def-tag

    closed-by

    232 | def-tag
    closed-by
    233 | def-tag 234 | def-tag closed-by 235 | def-tag
    closed-by
    236 | def-tag

    closed-by

    237 | def-tag closed-by 238 | 239 | def-attr =class 240 | def-attr =id 241 | def-attr =for 242 | def-attr =placeholder 243 | def-attr =type 244 | def-attr =checked 245 | def-attr =value 246 | def-attr =href 247 | 248 | ( virtual attrs ) 249 | def-attr =input-value 250 | def-attr =focus 251 | 252 | def-event =onclick 253 | def-event =oninput 254 | def-event =onchange 255 | def-event =onkeydown 256 | def-event =onmouseenter 257 | def-event =onmouseleave 258 | def-event =ondblclick 259 | def-event =onblur 260 | def-event =onfocus 261 | 262 | 0 QUIET ! 263 | -------------------------------------------------------------------------------- /kernel/forth_interpreter.py: -------------------------------------------------------------------------------- 1 | """ 2 | Forth interepter, defined in Forth within Python. 3 | """ 4 | 5 | from asm_ops import * 6 | from memory_layout import * 7 | 8 | 9 | def forth_def(label, *code, immediate=False): 10 | """ 11 | Splits each code string into forth byte-string words, and returns a flat list of words. 12 | Also allows to define labels using '~