├── .gitignore ├── .gitmodules ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── doc ├── building.md ├── elf.txt ├── glossary.md ├── internals.md ├── invoke.md ├── libs.md ├── manual.md └── programming.md ├── src ├── compile └── compiler.fth ├── target ├── 6502 │ ├── asm.fth │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── x1.fth │ └── x2.fth ├── 8051 │ ├── asm.fth │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── test.ucsim │ ├── x1.fth │ └── x2.fth ├── avr │ ├── asm.fth │ ├── avrdude.conf │ ├── gdbinit │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── uart.fth │ ├── x1.fth │ └── x2.fth ├── msp430 │ ├── asm.fth │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── x1.fth │ └── x2.fth ├── pdp8 │ ├── asm.fth │ ├── convert.sh │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── x1.fth │ └── x2.fth ├── pic │ ├── asm.fth │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── test.stc │ ├── upload.mdb │ ├── x1.fth │ └── x2.fth ├── stm8 │ ├── asm.fth │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── test.ucsim │ ├── x1.fth │ └── x2.fth └── thumb │ ├── asm.fth │ ├── gdbinit │ ├── nucleus.fth │ ├── params.fth │ ├── target.mk │ ├── x1.fth │ └── x2.fth └── test ├── blink-atmega328.fth ├── blink-curiosity.fth ├── blink-launchpad.fth ├── blink-nucleo32.fth ├── blink-stm8.fth ├── deps.sh ├── test-6502-asm.fth ├── test-8051-asm.fth ├── test-avr-asm.fth ├── test-kernel.fth ├── test-msp430-asm.fth ├── test-pdp8-asm.fth ├── test-pic-asm.fth ├── test-stm8-asm.fth ├── test-thumb-asm.fth └── trinket.fth /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | /target/*.fth 3 | /conf.mk 4 | /test-* 5 | /image 6 | /image.* 7 | /*-stamp 8 | /.gdbinit 9 | /app.fth 10 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "lbForth"] 2 | path = lbForth 3 | url = https://github.com/larsbrinkhoff/lbForth 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: trusty 2 | language: c 3 | sudo: required 4 | env: 5 | - TARGET=6502 6 | - TARGET=8051 7 | - TARGET=avr 8 | - TARGET=msp430 9 | - TARGET=pdp8 10 | - TARGET=pic 11 | - TARGET=stm8 12 | - TARGET=thumb 13 | cache: 14 | directories: 15 | - $HOME/bin 16 | - $HOME/share 17 | install: sh -e test/deps.sh 18 | script: make TARGET=$TARGET 19 | notifications: 20 | email: lars@nocrew.org 21 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | -include conf.mk 2 | 3 | T = target/params.fth target/asm.fth target/x1.fth target/x2.fth \ 4 | target/nucleus.fth 5 | STAMP = $(TARGET)-stamp 6 | TDIR = target/$(TARGET) 7 | 8 | all: check 9 | 10 | $(STAMP): $(wildcard conf.mk) 11 | rm -f *-stamp 12 | touch $@ 13 | 14 | check: test-$(TARGET)-asm test-image 15 | 16 | image: test/test-kernel.fth src/compile src/compiler.fth $(T) 17 | ./src/compile $< image 18 | 19 | image.hex: image 20 | objcopy -I binary -O ihex --change-section-address .data=$(START) $< $@ 21 | 22 | target/%.fth: $(TDIR)/%.fth $(STAMP) 23 | cp $< $@ 24 | 25 | test-%-asm: test/test-%-asm.fth target/%/asm.fth 26 | echo include $< | forth > $@ 27 | grep "Assembler test: PASS" $@ 28 | 29 | .gdbinit: $(TDIR)/gdbinit 30 | cp $< $@ 31 | 32 | clean: 33 | rm -f test-* image target/*.fth *-stamp 34 | 35 | include $(TDIR)/target.mk 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lbForth Lite 2 | 3 | This is a Forth cross compiler for tiny devices. It's based on 4 | [lbForth](http://github.com/larsbrinkhoff/lbForth). Supported targets 5 | are 8051, AVR, Cortex-M, MSP430, PIC, and STM8. There's also support 6 | for some classic machines: 6502 and PDP-8. 7 | 8 | This is a temporary battleground to get things up and running. I 9 | expect to fold the finished result back into lbForth. 10 | 11 | The targets are tested using these simulators: naken_asm, uCsim, 12 | simulavr, gpsim, simh, and thumbulator. The status of the tests is: 13 | [![Test](https://travis-ci.org/larsbrinkhoff/xForth.svg?branch=master)](https://travis-ci.org/larsbrinkhoff/xForth) 14 | 15 | The compiler is suitable for parts with 1K program memory and 64 bytes 16 | RAM. The kernel code occupies 100-500 bytes, and it's recommended to 17 | reserve about 24 bytes for the stacks. At this size, only a bare 18 | minimum of Forth words are supported. All targets come with a prefix 19 | assembler with its own unique syntax. 20 | 21 | There is no resident interpreter or compiler in the target. Things 22 | are set up to provide target interaction through tethered operation, 23 | but it's not implemented yet. For now, the output is a flat binary 24 | file. ELF or Intel hex format can be made available on request. 25 | 26 | The assemblers, compiler, and kernel are written in Forth and are all 27 | very simple. The user is encouraged to make modifications as see fit. 28 | 29 | ### Manual 30 | 31 | [See here](doc/manual.md). 32 | 33 | ### Glossary 34 | 35 | Compile-time words: 36 | 37 | : ; [ ] CONSTANT VARIABLE CODE END-CODE 38 | ['] [CHAR] LITERAL 39 | IF THEN ELSE AHEAD BEGIN AGAIN UNTIL WHILE REPEAT 40 | 41 | Run-time words: 42 | 43 | COLD WARM 44 | ! C! @ C@ +! 45 | DROP NIP DUP ?DUP SWAP OVER 46 | >R R> R@ 47 | + - 2* 2/ INVERT NEGATE AND OR XOR 1+ 1- CELL+ 48 | 0= 0< 0<> = <> 49 | -------------------------------------------------------------------------------- /doc/building.md: -------------------------------------------------------------------------------- 1 | ### Building xForth. 2 | 3 | - Checkout git repository. 4 | - Type `git submodule update --init --recursive` 5 | - Install dependencies as per `test/deps.sh`. (The simulators are just 6 | needed for testing.) 7 | - In particular, build and install lbForth somewhere accessible through 8 | $PATH. 9 | - Type `make TARGET=x`. `x` is one of the supported targets. 10 | -------------------------------------------------------------------------------- /doc/elf.txt: -------------------------------------------------------------------------------- 1 | Convert binar file to ELF: 2 | 3 | avr-objcopy --rename-section .data=.text,CONTENTS,ALLOC,LOAD,CODE -I binary image -O elf32-avr image.elf 4 | avr-ld image.elf -o image.exe 5 | 6 | Optionally: 7 | 8 | avr-strip -s image.exe 9 | -------------------------------------------------------------------------------- /doc/glossary.md: -------------------------------------------------------------------------------- 1 | # Glossary 2 | 3 | ### Compile-time words 4 | 5 | `:` ( "name" -- ) 6 | Start a new colon definition. 7 | 8 | `;` ( -- ) 9 | End a colon definition. 10 | 11 | `[` ( -- ) 12 | Enter interpretation state. 13 | 14 | `]` ( -- ) 15 | Enter compilation state. 16 | 17 | `CONSTANT` ( n "name" -- ) 18 | Define a constant. 19 | 20 | `VARIABLE` ( "name" -- ) 21 | Define a global variable. 22 | 23 | `CODE` ( "name" -- ) 24 | Start a new assembler definition. 25 | 26 | `END-CODE` ( -- ) 27 | End an assembler definition. 28 | 29 | `[']` ( "name" -- ) 30 | Compile the xt of a word. 31 | 32 | `[CHAR]` ( "c" -- ) 33 | Compile a character. 34 | 35 | `LITERAL` ( n -- ) 36 | Compile a literal. 37 | 38 | `IF` ( n -- ) 39 | ... 40 | 41 | `THEN` ( -- ) 42 | 43 | `ELSE` ( -- ) 44 | 45 | `AHEAD` ( -- ) 46 | 47 | `BEGIN` ( -- ) 48 | 49 | `AGAIN` ( -- ) 50 | 51 | `UNTIL` ( n -- ) 52 | 53 | `WHILE` ( n -- ) 54 | 55 | `REPEAT` ( -- ) 56 | 57 | ### Run-time words 58 | 59 | `COLD` ( -- ) 60 | The very first definition to be executed. 61 | 62 | `WARM` ( -- ) 63 | The first colon definition to be executed. 64 | 65 | `!` ( n a -- ) 66 | Store the word `n` at address `a`. 67 | 68 | `C!` ( c a -- ) 69 | Store the character `c` at address `a`. 70 | 71 | `@` ( a -- n ) 72 | Fetch the word `n` from address `a`. 73 | 74 | `C@` ( a -- c ) 75 | Fetch the character `c` from address `a`. 76 | 77 | `+!` ( n a -- ) 78 | Add `n` to the word at address `a`. 79 | 80 | `DROP` ( x -- ) 81 | Discard the top of the data stack. 82 | 83 | `NIP` ( x1 x2 -- x2 ) 84 | Discard the item under the top of the data stack. 85 | 86 | `DUP` ( x -- x x ) 87 | Duplicate the top of the data stack. 88 | 89 | `?DUP` ( x -- x|x x ) 90 | Duplicate the top of the data stack if it's not zero. 91 | 92 | `SWAP` ( x1 x2 -- x2 x1 ) 93 | Swap the top two items of the data stack. 94 | 95 | `OVER` ( x1 x2 -- x1 x2 x1 ) 96 | Duplicate the item under the top of the data stack. 97 | 98 | `>R` ( x -- ) ( R: -- x ) 99 | Move an item from the data stack to the return stack. 100 | 101 | `R>` ( -- x ) ( R: x -- ) 102 | Move an item from the return stack to the data stack. 103 | 104 | `R@` ( -- x ) ( R: x -- ) 105 | Copy the top of the return stack to the data stack. 106 | 107 | `+` ( n1 n2 -- n3 ) 108 | Add the top top items of the data stack. 109 | 110 | `-` ( n1 n2 -- n3 ) 111 | Subtract the top of the data stack from the next item. 112 | 113 | `2*` ( n1 -- n2 ) 114 | Double the top of the data stack. 115 | 116 | `2/` ( n1 -- n2 ) 117 | Divide the top of the data stack by two. 118 | 119 | `INVERT` ( n1 -- n2 ) 120 | Logical invertion of the top of the data stack. 121 | 122 | `NEGATE` ( n1 -- n2 ) 123 | Negate the top of the data stack. 124 | 125 | `AND` ( n1 n2 -- n3 ) 126 | Logical conjunction of the two top items of the data stack. 127 | 128 | `OR` ( n1 n2 -- n3 ) 129 | Logical disjunction of the two top items of the data stack. 130 | 131 | `XOR` ( n1 n2 -- n3 ) 132 | Exclusive disjunction of the two top items of the data stack. 133 | 134 | `1+` ( n1 -- n2 ) 135 | Add one to the top of the data stack. 136 | 137 | `1-` ( n1 -- n2 ) 138 | Subtract one from the top of the data stack. 139 | 140 | `CELL+` ( n1 -- n2 ) 141 | Add the size of a cell to the top of the data stack. 142 | 143 | `0=` ( n -- f ) 144 | Leave true flag if `n` is zero, false otherwise. 145 | 146 | `0<` ( n -- f ) 147 | Leave true flag if `n` is negative, false otherwise. 148 | 149 | `0<>` ( n -- f ) 150 | Leave true flag if `n` is nonzero, false otherwise. 151 | 152 | `=` ( n1 n2 -- f ) 153 | Leave true flag if `n1` and `n2` are equal, false otherwise. 154 | 155 | `<>` ( n1 n2 -- f ) 156 | Leave true flag if `n1` and `n2` are idfferent, false otherwise. 157 | -------------------------------------------------------------------------------- /doc/internals.md: -------------------------------------------------------------------------------- 1 | # Compiler internals 2 | 3 | The compiler generates headerless STC code for all targets. Code and 4 | data are always put in separate memory areas. 5 | 6 | The cell size is 12 bits for PDP-8, 16 bits for the 8 and 16 bit 7 | parts, and 32 bits for Thumb parts. 8 | 9 | ### Register usage 10 | 11 | | | TOS | SP | RP | Temporary 12 | | --- | --- | --- | --- | --- 13 | | 6502 | | X | SP | A, Y 14 | | 8051 | DPTR | R0 | SP | R1-R4 15 | | AVR | X | Y | SP | R2-R3, Z 16 | | MSP430 | R5 | R4 | R1 | R6 17 | | PDP-8 | AC | 10 | 11 | 5-7 18 | | PIC | 22-23 | 20 | | 24-25, W 19 | | STM8 | | X | SP | A, Y 20 | | Thumb | R6 | R7 | SP | R5, LR 21 | 22 | ### Memory map 23 | 24 | All numbers are in hexadecimal, except for the PDP-8 which use octal. 25 | 26 | | | Program | Data | Data Stack | Return Stack | Temporary 27 | | --- | --- | --- | --- | --- | --- 28 | | 6502 | 1000-FFFF | 0- | E0-FF | 100-1FF | 42-43 29 | | 8051 | 0- | 100- | -FF | 10- | 30 | | AVR | 0- | 60-7F | 80-8B | 8C-9E | 31 | | MSP430 | F800-FFFF | 200-25F | 270-27F | 260-26F | 32 | | PDP-8 | 0- | 4000-5777 | 6400-6777 | 6000-6377 | 33 | | PIC | 0- | 28-2F | 40-4F | | 30-3F 34 | | STM8 | 8000- | 0-1FF | 200-2FF | 300-3FF | 35 | | Thumb | 0- | 20000000- | -200006FF | -200007FF | 36 | -------------------------------------------------------------------------------- /doc/invoke.md: -------------------------------------------------------------------------------- 1 | ### Invoking xForth. 2 | 3 | The src/compile script provides a command line interface. 4 | 5 | The first argument is the source file, and the second argument names 6 | the binary image output file. 7 | -------------------------------------------------------------------------------- /doc/libs.md: -------------------------------------------------------------------------------- 1 | # Libraries 2 | 3 | ### UART 4 | 5 | `SETUP-UART` ( -- ) 6 | Prepare UART hardware for operation. 7 | 8 | `EMIT` ( c -- ) 9 | Send a character through the UART. 10 | 11 | `KEY` ( -- c) 12 | Receive a character through the UART. 13 | -------------------------------------------------------------------------------- /doc/manual.md: -------------------------------------------------------------------------------- 1 | # User Manual 2 | 3 | [Build instructions.](building.md) 4 | 5 | [Invoking the compiler.](invoke.md) 6 | 7 | [Compiler internals.](internals.md) 8 | 9 | [Programming an image onto a device.](programming.md) 10 | 11 | [Glossary of supported Forth words.](glossary.md) 12 | -------------------------------------------------------------------------------- /doc/programming.md: -------------------------------------------------------------------------------- 1 | # Programming an image file onto a device 2 | 3 | There's a wide variety of microcontrollers, development boards, and 4 | device programmers. To program a particular device, you have to 5 | figure out which combination of hardware and software is needed. 6 | Below are a few examples to get you started. 7 | 8 | The output from the compiler is a flat binary file. Some programming 9 | software accept a binary file; other want an Intel HEX file. There is 10 | a makefile target to make this conversion. 11 | 12 | ### AVR 13 | 14 | To program the image file onto a Adafruit Trinket board, use: 15 | 16 | avrdude -c usbtiny -p attiny85 -U flash:w:image:r -P usb 17 | 18 | Programming the fuses is outside the scope of this manual. 19 | 20 | ### Cortex-M 21 | 22 | To program an image onto a STM Nucleo-32, use: 23 | 24 | st-flash write image 0x08000000 25 | 26 | ### MSP430 27 | 28 | To program an image onto a Launchpad board, use: 29 | 30 | mspdebug rf2500 "prog image.hex" 31 | 32 | ### PIC 33 | 34 | To program an image onto a Curiosity board with a PIC16F1619, use the 35 | supplied mdb script in the target/pic directory: 36 | 37 | mdb.sh upload.mdb 38 | 39 | Programming the configuration bits is outside the scope of this 40 | manual. 41 | 42 | ### STM8 43 | 44 | To use an ST-Link V2 programmer to program an image onto a noname 45 | STM8S103F3 board, use: 46 | 47 | stm8flash -C stlinkv2 -p stm8s103f3 -W image.hex 48 | -------------------------------------------------------------------------------- /src/compile: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Shell script wrapping the Forth cross compiler. 4 | 5 | if test "$#" != 2; then 6 | echo "Usage: $0 " 7 | exit 1 8 | fi 9 | 10 | input="$PWD/$1" 11 | output="$PWD/$2" 12 | 13 | cd `dirname $0`/.. 14 | cp "$input" app.fth 15 | echo include src/compiler.fth | forth 16 | if test \! "$output" -ef image; then 17 | mv image "$output" 18 | fi 19 | -------------------------------------------------------------------------------- /src/compiler.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2017 Lars Brinkhoff. 2 | 3 | \ Forth cross compiler. 4 | 5 | 6 | : h: : ; 7 | 8 | 0 value latest 9 | 10 | include target/params.fth 11 | include lib/meta.fth 12 | 13 | variable ram-dp 14 | data-start ram-dp ! 15 | : ram-here ram-dp @ ; 16 | : ram-allot ram-dp +! ; 17 | 18 | only forth also meta definitions 19 | 20 | include target/asm.fth 21 | 22 | : header, ( a u -- ) here t-word here to latest ; 23 | 24 | include target/x1.fth 25 | 26 | also forth 27 | ' comp, is t-compile, 28 | ' t-num is t-literal 29 | 30 | host also meta definitions 31 | 32 | h: : parse-name header, prologue, ] ; 33 | h: constant t-constant ; 34 | h: variable ram-here t-constant t-cell ram-allot ; 35 | 36 | h: code parse-name header, also assembler ; 37 | h: end-code previous ; 38 | 39 | only forth also meta also compiler definitions previous 40 | include target/x2.fth 41 | 42 | h: ; [compile] exit [compile] [ ; 43 | h: ['] ' t-literal ; 44 | h: [char] char t-literal ; 45 | h: literal t-literal ; 46 | 47 | t-cell t-constant cell 48 | 49 | target 50 | 51 | program-start org 52 | include target/nucleus.fth 53 | include app.fth 54 | 55 | end-target 56 | 57 | only forth also meta also t-words resolve-all-forward-refs 58 | 59 | only forth also meta save-target 60 | -------------------------------------------------------------------------------- /target/6502/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2016 Lars Brinkhoff 2 | 3 | \ Assembler for 6502. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and 6502 opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | require search.fth 12 | also forth definitions 13 | require lib/common.fth 14 | 15 | vocabulary assembler 16 | 17 | base @ hex 18 | 19 | \ This constant signals that an operand is not a direct address. 20 | deadbeef constant -addr 21 | 22 | \ Assembler state. 23 | variable opcode 24 | variable mode 25 | variable data defer ?data, 26 | defer absolute,y 27 | 28 | \ Set opcode. 29 | : opcode! 3@ drop >r opcode ! ; 30 | : !mode mode +! ; 31 | 32 | \ Access instruction fields. 33 | : opcode@ opcode @ mode @ + ; 34 | : data@ data @ ; 35 | 36 | \ Possibly use a cross-compiling vocabulary to access a target image. 37 | previous 38 | 39 | \ Write instruction fields to memory. 40 | : w, dup c, 8 rshift c, ; 41 | : w! 2dup c! swap 8 rshift swap 1+ c! ; 42 | : opcode, opcode@ c, ; 43 | : data8, data@ c, ; 44 | : data16, data@ w, ; 45 | : pc- here - 2 - ; 46 | 47 | also forth 48 | 49 | \ Set operand data. 50 | : !data8 data ! ['] data8, is ?data, ; 51 | : !data16 data ! ['] data16, is ?data, ; 52 | 53 | \ Implements addressing modes. 54 | : zp? dup 100 < ; 55 | : special#? opcode@ 03 and 01 = ; 56 | : imm-op !data8 special#? if 08 else 00 then !mode ; 57 | : absolute zp? if !data8 04 else !data16 0C then !mode ; 58 | : absolute,x absolute 10 !mode ; 59 | : (absolute,y) !data16 18 !mode ; 60 | : indirect !data16 20 !mode ; 61 | : zeropage,x !data8 00 !mode ; 62 | : zeropage,y !data8 10 !mode ; 63 | : accumulator 08 !mode ; 64 | : relative pc- !data8 ; 65 | 66 | \ Reset assembler state. 67 | : 0data ['] noop is ?data, ; 68 | : 0modes 0 mode ! ['] (absolute,y) is absolute,y ; 69 | : 0asm 0data 0modes ; 70 | 71 | \ Process one operand. All operands except a direct address 72 | \ have the stack picture ( n*x xt -addr ). 73 | : addr? dup -addr <> ; 74 | : op addr? if absolute else drop execute then ; 75 | 76 | \ Define instruction formats. 77 | : instruction, opcode! opcode, ?data, 0asm ; 78 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 79 | : format: create ] !csp does> mnemonic ; 80 | : immediate: ' latestxt >body ! ; 81 | 82 | \ Instruction formats. 83 | format: 0op ; 84 | format: 1op op ; 85 | format: special,y ['] absolute,x is absolute,y op ; 86 | format: branch relative ; 87 | format: jump !data16 ; 88 | 89 | \ Instruction mnemonics. 90 | previous also assembler definitions 91 | 01 1op ora, 92 | 02 1op asl, 93 | 10 branch bpl, 94 | 20 jump jsr, 95 | 20 1op bit, 96 | 21 1op and, 97 | 22 1op rol, 98 | 30 branch bmi, 99 | \ 40 rti, 100 | 41 1op eor, 101 | 42 1op lsr, 102 | 4C jump jmp, 103 | 50 branch bvc, 104 | \ 60 rts, 105 | 61 1op adc, 106 | 62 1op ror, 107 | 70 branch bvs, 108 | 80 1op sty, 109 | 81 1op sta, 110 | 82 special,y stx, 111 | 90 branch bcc, 112 | A0 1op ldy, 113 | A1 1op lda, 114 | A2 special,y ldx, 115 | B0 branch bcs, 116 | C0 1op cpy, 117 | C1 1op cmp, 118 | C2 1op dec, 119 | D0 branch bne, 120 | E0 1op cpx, 121 | E1 1op sbc, 122 | E2 1op inc, 123 | F0 branch beq, 124 | 125 | 00 0op brk, 126 | 08 0op php, 127 | 18 0op clc, 128 | 28 0op plp, 129 | 38 0op sec, 130 | 40 0op rti, 131 | 48 0op pha, 132 | 58 0op cli, 133 | 60 0op rts, 134 | 68 0op pla, 135 | 78 0op sei, 136 | 88 0op dey, 137 | 8A 0op txa, 138 | 98 0op tya, 139 | 9A 0op txs, 140 | A8 0op tay, 141 | AA 0op tax, 142 | B8 0op clv, 143 | BA 0op tsx, 144 | C8 0op iny, 145 | CA 0op dex, 146 | D8 0op cld, 147 | E8 0op inx, 148 | EA 0op nop, 149 | F8 0op sed, 150 | 151 | \ 65C02 extensions. 152 | \ 12/32/52/72/92/B2/D2/F2 zp ) ora,/and,/eor,/adc,/sta,/lda,/cmp,/sbc, 153 | \ 7C abs ,x jmp, 154 | \ 34/3C addr ,x bit, 155 | \ 89 # bit, 156 | \ 04/0C tsb, 157 | \ 14/1C trb, 158 | \ 64/74/9C/9C stz, 159 | \ 80 bra, 160 | \ 1A a inc, 161 | \ 3A a dec, 162 | \ 5A phy, 163 | \ 7A ply, 164 | \ DA phx, 165 | \ FA plx, 166 | 167 | \ Addressing mode syntax. 168 | : # ['] imm-op -addr ; 169 | : a ['] accumulator -addr ; 170 | : ,x ['] absolute,x -addr ; 171 | : ,y ['] absolute,y -addr ; 172 | : ) 20 !mode ; 173 | : ,x) ['] zeropage,x -addr ; 174 | : ),y ['] zeropage,y -addr ; 175 | 176 | \ Resolve jumps. 177 | : rel! - negate swap c! ; 178 | : abs! nip swap w! ; 179 | : >mark1 here 1- here ['] rel! ; 180 | : >mark2 here 2 - here ['] abs! ; 181 | : >resolve here swap execute ; 182 | 183 | \ Unconditional jumps. 184 | : label here >r get-current ['] assembler set-current r> constant set-current ; 185 | : begin, here ; 186 | : again, jmp, ; 187 | : ahead, 0 jmp, >mark2 ; 188 | : then, >resolve ; 189 | 190 | \ Conditional jumps. 191 | : 0=, ['] bne, ; 192 | : 0<, ['] bcs, ; 193 | : cs, ['] bcc, ; 194 | : 0<>, ['] beq, ; 195 | : if, 0 swap execute >mark1 ; 196 | : until, execute ; 197 | 198 | : 3swap >r rot >r 2swap 2r> >r -rot r> ; 199 | : else, ahead, 3swap then, ; 200 | : while, >r if, r> ; 201 | : repeat, again, then, ; 202 | 203 | \ Runtime for ;CODE. CODE! is defined elsewhere. 204 | : (;code) r> code! ; 205 | 206 | \ Enter and exit assembler mode. 207 | : start-code also assembler 0asm ; 208 | : end-code previous ; 209 | 210 | base ! 211 | 212 | previous definitions also assembler 213 | 214 | \ Standard assembler entry points. 215 | : code parse-name header, ?code, reveal start-code ; 216 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 217 | 218 | 0asm 219 | previous 220 | -------------------------------------------------------------------------------- /target/6502/nucleus.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | code cold 4 | FF # ldx, 5 | txs, 6 | 10 # ldx, 7 | ahead, 8 | end-code 9 | 10 | code dup 11 | stack-lo ,x lda, 12 | stack-hi ,x ldy, 13 | label pushay 14 | dex, 15 | label storay 16 | stack-lo ,x sta, 17 | stack-hi ,x sty, 18 | rts, 19 | end-code 20 | 21 | code >r 22 | pla, 23 | w sta, 24 | pla, 25 | tay, 26 | stack-hi ,x lda, 27 | pha, 28 | stack-lo ,x lda, 29 | pha, 30 | inx, 31 | label jumpw 32 | tya, 33 | pha, 34 | w lda, 35 | pha, 36 | rts, 37 | end-code 38 | 39 | code r> 40 | pla, 41 | w sta, 42 | pla, 43 | tay, 44 | dex, 45 | pla, 46 | stack-lo ,x sta, 47 | pla, 48 | stack-hi ,x sta, 49 | jumpw jmp, 50 | end-code 51 | 52 | code r@ 53 | txa, 54 | tsx, 55 | 103 ,x ldy, 56 | w sty, 57 | 104 ,x ldy, 58 | tax, 59 | w lda, 60 | pushay jmp, 61 | end-code 62 | 63 | code over 64 | stack-hi 1+ ,x ldy, 65 | stack-lo 1+ ,x lda, 66 | pushay jmp, 67 | end-code 68 | 69 | code xor 70 | stack-hi ,x lda, 71 | stack-hi 1+ ,x eor, 72 | tay, 73 | stack-lo ,x lda, 74 | stack-lo 1+ ,x eor, 75 | pushay jmp, 76 | end-code 77 | 78 | code and 79 | stack-hi ,x lda, 80 | stack-hi 1+ ,x and, 81 | tay, 82 | stack-lo ,x lda, 83 | stack-lo 1+ ,x and, 84 | pushay jmp, 85 | end-code 86 | 87 | code or 88 | stack-hi ,x lda, 89 | stack-hi 1+ ,x ora, 90 | tay, 91 | stack-lo ,x lda, 92 | stack-lo 1+ ,x ora, 93 | pushay jmp, 94 | end-code 95 | 96 | code 2* 97 | stack-lo ,x asl, 98 | stack-hi ,x rol, 99 | rts, 100 | end-code 101 | 102 | code 2/ 103 | stack-hi ,x lda, 104 | a asl, 105 | stack-hi ,x ror, 106 | stack-lo ,x ror, 107 | rts, 108 | end-code 109 | 110 | code invert 111 | stack-lo ,x lda, 112 | FF # eor, 113 | stack-lo ,x sta, 114 | stack-hi ,x lda, 115 | FF # eor, 116 | stack-hi ,x sta, 117 | rts, 118 | end-code 119 | 120 | code fetchw 121 | stack-lo ,x lda, 122 | w sta, 123 | stack-hi ,x lda, 124 | w 1+ sta, 125 | 0 # ldy, 126 | w ),y lda, 127 | rts, 128 | end-code 129 | 130 | code @ 131 | ' fetchw jsr, 132 | iny, 133 | stack-lo ,x sta, 134 | w ),y lda, 135 | stack-hi ,x sta, 136 | rts, 137 | end-code 138 | 139 | code c@ 140 | ' fetchw jsr, 141 | storay jmp, 142 | end-code 143 | 144 | : negate invert [ \ Fall through. 145 | 146 | code 1+ 147 | stack-lo ,x inc, 148 | 0=, if, 149 | stack-hi ,x inc, 150 | then, 151 | rts, 152 | end-code 153 | 154 | : 1- 1 [ \ Fall through. 155 | : - negate [ \ Fall through. 156 | 157 | code + 158 | stack-lo ,x lda, 159 | clc, 160 | stack-lo 1+ ,x adc, 161 | stack-lo 1+ ,x sta, 162 | stack-hi ,x lda, 163 | stack-hi 1+ ,x adc, 164 | inx, 165 | stack-hi ,x sta, 166 | rts, 167 | end-code 168 | 169 | : +! dup >r @ + r> [ \ Fall through. 170 | 171 | code ! 172 | ' fetchw jsr, 173 | stack-lo 1+ ,x lda, 174 | w ),y sta, 175 | iny, 176 | stack-hi 1+ ,x lda, 177 | label stora 178 | w ),y sta, 179 | inx, 180 | inx, 181 | rts, 182 | end-code 183 | 184 | code c! 185 | ' fetchw jsr, 186 | stack-lo 1+ ,x lda, 187 | stora jmp, 188 | end-code 189 | 190 | code swap 191 | stack-lo ,x ldy, 192 | stack-lo 1+ ,x lda, 193 | stack-lo ,x sta, 194 | stack-lo 1+ ,x sty, 195 | stack-hi ,x ldy, 196 | stack-hi 1+ ,x lda, 197 | stack-hi ,x sta, 198 | stack-hi 1+ ,x sty, 199 | rts, 200 | end-code 201 | 202 | : nip swap drop ; 203 | 204 | code branch? 205 | inx, 206 | stack-lo 1- ,x lda, 207 | stack-hi 1- ,x ora, 208 | rts, 209 | end-code 210 | 211 | : ?dup dup if dup then ; 212 | 213 | : = - [ \ Fall through. 214 | 215 | code 0= 216 | 0 # ldy, 217 | stack-lo ,x lda, 218 | stack-hi ,x ora, 219 | 0=, if, 220 | dey, 221 | then, 222 | label pushyy 223 | stack-lo ,x sty, 224 | stack-hi ,x sty, 225 | rts, 226 | end-code 227 | 228 | code 0< 229 | 0 # ldy, 230 | stack-hi ,x asl, 231 | cs, if, 232 | dey, 233 | then, 234 | pushyy jmp, 235 | end-code 236 | 237 | : <> - [ \ Fall through. 238 | : 0<> 0= 0= ; 239 | : cell+ 1+ 1+ ; 240 | 241 | code bye 242 | brk, 243 | end-code 244 | 245 | code panic 246 | 1 # lda, 247 | 0F000 sta, 248 | end-code 249 | -------------------------------------------------------------------------------- /target/6502/params.fth: -------------------------------------------------------------------------------- 1 | 1 constant t-little-endian 2 | 2 constant t-cell 3 | hex 1000 constant program-start 4 | 0 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/6502/target.mk: -------------------------------------------------------------------------------- 1 | START = 0x1000 2 | OPTS = -6502 -break_io 0xF000 -set_pc $(START) -bin -address $(START) 3 | 4 | test-image: image 5 | naken_util $(OPTS) -run image > $@ 6 | -------------------------------------------------------------------------------- /target/6502/x1.fth: -------------------------------------------------------------------------------- 1 | \ 6502 backend. 2 | \ 3 | \ Subroutine threaded. To save space, most operations are NOT inlined. 4 | \ 5 | \ Register usage: 6 | \ A - temporary. 7 | \ X - data stack pointer. 8 | \ Y - temporary. 9 | \ SP - return stack pointer. 10 | \ 11 | \ Zero page usage: 12 | \ 40-41 TOS - top of stack. 13 | \ 42-43 W - temporary. 14 | \ E0-FF - data stack. 15 | 16 | only forth 17 | 18 | 224 constant stack-lo 19 | 240 constant stack-hi 20 | 64 constant tos 21 | 66 constant w 22 | 23 | also meta definitions also assembler 24 | 25 | : comp, jsr, ; 26 | 27 | : branch?, s" branch?" "' comp, 0<>, ; 28 | : dup, s" dup" "' comp, ; 29 | 30 | : store 255 and # lda, ,x sta, ; 31 | : t-num dex, stack-lo over store stack-hi swap 8 rshift store ; 32 | 33 | : prologue, ; 34 | : end-target ; 35 | -------------------------------------------------------------------------------- /target/6502/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: exit rts, ; 3 | h: drop inx, ; 4 | h: 2drop inx, inx, ; 5 | 6 | h: if branch?, if, ; 7 | h: ahead ahead, ; 8 | h: then then, ; 9 | h: else else, ; 10 | 11 | h: begin begin, ; 12 | h: again again, ; 13 | h: until branch?, until, ; 14 | h: while branch?, while, ; 15 | h: repeat repeat, ; 16 | previous 17 | -------------------------------------------------------------------------------- /target/8051/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2017 Lars Brinkhoff 2 | 3 | \ Assembler for 8051. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and AVR opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: 13 | \ - immediate: "n #" 14 | \ - absolute: n 15 | \ - register: a, r, dptr 16 | \ - indirect: @ 17 | 18 | require search.fth 19 | also forth definitions 20 | require lib/common.fth 21 | 22 | vocabulary assembler 23 | 24 | base @ hex 25 | 26 | \ This constant signals that an operand is not a direct address. 27 | deadbeef constant -addr 28 | 29 | \ Assembler state. 30 | variable opcode 31 | variable mode 32 | variable data defer ?data, 33 | defer !data8 34 | 35 | \ Set opcode. 36 | : opcode! 3@ drop >r opcode ! ; 37 | : !mode mode +! ; 38 | 39 | \ Access instruction fields. 40 | : opcode@ opcode @ mode @ + ; 41 | : mode@ mode @ ; 42 | : data@ data @ ; 43 | 44 | \ Possibly use a cross-compiling vocabulary to access a target image. 45 | previous 46 | 47 | \ Write instruction fields to memory. 48 | : w, dup 8 rshift c, c, ; 49 | : w! over 8 rshift over c! 1+ c! ; 50 | : opcode, opcode@ c, ; 51 | : data8, data@ c, ; 52 | : data16, data@ w, ; 53 | : pc- here - 2 - ; 54 | 55 | also forth 56 | 57 | : range-error ." Jump range error: " source type abort ; 58 | : ?range dup -80 80 within 0= if range-error then ; 59 | 60 | \ Set operand data. 61 | : !data8again data @ 8 lshift + data ! ['] data16, is ?data, ; 62 | : !data81+ !data8again 1 !mode ; 63 | : !data8stm 8 lshift data @ + data ! ['] data16, is ?data, ; 64 | : (!data8) data ! ['] data8, is ?data, ['] !data8again is !data8 ; 65 | : !jump dup !data8 3 rshift E0 and opcode +! ; 66 | : !data16 data ! ['] data16, is ?data, ; 67 | 68 | \ Implements addressing modes. 69 | : imm-op 04 !mode !data8 ; 70 | : accumulator 04 !mode ; 71 | : absolute 05 !mode !data8 ; 72 | : indirect !mode ; 73 | : reg !mode ; 74 | : movx-dptr 4 !mode ; 75 | : mov-dptr -4 !mode ['] !data16 is !data8 ; 76 | 77 | \ Reset assembler state. 78 | : 0mode 0 mode ! ; 79 | : 0data ['] noop is ?data, ['] (!data8) is !data8 ; 80 | : 0op 0 opcode ! ; 81 | : 0asm 0mode 0data 0op ; 82 | 83 | \ Process one operand. All operands except a direct address 84 | \ have the stack picture ( n*x xt -addr ). 85 | : addr? dup -addr <> ; 86 | : op addr? if absolute else drop execute then ; 87 | 88 | \ Define instruction formats. 89 | : instruction, opcode! opcode, ?data, 0asm ; 90 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 91 | : format: create ] !csp does> mnemonic ; 92 | 93 | \ Instruction formats. 94 | format: 0op ; 95 | format: 1op op ; 96 | format: 2op op op ; 97 | format: mem op ['] !data81+ is !data8 op -7 !mode ; 98 | format: movi op op -4 !mode ; 99 | format: movx op -4 !mode ; 100 | format: stm op ['] !data8stm is !data8 op -5 !mode ; 101 | format: ldm op op -5 !mode ; 102 | format: jump !jump ; 103 | format: long !data16 ; 104 | format: relative pc- ?range !data8 ; 105 | 106 | \ Define registers 107 | : reg: create dup , 1+ does> @ ['] reg -addr ; 108 | 109 | \ Instruction mnemonics. 110 | previous also assembler definitions 111 | 112 | 00 0op nop, 113 | 00 1op inc, 114 | 01 jump ajmp, 115 | 02 long ljmp, 116 | 03 0op rr, 117 | \ 10 jbc, 118 | 10 1op dec, 119 | 11 jump acall, 120 | 12 long lcall, 121 | 13 0op rrc, 122 | \ 20 jb, 123 | 20 1op add, 124 | 22 0op ret, 125 | 23 0op rl, 126 | \ 30 jnb, 127 | 30 1op addc, 128 | 32 0op reti, 129 | 33 0op rlc, 130 | 40 relative jc, 131 | 40 1op orl, 132 | 40 mem orlm, 133 | 50 relative jnc, 134 | 50 1op anl, 135 | 50 mem anlm, 136 | 60 relative jz, 137 | 60 1op xrl, 138 | 60 mem xrlm, 139 | 70 relative jnz, 140 | 70 movi movi, 141 | \ 72 orl, 142 | 73 0op jmp, 143 | 80 relative sjmp, 144 | 80 stm stm, 145 | \ 82 anl, 146 | \ 83 movc, 147 | 84 0op div, 148 | 90 2op mov, 149 | 90 1op subb, 150 | \ 92 mov, 151 | \ 93 movc, 152 | \ A0 orl, 153 | A0 ldm ldm, 154 | \ A3 inc, 155 | A4 0op mul, 156 | \ A5 (reserved) 157 | \ B0 anl, 158 | \ B0 cjne, 159 | \ B2 cpl, 160 | \ B3 cpl, 161 | BB 1op push, 162 | C0 1op xch, 163 | \ C2 clr, 164 | \ C3 clr, 165 | C4 0op swap, 166 | CB 1op pop, 167 | \ D0 djnz, 168 | D0 1op xchd, 169 | \ D2 setb, 170 | \ D3 setb, 171 | D4 0op da, 172 | E0 1op lda, 173 | E0 movx xlda, 174 | E0 1op clr, 175 | F0 1op sta, 176 | F0 movx xsta, 177 | F0 1op cpl, 178 | 179 | \ Addessing mode syntax. 180 | : # ['] imm-op -addr ; 181 | : a ['] accumulator -addr ; 182 | : @r0 06 ['] indirect -addr ; 183 | : @r1 07 ['] indirect -addr ; 184 | : @dptr ['] movx-dptr -addr ; 185 | : dptr ['] mov-dptr -addr ; 186 | 187 | \ Register names. 188 | 08 189 | reg: r0 reg: r1 reg: r2 reg: r3 190 | reg: r4 reg: r5 reg: r6 reg: r7 191 | drop 192 | 193 | \ Aliases 194 | 195 | \ Resolve jumps. 196 | : >mark here 1- here ; 197 | : long? dup 7F > over -80 < or ; 198 | : long! 1- 02 swap c!+ here swap w! ; 199 | : >resolve here swap - long? if drop long! else swap c! then ; 200 | 201 | \ Special function registers. 202 | 81 constant sp 203 | 82 constant dpl 204 | 83 constant dph 205 | D0 constant psw 206 | E0 constant acc 207 | F0 constant b 208 | 209 | \ Unconditional jumps. 210 | : label here >r get-current ['] assembler set-current r> constant set-current ; 211 | : begin, here ; 212 | : again, sjmp, ; 213 | : ahead, here sjmp, >mark ; 214 | : then, >resolve ; 215 | 216 | \ Conditional jumps. 217 | : 0=, ['] jnz, ; 218 | : 0<>, ['] jz, ; 219 | : cs, ['] jnc, ; 220 | : if, here swap execute >mark ; 221 | : until, execute ; 222 | 223 | : else, ahead, 2swap then, ; 224 | : while, >r if, r> ; 225 | : repeat, again, then, ; 226 | 227 | \ Runtime for ;CODE. CODE! is defined elsewhere. 228 | : (;code) r> code! ; 229 | 230 | \ Enter and exit assembler mode. 231 | : start-code also assembler 0asm ; 232 | : end-code previous ; 233 | 234 | also forth base ! previous 235 | 236 | previous definitions also assembler 237 | 238 | \ Standard assembler entry points. 239 | : code parse-name header, ?code, reveal start-code ; 240 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 241 | 242 | 0asm 243 | previous 244 | -------------------------------------------------------------------------------- /target/8051/nucleus.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | also assembler 4 | \ Interrupt vectors. 5 | ahead, nop, 6 | reti, 7 allot 7 | reti, 7 allot 8 | reti, 7 allot 9 | reti, 7 allot \ Breakpoint here for successful test. 10 | reti, 7 allot \ Breakpoint here for failed test. 11 | end-code 12 | 13 | code cold 14 | then, 15 | FF # r0 movi, 16 | 7 # sp movi, 17 | ahead, nop, 18 | end-code 19 | 20 | code dup 21 | r0 dec, 22 | dph lda, 23 | @r0 xsta, 24 | r0 dec, 25 | dpl lda, 26 | @r0 xsta, 27 | ret, 28 | end-code 29 | 30 | code r> 31 | ' dup acall, 32 | 3 pop, 33 | 2 pop, 34 | dph pop, 35 | dpl pop, 36 | 2 push, 37 | 3 push, 38 | ret, 39 | end-code 40 | 41 | code r@ 42 | ' dup acall, 43 | sp r1 ldm, 44 | r1 dec, 45 | r1 dec, 46 | @r1 dph stm, 47 | r1 dec, 48 | @r1 dpl stm, 49 | ret, 50 | end-code 51 | 52 | code swap 53 | @r0 xlda, 54 | r2 sta, 55 | r0 inc, 56 | @r0 xlda, 57 | r3 sta, 58 | label semiswap 59 | dph lda, 60 | @r0 xsta, 61 | r0 dec, 62 | dpl lda, 63 | @r0 xsta, 64 | r3 dph stm, 65 | r2 dpl stm, 66 | ret, 67 | end-code 68 | 69 | code over 70 | @r0 xlda, 71 | r2 sta, 72 | r0 inc, 73 | @r0 xlda, 74 | r3 sta, 75 | r0 dec, 76 | r0 dec, 77 | semiswap sjmp, 78 | end-code 79 | 80 | code invert 81 | FF # dpl xrlm, 82 | FF # dph xrlm, 83 | ret, 84 | end-code 85 | 86 | : negate invert 1+ ; 87 | : 1- 1 [ \ Fall through. 88 | : - negate [ \ Fall through. 89 | 90 | code + 91 | @r0 xlda, 92 | r0 inc, 93 | dpl add, 94 | dpl sta, 95 | @r0 xlda, 96 | r0 inc, 97 | dph addc, 98 | dph sta, 99 | ret, 100 | end-code 101 | 102 | code xor 103 | @r0 xlda, 104 | r0 inc, 105 | a dpl xrlm, 106 | @r0 xlda, 107 | r0 inc, 108 | a dph xrlm, 109 | ret, 110 | end-code 111 | 112 | code and 113 | @r0 xlda, 114 | r0 inc, 115 | a dpl anlm, 116 | @r0 xlda, 117 | r0 inc, 118 | a dph anlm, 119 | ret, 120 | end-code 121 | 122 | code or 123 | @r0 xlda, 124 | r0 inc, 125 | a dpl orlm, 126 | @r0 xlda, 127 | r0 inc, 128 | a dph orlm, 129 | ret, 130 | end-code 131 | 132 | code 2* 133 | dpl lda, 134 | dpl add, 135 | dpl sta, 136 | dph lda, 137 | rlc, 138 | dph sta, 139 | ret, 140 | end-code 141 | 142 | code 2/ 143 | dph lda, 144 | rlc, 145 | dph lda, 146 | rrc, 147 | dph sta, 148 | dpl lda, 149 | rrc, 150 | dpl sta, 151 | ret, 152 | end-code 153 | 154 | code @ 155 | @dptr xlda, 156 | r2 sta, 157 | A3 c, \ dptr inc, 158 | @dptr xlda, 159 | dph sta, 160 | r2 dpl stm, 161 | ret, 162 | end-code 163 | 164 | code c@ 165 | @dptr xlda, 166 | dpl sta, 167 | 0 # dph movi, 168 | ret, 169 | end-code 170 | 171 | code c! 172 | @r0 xlda, 173 | @dptr xsta, 174 | \ Fall through to "2drop". 175 | end-code 176 | 177 | code 2drop 178 | r0 inc, 179 | r0 inc, 180 | \ Fall through to "drop". 181 | end-code 182 | 183 | code drop 184 | @r0 xlda, 185 | dpl sta, 186 | r0 inc, 187 | @r0 xlda, 188 | dph sta, 189 | r0 inc, 190 | ret, 191 | end-code 192 | 193 | code >r 194 | 3 pop, 195 | 2 pop, 196 | dpl push, 197 | dph push, 198 | 2 push, 199 | 3 push, 200 | ' drop sjmp, 201 | end-code 202 | 203 | : +! dup >r @ + r> [ \ Fall through. 204 | 205 | code ! 206 | @r0 xlda, 207 | r0 inc, 208 | @dptr xsta, 209 | A3 c, \ dptr inc, 210 | @r0 xlda, 211 | r0 inc, 212 | @dptr xsta, 213 | ' drop sjmp, 214 | end-code 215 | 216 | code swap 217 | @r0 xlda, 218 | r2 sta, 219 | r0 inc, 220 | @r0 xlda, 221 | r3 sta, 222 | dph lda, 223 | @r0 xsta, 224 | r0 dec, 225 | dpl lda, 226 | @r0 xsta, 227 | r3 dph stm, 228 | r2 dpl stm, 229 | ret, 230 | end-code 231 | 232 | code branch? 233 | dpl lda, 234 | dph orl, 235 | r4 sta, 236 | ' drop acall, 237 | r4 lda, 238 | ret, 239 | end-code 240 | 241 | code 0< 242 | dph lda, 243 | rlc, 244 | cs, if, 245 | FF # dph movi, 246 | FF # dpl movi, 247 | else, 248 | 0 # dph movi, 249 | 0 # dpl movi, 250 | then, 251 | ret, 252 | end-code 253 | 254 | : ?dup dup if dup then ; 255 | : = - [ \ Fall through. 256 | : 0= if 0 else -1 then ; 257 | : <> - [ \ Fall through. 258 | : 0<> 0= 0= ; 259 | 260 | code bye 261 | 1B ljmp, 262 | end-code 263 | 264 | code panic 265 | 23 ljmp, 266 | end-code 267 | -------------------------------------------------------------------------------- /target/8051/params.fth: -------------------------------------------------------------------------------- 1 | 0 constant t-little-endian 2 | 2 constant t-cell 3 | 0 constant program-start 4 | hex 100 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/8051/target.mk: -------------------------------------------------------------------------------- 1 | START = 0 2 | 3 | test-image: image.hex 4 | s51 -J $< < $(TDIR)/test.ucsim > $@ 5 | ! grep "Stop at 0x000023" $@ 6 | grep "Stop at 0x00001b" $@ 7 | -------------------------------------------------------------------------------- /target/8051/test.ucsim: -------------------------------------------------------------------------------- 1 | break 0x1B 2 | break 0x23 3 | run 4 | quit 5 | 6 | -------------------------------------------------------------------------------- /target/8051/x1.fth: -------------------------------------------------------------------------------- 1 | \ 8051 backend. 2 | \ 3 | \ Subroutine threaded. To save space, most operations are NOT inlined. 4 | \ 5 | \ Register usage: 6 | \ A - temporary. 7 | \ B - temporary. 8 | \ DPTR - TOS 9 | \ R0 - data stack pointer. 10 | \ R1-R4 - temporary. 11 | \ SP - return stack pointer. 12 | 13 | only forth 14 | 15 | also meta definitions also assembler 16 | 17 | : pc- here - 2 - ; 18 | : short? dup pc- -128 128 within ; 19 | : comp, short? if acall, else lcall, then ; 20 | 21 | : branch?, s" branch?" "' comp, 0<>, ; 22 | : dup, s" dup" "' comp, ; 23 | 24 | : t-num dup, # dptr mov, ; 25 | 26 | : prologue, ; 27 | : end-target ; 28 | -------------------------------------------------------------------------------- /target/8051/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler hex 2 | h: exit ret, ; 3 | h: nip r0 inc, r0 inc, ; 4 | h: 1+ A3 c, ; 5 | h: cell+ A3 c, A3 c, ; 6 | 7 | h: if branch?, if, ; 8 | h: ahead ahead, ; 9 | h: then then, ; 10 | h: else else, ; 11 | 12 | h: begin begin, ; 13 | h: again again, ; 14 | h: until branch?, until, ; 15 | h: while branch?, while, ; 16 | h: repeat repeat, ; 17 | previous 18 | -------------------------------------------------------------------------------- /target/avr/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2016 Lars Brinkhoff 2 | 3 | \ Assembler for AVR. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and AVR opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: 13 | \ - immediate: "n #" 14 | \ - absolute: n 15 | \ - register: 16 | \ - preincrement: - 17 | \ - postdecrement: + 18 | \ - indirect with offset: "n )#" 19 | 20 | require search.fth 21 | also forth definitions 22 | require lib/common.fth 23 | 24 | vocabulary assembler 25 | 26 | base @ hex 27 | 28 | \ This constant signals that an operand is not a direct address. 29 | deadbeef constant -addr 30 | 31 | \ Assembler state. 32 | variable opcode 33 | variable word defer ?word, 34 | variable rd-mask 35 | defer reg 36 | defer idx 37 | defer imm-op 38 | defer addr 39 | 40 | \ Set opcode. 41 | : opcode! 3@ drop >r opcode ! ; 42 | : field! opcode swap !bits ; 43 | : idx! 100F field! ; 44 | : idx2 1 and opcode +! ; 45 | : rd! 4 lshift rd-mask @ field! ; 46 | : rn! dup 000F field! 5 lshift 0200 field! ; 47 | : imm! dup 000F field! 4 lshift 0F00 field! ; 48 | : wimm! dup 000F field! 2 lshift 00C0 field! ; 49 | : bit! 0007 field! ; 50 | : io! 3 lshift 00F8 field! ; 51 | : inout! dup 000F field! 5 lshift 0600 field! ; 52 | : disp! dup 0003 field! dup 5 lshift 0C00 field! 8 lshift 2000 field! ; 53 | : ?lpm opcode @ 9004 = if 95C8 opcode ! then ; 54 | 55 | 56 | \ Access instruction fields. 57 | : opcode@ opcode @ ; 58 | 59 | \ Possibly use a cross-compiling vocabulary to access a target image. 60 | previous definitions 61 | 62 | \ Write instruction fields to memory. 63 | : w, dup c, 8 rshift c, ; 64 | : w@ dup c@ swap 1+ c@ 8 lshift + ; 65 | : w! 2dup c! swap 8 rshift swap 1+ c! ; 66 | : opcode, opcode@ w, ; 67 | : pc- here - 2 - ; 68 | : offset! dup w@ FF000000 and rot 00FFFFFF and + swap w! ; 69 | : br! over w@ FC07 and swap 2 lshift 03F8 and + swap w! ; 70 | : jmp! over w@ F000 and swap 1 rshift 0FFF and + swap w! ; 71 | 72 | also forth definitions 73 | 74 | : word, word @ w, ; 75 | : !word word ! ['] word, is ?word, ; 76 | : !jump dup !word dup 10 rshift 0001 field! 0D rshift 01F0 field! ; 77 | : !rjump pc- 1 rshift 0FFF field! ; 78 | : !branch pc- 2 lshift 03F8 field! ; 79 | 80 | \ Implements addressing modes: register, indirect, postincrement, 81 | \ predecrement, and absolute. 82 | : reg2 rn! ; 83 | : !reg2 ['] reg2 is reg ; 84 | : reg1 rd! !reg2 ; 85 | : wimm-op wimm! ; 86 | : imm-op imm! ; 87 | 88 | \ Reset assembler state. 89 | : 0reg ['] reg1 is reg ; 90 | : 0w ['] noop is ?word, ; 91 | : 0rd 01F0 rd-mask ! ; 92 | : 0idx ['] idx! is idx ; 93 | : 0imm ['] imm! is imm-op ; 94 | : 0addr ['] io! is addr ; 95 | : 0asm 0reg 0w 0rd 0idx 0imm 0addr ; 96 | 97 | \ Process one operand. All operands except a direct address 98 | \ have the stack picture ( n*x xt -addr ). 99 | : addr? dup -addr <> ; 100 | : op addr? if addr else drop execute then ; 101 | : disp 2drop idx! disp! ; 102 | 103 | \ Define instruction formats. 104 | : instruction, ( a -- ) opcode! opcode, ?word, 0asm ; 105 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 106 | : format: create ] !csp does> mnemonic ; 107 | : immediate: ' latestxt >body ! ; 108 | 109 | \ Instruction formats. 110 | format: 0op ; 111 | format: 1op op ; 112 | format: 2op op op ; 113 | format: ds op !word ; 114 | format: movw 0F0 rd-mask ! 2>r >r 2>r 2/ 2r> r> 2/ 2r> op op ; 115 | format: adiw 030 rd-mask ! ['] wimm! is imm-op 2>r 18 - 2/ 2r> op op ; 116 | format: lpm ['] idx2 is idx op op ?lpm ; 117 | format: skip ['] bit! is imm-op op op ; 118 | format: inout ['] inout! is addr op op ; 119 | format: jump !jump ; 120 | format: rjump !rjump ; 121 | format: branch !branch ; 122 | 123 | \ Define registers 124 | : reg: create dup , 1+ does> @ ['] reg -addr ; 125 | : index: create , does> @ ['] idx -addr ; 126 | 127 | \ Instruction mnemonics. 128 | previous also assembler definitions 129 | 130 | 0000 0op nop, 131 | 0100 movw movw, 132 | \ 0200 muls, 133 | \ 0300 mulsu, 134 | \ 0308 fmul, 135 | \ 0380 fmuls, 136 | \ 0388 fmulsu, 137 | 0400 2op cpc, 138 | 0800 2op sbc, 139 | 0C00 2op add, 140 | 1000 2op cpse, 141 | 1400 2op cp, 142 | 1800 2op sub, 143 | 1C00 2op adc, 144 | 2000 2op and, 145 | 2400 2op eor, 146 | 2800 2op or, 147 | 2C00 2op mov, 148 | 3000 2op cpi, 149 | 4000 2op sbci, 150 | 5000 2op subi, 151 | 6000 2op ori, 152 | 7000 2op andi, 153 | 8000 2op ldd, 154 | 8200 2op std, 155 | 9000 ds lds, 156 | 9000 2op ld, 157 | 9200 ds sts, 158 | 9200 2op st, 159 | 9004 lpm lpm, 160 | 9006 lpm elpm, 161 | 9204 1op xch, 162 | 9205 1op las, 163 | 9206 1op lac, 164 | 9207 1op lat, 165 | 900F 1op pop, 166 | 920F 1op push, 167 | 9400 1op com, 168 | 9401 1op neg, 169 | 9402 1op swap, 170 | 9403 1op inc, 171 | 9405 1op asr, 172 | 9406 1op lsr, 173 | 9407 1op ror, 174 | 9408 0op sec, 175 | 9418 0op sez, 176 | 9428 0op sen, 177 | 9438 0op sev, 178 | 9448 0op ses, 179 | 9458 0op seh, 180 | 9468 0op set, 181 | 9478 0op sei, 182 | 9488 0op clc, 183 | 9498 0op clz, 184 | 94A8 0op cln, 185 | 94B8 0op clv, 186 | 94C8 0op cls, 187 | 94D8 0op clh, 188 | 94E8 0op clt, 189 | 94F8 0op cli, 190 | 9508 0op ret, 191 | 9518 0op reti, 192 | 9588 0op sleep, 193 | 9598 0op break, 194 | 95A8 0op wdr, 195 | 95E8 0op spm, 196 | 9409 0op ijmp, 197 | 9419 0op eijmp, 198 | 9509 0op icall, 199 | 9519 0op eicall, 200 | 940A 1op dec, 201 | \ 940B des, 202 | 940C jump jmp, 203 | 940E jump call, 204 | 9600 adiw adiw, 205 | 9700 adiw sbiw, 206 | 9800 skip cbi, 207 | 9900 skip sbic, 208 | 9A00 skip sbi, 209 | 9B00 skip sbis, 210 | 9C00 2op mul, 211 | B000 inout in, 212 | B800 inout out, 213 | C000 rjump rjmp, 214 | D000 rjump rcall, 215 | E000 2op ldi, 216 | F000 branch brcs, 217 | F001 branch breq, 218 | F002 branch brmi, 219 | F003 branch brvs, 220 | F004 branch brlt, 221 | F005 branch brhs, 222 | F006 branch brts, 223 | F007 branch brie, 224 | F400 branch brcc, 225 | F401 branch brne, 226 | F402 branch brpl, 227 | F403 branch brvc, 228 | F404 branch brge, 229 | F405 branch brhc, 230 | F406 branch brtc, 231 | F407 branch brid, 232 | \ F800 bld, 233 | \ FA00 bst, 234 | FC00 skip sbrc, 235 | FE00 skip sbrs, 236 | 237 | \ Addressing mode syntax. 238 | : # ['] imm-op -addr ; 239 | : )# ['] disp -addr ; 240 | 241 | \ Register names. 242 | 0 243 | reg: r0 reg: r1 reg: r2 reg: r3 reg: r4 reg: r5 reg: r6 reg: r7 244 | reg: r8 reg: r9 reg: r10 reg: r11 reg: r12 reg: r13 reg: r14 reg: r15 245 | reg: r16 reg: r17 reg: r18 reg: r19 reg: r20 reg: r21 reg: r22 reg: r23 246 | reg: r24 reg: r25 reg: r26 reg: r27 reg: r28 reg: r29 reg: r30 reg: r31 247 | drop 248 | 249 | \ Index registers. 250 | 0000 index: z 251 | 1001 index: z+ 252 | 1002 index: -z 253 | 0008 index: y 254 | 1009 index: y+ 255 | 100A index: -y 256 | 100C index: x 257 | 100D index: x+ 258 | 100E index: -x 259 | 260 | \ Aliases 261 | : clr, 3dup eor, ; 262 | : lsl, 3dup add, ; 263 | : rol, 3dup adc, ; 264 | 265 | \ Resolve jumps. 266 | : >mark-br here 2 - ['] br! here ; 267 | : >mark-jmp here 2 - ['] jmp! here ; 268 | : >resolve here - negate swap execute ; 269 | 270 | \ Unconditional jumps. 271 | : label here >r get-current ['] assembler set-current r> constant set-current ; 272 | : begin, here ; 273 | : again, rjmp, ; 274 | : ahead, 0 rjmp, >mark-jmp ; 275 | : then, >resolve ; 276 | 277 | \ Conditional jumps. 278 | : 0=, ['] brne, ; 279 | : 0<, ['] brge, ; 280 | : 0<>, ['] breq, ; 281 | : if, 0 swap execute >mark-br ; 282 | : until, execute ; 283 | 284 | : 3swap >r rot >r 2swap 2r> >r -rot r> ; 285 | : else, ahead, 3swap then, ; 286 | : while, >r if, r> ; 287 | : repeat, again, then, ; 288 | 289 | \ Runtime for ;CODE. CODE! is defined elsewhere. 290 | : (;code) r> code! ; 291 | 292 | \ Enter and exit assembler mode. 293 | : start-code also assembler 0asm ; 294 | : end-code align previous ; 295 | 296 | also forth base ! previous 297 | 298 | previous definitions also assembler 299 | 300 | \ Standard assembler entry points. 301 | : code parse-name header, ?code, reveal start-code ; 302 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 303 | 304 | 0asm 305 | previous 306 | -------------------------------------------------------------------------------- /target/avr/gdbinit: -------------------------------------------------------------------------------- 1 | target remote localhost:1212 2 | 3 | define s 4 | si 5 | x/1i $pc 6 | printf "S=%d, ", 256*$r29 + $r28 7 | printf "R=%d, ", (int)$sp & 0xffff 8 | printf "T=%d\n", 256*$r27 + $r26 9 | x/4dh 256*$r29 + $r28 10 | x/4xh (int)$sp & 0xffff 11 | end 12 | -------------------------------------------------------------------------------- /target/avr/nucleus.fth: -------------------------------------------------------------------------------- 1 | code cold 2 | ahead, \ Interrupt vectors. 3 | nop, nop, nop, nop, nop, nop, nop, nop, 4 | nop, nop, nop, nop, nop, nop, nop, nop, 5 | then, 6 | 7 | 140 # r28 ldi, \ Set data stack pointer. 8 | r29 clr, 9 | 158 # r16 ldi, 10 | 61 r16 out, \ Set return stack pointer. 11 | ahead, \ Jump to WARM. 12 | end-code 13 | 14 | code invert 15 | r26 com, 16 | r27 com, 17 | ret, 18 | end-code 19 | 20 | : negate invert 1+ ; 21 | : - negate [ \ Fall through. 22 | 23 | code + 24 | y+ r2 ld, 25 | r2 r26 add, 26 | y+ r2 ld, 27 | r2 r27 adc, 28 | ret, 29 | end-code 30 | 31 | code and 32 | y+ r2 ld, 33 | r2 r26 and, 34 | y+ r2 ld, 35 | r2 r27 and, 36 | ret, 37 | end-code 38 | 39 | code or 40 | y+ r2 ld, 41 | r2 r26 or, 42 | y+ r2 ld, 43 | r2 r27 or, 44 | ret, 45 | end-code 46 | 47 | code xor 48 | y+ r2 ld, 49 | r2 r26 eor, 50 | y+ r2 ld, 51 | r2 r27 eor, 52 | ret, 53 | end-code 54 | 55 | code 2* 56 | r26 lsl, 57 | r27 rol, 58 | ret, 59 | end-code 60 | 61 | code 2/ 62 | r27 asr, 63 | r26 ror, 64 | ret, 65 | end-code 66 | 67 | code @ 68 | r26 r30 movw, 69 | z+ r26 ld, 70 | z r27 ld, 71 | ret, 72 | end-code 73 | 74 | code c@ 75 | x r26 ld, 76 | r27 clr, 77 | ret, 78 | end-code 79 | 80 | code dup 81 | -y r27 st, 82 | -y r26 st, 83 | ret, 84 | end-code 85 | 86 | code branch? 87 | r26 r27 or, 88 | \ Fall through. 89 | end-code 90 | 91 | code drop 92 | y+ r26 ld, 93 | y+ r27 ld, 94 | ret, 95 | end-code 96 | 97 | code >r 98 | r31 pop, 99 | r30 pop, 100 | r26 push, 101 | r27 push, 102 | ] drop [ also assembler 103 | ijmp, 104 | end-code 105 | 106 | code r> 107 | r31 pop, 108 | r30 pop, 109 | ] dup [ also assembler 110 | r27 pop, 111 | r26 pop, 112 | ijmp, 113 | end-code 114 | 115 | : +! dup >r @ + r> [ \ Fall through. 116 | 117 | code ! 118 | r26 r30 movw, 119 | ] drop [ also assembler 120 | z+ r26 st, 121 | z r27 st, 122 | ' drop rjmp, 123 | end-code 124 | 125 | code c! 126 | r26 r30 movw, 127 | ] drop [ also assembler 128 | z r26 st, 129 | ' drop rjmp, 130 | end-code 131 | 132 | code ?dup 133 | 0 # r26 adiw, 134 | 0<>, if, 135 | ' dup rjmp, 136 | then, 137 | ret, 138 | end-code 139 | 140 | code swap 141 | r26 r2 movw, 142 | ] drop [ also assembler 143 | -y r3 st, 144 | -y r2 st, 145 | ret, 146 | end-code 147 | 148 | code over 149 | ] dup [ also assembler 150 | 2 y )# r26 ldd, 151 | 3 y )# r27 ldd, 152 | ret, 153 | end-code 154 | 155 | code 0< 156 | 0 # r26 adiw, 157 | 0<, if, 158 | 255 # r26 ldi, 159 | 255 # r27 ldi, 160 | ret, 161 | else, 162 | 0 # r26 ldi, 163 | 0 # r27 ldi, 164 | ret, 165 | then, 166 | end-code 167 | 168 | : r@ r> r> dup >r swap >r ; 169 | : = - [ \ Fall through. 170 | : 0= if 0 else -1 then ; 171 | : <> - [ \ Fall through. 172 | : 0<> 0= 0= ; 173 | 174 | code bye 175 | break, 176 | end-code 177 | 178 | : panic [ 255 dup c, c, ] bye ; \ FFFF is an undefined instruction. 179 | -------------------------------------------------------------------------------- /target/avr/params.fth: -------------------------------------------------------------------------------- 1 | 1 constant t-little-endian 2 | 2 constant t-cell 3 | 0 constant program-start 4 | hex 60 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/avr/target.mk: -------------------------------------------------------------------------------- 1 | test-image: image 2 | simulavr -D -d at90s2313 $< > $@ 2>&1 3 | ! grep "Unknown opcode" $@ 4 | grep "BREAK POINT" $@ 5 | 6 | upload: image 7 | sudo avrdude -C $(TDIR)/avrdude.conf -c usbtiny -p attiny85 -U flash:w:image:r -P usb 8 | -------------------------------------------------------------------------------- /target/avr/uart.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | \ This is for an ATmega328P running at 16 MHz. Other parts may need 4 | \ other register addresses. 5 | 6 | code setup-uart 7 | 0 # r16 ldi, 8 | C5 r16 sts, 9 | 67 # r16 ldi, 10 | C4 r16 sts, \ UBRR0, 9600 11 | 18 # r16 ldi, 12 | C1 r16 sts, \ UCSR0B, Rx and tx enabled. 13 | 6 # r16 ldi, 14 | C2 r16 sts, \ USCR0C, 8N1 15 | ret, 16 | end-code 17 | 18 | code emit 19 | C0 r16 lds, 20 | 5 # r16 sbrs, \ UCSR0A, data register empty. 21 | ' emit rjmp, 22 | C6 r26 sts, \ UDR0 23 | ' drop rjmp, 24 | end-code 25 | 26 | code key 27 | ] dup [ also assembler 28 | label key1 29 | C0 r16 lds, 30 | 7 # r16 sbrs, \ UCSR0A, receive complete. 31 | key1 rjmp, 32 | C6 r26 lds, \ UDR0 33 | r27 clr, 34 | ret, 35 | end-code 36 | 37 | decimal 38 | -------------------------------------------------------------------------------- /target/avr/x1.fth: -------------------------------------------------------------------------------- 1 | \ AVR backend. 2 | \ 3 | \ Subroutine threaded. To save space, most operations are NOT inlined. 4 | \ In small devices, the 16-bit RCALL instruction will be used. 5 | \ 6 | \ Register usage: 7 | \ X - TOS 8 | \ Y - Data stack pointer 9 | \ Z - Temporary 10 | \ r2-r3 - Temporary 11 | \ SP - Return stack pointer 12 | 13 | 14 | only forth 15 | 16 | also meta definitions also assembler 17 | 18 | : short? dup here - 4096 < ; 19 | : comp, short? if rcall, else call, then ; 20 | 21 | : branch?, s" branch?" "' rcall, 0<>, ; 22 | : dup, s" dup" "' rcall, ; 23 | 24 | : t-num dup, dup 255 and # r26 ldi, 8 rshift # r27 ldi, ; 25 | 26 | : prologue, ; 27 | : end-target ; 28 | -------------------------------------------------------------------------------- /target/avr/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: exit ret, ; 3 | h: nip 2 # r28 adiw, ; 4 | h: cell+ 2 # r26 adiw, ; 5 | h: 1+ 1 # r26 adiw, ; 6 | h: 1- 1 # r26 sbiw, ; 7 | 8 | h: if branch?, if, ; 9 | h: ahead ahead, ; 10 | h: then then, ; 11 | h: else else, ; 12 | 13 | h: begin begin, ; 14 | h: again again, ; 15 | h: until branch?, until, ; 16 | h: while branch?, while, ; 17 | h: repeat repeat, ; 18 | previous 19 | -------------------------------------------------------------------------------- /target/msp430/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2016 Lars Brinkhoff. 2 | 3 | \ Assembler for Texas Instruments MSP430. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and MSP430 opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: Traditional assembler: 13 | \ - immediate: "n #" #n 14 | \ - relative: n n 15 | \ - absolute: n & &n 16 | \ - register: Rx 17 | \ - indexed: "n )#" n(Rx) 18 | \ - indirect: " )" @Rx 19 | \ - postincrement: " )+" @Rx+ 20 | 21 | require search.fth 22 | also forth definitions 23 | require lib/common.fth 24 | 25 | vocabulary assembler 26 | 27 | base @ hex 28 | 29 | \ Assembler state. 30 | variable opcode 31 | variable bw 32 | create ext 2 cells allot 33 | variable #ext 34 | 35 | \ Instruction fields. 36 | : opcode! 3@ drop >r opcode ! ; 37 | : opcode@ opcode @ ; 38 | : .w 0000 bw ! ; 39 | : .b 0040 bw ! ; 40 | 41 | \ Reset assembler state. 42 | : 0asm 0 #ext ! .w ; 43 | 44 | \ Write instruction fields to memory. 45 | previous 46 | : h, dup c, 8 rshift c, ; 47 | : h@ dup c@ swap 1+ c@ 8 lshift + ; 48 | : h! 2dup c! 1+ swap 8 rshift swap c! ; 49 | : j+! tuck h@ tuck + 03FF and swap FC00 and + swap h! ; 50 | : opcode, opcode@ h, ; 51 | : pc- here 2 + - 0FFFF and ; 52 | also forth 53 | 54 | \ Operand addressing modes. 55 | -200000 constant register 56 | 000000 constant indexed 57 | 200000 constant indirect 58 | 400000 constant post-increment 59 | : >mode register - + ; 60 | 61 | \ Operand address. 62 | 010000 constant offset 63 | : >ext + offset invert and ; 64 | 65 | \ Operand register. 66 | : >reg 011 lshift register + offset + ; 67 | 68 | \ Extension words. 69 | : ext, #ext @ begin ?dup while 1- dup cells ext + @ h, repeat ; 70 | : !ext ext #ext @ cells + ! 1 #ext +! ; 71 | : ext? offset and 0= ; 72 | : ?ext dup ext? if !ext else drop then ; 73 | 74 | \ Addressing modes. 75 | : )# indexed >mode >ext ; \ (Rn) 76 | : & 2 >reg )# ; \ &n 77 | : ) indirect >mode ; \ @Rn 78 | : )+ post-increment >mode ; \ @Rn+ 79 | : # 0 >reg )+ >ext ; \ #n 80 | 81 | \ Special constants. 82 | : -1# 3 >reg )+ ; 83 | : 0# 3 >reg ; 84 | : 1# 3 >reg indexed >mode ; 85 | : 2# 3 >reg ) ; 86 | : 4# 2 >reg ) ; 87 | : 8# 2 >reg )+ ; 88 | 89 | : relative? 0FFFF invert and 0= ; 90 | : ?relative ( u1 -- u1|u2 ) dup relative? if pc- then ; 91 | 92 | \ Define registers 93 | : reg: dup >reg constant 1+ ; 94 | 95 | \ Convert operand to instruction fields. 96 | : s-reg 01E0000 and 9 rshift opcode +! ; 97 | : d-reg 01E0000 and 11 rshift opcode +! ; 98 | : s-mode 200000 + 11 rshift 0030 and opcode +! ; 99 | : d-mode 200000 + 0E rshift 0080 and opcode +! ; 100 | 101 | \ Instruction formats. 102 | : instruction, ( a -- ) opcode! bw @ opcode +! opcode, ext, 0asm ; 103 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 104 | : format: create ] !csp does> mnemonic ; 105 | 106 | format: 0op ; 107 | format: 1op ?relative dup d-reg dup s-mode ?ext ; 108 | format: 2op ?relative dup d-reg dup d-mode ?ext 109 | ?relative dup s-reg dup s-mode ?ext ; 110 | format: jump pc- 1 rshift 03FF and opcode +! ; 111 | 112 | \ Instruction mnemonics. 113 | previous also assembler definitions 114 | 115 | 1000 1op rrc, 116 | 1080 1op swpb, 117 | 1100 1op rra, 118 | 1180 1op sxt, 119 | 1200 1op push, 120 | 1280 1op call, 121 | 1300 0op reti, 122 | 2000 jump jne, 123 | 2400 jump jeq, 124 | 2800 jump jnc, 125 | 2C00 jump jc, 126 | 3000 jump jn, 127 | 3400 jump jge, 128 | 3800 jump jl, 129 | 3C00 jump jmp, 130 | 4000 2op mov, 131 | 5000 2op add, 132 | 6000 2op addc, 133 | 7000 2op subc, 134 | 8000 2op sub, 135 | 9000 2op cmp, 136 | A000 2op dadd, 137 | B000 2op bit, 138 | C000 2op bic, 139 | D000 2op bis, 140 | E000 2op xor, 141 | F000 2op and, 142 | 143 | \ Registers 144 | 0 145 | reg: pc reg: sp reg: sr reg: r3 reg: r4 reg: r5 reg: r6 reg: r7 146 | reg: r8 reg: r9 reg: r10 reg: r11 reg: r12 reg: r13 reg: r14 reg: r15 147 | drop 148 | 149 | \ Emulated instructions. 150 | : adc, 0# swap add, ; 151 | : br, pc mov, ; 152 | : clr, 0# swap mov, ; 153 | : clrc, 1# sr bic, ; 154 | : clrn, 4# sr bic, ; 155 | : clrz, 2# sr bic, ; 156 | : dadc, 0# swap dadd, ; 157 | : dec, 1# swap sub, ; 158 | : decd, 2# swap sub, ; 159 | : dint, 8# sr bic, ; 160 | : eint, 8# sr bis, ; 161 | : inc, 1# swap add, ; 162 | : incd, 2# swap add, ; 163 | : inv, -1# swap xor, ; 164 | : nop, 0# r3 mov, ; 165 | : pop, sp )+ swap mov, ; 166 | : ret, pc pop, ; 167 | : rla, dup add, ; 168 | : rlc, dup adc, ; 169 | : sbc, 0# swap subc, ; 170 | : setc, 1# sr bis, ; 171 | : setn, 4# sr bis, ; 172 | : setz, 2# sr bis, ; 173 | : tst, 0# swap cmp, ; 174 | 175 | \ Resolve jumps. 176 | : >mark here 2 - ['] j+! here ; 177 | : >resolve pc- negate 1 rshift -rot execute ; 178 | 179 | \ Unconditional jumps. 180 | : label here >r get-current ['] assembler set-current r> constant set-current ; 181 | : begin, here ; 182 | : again, jmp, ; 183 | : ahead, here jmp, >mark ; 184 | : then, >resolve ; 185 | 186 | \ Conditional jumps. 187 | : 0=, ['] jne, ; 188 | : 0<, ['] jge, ; 189 | : 0<>, ['] jeq, ; 190 | : if, here swap execute >mark ; 191 | : until, execute ; 192 | 193 | : 3swap >r rot >r 2swap 2r> >r -rot r> ; 194 | : else, ahead, 3swap then, ; 195 | : while, >r if, r> ; 196 | : repeat, again, then, ; 197 | 198 | \ Runtime for ;CODE. CODE! is defined elsewhere. 199 | : (;code) r> code! ; 200 | 201 | \ Enter and exit assembler mode. 202 | : start-code also assembler 0asm ; 203 | : end-code align previous ; 204 | 205 | base ! 206 | 207 | previous definitions also assembler 208 | 209 | \ Standard assembler entry points. 210 | : code parse-name header, ?code, reveal start-code ; 211 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 212 | 213 | 0asm 214 | previous 215 | -------------------------------------------------------------------------------- /target/msp430/nucleus.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | code cold 4 | 0280 # sp mov, \ Set return stack pointer. 5 | 0270 # r4 mov, \ Set data stack pointer. 6 | ahead, \ Jump to WARM. 7 | end-code 8 | 9 | code ! 10 | r4 )+ 0 r5 )# mov, 11 | \ Fall through. 12 | end-code 13 | 14 | : drop drop ; 15 | 16 | code c! 17 | r4 )+ 0 r5 )# .b mov, 18 | 1# r4 add, 19 | ' drop jmp, 20 | end-code 21 | 22 | code dup 23 | 2# r4 sub, 24 | r5 0 r4 )# mov, 25 | ret, 26 | end-code 27 | 28 | code ?dup 29 | r5 tst, 30 | 0<>, if, 31 | ' dup jmp, 32 | then, 33 | ret, 34 | end-code 35 | 36 | code swap 37 | r4 ) r6 mov, 38 | r5 0 r4 )# mov, 39 | r6 r5 mov, 40 | ret, 41 | end-code 42 | 43 | code over 44 | ] dup [ also assembler 45 | 2 r4 )# r5 mov, 46 | ret, 47 | end-code 48 | 49 | code r> 50 | r6 pop, 51 | ] dup [ also assembler 52 | r5 pop, 53 | r6 br, 54 | end-code 55 | 56 | code 0= 57 | r5 tst, 58 | label zero? 59 | 0=, if, 60 | -1# r5 mov, 61 | ret, 62 | then, 63 | 0# r5 mov, 64 | ret, 65 | end-code 66 | 67 | code = 68 | r4 )+ r5 sub, 69 | zero? jmp, 70 | end-code 71 | 72 | code 0< 73 | r5 tst, 74 | 0<, if, 75 | -1# r5 mov, 76 | ret, 77 | then, 78 | 0# r5 mov, 79 | ret, 80 | end-code 81 | 82 | code +! 83 | r4 )+ 0 r5 )# add, 84 | ' drop jmp, 85 | end-code 86 | 87 | code r@ 88 | ] dup [ also assembler 89 | 2 sp )# r5 mov, 90 | ret, 91 | end-code 92 | 93 | : - negate + ; 94 | : <> - [ \ Fall through. 95 | : 0<> 0= 0= ; 96 | 97 | code bye 98 | 0# 0 & mov, 99 | end-code 100 | 101 | code panic 102 | 1# 0 & mov, 103 | end-code 104 | -------------------------------------------------------------------------------- /target/msp430/params.fth: -------------------------------------------------------------------------------- 1 | 1 constant t-little-endian 2 | 2 constant t-cell 3 | hex F800 constant program-start 4 | 200 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/msp430/target.mk: -------------------------------------------------------------------------------- 1 | START = 0xF800 2 | OPTS = -msp430 -break_io 0x0000 -set_pc $(START) -bin -address $(START) 3 | 4 | test-image: image 5 | naken_util $(OPTS) -run image > $@ 6 | 7 | upload: image.hex 8 | sudo mspdebug rf2500 "prog $<" 9 | -------------------------------------------------------------------------------- /target/msp430/x1.fth: -------------------------------------------------------------------------------- 1 | \ MSP430 backend. 2 | \ 3 | \ Subroutine threaded. Operations no longer than a CALL instruction 4 | \ are inlined. 5 | \ 6 | \ Register usage: 7 | \ r0 Program counter. 8 | \ r1 Return stack pointer. 9 | \ r2 Status register. 10 | \ r4 Data stack pointer. 11 | \ r5 Top of stack. 12 | \ r6 Temporary. 13 | 14 | 15 | only forth 16 | 17 | also meta definitions also assembler 18 | 19 | : comp, # call, ; 20 | 21 | : branch?, r5 tst, r4 )+ r5 mov, 0<>, ; 22 | : dup, s" dup" "' # call, ; 23 | 24 | : t-num dup, # r5 mov, ; 25 | 26 | : prologue, ; 27 | 28 | hex 29 | : vectors, 30 | FFE0 here - allot 31 | 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 32 | 0 , 0 , 0 , 0 , 0 , 0 , 0 , 33 | 0F800 , ; 34 | decimal 35 | 36 | : end-target vectors, ; 37 | -------------------------------------------------------------------------------- /target/msp430/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: + r4 )+ r5 add, ; 3 | h: and r4 )+ r5 and, ; 4 | h: or r4 )+ r5 bis, ; 5 | h: xor r4 )+ r5 xor, ; 6 | h: 2* r5 rla, ; 7 | h: 2/ r5 rra, ; 8 | h: invert r5 inv, ; 9 | h: @ r5 ) r5 mov, ; 10 | h: c@ r5 ) r5 .b mov, ; 11 | h: drop r4 )+ r5 mov, ; 12 | h: exit ret, ; 13 | h: nip 2# r4 add, ; 14 | h: cell+ 2# r5 add, ; 15 | h: 1+ 1# r5 add, ; 16 | h: 1- 1# r5 sub, ; 17 | h: negate r5 inv, r5 inc, ; 18 | h: >r r5 push, r4 )+ r5 mov, ; 19 | 20 | h: if branch?, if, ; 21 | h: ahead ahead, ; 22 | h: then then, ; 23 | h: else else, ; 24 | 25 | h: begin begin, ; 26 | h: again again, ; 27 | h: until branch?, until, ; 28 | h: while branch?, while, ; 29 | h: repeat repeat, ; 30 | previous 31 | -------------------------------------------------------------------------------- /target/pdp8/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2017 Lars Brinkhoff 2 | 3 | \ Assembler for PDP-8. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and PIC opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: 13 | \ - absolute: n 14 | \ - indirect: n ) 15 | \ - literal: n # 16 | 17 | require search.fth 18 | : cell/ cell / ; 19 | also forth definitions 20 | require lib/common.fth 21 | 22 | vocabulary assembler 23 | 24 | base @ octal 25 | 26 | \ This constant signals that an operand is not a direct address. 27 | -124 constant -addr 28 | 29 | \ Assembler state. 30 | variable opcode 31 | 32 | \ Set opcode. 33 | : opcode! 3@ drop >r opcode ! ; 34 | : field! opcode swap !bits ; 35 | : -z -1 0200 field! ; 36 | : !z 0 0200 field! ; 37 | : !i -1 0400 field! ; 38 | : z? dup 0200 u< ; 39 | : ?z z? if !z else -z then ; 40 | : addr ?z 0177 field! ; 41 | : indirect !i addr ; 42 | 43 | \ Access instruction fields. 44 | : opcode@ opcode @ ; 45 | 46 | \ Literal pool. 47 | variable lit 48 | : 0lit 200 lit ! ; 49 | 0lit 50 | : lit+ -1 lit +! ; 51 | : lit@ lit @ ; 52 | 53 | \ Possibly use a cross-compiling vocabulary to access a target image. 54 | previous definitions 55 | 56 | \ Write instruction fields to memory. 57 | : opcode, opcode@ , ; 58 | : indirect? dup @ 0400 and ; 59 | : jmp! indirect? if @ 177 and cells else swap 0177 and swap then +! ; 60 | 61 | \ Merge two consecutive instructions. 62 | : +, cell negate allot here @ here cell - @ or here cell - ! ; 63 | 64 | \ Store a literal and return its address. 65 | : >l here cell/ -200 and + cells ; 66 | : 'lit lit@ >l ; 67 | : +lit lit+ 'lit ! 'lit cell/ ; 68 | : more? dup 200 < ; 69 | : different? 2dup >l @ <> ; 70 | : >lit ( x -- a ) 71 | lit@ begin more? while different? while 1+ repeat 72 | nip >l cell/ else drop +lit then ; 73 | 74 | \ Advance to next page boundary. 75 | : #left lit@ here cell/ 177 and - ; 76 | : page 0lit #left cells allot ; 77 | : ?page #left 20 < if page then ; 78 | 79 | also forth definitions 80 | 81 | \ Reset assembler state. 82 | : 0asm ; 83 | 84 | \ Process one operand. All operands except a direct address 85 | \ have the stack picture ( n*x xt -addr ). 86 | : addr? dup -addr <> ; 87 | : op addr? if addr else drop execute then ; 88 | 89 | \ Define instruction formats. 90 | : instruction, ( a -- ) opcode! opcode, 0asm ; 91 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 92 | : format: create ] !csp does> mnemonic ; 93 | : immediate: ' latestxt >body ! ; 94 | 95 | \ Instruction formats. 96 | format: 0op ; 97 | format: 1op op ; 98 | format: 2op op op ; 99 | 100 | \ Instruction mnemonics. 101 | previous also assembler definitions 102 | 103 | 0000 1op and, 104 | 1000 1op tad, 105 | 2000 1op isz, 106 | 3000 1op dca, 107 | 4000 1op jms, 108 | 5000 1op jmp, 109 | 110 | 6000 2op iot, 111 | 6001 0op ion, 112 | 6002 0op iof, 113 | 114 | 7000 1op opr, 115 | 7001 0op iac, 116 | 7002 0op bsw, 117 | 7004 0op ral, 118 | 7006 0op rtl, 119 | 7010 0op rar, 120 | 7012 0op rtr, 121 | 7020 0op cml, 122 | 7040 0op cma, 123 | 7041 0op cia, 124 | 7100 0op cll, 125 | 7200 0op cla, 126 | 7402 0op hlt, 127 | 7403 0op scl, 128 | 7404 0op osr, 129 | 7405 0op muy, 130 | 7407 0op dvi, 131 | 7411 0op nmi, 132 | 7413 0op shl, 133 | 7415 0op asr, 134 | 7417 0op lsr, 135 | 7420 0op snl, 136 | 7421 0op mql, 137 | 7440 0op sza, 138 | 7441 0op sca, 139 | 7410 0op skp, 140 | 7430 0op szl, 141 | 7450 0op sna, 142 | 7500 0op sma, 143 | 7501 0op mqa, 144 | 7510 0op spa, 145 | 7621 0op cam, 146 | 147 | \ Addressing mode syntax. 148 | : ) ['] indirect -addr ; 149 | : #i >lit ) ; 150 | : # >lit ; 151 | : +# 0 +lit ) ; 152 | 153 | \ Aliases. 154 | : tca, cma, iac, +, ; 155 | : stl, cll, cml, +, ; 156 | : nop, 0 opr, ; 157 | 158 | \ Register names. 159 | 160 | \ Resolve jumps. 161 | : >mark here cell - ; 162 | : >resolve here cell/ swap jmp! ; 163 | 164 | \ Unconditional jumps. 165 | : label here >r get-current ['] assembler set-current r> constant set-current ; 166 | : begin, here cell/ ; 167 | : again, jmp, ; 168 | : ahead, 200 jmp, >mark ; 169 | : then, >resolve ; 170 | 171 | \ Conditional jumps. 172 | : zero sza, jmp, ; 173 | : less sma, jmp, ; 174 | : nonzero sna, jmp, ; 175 | : link? snl, jmp, ; 176 | : 0=, ['] zero ; 177 | : 0<, ['] less ; 178 | : 0<>, ['] nonzero ; 179 | : l0<>, ['] link? ; 180 | : if, 200 swap execute >mark ; 181 | : until, execute ; 182 | 183 | : else, ahead, swap then, ; 184 | : while, >r if, r> ; 185 | : repeat, again, then, ; 186 | 187 | \ Runtime for ;CODE. CODE! is defined elsewhere. 188 | : (;code) r> code! ; 189 | 190 | \ Enter and exit assembler mode. 191 | : start-code also assembler 0asm ; 192 | : end-code align previous ; 193 | 194 | also forth base ! previous 195 | 196 | previous definitions also assembler 197 | 198 | \ Standard assembler entry points. 199 | : code parse-name header, ?code, reveal start-code ; 200 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 201 | 202 | 0asm 203 | previous 204 | -------------------------------------------------------------------------------- /target/pdp8/convert.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | a=0 4 | 5 | word() 6 | { 7 | test -z "$1" && exit 0 8 | printf 'd %04o %s\n' $a $1 9 | a=`expr $a + 1` 10 | } 11 | 12 | convert() { 13 | while read i; do 14 | set $i 15 | word $2 16 | word $3 17 | word $4 18 | word $5 19 | word $6 20 | word $7 21 | word $8 22 | word $9 23 | done 24 | } 25 | 26 | od -v | convert 27 | -------------------------------------------------------------------------------- /target/pdp8/nucleus.fth: -------------------------------------------------------------------------------- 1 | octal 2 | 3 | code cold 4 | cla, 5 | 7000 # tad, 6 | sp dca, 7 | 6400 # tad, 8 | rp dca, 9 | +# jmp, >mark 10 | end-code 11 | 12 | \ The stack pointers use auto incrementation. 13 | 10 cells here - allot 14 | 0 , 15 | 0 , 16 | 17 | 20 cells here - allot 18 | 19 | code bye 20 | hlt, 21 | end-code 22 | 23 | code panic 24 | hlt, 25 | end-code 26 | 27 | code push 28 | temp1 dca, 29 | sp tad, 30 | temp2 dca, 31 | temp1 tad, 32 | temp2 ) dca, 33 | cma, 34 | temp2 tad, 35 | sp dca, 36 | exit, 37 | end-code 38 | 39 | code dup 40 | ' push jms, 41 | temp1 tad, 42 | exit, 43 | end-code 44 | 45 | code drop 46 | cla, 47 | sp ) tad, 48 | exit, 49 | end-code 50 | 51 | code swap 52 | temp1 dca, 53 | cla, iac, +, 54 | sp tad, 55 | temp2 dca, 56 | temp2 ) tad, 57 | temp3 dca, 58 | temp1 tad, 59 | temp2 ) dca, 60 | temp3 tad, 61 | exit, 62 | end-code 63 | 64 | code over 65 | ' push jms, 66 | cla, cll, +, cml, +, rtl, +, 67 | sp tad, 68 | temp1 dca, 69 | temp1 ) tad, 70 | exit, 71 | end-code 72 | 73 | code xor 74 | temp1 dca, 75 | sp ) tad, 76 | temp2 dca, 77 | temp1 tad, 78 | temp2 and, 79 | cma, iac, 80 | cll, ral, 81 | temp1 tad, 82 | temp2 tad, 83 | exit, 84 | end-code 85 | 86 | code or 87 | cma, 88 | temp1 dca, 89 | sp ) tad, 90 | cma, 91 | temp1 and, 92 | cma, 93 | exit, 94 | end-code 95 | 96 | code 2/ 97 | cll, cml, +, 98 | sma, 99 | cml, 100 | rar, 101 | exit, 102 | end-code 103 | 104 | code >r 105 | temp1 dca, 106 | rp tad, 107 | temp2 dca, 108 | temp1 tad, 109 | temp2 ) dca, 110 | cma, 111 | temp2 tad, 112 | rp dca, 113 | sp ) tad, 114 | exit, 115 | end-code 116 | 117 | code r> 118 | ' push jms, 119 | rp ) tad, 120 | exit, 121 | end-code 122 | 123 | code r@ 124 | ' push jms, 125 | iac, 126 | rp tad, 127 | temp1 dca, 128 | temp1 ) tad, 129 | exit, 130 | end-code 131 | 132 | code @ 133 | temp1 dca, 134 | temp1 ) tad, 135 | exit, 136 | end-code 137 | 138 | : +! dup >r @ + r> [ \ Fall through. 139 | 140 | code ! 141 | temp1 dca, 142 | sp ) tad, 143 | temp1 ) dca, 144 | sp ) tad, 145 | exit, 146 | end-code 147 | 148 | : c! ! ; 149 | : c@ @ ; 150 | 151 | code branch? 152 | cll, 153 | sza, 154 | cml, 155 | cla, 156 | sp ) tad, 157 | exit, 158 | end-code 159 | 160 | code 0 161 | ' push jms, 162 | \ AC is already cleared. 163 | exit, 164 | end-code 165 | 166 | code 1 167 | ' push jms, 168 | cla, iac, +, 169 | exit, 170 | end-code 171 | 172 | code 2 173 | ' push jms, 174 | cla, cll, +, cml, +, rtl, +, 175 | exit, 176 | end-code 177 | 178 | code -1 179 | ' push jms, 180 | cla, cma, +, 181 | exit, 182 | end-code 183 | 184 | code -2 185 | ' push jms, 186 | cla, cma, +, cll, +, ral, +, 187 | exit, 188 | end-code 189 | 190 | code -3 191 | ' push jms, 192 | cla, cma, +, cll, +, rtl, +, 193 | exit, 194 | end-code 195 | 196 | code 0< 197 | 0<, if, 198 | cla, cma, +, 199 | else, 200 | cla, 201 | then, 202 | exit, 203 | end-code 204 | 205 | : 1- 1 [ \ Fall through. 206 | : - negate + ; 207 | : = - [ \ Fall through. 208 | : 0= if 0 else -1 then ; 209 | : <> - [ \ Fall through. 210 | : 0<> 0= 0= ; 211 | -------------------------------------------------------------------------------- /target/pdp8/params.fth: -------------------------------------------------------------------------------- 1 | 1 constant t-little-endian 2 | 2 constant t-cell 3 | 0 constant program-start 4 | 8 base ! 4000 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/pdp8/target.mk: -------------------------------------------------------------------------------- 1 | image.simh: image 2 | $(TDIR)/convert.sh < $< > $@ 3 | 4 | test-image: image.simh 5 | printf 'run 0\nquit\n' | pdp8 $< > $@ 6 | ! grep "HALT instruction, PC: 00024" $@ 7 | grep "HALT instruction, PC: 00022" $@ 8 | -------------------------------------------------------------------------------- /target/pdp8/x1.fth: -------------------------------------------------------------------------------- 1 | \ PDP-8 backend. 2 | \ 3 | \ Subroutine threaded. To save space, most operations are NOT inlined. 4 | \ 5 | \ Register usage: 6 | \ AC - TOS 7 | 8 | only forth 9 | octal 10 | 11 | 5 constant temp1 12 | 6 constant temp2 13 | 7 constant temp3 14 | 10 constant sp 15 | 11 constant rp 16 | 17 | 1 constant t-cell 18 | 19 | also meta definitions also assembler 20 | 21 | : header, header, 0 , ; 22 | 23 | : >page 7 rshift ; 24 | : near? dup >page dup 0= swap here cell/ >page = or ; 25 | : comp, cell/ near? if jms, else #i jms, then ; 26 | 27 | : exit, latest cell/ ) jmp, ; 28 | 29 | : branch?, s" branch?" "' comp, l0<>, ; 30 | : push, s" push" "' comp, ; 31 | 32 | : t-num push, # tad, ; 33 | 34 | : ' ' cell/ ; 35 | 36 | : prologue, ; 37 | : end-target page ; 38 | -------------------------------------------------------------------------------- /target/pdp8/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: exit exit, ?page ; 3 | h: nip sp isz, ; 4 | h: + sp ) tad, ; 5 | h: and sp ) and, ; 6 | h: invert cma, ; 7 | h: 1+ iac, ; 8 | h: cell+ iac, ; 9 | h: 2* cll, ral, +, ; 10 | h: negate cma, iac, +, ; 11 | h: cells ; 12 | 13 | h: if branch?, if, ; 14 | h: ahead ahead, ; 15 | h: then then, ; 16 | h: else else, ; 17 | 18 | h: begin begin, ; 19 | h: again again, ; 20 | h: until branch?, until, ; 21 | h: while branch?, while, ; 22 | h: repeat repeat, ; 23 | previous 24 | -------------------------------------------------------------------------------- /target/pic/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2017 Lars Brinkhoff 2 | 3 | \ Assembler for midrange PIC. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and PIC opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: 13 | \ - immediate: "n #" 14 | \ - absolute: n 15 | \ - register: 16 | \ - preincrement: - 17 | \ - postdecrement: + 18 | \ - indirect with offset: "n )#" 19 | 20 | require search.fth 21 | also forth definitions 22 | require lib/common.fth 23 | 24 | vocabulary assembler 25 | 26 | base @ hex 27 | 28 | \ This constant signals that an operand is not a direct address. 29 | deadbeef constant -addr 30 | 31 | \ Assembler state. 32 | variable opcode 33 | 34 | \ Set opcode. 35 | : opcode! 3@ drop >r opcode ! ; 36 | : field! opcode swap !bits ; 37 | : !bit 7 lshift opcode +! ; 38 | : !literal 00FF field! ; 39 | : !f 007F field! ; 40 | : !d 80 opcode +! ; 41 | : addr 03FF field! ; 42 | 43 | 44 | \ Access instruction fields. 45 | : opcode@ opcode @ ; 46 | 47 | \ Possibly use a cross-compiling vocabulary to access a target image. 48 | previous definitions 49 | 50 | \ Write instruction fields to memory. 51 | : opcode, opcode@ , ; 52 | : jmp! swap 03FF and swap +! ; 53 | 54 | also forth definitions 55 | 56 | \ Reset assembler state. 57 | : 0asm ; 58 | 59 | \ Process one operand. All operands except a direct address 60 | \ have the stack picture ( n*x xt -addr ). 61 | : addr? dup -addr <> ; 62 | : op addr? if addr else drop execute then ; 63 | 64 | \ Define instruction formats. 65 | : instruction, ( a -- ) opcode! opcode, 0asm ; 66 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 67 | : format: create ] !csp does> mnemonic ; 68 | : immediate: ' latestxt >body ! ; 69 | 70 | \ Instruction formats. 71 | format: 0op ; 72 | format: 1op !f ; 73 | format: byte-oriented !f op ; 74 | format: bit-oriented !f !bit ; 75 | format: literal-oriented !literal ; 76 | format: jump 2/ addr ; 77 | format: movlb opcode +! ; 78 | 79 | \ Define registers 80 | 81 | \ Instruction mnemonics. 82 | previous also assembler definitions 83 | 84 | 0000 0op nop, 85 | \ 0001*reset 86 | 0008 0op return, 87 | 0009 0op retfie, 88 | \ 000A*callw 89 | \ 000A*brw 90 | \ 0010*moviw 91 | \ 0018*movwi 92 | 0020 movlb movlb, 93 | \ 0062 option 94 | 0063 0op sleep, 95 | 0064 0op clrwdt, 96 | 97 | 0080 1op movwf, 98 | 0180 1op clrf, 99 | 0100 0op clrw, 100 | 0200 byte-oriented subwf, 101 | 0300 byte-oriented decf, 102 | 0400 byte-oriented iorwf, 103 | 0500 byte-oriented andwf, 104 | 0600 byte-oriented xorwf, 105 | 0700 byte-oriented addwf, 106 | 0800 byte-oriented movf, 107 | 0900 byte-oriented comf, 108 | 0A00 byte-oriented incf, 109 | 0B00 byte-oriented decfsz, 110 | 0C00 byte-oriented rrf, 111 | 0D00 byte-oriented rlf, 112 | 0E00 byte-oriented swapf, 113 | 0F00 byte-oriented incfsz, 114 | 115 | 1000 bit-oriented bcf, 116 | 1400 bit-oriented bsf, 117 | 1800 bit-oriented btfsc, 118 | 1C00 bit-oriented btfss, 119 | 120 | 2000 jump call, 121 | 2800 jump goto, 122 | 123 | 3000 literal-oriented movlw, 124 | \ 3100*addfsr 125 | \ 3180*movlp 126 | \ 3200*bra 127 | 3400 literal-oriented retlw, 128 | \ 3500*lslf 129 | \ 3600*lsrf 130 | \ 3700*asrf 131 | 3800 literal-oriented iorlw, 132 | 3900 literal-oriented andlw, 133 | 3A00 literal-oriented xorlw, 134 | \ 3B00*subwfb 135 | 3C00 literal-oriented sublw, 136 | \ 3D00*addwfc 137 | 3E00 literal-oriented addlw, 138 | \ 3F00*moviw 139 | \ 3F80*movwi 140 | 141 | 142 | \ Register names. 143 | : w ['] noop -addr ; 144 | : f ['] !d -addr ; 145 | : indf 0 ; 146 | : pcl 1 ; 147 | : status 3 ; 148 | : fsr 4 ; 149 | : pclath 0A ; 150 | : intcn 0B ; 151 | : option_reg 81 ; 152 | 153 | \ Resolve jumps. 154 | : >mark here cell - ; 155 | : >resolve here 2/ swap jmp! ; 156 | 157 | \ Unconditional jumps. 158 | : label here >r get-current ['] assembler set-current r> constant set-current ; 159 | : begin, here ; 160 | : again, goto, ; 161 | : ahead, 0 goto, >mark ; 162 | : then, >resolve ; 163 | 164 | \ Conditional jumps. 165 | : zero? 2 status btfss, goto, ; 166 | : not-zero? 2 status btfsc, goto, ; 167 | : 0=, ['] zero? ; 168 | : 0<>, ['] not-zero? ; 169 | : if, 0 swap execute >mark ; 170 | : until, execute ; 171 | 172 | : else, ahead, swap then, ; 173 | : while, >r if, r> ; 174 | : repeat, again, then, ; 175 | 176 | \ Runtime for ;CODE. CODE! is defined elsewhere. 177 | : (;code) r> code! ; 178 | 179 | \ Enter and exit assembler mode. 180 | : start-code also assembler 0asm ; 181 | : end-code align previous ; 182 | 183 | also forth base ! previous 184 | 185 | previous definitions also assembler 186 | 187 | \ Standard assembler entry points. 188 | : code parse-name header, ?code, reveal start-code ; 189 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 190 | 191 | 0asm 192 | previous 193 | -------------------------------------------------------------------------------- /target/pic/nucleus.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | code cold 4 | 5 status bsf, 5 | 0F movlw, 6 | option_reg movwf, 7 | 5 status bcf, 8 | clrwdt, 9 | 10 | 50 movlw, 11 | s movwf, 12 | 13 | 40 movlw, 14 | rp movwf, 15 | 16 | ahead, 17 | end-code 18 | 19 | code dup 20 | -2 movlw, 21 | f s addwf, 22 | 23 | w s movf, 24 | fsr movwf, 25 | w t movf, 26 | indf movwf, 27 | 28 | f fsr incf, 29 | w t 1+ movf, 30 | indf movwf, 31 | 32 | return, 33 | end-code 34 | 35 | code nip 36 | 2 movlw, 37 | f s addwf, 38 | return, 39 | end-code 40 | 41 | code invert 42 | f t comf, 43 | f t 1+ comf, 44 | return, 45 | end-code 46 | 47 | : negate invert [ \ Fall through. 48 | : 1+ 1 [ \ Fall through. 49 | 50 | code + 51 | w s movf, 52 | fsr movwf, 53 | w indf movf, 54 | f t addwf, 55 | 0 status btfsc, 56 | f t 1+ incf, 57 | f fsr incf, 58 | w indf movf, 59 | f t 1+ addwf, 60 | ' nip goto, 61 | end-code 62 | 63 | code and 64 | w s movf, 65 | fsr movwf, 66 | w indf movf, 67 | f t andwf, 68 | f fsr incf, 69 | w indf movf, 70 | f t 1+ andwf, 71 | ' nip goto, 72 | end-code 73 | 74 | code or 75 | w s movf, 76 | fsr movwf, 77 | w indf movf, 78 | f t iorwf, 79 | f fsr incf, 80 | w indf movf, 81 | f t 1+ iorwf, 82 | ' nip goto, 83 | end-code 84 | 85 | code xor 86 | w s movf, 87 | fsr movwf, 88 | w indf movf, 89 | f t xorwf, 90 | f fsr incf, 91 | w indf movf, 92 | f t 1+ xorwf, 93 | ' nip goto, 94 | end-code 95 | 96 | : 2* dup + ; 97 | 98 | code 2/ 99 | 0 status bcf, 100 | 7 t 1+ btfsc, 101 | 0 status bsf, 102 | f t 1+ rrf, 103 | f t rrf, 104 | return, 105 | end-code 106 | 107 | code @ 108 | w t movf, 109 | fsr movwf, 110 | w indf movf, 111 | t movwf, 112 | f fsr incf, 113 | w indf movf, 114 | t 1+ movwf, 115 | return, 116 | end-code 117 | 118 | code c@ 119 | ] @ [ also assembler 120 | t 1+ clrf, 121 | return, 122 | end-code 123 | 124 | code swap 125 | w t movf, 126 | x movwf, 127 | w t 1+ movf, 128 | x 1+ movwf, 129 | 130 | w s movf, 131 | fsr movwf, 132 | w indf movf, 133 | t movwf, 134 | f fsr incf, 135 | w indf movf, 136 | t 1+ movwf, 137 | 138 | w x 1+ movf, 139 | indf movwf, 140 | f fsr decf, 141 | w x movf, 142 | indf movwf, 143 | 144 | return, 145 | end-code 146 | 147 | : r> rp @ dup @ swap 2 + rp [ \ Fall through. 148 | 149 | code ! 150 | w s movf, 151 | fsr movwf, 152 | w indf movf, 153 | x movwf, 154 | f fsr incf, 155 | w indf movf, 156 | x 1+ movwf, 157 | 158 | w t movf, 159 | fsr movwf, 160 | w x movf, 161 | indf movwf, 162 | 163 | f fsr incf, 164 | w x 1+ movf, 165 | indf movwf, 166 | 167 | 2 movlw, 168 | f s addwf, 169 | \ Fall through. 170 | end-code 171 | 172 | code drop 173 | w s movf, 174 | fsr movwf, 175 | w indf movf, 176 | t movwf, 177 | 178 | f fsr incf, 179 | w indf movf, 180 | t 1+ movwf, 181 | 182 | 2 movlw, 183 | f s addwf, 184 | 185 | return, 186 | end-code 187 | 188 | code c! 189 | w s movf, 190 | fsr movwf, 191 | w indf movf, 192 | x movwf, 193 | 194 | w t movf, 195 | fsr movwf, 196 | w x movf, 197 | indf movwf, 198 | 199 | 2 movlw, 200 | f s addwf, 201 | ' drop goto, 202 | end-code 203 | 204 | code over 205 | ] dup [ also assembler 206 | 207 | w s movf, 208 | 2 addlw, 209 | fsr movwf, 210 | 211 | w indf movf, 212 | t movwf, 213 | f fsr incf, 214 | w indf movf, 215 | t 1+ movwf, 216 | 217 | return, 218 | end-code 219 | 220 | code branch? 221 | w t movf, 222 | w t 1+ iorwf, 223 | x movwf, 224 | ' drop call, 225 | f x movf, 226 | return, 227 | end-code 228 | 229 | code 0< 230 | 0 movlw, 231 | 7 t 1+ btfsc, 232 | FF movlw, 233 | t movwf, 234 | t 1+ movwf, 235 | return, 236 | end-code 237 | 238 | : ?dup dup if dup then ; 239 | : 1- 1 [ \ Fall through. 240 | : - negate + ; 241 | : >r rp @ 2 - dup rp ! ! ; 242 | : r@ rp @ @ ; 243 | : +! dup >r @ + r> ! ; 244 | : = - [ \ Fall through. 245 | : 0= if 0 else -1 then ; 246 | : 0<> 0= 0= ; 247 | : <> invert 1+ + if -1 else 0 then ; 248 | 249 | : cell+ 2 + ; 250 | 251 | code bye 252 | 60 movwf, 253 | end-code 254 | 255 | code panic 256 | 63 movwf, 257 | end-code 258 | -------------------------------------------------------------------------------- /target/pic/params.fth: -------------------------------------------------------------------------------- 1 | 1 constant t-little-endian 2 | 2 constant t-cell 3 | 0 constant program-start 4 | hex 28 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/pic/target.mk: -------------------------------------------------------------------------------- 1 | START=0 2 | 3 | test-image: image.hex 4 | gpsim -c $(TDIR)/test.stc > $@ 5 | ! grep INVREG_63 $@ 6 | grep INVREG_60 $@ 7 | 8 | upload: image.hex 9 | sudo /opt/microchip/mplabx/v4.01/mplab_ide/bin/mdb.sh $(TDIR)/upload.mdb 10 | -------------------------------------------------------------------------------- /target/pic/test.stc: -------------------------------------------------------------------------------- 1 | processor pic16f84 2 | load ../../image.hex 3 | run 4 | quit 5 | -------------------------------------------------------------------------------- /target/pic/upload.mdb: -------------------------------------------------------------------------------- 1 | device pic16f1619 2 | set system.disableerrormsg true 3 | hwtool sk -p 4 | program "./image.hex" 5 | reset mclr 6 | quit 7 | -------------------------------------------------------------------------------- /target/pic/x1.fth: -------------------------------------------------------------------------------- 1 | \ PIC backend. 2 | \ 3 | \ Subroutine threaded. To save space, most operations are NOT inlined. 4 | \ 5 | \ Register usage: 6 | 7 | 8 | only forth 9 | 10 | 32 constant s 11 | 34 constant t 12 | 36 constant x 13 | 38 constant rp 14 | 15 | also meta definitions also assembler 16 | 17 | : comp, call, ; 18 | 19 | : branch?, s" branch?" "' call, 0<>, ; 20 | : dup, s" dup" "' call, ; 21 | 22 | : t-num dup, dup 255 and movlw, t movwf, 8 rshift movlw, t 1+ movwf, ; 23 | 24 | : prologue, ; 25 | : end-target ; 26 | -------------------------------------------------------------------------------- /target/pic/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: exit return, ; 3 | h: clrwdt clrwdt, ; 4 | 5 | h: if branch?, if, ; 6 | h: ahead ahead, ; 7 | h: then then, ; 8 | h: else else, ; 9 | 10 | h: begin begin, ; 11 | h: again again, ; 12 | h: until branch?, until, ; 13 | h: while branch?, while, ; 14 | h: repeat repeat, ; 15 | previous 16 | 17 | rp t-constant rp 18 | -------------------------------------------------------------------------------- /target/stm8/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2017 Lars Brinkhoff 2 | 3 | \ Assembler for STM8. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and AVR opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: 13 | \ - immediate: "n #" 14 | \ - absolute: n 15 | \ - register: a, sp, x, y, xl, xh, yl, yh 16 | \ - indexed: () 17 | \ - indexed and offset: n ,) 18 | \ - indirect: n ) 19 | \ - indirect and indexed: n ),) 20 | 21 | require search.fth 22 | also forth definitions 23 | require lib/common.fth 24 | 25 | vocabulary assembler 26 | 27 | base @ hex 28 | 29 | \ This constant signals that an operand is not a direct address. 30 | deadbeef constant -addr 31 | 32 | \ Assembler state. 33 | variable opcode 34 | variable mode 35 | variable prefix 36 | defer !modeprefix 37 | variable data defer ?data, 38 | 39 | \ Set opcode. 40 | : opcode! 3@ drop >r opcode ! ; 41 | : !mode mode +! ; 42 | : !prefix prefix ! ; 43 | : !foo-modeprefix 2drop !mode !prefix ; 44 | : !bar-modeprefix !mode !prefix 2drop ; 45 | : !no-modeprefix 2drop 2drop ; 46 | 47 | \ Access instruction fields. 48 | : opcode@ opcode @ mode @ + ; 49 | : mode@ mode @ ; 50 | : prefix@ prefix @ ; 51 | : prefix! prefix ! ; 52 | : data@ data @ ; 53 | 54 | \ Possibly use a cross-compiling vocabulary to access a target image. 55 | previous 56 | 57 | \ Write instruction fields to memory. 58 | : w, dup 8 rshift c, c, ; 59 | : w! over 8 rshift over c! 1+ c! ; 60 | : ?prefix, prefix@ ?dup if c, then ; 61 | : opcode, ?prefix, opcode@ c, ; 62 | : data8, data@ c, ; 63 | : data16, data@ w, ; 64 | : pc- here - 2 - ; 65 | 66 | also forth 67 | 68 | : ?cpw opcode@ C3 = if -20 opcode +! 0 r> drop then ; 69 | : ?call opcode@ BD = if 10 opcode +! 0 r> drop then ; 70 | : ?exg opcode@ 31 = if 0 r> drop then ; 71 | : ?pop opcode@ 32 = if 0 r> drop then ; 72 | : ?push opcode@ 3B = if 0 r> drop then ; 73 | : ?ldw opcode@ AE = if 0 r> drop then ; 74 | : short? ?ldw ?push ?pop ?exg ?call ?cpw dup 100 u< ; 75 | 76 | : range-error ." Jump range error: " source type abort ; 77 | : ?range dup -80 80 within 0= if range-error then ; 78 | 79 | \ Set operand data. 80 | : !data8 data ! ['] data8, is ?data, ; 81 | : !data16 data ! ['] data16, is ?data, ; 82 | : !data short? if !data8 else !data16 then ; 83 | 84 | : ?pop opcode@ 42 = if 44 opcode ! then ; 85 | : ?push opcode@ 8F = if 06 opcode ! then 86 | opcode@ 4B = if 48 opcode ! then ; 87 | 88 | \ Implements addressing modes. 89 | : imm-op !modeprefix !data ; 90 | : accumulator !modeprefix ?pop ?push ; 91 | : index !modeprefix ; 92 | : absolute !modeprefix !data ; 93 | : indexed !modeprefix !data ; 94 | : indexed-no-offset !modeprefix ; 95 | : indexed-sp !modeprefix !data8 ; 96 | : indirect !modeprefix !data ; 97 | : indirect-indexed !modeprefix !data ; 98 | 99 | \ Reset assembler state. 100 | : 0mode 0 mode ! ; 101 | : 0prefix 0 prefix ! ; 102 | : 0data ['] noop is ?data, ; 103 | : 0modeprefix ['] !no-modeprefix is !modeprefix ; 104 | : 0op 0 opcode ! ; 105 | : 0asm 0mode 0prefix 0data 0modeprefix 0op ; 106 | 107 | \ Process one operand. All operands except a direct address 108 | \ have the stack picture ( n*x xt -addr ). 109 | : addr? dup -addr <> ; 110 | : absolute short? if 00 30 00 B0 else 72 50 00 C0 then absolute ; 111 | : op addr? if absolute else drop execute then ; 112 | 113 | \ 114 | : !foo ['] !foo-modeprefix is !modeprefix ; 115 | : !bar ['] !bar-modeprefix is !modeprefix ; 116 | 117 | \ Define instruction formats. 118 | : instruction, opcode! opcode, ?data, 0asm ; 119 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 120 | : format: create ] !csp does> mnemonic ; 121 | 122 | \ Instruction formats. 123 | format: 0op ; 124 | format: 1op op ; 125 | format: 1op90 90 c, op ; 126 | format: 2op op op ; 127 | format: 1foo !foo op ; 128 | format: 1bar !bar op ; 129 | format: ldx !bar op prefix@ 90 = if 0 prefix! then ; 130 | format: ldy !bar op 131 | prefix@ dup 72 = swap 92 = or if 91 prefix! exit then 132 | prefix@ 91 = if exit then 133 | mode@ 10 = if -8 opcode +! else 90 prefix ! then ; 134 | format: sty !bar op 135 | prefix@ 92 = mode@ C0 = and if 91 prefix! exit then 136 | mode@ 10 = if -8 opcode +! then 137 | mode@ dup B0 = swap C0 = or if 90 prefix ! then ; 138 | format: jump pc- ?range !data8 ; 139 | 140 | \ Instruction mnemonics. 141 | previous also assembler definitions 142 | 143 | \ Addressing mode: no operand. 144 | 80 0op iret, 145 | 81 0op ret, 146 | 83 0op trap, 147 | 65 0op divw, 148 | 51 0op exgw, 149 | 87 0op retf, 150 | 8B 0op break, 151 | 8C 0op ccf, 152 | 8E 0op halt, 153 | 8F 0op wfi, 154 | 98 0op rcf, 155 | 99 0op scf, 156 | 9A 0op rim, 157 | 9B 0op sim, 158 | 9C 0op rvf, 159 | 9D 0op nop, 160 | 161 | \ Addressing mode: register. 162 | 01 1op rrwa, 163 | 02 1op rlwa, 164 | 42 1op mul, 165 | 50 1op negw, 166 | 53 1op cplw, 167 | 54 1op srlw, 168 | 56 1op rrcw, 169 | 57 1op sraw, 170 | 58 1op sllw, 171 | 59 1op rlcw, 172 | 5A 1op decw, 173 | 5C 1op incw, 174 | 5D 1op tnzw, 175 | 5E 1op swapw, 176 | 5F 1op clrw, 177 | 62 1op div, 178 | 85 1op popw, 179 | 89 1op pushw, 180 | 95 1op ldxh, 181 | 97 1op ldxl, 182 | 95 1op90 ldyh, 183 | 97 1op90 ldyl, 184 | 185 | \ Addressing mode: accumulator/memory. 186 | 00 1foo neg, 187 | 01 1foo exg, 188 | 02 1foo pop, 189 | 03 1foo cpl, 190 | 04 1foo srl, 191 | 06 1foo rrc, 192 | 07 1foo sra, 193 | 08 1foo sll, 194 | 09 1foo rlc, 195 | 0A 1foo dec, 196 | 0B 1foo push, 197 | 0C 1foo inc, 198 | 0D 1foo tnz, 199 | 0E 1foo swap, 200 | 0F 1foo clr, 201 | 202 | \ Addressing mode: immediate/memory. 203 | 00 1bar sub, 204 | 01 1bar cp, 205 | 02 1bar sbc, 206 | 03 1bar cpw, 207 | 04 1bar and, 208 | 05 1bar bcp, 209 | 06 1bar lda, 210 | 07 1bar sta, 211 | 08 1bar xor, 212 | 09 1bar adc, 213 | 0A 1bar or, 214 | 0B 1bar add, 215 | 0C 1bar jp, 216 | 0D 1bar call, 217 | 0E ldx ldx, 218 | 0E ldy ldy, 219 | 0F 1bar stx, 220 | 0F sty sty, 221 | 0F 1bar ldsp, 222 | 223 | \ Addressing mode: immediate/memory, memory. 224 | 05 2op mov, 225 | 226 | : addsp, 5B c, c, ; 227 | : subsp, 52 c, c, ; 228 | \ ... addw, 229 | \ ... subw, 230 | 20 jump jra, 231 | 21 jump jrf, 232 | 22 jump jrugt, 233 | 23 jump jrule, 234 | 24 jump jrnc, \ jruge, 235 | 25 jump jrc, \ jrult, 236 | 26 jump jrne, 237 | 27 jump jreq, 238 | 28 jump jrnv, 239 | \ 9028 jrnh, 240 | \ 9029 jrh, 241 | 2A jump jrpl, 242 | 2B jump jrmi, 243 | 2C jump jrsgt, 244 | \ 902C jrnm, 245 | 2D jump jrsle, 246 | \ 902D jrm, 247 | 2E jump jrsge, 248 | \ 902E jril, 249 | 2F jump jrslt, 250 | \ 902F jrih, 251 | \ 53 cplw, 252 | \ 7200 btjf, 253 | \ 7200 btjt, 254 | \ 7210 bres, 255 | \ 7210 bset, 256 | : int, 82 c, dup 010 rshift c, w, ; 257 | : wfe, 72 c, 8F c, ; 258 | \ 9010 bccm, 259 | \ 9010 bcpl, 260 | AD jump callr, 261 | 262 | \ neg sub cpwx cpwy ldwx ldwy ldwmx ldwmy pop popw push pushw addwx addwy subwx subwy exg 263 | \ mode: # A0 A0 90A0 A0 90A0 4B 1C 72A9 1D 72A2 264 | \ mode: a 40 84 88 265 | \ mode: x 9093 85 89 266 | \ mode: y 93 9085 9089 267 | \ mode: xl 41 268 | \ mode: yl 61 269 | \ mode: sp 96 9096 94 "5B" "52" 270 | \ mode: cc 86 8A 271 | \ mode: memS 30 B0 B0 90B0 B0 90B0 B0 90B0 272 | \ mode: memL 7250 C0 C0 90C0 C0 90C0 C0 90C0 32 3B 72BB 72B9 72B0 72B2 31 273 | \ mode: (x) 70 F0 F0 F0 274 | \ mode: (y) 9070 90F0 90F0 90F0 90F0 F0 275 | \ mode: ,x)S 60 E0 E0 E0 90E0 E0 276 | \ mode: ,x)L 7240 D0 D0 D0 90D0 D0 277 | \ mode: ,y)S 9060 90E0 90E0 90E0 278 | \ mode: ,y)L 9040 90D0 90D0 90D0 279 | \ mode: ,sp) 00 10 10 10 16 10 17 72FB 72F9 72F0 72F2 280 | \ mode: )S 9230 92C0 92C0 91C0 92C0 91C0 92C0 91C0 281 | \ mode: )L 7230 72C0 72C0 72C0 91D0 72C0 282 | \ mode: ),x)S 9260 92D0 92D0 92D0 92D0 92D0 283 | \ mode: ),x)L 7260 72D0 72D0 72D0 72D0 92D0 284 | \ mode: ),y) 9160 91D0 91D0 285 | 286 | \ Addressing mode syntax. 287 | \ Stack: ( foo-prefix foo-mode bar-prefix bar-mode ) 288 | : # 00 40 00 A0 ['] imm-op -addr ; 289 | : a 00 40 00 00 ['] accumulator -addr ; 290 | : x 00 00 00 85 ['] index -addr ; 291 | : y 90 00 90 85 ['] index -addr 90 !prefix ; 292 | : sp 00 00 00 88 ['] accumulator -addr ; 293 | : cc 00 84 00 00 ['] accumulator -addr ; 294 | : xl 00 40 00 95 ['] accumulator -addr ; 295 | : xh 00 00 00 99 ['] accumulator -addr ; 296 | : yl 00 60 90 95 ['] accumulator -addr ; 297 | : yh 00 00 90 99 ['] accumulator -addr ; 298 | : (x) 00 70 00 F0 ['] indexed-no-offset -addr ; 299 | : (y) 90 70 90 F0 ['] indexed-no-offset -addr ; 300 | : ,x) short? if 00 60 00 E0 else 72 40 72 D0 then ['] indexed -addr ; 301 | : ,y) short? if 90 60 90 E0 else 90 40 90 D0 then ['] indexed -addr ; 302 | : ,sp) 00 00 00 10 ['] indexed-sp -addr ; 303 | : ) short? if 92 30 92 C0 else 72 30 72 C0 then ['] indirect -addr ; 304 | : ),x) short? if 92 60 92 D0 else 72 60 72 D0 then ['] indirect-indexed -addr ; 305 | : ),y) 91 60 91 D0 ['] indirect-indexed -addr ; 306 | 307 | \ Aliases 308 | 309 | \ Resolve jumps. 310 | : >mark here 1- here ; 311 | : long? dup 7F > over -80 < or ; 312 | : long! 1- 0CC swap c!+ here swap w! ; 313 | : >resolve here swap - long? if drop long! else swap c! then ; 314 | 315 | \ Unconditional jumps. 316 | : label here >r get-current ['] assembler set-current r> constant set-current ; 317 | : begin, here ; 318 | : again, jra, ; 319 | : ahead, here jra, >mark ; 320 | : then, >resolve ; 321 | 322 | \ Conditional jumps. 323 | : 0=, ['] jrne, ; 324 | : 0<, ['] jrpl, ; 325 | : 0<>, ['] jreq, ; 326 | : if, here swap execute >mark ; 327 | : until, execute ; 328 | 329 | : else, ahead, 2swap then, ; 330 | : while, >r if, r> ; 331 | : repeat, again, then, ; 332 | 333 | \ Runtime for ;CODE. CODE! is defined elsewhere. 334 | : (;code) r> code! ; 335 | 336 | \ Enter and exit assembler mode. 337 | : start-code also assembler 0asm ; 338 | : end-code previous ; 339 | 340 | also forth base ! previous 341 | 342 | previous definitions also assembler 343 | 344 | \ Standard assembler entry points. 345 | : code parse-name header, ?code, reveal start-code ; 346 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 347 | 348 | 0asm 349 | previous 350 | -------------------------------------------------------------------------------- /target/stm8/nucleus.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | code cold 4 | \ Interrupt vectors. 5 | 08080 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 6 | 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 7 | 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 8 | 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 0 int, 9 | 3FF # ldx, 10 | x ldsp, 11 | 2FF # ldx, 12 | ahead, nop, \ Leave room to make this a JP. 13 | end-code 14 | 15 | code dup 16 | x ldy, 17 | (y) ldy, 18 | label pushy 19 | x decw, 20 | x decw, 21 | (x) sty, 22 | ret, 23 | end-code 24 | 25 | : drop drop ; 26 | 27 | code >r 28 | exgw, 29 | 1 ,sp) ldx, 30 | x pushw, 31 | y ldx, 32 | (x) ldx, 33 | exgw, 34 | 3 ,sp) sty, 35 | ' drop jra, 36 | ret, 37 | end-code 38 | 39 | code r> 40 | 3 ,sp) ldy, 41 | pushy callr, 42 | y popw, 43 | 2 addsp, 44 | (y) jp, 45 | end-code 46 | 47 | code r@ 48 | 3 ,sp) ldy, 49 | pushy jra, 50 | end-code 51 | 52 | code over 53 | x ldy, 54 | 2 ,y) ldy, 55 | pushy jra, 56 | end-code 57 | 58 | code invert 59 | x ldy, 60 | (y) ldy, 61 | y cplw, 62 | (x) sty, 63 | ret, 64 | end-code 65 | 66 | : negate invert [ \ Fall through. 67 | : 1+ 1 [ \ Fall through. 68 | 69 | code + 70 | 1 ,x) lda, 71 | 3 ,x) add, 72 | 3 ,x) sta, 73 | (x) lda, 74 | 2 ,x) adc, 75 | label store 76 | 2 ,x) sta, 77 | ' drop jra, 78 | end-code 79 | 80 | code xor 81 | 1 ,x) lda, 82 | 3 ,x) xor, 83 | 3 ,x) sta, 84 | (x) lda, 85 | 2 ,x) xor, 86 | store jra, 87 | end-code 88 | 89 | code and 90 | 1 ,x) lda, 91 | 3 ,x) and, 92 | 3 ,x) sta, 93 | (x) lda, 94 | 2 ,x) and, 95 | store jra, 96 | end-code 97 | 98 | code or 99 | 1 ,x) lda, 100 | 3 ,x) or, 101 | 3 ,x) sta, 102 | (x) lda, 103 | 2 ,x) or, 104 | store jra, 105 | end-code 106 | 107 | code 2* 108 | x ldy, 109 | (y) ldy, 110 | y sllw, 111 | (x) sty, 112 | ret, 113 | end-code 114 | 115 | code 2/ 116 | x ldy, 117 | (y) ldy, 118 | y sraw, 119 | (x) sty, 120 | ret, 121 | end-code 122 | 123 | code @ 124 | x ldy, 125 | (y) ldy, 126 | (y) ldy, 127 | (x) sty, 128 | ret, 129 | end-code 130 | 131 | code c@ 132 | x ldy, 133 | (y) ldy, 134 | (y) lda, 135 | (x) clr, 136 | 1 ,x) sta, 137 | ret, 138 | end-code 139 | 140 | : +! dup >r @ + r> [ \ Fall through. 141 | 142 | code ! 143 | x ldy, 144 | (y) ldy, 145 | x pushw, 146 | 2 ,x) ldx, 147 | (y) stx, 148 | x popw, 149 | end-code 150 | 151 | code 2drop 152 | 1C c, 00 c, 04 c, \ 4 # addx, 153 | ret, 154 | end-code 155 | 156 | code c! 157 | x ldy, 158 | (y) ldy, 159 | 3 ,x) lda, 160 | (y) sta, 161 | ' 2drop jra, 162 | end-code 163 | 164 | code swap 165 | x ldy, 166 | 2 ,x) ldx, 167 | x pushw, 168 | y ldx, 169 | (x) ldx, 170 | exgw, 171 | 2 ,x) sty, 172 | y popw, 173 | (x) sty, 174 | ret, 175 | end-code 176 | 177 | code nip 178 | x ldy, 179 | (y) ldy, 180 | x incw, 181 | x incw, 182 | (x) sty, 183 | ret, 184 | end-code 185 | 186 | code branch? 187 | x ldy, 188 | x incw, 189 | x incw, 190 | (y) ldy, 191 | ret, 192 | end-code 193 | 194 | code 0< 195 | a clr, 196 | (x) tnz, 197 | 0<, if, 198 | a dec, 199 | then, 200 | (x) sta, 201 | 1 ,x) sta, 202 | ret, 203 | end-code 204 | 205 | : ?dup dup if dup then ; 206 | : 1- 1 [ \ Fall through. 207 | : - negate + ; 208 | : = - [ \ Fall through. 209 | : 0= -1 swap if 1+ then ; 210 | : <> - [ \ Fall through. 211 | : 0<> 0= 0= ; 212 | : cell+ 1+ 1+ ; 213 | 214 | code bye 215 | break, 216 | end-code 217 | 218 | code panic 219 | 05 c, 220 | end-code 221 | -------------------------------------------------------------------------------- /target/stm8/params.fth: -------------------------------------------------------------------------------- 1 | 0 constant t-little-endian 2 | 2 constant t-cell 3 | hex 8000 constant program-start 4 | 0 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/stm8/target.mk: -------------------------------------------------------------------------------- 1 | START=0x8000 2 | 3 | test-image: image.hex 4 | sstm8 -J -tS103 -C $(TDIR)/test.ucsim > $@ 5 | ! grep "05 UNKNOWN/INVALID" $@ 6 | grep "8b break" $@ 7 | 8 | upload: image.hex 9 | sudo stm8flash -c stlinkv2 -p stm8s103f3 -w $< 10 | 11 | -------------------------------------------------------------------------------- /target/stm8/test.ucsim: -------------------------------------------------------------------------------- 1 | file "image.hex" 2 | pc 0x8080 3 | run 4 | kill 5 | -------------------------------------------------------------------------------- /target/stm8/x1.fth: -------------------------------------------------------------------------------- 1 | \ STM8 backend. 2 | \ 3 | \ Subroutine threaded. To save space, most operations are NOT inlined. 4 | \ 5 | \ Register usage: 6 | \ A - temporary. 7 | \ X - data stack pointer. 8 | \ Y - temporary. 9 | \ SP - return stack pointer. 10 | 11 | only forth 12 | 13 | also meta definitions also assembler 14 | 15 | : pc- here - 2 - ; 16 | : short? dup pc- -128 128 within ; 17 | : comp, short? if callr, else call, then ; 18 | 19 | : branch?, s" branch?" "' comp, 0<>, ; 20 | : dup, s" dup" "' comp, ; 21 | 22 | : !# # lda, (x) sta, ; 23 | : !0 (x) clr, ; 24 | : push x decw, 255 and ?dup if !# else !0 then ; 25 | : t-num dup push 8 rshift push ; 26 | 27 | : prologue, ; 28 | : end-target ; 29 | -------------------------------------------------------------------------------- /target/stm8/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: exit ret, ; 3 | h: drop x incw, x incw, ; 4 | 5 | h: if branch?, if, ; 6 | h: ahead ahead, ; 7 | h: then then, ; 8 | h: else else, ; 9 | 10 | h: begin begin, ; 11 | h: again again, ; 12 | h: until branch?, until, ; 13 | h: while branch?, while, ; 14 | h: repeat repeat, ; 15 | previous 16 | -------------------------------------------------------------------------------- /target/thumb/asm.fth: -------------------------------------------------------------------------------- 1 | \ Copyright 2017 Lars Brinkhoff 2 | 3 | \ Assembler for ARM Thumb2. 4 | 5 | \ Adds to FORTH vocabulary: ASSEMBLER CODE ;CODE. 6 | \ Creates ASSEMBLER vocabulary with: END-CODE and Thumb opcodes. 7 | 8 | \ This will become a cross assembler if loaded with a cross-compiling 9 | \ vocabulary at the top of the search order. 10 | 11 | \ Conventional prefix syntax: " ,". 12 | \ Addressing modes: 13 | \ - immediate: "n #" 14 | \ - pc-relative: n 15 | \ - register: 16 | \ - indirect: " )" 17 | \ - indexed with immediate offset: "n )#" 18 | \ - indexed with register offset: " +)" 19 | 20 | require search.fth 21 | also forth definitions 22 | require lib/common.fth 23 | 24 | vocabulary assembler 25 | 26 | base @ hex 27 | 28 | \ This constant signals that an operand is not a direct address. 29 | deadbeef constant -addr 30 | 31 | \ Assembler state. 32 | variable opcode 33 | variable shift 34 | variable +op 35 | defer imm-op 36 | defer reg 37 | 38 | \ Set opcode. 39 | : opcode! 3@ drop >r opcode ! ; 40 | : op+! +op @ opcode +! ; 41 | : rd! opcode 0007 !bits ; 42 | : rdh! 4 lshift 0080 and ?dup if opcode 0080 !bits then ; 43 | : rs! 3 lshift opcode 0038 !bits ; 44 | : rsh! 3 lshift 0040 and ?dup if opcode 0040 !bits then ; 45 | : ro! 6 lshift opcode 01C0 !bits ; 46 | : ri! 8 lshift opcode 0700 !bits ; 47 | : !w 00200000 opcode +! ; 48 | : imm5! 6 lshift opcode 07C0 !bits ; 49 | : imm8! opcode 00FF !bits ; 50 | : imm9! opcode 01FF !bits ; 51 | : imm11! opcode 07FF !bits ; 52 | : shift! shift ! ; 53 | 54 | \ Access instruction fields. 55 | : opcode@ opcode @ ; 56 | 57 | \ Possibly use a cross-compiling vocabulary to access a target image. 58 | previous definitions 59 | 60 | \ Write instruction fields to memory. 61 | : w, dup c, 8 rshift c, ; 62 | : w@ dup c@ swap 1+ c@ 8 lshift + ; 63 | : w! 2dup c! swap 8 rshift swap 1+ c! ; 64 | : offset8! dup w@ FF00 and rot 00FF and + swap w! ; 65 | : offset11! dup w@ F800 and rot 07FF and + swap w! ; 66 | : opcode, opcode@ w, ; 67 | : callh, 12 rshift 07FF and F000 + w, ; 68 | : pc- here - ; 69 | : relative pc- 4 - 1 rshift ; 70 | 71 | also forth definitions 72 | 73 | \ Implements addressing modes: register, indirect, postincrement, 74 | \ predecrement, and absolute. 75 | : !ri ['] ri! is reg ; 76 | : reg3 ro! ; 77 | : !reg3 ['] reg3 is reg ; 78 | : reg2 dup rs! rsh! !reg3 ; 79 | : !reg2 ['] reg2 is reg ; 80 | : reg1 dup rd! rdh! !reg2 ; 81 | : ind# rs! shift @ rshift imm5! 1000 opcode +! ; 82 | : indr rs! 2drop ro! ; 83 | : indsp 4000 opcode +! 2 rshift imm8! ; 84 | : addr opcode @ ri! pc- 2 - 2 rshift imm8! -1000 opcode +! ; 85 | 86 | \ Implements addressing mode: immediate. 87 | : !imm5 ['] imm5! is imm-op ; 88 | : !imm8 ['] imm8! is imm-op ; 89 | : !imm9 ['] imm9! is imm-op ; 90 | 91 | \ Reset assembler state. 92 | : 0reg ['] reg1 is reg ; 93 | : 0imm !imm8 ; 94 | : 0shift 2 shift ! ; 95 | : 0x 0 +op ! ; 96 | : 0asm 0reg 0imm 0shift 0x ; 97 | 98 | \ Process one operand. All operands except a direct address 99 | \ have the stack picture ( n*x xt -addr ). 100 | : addr? dup -addr <> ; 101 | : op addr? if addr else drop execute then ; 102 | 103 | \ Define instruction formats. 104 | : instruction, ( a -- ) opcode! opcode, 0asm ; 105 | : mnemonic ( u a "name" -- ) create ['] noop 3, does> instruction, ; 106 | : format: create ] !csp does> mnemonic ; 107 | : immediate: ' latestxt >body ! ; 108 | 109 | \ Instruction formats. 110 | format: 0op ; 111 | format: 1op !reg2 op ; 112 | format: multi !imm9 op ; 113 | format: 2op op op ; 114 | format: byte 0 shift! op op op+! ; 115 | format: half 1 shift! op op op+! op+! ; 116 | format: 3op !imm5 0reg op op op ; 117 | format: branch8 relative imm8! ; 118 | format: branch11 relative imm11! ; 119 | format: call relative dup callh, imm11! ; 120 | 121 | \ Define registers. 122 | : reg: create dup 000F and , 1+ does> @ ['] reg -addr ; 123 | 124 | \ Instruction mnemonics. 125 | previous also assembler definitions 126 | 127 | \ Cortex-M0 instruction set: [32-BIT] 128 | \ adcs, add, adds, adr, ands, asrs, bcc, bics, bkpt, [BL], blx, bx, cmn, 129 | \ cmp, cpsid, cpsie, [DMB], [DSB], eors, [ISB], ldm, ldr, ldrb, ldrh, ldrsb, 130 | \ ldrsh, lsls, lsrs, mov, movs, [MRS], [MSR], muls, mvns, nop, orrs, pop, 131 | \ push, rev, rev16, revsh, rors, rsbs, sbcs, sev, stm, str, strb, strh, 132 | \ sub, subs, svc, sxtb, sxth, tst, uxtb, uxth, wfe, wfi 133 | 134 | 0000 3op lsli, 135 | 0800 3op lsri, 136 | 1000 3op asri, 137 | 1800 3op add, 138 | 1A00 3op sub, 139 | \ 1C00 add, 140 | \ 1E00 sub, 141 | 2000 2op movi, 142 | 2800 2op cmpi, 143 | 3000 2op addi, 144 | 3800 2op subi, 145 | 4000 2op and, 146 | 4040 2op eor, 147 | 4080 2op lsl, 148 | 40C0 2op lsr, 149 | 4100 2op asr, 150 | 4140 2op adc, 151 | 4180 2op sbc, 152 | 41C0 2op ror, 153 | 4200 2op tst, 154 | 4240 2op neg, 155 | 4280 2op cmp, 156 | 42C0 2op cmn, 157 | 4300 2op orr, 158 | 4340 2op mul, 159 | 4380 2op bic, 160 | 43C0 2op mvn, 161 | \ 4400 addh, 162 | \ 4500 cmph, 163 | 4600 2op movh, 164 | 4700 1op bx, 165 | 4780 1op blx, 166 | 5000 2op str, 167 | 5800 2op ldr, 168 | 169 | 5400 byte strb, \ 7000 1C00 - 170 | 5C00 byte ldrb, \ 7800 171 | 172 | 5200 half strh, \ 8000 2E00 - 173 | 5A00 half ldrh, \ 8800 174 | 175 | 5600 2op ldrsb, 176 | 5E00 2op ldrsh, 177 | \ A000 adr, 178 | \ A800 add, \ sp + reg 179 | B000 1op addsp, 180 | \ B080 sub, \ sp + # 181 | \ B100 cbz, 182 | B200 2op sxth, 183 | B240 2op sxtb, 184 | B280 2op uxth, 185 | B2C0 2op uxtb, 186 | B400 multi push, 187 | \ B660 cps, 188 | \ B900 cbnz, 189 | \ BA00 rev, 190 | \ BA40 rev16, 191 | \ BAC0 revsh, 192 | BC00 multi pop, 193 | BE00 1op bkpt, 194 | \ BF00 it, 195 | \ BF10 yield, 196 | \ BF20 wfe, 197 | \ BF30 wfi, 198 | \ BF40 sev, 199 | \ C800 stm, 200 | \ C800 ldm, 201 | D000 branch8 beq, 202 | D100 branch8 bne, 203 | D200 branch8 bcs, 204 | D300 branch8 bcc, 205 | D400 branch8 bmi, 206 | D500 branch8 bpl, 207 | D600 branch8 bvs, 208 | D700 branch8 bvc, 209 | D800 branch8 bhi, 210 | D900 branch8 bls, 211 | DA00 branch8 bge, 212 | DB00 branch8 blt, 213 | DC00 branch8 bgt, 214 | DD00 branch8 ble, 215 | DE00 1op udf, 216 | DF00 1op svc, 217 | E000 branch11 b, 218 | F800 call bl, 219 | \ E8000000 stm, 220 | \ E8000000 ldm, 221 | \ E8400000 \ load/store dual or exclusive, table branch 222 | \ EA000000 \ data processing 223 | \ EC000000 \ coprocessor 224 | \ F0000000 and, 225 | \ F0000F00 tst, 226 | \ F0008000 b, 227 | \ F000D000 bl, 228 | \ F0400000 bic, 229 | \ F0800000 orr, 230 | \ F0800F00 mov, 231 | \ F0C00000 orn, 232 | \ F0C00F00 mvn, 233 | \ F1000000 eor, 234 | \ F1000F00 teq, 235 | \ F2000000 add, 236 | \ F2000F00 cmn, 237 | \ F2800000 adc, 238 | \ F2C00000 sbc, 239 | \ F3400000 sub, 240 | \ F3400F00 cmp, 241 | \ F3800000 rsb, 242 | \ F7008000 msr, 243 | \ F7608000 mrs, 244 | \ F8000000 ldr, 245 | \ F8000000 \ store single data item 246 | \ F8100000 ldrb, 247 | \ F8300000 ldrh, 248 | \ F8500000 ldr, 249 | \ F8700000 \ undefined 250 | \ FA000000 \ data processing 251 | \ FB000000 mul, 252 | \ FB000000 mla, 253 | \ FB800000 mull, 254 | \ FC000000 \ coprocessor 255 | 256 | \ Addressing mode syntax: immediate, indirect, and indexed. 257 | : # ['] imm-op -addr !ri ; 258 | : )# 2drop ['] ind# -addr 1000 +op ! ; 259 | : ) 2>r 0 swap 2r> )# ; 260 | : +) 2drop ['] indr -addr ; 261 | : sp) ['] indsp -addr !ri ; 262 | 263 | \ Register names. 264 | 0 265 | reg: r0 reg: r1 reg: r2 reg: r3 reg: r4 reg: r5 reg: r6 reg: r7 266 | reg: r8 reg: r9 reg: r10 reg: r11 reg: r12 reg: sp reg: lr reg: pc 267 | drop 268 | 269 | \ Register sets. 270 | : {r0} 01 # ; 271 | : {r6} 40 # ; 272 | : {lr} 100 # ; 273 | : {pc} {lr} ; 274 | : {r0-r7, FF # ; 275 | : lr} rot 100 or -rot ; 276 | : pc} lr} ; 277 | 278 | \ Aliases. 279 | : mov, 2>r 2>r 2>r 0 # 2r> 2r> 2r> lsli, ; 280 | : nop, r8 r8 movh, ; 281 | 282 | \ Resolve jumps. 283 | : >mark8 ['] offset8! here 2 - ; 284 | : >mark11 ['] offset11! here 2 - ; 285 | : >resolve dup pc- 4 + negate 2/ swap rot execute ; 286 | 287 | \ Unconditional jumps. 288 | : label here >r get-current ['] assembler set-current r> constant set-current ; 289 | : begin, here ; 290 | : again, b, ; 291 | : ahead, here b, >mark11 ; 292 | : then, >resolve ; 293 | 294 | \ Conditional jumps. 295 | : 0=, ['] bne, ; 296 | : 0<, ['] bge, ; 297 | : 0<>, ['] beq, ; 298 | : if, 0 swap execute >mark8 ; 299 | : until, execute ; 300 | 301 | : else, ahead, 2swap then, ; 302 | : while, >r if, r> ; 303 | : repeat, again, then, ; 304 | 305 | \ Runtime for ;CODE. CODE! is defined elsewhere. 306 | : (;code) r> code! ; 307 | 308 | \ Enter and exit assembler mode. 309 | : start-code also assembler 0asm ; 310 | : end-code previous ; 311 | 312 | also forth base ! previous 313 | 314 | previous definitions also assembler 315 | 316 | \ Standard assembler entry points. 317 | : code parse-name header, ?code, reveal start-code ; 318 | : ;code postpone (;code) reveal postpone [ ?csp start-code ; immediate 319 | 320 | 0asm 321 | previous 322 | -------------------------------------------------------------------------------- /target/thumb/gdbinit: -------------------------------------------------------------------------------- 1 | set arm force-mode thumb 2 | target extended-remote localhost:4242 3 | load image.elf 4 | 5 | define s 6 | si 7 | disass $pc-8, $pc+12 8 | end 9 | -------------------------------------------------------------------------------- /target/thumb/nucleus.fth: -------------------------------------------------------------------------------- 1 | \ Cortex-M0 memory map: 2 | \ 0x00000000 code 3 | \ 0 initial SP 4 | \ 4 reset vector (lsb must be 1) 5 | \ 0x20000000 data 6 | \ 0x40000000 peripheral 7 | \ 0xE0000000 peripheral 8 | \ E000E000 system control 9 | 10 | program-start org 11 | hex 12 | 13 | 20000800 , \ Initial stack pointer. 14 | program-start 81 + , \ Reset vector 15 | 16 | program-start 80 + here - allot 17 | 18 | code cold 19 | sp r7 movh, 20 | 80 # r7 subi, 21 | 80 # r7 subi, 22 | ahead, 23 | end-code 24 | 25 | code bye 26 | 0 # bkpt, 27 | end-code 28 | 29 | code panic 30 | FF # bkpt, 31 | end-code 32 | 33 | code swap 34 | r7 ) r5 ldr, 35 | r7 ) r6 str, 36 | r5 r6 mov, 37 | lr bx, 38 | end-code 39 | 40 | code over 41 | ] dup [ also assembler 42 | 4 r7 )# r6 ldr, 43 | lr bx, 44 | end-code 45 | 46 | code + 47 | r7 ) r5 ldr, 48 | r6 r5 r6 add, 49 | label bump 50 | 4 # r7 addi, 51 | lr bx, 52 | end-code 53 | 54 | code - 55 | r7 ) r5 ldr, 56 | r6 r5 r6 sub, 57 | bump b, 58 | end-code 59 | 60 | code or 61 | r7 ) r5 ldr, 62 | r5 r6 orr, 63 | bump b, 64 | end-code 65 | 66 | code xor 67 | r7 ) r5 ldr, 68 | r5 r6 eor, 69 | bump b, 70 | end-code 71 | 72 | code and 73 | r7 ) r5 ldr, 74 | r5 r6 and, 75 | bump b, 76 | end-code 77 | 78 | code >r 79 | {r6} push, 80 | \ Fall through. 81 | end-code 82 | 83 | code drop 84 | ] drop [ also assembler 85 | lr bx, 86 | end-code 87 | 88 | code r> 89 | ] dup [ also assembler 90 | {r6} pop, 91 | lr bx, 92 | end-code 93 | 94 | code r@ 95 | ] dup [ also assembler 96 | 0 sp) r6 ldr, 97 | lr bx, 98 | end-code 99 | 100 | code ! 101 | r7 ) r5 ldr, 102 | r6 ) r5 str, 103 | \ Drop through. 104 | end-code 105 | 106 | code 2drop 107 | 4 r7 )# r6 ldr, 108 | 8 # r7 addi, 109 | lr bx, 110 | end-code 111 | 112 | code c! 113 | r7 ) r5 ldr, 114 | r6 ) r5 strb, 115 | ' 2drop b, 116 | end-code 117 | 118 | code branch? 119 | r6 r5 mov, 120 | ] drop [ also assembler 121 | r5 r5 tst, 122 | lr bx, 123 | end-code 124 | 125 | code 0= 126 | r6 r5 neg, 127 | r6 r5 adc, 128 | r5 r6 neg, 129 | lr bx, 130 | end-code 131 | 132 | code +! 133 | r7 ) r5 ldr, 134 | r6 ) r4 ldr, 135 | r4 r5 r5 add, 136 | r6 ) r5 str, 137 | ' 2drop b, 138 | end-code 139 | 140 | : = - 0= ; 141 | : <> - 0<> ; 142 | -------------------------------------------------------------------------------- /target/thumb/params.fth: -------------------------------------------------------------------------------- 1 | 1 constant t-little-endian 2 | 4 constant t-cell 3 | 0 constant program-start 4 | hex 20000000 constant data-start 5 | decimal 6 | -------------------------------------------------------------------------------- /target/thumb/target.mk: -------------------------------------------------------------------------------- 1 | # This is for STM32L0x1 devices. 2 | START=0x08000000 3 | 4 | test-image: image 5 | thumbulator -m 0 -d $< > $@ 2>&1 6 | ! grep "bkpt 0xFF" $@ 7 | grep "bkpt 0x00" $@ 8 | 9 | upload: image 10 | sudo st-flash write $< $(START) 11 | -------------------------------------------------------------------------------- /target/thumb/x1.fth: -------------------------------------------------------------------------------- 1 | \ ARM Thumb backend. 2 | \ 3 | \ Subroutine threaded. Operations no longer than a CALL instruction 4 | \ are inlined. 5 | \ 6 | \ Register usage: 7 | \ R5 - temporary. 8 | \ R6 - top of stack. 9 | \ R7 - data stack pointer. 10 | \ SP - return stack pointer. 11 | \ LR - link register. 12 | 13 | only forth 14 | 15 | hex 16 | 17 | also meta definitions also assembler 18 | 19 | : prologue, {lr} push, ; 20 | : comp, bl, ; 21 | 22 | : branch?, s" branch?" "' bl, 0<>, ; 23 | : dup, 4 # r7 subi, r7 ) r6 str, ; 24 | 25 | : small? dup 100 u< ; 26 | : small # r6 movi, ; 27 | : large dup 18 rshift # r6 movi, 18 # r6 r6 lsli, 28 | dup 10 rshift # r5 movi, 10 # r5 r5 lsli, r6 r5 r6 add, 29 | dup 8 rshift # r5 movi, 8 # r5 r5 lsli, r6 r5 r6 add, 30 | FF and # r6 addi, ; 31 | : t-num dup, small? if small else large then ; 32 | 33 | : end-target ; 34 | -------------------------------------------------------------------------------- /target/thumb/x2.fth: -------------------------------------------------------------------------------- 1 | also assembler 2 | h: exit {pc} pop, ; 3 | h: dup dup, ; 4 | h: drop r7 ) r6 ldr, 4 # r7 addi, ; 5 | h: nip 4 # r7 addi, ; 6 | h: 2* 1 # r6 r6 lsli, ; 7 | h: 2/ 1 # r6 r6 asri, ; 8 | h: @ r6 ) r6 ldr, ; 9 | h: c@ r6 ) r6 ldrb, ; 10 | h: 1+ 1 # r6 addi, ; 11 | h: 1- 1 # r6 subi, ; 12 | h: cell+ 4 # r6 addi, ; 13 | h: negate r6 r6 neg, ; 14 | h: invert r6 r6 mvn, ; 15 | h: 0<> r6 r5 neg, r6 r6 sbc, ; 16 | h: 0< 1F # r6 r6 asri, ; 17 | 18 | h: if branch?, if, ; 19 | h: ahead ahead, ; 20 | h: then then, ; 21 | h: else else, ; 22 | 23 | h: begin begin, ; 24 | h: again again, ; 25 | h: until branch?, until, ; 26 | h: while while, ; 27 | h: repeat repeat, ; 28 | previous 29 | -------------------------------------------------------------------------------- /test/blink-atmega328.fth: -------------------------------------------------------------------------------- 1 | include target/avr/uart.fth 2 | 3 | hex 4 | 5 | code set-output 6 | FF # r16 ldi, 7 | 04 r16 out, \ DDRB 8 | FF # r16 ldi, 9 | 07 r16 out, \ DDRC 10 | ret, 11 | end-code 12 | 13 | code !portb 14 | 05 r26 out, 15 | ' drop rjmp, 16 | end-code 17 | 18 | code !portc 19 | 08 r26 out, 20 | ' drop rjmp, 21 | end-code 22 | 23 | : more ( x -- x' ) dup 40 = if drop 1 then ; 24 | : cycle ( x -- x' ) dup dup + swap !portc more ; 25 | 26 | variable n 27 | variable x 28 | 29 | : setup setup-uart set-output 200 n ! 100 x ! ; 30 | : delay begin 1- dup 0= until drop ; 31 | : led-on 01 !portb 300 delay ; 32 | : led-off 0 !portb 300 delay ; 33 | \ Jump here from COLD. 34 | : warm then setup 01 begin led-off led-on 41 emit key emit cycle again ; 35 | -------------------------------------------------------------------------------- /test/blink-curiosity.fth: -------------------------------------------------------------------------------- 1 | include target/nucleus.fth 2 | 3 | hex 4 | 00C constant porta 5 | 00E constant portc 6 | 7 | code set-output 8 | 1 movlb, 9 | 00 movlw, 10 | 00C movwf, \ TRISA 11 | 00E movwf, \ TRISC 12 | 0 movlb, 13 | return, 14 | end-code 15 | 16 | : !porta porta c! ; 17 | 18 | variable n 19 | variable x 20 | 21 | : setup set-output 600 n ! 200 x ! ; 22 | : delay begin 1- dup 0= until drop ; 23 | : led-on FF !porta x @ delay ; 24 | : led-off 00 !porta n @ x @ - delay ; 25 | \ Jump here from COLD. 26 | : warm then setup begin led-off led-on again ; 27 | -------------------------------------------------------------------------------- /test/blink-launchpad.fth: -------------------------------------------------------------------------------- 1 | include target/nucleus.fth 2 | 3 | hex 4 | 0120 constant wdtctl 5 | 5A00 constant wdtpw 6 | 0080 constant wdthold 7 | 0022 constant p1dir 8 | 0021 constant p1out 9 | 10 | : set-output wdtpw wdthold + wdtctl ! FF p1dir c! ; 11 | : !port1 p1out c! ; 12 | 13 | variable n 14 | variable x 15 | 16 | : setup set-output 6000 n ! 2000 x ! ; 17 | : delay begin 1- dup 0= until drop ; 18 | : led-on FF !port1 x @ delay ; 19 | : led-off 0 !port1 n @ x @ - delay ; 20 | \ Jump here from COLD. 21 | : warm then setup begin led-off led-on again ; 22 | -------------------------------------------------------------------------------- /test/blink-nucleo32.fth: -------------------------------------------------------------------------------- 1 | only forth definitions 2 | 08000000 constant flash-start \ STM32L011 3 | also meta target 4 | 5 | include target/nucleus.fth 6 | 7 | 4002102C constant rcc_iopenr 8 | 50000400 constant gpiob_moder 9 | 50000414 constant gpiob_odr 10 | 11 | : set-output 2 rcc_iopenr ! 55555555 gpiob_moder ! ; 12 | : !portb gpiob_odr ! ; 13 | 14 | variable n 15 | variable x 16 | 17 | : setup set-output 10000 n ! 4000 x ! ; 18 | : delay begin 1- dup 0= until drop ; 19 | : led-on 0 !portb x @ delay ; 20 | : led-off 0000FFFF !portb n @ x @ - delay ; 21 | \ Jump here from COLD. 22 | : warm then setup begin led-off led-on again ; 23 | -------------------------------------------------------------------------------- /test/blink-stm8.fth: -------------------------------------------------------------------------------- 1 | include target/nucleus.fth 2 | 3 | 5005 constant pb_odr 4 | 5007 constant pb_ddr 5 | 5008 constant pb_cr1 6 | 5009 constant pb_cr2 7 | 8 | : set-output 20 pb_ddr c! 20 pb_cr1 c! ; 9 | : !portb pb_odr c! ; 10 | 11 | variable n 12 | variable x 13 | 14 | : setup set-output 1000 n ! 400 x ! ; 15 | : delay begin 1- dup 0= until drop ; 16 | : led-on 0 !portb x @ delay ; 17 | : led-off FF !portb n @ x @ - delay ; 18 | \ Jump here from COLD. 19 | : warm then setup begin led-off led-on again ; 20 | -------------------------------------------------------------------------------- /test/deps.sh: -------------------------------------------------------------------------------- 1 | set -ex 2 | 3 | install_lbforth() { 4 | test -f $HOME/bin/forth && return 5 | test -f lbForth/Makefile || git submodule update --init --recursive 6 | cd lbForth 7 | export M32=-m32 8 | sh -e test/install-deps.sh install_${TRAVIS_OS_NAME:-linux} 9 | make all TARGET=x86 OS=linux prefix=$HOME 10 | sudo make install TARGET=x86 OS=linux prefix=$HOME 11 | } 12 | 13 | install_naken_asm() { 14 | test -f $HOME/bin/naken_util && return 15 | git clone https://github.com/mikeakohn/naken_asm 16 | cd naken_asm 17 | ./configure --prefix=$HOME 18 | make 19 | sudo make install 20 | } 21 | 22 | install_ucsim() { 23 | test -f $HOME/bin/s51 && return 24 | sudo apt-get install subversion 25 | svn checkout svn://svn.code.sf.net/p/sdcc/code/trunk/sdcc sdcc 26 | cd sdcc/sim/ucsim 27 | ./configure --prefix=$HOME 28 | make 29 | sudo make install 30 | } 31 | 32 | install_binutils_arm() { 33 | sudo apt-get install binutils-arm-none-eabi 34 | } 35 | 36 | install_qemu_cortexm0() { 37 | #test -f $HOME/bin/s51 && return 38 | sudo apt-get install libglib2.0-dev libpixman-1-dev libfdt-dev 39 | git clone https://github.com/sushihangover/qemu 40 | cd qemu 41 | git checkout cortexm 42 | ./configure --disable-werror --target-list=arm-softmmu --prefix=$HOME 43 | make 44 | sudo make install 45 | } 46 | 47 | install_thumbulator() { 48 | #test -f $HOME/bin/s51 && return 49 | #sudo apt-get install libglib2.0-dev libpixman-1-dev libfdt-dev 50 | git clone https://github.com/ekoeppen/thumbulator 51 | cd thumbulator 52 | make 53 | sudo make install 54 | } 55 | 56 | sudo apt-get update -ym 57 | 58 | (install_lbforth) 59 | 60 | case $TARGET in 61 | 6502) (install_naken_asm);; 62 | 8051) (install_ucsim);; 63 | avr) sudo apt-get install simulavr;; 64 | msp430) (install_naken_asm);; 65 | pdp8) sudo apt-get install simh;; 66 | pic) sudo apt-get install gpsim;; 67 | stm8) (install_ucsim);; 68 | thumb) (install_thumbulator);; 69 | esac 70 | 71 | -------------------------------------------------------------------------------- /test/test-6502-asm.fth: -------------------------------------------------------------------------------- 1 | require targets/6502/asm.fth 2 | 3 | hex 4 | 5 | : fail? ( c a -- a' f ) 1- tuck c@ <> ; 6 | : .fail cr ." FAIL: " source 5 - type cr ; 7 | : ?fail fail? if .fail abort then ; 8 | : check here begin depth 1- while ?fail repeat drop ; 9 | 10 | \ Put machine code for a JMP instruction on the stack. 11 | : , until, F0 FE check 98 | end-code 99 | .( PASS ) cr 100 | -------------------------------------------------------------------------------- /test/test-8051-asm.fth: -------------------------------------------------------------------------------- 1 | require target/8051/asm.fth 2 | 3 | hex 4 | 5 | : fail? ( c a -- a' f ) 1- tuck c@ <> ; 6 | : .fail cr ." FAIL: " source 5 - type cr ; 7 | : ?fail fail? if .fail abort then ; 8 | : check here begin depth 1- while ?fail repeat drop ; 9 | 10 | .( Assembler test: ) 11 | code assembler-test 12 | 13 | nop, 00 check 14 | rr, 03 check 15 | rrc, 13 check 16 | ret, 22 check 17 | rl, 23 check 18 | reti, 32 check 19 | rlc, 33 check 20 | jmp, 73 check 21 | div, 84 check 22 | mul, A4 check 23 | swap, C4 check 24 | da, D4 check 25 | 26 | a inc, 04 check 27 | 0 inc, 05 00 check 28 | @r0 inc, 06 check 29 | @r1 inc, 07 check 30 | r0 inc, 08 check 31 | r7 inc, 0F check 32 | 33 | a dec, 14 check 34 | 1 # add, 24 01 check 35 | @r0 addc, 36 check 36 | @r1 orl, 47 check 37 | r0 anl, 58 check 38 | r1 xrl, 69 check 39 | FF # subb, 94 FF check 40 | 1 xch, C5 01 check 41 | @r0 xchd, D6 check 42 | a clr, E4 check 43 | a cpl, F4 check 44 | 45 | a 1 orlm, 42 1 check 46 | 2 # 1 orlm, 43 1 2 check 47 | a 3 anlm, 52 3 check 48 | 5 # 4 xrlm, 63 4 5 check 49 | 50 | 0 # a movi, 74 00 check 51 | 1 # sp movi, 75 81 01 check 52 | 2 # @r0 movi, 76 02 check 53 | FF # r7 movi, 7F FF check 54 | 1 2 stm, 85 01 02 check 55 | @r0 psw stm, 86 D0 check 56 | r0 acc stm, 88 E0 check 57 | 1 @r1 ldm, A7 01 check 58 | 2 r1 ldm, A9 02 check 59 | dpl lda, E5 82 check 60 | @r1 lda, E7 check 61 | r0 lda, E8 check 62 | dph sta, F5 83 check 63 | @r0 sta, F6 check 64 | r7 sta, FF check 65 | @dptr xlda, E0 check 66 | @r0 xlda, E2 check 67 | @dptr xsta, F0 check 68 | @r1 xsta, F3 check 69 | 70 | 1234 # dptr mov, 90 12 34 check 71 | \ @a+pc movc, 93 check 72 | \ @a+dptr movc, 83 check 73 | 74 | 0 push, C0 00 check 75 | FF pop, D0 FF check 76 | 77 | 0 ajmp, 01 00 check 78 | 1 ajmp, 01 01 check 79 | FF ajmp, 01 FF check 80 | 100 ajmp, 21 00 check 81 | 400 ajmp, 81 00 check 82 | 0 acall, 11 00 check 83 | 100 acall, 31 00 check 84 | 85 | FF ljmp, 02 00 FF check 86 | 100 ljmp, 02 01 00 check 87 | FF00 lcall, 12 FF 00 check 88 | 89 | create l \ label 90 | l jc, 40 FE check 91 | l jnc, 50 FC check 92 | l jz, 60 FA check 93 | l jnz, 70 F8 check 94 | l sjmp, 80 F6 check 95 | 96 | ahead, nop, then, 80 01 00 check 97 | 0=, if, nop, then, 70 01 00 check 98 | begin, again, 80 FE check 99 | begin, 0<>, until, 60 FE check 100 | 101 | end-code 102 | .( PASS ) cr 103 | -------------------------------------------------------------------------------- /test/test-avr-asm.fth: -------------------------------------------------------------------------------- 1 | \ Test assembler and nucleus by loading into running Forth. 2 | \ The existing CODE words will be patched to point to the 3 | \ new nucleus. 4 | 5 | require target/avr/asm.fth 6 | 7 | : w@ ( a -- u ) dup c@ swap 1+ c@ 8 lshift + ; 8 | : fail? ( c a -- a' f ) 2 - tuck w@ <> ; 9 | : .fail cr ." FAIL: " source 5 - type cr ; 10 | : ?fail fail? if .fail abort then ; 11 | : check here begin depth 1- while ?fail repeat drop ; 12 | 13 | .( Assembler test: ) 14 | code assembler-test 15 | hex 16 | 17 | nop, 0000 check 18 | 19 | r0 xch, 9204 check 20 | r1 las, 9215 check 21 | r2 lac, 9226 check 22 | r3 lat, 9237 check 23 | r4 pop, 904F check 24 | r5 push, 925F check 25 | r6 com, 9460 check 26 | r7 neg, 9471 check 27 | r8 swap, 9482 check 28 | r9 inc, 9493 check 29 | r10 asr, 94A5 check 30 | r11 lsr, 94B6 check 31 | r12 ror, 94C7 check 32 | r13 dec, 94DA check 33 | r14 rol, 1CEE check 34 | r15 lsl, 0CFF check 35 | r16 clr, 2700 check 36 | 37 | r0 r0 cpc, 0400 check 38 | r0 r31 cpc, 05F0 check 39 | r31 r0 cpc, 060F check 40 | r0 r1 sub, 1810 check 41 | r1 r0 adc, 1C01 check 42 | r0 r0 mov, 2C00 check 43 | r1 r2 mul, 9C21 check 44 | 45 | r2 r0 movw, 0101 check 46 | r0 r30 movw, 01F0 check 47 | 1 # r24 adiw, 9601 check 48 | 3F # r30 sbiw, 97FF check 49 | 50 | 0 # r16 cpi, 3000 check 51 | FF # r17 sbci, 4F1F check 52 | 1 # r18 subi, 5021 check 53 | 10 # r19 ori, 6130 check 54 | F0 # r20 ldi, EF40 check 55 | 56 | z r20 ld, 8140 check 57 | z+ r0 ld, 9001 check 58 | r1 -z st, 9212 check 59 | y r0 ld, 8008 check 60 | r2 y+ st, 9229 check 61 | -y r3 ld, 903A check 62 | x r4 ld, 904C check 63 | x+ r5 ld, 905D check 64 | -x r6 ld, 906E check 65 | 0 z )# r7 ldd, 8070 check 66 | 29 y )# r8 std, A689 check 67 | 68 | 0 r1 lds, 9010 0000 check 69 | FFFF r31 sts, 93F0 FFFF check 70 | 1 r1 in, B011 check 71 | 3D r16 out, BF0D check 72 | 73 | ijmp, 9409 check 74 | icall, 9509 check 75 | 0 jmp, 940C 0000 check 76 | here rjmp, CFFF check 77 | 22F123 call, 78 | cell 2 = [if] 79 | 940E F123 check 80 | [else] 81 | 951E F123 check 82 | [then] 83 | 84 | z r0 lpm, 95C8 check 85 | z r1 lpm, 9014 check 86 | z+ r29 lpm, 91D5 check 87 | z r2 elpm, 9026 check 88 | z+ r3 elpm, 9037 check 89 | spm, 95E8 check 90 | 91 | create l \ label 92 | l brcs, F3F8 check 93 | l breq, F3F1 check 94 | l brie, F3EF check 95 | l brcc, F7E0 check 96 | l brpl, F7DA check 97 | l brid, F7D7 check 98 | 99 | 1 # 2 sbic, 9911 check 100 | 7 # 1F sbis, 9BFF check 101 | 1 # r2 sbrc, FC21 check 102 | 7 # r31 sbrs, FFF7 check 103 | 1 # 2 sbi, 9A11 check 104 | 7 # 1F cbi, 98FF check 105 | 106 | ahead, then, C000 check 107 | 0=, if, then, F401 check 108 | begin, again, CFFF check 109 | begin, 0<>, until, F3F9 check 110 | end-code 111 | .( PASS ) cr 112 | -------------------------------------------------------------------------------- /test/test-kernel.fth: -------------------------------------------------------------------------------- 1 | hex 2 | 3 | : assert= <> if panic then ; 4 | 5 | variable var1 6 | variable var2 7 | 42 constant const 8 | 9 | : 2dup over over ; 10 | : cell 0 cell+ ; 11 | 12 | : juggling 42 dup swap nip 42 assert= ; 13 | : arithmetic 1 2 3 + + 2* 11 xor 2/ 0E assert= ; 14 | : negative 1 0< 0 assert= -1 0< -1 assert= ; 15 | : return 2 1 >r r@ r> assert= 2 assert= ; 16 | : ?and and 0 assert= ; 17 | : ?or or 42 assert= ; 18 | : memory 42 var1 ! var1 c@ var1 1+ c@ 2dup ?and ?or 19 | 0 var2 ! 1 var2 c! 2 var2 1+ c! var2 @ 20 | dup 0102 = over 0201 = or swap 0001 = or -1 assert= ; 21 | : ram var2 var1 - cell assert= const 42 assert= ; 22 | : test juggling arithmetic negative return ram memory ; 23 | 24 | \ Jump here from COLD. 25 | : warm then test bye ; 26 | -------------------------------------------------------------------------------- /test/test-msp430-asm.fth: -------------------------------------------------------------------------------- 1 | \ Test MSP430 assembler. 2 | 3 | require targets/msp430/asm.fth 4 | 5 | : w@ ( a -- u ) dup c@ swap 1+ c@ 8 lshift + ; 6 | : fail? ( c a -- a' f ) 2 - tuck w@ <> ; 7 | : .fail cr ." FAIL: " source 5 - type cr ; 8 | : ?fail fail? if .fail abort then ; 9 | : check here begin depth 1- while ?fail repeat drop ; 10 | 11 | .( Assembler test: ) 12 | code assembler-test 13 | hex 14 | 15 | reti, 1300 check 16 | 17 | r4 push, 1204 check 18 | 1234 r4 )# push, 1214 1234 check 19 | r4 ) push, 1224 check 20 | r4 )+ push, 1234 check 21 | 3 # push, 1230 0003 check 22 | here 0FFFF and push, 1210 FFFE check 23 | 1234 & push, 1212 1234 check 24 | 25 | -1# push, 1233 check 26 | 0# push, 1203 check 27 | 1# push, 1213 check 28 | 2# push, 1223 check 29 | 4# push, 1222 check 30 | 8# push, 1232 check 31 | 32 | r4 r5 mov, 4405 check 33 | r4 )+ r5 mov, 4435 check 34 | r4 ) 1234 r5 )# mov, 44A5 1234 check 35 | 1234 r4 )# r5 mov, 4415 1234 check 36 | 1234 & 5678 r5 )# mov, 4295 1234 5678 check 37 | 38 | create l \ label 39 | l jmp, 3FFF check 40 | l jne, 23FE check 41 | l jeq, 27FD check 42 | 43 | r4 )+ call, 12B4 check 44 | ret, 4130 check 45 | 46 | ahead, then, 3C00 check 47 | 0=, if, then, 2000 check 48 | begin, again, 3FFF check 49 | begin, 0<>, until, 27FF check 50 | 51 | decimal 52 | end-code 53 | .( PASS ) cr 54 | -------------------------------------------------------------------------------- /test/test-pdp8-asm.fth: -------------------------------------------------------------------------------- 1 | require target/pdp8/asm.fth 2 | 3 | octal 4 | 5 | : fail? ( c a -- a' f ) cell - tuck @ <> ; 6 | : .fail cr ." FAIL: " source 5 - type cr ; 7 | : ?fail fail? if .fail abort then ; 8 | : check here begin depth 1- while ?fail repeat drop ; 9 | 10 | variable j 11 | : cell/ cell / ; 12 | : !jump 5200 here cell/ 177 and + j ! ; 13 | : @jump j @ ; 14 | 15 | .( Assembler test: ) 16 | code assembler-test 17 | 18 | ion, 6001 check 19 | iof, 6002 check 20 | nop, 7000 check 21 | hlt, 7402 check 22 | 23 | iac, 7001 check 24 | ral, 7004 check 25 | rtl, 7006 check 26 | rar, 7010 check 27 | rtr, 7012 check 28 | cml, 7020 check 29 | cma, 7040 check 30 | cla, 7200 check 31 | 32 | cla, iac, +, 7201 check 33 | cla, cma, +, 7240 check 34 | cla, cma, +, cll, +, 7340 check 35 | 36 | 1 and, 0001 check 37 | 1 ) and, 0401 check 38 | 1234 and, 0234 check 39 | 177 tad, 1177 check 40 | 177 ) isz, 2577 check 41 | 1234 dca, 3234 check 42 | 43 | 1 jms, 4001 check 44 | 177 jmp, 5177 check 45 | 46 | 176 here cell/ 177 and - cells allot 47 | 42 # tad, page 1377 0042 check 48 | 49 | ahead, then, !jump @jump check 50 | begin, !jump again, @jump check 51 | \ 0=, if, then, !jump 1D03 @jump check 52 | \ begin, !jump 0=, until, 1D03 @jump check 53 | 54 | end-code 55 | .( PASS ) cr 56 | -------------------------------------------------------------------------------- /test/test-pic-asm.fth: -------------------------------------------------------------------------------- 1 | require target/pic/asm.fth 2 | 3 | hex 4 | 5 | : fail? ( c a -- a' f ) cell - tuck @ <> ; 6 | : .fail cr ." FAIL: " source 5 - type cr ; 7 | : ?fail fail? if .fail abort then ; 8 | : check here begin depth 1- while ?fail repeat drop ; 9 | 10 | variable j 11 | : !jump 2800 here 2/ 3FF and + j ! ; 12 | : @jump j @ ; 13 | 14 | .( Assembler test: ) 15 | code assembler-test 16 | 17 | nop, 0000 check 18 | return, 0008 check 19 | retfie, 0009 check 20 | sleep, 0063 check 21 | 22 | 0 call, 2000 check 23 | 2 goto, 2801 check 24 | 2 movlw, 3002 check 25 | 3 retlw, 3403 check 26 | 4 iorlw, 3804 check 27 | 5 andlw, 3905 check 28 | 6 xorlw, 3A06 check 29 | 7 sublw, 3C07 check 30 | FF addlw, 3EFF check 31 | FFE call, 23FF check 32 | 33 | 1 movwf, 0081 check 34 | 2 clrf, 0182 check 35 | clrw, 0100 check 36 | w 3 subwf, 0203 check 37 | f 4 decf, 0384 check 38 | f 5 iorwf, 0485 check 39 | w 6 andwf, 0506 check 40 | w 7 xorwf, 0607 check 41 | w 13 addwf, 0713 check 42 | f 63 addwf, 07E3 check 43 | w 8 movf, 0808 check 44 | f 9 movf, 0889 check 45 | w 10 comf, 0910 check 46 | w 11 incf, 0A11 check 47 | w 12 decfsz, 0B12 check 48 | w 13 rrf, 0C13 check 49 | w 14 rlf, 0D14 check 50 | w 15 swapf, 0E15 check 51 | w 16 incfsz, 0F16 check 52 | 53 | 0 0 bcf, 1000 check 54 | 0 1 bcf, 1001 check 55 | 1 0 bcf, 1080 check 56 | 0 7F bsf, 147F check 57 | 7 0 btfsc, 1B80 check 58 | 7 7F btfss, 1FFF check 59 | 60 | ahead, then, !jump @jump check 61 | 0=, if, then, !jump 1D03 @jump check 62 | begin, !jump again, @jump check 63 | begin, !jump 0=, until, 1D03 @jump check 64 | end-code 65 | .( PASS ) cr 66 | -------------------------------------------------------------------------------- /test/test-stm8-asm.fth: -------------------------------------------------------------------------------- 1 | require target/stm8/asm.fth 2 | 3 | hex 4 | 5 | : fail? ( c a -- a' f ) 1- tuck c@ <> ; 6 | : .fail cr ." FAIL: " source 5 - type cr ; 7 | : ?fail fail? if .fail abort then ; 8 | : check here begin depth 1- while ?fail repeat drop ; 9 | 10 | .( Assembler test: ) 11 | code assembler-test 12 | 13 | exgw, 51 check 14 | iret, 80 check 15 | ret, 81 check 16 | trap, 83 check 17 | retf, 87 check 18 | break, 8B check 19 | ccf, 8C check 20 | halt, 8E check 21 | wfi, 8F check 22 | wfe, 72 8F check 23 | rim, 9A check 24 | sim, 9B check 25 | rcf, 98 check 26 | scf, 99 check 27 | rvf, 9C check 28 | nop, 9D check 29 | 30 | 123456 int, 82 12 34 56 check 31 | 32 | a neg, 40 check 33 | 12 cpl, 33 12 check 34 | 1234 srl, 72 54 12 34 check 35 | (x) rrc, 76 check 36 | (y) sra, 90 77 check 37 | 0 ,x) sll, 68 00 check 38 | 1234 ,x) rlc, 72 49 12 34 check 39 | 0 ,y) neg, 90 60 00 check 40 | 1234 ,y) neg, 90 40 12 34 check 41 | 0 ,sp) dec, 0A 00 check 42 | 0 ) inc, 92 3C 00 check 43 | 1234 ) tnz, 72 3D 12 34 check 44 | 0 ),x) swap, 92 6E 00 check 45 | 1234 ),x) clr, 72 6F 12 34 check 46 | 0 ),y) neg, 91 60 00 check 47 | 48 | xl exg, 41 check 49 | yl exg, 61 check 50 | 1 exg, 31 00 01 check 51 | 52 | 0 # sub, A0 00 check 53 | 12 cp, B1 12 check 54 | 1234 sbc, C2 12 34 check 55 | 1234 cpw, A3 12 34 check 56 | (x) cpw, F3 check 57 | (y) and, 90 F4 check 58 | 0 ,x) bcp, E5 00 check 59 | 1234 ,x) lda, D6 12 34 check 60 | 0 ,y) sta, 90 E7 00 check 61 | 1234 ,y) xor, 90 D8 12 34 check 62 | 0 ,sp) adc, 19 00 check 63 | 0 ) or, 92 CA 00 check 64 | 1234 ) add, 72 CB 12 34 check 65 | 0 ),x) jp, 92 DC 00 check 66 | 1234 ),x) call, 72 DD 12 34 check 67 | 0 call, CD 00 00 check 68 | 0 ),y) sub, 91 D0 00 check 69 | 70 | a ldxl, 97 check 71 | a ldxh, 95 check 72 | a ldyl, 90 97 check 73 | a ldyh, 90 95 check 74 | xl lda, 9B check 75 | xh lda, 9F check 76 | yl lda, 90 9B check 77 | yh lda, 90 9F check 78 | 79 | 0 # ldx, AE 00 00 check 80 | 0 ldx, BE 00 check 81 | 1234 ldx, CE 12 34 check 82 | (x) ldx, FE check 83 | 0 ,x) ldx, EE 00 check 84 | 1234 ,x) ldx, DE 12 34 check 85 | 0 ,sp) ldx, 1E 00 check 86 | 0 ) ldx, 92 CE 00 check 87 | 1234 ) ldx, 72 CE 12 34 check 88 | 0 ),x) ldx, 92 DE 00 check 89 | 1234 ),x) ldx, 72 DE 12 34 check 90 | 91 | 0 stx, BF 0 check 92 | 1234 stx, CF 12 34 check 93 | (y) stx, 90 FF check 94 | 0 ,y) stx, 90 EF 00 check 95 | 1234 ,y) stx, 90 DF 12 34 check 96 | 0 ,sp) stx, 1F 00 check 97 | 0 ) stx, 92 CF 00 check 98 | 1234 ) stx, 72 CF 12 34 check 99 | 0 ),y) stx, 91 DF 00 check 100 | 101 | 0 sty, 90 BF 0 check 102 | 1234 sty, 90 CF 12 34 check 103 | (x) sty, FF check 104 | 0 ,x) sty, EF 00 check 105 | 1234 ,x) sty, DF 12 34 check 106 | 0 ,sp) sty, 17 00 check 107 | 0 ) sty, 91 CF 00 check 108 | 0 ),x) sty, 92 DF 00 check 109 | 1234 ),x) sty, 72 DF 12 34 check 110 | 111 | 0 # ldy, 90 AE 00 00 check 112 | 0 ldy, 90 BE 00 check 113 | 1234 ldy, 90 CE 12 34 check 114 | (y) ldy, 90 FE check 115 | 0 ,y) ldy, 90 EE 00 check 116 | 1234 ,y) ldy, 90 DE 12 34 check 117 | 0 ,sp) ldy, 16 00 check 118 | 0 ) ldy, 91 CE 00 check 119 | 0 ),y) ldy, 91 DE 00 check 120 | 121 | y ldx, 93 check 122 | x ldy, 90 93 check 123 | sp ldx, 96 check 124 | sp ldy, 90 96 check 125 | x ldsp, 94 check 126 | y ldsp, 90 94 check 127 | 128 | x decw, (x) sty, 5A FF check 129 | x pushw, y ldx, 89 93 check 130 | 131 | a pop, 84 check 132 | cc pop, 86 check 133 | 1 pop, 32 00 01 check 134 | 0 # push, 4B 00 check 135 | a push, 88 check 136 | cc push, 8A check 137 | 1 push, 3B 00 01 check 138 | 139 | (* 0 # 1 mov, 35 00 00 01 check 140 | 1 2 mov, 45 01 02 check 141 | 1234 0 mov, 55 00 00 12 34 check 142 | 0 1234 mov, 55 12 34 00 00 check *) 143 | 144 | here callr, AD FE check 145 | here jra, 20 FE check 146 | 147 | create l \ label 148 | l jrf, 21 FE check 149 | l jrugt, 22 FC check 150 | l jrule, 23 FA check 151 | l jrnc, 24 F8 check 152 | l jrc, 25 F6 check 153 | l jrne, 26 F4 check 154 | l jreq, 27 F2 check 155 | l jrnv, 28 F0 check 156 | l jrpl, 2A EE check 157 | l jrmi, 2B EC check 158 | l jrsgt, 2C EA check 159 | l jrsle, 2D E8 check 160 | l jrsge, 2E E6 check 161 | l jrslt, 2F E4 check 162 | 163 | x rrwa, 01 check 164 | y rlwa, 90 02 check 165 | x mul, 42 check 166 | y mul, 90 42 check 167 | x negw, 50 check 168 | y negw, 90 50 check 169 | exgw, 51 check 170 | y cplw, 90 53 check 171 | x srlw, 54 check 172 | y rrcw, 90 56 check 173 | x sraw, 57 check 174 | y sllw, 90 58 check 175 | x rlcw, 59 check 176 | y decw, 90 5A check 177 | x incw, 5C check 178 | y tnzw, 90 5D check 179 | x swapw, 5E check 180 | y clrw, 90 5F check 181 | x div, 62 check 182 | y div, 90 62 check 183 | divw, 65 check 184 | x popw, 85 check 185 | y popw, 90 85 check 186 | x pushw, 89 check 187 | y pushw, 90 89 check 188 | 189 | ahead, nop, then, 20 01 9D check 190 | 0=, if, nop, then, 26 01 9D check 191 | begin, again, 20 FE check 192 | begin, 0<>, until, 27 FE check 193 | end-code 194 | .( PASS ) cr 195 | -------------------------------------------------------------------------------- /test/test-thumb-asm.fth: -------------------------------------------------------------------------------- 1 | \ Test ARM Thumb assembler. 2 | 3 | require target/thumb/asm.fth 4 | 5 | : w@ ( a -- u ) dup c@ swap 1+ c@ 8 lshift + ; 6 | : fail? ( c a -- a' f ) 2 - tuck w@ <> ; 7 | : .fail cr ." FAIL: " source 5 - type cr ; 8 | : ?fail fail? if .fail abort then ; 9 | : check here begin depth 1- while ?fail repeat drop ; 10 | 11 | .( Assembler test: ) 12 | code assembler-test 13 | hex 14 | 15 | 1 # addsp, B001 check 16 | -1 # addsp, B0FF check 17 | 0 # bkpt, BE00 check 18 | FF # svc, DFFF check 19 | 1 # udf, DE01 check 20 | {r0} push, B401 check 21 | {lr} push, B500 check 22 | {pc} pop, BD00 check 23 | {r0-r7, pc} pop, BDFF check 24 | 25 | 00 # r0 movi, 2000 check 26 | 00 # r7 cmpi, 2F00 check 27 | FF # r0 addi, 30FF check 28 | FF # r7 subi, 3FFF check 29 | 30 | 0 # r0 r0 lsli, 0000 check 31 | r0 r1 mov, 0001 check 32 | 0 # r1 r0 lsri, 0808 check 33 | 1F # r0 r0 asri, 17C0 check 34 | 35 | r0 r0 and, 4000 check 36 | r0 r1 eor, 4041 check 37 | r1 r0 lsl, 4088 check 38 | r0 r2 lsr, 40C2 check 39 | r3 r0 asr, 4118 check 40 | r0 r4 adc, 4144 check 41 | r5 r0 sbc, 41A8 check 42 | r0 r6 ror, 41C6 check 43 | r7 r0 tst, 4238 check 44 | r0 r0 neg, 4240 check 45 | r0 r0 cmp, 4280 check 46 | r0 r0 cmn, 42C0 check 47 | r0 r0 orr, 4300 check 48 | r0 r0 mul, 4340 check 49 | r0 r0 bic, 4380 check 50 | r0 r0 mvn, 43C0 check 51 | 52 | r0 r1 sxth, B201 check 53 | r2 r3 sxtb, B253 check 54 | r4 r5 uxth, B2A5 check 55 | r6 r7 uxtb, B2F7 check 56 | 57 | pc r0 movh, 4678 check 58 | r0 pc movh, 4687 check 59 | nop, 46C0 check 60 | r0 bx, 4700 check 61 | lr bx, 4770 check 62 | r1 blx, 4788 check 63 | 64 | r0 r0 r1 add, 1801 check 65 | r0 r1 r0 add, 1808 check 66 | r1 r0 r0 sub, 1A40 check 67 | 68 | r1 ) r0 ldr, 6808 check 69 | 4 r1 )# r0 ldr, 6848 check 70 | r2 r1 +) r0 ldr, 5888 check 71 | here 2 + r7 ldr, 4F00 check 72 | 4 sp) r0 ldr, 9801 check 73 | 74 | 1 r1 )# r0 ldrb, 7848 check 75 | r2 r1 +) r0 ldrb, 5C88 check 76 | r2 r1 +) r0 ldrsb, 5688 check 77 | 78 | 2 r1 )# r0 ldrh, 8848 check 79 | r2 r1 +) r0 ldrh, 5A88 check 80 | r2 r1 +) r0 ldrsh, 5E88 check 81 | 82 | r1 ) r0 str, 6008 check 83 | 4 r1 )# r0 str, 6048 check 84 | r2 r1 +) r0 str, 5088 check 85 | 4 sp) r0 str, 9001 check 86 | 87 | 1 r1 )# r0 strb, 7048 check 88 | r2 r1 +) r0 strb, 5488 check 89 | 90 | 2 r1 )# r0 strh, 8048 check 91 | r2 r1 +) r0 strh, 5288 check 92 | 93 | here b, E7FE check 94 | here bl, F7FF FFFE check 95 | 96 | create l \ label 97 | l beq, D0FE check 98 | l bne, D1FD check 99 | l bcs, D2FC check 100 | l bcc, D3FB check 101 | l bmi, D4FA check 102 | l bpl, D5F9 check 103 | l bvs, D6F8 check 104 | l bvc, D7F7 check 105 | l bhi, D8F6 check 106 | l bls, D9F5 check 107 | l bge, DAF4 check 108 | l blt, DBF3 check 109 | l bgt, DCF2 check 110 | l ble, DDF1 check 111 | 112 | ahead, then, E7FF check 113 | 0=, if, then, D1FF check 114 | begin, again, E7FE check 115 | begin, 0<>, until, D0FE check 116 | 117 | end-code 118 | .( PASS ) cr 119 | -------------------------------------------------------------------------------- /test/trinket.fth: -------------------------------------------------------------------------------- 1 | include target/nucleus.fth 2 | 3 | hex 4 | 5 | code set-output 6 | FF # r16 ldi, 7 | 17 r16 out, 8 | ret, 9 | end-code 10 | 11 | code !portb 12 | 18 r26 out, 13 | ' drop rjmp, 14 | end-code 15 | 16 | variable n 17 | variable x 18 | 19 | : setup set-output F000 n ! 1000 x ! ; 20 | : delay begin 1- dup 0= until drop ; 21 | : led-on 2 !portb x @ delay ; 22 | : led-off 0 !portb n @ x @ - delay ; 23 | \ Jump here from COLD. 24 | : warm then setup begin led-off led-on again ; 25 | --------------------------------------------------------------------------------