├── .gitattributes ├── AUTHORS ├── LICENSE ├── Makefile ├── README.txt ├── alt09.rom ├── basic ├── Makefile ├── README.txt ├── basic.asm ├── basic.txt ├── exampl.bas ├── fbasic.asm ├── floatnum.src └── makeflot.c ├── doc ├── latex2creole.py ├── origin │ ├── README │ ├── basic.txt │ ├── monitor.tex │ ├── sbc09.tex │ └── sbc09fig.tex └── sbc09.creole ├── examples ├── Makefile ├── asmtest.asm ├── bench09.asm ├── bin2dec.asm ├── cond09.asm ├── cond09.inc ├── crc16.asm ├── crc32.asm ├── ef09.asm ├── erat-sieve.asm ├── erat-sieve.txt ├── input.asm ├── printval.asm ├── test09.asm └── uslash.asm ├── examples_forth ├── Makefile ├── asm09.4 ├── asm6309.4 ├── core.4 ├── cross09.4 ├── extend09.4 ├── forthload.asm ├── kernel09 ├── kernel09.4 ├── meta09.4 ├── test6309.4 ├── test6309.asm ├── tester.4 └── tetris.4 └── src ├── Makefile ├── a09.c ├── engine.c ├── io.c ├── makerom.c ├── mon2.asm ├── monitor.asm ├── v09.c ├── v09.h ├── v09s.c └── v09st.c /.gitattributes: -------------------------------------------------------------------------------- 1 | *.4 linguist-language=Forth 2 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | 2 | AUTHORS are and/or have been: 3 | 4 | * Lennart Benschop: http://lennartb.home.xs4all.nl/m6809.html 5 | * Jens Diemer: http://www.jensdiemer.de/ 6 | * Johann E. Klasek: http://klasek.at/hc/6809/ 7 | 8 | basic.asm created 20-OCT-77 by John Byrns -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | Lennart Benschop 6809 Single Board Computer 294 | Copyright (C) 1993 L.C. Benschop, Eidnhoven The Netherlands 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | {signature of Ty Coon}, 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile Sim6809 3 | # 4 | # created 1994 by L.C. Benschop 5 | # 2013-10-28 - Jens Diemer: add "clean" section 6 | # 2014-06-25 - J.E. Klasek 7 | # 8 | # copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 9 | # license: GNU General Public License version 2, see LICENSE for more details. 10 | # 11 | 12 | ASM=a09 13 | CFLAGS=-O3 -fomit-frame-pointer -DTERM_CONTROL 14 | 15 | all: v09 v09t ef09 uslash crc16 crc32 input printval erat-sieve 16 | 17 | v09: v09.c 18 | 19 | v09t: v09.c 20 | $(CC) $(CFLAGS) -DTRACE -o $@ $< 21 | 22 | a09: a09.c 23 | 24 | 25 | # ------------------------------------ 26 | 27 | bench09: bench09.asm $(ASM) 28 | $(ASM) $< 29 | 30 | test09: test09.asm $(ASM) 31 | $(ASM) $< 32 | 33 | input: input.asm $(ASM) 34 | $(ASM) $< 35 | 36 | uslash: uslash.asm $(ASM) 37 | $(ASM) -l $@.lst $< 38 | 39 | crc16: crc16.asm $(ASM) 40 | $(ASM) -l $@.lst $< 41 | 42 | crc32: crc32.asm $(ASM) 43 | $(ASM) -l $@.lst $< 44 | 45 | ef09: ef09.asm $(ASM) 46 | $(ASM) -l $@.lst $< 47 | 48 | printval: printval.asm $(ASM) 49 | $(ASM) -l $@.lst $< 50 | 51 | erat-sieve: erat-sieve.asm 52 | $(ASM) -l $@.lst $< 53 | 54 | # ------------------------------------ 55 | 56 | cleanall: clean 57 | rm -f v09 $(ASM) bench09 test09 ef09 58 | 59 | clean: 60 | rm -f core *.BAK 61 | 62 | archive: clean 63 | @(cd ..; \ 64 | tar cvfz sim6809.tgz sim6809 ) 65 | 66 | # ------------------------------------ 67 | 68 | DIST=sim6809-jk-edition 69 | FILES=ef09.asm bench09.asm test09.asm printval.asm uslash.asm crc32.asm erat-sieve.asm input.asm crc16.asm $(ASM).c v09.c v09tc.c README info.txt erat-sieve.txt $(ASM) v09 v09t 70 | 71 | dist: 72 | mkdir -p $(DIST) 73 | cp -p $(FILES) $(DIST)/. 74 | cp -p Makefile.dist $(DIST)/Makefile 75 | cp -p info.en.txt $(DIST)/info.txt 76 | tar cvfz $(DIST).tgz $(DIST) 77 | rm -rf $(DIST) 78 | 79 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | 6809 Simulator/Emulator 2 | ======================= 3 | 4 | sbc09 stands for Lennart Benschop 6809 Single Board Computer. 5 | It contains a assembler and simulator for the Motorola M6809 processor. 6 | 7 | copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 8 | license: GNU General Public License version 2, see LICENSE for more details. 9 | 10 | 11 | Forum thread: http://archive.worldofdragon.org/phpBB3/viewtopic.php?f=8&t=4880 12 | Project: https://github.com/6809/sbc09 13 | 14 | 15 | For the usage of the assembler a09 and 6809 single board system v09 16 | read doc/sbc09.creole! 17 | 18 | 19 | This distribution includes two different kinds of simulators: 20 | 1. The old sim6809 based "simple" simulator built as v09s, v09st 21 | 2. The 6809 single board system as a stand alone environment built as v09 22 | 23 | 24 | 25 | Structure 26 | --------- 27 | 28 | src/ 29 | Source for the developement tools and virtual machines ... 30 | 31 | a09.c 32 | The 6809 assembler. It's fairly portable (ANSI) C. It works on both 33 | Unix and DOS (TC2.0). 34 | 35 | Features of the assembler: 36 | - generates binary file starting at the first address 37 | where code is actually generated. So an initial block of RMB's 38 | (maybe at a different ORG) is not included in the file. 39 | - Accepts standard syntax. 40 | - full expression evaluator. 41 | - Statements SET, MACRO, PUBLIC, EXTERN IF/ELSE/ENDIF INCLUDE not yet 42 | implemented. Some provisions are already made internally for macros 43 | and/or relocatable objects. 44 | 45 | v09s.c 46 | The (old) 6809 simulator. Loads a binary image (from a09) at adress $100 47 | and starts executing. SWI2 and SWI3 are for character output/input. 48 | SYNC stops simulation. When compiling set -DBIG_ENDIAN if your 49 | computer is big-endian. Set TERM_CONTROL for a crude single character 50 | (instead of ANSI line-by-line) input. Works on Unix. 51 | 52 | v09stc.c 53 | Same as v09s.c but for Turbo C. Has its own term control. 54 | 55 | v09.c 56 | engine.c 57 | io.c 58 | The 6809 single board simulator/emulator v09. 59 | 60 | mon2.asm 61 | Monitor progam, alternative version of monitor.asm 62 | (used in ROM image alt09.rom) 63 | 64 | monitor.asm 65 | Monitor progam (used in ROM image v09.rom for v09) 66 | 67 | makerom.c 68 | Helper tool to generate ROM images for v09. 69 | 70 | 71 | basic/ 72 | Basic interpreters ... 73 | 74 | basic.asm 75 | Tiny Basic 76 | fbasic.asm 77 | Tiny Basic with Lennarts floating point routines. 78 | 79 | 80 | doc/ 81 | Documentation ... 82 | 83 | 84 | examples/ 85 | Several test and benchmark programs, simple routines and some bigger stuff 86 | like a Forth system (ef09). 87 | 88 | ef09.asm Implementation of E-Forth, a very rudimentary and portable Forth. 89 | Type WORDS to see what words you have. You can evaluate RPN integer 90 | expressions, like "12 34 + 5 * . " You can make new words like 91 | " : SQUARED DUP * ; " etc. 92 | 93 | 94 | examples_forth/ 95 | Forth environment with examples. 96 | For the 6809 single board system. 97 | 98 | 99 | 100 | 101 | Notes on Linux Fedora Core 6 102 | ---------------------------- 103 | 2012-06-04 104 | 105 | Compiling v09s, v09st: 106 | 107 | * BIG_ENDIAN (already used by LINUX itself, changed to CPU_BIG_ENDIAN) 108 | Now automatically set according to BIG_ENDIAN and BYTE_ORDER 109 | if existing. 110 | 111 | * If TERM_CONTROL mode is active the keyboard is not really in raw mode - 112 | keyboard signals are still allowed. 113 | 114 | * A tracefilter based on register values can be placed in the TRACE area to 115 | get tracing output triggered by special states 116 | 117 | 118 | 119 | a09 Assembler 120 | ------------- 121 | 122 | Bugfixes: 123 | * addres modes a,INDEXREG b,INDEXREG d,INDEXREG now known 124 | as *legal*! 125 | 126 | Extended version: 127 | http://lennartb.home.xs4all.nl/A09.c 128 | (see above) 129 | 130 | * options -x and -s produces output in Intel Binary/Srecord format, 131 | contains the above mentioned bugfixes (but fixed by the original 132 | author). 133 | 134 | 135 | 136 | 137 | v09s* Simulator 138 | --------------- 139 | 140 | ### CC register 141 | 142 | E F H I N Z V C Flag 143 | 8 7 6 5 4 3 2 1 Bit 144 | | | | | | | | | 145 | | | | | | | | +- $01 146 | | | | | | | +--- $02 147 | | | | | | +----- $04 148 | | | | | +------- $08 149 | | | | +--------- $10 150 | | | +----------- $20 151 | | +------------- $40 152 | +--------------- $80 153 | 154 | 155 | # differences from real 6809: 156 | 157 | ldd #$0fc9 158 | addb #$40 ; $C9+$40 -> $09 -> C=1 159 | adca #$00 ; $0F+C -> $10 -> H=1 160 | 161 | Should Set the half-carry! 162 | 163 | For this example the half-carry is set on a real 6809, also correctly 164 | emulated on the VCC. v09s does the same. 165 | 166 | According to "Motorola 6809 and Hitachi 6309 Programmer's Reference" 167 | the half-carry is only properly set for ADD and ADC (on 8-bit accumulators). 168 | For ASR, ASL (= LSL), CMP, SBC, SUB this condition flag is undefined. 169 | The v09s simulator calculates the half-carry also for ASR and ASL. 170 | 171 | ASL does the following: 172 | * sets H if bit 4 was set. 173 | * clears H if bit was not set. 174 | 175 | ASR (=LSR) does the following: 176 | * xxx1 xxxx --- (LSR|ASR) ---> xxxx 1xxx => H=1 177 | * xxx0 xxxx --- (LSR|ASR) ---> xxxx 0xxx => H=0 178 | 179 | 180 | But note: LSR never touches the half-carry! 181 | 182 | 183 | ## TFR/EXG with unaligned register sizes 184 | 185 | See http://archive.worldofdragon.org/phpBB3/viewtopic.php?f=8&t=5512 186 | Points to the 6309 behavior which is not compatible to 6809! 187 | 188 | tfr x,b ; 6809,6309: b low byte of x, a unchanged 189 | tfr x,a ; 6809, a low byte of x, b unchanged 190 | ; on a 6309: a high(!) byte of x, b unchanged 191 | 192 | Might be used to get the low byte out of an index register without harm 193 | the A register: 194 | 195 | instead of 196 | pushs a 197 | tfr x,d 198 | andb #$1f 199 | it could be used 200 | tfr x,b 201 | andb #$1f ; a left untouched! 202 | 203 | REF: http://www.6809.org.uk/dragon/illegal-opcodes.shtml 204 | REF: http://archive.worldofdragon.org/phpBB3/viewtopic.php?f=8&t=4886 205 | 206 | tfr a,x ; low byte of x has value of a, high byte is $FF 207 | tfr b,x ; low byte of x has value of b, high byte is $FF 208 | 209 | exg a,x ; low byte of x has value of a, high byte is $FF 210 | exg b,x ; low byte of x has value of b, high byte is $FF 211 | 212 | According to Motorola 6809 and Hitachi 6309 Programmer's Reference 213 | 214 | Except for the case where the first operand is 8 bit and register CC or DP: 215 | In this case the 16-bit register has the value of the 8-bit register in 216 | high and low byte! 217 | 218 | 219 | ### special behavior 220 | 221 | swi2 output character (STDOUT) in register B 222 | swi3 read character from keyboard into register B 223 | sync exit simulator 224 | 225 | 226 | ### start program 227 | v09s BINARY 228 | 229 | ### start program with tracing output on STDOUT 230 | v09st BINARY 231 | 232 | ### run program and leave memory dump (64k) 233 | 234 | # memory dump in file dump.v09 235 | v09s -d BINARY 236 | 237 | 238 | 239 | ### Bugfixes 240 | 241 | * static int index; 242 | otherwise the global C library function index() is referenced! 243 | Write access on it leads to a core dump. 244 | 245 | * BIG_ENDIAN is not useable in FLAG because (POSIX?) Unix 246 | (especially Linux) defines its byte order. 247 | If BIG_ENDIAN == BYTE_ORDER -> architecture is big endian! 248 | Changed to CPU_BIG_ENDIAN, which is refering BIG_ENDIAN and 249 | BYTE_ORDER automatically (if existent). 250 | 251 | 252 | 253 | 254 | 255 | 256 | eForth 257 | ------ 258 | 259 | Source: 260 | 261 | ef09.asm 262 | 263 | Backspace character changed from 127 to 8. 264 | 265 | 266 | Memory-Layout: 267 | 268 | 0100 At this address the binary is placed to, the Forth entry point 269 | 03C0 USER area start 270 | 4000 Memory TOP 271 | 272 | 273 | I/O: 274 | Keyboard input: 275 | * ^H or BSP deletes character 276 | * RETURN -> interrupts (long) output 277 | 278 | Start: 279 | 280 | ../v09s ef09 281 | 282 | 283 | Bugs: 284 | SEE ; 285 | STAR (*) : * UM* DROP ; ... wrong, 286 | : * M* DROP ; ... correct (sign!) 287 | 288 | Typical commands: 289 | 290 | Commands alway in upper case!!! 291 | 292 | WORD list of defined words of the current vocabulary 293 | 294 | BYE exit Forth (back to shell) 295 | DUMP hex memory dump 296 | SEE HL-word decompiler, corrected: 297 | * stops at EXIT 298 | * handles more special primitives (literals, strings, 299 | variable, constants)) 300 | * handles Direct Threading 301 | * output line by line with address 302 | .S shows the content of the parameter stack 303 | 304 | count FOR ... NEXT 305 | replacement for 306 | hi lo DO ... I ... LOOP 307 | hi lo - 1+ FOR ... R@ lo + ... NEXT 308 | 309 | 310 | 311 | 312 | Extensions: 313 | 314 | ZEQUAL 0= Primitive 315 | PLUS1 1+ Primitive, added 316 | 2012-06-07 317 | ROLL ROLL HL, added 318 | CONST CONSTANT HL, added 319 | doCONST Primitive, added 320 | 321 | 2012-06-08 322 | TWOSTAR 2* Primtive, added 323 | TWOSLASH 2/ Primtive, added 324 | MINUS1 1- Primtive, added 325 | SWAPHL >< Primtive, added 326 | STAR256 256* Primtive, added 327 | SLASH256 256/ Primtive, added 328 | CMOVE CMOVE Primtive 329 | FILL FILL Primtive 330 | 2012-06-09 331 | ULESS U< Primitive 332 | LESS < Primitive 333 | DO DO HL, added 334 | QDO ?DO HL, added 335 | DODO (DO) Primitive, added 336 | DOQDO (?DO) Primitive, added 337 | LOOP LOOP HL, added 338 | PLOOP +LOOP HL, added 339 | DOLOOP (LOOP) Primitive, added 340 | DOPLOOP (+LOOP) Primitive, added 341 | 342 | 2012-06-11 343 | NEGAT NEGATE Primitive, alternative added 344 | UMSTA UM* Primitive, but without MUL 345 | LSHIFT LSHIFT Primitive, added 346 | RSHIFT RSHIFT Primitive, added 347 | 2012-06-12 348 | LEAVE LEAVE Primitive, added (fig Forth) 349 | MDO -DO HL, added 350 | DOMDO (-DO) Primitive, added 351 | I I Primitive, added (same as R@) 352 | CMOVEW CMOVE Primitive, other implementation 353 | STAR * korr.: uses M* (instead UM*) 354 | BLANK BL Constant 355 | 356 | 2012-06-19 357 | USLASH U/ Primitive, same as UM/MOD 358 | UM/MOD uses USLASH 359 | 360 | 2012-06-20 361 | DPLUS D+ Primitive 362 | DSUB D- HL 363 | ZERO 0 Constant 364 | ONE 1 Constant 365 | TWO 2 Constant 366 | MONE -1 Constant 367 | DOCLIT doCLIT Primitive 368 | 2012-06-21 369 | SEE SEE extended: handles LIT, CLIT 370 | 2012-06-22 371 | SEE SEE extended: handles 372 | BRANCH,?BRANCH,?DO,-DO,LOOP,+LOOP,."..." 373 | 374 | 2012-09-07 375 | SEE SEE ABORT", (DO) added, remarks corrected. 376 | 377 | TODO: 378 | * XXX marks points to open issues. 379 | * SEE command: 380 | handling of 381 | - [COMPILE] 382 | - DOCONST, DOVAR, DOUSE 383 | 384 | 385 | TEST: 386 | 387 | HEX ok 388 | 0 8000 8001 U/ . . FFFE 2 ok 389 | FFFE 8001 U* . . U* ? ok 390 | FFFE 8001 UM* . . 7FFF FFFE ok 391 | FFFE 8001 UM* 2 0 D+ . . 8000 0 ok 392 | 393 | 0 8000 7FFF U/ . . FFFF FFFF ok 394 | 0 FFFF FFFF U/ . . FFFF FFFF ok 395 | 0 FFFE FFFF U/ . . FFFE FFFE ok 396 | FFFF FFFF UM* . . FFFE 1 ok 397 | FFFF FFFE FFFF U/ . . FFFF FFFE ok 398 | 399 | 400 | 401 | 402 | 403 | Links/References 404 | ================ 405 | 406 | 407 | Project: 408 | https://github.com/6809/sbc09 409 | Maintained by the original author and others. 410 | 411 | Source: 412 | http://groups.google.com/group/alt.sources/browse_thread/thread/8bfd60536ec34387/94a7cce3fdc5df67 413 | Autor: Lennart Benschop lennart@blade.stack.urc.tue.nl, 414 | lennartb@xs4all.nl (Webpage, Subject must start with "Your Homepage"!) 415 | 416 | Newsgroups: alt.sources 417 | From: lennart@blade.stack.urc.tue.nl (Lennart Benschop) 418 | Date: 3 Nov 1993 15:21:16 GMT 419 | Local: Mi 3 Nov. 1993 17:21 420 | Subject: 6809 assembler and simulator (examples) 2/2 421 | 422 | 423 | Homepage/Download links of Lennart Benschop: 424 | http://lennartb.home.xs4all.nl/m6809.html 425 | http://lennartb.home.xs4all.nl/sbc09.tar.gz 426 | http://lennartb.home.xs4all.nl/A09.c 427 | 428 | 429 | Emulator for 6809 written in Python, can run sbc09 ROM: 430 | https://github.com/jedie/DragonPy/ 431 | 432 | 433 | Newer posting in alt.sources (1994): 434 | 435 | Newsgroups: alt.sources 436 | From: lenn...@blade.stack.urc.tue.nl (Lennart Benschop) 437 | Date: 17 May 1994 08:13:25 GMT 438 | Local: Di 17 Mai 1994 10:13 439 | Subject: 6809 assembler/simulator (3 of 3) 440 | 441 | 442 | Referenced by: 443 | 444 | http://foldoc.org/6809 445 | Reference points to posting with buggy version from 1993. 446 | 447 | http://lennartb.home.xs4all.nl/m6809.html 448 | BAD LINK: http://www.sandelman.ocunix.on.ca/People/Alan_DeKok/interests/6809.html 449 | -> http://www.sandelman.ottawa.on.ca/People/Alan_DeKok/interests/ 450 | 6809 specific site will be redirected, but does not exist. 451 | 452 | Internet-Archiv: 453 | https://web.archive.org/web/20070112041235/http://www.striker.ottawa.on.ca/6809/ 454 | 2014-05-01: Lennart B. lennartb@xs4all.nl has been informed. 455 | 456 | http://archive.worldofdragon.org/phpBB3/viewtopic.php?f=5&t=4308&start=60#p9750 457 | -------------------------------------------------------------------------------- /alt09.rom: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/6809/sbc09/39181b46a058fe23f6606ee2fe5e6d237f7d4ba0/alt09.rom -------------------------------------------------------------------------------- /basic/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile examples SBC09/Sim6809 3 | # 4 | # created 1994 by L.C. Benschop 5 | # 2014-06-25 - J.E. Klasek 6 | # 7 | # copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 8 | # license: GNU General Public License version 2, see LICENSE for more details. 9 | # 10 | 11 | ASM=../a09 12 | 13 | PROGS=basic fbasic 14 | 15 | OTHER=floatnum.inc makeflot 16 | 17 | 18 | all: $(ASM) $(PROGS) 19 | 20 | $(ASM): 21 | $(MAKE) -c ../src a09 install 22 | 23 | # ------------------------------------ 24 | # rules 25 | 26 | .SUFFIXES: .asm 27 | 28 | .asm: 29 | $(ASM) -l $@.lst $< 30 | 31 | # ------------------------------------ 32 | 33 | basic: basic.asm 34 | 35 | 36 | fbasic: fbasic.asm floatnum.inc 37 | $(ASM) -l $@.lst fbasic.asm 38 | 39 | floatnum.inc: floatnum.src makeflot 40 | ./makeflot < floatnum.src > floatnum.inc 41 | 42 | makeflot: makeflot.c 43 | 44 | 45 | # ------------------------------------ 46 | 47 | cleanall: clean 48 | rm -f $(PROGS) $(OTHER) 49 | 50 | clean: 51 | rm -f core *.BAK *.lst $(PROGS) 52 | 53 | -------------------------------------------------------------------------------- /basic/README.txt: -------------------------------------------------------------------------------- 1 | BASIC AND FLOATING POINT ROUTINES FOR THE 6809 2 | ============================================== 3 | 4 | sbc09 stands for Lennart Benschop 6809 Single Board Computer. 5 | It contains a assembler and simulator for the Motorola M6809 processor. 6 | 7 | copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 8 | license: GNU General Public License version 2, see LICENSE for more details. 9 | 10 | 11 | 12 | FLOATING POINT ROUTINES FOR THE 6809 13 | ------------------------------------ 14 | 15 | They are intended to be used with the sbc09 system. These routines 16 | should be fairly portable to any 6809-based system. 17 | 18 | As it is an unfinished program (intended to become a full-featured 19 | BASIC interpreter one day), I never released it before and I almost 20 | forgot about it. Fortunately it was still on a backup CD-R that I 21 | made in 2001. 22 | 23 | 24 | FILES 25 | - - - 26 | 27 | makeflot.c Conversion tool to convert floatnum.src to floatnum.inc 28 | 29 | floatnum.inc Floating point constants to be included in main program. 30 | floatnum.src Same constants, but not converted to binary. 31 | 32 | fbasic.asm RPN calculator with floating point (just to test the FP routines. 33 | This was intended to be part of a larger Basic interpreter, 34 | but this was never finished). 35 | 36 | basic.asm Tiny Basic 37 | basic.txt Tiny Basic instructions 38 | 39 | It was originally planned to turn this into a full-fledged BASIC 40 | interpreter (maybe somewhat like BBC Basic), but this never 41 | happened. It is now a rudimentary RPN calculator, just to test the 42 | floating point routines. Each number or command needs to be on a separate 43 | line. 44 | 45 | 46 | 47 | 48 | MAKE THE PROGRAMS 49 | - - - - - - - - - 50 | 51 | Simple: 52 | 53 | make 54 | 55 | 56 | Or in single steps: 57 | 58 | compile the helper tool ... 59 | 60 | ./makeflot floatnum.inc 61 | 62 | 63 | assemble the FP calculator ... 64 | 65 | ./a09 fbasic.asm 66 | 67 | 68 | assemble Tiny Basic (integer only) ... 69 | 70 | ./a09 basic.asm 71 | 72 | 73 | 74 | 75 | RUN THE PROGRAMS 76 | - - - - - - - - 77 | 78 | 79 | Start the board simulator 80 | 81 | ../v09 82 | 83 | You should see the prompt "Welcome to BUGGY version 1.0" 84 | 85 | Type the command 86 | 87 | xl400 88 | 89 | Press the escape character Control-] 90 | (e.g. on Linux for a german style keyboard Control+AltGr+9) 91 | 92 | Then you see the v09> prompt. 93 | 94 | Type the command 95 | 96 | ufbasic 97 | 98 | Now the file "fbasic" will be uploaded to the board. 99 | 100 | Type the command 101 | 102 | g400 103 | 104 | Now you can type floating point numbers and commands (RPN style), each 105 | on a different line, like this 106 | 107 | 2 108 | 3 109 | * 110 | 6.00000000E+00 111 | 112 | 1 113 | 0 114 | / 115 | 116 | The last calculation breaks back to the monitor. 117 | 118 | The following commands are available (see the source): 119 | + - * / (the normal arithmetic operators). 120 | = compare top two numbers on stack (and leave them), show < = or > 121 | i round to integer (round to -Inf, like BASIC INT() function). 122 | q square root 123 | s sin 124 | c cos 125 | t tan 126 | a atan 127 | l ln 128 | e exp 129 | d duplicate number on stack 130 | x exchange top numbers on stack. 131 | r remove top of stack. 132 | 133 | 134 | 135 | IMPLEMENTATION NOTES 136 | - - - - - - - - - - 137 | 138 | This is a 40-bit float, like many microcomputers of the 80s had, 139 | including the Commodore 64, the ZX-Spectrum, the BBC and others. It 140 | has an 8-bit exponent and a 32-bit mantissa (with hidden leading bit). 141 | The basic operations (including square root) should be as accurate as 142 | can be expected. 143 | 144 | It does not do IEEE-754 features, such as Infinity, NaN, +/-zero and 145 | subnormal numbers, but appears to work quite reasonably. 146 | 147 | Trig functions deviate a few places in the 9th decimal. In particular 148 | sin(pi/2) shows as 9.99999998E-01 instead of 1.00000000E+00. I 149 | consider this acceptable and consistent with what could be expected. 150 | 151 | The Log function deviates a few places in the 8th decimal. LN(5) appears to 152 | be about worst-case. I find this a bit disappointing. 153 | 154 | 2 155 | l 156 | 5 157 | l 158 | + 159 | e 160 | 161 | should show exactly 10, but it shows 9.99999970E+00 instead. This is 162 | not caused by the exp function, but by the log of 5 (as I checked with 163 | Python). 164 | 165 | 166 | -------------------------------------------------------------------------------- /basic/basic.asm: -------------------------------------------------------------------------------- 1 | ;NAM TB01V137 2 | * WRITTEN 20-OCT-77 BY JOHN BYRNS 3 | * REVISED 30-DEC-77 4 | * REVISED 18-JAN-78 5 | * REVISED 10-APR-78 6 | * REVISED 08-MAY-79 TO ELIMINATE USE OF SP 7 | * REVISED 24-JAN-80 TO USE 6801 ON CHIP RAM 8 | * REVISED 26-JAN-80 FOR NEW 6801 INSTRUCTIONS 9 | * REVISED 24-JUL-81 FOR WHISTON BOARD 10 | * REVISED 24-SEP-81 INCLUDE USER FUNCTION 11 | * REVISED 08-APR-82 MAKE STANDALONE INCLUDE HEX CONSTANTS AND MEM FUNCTION 12 | * REVISED 21-NOV-84 FOR 6809 13 | * REVISED FEB 94 ADAPTED TO SIMULATOR AND BUGFIXES BY L.C. BENSCHOP. 14 | * 15 | EOL EQU $04 16 | ETX EQU $03 17 | SPACE EQU $20 18 | CR EQU $0D 19 | LF EQU $0A 20 | BS EQU $08 21 | CAN EQU $18 22 | BELL EQU $07 23 | FILL EQU $00 24 | DEL EQU $7F 25 | BSIZE EQU 73 26 | STKCUS EQU 48 27 | * 28 | ACIA EQU $E000 29 | RMCR EQU ACIA 30 | TRCS EQU ACIA 31 | RECEV EQU ACIA+1 32 | TRANS EQU ACIA+1 33 | CNTL1 EQU $03 34 | CNTL2 EQU $15 35 | RDRF EQU $01 36 | ORFE EQU $20 37 | TDRE EQU $02 38 | * EDIT THE FOLLOWING EQUATES TO REFLECT THE 39 | * DESIRED ROM AND RAM LAYOUT 40 | LORAM EQU $0080 ADDRESS OF DIRECT PAGE SCRATCH RAM 41 | BUFFER EQU $4000 ADDRESS OF MAIN RAM 42 | RAMSIZ EQU $2000 SIZE OF MAIN RAM 43 | ROMADR EQU $400 ADDRESS OF TINY BASIC ROM 44 | * 45 | RAMBEG EQU BUFFER+BSIZE 46 | RAMEND EQU BUFFER+RAMSIZ 47 | * 48 | RAMPAT EQU $AA0F 49 | ROMPAT EQU $F055 50 | * 51 | ORG LORAM 52 | USRBAS RMB 2 53 | USRTOP RMB 2 54 | STKLIM RMB 2 55 | STKTOP RMB 2 56 | CURSOR RMB 2 57 | SAVESP RMB 2 58 | LINENB RMB 2 59 | SCRTCH RMB 2 60 | CHAR RMB 2 61 | ZONE RMB 1 62 | MODE RMB 1 63 | RESRVD RMB 1 64 | LOEND EQU * 65 | * 66 | ORG ROMADR 67 | BASIC JMP SETUP 68 | WARMS LDS STKTOP 69 | JSR INTEEE 70 | BRA WMS05 71 | SETUP LDS #RAMEND-52 72 | SET03 STS STKTOP 73 | JSR INTEEE 74 | CLEAR LDD #RAMBEG 75 | STD USRBAS 76 | STD USRTOP 77 | CLR02 STD STKLIM 78 | WMS05 JSR CRLF 79 | LDX #VSTR 80 | JSR PUTSTR 81 | CMDB LDS STKTOP 82 | CLR MODE 83 | JSR CRLF 84 | LDX USRBAS 85 | STX CURSOR 86 | CMDE LDX #0000 87 | STX LINENB 88 | TST MODE 89 | BNE CMD01 90 | LDA #': 91 | JSR PUTCHR 92 | CMD01 JSR GETLIN 93 | JSR TSTNBR 94 | BCC CMD02 95 | BVS CMD05 96 | JSR SKIPSP 97 | CMPA #EOL 98 | BEQ CMDE 99 | JSR MSLINE 100 | BRA CMDB 101 | CMD02 PSHS X 102 | LDX USRTOP 103 | CMPX STKLIM 104 | PULS X 105 | BEQ CMD03 106 | JMP ERRORR 107 | CMD03 ADDD #0 108 | BEQ CMD05 109 | CMD04 PSHS D 110 | SUBD #9999 111 | PULS D 112 | BHI CMD05 113 | BSR EDITOR 114 | BRA CMDE 115 | CMD05 JMP ERRORS 116 | VSTR FCC /TINY V1.37/ 117 | FCB EOL 118 | ****************************** 119 | ****************************** 120 | EDITOR PSHS D 121 | JSR SKIPSP 122 | STX SCRTCH 123 | LDA 0,S 124 | LDX CURSOR 125 | CMPX USRTOP 126 | BEQ ED00 127 | CMPD 0,X 128 | BCC ED01 129 | ED00 LDX USRBAS 130 | ED01 JSR FNDLIN 131 | STX CURSOR 132 | BCS ED04 133 | STX SAVESP 134 | LEAX 2,X 135 | ED02 LDA ,X+ 136 | CMPA #EOL 137 | BNE ED02 138 | ED03 CMPX USRTOP 139 | BEQ ED35 140 | LDA ,X+ 141 | STX CHAR 142 | LDX SAVESP 143 | STA ,X+ 144 | STX SAVESP 145 | LDX CHAR 146 | BRA ED03 147 | ED35 LDX SAVESP 148 | STX USRTOP 149 | STX STKLIM 150 | ED04 LDX SCRTCH 151 | LDB #-1 152 | ED05 INCB 153 | LDA ,X+ 154 | CMPA #EOL 155 | BNE ED05 156 | TSTB 157 | BNE ED55 158 | LEAS 2,S 159 | RTS 160 | ED55 LEAX -1,X 161 | ADDB #4 162 | ED06 LEAX -1,X 163 | DECB 164 | LDA 0,X 165 | CMPA #SPACE 166 | BEQ ED06 167 | LDA #EOL 168 | STA 1,X 169 | CLRA 170 | LDX USRTOP 171 | STX CHAR 172 | ADDD USRTOP 173 | STD USRTOP 174 | STD STKLIM 175 | JSR TSTSTK 176 | BCC ED07 177 | STX USRTOP 178 | STX STKLIM 179 | JMP ERRORF 180 | ED07 LDX USRTOP 181 | ED08 STX SAVESP 182 | LDX CHAR 183 | CMPX CURSOR 184 | BEQ ED09 185 | LDA ,-X 186 | STX CHAR 187 | LDX SAVESP 188 | STA ,-X 189 | BRA ED08 190 | ED09 PULS D 191 | LDX CURSOR 192 | STD ,X++ 193 | STX CHAR 194 | ED10 LDX SCRTCH 195 | LDA ,X+ 196 | STX SCRTCH 197 | LDX CHAR 198 | STA ,X+ 199 | STX CHAR 200 | CMPA #EOL 201 | BNE ED10 202 | RTS 203 | ****************************** 204 | ****************************** 205 | PUTS01 JSR PUTCHR 206 | LEAX 1,X 207 | PUTSTR LDA 0,X 208 | CMPA #EOL 209 | BNE PUTS01 210 | RTS 211 | ****************************** 212 | ****************************** 213 | CRLF LDX #CRLFST 214 | BSR PUTSTR 215 | CLR ZONE 216 | RTS 217 | CRLFST FCB CR,LF,DEL,FILL,FILL,FILL,EOL 218 | ****************************** 219 | ****************************** 220 | ERRORF BSR ER01 221 | FCC /SORRY/ 222 | FCB EOL 223 | ERRORS BSR ER01 224 | FCC /WHAT ?/ 225 | FCB EOL 226 | ERRORR BSR ER01 227 | FCC /HOW ?/ 228 | FCB EOL 229 | BREAK BSR ER01 230 | FCC /BREAK/ 231 | FCB EOL 232 | END BSR ER01 233 | FCC /STOP/ 234 | FCB EOL 235 | ER01 BSR CRLF 236 | LDA #BELL 237 | JSR PUTCHR 238 | LDD LINENB 239 | JSR PRNT4 240 | LDA #SPACE 241 | JSR PUTCHR 242 | PULS X 243 | BSR PUTSTR 244 | BSR CRLF 245 | JMP CMDB 246 | ****************************** 247 | ****************************** 248 | GL00 BSR CRLF 249 | GETLIN LDX #BUFFER 250 | GL03 JSR GETCHR 251 | CMPA #SPACE 252 | BCS GL05 253 | CMPA #$7F 254 | BEQ GL03 255 | CMPX #BUFFER+BSIZE-1 256 | BNE GL04 257 | LDA #BELL 258 | BRA GL02 259 | GL04 STA ,X+ 260 | GL02 JSR PUTCHR 261 | BRA GL03 262 | GL05 CMPA #BS 263 | BEQ GL07 264 | CMPA #CAN 265 | BEQ GL00 266 | CMPA #LF 267 | BEQ GL09 268 | CMPA #CR 269 | BNE GL03 270 | TST MODE 271 | BEQ GL06 272 | JSR PUTCHR 273 | BRA GL08 274 | GL06 PSHS X 275 | JSR CRLF 276 | PULS X 277 | GL08 LDA #EOL 278 | STA 0,X 279 | LDX #BUFFER 280 | RTS 281 | GL07 CMPX #BUFFER 282 | BEQ GL03 283 | LEAX -1,X 284 | LDA #BS 285 | JSR PUTCHR 286 | LDA #SPACE 287 | JSR PUTCHR 288 | LDA #BS 289 | BRA GL02 290 | GL09 ORCC #$01 291 | ROR MODE 292 | BRA GL02 293 | ****************************** 294 | ****************************** 295 | REM00 LEAX 1,X 296 | REM BSR SKIPSP 297 | CMPA #EOL 298 | BNE REM00 299 | ENDSMT JSR TSTEOL 300 | ENDS02 LDA LINENB 301 | ORA LINENB+1 302 | BEQ REM09 303 | REM05 CMPX USRTOP 304 | BNE NXTLIN 305 | JMP ERRORR 306 | NXTLIN LDD ,X++ 307 | STD LINENB 308 | MSLINE JSR TSTBRK 309 | BSR IFAN 310 | BCS IMPLET 311 | PSHS D 312 | REM09 RTS 313 | IMPLET JMP LET 314 | ****************************** 315 | ****************************** 316 | IFAN BSR SKIPSP 317 | STX CURSOR 318 | LDX #VERBT 319 | FAN00 LDA ,X+ 320 | CMPA #EOL 321 | BNE FAN04 322 | LDX CURSOR 323 | ORCC #$01 324 | RTS 325 | FAN04 STX CHAR 326 | LDX CURSOR 327 | STX SCRTCH 328 | FAN05 LDX SCRTCH 329 | CMPA 0,X 330 | BNE FAN07 331 | LEAX 1,X 332 | STX SCRTCH 333 | LDX CHAR 334 | LDA ,X+ 335 | STX CHAR 336 | CMPA #EOL 337 | BNE FAN05 338 | LDD 0,X 339 | LDX SCRTCH 340 | ANDCC #$FE 341 | RTS 342 | FAN07 LDX CHAR 343 | FAN08 LDA ,X+ 344 | CMPA #EOL 345 | BNE FAN08 346 | LEAX 2,X 347 | BRA FAN00 348 | ****************************** 349 | ****************************** 350 | NXTNSP LEAX 1,X 351 | SKIPSP LDA 0,X 352 | CMPA #SPACE 353 | BEQ NXTNSP 354 | RTS 355 | ****************************** 356 | ****************************** 357 | TSTHEX BSR TSTDIG 358 | BCC TST05 359 | CMPA #'A 360 | BCS TST03 361 | CMPA #'F 362 | BHI TST03 363 | SUBA #'A-10 364 | ANDCC #$FE 365 | RTS 366 | ****************************** 367 | ****************************** 368 | TSTLTR CMPA #'A 369 | BCS TST03 370 | CMPA #'Z 371 | BLS TST05 372 | TST03 ORCC #$01 373 | RTS 374 | ****************************** 375 | ****************************** 376 | TSTDIG CMPA #'0 377 | BCS TST03 378 | CMPA #'9 379 | BHI TST03 380 | SUBA #'0 381 | TST05 ANDCC #$FE 382 | RTS 383 | ****************************** 384 | ****************************** 385 | TSTVAR BSR SKIPSP 386 | BSR TSTLTR 387 | BCS TSTV03 388 | TFR A,B 389 | LDA 1,X 390 | BSR TSTLTR 391 | BCC TST03 392 | LEAX 1,X 393 | SUBB #'A 394 | ASLB 395 | CLRA 396 | ADDD STKTOP 397 | TSTV02 ANDCC #$FE 398 | TSTV03 RTS 399 | ****************************** 400 | ****************************** 401 | USER JSR ARGONE 402 | PSHS D 403 | JSR SKIPSP 404 | CMPA #', 405 | BEQ USER03 406 | CMPA #') 407 | ORCC #$01 408 | BEQ USER05 409 | USER02 JMP ERRORS 410 | USER03 LEAX 1,X 411 | JSR EXPR 412 | PSHS A 413 | JSR SKIPSP 414 | CMPA #') 415 | PULS A 416 | BNE USER02 417 | ANDCC #$FE 418 | USER05 LEAX 1,X 419 | STX CURSOR 420 | JSR [,S++] 421 | LDX CURSOR 422 | ANDCC #$FE 423 | RTS 424 | ****************************** 425 | ****************************** 426 | TSTSNB JSR SKIPSP 427 | CMPA #'- 428 | BNE TSTNBR 429 | LEAX 1,X 430 | BSR TSTNBR 431 | BCS TSN02 432 | NEGA 433 | NEGB 434 | SBCA #0 435 | ANDCC #$FC 436 | TSN02 RTS 437 | ****************************** 438 | ****************************** 439 | TSTNBR JSR SKIPSP 440 | JSR TSTDIG 441 | BCC TSTN02 442 | CMPA #'$ 443 | ORCC #$01 444 | BNE TSTN09 445 | TSTN20 LEAX 1,X 446 | CLR ,-S 447 | CLR ,-S 448 | TSTN23 LDA 0,X 449 | JSR TSTHEX 450 | BCS TSTN07 451 | LEAX 1,X 452 | PSHS X 453 | PSHS A 454 | LDD 3,S 455 | BITA #$F0 456 | BNE TSTN11 457 | ASLB 458 | ROLA 459 | ASLB 460 | ROLA 461 | ASLB 462 | ROLA 463 | ASLB 464 | ROLA 465 | ADDB ,S+ 466 | STD 2,S 467 | PULS X 468 | BRA TSTN23 469 | TSTN02 LEAX 1,X 470 | PSHS A 471 | CLR ,-S 472 | TSTN03 LDA 0,X 473 | JSR TSTDIG 474 | BCS TSTN07 475 | LEAX 1,X 476 | PSHS X 477 | PSHS A 478 | LDD 3,S 479 | ASLB 480 | ROLA 481 | BVS TSTN11 482 | ASLB 483 | ROLA 484 | BVS TSTN11 485 | ADDD 3,S 486 | BVS TSTN11 487 | ASLB 488 | ROLA 489 | BVS TSTN11 490 | ADDB 0,S 491 | ADCA #0 492 | BVS TSTN11 493 | STD 3,S 494 | LEAS 1,S 495 | PULS X 496 | BRA TSTN03 497 | TSTN07 PULS D 498 | ANDCC #$FE 499 | TSTN09 ANDCC #$FD 500 | RTS 501 | TSTN11 LDX 1,S 502 | LEAS 5,S 503 | ORCC #$03 504 | RTS 505 | ****************************** 506 | ****************************** 507 | TSTSTK STS SAVESP 508 | LDD SAVESP 509 | SUBD #STKCUS 510 | SUBD STKLIM 511 | RTS 512 | ****************************** 513 | ****************************** 514 | PEEK JSR PAREXP 515 | PSHS D 516 | PSHS X 517 | LDB [2,S] 518 | PULS X 519 | LEAS 2,S 520 | CLRA 521 | RTS 522 | ****************************** 523 | ****************************** 524 | POKE JSR PAREXP 525 | PSHS D 526 | JSR SKIPSP 527 | CMPA #'= 528 | BEQ POKE05 529 | JMP ERRORS 530 | POKE05 LEAX 1,X 531 | JSR EXPR 532 | JSR TSTEOL 533 | PSHS X 534 | STB [2,S] 535 | PULS X 536 | LEAS 2,S 537 | JMP ENDS02 538 | ****************************** 539 | ****************************** 540 | TSTFUN JSR SKIPSP 541 | STX CURSOR 542 | LDX #FUNT 543 | JSR FAN00 544 | BCS TSTF05 545 | PSHS D 546 | TSTF05 RTS 547 | ****************************** 548 | ****************************** 549 | FUNT FCC /USR/ 550 | FCB EOL 551 | FDB USER 552 | FCC /PEEK/ 553 | FCB EOL 554 | FDB PEEK 555 | FCC /MEM/ 556 | FCB EOL 557 | FDB TSTSTK 558 | FCB EOL 559 | ****************************** 560 | ****************************** 561 | FLINE LDX USRBAS 562 | FNDLIN CMPX USRTOP 563 | BNE FND03 564 | ORCC #$03 565 | RTS 566 | FND03 CMPD 0,X 567 | BNE FND05 568 | ANDCC #$FC 569 | RTS 570 | FND05 BCC FND07 571 | ORCC #$01 572 | ANDCC #$FD 573 | RTS 574 | FND07 PSHS A 575 | LDA #EOL 576 | LEAX 1,X 577 | FND09 LEAX 1,X 578 | CMPA 0,X 579 | BNE FND09 580 | PULS A 581 | LEAX 1,X 582 | BRA FNDLIN 583 | ****************************** 584 | ****************************** 585 | RELEXP BSR EXPR 586 | PSHS D 587 | CLRB 588 | JSR SKIPSP 589 | CMPA #'= 590 | BEQ REL06 591 | CMPA #'< 592 | BNE REL03 593 | LEAX 1,X 594 | INCB 595 | JSR SKIPSP 596 | CMPA #'> 597 | BNE REL05 598 | LEAX 1,X 599 | ADDB #4 600 | BRA REL07 601 | REL03 CMPA #'> 602 | BNE EXPR06 603 | LEAX 1,X 604 | ADDB #4 605 | JSR SKIPSP 606 | REL05 CMPA #'= 607 | BNE REL07 608 | REL06 LEAX 1,X 609 | ADDB #2 610 | REL07 PSHS B 611 | BSR EXPR 612 | PSHS X 613 | SUBD 3,S 614 | TFR CC,A 615 | LSRA 616 | TFR A,B 617 | ASLA 618 | ASLA 619 | PSHS B 620 | ADDA ,S+ 621 | ANDA #$06 622 | BNE REL08 623 | INCA 624 | REL08 CLRB 625 | ANDA 2,S 626 | BEQ REL09 627 | COMB 628 | REL09 CLRA 629 | PULS X 630 | LEAS 3,S 631 | RTS 632 | ****************************** 633 | ****************************** 634 | EXPR CLR ,-S 635 | CLR ,-S 636 | JSR SKIPSP 637 | CMPA #'- 638 | BEQ EXPR05 639 | CMPA #'+ 640 | BNE EXPR03 641 | EXPR02 LEAX 1,X 642 | EXPR03 BSR TERM 643 | EXPR04 ADDD 0,S 644 | STD 0,S 645 | JSR SKIPSP 646 | CMPA #'+ 647 | BEQ EXPR02 648 | CMPA #'- 649 | BNE EXPR06 650 | EXPR05 LEAX 1,X 651 | BSR TERM 652 | NEGA 653 | NEGB 654 | SBCA #0 655 | BRA EXPR04 656 | EXPR06 PULS D 657 | RTS 658 | ****************************** 659 | ****************************** 660 | TERM JSR FACT 661 | PSHS D 662 | TERM03 JSR SKIPSP 663 | CMPA #'* 664 | BEQ TERM07 665 | CMPA #'/ 666 | BEQ TERM05 667 | PULS D 668 | RTS 669 | TERM05 LEAX 1,X 670 | BSR FACT 671 | PSHS X 672 | LEAX 2,S 673 | PSHS D 674 | EORA 0,X 675 | JSR ABSX 676 | LEAX 0,S 677 | JSR ABSX 678 | PSHS A 679 | LDA #17 680 | PSHS A 681 | CLRA 682 | CLRB 683 | DIV05 SUBD 2,S 684 | BCC DIV07 685 | ADDD 2,S 686 | ANDCC #$FE 687 | BRA DIV09 688 | DIV07 ORCC #$01 689 | DIV09 ROL 7,S 690 | ROL 6,S 691 | ROLB 692 | ROLA 693 | DEC 0,S 694 | BNE DIV05 695 | LDA 1,S 696 | LEAS 4,S 697 | TSTA 698 | BPL TERM06 699 | LEAX 2,S 700 | BSR NEGX 701 | TERM06 PULS X 702 | BRA TERM03 703 | TERM07 LEAX 1,X 704 | BSR FACT 705 | MULT PSHS B 706 | LDB 2,S 707 | MUL 708 | LDA 1,S 709 | STB 1,S 710 | LDB 0,S 711 | MUL 712 | LDA 2,S 713 | STB 2,S 714 | PULS B 715 | MUL 716 | ADDA 0,S 717 | ADDA 1,S 718 | STD 0,S 719 | BRA TERM03 720 | ****************************** 721 | ****************************** 722 | FACT JSR TSTVAR 723 | BCS FACT03 724 | PSHS X 725 | TFR D,X 726 | LDD 0,X 727 | PULS X 728 | FACT02 RTS 729 | FACT03 JSR TSTNBR 730 | BCC FACT02 731 | JSR TSTFUN 732 | BCC FACT02 733 | PAREXP BSR ARGONE 734 | PSHS A 735 | JSR SKIPSP 736 | CMPA #') 737 | PULS A 738 | BNE FACT05 739 | LEAX 1,X 740 | RTS 741 | FACT05 JMP ERRORS 742 | ****************************** 743 | ****************************** 744 | ARGONE JSR TSTSTK 745 | BCC FACT04 746 | JMP ERRORF 747 | FACT04 JSR SKIPSP 748 | CMPA #'( 749 | BNE FACT05 750 | LEAX 1,X 751 | JMP EXPR 752 | ****************************** 753 | ****************************** 754 | ABSX TST 0,X 755 | BPL NEG05 756 | NEGX NEG 0,X 757 | NEG 1,X 758 | BCC NEG05 759 | DEC 0,X 760 | NEG05 RTS 761 | ****************************** 762 | ****************************** 763 | TSTEOL PSHS A 764 | JSR SKIPSP 765 | CMPA #EOL 766 | BEQ TEOL03 767 | JMP ERRORS 768 | TEOL03 LEAX 1,X 769 | PULS A 770 | RTS 771 | ****************************** 772 | ****************************** 773 | LET JSR TSTVAR 774 | BCC LET03 775 | JMP ERRORS 776 | LET03 PSHS D 777 | JSR SKIPSP 778 | CMPA #'= 779 | BEQ LET05 780 | JMP ERRORS 781 | LET05 LEAX 1,X 782 | JSR EXPR 783 | BSR TSTEOL 784 | STX CURSOR 785 | PULS X 786 | STD 0,X 787 | LDX CURSOR 788 | JMP ENDS02 789 | ****************************** 790 | ****************************** 791 | IF JSR RELEXP 792 | TSTB 793 | BEQ IF03 794 | JMP MSLINE 795 | IF03 JMP REM 796 | ****************************** 797 | ****************************** 798 | GOTO JSR EXPR 799 | BSR TSTEOL 800 | JSR FLINE 801 | BCS GOSB04 802 | JMP NXTLIN 803 | ****************************** 804 | ****************************** 805 | GOSUB JSR EXPR 806 | BSR TSTEOL 807 | STX CURSOR 808 | JSR FLINE 809 | BCC GOSB03 810 | GOSB04 JMP ERRORR 811 | GOSB03 JSR TSTSTK 812 | BCC GOSB05 813 | JMP ERRORF 814 | GOSB05 LDD CURSOR 815 | PSHS D 816 | LDD LINENB 817 | PSHS D 818 | JSR NXTLIN 819 | PULS D 820 | STD LINENB 821 | PULS X 822 | JMP ENDS02 823 | ****************************** 824 | ****************************** 825 | RETURN EQU TSTEOL 826 | ****************************** 827 | ****************************** 828 | PRINT JSR SKIPSP 829 | PR01 CMPA #', 830 | BEQ PR05 831 | CMPA #'; 832 | BEQ PR07 833 | CMPA #EOL 834 | BEQ PR04 835 | CMPA #'" 836 | BNE PR02 837 | LEAX 1,X 838 | BSR PRNTQS 839 | BRA PR03 840 | PR02 JSR EXPR 841 | PSHS X 842 | BSR PRNTN 843 | PULS X 844 | PR03 JSR SKIPSP 845 | CMPA #', 846 | BEQ PR05 847 | CMPA #'; 848 | BEQ PR07 849 | CMPA #EOL 850 | BEQ PR04 851 | JMP ERRORS 852 | PR04 PSHS X 853 | JSR CRLF 854 | PULS X 855 | BRA PR08 856 | PR05 LDB #$7 857 | PR06 LDA #SPACE 858 | JSR PUTCHR 859 | BITB ZONE 860 | BNE PR06 861 | PR07 LEAX 1,X 862 | JSR SKIPSP 863 | CMPA #EOL 864 | BNE PR01 865 | PR08 LEAX 1,X 866 | JMP ENDS02 867 | * 868 | * 869 | PRQ01 JSR PUTCHR 870 | PRNTQS LDA ,X+ 871 | CMPA #EOL 872 | BNE PRQ03 873 | JMP ERRORS 874 | PRQ03 CMPA #'" 875 | BNE PRQ01 876 | RTS 877 | * 878 | PRNTN TSTA 879 | BPL PRN03 880 | NEGA 881 | NEGB 882 | SBCA #0 883 | PSHS A 884 | LDA #'- 885 | JSR PUTCHR 886 | PULS A 887 | PRN03 LDX #PRNPT-2 888 | PRN05 LEAX 2,X 889 | CMPD 0,X 890 | BCC PRN07 891 | CMPX #PRNPTO 892 | BNE PRN05 893 | PRN07 CLR CHAR 894 | PRN09 CMPD 0,X 895 | BCS PRN11 896 | SUBD 0,X 897 | INC CHAR 898 | BRA PRN09 899 | PRN11 PSHS A 900 | LDA #'0 901 | ADDA CHAR 902 | JSR PUTCHR 903 | PULS A 904 | CMPX #PRNPTO 905 | BEQ PRN13 906 | LEAX 2,X 907 | BRA PRN07 908 | PRN13 RTS 909 | PRNPT FDB 10000 910 | FDB 1000 911 | FDB 100 912 | FDB 10 913 | PRNPTO FDB 1 914 | * 915 | PRNT4 LDX #PRNPT+2 916 | BRA PRN07 917 | ****************************** 918 | ****************************** 919 | INPUT JSR TSTVAR 920 | BCS IN11 921 | PSHS D 922 | STX CURSOR 923 | IN03 LDA #'? 924 | JSR PUTCHR 925 | JSR GETLIN 926 | IN05 JSR SKIPSP 927 | CMPA #EOL 928 | BEQ IN03 929 | JSR TSTSNB 930 | BCC IN07 931 | LDX #RMESS 932 | JSR PUTSTR 933 | JSR CRLF 934 | BRA IN03 935 | IN07 STX SCRTCH 936 | PULS X 937 | STD 0,X 938 | LDX CURSOR 939 | JSR SKIPSP 940 | CMPA #', 941 | BEQ IN09 942 | JMP ENDSMT 943 | IN09 LEAX 1,X 944 | JSR TSTVAR 945 | BCC IN13 946 | IN11 JMP ERRORS 947 | IN13 PSHS D 948 | PSHS X 949 | LDX SCRTCH 950 | JSR SKIPSP 951 | CMPA #', 952 | BNE IN05 953 | LEAX 1,X 954 | BRA IN05 955 | RMESS FCC /RE-ENTER/ 956 | FCB EOL 957 | ****************************** 958 | ****************************** 959 | RUN LDX STKTOP 960 | LDA #52 961 | RUN01 CLR ,X+ 962 | DECA 963 | BNE RUN01 964 | LDX USRBAS 965 | JMP REM05 966 | ****************************** 967 | ****************************** 968 | LIST JSR TSTNBR 969 | BCC LIST03 970 | CLRA 971 | CLRB 972 | STD CURSOR 973 | LDA #$7F 974 | BRA LIST07 975 | LIST03 STD CURSOR 976 | JSR SKIPSP 977 | CMPA #', 978 | BEQ LIST05 979 | LDA CURSOR 980 | BRA LIST07 981 | LIST05 LEAX 1,X 982 | JSR TSTNBR 983 | BCC LIST07 984 | JMP ERRORS 985 | LIST07 JSR TSTEOL 986 | PSHS D 987 | LDD CURSOR 988 | STX CURSOR 989 | JSR FLINE 990 | LIST09 CMPX USRTOP 991 | BEQ LIST10 992 | PULS D 993 | CMPD 0,X 994 | BCS LIST11 995 | PSHS D 996 | LDD ,X++ 997 | PSHS X 998 | JSR PRNT4 999 | PULS X 1000 | LDA #SPACE 1001 | JSR PUTCHR 1002 | JSR PUTSTR 1003 | LEAX 1,X 1004 | PSHS X 1005 | JSR CRLF 1006 | PULS X 1007 | JSR TSTBRK 1008 | BRA LIST09 1009 | LIST10 LEAS 2,S 1010 | LDA #ETX 1011 | JSR PUTCHR 1012 | LIST11 LDX CURSOR 1013 | JMP ENDS02 1014 | ****************************** 1015 | ****************************** 1016 | VERBT FCC /LET/ 1017 | FCB EOL 1018 | FDB LET 1019 | FCC /IF/ 1020 | FCB EOL 1021 | FDB IF 1022 | FCC /GOTO/ 1023 | FCB EOL 1024 | FDB GOTO 1025 | FCC /GOSUB/ 1026 | FCB EOL 1027 | FDB GOSUB 1028 | FCC /RETURN/ 1029 | FCB EOL 1030 | FDB RETURN 1031 | FCC /POKE/ 1032 | FCB EOL 1033 | FDB POKE 1034 | FCC /PRINT/ 1035 | FCB EOL 1036 | FDB PRINT 1037 | FCC /INPUT/ 1038 | FCB EOL 1039 | FDB INPUT 1040 | FCC /REM/ 1041 | FCB EOL 1042 | FDB REM 1043 | FCC /STOP/ 1044 | FCB EOL 1045 | FDB END 1046 | FCC /END/ 1047 | FCB EOL 1048 | FDB END 1049 | FCC /RUN/ 1050 | FCB EOL 1051 | FDB RUN 1052 | FCC /LIST/ 1053 | FCB EOL 1054 | FDB LIST 1055 | FCC /NEW/ 1056 | FCB EOL 1057 | FDB CLEAR 1058 | FCC /?/ 1059 | FCB EOL 1060 | FDB PRINT 1061 | FCB EOL 1062 | ****************************** 1063 | ****************************** 1064 | TSTBRK bsr BRKEEE 1065 | beq GETC05 1066 | GETCHR bsr INEEE 1067 | CMPA #ETX 1068 | BNE GETC05 1069 | JMP BREAK 1070 | GETC05 RTS 1071 | PUTCHR INC ZONE 1072 | JMP OUTEEE 1073 | ****************************** 1074 | ****************************** 1075 | INEEE BSR BRKEEE 1076 | BEQ INEEE 1077 | LDA RECEV 1078 | ANDA #$7F 1079 | RTS 1080 | OUTEEE PSHS A 1081 | OUT01 LDA TRCS 1082 | BITA #TDRE 1083 | BEQ OUT01 1084 | PULS A 1085 | STA TRANS 1086 | RTS 1087 | BRKEEE PSHS A 1088 | BRK03 LDA TRCS 1089 | BITA #ORFE 1090 | BEQ BRK05 1091 | LDA RECEV 1092 | BRA BRK03 1093 | BRK05 BITA #RDRF 1094 | PULS A 1095 | RTS 1096 | * 1097 | LDA #CNTL1 1098 | STA RMCR 1099 | LDA #CNTL2 1100 | STA TRCS 1101 | INTEEE EQU * 1102 | RTS 1103 | 1104 | 1105 | 1106 | ****************************** 1107 | ****************************** 1108 | END 1109 | -------------------------------------------------------------------------------- /basic/basic.txt: -------------------------------------------------------------------------------- 1 | TINY BASIC SUMMARY 2 | 3 | Editing Standard Basic 4 | 5 | Direct Mode All Verbs Usable 6 | 7 | Statement Types 8 | 9 | PRINT Item List 10 | LET Var = Expr (LET is optional) 11 | IF Expr Relop Expr Statement 12 | INPUT Variable List 13 | GOTO Line Number 14 | GOSUB Line Number 15 | RETURN 16 | POKE POKE(Expr) = Expr 17 | STOP 18 | LIST Line Number, Line Number (Line Numbers are optional) 19 | RUN 20 | NEW 21 | 22 | Functions 23 | 24 | USR Variable = USR(Expr,Expr) 25 | PEEK Variable = PEEK(Expr) 26 | MEM Variable = MEM 27 | 28 | Number Integers to _+32767 or Hex Integers preceded by a $ symbol 29 | 30 | Variable Letters A-Z 31 | 32 | Expression Variables, Numbers, and Functions combined with the following 33 | operators +, -, *, /, (, ). 34 | 35 | Relop Comparison operators =, <, >, <=, >=, <>. 36 | 37 | Line Number Numbers 1 through 9999 38 | 39 | String "ALPHANUMERICS" 40 | 41 | Item List Expressions and Strings seperated by format control 42 | characters , and ;. 43 | 44 | Control Chars. Control H or "Back Space" deletes last input character. 45 | Control X or "Cancel" deletes entire input line. 46 | Control C Terminates Basic program or List operation and 47 | returns control to command mode. 48 | 49 | Memory Usage Tiny Basic V1.37 50 | 51 | $0080 - $009F Tiny Basic interpreter scratch area. 52 | $00A0 - $00FD Not used by Tiny Basic interpreter. (usable USR routines) 53 | $**** - $**** Pointer to Interrupt Vector Table. (Identical to LILBUG) 54 | $D800 - $DFFF Input Buffer, Basic Program storage, Stack Space, and 55 | Variables in RAM. 56 | $**** - $**** Optional Power Up Basic Program and/or USR functions in ROM. 57 | $E800 - $EFFF Tiny Basic interpreter ROM. 58 | 59 | $E800 Cold Start Address. 60 | $E803 Warm Start Address. 61 | 62 | Tiny Basic USR Function 63 | 64 | The USR function in Tiny Basic takes 2 arguments and returns a value to a 65 | variable. The form of the USR function is "LET V = USR(Expr,Expr)". 66 | The USR function can be used in any expression in Tiny Basic as an example 67 | "LET V = A * ( B + USR( $EF00, K))". The USR function can also be used with 68 | the PRINT statement. 69 | 70 | The first argument of the USR function is evaluated to determine the address 71 | or the machine language code to be called. The second argument is evaluated 72 | and the value is send to the machine code routine in the D accumulator. The 73 | second argument is optional, if it is present the Carry bit in the condition 74 | code register will be cleared when the machine code routine is called. If the 75 | second argument is not present the Carry Bit will be set when the machine code 76 | is called. The machine code routine may return a result to the BASIC program 77 | in the D accumulator, the value in the D accumulator on return from the machine 78 | code routine will be used by the BASIC program as the value of the function. 79 | 80 | The machine code routine must execute a RTS instruction to return conterol to 81 | the BASIC program. The machine code routine may use all the processor registers 82 | freely and need not save and restore any registers. It is important that the 83 | machine code routine not modify any memory used by the Tiny Basic interpreter. 84 | Consult the memory map provided with your version of Tiny Basic to determine 85 | which memory areas are not used. 86 | 87 | Tiny Basic handles interrupts with the same interrupt vectoring technique used 88 | by LILBUG. Consult the LILBUG manual for details on interrupt vector usage. 89 | 90 | 91 | 92 | JPB 12-APR-82 93 | -------------------------------------------------------------------------------- /basic/exampl.bas: -------------------------------------------------------------------------------- 1 | 10 REM SYRACUSE SEQUENCES. 2 | 20 PRINT "ENTER A POSITIVE NUMBER"; 3 | 30 INPUT K 4 | 40 IF K>0 GOTO 70 5 | 50 PRINT "ERROR" 6 | 60 GOTO 20 7 | 70 N=0 8 | 80 PRINT K, 9 | 90 IF K=1 GOTO 160 10 | 100 IF K<>2*(K/2) GOTO 130 11 | 110 K=K/2 12 | 120 GOTO 140 13 | 130 K=3*K+1 14 | 140 N=N+1 15 | 150 GOTO 80 16 | 160 PRINT 17 | 170 PRINT "CONVERGED TO 1 IN ";N;" STEPS." 18 | 180 END 19 | -------------------------------------------------------------------------------- /basic/floatnum.src: -------------------------------------------------------------------------------- 1 | * Simple constants. 2 | fpzero 3 | 0 4 | fpone 5 | 1 6 | fptwo 7 | 2 8 | fpten 9 | 10 10 | fphalf 11 | 0.5 12 | * Numbers used in conversion. 13 | fplolim 14 | 99999999.95 15 | fphilim 16 | 999999999.5 17 | * Mathematical constants. 18 | fpi 19 | 3.1415926535898 20 | fln2 21 | 0.6931471805599 22 | * Even coefficients for the sin(x)/x polynumial. 23 | sincoeff 24 | -0.0000000239 25 | 0.0000027526 26 | -0.0001984090 27 | 0.0083333315 28 | -0.1666666664 29 | * Even coefficients for the arctan(x)/x polynomial. 30 | atancoeff 31 | 0.0028662257 32 | -0.0161657367 33 | 0.0429096138 34 | -0.0752896400 35 | 0.1065626393 36 | -0.1420889944 37 | 0.1999355085 38 | -0.3333314528 39 | * Coefficients for the exp(-x) polynomial. 40 | expcoeff 41 | -0.0001413161 42 | 0.0013298820 43 | -0.0083013598 44 | 0.0416573475 45 | -0.1666653019 46 | 0.4999999206 47 | -0.9999999995 48 | * Coefficients for the ln(1+x) polynomial. 49 | lncoeff 50 | -0.0064535442 51 | 0.0360884937 52 | -0.0953293897 53 | 0.1676540711 54 | -0.2407338084 55 | 0.3317990258 56 | -0.4998741238 57 | 0.9999964239 58 | -------------------------------------------------------------------------------- /basic/makeflot.c: -------------------------------------------------------------------------------- 1 | /* This program converts floating point numbers to 2 | the 5-bit binary representation used in 6809 BASIC. 3 | */ 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | main() 12 | { 13 | double num; 14 | char line[128],label[128]; 15 | unsigned char byte[5]; 16 | int expo,sign,i; 17 | unsigned long mant; 18 | label[0]=0; 19 | printf("* These are the floating point constants.\n"); 20 | printf("* They are generated by the program makeflot.c\n"); 21 | while(fgets(line,128,stdin)) { 22 | line[strlen(line)-1]=0; 23 | if(!line[0])continue; 24 | if(line[0]=='*'){printf("%s\n",line);continue;} 25 | if(isalpha(line[0])) { 26 | sscanf(line,"%s",label); 27 | }else{ 28 | sscanf(line,"%lf",&num); 29 | if(num==0) { 30 | sign=0; 31 | expo=0; 32 | mant=0; 33 | }else{ 34 | sign=0x80*(num<0); 35 | num=fabs(num); 36 | expo=0x9f; 37 | while(num<2147483648.0){ 38 | num=num*2; 39 | expo-=1; 40 | } 41 | while(num>=4294967296.0){ 42 | num=num/2; 43 | expo+=1; 44 | } 45 | mant=num+0.5; 46 | } 47 | byte[0]=expo;byte[1]=((mant>>24)&0x7f)+sign; 48 | byte[2]=((mant>>16)&0xff);byte[3]=((mant>>8)&0xff);byte[4]=mant&0xff; 49 | printf("%-16s fcb $%02x,$%02x,$%02x,$%02x,$%02x ;%s\n", 50 | label,byte[0],byte[1],byte[2],byte[3],byte[4],line); 51 | label[0]=0; 52 | } 53 | } 54 | printf("* End of floating point constants.\n"); 55 | exit(0); 56 | } 57 | -------------------------------------------------------------------------------- /doc/latex2creole.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # coding: utf-8 3 | 4 | """ 5 | latex2creole 6 | ~~~~~~~~~~~~ 7 | 8 | Hacked script to convert a LaTeX file into creole markup. 9 | 10 | Note: 11 | Some hand-editing is needed. 12 | 13 | :created: 2013 by Jens Diemer - www.jensdiemer.de 14 | :copyleft: 2013 by the DragonPy team, see AUTHORS for more details. 15 | :license: GNU GPL v3 or above, see LICENSE for more details. 16 | """ 17 | 18 | import sys 19 | 20 | sourcefile = r"sbc09/sbc09.tex" 21 | destination = r"sbc09.creole" 22 | 23 | 24 | HEADLINES = ( 25 | r"\title{", 26 | r"\chapter{", 27 | r"\section{", 28 | r"\subsection{", 29 | ) 30 | SKIPS = ( 31 | r"\begin", 32 | r"\end", 33 | r"\document", 34 | r"\maketitle", 35 | r"\tableofcontents", 36 | "\\def\\", 37 | ) 38 | 39 | in_list = 0 40 | 41 | def should_skip(line): 42 | for skip in SKIPS: 43 | if line.startswith(skip): 44 | return True 45 | 46 | 47 | with open(sourcefile, "r") as infile: 48 | with open(destination, "w") as outfile: 49 | for line in infile: 50 | # ~ print line 51 | 52 | line = line.strip() 53 | 54 | if line.startswith(r"\begin{itemize}"): 55 | in_list += 1 56 | continue 57 | if line.startswith(r"\end{itemize}"): 58 | in_list -= 1 59 | if in_list == 0: 60 | outfile.write("\n") 61 | continue 62 | 63 | if in_list: 64 | if line.startswith(r"\item"): 65 | line = "\n%s%s" % ("*"*in_list, line[5:]) 66 | outfile.write(line) 67 | continue 68 | 69 | if line == r"\begin{verbatim}": 70 | line = "{{{" 71 | elif line == r"\end{verbatim}": 72 | line = "}}}" 73 | 74 | if should_skip(line): 75 | continue 76 | 77 | for no, prefix in enumerate(HEADLINES, 1): 78 | if line.startswith(prefix): 79 | line = line.replace("{\\tt ", "").replace("}", "") 80 | line = line.split("{", 1)[1].replace("{", "").replace("}", "") 81 | line = "\n%(m)s %(l)s %(m)s\n" % { 82 | "m": "="*no, 83 | "l": line 84 | } 85 | break 86 | 87 | if line.startswith(r"\item["): 88 | item, txt = line[6:].split("]") 89 | item = item.strip() 90 | txt = txt.strip() 91 | line = "** %s **\n%s" % (item, txt) 92 | 93 | if "{\\tt" in line: 94 | line = line.replace("{\\tt ", "{{{").replace("}", "}}}") 95 | if "{\\em" in line: 96 | line = line.replace("{\\em ", "{{{").replace("}", "}}}") 97 | 98 | line = line.replace("\\", "") 99 | 100 | print line 101 | line += "\n" 102 | outfile.write(line) 103 | -------------------------------------------------------------------------------- /doc/origin/README: -------------------------------------------------------------------------------- 1 | This is an unfinished. but working version of the 6809 assewmbler. simulator 2 | and software. It is released under the GPL 3 | It runs under several versions of Unix. Docs are in LaTeX format (sbc09.tex) and 4 | in ASCI (README.doc) 5 | 6 | mon2.asm is an alternative version of the monitor program. 7 | 8 | alt09.rom is a version of the ROM that contains the alternative monitor and 9 | Forth. Forth is transferrred to RAM by a small loader. 10 | To start Forth type G8000. To start it again, type G400. 11 | 12 | Yes, you can run TETRIS from the Forth included with this simulator. 13 | 14 | -------------------------------------------------------------------------------- /doc/origin/basic.txt: -------------------------------------------------------------------------------- 1 | TINY BASIC SUMMARY 2 | 3 | Editing Standard Basic 4 | 5 | Direct Mode All Verbs Usable 6 | 7 | Statement Types 8 | 9 | PRINT Item List 10 | LET Var = Expr (LET is optional) 11 | IF Expr Relop Expr Statement 12 | INPUT Variable List 13 | GOTO Line Number 14 | GOSUB Line Number 15 | RETURN 16 | POKE POKE(Expr) = Expr 17 | STOP 18 | LIST Line Number, Line Number (Line Numbers are optional) 19 | RUN 20 | NEW 21 | 22 | Functions 23 | 24 | USR Variable = USR(Expr,Expr) 25 | PEEK Variable = PEEK(Expr) 26 | MEM Variable = MEM 27 | 28 | Number Integers to _+32767 or Hex Integers preceded by a $ symbol 29 | 30 | Variable Letters A-Z 31 | 32 | Expression Variables, Numbers, and Functions combined with the following 33 | operators +, -, *, /, (, ). 34 | 35 | Relop Comparison operators =, <, >, <=, >=, <>. 36 | 37 | Line Number Numbers 1 through 9999 38 | 39 | String "ALPHANUMERICS" 40 | 41 | Item List Expressions and Strings seperated by format control 42 | characters , and ;. 43 | 44 | Control Chars. Control H or "Back Space" deletes last input character. 45 | Control X or "Cancel" deletes entire input line. 46 | Control C Terminates Basic program or List operation and 47 | returns control to command mode. 48 | 49 | Memory Usage Tiny Basic V1.37 50 | 51 | $0080 - $009F Tiny Basic interpreter scratch area. 52 | $00A0 - $00FD Not used by Tiny Basic interpreter. (usable USR routines) 53 | $**** - $**** Pointer to Interrupt Vector Table. (Identical to LILBUG) 54 | $D800 - $DFFF Input Buffer, Basic Program storage, Stack Space, and 55 | Variables in RAM. 56 | $**** - $**** Optional Power Up Basic Program and/or USR functions in ROM. 57 | $E800 - $EFFF Tiny Basic interpreter ROM. 58 | 59 | $E800 Cold Start Address. 60 | $E803 Warm Start Address. 61 | 62 | Tiny Basic USR Function 63 | 64 | The USR function in Tiny Basic takes 2 arguments and returns a value to a 65 | variable. The form of the USR function is "LET V = USR(Expr,Expr)". 66 | The USR function can be used in any expression in Tiny Basic as an example 67 | "LET V = A * ( B + USR( $EF00, K))". The USR function can also be used with 68 | the PRINT statement. 69 | 70 | The first argument of the USR function is evaluated to determine the address 71 | or the machine language code to be called. The second argument is evaluated 72 | and the value is send to the machine code routine in the D accumulator. The 73 | second argument is optional, if it is present the Carry bit in the condition 74 | code register will be cleared when the machine code routine is called. If the 75 | second argument is not present the Carry Bit will be set when the machine code 76 | is called. The machine code routine may return a result to the BASIC program 77 | in the D accumulator, the value in the D accumulator on return from the machine 78 | code routine will be used by the BASIC program as the value of the function. 79 | 80 | The machine code routine must execute a RTS instruction to return conterol to 81 | the BASIC program. The machine code routine may use all the processor registers 82 | freely and need not save and restore any registers. It is important that the 83 | machine code routine not modify any memory used by the Tiny Basic interpreter. 84 | Consult the memory map provided with your version of Tiny Basic to determine 85 | which memory areas are not used. 86 | 87 | Tiny Basic handles interrupts with the same interrupt vectoring technique used 88 | by LILBUG. Consult the LILBUG manual for details on interrupt vector usage. 89 | 90 | 91 | 92 | JPB 12-APR-82 93 | -------------------------------------------------------------------------------- /doc/origin/sbc09fig.tex: -------------------------------------------------------------------------------- 1 | \setlength{\unitlength}{0.009in}% 2 | \begin{picture}(510,355)(125,400) 3 | \thicklines 4 | \put(370,665){\framebox(170,90){}} 5 | \put(370,535){\framebox(170,90){}} 6 | \put(370,400){\framebox(170,90){}} 7 | \put(125,535){\framebox(170,90){}} 8 | \put(295,585){\line( 1, 0){ 75}} 9 | \put(320,585){\makebox(0.4444,0.6667){\SetFigFont{10}{12}{rm}.}} 10 | \put(325,585){\line( 0, 1){140}} 11 | \put(325,725){\line( 1, 0){ 45}} 12 | \put(325,585){\line( 0,-1){135}} 13 | \put(325,450){\line( 1, 0){ 45}} 14 | \put(155,440){\framebox(100,50){}} 15 | \put(210,490){\vector( 0, 1){ 45}} 16 | \put(195,690){\vector( 0,-1){ 65}} 17 | \put(635,445){\vector(-1, 0){ 95}} 18 | \put(415,570){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}32K RAM}}} 19 | \put(415,440){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}6850 ACIA}}} 20 | \put(180,570){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}6809 CPU}}} 21 | \put(420,705){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}32K ROM}}} 22 | \put(190,460){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}TIMER}}} 23 | \put(175,700){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}RESET}}} 24 | \put(220,505){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}FIRQ}}} 25 | \put(605,460){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}RS232}}} 26 | \end{picture} 27 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile examples SBC09/Sim6809 3 | # 4 | # created 1994 by L.C. Benschop 5 | # 2013-10-28 - Jens Diemer: add "clean" section 6 | # 2014-06-25 - J.E. Klasek 7 | # 8 | # copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 9 | # license: GNU General Public License version 2, see LICENSE for more details. 10 | # 11 | 12 | ASM=../a09 13 | 14 | EXAMPLES=asmtest bench09 bin2dec cond09 crc16 crc32 ef09 erat-sieve input printval test09 uslash 15 | 16 | 17 | 18 | all: $(ASM) $(EXAMPLES) 19 | 20 | $(ASM): 21 | $(MAKE) -c ../src a09 install 22 | 23 | # ------------------------------------ 24 | # rules 25 | 26 | .SUFFIXES: .asm 27 | 28 | .asm: 29 | $(ASM) -l $@.lst $< 30 | 31 | # ------------------------------------ 32 | 33 | asmtest: asmtest.asm 34 | 35 | bench09: bench09.asm 36 | 37 | bin2dec: bin2dec.asm 38 | 39 | cond09: cond09.asm 40 | 41 | crc16: crc16.asm 42 | 43 | crc32: crc32.asm 44 | 45 | ef09: ef09.asm 46 | 47 | erat-sieve: erat-sieve.asm 48 | 49 | printval: printval.asm 50 | 51 | input: input.asm 52 | 53 | test09: test09.asm 54 | 55 | uslash: uslash.asm 56 | 57 | 58 | 59 | # ------------------------------------ 60 | 61 | cleanall: clean 62 | 63 | clean: 64 | rm -f core *.BAK *.lst $(EXAMPLES) 65 | 66 | -------------------------------------------------------------------------------- /examples/asmtest.asm: -------------------------------------------------------------------------------- 1 | org $400 2 | addr8 equ $80h 3 | addr16 equ $1234 4 | 5 | neg addr8 6 | com addr8 7 | lsr addr8 8 | ror addr8 9 | asr addr8 10 | asl addr8 11 | lsl addr8 12 | rol addr8 13 | dec addr8 14 | inc addr8 15 | tst addr8 16 | jmp addr8 17 | clr addr8 18 | 19 | lbrn addr16 20 | lbhi addr16 21 | lbls addr16 22 | lbhs addr16 23 | lbcc addr16 24 | lblo addr16 25 | lbcs addr16 26 | lbne addr16 27 | lbeq addr16 28 | lbvc addr16 29 | lbvs addr16 30 | lbpl addr16 31 | lbmi addr16 32 | lbge addr16 33 | lblt addr16 34 | lbgt addr16 35 | lble addr16 36 | 37 | swi2 38 | cmpd #$4444 39 | cmpy #$4444 40 | ldy #$4444 41 | cmpd addr8 42 | cmpy addr8 43 | ldy addr8 44 | sty addr8 45 | cmpd ,x 46 | cmpy ,x 47 | ldy ,x 48 | sty ,x 49 | cmpd addr16 50 | cmpy addr16 51 | ldy addr16 52 | sty addr16 53 | lds #$4444 54 | lds addr8 55 | sts addr8 56 | lds ,x 57 | sts ,x 58 | lds addr16 59 | sts addr16 60 | swi3 61 | cmpu #$4444 62 | cmps #$4444 63 | cmpu addr8 64 | cmps addr8 65 | cmpu ,x 66 | cmps ,x 67 | cmpu addr16 68 | cmps addr16 69 | 70 | nop 71 | sync 72 | lbra addr16 73 | lbsr addr16 74 | daa 75 | orcc #$ff 76 | andcc #$00 77 | sex 78 | exg a,b 79 | tfr a,b 80 | 81 | 82 | labx bra labx 83 | brn labx 84 | bhi labx 85 | bls labx 86 | bhs labx 87 | bcc labx 88 | blo labx 89 | bcs labx 90 | bne labx 91 | beq labx 92 | bvc labx 93 | bvs labx 94 | bpl labx 95 | bmi labx 96 | bge labx 97 | blt labx 98 | bgt labx 99 | ble labx 100 | 101 | leax ,x 102 | leay ,x 103 | leas ,x 104 | leau ,x 105 | pshs x 106 | puls x 107 | pshu x 108 | pulu x 109 | rts 110 | abx 111 | rti 112 | cwai #$00 113 | mul 114 | swi 115 | 116 | nega 117 | coma 118 | lsra 119 | rora 120 | asra 121 | asla 122 | lsla 123 | rola 124 | deca 125 | inca 126 | tsta 127 | clra 128 | 129 | negb 130 | comb 131 | lsrb 132 | rorb 133 | asrb 134 | aslb 135 | lslb 136 | rolb 137 | decb 138 | incb 139 | tstb 140 | clrb 141 | 142 | neg ,x 143 | com ,x 144 | lsr ,x 145 | ror ,x 146 | asr ,x 147 | asl ,x 148 | lsl ,x 149 | rol ,x 150 | dec ,x 151 | inc ,x 152 | tst ,x 153 | jmp ,x 154 | clr ,x 155 | 156 | neg addr16 157 | com addr16 158 | lsr addr16 159 | ror addr16 160 | asr addr16 161 | asl addr16 162 | lsl addr16 163 | rol addr16 164 | dec addr16 165 | inc addr16 166 | tst addr16 167 | jmp addr16 168 | clr addr16 169 | 170 | suba #$22 171 | cmpa #$22 172 | sbca #$22 173 | subd #$4444 174 | anda #$22 175 | bita #$22 176 | lda #$22 177 | eora #$22 178 | adca #$22 179 | ora #$22 180 | adda #$22 181 | cmpx #$4444 182 | laby bsr laby 183 | ldx #$4444 184 | 185 | suba addr8 186 | cmpa addr8 187 | sbca addr8 188 | subd addr8 189 | anda addr8 190 | bita addr8 191 | lda addr8 192 | sta addr8 193 | eora addr8 194 | adca addr8 195 | ora addr8 196 | adda addr8 197 | cmpx addr8 198 | jsr addr8 199 | ldx addr8 200 | stx addr8 201 | 202 | suba ,x 203 | cmpa ,x 204 | sbca ,x 205 | subd ,x 206 | anda ,x 207 | bita ,x 208 | lda ,x 209 | sta ,x 210 | eora ,x 211 | adca ,x 212 | ora ,x 213 | adda ,x 214 | cmpx ,x 215 | jsr ,x 216 | ldx ,x 217 | stx ,x 218 | 219 | suba addr16 220 | cmpa addr16 221 | sbca addr16 222 | subd addr16 223 | anda addr16 224 | bita addr16 225 | lda addr16 226 | sta addr16 227 | eora addr16 228 | adca addr16 229 | ora addr16 230 | adda addr16 231 | cmpx addr16 232 | jsr addr16 233 | ldx addr16 234 | stx addr16 235 | 236 | subb #$22 237 | cmpb #$22 238 | sbcb #$22 239 | addd #$4444 240 | andb #$22 241 | bitb #$22 242 | ldb #$22 243 | eorb #$22 244 | adcb #$22 245 | orb #$22 246 | addb #$22 247 | ldd #$4444 248 | ldu #$4444 249 | 250 | subb addr8 251 | cmpb addr8 252 | sbcb addr8 253 | addd addr8 254 | andb addr8 255 | bitb addr8 256 | ldb addr8 257 | stb addr8 258 | eorb addr8 259 | adcb addr8 260 | orb addr8 261 | addb addr8 262 | ldd addr8 263 | std addr8 264 | ldu addr8 265 | stu addr8 266 | 267 | subb ,x 268 | cmpb ,x 269 | sbcb ,x 270 | addd ,x 271 | andb ,x 272 | bitb ,x 273 | ldb ,x 274 | stb ,x 275 | eorb ,x 276 | adcb ,x 277 | orb ,x 278 | addb ,x 279 | ldd ,x 280 | std ,x 281 | ldu ,x 282 | stu ,x 283 | 284 | subb addr16 285 | cmpb addr16 286 | sbcb addr16 287 | addd addr16 288 | andb addr16 289 | bitb addr16 290 | ldb addr16 291 | stb addr16 292 | eorb addr16 293 | adcb addr16 294 | orb addr16 295 | addb addr16 296 | ldd addr16 297 | std addr16 298 | ldu addr16 299 | stu addr16 300 | 301 | tfr d,d 302 | tfr d,x 303 | tfr d,y 304 | tfr d,u 305 | tfr d,s 306 | tfr d,pc 307 | tfr a,a 308 | tfr a,b 309 | tfr a,cc 310 | tfr a,dp 311 | tfr d,d 312 | tfr x,d 313 | tfr y,d 314 | tfr u,d 315 | tfr s,d 316 | tfr pc,d 317 | tfr a,a 318 | tfr b,a 319 | tfr cc,a 320 | tfr dp,a 321 | 322 | pshs pc 323 | pshs u 324 | pshu s 325 | pshs x 326 | pshs y 327 | pshs dp 328 | pshs d 329 | pshs a,b 330 | pshs a 331 | pshs b 332 | pshs cc 333 | pshs pc,u,x,y,dp,a,b,cc 334 | 335 | lda 0,x 336 | lda 1,x 337 | lda 2,x 338 | lda 3,x 339 | lda 4,x 340 | lda 5,x 341 | lda 6,x 342 | lda 7,x 343 | lda 8,x 344 | lda 9,x 345 | lda 10,x 346 | lda 11,x 347 | lda 12,x 348 | lda 13,x 349 | lda 14,x 350 | lda 15,x 351 | lda -16,x 352 | lda -15,x 353 | lda -14,x 354 | lda -13,x 355 | lda -12,x 356 | lda -11,x 357 | lda -10,x 358 | lda -9,x 359 | lda -8,x 360 | lda -7,x 361 | lda -6,x 362 | lda -5,x 363 | lda -4,x 364 | lda -3,x 365 | lda -2,x 366 | lda -1,x 367 | lda 1,y 368 | lda -1,y 369 | lda 1,u 370 | lda -1,u 371 | lda 1,s 372 | lda -1,s 373 | lda ,x+ 374 | ldd ,x++ 375 | lda ,-x 376 | ldd ,--x 377 | lda ,x 378 | lda b,x 379 | lda a,x 380 | lda -128,x 381 | lda 33,x 382 | lda 127,x 383 | lda -129,x 384 | lda $1234,x 385 | lda d,x 386 | labz lda labz,pcr 387 | lda addr16,pcr 388 | lda [,x++] 389 | lda [,--x] 390 | lda [,x] 391 | lda [b,x] 392 | lda [a,x] 393 | lda [33,x] 394 | lda [1,x] 395 | lda [$1234,x] 396 | lda [d,x] 397 | lda [labz,pcr] 398 | lda [addr16,pcr] 399 | lda [addr16] 400 | lda ,y+ 401 | lda ,u+ 402 | lda ,s+ 403 | ldy [addr16] 404 | ldy addr16,pcr 405 | 406 | -------------------------------------------------------------------------------- /examples/bench09.asm: -------------------------------------------------------------------------------- 1 | ;6809 Benchmark program. 2 | 3 | org $100 4 | 5 | lds #$100 6 | 7 | ldb #'a' 8 | jsr outc 9 | 10 | 11 | ldy #0 12 | loop ldx #data 13 | lda #(enddata-data) 14 | clrb 15 | loop2: addb ,x+ 16 | deca 17 | bne loop2 18 | cmpb #210 19 | lbne error 20 | leay -1,y 21 | bne loop 22 | 23 | ldb #'b' 24 | jsr outc 25 | jmp realexit 26 | 27 | error ldb #'e' 28 | jsr outc 29 | jmp realexit 30 | 31 | outc swi2 32 | rts 33 | 34 | realexit sync 35 | 36 | data fcb 1,2,3,4,5,6,7,8,9,10 37 | fcb 11,12,13,14,15,16,17,18,19,20 38 | enddata 39 | 40 | end 41 | -------------------------------------------------------------------------------- /examples/bin2dec.asm: -------------------------------------------------------------------------------- 1 | * Convert 32-bits binary number to decimal. 2 | org $400 3 | 4 | main lds #$8000 5 | ldx #num1 6 | jsr prtdec 7 | ldx #num2 8 | jsr prtdec 9 | ldx #num3 10 | jsr prtdec 11 | ldx #num4 12 | jsr prtdec 13 | ldx #num5 14 | jsr prtdec 15 | ldx #num6 16 | jsr prtdec 17 | swi 18 | 19 | 20 | * Print double number (including leading zeros) pointed to by X. 21 | * Number at that location is destroyed by the process. 22 | prtdec jsr bin2bcd ;Convert to bcd 23 | ldx #bcdbuf ;Traverse 5-byte buffer. 24 | ldb #5 25 | stb temp 26 | pdloop lda ,x+ 27 | tfr a,b 28 | lsrb 29 | lsrb 30 | lsrb 31 | lsrb ;Extract higher digit from bcd byte. 32 | addb #'0 33 | jsr outch 34 | tfr a,b 35 | andb #15 ;Extract lower digit. 36 | addb #'0 37 | jsr outch 38 | dec temp 39 | bne pdloop 40 | ldb #13 ;output newline. 41 | jsr outch 42 | ldb #10 43 | jsr outch 44 | rts 45 | 46 | * Convert 4-byte number pointed to by X to 5-byte (10 digit) bcd. 47 | bin2bcd ldu #bcdbuf 48 | ldb #5 49 | bbclr clr ,u+ ;Clear the 5-byte bcd buffer. 50 | decb 51 | bne bbclr 52 | ldb #4 ;traverse 4 bytes of bin number 53 | stb temp 54 | bbloop ldb #8 ;and 8 bits of each byte. (msb to lsb) 55 | stb temp2 56 | bbl1 rol ,x ;Extract next bit from binary number. 57 | ldb #5 58 | ldu #bcdbuf+5 59 | bbl2 lda ,-u ;multiply bcd number by 2 and add extracted bit 60 | adca ,u ;into it. 61 | daa 62 | sta ,u 63 | decb 64 | bne bbl2 65 | dec temp2 66 | bne bbl1 67 | leax 1,x 68 | dec temp 69 | bne bbloop 70 | rts 71 | 72 | * Output character B 73 | outch jsr 3 74 | rts 75 | 76 | bcdbuf rmb 5 77 | temp rmb 1 78 | temp2 rmb 1 79 | 80 | num1 fdb -1,-1 ; should be 4294967295 81 | num2 fdb 0,0 ; should be 0000000000 82 | num3 fdb 32768,0 ; should be 2147483648 83 | num4 fdb $3b9A,$c9ff ; should be 0999999999 84 | num5 fdb $3b9a,$ca00 ; should be 1000000000 85 | num6 fdb 0,5501 ; should be 0000005501 -------------------------------------------------------------------------------- /examples/cond09.asm: -------------------------------------------------------------------------------- 1 | * Conditional assembly. 2 | 3 | jantje equ 2 4 | 5 | org $100 6 | if jantje=1 7 | main ldx #12 8 | else 9 | man2 ldx #13 10 | endif 11 | labx ldy #25 12 | 13 | include cond09.inc 14 | 15 | ldb #23 16 | ldu labx,pcr 17 | ldy laby,pcr 18 | sex 19 | mul 20 | laby sync 21 | end -------------------------------------------------------------------------------- /examples/cond09.inc: -------------------------------------------------------------------------------- 1 | addb ,y+ 2 | adda ,x+ 3 | -------------------------------------------------------------------------------- /examples/crc16.asm: -------------------------------------------------------------------------------- 1 | ; 6809 CRC16 with tests 2 | ; 3 | ; Johann E. Klasek, j AT klasek at 4 | ; 5 | ; Testprogram and finaly submitted to http://beebwiki.mdfs.net/index.php/CRC-16#6809 6 | 7 | org $100 8 | lds #$8000 9 | 10 | ; Calculate an XMODEM 16-bit CRC from data in memory. This code is as 11 | ; tight and as fast as it can be, moving as much code out of inner 12 | ; loops as possible. 13 | ; 14 | ; On entry, reg. D = incoming CRC 15 | ; reg. U = start address of data 16 | ; reg. X = number of bytes 17 | ; On exit, reg. D = updated CRC 18 | ; reg. U = points to first byte behind data 19 | ; reg. X = 0 20 | ; reg. Y = 0 21 | ; 22 | ; Value order in memory is H,L (big endian) 23 | ; 24 | ; Multiple passes over data in memory can be made to update the CRC. 25 | ; For XMODEM, initial CRC must be 0000. 26 | ; 27 | ; XMODEM setup: 28 | ; polynomic 29 | CRCH EQU $10 30 | CRCL EQU $21 31 | ; initial CRC 32 | CRCINIT EQU $0000 33 | 34 | ; input parameters ... 35 | ldu #s2 ; data (samples: s1 or s2) 36 | ldb ,u+ 37 | clra 38 | tfr d,x ; data size 39 | ldd #CRCINIT ; incoming CRC 40 | 41 | crc16: 42 | 43 | bl: 44 | eora ,u+ ; fetch byte and XOR into CRC high byte 45 | ldy #8 ; rotate loop counter 46 | rl: aslb ; shift CRC left, first low 47 | rola ; and than high byte 48 | bcc cl ; Justify or ... 49 | eora #CRCH ; CRC=CRC XOR polynomic, high 50 | eorb #CRCL ; and low byte 51 | cl: leay -1,y ; shift loop (8 bits) 52 | bne rl 53 | leax -1,x ; byte loop 54 | bne bl 55 | 56 | ; CRC in D 57 | 58 | realexit: 59 | sync 60 | 61 | s1: fcb 19,"An Arbitrary String" 62 | ; CRC=$DDFC 63 | s2: fcb 26,"ZYXWVUTSRQPONMLKJIHGFEDBCA" 64 | ; CRC=$B199 65 | 66 | enddata 67 | 68 | end 69 | -------------------------------------------------------------------------------- /examples/crc32.asm: -------------------------------------------------------------------------------- 1 | ; 6809 CRC32 with tests 2 | ; 3 | ; Johann E. Klasek, j AT klasek at 4 | ; 5 | ; Testprogram, previous version submitted to http://beebwiki.mdfs.net/index.php/CRC-32#6809 6 | 7 | org $100 8 | lds #$8000 9 | 10 | ; Calculate a ZIP 32-bit CRC from data in memory. This code is as 11 | ; tight and nearly as fast as it can be, moving as much code out of inner 12 | ; loops as possible. With the included optimisation, moving the whole 13 | ; CRC in registers, the performane gain on average data is only slight 14 | ; (estimated 2% but at losing clarity of implementation; 15 | ; worst case gain is 18%, best case worsens at 29%) 16 | ; 17 | ; On entry, crc..crc+3 = incoming CRC 18 | ; reg. U = start address of data 19 | ; reg. X = number of bytes 20 | ; On exit, crc..crc+3 = updated CRC 21 | ; reg. U = points to first byte behind data 22 | ; reg. X = 0 23 | ; reg. Y = 0 24 | ; 25 | ; Value order in memory is H,L (big endian) 26 | ; 27 | ; Multiple passes over data in memory can be made to update the CRC. 28 | ; For ZIP, initial CRC must be $FFFFFFFF, and the final CRC must 29 | ; be EORed with $FFFFFFFF before being stored in the ZIP file. 30 | ; Total 47 bytes (if above parameters are located in direct page). 31 | ; 32 | ; ZIP polynomic, reflected (bit reversed) from $04C11DB7 33 | CRCHH EQU $ED 34 | CRCHL EQU $B8 35 | CRCLH EQU $83 36 | CRCLL EQU $20 37 | CRCINITH EQU $FFFF 38 | CRCINITL EQU $FFFF 39 | 40 | ; CRC 32 bit in DP (4 bytes) 41 | crc EQU $80 42 | 43 | ldu #s1 ; start address in u 44 | ldb ,u+ ; 45 | clra ; length in d 46 | leax d,u ; 47 | pshs x ; end address +1 to TOS 48 | ldd #CRCINITL 49 | std crc+2 50 | ldx #CRCINITH 51 | stx crc 52 | ; d/x contains the CRC 53 | bl: 54 | eorb ,u+ ; XOR with lowest byte 55 | ldy #8 ; bit counter 56 | rl: 57 | exg d,x 58 | rl1: 59 | lsra ; shift CRC right, beginning with high word 60 | rorb 61 | exg d,x 62 | rora ; low word 63 | rorb 64 | bcc cl 65 | ; CRC=CRC XOR polynomic 66 | eora #CRCLH ; apply CRC polynomic low word 67 | eorb #CRCLL 68 | exg d,x 69 | eora #CRCHH ; apply CRC polynomic high word 70 | eorb #CRCHL 71 | leay -1,y ; bit count down 72 | bne rl1 73 | exg d,x ; CRC: restore correct order 74 | beq el ; leave bit loop 75 | cl: 76 | leay -1,y ; bit count down 77 | bne rl ; bit loop 78 | el: 79 | cmpu ,s ; end address reached? 80 | bne bl ; byte loop 81 | 82 | std crc+2 ; CRC low word 83 | stx crc ; CRC high word 84 | 85 | 86 | realexit: 87 | sync 88 | 89 | 90 | s1: fcb 19,"An Arbitrary String" 91 | ; CRC=$90415518 92 | 93 | s2: fcb 26,"ZYXWVUTSRQPONMLKJIHGFEDBCA" 94 | ; CRC32=$6632024D 95 | 96 | enddata 97 | 98 | end 99 | -------------------------------------------------------------------------------- /examples/erat-sieve.asm: -------------------------------------------------------------------------------- 1 | ; ERATOSTHENES SIEVE PRIMES 2 | ; BYTE MAGAZINE 9/1981 BENCHMARK 3 | ; Adapted by Johann Klasek, j AT klasek at 4 | ; Previously implemented for a Dragon 32, 5 | ; later also for a the sim6809 simulator. 6 | ; 7 | org $c000 8 | 9 | FLAG EQU $5000 ; array of bytes, length SIZE 10 | SIZE EQU $2000 11 | 12 | START 13 | 14 | lds #FLAG ; stack below flags array 15 | 16 | ; lda #$42 17 | ; jsr >$b54a ; char out Dragon Basic 18 | ldb #'B 19 | swi2 20 | 21 | lda #$0a 22 | pshs a 23 | 24 | ITER ldx #FLAG ; array 25 | ldu #$ffff ; filled with 26 | ldd #(SIZE/2) ; words 27 | CLEAR stu ,x++ ; word fill 28 | decb ; byte decrement works only 29 | bne CLEAR ; low byte of count is 0 30 | deca 31 | bne CLEAR 32 | 33 | leau 1,u ; prime counter to 0 34 | ldy #FLAG ; array 35 | 36 | PRIMES tst ,y+ ; is prime? 37 | beq NPRIME 38 | leax -1,y ; prime found 39 | tfr x,d 40 | suba #(FLAG>>8) 41 | lslb 42 | rola 43 | addd #3 ; prime = step 44 | bra STEP 45 | 46 | NMARK clr ,x ; mark all non-primes 47 | STEP leax d,x ; step to next 48 | cmpx #(FLAG+SIZE) 49 | bcs NMARK 50 | 51 | leau 1,u ; count primes 52 | NPRIME cmpy #(FLAG+SIZE) 53 | bcs PRIMES 54 | 55 | ldb #'. 56 | swi2 ; print 57 | ; lda #$2e 58 | ; jsr >$b54a ; char out Dragon Basic 59 | 60 | dec ,s 61 | bne ITER 62 | 63 | puls a ; drop counter 64 | pshs u ; store count on stack 65 | ; rts 66 | sync 67 | 68 | -------------------------------------------------------------------------------- /examples/erat-sieve.txt: -------------------------------------------------------------------------------- 1 | 2 | Eratostenes Sieve 3 | ================= 4 | J.E. Klasek j AT klasek at 5 | 6 | 7 | 8 | # compile 9 | 10 | make 11 | 12 | # start (with memory dump) 13 | 14 | v09 -d erat-sieve 15 | 16 | # hex editor on memory dump ... 17 | 18 | he dump.v09 19 | 20 | # variable area ... 21 | # prime count: vv vv 22 | 00004FEC F3 07 F7 EF 08 DD E8 FF 95 4F A7 08 45 FC 5A D7 9F DE 07 6B .........O..E.Z....k 23 | 00005000 FF FF FF 00 FF FF 00 FF FF 00 FF 00 00 FF FF 00 00 FF 00 FF .................... 24 | 25 | 26 | # convert hex value to decimal with dc command ... 27 | dc 28 | 16 i 29 | 076B p 30 | 1899 31 | 32 | # 1899 is the correct value for the prime count! 33 | 34 | -------------------------------------------------------------------------------- /examples/input.asm: -------------------------------------------------------------------------------- 1 | ;6809 Benchmark program. 2 | 3 | org $100 4 | 5 | lds #$100 6 | 7 | ldb #'a' 8 | jsr outc 9 | 10 | 11 | ldx #40 12 | inloop jsr inc 13 | jsr outc 14 | leax -1,x 15 | bne inloop 16 | 17 | ldb #'b' 18 | jsr outc 19 | jmp realexit 20 | 21 | error ldb #'e' 22 | jsr outc 23 | jmp realexit 24 | 25 | outc swi2 26 | rts 27 | 28 | inc swi3 29 | rts 30 | 31 | realexit sync 32 | 33 | enddata 34 | 35 | end 36 | -------------------------------------------------------------------------------- /examples/printval.asm: -------------------------------------------------------------------------------- 1 | ;print value as decimal 2 | 3 | org $100 4 | 5 | ldx #$ff00 6 | loop: 7 | bsr printdec 8 | ldb #32 9 | swi2 10 | leax 1,x 11 | bne loop 12 | sync 13 | 14 | 15 | printdec: 16 | pshs cc,d,x ; save regs 17 | lda #$80 ; init. terminator 18 | nxtdg: 19 | sta ,-s ; push digit term 20 | ldb #16 ; 16 bit counter for rotate 21 | clra ; clear accu and carry 22 | roll: 23 | rola ; divide by 10 using binary 24 | adda #$f6 ; long division, shifting X one 25 | bcs sub ; bit at a time info A and 26 | suba #$f6 ; subtracting 10 which sets 27 | sub: 28 | exg d,x ; C if sub goes, else add 10 29 | rolb ; back and reset C. Rotating X 30 | rola ; by means of A & B both shifts 31 | exg d,x ; X bits into A and shifts 32 | decb ; result bits into X. Do 17 33 | bpl roll ; times to get last result bit. 34 | leax ,x ; test X and repeat if 35 | bne nxtdg ; X is not zero 36 | tfr a,b 37 | prog: 38 | orb #$30 ; make into ASCII digit, call 39 | swi2 ; print char 40 | ldb ,s+ ; pull next digit of stack and 41 | bpl prog ; repeat if not terminator 42 | puls cc,d,x,pc ; restore regs and return 43 | 44 | 45 | end 46 | 47 | -------------------------------------------------------------------------------- /examples/test09.asm: -------------------------------------------------------------------------------- 1 | ; 6809 Test program. 2 | 3 | testnr equ 32 4 | 5 | org $100 6 | jmp entry 7 | error ldx #errmsg 8 | bsr outs 9 | lda testnr 10 | bsr outa 11 | ldx #newline 12 | bsr outs 13 | sync 14 | 15 | errmsg fcb "ERROR ",0 16 | newline fcb 13,10,0 17 | outs ldb ,x+ 18 | beq done1 19 | swi2 20 | bra outs 21 | done1 rts 22 | outdig addb # 48 23 | cmpb # 57 24 | bls od2 25 | addb #7 26 | od2 swi2 27 | rts 28 | outa tfr a,b 29 | lsrb 30 | lsrb 31 | lsrb 32 | lsrb 33 | bsr outdig 34 | tfr a,b 35 | andb # 15 36 | bra outdig 37 | passmsg fcb "PASSED ",0 38 | good ldx #passmsg 39 | jsr outs 40 | lda testnr 41 | jsr outa 42 | ldx #newline 43 | jsr outs 44 | inc testnr 45 | rts 46 | 47 | entry clr testnr 48 | jsr good ;test #0, does it print msg? 49 | andcc #0 ;test #1, conditional (long) branches 50 | lbvs error ; andcc, orcc 51 | lbcs error 52 | lbeq error 53 | lbmi error 54 | lbls error 55 | lblt error 56 | lble error 57 | lbrn error 58 | bvs errt1 59 | bcs errt1 60 | beq errt1 61 | bmi errt1 62 | bls errt1 63 | blt errt1 64 | ble errt1 65 | brn errt1 66 | lbvc goot1 67 | errt1 jmp error 68 | goot1 lbcc goot2 69 | jmp error 70 | goot2 lbne goot3 71 | jmp error 72 | goot3 lbpl goot4 73 | jmp error 74 | goot4 lbhi goot5 75 | jmp error 76 | goot5 lbge goot6 77 | jmp error 78 | goot6 lbgt goot7 79 | jmp error 80 | goot7 lbra goot8 81 | jmp error 82 | goot8 bvc goot9 83 | jmp error 84 | goot9 bcc goot10 85 | jmp error 86 | goot10 bne goot11 87 | jmp error 88 | goot11 bpl goot12 89 | jmp error 90 | goot12 bhi goot13 91 | jmp error 92 | goot13 bge goot14 93 | jmp error 94 | goot14 bgt goot15 95 | jmp error 96 | goot15 bra goot16 97 | jmp error 98 | goot16 tfr cc,a 99 | tsta 100 | lbne error 101 | andcc #0 102 | orcc #1 103 | lbcc error 104 | lbeq error 105 | lbvs error 106 | lbmi error 107 | orcc #2 108 | lbvc error 109 | lbeq error 110 | lbmi error 111 | orcc #4 112 | lbne error 113 | lbmi error 114 | orcc #8 115 | lbpl error 116 | tfr cc,a 117 | cmpa #15 118 | lbne error 119 | orcc #15 120 | orcc #240 121 | tfr cc,a 122 | inca 123 | lbne error 124 | orcc #255 125 | andcc #$aa 126 | tfr cc,a 127 | cmpa #$aa 128 | lbne error 129 | jsr good 130 | 131 | lds #0 ; test #2: registers and their values, tfr, exg 132 | lda #$28 133 | ldb #$7f 134 | ldu #3417 135 | ldx #2221 136 | ldy #16555 137 | cmpa #$28 138 | lbne error 139 | cmpb #$7f 140 | lbne error 141 | cmpd #$287f 142 | lbne error 143 | cmpx #2221 144 | lbne error 145 | cmpy #13 146 | lbeq error 147 | cmpy #16555 148 | lbne error 149 | cmpu #3417 150 | lbne error 151 | cmps #0 152 | lbne error 153 | exg x,y 154 | cmpx #16555 155 | lbne error 156 | cmpy #2221 157 | lbne error 158 | exg x,d 159 | cmpd #16555 160 | lbne error 161 | cmpx #$287f 162 | lbne error 163 | cmpy #2221 164 | lbne error 165 | exg x,d 166 | exg a,dp 167 | tsta 168 | lbne error 169 | exg a,dp 170 | exg a,b 171 | cmpa #$7f 172 | lbne error 173 | cmpb #$28 174 | lbne error 175 | tfr b,a 176 | cmpb #$28 177 | lbne error 178 | cmpa #$28 179 | lbne error 180 | tfr u,x 181 | cmpu #3417 182 | lbne error 183 | cmpx #3417 184 | lbne error 185 | tfr pc,x 186 | here cmpx #here 187 | lbne error 188 | tfr u,s 189 | cmps #3417 190 | lbne error 191 | lds #0 192 | clra 193 | tfr b,cc 194 | tfr cc,a 195 | cmpa #$28 196 | lbne error 197 | jsr good 198 | 199 | lda #128 ;Arithmetic and their status. 200 | adda #255 201 | lbcc error 202 | lbvc error 203 | lbmi error 204 | cmpa #127 205 | lbne error 206 | lda #0 207 | adda #255 208 | lbcs error 209 | lbvs error 210 | lbpl error 211 | cmpa #255 212 | lbne error 213 | orcc #1 214 | lda #255 215 | adca #0 216 | lbne error 217 | lbmi error 218 | lbcc error 219 | lda #216 220 | adda #40 221 | lbne error 222 | lda #80 223 | adda #40 224 | lbcs error 225 | lbvs error 226 | cmpa #120 227 | lbne error 228 | orcc #1 229 | lda #80 230 | adca #40 231 | lbcs error 232 | lbvs error 233 | cmpa #121 234 | lbne error 235 | andcc #254 236 | ldb #80 237 | adcb #40 238 | lbcs error 239 | lbvs error 240 | cmpb #120 241 | lbne error 242 | ldb #80 243 | subb #120 244 | lbcc error 245 | lbvs error 246 | cmpb #216 247 | lbne error 248 | andcc #254 249 | lda #140 250 | sbca #20 251 | lbvc error 252 | lbcs error 253 | cmpa #120 254 | lbne error 255 | orcc #1 256 | lda #140 257 | sbca #20 258 | lbvc error 259 | lbcs error 260 | cmpa #119 261 | lbne error 262 | ldd #40000 263 | subd #20000 264 | lbvc error 265 | lbcs error 266 | cmpd #20000 267 | lbne error 268 | ldd #20000 269 | subd #40000 270 | lbvc error 271 | lbcc error 272 | cmpd #-20000 273 | lbne error 274 | ldd #30000 275 | addd #-20000 276 | lbcc error 277 | lbvs error 278 | cmpd #10000 279 | lbne error 280 | jsr good 281 | 282 | lda #$23 ;Test #4 decimal arithmetic. 283 | adda #$34 284 | daa 285 | lbcs error 286 | cmpa #$57 287 | lbne error 288 | orcc #1 289 | lda #$19 290 | adca #$29 291 | daa 292 | lbcs error 293 | cmpa #$49 294 | lbne error 295 | lda #$92 296 | adda #$8 297 | daa 298 | lbcc error 299 | cmpa #$00 300 | jsr good 301 | 302 | lda #128 ;Test#5 MUL and SEX 303 | ldb #2 304 | mul 305 | lbeq error 306 | lbcs error 307 | cmpd #256 308 | lbne error 309 | lda #0 310 | ldb #23 311 | mul 312 | lbne error 313 | lbcs error 314 | cmpd #0 315 | lbne error 316 | lda #10 317 | ldb #20 318 | mul 319 | lbcc error 320 | cmpd #200 321 | lbne error 322 | lda #100 323 | ldb #49 324 | mul 325 | cmpd #4900 326 | lbne error 327 | clrb 328 | sex 329 | cmpd #0 330 | lbne error 331 | ldb #128 332 | sex 333 | cmpd #-128 334 | lbne error 335 | ldb #50 336 | sex 337 | cmpd #50 338 | lbne error 339 | jsr good 340 | 341 | lda #$55 ; Test #6 Shifts and rotates. 342 | asla 343 | lbcs error 344 | cmpa #$aa 345 | lbne error 346 | asla 347 | lbcc error 348 | cmpa #$54 349 | lbne error 350 | lda #$0 351 | andcc #254 352 | rola 353 | lbne error 354 | orcc #1 355 | rola 356 | deca 357 | lbne error 358 | andcc #254 359 | rora 360 | lbne error 361 | orcc #1 362 | rora 363 | cmpa #128 364 | lbne error 365 | asra 366 | cmpa #192 367 | lbne error 368 | lsra 369 | cmpa #96 370 | lbne error 371 | ldb # 54 372 | aslb 373 | cmpb # 108 374 | lbne error 375 | jsr good 376 | 377 | orcc #15 ; Test #7 INC, DEC and NEG 378 | lda # 33 379 | inca 380 | lbeq error 381 | lbvs error 382 | lbcc error 383 | lbmi error 384 | deca 385 | lbeq error 386 | lbvs error 387 | lbcc error 388 | lbmi error 389 | clra 390 | andcc #254 391 | deca 392 | lbcs error 393 | lbpl error 394 | inca 395 | lbne error 396 | ldb #126 397 | negb 398 | lbvs error 399 | lbcc error 400 | cmpb #130 401 | lbne error 402 | decb 403 | decb 404 | negb 405 | lbvc error 406 | cmpb #128 407 | lbne error 408 | clrb 409 | negb 410 | lbcs error 411 | lbne error 412 | jsr good 413 | 414 | ;test #8 Addessing modes. 415 | ldx #testdat+4 416 | lda ,x 417 | cmpa #5 418 | lbne error 419 | lda ,x+ 420 | cmpa #5 421 | lbne error 422 | cmpx #testdat+5 423 | lbne error 424 | ldd ,x++ 425 | cmpd #6*256+7 426 | lbne error 427 | cmpx #testdat+7 428 | lbne error 429 | ldx #testdat+4 430 | lda ,-x 431 | cmpa #4 432 | lbne error 433 | cmpx #testdat+3 434 | lbne error 435 | ldd ,--x 436 | cmpd #2*256+3 437 | lbne error 438 | cmpx #testdat+1 439 | lbne error 440 | ldx #testdat+4 441 | lda -2,x 442 | cmpa #3 443 | lbne error 444 | lda 2,x 445 | cmpa #7 446 | lbne error 447 | ldx #td1 448 | ldd [,x] 449 | cmpd #3*256+4 450 | lbne error 451 | cmpx #td1 452 | lbne error 453 | jsr good 454 | bra next1 455 | testdat fcb 1,2,3,4,5,6,7,8,9,10 456 | td1 fdb testdat+2 457 | next1 458 | 459 | sync 460 | end $100 461 | 462 | 463 | 464 | -------------------------------------------------------------------------------- /examples/uslash.asm: -------------------------------------------------------------------------------- 1 | ; 6809 32/16 divison for a forth environment 2 | ; 2012-06-20, 2014-07-01 J.E. Klasek j+forth@klasek.at 3 | ; 4 | ; There are two implementations: 5 | ; TALBOT just for analysis, not really used here. 6 | ; EFORTH advanced and optimized version for ef09 7 | ; 8 | ; EFORTH version's special cases: 9 | ; overflow: quotient = $FFFF, remainder = divisor 10 | ; underflow: quotient = $0000, remainder = dividend low 11 | ; division by zero: quotient = $FFFF, remainder = $0000 12 | 13 | org $100 14 | lds #$100 15 | ldu #$8000 16 | 17 | ; Testvalues: 18 | ; 19 | ; DIVH DIVL DVSR QUOT REM comment 20 | ; 21 | ; 0100 0000 FFFF 0100 0100 maximum divisor 22 | ; 0000 0001 8000 0000 0001 underflow (REM = DIVL) 23 | ; 0000 5800 3000 0001 1800 normal divsion 24 | ; 5800 0000 3000 FFFF 3000 overflow 25 | ; 0000 0001 0000 FFFF 0000 overflow (division by zero) 26 | ; 27 | 28 | DIVH EQU $0000 29 | DIVL EQU $5800 30 | DVSR EQU $3000 31 | 32 | bra EFORTH ; comment out to try TALBOT's version 33 | 34 | ; ------------------------------------ 35 | ; Version from Talbot System FIG Forth 36 | ; ------------------------------------ 37 | 38 | TALBOT: 39 | 40 | ; sample parameters on forth parameter stack (U) ... 41 | ldd #DIVL ; dividend low word 42 | pshu d 43 | ldd #DIVH ; dividend high word 44 | pshu d 45 | ldd #DVSR ; divisor 46 | pshu d 47 | 48 | USLASH: ldd 2,u ; dividend swap H/L word 49 | ldx 4,u 50 | stx 2,u 51 | std 4,u 52 | asl 3,u ; initial shift of L word 53 | rol 2,u 54 | ldx #$10 55 | USL1: rol 5,u ; shift H word 56 | rol 4,u 57 | ldd 4,u 58 | subd ,u ; does divisor fit? 59 | andcc #$fe ; clc - clear carry flag 60 | bmi USL2 61 | std 4,u ; fits -> quotient = 1 62 | orcc #$01 ; sec - set carry flag 63 | USL2: rol 3,u ; L word/quotient 64 | rol 2,u 65 | leax -1,x 66 | bne USL1 67 | leau 2,u ; drop divisor from parameter stack 68 | 69 | ; into registers for simulator ... 70 | 71 | ldx ,u ; quotient on TOS 72 | ldd 2,u ; remainder on 2nd 73 | 74 | realexit: 75 | sync 76 | 77 | 78 | 79 | 80 | ; ------------------------------------ 81 | ; Version from J.E. Klasek, replacing 82 | ; high-level variant in eFORTH. 83 | ; ------------------------------------ 84 | 85 | EFORTH: 86 | ; sample parameters on forth parameter stack (S) ... 87 | ldd #DIVL ; dividend low word 88 | pshs d 89 | ldd #DIVH ; dividend high word 90 | pshs d 91 | ldd #DVSR ; divisor 92 | pshs d 93 | 94 | ; U/ ( udl udh un -- ur uq ) 95 | ; Unsigned divide of a double by a single. Return mod and quotient. 96 | ; 97 | ; Special cases: 98 | ; 1. overflow: quotient overflow if dividend is to great (remainder = divisor), 99 | ; remainder is set to $FFFF -> special handling. 100 | ; This is checked also right before the main loop. 101 | ; 2. underflow: divisor does not fit into dividend -> remainder 102 | ; get the value of the dividend -> automatically covered. 103 | 104 | USLASH2: 105 | ldx #16 106 | ldd 2,s ; udh 107 | cmpd ,s ; dividend to great? 108 | bhs UMMODOV ; quotient overflow! 109 | asl 5,s ; udl low 110 | rol 4,s ; udl high 111 | 112 | UMMOD1: rolb ; got one bit from udl 113 | rola 114 | bcs UMMOD2 ; bit 16 means always greater as divisor 115 | cmpd ,s ; divide by un 116 | bhs UMMOD2 ; higher or same as divisor? 117 | andcc #$fe ; clc - clear carry flag 118 | bra UMMOD3 119 | UMMOD2: subd ,s 120 | orcc #$01 ; sec - set carry flag 121 | UMMOD3: rol 5,s ; udl, quotient shifted in 122 | rol 4,s 123 | leax -1,x 124 | bne UMMOD1 125 | 126 | ldx 4,s ; quotient 127 | cmpd ,s ; remainder >= divisor -> overflow 128 | blo UMMOD4 129 | UMMODOV: 130 | ldd ,s ; remainder set to divisor 131 | ldx #$FFFF ; quotient = FFFF (-1) marks overflow 132 | ; (case 1) 133 | UMMOD4: 134 | leas 2,s ; un (divisor thrown away) 135 | stx ,s ; quotient to TOS 136 | std 2,s ; remainder 2nd 137 | 138 | bra realexit 139 | 140 | ; not reached 141 | pulu pc ; eFORTH NEXT 142 | 143 | enddata 144 | 145 | end 146 | -------------------------------------------------------------------------------- /examples_forth/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile examples_forth SBC09/Sim6809 3 | # 4 | # created 1994 by L.C. Benschop 5 | # 2013-10-28 - Jens Diemer: add "clean" section 6 | # 2014-07-16 - J.E. Klasek 7 | # 8 | # copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 9 | # license: GNU General Public License version 2, see LICENSE for more details. 10 | # 11 | 12 | ASM=../a09 13 | 14 | PROGS=forthload.s 15 | 16 | 17 | 18 | all: $(ASM) $(PROGS) 19 | 20 | $(ASM): 21 | $(MAKE) -c ../src a09 install 22 | 23 | 24 | # ------------------------------------ 25 | # rules 26 | 27 | .SUFFIXES: .asm .s 28 | 29 | .asm.s: 30 | $(ASM) -s $@ $< 31 | 32 | # 33 | # ------------------------------------ 34 | 35 | forthload.s: forthload.asm 36 | 37 | 38 | # ------------------------------------ 39 | 40 | cleanall: clean 41 | 42 | clean: 43 | rm -f core *.BAK *.lst $(PROGS) 44 | 45 | -------------------------------------------------------------------------------- /examples_forth/asm09.4: -------------------------------------------------------------------------------- 1 | \ 6809 assembler 2 | 3 | BASE @ HEX 4 | 5 | : DEFER CREATE 0 , DOES> @ EXECUTE ; 6 | : IS ' >BODY ! ; 7 | 8 | VOCABULARY ASSEMBLER 9 | ASSEMBLER ALSO DEFINITIONS 10 | 11 | ' C! DEFER VC! IS VC! \ Vectorize the important words so we can cross 12 | ' C@ DEFER VC@ IS VC@ \ assemble and self-assemble using the same code. 13 | ' ! DEFER V! IS V! 14 | ' @ DEFER V@ IS V@ 15 | ' C, DEFER C, IS C, 16 | ' , DEFER , IS , 17 | ' HERE DEFER HERE IS HERE 18 | ' ALLOT DEFER ALLOT IS ALLOT 19 | 20 | VARIABLE VDP 21 | : VHERE ( --- addr) 22 | VDP @ ; 23 | : VALLOT VDP +! ; 24 | : VC, ( c --- ) 25 | VHERE VC! 1 VALLOT ; 26 | : V, ( n ---) 27 | VHERE V! 2 VALLOT ; 28 | : ORG VDP ! ; 29 | 30 | : MARK ( --- addr ) 35 | HERE 0 C, ; 36 | : >RESOLVE ( addr --- ) 37 | HERE OVER 1+ - SWAP VC! ; 38 | 39 | VARIABLE ?PREBYTE VARIABLE PREBYTE \ Byte $10 or $11 before opcode 40 | VARIABLE ?OPCODE VARIABLE OPCODE \ Opcode byte 41 | VARIABLE ?POSTBYTE VARIABLE POSTBYTE \ Byte after opcode indicating mode. 42 | VARIABLE ?OPERAND \ Address or data after instruction. 43 | VARIABLE MODE \ True is direct addressing false is other. 44 | VARIABLE DPAGE \ Direct page address. 45 | : SETDP ( n ---) \ Set direct page. 46 | 100 * DPAGE ! ; 47 | 0 SETDP 48 | 49 | : NOINSTR \ Reset all the instruction flags so there will be no instruction. 50 | ?PREBYTE OFF ?OPCODE OFF ?POSTBYTE OFF ?OPERAND OFF MODE OFF ; 51 | : A; \ Assemble current instruction and reset instruction flags. 52 | MODE @ IF \ direct addresiing? 53 | DUP DPAGE @ - 0FF U> IF \ Is address 16 bits? 54 | 2 ?OPERAND ! \ Indicate 16 bits address. 55 | OPCODE @ 0F0 AND 0= \ Change opcode byte. 56 | IF 70 OPCODE +! 57 | ELSE 20 OPCODE +! 58 | THEN 59 | ELSE 1 ?OPERAND ! \ Indicate 8 bis address. 60 | THEN 61 | THEN 62 | ?PREBYTE @ IF PREBYTE @ C, THEN 63 | ?OPCODE @ IF OPCODE @ C, THEN 64 | ?POSTBYTE @ IF POSTBYTE @ C, THEN 65 | ?OPERAND @ IF 66 | CASE ?OPERAND @ 67 | 1 OF C, ENDOF \ 8 bits data/address. 68 | 2 OF , ENDOF \ 16 bits data/address. 69 | 3 OF HERE 1+ - C, ENDOF \ 8 bits relative address. 70 | 4 OF HERE 2 + - , ENDOF \ 16 bits realtive address. 71 | ENDCASE 72 | THEN NOINSTR ; 73 | 74 | 75 | : LABEL A; HERE CONSTANT ; 76 | 77 | 78 | HEX 79 | : flag10 \ Indicate that next instruction has prebyte $10 80 | ?PREBYTE ON 10 PREBYTE ! ; 81 | : flag11 \ Indicate that next instruction has prebyte $11 82 | ?PREBYTE ON 11 PREBYTE ! ; 83 | 84 | : # \ Signal immediate mode. 85 | MODE OFF -10 OPCODE +! ; 86 | 87 | : USE-POSTBYTE \ Signal that postbyte must be used. 88 | MODE OFF 89 | ?POSTBYTE ON 90 | OPCODE @ 0F0 AND 0= IF 91 | 60 OPCODE +! 92 | ELSE 93 | OPCODE @ 80 AND IF 94 | 10 OPCODE +! 95 | THEN 96 | THEN ; 97 | 98 | : [] \ Signal indirect mode. 99 | MODE @ IF \ Indirect addressing with 16-bits addres, no postbyte made yet. 100 | USE-POSTBYTE 101 | 9F POSTBYTE ! \ Make postbyte. 102 | 2 ?OPERAND ! \ Indicate 16-bits address. 103 | ELSE 104 | POSTBYTE @ 80 AND 0= IF \ 5-bits address format already assembled? 105 | POSTBYTE @ 1F AND DUP 10 AND 0<> 0E0 AND OR 106 | 1 ?OPERAND ! \ Signal operand. 107 | POSTBYTE @ 60 AND 98 OR POSTBYTE ! \ Change postbyte. 108 | ELSE 109 | POSTBYTE @ 10 OR POSTBYTE ! \ Indicate indirect addressing. 110 | THEN 111 | THEN ; 112 | 113 | : ,R \ Modes with a constant offset from a register. 114 | CREATE C, 115 | DOES> USE-POSTBYTE 116 | C@ POSTBYTE ! \ Make register field in postbyte. 117 | DUP 0= IF 118 | 84 POSTBYTE +! DROP \ Zero offset. 119 | ?OPERAND OFF 120 | ELSE 121 | DUP -10 >= OVER 0F <= AND IF \ 5-bit offset. 122 | 1F AND POSTBYTE +! 123 | ?OPERAND OFF 124 | ELSE 125 | DUP 80 + 100 U< IF \ 8-bit offset. 126 | 88 POSTBYTE +! 127 | 1 ?OPERAND ! 128 | ELSE 129 | 89 POSTBYTE +! \ 16-bit offset. 130 | 2 ?OPERAND ! 131 | THEN 132 | THEN 133 | THEN ; 134 | 00 ,R ,X 135 | 20 ,R ,Y 136 | 40 ,R ,U 137 | 60 ,R ,S 138 | 139 | : AMODE \ addressing modes with no operands. 140 | CREATE C, 141 | DOES> USE-POSTBYTE 142 | C@ POSTBYTE ! 143 | ?OPERAND OFF ; 144 | 080 AMODE ,X+ 081 AMODE ,X++ 082 AMODE ,-X 083 AMODE ,--X 145 | 085 AMODE B,X 086 AMODE A,X 08B AMODE D,X 146 | 0A0 AMODE ,Y+ 0A1 AMODE ,Y++ 0A2 AMODE ,-Y 0A3 AMODE ,--Y 147 | 0A5 AMODE B,Y 0A6 AMODE A,Y 0AB AMODE D,Y 148 | 0C0 AMODE ,U+ 0C1 AMODE ,U++ 0C2 AMODE ,-U 0C3 AMODE ,--U 149 | 0C5 AMODE B,U 0C6 AMODE A,U 0CB AMODE D,U 150 | 0E0 AMODE ,S+ 0E1 AMODE ,S++ 0E2 AMODE ,-S 0E3 AMODE ,--S 151 | 0E5 AMODE B,S 0E6 AMODE A,S 0EB AMODE D,S 152 | 153 | : ,PCR \ Signal program counter relative. 154 | USE-POSTBYTE 155 | DUP 156 | HERE ?PREBYTE @ - 3 + - \ Subtract address after instruction 157 | 80 + 100 U< IF \ 8-bits offset good? 158 | 3 ?OPERAND ! 159 | 8C POSTBYTE ! 160 | ELSE 161 | 4 ?OPERAND ! 162 | 8D POSTBYTE ! 163 | THEN ; 164 | 165 | : USE-OPCODE ( c ---) 166 | ?OPCODE ON 167 | OPCODE ! ; 168 | 169 | : IN1 \ Simple instructions with one byte opcode 170 | CREATE C, 171 | DOES> >R A; R> C@ USE-OPCODE ; 172 | 12 IN1 NOP 13 IN1 SYNC 173 | 19 IN1 DAA 1D IN1 SEX 174 | 39 IN1 RTS 3A IN1 ABX 175 | 3B IN1 RTI 3D IN1 MUL 176 | 3F IN1 SWI : SWI2 SWI flag10 ; : SWI3 SWI flag11 ; 177 | 40 IN1 NEGA 50 IN1 NEGB 178 | 43 IN1 COMA 53 IN1 COMB 179 | 44 IN1 LSRA 54 IN1 LSRB 180 | 46 IN1 RORA 56 IN1 RORB 181 | 47 IN1 ASRA 57 IN1 ASRB 182 | 48 IN1 ASLA 58 IN1 ASLB 183 | 48 IN1 LSLA 58 IN1 LSLB 184 | 49 IN1 ROLA 59 IN1 ROLB 185 | 4A IN1 DECA 5A IN1 DECB 186 | 4C IN1 INCA 5C IN1 INCB 187 | 4D IN1 TSTA 5D IN1 TSTB 188 | 4F IN1 CLRA 5F IN1 CLRB 189 | \ Though not no-operand instructions the LEA instructions 190 | \ are treated correctly as the postbyte is added by the mode words. 191 | 30 IN1 LEAX 31 IN1 LEAY 192 | 32 IN1 LEAS 33 IN1 LEAU 193 | : DEX LEAX -1 ,X ; : INX LEAX 1 ,X ; 194 | : DES LEAS -1 ,S ; : INS LEAS 1 ,S ; 195 | : DEY LEAY -1 ,Y ; : INY LEAY 1 ,Y ; 196 | 197 | : BR-8 \ relative branches with 8-bit offset 198 | CREATE C, 199 | DOES> >R A; R> C@ USE-OPCODE 3 ?OPERAND ! ; 200 | 20 BR-8 BRA 21 BR-8 BRN 201 | 22 BR-8 BHI 23 BR-8 BLS 202 | 24 BR-8 BCC 25 BR-8 BCS 203 | 24 BR-8 BHS 25 BR-8 BLO 204 | 26 BR-8 BNE 27 BR-8 BEQ 205 | 28 BR-8 BVC 29 BR-8 BVS 206 | 2A BR-8 BPL 2B BR-8 BMI 207 | 2C BR-8 BGE 2D BR-8 BLT 208 | 2E BR-8 BGT 2F BR-8 BLE 209 | 8D BR-8 BSR 210 | 211 | : LBRA 212 | A; 16 USE-OPCODE 4 ?OPERAND ! ; 213 | : LBSR 214 | A; 17 USE-OPCODE 4 ?OPERAND ! ; 215 | 216 | : BR16 \ Relative branches with 16-bit offset. 217 | CREATE C, 218 | DOES> >R A; R> C@ USE-OPCODE flag10 4 ?OPERAND ! ; 219 | 21 BR16 LBRN 220 | 22 BR16 LBHI 23 BR16 LBLS 221 | 24 BR16 LBCC 25 BR16 LBCS 222 | 24 BR16 LBHS 25 BR16 LBLO 223 | 26 BR16 LBNE 27 BR16 LBEQ 224 | 28 BR16 LBVC 29 BR16 LBVS 225 | 2A BR16 LBPL 2B BR16 LBMI 226 | 2C BR16 LBGE 2D BR16 LBLT 227 | 2E BR16 LBGT 2F BR16 LBLE 228 | 229 | : IN2 \ Instructions with one immediate data byte. 230 | CREATE C, 231 | DOES> >R A; R> C@ USE-OPCODE 1 ?OPERAND ! ; 232 | 1A IN2 ORCC 1C IN2 ANDCC 3C IN2 CWAI 233 | : CLC ANDCC 0FE ; : SEC ORCC 01 ; 234 | : CLF ANDCC 0BF ; : SEF ORCC 40 ; 235 | : CLI ANDCC 0EF ; : SEI ORCC 10 ; 236 | : CLIF ANDCC 0AF ; : SEIF ORCC 50 ; 237 | : CLV ANDCC 0FD ; : SEV ORCC 02 ; 238 | : % ( --- n) \ Interpret next word as a binary number. 239 | BASE @ 2 BASE ! BL WORD NUMBER? drop DROP SWAP BASE ! ; 240 | 241 | : REG \ Registers as used in PUSH PULL TFR and EXG instructions. 242 | CREATE C, C, 243 | DOES> ?OPERAND @ IF \ Is a PUSH/PULL instruction meant? 244 | 1+ C@ OR 245 | ELSE 246 | C@ POSTBYTE +! \ It's a TFR,EXG instruction. 247 | THEN ; 248 | 06 00 REG D, 06 00 REG D 249 | 10 10 REG X, 10 01 REG X 250 | 20 20 REG Y, 20 02 REG Y 251 | 40 30 REG U, 40 03 REG U 252 | 40 40 REG S, 40 04 REG S 253 | 80 50 REG PC, 80 05 REG PC 254 | 02 80 REG A, 02 08 REG A 255 | 04 90 REG B, 04 09 REG B 256 | 01 A0 REG CC, 01 0A REG CC 257 | 08 B0 REG DP, 08 0B REG DP 258 | 259 | : EXG A; 1E USE-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; 260 | : TFR A; 1F USE-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; 261 | : STK \ Stack instructions. 262 | CREATE C, 263 | DOES> >R A; R> C@ USE-OPCODE 264 | 1 ?OPERAND ! 0 ; 265 | 34 STK PSHS 35 STK PULS 266 | 36 STK PSHU 37 STK PULU 267 | 268 | : OP-8 \ Instructions with 8-bits data. 269 | CREATE C, 270 | DOES> >R A; R> C@ USE-OPCODE 271 | MODE ON 272 | 1 ?OPERAND ! ; 273 | 00 OP-8 NEG 03 OP-8 COM 274 | 04 OP-8 LSR 06 OP-8 ROR 275 | 07 OP-8 ASR 08 OP-8 ASL 276 | 08 OP-8 LSL 09 OP-8 ROL 277 | 0A OP-8 DEC 0C OP-8 INC 278 | 0D OP-8 TST 0E OP-8 JMP 279 | 0F OP-8 CLR 280 | 90 OP-8 SUBA 0D0 OP-8 SUBB 281 | 91 OP-8 CMPA 0D1 OP-8 CMPB 282 | 92 OP-8 SBCA 0D2 OP-8 SBCB 283 | 94 OP-8 ANDA 0D4 OP-8 ANDB 284 | 95 OP-8 BITA 0D5 OP-8 BITB 285 | 96 OP-8 LDA 0D6 OP-8 LDB 286 | 97 OP-8 STA 0D7 OP-8 STB 287 | 98 OP-8 EORA 0D8 OP-8 EORB 288 | 99 OP-8 ADCA 0D9 OP-8 ADCB 289 | 9A OP-8 ORA 0DA OP-8 ORB 290 | 9B OP-8 ADDA 0DB OP-8 ADDB 291 | 9D OP-8 JSR 292 | 293 | : OP16 \ Instructions with 16-bits daia. 294 | CREATE C, 295 | DOES> >R A; R> C@ USE-OPCODE 296 | MODE ON 297 | 2 ?OPERAND ! ; 298 | 93 OP16 SUBD 0D3 OP16 ADDD 299 | 9C OP16 CMPX 0DC OP16 LDD 0DD OP16 STD 300 | 9E OP16 LDX 0DE OP16 LDU 301 | 9F OP16 STX 0DF OP16 STU 302 | : CMPD SUBD flag10 ; : CMPY CMPX flag10 ; 303 | : LDY LDX flag10 ; : STY STX flag10 ; 304 | : LDS LDU flag10 ; : STS STU flag10 ; 305 | : CMPU SUBD flag11 ; : CMPS CMPX flag11 ; 306 | 307 | \ Structured assembler constructs. 308 | : IF >R A; R> C, >MARK ; 309 | : THEN A; >RESOLVE ; 310 | : ELSE A; 20 C, >MARK SWAP >RESOLVE ; 311 | : BEGIN A; R A; R> C, R A; R> C, >MARK ; 314 | : REPEAT A; 20 C, SWAP RESOLVE ; 315 | : AGAIN 20 UNTIL ; 316 | 22 CONSTANT U<= 23 CONSTANT U> 317 | 24 CONSTANT U< 25 CONSTANT U>= 318 | 26 CONSTANT 0= 27 CONSTANT 0<> 319 | 28 CONSTANT VS 29 CONSTANT VC 320 | 2A CONSTANT 0< 2B CONSTANT 0>= 321 | 2C CONSTANT < 2D CONSTANT >= 322 | 2E CONSTANT <= 2F CONSTANT > 323 | 324 | : ENDASM \ End assembly. 325 | A; PREVIOUS ; 326 | FORTH DEFINITIONS 327 | : ASSEMBLE \ Start assembly. 328 | ALSO ASSEMBLER NOINSTR ; 329 | 330 | : CODE CREATE -3 ALLOT ASSEMBLE ; 331 | : END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; 332 | 333 | PREVIOUS FORTH DEFINITIONS 334 | 335 | BASE ! \ Restore the original base. 336 | -------------------------------------------------------------------------------- /examples_forth/asm6309.4: -------------------------------------------------------------------------------- 1 | \ 6309 assembler 2 | 3 | BASE @ HEX 4 | 5 | : DEFER CREATE 0 , DOES> @ EXECUTE ; 6 | : IS ' >BODY ! ; 7 | 8 | VOCABULARY ASSEMBLER 9 | ASSEMBLER ALSO DEFINITIONS 10 | 11 | ' C! DEFER VC! IS VC! \ Vectorize the important words so we can cross 12 | ' C@ DEFER VC@ IS VC@ \ assemble and self-assemble using the same code. 13 | ' ! DEFER V! IS V! 14 | ' @ DEFER V@ IS V@ 15 | ' C, DEFER C, IS C, 16 | ' , DEFER , IS , 17 | ' HERE DEFER HERE IS HERE 18 | ' ALLOT DEFER ALLOT IS ALLOT 19 | 20 | VARIABLE VDP 21 | : VHERE ( --- addr) 22 | VDP @ ; 23 | : VALLOT VDP +! ; 24 | : VC, ( c --- ) 25 | VHERE VC! 1 VALLOT ; 26 | : V, ( n ---) 27 | VHERE V! 2 VALLOT ; 28 | : ORG VDP ! ; 29 | 30 | : MARK ( --- addr ) 35 | HERE 0 C, ; 36 | : >RESOLVE ( addr --- ) 37 | HERE OVER 1+ - SWAP VC! ; 38 | 39 | VARIABLE ?MEMIMM \ Memory + immediate (AIM, OIM, EOIM) 40 | VARIABLE ?OPCODE VARIABLE OPCODE \ Opcode byte 41 | VARIABLE ?POSTBYTE VARIABLE POSTBYTE \ Byte after opcode indicating mode. 42 | VARIABLE ?OPERAND \ Address or data after instruction. 43 | VARIABLE MODE \ True is direct addressing false is other. 44 | VARIABLE DPAGE \ Direct page address. 45 | : SETDP ( n ---) \ Set direct page. 46 | 100 * DPAGE ! ; 47 | 0 SETDP 48 | 49 | : NOINSTR \ Reset all the instruction flags so there will be no instruction. 50 | ?OPCODE OFF ?POSTBYTE OFF ?OPERAND OFF MODE OFF ?MEMIMM OFF ; 51 | : A; \ Assemble current instruction and reset instruction flags. 52 | MODE @ IF \ direct addresiing? 53 | DUP DPAGE @ - 0FF U> IF \ Is address 16 bits? 54 | 2 ?OPERAND ! \ Indicate 16 bits address. 55 | OPCODE @ 0F0 AND 0= \ Change opcode byte. 56 | IF 70 OPCODE +! 57 | ELSE 20 OPCODE +! 58 | THEN 59 | ELSE 1 ?OPERAND ! \ Indicate 8 bis address. 60 | THEN 61 | THEN 62 | ?OPCODE @ IF 63 | OPCODE @ DUP 100 > IF 64 | DUP 8 RSHIFT C, \ assemble prebyte 65 | THEN 66 | C, 67 | THEN 68 | ?MEMIMM @ IF 69 | ?OPERAND @ IF SWAP THEN \ move immediate byte from under operand. 70 | C, 71 | THEN 72 | ?POSTBYTE @ IF POSTBYTE @ C, THEN 73 | ?OPERAND @ IF 74 | CASE ?OPERAND @ 75 | 1 OF C, ENDOF \ 8 bits data/address. 76 | 2 OF , ENDOF \ 16 bits data/address. 77 | 3 OF HERE 1+ - C, ENDOF \ 8 bits relative address. 78 | 4 OF HERE 2 + - , ENDOF \ 16 bits relative address. 79 | 5 OF , , ENDOF \ 32 bits immediate (LDQ) 80 | 6 OF \ single-bit operations. 81 | >R \ Save DP address. 82 | SWAP 3 LSHIFT OR \ or the bit numbers together. 83 | SWAP 6 AND 5 LSHIFT OR \ Add register number. 84 | C, \ Store post-byte (reg-srcbit-dstbit) 85 | R> C, \ Store direct address. 86 | ENDOF \ LDBT etc. 87 | ENDCASE 88 | THEN NOINSTR ; 89 | 90 | 91 | : LABEL A; HERE CONSTANT ; 92 | 93 | 94 | HEX 95 | 96 | : # \ Signal immediate mode. 97 | MODE OFF -10 OPCODE +! 98 | ?OPERAND @ 5 = IF \ Special case is LDQ immediate. 99 | 0CD OPCODE ! 100 | THEN 101 | ; 102 | 103 | : USE-POSTBYTE \ Signal that postbyte must be used. 104 | MODE OFF 105 | ?POSTBYTE ON 106 | OPCODE @ 0F0 AND 0= IF 107 | 60 OPCODE +! 108 | ELSE 109 | OPCODE @ 80 AND IF 110 | 10 OPCODE +! 111 | THEN 112 | THEN ; 113 | 114 | : [] \ Signal indirect mode. 115 | MODE @ IF \ Indirect addressing with 16-bits addres, no postbyte made yet. 116 | USE-POSTBYTE 117 | 9F POSTBYTE ! \ Make postbyte. 118 | 2 ?OPERAND ! \ Indicate 16-bits address. 119 | ELSE 120 | POSTBYTE @ 80 AND 0= IF \ 5-bits address format already assembled? 121 | POSTBYTE @ 1F AND DUP 10 AND 0<> 0E0 AND OR 122 | 1 ?OPERAND ! \ Signal operand. 123 | POSTBYTE @ 60 AND 98 OR POSTBYTE ! \ Change postbyte. 124 | ELSE 125 | POSTBYTE @ 9F AND 8F = 126 | IF 127 | POSTBYTE @ 1+ POSTBYTE ! \ special case for ,W indexing 128 | ELSE 129 | POSTBYTE @ 10 OR POSTBYTE ! \ Indicate indirect addressing. 130 | THEN 131 | THEN 132 | THEN ; 133 | 134 | : ,R \ Modes with a constant offset from a register. 135 | CREATE C, 136 | DOES> USE-POSTBYTE 137 | C@ POSTBYTE ! \ Make register field in postbyte. 138 | DUP 0= IF 139 | 84 POSTBYTE +! DROP \ Zero offset. 140 | ?OPERAND OFF 141 | ELSE 142 | DUP -10 >= OVER 0F <= AND IF \ 5-bit offset. 143 | 1F AND POSTBYTE +! 144 | ?OPERAND OFF 145 | ELSE 146 | DUP 80 + 100 U< IF \ 8-bit offset. 147 | 88 POSTBYTE +! 148 | 1 ?OPERAND ! 149 | ELSE 150 | 89 POSTBYTE +! \ 16-bit offset. 151 | 2 ?OPERAND ! 152 | THEN 153 | THEN 154 | THEN ; 155 | 00 ,R ,X 156 | 20 ,R ,Y 157 | 40 ,R ,U 158 | 60 ,R ,S 159 | 160 | : ,W \ Addressing with constant offset from W register. 161 | USE-POSTBYTE 162 | DUP 0= IF 163 | 8F POSTBYTE ! DROP \ offset = 0 164 | ?OPERAND OFF 165 | ELSE 166 | 0AF POSTBYTE ! \ 16-bit offset 167 | 2 ?OPERAND ! 168 | THEN 169 | ; 170 | 171 | : AMODE \ addressing modes with no operands. 172 | CREATE C, 173 | DOES> USE-POSTBYTE 174 | C@ POSTBYTE ! 175 | ?OPERAND OFF ; 176 | 080 AMODE ,X+ 081 AMODE ,X++ 082 AMODE ,-X 083 AMODE ,--X 177 | 085 AMODE B,X 086 AMODE A,X 08B AMODE D,X 178 | 087 AMODE E,X 08A AMODE F,X 08E AMODE W,X 179 | 0A0 AMODE ,Y+ 0A1 AMODE ,Y++ 0A2 AMODE ,-Y 0A3 AMODE ,--Y 180 | 0A5 AMODE B,Y 0A6 AMODE A,Y 0AB AMODE D,Y 181 | 0A7 AMODE E,Y 0AA AMODE F,Y 0AE AMODE W,Y 182 | 0C0 AMODE ,U+ 0C1 AMODE ,U++ 0C2 AMODE ,-U 0C3 AMODE ,--U 183 | 0C5 AMODE B,U 0C6 AMODE A,U 0CB AMODE D,U 184 | 0C7 AMODE E,U 0CA AMODE F,U 0CE AMODE W,U 185 | 0E0 AMODE ,S+ 0E1 AMODE ,S++ 0E2 AMODE ,-S 0E3 AMODE ,--S 186 | 0E5 AMODE B,S 0E6 AMODE A,S 0EB AMODE D,S 187 | 0E7 AMODE E,S 0EA AMODE F,S 0EE AMODE W,S 188 | 0CF AMODE ,W++ 0EF AMODE ,--W 189 | 190 | : ,PCR \ Signal program counter relative. 191 | USE-POSTBYTE 192 | DUP 193 | HERE OPCODE @ 0FF U> - 3 + - \ Subtract address after instruction 194 | 80 + 100 U< IF \ 8-bits offset good? 195 | 3 ?OPERAND ! 196 | 8C POSTBYTE ! 197 | ELSE 198 | 4 ?OPERAND ! 199 | 8D POSTBYTE ! 200 | THEN ; 201 | 202 | : USE-OPCODE ( w ---) 203 | ?OPCODE ON 204 | OPCODE ! ; 205 | 206 | : GET-OPCODE ( addr -- )\ 207 | >R A; R> @ USE-OPCODE ; 208 | 209 | : IN1 \ Simple instructions with only opcode, possibly prebyte 210 | CREATE , 211 | DOES> GET-OPCODE ; 212 | 12 IN1 NOP 13 IN1 SYNC 213 | 14 IN1 SEXW 214 | 19 IN1 DAA 1D IN1 SEX 215 | 39 IN1 RTS 3A IN1 ABX 216 | 3B IN1 RTI 3D IN1 MUL 217 | 1038 IN1 PSHSW 1039 IN1 PULSW 218 | 103A IN1 PSHUW 103B IN1 PULUW 219 | 3F IN1 SWI 103F IN1 SWI2 113F IN1 SWI3 220 | 40 IN1 NEGA 50 IN1 NEGB 221 | 43 IN1 COMA 53 IN1 COMB 222 | 44 IN1 LSRA 54 IN1 LSRB 223 | 46 IN1 RORA 56 IN1 RORB 224 | 47 IN1 ASRA 57 IN1 ASRB 225 | 48 IN1 ASLA 58 IN1 ASLB 226 | 48 IN1 LSLA 58 IN1 LSLB 227 | 49 IN1 ROLA 59 IN1 ROLB 228 | 4A IN1 DECA 5A IN1 DECB 229 | 4C IN1 INCA 5C IN1 INCB 230 | 4D IN1 TSTA 5D IN1 TSTB 231 | 4F IN1 CLRA 5F IN1 CLRB 232 | 1040 IN1 NEGD 1050 IN1 NEGW 233 | 1043 IN1 COMD 1051 IN1 COMW 234 | 1044 IN1 LSRD 1054 IN1 LSRW 235 | 1046 IN1 RORD 1056 IN1 RORW 236 | 1047 IN1 ASRD \ what were they smoking when they decided to leave out ASRW/ASLW 237 | 1048 IN1 ASLD 238 | 1048 IN1 LSRD 239 | 1049 IN1 ROLD 1059 IN1 ROLW 240 | 104A IN1 DECD 105A IN1 DECW 241 | 104C IN1 INCD 105C IN1 INCW 242 | 104D IN1 TSTD 105D IN1 TSTW 243 | 104F IN1 CLRD 105F IN1 CLRW 244 | 1143 IN1 COME 1153 IN1 COMF 245 | 114A IN1 DECE 115A IN1 DECF 246 | 114C IN1 INCE 115C IN1 INCF 247 | 114D IN1 TSTE 115D IN1 TSTF 248 | 114F IN1 CLRE 115F IN1 CLRF 249 | 250 | \ Though not no-operand instructions the LEA instructions 251 | \ are treated correctly as the postbyte is added by the mode words. 252 | 30 IN1 LEAX 31 IN1 LEAY 253 | 32 IN1 LEAS 33 IN1 LEAU 254 | 255 | : BR-8 \ relative branches with 8-bit offset 256 | CREATE , 257 | DOES> GET-OPCODE 3 ?OPERAND ! ; 258 | 20 BR-8 BRA 21 BR-8 BRN 259 | 22 BR-8 BHI 23 BR-8 BLS 260 | 24 BR-8 BCC 25 BR-8 BCS 261 | 24 BR-8 BHS 25 BR-8 BLO 262 | 26 BR-8 BNE 27 BR-8 BEQ 263 | 28 BR-8 BVC 29 BR-8 BVS 264 | 2A BR-8 BPL 2B BR-8 BMI 265 | 2C BR-8 BGE 2D BR-8 BLT 266 | 2E BR-8 BGT 2F BR-8 BLE 267 | 8D BR-8 BSR 268 | 269 | : LBRA 270 | A; 16 USE-OPCODE 4 ?OPERAND ! ; 271 | : LBSR 272 | A; 17 USE-OPCODE 4 ?OPERAND ! ; 273 | 274 | : BR16 \ Relative branches with 16-bit offset. 275 | CREATE , 276 | DOES> GET-OPCODE 4 ?OPERAND ! ; 277 | 1021 BR16 LBRN 278 | 1022 BR16 LBHI 1023 BR16 LBLS 279 | 1024 BR16 LBCC 1025 BR16 LBCS 280 | 1024 BR16 LBHS 1025 BR16 LBLO 281 | 1026 BR16 LBNE 1027 BR16 LBEQ 282 | 1028 BR16 LBVC 1029 BR16 LBVS 283 | 102A BR16 LBPL 102B BR16 LBMI 284 | 102C BR16 LBGE 102D BR16 LBLT 285 | 102E BR16 LBGT 102F BR16 LBLE 286 | 287 | : IN2 \ Instructions with one immediate data byte. 288 | CREATE , 289 | DOES> GET-OPCODE 1 ?OPERAND ! ; 290 | 1A IN2 ORCC 1C IN2 ANDCC 3C IN2 CWAI 291 | 113C IN2 BITMD 113D IN2 LDMD 292 | : % ( --- n) \ Interpret next word as a binary number. 293 | BASE @ 2 BASE ! BL WORD NUMBER? drop DROP SWAP BASE ! ; 294 | 295 | : REG \ Registers as used in PUSH PULL TFR and EXG instructions. 296 | CREATE C, C, 297 | DOES> ?OPERAND @ IF \ Is a PUSH/PULL instruction meant? 298 | 1+ C@ OR 299 | ELSE 300 | C@ POSTBYTE +! \ It's a TFR,EXG instruction. 301 | THEN ; 302 | 06 00 REG D, 06 00 REG D 303 | 10 10 REG X, 10 01 REG X 304 | 20 20 REG Y, 20 02 REG Y 305 | 40 30 REG U, 40 03 REG U 306 | 40 40 REG S, 40 04 REG S 307 | 80 50 REG PC, 80 05 REG PC 308 | 00 60 REG W, 00 06 REG W 309 | 00 70 REG V, 00 07 REG V 310 | 02 80 REG A, 02 08 REG A 311 | 04 90 REG B, 04 09 REG B 312 | 01 A0 REG CC, 01 0A REG CC 313 | 08 B0 REG DP, 08 0B REG DP 314 | 00 C0 REG Z, 08 0C REG Z \ Zero register. 315 | 00 E0 REG E, 00 0E REG E 316 | 00 F0 REG F, 00 0F REG F 317 | 318 | : R2R \ Reg to reg instructions 319 | CREATE , DOES> GET-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; 320 | 1E R2R EXG 321 | 1F R2R TFR 322 | 1030 R2R ADDR 323 | 1031 R2R ADCR 324 | 1032 R2R SUBR 325 | 1033 R2R SBCR 326 | 1034 R2R ANDR 327 | 1035 R2R ORR 328 | 1036 R2R EORR 329 | 1037 R2R CMPR 330 | 331 | 1138 R2R TFM++ \ TFM++ X, Y for tfm x+,y+ 332 | 1139 R2R TFM-- \ TFM-- X, Y for tfm x-,y- 333 | 113A R2R TFM+0 \ TFM+0 X, Y for tfm x+,y 334 | 113B R2R TFM0+ \ TFM0+ X, Y for tfm x,y+ 335 | 336 | 337 | : STK \ Stack instructions. 338 | CREATE , 339 | DOES> GET-OPCODE 340 | 1 ?OPERAND ! 0 ; 341 | 34 STK PSHS 35 STK PULS 342 | 36 STK PSHU 37 STK PULU 343 | 344 | : OP-8 \ Instructions with 8-bits data. 345 | CREATE , 346 | DOES> GET-OPCODE 347 | MODE ON 348 | 1 ?OPERAND ! ; 349 | 00 OP-8 NEG 03 OP-8 COM 350 | 04 OP-8 LSR 06 OP-8 ROR 351 | 07 OP-8 ASR 08 OP-8 ASL 352 | 08 OP-8 LSL 09 OP-8 ROL 353 | 0A OP-8 DEC 0C OP-8 INC 354 | 0D OP-8 TST 0E OP-8 JMP 355 | 0F OP-8 CLR 356 | 90 OP-8 SUBA 0D0 OP-8 SUBB 357 | 91 OP-8 CMPA 0D1 OP-8 CMPB 358 | 92 OP-8 SBCA 0D2 OP-8 SBCB 359 | 94 OP-8 ANDA 0D4 OP-8 ANDB 360 | 95 OP-8 BITA 0D5 OP-8 BITB 361 | 96 OP-8 LDA 0D6 OP-8 LDB 362 | 97 OP-8 STA 0D7 OP-8 STB 363 | 98 OP-8 EORA 0D8 OP-8 EORB 364 | 99 OP-8 ADCA 0D9 OP-8 ADCB 365 | 9A OP-8 ORA 0DA OP-8 ORB 366 | 9B OP-8 ADDA 0DB OP-8 ADDB 367 | 9D OP-8 JSR 368 | 1190 OP-8 SUBE 11D0 OP-8 SUBF 369 | 1191 OP-8 CMPE 11D1 OP-8 CMPF 370 | 1196 OP-8 LDE 11D6 OP-8 LDF 371 | 1197 OP-8 STE 11D7 OP-8 STF 372 | 119B OP-8 ADDE 11DB OP-8 ADDF 373 | 119D OP-8 DIVD 374 | 375 | : OP16 \ Instructions with 16-bits daia. 376 | CREATE , 377 | DOES> GET-OPCODE 378 | MODE ON 379 | 2 ?OPERAND ! ; 380 | 93 OP16 SUBD 0D3 OP16 ADDD 381 | 9C OP16 CMPX 0DC OP16 LDD 0DD OP16 STD 382 | 9E OP16 LDX 0DE OP16 LDU 383 | 9F OP16 STX 0DF OP16 STU 384 | 1090 OP16 SUBW 1091 OP16 CMPW 385 | 1092 OP16 SBCD 1093 OP16 CMPD 386 | 1094 OP16 ANDD 1095 OP16 BITD 387 | 1096 OP16 LDW 1097 OP16 STW 388 | 1098 OP16 EORD 1099 OP16 ADCD 389 | 109A OP16 ORD 109B OP16 ADDW 390 | 109C OP16 CMPY 391 | 109E OP16 LDY 109F OP16 STY 392 | 10DE OP16 LDS 10DF OP16 STS 393 | 1193 OP16 CMPU 119C OP16 CMPS 394 | 119E OP16 DIVQ 119F OP16 MULD 395 | 396 | : OP32 \ Instructions with 32-bits daia. 397 | CREATE , 398 | DOES> GET-OPCODE 399 | MODE ON 400 | 5 ?OPERAND ! ; 401 | 10DC OP32 LDQ 10DD OP32 STQ 402 | 403 | : OP-MEMIMM \ Instructions with memory addressing and 8-bit immediate 404 | CREATE , 405 | DOES> GET-OPCODE 406 | MODE ON ?MEMIMM ON 407 | 1 ?OPERAND ! ; 408 | 01 OP-MEMIMM OIM 409 | 02 OP-MEMIMM AIM 410 | 05 OP-MEMIMM EIM 411 | 0B OP-MEMIMM TIM 412 | 413 | : OP-BIT \ Instructions for single bit in A,B,CC register and direct page. 414 | CREATE , 415 | DOES> GET-OPCODE 416 | 6 ?OPERAND ! 0 ; 417 | 1130 OP-BIT BAND 418 | 1131 OP-BIT BIAND 419 | 1132 OP-BIT BOR 420 | 1133 OP-BIT BIOR 421 | 1134 OP-BIT BEOR 422 | 1135 OP-BIT BIEOR 423 | 1136 OP-BIT LDBT 424 | 1137 OP-BIT STBT 425 | 426 | \ Structured assembler constructs. 427 | : IF >R A; R> C, >MARK ; 428 | : THEN A; >RESOLVE ; 429 | : ELSE A; 20 C, >MARK SWAP >RESOLVE ; 430 | : BEGIN A; R A; R> C, R A; R> C, >MARK ; 433 | : REPEAT A; 20 C, SWAP RESOLVE ; 434 | : AGAIN 20 UNTIL ; 435 | 22 CONSTANT U<= 23 CONSTANT U> 436 | 24 CONSTANT U< 25 CONSTANT U>= 437 | 26 CONSTANT 0= 27 CONSTANT 0<> 438 | 28 CONSTANT VS 29 CONSTANT VC 439 | 2A CONSTANT 0< 2B CONSTANT 0>= 440 | 2C CONSTANT < 2D CONSTANT >= 441 | 2E CONSTANT <= 2F CONSTANT > 442 | 443 | : ENDASM \ End assembly. 444 | A; PREVIOUS ; 445 | FORTH DEFINITIONS 446 | : ASSEMBLE \ Start assembly. 447 | ALSO ASSEMBLER NOINSTR ; 448 | 449 | : CODE CREATE -3 ALLOT ASSEMBLE ; 450 | : END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; 451 | 452 | PREVIOUS FORTH DEFINITIONS 453 | 454 | BASE ! \ Restore the original base. 455 | -------------------------------------------------------------------------------- /examples_forth/cross09.4: -------------------------------------------------------------------------------- 1 | \ 6809 meta compiler to be run from an ANSI standard FORTH system 2 | \ that contains the FILE wordset. 3 | 4 | \ We need the word VOCABULARY. It's not in the standard though it will 5 | \ be in most actual implementations. 6 | : VOCABULARY WORDLIST CREATE , \ Make a new wordlist and store it in def. 7 | DOES> >R \ Replace last item in the search order. 8 | GET-ORDER SWAP DROP R> @ SWAP SET-ORDER ; 9 | 10 | .( Loading the assembler "asm09.4") CR 11 | S" asm09.4" INCLUDED 12 | 13 | .( Loading the meta compiler "meta09.4") CR 14 | S" meta09.4" INCLUDED 15 | 16 | .( Compiling the kernel from "kernel09.4") CR 17 | S" kernel09.4" INCLUDED 18 | 19 | \ Save the binary image of the Forth system as Motorola S records. 20 | 21 | DECIMAL 22 | VARIABLE CHKSUM 23 | CREATE SBUF 42 CHARS ALLOT 24 | CHAR S SBUF C! 25 | CHAR 1 SBUF CHAR+ C! 26 | VARIABLE BYTECOUNT 27 | VARIABLE ADDR 28 | VARIABLE FILEHAND 29 | : TOHEX ( byte addr ---) \ Conert byte to two-digit hex at addr 30 | BASE @ >R HEX SWAP 0 <# # # #> DROP SWAP 2 CHARS CMOVE R> BASE ! ; 31 | : FLUSHHEX \ Store the S-record buffer in a file 32 | BYTECOUNT @ IF 33 | BYTECOUNT @ 3 + DUP CHKSUM +! SBUF 2 CHARS + TOHEX 34 | ADDR @ 8 RSHIFT 255 AND DUP CHKSUM +! SBUF 4 CHARS + TOHEX 35 | ADDR @ 255 AND DUP CHKSUM +! SBUF 6 CHARS + TOHEX 36 | 255 CHKSUM @ 255 AND - SBUF 8 BYTECOUNT @ 2* + CHARS + TOHEX 37 | SBUF 10 BYTECOUNT @ 2* + FILEHAND @ WRITE-LINE THROW 38 | THEN BYTECOUNT @ ADDR +! 0 BYTECOUNT ! 0 CHKSUM ! ; 39 | : PUTHEX ( byte ---) \ Store the byte in the S-record buffer 40 | BYTECOUNT @ 16 = IF FLUSHHEX THEN 41 | DUP CHKSUM +! SBUF 8 BYTECOUNT @ 2* + CHARS + TOHEX 42 | 1 BYTECOUNT +! 43 | ; 44 | : SAVE-IMAGE ( --- ) 45 | S" kernel09" W/O CREATE-FILE THROW FILEHAND ! 46 | 0 CHKSUM ! 0 BYTECOUNT ! ORIGIN ADDR ! 47 | THERE ORIGIN - 0 DO IMAGE I + C@ PUTHEX LOOP FLUSHHEX 48 | S" S9030000FC" FILEHAND @ WRITE-LINE THROW 49 | FILEHAND @ CLOSE-FILE THROW 50 | ; 51 | SAVE-IMAGE 52 | .( Image saved as "kernel09") CR 53 | 54 | BYE 55 | -------------------------------------------------------------------------------- /examples_forth/extend09.4: -------------------------------------------------------------------------------- 1 | \ Extensions to sod Forth kernel to make a complete Forth system. 2 | \ created 1994 by L.C. Benschop. 3 | \ copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 4 | \ license: GNU General Public License version 2, see LICENSE for more details. 5 | 6 | : \G POSTPONE \ ; IMMEDIATE 7 | \G comment till end of line for inclusion in glossary. 8 | 9 | \ PART 1: MISCELLANEOUS WORDS. 10 | 11 | : COMPARE ( addr1 u1 addr2 u2 --- diff ) 12 | \G Compare two strings. diff is negative if addr1 u1 is smaller, 0 if it 13 | \G is equal and positive if it is greater than addr2 u2. 14 | ROT 2DUP - >R 15 | MIN DUP IF 16 | >R 17 | BEGIN 18 | OVER C@ OVER C@ - IF 19 | SWAP C@ SWAP C@ - R> DROP R> DROP EXIT 20 | THEN 21 | 1+ SWAP 1+ SWAP 22 | R> 1- DUP >R 0= 23 | UNTIL R> 24 | THEN DROP 25 | DROP DROP R> NEGATE 26 | ; 27 | 28 | : ERASE 0 FILL ; 29 | 30 | : <= ( n1 n2 --- f) 31 | \G f is true if and only if n1 is less than or equal to n2. 32 | > 0= ; 33 | 34 | : 0<= ( n1 --- f) 35 | \G f is true if and only if n1 is less than zero. 36 | 0 <= ; 37 | 38 | : >= 39 | < 0= ; 40 | 41 | : 0<> 42 | 0= 0= ; 43 | 44 | : BOUNDS ( addr1 n --- addr2 addr1) 45 | \G Convert address and length to two bounds addresses for DO LOOP 46 | OVER + SWAP ; 47 | 48 | : WITHIN ( u1 u2 u3 --- f) 49 | \G f is true if u1 is greater or equal to u2 and less than u3 50 | 2 PICK U> ROT ROT U< 0= AND ; 51 | 52 | : -TRAILING ( c-addr1 u1 --- c-addr2 u2) 53 | \G Adjust the length of the string such that trailing spaces are excluded. 54 | BEGIN 55 | 2DUP + 1- C@ BL = 56 | WHILE 57 | 1- 58 | REPEAT 59 | ; 60 | 61 | : NIP ( x1 x2 --- x2) 62 | \G Discard the second item on the stack. 63 | SWAP DROP ; 64 | 65 | \ PART 2: SEARCH ORDER WORDLIST 66 | 67 | : GET-ORDER ( --- w1 w2 ... wn n ) 68 | \G Return all wordlists in the search order, followed by the count. 69 | #ORDER @ 0 ?DO CONTEXT I CELLS + @ LOOP #ORDER @ ; 70 | 71 | : SET-ORDER ( w1 w2 ... wn n --- ) 72 | \G Set the search order to the n wordlists given on the stack. 73 | #ORDER ! 0 #ORDER @ 1- DO CONTEXT I CELLS + ! -1 +LOOP ; 74 | 75 | : ALSO ( --- ) 76 | \G Duplicate the last wordlist in the search order. 77 | CONTEXT #ORDER @ CELLS + DUP CELL- @ SWAP ! 1 #ORDER +! ; 78 | 79 | : PREVIOUS ( --- ) 80 | \G Remove the last wordlist from search order. 81 | -1 #ORDER +! ; 82 | 83 | VARIABLE #THREADS ( --- a-addr) 84 | \G This variable holds the number of threads a word list will have. 85 | 86 | : WORDLIST ( --- wid) 87 | \G Make a new wordlist and give its address. 88 | HERE #THREADS @ , #THREADS @ CELLS ALLOT HERE #THREADS @ CELLS - 89 | #THREADS @ CELLS ERASE ; 90 | 91 | : DEFINITIONS ( --- ) 92 | \G Set the definitions wordlist to the last wordlist in the search order. 93 | CONTEXT #ORDER @ 1- CELLS + @ CURRENT ! ; 94 | 95 | : FORTH ( --- ) 96 | \G REplace the last wordlist in the search order with FORTH-WORDLIST 97 | FORTH-WORDLIST CONTEXT #ORDER @ 1- CELLS + ! ; 98 | 99 | 1 #THREADS ! 100 | WORDLIST 101 | CONSTANT ROOT-WORDLIST ( --- wid ) 102 | \G Minimal wordlist for ONLY 103 | 104 | 4 #THREADS ! 105 | 106 | : ONLY ( --- ) 107 | \G Set the search order to the minimal wordlist. 108 | 1 #ORDER ! ROOT-WORDLIST CONTEXT ! ; 109 | 110 | : VOCABULARY ( --- ) 111 | \G Make a definition that will replace the last word in the search order 112 | \G by its wordlist. 113 | WORDLIST CREATE , \ Make a new wordlist and store it in def. 114 | DOES> >R \ Replace last item in the search order. 115 | GET-ORDER SWAP DROP R> @ SWAP SET-ORDER ; 116 | 117 | 118 | \ PART 3: SOME UTILITIES, DUMP .S WORDS 119 | 120 | : DL ( addr1 --- addr2 ) 121 | \G hex/ascii dump in one line of 16 bytes at addr1 addr2 is addr1+16 122 | BASE @ >R 16 BASE ! CR 123 | DUP 0 <# # # # # #> TYPE ." : " 124 | 16 0 DO 125 | DUP I + C@ 0 <# # # #> TYPE SPACE 126 | LOOP 127 | 16 0 DO 128 | DUP I + C@ DUP 127 AND 31 < IF DROP ." ." ELSE EMIT THEN 129 | LOOP 130 | 16 + R> BASE ! ; 131 | 132 | 133 | : DUMP ( addr len --- ) 134 | \G Show a hex/ascii dump of the memory block of len bytes at addr 135 | 15 + 4 RSHIFT 0 DO 136 | DL 137 | LOOP DROP ; 138 | 139 | : .S ( --- ) 140 | \G Show the contents of the stack. 141 | DEPTH IF 142 | 0 DEPTH 2 - DO I PICK . -1 +LOOP 143 | ELSE ." Empty " THEN ; 144 | 145 | 146 | : ID. ( nfa --- ) 147 | \G Show the name of the word with name field address nfa. 148 | COUNT 31 AND TYPE SPACE ; 149 | 150 | : WORDS ( --- ) 151 | \G Show all words in the last wordlist of the search order. 152 | CONTEXT #ORDER @ 1- CELLS + @ 153 | DUP @ >R \ number of threads to return stack. 154 | CELL+ R@ 0 DO DUP I CELLS + @ SWAP LOOP DROP \ All thread pointers to stack. 155 | BEGIN 156 | 0 0 157 | R@ 0 DO 158 | I 2 + PICK OVER U> IF 159 | DROP DROP I I 1 + PICK 160 | THEN 161 | LOOP \ Find the thread pointer with the highest address. 162 | WHILE 163 | DUP 1+ PICK DUP ID. \ Print the name. 164 | CELL- @ \ Link to previous. 165 | SWAP 2 + CELLS SP@ + ! \ Update the right thread pointer. 166 | REPEAT 167 | DROP R> 0 DO DROP LOOP \ Drop the thread pointers. 168 | ; 169 | 170 | 171 | ROOT-WORDLIST CURRENT ! 172 | : FORTH FORTH ; 173 | : ALSO ALSO ; 174 | : ONLY ONLY ; 175 | : PREVIOUS PREVIOUS ; 176 | : DEFINITIONS DEFINITIONS ; 177 | : WORDS WORDS ; 178 | DEFINITIONS 179 | \ Fill the ROOT wordlist. 180 | 181 | \ PART 4: ERROR MESSAGES 182 | 183 | : MESS" ( n "cccq" --- ) 184 | \G Create an error message for throw code n. 185 | ALIGN , ERRORS @ , HERE 2 CELLS - ERRORS ! 34 WORD C@ 1+ ALLOT ; 186 | 187 | -3 MESS" Stack overflow" 188 | -4 MESS" Stack underflow" 189 | -10 MESS" Divide overflow" 190 | -13 MESS" Undefined word" 191 | -22 MESS" Incomplete control structure" 192 | -28 MESS" BREAK key pressed" 193 | -37 MESS" File I/O error" 194 | -38 MESS" File does not exist" 195 | 196 | : 2CONSTANT ( d --- ) 197 | \G Create a new definition that has the following runtime behavior. 198 | \G Runtime: ( --- d) push the constant double number on the stack. 199 | CREATE HERE 2! 2 CELLS ALLOT DOES> 2@ ; 200 | 201 | : D.R ( d n --- ) 202 | \G Print double number d right-justified in a field of width n. 203 | >R SWAP OVER DABS <# #S ROT SIGN #> R> OVER - 0 MAX SPACES TYPE ; 204 | 205 | : U.R ( u n --- ) 206 | \G Print unsigned number u right-justified in a field of width n. 207 | >R 0 R> D.R ; 208 | 209 | : .R ( n1 n2 --- ) 210 | \G Print number n1 right-justified in a field of width n2. 211 | >R S>D R> D.R ; 212 | 213 | : AT-XY ( x y --- ) 214 | \G Put screen cursor at location (x,y) (0,0) is upper left corner. 215 | 27 EMIT [CHAR] [ EMIT SWAP 1+ SWAP 0 .R [CHAR] ; EMIT 216 | 1+ 0 .R [CHAR] H EMIT ; 217 | 218 | : PAGE 219 | \G Clear the screen. 220 | 27 EMIT ." [2J" 0 0 AT-XY ; 221 | 222 | : VALUE ( n --- ) 223 | CREATE , DOES> @ ; 224 | 225 | : TO 226 | ' >BODY STATE @ IF 227 | POSTPONE LITERAL POSTPONE ! 228 | ELSE 229 | ! 230 | THEN 231 | ; IMMEDIATE 232 | 233 | : D- ( d1 d2 --- d3) 234 | DNEGATE D+ ; 235 | 236 | : D0= 237 | OR 0= ; 238 | 239 | : D= 240 | D- D0= ; 241 | 242 | : BLANK 243 | 32 FILL ; 244 | 245 | : AGAIN 246 | POSTPONE 0 POSTPONE UNTIL ; IMMEDIATE 247 | 248 | : CASE 249 | CSP @ SP@ CSP ! ; IMMEDIATE 250 | : OF 251 | POSTPONE OVER POSTPONE = POSTPONE IF POSTPONE DROP ; IMMEDIATE 252 | : ENDOF 253 | POSTPONE ELSE ; IMMEDIATE 254 | : ENDCASE 255 | POSTPONE DROP BEGIN SP@ CSP @ - WHILE POSTPONE THEN REPEAT 256 | CSP ! ; IMMEDIATE 257 | 258 | 259 | : MS ( n --- ) 260 | \G Delay for n milliseconds. 261 | 5 + 20 / $2B @ + BEGIN DUP $2B @ = UNTIL DROP ; 262 | 263 | CAPS ON 264 | 265 | -------------------------------------------------------------------------------- /examples_forth/forthload.asm: -------------------------------------------------------------------------------- 1 | * Load Forth into RAM. 2 | org $8000 3 | ldy #$8020 4 | ldu #$0400 5 | ldx #$3741 6 | movloop lda ,y+ 7 | sta ,u+ 8 | leax -1,x 9 | bne movloop 10 | jmp $400 11 | -------------------------------------------------------------------------------- /examples_forth/kernel09: -------------------------------------------------------------------------------- 1 | S11304007E1E467E1DF5ECF4EDE43780EFA3EEE1AD 2 | S11304103780AEF16E840000834C4954ECC1EDE3A7 3 | S113042037800000864252414E4348EEC437800074 4 | S113043000873F4252414E4348ECE127EE334237B6 5 | S1130440800431874558454355544539042484452F 6 | S1130450584954EEA13780000086554E4E455354FA 7 | S1130460EEA1378004598428444F29ECE1A3E488A1 8 | S113047080AEE1AFA3EDA33780044385283F444F0A 9 | S113048029ECE110A3E42704334220E13262209BEB 10 | S1130490044E86284C4F4F5029ECA4C30001290672 11 | S11304A0EDA4EEC437803124334237800418872802 12 | S11304B02B4C4F4F5029ECA4E3E120E204AE8728F3 13 | S11304C04C4541564529EEC43124378004668828BA 14 | S11304D03F4C4541564529ECE127EB334237800434 15 | S11304E0BE8149ECA48880E322EDE3378004CE8208 16 | S11304F04927EC22EDE33780047B814AEC24888091 17 | S1130500E326EDE3378004EF86554E4C4F4F5031D0 18 | S11305102437800492825240ECA4EDE33780051521 19 | S1130520823E52ECE1EDA33780052082523EECA1DD 20 | S1130530EDE3378004E183525040342037800536A0 21 | S1130540835250213520378004FA835350401F4092 22 | S1130550EDE33780054A83535021ECE11F043780D3 23 | S1130560055683554D2A327CA667E6653DED62A6A5 24 | S113057067E6643DEB628900ED61A666E6653DE3EE 25 | S113058061ED6186008900A7E4A666E6643DE3E4C4 26 | S1130590ED64EC62ED6632643780050886554D2FB4 27 | S11305A04D4F44327F8610A7E468666965696469C3 28 | S11305B063EC632408A361ED636C662008A36125E2 29 | S11305C004ED636C666AE426E03263EC62AEE4AF89 30 | S11305D062EDE437800540812BECE1E3E4EDE437A0 31 | S11305E08005D7812DEC62A3E1EDE43780052B86ED 32 | S11305F04E45474154454F5FA3E4EDE4378005621F 33 | S113060083414E44EC62A4E0E4E0EDE43780059CD1 34 | S1130610824F52EC62AAE0EAE0EDE4378005E3831E 35 | S1130620584F52EC62A8E0E8E0EDE437800610820F 36 | S1130630312B6C6126026CE43780062F82312DEC5D 37 | S1130640E4830001EDE4378005EF82322BECE4C350 38 | S11306500002EDE43780064A82322DECE483000286 39 | S1130660EDE43780065882322AECE45849EDE43749 40 | S113067080066682322FECE44756EDE43780067339 41 | S113068082442BEC66E362ED66EC64E961A9E4ED77 42 | S11306906432643780061F87444E45474154454FB2 43 | S11306A05FA362ED62CC0000E261A2E4EDE4378076 44 | S11306B00680864C534849465435065D27076861D1 45 | S11306C069E45A26F9378006B2865253484946549B 46 | S11306D035065D270764E466615A26F93780063CCF 47 | S11306E08444524F5032623780069783445550EC0D 48 | S11306F0E4EDE3378006C98453574150ECE4AE621D 49 | S1130700AFE4ED62378006F7844F564552EC62ED54 50 | S1130710E3378006EB83524F54EC64AEE4EDE4EC33 51 | S113072062AF62ED6437800708842D524F54EC6445 52 | S1130730AE62ED62ECE4AFE4ED643780060085322E 53 | S113074044524F503264378006E08432445550AEF0 54 | S113075062ECE434163780073E853253574150EC3F 55 | S113076066AE62ED62AF66EC64AEE4EDE4AF6437AE 56 | S113077080075985324F564552AE66EC64341637BD 57 | S113078080074A845049434BECE4E3E1ECEBEDE3AE 58 | S11307903780078384524F4C4CECE4327EC3000113 59 | S11307A0EDE4E362C3000330EB3002ECEBED626C8A 60 | S11307B0E4EC1CED836A6126F86AE426F4326437BB 61 | S11307C0800794824340E6F44FEDE4378007738159 62 | S11307D040ECF4EDE4378007C3824321E663E7F499 63 | S11307E03264378007158121EC62EDF4326437807E 64 | S11307F007D9822B2135103506E384ED8437800731 65 | S113080029823240AEE4EC84AE02AFE4EDE33780FB 66 | S11308100801823221AEE4EC62ED84EC64ED023234 67 | S1130820663780301FAFE43780081282303D8E0077 68 | S113083000ECE427EEAFE43780082B82303C8E00D6 69 | S113084000ECE42BDEAFE4378007CF813C8E000060 70 | S1130850EC62A3E12DCDAFE4378007F282553C8EE4 71 | S11308600000EC62A3E125BBAFE4378007E68543D3 72 | S11308704D4F5645AE6410AF6410AE62ECE4270DE4 73 | S11308806CE4A680A7A05A26F96AE426F510AE64A3 74 | S113089032663780085C86434D4F56453EAE641041 75 | S11308A0AF6410AE62ECE4308B31ABECE4270D6C3A 76 | S11308B0E4A682A7A25A26F96AE426F510AE6432A9 77 | S11308C066378008968446494C4CAE64EC62270D2A 78 | S11308D06C62A661A7805A26FB6A6226F7326637E5 79 | S11308E080083B862846494E4429AEE42750EFE46D 80 | S11308F0EE6210AF6234401F12A680841FA1C0268E 81 | S11309002C4AE680E1C027F94C262232621F2110CE 82 | S1130910AE62EEE4A68484402605CCFFFF2003CC1F 83 | S11309200001EDE4E680C41F3AAF623780EEE4AE26 84 | S11309303E26C4326210AE62EF62EEE4AFE437806A 85 | S113094008E384534B4950EFA33506351035403046 86 | S1130950842712E1C0270A335F34403410EEA137F4 87 | S113096080301F26EE34403410EEA13780094284D3 88 | S11309705343414EEFA335063510354030842712DA 89 | S1130980E1C0260A335F34403410EEA13780301FB3 90 | S113099026EE34403410EEA13780084B834B455982 91 | S11309A09D004FEDE33780096F84454D4954ECE1D8 92 | S11309B09D03378009A9844B45593F9D0F1D34067B 93 | S11309C03780086E834259457EE400378008C5822B 94 | S11309D043529D0C378009C487584F50454E494EA9 95 | S11309E09D12378009CF885841424F5254494E34A2 96 | S11309F0609D183560378009E6844E4F4F50BD0422 97 | S1130A000C0460099C8130BD0406000009D88131C2 98 | S1130A10BD040600010A058132BD0406000209F97D 99 | S1130A20822D31BD0406FFFF0A0E813DBD040C0575 100 | S1130A30E5082E046009B6823C3EBD040C0A2C086D 101 | S1130A402E04600A17813EBD040C06FC084D0460A8 102 | S1130A500A3782303EBD040C0A070A4704600A20A4 103 | S1130A6082553EBD040C06FC085F04600A60825394 104 | S1130A7030BD040A00000A52825230BD040A00004C 105 | S1130A800A45854445505448BD040C054E0A710777 106 | S1130A90D106FC05E5067604600A2A85434F554EC7 107 | S1130AA054BD040C06EF0A1005D906FC07C6046001 108 | S1130AB00A6E8454595045BD040C06EF04390AD813 109 | S1130AC00A07046B06EF04E305D907C609AE0499C7 110 | S1130AD00AC406E5042B0ADC06E506E504600A827E 111 | S1130AE087414C49474E4544BD040C04600AB28416 112 | S1130AF0282E2229BD040C052E0AA1070D070D0A74 113 | S1130B00B705D90AE8052304600AEF84285322298B 114 | S1130B10BD040C052E0AA1070D070D05D90AE80529 115 | S1130B202304600AE08546414C5345BD0406000099 116 | S1130B300B0B8454525545BD0406FFFF0A788242CC 117 | S1130B404CBD040600200B25834F4646BD040C0A09 118 | S1130B500706FC07E804600B32824F4EBD040C0A02 119 | S1130B602306FC07E804600B5986494E5645525447 120 | S1130B70BD040C0A23062304600A9B8543484152A2 121 | S1130B802BBD040C063204600B7B85434841525351 122 | S1130B90BD040C04600B8A85434841522DBD040CEE 123 | S1130BA0063F04600B978543454C4C2BBD040C0653 124 | S1130BB04D04600BA68543454C4C53BD040C0A10F0 125 | S1130BC006B904600BB58543454C4C2DBD040C0699 126 | S1130BD05B04600B3E843F445550BD040C06EF0497 127 | S1130BE0390BE506EF04600B48834D494EBD040CF8 128 | S1130BF0070D070D0A4704390BFC06FC06E50460E3 129 | S1130C000BE9834D4158BD040C070D070D084D0435 130 | S1130C10390C1506FC06E504600C0283414253BD01 131 | S1130C20040C06EF083E04390C2C05F604600B692D 132 | S1130C308444414253BD040C06EF083E04390C427F 133 | S1130C40069F04600C3086534D2F52454DBD040C55 134 | S1130C50074F06230523070D05230C1F05230C3519 135 | S1130C60052E05A306FC052E083E04390C7005F676 136 | S1130C7006FC052E083E04390C7C05F604600BD5F1 137 | S1130C8086464D2F4D4F44BD040C06EF0523070D3A 138 | S1130C90070D062305230C4D070D052E083E0604FB 139 | S1130CA004390CB006FC051805D906FC0A1005E544 140 | S1130CB0052E06E504600C46824D2ABD040C074F40 141 | S1130CC0062305230C1F06FC0C1F0566052E083E93 142 | S1130CD004390CD6069F04600C1B812ABD040C0544 143 | S1130CE06606E504600CDA852A2F4D4F44BD040CDA 144 | S1130CF005230CBB052E0C8704600C80822A2FBDB3 145 | S1130D00040C0CED06FC06E504600CE783533E443A 146 | S1130D10BD040C06EF083E04600CFC842F4D4F44C8 147 | S1130D20BD040C06FC0D1007190C8704600BC6816A 148 | S1130D302FBD040C0D2006FC06E504600D0C834D4C 149 | S1130D404F44BD040C0D2006E504600CB8863F54E6 150 | S1130D5048524F57BD040C06FC04390D63151104A9 151 | S1130D602B0D6506E504600D4D8442415345BD04D9 152 | S1130D700A00000D1B824450BD040A1E590D2F8326 153 | S1130D80484C44BD040A00000D7F8344504CBD040C 154 | S1130D900A00000D8A87444543494D414CBD040C6B 155 | S1130DA0041C000A0D6E07E804600D95834845583D 156 | S1130DB0BD040C041C00100D6E07E804600DAC8526 157 | S1130DC05350414345BD040C041C002009AE04608B 158 | S1130DD00D6986535041434553BD040C0BDA043965 159 | S1130DE00DEC0A07046B0DC504990DE604600DD2E1 160 | S1130DF08448455245BD040C0D7807D104600DBFED 161 | S1130E0083504144BD040C0D7807D1041C005405E3 162 | S1130E10D904600DF0864D552F4D4F44BD040C058B 163 | S1130E20230A07051805A3052E06FC052305A305BB 164 | S1130E302E04600E1584484F4C44BD040C0A100562 165 | S1130E40F60D8307F50D8307D107DC04600E0081DE 166 | S1130E5023BD040C0D6E07D10E1C071906EF041CEC 167 | S1130E6000090A4704390E6E041C000705D9041C46 168 | S1130E70003005D90E3A04600E35822353BD040CAC 169 | S1130E800E51070D070D0613082E04390E80046059 170 | S1130E900D75845349474EBD040C083E04390EA613 171 | S1130EA0041C002D0E3A04600E92823C23BD040CF7 172 | S1130EB00E040D8307E804600E7A82233EBD040C01 173 | S1130EC006E506E50D8307D10E04070D05E504606C 174 | S1130ED00EAA82442EBD040C06FC070D0C350EAD83 175 | S1130EE00E7D07190E970EBD0AB70DC504600EBA24 176 | S1130EF082552EBD040C0A070ED504600D3E812ECA 177 | S1130F00BD040C0D100ED504600ED2844D4F564511 178 | S1130F10BD040C0523070D070D085F04390F2705D1 179 | S1130F202E089D042B0F2B052E087404600EF086EA 180 | S1130F3041434345505435169D064F340637800EC1 181 | S1130F404F83544942BD040602000F0B84535041A1 182 | S1130F504EBD040A00000F4C8423544942BD040AC8 183 | S1130F6000000F41833E494EBD040A00000EFE837B 184 | S1130F70534944BD040A00000F6F83535243BD0418 185 | S1130F800A00000F588423535243BD040A00000F83 186 | S1130F902F884C4F41444C494E45BD040A00000F74 187 | S1130FA09186455850454354BD040C0F360F5107E4 188 | S1130FB0E804600F64855155455259BD040C0F4532 189 | S1130FC0041C00800F360F5D07E804600FA18653F0 190 | S1130FD04F55524345BD040C0F7E07D10F8A07D1EC 191 | S1130FE004600FB589534F555243452D4944BD0400 192 | S1130FF00C0F7307D104600F8586524546494C4C4B 193 | S1131000BD040C0FEE0A230A2C043910130A07043A 194 | S11310102B102B0FBB0F5D07D10F8A07E80A070FB0 195 | S11310206807E80A230A100F9A07F504600F7A8507 196 | S11310305041525345BD040C05230FD50F6807D109 197 | S113104005E506FC0F6807D105D9052E070D052314 198 | S1131050052306FC05180947070D052E06FC052384 199 | S113106009740439106C0A100F6807F506EF0518A7 200 | S113107005E5052E06FC0719052E05E50F6807F59D 201 | S11310800460102F85504C414345BD040C070D07E7 202 | S11310900D07DC063206FC087404600FF984574F10 203 | S11310A05244BD040C10350DF5108A0DF50B410D9D 204 | S11310B0F50AA105D907DC0460109D84434150530F 205 | S11310C0BD040A00000FCE8A555050455243415387 206 | S11310D0453FBD040C10C007D10DF507C606040436 207 | S11310E03911230DF50AA10A07046B06EF04E30581 208 | S11310F0D907C606EF041C00600A4706FC041C005E 209 | S11311007B084D06040439111D06EF04E305D906D6 210 | S1131110EF07C6041C002005E506FC07DC04991053 211 | S1131120EB06E504600FE4874E414D45425546BD4C 212 | S1131130040A00000000000000000000000000009D 213 | S1131140000000000000000000000000000000009B 214 | S1131150000010BB8E464F5254482D574F52444CFA 215 | S1131160495354BD040A00041CE61DD51E411C113C 216 | S113117010C7844C415354BD040A000010848743B3 217 | S11311804F4E54455854BD040A00000000000000AE 218 | S1131190000000000000000000000000000000004B 219 | S11311A000000000000000117286234F5244455293 220 | S11311B0BD040A0000117E8743555252454E54BD6A 221 | S11311C0040A000011A98448415348BD040C0523B6 222 | S11311D0070D07C60A1006B9070D0A100A47043995 223 | S11311E011F207190B8107C60A1906B90623042B45 224 | S11311F011F6071906E50623052E063F06040460CA 225 | S113120011C6884E414D453E425546BD040C112F32 226 | S1131210041C00200A0708CA041C00200BED112F2F 227 | S1131220108A046011B78F5345415243482D574FDC 228 | S113123052444C495354BD040C07190719120B119D 229 | S11312402F0AA10A19078807D111CB06320BBB0656 230 | S1131250FC05D907D106EF04391271112F06FC08D9 231 | S1131260EA06EF082E0439126F06E506E50A0704BC 232 | S11312705306E50A07046012028446494E44BD043D 233 | S11312800C11B007D106EF0A100A47043912AB114A 234 | S11312908611B007D1063F0BBB05D906EF07D1066F 235 | S11312A0FC0BCC07D10A2C042B12AD0A070439120B 236 | S11312B0B3063F06EF043912E5063F052306EF0A9D 237 | S11312C0A105180BBB118605D907D1123606EF0408 238 | S11312D03912DD052E06E5071906E5045306E50572 239 | S11312E02E042B12B3046011548644494749543FD9 240 | S11312F0BD040C041C003005E506EF083E04391358 241 | S11313000706E50A07045306EF041C00090A470709 242 | S11313100D041C0011084D06040439132306E50AC4 243 | S113132007045306EF041C00090A47043913350463 244 | S11313301C000705E506EF0D6E07D1084D082E04C5 245 | S113134039134906E50A0704530A23046011278761 246 | S11313503E4E554D424552BD040C06EF043913A8C8 247 | S11313600A1005E505230AA112F0082E0439137E9C 248 | S1131370052E063206FC0A1005E506FC045306FC9D 249 | S11313800523052306FC0D6E07D1056607190D6EAE 250 | S113139007D10CDC0A0706FC0683052E0A07068320 251 | S11313A0052E052E042B135A0460122687434F4E34 252 | S11313B056455254BD040C0A1005E50A231357067A 253 | S11313C0E50460134F874E554D4245523FBD040C12 254 | S11313D00A230D8E07E80D6E07D105230AA1070D18 255 | S11313E007C6041C002D0A2C06EF0523043913FC40 256 | S11313F00A1005E506FC0A1005D906FC070D07C608 257 | S1131400041C00240A2C0439141E041C00100D6E44 258 | S113141007E80A1005E506FC0A1005D906FC070DC5 259 | S113142007C6041C00230A2C04391440041C000AB7 260 | S11314300D6E07E80A1005E506FC0A1005D906FC3E 261 | S113144006EF0A070A47082E0439145A052E06E542 262 | S1131450052E0D6E07E80A070453052305230A0722 263 | S11314600A07052E052E135706EF043914A0070D9D 264 | S113147007C6041C002E0A2C043914920A1005E530 265 | S113148006EF0D8E07E806FC0A1005D906FC042BAE 266 | S113149014A0052E06E5052E0D6E07E80A07045371 267 | S11314A006EF082E0439146606E506E5052E043910 268 | S11314B014B4069F052E0D6E07E80A230460127902 269 | S11314C0864552524F5224BD040A000013C5874872 270 | S11314D0414E444C4552BD040A000014C0882841C2 271 | S11314E0424F52542229BD040C043914FD052E1414 272 | S11314F0C707E8041CFFFE1511042B1507052E0A67 273 | S1131500A105D90AE80523046013AC855448524F59 274 | S113151057BD040C06EF0439155014D607D104390D 275 | S1131520154A14D607D10544053A041C000405D90C 276 | S113153007D114D607E8052E06FC0523055A06E54F 277 | S1131540052E052E06E5042B154C1DF5042B15520E 278 | S113155006E5046014CE854341544348BD040C148D 279 | S1131560D607D10523054E0523053A14D607E8040A 280 | S11315704B053A041C000405D907D114D607E80525 281 | S11315802E06E5052E06E50A070460155685414C2E 282 | S11315904C4F54BD040C0D7807F50460150B812CD9 283 | S11315A0BD040C0DF507E80A100BBB159304601479 284 | S11315B0DD82432CBD040C0DF507DC0A10159304E1 285 | S11315C060158D85414C49474EBD040C0460159E41 286 | S11315D0853E4E414D45BD040C063F06EF07C6044B 287 | S11315E01C00800604043915D9046015D0854E41C9 288 | S11315F04D453EBD040C0AA1041C001F060405D978 289 | S11316000AE8046012E986484541444552BD040C89 290 | S113161015C90A0715A00DF5117707E8041C002069 291 | S113162010A210D206EF127E043916430AF40C52AB 292 | S113163065646566696E696E673A200DF50AA10AEC 293 | S1131640B709D206E506EF0AA111BF07D107D111E8 294 | S1131650CB06320BBB11BF07D105D907D10DF50B52 295 | S1131660CC07E807C606320DF507C6041C00800542 296 | S1131670D90DF507DC159315C9046015B1844A53D7 297 | S1131680522CBD040C041C00BD15B404601606865F 298 | S113169052455645414CBD040C117707D106EF0A5B 299 | S11316A0A1041C001F060411BF07D107D111CB06EA 300 | S11316B0320BBB11BF07D105D907E80460167D863C 301 | S11316C0435245415445BD040C160D16961682042A 302 | S11316D01C040A15A0046016BF88564152494142B1 303 | S11316E04C45BD040C16C60A0715A00460168F8865 304 | S11316F0434F4E5354414E54BD040C160D169616CA 305 | S113170082041C040615A015A0046015C385535457 306 | S1131710415445BD040A0000170D815DBD040C0A47 307 | S113172010171307E80460171AC15BBD040C0A07FD 308 | S1131730171307E804601729C74C49544552414C14 309 | S1131740BD040C17C2041C15A0046016EF88434F97 310 | S11317504D50494C452CBD040C15A0046015ED8377 311 | S1131760435350BD040A000016D986274C45415600 312 | S113177045BD040A0000174D8421435350BD040C99 313 | S1131780054E176307E804601778843F435350BD40 314 | S1131790040C054E176307D105E5041CFFEA0D543C 315 | S11317A004601738C13BBD040C17C20460172B1723 316 | S11317B08F16960460178A8A28504F5354504F4E00 317 | S11317C04529BD040C052E06EF07D106FC0BAC051C 318 | S11317D02306EF15D607C6041C0040060404391777 319 | S11317E0E7044B042B17E917560460175F813ABDD1 320 | S11317F0040C177D160D1682041C040C15A0171C6E 321 | S1131800046017EDC5424547494EBD040C0DF5046F 322 | S11318106017A4C5554E54494CBD040C17C2043975 323 | S113182015A00460176AC24946BD040C17C20439E6 324 | S11318300DF50A100BBB159304601826C4544845D3 325 | S11318404EBD040C0DF506FC07E8046017B7C4454B 326 | S11318504C5345BD040C17C2042B0DF50A100BBBE9 327 | S1131860159306FC17C2184104601813C55748495C 328 | S11318704C45BD040C17C2182906FC0460184EC65A 329 | S1131880524550454154BD040C17C2042B15A017F2 330 | S1131890C218410460187F86504F434B4554BD0421 331 | S11318A00A0000000000000000000000000000002A 332 | S11318B00000000000000000000000000000000024 333 | S11318C00000000000000000000000000000000014 334 | S11318D00000000000000000000000000000000004 335 | S11318E000000000000000000000000000000000F4 336 | S11318F000000000000000000000000000000000E4 337 | S113190000000000000000000000000000000000D3 338 | S113191000000000000000000000000000000000C3 339 | S113192000000000000000000000000000000000B3 340 | S113193000000000000000000000000000000000A3 341 | S11319400000000000000000000000000000000093 342 | S11319500000000000000000000000000000000083 343 | S11319600000000000000000000000000000000073 344 | S11319700000000000000000000000000000000063 345 | S11319800000000000000000000000000000000053 346 | S1131990000000000000000000000000000000182B 347 | S11319A06C8127BD040C041C002010A210D2127EEE 348 | S11319B0082E041CFFF30D5404601804C35B275D58 349 | S11319C0BD040C19A317400460189784434841527E 350 | S11319D0BD040C0B4110A20A1005D907C6046018F7 351 | S11319E03CC65B434841525DBD040C19D01740040A 352 | S11319F06019CBC2444FBD040C17C2046B177107A6 353 | S1131A00D10DF50A07177107E8046019BCC33F44F8 354 | S1131A104FBD040C17C20481177107D10DF517715E 355 | S1131A2007E80A0715A00DF504601A0DC54C4541D9 356 | S1131A305645BD040C17C204C60DF5177107D11520 357 | S1131A40A0177107E804601A2C8D5245534F4C5669 358 | S1131A50452D4C45415645BD040C177107D106EF81 359 | S1131A6004391A7206EF07D10DF5071907E8042B9C 360 | S1131A701A5E06E5046019E1C44C4F4F50BD040CD6 361 | S1131A8017C2049915A01A57177107E8046019A121 362 | S1131A90C52B4C4F4F50BD040C17C204B615A01AE9 363 | S1131AA057177107E804601A90C7524543555253BB 364 | S1131AB045BD040C117707D115F31756046019F3CB 365 | S1131AC0C22E22BD040C17C20AF4041C002210A268 366 | S1131AD007C60632159315C904601A78C25322BD8D 367 | S1131AE0040C171307D104391B0017C20B10041C74 368 | S1131AF0002210A207C60632159315C9042B1B1029 369 | S1131B00041C002210A20AA1189E108A189E0AA181 370 | S1131B1004601ADCC641424F525422BD040C17C261 371 | S1131B2014E6041C002210A207C60632159315C938 372 | S1131B3004601AA98541424F5254BD040C0A23156E 373 | S1131B401104601B14C8504F5354504F4E45BD04EC 374 | S1131B500C17C217C219A315A004601B3489494D80 375 | S1131B604D454449415445BD040C117707D106EF56 376 | S1131B7007C6041C0040061306FC07DC04601A496F 377 | S1131B80C128BD040C041C0029103506E506E50433 378 | S1131B90601B80C15CBD040C0FD50F6807E806E527 379 | S1131BA004601B93853E424F4459BD040C041C0041 380 | S1131BB00305D904601B5D87283B434F444529BD79 381 | S1131BC0040C052E117707D115F3063207E80460DB 382 | S1131BD01BA4C5444F45533EBD040C17C21BBF167E 383 | S1131BE082041C040C15A004601B45863F53544119 384 | S1131BF0434BBD040C0A8806EF083E041CFFFC0D91 385 | S1131C0054041C27100A47041CFFFD0D5404601BD8 386 | S1131C10B789494E54455250524554BD040C041CD6 387 | S1131C20002010A210D206EF07C604391C8A127EC7 388 | S1131C3006EF04391C500A230A2C171307D1060493 389 | S1131C4004391C4A1756042B1C4C044B042B1C84CB 390 | S1131C5006E513CD082E041CFFF30D540D8E07D199 391 | S1131C60063204391C78171307D104391C7406FC96 392 | S1131C7017401740042B1C8406E5171307D10439B9 393 | S1131C801C8417401BF2042B1C1E06E504601AC0BA 394 | S1131C90884556414C55415445BD040C0F7307D13A 395 | S1131CA005230F7E07D105230F8A07D105230F686B 396 | S1131CB007D105230F8A07E80F7E07E80A070F6894 397 | S1131CC007E80A230F7307E81C1B052E0F6807E8B3 398 | S1131CD0052E0F8A07E8052E0F7E07E8052E0F73E1 399 | S1131CE007E804601BEB864552524F5253BD040A69 400 | S1131CF000001C908C4552524F522D534F55524365 401 | S1131D0045BD040C0F7307D10A070A4704391D2186 402 | S1131D100AF408696E206C696E65200F9A07D10F6A 403 | S1131D20000DF50AA10AB709D21DF504601CF4845C 404 | S1131D3051554954BD040C0A7B07D10544172B0F98 405 | S1131D40450F7E07E80A070F7307E8100006E5044D 406 | S1131D501C1C1B155C06EF082E04391D7406E517C0 407 | S1131D601307D1082E04391D6E0AF4024F4B09D211 408 | S1131D70042B1DCB09EF06EF041CFFFE0A2C0439CB 409 | S1131D801D9014C707D10AA10AB70DC5042B1DC99C 410 | S1131D901CED07D106EF04391DBC070D070D07D153 411 | S1131DA00A2C04391DB4041C000405D90AA10AB77D 412 | S1131DB00DC51D010BAC07D1042B1D9406E50AF4D7 413 | S1131DC0064572726F72200F001D010A0704391D47 414 | S1131DD04B04601BD285584C4F4144BD040C09E0B0 415 | S1131DE00A100F7307E80A070F9A07E804601D2F0B 416 | S1131DF0845741524DBD040C0A7B07D105440A7136 417 | S1131E0007D1055A0D9D0A1911B007E8116311860F 418 | S1131E1007E8116311860BAC07E8116311BF07E8EB 419 | S1131E200A0714D607E80AF41057656C636F6D65EA 420 | S1131E3020746F20466F72746809D21D3404601DCB 421 | S1131E40F084434F4C44108E800010BF0A7E10CEA5 422 | S10C1E507C0010FF0A747E1DF5EC 423 | S9030000FC 424 | -------------------------------------------------------------------------------- /examples_forth/meta09.4: -------------------------------------------------------------------------------- 1 | \ CROSS COMPILER FOR THE MOTORAOLA 6809 PROCESSOR 2 | \ created 1995 by L.C. Benschop. 3 | \ copyleft (c) 1995-2014 by the sbc09 team, see AUTHORS for more details. 4 | \ license: GNU General Public License version 2, see LICENSE for more details. 5 | \ 6 | \ This serves as an introduction to Forth cross compiling, so it is excessively 7 | \ commented. 8 | \ 9 | \ This cross compiler can be run on any ANS Forth with the necessary 10 | \ extension wordset that is at least 16-bit, including Motorola 6809 Forth. 11 | \ 12 | \ It creates the memory image of a new Forth system that is to be run 13 | \ by the Motorola 6809 processor. 14 | \ 15 | \ The cross compiler (or meta compiler or target compiler) is similar 16 | \ to a regular Forth compiler, except that it builds definitions in 17 | \ a dictionary in the memory image of a different Forth system. 18 | \ We call this the target dictionary in the target space of the 19 | \ target system. 20 | \ 21 | \ As the new definitions are for a different Forth system, the cross 22 | \ compiler cannot EXECUTE them. Neither can it easily find the new 23 | \ definitions in the target dictionary. Hence a shadow definition 24 | \ for each target definition is made in the normal Forth dictionary. 25 | \ 26 | \ The names of the new definitions overlap with the names of existing 27 | \ elementary. Forth words. Therefore they need to be in a wordlist 28 | \ different from the normal Forth wordlist. 29 | 30 | \ PART 1: THE VOCABULARIES. 31 | 32 | VOCABULARY TARGET 33 | \ This vocabulary will hold shadow definitions for all words that are in 34 | \ the target dictionary. When a shadow definition is executed, it 35 | \ performs the compile action in the target dictionary. 36 | 37 | VOCABULARY TRANSIENT 38 | \ This vocabulary will hold definitions that must be executed by the 39 | \ host system ( the system on which the cross compiler runs) and that 40 | \ compile to the target system. 41 | 42 | \ Expl: The word IF occurs in all three vocabularies. The word IF in the 43 | \ FORTH vocabulary is run by the host system and is used when 44 | \ compiling host definitions. A different version is in the 45 | \ TRANSIENT vocabulary. This one runs on the host system and 46 | \ is used when compiling target definitions. The version in the 47 | \ TARGET vocabulary is the version that will run on the target 48 | \ system. 49 | 50 | \ : \D ; \ Uncomment one of these. If uncommented, display debug info. 51 | : \D POSTPONE \ ; IMMEDIATE 52 | 53 | \ PART 2: THE TARGET DICTIONARY SPACE. 54 | 55 | \ Next we need to define the target space and the words to access it. 56 | 57 | 1024 CONSTANT ORIGIN \ Start address of Forth image. 58 | 8192 CONSTANT IMAGE_SIZE 59 | 60 | 61 | CREATE IMAGE IMAGE_SIZE CHARS ALLOT \ This space contains the target image. 62 | IMAGE IMAGE_SIZE 0 FILL \ Initialize it to zero. 63 | 64 | \ Fetch and store characters in the target space. 65 | : C@-T ( t-addr --- c) ORIGIN - CHARS IMAGE + C@ ; 66 | : C!-T ( c t-addr ---) ORIGIN - CHARS IMAGE + C! ; 67 | 68 | \ Fetch and store cells in the target space. 69 | \ M6809 is big endian 32 bit so store explicitly big-endian. 70 | : @-T ( t-addr --- x) 71 | ORIGIN - CHARS IMAGE + DUP C@ 8 LSHIFT SWAP 1 CHARS + C@ + ; 72 | 73 | : !-T ( x t-addr ---) 74 | ORIGIN - CHARS IMAGE + OVER 8 RSHIFT OVER C! 1 CHARS + C! ; 75 | 76 | \ A dictionary is constructed in the target space. Here are the primitives 77 | \ to maintain the dictionary pointer and to reserve space. 78 | 79 | VARIABLE DP-T \ Dictionary pointer for target dictionary. 80 | ORIGIN DP-T ! \ Initialize it to origin. 81 | : THERE ( --- t-addr) DP-T @ ; \ Equivalent of HERE in target space. 82 | : ALLOT-T ( n --- ) DP-T +! ; \ Reserve n bytes in the dictionary. 83 | : CHARS-T ( n1 --- n2 ) ; 84 | : CELLS-T ( n1 --- n2 ) 1 LSHIFT ; \ Cells are 2 chars. 85 | : ALIGN-T ; \ No alignment used. 86 | : ALIGNED-T ( n1 --- n2 ) ; 87 | : C,-T ( c --- ) THERE C!-T 1 CHARS ALLOT-T ; 88 | : ,-T ( x --- ) THERE !-T 1 CELLS-T ALLOT-T ; 89 | 90 | : PLACE-T ( c-addr len t-addr --- ) \ Move counted string to target space. 91 | OVER OVER C!-T 1+ CHARS ORIGIN - IMAGE + SWAP CHARS CMOVE ; 92 | 93 | \ 6809 cross assembler already loaded, configure it for cross assembly. 94 | 95 | FORTH ' ,-T ASSEMBLER IS , 96 | FORTH ' C,-T ASSEMBLER IS C, 97 | FORTH ' !-T ASSEMBLER IS V! 98 | FORTH ' @-T ASSEMBLER IS V@ 99 | FORTH ' C!-T ASSEMBLER IS VC! 100 | FORTH ' C@-T ASSEMBLER IS VC@ 101 | FORTH ' THERE ASSEMBLER IS HERE 102 | FORTH 103 | 104 | \ PART 3: CREATING NEW DEFINITIONS IN THE TARGET SYSTEM. 105 | 106 | \ These words create new target definitions, both the shadow definition 107 | \ and the header in the target dictionary. The layout of target headers 108 | \ can be changed but FIND in the target system must be changed accordingly. 109 | 110 | \ All definitions are linked together in a number of threads. Each word 111 | \ is linked in only one thread. Which thread the word is linked to, can be 112 | \ determined from the name by a 'hash' code. To find a word, one can compute 113 | \ the hash code and then one can search just one thread that contains a 114 | \ small fraction of the words. 115 | 116 | 4 CONSTANT #THREADS \ Number of threads 117 | 118 | CREATE TLINKS #THREADS CELLS ALLOT \ This array points to the names 119 | \ of the last definition in each thread. 120 | TLINKS #THREADS CELLS 0 FILL 121 | 122 | VARIABLE LAST-T \ Address of last definition. 123 | 124 | : HASH ( c-addr u #threads --- n) 125 | >R OVER C@ 1 LSHIFT OVER 1 > IF ROT CHAR+ C@ 2 LSHIFT XOR ELSE ROT DROP 126 | THEN XOR 127 | R> 1- AND 128 | ; 129 | 130 | : "HEADER >IN @ CREATE >IN ! \ Create the shadow definition. 131 | BL WORD 132 | DUP COUNT #THREADS HASH >R \ Compute the hash code. 133 | ALIGN-T TLINKS R@ CELLS + @ ,-T \ Lay out the link field. 134 | \D DUP COUNT CR ." Creating: " TYPE ." Hash:" R@ . 135 | COUNT DUP >R THERE PLACE-T \ Place name in target dictionary. 136 | THERE TLINKS R> R> SWAP >R CELLS + ! 137 | THERE LAST-T ! 138 | THERE C@-T 128 OR THERE C!-T R> 1+ ALLOT-T ALIGN-T ; 139 | \ Set bit 7 of count byte as a marker. 140 | 141 | \ : "HEADER CREATE ALIGN-T ; \ Alternative for "HEADER in case the target system 142 | \ is just an application without headers. 143 | 144 | 145 | ALSO TRANSIENT DEFINITIONS 146 | : IMMEDIATE LAST-T @ DUP C@-T 64 OR SWAP C!-T ; 147 | \ Set the IMMEDIATE bit of last name. 148 | PREVIOUS DEFINITIONS 149 | 150 | \ PART 4: FORWARD REFERENCES 151 | 152 | \ Some definitions are referenced before they are defined. A definition 153 | \ in the TRANSIENT voc is created for each forward referenced definition. 154 | \ This links all addresses together where the forward reference is used. 155 | \ The word RESOLVE stores the real address everywhere it is needed. 156 | 157 | : FORWARD 158 | CREATE 0 , \ Store head of list in the definition. 159 | DOES> 160 | DUP @ ,-T THERE 1 CELLS-T - SWAP ! \ Reserve a cell in the dictionary 161 | \ where the call to the forward definition must come. 162 | \ As the call address is unknown, store link to next 163 | \ reference instead. 164 | ; 165 | 166 | : RESOLVE 167 | ALSO TARGET >IN @ ' >BODY @ >R >IN ! \ Find the resolving word in the 168 | \ target voc. and take the CFA out of the definition. 169 | \D >IN @ BL WORD COUNT CR ." Resolving: " TYPE >IN ! 170 | TRANSIENT ' >BODY @ \ Find the forward ref word in the 171 | \ TRANSIENT VOC and take list head. 172 | BEGIN 173 | DUP \ Traverse all the links until end. 174 | WHILE 175 | DUP @-T \ Take address of next link from dict. 176 | R@ ROT !-T \ Set resolved address in dict. 177 | REPEAT DROP R> DROP PREVIOUS 178 | ; 179 | 180 | 181 | \ PART 5: CODE GENERATION 182 | 183 | \ Motorola 6809 Forth is a direct threaded Forth. It uses the following 184 | \ registers: S for stack pointer, Y for return stack pointer, U for 185 | \ instruction pointer. NEXT is the single instruction PULU PC. 186 | \ THe code field of a definition contains a JSR instruction. 187 | 188 | : JSR, [ HEX ] BD C,-T [ DECIMAL ] ; 189 | 190 | VARIABLE STATE-T 0 STATE-T ! \ State variable for cross compiler. 191 | : T] 1 STATE-T ! ; 192 | : T[ 0 STATE-T ! ; 193 | 194 | VARIABLE CSP \ Stack pointer checking between : and ; 195 | : !CSP DEPTH CSP ! ; 196 | : ?CSP DEPTH CSP @ - ABORT" Incomplete control structure" ; 197 | 198 | TRANSIENT DEFINITIONS FORTH 199 | FORWARD LIT 200 | FORWARD DOCOL 201 | FORWARD DOCON 202 | FORWARD DOVAR 203 | FORWARD UNNEST 204 | FORWARD BRANCH 205 | FORWARD ?BRANCH 206 | FORTH DEFINITIONS 207 | 208 | : LITERAL-T ( n --- ) 209 | \D DUP ." Literal:" . CR 210 | [ TRANSIENT ] LIT [ FORTH ] ,-T ; 211 | 212 | TRANSIENT DEFINITIONS FORTH 213 | \ Now define the words that do compile code. 214 | 215 | 216 | : : !CSP "HEADER THERE , JSR, [ TRANSIENT ] DOCOL [ FORTH ] T] 217 | DOES> @ ,-T ; 218 | 219 | : ; [ TRANSIENT ] UNNEST [ FORTH ] \ Compile the unnest primitive. 220 | T[ ?CSP \ Quit compilation state. 221 | ; 222 | 223 | 224 | : CODE "HEADER ASSEMBLE THERE , 225 | DOES> @ ,-T ; 226 | : END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; 227 | : LABEL THERE CONSTANT ASSEMBLE ; 228 | 229 | FORTH DEFINITIONS 230 | 231 | \ PART 6: DEFINING WORDS. 232 | 233 | TRANSIENT DEFINITIONS FORTH 234 | 235 | : VARIABLE "HEADER THERE , JSR, [ TRANSIENT ] DOVAR [ FORTH ] 0 ,-T 236 | \ Create a variable. 237 | DOES> @ ,-T ; 238 | 239 | : CONSTANT "HEADER THERE , JSR, [ TRANSIENT ] DOCON [ FORTH ] 240 | ,-T 241 | DOES> @ ,-T ; 242 | 243 | FORTH DEFINITIONS 244 | 245 | : T' ( --- t-addr) \ Find the execution token of a target definition. 246 | ALSO TARGET ' 247 | \D ." T' shadow address, target address " DUP . DUP >BODY @ . 248 | >BODY @ \ Get the address from the shadow definition. 249 | PREVIOUS 250 | ; 251 | 252 | : >BODY-T ( t-addr1 --- t-addr2 ) \ Convert executing token to param address. 253 | 3 + ; 254 | 255 | \ PART 7: COMPILING WORDS 256 | 257 | TRANSIENT DEFINITIONS FORTH 258 | 259 | \ The TRANSIENT definitions for IF, THEN etc. compile the 260 | \ branch primitives BRAMCH and ?BRANCH. 261 | 262 | : BEGIN THERE ; 263 | : UNTIL [ TRANSIENT ] ?BRANCH [ FORTH ] ,-T ; 264 | : IF [ TRANSIENT ] ?BRANCH [ FORTH ] THERE 1 CELLS-T ALLOT-T ; 265 | : THEN THERE SWAP !-T ; TARGET 266 | : ELSE [ TRANSIENT ] BRANCH THERE 1 CELLS-T ALLOT-T SWAP THEN [ FORTH ] ; 267 | : WHILE [ TRANSIENT ] IF [ FORTH ] SWAP ; TARGET 268 | : REPEAT [ TRANSIENT ] BRANCH ,-T THEN [ FORTH ] ; 269 | 270 | FORWARD (DO) 271 | FORWARD (LOOP) 272 | FORWARD (.") 273 | FORWARD (POSTPONE) 274 | 275 | : DO [ TRANSIENT ] (DO) [ FORTH ] THERE ; 276 | : LOOP [ TRANSIENT ] (LOOP) [ FORTH ] ,-T ; 277 | : ." [ TRANSIENT ] (.") [ FORTH ] 34 WORD COUNT DUP 1+ >R 278 | THERE PLACE-T R> ALLOT-T ALIGN-T ; 279 | : POSTPONE [ TRANSIENT ] (POSTPONE) [ FORTH ] T' ,-T ; 280 | 281 | : \ POSTPONE \ ; IMMEDIATE 282 | : \G POSTPONE \ ; IMMEDIATE 283 | : ( POSTPONE ( ; IMMEDIATE \ Move duplicates of comment words to TRANSIENT 284 | : CHARS-T CHARS-T ; \ Also words that must be executed while cross compiling. 285 | : CELLS-T CELLS-T ; 286 | : ALLOT-T ALLOT-T ; 287 | : ['] T' LITERAL-T ; 288 | 289 | FORTH DEFINITIONS 290 | 291 | \ PART 8: THE CROSS COMPILER ITSELF. 292 | 293 | VARIABLE DPL 294 | : NUMBER? ( c-addr ---- d f) 295 | -1 DPL ! 296 | BASE @ >R 297 | COUNT 298 | OVER C@ 45 = DUP >R IF 1 - SWAP 1 + SWAP THEN \ Get any - sign 299 | OVER C@ 36 = IF 16 BASE ! 1 - SWAP 1 + SWAP THEN \ $ sign for hex. 300 | OVER C@ 35 = IF 10 BASE ! 1 - SWAP 1 + SWAP THEN \ # sign for decimal 301 | DUP 0 > 0= IF R> DROP R> BASE ! 0 EXIT THEN \ Length 0 or less? 302 | >R >R 0 0 R> R> 303 | BEGIN 304 | >NUMBER 305 | DUP IF OVER C@ 46 = IF 1 - DUP DPL ! SWAP 1 + SWAP ELSE \ handle point. 306 | R> DROP R> BASE ! 0 EXIT THEN \ Error if anything but point 307 | THEN 308 | DUP 0= UNTIL DROP DROP R> IF DNEGATE THEN 309 | R> BASE ! -1 310 | ; 311 | 312 | 313 | : CROSS-COMPILE 314 | ONLY TARGET DEFINITIONS ALSO TRANSIENT \ Restrict search order. 315 | BEGIN 316 | BL WORD 317 | \D CR DUP COUNT TYPE 318 | DUP C@ 0= IF \ Get new word 319 | DROP REFILL DROP \ If empty, get new line. 320 | ELSE 321 | DUP COUNT S" END-CROSS" COMPARE 0= \ Exit cross compiler on END-CROSS 322 | IF 323 | ONLY FORTH ALSO DEFINITIONS \ Normal search order again. 324 | DROP EXIT 325 | THEN 326 | FIND IF \ Execute if found. 327 | EXECUTE 328 | ELSE 329 | NUMBER? 0= ABORT" Undefined word" DROP 330 | STATE-T @ IF \ Parse it as a number. 331 | LITERAL-T \ If compiling then compile as a literal. 332 | THEN 333 | THEN 334 | THEN 335 | 0 UNTIL 336 | ; 337 | 338 | -------------------------------------------------------------------------------- /examples_forth/test6309.4: -------------------------------------------------------------------------------- 1 | \ Test for the 6309 assembler 2 | 3 | CODE TEST 4 | PSHSW 5 | PULSW 6 | PSHUW 7 | PULUW 8 | LDW 0 ,W 9 | STW $1234 ,W 10 | ADDW ,--W 11 | SUBW ,W++ 12 | ANDD 0 ,W [] 13 | ORD $1234 ,W [] 14 | EORD ,--W [] 15 | CMPD ,W++ [] 16 | SEXW 17 | TFM++ X, Y 18 | TFM-- D, U 19 | TFM+0 X, D 20 | TFM0+ U, X 21 | ADDR A, B 22 | ADCR B, A 23 | ORR D, W 24 | ANDR W, Y 25 | EORR X, U 26 | CMPR E, F 27 | LDQ # $1234.5678 28 | LDQ $1f 29 | STQ $1234 30 | ADDD E,X 31 | ADDD F,X 32 | ADDD W,X 33 | ASLD 34 | RORW 35 | COME 36 | INCF 37 | AIM $80 $12 38 | OIM $40 $1234 39 | EIM $20 5 ,U 40 | TIM $10 0 ,W 41 | LDBT A 1 0 $FE 42 | BOR B 0 1 $FE 43 | STBT CC 0 7 $FE 44 | BIAND A 1 4 $FE 45 | MULD # $12 46 | DIVD # $12 47 | DIVQ $1234 [] 48 | LDE # 4 49 | STE $34 ,X [] 50 | LDMD $01 51 | BITMD $80 52 | PULU A, B, X, S 53 | END-CODE 54 | 55 | -------------------------------------------------------------------------------- /examples_forth/test6309.asm: -------------------------------------------------------------------------------- 1 | * Test for 6309 instructions, compare with Forth assembler output. 2 | PSHSW 3 | PULSW 4 | PSHUW 5 | PULUW 6 | LDW ,W 7 | STW $1234,W 8 | ADDW ,--W 9 | SUBW ,W++ 10 | ANDD [,W] 11 | ORD [$1234,W] 12 | EORD [,--W] 13 | CMPD [,W++] 14 | SEXW 15 | TFM X+,Y+ 16 | TFM D-,U- 17 | TFM X+,D 18 | TFM U,X+ 19 | ADDR A,B 20 | ADCR B,A 21 | ORR D,W 22 | ANDR W,Y 23 | EORR X,U 24 | CMPR E,F 25 | LDQ #$12345678 26 | LDQ <$1f 27 | STQ $1234 28 | ADDD E,X 29 | ADDD F,X 30 | ADDD W,X 31 | ASLD 32 | RORW 33 | COME 34 | INCF 35 | AIM #$80,<$12 36 | OIM #$40,$1234 37 | EIM #$20,5,U 38 | TIM #$10,,W 39 | LDBT A,1,0,$FE 40 | BOR B,0,1,$FE 41 | STBT CC,0,7,$FE 42 | BIAND A,1,4,$FE 43 | MULD # $12 44 | DIVD # $12 45 | DIVQ [$1234] 46 | LDE #4 47 | STE [$34,X] 48 | LDMD #$01 49 | BITMD #$80 50 | PULU A, B, X, S 51 | -------------------------------------------------------------------------------- /examples_forth/tester.4: -------------------------------------------------------------------------------- 1 | \ (C) 1993 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY 2 | \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. 3 | \ VERSION 1.0 4 | HEX 5 | 6 | \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY 7 | \ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. 8 | VARIABLE VERBOSE 9 | FALSE VERBOSE ! 10 | 11 | : EMPTY-STACK \ ( ... -- ) EMPTY STACK. 12 | DEPTH ?DUP IF 0 DO DROP LOOP THEN ; 13 | 14 | : ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY 15 | \ THE LINE THAT HAD THE ERROR. 16 | TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR 17 | EMPTY-STACK \ THROW AWAY EVERY THING ELSE 18 | ; 19 | 20 | VARIABLE ACTUAL-DEPTH \ STACK RECORD 21 | CREATE ACTUAL-RESULTS 20 CELLS ALLOT 22 | 23 | : { \ ( -- ) SYNTACTIC SUGAR. 24 | ; 25 | 26 | : -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. 27 | DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH 28 | ?DUP IF \ IF THERE IS SOMETHING ON STACK 29 | 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM 30 | THEN ; 31 | 32 | : } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED 33 | \ (ACTUAL) CONTENTS. 34 | DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH 35 | DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK 36 | 0 DO \ FOR EACH STACK ITEM 37 | ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED 38 | <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN 39 | LOOP 40 | THEN 41 | ELSE \ DEPTH MISMATCH 42 | S" WRONG NUMBER OF RESULTS: " ERROR 43 | THEN ; 44 | 45 | : TESTING \ ( -- ) TALKING COMMENT. 46 | SOURCE VERBOSE @ 47 | IF DUP >R TYPE CR R> >IN ! 48 | ELSE >IN ! DROP 49 | THEN ; 50 | -------------------------------------------------------------------------------- /examples_forth/tetris.4: -------------------------------------------------------------------------------- 1 | \ 2 | \ tetris.4th Tetris for terminals, redone in ANSI-Forth. 3 | \ Written 05Apr94 by Dirk Uwe Zoller, e-mail: 4 | \ duz@roxi.rz.fht-mannheim.de. 5 | \ Look&feel stolen from Mike Taylor's "TETRIS FOR TERMINALS" 6 | \ 7 | \ Please copy and share this program, modify it for your system 8 | \ and improve it as you like. But don't remove this notice. 9 | \ 10 | \ Thank you. 11 | \ 12 | \ Changes: 13 | \ 14 | \ 15 | 16 | ONLY FORTH DEFINITIONS 17 | \ S" FORGET-TT" DROP 1 CHARS - FIND NIP [IF] FORGET-TT [THEN] 18 | \ MARKER FORGET-TT 19 | 20 | DECIMAL 21 | 22 | WORDLIST CONSTANT TETRIS 23 | GET-ORDER TETRIS DUP ROT 2 + SET-ORDER DEFINITIONS 24 | 25 | 26 | \ Variables, constants 27 | 28 | BL BL 2CONSTANT EMPTY \ an empty position 29 | VARIABLE WIPING \ if true: wipe brick, else draw brick 30 | 2 CONSTANT COL0 \ position of the pit on screen 31 | 0 CONSTANT ROW0 32 | 33 | 10 CONSTANT WIDE \ size of pit in brick positions 34 | 20 CONSTANT DEEP 35 | 36 | CHAR J VALUE LEFT-KEY \ customize if you don't like them 37 | CHAR K VALUE ROT-KEY 38 | CHAR L VALUE RIGHT-KEY 39 | BL VALUE DROP-KEY 40 | CHAR P VALUE PAUSE-KEY 41 | 12 VALUE REFRESH-KEY 42 | CHAR Q VALUE QUIT-KEY 43 | 44 | VARIABLE SCORE 45 | VARIABLE PIECES 46 | VARIABLE LEVELS 47 | VARIABLE DELAY 48 | 49 | VARIABLE BROW \ where the brick is 50 | VARIABLE BCOL 51 | 52 | 53 | \ stupid random number generator 54 | 55 | VARIABLE SEED 56 | 57 | : RANDOMIZE 0 ." Press any key." CR BEGIN 1+ KEY? UNTIL KEY DROP SEED ! ; 58 | 59 | : RANDOM \ max --- n ; return random number < max 60 | SEED @ 1103515245 * 12345 + [ HEX ] 07FFF [ DECIMAL ] AND 61 | DUP SEED ! SWAP MOD ; 62 | 63 | 64 | \ Access pairs of characters in memory: 65 | 66 | : 2C@ DUP 1+ C@ SWAP C@ ; 67 | : 2C! DUP >R C! R> 1+ C! ; 68 | 69 | 70 | : <= > INVERT ; 71 | : >= < INVERT ; 72 | : D<> D= INVERT ; 73 | 74 | 75 | \ Drawing primitives: 76 | 77 | : 2EMIT EMIT EMIT ; 78 | 79 | : POSITION \ row col --- ; cursor to the position in the pit 80 | 2* COL0 + SWAP ROW0 + AT-XY ; 81 | 82 | : STONE \ c1 c2 --- ; draw or undraw these two characters 83 | WIPING @ IF 2DROP 2 SPACES ELSE 2EMIT THEN ; 84 | 85 | 86 | \ Define the pit where bricks fall into: 87 | 88 | : DEF-PIT CREATE WIDE DEEP * 2* ALLOT 89 | DOES> ROT WIDE * ROT + 2* CHARS + ; 90 | 91 | DEF-PIT PIT 92 | 93 | : EMPTY-PIT DEEP 0 DO WIDE 0 DO EMPTY J I PIT 2C! 94 | LOOP LOOP ; 95 | 96 | 97 | \ Displaying: 98 | 99 | : DRAW-BOTTOM \ --- ; redraw the bottom of the pit 100 | DEEP -1 POSITION 101 | [CHAR] + DUP STONE 102 | WIDE 0 DO [CHAR] = DUP STONE LOOP 103 | [CHAR] + DUP STONE ; 104 | 105 | : DRAW-FRAME \ --- ; draw the border of the pit 106 | DEEP 0 DO 107 | I -1 POSITION [CHAR] | DUP STONE 108 | I WIDE POSITION [CHAR] | DUP STONE 109 | LOOP DRAW-BOTTOM ; 110 | 111 | : BOTTOM-MSG \ addr cnt --- ; output a message in the bottom of the pit 112 | DEEP OVER 2/ WIDE SWAP - 2/ POSITION TYPE ; 113 | 114 | : DRAW-LINE \ line --- 115 | DUP 0 POSITION WIDE 0 DO DUP I PIT 2C@ 2EMIT LOOP DROP ; 116 | 117 | : DRAW-PIT \ --- ; draw the contents of the pit 118 | DEEP 0 DO I DRAW-LINE LOOP ; 119 | 120 | : SHOW-KEY \ char --- ; visualization of that character 121 | DUP BL < 122 | IF [CHAR] @ OR [CHAR] ^ EMIT EMIT SPACE 123 | ELSE [CHAR] ` EMIT EMIT [CHAR] ' EMIT 124 | THEN ; 125 | 126 | : SHOW-HELP \ --- ; display some explanations 127 | 30 1 AT-XY ." ***** T E T R I S *****" 128 | 30 2 AT-XY ." =======================" 129 | 30 4 AT-XY ." Use keys:" 130 | 32 5 AT-XY LEFT-KEY SHOW-KEY ." Move left" 131 | 32 6 AT-XY ROT-KEY SHOW-KEY ." Rotate" 132 | 32 7 AT-XY RIGHT-KEY SHOW-KEY ." Move right" 133 | 32 8 AT-XY DROP-KEY SHOW-KEY ." Drop" 134 | 32 9 AT-XY PAUSE-KEY SHOW-KEY ." Pause" 135 | 32 10 AT-XY REFRESH-KEY SHOW-KEY ." Refresh" 136 | 32 11 AT-XY QUIT-KEY SHOW-KEY ." Quit" 137 | 32 13 AT-XY ." -> " 138 | 30 16 AT-XY ." Score:" 139 | 30 17 AT-XY ." Pieces:" 140 | 30 18 AT-XY ." Levels:" 141 | 0 22 AT-XY ." ======= This program was written 1994 in ANS Forth by Dirk Uwe Zoller ========" 142 | 0 23 AT-XY ." =================== Copy it, port it, play it, enjoy it! =====================" ; 143 | 144 | : UPDATE-SCORE \ --- ; display current score 145 | 38 16 AT-XY SCORE @ 3 .R 146 | 38 17 AT-XY PIECES @ 3 .R 147 | 38 18 AT-XY LEVELS @ 3 .R ; 148 | 149 | : REFRESH \ --- ; redraw everything on screen 150 | PAGE DRAW-FRAME DRAW-PIT SHOW-HELP UPDATE-SCORE ; 151 | 152 | 153 | \ Define shapes of bricks: 154 | 155 | : DEF-BRICK CREATE 4 0 DO 156 | ' EXECUTE 0 DO DUP I CHARS + C@ C, LOOP DROP 157 | REFILL DROP 158 | LOOP 159 | DOES> ROT 4 * ROT + 2* CHARS + ; 160 | 161 | DEF-BRICK BRICK1 S" " 162 | S" ###### " 163 | S" ## " 164 | S" " 165 | 166 | DEF-BRICK BRICK2 S" " 167 | S" <><><><>" 168 | S" " 169 | S" " 170 | 171 | DEF-BRICK BRICK3 S" " 172 | S" {}{}{}" 173 | S" {} " 174 | S" " 175 | 176 | DEF-BRICK BRICK4 S" " 177 | S" ()()() " 178 | S" () " 179 | S" " 180 | 181 | DEF-BRICK BRICK5 S" " 182 | S" [][] " 183 | S" [][] " 184 | S" " 185 | 186 | DEF-BRICK BRICK6 S" " 187 | S" @@@@ " 188 | S" @@@@ " 189 | S" " 190 | 191 | DEF-BRICK BRICK7 S" " 192 | S" %%%% " 193 | S" %%%% " 194 | S" " 195 | 196 | \ this brick is actually in use: 197 | 198 | DEF-BRICK BRICK S" " 199 | S" " 200 | S" " 201 | S" " 202 | 203 | DEF-BRICK SCRATCH S" " 204 | S" " 205 | S" " 206 | S" " 207 | 208 | CREATE BRICKS ' BRICK1 , ' BRICK2 , ' BRICK3 , ' BRICK4 , 209 | ' BRICK5 , ' BRICK6 , ' BRICK7 , 210 | 211 | CREATE BRICK-VAL 1 C, 2 C, 3 C, 3 C, 4 C, 5 C, 5 C, 212 | 213 | 214 | : IS-BRICK \ brick --- ; activate a shape of brick 215 | >BODY ['] BRICK >BODY 32 CMOVE ; 216 | 217 | : NEW-BRICK \ --- ; select a new brick by random, count it 218 | 1 PIECES +! 7 RANDOM 219 | BRICKS OVER CELLS + @ IS-BRICK 220 | BRICK-VAL SWAP CHARS + C@ SCORE +! ; 221 | 222 | : ROTLEFT 4 0 DO 4 0 DO 223 | J I BRICK 2C@ 3 I - J SCRATCH 2C! 224 | LOOP LOOP 225 | ['] SCRATCH IS-BRICK ; 226 | 227 | : ROTRIGHT 4 0 DO 4 0 DO 228 | J I BRICK 2C@ I 3 J - SCRATCH 2C! 229 | LOOP LOOP 230 | ['] SCRATCH IS-BRICK ; 231 | 232 | : DRAW-BRICK \ row col --- 233 | 4 0 DO 4 0 DO 234 | J I BRICK 2C@ EMPTY D<> 235 | IF OVER J + OVER I + POSITION 236 | J I BRICK 2C@ STONE 237 | THEN 238 | LOOP LOOP 2DROP ; 239 | 240 | : SHOW-BRICK FALSE WIPING ! DRAW-BRICK ; 241 | : HIDE-BRICK TRUE WIPING ! DRAW-BRICK ; 242 | 243 | : PUT-BRICK \ row col --- ; put the brick into the pit 244 | 4 0 DO 4 0 DO 245 | J I BRICK 2C@ EMPTY D<> 246 | IF OVER J + OVER I + PIT 247 | J I BRICK 2C@ ROT 2C! 248 | THEN 249 | LOOP LOOP 2DROP ; 250 | 251 | : REMOVE-BRICK \ row col --- ; remove the brick from that position 252 | 4 0 DO 4 0 DO 253 | J I BRICK 2C@ EMPTY D<> 254 | IF OVER J + OVER I + PIT EMPTY ROT 2C! THEN 255 | LOOP LOOP 2DROP ; 256 | 257 | : TEST-BRICK \ row col --- flag ; could the brick be there? 258 | 4 0 DO 4 0 DO 259 | J I BRICK 2C@ EMPTY D<> 260 | IF OVER J + OVER I + 261 | OVER DUP 0< SWAP DEEP >= OR 262 | OVER DUP 0< SWAP WIDE >= OR 263 | 2SWAP PIT 2C@ EMPTY D<> 264 | OR OR IF UNLOOP UNLOOP 2DROP FALSE EXIT THEN 265 | THEN 266 | LOOP LOOP 2DROP TRUE ; 267 | 268 | : MOVE-BRICK \ rows cols --- flag ; try to move the brick 269 | BROW @ BCOL @ REMOVE-BRICK 270 | SWAP BROW @ + SWAP BCOL @ + 2DUP TEST-BRICK 271 | IF BROW @ BCOL @ HIDE-BRICK 272 | 2DUP BCOL ! BROW ! 2DUP SHOW-BRICK PUT-BRICK TRUE 273 | ELSE 2DROP BROW @ BCOL @ PUT-BRICK FALSE 274 | THEN ; 275 | 276 | : ROTATE-BRICK \ flag --- flag ; left/right, success 277 | BROW @ BCOL @ REMOVE-BRICK 278 | DUP IF ROTRIGHT ELSE ROTLEFT THEN 279 | BROW @ BCOL @ TEST-BRICK 280 | OVER IF ROTLEFT ELSE ROTRIGHT THEN 281 | IF BROW @ BCOL @ HIDE-BRICK 282 | IF ROTRIGHT ELSE ROTLEFT THEN 283 | BROW @ BCOL @ PUT-BRICK 284 | BROW @ BCOL @ SHOW-BRICK TRUE 285 | ELSE DROP FALSE THEN ; 286 | 287 | : INSERT-BRICK \ row col --- flag ; introduce a new brick 288 | 2DUP TEST-BRICK 289 | IF 2DUP BCOL ! BROW ! 290 | 2DUP PUT-BRICK DRAW-BRICK TRUE 291 | ELSE 2DROP FALSE THEN ; 292 | 293 | : DROP-BRICK \ --- ; move brick down fast 294 | BEGIN 1 0 MOVE-BRICK 0= UNTIL ; 295 | 296 | : MOVE-LINE \ from to --- 297 | OVER 0 PIT OVER 0 PIT WIDE 2* CMOVE DRAW-LINE 298 | DUP 0 PIT WIDE 2* BLANK DRAW-LINE ; 299 | 300 | : LINE-FULL \ line-no --- flag 301 | TRUE WIDE 0 302 | DO OVER I PIT 2C@ EMPTY D= 303 | IF DROP FALSE LEAVE THEN 304 | LOOP NIP ; 305 | 306 | : REMOVE-LINES \ --- 307 | DEEP DEEP 308 | BEGIN 309 | SWAP 310 | BEGIN 1- DUP 0< IF 2DROP EXIT THEN DUP LINE-FULL 311 | WHILE 1 LEVELS +! 10 SCORE +! REPEAT 312 | SWAP 1- 313 | 2DUP <> IF 2DUP MOVE-LINE THEN 314 | AGAIN ; 315 | 316 | : TO-UPPER \ char --- char ; convert to upper case 317 | DUP [CHAR] a >= OVER [CHAR] z <= AND 318 | IF [ CHAR A CHAR a - ] LITERAL + THEN ; 319 | 320 | : DISPATCH \ key --- flag 321 | CASE TO-UPPER 322 | LEFT-KEY OF 0 -1 MOVE-BRICK DROP ENDOF 323 | RIGHT-KEY OF 0 1 MOVE-BRICK DROP ENDOF 324 | ROT-KEY OF 0 ROTATE-BRICK DROP ENDOF 325 | DROP-KEY OF DROP-BRICK ENDOF 326 | PAUSE-KEY OF S" Paused " BOTTOM-MSG KEY DROP 327 | DRAW-BOTTOM ENDOF 328 | REFRESH-KEY OF REFRESH ENDOF 329 | QUIT-KEY OF FALSE EXIT ENDOF 330 | ENDCASE TRUE ; 331 | 332 | : INITIALIZE \ --- ; prepare for playing 333 | RANDOMIZE EMPTY-PIT REFRESH 334 | 0 SCORE ! 0 PIECES ! 0 LEVELS ! 100 DELAY ! ; 335 | 336 | : ADJUST-DELAY \ --- ; make it faster with increasing score 337 | LEVELS @ 338 | DUP 50 < IF 100 OVER - ELSE 339 | DUP 100 < IF 62 OVER 4 / - ELSE 340 | DUP 500 < IF 31 OVER 16 / - ELSE 0 THEN THEN THEN 341 | DELAY ! DROP ; 342 | 343 | : PLAY-GAME \ --- ; play one tetris game 344 | BEGIN 345 | NEW-BRICK 346 | -1 3 INSERT-BRICK 347 | WHILE 348 | BEGIN 4 0 349 | DO 35 13 AT-XY 350 | DELAY @ MS KEY? 351 | IF BEGIN KEY KEY? WHILE DROP REPEAT 352 | DISPATCH 0= 353 | IF UNLOOP EXIT THEN 354 | THEN 355 | LOOP 356 | 1 0 MOVE-BRICK 0= 357 | UNTIL 358 | REMOVE-LINES 359 | UPDATE-SCORE 360 | ADJUST-DELAY 361 | REPEAT ; 362 | 363 | FORTH DEFINITIONS 364 | 365 | : TT \ --- ; play the tetris game 366 | INITIALIZE 367 | S" Press any key " BOTTOM-MSG KEY DROP DRAW-BOTTOM 368 | BEGIN 369 | PLAY-GAME 370 | S" Again? " BOTTOM-MSG KEY TO-UPPER [CHAR] Y = 371 | WHILE INITIALIZE REPEAT 372 | 0 23 AT-XY CR ; 373 | 374 | ONLY FORTH ALSO DEFINITIONS 375 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile Sim6809 3 | # 4 | # created 1994 by L.C. Benschop 5 | # 2013-10-28 - Jens Diemer: add "clean" section 6 | # 2014-06-25 - J.E. Klasek 7 | # 8 | # copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. 9 | # license: GNU General Public License version 2, see LICENSE for more details. 10 | # 11 | 12 | CFLAGS=-O3 -fomit-frame-pointer -DTERM_CONTROL 13 | 14 | V09FLAGS= -DUSE_TERMIOS #-DBIG_ENDIAN 15 | 16 | 17 | SIM_BIN=v09s v09st 18 | 19 | APPS=mon2.s 20 | 21 | # will be installed to ".." 22 | BIN=a09 v09 $(SIM_BIN) v09.rom 23 | 24 | TARGETS=$(BIN) $(APPS) 25 | 26 | OTHER=monitor.s makerom 27 | 28 | all: $(TARGETS) 29 | 30 | # ------------------------------------ 31 | 32 | a09: a09.c 33 | 34 | v09: v09.o engine.o io.o 35 | $(CC) -o v09 $(CFLAGS) v09.o engine.o io.o 36 | 37 | v09.o: v09.c v09.h 38 | $(CC) -c $(CFLAGS) $(V09FLAGS) v09.c 39 | 40 | engine.o: engine.c v09.h 41 | $(CC) -c $(CFLAGS) $(V09FLAGS) engine.c 42 | 43 | io.o: io.c v09.h 44 | $(CC) -c $(CFLAGS) $(V09FLAGS) io.c 45 | 46 | v09.rom: makerom monitor.s 47 | ./makerom 29 | #include 30 | #include 31 | #include 32 | #include 33 | 34 | #include 35 | #include 36 | #include 37 | 38 | #ifdef USE_TERMIOS 39 | #include 40 | #endif 41 | 42 | #define engine extern 43 | #include "v09.h" 44 | 45 | int tflags; 46 | struct termios termsetting; 47 | 48 | int xmstat; /* 0= no XMODEM transfer, 1=send, 2=receiver */ 49 | unsigned char xmbuf[132]; 50 | int xidx; 51 | int acknak; 52 | int rcvdnak; 53 | int blocknum; 54 | 55 | FILE *logfile; 56 | FILE *infile; 57 | FILE *xfile; 58 | 59 | int char_input(void) { 60 | int c, w, sum; 61 | if (!xmstat) { 62 | if (infile) { 63 | c = getc(infile); 64 | if (c == EOF) { 65 | fclose(infile); 66 | infile = 0; 67 | return char_input(); 68 | } 69 | if (c == '\n') 70 | c = '\r'; 71 | return c; 72 | } else 73 | return getchar(); 74 | } else if (xmstat == 1) { 75 | if (xidx) { 76 | c = xmbuf[xidx++]; 77 | if (xidx == 132) { 78 | xidx = 0; 79 | rcvdnak = EOF; 80 | acknak = 6; 81 | } 82 | } else { 83 | if (acknak == 21 && rcvdnak == 21 || acknak == 6 && rcvdnak == 6) { 84 | rcvdnak = 0; 85 | memset(xmbuf, 0, 132); 86 | w = fread(xmbuf + 3, 1, 128, xfile); 87 | if (w) { 88 | printf("Block %3d transmitted, ", blocknum); 89 | xmbuf[0] = 1; 90 | xmbuf[1] = blocknum; 91 | xmbuf[2] = 255 - blocknum; 92 | blocknum = (blocknum + 1) & 255; 93 | sum = 0; 94 | for (w = 3; w < 131; w++) 95 | sum = (sum + xmbuf[w]) & 255; 96 | xmbuf[131] = sum; 97 | acknak = 6; 98 | c = 1; 99 | xidx = 1; 100 | } else { 101 | printf("EOT transmitted, "); 102 | acknak = 4; 103 | c = 4; 104 | } 105 | } else if (rcvdnak == 21) { 106 | rcvdnak = 0; 107 | printf("Block %3d retransmitted, ", xmbuf[1]); 108 | c = xmbuf[xidx++]; /*retransmit the same block */ 109 | } else 110 | c = EOF; 111 | } 112 | return c; 113 | } else { 114 | if (acknak == 4) { 115 | c = 6; 116 | acknak = 0; 117 | fclose(xfile); 118 | xfile = 0; 119 | xmstat = 0; 120 | } else if (acknak) { 121 | c = acknak; 122 | acknak = 0; 123 | } else 124 | c = EOF; 125 | if (c == 6) 126 | printf("ACK\n"); 127 | if (c == 21) 128 | printf("NAK\n"); 129 | return c; 130 | } 131 | } 132 | 133 | int do_input(int a) { 134 | static int c, f = EOF; 135 | if (a == 0) { 136 | if (f == EOF) 137 | f = char_input(); 138 | if (f != EOF) 139 | c = f; 140 | return 2 + (f != EOF); 141 | } else if (a == 1) { /*data port*/ 142 | if (f == EOF) 143 | f = char_input(); 144 | if (f != EOF) { 145 | c = f; 146 | f = EOF; 147 | } 148 | return c; 149 | } 150 | } 151 | 152 | void do_output(int a, int c) { 153 | int i, sum; 154 | if (a == 1) { /* ACIA data port,ignore address */ 155 | if (!xmstat) { 156 | if (logfile && c != 127 && (c >= ' ' || c == '\n')) 157 | putc(c, logfile); 158 | putchar(c); 159 | fflush(stdout); 160 | } else if (xmstat == 1) { 161 | rcvdnak = c; 162 | if (c == 6 && acknak == 4) { 163 | fclose(xfile); 164 | xfile = 0; 165 | xmstat = 0; 166 | } 167 | if (c == 6) 168 | printf("ACK\n"); 169 | if (c == 21) 170 | printf("NAK\n"); 171 | if (c == 24) { 172 | printf("CAN\n"); 173 | fclose(xfile); 174 | xmstat = 0; 175 | xfile = 0; 176 | } 177 | } else { 178 | if (xidx == 0 && c == 4) { 179 | acknak = 4; 180 | printf("EOT received, "); 181 | } 182 | xmbuf[xidx++] = c; 183 | if (xidx == 132) { 184 | sum = 0; 185 | for (i = 3; i < 131; i++) 186 | sum = (sum + xmbuf[i]) & 255; 187 | if (xmbuf[0] == 1 && xmbuf[1] == 255 - xmbuf[2] 188 | && sum == xmbuf[131]) 189 | acknak = 6; 190 | else 191 | acknak = 21; 192 | printf("Block %3d received, ", xmbuf[1]); 193 | if (blocknum == xmbuf[1]) { 194 | blocknum = (blocknum + 1) & 255; 195 | fwrite(xmbuf + 3, 1, 128, xfile); 196 | } 197 | xidx = 0; 198 | } 199 | } 200 | } 201 | } 202 | 203 | void restore_term(void) { 204 | tcsetattr(0, TCSAFLUSH, &termsetting); 205 | fcntl(0, F_SETFL, tflags); 206 | signal(SIGALRM, SIG_IGN); 207 | } 208 | 209 | void do_exit(void) { 210 | restore_term(); 211 | exit(0); 212 | } 213 | 214 | void do_escape(void) { 215 | char s[80]; 216 | restore_term(); 217 | printf("v09>"); 218 | fgets(s, 80, stdin); 219 | if (s[0]) 220 | s[strlen(s) - 1] = 0; 221 | switch (toupper(s[0])) { 222 | case 'L': 223 | if (logfile) 224 | fclose(logfile); 225 | logfile = 0; 226 | if (s[1]) { 227 | logfile = fopen(s + 1, "w"); 228 | } 229 | break; 230 | case 'S': 231 | if (infile) 232 | fclose(infile); 233 | infile = 0; 234 | if (s[1]) { 235 | infile = fopen(s + 1, "r"); 236 | } 237 | break; 238 | case 'X': 239 | if (!xmstat) 240 | do_exit(); 241 | else { 242 | xmstat = 0; 243 | fclose(xfile); 244 | xfile = 0; 245 | } 246 | break; 247 | case 'U': 248 | if (xfile) 249 | fclose(xfile); 250 | xfile = 0; 251 | if (s[1]) { 252 | xfile = fopen(s + 1, "rb"); 253 | } 254 | if (xfile) 255 | xmstat = 1; 256 | else 257 | xmstat = 0; 258 | xidx = 0; 259 | acknak = 21; 260 | rcvdnak = EOF; 261 | blocknum = 1; 262 | break; 263 | case 'D': 264 | if (xfile) 265 | fclose(xfile); 266 | xfile = 0; 267 | if (s[1]) { 268 | xfile = fopen(s + 1, "wb"); 269 | } 270 | if (xfile) 271 | xmstat = 2; 272 | else 273 | xmstat = 0; 274 | xidx = 0; 275 | acknak = 21; 276 | blocknum = 1; 277 | break; 278 | case 'R': 279 | pcreg = (mem[0xfffe] << 8) + mem[0xffff]; 280 | } 281 | if (!tracing) 282 | attention = 0; 283 | escape = 0; 284 | set_term(escchar); 285 | } 286 | 287 | void timehandler(int sig) { 288 | attention = 1; 289 | irq = 2; 290 | signal(SIGALRM, timehandler); 291 | } 292 | 293 | void handler(int sig) { 294 | escape = 1; 295 | attention = 1; 296 | } 297 | 298 | void set_term(char c) { 299 | struct termios newterm; 300 | struct itimerval timercontrol; 301 | signal(SIGQUIT, SIG_IGN); 302 | signal(SIGTSTP, SIG_IGN); 303 | signal(SIGINT, handler); 304 | tcgetattr(0, &termsetting); 305 | newterm = termsetting; 306 | newterm.c_iflag = newterm.c_iflag & ~INLCR & ~ICRNL; 307 | newterm.c_lflag = newterm.c_lflag & ~ECHO & ~ICANON; 308 | newterm.c_cc[VTIME] = 0; 309 | newterm.c_cc[VMIN] = 1; 310 | newterm.c_cc[VINTR] = escchar; 311 | tcsetattr(0, TCSAFLUSH, &newterm); 312 | tflags = fcntl(0, F_GETFL, 0); 313 | fcntl(0, F_SETFL, tflags | O_NDELAY); /* Make input from stdin non-blocking */ 314 | signal(SIGALRM, timehandler); 315 | timercontrol.it_interval.tv_sec = 0; 316 | timercontrol.it_interval.tv_usec = 20000; 317 | timercontrol.it_value.tv_sec = 0; 318 | timercontrol.it_value.tv_usec = 20000; 319 | setitimer(ITIMER_REAL, &timercontrol, NULL); 320 | } 321 | -------------------------------------------------------------------------------- /src/makerom.c: -------------------------------------------------------------------------------- 1 | /* makerom.c 2 | Read standard input as S-records and build ROM image file v09.rom 3 | ROM starts at 0x8000 and is 32K. 4 | */ 5 | 6 | #include 7 | #include 8 | #include 9 | 10 | static int sum,charindex; 11 | unsigned char mem[0x8000]; 12 | char linebuf[130]; 13 | 14 | void hexerr() 15 | { 16 | fprintf(stderr,"Illegal character in hex number\n"); 17 | exit(1); 18 | } 19 | 20 | int gethex() 21 | { 22 | int c; 23 | c=linebuf[charindex++]; 24 | if(c<'0')hexerr(); 25 | if(c>'9') if(c<'A')hexerr();else c-=7; 26 | c-='0'; 27 | return c; 28 | } 29 | 30 | int getbyte() 31 | { 32 | int b; 33 | b=gethex(); 34 | b=b*16+gethex(); 35 | sum=(sum+b)&0xff; 36 | return b; 37 | } 38 | 39 | void main() 40 | { 41 | FILE *romfile; 42 | unsigned int i,length,addr; 43 | for(i=0;i<0x8000;i++)mem[i]=0xff; /*set unused locations to FF */ 44 | for(;;) { 45 | if(fgets(linebuf,128,stdin)==NULL)break; 46 | if(strlen(linebuf))linebuf[strlen(linebuf)]=0; 47 | if(linebuf[0]=='S'&&linebuf[1]=='1') { 48 | sum=0;charindex=2; 49 | length=getbyte(); 50 | if(length<3) { 51 | fprintf(stderr,"Illegal length in data record\n"); 52 | exit(1); 53 | } 54 | addr=getbyte(); 55 | addr=(addr<<8)+getbyte(); 56 | if((long)addr+length-3>0x10000||addr<0x8000) { 57 | fprintf(stderr,"Address 0x%x out of range\n",addr); 58 | exit(1); 59 | } 60 | for(i=0;i!=length-3;i++)mem[addr-0x8000+i]=getbyte(); 61 | getbyte(); 62 | if(sum!=0xff) { 63 | fprintf(stderr,"Checksum error\n"); 64 | exit(1); 65 | } 66 | } 67 | } 68 | romfile=fopen("v09.rom","wb"); 69 | if(!romfile) { 70 | fprintf(stderr,"Cannot create file v09.rom\n"); 71 | exit(1); 72 | } 73 | fwrite(mem,0x8000,1,romfile); 74 | fclose(romfile); 75 | exit(0); 76 | } 77 | -------------------------------------------------------------------------------- /src/v09.c: -------------------------------------------------------------------------------- 1 | /* 6809 Simulator V09. 2 | 3 | Copyright 1994, L.C. Benschop, Eidnhoven The Netherlands. 4 | This version of the program is distributed under the terms and conditions 5 | of the GNU General Public License version 2. See the file COPYING. 6 | THERE IS NO WARRANTY ON THIS PROGRAM!!! 7 | 8 | This program simulates a 6809 processor. 9 | 10 | System dependencies: short must be 16 bits. 11 | char must be 8 bits. 12 | long must be more than 16 bits. 13 | arrays up to 65536 bytes must be supported. 14 | machine must be twos complement. 15 | Most Unix machines will work. For MSODS you need long pointers 16 | and you may have to malloc() the mem array of 65536 bytes. 17 | 18 | Define BIG_ENDIAN if you have a big-endian machine (680x0 etc) 19 | 20 | Special instructions: 21 | SWI2 writes char to stdout from register B. 22 | SWI3 reads char from stdout to register B, sets carry at EOF. 23 | (or when no key available when using term control). 24 | SWI retains its normal function. 25 | CWAI and SYNC stop simulator. 26 | 27 | */ 28 | 29 | 30 | #include 31 | #include 32 | #include 33 | 34 | #define engine extern 35 | 36 | #include "v09.h" 37 | 38 | FILE *tracefile; 39 | 40 | void do_trace(void) 41 | { 42 | Word pc=pcreg; 43 | Byte ir; 44 | fprintf(tracefile,"pc=%04x ",pc); 45 | ir=mem[pc++]; 46 | fprintf(tracefile,"i=%02x ",ir); 47 | if((ir&0xfe)==0x10) 48 | fprintf(tracefile,"%02x ",mem[pc]);else fprintf(tracefile," "); 49 | fprintf(tracefile,"x=%04x y=%04x u=%04x s=%04x a=%02x b=%02x cc=%02x\n", 50 | xreg,yreg,ureg,sreg,*areg,*breg,ccreg); 51 | } 52 | 53 | void read_image() 54 | { 55 | FILE *image; 56 | if((image=fopen("v09.rom","rb"))==NULL) 57 | if((image=fopen("../v09.rom","rb"))==NULL) 58 | if((image=fopen("..\\v09.rom","rb"))==NULL) { 59 | perror("v09, image file"); 60 | exit(2); 61 | } 62 | fread(mem+0x8000,0x8000,1,image); 63 | fclose(image); 64 | } 65 | 66 | void usage(void) 67 | { 68 | fprintf(stderr,"Usage: v09 [-t tracefile [-tl addr] " 69 | "[-th addr] ]\n[-e escchar] \n"); 70 | exit(1); 71 | } 72 | 73 | 74 | #define CHECKARG if(i==argc)usage();else i++; 75 | 76 | void main(int argc,char *argv[]) 77 | { 78 | Word loadaddr=0x100; 79 | char *imagename=0; 80 | int i; 81 | escchar='\x1d'; 82 | tracelo=0;tracehi=0xffff; 83 | for(i=1;i