# HG changeset patch # User Shinji KONO # Date 1532329632 -32400 # Node ID 2088fd9988656338964318745723eb2b68df52e9 # Parent 4fa2bdb0c457bc98f1ab4fcf2cf2a734f477ba17 sbc09 directry clean up diff -r 4fa2bdb0c457 -r 2088fd998865 .gdbinit --- a/.gdbinit Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -handle 2 pass -define regs -call (void)printf("rax=%08lx rbx=%08lx rcx=%08lx rdx=%08lx\nrsi=%08lx rdi=%08lx rbp=%08lx rsp=%08lx rip=%08lx\n",$rax,$rbx,$rcx,$rdx,$rsi,$rdi,$rbp,$rsp,$rip) -end -define si -stepi -regs -x/1i $rip -end -define ni -nexti -regs -x/1i $rip -end - diff -r 4fa2bdb0c457 -r 2088fd998865 .lldbinit diff -r 4fa2bdb0c457 -r 2088fd998865 AUTHORS --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/AUTHORS Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,8 @@ + +AUTHORS are and/or have been: + +* Lennart Benschop: http://lennartb.home.xs4all.nl/m6809.html +* Jens Diemer: http://www.jensdiemer.de/ +* Johann E. Klasek: http://klasek.at/hc/6809/ + +basic.asm created 20-OCT-77 by John Byrns \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 LICENSE --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/LICENSE Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + Lennart Benschop 6809 Single Board Computer + Copyright (C) 1993 L.C. Benschop, Eidnhoven The Netherlands + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + {signature of Ty Coon}, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 Makefile --- a/Makefile Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,113 +0,0 @@ -# -# Makefile Sim6809 -# -# created 1994 by L.C. Benschop -# 2013-10-28 - Jens Diemer: add "clean" section -# 2014-06-25 - J.E. Klasek -# -# copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. -# license: GNU General Public License version 2, see LICENSE for more details. -# - -# CFLAGS=-O3 -fomit-frame-pointer -DTERM_CONTROL -CFLAGS=-g -DTERM_CONTROL - -V09FLAGS= -DUSE_TERMIOS #-DBIG_ENDIAN - - -SIM_BIN=v09s v09st - -APPS=mon2.s - -# will be installed to ".." -BIN=a09 v09 v09c d09 $(SIM_BIN) v09.rom - -TARGETS=$(BIN) $(APPS) - -OTHER=monitor.s makerom - -all: $(TARGETS) - -# ------------------------------------ - -a09 : a09.o os9crc.o - $(CC) $(CFLAGS) $(V09FLAGS) a09.o os9crc.o -o $@ - -v09: v09.o engine.o io.o d09.o trace.o vdisk.o - $(CC) -o v09 $(CFLAGS) v09.o engine.o io.o d09.o trace.o vdisk.o - -# with Coco MMU -v09c: v09.c engine.c io.c d09.o trace.o vdisk.o - $(CC) -o v09c $(CFLAGS) $(V09FLAGS) -DIOPAGE=0xff80 -DUSE_MMU=1 -DUSE_VDISK v09.c engine.c io.c d09.o trace.c vdisk.c - -a09.o : a09.c - $(CC) -c $(CFLAGS) $(V09FLAGS) $< - -v09.o: v09.c - $(CC) -c $(CFLAGS) $(V09FLAGS) $< - -d09 : d09.c - $(CC) -Wno-format-security $(CFLAGS) $(V09FLAGS) $< -o $@ - -d09.o : d09.c - $(CC) -c -DNO_MAIN -Wno-format-security $(CFLAGS) $(V09FLAGS) $< - -engine.o: engine.c - $(CC) -c $(CFLAGS) $(V09FLAGS) $< - -io.o: io.c - $(CC) -c $(CFLAGS) -DUSE_VDISK $(V09FLAGS) $< - -vdisk.o: vdisk.c v09.h - $(CC) -c $(CFLAGS) $(V09FLAGS) $< - -trace.o: trace.c v09.h - $(CC) -c $(CFLAGS) $(V09FLAGS) $< - -v09.rom: makerom monitor.s - ./makerom h + s [count] one step trace (default) + n step over call or os9 system call + f finish this call (until stack pop) (unreliable) + b [adr] set break / watch point (on current physical address) + it stoped on pc==adr or value of adr was changed + B break / watch point list + d [n] delte break point list + c [count] continue; + x disassemble on pc + x [adr] [count] dump + xp page [adr] [count] mmu page dump + xi [adr] [count] disassemble + 0 file disk drive 0 image + 1 file disk drive 1 image + L file start log to file + S file set input file + X exit + q exit + U file upload from srecord file + D file download to srecord file + R do reset (unreliable) + h,? print this + + to see GIME + x 0xff90 + +a09 Assembler for os9 +------------- + + mod eom,name,tylg,atrv,start,size define os9 mod with crc + . data pointer ( same as *, only works just after the mod ) + * code pointer + emod + + os9 os9 system call + end + + fcs generates os9 string with 8th bit on termination + + use use os9 sources ( subsequent use/lib follow the directories ) + + accepts some more chars in names such as $ . _ + + +Links/References +================ + + +Project: + https://github.com/6809/sbc09 + Maintained by the original author and others. + +Source: + http://groups.google.com/group/alt.sources/browse_thread/thread/8bfd60536ec34387/94a7cce3fdc5df67 + Autor: Lennart Benschop lennart@blade.stack.urc.tue.nl, + lennartb@xs4all.nl (Webpage, Subject must start with "Your Homepage"!) diff -r 4fa2bdb0c457 -r 2088fd998865 README.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/README.txt Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,417 @@ +6809 Simulator/Emulator with os9 level1/level2 + Shini KONO (kono@ie.u-ryukyu.ac.jp) Mon Jul 23 10:59:06 JST 2018 + + using nitros9 + hg clone http://hg.code.sf.net/p/nitros9/code nitros9-code + + This emulator support vrbf ( simulate unix directory as a rbf disk ) and + ROM based boot. + + make clean; make + + to run lv1 or lv2 + + make lv1 + or + make lv2 + +======================= + +sbc09 stands for Lennart Benschop 6809 Single Board Computer. +It contains a assembler and simulator for the Motorola M6809 processor. + +copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +license: GNU General Public License version 2, see LICENSE for more details. + + +Forum thread: http://archive.worldofdragon.org/phpBB3/viewtopic.php?f=8&t=4880 +Project: https://github.com/6809/sbc09 + + +For the usage of the assembler a09 and 6809 single board system v09 +read doc/sbc09.creole! + + +This distribution includes two different kinds of simulators: + 1. The old sim6809 based "simple" simulator built as v09s, v09st + 2. The 6809 single board system as a stand alone environment built as v09 + + + +Structure +--------- + +src/ + Source for the developement tools and virtual machines ... + + a09.c + The 6809 assembler. It's fairly portable (ANSI) C. It works on both + Unix and DOS (TC2.0). + + Features of the assembler: + - generates binary file starting at the first address + where code is actually generated. So an initial block of RMB's + (maybe at a different ORG) is not included in the file. + - Accepts standard syntax. + - full expression evaluator. + - Statements SET, MACRO, PUBLIC, EXTERN IF/ELSE/ENDIF INCLUDE not yet + implemented. Some provisions are already made internally for macros + and/or relocatable objects. + + v09s.c + The (old) 6809 simulator. Loads a binary image (from a09) at adress $100 + and starts executing. SWI2 and SWI3 are for character output/input. + SYNC stops simulation. When compiling set -DBIG_ENDIAN if your + computer is big-endian. Set TERM_CONTROL for a crude single character + (instead of ANSI line-by-line) input. Works on Unix. + + v09stc.c + Same as v09s.c but for Turbo C. Has its own term control. + + v09.c + engine.c + io.c + The 6809 single board simulator/emulator v09. + + mon2.asm + Monitor progam, alternative version of monitor.asm + (used in ROM image alt09.rom) + + monitor.asm + Monitor progam (used in ROM image v09.rom for v09) + + makerom.c + Helper tool to generate ROM images for v09. + + +basic/ + Basic interpreters ... + + basic.asm + Tiny Basic + fbasic.asm + Tiny Basic with Lennarts floating point routines. + + +doc/ + Documentation ... + + +examples/ + Several test and benchmark programs, simple routines and some bigger stuff + like a Forth system (ef09). + + ef09.asm Implementation of E-Forth, a very rudimentary and portable Forth. + Type WORDS to see what words you have. You can evaluate RPN integer + expressions, like "12 34 + 5 * . " You can make new words like + " : SQUARED DUP * ; " etc. + + +examples_forth/ + Forth environment with examples. + For the 6809 single board system. + + + + +Notes on Linux Fedora Core 6 +---------------------------- +2012-06-04 + +Compiling v09s, v09st: + + * BIG_ENDIAN (already used by LINUX itself, changed to CPU_BIG_ENDIAN) + Now automatically set according to BIG_ENDIAN and BYTE_ORDER + if existing. + + * If TERM_CONTROL mode is active the keyboard is not really in raw mode - + keyboard signals are still allowed. + + * A tracefilter based on register values can be placed in the TRACE area to + get tracing output triggered by special states + + + +a09 Assembler +------------- + +Bugfixes: + * addres modes a,INDEXREG b,INDEXREG d,INDEXREG now known + as *legal*! + +Extended version: + http://lennartb.home.xs4all.nl/A09.c + (see above) + + * options -x and -s produces output in Intel Binary/Srecord format, + contains the above mentioned bugfixes (but fixed by the original + author). + + + + +v09s* Simulator +--------------- + +### CC register + +E F H I N Z V C Flag +8 7 6 5 4 3 2 1 Bit +| | | | | | | | +| | | | | | | +- $01 +| | | | | | +--- $02 +| | | | | +----- $04 +| | | | +------- $08 +| | | +--------- $10 +| | +----------- $20 +| +------------- $40 ++--------------- $80 + + +# differences from real 6809: + +ldd #$0fc9 +addb #$40 +adca #$00 + +H is set on VCC but not on real 6809, sim6809 does what? + + +### special behavior + + swi2 output character (STDOUT) in register B + swi3 read character from keyboard into register B + sync exit simulator + + +### start program +v09s BINARY + +### start program with tracing output on STDOUT +v09st BINARY + +### run program and leave memory dump (64k) + +# memory dump in file dump.v09 +v09s -d BINARY + + + +### Bugfixes + + * static int index; + otherwise the global C library function index() is referenced! + Write access on it leads to a core dump. + + * BIG_ENDIAN is not useable in FLAG because (POSIX?) Unix + (especially Linux) defines its byte order. + If BIG_ENDIAN == BYTE_ORDER -> architecture is big endian! + Changed to CPU_BIG_ENDIAN, which is refering BIG_ENDIAN and + BYTE_ORDER automatically (if existent). + + + + + + +eForth +------ + +Source: + + ef09.asm + + Backspace character changed from 127 to 8. + + +Memory-Layout: + + 0100 At this address the binary is placed to, the Forth entry point + 03C0 USER area start + 4000 Memory TOP + + +I/O: + Keyboard input: + * ^H or BSP deletes character + * RETURN -> interrupts (long) output + +Start: + + ../v09s ef09 + + +Bugs: + SEE ; + STAR (*) : * UM* DROP ; ... wrong, + : * M* DROP ; ... correct (sign!) + +Typical commands: + + Commands alway in upper case!!! + +WORD list of defined words of the current vocabulary + +BYE exit Forth (back to shell) +DUMP hex memory dump +SEE HL-word decompiler, corrected: + * stops at EXIT + * handles more special primitives (literals, strings, + variable, constants)) + * handles Direct Threading + * output line by line with address +.S shows the content of the parameter stack + +count FOR ... NEXT + replacement for + hi lo DO ... I ... LOOP + hi lo - 1+ FOR ... R@ lo + ... NEXT + + + + +Extensions: + + ZEQUAL 0= Primitive + PLUS1 1+ Primitive, added +2012-06-07 + ROLL ROLL HL, added + CONST CONSTANT HL, added + doCONST Primitive, added + +2012-06-08 + TWOSTAR 2* Primtive, added + TWOSLASH 2/ Primtive, added + MINUS1 1- Primtive, added + SWAPHL >< Primtive, added + STAR256 256* Primtive, added + SLASH256 256/ Primtive, added + CMOVE CMOVE Primtive + FILL FILL Primtive +2012-06-09 + ULESS U< Primitive + LESS < Primitive + DO DO HL, added + QDO ?DO HL, added + DODO (DO) Primitive, added + DOQDO (?DO) Primitive, added + LOOP LOOP HL, added + PLOOP +LOOP HL, added + DOLOOP (LOOP) Primitive, added + DOPLOOP (+LOOP) Primitive, added + +2012-06-11 + NEGAT NEGATE Primitive, alternative added + UMSTA UM* Primitive, but without MUL + LSHIFT LSHIFT Primitive, added + RSHIFT RSHIFT Primitive, added +2012-06-12 + LEAVE LEAVE Primitive, added (fig Forth) + MDO -DO HL, added + DOMDO (-DO) Primitive, added + I I Primitive, added (same as R@) + CMOVEW CMOVE Primitive, other implementation + STAR * korr.: uses M* (instead UM*) + BLANK BL Constant + +2012-06-19 + USLASH U/ Primitive, same as UM/MOD + UM/MOD uses USLASH + +2012-06-20 + DPLUS D+ Primitive + DSUB D- HL + ZERO 0 Constant + ONE 1 Constant + TWO 2 Constant + MONE -1 Constant + DOCLIT doCLIT Primitive +2012-06-21 + SEE SEE extended: handles LIT, CLIT +2012-06-22 + SEE SEE extended: handles + BRANCH,?BRANCH,?DO,-DO,LOOP,+LOOP,."..." + +2012-09-07 + SEE SEE ABORT", (DO) added, remarks corrected. + +TODO: + * XXX marks points to open issues. + * SEE command: + handling of + - [COMPILE] + - DOCONST, DOVAR, DOUSE + + +TEST: + +HEX ok +0 8000 8001 U/ . . FFFE 2 ok +FFFE 8001 U* . . U* ? ok +FFFE 8001 UM* . . 7FFF FFFE ok +FFFE 8001 UM* 2 0 D+ . . 8000 0 ok + +0 8000 7FFF U/ . . FFFF FFFF ok +0 FFFF FFFF U/ . . FFFF FFFF ok +0 FFFE FFFF U/ . . FFFE FFFE ok +FFFF FFFF UM* . . FFFE 1 ok +FFFF FFFE FFFF U/ . . FFFF FFFE ok + + + + + +Links/References +================ + + +Project: + https://github.com/6809/sbc09 + Maintained by the original author and others. + +Source: + http://groups.google.com/group/alt.sources/browse_thread/thread/8bfd60536ec34387/94a7cce3fdc5df67 + Autor: Lennart Benschop lennart@blade.stack.urc.tue.nl, + lennartb@xs4all.nl (Webpage, Subject must start with "Your Homepage"!) + + Newsgroups: alt.sources + From: lennart@blade.stack.urc.tue.nl (Lennart Benschop) + Date: 3 Nov 1993 15:21:16 GMT + Local: Mi 3 Nov. 1993 17:21 + Subject: 6809 assembler and simulator (examples) 2/2 + + +Homepage/Download links of Lennart Benschop: + http://lennartb.home.xs4all.nl/m6809.html + http://lennartb.home.xs4all.nl/sbc09.tar.gz + http://lennartb.home.xs4all.nl/A09.c + + +Emulator for 6809 written in Python, can run sbc09 ROM: + https://github.com/jedie/DragonPy/ + + +Newer posting in alt.sources (1994): + + Newsgroups: alt.sources + From: lenn...@blade.stack.urc.tue.nl (Lennart Benschop) + Date: 17 May 1994 08:13:25 GMT + Local: Di 17 Mai 1994 10:13 + Subject: 6809 assembler/simulator (3 of 3) + + +Referenced by: + + http://foldoc.org/6809 + Reference points to posting with buggy version from 1993. + + http://lennartb.home.xs4all.nl/m6809.html + BAD LINK: http://www.sandelman.ocunix.on.ca/People/Alan_DeKok/interests/6809.html + -> http://www.sandelman.ottawa.on.ca/People/Alan_DeKok/interests/ + 6809 specific site will be redirected, but does not exist. + + Internet-Archiv: + https://web.archive.org/web/20070112041235/http://www.striker.ottawa.on.ca/6809/ + 2014-05-01: Lennart B. lennartb@xs4all.nl has been informed. + + http://archive.worldofdragon.org/phpBB3/viewtopic.php?f=5&t=4308&start=60#p9750 diff -r 4fa2bdb0c457 -r 2088fd998865 WORK.dsk Binary file WORK.dsk has changed diff -r 4fa2bdb0c457 -r 2088fd998865 a09.c --- a/a09.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1695 +0,0 @@ -/* A09, 6809 Assembler2 - - created 1993,1994 by L.C. Benschop. - copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. - license: GNU General Public License version 2, see LICENSE for more details. - THERE IS NO WARRANTY ON THIS PROGRAM. - - Generates binary image file from the lowest to - the highest address with actually assembled data. - - Machin edependencies: - char is 8 bits. - short is 16 bits. - integer arithmetic is twos complement. - - syntax a09 [-o filename] [-l filename] sourcefile. - - Options - -o filename name of the output file (default name minus a09 suffix) - -s filename name of the s-record output file (default its a binary file) - -l filename list file name (default no listing) - -d enable debugging - - recognized pseudoops: - extern public - macro endm if else endif - org equ set setdp - fcb fcw fdb fcc rmb - end include title - - Not all of these are actually IMPLEMENTED!!!!!! - - Revisions: - 1993-11-03 v0.1 - Initial version. - 1994/03/21 v0.2 - Fixed PC relative addressing bug - Added SET, SETDP, INCLUDE. IF/ELSE/ENDIF - No macros yet, and no separate linkable modules. - 2012-06-04 j at klasek at - New: debugging parameter/option. - Fixed additional possible issue PC relative addressing. - Compatibility: Octal number prefix "&". - 2014-07-15 j at klasek at - Fixed usage message. - 2018-07-11 - leax $ED00/256,x kernel offset in map - should be positive offset expr should be int(32bit) -*/ - -#include -#include -#include -#include - -#define NLABELS 2048 -#define MAXIDLEN 16 -#define MAXLISTBYTES 8 -#define FNLEN 30 -#define LINELEN 128 - -static int debug=0; -static struct incl { - char *name; - struct incl *next; -} *incls = 0; - -static struct longer { - int gline; - int change; - struct longer *next; -} *lglist = 0; - - -struct oprecord{char * name; - unsigned char cat; - unsigned short code;}; - -/* Instruction categories: - 0 one byte oprcodes NOP - 1 two byte opcodes SWI2 - 2 opcodes w. imm byte ANDCC - 3 LEAX etc. - 4 short branches. BGE - 5 long branches 2byte opc LBGE - 6 long branches 1byte opc LBRA - 7 accumulator instr. ADDA - 8 double reg instr 1byte opc LDX - 9 double reg instr 2 byte opc LDY - 10 single address instrs NEG - 11 TFR, EXG - 12 push,pull - 13 pseudoops -*/ - -struct oprecord optable[]={ - {"ABX",0,0x3a},{"ADCA",7,0x89},{"ADCB",7,0xc9}, - {"ADDA",7,0x8b},{"ADDB",7,0xcb},{"ADDD",8,0xc3}, - {"ANDA",7,0X84},{"ANDB",7,0xc4},{"ANDCC",2,0x1c}, - {"ASL",10,0x08},{"ASLA",0,0x48},{"ASLB",0,0x58}, - {"ASR",10,0x07},{"ASRA",0,0x47},{"ASRB",0,0x57}, - {"BCC",4,0x24},{"BCS",4,0x25},{"BEQ",4,0x27}, - {"BGE",4,0x2c},{"BGT",4,0x2e},{"BHI",4,0x22}, - {"BHS",4,0x24},{"BITA",7,0x85},{"BITB",7,0xc5}, - {"BLE",4,0x2f},{"BLO",4,0x25},{"BLS",4,0x23}, - {"BLT",4,0x2d},{"BMI",4,0x2b},{"BNE",4,0x26}, - {"BPL",4,0x2a},{"BRA",4,0x20},{"BRN",4,0x21}, - {"BSR",4,0x8d}, - {"BVC",4,0x28},{"BVS",4,0x29}, - {"CLC",1,0x1cfe},{"CLF",1,0x1cbf},{"CLI",1,0x1cef}, - {"CLIF",1,0x1caf}, - {"CLR",10,0x0f},{"CLRA",0,0x4f},{"CLRB",0,0x5f}, - {"CLV",1,0x1cfd}, - {"CMPA",7,0x81},{"CMPB",7,0xc1},{"CMPD",9,0x1083}, - {"CMPS",9,0x118c},{"CMPU",9,0x1183},{"CMPX",8,0x8c}, - {"CMPY",9,0x108c}, - {"COM",10,0x03},{"COMA",0,0x43},{"COMB",0,0x53}, - {"CWAI",2,0x3c},{"DAA",0,0x19}, - {"DEC",10,0x0a},{"DECA",0,0x4a},{"DECB",0,0x5a}, - {"DES",1,0x327f},{"DEU",1,0x335f},{"DEX",1,0x301f}, - {"DEY",1,0x313f}, - {"ELSE",13,1}, - {"EMOD",13,25}, - {"END",13,2}, - {"ENDC",13,3}, - {"ENDIF",13,3}, - {"ENDM",13,4}, - {"EORA",7,0x88},{"EORB",7,0xc8}, - {"EQU",13,5},{"EXG",11,0x1e},{"EXTERN",13,6}, - {"FCB",13,7},{"FCC",13,8}, - {"FCS",13,23}, - {"FCW",13,9}, - {"FDB",13,9}, - {"IF",13,10}, - {"IFEQ",13,30}, - {"IFGT",13,29}, - {"IFNDEF",13,33}, - {"IFNE",13,28}, - {"IFP1",13,21}, - {"INC",10,0x0c},{"INCA",0,0x4c},{"INCB",0,0x5c}, - {"INCLUDE",13,16}, - {"INS",1,0x3261},{"INU",1,0x3341},{"INX",1,0x3001}, - {"INY",1,0x3121},{"JMP",10,0x0e},{"JSR",8,0x8d}, - {"LBCC",5,0x1024},{"LBCS",5,0x1025},{"LBEQ",5,0x1027}, - {"LBGE",5,0x102c},{"LBGT",5,0x102e},{"LBHI",5,0x1022}, - {"LBHS",5,0x1024}, - {"LBLE",5,0x102f},{"LBLO",5,0x1025},{"LBLS",5,0x1023}, - {"LBLT",5,0x102d},{"LBMI",5,0x102b},{"LBNE",5,0x1026}, - {"LBPL",5,0x102a},{"LBRA",6,0x16},{"LBRN",5,0x1021}, - {"LBSR",6,0x17}, - {"LBVC",5,0x1028},{"LBVS",5,0x1029}, - {"LDA",7,0x86},{"LDB",7,0xc6},{"LDD",8,0xcc}, - {"LDS",9,0x10ce},{"LDU",8,0xce},{"LDX",8,0x8e}, - {"LDY",9,0x108e},{"LEAS",3,0x32}, - {"LEAU",3,0x33},{"LEAX",3,0x30},{"LEAY",3,0x31}, - {"LSL",10,0x08},{"LSLA",0,0x48},{"LSLB",0,0x58}, - {"LSR",10,0x04},{"LSRA",0,0x44},{"LSRB",0,0x54}, - {"MACRO",13,11}, - {"MOD",13,24}, - {"MUL",0,0x3d}, - {"NAM",13,26}, - {"NEG",10,0x00},{"NEGA",0,0x40},{"NEGB",0,0x50}, - {"NOP",0,0x12}, - {"OPT",13,19}, - {"ORA",7,0x8a},{"ORB",7,0xca},{"ORCC",2,0x1a}, - {"ORG",13,12}, - {"OS9",13,32}, - {"PAG",13,20}, {"PAGE",13,20}, - {"PSHS",12,0x34},{"PSHU",12,0x36},{"PUBLIC",13,13}, - {"PULS",12,0x35},{"PULU",12,0x37},{"RMB",13,0}, - {"ROL",10,0x09},{"ROLA",0,0x49},{"ROLB",0,0x59}, - {"ROR",10,0x06},{"RORA",0,0x46},{"RORB",0,0x56}, - {"RTI",0,0x3b},{"RTS",0,0x39}, - {"SBCA",7,0x82},{"SBCB",7,0xc2}, - {"SEC",1,0x1a01},{"SEF",1,0x1a40},{"SEI",1,0x1a10}, - {"SEIF",1,0x1a50},{"SET",13,15}, - {"SETDP",13,14},{"SEV",1,0x1a02},{"SEX",0,0x1d}, - {"STA",7,0x87},{"STB",7,0xc7},{"STD",8,0xcd}, - {"STS",9,0x10cf},{"STU",8,0xcf},{"STX",8,0x8f}, - {"STY",9,0x108f}, - {"SUBA",7,0x80},{"SUBB",7,0xc0},{"SUBD",8,0x83}, - {"SWI",0,0x3f},{"SWI2",1,0x103f},{"SWI3",1,0x113f}, - {"SYNC",0,0x13},{"TFR",11,0x1f}, - {"TITLE",13,18}, - {"TST",10,0x0d},{"TSTA",0,0x4d},{"TSTB",0,0x5d}, - {"TTL",13,18}, - {"USE",13,27}, -}; - -struct symrecord{char name[MAXIDLEN+1]; - char cat; - unsigned short value; - struct symrecord *next; - }; - -int symcounter=0; -int os9 = 0; // os9 flag -int rmbmode = 0; // in os9 work area -struct symrecord * prevlp = 0; - -/* expression categories... - ECORD all zeros is ordinary constant. - ECADR bit 1 indicates address within module. - ECEXT bit 2 indicates external address. - ECLBL bit 3 public label - ECABS bit 4 indicates this can't be relocated if it's an address. - ECNEG bit 5 indicates address (if any) is negative. -*/ - - -/* Symbol categories. exprcat ( symcat & 0xe ) - 0 SCC Constant value (from equ). ECORD - 1 SCV Variable value (from set) ECORD - 2 SCC__ADR Address within program module (label). ECADR - 3 SCV__ADR Variable containing address. ECADR - 4 SC_E_ADR Adress in other program module (extern) ECEXT - 5 SCVE_ADR Variable containing external address. ECEXT - 6 SCU _ADR Unresolved address. ECEXT+ECADR - 7 SCV_UADR Variable containing unresolved address. ECEXT+ECADR - 8 SC___LBL Public label. ECLBL - 9 SCMACRO Macro definition. xxx - 10 SCU__LBL Public label (yet undefined). ECADR+ECLBL - 11 SCPARAM parameter name. ECADR+ECLBL - 12 SCLOCAL local label. ECEXT+ECLBL - 13 SCEMPTY empty. xxx -*/ - -struct symrecord symtable[NLABELS]; - -void processfile(char *name); - -struct oprecord * findop(char * nm) -/* Find operation (mnemonic) in table using binary search */ -{ - int lo,hi,i,s; - lo=0;hi=sizeof(optable)/sizeof(optable[0])-1; - do { - i=(lo+hi)/2; - s=strcmp(optable[i].name,nm); - if(s<0) lo=i+1; - else if(s>0) hi=i-1; - else break; - } while(hi>=lo); - if (s) return NULL; - return optable+i; -} - -struct symrecord * findsym(char * nm) { -/* finds symbol table record; inserts if not found - uses binary search, maintains sorted table */ - int lo,hi,i,j,s; - lo=0;hi=symcounter-1; - s=1;i=0; - while (hi>=lo) { - i=(lo+hi)/2; - s=strcmp(symtable[i].name,nm); - if(s<0) lo=i+1; - else if(s>0) hi=i-1; - else break; - } - if(s) { - i=(s<0?i+1:i); - if(symcounter==NLABELS) { - fprintf(stderr,"Sorry, no storage for symbols!!!"); - exit(4); - } - for(j=symcounter;j>i;j--) { - struct symrecord *from = &symtable[j-1]; - if (prevlp == from) prevlp++; - if (from->next && from->next - symtable > i) from->next ++; - symtable[j]=symtable[j-1]; - } - symcounter++; - strcpy(symtable[i].name,nm); - symtable[i].cat=13; - } - return symtable+i; -} - -FILE *listfile,*objfile; -char *listname,*objname,*srcname,*curname; -int lineno,glineno; - -void -outsymtable() -{ - int i,j=0; - fprintf(listfile,"\nSYMBOL TABLE"); - for(i=0;inext) { - if (p->gline==gl) { // already fixed - p->change = 1; - return; - } - } - struct longer *p = (struct longer *)calloc(sizeof(struct longer *),1); - p->gline=gl; - p->next = lglist; - lglist = p; -} - -int longer() { - for(struct longer *p=lglist;p;p=p->next) { - if (p->change == 0) return 1; - } - return 0; -} -void generate() -{ - generating = 1; - if (rmbmode) { - rmbcounter = loccounter; - oldlc = loccounter = prevloc; - rmbmode = 0; - } -} - - -char namebuf[MAXIDLEN+1]; - -void -err(int er) { - error |= er ; -} - -void -scanname() -{ - int i=0; - char c; - while(1) { - c=*srcptr++; - if(c>='a'&&c<='z')c-=32; - if(c!='_'&&c!='@'&&c!='.'&&c!='$'&&(c<'0'||c>'9')&&(c<'A'||c>'Z'))break; - if(i='0'&&namebuf[i]<='F') { - t=t*16+namebuf[i]-'0'; - if(namebuf[i]>'9')t-=7; - i++; - } - if(i==0)error|=1; - return t; -} - -int scanchar() -{ - int t; - srcptr++; - t=*srcptr; - if(t)srcptr++; - if (*srcptr=='\'')srcptr++; - return t; -} - -int scanbin() -{ - char c; - int t=0; - srcptr++; - c=*srcptr++; - while(c=='0'||c=='1') { - t=t*2+c-'0'; - c=*srcptr++; - } - srcptr--; - return t; -} - -int scanoct() -{ - char c; - int t=0; - srcptr++; - c=*srcptr++; - while(c>='0'&&c<='7') { - t=t*8+c-'0'; - c=*srcptr++; - } - srcptr--; - return t; -} - - -int scanlabel() -{ - struct symrecord * p; - scanname(); - p=findsym(namebuf); - if(p->cat==13) { - p->cat=6; - p->value=0; - } - if(p->cat==9||p->cat==11)error|=1; - exprcat=p->cat&14; - if(exprcat==6||exprcat==10)unknown=1; - if(((exprcat==2||exprcat==8) - && (unsigned short)(p->value)>(unsigned short)loccounter)|| - exprcat==4) - certain=0; - if(exprcat==8||exprcat==6||exprcat==10)exprcat=2; - return p->value; -} - - -int scanfactor() -{ - char c; - int t; - skipspace(); - c=*srcptr; - if(isalpha(c))return scanlabel(); - else if(isdigit(c))return scandecimal(); - else switch(c) { - case '*' : srcptr++;exprcat|=2; if(rmbmode) return prevloc; else return loccounter; - case '.' : srcptr++;exprcat|=2; if(os9&&!rmbmode) return rmbcounter; else return loccounter; - case '$' : return scanhex(); - case '%' : return scanbin(); - case '&' : /* compatibility */ - case '@' : return scanoct(); - case '\'' : return scanchar(); - case '(' : srcptr++;t=scanexpr(0);skipspace(); - if(*srcptr==')')srcptr++;else error|=1; - return t; - case '-' : srcptr++;exprcat^=32;return -scanfactor(); - case '+' : srcptr++;return scanfactor(); - case '!' : srcptr++;exprcat|=16;return !scanfactor(); - case '^' : - case '~' : srcptr++;exprcat|=16;return ~scanfactor(); - } - error|=1; - return 0; -} - -#define EXITEVAL {srcptr--;return t;} - -#define RESOLVECAT if((oldcat&15)==0)oldcat=0;\ - if((exprcat&15)==0)exprcat=0;\ - if((exprcat==2&&oldcat==34)||(exprcat==34&&oldcat==2)) {\ - exprcat=0;\ - oldcat=0;}\ - exprcat|=oldcat;\ -/* resolve such cases as constant added to address or difference between - two addresses in same module */ - - -int scanexpr(int level) /* This is what you call _recursive_ descent!!!*/ -{ - int t,u; - char oldcat,c; - exprcat=0; - if(level==10)return scanfactor(); - t=scanexpr(level+1); - while(1) { - // skipspace(); - c=*srcptr++; - switch(c) { - case '*':oldcat=exprcat; - t*=scanexpr(10); - exprcat|=oldcat|16; - break; - case '/':oldcat=exprcat; - u=scanexpr(10); - if(u)t/=u;else error|=1; - exprcat|=oldcat|16; - break; - case '%':oldcat=exprcat; - u=scanexpr(10); - if(u)t%=u;else error|=1; - exprcat|=oldcat|16; - break; - case '+':if(level==9)EXITEVAL - oldcat=exprcat; - t+=scanexpr(9); - RESOLVECAT - break; - case '-':if(level==9)EXITEVAL - oldcat=exprcat; - t-=scanexpr(9); - exprcat^=32; - RESOLVECAT - break; - case '<':if(*(srcptr)=='<') { - if(level>=8)EXITEVAL - srcptr++; - oldcat=exprcat; - t<<=scanexpr(8); - exprcat|=oldcat|16; - break; - } else if(*(srcptr)=='=') { - if(level>=7)EXITEVAL - srcptr++; - oldcat=exprcat; - t=t<=scanexpr(7); - exprcat|=oldcat|16; - break; - } else { - if(level>=7)EXITEVAL - oldcat=exprcat; - t=t':if(*(srcptr)=='>') { - if(level>=8)EXITEVAL - srcptr++; - oldcat=exprcat; - t>>=scanexpr(8); - exprcat|=oldcat|16; - break; - } else if(*(srcptr)=='=') { - if(level>=7)EXITEVAL - srcptr++; - oldcat=exprcat; - t=t>=scanexpr(7); - exprcat|=oldcat|16; - break; - } else { - if(level>=7)EXITEVAL - oldcat=exprcat; - t=t>scanexpr(7); - exprcat|=oldcat|16; - break; - } - case '!':if(level>=6) { - if (*srcptr=='=') { - srcptr++; - oldcat=exprcat; - t=t!=scanexpr(6); - exprcat|=oldcat|16; - } else { - oldcat=exprcat; - t|=scanexpr(6); - exprcat|=oldcat|16; - } - } - break; - case '=':if(level>=6)EXITEVAL - if(*srcptr=='=')srcptr++; - oldcat=exprcat; - t=t==scanexpr(6); - exprcat|=oldcat|16; - break; - case '&':if(level>=5)EXITEVAL - oldcat=exprcat; - t&=scanexpr(5); - exprcat|=oldcat|16; - break; - case '^':if(level>=4)EXITEVAL - oldcat=exprcat; - t^=scanexpr(4); - exprcat|=oldcat|16; - break; - case '|':if(level>=3)EXITEVAL - oldcat=exprcat; - t|=scanexpr(3); - exprcat|=oldcat|16; - default: EXITEVAL - } - } -} - -char mode; /* addressing mode 0=immediate,1=direct,2=extended,3=postbyte - 4=pcrelative(with postbyte) 5=indirect 6=pcrel&indirect*/ -char opsize; /*desired operand size 0=dunno,1=5,2=8,3=16*/ -short operand; -unsigned char postbyte; - -int dpsetting; - - -int scanindexreg() -{ - char c; - c=*srcptr; - if(islower(c))c-=32; - if (debug) fprintf(stderr,"DEBUG: scanindexreg: indexreg=%d, mode=%d, opsize=%d, error=%d, postbyte=%02X\n",c,mode,opsize,error,postbyte); - switch(c) { - case 'X':return 1; - case 'Y':postbyte|=0x20;return 1; - case 'U':postbyte|=0x40;return 1; - case 'S':postbyte|=0x60;return 1; - default: return 0; - } -} - -void -set3() -{ - if(mode<3)mode=3; -} - -void -scanspecial() -{ - set3(); - skipspace(); - if(*srcptr=='-') { - srcptr++; - if(*srcptr=='-') { - srcptr++; - postbyte=0x83; - } else postbyte=0x82; - if(!scanindexreg())error|=2;else srcptr++; - } else { - postbyte=0x80; - if(!scanindexreg())error|=2;else srcptr++; - if(*srcptr=='+') { - srcptr++; - if(*srcptr=='+') { - srcptr++; - postbyte+=1; - } - } else postbyte+=4; - } -} - -void -scanindexed() -{ - set3(); - postbyte=0; - if(scanindexreg()) { - srcptr++; - if(opsize==0) { - if(unknown||!certain)opsize=3; - else if(operand>=-16&&operand<16&&mode==3)opsize=1; - else if(operand>=-128&&operand<128)opsize=2; - else opsize=3; - } - switch(opsize) { - case 1:postbyte+=(operand&31);opsize=0;break; - case 2:postbyte+=0x88;break; - case 3:postbyte+=0x89;break; - } - } else { /*pc relative*/ - if(toupper(*srcptr)!='P')error|=2; - else { - srcptr++; - if(toupper(*srcptr)!='C')error|=2; - else { - srcptr++; - if(toupper(*srcptr)=='R')srcptr++; - } - } - mode++;postbyte+=0x8c; - if(opsize==1)opsize=2; - } -} - -#define RESTORE {srcptr=oldsrcptr;c=*srcptr;goto dodefault;} - -void -scanoperands() -{ - char c,d,*oldsrcptr; - unknown=0; - opsize=0; - certain=1; - skipspace(); - c=*srcptr; - mode=0; - if(c=='[') { - srcptr++; - c=*srcptr; - mode=5; - } - if (debug) fprintf(stderr,"DEBUG: scanoperands: c=%c (%02X)\n",c,c); - switch(c) { - case 'D': case 'd': - oldsrcptr=srcptr; - srcptr++; - skipspace(); - if(*srcptr!=',')RESTORE else { - postbyte=0x8b; - srcptr++; - if(!scanindexreg())RESTORE else {srcptr++;set3();} - } - break; - case 'A': case 'a': - oldsrcptr=srcptr; - srcptr++; - skipspace(); - if(*srcptr!=',')RESTORE else { - postbyte=0x86; - srcptr++; - if(!scanindexreg())RESTORE else {srcptr++;set3();} - } - break; - case 'B': case 'b': - oldsrcptr=srcptr; - srcptr++; - skipspace(); - if(*srcptr!=',')RESTORE else { - postbyte=0x85; - srcptr++; - if (debug) fprintf(stderr,"DEBUG: scanoperands: breg preindex: c=%c (%02X)\n",*srcptr,*srcptr); - if(!scanindexreg())RESTORE else {srcptr++;set3();} - if (debug) fprintf(stderr,"DEBUG: scanoperands: breg: postindex c=%c (%02X)\n",*srcptr,*srcptr); - } - break; - case ',': - srcptr++; - scanspecial(); - break; - case '#': - if(mode==5)error|=2;else mode=0; - srcptr++; - if (*srcptr=='"') { - operand = (srcptr[1]<<8) + srcptr[2] ; - srcptr += 3; - break; - } - operand=scanexpr(0); - break; - case '<': - srcptr++; - if(*srcptr=='<') { - srcptr++; - opsize=1; - } else opsize=2; - goto dodefault; - case '>': - srcptr++; - opsize=3; - default: dodefault: - operand=scanexpr(0); - skipspace(); - if(*srcptr==',') { - srcptr++; - scanindexed(); - } else { - if(opsize==0) { - if(unknown||!certain||dpsetting==-1|| - (unsigned short)(operand-dpsetting*256)>=256) - opsize=3; else opsize=2; - } - if(opsize==1)opsize=2; - if(mode==5){ - postbyte=0x8f; - opsize=3; - } else mode=opsize-1; - } - } - if (debug) fprintf(stderr,"DEBUG: scanoperands: mode=%d, error=%d, postbyte=%02X\n",mode,error,postbyte); - if(mode>=5) { - skipspace(); - postbyte|=0x10; - if(*srcptr!=']')error|=2;else srcptr++; - } - if(pass==2&&unknown)error|=4; -} - -unsigned char codebuf[128]; -int codeptr; /* byte offset within instruction */ -int suppress; /* 0=no suppress 1=until ENDIF 2=until ELSE 3=until ENDM */ -int ifcount; /* count of nested IFs within suppressed text */ - -unsigned char outmode; /* 0 is binary, 1 is s-records */ - -unsigned short hexaddr; -int hexcount; -unsigned char hexbuffer[16]; -unsigned int chksum; - -extern int os9crc(unsigned char c, int crcp); -int crc; - -void -reset_crc() -{ - crc = -1; -} - - -void -flushhex() -{ - int i; - if(hexcount){ - fprintf(objfile,"S1%02X%04X",(hexcount+3)&0xff,hexaddr&0xffff); - for(i=0;i>8)&0xff)+hexcount+3; - fprintf(objfile,"%02X\n",0xff-(chksum&0xff)); - hexaddr+=hexcount; - hexcount=0; - chksum=0; - } -} - -void -outhex(unsigned char x) -{ - if(hexcount==16)flushhex(); - hexbuffer[hexcount++]=x; - chksum+=x; -} - -void -outbuffer() -{ - int i; - for(i=0;i>=1; - } - error = 0; - errors++; -} - -void -outlist() -{ - int i; - fprintf(listfile,"%04X: ",oldlc); - for(i=0;inext; - l->next = 0; - setlabel(l); - } - if(lp) { - if(lp->cat!=13&&lp->cat!=6) { - if(lp->cat!=2||lp->value!=loccounter) - lp->value=loccounter; // error|=8; - } else { - lp->cat=2; - lp->value=loccounter; - } - } -} - -void -putbyte(unsigned char b) -{ - codebuf[codeptr++]=b; -} - -void -putword(unsigned short w) -{ - codebuf[codeptr++]=w>>8; - codebuf[codeptr++]=w&0x0ff; -} - -void -doaddress() /* assemble the right addressing bytes for an instruction */ -{ - int offs; - switch(mode) { - case 0: if(opsize==2)putbyte(operand);else putword(operand);break; - case 1: putbyte(operand);break; - case 2: putword(operand);break; - case 3: case 5: putbyte(postbyte); - switch(opsize) { - case 2: putbyte(operand);break; - case 3: putword(operand); - } - break; - case 4: case 6: offs=(unsigned short)operand-loccounter-codeptr-2; - if(offs<-128||offs>=128||opsize==3||unknown||!certain) { - if((!unknown)&&opsize==2&&(offs<-128||offs>=128) ) { - error|=16; makelonger(glineno); - } - offs--; - opsize=3; - postbyte++; - } - putbyte(postbyte); - if (debug) fprintf(stderr,"DEBUG: doaddress: mode=%d, opsize=%d, error=%d, postbyte=%02X, operand=%04X offs=%d\n",mode,opsize,error,postbyte,operand,offs); - if(opsize==3)putword(offs); - else putbyte(offs); - } -} - -void -onebyte(int co) -{ - putbyte(co); -} - -void -twobyte(int co) -{ - putword(co); -} - -void -oneimm(int co) -{ - scanoperands(); - if(mode>=3) - error|=2; - putbyte(co); - putbyte(operand); -} - -void -lea(int co) -{ - putbyte(co); - scanoperands(); - if(mode==0) error|=2; - if(mode<3) { - opsize=3; - postbyte=0x8f; - mode=3; - } - if (debug) fprintf(stderr,"DEBUG: lea: mode=%d, opsize=%d, error=%d, postbyte=%02X, *src=%c\n",mode,opsize,error,postbyte,*srcptr); - doaddress(); -} - -void -sbranch(int co) -{ - int offs; - scanoperands(); - if(mode!=1&&mode!=2)error|=2; - offs=(unsigned short)operand-loccounter-2; - if(!unknown&&(offs<-128||offs>=128)) { - error|=16;makelonger(glineno); - if (co==0x20) { - if(mode!=1&&mode!=2)error|=2; - putbyte(0x16); - putword(operand-loccounter-3); - } else { - if(mode!=1&&mode!=2)error|=2; - putbyte(0x10); - putbyte(co); - putword(operand-loccounter-4); - } - return; - } - if(pass==2&&unknown)error|=4; - putbyte(co); - putbyte(offs); -} - -void -lbra(int co) -{ - scanoperands(); - if(mode!=1&&mode!=2)error|=2; - putbyte(co); - putword(operand-loccounter-3); -} - -void -lbranch(int co) -{ - scanoperands(); - if(mode!=1&&mode!=2)error|=2; - putword(co); - putword(operand-loccounter-4); -} - -void -arith(int co) -{ - scanoperands(); - switch(mode) { - case 0:opsize=2;putbyte(co);break; - case 1:putbyte(co+0x010);break; - case 2:putbyte(co+0x030);break; - default:putbyte(co+0x020); - } - doaddress(); -} - -void -darith(int co) -{ - scanoperands(); - switch(mode) { - case 0:opsize=3;putbyte(co);break; - case 1:putbyte(co+0x010);break; - case 2:putbyte(co+0x030);break; - default:putbyte(co+0x020); - } - doaddress(); -} - -void -d2arith(int co) -{ - scanoperands(); - switch(mode) { - case 0:opsize=3;putword(co);break; - case 1:putword(co+0x010);break; - case 2:putword(co+0x030);break; - default:putword(co+0x020); - } - doaddress(); -} - -void -oneaddr(int co) -{ - scanoperands(); - switch(mode) { - case 0: error|=2;break; - case 1: putbyte(co);break; - case 2: putbyte(co+0x70);break; - default: putbyte(co+0x60);break; - } - doaddress(); -} - -void -tfrexg(int co) -{ - struct regrecord * p; - putbyte(co); - skipspace(); - scanname(); - if((p=findreg(namebuf))==0)error|=2; - else postbyte=(p->tfr)<<4; - skipspace(); - if(*srcptr==',')srcptr++;else error|=2; - skipspace(); - scanname(); - if((p=findreg(namebuf))==0)error|=2; - else postbyte|=p->tfr; - putbyte(postbyte); -} - -void -pshpul(int co) -{ - struct regrecord *p; - putbyte(co); - postbyte=0; - do { - if(*srcptr==',')srcptr++; - skipspace(); - scanname(); - if((p=findreg(namebuf))==0)error|=2; - else postbyte|=p->psh; - skipspace(); - }while (*srcptr==','); - putbyte(postbyte); -} - -void -skipComma() -{ - while(*srcptr && *srcptr!='\n' && *srcptr!=',')srcptr++; - if (*srcptr==',') { - srcptr++; - } else { - error|=1; - } -} - -void os9begin() -{ - generate(); - os9=1; // contiguous code generation ( seprate rmb and code ) - oldlc = loccounter = rmbcounter = rmbmode = 0; - reset_crc(); - putword(0x87cd); - putword(scanexpr(0)-loccounter); // module size - if(unknown&&pass==2)error|=4; - skipComma(); - putword(scanexpr(0)-loccounter); // offset to module name - if(unknown&&pass==2)error|=4; - skipComma(); - putbyte(scanexpr(0)); // type / language - if(unknown&&pass==2)error|=4; - skipComma(); - putbyte(scanexpr(0)); // attribute - if(unknown&&pass==2)error|=4; - int parity=0; - for(int i=0; i< 8; i++) parity^=codebuf[i]; - putbyte(parity^0xff); // header parity - skipspace(); - while (*srcptr==',') { // there are some more - srcptr++; - putword(scanexpr(0)); - if(unknown&&pass==2)error|=4; - skipspace(); - } - prevloc = codeptr; - rmbmode = 1; // next org works on rmb - rmbcounter=0; - loccounter = 0x10000-codeptr; // should start at 0 -} - -void os9end() -{ - crc = crc ^ 0xffffff; - - putbyte((crc>>16)&0xff); - putbyte((crc>>8)&0xff); - putbyte(crc&0xff); - os9 = 0; -} - - -void -pseudoop(int co,struct symrecord * lp) -{ - int i; - char c; - char *fname; - int locsave; - - switch(co) { - case 0:/* RMB */ - // in OS9 mode, this generates no data - // loccounter will be reset after any code to the current code generation - if (os9 && !rmbmode) { - prevloc = loccounter; - oldlc = loccounter = rmbcounter; - rmbmode = 1; - } - setlabel(lp); - oldlc = loccounter; - operand=scanexpr(0); - if(unknown)error|=4; - loccounter+=operand; - if(generating&&pass==2) { - if(!outmode && !os9 ) { - for(i=0;icat==13||lp->cat==6|| - (lp->value==(unsigned short)operand&&pass==2)) { - if(exprcat==2)lp->cat=2; - else lp->cat=0; - lp->value=oldlc=operand; - } else // else error|=8; - lp->value=oldlc=operand; - } - break; - case 7:/* FCB */ - generate(); - setlabel(lp); - do { - if(*srcptr==',')srcptr++; - skipspace(); - if(*srcptr=='\"') { - srcptr++; - while(*srcptr!='\"'&&*srcptr) - putbyte(*srcptr++); - if(*srcptr=='\"')srcptr++; - } else { - putbyte(scanexpr(0)); - if(unknown&&pass==2)error|=4; - } - skipspace(); - } while(*srcptr==','); - break; - case 8:/* FCC */ - generate(); - setlabel(lp); - skipspace(); - c=*srcptr++; - while(*srcptr!=c&&*srcptr) - putbyte(*srcptr++); - if(*srcptr==c)srcptr++; - break; - case 9:/* FDB */ - generate(); - setlabel(lp); - do { - if(*srcptr==',')srcptr++; - skipspace(); - putword(scanexpr(0)); - if(unknown&&pass==2)error|=4; - skipspace(); - } while(*srcptr==','); - break; - case 23 :/* FCS */ - generate(); - setlabel(lp); - skipspace(); - int sep = *srcptr; - if(sep=='\"' || sep=='/' || sep=='\'') { - srcptr++; - while(*srcptr!=sep&&*srcptr) - putbyte(*srcptr++); - if(*srcptr==sep)srcptr++; - codebuf[codeptr-1] |= 0x80; // os9 string termination - } - break; - case 1: /* ELSE */ - suppress=1; - break; - case 21: /* IFP1 */ - if(pass==2)suppress=2; - break; - case 29: /* IFGT */ - operand=scanexpr(0); - if(operand<=0)suppress=2; - break; - case 31: /* IFLT */ - operand=scanexpr(0); - if(operand>=0)suppress=2; - break; - case 30: /* IFEQ */ - operand=scanexpr(0); - if(operand!=0)suppress=2; - break; - case 28: /* IFNE */ - case 10: /* IF */ - operand=scanexpr(0); - if(operand==0)suppress=2; - break; - case 33: /* IFNDEF */ - operand=scanexpr(0); - if(!unknown)suppress=2; - break; - case 12: /* ORG */ - operand=scanexpr(0); - if(unknown)error|=4; - if(generating&&pass==2&&!outmode&&!os9) { - for(i=0;i<(unsigned short)operand-loccounter;i++) - fputc(0,objfile); - } else flushhex(); - loccounter=operand; - hexaddr=loccounter; - break; - case 14: /* SETDP */ - operand=scanexpr(0); - if(unknown)error|=4; - if(!(operand&255))operand=(unsigned short)operand>>8; - if((unsigned)operand>255)operand=-1; - dpsetting=operand; - break; - case 15: /* SET */ - operand=scanexpr(0); - if(!lp)error|=32; - else { - if(lp->cat&1||lp->cat==6) { - if(exprcat==2)lp->cat=3; - else lp->cat=1; - lp->value=oldlc=operand; - } else // else error|=8; - lp->value=oldlc=operand; - } - break; - case 2: /* END */ - terminate=1; - break; - case 27: /* USE */ - case 16: /* INCLUDE */ - skipspace(); - if(*srcptr=='"')srcptr++; - i = 0; - for(i=0; !(srcptr[i]==0||srcptr[i]=='"'); i++); - int len = i; - fname = calloc(1,len); - for(i=0;ivalue; - } - } - skipspace(); - if(isalnum(*srcptr)) { - scanname(); - op=findop(namebuf); - if(op) { - if(op->cat!=13){ - generate(); - setlabel(lp); - } - co=op->code; - switch(op->cat) { - case 0:onebyte(co);break; - case 1:twobyte(co);break; - case 2:oneimm(co);break; - case 3:lea(co);break; - case 4:sbranch(co);break; - case 5:lbranch(co);break; - case 6:lbra(co);break; - case 7:arith(co);break; - case 8:darith(co);break; - case 9:d2arith(co);break; - case 10:oneaddr(co);break; - case 11:tfrexg(co);break; - case 12:pshpul(co);break; - case 13:pseudoop(co,lp); - } - c=*srcptr; - if (debug) fprintf(stderr,"DEBUG: processline: mode=%d, opsize=%d, error=%d, postbyte=%02X c=%c\n",mode,opsize,error,postbyte,c); - if(c!=' '&&*(srcptr-1)!=' '&&c!=0&&c!=';')error|=2; - } - else error|=0x8000; - } else { - if (lp) { - lp->next = prevlp; - prevlp = lp; // os9 mode label can be data or code - } - } - if(pass==2) { - outbuffer(); - if(listing)outlist(); - } - if(error)report(); - loccounter+=codeptr; -} - -void -suppressline() -{ - struct oprecord * op; - srcptr=srcline; - oldlc=loccounter; - struct symrecord * lp = 0; - codeptr=0; - if(isalnum(*srcptr)) { - scanname();lp=findsym(namebuf); - if (lp) oldlc = lp->value; - if(*srcptr==':')srcptr++; - } - skipspace(); - scanname();op=findop(namebuf); - if(op && op->cat==13) { - if(op->code==10||op->code==13||op->code==29||op->code==28||op->code==21||op->code==30||op->code==31||op->code==33) ifcount++; - else if(op->code==3) { - if(ifcount>0)ifcount--;else if(suppress==1|suppress==2)suppress=0; - } else if(op->code==1) { - if(ifcount==0 && suppress==2)suppress=0; - } - } - if(pass==2&&listing)outlist(); } - -void -usage(char*nm) -{ - fprintf(stderr,"Usage: %s [-o objname] [-l listname] [-s srecord-file] srcname\n",nm); - exit(2); -} - -char * -strconcat(char *s,int spos,char *d) -{ - int slen = strlen(s); - int dlen = strlen(d); - if ( spos == 0) spos = slen; - char *out = calloc(1,spos+dlen+1); - int i = 0; - for(; i< spos; i++ ) out[i] = s[i]; - for(; i< spos+dlen+1; i++ ) out[i] = *d++; - return out; -} - - -void -getoptions(int c,char*v[]) -{ - int i=1; - if(c==1)usage(v[0]); - while(v[i]) { - if(strcmp(v[i],"-d")==0) { - debug=1; - i++; - } else if(strcmp(v[i],"-o")==0) { - objname = v[i+1]; - i+=2; - } else if(strcmp(v[i],"-s")==0) { - objname=v[i+1]; - outmode=1; - i+=2; - } else if(strcmp(v[i],"-l")==0) { - listname=v[i+1]; - i+=2; - } else if(strcmp(v[i],"-I")==0) { - struct incl *j = (struct incl *)malloc(sizeof(struct incl)); - j->name = v[i+1]; - j->next = 0; - if (!incls) incls = j; - else { - struct incl *k=incls ; - for(; k->next ; k = k->next ) ; - k->next = j; - } - i+=2; - } else if(*v[i]=='-') { - usage(v[0]); - } else { - if (srcname) usage(v[0]); - srcname=v[i]; - i++; - } - } - if(objname==0) { - for(i=0;srcname[i]!='.' && srcname[i]!=0 ;i++) ; - objname = strconcat(srcname,i,".b"); - } - listing=(listname!=0); -} - -void -expandline() -{ - int i=0,j=0,k,j1; - for(i=0;i<128&&j<128;i++) - { - if(inpline[i]=='\n') { - srcline[j]=0;break; - } - if(inpline[i]=='\t') { - j1=j; - for(k=0;k<8-j1%8 && j<128;k++)srcline[j++]=' '; - }else srcline[j++]=inpline[i]; - } - srcline[127]=0; -} - - -void -processfile(char *name) -{ - char *oldname; - int oldno; - FILE *srcfile; - oldname=curname; - curname=name; - oldno=lineno; - lineno=0; - if((srcfile=fopen(name,"r"))==0) { - int i = 0; - if (oldname) { - i = strlen(oldname); - while(i>0 && oldname[i]!='/') i--; - } - if (i>0) { - char *next = strconcat(oldname,i+1,name); - if((srcfile=fopen(next,"r"))!=0) { - curname = next; - } - } - if (!srcfile) { - for( struct incl *d = incls; d ; d = d->next) { - char *next = strconcat(d->name,0,name); - if((srcfile=fopen(next,"r"))!=0) { - curname = next; - break; - } - } - } - } - if (!srcfile) { - fprintf(stderr,"Cannot open source file %s\n",name); - exit(4); - } - while(!terminate&&fgets(inpline,128,srcfile)) { - expandline(); - lineno++; glineno++; - srcptr=srcline; - if(suppress) - suppressline(); - else - processline(); - } - setlabel(0); // process prevlp - fclose(srcfile); - if(suppress) { - fprintf(stderr,"improperly nested IF statements in %s",curname); - errors++; - suppress=0; - } - lineno=oldno; - curname=oldname; -} - -int -main(int argc,char *argv[]) -{ - char c; - getoptions(argc,argv); - pass=1; - errors=0; - generating=0; - terminate=0; - processfile(srcname); - if(errors) { - fprintf(stderr,"%d Pass 1 Errors, Continue?",errors); - c=getchar(); - if(c=='n'||c=='N') exit(3); - } - do { - pass=2; - prevloc = 0; - loccounter=0; - rmbcounter=0; - errors=0; - generating=0; - terminate=0; - glineno=0; - if(listing&&((listfile=fopen(listname,"w"))==0)) { - fprintf(stderr,"Cannot open list file"); - exit(4); - } - if((objfile=fopen(objname,outmode?"w":"wb"))==0) { - fprintf(stderr,"Cannot write object file\n"); - exit(4); - } - processfile(srcname); - fprintf(stderr,"%d Pass 2 errors.\n",errors); - if(listing) { - fprintf(listfile,"%d Pass 2 errors.\n",errors); - outsymtable(); - fclose(listfile); - } - if(outmode){ - flushhex(); - fprintf(objfile,"S9030000FC\n"); - } - fclose(objfile); - } while (longer()); - return 0; -} - diff -r 4fa2bdb0c457 -r 2088fd998865 alt09.rom Binary file alt09.rom has changed diff -r 4fa2bdb0c457 -r 2088fd998865 basic/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/Makefile Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,52 @@ +# +# Makefile examples SBC09/Sim6809 +# +# created 1994 by L.C. Benschop +# 2014-06-25 - J.E. Klasek +# +# copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +# license: GNU General Public License version 2, see LICENSE for more details. +# + +ASM=../a09 + +PROGS=basic fbasic + +OTHER=floatnum.inc makeflot + + +all: $(ASM) $(PROGS) + +$(ASM): + $(MAKE) -c ../src a09 install + +# ------------------------------------ +# rules + +.SUFFIXES: .asm + +.asm: + $(ASM) -l $@.lst $< + +# ------------------------------------ + +basic: basic.asm + + +fbasic: fbasic.asm floatnum.inc + $(ASM) -l $@.lst fbasic.asm + +floatnum.inc: floatnum.src makeflot + ./makeflot < floatnum.src > floatnum.inc + +makeflot: makeflot.c + + +# ------------------------------------ + +cleanall: clean + rm -f $(PROGS) $(OTHER) + +clean: + rm -f core *.BAK *.lst $(PROGS) + diff -r 4fa2bdb0c457 -r 2088fd998865 basic/README.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/README.txt Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,165 @@ +BASIC AND FLOATING POINT ROUTINES FOR THE 6809 +============================================== + +sbc09 stands for Lennart Benschop 6809 Single Board Computer. +It contains a assembler and simulator for the Motorola M6809 processor. + +copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +license: GNU General Public License version 2, see LICENSE for more details. + + + +FLOATING POINT ROUTINES FOR THE 6809 +------------------------------------ + +They are intended to be used with the sbc09 system. These routines +should be fairly portable to any 6809-based system. + +As it is an unfinished program (intended to become a full-featured +BASIC interpreter one day), I never released it before and I almost +forgot about it. Fortunately it was still on a backup CD-R that I +made in 2001. + + +FILES +- - - + +makeflot.c Conversion tool to convert floatnum.src to floatnum.inc + +floatnum.inc Floating point constants to be included in main program. +floatnum.src Same constants, but not converted to binary. + +fbasic.asm RPN calculator with floating point (just to test the FP routines. + This was intended to be part of a larger Basic interpreter, + but this was never finished). + +basic.asm Tiny Basic +basic.txt Tiny Basic instructions + +It was originally planned to turn this into a full-fledged BASIC +interpreter (maybe somewhat like BBC Basic), but this never +happened. It is now a rudimentary RPN calculator, just to test the +floating point routines. Each number or command needs to be on a separate +line. + + + + +MAKE THE PROGRAMS +- - - - - - - - - + +Simple: + +make + + +Or in single steps: + +compile the helper tool ... + +./makeflot floatnum.inc + + +assemble the FP calculator ... + +./a09 fbasic.asm + + +assemble Tiny Basic (integer only) ... + +./a09 basic.asm + + + + +RUN THE PROGRAMS +- - - - - - - - + + +Start the board simulator + +../v09 + +You should see the prompt "Welcome to BUGGY version 1.0" + +Type the command + +xl400 + +Press the escape character Control-] +(e.g. on Linux for a german style keyboard Control+AltGr+9) + +Then you see the v09> prompt. + +Type the command + +ufbasic + +Now the file "fbasic" will be uploaded to the board. + +Type the command + +g400 + +Now you can type floating point numbers and commands (RPN style), each +on a different line, like this + +2 +3 +* + 6.00000000E+00 + +1 +0 +/ + +The last calculation breaks back to the monitor. + +The following commands are available (see the source): ++ - * / (the normal arithmetic operators). += compare top two numbers on stack (and leave them), show < = or > +i round to integer (round to -Inf, like BASIC INT() function). +q square root +s sin +c cos +t tan +a atan +l ln +e exp +d duplicate number on stack +x exchange top numbers on stack. +r remove top of stack. + + + +IMPLEMENTATION NOTES +- - - - - - - - - - + +This is a 40-bit float, like many microcomputers of the 80s had, +including the Commodore 64, the ZX-Spectrum, the BBC and others. It +has an 8-bit exponent and a 32-bit mantissa (with hidden leading bit). +The basic operations (including square root) should be as accurate as +can be expected. + +It does not do IEEE-754 features, such as Infinity, NaN, +/-zero and +subnormal numbers, but appears to work quite reasonably. + +Trig functions deviate a few places in the 9th decimal. In particular +sin(pi/2) shows as 9.99999998E-01 instead of 1.00000000E+00. I +consider this acceptable and consistent with what could be expected. + +The Log function deviates a few places in the 8th decimal. LN(5) appears to +be about worst-case. I find this a bit disappointing. + +2 +l +5 +l ++ +e + +should show exactly 10, but it shows 9.99999970E+00 instead. This is +not caused by the exp function, but by the log of 5 (as I checked with +Python). + + diff -r 4fa2bdb0c457 -r 2088fd998865 basic/basic.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/basic.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,1108 @@ + ;NAM TB01V137 +* WRITTEN 20-OCT-77 BY JOHN BYRNS +* REVISED 30-DEC-77 +* REVISED 18-JAN-78 +* REVISED 10-APR-78 +* REVISED 08-MAY-79 TO ELIMINATE USE OF SP +* REVISED 24-JAN-80 TO USE 6801 ON CHIP RAM +* REVISED 26-JAN-80 FOR NEW 6801 INSTRUCTIONS +* REVISED 24-JUL-81 FOR WHISTON BOARD +* REVISED 24-SEP-81 INCLUDE USER FUNCTION +* REVISED 08-APR-82 MAKE STANDALONE INCLUDE HEX CONSTANTS AND MEM FUNCTION +* REVISED 21-NOV-84 FOR 6809 +* REVISED FEB 94 ADAPTED TO SIMULATOR AND BUGFIXES BY L.C. BENSCHOP. +* +EOL EQU $04 +ETX EQU $03 +SPACE EQU $20 +CR EQU $0D +LF EQU $0A +BS EQU $08 +CAN EQU $18 +BELL EQU $07 +FILL EQU $00 +DEL EQU $7F +BSIZE EQU 73 +STKCUS EQU 48 +* +ACIA EQU $E000 +RMCR EQU ACIA +TRCS EQU ACIA +RECEV EQU ACIA+1 +TRANS EQU ACIA+1 +CNTL1 EQU $03 +CNTL2 EQU $15 +RDRF EQU $01 +ORFE EQU $20 +TDRE EQU $02 +* EDIT THE FOLLOWING EQUATES TO REFLECT THE +* DESIRED ROM AND RAM LAYOUT +LORAM EQU $0080 ADDRESS OF DIRECT PAGE SCRATCH RAM +BUFFER EQU $4000 ADDRESS OF MAIN RAM +RAMSIZ EQU $2000 SIZE OF MAIN RAM +ROMADR EQU $400 ADDRESS OF TINY BASIC ROM +* +RAMBEG EQU BUFFER+BSIZE +RAMEND EQU BUFFER+RAMSIZ +* +RAMPAT EQU $AA0F +ROMPAT EQU $F055 +* + ORG LORAM +USRBAS RMB 2 +USRTOP RMB 2 +STKLIM RMB 2 +STKTOP RMB 2 +CURSOR RMB 2 +SAVESP RMB 2 +LINENB RMB 2 +SCRTCH RMB 2 +CHAR RMB 2 +ZONE RMB 1 +MODE RMB 1 +RESRVD RMB 1 +LOEND EQU * +* + ORG ROMADR +BASIC JMP SETUP +WARMS LDS STKTOP + JSR INTEEE + BRA WMS05 +SETUP LDS #RAMEND-52 +SET03 STS STKTOP + JSR INTEEE +CLEAR LDD #RAMBEG + STD USRBAS + STD USRTOP +CLR02 STD STKLIM +WMS05 JSR CRLF + LDX #VSTR + JSR PUTSTR +CMDB LDS STKTOP + CLR MODE + JSR CRLF + LDX USRBAS + STX CURSOR +CMDE LDX #0000 + STX LINENB + TST MODE + BNE CMD01 + LDA #': + JSR PUTCHR +CMD01 JSR GETLIN + JSR TSTNBR + BCC CMD02 + BVS CMD05 + JSR SKIPSP + CMPA #EOL + BEQ CMDE + JSR MSLINE + BRA CMDB +CMD02 PSHS X + LDX USRTOP + CMPX STKLIM + PULS X + BEQ CMD03 + JMP ERRORR +CMD03 ADDD #0 + BEQ CMD05 +CMD04 PSHS D + SUBD #9999 + PULS D + BHI CMD05 + BSR EDITOR + BRA CMDE +CMD05 JMP ERRORS +VSTR FCC /TINY V1.37/ + FCB EOL +****************************** +****************************** +EDITOR PSHS D + JSR SKIPSP + STX SCRTCH + LDA 0,S + LDX CURSOR + CMPX USRTOP + BEQ ED00 + CMPD 0,X + BCC ED01 +ED00 LDX USRBAS +ED01 JSR FNDLIN + STX CURSOR + BCS ED04 + STX SAVESP + LEAX 2,X +ED02 LDA ,X+ + CMPA #EOL + BNE ED02 +ED03 CMPX USRTOP + BEQ ED35 + LDA ,X+ + STX CHAR + LDX SAVESP + STA ,X+ + STX SAVESP + LDX CHAR + BRA ED03 +ED35 LDX SAVESP + STX USRTOP + STX STKLIM +ED04 LDX SCRTCH + LDB #-1 +ED05 INCB + LDA ,X+ + CMPA #EOL + BNE ED05 + TSTB + BNE ED55 + LEAS 2,S + RTS +ED55 LEAX -1,X + ADDB #4 +ED06 LEAX -1,X + DECB + LDA 0,X + CMPA #SPACE + BEQ ED06 + LDA #EOL + STA 1,X + CLRA + LDX USRTOP + STX CHAR + ADDD USRTOP + STD USRTOP + STD STKLIM + JSR TSTSTK + BCC ED07 + STX USRTOP + STX STKLIM + JMP ERRORF +ED07 LDX USRTOP +ED08 STX SAVESP + LDX CHAR + CMPX CURSOR + BEQ ED09 + LDA ,-X + STX CHAR + LDX SAVESP + STA ,-X + BRA ED08 +ED09 PULS D + LDX CURSOR + STD ,X++ + STX CHAR +ED10 LDX SCRTCH + LDA ,X+ + STX SCRTCH + LDX CHAR + STA ,X+ + STX CHAR + CMPA #EOL + BNE ED10 + RTS +****************************** +****************************** +PUTS01 JSR PUTCHR + LEAX 1,X +PUTSTR LDA 0,X + CMPA #EOL + BNE PUTS01 + RTS +****************************** +****************************** +CRLF LDX #CRLFST + BSR PUTSTR + CLR ZONE + RTS +CRLFST FCB CR,LF,DEL,FILL,FILL,FILL,EOL +****************************** +****************************** +ERRORF BSR ER01 + FCC /SORRY/ + FCB EOL +ERRORS BSR ER01 + FCC /WHAT ?/ + FCB EOL +ERRORR BSR ER01 + FCC /HOW ?/ + FCB EOL +BREAK BSR ER01 + FCC /BREAK/ + FCB EOL +END BSR ER01 + FCC /STOP/ + FCB EOL +ER01 BSR CRLF + LDA #BELL + JSR PUTCHR + LDD LINENB + JSR PRNT4 + LDA #SPACE + JSR PUTCHR + PULS X + BSR PUTSTR + BSR CRLF + JMP CMDB +****************************** +****************************** +GL00 BSR CRLF +GETLIN LDX #BUFFER +GL03 JSR GETCHR + CMPA #SPACE + BCS GL05 + CMPA #$7F + BEQ GL03 + CMPX #BUFFER+BSIZE-1 + BNE GL04 + LDA #BELL + BRA GL02 +GL04 STA ,X+ +GL02 JSR PUTCHR + BRA GL03 +GL05 CMPA #BS + BEQ GL07 + CMPA #CAN + BEQ GL00 + CMPA #LF + BEQ GL09 + CMPA #CR + BNE GL03 + TST MODE + BEQ GL06 + JSR PUTCHR + BRA GL08 +GL06 PSHS X + JSR CRLF + PULS X +GL08 LDA #EOL + STA 0,X + LDX #BUFFER + RTS +GL07 CMPX #BUFFER + BEQ GL03 + LEAX -1,X + LDA #BS + JSR PUTCHR + LDA #SPACE + JSR PUTCHR + LDA #BS + BRA GL02 +GL09 ORCC #$01 + ROR MODE + BRA GL02 +****************************** +****************************** +REM00 LEAX 1,X +REM BSR SKIPSP + CMPA #EOL + BNE REM00 +ENDSMT JSR TSTEOL +ENDS02 LDA LINENB + ORA LINENB+1 + BEQ REM09 +REM05 CMPX USRTOP + BNE NXTLIN + JMP ERRORR +NXTLIN LDD ,X++ + STD LINENB +MSLINE JSR TSTBRK + BSR IFAN + BCS IMPLET + PSHS D +REM09 RTS +IMPLET JMP LET +****************************** +****************************** +IFAN BSR SKIPSP + STX CURSOR + LDX #VERBT +FAN00 LDA ,X+ + CMPA #EOL + BNE FAN04 + LDX CURSOR + ORCC #$01 + RTS +FAN04 STX CHAR + LDX CURSOR + STX SCRTCH +FAN05 LDX SCRTCH + CMPA 0,X + BNE FAN07 + LEAX 1,X + STX SCRTCH + LDX CHAR + LDA ,X+ + STX CHAR + CMPA #EOL + BNE FAN05 + LDD 0,X + LDX SCRTCH + ANDCC #$FE + RTS +FAN07 LDX CHAR +FAN08 LDA ,X+ + CMPA #EOL + BNE FAN08 + LEAX 2,X + BRA FAN00 +****************************** +****************************** +NXTNSP LEAX 1,X +SKIPSP LDA 0,X + CMPA #SPACE + BEQ NXTNSP + RTS +****************************** +****************************** +TSTHEX BSR TSTDIG + BCC TST05 + CMPA #'A + BCS TST03 + CMPA #'F + BHI TST03 + SUBA #'A-10 + ANDCC #$FE + RTS +****************************** +****************************** +TSTLTR CMPA #'A + BCS TST03 + CMPA #'Z + BLS TST05 +TST03 ORCC #$01 + RTS +****************************** +****************************** +TSTDIG CMPA #'0 + BCS TST03 + CMPA #'9 + BHI TST03 + SUBA #'0 +TST05 ANDCC #$FE + RTS +****************************** +****************************** +TSTVAR BSR SKIPSP + BSR TSTLTR + BCS TSTV03 + TFR A,B + LDA 1,X + BSR TSTLTR + BCC TST03 + LEAX 1,X + SUBB #'A + ASLB + CLRA + ADDD STKTOP +TSTV02 ANDCC #$FE +TSTV03 RTS +****************************** +****************************** +USER JSR ARGONE + PSHS D + JSR SKIPSP + CMPA #', + BEQ USER03 + CMPA #') + ORCC #$01 + BEQ USER05 +USER02 JMP ERRORS +USER03 LEAX 1,X + JSR EXPR + PSHS A + JSR SKIPSP + CMPA #') + PULS A + BNE USER02 + ANDCC #$FE +USER05 LEAX 1,X + STX CURSOR + JSR [,S++] + LDX CURSOR + ANDCC #$FE + RTS +****************************** +****************************** +TSTSNB JSR SKIPSP + CMPA #'- + BNE TSTNBR + LEAX 1,X + BSR TSTNBR + BCS TSN02 + NEGA + NEGB + SBCA #0 + ANDCC #$FC +TSN02 RTS +****************************** +****************************** +TSTNBR JSR SKIPSP + JSR TSTDIG + BCC TSTN02 + CMPA #'$ + ORCC #$01 + BNE TSTN09 +TSTN20 LEAX 1,X + CLR ,-S + CLR ,-S +TSTN23 LDA 0,X + JSR TSTHEX + BCS TSTN07 + LEAX 1,X + PSHS X + PSHS A + LDD 3,S + BITA #$F0 + BNE TSTN11 + ASLB + ROLA + ASLB + ROLA + ASLB + ROLA + ASLB + ROLA + ADDB ,S+ + STD 2,S + PULS X + BRA TSTN23 +TSTN02 LEAX 1,X + PSHS A + CLR ,-S +TSTN03 LDA 0,X + JSR TSTDIG + BCS TSTN07 + LEAX 1,X + PSHS X + PSHS A + LDD 3,S + ASLB + ROLA + BVS TSTN11 + ASLB + ROLA + BVS TSTN11 + ADDD 3,S + BVS TSTN11 + ASLB + ROLA + BVS TSTN11 + ADDB 0,S + ADCA #0 + BVS TSTN11 + STD 3,S + LEAS 1,S + PULS X + BRA TSTN03 +TSTN07 PULS D + ANDCC #$FE +TSTN09 ANDCC #$FD + RTS +TSTN11 LDX 1,S + LEAS 5,S + ORCC #$03 + RTS +****************************** +****************************** +TSTSTK STS SAVESP + LDD SAVESP + SUBD #STKCUS + SUBD STKLIM + RTS +****************************** +****************************** +PEEK JSR PAREXP + PSHS D + PSHS X + LDB [2,S] + PULS X + LEAS 2,S + CLRA + RTS +****************************** +****************************** +POKE JSR PAREXP + PSHS D + JSR SKIPSP + CMPA #'= + BEQ POKE05 + JMP ERRORS +POKE05 LEAX 1,X + JSR EXPR + JSR TSTEOL + PSHS X + STB [2,S] + PULS X + LEAS 2,S + JMP ENDS02 +****************************** +****************************** +TSTFUN JSR SKIPSP + STX CURSOR + LDX #FUNT + JSR FAN00 + BCS TSTF05 + PSHS D +TSTF05 RTS +****************************** +****************************** +FUNT FCC /USR/ + FCB EOL + FDB USER + FCC /PEEK/ + FCB EOL + FDB PEEK + FCC /MEM/ + FCB EOL + FDB TSTSTK + FCB EOL +****************************** +****************************** +FLINE LDX USRBAS +FNDLIN CMPX USRTOP + BNE FND03 + ORCC #$03 + RTS +FND03 CMPD 0,X + BNE FND05 + ANDCC #$FC + RTS +FND05 BCC FND07 + ORCC #$01 + ANDCC #$FD + RTS +FND07 PSHS A + LDA #EOL + LEAX 1,X +FND09 LEAX 1,X + CMPA 0,X + BNE FND09 + PULS A + LEAX 1,X + BRA FNDLIN +****************************** +****************************** +RELEXP BSR EXPR + PSHS D + CLRB + JSR SKIPSP + CMPA #'= + BEQ REL06 + CMPA #'< + BNE REL03 + LEAX 1,X + INCB + JSR SKIPSP + CMPA #'> + BNE REL05 + LEAX 1,X + ADDB #4 + BRA REL07 +REL03 CMPA #'> + BNE EXPR06 + LEAX 1,X + ADDB #4 + JSR SKIPSP +REL05 CMPA #'= + BNE REL07 +REL06 LEAX 1,X + ADDB #2 +REL07 PSHS B + BSR EXPR + PSHS X + SUBD 3,S + TFR CC,A + LSRA + TFR A,B + ASLA + ASLA + PSHS B + ADDA ,S+ + ANDA #$06 + BNE REL08 + INCA +REL08 CLRB + ANDA 2,S + BEQ REL09 + COMB +REL09 CLRA + PULS X + LEAS 3,S + RTS +****************************** +****************************** +EXPR CLR ,-S + CLR ,-S + JSR SKIPSP + CMPA #'- + BEQ EXPR05 + CMPA #'+ + BNE EXPR03 +EXPR02 LEAX 1,X +EXPR03 BSR TERM +EXPR04 ADDD 0,S + STD 0,S + JSR SKIPSP + CMPA #'+ + BEQ EXPR02 + CMPA #'- + BNE EXPR06 +EXPR05 LEAX 1,X + BSR TERM + NEGA + NEGB + SBCA #0 + BRA EXPR04 +EXPR06 PULS D + RTS +****************************** +****************************** +TERM JSR FACT + PSHS D +TERM03 JSR SKIPSP + CMPA #'* + BEQ TERM07 + CMPA #'/ + BEQ TERM05 + PULS D + RTS +TERM05 LEAX 1,X + BSR FACT + PSHS X + LEAX 2,S + PSHS D + EORA 0,X + JSR ABSX + LEAX 0,S + JSR ABSX + PSHS A + LDA #17 + PSHS A + CLRA + CLRB +DIV05 SUBD 2,S + BCC DIV07 + ADDD 2,S + ANDCC #$FE + BRA DIV09 +DIV07 ORCC #$01 +DIV09 ROL 7,S + ROL 6,S + ROLB + ROLA + DEC 0,S + BNE DIV05 + LDA 1,S + LEAS 4,S + TSTA + BPL TERM06 + LEAX 2,S + BSR NEGX +TERM06 PULS X + BRA TERM03 +TERM07 LEAX 1,X + BSR FACT +MULT PSHS B + LDB 2,S + MUL + LDA 1,S + STB 1,S + LDB 0,S + MUL + LDA 2,S + STB 2,S + PULS B + MUL + ADDA 0,S + ADDA 1,S + STD 0,S + BRA TERM03 +****************************** +****************************** +FACT JSR TSTVAR + BCS FACT03 + PSHS X + TFR D,X + LDD 0,X + PULS X +FACT02 RTS +FACT03 JSR TSTNBR + BCC FACT02 + JSR TSTFUN + BCC FACT02 +PAREXP BSR ARGONE + PSHS A + JSR SKIPSP + CMPA #') + PULS A + BNE FACT05 + LEAX 1,X + RTS +FACT05 JMP ERRORS +****************************** +****************************** +ARGONE JSR TSTSTK + BCC FACT04 + JMP ERRORF +FACT04 JSR SKIPSP + CMPA #'( + BNE FACT05 + LEAX 1,X + JMP EXPR +****************************** +****************************** +ABSX TST 0,X + BPL NEG05 +NEGX NEG 0,X + NEG 1,X + BCC NEG05 + DEC 0,X +NEG05 RTS +****************************** +****************************** +TSTEOL PSHS A + JSR SKIPSP + CMPA #EOL + BEQ TEOL03 + JMP ERRORS +TEOL03 LEAX 1,X + PULS A + RTS +****************************** +****************************** +LET JSR TSTVAR + BCC LET03 + JMP ERRORS +LET03 PSHS D + JSR SKIPSP + CMPA #'= + BEQ LET05 + JMP ERRORS +LET05 LEAX 1,X + JSR EXPR + BSR TSTEOL + STX CURSOR + PULS X + STD 0,X + LDX CURSOR + JMP ENDS02 +****************************** +****************************** +IF JSR RELEXP + TSTB + BEQ IF03 + JMP MSLINE +IF03 JMP REM +****************************** +****************************** +GOTO JSR EXPR + BSR TSTEOL + JSR FLINE + BCS GOSB04 + JMP NXTLIN +****************************** +****************************** +GOSUB JSR EXPR + BSR TSTEOL + STX CURSOR + JSR FLINE + BCC GOSB03 +GOSB04 JMP ERRORR +GOSB03 JSR TSTSTK + BCC GOSB05 + JMP ERRORF +GOSB05 LDD CURSOR + PSHS D + LDD LINENB + PSHS D + JSR NXTLIN + PULS D + STD LINENB + PULS X + JMP ENDS02 +****************************** +****************************** +RETURN EQU TSTEOL +****************************** +****************************** +PRINT JSR SKIPSP +PR01 CMPA #', + BEQ PR05 + CMPA #'; + BEQ PR07 + CMPA #EOL + BEQ PR04 + CMPA #'" + BNE PR02 + LEAX 1,X + BSR PRNTQS + BRA PR03 +PR02 JSR EXPR + PSHS X + BSR PRNTN + PULS X +PR03 JSR SKIPSP + CMPA #', + BEQ PR05 + CMPA #'; + BEQ PR07 + CMPA #EOL + BEQ PR04 + JMP ERRORS +PR04 PSHS X + JSR CRLF + PULS X + BRA PR08 +PR05 LDB #$7 +PR06 LDA #SPACE + JSR PUTCHR + BITB ZONE + BNE PR06 +PR07 LEAX 1,X + JSR SKIPSP + CMPA #EOL + BNE PR01 +PR08 LEAX 1,X + JMP ENDS02 +* +* +PRQ01 JSR PUTCHR +PRNTQS LDA ,X+ + CMPA #EOL + BNE PRQ03 + JMP ERRORS +PRQ03 CMPA #'" + BNE PRQ01 + RTS +* +PRNTN TSTA + BPL PRN03 + NEGA + NEGB + SBCA #0 + PSHS A + LDA #'- + JSR PUTCHR + PULS A +PRN03 LDX #PRNPT-2 +PRN05 LEAX 2,X + CMPD 0,X + BCC PRN07 + CMPX #PRNPTO + BNE PRN05 +PRN07 CLR CHAR +PRN09 CMPD 0,X + BCS PRN11 + SUBD 0,X + INC CHAR + BRA PRN09 +PRN11 PSHS A + LDA #'0 + ADDA CHAR + JSR PUTCHR + PULS A + CMPX #PRNPTO + BEQ PRN13 + LEAX 2,X + BRA PRN07 +PRN13 RTS +PRNPT FDB 10000 + FDB 1000 + FDB 100 + FDB 10 +PRNPTO FDB 1 +* +PRNT4 LDX #PRNPT+2 + BRA PRN07 +****************************** +****************************** +INPUT JSR TSTVAR + BCS IN11 + PSHS D + STX CURSOR +IN03 LDA #'? + JSR PUTCHR + JSR GETLIN +IN05 JSR SKIPSP + CMPA #EOL + BEQ IN03 + JSR TSTSNB + BCC IN07 + LDX #RMESS + JSR PUTSTR + JSR CRLF + BRA IN03 +IN07 STX SCRTCH + PULS X + STD 0,X + LDX CURSOR + JSR SKIPSP + CMPA #', + BEQ IN09 + JMP ENDSMT +IN09 LEAX 1,X + JSR TSTVAR + BCC IN13 +IN11 JMP ERRORS +IN13 PSHS D + PSHS X + LDX SCRTCH + JSR SKIPSP + CMPA #', + BNE IN05 + LEAX 1,X + BRA IN05 +RMESS FCC /RE-ENTER/ + FCB EOL +****************************** +****************************** +RUN LDX STKTOP + LDA #52 +RUN01 CLR ,X+ + DECA + BNE RUN01 + LDX USRBAS + JMP REM05 +****************************** +****************************** +LIST JSR TSTNBR + BCC LIST03 + CLRA + CLRB + STD CURSOR + LDA #$7F + BRA LIST07 +LIST03 STD CURSOR + JSR SKIPSP + CMPA #', + BEQ LIST05 + LDA CURSOR + BRA LIST07 +LIST05 LEAX 1,X + JSR TSTNBR + BCC LIST07 + JMP ERRORS +LIST07 JSR TSTEOL + PSHS D + LDD CURSOR + STX CURSOR + JSR FLINE +LIST09 CMPX USRTOP + BEQ LIST10 + PULS D + CMPD 0,X + BCS LIST11 + PSHS D + LDD ,X++ + PSHS X + JSR PRNT4 + PULS X + LDA #SPACE + JSR PUTCHR + JSR PUTSTR + LEAX 1,X + PSHS X + JSR CRLF + PULS X + JSR TSTBRK + BRA LIST09 +LIST10 LEAS 2,S + LDA #ETX + JSR PUTCHR +LIST11 LDX CURSOR + JMP ENDS02 +****************************** +****************************** +VERBT FCC /LET/ + FCB EOL + FDB LET + FCC /IF/ + FCB EOL + FDB IF + FCC /GOTO/ + FCB EOL + FDB GOTO + FCC /GOSUB/ + FCB EOL + FDB GOSUB + FCC /RETURN/ + FCB EOL + FDB RETURN + FCC /POKE/ + FCB EOL + FDB POKE + FCC /PRINT/ + FCB EOL + FDB PRINT + FCC /INPUT/ + FCB EOL + FDB INPUT + FCC /REM/ + FCB EOL + FDB REM + FCC /STOP/ + FCB EOL + FDB END + FCC /END/ + FCB EOL + FDB END + FCC /RUN/ + FCB EOL + FDB RUN + FCC /LIST/ + FCB EOL + FDB LIST + FCC /NEW/ + FCB EOL + FDB CLEAR + FCC /?/ + FCB EOL + FDB PRINT + FCB EOL +****************************** +****************************** +TSTBRK bsr BRKEEE + beq GETC05 +GETCHR bsr INEEE + CMPA #ETX + BNE GETC05 + JMP BREAK +GETC05 RTS +PUTCHR INC ZONE + JMP OUTEEE +****************************** +****************************** +INEEE BSR BRKEEE + BEQ INEEE + LDA RECEV + ANDA #$7F + RTS +OUTEEE PSHS A +OUT01 LDA TRCS + BITA #TDRE + BEQ OUT01 + PULS A + STA TRANS + RTS +BRKEEE PSHS A +BRK03 LDA TRCS + BITA #ORFE + BEQ BRK05 + LDA RECEV + BRA BRK03 +BRK05 BITA #RDRF + PULS A + RTS +* + LDA #CNTL1 + STA RMCR + LDA #CNTL2 + STA TRCS +INTEEE EQU * + RTS + + + +****************************** +****************************** + END diff -r 4fa2bdb0c457 -r 2088fd998865 basic/basic.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/basic.txt Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,92 @@ + TINY BASIC SUMMARY + +Editing Standard Basic + +Direct Mode All Verbs Usable + +Statement Types + + PRINT Item List + LET Var = Expr (LET is optional) + IF Expr Relop Expr Statement + INPUT Variable List + GOTO Line Number + GOSUB Line Number + RETURN + POKE POKE(Expr) = Expr + STOP + LIST Line Number, Line Number (Line Numbers are optional) + RUN + NEW + +Functions + + USR Variable = USR(Expr,Expr) + PEEK Variable = PEEK(Expr) + MEM Variable = MEM + +Number Integers to _+32767 or Hex Integers preceded by a $ symbol + +Variable Letters A-Z + +Expression Variables, Numbers, and Functions combined with the following + operators +, -, *, /, (, ). + +Relop Comparison operators =, <, >, <=, >=, <>. + +Line Number Numbers 1 through 9999 + +String "ALPHANUMERICS" + +Item List Expressions and Strings seperated by format control + characters , and ;. + +Control Chars. Control H or "Back Space" deletes last input character. + Control X or "Cancel" deletes entire input line. + Control C Terminates Basic program or List operation and + returns control to command mode. + +Memory Usage Tiny Basic V1.37 + +$0080 - $009F Tiny Basic interpreter scratch area. +$00A0 - $00FD Not used by Tiny Basic interpreter. (usable USR routines) +$**** - $**** Pointer to Interrupt Vector Table. (Identical to LILBUG) +$D800 - $DFFF Input Buffer, Basic Program storage, Stack Space, and + Variables in RAM. +$**** - $**** Optional Power Up Basic Program and/or USR functions in ROM. +$E800 - $EFFF Tiny Basic interpreter ROM. + +$E800 Cold Start Address. +$E803 Warm Start Address. + + Tiny Basic USR Function + +The USR function in Tiny Basic takes 2 arguments and returns a value to a +variable. The form of the USR function is "LET V = USR(Expr,Expr)". +The USR function can be used in any expression in Tiny Basic as an example +"LET V = A * ( B + USR( $EF00, K))". The USR function can also be used with +the PRINT statement. + +The first argument of the USR function is evaluated to determine the address +or the machine language code to be called. The second argument is evaluated +and the value is send to the machine code routine in the D accumulator. The +second argument is optional, if it is present the Carry bit in the condition +code register will be cleared when the machine code routine is called. If the +second argument is not present the Carry Bit will be set when the machine code +is called. The machine code routine may return a result to the BASIC program +in the D accumulator, the value in the D accumulator on return from the machine +code routine will be used by the BASIC program as the value of the function. + +The machine code routine must execute a RTS instruction to return conterol to +the BASIC program. The machine code routine may use all the processor registers +freely and need not save and restore any registers. It is important that the +machine code routine not modify any memory used by the Tiny Basic interpreter. +Consult the memory map provided with your version of Tiny Basic to determine +which memory areas are not used. + +Tiny Basic handles interrupts with the same interrupt vectoring technique used +by LILBUG. Consult the LILBUG manual for details on interrupt vector usage. + + + + JPB 12-APR-82 diff -r 4fa2bdb0c457 -r 2088fd998865 basic/exampl.bas --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/exampl.bas Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,18 @@ +10 REM SYRACUSE SEQUENCES. +20 PRINT "ENTER A POSITIVE NUMBER"; +30 INPUT K +40 IF K>0 GOTO 70 +50 PRINT "ERROR" +60 GOTO 20 +70 N=0 +80 PRINT K, +90 IF K=1 GOTO 160 +100 IF K<>2*(K/2) GOTO 130 +110 K=K/2 +120 GOTO 140 +130 K=3*K+1 +140 N=N+1 +150 GOTO 80 +160 PRINT +170 PRINT "CONVERGED TO 1 IN ";N;" STEPS." +180 END diff -r 4fa2bdb0c457 -r 2088fd998865 basic/fbasic.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/fbasic.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,1344 @@ + ;FBASIC, Floating point BASIC. + + ;This is not a BASIC interpreter, but a simple RPN calculator + ;to test the floating point routines. As such it is not a finished + ;application. + ;Written in 1996 by Lennart Benschoo. + ; + ;2014-07-26: Added welcome message, a few more comments. + + ;Configuration info, change this for different apps. +ROM equ 0 ;Flag to indicate that BASIC is in ROM +ROMSTART equ $8000 ;First ROM address. +RAMSTART equ $400 ;First RAM address. +RAMTOP equ $8000 ;Last RAM address +1. + +PROGORG equ ROM*ROMSTART+(1-ROM)*RAMSTART + + ;First the O.S. vectors in the zero page. + org $0000 +* First the I/O routine vectors. +getchar rmb 3 ;Jump to getchar routine. +putchar rmb 3 ;Jump to putchar routine. +getline rmb 3 ;Jump to getline routine. +putline rmb 3 ;Jump to putline routine. +putcr rmb 3 ;Jump to putcr routine. +getpoll rmb 3 ;Jump to getpoll routine. +xopenin rmb 3 ;Jump to xopenin routine. +xopenout rmb 3 ;Jump to xopenout routine. +xabortin rmb 3 ;Jump to xabortin routine. +xclosein rmb 3 ;Jump to xclosein routine. +xcloseout rmb 3 ;Jump to xcloseout routine. +delay rmb 3 ;Jump to delay routine. + +timer equ *+6 ;3-byte timer. +linebuf equ $200 ;Input line buffer +xerrvec equ $280+6*3 ;Error vector. + +* Now BASIC's own zero-page allocations. + org $40 +startprog rmb 2 ;Start of BASIC program. +endprog rmb 2 ;End of BASIC program. +endvar rmb 2 ;End of variable area. +fpsp rmb 2 ;Floating point stack pointer (grows up). +endmem rmb 2 + +intbuf rmb 4 ;Buffer to store integer. +intbuf2 rmb 4 +bcdbuf rmb 5 ;Buffer for BCD conversion. + +endstr rmb 2 ;End address of string. +dpl rmb 1 ;Decimal point location. + +* The BASIC interpreter starts here. + org PROGORG +cold jmp docold +warm bra noboot + +* Cold start routine. +docold ldx #RAMTOP + stx endmem + tfr x,s + ldu #FREEMEM + stu startprog + clr ,u+ + clr ,u+ + stu endprog + ldx PROGEND + leax 1,x + beq noboot ;Test for autoboot program. + ldx #PROGEND + stx startprog + jmp dorun +noboot jsr doclear + ;; Print a welcome message first. + ldx #nbmesg + ldb #nbmend-nbmesg + jsr putline + jsr putcr + ldd #$4000 + std fpsp + ldu fpsp + ;; Main loop. This is a simple RPN calculator that treat +nbloop ldx #$5000 + ldb #20 + jsr getline + clr b,x + cmpb #1 + lbne donum ; All commands are single-character, everything + ; else is treated as a number. Also the single-character lines that + ; are not commands are later parsed as numbers. + ldb ,x + cmpb #'+' ; Add + bne nb1 + jsr fpadd + lbra doprint +nb1 cmpb #'-' ; Subtract + bne nb2 + jsr fpsub + lbra doprint +nb2 cmpb #'*' ; Multiply + bne nb3 + jsr fpmul + lbra doprint +nb3 cmpb #'/' ; Divide + bne nb4 + jsr fpdiv + lbra doprint +nb4 cmpb #'q' ; Square root. + bne nb5 + jsr fpsqrt + lbra doprint +nb5 cmpb #'i' ; Round to -Inf INT() in BASIC. + bne nb6 + jsr fpfloor + lbra doprint +nb6 cmpb #'s' ; SIN() function + bne nb7 + jsr fpsin + lbra doprint +nb7 cmpb #'=' ; Compare top two numbers Show < = or > + bne nb8 + jsr fpcmp + beq nbeq + bcc nbgt + ldb #'<' + bra nbcmp +nbeq ldb #'=' + bra nbcmp +nbgt ldb #'>' +nbcmp leau -10,u + jsr putchar + jsr putcr + bra nbloop +nb8 cmpb #'c' ; COS() function. + bne nb9 + jsr fpcos + bra doprint +nb9 cmpb #'t' ; TAN() function. + bne nb10 + jsr fptan + bra doprint +nb10 cmpb #'a' ; ATAN() function. + bne nb11 + jsr fpatan + bra doprint +nb11 cmpb #'e' ; EXP() function. + bne nb12 + jsr fpexp + bra doprint +nb12 cmpb #'l' ; LN() function. + bne nb13 + jsr fln + bra doprint +nb13 cmpb #'d' ; Duplicate top number on stack. + bne nb14 + jsr fpdup + bra doprint ; Exchange top two numbers on stack. +nb14 cmpb #'x' + bne nb15 + jsr fpexg + bra doprint +nb15 cmpb #'r' ; Drop top from stack. + bne nb16 + leau -5,u + bra doprint +nb16 +donum ldy #$5000 + jsr scannum + lbra nbloop +doprint ldy #$5000 + jsr fpdup + jsr fpscient + ldx #$5000 + ldb ,x+ + jsr putline + jsr putcr + lbra nbloop +nbmesg fcc "Welcome to RPN calculator" +nbmend + +doclear rts +dorun swi +makefree rts + +* Floating point primitives. + +* U is the floating point stack pointer and points to the first free +* location. Each number occupies 5 bytes, +* Format: byte0: binary exponent $00-$FF $80 means number in range 1..2. +* byte1-byte4 binary fraction between 1.0 and 2.0, msb would +* always be set, but replaced by sign. +* Special case: all bytes zero, number=0. + +* Exchange top two numbers on stack. +fpexg ldx -2,u + ldd -7,u + stx -7,u + std -2,u + ldx -4,u + ldd -9,u + stx -9,u + std -4,u + lda -5,u + ldb -10,u + sta -10,u + stb -5,u + rts + +fpdup leax -5,u +* Load fp number from address X and push onto stack. +fplod ldd ,x++ + std ,u++ + ldd ,x++ + std ,u++ + lda ,x+ + sta ,u+ +fckmem tfr s,d + stu fpsp + subd fpsp + subd #40 + lbcs makefree ;Test for sufficient free space. + rts + +* Pop fp number from stack and store into address X. +fpsto lda -5,u + sta ,x+ + ldd -4,u + std ,x++ + ldd -2,u + std ,x++ + leau -5,u + rts + +* Compare magnitude (second-top). +fpcmpmag lda -10,u + cmpa -5,u ;Compare exponents. + bne cmpend + ldd -4,u + anda #$7F ;Eliminate sign bit. + std ,--s + ldd -9,u + anda #$7F ;Eliminate sign bit. + subd ,s++ ;Compare msb of mantissa. + bne cmpend + ldd -7,u + subd -2,u + bne cmpend +cmpend rts + +* Test a top number for 0. +fptest0 tst -5,u + bne cmpend + ldd -4,u + bne cmpend + ldd -2,u + rts + +* Floating point subtraction. +fpsub jsr fpneg + +* Floating point addition. +fpadd bsr fpcmpmag ;First compare magnitudes. + bcc fpadd1 + jsr fpexg ;Put the biggest one second. +fpadd1 bsr fptest0 + beq fpaddend ;Done if smallest number is 0. + lda -10,u + suba -5,u ;Determine exponent difference. + cmpa #32 + bhi fpaddend ;Done if difference too big. + ldb -9,u + andb #$80 + stb ,-s ;Store sign of biggest number. + eorb -4,u + stb ,-s ;Store difference of signs. + ldb -9,u + orb #$80 + stb -9,u + ldb -4,u + orb #$80 + stb -4,u ;Put the hidden msbs back in. + clr ,u ;Make extra mantissa byte. + tsta + beq fpadd2b ;Skip the alignment phase. +fpalign lsr -4,u + ror -3,u + ror -2,u + ror -1,u ;Shift the smaller number right to align + ror ,u + deca + bne fpalign +fpadd2b tst ,s+ + bmi dosub ;Did signs differ? Then subtract. + ldd -7,u ;Add the mantissas. + addd -2,u + std -7,u + ldd -9,u + adcb -3,u + adca -4,u + std -9,u + bcc fpadd2 +fpadd2a inc -10,u ;Sum overflowed, inc exp, shift mant. + lbeq fpovf ;If exponent overflowed, too bad. + ror -9,u + ror -8,u + ror -7,u + ror -6,u + ror ,u +fpadd2 tst ,u + bpl fpadd3 ;test msb of extra mantissa byte. + ldd -7,u ;Add 1 to mantissa if this is set + addd #1 + std -7,u + bcc fpadd3 + ldd -9,u + clr ,u + addd #1 + std -9,u + bcs fpadd2a +fpadd3 ldb -9,u + andb #$7F + eorb ,s+ + stb -9,u ;Put original sign back in. +fpaddend leau -5,u + rts +dosub ldb ,u + negb + stb ,u + ldd -7,u ;Signs differed, so sbutract. + sbcb -1,u + sbca -2,u + std -7,u + ldd -9,u + sbcb -3,u + sbca -4,u + std -9,u + bmi fpadd2 ;Number still normalized, then done. + ldd -9,u + bne fpnorm + ldd -7,u + bne fpnorm + tst ,u + beq fpundf ;If mantissa exactly zero, underflow. +fpnorm tst -10,u ;dec exp, shift mant left + beq fpundf ;Underflow, put a zero in. + dec -10,u + asl ,u + rol -6,u + rol -7,u + rol -8,u + rol -9,u + bpl fpnorm ;Until number is normalized. + bra fpadd2 + +fpundf clr -10,u ;Underflow, substitute zero. + clr -9,u + clr -8,u + clr -7,u + clr -6,u + leas 1,s ;Discard the sign on stack. + bra fpaddend + +* Compare Floating Point Numbers, flags as with unsigned comparison. +fpcmp lda -9,u + anda #$80 + sta ,-s + lda -4,u + anda #$80 + suba ,s+ ;Subtract the signs, subtraction is reversed. + bne fpcmpend + tst -9,u + bmi fpcmpneg ;Are numbers negative? + jmp fpcmpmag +fpcmpneg jsr fpcmpmag + beq fpcmpend + tfr cc,a + eora #$1 + tfr a,cc ;Reverse the carry flag. +fpcmpend rts + +* Multiply floating point numbers. +fpmul lda -9,u + eora -4,u + anda #$80 + sta ,-s ;Sign difference to stack. + jsr fptest0 ;Test one operand for 0 + beq fpundf + ldd -7,u + bne fpmula + ldd -9,u + bne fpmula ;And the other one. + ldb -10,u + beq fpundf +fpmula ldb -9,u + orb #$80 + stb -9,u + ldb -4,u + orb #$80 + stb -4,u ;Put hidden msb back in. + lda -10,u + suba #$80 ;Make unbiased signed num of exponents. + sta ,-s + lda -5,u + suba #$80 + adda ,s+ ;add exponents. + bvc fpmul1 ;Check over/underflow + lbmi fpovf + bra fpundf +fpmul1 adda #$80 ;Make exponent biased again. + sta -10,u ;Store result exponent. +* Now perform multiplication of mantissas to 40-bit product. +* 0,u--4,u product. 5,u--9,u added term +* Having a mul instruction is nice, but using it for an efficient +* multiprecision multiplicaton is hard. This routine has 13 mul instructions. + lda -1,u + ldb -8,u + mul ;b4*a2 + sta 4,u + lda -1,u + ldb -9,u + mul ;b4*a1 + addb 4,u + adca #0 + std 3,u + lda -2,u + ldb -7,u + mul ;b3*a3 + sta 9,u + lda -2,u + ldb -8,u + mul ;b3*a2 + addb 9,u + adca #0 + std 8,u + lda -2,u + ldb -9,u + mul ;b3*a1 + addb 8,u + adca #0 + std 7,u + ldd 8,u + addd 3,u + std 3,u + ldb 7,u + adcb #0 + stb 2,u ;Add b4*a and b3*a partial products. + lda -3,u + ldb -6,u + mul ;b2*a4 + sta 9,u + lda -3,u + ldb -7,u + mul ;b2*a3 + addb 9,u + adca #0 + std 8,u + lda -3,u + ldb -8,u + mul ;b2*a2 + addb 8,u + adca #0 + std 7,u + lda -3,u + ldb -9,u ;b2*a1 + mul + addb 7,u + adca #0 + std 6,u + ldd 8,u + addd 3,u + std 3,u + ldd 6,u + adcb 2,u + adca #0 + std 1,u ;Add b2*a partial product in. + lda -4,u + ldb -6,u + mul ;b1*a4 + std 8,u + lda -4,u + ldb -7,u + mul ;b1*a3 + addb 8,u + adca #0 + std 7,u + lda -4,u + ldb -8,u + mul ;b1*a2 + addb 7,u + adca #0 + std 6,u + lda -4,u + ldb -9,u + mul ;b1*a1 + addb 6,u + adca #0 + std 5,u + ldd 8,u + addd 3,u + std -6,u + ldd 6,u + adcb 2,u + adca 1,u + std -8,u + ldb 5,u + adcb #0 + stb -9,u ;Add product term b1*a in, result to dest. + bmi fpmul2 + asl -5,u + rol -6,u + rol -7,u + rol -8,u + rol -9,u ;Normalize by shifting mantissa left. + bra fpmul3 +fpmul2 inc -10,u ;increment exponent. + lbeq fpovf ;Test for overflow. +fpmul3 tst -5,u + lbpl fpadd3 + ldd -7,u ;Add 1 if msb of 5th nibble is set. + addd #1 + std -7,u + lbcc fpadd3 + ldd -9,u + addd #1 + std -9,u + bcs fpmul4 ;It could overflow. + lbra fpadd3 +fpmul4 clr -5,u + bra fpmul2 + +* Divide floating point numbers. +fpdiv lda -9,u + eora -4,u + anda #$80 + sta ,-s ;Sign difference to stack. + jsr fptest0 ;Test divisor for 0 + lbeq fpovf + ldd -7,u + bne fpdiva + ldd -9,u + bne fpdiva ;And the other one. + ldb -10,u + lbeq fpundf +fpdiva ldb -9,u + orb #$80 + stb -9,u + ldb -4,u + orb #$80 + stb -4,u ;Put hidden msb back in. + lda -5,u + suba #$80 ;Make unbiased signed difference of exponents. + sta ,-s + lda -10,u + suba #$80 + suba ,s+ ;subtract exponents. + bvc fpdiv1 ;Check over/underflow + lbmi fpovf + lbra fpundf +fpdiv1 adda #$80 ;Make exponent biased again. + sta -10,u ;Store result exponent. +* Now start the division of mantissas. Temprorary 34-bit quotient in 0,u--4,u +* -5,u is extra byte of dividend. + lda #34 + sta ,-s + clr ,u + clr 1,u + clr 2,u + clr 3,u + clr 4,u + clr -5,u +fpdivloop asl 4,u ;Shift quotient left. + rol 3,u + rol 2,u + rol 1,u + rol ,u + ldd -7,u ;Perform trial subtraction. + subd -2,u + std -7,u + ldd -9,u + sbcb -3,u + sbca -4,u + std -9,u + ldb -5,u + sbcb #0 + bcc fpdiv2 + ldd -7,u ;Undo the trial subtraction. + addd -2,u + std -7,u + ldd -9,u + adcb -3,u + adca -4,u + std -9,u + bra fpdiv4 +fpdiv2 stb -5,u ;Store new msb of quotient. + lda 4,u ;Add 1 to quotient. + adda #$40 + sta 4,u +fpdiv4 asl -6,u ;Shift dividend left. + rol -7,u + rol -8,u + rol -9,u + rol -5,u + dec ,s + bne fpdivloop + leas 1,s + ldd 3,u + std -6,u + ldd 1,u + std -8,u + ldb ,u + stb -9,u ;Move quotient to final location. + bmi fpdiv3 +fpdiv5 asl -5,u + rol -6,u + rol -7,u + rol -8,u + rol -9,u ;Normalize by shifting mantissa left. + ldb -10,u ;decrement exponent. + lbeq fpundf ;Test for underflow. + decb + stb -10,u +fpdiv3 tst -5,u + lbpl fpadd3 + ldd -7,u ;Add 1 if msb of 5th nibble is set. + addd #1 + std -7,u + lbcc fpadd3 + ldd -9,u + addd #1 + std -9,u + lbcs fpmul4 ;This addition could overflow. + lbra fpadd3 + +* Floating point negation. +fpneg jsr fptest0 + beq fpnegend ;Do nothing if number equals zero. + lda -4,u + eora #$80 + sta -4,u ;Invert the sign bit. +fpnegend rts + +* Convert unsigned double number at X to float. +ufloat leau 5,u ;Make room for extra number on stack. + ldd ,x + std -4,u + ldd 2,x + clr -5,u +uf16 std -2,u ;Transfer integer to FP number. + jsr fptest0 + beq ufzero + ldb #$9f ;Number is not zero. + stb -5,u + tst -4,u + bmi ufdone +ufloop dec -5,u ;Decrement exponent. + asl -1,u + rol -2,u + rol -3,u + rol -4,u ;Shift mantissa. + bpl ufloop ;until normalized. +ufdone ldb -4,u + andb #$7f + stb -4,u ;Remove the hidden msb. +ufend jmp fckmem ;Check that fp stack does not overflow +ufzero clr -5,u ;Make exponent zero as well. + bra ufend + +* Convert unsigned 16-bit integer in D to floating point. +unint2fp clr ,-s + bra i2fp2 +* Convert signed 16-bit integer in D to floating point. +int2fp sta ,-s ;Store sign byte. + bpl i2fp2 + comb + coma + addd #1 ;Negate D if negative. +i2fp2 leau 5,u + clr -4,u + clr -5,u + clr -3,u ;Clear msb + jsr uf16 + tst ,s+ + bmi fpneg + rts ;Negate number if it was negative. + +* Convert float to unsigned 32-bit integer at X. +* A is nonzero if number was not integer or zero. +uint ldd -4,u + ora #$80 ;Put the hidden msb back in. + std ,x + ldd -2,u + std 2,x ;Transfer mantissa. + clra + ldb -5,u + cmpb #$80 ;If less than 1, it's 0 + blo uizero + cmpb #$9f + lbhi intrange ;2^32 or higher, that's too bad. + beq uidone +uiloop lsr ,x + ror 1,x + ror 2,x + ror 3,x ;Adjust integer by shifting to right + adca #0 ;Add any shifted out bit into A. + incb + cmpb #$9f + blo uiloop +uidone leau -5,u + rts +uizero inca ; Indicate non-integer. + clr ,x ; Number is zero + clr 1,x + clr 2,x + clr 3,x + leau -5,u + rts + +* Convert fp number to signed or unsigned 16-bit number in D. +* Acceptable values are -65535..65535. +fp2uint ldb -5,u + stb ,-s ;Store sign. + ldx #intbuf + bsr uint + ldx ,x + lbne intrange ;Integer must be in 16-bit range. + ldd intbuf+2 + tst ,s+ + bpl fp2iend + comb + coma + addd #1 ;Negate number if negative. +fp2iend rts +* Convert fp number to signed 16-bit number in D. +fp2int ldb -5,u + stb ,-s ;Store sign of FP number. + bsr fp2uint + pshs d + eora ,s+ + lbmi intrange ;Compare sign to what it should be. + puls d,pc + +* Scan a number at address Y and convert to integer or floating point +scannum jsr skipspace + clr ,-s ;Store sign on stack. + cmpb #'-' ;Test for minus sign. + bne sn1 + inc ,s ;Set sign on stack + ldb ,y+ +sn1 jsr scanint ;First scan the number as an integer. + ldx #intbuf + jsr ufloat ;Convert to float. + ldb -1,y +sn1loop cmpb #'.' + bne sn1c + tst dpl ;If dpl already set, accept no other point. + bne sn1d + inc dpl + ldb ,y+ + bra sn1loop +sn1c subb #'0' + blo sn1d + cmpb #9 + bhi sn1d + clra + jsr int2fp ;Convert digit to fp + jsr fpexg + ldx #fpten + jsr fplod + jsr fpmul ;Multiply original number by 10. + jsr fpadd ;Add digit to it. + tst dpl + beq sn1k + inc dpl ;Adjust dpl (one more digit after .) +sn1k ldb ,y+ + bra sn1loop +sn1d tst ,s+ + beq sn1a + jsr fpneg ;Negate the number if negative. +sn1a clr ,-s + clr ,-s ;Prepare exponent part on stack. + ldb -1,y + cmpb #'e' + beq sn1e + cmpb #'E' + bne sn1f ;Test for exponent part. +sn1e ldb ,y+ + clr ,-s ;Prepare exponent sign on stack. + cmpb #'+' + beq sn1g + cmpb #'-' + bne sn1h + inc ,s ;Set sign to negative. +sn1g ldb ,y+ +sn1h lda dpl + pshs a + clr dpl + inc dpl + jsr scanint ;Scan the exponent part. + puls a + sta dpl ;Restore dpl. + lda intbuf + ora intbuf+1 + ora intbuf+2 + lbne fpovf ;Exponent may not be greater than 255. + ldb intbuf+3 + lbmi fpovf ;Not even greater than 127. + tst ,s+ + beq sn1i + negb +sn1i sex + std ,s +sn1f ldb dpl + beq sn1j + decb +sn1j negb + sex + addd ,s++ ;Add exponent part as well + pshs d + ldx #fpten + jsr fplod + puls d + jsr fpipower + jsr fpmul +sn1b rts + +* Scan integer number below 1e9 at address Y, first digit in B. +scanint clr dpl +scanint1 clr intbuf + clr intbuf+1 + clr intbuf+2 + clr intbuf+3 ;Initialize number +snloop cmpb #'.' + bne sn2a ;Test for decimal point. + tst dpl + bne sndone ;Done if second point found. + inc dpl ;Set dpl to indicate decimal point. + bra sn3 +sn2a subb #'0' + blo sndone + cmpb #9 + bhi sndone ;Check that character is a digit. + tst dpl + beq sn2b + inc dpl ;Incremend deecimal point loc if set. +sn2b pshs b + ldd intbuf+2 + aslb + rola + std intbuf+2 + std intbuf2+2 + ldd intbuf + rolb + rola + std intbuf + std intbuf2 + asl intbuf+3 + rol intbuf+2 + rol intbuf+1 + rol intbuf + asl intbuf+3 + rol intbuf+2 + rol intbuf+1 + rol intbuf + ldd intbuf+2 + addd intbuf2+2 + std intbuf +2 + ldd intbuf + adcb intbuf2+1 + adca intbuf2 + std intbuf ;Multiply the integer by 10 + ldd intbuf+2 + addb ,s+ ;Add the digit in. + adca #0 + std intbuf+2 + bcc sn2 + ldd intbuf + addd #1 + std intbuf +sn2 ldd intbuf + cmpd #$5f5 + blo sn3 + bhi snovf + ldd intbuf+2 ;note $5f5e100 is 100 million + cmpd #$e100 ;Compare result to 100 million + bhs snovf +sn3 ldb ,y+ ;get next digit. + bra snloop +snovf ldb ,y+ ;get next digit. +sndone ldb -1,y + rts + +*Convert integer at X to BCD. +int2bcd clr bcdbuf + clr bcdbuf+1 + clr bcdbuf+2 + clr bcdbuf+3 + clr bcdbuf+4 + ldb #4 +tstzero tst ,x+ + bne bcd1 + decb + bne tstzero ;Skip bytes that are zero. + bra sndone ;Done if number already zero. +bcd1 stb ,-s ;Store number of bytes. + leax -1,x +bcdloop ldb #8 +bcdloop1 rol ,x ;Get next bit of binary nunber + lda bcdbuf+4 + adca bcdbuf+4 + daa + sta bcdbuf+4 + lda bcdbuf+3 + adca bcdbuf+3 + daa + sta bcdbuf+3 + lda bcdbuf+2 + adca bcdbuf+2 + daa + sta bcdbuf+2 + lda bcdbuf+1 + adca bcdbuf+1 + daa + sta bcdbuf+1 + lda bcdbuf + adca bcdbuf + daa + sta bcdbuf ;Add BCD number to itself plus the extra bit. + decb + bne bcdloop1 + leax 1,x + dec ,s + bne bcdloop + leas 1,s ;Remove counter from stack. + rts + +* Raise fp number to an integer power contained in D. +fpipower sta ,-s ;Store sign of exponent. + bpl fppow1 ;Is exponent negative. + coma + comb + addd #1 ;Take absolute value of exponent. +fppow1 std ,--s ;Store the exponent. + ldx #fpone + jsr fplod ;Start with number one. +fppowloop lsr ,s + ror 1,s ;Divide exponent by 2. + bcc fppow2 ;Test if it was odd. + leax -10,u + jsr fplod + jsr fpmul ;Multiply result by factor. +fppow2 ldd ,s + beq fppowdone ;Is exponent zero? + leax -10,u + jsr fplod + jsr fpdup + jsr fpmul ;Sqaure the factor. + leax -15,u + jsr fpsto ;Store it in its place on stack. + bra fppowloop +fppowdone leas 2,s ;Remove exponent. + tst ,s+ + bpl fppow3 ;Was exponent negative? + ldx #fpone + jsr fplod + jsr fpexg + jsr fpdiv :compute 1/result. +fppow3 jsr fpexg + leau -5,u ;Remove factor from stack. + rts + + +* Convert fp number to string at address Y in scientific notation. +fpscient ldb #15 + stb ,y+ ;Store the string length. + lda #' ' + ldb -4,u + bpl fpsc1 + lda #'-' +fpsc1 sta ,y+ ;Store - or space depending on sign. + andb #$7f + stb -4,u ;Make number positive. + clr ,-s ;Store decimal exponent (default 0) + jsr fptest0 + beq fpsc2 ;Test for zero + lda -5,u + suba #$80 + suba #$1D ;Adjust exponent. + bvc fpsc11a + lda #-128 +fpsc11a sta ,-s ;store it to recover sign later. + bpl posexp + nega ;Take absolute value. +posexp ldb #5 + mul + lsra + rorb + lsra + rorb + lsra + rorb + lsra + rorb ;multiply by 5/16 approx 10log 2 + cmpb #37 + bls expmax + ldb #37 ;Maximum decimal exponent=37 +expmax tst ,s+ + bpl posexp1 + negb +posexp1 stb ,s ;Store approximate decimal exponent. + negb + sex ;Approximate (negated) decimal exponent in D. + pshs d + ldx #fpten + jsr fplod + puls d + jsr fpipower ;Take 10^-exp + jsr fpmul +fpsc1a ldx #fplolim + jsr fplod + jsr fpcmpmag ;Compare number to 100 million + leau -5,u + bhs fpsc1c + dec ,s ;Decrement approximate exponent. + ldx #fpten + jsr fplod + jsr fpmul ;Multiply by ten. + bra fpsc1a +fpsc1c ldx #fphilim + jsr fplod + jsr fpcmpmag ;Compare number to 1 billion + leau -5,u + blo fpsc1d + inc ,s ;Increment approximate exponent. + ldx #fpten + jsr fplod + jsr fpdiv ;Divide by ten. + bra fpsc1c +fpsc1d ldb ,s + addb #8 + stb ,s ;Adjust decimal exponent (8 decimals) + ldx #fphalf + jsr fplod + jsr fpadd ;Add 0.5 for the final round to integer. +* Number is either zero or between 100 million and 1 billion. +fpsc2 ldx #intbuf + jsr uint ;Convert decimal mantissa to integer. + jsr int2bcd ;Convert to bcd. + ldb bcdbuf + addb #'0' + stb ,y+ ;Store digit before decimal point + ldb #'.' + stb ,y+ ;Store decimal point. + lda #4 + sta ,-s + ldx #bcdbuf+1 +fpscloop lda ,x+ + tfr a,b + lsrb + lsrb + lsrb + lsrb + addb #'0' + stb ,y+ + anda #$0f + adda #'0 + sta ,y+ + dec ,s ;Convert the other 8 digits to ASCII + bne fpscloop + leas 1,s ;Remove loop counter. + ldb #'E' + stb ,y+ ;Store the E character. + lda #'+' + ldb ,s+ ;Get decimal exponent. + bpl fpsc3 ;Test sign of exponent. + lda #'-' + negb ;Take absolute value of exponent. +fpsc3 sta ,y+ ;Store sign of exponent. + stb intbuf+3 + clr intbuf+2 + clr intbuf+1 + clr intbuf + ldx #intbuf + jsr int2bcd ;Convert decimal exponent to bcd. + lda bcdbuf+4 + tfr a,b + lsrb + lsrb + lsrb + lsrb + addb #'0' + stb ,y+ ;Convert first exp digit to ascii + anda #$0f + adda #'0' + sta ,y+ ;And the second one. + rts + + + include "floatnum.inc" + +fpovf swi +intrange swi +inval swi + +* This routine takes the square root of an FP number. +* Uses Newton's algorithm. +fpsqrt tst -4,u + lbmi inval ;Negative arguments are invalid. + jsr fptest0 + beq sqdone ;Sqaure root of 0 is 0. + jsr fpdup + ldb -5,u + subb #$80 ;Unbias the exponent. + bpl sq1 + addb #1 +sq1 asrb ;Divide exponent by 2. + addb #$80 ;Make it biased again. + stb -5,u ;This is the initial guess for the root. + ldb #4 ;Do the loop 4 times. + stb ,-s +sqloop leax -10,u + jsr fplod + leax -10,u + jsr fplod + jsr fpdiv ;Divide argument by guess. + jsr fpadd ;Add to guess. + dec -5,u ;Divide this by two, giving new guess. + dec ,s + bne sqloop + leas 1,s + jsr fpexg + leau -5,u ;Remove argument, leave final guess. +sqdone rts + +* Compute the floor of an fp number (result is still fp. +fpfloor ldb -5,u + cmpb #$9f + bhs sqdone ;If abs value >=2^31, then already integer. + ldb -4,u + stb ,-s ;Stroe sign of number + andb #$7f + stb -4,u ;Take absolute value of number. + ldx #intbuf + jsr uint ;Convert to int (truncation) + sta ,-s ;Store number of fraction bits. + ldx #intbuf + jsr ufloat ;Convert back to float + ldd ,s++ + tstb + bpl sqdone + sta ,-s + jsr fpneg ;Negate number if it was negative + lda ,s+ + beq sqdone + ldx #fpone + jsr fplod + jmp fpsub ;Subtract 1 if negative & not integer. + +* Floating point modulo operation (floored modulo). +* Integer part of quotient is still left in intbuf +fpmod leax -10,u + jsr fplod + leax -10,u + jsr fplod + jsr fpdiv ;Perform division. + jsr fpfloor + jsr fpmul ;Multiply Quotient and Divisor + leax -10,u + jmp fpsub ;Dividend - quotient*divisor = modulus. + + +* Now the transcendental functions follow. +* They use approximation polynomials as defined in the +* Handbook of Mathematical Functions by Abramowitz & Stegun. + +* Compute polynomial, number of terms in B, coefficients start at Y +fppoly stb ,-s + ldx #fpzero + jsr fplod ;Start with zero. +polyloop leax ,y + jsr fplod + jsr fpadd ;Add next coefficient. + leay 5,y + leax -10,u + jsr fplod + jsr fpmul ;Multiply by x. + dec ,s + bne polyloop + leas 1,s + jsr fpexg + leau -5,u ;Remove x from stack. + rts + +add1 ldx #fpone + jsr fplod + jsr fpadd + rts + +halfpi ldx #fpi + jsr fplod + dec -5,u + rts + +* sin(x) +fpsin ldx #fpi + jsr fplod + inc -5,u ;Load 2*pi + jsr fpmod ;Modulo 2pi + bsr halfpi + jsr fpcmp ;Compare x to pi/2 + bls sin2 + inc -5,u ;Change pi/2 to pi + jsr fpsub + jsr fpneg ;x := pi-x if x>pi/2 + bsr halfpi + jsr fpneg + jsr fpcmp ;Compare x to -pi/2 + bhs sin2 + inc -5,u ;Change -pi/2 to -pi + jsr fpsub + jsr fpneg + bra sin3 +sin2 leau -5,u ;Drop the compare limit pi/2 or -pi/2 +sin3 jsr fpdup + jsr fpdup + jsr fpmul ;On stack: x, x*x + ldy #sincoeff + ldb #5 + jsr fppoly ;Do the sine polynomial with x*x as argument + jsr add1 ;Add 1 to the result. + jmp fpmul ;multiply the polynomial result with x. +* cos(x) +fpcos jsr halfpi + jsr fpsub + jsr fpneg + bra fpsin ;Compute sin(pi/2-x) + +* tan(x) +fptan jsr fpdup + jsr fpsin + jsr fpexg + jsr fpcos + jmp fpdiv ;Compute sin(x)/cos(x) + +* atan(x) +fpatan clr ,-s ;Make flag on stack + ldb -5,u + cmpb #$80 ;Compare magnitude to 1. + blo atn1 + inc ,s ;Set flag on stack. + ldx #fpone ;if x>1 then compute 1/x + jsr fplod + jsr fpexg + jsr fpdiv +atn1 jsr fpdup + jsr fpdup + jsr fpmul ;On stack: x, x*x + ldb #8 + ldy #atancoeff + jsr fppoly ;Doe the arctan polynomyal, x*x as argument. + jsr add1 ;Add 1 to result + jsr fpmul ;multiply result by x. + tst ,s+ + beq atndone + jsr halfpi + jsr fpsub + jsr fpneg ;Compute pi/2 - result when x was >1 +atndone rts + +* exp(x) +fpexp ldb -4,u + stb ,-s ;Store sign of x. + andb #$7f + stb -4,u ;Take absolute value. + ldx #fln2 + jsr fplod + jsr fpmod ;modulo ln2. + ldb #7 + ldy #expcoeff + jsr fppoly ;Do the exp(-x) polynomial. + jsr add1 + tst ,s+ + bpl exppos + ldb -5,u ;Number was negative. + subb intbuf+3 ;Subtract the integer quotient of the modln2 + bcs expund + lda intbuf + ora intbuf+1 + ora intbuf+2 + bne expund ;Underflow also if quotient >255 + stb -5,u ;Store exponent. + rts +exppos ldx #fpone + jsr fplod + jsr fpexg + jsr fpdiv ;x was postitive, compute 1/exp(-x) + ldb intbuf + orb intbuf+1 + orb intbuf+2 ;Check int part is less than 255 + lbne fpovf + ldb -5,u + addb intbuf+3 ;Add integer part to exponent. + lbcs fpovf ;Check for overflow. + stb -5,u + rts +expund leau -5,u + ldx #fpzero + jmp fplod ;underflow, result is zero. + +* ln(x) Natural logarithm +fln jsr fptest0 + lbeq inval ;Don't accept zero as argument. + tst -4,u + lbmi inval ;No negative numbers either. + ldb -5,u + stb ,-s ;Save the binary exponent. + ldb #$80 + stb -5,u ;Replace exponent with 1. + ldx #fpone ;Argument is now in range 1..2 + jsr fplod + jsr fpsub ;Subtract 1. + ldy #lncoeff + ldb #8 + jsr fppoly ;Do the ln(1+x) polynomial. + ldb ,s+ ;Get original exponent. + subb #$80 ;Unbias it. + sex + jsr int2fp ;Convert to fp. + ldx #fln2 + jsr fplod + jsr fpmul ;Multiply it by ln2. + jmp fpadd ;Add that to result. + +skipspace ldb ,y+ + cmpb #' ' + beq skipspace + rts + +PROGEND fdb $FFFF ;Indicate there is no AUTOBOOT app. + ;Flag can be overwritten by it. +FREEMEM equ ROM*RAMSTART+(1-ROM)*(PROGEND+2) + + + end + diff -r 4fa2bdb0c457 -r 2088fd998865 basic/floatnum.src --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/floatnum.src Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,57 @@ +* Simple constants. +fpzero +0 +fpone +1 +fptwo +2 +fpten +10 +fphalf +0.5 +* Numbers used in conversion. +fplolim +99999999.95 +fphilim +999999999.5 +* Mathematical constants. +fpi +3.1415926535898 +fln2 +0.6931471805599 +* Even coefficients for the sin(x)/x polynumial. +sincoeff +-0.0000000239 + 0.0000027526 +-0.0001984090 + 0.0083333315 +-0.1666666664 +* Even coefficients for the arctan(x)/x polynomial. +atancoeff + 0.0028662257 +-0.0161657367 + 0.0429096138 +-0.0752896400 + 0.1065626393 +-0.1420889944 + 0.1999355085 +-0.3333314528 +* Coefficients for the exp(-x) polynomial. +expcoeff +-0.0001413161 + 0.0013298820 +-0.0083013598 + 0.0416573475 +-0.1666653019 + 0.4999999206 +-0.9999999995 +* Coefficients for the ln(1+x) polynomial. +lncoeff +-0.0064535442 + 0.0360884937 +-0.0953293897 + 0.1676540711 +-0.2407338084 + 0.3317990258 +-0.4998741238 + 0.9999964239 diff -r 4fa2bdb0c457 -r 2088fd998865 basic/makeflot.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/basic/makeflot.c Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,56 @@ +/* This program converts floating point numbers to + the 5-bit binary representation used in 6809 BASIC. +*/ + +#include +#include +#include +#include +#include + +main() +{ + double num; + char line[128],label[128]; + unsigned char byte[5]; + int expo,sign,i; + unsigned long mant; + label[0]=0; + printf("* These are the floating point constants.\n"); + printf("* They are generated by the program makeflot.c\n"); + while(fgets(line,128,stdin)) { + line[strlen(line)-1]=0; + if(!line[0])continue; + if(line[0]=='*'){printf("%s\n",line);continue;} + if(isalpha(line[0])) { + sscanf(line,"%s",label); + }else{ + sscanf(line,"%lf",&num); + if(num==0) { + sign=0; + expo=0; + mant=0; + }else{ + sign=0x80*(num<0); + num=fabs(num); + expo=0x9f; + while(num<2147483648.0){ + num=num*2; + expo-=1; + } + while(num>=4294967296.0){ + num=num/2; + expo+=1; + } + mant=num+0.5; + } + byte[0]=expo;byte[1]=((mant>>24)&0x7f)+sign; + byte[2]=((mant>>16)&0xff);byte[3]=((mant>>8)&0xff);byte[4]=mant&0xff; + printf("%-16s fcb $%02x,$%02x,$%02x,$%02x,$%02x ;%s\n", + label,byte[0],byte[1],byte[2],byte[3],byte[4],line); + label[0]=0; + } + } + printf("* End of floating point constants.\n"); + exit(0); +} diff -r 4fa2bdb0c457 -r 2088fd998865 d09.c --- a/d09.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1662 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include - - -/*************************************************************************** - Originally posted to comp.sys.m6809 by Didier Derny (didier@aida.remcomp.fr) - - Minor hacks by Alan DeKok - - Fixed: D_Indexed addressing used prog[2] and prog[3] when it meant - prog[pc+2] and prog[pc+3]: Would produce flawed disassemblies! - - changed addresses in D_Indexed to be all hex. - added 2 instances of 'extrabyte' in D_Indexed: would not skip them.. - Added PC offsets to D_Indexed ,PCR formats - added SWI2 print out as OS9 - - To do: - - handle command-line options properly... - - Fix handling of illegal opcodes so it doesn't skip a byte - i.e. $87 is a skip 2 - - Move defines to another file - - Add 6309 support - also add 6309 native-mode support, and listing of clock cycles for opcodes. - - Add OS-9 support - - add proper label-disassembly. i.e. 2-pass. - -****************************************************************************/ - -// extern int errno; -// extern char *sys_errlist[]; - -static unsigned char prog0[65536]; -unsigned char *prog = prog0; - -FILE *fp; - -typedef struct { - char *name; - int clock; - int bytes; - int (*display)(); - int (*execute)(); -} Opcode; - -typedef struct { - int address; - int length; - int width; -} String; - -int D_Illegal(Opcode *, int, int, char *); -int D_Direct(Opcode *, int, int, char *); -int D_Page10(Opcode *, int, int, char *); -int D_Page11(Opcode *, int, int, char *); -int D_Immediat(Opcode *, int, int, char *); -int D_ImmediatL(Opcode *, int, int, char *); -int D_Inherent(Opcode *, int, int, char *); -int D_Indexed(Opcode *, int, int, char *); -int D_Extended(Opcode *, int, int, char *); -int D_Relative(Opcode *, int, int, char *); -int D_RelativeL(Opcode *, int, int, char *); -int D_Register0(Opcode *, int, int, char *); -int D_Register1(Opcode *, int, int, char *); -int D_Register2(Opcode *, int, int, char *); -int D_Page10(Opcode *, int, int, char *); -int D_Page11(Opcode *, int, int, char *); -int D_OS9(Opcode *, int, int, char *); -char *IndexRegister(int); - -String stringtable[] = { - { 0xc321, 16, 16 }, - { 0xc395, 258, 16 }, - { 0xeb15, 50, 16 }, - { 0xee6f, 128, 16 }, - { 0xfdf4, 492, 16 }, - { 0xfff0, 16, 2 }, -}; - -int adoffset = 0; -int laststring = 6; - -Opcode optable[] = { - { "NEG ", 6, 2, D_Direct, NULL }, /* 0x00 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x01 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x02 */ - { "COM ", 6, 2, D_Direct, NULL }, /* 0x03 */ - { "LSR ", 6, 2, D_Direct, NULL }, /* 0x04 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x05 */ - { "ROR ", 6, 2, D_Direct, NULL }, /* 0x06 */ - { "ASR ", 6, 2, D_Direct, NULL }, /* 0x07 */ - { "LSL ", 6, 2, D_Direct, NULL }, /* 0x08 */ - { "ROR ", 6, 2, D_Direct, NULL }, /* 0x09 */ - { "DEC ", 6, 2, D_Direct, NULL }, /* 0x0a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0b */ - { "INC ", 6, 2, D_Direct, NULL }, /* 0x0c */ - { "TST ", 6, 2, D_Direct, NULL }, /* 0x0d */ - { "JMP ", 3, 2, D_Direct, NULL }, /* 0x0e */ - { "CLR ", 6, 2, D_Direct, NULL }, /* 0x0f */ - - { "", 0, 1, D_Page10, NULL }, /* 0x10 */ - { "", 0, 1, D_Page11, NULL }, /* 0x11 */ - { "NOP ", 2, 1, D_Inherent, NULL }, /* 0x12 */ - { "SYNC ", 4, 1, D_Inherent, NULL }, /* 0x13 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x14 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x15 */ - { "LBRA ", 5, 3, D_RelativeL, NULL }, /* 0x16 */ - { "LBSR ", 9, 3, D_RelativeL, NULL }, /* 0x17 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x18 */ - { "DAA ", 2, 1, D_Inherent, NULL }, /* 0x19 */ - { "ORCC ", 3, 2, D_Immediat, NULL }, /* 0x1a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1b */ - { "ANDCC", 3, 2, D_Immediat, NULL }, /* 0x1c */ - { "SEX ", 2, 1, D_Inherent, NULL }, /* 0x1d */ - { "EXG ", 8, 2, D_Register0, NULL }, /* 0x1e */ - { "TFR ", 6, 2, D_Register0, NULL }, /* 0x1f */ - - { "BRA ", 3, 2, D_Relative, NULL }, /* 0x20 */ - { "BRN ", 3, 2, D_Relative, NULL }, /* 0x21 */ - { "BHI ", 3, 2, D_Relative, NULL }, /* 0x22 */ - { "BLS ", 3, 2, D_Relative, NULL }, /* 0x23 */ - { "BCC ", 3, 2, D_Relative, NULL }, /* 0x24 */ - { "BCS ", 3, 2, D_Relative, NULL }, /* 0x25 */ - { "BNE ", 3, 2, D_Relative, NULL }, /* 0x26 */ - { "BEQ ", 3, 2, D_Relative, NULL }, /* 0x27 */ - { "BVC ", 3, 2, D_Relative, NULL }, /* 0x28 */ - { "BVS ", 3, 2, D_Relative, NULL }, /* 0x29 */ - { "BPL ", 3, 2, D_Relative, NULL }, /* 0x2a */ - { "BMI ", 3, 2, D_Relative, NULL }, /* 0x2b */ - { "BGE ", 3, 2, D_Relative, NULL }, /* 0x2c */ - { "BLT ", 3, 2, D_Relative, NULL }, /* 0x2d */ - { "BGT ", 3, 2, D_Relative, NULL }, /* 0x2e */ - { "BLE ", 3, 2, D_Relative, NULL }, /* 0x2f */ - - { "LEAX ", 4, 2, D_Indexed, NULL }, /* 0x30 */ - { "LEAY ", 4, 2, D_Indexed, NULL }, /* 0x31 */ - { "LEAS ", 4, 2, D_Indexed, NULL }, /* 0x32 */ - { "LEAU ", 4, 2, D_Indexed, NULL }, /* 0x33 */ - { "PSHS ", 5, 2, D_Register1, NULL }, /* 0x34 */ - { "PULS ", 5, 2, D_Register1, NULL }, /* 0x35 */ - { "PSHU ", 5, 2, D_Register2, NULL }, /* 0x36 */ - { "PULU ", 5, 2, D_Register2, NULL }, /* 0x37 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x38 */ - { "RTS ", 5, 1, D_Inherent, NULL }, /* 0x39 */ - { "ABX ", 3, 1, D_Inherent, NULL }, /* 0x3a */ - { "RTI ", 6, 1, D_Inherent, NULL }, /* 0x3b */ - { "CWAI ", 20, 2, D_Inherent, NULL }, /* 0x3c */ - { "MUL ", 11, 1, D_Inherent, NULL }, /* 0x3d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3e */ - { "SWI ", 19, 1, D_Inherent, NULL }, /* 0x3f */ - - { "NEGA ", 2, 1, D_Inherent, NULL }, /* 0x40 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x41 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x42 */ - { "COMA ", 2, 1, D_Inherent, NULL }, /* 0x43 */ - { "LSRA ", 2, 1, D_Inherent, NULL }, /* 0x44 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x45 */ - { "RORA ", 2, 1, D_Inherent, NULL }, /* 0x46 */ - { "ASRA ", 2, 1, D_Inherent, NULL }, /* 0x47 */ - { "LSLA ", 2, 1, D_Inherent, NULL }, /* 0x48 */ - { "ROLA ", 2, 1, D_Inherent, NULL }, /* 0x49 */ - { "DECA ", 2, 1, D_Inherent, NULL }, /* 0x4a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4b */ - { "INCA ", 2, 1, D_Inherent, NULL }, /* 0x4c */ - { "TSTA ", 2, 1, D_Inherent, NULL }, /* 0x4d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4e */ - { "CLRA ", 2, 1, D_Inherent, NULL }, /* 0x4f */ - - { "NEGB ", 2, 1, D_Inherent, NULL }, /* 0x50 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x51 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x52 */ - { "COMB ", 2, 1, D_Inherent, NULL }, /* 0x53 */ - { "LSRB ", 2, 1, D_Inherent, NULL }, /* 0x54 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x55 */ - { "RORB ", 2, 1, D_Inherent, NULL }, /* 0x56 */ - { "ASRB ", 2, 1, D_Inherent, NULL }, /* 0x57 */ - { "LSLB ", 2, 1, D_Inherent, NULL }, /* 0x58 */ - { "ROLB ", 2, 1, D_Inherent, NULL }, /* 0x59 */ - { "DECB ", 2, 1, D_Inherent, NULL }, /* 0x5a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5b */ - { "INCB ", 2, 1, D_Inherent, NULL }, /* 0x5c */ - { "TSTB ", 2, 1, D_Inherent, NULL }, /* 0x5d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5e */ - { "CLRB ", 2, 1, D_Inherent, NULL }, /* 0x5f */ - - { "NEG ", 6, 2, D_Indexed, NULL }, /* 0x60 */ - { "?????", 0, 2, D_Illegal, NULL }, /* 0x61 */ - { "?????", 0, 2, D_Illegal, NULL }, /* 0x62 */ - { "COM ", 6, 2, D_Indexed, NULL }, /* 0x63 */ - { "LSR ", 6, 2, D_Indexed, NULL }, /* 0x64 */ - { "?????", 0, 2, D_Indexed, NULL }, /* 0x65 */ - { "ROR ", 6, 2, D_Indexed, NULL }, /* 0x66 */ - { "ASR ", 6, 2, D_Indexed, NULL }, /* 0x67 */ - { "LSL ", 6, 2, D_Indexed, NULL }, /* 0x68 */ - { "ROL ", 6, 2, D_Indexed, NULL }, /* 0x69 */ - { "DEC ", 6, 2, D_Indexed, NULL }, /* 0x6a */ - { "?????", 0, 2, D_Illegal, NULL }, /* 0x6b */ - { "INC ", 6, 2, D_Indexed, NULL }, /* 0x6c */ - { "TST ", 6, 2, D_Indexed, NULL }, /* 0x6d */ - { "JMP ", 3, 2, D_Indexed, NULL }, /* 0x6e */ - { "CLR ", 6, 2, D_Indexed, NULL }, /* 0x6f */ - - { "NEG ", 7, 3, D_Extended, NULL }, /* 0x70 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x71 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x72 */ - { "COM ", 7, 3, D_Extended, NULL }, /* 0x73 */ - { "LSR ", 7, 3, D_Extended, NULL }, /* 0x74 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x75 */ - { "ROR ", 7, 3, D_Extended, NULL }, /* 0x76 */ - { "ASR ", 7, 3, D_Extended, NULL }, /* 0x77 */ - { "LSL ", 7, 3, D_Extended, NULL }, /* 0x78 */ - { "ROL ", 7, 3, D_Extended, NULL }, /* 0x79 */ - { "DEC ", 7, 3, D_Extended, NULL }, /* 0x7a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7b */ - { "INC ", 7, 3, D_Extended, NULL }, /* 0x7c */ - { "TST ", 7, 3, D_Extended, NULL }, /* 0x7d */ - { "JMP ", 4, 3, D_Extended, NULL }, /* 0x7e */ - { "CLR ", 7, 3, D_Extended, NULL }, /* 0x7f */ - - { "SUBA ", 2, 2, D_Immediat, NULL }, /* 0x80 */ - { "CMPA ", 2, 2, D_Immediat, NULL }, /* 0x81 */ - { "SBCA ", 2, 2, D_Immediat, NULL }, /* 0x82 */ - { "SUBD ", 4, 3, D_ImmediatL, NULL }, /* 0x83 */ - { "ANDA ", 2, 2, D_Immediat, NULL }, /* 0x84 */ - { "BITA ", 2, 2, D_Immediat, NULL }, /* 0x85 */ - { "LDA ", 2, 2, D_Immediat, NULL }, /* 0x86 */ - { "?????", 0, 2, D_Illegal, NULL }, /* 0x87 */ - { "EORA ", 2, 2, D_Immediat, NULL }, /* 0x88 */ - { "ADCA ", 2, 2, D_Immediat, NULL }, /* 0x89 */ - { "ORA ", 2, 2, D_Immediat, NULL }, /* 0x8a */ - { "ADDA ", 2, 2, D_Immediat, NULL }, /* 0x8b */ - { "CMPX ", 4, 3, D_ImmediatL, NULL }, /* 0x8c */ - { "BSR ", 7, 2, D_Relative, NULL }, /* 0x8d */ - { "LDX ", 3, 3, D_ImmediatL, NULL }, /* 0x8e */ - { "?????", 0, 2, D_Illegal, NULL }, /* 0x8f */ - - { "SUBA ", 4, 2, D_Direct, NULL }, /* 0x90 */ - { "CMPA ", 4, 2, D_Direct, NULL }, /* 0x91 */ - { "SBCA ", 4, 2, D_Direct, NULL }, /* 0x92 */ - { "SUBD ", 6, 2, D_Direct, NULL }, /* 0x93 */ - { "ANDA ", 4, 2, D_Direct, NULL }, /* 0x94 */ - { "BITA ", 4, 2, D_Direct, NULL }, /* 0x95 */ - { "LDA ", 4, 2, D_Direct, NULL }, /* 0x96 */ - { "STA ", 4, 2, D_Direct, NULL }, /* 0x97 */ - { "EORA ", 4, 2, D_Direct, NULL }, /* 0x98 */ - { "ADCA ", 4, 2, D_Direct, NULL }, /* 0x99 */ - { "ORA ", 4, 2, D_Direct, NULL }, /* 0x9a */ - { "ADDA ", 4, 2, D_Direct, NULL }, /* 0x9b */ - { "CMPX ", 6, 2, D_Direct, NULL }, /* 0x9c */ - { "JSR ", 7, 2, D_Direct, NULL }, /* 0x9d */ - { "LDX ", 5, 2, D_Direct, NULL }, /* 0x9e */ - { "STX ", 5, 2, D_Direct, NULL }, /* 0x9f */ - - { "SUBA ", 4, 2, D_Indexed, NULL }, /* 0xa0 */ - { "CMPA ", 4, 2, D_Indexed, NULL }, /* 0xa1 */ - { "SBCA ", 4, 2, D_Indexed, NULL }, /* 0xa2 */ - { "SUBD ", 6, 2, D_Indexed, NULL }, /* 0xa3 */ - { "ANDA ", 4, 2, D_Indexed, NULL }, /* 0xa4 */ - { "BITA ", 4, 2, D_Indexed, NULL }, /* 0xa5 */ - { "LDA ", 4, 2, D_Indexed, NULL }, /* 0xa6 */ - { "STA ", 4, 2, D_Indexed, NULL }, /* 0xa7 */ - { "EORA ", 4, 2, D_Indexed, NULL }, /* 0xa8 */ - { "ADCA ", 4, 2, D_Indexed, NULL }, /* 0xa9 */ - { "ORA ", 4, 2, D_Indexed, NULL }, /* 0xaa */ - { "ADDA ", 4, 2, D_Indexed, NULL }, /* 0xab */ - { "CMPX ", 6, 2, D_Indexed, NULL }, /* 0xac */ - { "JSR ", 7, 2, D_Indexed, NULL }, /* 0xad */ - { "LDX ", 5, 2, D_Indexed, NULL }, /* 0xae */ - { "STX ", 5, 2, D_Indexed, NULL }, /* 0xaf */ - - { "SUBA ", 5, 3, D_Extended, NULL }, /* 0xb0 */ - { "CMPA ", 5, 3, D_Extended, NULL }, /* 0xb1 */ - { "SBCA ", 5, 3, D_Extended, NULL }, /* 0xb2 */ - { "SUBD ", 7, 3, D_Extended, NULL }, /* 0xb3 */ - { "ANDA ", 5, 3, D_Extended, NULL }, /* 0xb4 */ - { "BITA ", 5, 3, D_Extended, NULL }, /* 0xb5 */ - { "LDA ", 5, 3, D_Extended, NULL }, /* 0xb6 */ - { "STA ", 5, 3, D_Extended, NULL }, /* 0xb7 */ - { "EORA ", 5, 3, D_Extended, NULL }, /* 0xb8 */ - { "ADCA ", 5, 3, D_Extended, NULL }, /* 0xb9 */ - { "ORA ", 5, 3, D_Extended, NULL }, /* 0xba */ - { "ADDA ", 5, 3, D_Extended, NULL }, /* 0xbb */ - { "CMPX ", 7, 3, D_Extended, NULL }, /* 0xbc */ - { "JSR ", 8, 3, D_Extended, NULL }, /* 0xbd */ - { "LDX ", 6, 3, D_Extended, NULL }, /* 0xbe */ - { "STX ", 6, 3, D_Extended, NULL }, /* 0xbf */ - - { "SUBB ", 2, 2, D_Immediat, NULL }, /* 0xc0 */ - { "CMPB ", 2, 2, D_Immediat, NULL }, /* 0xc1 */ - { "SBCB ", 2, 2, D_Immediat, NULL }, /* 0xc2 */ - { "ADDD ", 4, 3, D_ImmediatL, NULL }, /* 0xc3 */ - { "ANDB ", 2, 2, D_Immediat, NULL }, /* 0xc4 */ - { "BITB ", 2, 2, D_Immediat, NULL }, /* 0xc5 */ - { "LDB ", 2, 2, D_Immediat, NULL }, /* 0xc6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc7 */ - { "EORB ", 2, 2, D_Immediat, NULL }, /* 0xc8 */ - { "ADCB ", 2, 2, D_Immediat, NULL }, /* 0xc9 */ - { "ORB ", 2, 2, D_Immediat, NULL }, /* 0xca */ - { "ADDB ", 2, 2, D_Immediat, NULL }, /* 0xcb */ - { "LDD ", 3, 3, D_ImmediatL, NULL }, /* 0xcc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcd */ - { "LDU ", 3, 3, D_ImmediatL, NULL }, /* 0xce */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcf */ - - { "SUBB ", 4, 2, D_Direct, NULL }, /* 0xd0 */ - { "CMPB ", 4, 2, D_Direct, NULL }, /* 0xd1 */ - { "SBCB ", 4, 2, D_Direct, NULL }, /* 0xd2 */ - { "ADDD ", 6, 2, D_Direct, NULL }, /* 0xd3 */ - { "ANDB ", 4, 2, D_Direct, NULL }, /* 0xd4 */ - { "BITB ", 4, 2, D_Direct, NULL }, /* 0xd5 */ - { "LDB ", 4, 2, D_Direct, NULL }, /* 0xd6 */ - { "STB ", 4, 2, D_Direct, NULL }, /* 0xd7 */ - { "EORB ", 4, 2, D_Direct, NULL }, /* 0xd8 */ - { "ADCB ", 4, 2, D_Direct, NULL }, /* 0xd9 */ - { "ORB ", 4, 2, D_Direct, NULL }, /* 0xda */ - { "ADDB ", 4, 2, D_Direct, NULL }, /* 0xdb */ - { "LDD ", 5, 2, D_Direct, NULL }, /* 0xdc */ - { "STD ", 5, 2, D_Direct, NULL }, /* 0xdd */ - { "LDU ", 5, 2, D_Direct, NULL }, /* 0xde */ - { "STU ", 5, 2, D_Direct, NULL }, /* 0xdf */ - - { "SUBB ", 4, 2, D_Indexed, NULL }, /* 0xe0 */ - { "CMPB ", 4, 2, D_Indexed, NULL }, /* 0xe1 */ - { "SBCB ", 4, 2, D_Indexed, NULL }, /* 0xe2 */ - { "ADDD ", 6, 2, D_Indexed, NULL }, /* 0xe3 */ - { "ANDB ", 4, 2, D_Indexed, NULL }, /* 0xe4 */ - { "BITB ", 4, 2, D_Indexed, NULL }, /* 0xe5 */ - { "LDB ", 4, 2, D_Indexed, NULL }, /* 0xe6 */ - { "STB ", 4, 2, D_Indexed, NULL }, /* 0xe7 */ - { "EORB ", 4, 2, D_Indexed, NULL }, /* 0xe8 */ - { "ADCB ", 4, 2, D_Indexed, NULL }, /* 0xe9 */ - { "ORB ", 4, 2, D_Indexed, NULL }, /* 0xea */ - { "ADDB ", 4, 2, D_Indexed, NULL }, /* 0xeb */ - { "LDD ", 5, 2, D_Indexed, NULL }, /* 0xec */ - { "STD ", 5, 2, D_Indexed, NULL }, /* 0xed */ - { "LDU ", 5, 2, D_Indexed, NULL }, /* 0xee */ - { "STU ", 5, 2, D_Indexed, NULL }, /* 0xef */ - - { "SUBB ", 5, 3, D_Extended, NULL }, /* 0xf0 */ - { "CMPB ", 5, 3, D_Extended, NULL }, /* 0xf1 */ - { "SBCB ", 5, 3, D_Extended, NULL }, /* 0xf2 */ - { "ADDD ", 7, 3, D_Extended, NULL }, /* 0xf3 */ - { "ANDB ", 5, 3, D_Extended, NULL }, /* 0xf4 */ - { "BITB ", 5, 3, D_Extended, NULL }, /* 0xf5 */ - { "LDB ", 5, 3, D_Extended, NULL }, /* 0xf6 */ - { "STB ", 5, 3, D_Extended, NULL }, /* 0xf7 */ - { "EORB ", 5, 3, D_Extended, NULL }, /* 0xf8 */ - { "ADCB ", 5, 3, D_Extended, NULL }, /* 0xf9 */ - { "ORB ", 5, 3, D_Extended, NULL }, /* 0xfa */ - { "ADDB ", 5, 3, D_Extended, NULL }, /* 0xfb */ - { "LDD ", 6, 3, D_Extended, NULL }, /* 0xfc */ - { "STD ", 6, 3, D_Extended, NULL }, /* 0xfd */ - { "LDU ", 6, 3, D_Extended, NULL }, /* 0xfe */ - { "STU ", 6, 3, D_Extended, NULL }, /* 0xff */ -}; - -Opcode optable10[] = { - { "?????", 0, 1, D_Illegal, NULL }, /* 0x00 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x01 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x02 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x03 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x04 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x05 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x06 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x07 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x08 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x09 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x10 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x11 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x12 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x13 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x14 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x15 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x16 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x17 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x18 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x19 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x20 */ - { "LBRN ", 5, 4, D_RelativeL, NULL }, /* 0x21 */ - { "LBHI ", 5, 4, D_RelativeL, NULL }, /* 0x22 */ - { "LBLS ", 5, 4, D_RelativeL, NULL }, /* 0x23 */ - { "LBCC ", 5, 4, D_RelativeL, NULL }, /* 0x24 */ - { "LBCS ", 5, 4, D_RelativeL, NULL }, /* 0x25 */ - { "LBNE ", 5, 4, D_RelativeL, NULL }, /* 0x26 */ - { "LBEQ ", 5, 4, D_RelativeL, NULL }, /* 0x27 */ - { "LBVC ", 5, 4, D_RelativeL, NULL }, /* 0x28 */ - { "LBVS ", 5, 4, D_RelativeL, NULL }, /* 0x29 */ - { "LBPL ", 5, 4, D_RelativeL, NULL }, /* 0x2a */ - { "LBMI ", 5, 4, D_RelativeL, NULL }, /* 0x2b */ - { "LBGE ", 5, 4, D_RelativeL, NULL }, /* 0x2c */ - { "LBLT ", 5, 4, D_RelativeL, NULL }, /* 0x2d */ - { "LBGT ", 5, 4, D_RelativeL, NULL }, /* 0x2e */ - { "LBLE ", 5, 4, D_RelativeL, NULL }, /* 0x2f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x30 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x31 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x32 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x33 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x34 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x35 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x36 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x37 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x38 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x39 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3e */ -/* Fake SWI2 as an OS9 F$xxx system call */ - { "OS9 ", 20, 3, D_OS9, NULL }, /* 0x3f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x40 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x41 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x42 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x43 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x44 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x45 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x46 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x47 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x48 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x49 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x50 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x51 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x52 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x53 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x54 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x55 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x56 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x57 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x58 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x59 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x60 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x61 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x62 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x63 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x64 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x65 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x66 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x67 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x68 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x69 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x70 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x71 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x72 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x73 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x74 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x75 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x76 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x77 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x78 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x79 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x80 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x81 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x82 */ - { "CMPD ", 5, 4, D_ImmediatL, NULL }, /* 0x83 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x84 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x85 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x86 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x87 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x88 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x89 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8b */ - { "CMPY ", 5, 4, D_ImmediatL, NULL }, /* 0x8c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8d */ - { "LDY ", 4, 4, D_ImmediatL, NULL }, /* 0x8e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x90 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x91 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x92 */ - { "CMPD ", 7, 3, D_Direct, NULL }, /* 0x93 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x94 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x95 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x96 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x97 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x98 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x99 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9b */ - { "CMPY ", 7, 3, D_Direct, NULL }, /* 0x9c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9d */ - { "LDY ", 6, 3, D_Direct, NULL }, /* 0x9e */ - { "STY ", 6, 3, D_Direct, NULL }, /* 0x9f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa2 */ - { "CMPD ", 7, 3, D_Indexed, NULL }, /* 0xa3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xaa */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xab */ - { "CMPY ", 7, 3, D_Indexed, NULL }, /* 0xac */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xad */ - { "LDY ", 6, 3, D_Indexed, NULL }, /* 0xae */ - { "STY ", 6, 3, D_Indexed, NULL }, /* 0xaf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb2 */ - { "CMPD ", 8, 4, D_Extended, NULL }, /* 0xb3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xba */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xbb */ - { "CMPY ", 8, 4, D_Extended, NULL }, /* 0xbc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xbd */ - { "LDY ", 7, 4, D_Extended, NULL }, /* 0xbe */ - { "STY ", 7, 4, D_Extended, NULL }, /* 0xbf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xca */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcd */ - { "LDS ", 4, 4, D_ImmediatL, NULL }, /* 0xce */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xda */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdd */ - { "LDS ", 6, 3, D_Direct, NULL }, /* 0xde */ - { "STS ", 6, 3, D_Direct, NULL }, /* 0xdf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xea */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xeb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xec */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xed */ - { "LDS ", 6, 3, D_Indexed, NULL }, /* 0xee */ - { "STS ", 6, 3, D_Indexed, NULL }, /* 0xef */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfa */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfd */ - { "LDS ", 7, 4, D_Extended, NULL }, /* 0xfe */ - { "STS ", 7, 4, D_Extended, NULL }, /* 0xff */ - -}; - - -Opcode optable11[] = { - { "?????", 0, 1, D_Illegal, NULL }, /* 0x00 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x01 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x02 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x03 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x04 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x05 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x06 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x07 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x08 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x09 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x0f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x10 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x11 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x12 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x13 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x14 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x15 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x16 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x17 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x18 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x19 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x1f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x20 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x21 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x22 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x23 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x24 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x25 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x26 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x27 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x28 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x29 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x2a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x2b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x2c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x2d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x2e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x2f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x30 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x31 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x32 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x33 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x34 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x35 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x36 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x37 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x38 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x39 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x3e */ - { "SWI3 ", 20, 2, D_Inherent, NULL }, /* 0x3f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x40 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x41 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x42 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x43 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x44 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x45 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x46 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x47 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x48 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x49 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x4f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x50 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x51 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x52 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x53 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x54 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x55 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x56 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x57 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x58 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x59 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x5f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x60 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x61 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x62 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x63 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x64 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x65 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x66 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x67 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x68 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x69 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x6f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x70 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x71 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x72 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x73 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x74 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x75 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x76 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x77 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x78 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x79 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7b */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x7f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x80 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x81 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x82 */ - { "CMPU ", 5, 4, D_ImmediatL, NULL }, /* 0x83 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x84 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x85 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x86 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x87 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x88 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x89 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8b */ - { "CMPS ", 5, 4, D_ImmediatL, NULL }, /* 0x8c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x8f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0x90 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x91 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x92 */ - { "CMPU ", 7, 3, D_Direct, NULL }, /* 0x93 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x94 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x95 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x96 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x97 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x98 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x99 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9a */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9b */ - { "CMPS ", 7, 3, D_Direct, NULL }, /* 0x9c */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9d */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9e */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0x9f */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa2 */ - { "CMPU ", 7, 3, D_Indexed, NULL }, /* 0xa3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xa9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xaa */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xab */ - { "CMPS ", 7, 3, D_Indexed, NULL }, /* 0xac */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xad */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xae */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xaf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb2 */ - { "CMPU ", 8, 4, D_Extended, NULL }, /* 0xb3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xb9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xba */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xbb */ - { "CMPS ", 8, 4, D_Extended, NULL }, /* 0xbc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xbd */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xbe */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xbf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xc9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xca */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcd */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xce */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xcf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xd9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xda */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdd */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xde */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xdf */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xe9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xea */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xeb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xec */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xed */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xee */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xef */ - - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf0 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf1 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf2 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf3 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf4 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf5 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf6 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf7 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf8 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xf9 */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfa */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfb */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfc */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfd */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xfe */ - { "?????", 0, 1, D_Illegal, NULL }, /* 0xff */ -}; - - -struct os9syscall { int code; char *name; } os9sys[] = { - {0x0000,"F$LINK"}, - {0x0001,"F$LOAD"}, - {0x0002,"F$UNLINK"}, - {0x0003,"F$FORK"}, - {0x0004,"F$WAIT"}, - {0x0005,"F$CHAIN"}, - {0x0006,"F$EXIT"}, - {0x0007,"F$MEM"}, - {0x0008,"F$SEND"}, - {0x0009,"F$ICPT"}, - {0x000a,"F$SLEEP"}, - {0x000b,"F$SSPD"}, - {0x000c,"F$ID"}, - {0x000d,"F$SPRIOR"}, - {0x000e,"F$SSWI"}, - {0x000f,"F$PERR"}, - {0x0010,"F$PRSNAM"}, - {0x0011,"F$CMPNAM"}, - {0x0012,"F$SCHBIT"}, - {0x0013,"F$ALLBIT"}, - {0x0014,"F$DELBIT"}, - {0x0015,"F$TIME"}, - {0x0016,"F$STIME"}, - {0x0017,"F$CRC"}, - {0x0018,"F$GPRDSC"}, - {0x0019,"F$GBLKMP"}, - {0x001a,"F$GMODDR"}, - {0x001b,"F$CPYMEM"}, - {0x001c,"F$SUSER"}, - {0x001d,"F$UNLOAD"}, - {0x0027,"F$VIRQ"}, - {0x0028,"F$SRQMEM"}, - {0x0029,"F$SRTMEM"}, - {0x002a,"F$IRQ"}, - {0x002b,"F$IOQU"}, - {0x002c,"F$APROC"}, - {0x002d,"F$NPROC"}, - {0x002e,"F$VMODUL"}, - {0x002f,"F$FIND64"}, - {0x0030,"F$ALL64"}, - {0x0031,"F$RET64"}, - {0x0032,"F$SSVC"}, - {0x0033,"F$IODEL"}, - {0x0034,"F$SLINK"}, - {0x0035,"F$BOOT"}, - {0x0036,"F$BTMEM"}, - {0x0037,"F$GPROCP"}, - {0x0038,"F$MOVE"}, - {0x0039,"F$ALLRAM"}, - {0x003a,"F$ALLIMG"}, - {0x003b,"F$DELIMG"}, - {0x003c,"F$SETIMG"}, - {0x003d,"F$FREELB"}, - {0x003e,"F$FREEHB"}, - {0x003f,"F$ALLTSK"}, - {0x0040,"F$DELTSK"}, - {0x0041,"F$SETTSK"}, - {0x0042,"F$RESTSK"}, - {0x0043,"F$RELTSK"}, - {0x0044,"F$DATLOG"}, - {0x0045,"F$DATTMP"}, - {0x0046,"F$LDAXY"}, - {0x0047,"F$LDAXYP"}, - {0x0048,"F$LDDDXY"}, - {0x0049,"F$LDABX"}, - {0x004a,"F$STABX"}, - {0x004b,"F$ALLPRC"}, - {0x004c,"F$DELPRC"}, - {0x004d,"F$ELINK"}, - {0x004e,"F$FMODUL"}, - {0x004f,"F$MAPBLK"}, - {0x0050,"F$CLRBLK"}, - {0x0051,"F$DELRAM"}, - {0x0052,"F$GCMDIR"}, - {0x0053,"F$ALHRAM"}, - {0x0080 , "I$ATTACH"}, - {0x0081, "I$DETACH"}, - {0x0082 , "I$DUP"}, - {0x0083 , "I$CREATE"}, - {0x0084, "I$OPEN"}, - {0x0085 , "I$MAKDIR"}, - {0x0086 , "I$CHGDIR"}, - {0x0087 , "I$DELETE"}, - {0x0088, "I$SEEK"}, - {0x0089 , "I$READ"}, - {0x008a, "I$WRITE"}, - {0x008b , "I$READLN"}, - {0x008c , "I$WRITLN"}, - {0x008d, "I$GETSTT"}, - {0x008e , "I$SSTT"}, - {0x008f , "I$CLOSE"}, - {0x0090 , "I$DELETX"}, - } ; - - -int iotable[32] = { - 0x0000, - 0x0001, - 0x0002, - 0x0003, - 0x0008, - 0x0009, - 0x000a, - 0x000b, - 0x000c, - 0x000d, - 0x000e, - 0x0010, - 0x0011, - 0x0012, - 0x0013, - 0x0014, - 0x8000, - 0x8001, - 0x8002, - 0x8003, - 0x8004, - 0x8005, - 0x8006, - 0x8007, - 0x8008, - 0x8009, - 0x800a, - 0x800b, - 0x800c, - 0x800d, - 0x800e, - 0x800f, -}; - -char *iocomment[32] = { - "Data direction register port 1", - "Data direction register port 2", - "I/O register port 1", - "I/O register port 2", - "Timer control and status", - "Counter high byte", - "Counter low byte", - "Output compare high byte", - "Output compare low byte", - "Input capture high byte", - "Input capture low byte", - "Serial rate and mode register", - "Serial control and status register", - "Serial receiver data register", - "Serial transmit data register", - "Ram control register", - "Modem port 0", - "Modem port 1", - "Modem port 2", - "Modem port 3", - "Modem port 4", - "Modem port 5", - "Modem port 6", - "Modem port 7", - "Modem port 8", - "Modem port 9", - "Modem port 10", - "Modem port 11", - "Modem port 12", - "Modem port 13", - "Modem port 14", - "Modem port 15", -}; - -char *Inter_Register[16]={"D","X","Y","U","S","PC","??","??","A","B","CC","DP","??","??","??","??"}; - -char *Indexed_Register[4]={"X","Y","U","S"}; - -int lastio = 32; - -#pragma argsused -int D_Illegal(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - fprintf(fp,"%0.2X %s%s", code, suffix, op->name); - return op->bytes; -} - -#pragma argsused -int D_Direct(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - - offset = prog[pc+1]; - fprintf(fp,"%0.2X %0.2X %s%s <$%0.2X", - code, offset, suffix, op->name, offset); - return op->bytes; -} - -#pragma argsused -int D_Page10(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - fprintf(fp,"10 "); - code = prog[pc+1]; - return (*optable10[code].display)(&optable10[code], code, pc+1, ""); -} - -#pragma argsused -int D_Page11(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - fprintf(fp,"11 "); - code = prog[pc+1]; - return (*optable11[code].display)(&optable11[code], code, pc+1, ""); -} - -#pragma argsused -int D_Immediat(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - - offset = prog[pc+1]; - fprintf(fp,"%0.2X %0.2X %s%s #$%0.2X", - code, offset, suffix, op->name, offset); - return op->bytes; -} - -#pragma argsused -int D_ImmediatL(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - - offset = prog[pc+1] * 256 + prog[pc+2]; - fprintf(fp,"%0.2X %0.2X %0.2X %s%s #$%0.4X", - code, prog[pc+1], prog[pc+2], suffix, op->name, offset); - return op->bytes; -} - -#pragma argsused -int D_Inherent(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - fprintf(fp,"%0.2X %s%s", code, suffix, op->name); - return op->bytes; -} - -#pragma argsused -int D_OS9(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - - offset = prog[pc+1]; - for(int i =0, j = sizeof(os9sys)/sizeof(struct os9syscall), m = (i+j)/2 ;i<=j; m=(i+j)/2 ) { - if (os9sys[m].code > offset) { - j=m-1; - } else if (os9sys[m].code < offset) { - i=m+1; - } else if (os9sys[m].code == offset) { - fprintf(fp,"%0.2X %0.2X %s%s %s", - code, offset, suffix, op->name, os9sys[m].name); - return op->bytes; - } - } - fprintf(fp,"%0.2X %0.2X %s%s $%0.2X", - code, offset, suffix, op->name, prog[pc+1]); - return op->bytes; -} - -#pragma argsused -char *IndexRegister(postbyte) -int postbyte; -{ - return Indexed_Register[ (postbyte>>5) & 0x03]; -} - -#pragma argsused -int D_Indexed(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int postbyte; - char *s; - int extrabytes; - int disp; - int address; - int offset; - - extrabytes = 0; - postbyte = prog[pc+1]; - if ((postbyte & 0x80) == 0x00) { - disp = postbyte & 0x1f; - if ((postbyte & 0x10) == 0x10) { - s = "-"; - disp=0x20-disp; - } - else - s = "+"; - fprintf(fp,"%0.2X %0.2X %s%s %s$%0.2X,%s", - code, postbyte, suffix, op->name, s,disp,IndexRegister(postbyte)); - } else { - switch(postbyte & 0x1f) { - case 0x00 : - fprintf(fp,"%0.2X %0.2X %s%s ,%s+", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x01 : - fprintf(fp,"%0.2X %0.2X %s%s ,%s++", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x02 : - fprintf(fp,"%0.2X %0.2X %s%s ,-%s", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x03 : - fprintf(fp,"%0.2X %0.2X %s%s ,--%s", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x04 : - fprintf(fp,"%0.2X %0.2X %s%s ,%s", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x05 : - fprintf(fp,"%0.2X %0.2X %s%s B,%s", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x06 : - fprintf(fp,"%0.2X %0.2X %s%s A,%s", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x07 : - break; - case 0x08 : - offset = prog[pc+2]; - if (offset < 128) - s = "+"; - else { - s = "-"; - offset=0x0100-offset; - } - fprintf(fp,"%0.2X %0.2X %0.2X %s%s %s$%0.2X,%s", - code, postbyte, prog[pc+2], suffix, op->name, s, offset, - IndexRegister(postbyte)); - extrabytes=1; - break; - case 0x09 : - offset = prog[pc+2] * 256 + prog[pc+3]; - if (offset < 32768) - s = "+"; - else { - s = "-"; - offset=0xffff-offset+1; - } - fprintf(fp,"%0.2X %0.2X %0.2X %0.2X %s%s %s$%0.4X,%s", - code, postbyte, prog[pc+2], prog[pc+3], suffix, op->name, s, offset, - IndexRegister(postbyte)); - extrabytes=2; - break; - case 0x0a : - break; - case 0x0b : - fprintf(fp,"%0.2X %0.2X %s%s D,%s", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x0c : - offset = (*(char *)(prog+pc+2)+pc+3) & 0xFFFF; - s = "<"; - fprintf(fp,"%0.2X %0.2X %0.2X %s%s %s$%0.2X,PCR", - code, postbyte, prog[pc+2], suffix, op->name, s, offset+adoffset); - extrabytes = 1; - break; - case 0x0d : - offset = prog[pc+2] * 256 + prog[pc+3]; - offset = ((offset>0x7fff? offset-0x10000 : offset )+pc+4) & 0xFFFF; - s = ">"; - fprintf(fp,"%0.2X %0.2X %0.2X %0.2X %s%s %s$%0.4X,PCR", - code, postbyte, prog[pc+2], prog[pc+3], suffix, op->name, s, offset+adoffset); - extrabytes = 2; - break; - case 0x0e : - break; - case 0x0f : - fprintf(fp,"%0.2X %0.2X %s?????", - code, postbyte, suffix); - break; - case 0x10 : - fprintf(fp,"%0.2X %0.2X %s?????", - code, postbyte, suffix); - break; - case 0x11 : - fprintf(fp,"%0.2X %0.2X %s%s [,%s++]", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x12 : - fprintf(fp,"%0.2X %0.2X %s?????", - code, postbyte, suffix); - break; - case 0x13 : - fprintf(fp,"%0.2X %0.2X %s%s [,--%s]", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x14 : - fprintf(fp,"%0.2X %0.2X %s%s [,%s]", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x15 : - fprintf(fp,"%0.2X %0.2X %s%s [B,%s]", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x16 : - fprintf(fp,"%0.2X %0.2X %s%s [A,%s]", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x17 : - break; - case 0x18 : - offset = prog[pc+2]; - if (offset < 128) - s = "+"; - else { - s = "-"; - offset=0x0100-offset; - } - fprintf(fp,"%0.2X %0.2X %0.2X %s%s [%s$%0.2X,%s]", - code, postbyte, prog[pc+2], suffix, op->name, s, offset, - IndexRegister(postbyte)); - extrabytes = 1; - break; - case 0x19 : - offset = prog[pc+2] * 256 + prog[pc+3]; - if (offset < 32768) - s = "+"; - else { - s = "-"; - offset=0xffff-offset+1; - } - fprintf(fp,"%0.2X %0.2X %0.2X %0.2X %s%s [%s$%0.4X,%s]", - code, postbyte, prog[pc+2], prog[pc+3], suffix, op->name, s, offset, - IndexRegister(postbyte)); - extrabytes = 2; - break; - case 0x1a : - break; - case 0x1b : - fprintf(fp,"%0.2X %0.2X %s%s [D,%s]", - code, postbyte, suffix, op->name, IndexRegister(postbyte)); - break; - case 0x1c : - offset = (*((char*)prog+pc+2)+pc+3) & 0xFFFF; - s = "<"; - fprintf(fp,"%0.2X %0.2X %0.2X %s%s [%s$%0.2X,PCR]", - code, postbyte, prog[pc+2], suffix, op->name, s, offset+adoffset); - extrabytes = 1; - break; - case 0x1d : - offset = prog[pc+2] * 256 + prog[pc+3]; - offset = ((offset>0x7fff?offset-0x8001 : offset )+pc+4) & 0xFFFF; - s = ">"; - fprintf(fp,"%0.2X %0.2X %0.2X %0.2X %s%s [%s$%0.4X,PCR]", - code, postbyte, prog[pc+2], prog[pc+3], suffix, op->name, s, offset+adoffset); - extrabytes = 2; - break; - case 0x1e : - break; - case 0x1f : - address = prog[pc+2] * 256 + prog[pc+3]; - extrabytes = 2; - fprintf(fp,"%0.2X %0.2X %0.2X %0.2X %s%s [$%4X]", - code, postbyte, prog[pc+2], prog[pc+3], suffix, op->name, address); - break; - } - } - return op->bytes + extrabytes; -} - -#pragma argsused -int D_Extended(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - - offset = prog[pc+1] * 256 + prog[pc+2]; - fprintf(fp,"%0.2X %0.2X %0.2X %s%s $%0.4X", - code, prog[pc+1], prog[pc+2], suffix, op->name, offset); - return op->bytes; -} - -#pragma argsused -int D_Relative(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - int disp; - - offset = prog[pc+1]; - if (offset < 127 ) - disp = pc + 2 + offset; - else - disp = pc + 2 - (256 - offset); - fprintf(fp,"%0.2X %0.2X %s%s $%0.4X", - code, offset, suffix, op->name, disp); - return op->bytes; -} - -#pragma argsused -int D_RelativeL(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int offset; - int disp; - - offset = prog[pc+1] * 256 + prog[pc+2]; - if (offset < 32767 ) - disp = pc + 3 + offset + adoffset; - else - disp = pc + 3 - (65536 - offset) + adoffset; - fprintf(fp,"%0.2X %0.2X %0.2X %s%s $%0.4X", - code, prog[pc+1], prog[pc+2], suffix, op->name, disp); - return op->bytes; -} - -#pragma argsused -int D_Register0(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int postbyte; - - postbyte = prog[pc+1]; - - fprintf(fp,"%0.2X %0.2X %s%s %s,%s", - code, postbyte, suffix, op->name, Inter_Register[postbyte>>4], Inter_Register[postbyte & 0x0F]); - - - return op->bytes; -} - -#pragma argsused -int D_Register1(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int postbyte; - int i; - int flag=0; - static char *s_stack[8]={"PC","U","Y","X","DP","B","A","CC"}; - static int bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01}; - - postbyte = prog[pc+1]; - - fprintf(fp,"%0.2X %0.2X %s%s ", - code, postbyte, suffix, op->name); - - for(i=0;i<8;i++) { - if ((postbyte & bits[i]) !=0) { - if (flag !=0) { - fprintf(fp,","); - } else { - flag=1; - } - fprintf(fp,s_stack[i]); - } - } - return op->bytes; -} - -#pragma argsused -int D_Register2(op, code, pc, suffix) -Opcode *op; -int code; -int pc; -char *suffix; -{ - int postbyte; - int i; - int flag=0; - static char *u_stack[8]={"PC","S","Y","X","DP","B","A","CC"}; - static int bits[8]={0x80,0x40,0x20,0x10,0x08,0x04,0x02,0x01}; - - postbyte = prog[pc+1]; - fprintf(fp,"%0.2X %0.2X %s%s ", - code, postbyte, suffix, op->name); - - for(i=0;i<8;i++) { - if ((postbyte & bits[i]) !=0) { - if (flag !=0) { - fprintf(fp,","); - } else { - flag=1; - } - fprintf(fp,u_stack[i]); - } - } - return op->bytes; -} - - -void hexadump(b, l, loc, w) -unsigned char *b; -int l; -int loc; -int w; -{ - int i; - int j; - int end; - // char b[4096]; - - // memset(b, '\0', 4096); - // memcpy(b, s, l); - //fprintf(fp,"\n"); - end = ((l%w)>0)?(l/w)+1:(l/w); - for (j=0;j= 0x20) && (b[j*w+i] < 0x7f)) { - fprintf(fp,"%c", b[j*w+i]); - } else { - fprintf(fp,"."); - } - } - fprintf(fp,"|\n"); - } - //fprintf(fp,"\n"); -} - -char *comment(arg) -int arg; -{ - int i; - - for (i=0;i 2 && *argv[1] == '-') { - if (argv[1][1]=='o') { - adoffset=strtol(argv[2],(char**)0,0); - argc-=2; - argv += 2; - } - } - if ( argc != 4 ) { - fprintf(stderr, "usage: disasm [-o offset] \n"); - fprintf(stderr, " where start and end are in hex.\n"); - exit(1); - } - - sscanf(argv[2],"%x",&start); start -= adoffset; - sscanf(argv[3],"%x",&end); end -= adoffset; - printf("disass %x - %x\n",start,end); - - fp = stdout; - - fd = open(argv[1], O_RDONLY, S_IREAD|S_IWRITE); - size = read(fd, &prog[0x0000], 0xffff); - - if (end > size) end=size; - - disasm(start, end); - close(fd); - return 0; -} - -#endif // NO_MAIN diff -r 4fa2bdb0c457 -r 2088fd998865 doc/latex2creole.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/latex2creole.py Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,102 @@ +#!/usr/bin/env python +# coding: utf-8 + +""" + latex2creole + ~~~~~~~~~~~~ + + Hacked script to convert a LaTeX file into creole markup. + + Note: + Some hand-editing is needed. + + :created: 2013 by Jens Diemer - www.jensdiemer.de + :copyleft: 2013 by the DragonPy team, see AUTHORS for more details. + :license: GNU GPL v3 or above, see LICENSE for more details. +""" + +import sys + +sourcefile = r"sbc09/sbc09.tex" +destination = r"sbc09.creole" + + +HEADLINES = ( + r"\title{", + r"\chapter{", + r"\section{", + r"\subsection{", +) +SKIPS = ( + r"\begin", + r"\end", + r"\document", + r"\maketitle", + r"\tableofcontents", + "\\def\\", +) + +in_list = 0 + +def should_skip(line): + for skip in SKIPS: + if line.startswith(skip): + return True + + +with open(sourcefile, "r") as infile: + with open(destination, "w") as outfile: + for line in infile: + # ~ print line + + line = line.strip() + + if line.startswith(r"\begin{itemize}"): + in_list += 1 + continue + if line.startswith(r"\end{itemize}"): + in_list -= 1 + if in_list == 0: + outfile.write("\n") + continue + + if in_list: + if line.startswith(r"\item"): + line = "\n%s%s" % ("*"*in_list, line[5:]) + outfile.write(line) + continue + + if line == r"\begin{verbatim}": + line = "{{{" + elif line == r"\end{verbatim}": + line = "}}}" + + if should_skip(line): + continue + + for no, prefix in enumerate(HEADLINES, 1): + if line.startswith(prefix): + line = line.replace("{\\tt ", "").replace("}", "") + line = line.split("{", 1)[1].replace("{", "").replace("}", "") + line = "\n%(m)s %(l)s %(m)s\n" % { + "m": "="*no, + "l": line + } + break + + if line.startswith(r"\item["): + item, txt = line[6:].split("]") + item = item.strip() + txt = txt.strip() + line = "** %s **\n%s" % (item, txt) + + if "{\\tt" in line: + line = line.replace("{\\tt ", "{{{").replace("}", "}}}") + if "{\\em" in line: + line = line.replace("{\\em ", "{{{").replace("}", "}}}") + + line = line.replace("\\", "") + + print line + line += "\n" + outfile.write(line) diff -r 4fa2bdb0c457 -r 2088fd998865 doc/origin/README --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/origin/README Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,13 @@ +This is an unfinished. but working version of the 6809 assewmbler. simulator +and software. It is released under the GPL +It runs under several versions of Unix. Docs are in LaTeX format (sbc09.tex) and +in ASCI (README.doc) + +mon2.asm is an alternative version of the monitor program. + +alt09.rom is a version of the ROM that contains the alternative monitor and +Forth. Forth is transferrred to RAM by a small loader. +To start Forth type G8000. To start it again, type G400. + +Yes, you can run TETRIS from the Forth included with this simulator. + diff -r 4fa2bdb0c457 -r 2088fd998865 doc/origin/basic.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/origin/basic.txt Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,92 @@ + TINY BASIC SUMMARY + +Editing Standard Basic + +Direct Mode All Verbs Usable + +Statement Types + + PRINT Item List + LET Var = Expr (LET is optional) + IF Expr Relop Expr Statement + INPUT Variable List + GOTO Line Number + GOSUB Line Number + RETURN + POKE POKE(Expr) = Expr + STOP + LIST Line Number, Line Number (Line Numbers are optional) + RUN + NEW + +Functions + + USR Variable = USR(Expr,Expr) + PEEK Variable = PEEK(Expr) + MEM Variable = MEM + +Number Integers to _+32767 or Hex Integers preceded by a $ symbol + +Variable Letters A-Z + +Expression Variables, Numbers, and Functions combined with the following + operators +, -, *, /, (, ). + +Relop Comparison operators =, <, >, <=, >=, <>. + +Line Number Numbers 1 through 9999 + +String "ALPHANUMERICS" + +Item List Expressions and Strings seperated by format control + characters , and ;. + +Control Chars. Control H or "Back Space" deletes last input character. + Control X or "Cancel" deletes entire input line. + Control C Terminates Basic program or List operation and + returns control to command mode. + +Memory Usage Tiny Basic V1.37 + +$0080 - $009F Tiny Basic interpreter scratch area. +$00A0 - $00FD Not used by Tiny Basic interpreter. (usable USR routines) +$**** - $**** Pointer to Interrupt Vector Table. (Identical to LILBUG) +$D800 - $DFFF Input Buffer, Basic Program storage, Stack Space, and + Variables in RAM. +$**** - $**** Optional Power Up Basic Program and/or USR functions in ROM. +$E800 - $EFFF Tiny Basic interpreter ROM. + +$E800 Cold Start Address. +$E803 Warm Start Address. + + Tiny Basic USR Function + +The USR function in Tiny Basic takes 2 arguments and returns a value to a +variable. The form of the USR function is "LET V = USR(Expr,Expr)". +The USR function can be used in any expression in Tiny Basic as an example +"LET V = A * ( B + USR( $EF00, K))". The USR function can also be used with +the PRINT statement. + +The first argument of the USR function is evaluated to determine the address +or the machine language code to be called. The second argument is evaluated +and the value is send to the machine code routine in the D accumulator. The +second argument is optional, if it is present the Carry bit in the condition +code register will be cleared when the machine code routine is called. If the +second argument is not present the Carry Bit will be set when the machine code +is called. The machine code routine may return a result to the BASIC program +in the D accumulator, the value in the D accumulator on return from the machine +code routine will be used by the BASIC program as the value of the function. + +The machine code routine must execute a RTS instruction to return conterol to +the BASIC program. The machine code routine may use all the processor registers +freely and need not save and restore any registers. It is important that the +machine code routine not modify any memory used by the Tiny Basic interpreter. +Consult the memory map provided with your version of Tiny Basic to determine +which memory areas are not used. + +Tiny Basic handles interrupts with the same interrupt vectoring technique used +by LILBUG. Consult the LILBUG manual for details on interrupt vector usage. + + + + JPB 12-APR-82 diff -r 4fa2bdb0c457 -r 2088fd998865 doc/origin/monitor.tex --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/origin/monitor.tex Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,3085 @@ +\documentstyle[a4wide]{report} +\title{A macine language monitor for the 6809 Processor} +\author{L.C. Benschop} +\begin{document} +\maketitle +\tableofcontents +\chapter{Introduction} + +The program {\tt monitor.asm} is a program that is intended to be included +in the ROM of a 6809 based single board computer. The program allows a user +to communicate with the single board computer through a serial port. It +allows a user to enter machine code, examine memory and registers, to set +breakpoints, to trace a program and more. Furthermore, data can be sent to +and be received from the single board computer through the X-MODEM protocol. + +\section{A bit of history.} + +In the seventies you could buy single board microcomputers that had a +hexadecimal keypad and 7-segment displays. These computers typically had +less than 1 kilobyte of RAM and a simple monitor program in ROM. An +interface to a cassette recorder (or paper tape reader/writer) and a +terminal was possible, but not standard. The typical way to program the +machine was entering hexadecimal machine codes on the keypad. Machine code +was the only language in which you could program them, especially if you +only had a hexadecimal keypad and 7-segment led displays. You typically used +these machines to experiment with hardware interfacing, as games and +calculations were a bit limited with only six 7-sengment digits. + +Next came simple home computers, like the TRS80, the Apple ][ and the +Commodore PET. These machines had BASIC in ROM and they used a simple +cassette recorder to store data. These computers had a TV or a low quality +monitor as display and a QWERTY keyboard. These machines could be upgraded +with a floppy disk drive and a printer and then they could be used for +professional work. These machines had 4 to 64 kilobyts of memory. +Apart from assembly language you could use BASIC, Forth +and sometimes Pascal to program these machines. Most useful programs (and +the best games) were programmed in assembly language. Many of these machines +had BASIC in ROM and no machine code monitor. You had to load that +separately. + +Today we have personal computers that run DOS, Windows, Unix or something +else. New computers have 4 to 16 megabytes of RAM and hard disks of more +than 500 Megabytes. Apart from having in the order of 1000 times more +storage, they are also 1000 times faster than the old 8-bit home computers. +Programming? You can use Visual BASIC, C++ and about +every other programming language on the planet. But programs have become +bigger and bigger. Programming is not the same as it was before. + +I guess there is some demand for small 8-bit computer systems that are simple +to build, easy to interface to all kinds of hobby projects, fun to program +and small enough to integrate into a home-built project. +Do we want to use hexadecimal keyboards and 7-segment displays? I guess not +many people want to use them. Do we want to use a cassette recorder for data +storage and a TV as a display? Not me. And if you build your own 8-bit +microprocessor, do you want to waste your time and money on a hexadecimal +keypad or a cassette interface that you do not like to use and that you do +not need anyway? PCs of five years ago are more than adequate to run an +editor, a terminal program and a cross assembler for your favourite 8-bit +processor. If you equip an 8-bit system with some static CMOS RAM, a serial +interface and a monitor in ROM, you can use the keyboard, hard disk and +monitor of your PC for program development and the 8-bit micro can be +disconnected from the PC and do its task, once it is programmed. + +Cross development is nothing special. How do you think the microprocessor in +you microwave was programmed? But it is not practical for a hobbyist to +program an EPROM for each program change. Professional developers of +embedded processors have expensive tools, like ROM emulators, processor +emulators etc. to see what the processor is doing on its way to the next +crash. For a hobbyist it is much more practival to have a slightly more +expensive embedded computer that you can run an interactive debugger on. +And you are not even limited to assembly language. If you have 32k ROM you +can have both the monitor program and a BASIC interpreter and some +aplication code in ROM. Nothing prevents you from having Forth as well. + + +\chapter{Hardware that the program is supposed to run on} + +\chapter{Use of the monitor commands} + +\item{Usage of the memory} + +\chapter{Operating System Facilities} + +\begin{description} +\item[getchar] address \$00. +\item[putchar] address \$03. +\item[getline] address \$06. +\item[putline] address \$09. +\item[putcr] address \$0C. +\item[getpoll] address \$0F. +\item[xopenin] address \$12. +\item[xopenout] address \$15. +\item[xabortin] address \$18. +\item[xclosein] address \$1B. +\item[xcloseout] address \$1E. +\item[delay] address \$21. +\end{description} + + +\end{description} + +\chapter{Extending the built-in Assembler} + +\appendix +\chapter{Assembly listing of monitor program} +{\footnotesize +\begin{verbatim} +0000: ;Buggy machine language monitor and rudimentary O.S. version 1.0 +0000: +0000: * Memory map of SBC +0000: * $0-$40 Zero page variables reserved by monitor and O.S. +0000: * $40-$FF Zero page portion for user programs. +0000: * $100-$17F Xmodem buffer 0, terminal input buffer, +0000: * $180-$1FF Xmodem buffer 1, terminal output buffer. +0000: * $200-$27F Terminal input line. +0000: * $280-$2FF Variables reserved by monitor and O.S. +0000: * $300-$400 System stack. +0000: * $400-$7FFF RAM for user programs and data. +0000: * $8000-$DFFF PROM for user programs. +0000: * $E000-$E1FF I/O addresses. +0000: * $E200-$E3FF Reserved. +0000: * $E400-$FFFF Monitor ROM +0000: +0000: * Reserved Zero page addresses +0000: org $0000 +0000: * First the I/O routine vectors. +0000: getchar rmb 3 ;Jump to getchar routine. +0003: putchar rmb 3 ;Jump to putchar routine. +0006: getline rmb 3 ;Jump to getline routine. +0009: putline rmb 3 ;Jump to putline routine. +000C: putcr rmb 3 ;Jump to putcr routine. +000F: getpoll rmb 3 ;Jump to getpoll routine. +0012: xopenin rmb 3 ;Jump to xopenin routine. +0015: xopenout rmb 3 ;Jump to xopenout routine. +0018: xabortin rmb 3 ;Jump to xabortin routine. +001B: xclosein rmb 3 ;Jump to xclosein routine. +001E: xcloseout rmb 3 ;Jump to xcloseout routine. +0021: delay rmb 3 ;Jump to delay routine. +0024: +0024: *Next the system variables in the zero page. +0024: temp rmb 2 ;hex scanning/disasm +0026: temp2 rmb 2 ;Hex scanning/disasm +0028: temp3 rmb 2 ;Used in Srecords, H command +002A: timer rmb 3 ;3 byte timer, incremented every 20ms +002D: xpacknum rmb 1 ;Packet number for XMODEM block, +002E: xsum rmb 1 ;XMODEM checksum +002F: lastok rmb 1 ;flag to indicate last block was OK +0030: xcount rmb 1 ;Count of characters in buffer. +0031: xmode rmb 1 ;XMODEM mode, 0 none, 1 out, 2 in. +0032: +0032: * I/O buffers. +0032: buflen equ 128 ;Length of input line buffer. +0032: org $100 +0100: buf0 rmb 128 ;Xmodem buffer 0, serial input buffer. +0180: buf1 rmb 128 ;Xmodem buffer 1, serial output buffer. +0200: linebuf rmb buflen ;Input line buffer. +0280: +0280: +0280: * Interrupt vectors (start at $280) +0280: * All interrupts except RESET are vectored through jumps. +0280: * FIRQ is timer interrupt, IRQ is ACIA interrupt. +0280: swi3vec rmb 3 +0283: swi2vec rmb 3 +0286: firqvec rmb 3 +0289: irqvec rmb 3 +028C: swivec rmb 3 +028F: nmivec rmb 3 +0292: xerrvec rmb 3 ;Error handler for XMODEM error. +0295: exprvec rmb 3 ;Expression evaluator in assembler. +0298: asmerrvec rmb 3 ;Error handler for assembler errors. +029B: +029B: * Next the non zero page system variables. +029B: oldpc rmb 2 ;Saved pc value for J command. +029D: addr rmb 2 ;Address parameter. +029F: length rmb 2 ;Length parameter. +02A1: +02A1: brkpoints equ 4 ;Number of settable breakpoints. +02A1: bpaddr rmb brkpoints*3 ;Address and byte for each break point. +02AD: stepbp rmb 3 ;Address of P command break point. +02B0: +02B0: sorg rmb 2 ;Origin address of S record entry. +02B2: soffs rmb 2 ;Offset load adrr-addr in record +02B4: +02B4: oldgetc rmb 2 ;Old getchar address. +02B6: oldputc rmb 2 ;Old putchar address. +02B8: oldputcr rmb 2 ;Old putcr address. +02BA: lastterm rmb 1 ;Last terminating character. +02BB: filler rmb 1 ;Filler at end of XMODEM file. +02BC: xmcr rmb 1 ;end-of-line characters for XMODEM send. +02BD: savesp rmb 2 ;Save sp to restore it on error. +02BF: +02BF: * Following variables are used by assembler/disassembler. +02BF: prebyte rmb 1 +02C0: opc1 rmb 1 +02C1: opcode rmb 1 +02C2: postbyte rmb 1 +02C3: amode rmb 1 +02C4: operand rmb 2 +02C6: mnembuf rmb 5 ;Buffer to store capitalized mnemonic. +02CB: opsize rmb 1 ;SIze (in bytes) of extra oeprand (0--2) +02CC: uncert rmb 1 ;Flag to indicate that op is unknown. +02CD: dpsetting rmb 2 +02CF: +02CF: endvars equ * +02CF: +02CF: ramstart equ $400 ;first free RAM address. +02CF: +02CF: ramtop equ $8000 ;top of RAM. +02CF: +02CF: * I/O port addresses +02CF: aciactl equ $e000 ;Control port of ACIA +02CF: aciasta equ $e000 ;Status port of ACIA +02CF: aciadat equ $e001 ;Data port of ACIA +02CF: +02CF: * ASCII control characters. +02CF: SOH equ 1 +02CF: EOT equ 4 +02CF: ACK equ 6 +02CF: BS equ 8 +02CF: LF equ 10 +02CF: CR equ 13 +02CF: NAK equ 21 +02CF: CAN equ 24 +02CF: DEL equ 127 +02CF: +02CF: CASEMASK equ $DF ;Mask to make lowercase into uppercase. +02CF: +02CF: * Monitor ROM starts here. +02CF: org $E400 +E400: +E400: 1AFF reset orcc #$FF ;Disable interrupts. +E402: 4F clra +E403: 1F8B tfr a,dp ;Set direct page register to 0. +E405: 10CE0400 lds #ramstart +E409: 8EE4FF ldx #intvectbl +E40C: CE0280 ldu #swi3vec +E40F: C61B ldb #osvectbl-intvectbl +E411: 8D37 bsr blockmove ;Initialize interrupt vectors from ROM. +E413: 8EE51A ldx #osvectbl +E416: CE0000 ldu #0 +E419: C624 ldb #endvecs-osvectbl +E41B: 8D2D bsr blockmove ;Initialize I/O vectors from ROM. +E41D: 8D33 bsr initacia ;Initialize serial port. +E41F: 1C00 andcc #$0 ;Enable interrupts +E421: * Put the 'saved' registers of the program being monitored on top of the +E421: * stack. There are 12 bytes on the stack for cc,b,a,dp,x,y,u and pc +E421: * pc is initialized to $400, the rest to zero. +E421: 8E0000 ldx #0 +E424: 1F12 tfr x,y +E426: CE0400 ldu #ramstart +E429: 3450 pshs x,u +E42B: 3430 pshs x,y +E42D: 3430 pshs x,y +E42F: 8E029B ldx #oldpc +E432: C634 ldb #endvars-oldpc +E434: 6F80 clvar clr ,x+ +E436: 5A decb +E437: 26FB bne clvar ;Clear the variable area. +E439: CC1A03 ldd #$1A03 +E43C: FD02BB std filler ;Set XMODEM filler and end-of-line. +E43F: 8EE5C1 ldx #welcome +E442: BDE4E1 jsr outcount +E445: 9D0C jsr putcr ;Print a welcome message. +E447: 7EE558 jmp cmdline +E44A: * Block move routine, from X to U length B. Modifies them all and A. +E44A: A680 blockmove lda ,x+ +E44C: A7C0 sta ,u+ +E44E: 5A decb +E44F: 26F9 bne blockmove +E451: 39 rts +E452: +E452: * Initialize serial communications port, buffers, interrupts. +E452: C603 initacia ldb #$03 +E454: F7E000 stb aciactl +E457: C635 ldb #%00110101 +E459: 39 rts +E45A: +E45A: * O.S. routine to read a character into B register. +E45A: F6E000 osgetc ldb aciasta +E45D: C501 bitb #$01 +E45F: 27F9 beq osgetc +E461: F6E001 ldb aciadat +E464: 39 rts +E465: +E465: ;O.S. rotuine to check if there is a character ready to be read. +E465: F6E000 osgetpoll ldb aciasta +E468: C501 bitb #$01 +E46A: 2602 bne poltrue +E46C: 5F clrb +E46D: 39 rts +E46E: C6FF poltrue ldb #$ff +E470: 39 rts +E471: +E471: * O.S. routine to write the character in the B register. +E471: 3402 osputc pshs a +E473: B6E000 putcloop lda aciasta +E476: 8502 bita #$02 +E478: 27F9 beq putcloop +E47A: F7E001 stb aciadat +E47D: 3502 puls a +E47F: 39 rts +E480: +E480: * O.S. routine to read a line into memory at address X, at most B chars +E480: * long, return actual length in B. Permit backspace editing. +E480: 3412 osgetl pshs a,x +E482: D724 stb temp +E484: 4F clra +E485: 9D00 osgetl1 jsr getchar +E487: C47F andb #$7F +E489: C108 cmpb #BS +E48B: 2704 beq backsp +E48D: C17F cmpb #DEL +E48F: 2614 bne osgetl2 +E491: 4D backsp tsta ;Recognize BS and DEL as backspace key. +E492: 27F1 beq osgetl1 ;ignore if line already zero length. +E494: C608 ldb #BS +E496: 9D03 jsr putchar +E498: C620 ldb #' ' +E49A: 9D03 jsr putchar +E49C: C608 ldb #BS ;Send BS,space,BS. This erases last +E49E: 9D03 jsr putchar ;character on most terminals. +E4A0: 301F leax -1,x ;Decrement address. +E4A2: 4A deca +E4A3: 20E0 bra osgetl1 +E4A5: C10D osgetl2 cmpb #CR +E4A7: 2704 beq newline +E4A9: C10A cmpb #LF +E4AB: 2607 bne osgetl3 ;CR or LF character ends line. +E4AD: 9D0C newline jsr putcr +E4AF: 1F89 tfr a,b ;Move length to B +E4B1: 3512 puls a,x ;restore registers. +E4B3: 39 rts ;<--- Here is the exit point. +E4B4: C120 osgetl3 cmpb #' ' +E4B6: 25CD blo osgetl1 ;Ignore control characters. +E4B8: 9124 cmpa temp +E4BA: 27C9 beq osgetl1 ;Ignore char if line full. +E4BC: 9D03 jsr putchar ;Echo the character. +E4BE: E780 stb ,x+ ;Store it in memory. +E4C0: 4C inca +E4C1: 20C2 bra osgetl1 +E4C3: +E4C3: * O.S. routine to write a line starting at address X, B chars long. +E4C3: 3416 osputl pshs a,b,x +E4C5: 1F98 tfr b,a +E4C7: 4D tsta +E4C8: 2707 beq osputl1 +E4CA: E680 osputl2 ldb ,x+ +E4CC: 9D03 jsr putchar +E4CE: 4A deca +E4CF: 26F9 bne osputl2 +E4D1: 3516 osputl1 puls a,b,x +E4D3: 39 rts +E4D4: +E4D4: * O.S. routine to terminate a line. +E4D4: 3404 oscr pshs b +E4D6: C60D ldb #CR +E4D8: 9D03 jsr putchar +E4DA: C60A ldb #LF +E4DC: 9D03 jsr putchar ;Send the CR and LF characters. +E4DE: 3504 puls b +E4E0: 39 rts +E4E1: +E4E1: * Output a counted string at addr X +E4E1: 3414 outcount pshs x,b +E4E3: E680 ldb ,x+ +E4E5: 9D09 jsr putline +E4E7: 3514 puls x,b +E4E9: 39 rts +E4EA: +E4EA: 0C2C timerirq inc timer+2 +E4EC: 2608 bne endirq +E4EE: 0C2B inc timer+1 +E4F0: 2604 bne endirq +E4F2: 0C2A inc timer +E4F4: 3B rti +E4F5: 12 aciairq nop +E4F6: 3B endirq rti +E4F7: +E4F7: * Wait D times 20ms. +E4F7: D32B osdly addd timer+1 +E4F9: 10932B dlyloop cmpd timer+1 +E4FC: 26FB bne dlyloop +E4FE: 39 rts +E4FF: +E4FF: * This table will be copied to the interrupt vector area in RAM. +E4FF: 7EE4F6 intvectbl jmp endirq +E502: 7EE4F6 jmp endirq +E505: 7EE4EA jmp timerirq +E508: 7EE4F5 jmp aciairq +E50B: 7EE549 jmp unlaunch +E50E: 7EE4F6 jmp endirq +E511: 7EEDED jmp xerrhand +E514: 7EF69B jmp expr +E517: 7E0298 jmp asmerrvec +E51A: * And this one to the I/O vector table. +E51A: 7EE45A osvectbl jmp osgetc +E51D: 7EE471 jmp osputc +E520: 7EE480 jmp osgetl +E523: 7EE4C3 jmp osputl +E526: 7EE4D4 jmp oscr +E529: 7EE465 jmp osgetpoll +E52C: 7EECE6 jmp xopin +E52F: 7EED09 jmp xopout +E532: 7EED2E jmp xabtin +E535: 7EED71 jmp xclsin +E538: 7EED4E jmp xclsout +E53B: 7EE4F7 jmp osdly +E53E: endvecs equ * +E53E: +E53E: * The J command returns here. +E53E: 3410 stakregs pshs x ;Stack something where the pc comes +E540: 347F pshs ccr,b,a,dp,x,y,u ;Stack the normal registers. +E542: BE029B ldx oldpc +E545: AF6A stx 10,s ;Stack the old pc value. +E547: 2007 bra unlaunch1 +E549: * The G and P commands return here through a breakpoint. +E549: * Registers are already stacked. +E549: EC6A unlaunch ldd 10,s +E54B: 830001 subd #1 +E54E: ED6A std 10,s ;Decrement pc before breakpoint +E550: 1C00 unlaunch1 andcc #$0 ;reenable the interrupts. +E552: BDE970 jsr disarm ;Disarm the breakpoints. +E555: BDE8C5 jsr dispregs +E558: 9D1E cmdline jsr xcloseout +E55A: 10FF02BD sts savesp +E55E: 8E0200 ldx #linebuf +E561: C680 ldb #buflen +E563: 9D06 jsr getline +E565: 5D tstb +E566: 27F0 beq cmdline ;Ignore line if it is empty +E568: 3A abx +E569: 6F84 clr ,x ;Make location after line zero. +E56B: 8E0200 ldx #linebuf +E56E: E680 ldb ,x+ +E570: C4DF andb #CASEMASK ;Make 1st char uppercase. +E572: C041 subb #'A' +E574: 253E bcs unk +E576: C11A cmpb #26 +E578: 243A bcc unk ;Unknown cmd if it is not a letter. +E57A: 8EE580 ldx #cmdtab +E57D: 58 aslb ;Index into command table. +E57E: 6E95 jmp [b,x] +E580: +E580: FBA4E9A6E5B4E7 cmdtab fdb asm,break,unk,dump +E588: E7BDEB56E86AE8 fdb enter,find,go,hex +E590: E824E879E5B4E5 fdb inp,jump,unk,unk +E598: EB19E5B4E5B4E8 fdb move,unk,unk,prog +E5A0: E5B4E90CEA14E8 fdb unk,regs,srec,trace +E5A8: F644E5B4E5B4ED fdb unasm,unk,unk,xmodem +E5B0: E5B4E5B4 fdb unk,unk +E5B4: +E5B4: * Unknown command handling routine. +E5B4: 9D18 unk jsr xabortin +E5B6: 8EE5DE ldx #unknown +E5B9: BDE4E1 jsr outcount +E5BC: 9D0C jsr putcr +E5BE: 7EE558 jmp cmdline +E5C1: +E5C1: +E5C1: +E5C1: * Here are some useful messages. +E5C1: 1C welcome fcb unknown-welcome-1 +E5C2: 57656C636F6D65 fcc "Welcome to BUGGY version 1.0" +E5DE: 0F unknown fcb brkmsg-unknown-1 +E5DF: 556E6B6E6F776E fcc "Unknown command" +E5EE: 0E brkmsg fcb clrmsg-brkmsg-1 +E5EF: 427265616B706F fcc "Breakpoint set" +E5FD: 12 clrmsg fcb fullmsg-clrmsg-1 +E5FE: 427265616B706F fcc "Breakpoint cleared" +E610: 10 fullmsg fcb smsg-fullmsg-1 +E611: 427265616B706F fcc "Breakpoints full" +E621: 11 smsg fcb lastrec-smsg-1 +E622: 4572726F722069 fcc "Error in S record" +E633: 0A lastrec fcb xsmsg-lastrec-1 +E634: 53393033303030 fcc "S9030000FC" +E63E: 11 xsmsg fcb xrmsg-xsmsg-1 +E63F: 53746172742058 fcc "Start XMODEM Send" +E650: 14 xrmsg fcb xamsg-xrmsg-1 +E651: 53746172742058 fcc "Start XMODEM Receive" +E665: 17 xamsg fcb invmmsg-xamsg-1 +E666: 584D4F44454D20 fcc "XMODEM transfer aborted" +E67D: 10 invmmsg fcb exprmsg-invmmsg-1 +E67E: 496E76616C6964 fcc "Invalid mnemonic" +E68E: 10 exprmsg fcb modemsg-exprmsg-1 +E68F: 45787072657373 fcc "Expression error" +E69F: 15 modemsg fcb brmsg-modemsg-1 +E6A0: 41646472657373 fcc "Addressing mode error" +E6B5: 0F brmsg fcb endmsg-brmsg-1 +E6B6: 4272616E636820 fcc "Branch too long" +E6C5: endmsg equ * +E6C5: +E6C5: * Output hex digit contained in A +E6C5: 8B90 hexdigit adda #$90 +E6C7: 19 daa +E6C8: 8940 adca #$40 +E6CA: 19 daa ;It's the standard conversion trick ascii +E6CB: 1F89 tfr a,b ;to hex without branching. +E6CD: 9D03 jsr putchar +E6CF: 39 rts +E6D0: +E6D0: * Output contents of A as two hex digits +E6D0: 3402 outbyte pshs a +E6D2: 44 lsra +E6D3: 44 lsra +E6D4: 44 lsra +E6D5: 44 lsra +E6D6: 8DED bsr hexdigit +E6D8: 3502 puls a +E6DA: 840F anda #$0f +E6DC: 20E7 bra hexdigit +E6DE: +E6DE: * Output contents of d as four hex digits +E6DE: 3404 outd pshs b +E6E0: 8DEE bsr outbyte +E6E2: 3502 puls a +E6E4: 8DEA bsr outbyte +E6E6: 39 rts +E6E7: +E6E7: * Skip X past spaces, B is first non-space character. +E6E7: E680 skipspace ldb ,x+ +E6E9: C120 cmpb #' ' +E6EB: 27FA beq skipspace +E6ED: 39 rts +E6EE: +E6EE: * Convert ascii hex digit in B register to binary Z flag set if no hex digit. +E6EE: C030 convb subb #'0' +E6F0: 2513 blo convexit +E6F2: C109 cmpb #9 +E6F4: 230C bls cb2 +E6F6: C4DF andb #CASEMASK ;Make uppercase. +E6F8: C007 subb #7 ;If higher than digit 9 it must be a letter. +E6FA: C109 cmpb #9 +E6FC: 2307 bls convexit +E6FE: C10F cmpb #15 +E700: 2203 bhi convexit +E702: 1CFB cb2 andcc #$FB ;clear zero +E704: 39 rts +E705: 1A04 convexit orcc #$04 +E707: 39 rts +E708: +E708: DC24 scanexit ldd temp +E70A: 301F leax -1,x +E70C: 0D26 tst temp2 +E70E: 39 rts <-- exit point of scanhex +E70F: +E70F: * Scan for hexadecimal number at address X return in D, Z flag is set it no +E70F: * number found. +E70F: 0F24 scanhex clr temp +E711: 0F25 clr temp+1 +E713: 0F26 clr temp2 +E715: 8DD0 bsr skipspace +E717: BDE6EE scloop jsr convb +E71A: 27EC beq scanexit +E71C: 3404 pshs b +E71E: DC24 ldd temp +E720: 58 aslb +E721: 49 rola +E722: 58 aslb +E723: 49 rola +E724: 58 aslb +E725: 49 rola +E726: 58 aslb +E727: 49 rola +E728: EBE0 addb ,s+ +E72A: DD24 std temp +E72C: 0C26 inc temp2 +E72E: E680 ldb ,x+ +E730: 20E5 bra scloop +E732: +E732: FD029F scan2parms std length +E735: 8DD8 bsr scanhex +E737: 2710 beq sp2 +E739: FD029D std addr +E73C: 8DA9 bsr skipspace +E73E: C12C cmpb #',' +E740: 2607 bne sp2 +E742: 8DCB bsr scanhex +E744: 2703 beq sp2 +E746: FD029F std length +E749: 39 sp2 rts +E74A: +E74A: * Scan two hexdigits at in and convert to byte into A, Z flag if error. +E74A: 8D9B scanbyte bsr skipspace +E74C: 8DA0 bsr convb +E74E: 2712 beq sb1 +E750: 1F98 tfr b,a +E752: E680 ldb ,x+ +E754: 8D98 bsr convb +E756: 270A beq sb1 +E758: 48 asla +E759: 48 asla +E75A: 48 asla +E75B: 48 asla +E75C: D724 stb temp +E75E: 9B24 adda temp +E760: 1CFB andcc #$fb ;Clear zero flag +E762: 39 sb1 rts +E763: +E763: +E763: * This is the code for the D command, hex/ascii dump of memory +E763: * Syntax: D or D or D, +E763: 8E0201 dump ldx #linebuf+1 +E766: CC0040 ldd #$40 +E769: BDE732 jsr scan2parms ;Scan address and length, default length=64 +E76C: 10BE029D ldy addr +E770: 8610 dh1 lda #16 +E772: 9725 sta temp+1 +E774: 1F20 tfr y,d +E776: BDE6DE jsr outd +E779: C620 ldb #' ' +E77B: 9D03 jsr putchar +E77D: A6A0 dh2 lda ,y+ ;display row of 16 mem locations as hex +E77F: BDE6D0 jsr outbyte +E782: C620 ldb #' ' +E784: 9625 lda temp+1 +E786: 8109 cmpa #9 +E788: 2602 bne dh6 +E78A: C62D ldb #'-' ;Do a - after the eighth byte. +E78C: 9D03 dh6 jsr putchar +E78E: 0A25 dec temp+1 +E790: 26EB bne dh2 +E792: 3130 leay -16,y ;And now for the ascii dump. +E794: 8610 lda #16 +E796: E6A0 dh3 ldb ,y+ +E798: C120 cmpb #' ' +E79A: 2402 bhs dh4 +E79C: C62E ldb #'.' +E79E: C17F dh4 cmpb #DEL +E7A0: 2502 blo dh5 +E7A2: C62E ldb #'.' ;Convert all nonprintables to . +E7A4: 9D03 dh5 jsr putchar +E7A6: 4A deca +E7A7: 26ED bne dh3 +E7A9: 9D0C jsr putcr +E7AB: FC029F ldd length +E7AE: 830010 subd #16 +E7B1: FD029F std length +E7B4: 22BA bhi dh1 +E7B6: 10BF029D sty addr +E7BA: 7EE558 jmp cmdline +E7BD: +E7BD: * This is the code for the E command, enter hex bytes or ascii string. +E7BD: * Syntax E or E or E or E"string" +E7BD: 8E0201 enter ldx #linebuf+1 +E7C0: BDE70F jsr scanhex +E7C3: 2703 beq ent1 +E7C5: FD029D std addr +E7C8: 8D26 ent1 bsr entline +E7CA: 1026FD8A lbne cmdline ;No bytes, then enter interactively. +E7CE: C645 ent2 ldb #'E' +E7D0: 9D03 jsr putchar +E7D2: FC029D ldd addr +E7D5: BDE6DE jsr outd +E7D8: C620 ldb #' ' +E7DA: 9D03 jsr putchar ;Display Eaddr + space +E7DC: 8E0200 ldx #linebuf +E7DF: C680 ldb #buflen +E7E1: 9D06 jsr getline ;Get the line. +E7E3: 3A abx +E7E4: 6F84 clr ,x +E7E6: 8E0200 ldx #linebuf +E7E9: 8D05 bsr entline +E7EB: 26E1 bne ent2 +E7ED: 7EE558 jmp cmdline +E7F0: +E7F0: * Enter a line of hex bytes or ascci string at address X, Z if empty. +E7F0: BDE6E7 entline jsr skipspace +E7F3: 5D tstb +E7F4: 272B beq entexit +E7F6: C122 cmpb #'"' +E7F8: 270F beq entasc +E7FA: 301F leax -1,x +E7FC: 10BE029D ldy addr +E800: BDE74A entl2 jsr scanbyte ;Enter hex digits. +E803: 2715 beq entdone +E805: A7A0 sta ,y+ +E807: 20F7 bra entl2 +E809: 10BE029D entasc ldy addr +E80D: A680 entl3 lda ,x+ +E80F: 4D tsta +E810: 2708 beq entdone +E812: 8122 cmpa #'"' +E814: 2704 beq entdone +E816: A7A0 sta ,y+ +E818: 20F3 bra entl3 +E81A: 10BF029D entdone sty addr +E81E: 1CFB andcc #$fb +E820: 39 rts +E821: 1A04 entexit orcc #$04 +E823: 39 rts +E824: +E824: *This is the code for the I command, display the contents of an address +E824: * Syntax: Iaddr +E824: 8E0201 inp ldx #linebuf+1 +E827: BDE70F jsr scanhex +E82A: 1F01 tfr d,x +E82C: A684 lda ,x ;Read the byte from memory. +E82E: BDE6D0 jsr outbyte ;Display itin hex. +E831: 9D0C jsr putcr +E833: 7EE558 jmp cmdline +E836: +E836: *This is the code for the H command, display result of simple hex expression +E836: *Syntax Hhexnum{+|-hexnum} +E836: 8E0201 hex ldx #linebuf+1 +E839: BDE70F jsr scanhex +E83C: DD28 std temp3 +E83E: BDE6E7 hexloop jsr skipspace +E841: C12B cmpb #'+' +E843: 2609 bne hex1 +E845: BDE70F jsr scanhex +E848: D328 addd temp3 +E84A: DD28 std temp3 +E84C: 20F0 bra hexloop +E84E: C12D hex1 cmpb #'-' +E850: 260E bne hexend +E852: BDE70F jsr scanhex +E855: 53 comb +E856: 43 coma +E857: C30001 addd #1 +E85A: D328 addd temp3 +E85C: DD28 std temp3 +E85E: 20DE bra hexloop +E860: DC28 hexend ldd temp3 +E862: BDE6DE jsr outd +E865: 9D0C jsr putcr +E867: 7EE558 jmp cmdline +E86A: +E86A: * This is the code for the G command, jump to the program +E86A: * Syntax G or G +E86A: 8E0201 go ldx #linebuf+1 +E86D: BDE70F jsr scanhex +E870: 2702 beq launch +E872: ED6A std 10,s ;Store parameter in pc location. +E874: BDE98A launch jsr arm ;Arm the breakpoints. +E877: 35FF puls ccr,b,a,dp,x,y,u,pc +E879: +E879: * This is the code for the J command, run a subroutine. +E879: * Syntax J +E879: 8E0201 jump ldx #linebuf+1 +E87C: EC6A ldd 10,s +E87E: FD029B std oldpc ;Save old pc +E881: BDE70F jsr scanhex +E884: ED6A std 10,s ;Store parameter in PC location +E886: 1F41 tfr s,x +E888: 327E leas -2,s +E88A: 1F43 tfr s,u +E88C: C60C ldb #12 ;Move the saved register set 2 addresses +E88E: BDE44A jsr blockmove ;down on the stack. +E891: CCE53E ldd #stakregs +E894: ED6C std 12,s ;Prepare subroutine return address. +E896: 20DC bra launch ;Jump to the routine. +E898: +E898: +E898: * This is the code for the P command, run instruction followed by breakpoint +E898: * Syntax P +E898: 10AE6A prog ldy 10,s ;Get program counter value. +E89B: BDF36B jsr disdecode ;Find out location past current insn. +E89E: 10BF02AD sty stepbp +E8A2: 20D0 bra launch +E8A4: +E8A4: * This is the code for the T command, single step trace an instruction. +E8A4: * Syntax T +E8A4: 7EE558 trace jmp cmdline +E8A7: +E8A7: * Display the contents of 8 bit register, name in B, contents in A +E8A7: 9D03 disp8 jsr putchar +E8A9: C63D ldb #'=' +E8AB: 9D03 jsr putchar +E8AD: BDE6D0 jsr outbyte +E8B0: C620 ldb #' ' +E8B2: 9D03 jsr putchar +E8B4: 39 rts +E8B5: +E8B5: * Display the contents of 16 bit register, name in B, contents in Y +E8B5: 9D03 disp16 jsr putchar +E8B7: C63D ldb #'=' +E8B9: 9D03 jsr putchar +E8BB: 1F20 tfr y,d +E8BD: BDE6DE jsr outd +E8C0: C620 ldb #' ' +E8C2: 9D03 jsr putchar +E8C4: 39 rts +E8C5: +E8C5: * Display the contents of the registers and disassemble instruction at +E8C5: * PC location. +E8C5: C658 dispregs ldb #'X' +E8C7: 10AE66 ldy 6,s ;Note that there's one return address on +E8CA: 8DE9 bsr disp16 ;stack so saved register offsets are +E8CC: C659 ldb #'Y' ;inremented by 2. +E8CE: 10AE68 ldy 8,s +E8D1: 8DE2 bsr disp16 +E8D3: C655 ldb #'U' +E8D5: 10AE6A ldy 10,s +E8D8: 8DDB bsr disp16 +E8DA: C653 ldb #'S' +E8DC: 1F42 tfr s,y +E8DE: 312E leay 14,y ;S of the running program is 12 higher, +E8E0: ;because regs are not stacked when running. +E8E0: 8DD3 bsr disp16 +E8E2: C641 ldb #'A' +E8E4: A663 lda 3,s +E8E6: 8DBF bsr disp8 +E8E8: C642 ldb #'B' +E8EA: A664 lda 4,s +E8EC: 8DB9 bsr disp8 +E8EE: C644 ldb #'D' +E8F0: A665 lda 5,s +E8F2: 8DB3 bsr disp8 +E8F4: C643 ldb #'C' +E8F6: A662 lda 2,s +E8F8: 8DAD bsr disp8 +E8FA: 9D0C jsr putcr +E8FC: C650 ldb #'P' +E8FE: 10AE6C ldy 12,s +E901: 8DB2 bsr disp16 +E903: BDF36B jsr disdecode +E906: BDF44E jsr disdisp ;Disassemble instruction at PC +E909: 9D0C jsr putcr +E90B: 39 rts +E90C: +E90C: +E90C: * This is the code for the R command, display or alter the registers. +E90C: * Syntax R or R +E90C: 8E0201 regs ldx #linebuf+1 +E90F: BDE6E7 jsr skipspace +E912: 5D tstb +E913: 2605 bne setreg +E915: 8DAE bsr dispregs ;Display regs ifnothing follows. +E917: 7EE558 jmp cmdline +E91A: 108EE966 setreg ldy #regtab +E91E: 4F clra +E91F: C4DF andb #CASEMASK ;Make letter uppercase. +E921: 6DA4 sr1 tst ,y +E923: 1027FC8D lbeq unk ;At end of register tab, unknown reg +E927: E1A0 cmpb ,y+ +E929: 2703 beq sr2 ;Found the register? +E92B: 4C inca +E92C: 20F3 bra sr1 +E92E: 3402 sr2 pshs a +E930: BDE70F jsr scanhex ;Convert the hex argument. +E933: 3406 pshs d +E935: A662 lda 2,s ;Get register number. +E937: 8104 cmpa #4 +E939: 2409 bcc sr3 +E93B: E661 ldb 1,s ;It's 8 bit. +E93D: 3263 leas 3,s ;Remove temp stuff from stack. +E93F: E7E6 stb a,s ;Store it in the reg on stack. +E941: 7EE558 jmp cmdline +E944: 8108 sr3 cmpa #8 +E946: 240C bcc sr4 +E948: 3510 puls x ;It's 16 bit. +E94A: 3261 leas 1,s +E94C: 48 lsla +E94D: 8004 suba #4 ;Convert reg no to stack offset. +E94F: AFE6 stx a,s +E951: 7EE558 jmp cmdline +E954: 3540 sr4 puls u ;It's the stack pointer. +E956: 3261 leas 1,s +E958: 3354 leau -12,u +E95A: 1F41 tfr s,x +E95C: 1F34 tfr u,s ;Set new stack pointer. +E95E: C60C ldb #12 +E960: BDE44A jsr blockmove ;Move register set to new stack location. +E963: 7EE558 jmp cmdline +E966: +E966: 43414244585955 regtab FCC "CABDXYUPS " +E970: +E970: * Disarm the breakpoints, this is replace the SWI instructions with the +E970: * original byte. +E970: 8E02A1 disarm ldx #bpaddr +E973: 8605 lda #brkpoints+1 +E975: EE81 disarm1 ldu ,x++ +E977: E680 ldb ,x+ ;Get address in u, byte in b +E979: 11830000 cmpu #0 +E97D: 2702 beq disarm2 +E97F: E7C4 stb ,u +E981: 4A disarm2 deca +E982: 26F1 bne disarm1 +E984: CE0000 ldu #0 +E987: EF1D stu -3,x ;Clear the step breakpoint. +E989: 39 rts +E98A: +E98A: * Arm the breakponts, this is replace the byte at the breakpoint address +E98A: * with an SWI instruction. +E98A: 8E02AD arm ldx #bpaddr+brkpoints*3 +E98D: 8605 lda #brkpoints+1 ;Arm them in reverse order of disarming. +E98F: EE84 arm1 ldu ,x ;Get address in u. +E991: 270D beq arm2 +E993: E6C4 ldb ,u +E995: E702 stb 2,x +E997: 11A36C cmpu 12,s ;Compare to program counter location +E99A: 2704 beq arm2 +E99C: C63F ldb #$3F +E99E: E7C4 stb ,u ;Store SWI instruction if not equal. +E9A0: 301D arm2 leax -3,x +E9A2: 4A deca +E9A3: 26EA bne arm1 +E9A5: 39 rts +E9A6: +E9A6: * This is the code for the break command, set, clear display breakpoints. +E9A6: * Syntax B or B. B displays, B sets or clears breakpoint. +E9A6: 8604 break lda #brkpoints +E9A8: 9727 sta temp2+1 ;Store number of breakpoints to visit. +E9AA: 8E0201 ldx #linebuf+1 +E9AD: BDE70F jsr scanhex +E9B0: 273B beq dispbp ;No number then display breakpoints +E9B2: 8E02A1 ldx #bpaddr +E9B5: CE0000 ldu #0 +E9B8: 1F32 tfr u,y +E9BA: 10A384 bp1 cmpd ,x +E9BD: 2720 beq clearit ;Found the breakpoint, so clear it, +E9BF: 11A384 cmpu ,x ;Is location zero +E9C2: 2602 bne bp2 +E9C4: 1F12 tfr x,y ;Set free address to y +E9C6: 3003 bp2 leax 3,x +E9C8: 0A27 dec temp2+1 +E9CA: 26EE bne bp1 +E9CC: 108C0000 cmpy #0 ;Address not found in list of breakpoints +E9D0: 2716 beq bpfull ;Was free address found. +E9D2: EDA4 std ,y ;If so, store breakpoint there. +E9D4: 8EE5EE ldx #brkmsg +E9D7: BDE4E1 bpexit jsr outcount +E9DA: 9D0C jsr putcr +E9DC: 7EE558 jmp cmdline +E9DF: 4F clearit clra +E9E0: 5F clrb +E9E1: ED84 std ,x +E9E3: 8EE5FD ldx #clrmsg +E9E6: 20EF bra bpexit +E9E8: 8EE610 bpfull ldx #fullmsg +E9EB: 20EA bra bpexit +E9ED: +E9ED: 8E02A1 dispbp ldx #bpaddr +E9F0: EC84 dbp1 ldd ,x +E9F2: 2707 beq dbp2 +E9F4: BDE6DE jsr outd +E9F7: C620 ldb #' ' +E9F9: 9D03 jsr putchar +E9FB: 3003 dbp2 leax 3,x +E9FD: 0A27 dec temp2+1 +E9FF: 26EF bne dbp1 +EA01: 9D0C jsr putcr +EA03: 7EE558 jmp cmdline +EA06: +EA06: * Scan hex byte into a and add it to check sum in temp2+1 +EA06: BDE74A addchk jsr scanbyte +EA09: 10270077 lbeq srecerr +EA0D: 1F89 tfr a,b +EA0F: DB27 addb temp2+1 +EA11: D727 stb temp2+1 +EA13: 39 rts +EA14: +EA14: * This tis the code for the S command, the Motorola S records entry. +EA14: * Syntax SO or SS, or S1 or S9 +EA14: 8E0201 srec ldx #linebuf+1 +EA17: E680 ldb ,x+ +EA19: C4DF andb #CASEMASK +EA1B: C14F cmpb #'O' +EA1D: 2772 beq setsorg +EA1F: C153 cmpb #'S' +EA21: 277C beq sendrec +EA23: E61F ldb -1,x +EA25: 0F28 clr temp3 +EA27: C131 cmpb #'1' +EA29: 2706 beq readrec +EA2B: C139 cmpb #'9' +EA2D: 2655 bne srecerr +EA2F: 0C28 inc temp3 +EA31: 0F27 readrec clr temp2+1 ;clear checksum. +EA33: 8DD1 bsr addchk +EA35: 8002 suba #2 ;discount the address bytes from the count. +EA37: 9729 sta temp3+1 ;Read length byte. +EA39: 8DCB bsr addchk +EA3B: 3402 pshs a +EA3D: 8DC7 bsr addchk +EA3F: 3504 puls b +EA41: 1E89 exg a,b ;Read address into d. +EA43: FE02B0 ldu sorg +EA46: 270F beq rr1 +EA48: FE02B2 ldu soffs +EA4B: 260A bne rr1 +EA4D: 3406 pshs d ;Sorg is nonzero and soffs is zero, now +EA4F: B302B0 subd sorg ;set soffs +EA52: FD02B2 std soffs +EA55: 3506 puls d +EA57: B302B2 rr1 subd soffs ;Subtract the address offset. +EA5A: 1F02 tfr d,y +EA5C: 8DA8 rr2 bsr addchk +EA5E: 0A29 dec temp3+1 +EA60: 2704 beq endrec +EA62: A7A0 sta ,y+ +EA64: 20F6 bra rr2 +EA66: 0C27 endrec inc temp2+1 ;Check checksum. +EA68: 261A bne srecerr +EA6A: 0D28 tst temp3 +EA6C: 1027FAE8 lbeq cmdline ;Was it no S9 record? +EA70: 108C0000 cmpy #0 +EA74: 2703 beq endrec1 +EA76: 10AF6A sty 10,s ;Store address into program counter. +EA79: 4F endrec1 clra +EA7A: 5F clrb +EA7B: FD02B0 std sorg ;Reset sorg, next S loads will be normal. +EA7E: FD02B2 std soffs +EA81: 7EE558 jmp cmdline +EA84: 9D18 srecerr jsr xabortin +EA86: 8EE621 ldx #smsg ;Error in srecord, display message. +EA89: BDE4E1 jsr outcount +EA8C: 9D0C jsr putcr +EA8E: 7EE558 jmp cmdline +EA91: BDE70F setsorg jsr scanhex ;Set S record origin. +EA94: FD02B0 std sorg +EA97: 4F clra +EA98: 5F clrb +EA99: FD02B2 std soffs +EA9C: 7EE558 jmp cmdline +EA9F: * Send a memory region as S-records. +EA9F: CC0100 sendrec ldd #$100 ;Scan address and length parameter. +EAA2: BDE732 jsr scan2parms +EAA5: FC02B0 ldd sorg +EAA8: 2709 beq ss1 +EAAA: FC029D ldd addr +EAAD: B302B0 subd sorg +EAB0: FD02B2 std soffs ;Compute offset for origin. +EAB3: FC029F ss1 ldd length +EAB6: 2748 beq endss ;All bytes sent? +EAB8: 10830010 cmpd #16 +EABC: 2502 blo ss2 +EABE: C610 ldb #16 ;If more than 16 left, then send 16. +EAC0: D724 ss2 stb temp +EAC2: 50 negb +EAC3: FE029F ldu length +EAC6: 33C5 leau b,u +EAC8: FF029F stu length ;Discount line length from length. +EACB: C653 ldb #'S' +EACD: 9D03 jsr putchar +EACF: C631 ldb #'1' +EAD1: 9D03 jsr putchar +EAD3: 0F25 clr temp+1 ;Clear check sum +EAD5: D624 ldb temp +EAD7: CB03 addb #3 +EAD9: 8D30 bsr checkout ;Output byte b as hex and add to check sum. +EADB: FC029D ldd addr +EADE: 1F02 tfr d,y +EAE0: B302B2 subd soffs +EAE3: 1E89 exg a,b +EAE5: 8D24 bsr checkout +EAE7: 1E89 exg a,b +EAE9: 8D20 bsr checkout ;Output address (add into check sum) +EAEB: E6A0 ss3 ldb ,y+ +EAED: 8D1C bsr checkout +EAEF: 0A24 dec temp +EAF1: 26F8 bne ss3 +EAF3: 10BF029D sty addr +EAF7: D625 ldb temp+1 +EAF9: 53 comb +EAFA: 8D0F bsr checkout ;Output checksum byte. +EAFC: 9D0C jsr putcr +EAFE: 20B3 bra ss1 +EB00: 8EE633 endss ldx #lastrec +EB03: BDE4E1 jsr outcount +EB06: 9D0C jsr putcr +EB08: 7EE558 jmp cmdline +EB0B: * Output byte in register B and add it into check sum at temp+1 +EB0B: 3402 checkout pshs a +EB0D: 1F98 tfr b,a +EB0F: DB25 addb temp+1 +EB11: D725 stb temp+1 +EB13: BDE6D0 jsr outbyte +EB16: 3502 puls a +EB18: 39 rts +EB19: +EB19: * This is the code for the M command, move memory region. +EB19: * Syntax: Maddr1,addr2,length +EB19: 8E0201 move ldx #linebuf+1 +EB1C: BDE70F jsr scanhex +EB1F: 1027FA91 lbeq unk +EB23: DD28 std temp3 +EB25: BDE6E7 jsr skipspace +EB28: C12C cmpb #',' +EB2A: 1026FA86 lbne unk +EB2E: BDE70F jsr scanhex +EB31: 1027FA7F lbeq unk +EB35: 1F03 tfr d,u +EB37: BDE6E7 jsr skipspace +EB3A: C12C cmpb #',' +EB3C: 1026FA74 lbne unk +EB40: BDE70F jsr scanhex +EB43: 1027FA6D lbeq unk +EB47: 1F02 tfr d,y ;Read the argument separated by commas +EB49: 9E28 ldx temp3 ;src addr to x, dest addr to u, length to y +EB4B: ;Don't tolerate syntax deviations. +EB4B: A680 mvloop lda ,x+ +EB4D: A7C0 sta ,u+ +EB4F: 313F leay -1,y +EB51: 26F8 bne mvloop ;Perform the block move. +EB53: 7EE558 jmp cmdline +EB56: +EB56: +EB56: * This is the code for the F command, find byte/ascii string in memory. +EB56: * Syntax: Faddr bytes or Faddr "ascii" +EB56: 8E0201 find ldx #linebuf+1 +EB59: BDE70F jsr scanhex +EB5C: 1F02 tfr d,y ;Scan the start address. +EB5E: BDE6E7 jsr skipspace +EB61: C122 cmpb #'"' +EB63: 2611 bne findhex +EB65: CE0200 ldu #linebuf ;Quote found, so scan for quoted string. +EB68: 4F clra +EB69: E680 fstrloop ldb ,x+ +EB6B: 271F beq startsrch ;End of line without final quote. +EB6D: C122 cmpb #'"' +EB6F: 271B beq startsrch ;End quote found +EB71: E7C0 stb ,u+ +EB73: 4C inca +EB74: 20F3 bra fstrloop +EB76: CE0200 findhex ldu #linebuf ;Convert string of hex bytes. +EB79: 301F leax -1,x ;String will be stored at start of line +EB7B: 4F clra ;buffer and may overwrite part of the +EB7C: 3402 fhexloop pshs a ;already converted string. +EB7E: BDE74A jsr scanbyte +EB81: 1F89 tfr a,b +EB83: 3502 puls a +EB85: 2705 beq startsrch +EB87: E7C0 stb ,u+ +EB89: 4C inca +EB8A: 20F0 bra fhexloop +EB8C: 4D startsrch tsta ;Start searching, start addr in Y, +EB8D: ;string starts at linebuf, length A +EB8D: 1027F9C7 lbeq cmdline ;Quit with zero length string. +EB91: 0F28 clr temp3 +EB93: 9729 sta temp3+1 +EB95: 1F21 srchloop tfr y,x +EB97: 9629 lda temp3+1 +EB99: 8CE100 cmpx #$e100 +EB9C: 2409 bcc srch1 +EB9E: 3086 leax a,x +EBA0: 8CE000 cmpx #$e000 ;Stop at I/O addresses. +EBA3: 1024F9B1 lbcc cmdline +EBA7: 1F21 srch1 tfr y,x +EBA9: CE0200 ldu #linebuf +EBAC: E680 srch2 ldb ,x+ +EBAE: E1C0 cmpb ,u+ +EBB0: 2614 bne srch3 ;Not equal, try next address. +EBB2: 4A deca +EBB3: 26F7 bne srch2 +EBB5: 1F20 tfr y,d +EBB7: BDE6DE jsr outd ;String found +EBBA: 9D0C jsr putcr +EBBC: 0C28 inc temp3 +EBBE: 9628 lda temp3 +EBC0: 8110 cmpa #$10 +EBC2: 1027F992 lbeq cmdline ;If 10 matches found, just stop. +EBC6: 3121 srch3 leay 1,y +EBC8: 20CB bra srchloop +EBCA: +EBCA: * Send the contents of the xmodem buffer and get it acknowledged, zero flag +EBCA: * is set if transfer aborted. +EBCA: C601 xsendbuf ldb #SOH +EBCC: BDE471 jsr osputc ;Send SOH +EBCF: D62D ldb xpacknum +EBD1: BDE471 jsr osputc ;Send block number. +EBD4: 53 comb +EBD5: BDE471 jsr osputc ;and its complement. +EBD8: 0F2E clr xsum +EBDA: 8680 lda #128 +EBDC: 8E0100 ldx #buf0 +EBDF: E684 xsloop ldb ,x +EBE1: DB2E addb xsum +EBE3: D72E stb xsum +EBE5: E680 ldb ,x+ +EBE7: BDE471 jsr osputc +EBEA: 4A deca +EBEB: 26F2 bne xsloop ;Send the buffer contents. +EBED: D62E ldb xsum +EBEF: BDE471 jsr osputc ;Send the check sum +EBF2: BDE45A waitack jsr osgetc +EBF5: C118 cmpb #CAN +EBF7: 270C beq xsabt ;^X for abort. +EBF9: C115 cmpb #NAK +EBFB: 27CD beq xsendbuf ;Send again if NAK +EBFD: C106 cmpb #ACK +EBFF: 26F1 bne waitack +EC01: 0C2D inc xpacknum +EC03: 1CFB xsok andcc #$fb ;Clear zero flag after ACK +EC05: 39 xsabt rts +EC06: +EC06: * Start an XMODEM send session. +EC06: C601 xsendinit ldb #1 +EC08: D72D stb xpacknum ;Initialize block number. +EC0A: BDE45A waitnak jsr osgetc +EC0D: C118 cmpb #CAN +EC0F: 27F4 beq xsabt ;If ^X exit with zero flag. +EC11: C115 cmpb #NAK +EC13: 27EE beq xsok +EC15: 20F3 bra waitnak ;Wait until NAK received. +EC17: +EC17: * Send ETX and wait for ack. +EC17: C604 xsendeot ldb #EOT +EC19: BDE471 jsr osputc +EC1C: BDE45A waitack2 jsr osgetc +EC1F: C118 cmpb #CAN +EC21: 27E2 beq xsabt +EC23: C115 cmpb #NAK +EC25: 27F0 beq xsendeot +EC27: C106 cmpb #ACK +EC29: 27D8 beq xsok +EC2B: 20EF bra waitack2 +EC2D: +EC2D: * Read character into B with a timeout of A seconds, Carry set if timeout. +EC2D: 48 gettimeout asla +EC2E: 48 asla +EC2F: BDE465 gt1 jsr osgetpoll +EC32: 5D tstb +EC33: 2606 bne gtexit +EC35: 4A deca +EC36: 26F7 bne gt1 +EC38: 1A01 orcc #$1 +EC3A: 39 rts +EC3B: BDE45A gtexit jsr osgetc +EC3E: 1CFE andcc #$fe +EC40: 39 rts +EC41: +EC41: * Wait until line becomes quiet. +EC41: 8603 purge lda #3 +EC43: BDEC2D jsr gettimeout +EC46: 24F9 bcc purge +EC48: 39 rts +EC49: +EC49: * Receive an XMODEM block and wait till it is OK, Z set if etx. +EC49: 8603 xrcvbuf lda #3 +EC4B: 0D2F tst lastok +EC4D: 2709 beq sendnak +EC4F: C606 ldb #ACK +EC51: BDE471 jsr osputc ;Send an ack. +EC54: 860A lda #10 +EC56: 2005 bra startblock +EC58: C615 sendnak ldb #NAK +EC5A: BDE471 jsr osputc ;Send a NAK +EC5D: 0F2F startblock clr lastok +EC5F: 8DCC bsr gettimeout +EC61: 8603 lda #3 +EC63: 25F3 bcs sendnak ;Keep sending NAKs when timed out. +EC65: C104 cmpb #EOT +EC67: 2752 beq xrcveot ;End of file reached, acknowledge EOT. +EC69: C101 cmpb #SOH +EC6B: 2649 bne purgeit ;Not, SOH, bad block. +EC6D: 8601 lda #1 +EC6F: 8DBC bsr gettimeout +EC71: 2543 bcs purgeit +EC73: D12D cmpb xpacknum ;Is it the right block? +EC75: 2707 beq xr1 +EC77: 5C incb +EC78: D12D cmpb xpacknum ;Was it the previous block. +EC7A: 263A bne purgeit +EC7C: 0C2F inc lastok +EC7E: D72E xr1 stb xsum +EC80: 8601 lda #1 +EC82: 8DA9 bsr gettimeout +EC84: 2530 bcs purgeit +EC86: 53 comb +EC87: D12E cmpb xsum ;Is the complement of the block number OK +EC89: 262B bne purgeit +EC8B: 8E0100 ldx #buf0 +EC8E: 0F2E clr xsum +EC90: 8601 xrloop lda #1 +EC92: 8D99 bsr gettimeout +EC94: 2520 bcs purgeit +EC96: E780 stb ,x+ +EC98: DB2E addb xsum +EC9A: D72E stb xsum +EC9C: 8C0180 cmpx #buf0+128 +EC9F: 26EF bne xrloop ;Get the data bytes. +ECA1: 8601 lda #1 +ECA3: 8D88 bsr gettimeout +ECA5: 250F bcs purgeit +ECA7: D12E cmpb xsum +ECA9: 260B bne purgeit ;Check the check sum. +ECAB: 0D2F tst lastok +ECAD: 269A bne xrcvbuf ;Block was the previous block, get next one +ECAF: 0C2F inc lastok +ECB1: 0C2D inc xpacknum +ECB3: 1CFB andcc #$fb +ECB5: 39 rts +ECB6: BDEC41 purgeit jsr purge +ECB9: 209D bra sendnak +ECBB: 8603 xrcveot lda #3 ;EOT was received. +ECBD: C606 ldb #ACK +ECBF: BDE471 ackloop jsr osputc +ECC2: 4A deca +ECC3: 26FA bne ackloop ;Send 3 acks in a row. +ECC5: 39 rts +ECC6: +ECC6: +ECC6: 9E01 savevecs ldx getchar+1 +ECC8: BF02B4 stx oldgetc +ECCB: 9E04 ldx putchar+1 +ECCD: BF02B6 stx oldputc +ECD0: 9E0D ldx putcr+1 +ECD2: BF02B8 stx oldputcr +ECD5: 39 rts +ECD6: +ECD6: BE02B4 rstvecs ldx oldgetc +ECD9: 9F01 stx getchar+1 +ECDB: BE02B6 ldx oldputc +ECDE: 9F04 stx putchar+1 +ECE0: BE02B8 ldx oldputcr +ECE3: 9F0D stx putcr+1 +ECE5: 39 rts +ECE6: +ECE6: * O.S. routine to open input through XMODEM transfer. +ECE6: 3416 xopin pshs x,a,b +ECE8: 8EE63E ldx #xsmsg +ECEB: BDE4E1 jsr outcount +ECEE: 9D0C jsr putcr ;Display message to start XMODEM send. +ECF0: 8DD4 bsr savevecs +ECF2: 8EF434 ldx #noop +ECF5: 9F04 stx putchar+1 ;Disable character output. +ECF7: 8EEDB4 ldx #xgetc +ECFA: 9F01 stx getchar+1 ; +ECFC: 0F2F clr lastok +ECFE: 0F30 clr xcount +ED00: 8601 lda #1 +ED02: 972D sta xpacknum +ED04: 4C inca +ED05: 9731 sta xmode ;set xmode to 2. +ED07: 3596 puls x,a,b,pc +ED09: +ED09: * O.S. routine to open output through XMODEM transfer. +ED09: 3416 xopout pshs x,a,b +ED0B: 8DB9 bsr savevecs +ED0D: 8EE650 ldx #xrmsg +ED10: BDE4E1 jsr outcount ;Display message to start XMODEM receive +ED13: 9D0C jsr putcr +ED15: 8EED7B ldx #xputc +ED18: 9F04 stx putchar+1 +ED1A: 8EED99 ldx #xputcr +ED1D: 9F0D stx putcr+1 +ED1F: BDEC06 jsr xsendinit +ED22: 102700B7 lbeq xerror +ED26: 0F30 clr xcount +ED28: 8601 lda #1 +ED2A: 9731 sta xmode +ED2C: 3596 puls x,a,b,pc +ED2E: +ED2E: +ED2E: * O.S. routine to abort input through XMODEM transfer. +ED2E: 9631 xabtin lda xmode +ED30: 8102 cmpa #2 +ED32: 263C bne xclsend +ED34: BDEC41 jsr purge +ED37: C618 ldb #CAN +ED39: 8608 lda #8 +ED3B: BDE471 xabtloop jsr osputc +ED3E: 4A deca +ED3F: 26FA bne xabtloop ;Send 8 CAN characters to kill transfer. +ED41: 8D93 bsr rstvecs +ED43: 0F31 clr xmode +ED45: 8EE665 ldx #xamsg +ED48: BDE4E1 jsr outcount +ED4B: 9D0C jsr putcr ;Send diagnostic message. +ED4D: 39 rts +ED4E: +ED4E: * O.S. routine to close output through XMODEM transfer. +ED4E: 9631 xclsout lda xmode +ED50: 8101 cmpa #1 +ED52: 261C bne xclsend +ED54: 0D30 tst xcount +ED56: 270C beq xclsdone +ED58: 8680 lda #128 +ED5A: 9030 suba xcount +ED5C: F602BB xclsloop ldb filler +ED5F: 8D1A bsr xputc +ED61: 4A deca +ED62: 26F8 bne xclsloop ;Transfer filler chars to force block out. +ED64: BDEC17 xclsdone jsr xsendeot ;Send EOT +ED67: 10270072 lbeq xerror +ED6B: BDECD6 jsr rstvecs +ED6E: 0F31 clr xmode +ED70: 39 xclsend rts +ED71: +ED71: * O.S. routine to close input through XMODEM, by gobbling up the remaining +ED71: * bytes. +ED71: D631 xclsin ldb xmode +ED73: C102 cmpb #2 +ED75: 26F9 bne xclsend +ED77: 9D03 jsr putchar +ED79: 20F6 bra xclsin +ED7B: +ED7B: * putchar routine for XMODEM +ED7B: 3416 xputc pshs x,a,b +ED7D: 9630 lda xcount +ED7F: 0C30 inc xcount +ED81: 8E0100 ldx #buf0 +ED84: E786 stb a,x ;Store character in XMODEM buffer. +ED86: 817F cmpa #127 +ED88: 260D bne xputc1 ;is buffer full? +ED8A: 0F30 clr xcount +ED8C: 3460 pshs y,u +ED8E: BDEBCA jsr xsendbuf +ED91: 10270048 lbeq xerror +ED95: 3560 puls y,u +ED97: 3596 xputc1 puls x,a,b,pc +ED99: +ED99: * putcr routine for XMODEM +ED99: 3404 xputcr pshs b +ED9B: F602BC ldb xmcr +ED9E: C502 bitb #2 +EDA0: 2704 beq xputcr1 +EDA2: C60D ldb #CR +EDA4: 8DD5 bsr xputc +EDA6: F602BC xputcr1 ldb xmcr +EDA9: C501 bitb #1 +EDAB: 2704 beq xputcr2 +EDAD: C60A ldb #LF +EDAF: 8DCA bsr xputc +EDB1: 3504 xputcr2 puls b +EDB3: 39 rts +EDB4: +EDB4: * getchar routine for XMODEM +EDB4: 3412 xgetc pshs x,a +EDB6: 0D30 tst xcount ;No characters left? +EDB8: 260D bne xgetc1 +EDBA: 3460 pshs y,u +EDBC: BDEC49 jsr xrcvbuf ;Receive new block. +EDBF: 3560 puls y,u +EDC1: 2710 beq xgetcterm ;End of input? +EDC3: 8680 lda #128 +EDC5: 9730 sta xcount +EDC7: 9630 xgetc1 lda xcount +EDC9: 40 nega +EDCA: 8E0180 ldx #buf0+128 +EDCD: E686 ldb a,x ;Get character from buffer +EDCF: 0A30 dec xcount +EDD1: 3592 puls x,a,pc +EDD3: BDECD6 xgetcterm jsr rstvecs +EDD6: 0F31 clr xmode +EDD8: F602BB ldb filler +EDDB: 3592 puls x,a,pc +EDDD: +EDDD: BDECD6 xerror jsr rstvecs ;Restore I/O vectors +EDE0: 0F31 clr xmode +EDE2: 8EE665 ldx #xamsg +EDE5: BDE4E1 jsr outcount +EDE8: 9D0C jsr putcr +EDEA: 7E0292 jmp xerrvec +EDED: +EDED: 10FE02BD xerrhand lds savesp +EDF1: 7EE558 jmp cmdline +EDF4: +EDF4: * This is the code for the X command, various XMODEM related commands. +EDF4: * Syntax: XSaddr,len XLaddr,len XX XOcrlf,filler, XSSaddr,len +EDF4: 8E0201 xmodem ldx #linebuf+1 +EDF7: A680 lda ,x+ +EDF9: 84DF anda #CASEMASK ;Convert to uppercase. +EDFB: 8158 cmpa #'X' +EDFD: 274A beq xeq +EDFF: 814C cmpa #'L' +EE01: 2733 beq xload +EE03: 814F cmpa #'O' +EE05: 2747 beq xopts +EE07: 8153 cmpa #'S' +EE09: 1026F7A7 lbne unk +EE0D: A684 lda ,x +EE0F: 84DF anda #CASEMASK +EE11: 8153 cmpa #'S' +EE13: 271A beq xss +EE15: CC0100 ldd #$100 ;XSaddr,len command. +EE18: BDE732 jsr scan2parms ;Send binary through XMODEM +EE1B: 9D15 jsr xopenout +EE1D: FE029D ldu addr +EE20: 10BE029F ldy length +EE24: E6C0 xsbinloop ldb ,u+ +EE26: 9D03 jsr putchar +EE28: 313F leay -1,y +EE2A: 26F8 bne xsbinloop ;Send all the bytes through XMODEM. +EE2C: 7EE558 jmp cmdline +EE2F: 3001 xss leax 1,x ;XSSaddr,len command. +EE31: 9D15 jsr xopenout ;Send Srecords through XMODEM +EE33: 7EEA9F jmp sendrec +EE36: BDE70F xload jsr scanhex ;XLaddr command +EE39: 1F02 tfr d,y ;Load binary through XMODEM +EE3B: 9D12 jsr xopenin +EE3D: 9D00 xlodloop jsr getchar +EE3F: 0D31 tst xmode ;File ended? then done +EE41: 1027F713 lbeq cmdline +EE45: E7A0 stb ,y+ +EE47: 20F4 bra xlodloop +EE49: 9D12 xeq jsr xopenin ;XX command +EE4B: 7EE558 jmp cmdline ;Execute commands received from XMODEM +EE4E: CC001A xopts ldd #$1a +EE51: BDE732 jsr scan2parms +EE54: B6029E lda addr+1 +EE57: B702BC sta xmcr +EE5A: B602A0 lda length+1 +EE5D: B702BB sta filler +EE60: 7EE558 jmp cmdline +EE63: +EE63: * mnemonics table, ordered alphabetically. +EE63: * 5 bytes name, 1 byte category, 2 bytes opcode, 8 bytes total. +EE63: 4142582020 mnemtab fcc "ABX " +EE68: 00 fcb 0 +EE69: 003A fdb $3a +EE6B: 4144434120 fcc "ADCA " +EE70: 07 fcb 7 +EE71: 0089 fdb $89 +EE73: 4144434220 fcc "ADCB " +EE78: 07 fcb 7 +EE79: 00C9 fdb $c9 +EE7B: 4144444120 fcc "ADDA " +EE80: 07 fcb 7 +EE81: 008B fdb $8b +EE83: 4144444220 fcc "ADDB " +EE88: 07 fcb 7 +EE89: 00CB fdb $cb +EE8B: 4144444420 fcc "ADDD " +EE90: 08 fcb 8 +EE91: 00C3 fdb $c3 +EE93: 414E444120 fcc "ANDA " +EE98: 07 fcb 7 +EE99: 0084 fdb $84 +EE9B: 414E444220 fcc "ANDB " +EEA0: 07 fcb 7 +EEA1: 00C4 fdb $c4 +EEA3: 414E444343 fcc "ANDCC" +EEA8: 02 fcb 2 +EEA9: 001C fdb $1c +EEAB: 41534C2020 fcc "ASL " +EEB0: 0A fcb 10 +EEB1: 0008 fdb $08 +EEB3: 41534C4120 fcc "ASLA " +EEB8: 00 fcb 0 +EEB9: 0048 fdb $48 +EEBB: 41534C4220 fcc "ASLB " +EEC0: 00 fcb 0 +EEC1: 0058 fdb $58 +EEC3: 4153522020 fcc "ASR " +EEC8: 0A fcb 10 +EEC9: 0007 fdb $07 +EECB: 4153524120 fcc "ASRA " +EED0: 00 fcb 0 +EED1: 0047 fdb $47 +EED3: 4153524220 fcc "ASRB " +EED8: 00 fcb 0 +EED9: 0057 fdb $57 +EEDB: 4243432020 fcc "BCC " +EEE0: 04 fcb 4 +EEE1: 0024 fdb $24 +EEE3: 4243532020 fcc "BCS " +EEE8: 04 fcb 4 +EEE9: 0025 fdb $25 +EEEB: 4245512020 fcc "BEQ " +EEF0: 04 fcb 4 +EEF1: 0027 fdb $27 +EEF3: 4247452020 fcc "BGE " +EEF8: 04 fcb 4 +EEF9: 002C fdb $2c +EEFB: 4247542020 fcc "BGT " +EF00: 04 fcb 4 +EF01: 002E fdb $2e +EF03: 4248492020 fcc "BHI " +EF08: 04 fcb 4 +EF09: 0022 fdb $22 +EF0B: 4248532020 fcc "BHS " +EF10: 04 fcb 4 +EF11: 0024 fdb $24 +EF13: 4249544120 fcc "BITA " +EF18: 07 fcb 7 +EF19: 0085 fdb $85 +EF1B: 4249544220 fcc "BITB " +EF20: 07 fcb 7 +EF21: 00C5 fdb $c5 +EF23: 424C452020 fcc "BLE " +EF28: 04 fcb 4 +EF29: 002F fdb $2f +EF2B: 424C4F2020 fcc "BLO " +EF30: 04 fcb 4 +EF31: 0025 fdb $25 +EF33: 424C532020 fcc "BLS " +EF38: 04 fcb 4 +EF39: 0023 fdb $23 +EF3B: 424C542020 fcc "BLT " +EF40: 04 fcb 4 +EF41: 002D fdb $2d +EF43: 424D492020 fcc "BMI " +EF48: 04 fcb 4 +EF49: 002B fdb $2b +EF4B: 424E452020 fcc "BNE " +EF50: 04 fcb 4 +EF51: 0026 fdb $26 +EF53: 42504C2020 fcc "BPL " +EF58: 04 fcb 4 +EF59: 002A fdb $2a +EF5B: 4252412020 fcc "BRA " +EF60: 04 fcb 4 +EF61: 0020 fdb $20 +EF63: 42524E2020 fcc "BRN " +EF68: 04 fcb 4 +EF69: 0021 fdb $21 +EF6B: 4253522020 mnembsr fcc "BSR " +EF70: 04 fcb 4 +EF71: 008D fdb $8d +EF73: 4256432020 fcc "BVC " +EF78: 04 fcb 4 +EF79: 0028 fdb $28 +EF7B: 4256532020 fcc "BVS " +EF80: 04 fcb 4 +EF81: 0029 fdb $29 +EF83: 434C522020 fcc "CLR " +EF88: 0A fcb 10 +EF89: 000F fdb $0f +EF8B: 434C524120 fcc "CLRA " +EF90: 00 fcb 0 +EF91: 004F fdb $4f +EF93: 434C524220 fcc "CLRB " +EF98: 00 fcb 0 +EF99: 005F fdb $5f +EF9B: 434D504120 fcc "CMPA " +EFA0: 07 fcb 7 +EFA1: 0081 fdb $81 +EFA3: 434D504220 fcc "CMPB " +EFA8: 07 fcb 7 +EFA9: 00C1 fdb $c1 +EFAB: 434D504420 fcc "CMPD " +EFB0: 09 fcb 9 +EFB1: 1083 fdb $1083 +EFB3: 434D505320 fcc "CMPS " +EFB8: 09 fcb 9 +EFB9: 118C fdb $118c +EFBB: 434D505520 fcc "CMPU " +EFC0: 09 fcb 9 +EFC1: 1183 fdb $1183 +EFC3: 434D505820 fcc "CMPX " +EFC8: 08 fcb 8 +EFC9: 008C fdb $8c +EFCB: 434D505920 fcc "CMPY " +EFD0: 09 fcb 9 +EFD1: 108C fdb $108c +EFD3: 434F4D2020 fcc "COM " +EFD8: 0A fcb 10 +EFD9: 0003 fdb $03 +EFDB: 434F4D4120 fcc "COMA " +EFE0: 00 fcb 0 +EFE1: 0043 fdb $43 +EFE3: 434F4D4220 fcc "COMB " +EFE8: 00 fcb 0 +EFE9: 0053 fdb $53 +EFEB: 4357414920 fcc "CWAI " +EFF0: 02 fcb 2 +EFF1: 003C fdb $3c +EFF3: 4441412020 fcc "DAA " +EFF8: 00 fcb 0 +EFF9: 0019 fdb $19 +EFFB: 4445432020 fcc "DEC " +F000: 0A fcb 10 +F001: 000A fdb $0a +F003: 4445434120 fcc "DECA " +F008: 00 fcb 0 +F009: 004A fdb $4a +F00B: 4445434220 fcc "DECB " +F010: 00 fcb 0 +F011: 005A fdb $5a +F013: 454F524120 fcc "EORA " +F018: 07 fcb 7 +F019: 0088 fdb $88 +F01B: 454F524220 fcc "EORB " +F020: 07 fcb 7 +F021: 00C8 fdb $c8 +F023: 4551552020 fcc "EQU " +F028: 0D fcb 13 +F029: 0005 fdb 5 +F02B: 4558472020 fcc "EXG " +F030: 0B fcb 11 +F031: 001E fdb $1e +F033: 4643422020 mnemfcb fcc "FCB " +F038: 0D fcb 13 +F039: 0007 fdb 7 +F03B: 4643432020 fcc "FCC " +F040: 0D fcb 13 +F041: 0008 fdb 8 +F043: 4644422020 fcc "FDB " +F048: 0D fcb 13 +F049: 0009 fdb 9 +F04B: 494E432020 fcc "INC " +F050: 0A fcb 10 +F051: 000C fdb $0c +F053: 494E434120 fcc "INCA " +F058: 00 fcb 0 +F059: 004C fdb $4c +F05B: 494E434220 fcc "INCB " +F060: 00 fcb 0 +F061: 005C fdb $5c +F063: 4A4D502020 fcc "JMP " +F068: 0A fcb 10 +F069: 000E fdb $0e +F06B: 4A53522020 mnemjsr fcc "JSR " +F070: 08 fcb 8 +F071: 008D fdb $8d +F073: 4C42434320 fcc "LBCC " +F078: 05 fcb 5 +F079: 1024 fdb $1024 +F07B: 4C42435320 fcc "LBCS " +F080: 05 fcb 5 +F081: 1025 fdb $1025 +F083: 4C42455120 fcc "LBEQ " +F088: 05 fcb 5 +F089: 1027 fdb $1027 +F08B: 4C42474520 fcc "LBGE " +F090: 05 fcb 5 +F091: 102C fdb $102c +F093: 4C42475420 fcc "LBGT " +F098: 05 fcb 5 +F099: 102E fdb $102e +F09B: 4C42484920 fcc "LBHI " +F0A0: 05 fcb 5 +F0A1: 1022 fdb $1022 +F0A3: 4C42485320 fcc "LBHS " +F0A8: 05 fcb 5 +F0A9: 1024 fdb $1024 +F0AB: 4C424C4520 fcc "LBLE " +F0B0: 05 fcb 5 +F0B1: 102F fdb $102f +F0B3: 4C424C4F20 fcc "LBLO " +F0B8: 05 fcb 5 +F0B9: 1025 fdb $1025 +F0BB: 4C424C5320 fcc "LBLS " +F0C0: 05 fcb 5 +F0C1: 1023 fdb $1023 +F0C3: 4C424C5420 fcc "LBLT " +F0C8: 05 fcb 5 +F0C9: 102D fdb $102d +F0CB: 4C424D4920 fcc "LBMI " +F0D0: 05 fcb 5 +F0D1: 102B fdb $102b +F0D3: 4C424E4520 fcc "LBNE " +F0D8: 05 fcb 5 +F0D9: 1026 fdb $1026 +F0DB: 4C42504C20 fcc "LBPL " +F0E0: 05 fcb 5 +F0E1: 102A fdb $102a +F0E3: 4C42524120 fcc "LBRA " +F0E8: 06 fcb 6 +F0E9: 0016 fdb $16 +F0EB: 4C42524E20 fcc "LBRN " +F0F0: 05 fcb 5 +F0F1: 1021 fdb $1021 +F0F3: 4C42535220 fcc "LBSR " +F0F8: 06 fcb 6 +F0F9: 0017 fdb $17 +F0FB: 4C42564320 fcc "LBVC " +F100: 05 fcb 5 +F101: 1028 fdb $1028 +F103: 4C42565320 fcc "LBVS " +F108: 05 fcb 5 +F109: 1029 fdb $1029 +F10B: 4C44412020 fcc "LDA " +F110: 07 fcb 7 +F111: 0086 fdb $86 +F113: 4C44422020 fcc "LDB " +F118: 07 fcb 7 +F119: 00C6 fdb $c6 +F11B: 4C44442020 fcc "LDD " +F120: 08 fcb 8 +F121: 00CC fdb $cc +F123: 4C44532020 fcc "LDS " +F128: 09 fcb 9 +F129: 10CE fdb $10ce +F12B: 4C44552020 fcc "LDU " +F130: 08 fcb 8 +F131: 00CE fdb $ce +F133: 4C44582020 fcc "LDX " +F138: 08 fcb 8 +F139: 008E fdb $8e +F13B: 4C44592020 fcc "LDY " +F140: 09 fcb 9 +F141: 108E fdb $108e +F143: 4C45415320 fcc "LEAS " +F148: 03 fcb 3 +F149: 0032 fdb $32 +F14B: 4C45415520 fcc "LEAU " +F150: 03 fcb 3 +F151: 0033 fdb $33 +F153: 4C45415820 fcc "LEAX " +F158: 03 fcb 3 +F159: 0030 fdb $30 +F15B: 4C45415920 fcc "LEAY " +F160: 03 fcb 3 +F161: 0031 fdb $31 +F163: 4C534C2020 fcc "LSL " +F168: 0A fcb 10 +F169: 0008 fdb $08 +F16B: 4C534C4120 fcc "LSLA " +F170: 00 fcb 0 +F171: 0048 fdb $48 +F173: 4C534C4220 fcc "LSLB " +F178: 00 fcb 0 +F179: 0058 fdb $58 +F17B: 4C53522020 fcc "LSR " +F180: 0A fcb 10 +F181: 0004 fdb $04 +F183: 4C53524120 fcc "LSRA " +F188: 00 fcb 0 +F189: 0044 fdb $44 +F18B: 4C53524220 fcc "LSRB " +F190: 00 fcb 0 +F191: 0054 fdb $54 +F193: 4D554C2020 fcc "MUL " +F198: 00 fcb 0 +F199: 003D fdb $3d +F19B: 4E45472020 fcc "NEG " +F1A0: 0A fcb 10 +F1A1: 0000 fdb $00 +F1A3: 4E45474120 fcc "NEGA " +F1A8: 00 fcb 0 +F1A9: 0040 fdb $40 +F1AB: 4E45474220 fcc "NEGB " +F1B0: 00 fcb 0 +F1B1: 0050 fdb $50 +F1B3: 4E4F502020 fcc "NOP " +F1B8: 00 fcb 0 +F1B9: 0012 fdb $12 +F1BB: 4F52412020 fcc "ORA " +F1C0: 07 fcb 7 +F1C1: 008A fdb $8a +F1C3: 4F52422020 fcc "ORB " +F1C8: 07 fcb 7 +F1C9: 00CA fdb $ca +F1CB: 4F52434320 fcc "ORCC " +F1D0: 02 fcb 2 +F1D1: 001A fdb $1a +F1D3: 4F52472020 fcc "ORG " +F1D8: 0D fcb 13 +F1D9: 000C fdb 12 +F1DB: 5053485320 fcc "PSHS " +F1E0: 0C fcb 12 +F1E1: 0034 fdb $34 +F1E3: 5053485520 fcc "PSHU " +F1E8: 0C fcb 12 +F1E9: 0036 fdb $36 +F1EB: 50554C5320 fcc "PULS " +F1F0: 0C fcb 12 +F1F1: 0035 fdb $35 +F1F3: 50554C5520 fcc "PULU " +F1F8: 0C fcb 12 +F1F9: 0037 fdb $37 +F1FB: 524D422020 fcc "RMB " +F200: 0D fcb 13 +F201: 0000 fdb 0 +F203: 524F4C2020 fcc "ROL " +F208: 0A fcb 10 +F209: 0009 fdb $09 +F20B: 524F4C4120 fcc "ROLA " +F210: 00 fcb 0 +F211: 0049 fdb $49 +F213: 524F4C4220 fcc "ROLB " +F218: 00 fcb 0 +F219: 0059 fdb $59 +F21B: 524F522020 fcc "ROR " +F220: 0A fcb 10 +F221: 0006 fdb $06 +F223: 524F524120 fcc "RORA " +F228: 00 fcb 0 +F229: 0046 fdb $46 +F22B: 524F524220 fcc "RORB " +F230: 00 fcb 0 +F231: 0056 fdb $56 +F233: 5254492020 fcc "RTI " +F238: 00 fcb 0 +F239: 003B fdb $3b +F23B: 5254532020 fcc "RTS " +F240: 00 fcb 0 +F241: 0039 fdb $39 +F243: 5342434120 fcc "SBCA " +F248: 07 fcb 7 +F249: 0082 fdb $82 +F24B: 5342434220 fcc "SBCB " +F250: 07 fcb 7 +F251: 00C2 fdb $c2 +F253: 5345542020 fcc "SET " +F258: 0D fcb 13 +F259: 000F fdb 15 +F25B: 5345544450 fcc "SETDP" +F260: 0D fcb 13 +F261: 000E fdb 14 +F263: 5345582020 fcc "SEX " +F268: 00 fcb 0 +F269: 001D fdb $1d +F26B: 5354412020 fcc "STA " +F270: 07 fcb 7 +F271: 0087 fdb $87 +F273: 5354422020 fcc "STB " +F278: 07 fcb 7 +F279: 00C7 fdb $c7 +F27B: 5354442020 fcc "STD " +F280: 08 fcb 8 +F281: 00CD fdb $cd +F283: 5354532020 fcc "STS " +F288: 09 fcb 9 +F289: 10CF fdb $10cf +F28B: 5354552020 fcc "STU " +F290: 08 fcb 8 +F291: 00CF fdb $cf +F293: 5354582020 fcc "STX " +F298: 08 fcb 8 +F299: 008F fdb $8f +F29B: 5354592020 fcc "STY " +F2A0: 09 fcb 9 +F2A1: 108F fdb $108f +F2A3: 5355424120 fcc "SUBA " +F2A8: 07 fcb 7 +F2A9: 0080 fdb $80 +F2AB: 5355424220 fcc "SUBB " +F2B0: 07 fcb 7 +F2B1: 00C0 fdb $c0 +F2B3: 5355424420 fcc "SUBD " +F2B8: 08 fcb 8 +F2B9: 0083 fdb $83 +F2BB: 5357492020 fcc "SWI " +F2C0: 00 fcb 0 +F2C1: 003F fdb $3f +F2C3: 5357493220 fcb "SWI2 " +F2C8: 01 fcb 1 +F2C9: 103F fdb $103f +F2CB: 5357493320 fcb "SWI3 " +F2D0: 01 fcb 1 +F2D1: 113F fdb $113f +F2D3: 53594E4320 fcc "SYNC " +F2D8: 00 fcb 0 +F2D9: 0013 fdb $13 +F2DB: 5446522020 fcc "TFR " +F2E0: 0B fcb 11 +F2E1: 001F fdb $1f +F2E3: 5453542020 fcc "TST " +F2E8: 0A fcb 10 +F2E9: 000D fdb $0d +F2EB: 5453544120 fcc "TSTA " +F2F0: 00 fcb 0 +F2F1: 004D fdb $4d +F2F3: 5453544220 fcc "TSTB " +F2F8: 00 fcb 0 +F2F9: 005D fdb $5d +F2FB: +F2FB: mnemsize equ (*-mnemtab)/8 +F2FB: +F2FB: * Register table for PUSH/PULL and TFR/EXG instructions. +F2FB: * 3 bytes for name, 1 for tfr/exg, 1 for push/pull, 5 total +F2FB: 582020 asmregtab fcc "X " +F2FE: 0110 fcb $01,$10 +F300: 592020 fcc "Y " +F303: 0220 fcb $02,$20 +F305: 552020 aregu fcc "U " +F308: 0340 fcb $03,$40 +F30A: 532020 aregs fcc "S " +F30D: 0440 fcb $04,$40 +F30F: 504320 fcc "PC " +F312: 0580 fcb $05,$80 +F314: 412020 fcc "A " +F317: 0802 fcb $08,$02 +F319: 422020 fcc "B " +F31C: 0904 fcb $09,$04 +F31E: 442020 fcc "D " +F321: 0006 fcb $00,$06 +F323: 434320 fcc "CC " +F326: 0A01 fcb $0a,$01 +F328: 434352 fcc "CCR" +F32B: 0A01 fcb $0a,$01 +F32D: 445020 fcc "DP " +F330: 0B08 fcb $0b,$08 +F332: 445052 fcc "DPR" +F335: 0B08 fcb $0b,$08 +F337: 3F2020 reginval fcc "? " +F33A: +F33A: 58595553 ixregs fcc "XYUS" +F33E: +F33E: * opcode offsets to basic opcode, depends on first nibble. +F33E: 000000000000A0 opcoffs fcb 0,0,0,0,0,0,-$60,-$70 +F346: 00F0E0D000F0E0 fcb 0,-$10,-$20,-$30,0,-$10,-$20,-$30 +F34E: * mode depending on first nibble of opcode. +F34E: 03000000000005 modetab fcb 3,0,0,0,0,0,5,4,1,3,5,4,1,3,5,4 +F35E: * mode depending on category code stored in mnemtab +F35E: 00000105060707 modetab2 fcb 0,0,1,5,6,7,7,1,2,2,0,8,9 +F36B: * modes in this context: 0 no operands, 1 8-bit immediate, 2 16 bit imm, +F36B: * 3, 8-bit address, 4 16 bit address, 5 indexed with postbyte, 6 short +F36B: * relative, 7 long relative, 8 pushpul, 9 tftetx +F36B: +F36B: * Decode instruction pointed to by Y for disassembly (and to find out +F36B: * how long it is). On return, U points to appropriate mnemonic table entry, +F36B: * Y points past instruction. +F36B: * It's rather clumsy code, but we do want to reuse the same table +F36B: * as used with assembling. +F36B: 7F02BF disdecode clr prebyte +F36E: 7F02C3 clr amode +F371: A6A0 lda ,y+ +F373: 8110 cmpa #$10 +F375: 2704 beq ddec1 +F377: 8111 cmpa #$11 +F379: 2605 bne ddec2 +F37B: B702BF ddec1 sta prebyte ;Store $10 or $11 prebyte. +F37E: A6A0 lda ,y+ ;Get new opcode. +F380: B702C1 ddec2 sta opcode +F383: 44 lsra +F384: 44 lsra +F385: 44 lsra +F386: 44 lsra ;Get high nibble. +F387: 8EF34E ldx #modetab +F38A: E686 ldb a,x +F38C: F702C3 stb amode +F38F: 8EF33E ldx #opcoffs +F392: A686 lda a,x +F394: BB02C1 adda opcode ;Add opcode offset to opcode. +F397: B702C0 ddec4 sta opc1 ;Store the 'basis' opcode. +F39A: CEEE63 ldu #mnemtab +F39D: 8E0093 ldx #mnemsize +F3A0: C60D ddecloop ldb #13 +F3A2: E145 cmpb 5,u ;Compare category code with 13 +F3A4: 2708 beq ddec3 ;13=pseudo op, no valid opcode +F3A6: FC02BF ldd prebyte +F3A9: 10A346 cmpd 6,u +F3AC: 2722 beq ddecfound ;Opcode&prebyte agree, operation found. +F3AE: 3348 ddec3 leau 8,u ;point to next mnemonic +F3B0: 301F leax -1,x +F3B2: 26EC bne ddecloop +F3B4: CEF033 ldu #mnemfcb ;mnemonic not found, use FCB byte. +F3B7: 8603 lda #3 +F3B9: B702C3 sta amode ;Store mode 3, 8 bit address. +F3BC: B602C1 lda opcode +F3BF: 7D02BF tst prebyte +F3C2: 2708 beq ddec5 +F3C4: B602BF lda prebyte ;if it was the combination prebyte +F3C7: 7F02BF clr prebyte ;and opcode that was not found, +F3CA: 313F leay -1,y ;FCB just the prebyte +F3CC: B702C5 ddec5 sta operand+1 ;The byte must be stored as operand. +F3CF: 39 rts +F3D0: 1183EF6B ddecfound cmpu #mnembsr +F3D4: 260A bne ddec6 +F3D6: 868D lda #$8d ;Is it really the BSR opcode? +F3D8: B102C1 cmpa opcode +F3DB: 2703 beq ddec6 +F3DD: CEF06B ldu #mnemjsr ;We mistakenly found BSR instead of JSR +F3E0: B602C3 ddec6 lda amode +F3E3: 84FE anda #$FE +F3E5: 260A bne ddec7 +F3E7: A645 lda 5,u ;nibble-dependent mode was 0 or 1, +F3E9: 8EF35E ldx #modetab2 ;use category dependent mode instead. +F3EC: A686 lda a,x +F3EE: B702C3 sta amode +F3F1: B602C3 ddec7 lda amode +F3F4: 48 asla +F3F5: 8EF3FA ldx #disdectab +F3F8: 6E96 jmp [a,x] ;jump dependent on definitive mode. +F3FA: F434F42EF435F4 disdectab fdb noop,opdec1,opdec2,opdec1,opdec2,opdecidx +F406: F42EF435F439F4 fdb opdec1,opdec2,opdecpb,opdecpb +F40E: F434F434F434F4 disdectab1 fdb noop,noop,noop,noop,noop,noop,noop,noop +F41E: F42EF435F434F4 fdb opdec1,opdec2,noop,noop,opdec1,opdec2,noop,opdec2 +F42E: E6A0 opdec1 ldb ,y+ +F430: 1D sex +F431: FD02C4 od1a std operand +F434: 39 noop rts +F435: ECA1 opdec2 ldd ,y++ +F437: 20F8 bra od1a +F439: E6A0 opdecpb ldb ,y+ +F43B: F702C2 odpa stb postbyte +F43E: 39 rts +F43F: E6A0 opdecidx ldb ,y+ +F441: 2AF8 bpl odpa ;postbytes <$80 have no extra operands. +F443: F702C2 stb postbyte +F446: C40F andb #$0f +F448: 58 aslb +F449: 8EF40E ldx #disdectab1 +F44C: 6E95 jmp [b,x] +F44E: +F44E: * Display disassembled instruction after the invocation of disdecode. +F44E: * U points to mnemonic table entry. +F44E: 1F31 disdisp tfr u,x +F450: C605 ldb #5 +F452: 9D09 jsr putline ;Display the mnemonic. +F454: C620 ldb #' ' +F456: 9D03 jsr putchar +F458: B602C3 lda amode +F45B: 48 asla +F45C: 8EF461 ldx #disdisptab +F45F: 6E96 jmp [a,x] ;Perform action dependent on mode. +F461: F434F475F479F4 disdisptab fdb noop,disim8,disim16,disadr8,disadr16 +F46B: F53BF48BF499F4 fdb disidx,disrel8,disrel16,distfr,dispush +F475: 8D29 disim8 bsr puthash +F477: 200A bra disadr8 +F479: 8D25 disim16 bsr puthash +F47B: 8D27 disadr16 bsr putdol +F47D: FC02C4 ldd operand +F480: 7EE6DE jmp outd +F483: 8D1F disadr8 bsr putdol +F485: B602C5 lda operand+1 +F488: 7EE6D0 jmp outbyte +F48B: 8D17 disrel8 bsr putdol +F48D: F602C5 ldb operand+1 +F490: 1D sex +F491: 109F24 dr8a sty temp +F494: D324 addd temp +F496: 7EE6DE jmp outd +F499: 8D09 disrel16 bsr putdol +F49B: FC02C4 ldd operand +F49E: 20F1 bra dr8a +F4A0: +F4A0: C623 puthash ldb #'#' +F4A2: 0E03 jmp putchar +F4A4: C624 putdol ldb #'$' +F4A6: 0E03 jmp putchar +F4A8: C62C putcomma ldb #',' +F4AA: 0E03 jmp putchar +F4AC: C620 putspace ldb #' ' +F4AE: 0E03 jmp putchar +F4B0: +F4B0: C60C dispush ldb #12 +F4B2: 8EF2FB ldx #asmregtab ;Walk through the register table. +F4B5: 0F24 clr temp +F4B7: B602C2 regloop lda postbyte +F4BA: A404 anda 4,x +F4BC: 2735 beq dispush1 ;Is bit corresponding to reg set in postbyte +F4BE: 8CF305 cmpx #aregu +F4C1: 260B bne dispush3 +F4C3: 9725 sta temp+1 +F4C5: B602C1 lda opcode +F4C8: 8402 anda #2 +F4CA: 2627 bne dispush1 ;no u register in pshu pulu. +F4CC: 9625 lda temp+1 +F4CE: 8CF30A dispush3 cmpx #aregs +F4D1: 260B bne dispush4 +F4D3: 9725 sta temp+1 +F4D5: B602C1 lda opcode +F4D8: 8402 anda #2 +F4DA: 2717 beq dispush1 ;no s register in pshs puls. +F4DC: 9625 lda temp+1 +F4DE: 43 dispush4 coma +F4DF: B402C2 anda postbyte ;remove the bits from postbyte. +F4E2: B702C2 sta postbyte +F4E5: 3404 pshs b +F4E7: 0D24 tst temp +F4E9: 2702 beq dispush2 +F4EB: 8DBB bsr putcomma ;print comma after first register. +F4ED: 8D2B dispush2 bsr disregname +F4EF: 0C24 inc temp +F4F1: 3504 puls b +F4F3: 3005 dispush1 leax 5,x +F4F5: 5A decb +F4F6: 26BF bne regloop +F4F8: 39 rts +F4F9: +F4F9: B602C2 distfr lda postbyte +F4FC: 44 lsra +F4FD: 44 lsra +F4FE: 44 lsra +F4FF: 44 lsra +F500: 8D07 bsr distfrsub +F502: 8DA4 bsr putcomma +F504: B602C2 lda postbyte +F507: 840F anda #$0f +F509: C60C distfrsub ldb #12 +F50B: 8EF2FB ldx #asmregtab +F50E: A103 distfrloop cmpa 3,x +F510: 2705 beq distfrend +F512: 3005 leax 5,x +F514: 5A decb +F515: 26F7 bne distfrloop +F517: 8D01 distfrend bsr disregname +F519: 39 rts +F51A: +F51A: 8603 disregname lda #3 +F51C: 1F13 tfr x,u +F51E: E6C0 drnloop ldb ,u+ +F520: C120 cmpb #' ' +F522: 2705 beq drnend +F524: 9D03 jsr putchar +F526: 4A deca +F527: 26F5 bne drnloop +F529: 39 drnend rts +F52A: +F52A: B602C2 disidxreg lda postbyte +F52D: 44 lsra +F52E: 44 lsra +F52F: 44 lsra +F530: 44 lsra +F531: 44 lsra +F532: 8403 anda #3 +F534: 8EF33A ldx #ixregs +F537: E686 ldb a,x +F539: 0E03 jmp putchar +F53B: +F53B: 0F24 disidx clr temp +F53D: B602C2 lda postbyte +F540: 2B23 bmi disidx1 +F542: 841F anda #$1f +F544: 8510 bita #$10 +F546: 2605 bne negoffs +F548: BDF634 jsr outdecbyte +F54B: 200A bra discomma +F54D: C62D negoffs ldb #'-' +F54F: 9D03 jsr putchar +F551: 8AF0 ora #$f0 +F553: 40 nega +F554: BDF634 jsr outdecbyte +F557: BDF4A8 discomma jsr putcomma ;Display ,Xreg and terminating ] +F55A: 8DCE disindex bsr disidxreg +F55C: 0D24 disindir tst temp ;Display ] if indirect. +F55E: 2704 beq disidxend +F560: C65D ldb #']' +F562: 9D03 jsr putchar +F564: 39 disidxend rts +F565: 8510 disidx1 bita #$10 +F567: 2706 beq disidx2 +F569: C65B ldb #'[' +F56B: 9D03 jsr putchar +F56D: 0C24 inc temp +F56F: B602C2 disidx2 lda postbyte +F572: 840F anda #$0f +F574: 48 asla +F575: 8EF614 ldx #disidxtab +F578: 6E96 jmp [a,x] ;Jump to routine for indexed mode +F57A: 8602 disadec2 lda #2 +F57C: 2002 bra disadeca +F57E: 8601 disadec1 lda #1 +F580: BDF4A8 disadeca jsr putcomma +F583: C62D disadloop ldb #'-' +F585: 9D03 jsr putchar +F587: 4A deca +F588: 26F9 bne disadloop +F58A: 20CE bra disindex +F58C: 8602 disainc2 lda #2 +F58E: 2002 bra disainca +F590: 8601 disainc1 lda #1 +F592: 9725 disainca sta temp+1 +F594: BDF4A8 jsr putcomma +F597: BDF52A jsr disidxreg +F59A: 9625 lda temp+1 +F59C: C62B disailoop ldb #'+' +F59E: 9D03 jsr putchar +F5A0: 4A deca +F5A1: 26F9 bne disailoop +F5A3: 7EF55C jmp disindir +F5A6: C641 disax ldb #'A' +F5A8: 9D03 jsr putchar +F5AA: 7EF557 jmp discomma +F5AD: C642 disbx ldb #'B' +F5AF: 9D03 jsr putchar +F5B1: 7EF557 jmp discomma +F5B4: C644 disdx ldb #'D' +F5B6: 9D03 jsr putchar +F5B8: 7EF557 jmp discomma +F5BB: C63F disinval ldb #'?' +F5BD: 9D03 jsr putchar +F5BF: 7EF55C jmp disindir +F5C2: B602C5 disnx lda operand+1 +F5C5: 2B09 bmi disnxneg +F5C7: BDF4A4 disnx1 jsr putdol +F5CA: BDE6D0 jsr outbyte +F5CD: 7EF557 jmp discomma +F5D0: C62D disnxneg ldb #'-' +F5D2: 9D03 jsr putchar +F5D4: 40 nega +F5D5: 20F0 bra disnx1 +F5D7: BDF4A4 disnnx jsr putdol +F5DA: FC02C4 ldd operand +F5DD: BDE6DE jsr outd +F5E0: 7EF557 jmp discomma +F5E3: BDF4A4 disnpc jsr putdol +F5E6: F602C5 ldb operand+1 +F5E9: 1D sex +F5EA: 109F26 disnpca sty temp2 +F5ED: D326 addd temp2 +F5EF: BDE6DE jsr outd +F5F2: 8EF610 ldx #commapc +F5F5: C604 ldb #4 +F5F7: 9D09 jsr putline +F5F9: 7EF55C jmp disindir +F5FC: BDF4A4 disnnpc jsr putdol +F5FF: FC02C4 ldd operand +F602: 20E6 bra disnpca +F604: BDF4A4 disdirect jsr putdol +F607: FC02C4 ldd operand +F60A: BDE6DE jsr outd +F60D: 7EF55C jmp disindir +F610: +F610: 2C504352 commapc fcc ",PCR" +F614: +F614: F590F58CF57EF5 disidxtab fdb disainc1,disainc2,disadec1,disadec2 +F61C: F557F5ADF5A6F5 fdb discomma,disbx,disax,disinval +F624: F5C2F5D7F5BBF5 fdb disnx,disnnx,disinval,disdx +F62C: F5E3F5FCF5BBF6 fdb disnpc,disnnpc,disinval,disdirect +F634: +F634: * Display byte A in decimal (0<=A<20) +F634: 810A outdecbyte cmpa #10 +F636: 2506 blo odb1 +F638: 800A suba #10 +F63A: C631 ldb #'1' +F63C: 9D03 jsr putchar +F63E: 8B30 odb1 adda #'0' +F640: 1F89 tfr a,b +F642: 0E03 jmp putchar +F644: +F644: * This is the code for the U command, unassemble instructions in memory. +F644: * Syntax: U or Uaddr or Uaddr,length +F644: 8E0201 unasm ldx #linebuf+1 +F647: CC0014 ldd #20 +F64A: BDE732 jsr scan2parms ;Scan address,length parameters. +F64D: FC029D ldd addr +F650: F3029F addd length +F653: FD029F std length +F656: 10BE029D ldy addr +F65A: 1F20 unasmloop tfr y,d +F65C: BDE6DE jsr outd ;Display instruction address +F65F: BDF4AC jsr putspace +F662: 3420 pshs y +F664: BDF36B jsr disdecode +F667: 3510 puls x +F669: 109F24 sty temp +F66C: 0F26 clr temp2 +F66E: A680 unadishex lda ,x+ +F670: BDE6D0 jsr outbyte +F673: 0C26 inc temp2 +F675: 0C26 inc temp2 +F677: 9C24 cmpx temp +F679: 26F3 bne unadishex ;Display instruction bytes as hex. +F67B: C620 unadisspc ldb #' ' +F67D: 9D03 jsr putchar +F67F: 0C26 inc temp2 +F681: 860B lda #11 +F683: 9126 cmpa temp2 ;Fill out with spaces to width 11. +F685: 26F4 bne unadisspc +F687: 26E5 bne unadishex +F689: BDF44E jsr disdisp ;Display disassembled instruction. +F68C: 9D0C jsr putcr +F68E: 10BC029F cmpy length +F692: 23C6 bls unasmloop +F694: 10BF029D sty addr +F698: 7EE558 jmp cmdline +F69B: +F69B: * Simple 'expression evaluator' for assembler. +F69B: E684 expr ldb ,x +F69D: C12D cmpb #'-' +F69F: 2603 bne pos +F6A1: 5F clrb +F6A2: 3001 leax 1,x +F6A4: 3404 pos pshs b +F6A6: 8D11 bsr scanfact +F6A8: 270C beq exprend1 +F6AA: 6DE0 tst ,s+ +F6AC: 2607 bne exprend ;Was the minus sign there. +F6AE: 43 coma +F6AF: 53 comb +F6B0: C30001 addd #1 +F6B3: 1CFB andcc #$fb ;Clear Z flag for valid result. +F6B5: 39 exprend rts +F6B6: 3504 exprend1 puls b +F6B8: 39 rts +F6B9: +F6B9: E680 scanfact ldb ,x+ +F6BB: C124 cmpb #'$' +F6BD: 1027F04E lbeq scanhex ;Hex number if starting with dollar. +F6C1: C127 cmpb #''' +F6C3: 260E bne scandec ;char if starting with ' else decimal +F6C5: E680 ldb ,x+ +F6C7: A684 lda ,x +F6C9: 8127 cmpa #''' +F6CB: 2602 bne scanchar2 +F6CD: 3001 leax 1,x ;Increment past final quote if it's there. +F6CF: 4F scanchar2 clra +F6D0: 1CFB andcc #$fb ;Clear zero flag. +F6D2: 39 rts +F6D3: C130 scandec cmpb #'0' +F6D5: 252F blo noexpr +F6D7: C139 cmpb #'9' +F6D9: 222B bhi noexpr +F6DB: 0F24 clr temp +F6DD: 0F25 clr temp+1 +F6DF: C030 scandloop subb #'0' +F6E1: 251C bcs sdexit +F6E3: C10A cmpb #10 +F6E5: 2418 bcc sdexit +F6E7: 3404 pshs b +F6E9: DC24 ldd temp +F6EB: 58 aslb +F6EC: 49 rola +F6ED: 3406 pshs d +F6EF: 58 aslb +F6F0: 49 rola +F6F1: 58 aslb +F6F2: 49 rola +F6F3: E3E1 addd ,s++ ;Multiply number by 10. +F6F5: EBE0 addb ,s+ +F6F7: 8900 adca #0 ;Add digit to 10. +F6F9: DD24 std temp +F6FB: E680 ldb ,x+ ;Get next character. +F6FD: 20E0 bra scandloop +F6FF: DC24 sdexit ldd temp +F701: 301F leax -1,x +F703: 1CFB andcc #$fb +F705: 39 rts +F706: 1A04 noexpr orcc #$04 +F708: 39 rts +F709: +F709: * Assemble the instruction pointed to by X. +F709: * Fisrt stage: copy mnemonic to mnemonic buffer. +F709: 8605 asminstr lda #5 +F70B: CE02C6 ldu #mnembuf +F70E: E680 mncploop ldb ,x+ +F710: 2715 beq mncpexit +F712: C120 cmpb #' ' +F714: 2711 beq mncpexit ;Mnemonic ends at first space or null +F716: C4DF andb #CASEMASK +F718: C141 cmpb #'A' +F71A: 2504 blo nolet +F71C: C15A cmpb #'Z' +F71E: 2302 bls mnemcp1 ;Capitalize letters, but only letters. +F720: E61F nolet ldb -1,x +F722: E7C0 mnemcp1 stb ,u+ ;Copy to mnemonic buffer. +F724: 4A deca +F725: 26E7 bne mncploop +F727: 4D mncpexit tsta +F728: 2707 beq mncpdone +F72A: C620 ldb #' ' +F72C: E7C0 mnfilloop stb ,u+ +F72E: 4A deca +F72F: 26FB bne mnfilloop ;Fill the rest of mnem buffer with spaces. +F731: * Second stage: look mnemonic up using binary search. +F731: 9F28 mncpdone stx temp3 +F733: 0F24 clr temp ;Low index=0 +F735: 8693 lda #mnemsize +F737: 9725 sta temp+1 ;High index=mnemsize. +F739: D625 bsrchloop ldb temp+1 +F73B: C1FF cmpb #$ff +F73D: 2739 beq invmnem ;lower limit -1? +F73F: D124 cmpb temp +F741: 2535 blo invmnem ;hi index lower than low index? +F743: 4F clra +F744: DB24 addb temp ;Add indexes. +F746: 8900 adca #0 +F748: 44 lsra +F749: 56 rorb ;Divide by 2 to get average +F74A: D726 stb temp2 +F74C: 58 aslb +F74D: 49 rola +F74E: 58 aslb +F74F: 49 rola +F750: 58 aslb +F751: 49 rola ;Multiply by 8 to get offset. +F752: CEEE63 ldu #mnemtab +F755: 33CB leau d,u ;Add offset to table base +F757: 1F32 tfr u,y +F759: 8605 lda #5 +F75B: 8E02C6 ldx #mnembuf +F75E: E680 bscmploop ldb ,x+ +F760: E1A0 cmpb ,y+ +F762: 2606 bne bscmpexit ;Characters don't match? +F764: 4A deca +F765: 26F7 bne bscmploop +F767: 7EF77E jmp mnemfound ;We found the mnemonic. +F76A: D626 bscmpexit ldb temp2 +F76C: 2405 bcc bscmplower +F76E: 5A decb +F76F: D725 stb temp+1 ;mnembuftable, adjust low limit. +F776: 20C1 bra bsrchloop +F778: 8EE67D invmnem ldx #invmmsg +F77B: 7E0298 jmp asmerrvec +F77E: * Stage 3: Perform routine depending on category code. +F77E: 7F02CC mnemfound clr uncert +F781: 10BE029D ldy addr +F785: A645 lda 5,u +F787: 48 asla +F788: 8EF792 ldx #asmtab +F78B: AD96 jsr [a,x] +F78D: 10BF029D sty addr +F791: 39 rts +F792: F7B4F7B8F7BCF7 asmtab fdb onebyte,twobyte,immbyte,lea +F79A: F7F7F80AF81DF8 fdb sbranch,lbranch,lbra,acc8 +F7A2: F835F846F859F8 fdb dreg1,dreg2,oneaddr,tfrexg +F7AA: F8A4F8CA fdb pushpul,pseudo +F7AE: +F7AE: E7A0 putbyte stb ,y+ +F7B0: 39 rts +F7B1: EDA1 putword std ,y++ +F7B3: 39 rts +F7B4: +F7B4: E647 onebyte ldb 7,u ;Cat 0, one byte opcode w/o operands RTS +F7B6: 20F6 bra putbyte +F7B8: EC46 twobyte ldd 6,u ;Cat 1, two byte opcode w/o operands SWI2 +F7BA: 20F5 bra putword +F7BC: E647 immbyte ldb 7,u ;Cat 2, opcode w/ immdiate operand ANDCC +F7BE: 8DEE bsr putbyte +F7C0: BDF8ED jsr scanops +F7C3: F602C3 ldb amode +F7C6: C101 cmpb #1 +F7C8: 1026038A lbne moderr +F7CC: F602C5 ldb operand+1 +F7CF: 20DD bra putbyte +F7D1: E647 lea ldb 7,u ;Cat 3, LEA +F7D3: 8DD9 bsr putbyte +F7D5: BDF8ED jsr scanops +F7D8: B602C3 lda amode +F7DB: 8101 cmpa #1 +F7DD: 10270375 lbeq moderr ;No immediate w/ lea +F7E1: 8103 cmpa #3 +F7E3: 102402BE lbhs doaddr +F7E7: BDFA98 jsr set3 +F7EA: 868F lda #$8f +F7EC: B702C2 sta postbyte +F7EF: 8602 lda #2 +F7F1: B702CB sta opsize ;Use 8F nn nn for direct mode. +F7F4: 7EFAA5 jmp doaddr +F7F7: E647 sbranch ldb 7,u ;Cat 4, short branch instructions +F7F9: 8DB3 bsr putbyte +F7FB: BDF8E5 jsr startop +F7FE: 301F leax -1,x +F800: BD0295 jsr exprvec +F803: 10270349 lbeq exprerr +F807: 7EFB0E jmp shortrel +F80A: EC46 lbranch ldd 6,u ;Cat 5, long brach w/ two byte opcode +F80C: 8DA3 bsr putword +F80E: BDF8E5 lbra1 jsr startop +F811: 301F leax -1,x +F813: BD0295 jsr exprvec +F816: 10270336 lbeq exprerr +F81A: 7EFB32 jmp longrel +F81D: E647 lbra ldb 7,u ;Cat 6, long branch w/ one byte opcode. +F81F: BDF7AE jsr putbyte +F822: 20EA bra lbra1 +F824: 8601 acc8 lda #1 ;Cat 7, 8-bit two operand instructions ADDA +F826: B702CB sta opsize +F829: BDF8ED jsr scanops +F82C: BDF8CB jsr adjopc +F82F: BDF7AE jsr putbyte +F832: 7EFAA5 jmp doaddr +F835: 8602 dreg1 lda #2 ;Cat 8, 16-bit 2operand insns 1byte opc LDX +F837: B702CB sta opsize +F83A: BDF8ED jsr scanops +F83D: BDF8CB jsr adjopc +F840: BDF7AE jsr putbyte +F843: 7EFAA5 jmp doaddr +F846: 8602 dreg2 lda #2 ;Cat 9, 16-bit 2operand insns 2byte opc LDY +F848: B702CB sta opsize +F84B: BDF8ED jsr scanops +F84E: BDF8CB jsr adjopc +F851: A646 lda 6,u +F853: BDF7B1 jsr putword +F856: 7EFAA5 jmp doaddr +F859: BDF8ED oneaddr jsr scanops ;Cat 10, one-operand insns NEG..CLR +F85C: E647 ldb 7,u +F85E: B602C3 lda amode +F861: 8101 cmpa #1 +F863: 102702EF lbeq moderr ;No immediate mode +F867: 8103 cmpa #3 +F869: 2408 bhs oaind ;indexed etc +F86B: B602CB lda opsize +F86E: 4A deca +F86F: 2704 beq oadir +F871: CB10 addb #$10 ;Add $70 for extended direct. +F873: CB60 oaind addb #$60 ;And $60 for indexed etc. +F875: BDF7AE oadir jsr putbyte ;And nothing for direct8. +F878: 7EFAA5 jmp doaddr +F87B: BDF8E5 tfrexg jsr startop ;Cat 11, TFR and EXG +F87E: 301F leax -1,x +F880: E647 ldb 7,u +F882: BDF7AE jsr putbyte +F885: BDFB6E jsr findreg +F888: E6C4 ldb ,u +F88A: 58 aslb +F88B: 58 aslb +F88C: 58 aslb +F88D: 58 aslb +F88E: F702C2 stb postbyte +F891: E680 ldb ,x+ +F893: C12C cmpb #',' +F895: 102602BD lbne moderr +F899: BDFB6E jsr findreg +F89C: E6C4 ldb ,u +F89E: FA02C2 orb postbyte +F8A1: 7EF7AE jmp putbyte +F8A4: BDF8E5 pushpul jsr startop ;Cat 12, PSH and PUL +F8A7: 301F leax -1,x +F8A9: E647 ldb 7,u +F8AB: BDF7AE jsr putbyte +F8AE: 7F02C2 clr postbyte +F8B1: BDFB6E pploop jsr findreg +F8B4: E641 ldb 1,u +F8B6: FA02C2 orb postbyte +F8B9: F702C2 stb postbyte +F8BC: E680 ldb ,x+ +F8BE: C12C cmpb #',' +F8C0: 27EF beq pploop +F8C2: 301F leax -1,x +F8C4: F602C2 ldb postbyte +F8C7: 7EF7AE jmp putbyte +F8CA: pseudo ;Cat 13, pseudo oeprations +F8CA: 39 rts +F8CB: +F8CB: * Adjust opcdoe depending on mode (in $80-$FF range) +F8CB: E647 adjopc ldb 7,u +F8CD: B602C3 lda amode +F8D0: 8102 cmpa #2 +F8D2: 2708 beq adjdir ;Is it direct? +F8D4: 8103 cmpa #3 +F8D6: 2401 bhs adjind ;Indexed etc? +F8D8: 39 rts ;Not, then immediate, no adjust. +F8D9: CB20 adjind addb #$20 ;Add $20 to opcode for indexed etc modes. +F8DB: 39 rts +F8DC: CB10 adjdir addb #$10 ;Add $10 to opcode for direct8 +F8DE: B602CB lda opsize +F8E1: 4A deca +F8E2: 26F5 bne adjind ;If opsize=2, add another $20 for extended16 +F8E4: 39 rts +F8E5: +F8E5: * Start scanning of operands. +F8E5: 9E28 startop ldx temp3 +F8E7: 7F02C3 clr amode +F8EA: 7EE6E7 jmp skipspace +F8ED: +F8ED: * amode settings in assembler: 1=immediate, 2=direct/extended, 3=indexed +F8ED: * etc. 4=pc relative, 5=indirect, 6=pcrelative and indirect. +F8ED: +F8ED: * This subroutine scans the assembler operands. +F8ED: 8DF6 scanops bsr startop +F8EF: C15B cmpb #'[' +F8F1: 2607 bne noindir +F8F3: 8605 lda #5 ;operand starts with [, then indirect. +F8F5: B702C3 sta amode +F8F8: E680 ldb ,x+ +F8FA: C123 noindir cmpb #'#' +F8FC: 10270087 lbeq doimm +F900: C12C cmpb #',' +F902: 1027009A lbeq dospecial +F906: C4DF andb #CASEMASK ;Convert to uppercase. +F908: 8686 lda #$86 +F90A: C141 cmpb #'A' +F90C: 270C beq scanacidx +F90E: 8685 lda #$85 +F910: C142 cmpb #'B' +F912: 2706 beq scanacidx +F914: 868B lda #$8B +F916: C144 cmpb #'D' +F918: 2616 bne scanlab +F91A: E680 scanacidx ldb ,x+ ;Could it be A,X B,X or D,X +F91C: C12C cmpb #',' +F91E: 260E bne nocomma +F920: B702C2 sta postbyte +F923: 7F02CB clr opsize +F926: BDFA98 jsr set3 +F929: BDFA7A jsr scanixreg +F92C: 2041 bra scanend +F92E: 301F nocomma leax -1,x +F930: 301F scanlab leax -1,x ;Point to the start of the operand +F932: BD0295 jsr exprvec +F935: 10270217 lbeq exprerr +F939: FD02C4 std operand +F93C: 7D02CC tst uncert +F93F: 2609 bne opsz2 ;Go for extended if operand unknown. +F941: B302CD subd dpsetting +F944: 4D tsta ;Can we use 8-bit operand? +F945: 2603 bne opsz2 +F947: 4C inca +F948: 2002 bra opsz1 +F94A: 8602 opsz2 lda #2 +F94C: B702CB opsz1 sta opsize ;Set opsize depending on magnitude of op. +F94F: B602C3 lda amode +F952: 8105 cmpa #5 +F954: 260C bne opsz3 ;Or was it indirect. +F956: 8602 lda #2 ;Then we have postbyte and opsize=2 +F958: B702CB sta opsize +F95B: 868F lda #$8F +F95D: B702C2 sta postbyte +F960: 2005 bra opsz4 +F962: 8602 opsz3 lda #2 +F964: B702C3 sta amode ;Assume direct or absolute addressing +F967: E680 opsz4 ldb ,x+ +F969: C12C cmpb #',' +F96B: 10270086 lbeq doindex ;If followed by, then indexed. +F96F: B602C3 scanend lda amode +F972: 8105 cmpa #5 +F974: 2510 blo scanend2 ;Was it an indirect mode? +F976: B602C2 lda postbyte +F979: 8A10 ora #$10 ;Set indirect bit. +F97B: B702C2 sta postbyte +F97E: E680 ldb ,x+ +F980: C15D cmpb #']' ;Check for the other ] +F982: 102701D0 lbeq moderr +F986: 39 scanend2 rts +F987: BD0295 doimm jsr exprvec ;Immediate addressing. +F98A: 102701C2 lbeq exprerr +F98E: FD02C4 std operand +F991: B602C3 lda amode +F994: 8105 cmpa #5 +F996: 102701BC lbeq moderr ;Inirect mode w/ imm is illegal. +F99A: 8601 lda #$01 +F99C: B702C3 sta amode +F99F: 39 rts +F9A0: BDFA98 dospecial jsr set3 +F9A3: 7F02CB clr opsize +F9A6: 4F clra +F9A7: E680 adecloop ldb ,x+ +F9A9: C12D cmpb #'-' +F9AB: 2603 bne adecend +F9AD: 4C inca ;Count the - signs for autodecrement. +F9AE: 20F7 bra adecloop +F9B0: 301F adecend leax -1,x +F9B2: 8102 cmpa #2 +F9B4: 1022019E lbhi moderr +F9B8: 4D tsta +F9B9: 262F bne autodec +F9BB: 7F02C2 clr postbyte +F9BE: BDFA7A jsr scanixreg +F9C1: 4F clra +F9C2: E680 aincloop ldb ,x+ +F9C4: C12B cmpb #'+' +F9C6: 2603 bne aincend +F9C8: 4C inca +F9C9: 20F7 bra aincloop ;Count the + signs for autoincrement. +F9CB: 301F aincend leax -1,x +F9CD: 8102 cmpa #2 +F9CF: 10220183 lbhi moderr +F9D3: 4D tsta +F9D4: 260A bne autoinc +F9D6: 8684 lda #$84 +F9D8: BA02C2 ora postbyte +F9DB: B702C2 sta postbyte +F9DE: 208F bra scanend +F9E0: 8B7F autoinc adda #$7f +F9E2: BA02C2 ora postbyte +F9E5: B702C2 sta postbyte +F9E8: 2085 bra scanend +F9EA: 8B81 autodec adda #$81 +F9EC: B702C2 sta postbyte +F9EF: BDFA7A jsr scanixreg +F9F2: 16FF7A lbra scanend +F9F5: 7F02C2 doindex clr postbyte +F9F8: BDFA98 jsr set3 +F9FB: E680 ldb ,x+ +F9FD: C4DF andb #CASEMASK ;Convert to uppercase. +F9FF: C150 cmpb #'P' +FA01: 10270057 lbeq dopcrel ;Check for PC relative. +FA05: 301F leax -1,x +FA07: 7F02CB clr opsize +FA0A: 8D6E bsr scanixreg +FA0C: FC02C4 ldd operand +FA0F: 7D02CC tst uncert +FA12: 2638 bne longindex ;Go for long index if operand unknown. +FA14: 1083FFF0 cmpd #-16 +FA18: 2D18 blt shortindex +FA1A: 1083000F cmpd #15 +FA1E: 2E12 bgt shortindex +FA20: B602C3 lda amode +FA23: 8105 cmpa #5 +FA25: 2717 beq shortind1 ;Indirect may not be 5-bit index +FA27: ;It's a five-bit index. +FA27: C41F andb #$1f +FA29: FA02C2 orb postbyte +FA2C: F702C2 stb postbyte +FA2F: 16FF3D lbra scanend +FA32: 1083FF80 shortindex cmpd #-128 +FA36: 2D14 blt longindex +FA38: 1083007F cmpd #127 +FA3C: 2E0E bgt longindex +FA3E: 7C02CB shortind1 inc opsize +FA41: C688 ldb #$88 +FA43: FA02C2 orb postbyte +FA46: F702C2 stb postbyte +FA49: 16FF23 lbra scanend +FA4C: 8602 longindex lda #$2 +FA4E: B702CB sta opsize +FA51: C689 ldb #$89 +FA53: FA02C2 orb postbyte +FA56: F702C2 stb postbyte +FA59: 16FF13 lbra scanend +FA5C: E680 dopcrel ldb ,x+ +FA5E: C4DF andb #CASEMASK ;Convert to uppercase +FA60: C143 cmpb #'C' +FA62: 2506 blo pcrelend +FA64: C152 cmpb #'R' +FA66: 2202 bhi pcrelend +FA68: 20F2 bra dopcrel ;Scan past the ,PCR +FA6A: 301F pcrelend leax -1,x +FA6C: C68C ldb #$8C +FA6E: FA02C2 orb postbyte ;Set postbyte +FA71: F702C2 stb postbyte +FA74: 7C02C3 inc amode ;Set addr mode to PCR +FA77: 16FEF5 lbra scanend +FA7A: +FA7A: * Scan for one of the 4 index registers and adjust postbyte. +FA7A: E680 scanixreg ldb ,x+ +FA7C: C4DF andb #CASEMASK ;Convert to uppercase. +FA7E: 3410 pshs x +FA80: 8EF33A ldx #ixregs +FA83: 4F clra +FA84: E180 scidxloop cmpb ,x+ +FA86: 2707 beq ixfound +FA88: 8B20 adda #$20 +FA8A: 2AF8 bpl scidxloop +FA8C: 7EFB56 jmp moderr ;Index register not found where expected. +FA8F: BA02C2 ixfound ora postbyte +FA92: B702C2 sta postbyte ;Set index reg bits in postbyte. +FA95: 3510 puls x +FA97: 39 rts +FA98: +FA98: * This routine sets amode to 3, if it was less. +FA98: B602C3 set3 lda amode +FA9B: 8103 cmpa #3 +FA9D: 2405 bhs set3a +FA9F: 8603 lda #3 +FAA1: B702C3 sta amode +FAA4: 39 set3a rts +FAA5: +FAA5: * This subroutine lays down the address. +FAA5: B602C3 doaddr lda amode +FAA8: 8103 cmpa #3 +FAAA: 250D blo doa1 +FAAC: F602C2 ldb postbyte +FAAF: BDF7AE jsr putbyte +FAB2: B602C3 lda amode +FAB5: 8401 anda #1 +FAB7: 2715 beq doapcrel ;pc rel modes. +FAB9: B602CB doa1 lda opsize +FABC: 4D tsta +FABD: 27E5 beq set3a +FABF: 4A deca +FAC0: 2706 beq doa2 +FAC2: FC02C4 ldd operand +FAC5: 7EF7B1 jmp putword +FAC8: F602C5 doa2 ldb operand+1 +FACB: 7EF7AE jmp putbyte +FACE: 10BF029D doapcrel sty addr +FAD2: FC02C4 ldd operand +FAD5: B3029D subd addr +FAD8: 830001 subd #1 +FADB: 7D02CC tst uncert +FADE: 2614 bne pcrlong +FAE0: 1083FF80 cmpd #-128 +FAE4: 2D0E blt pcrlong +FAE6: 1083FF81 cmpd #-127 +FAEA: 2E08 bgt pcrlong +FAEC: 8601 lda #1 +FAEE: B702CB sta opsize +FAF1: 7EF7AE jmp putbyte +FAF4: 830001 pcrlong subd #1 +FAF7: 313F leay -1,y +FAF9: 7C02C2 inc postbyte +FAFC: 3406 pshs d +FAFE: F602C2 ldb postbyte +FB01: BDF7AE jsr putbyte +FB04: 8602 lda #2 +FB06: B702CB sta opsize +FB09: 3506 puls d +FB0B: 7EF7B1 jmp putword +FB0E: +FB0E: * This routine checks and lays down short relative address. +FB0E: 10BF029D shortrel sty addr +FB12: B3029D subd addr +FB15: 830001 subd #1 +FB18: 1083FF80 cmpd #-128 +FB1C: 2D2C blt brerr +FB1E: 1083007F cmpd #127 +FB22: 2E26 bgt brerr +FB24: BDF7AE jsr putbyte +FB27: 8604 lda #4 +FB29: B702C3 sta amode +FB2C: 8601 lda #1 +FB2E: B702CB sta opsize +FB31: 39 rts +FB32: * This routine lays down long relative address. +FB32: 10BF029D longrel sty addr +FB36: B3029D subd addr +FB39: 830002 subd #2 +FB3C: BDF7B1 jsr putword +FB3F: 8604 lda #4 +FB41: B702C3 sta amode +FB44: 8602 lda #2 +FB46: B702CB sta opsize +FB49: 39 rts +FB4A: +FB4A: 8EE6B5 brerr ldx #brmsg +FB4D: 7E0298 jmp asmerrvec +FB50: 8EE68E exprerr ldx #exprmsg +FB53: 7E0298 jmp asmerrvec +FB56: 8EE69F moderr ldx #modemsg +FB59: 7E0298 jmp asmerrvec +FB5C: 3410 asmerr pshs x +FB5E: 9D18 jsr xabortin +FB60: 3510 puls x +FB62: BDE4E1 jsr outcount +FB65: 9D0C jsr putcr +FB67: 10FE02BD lds savesp +FB6B: 7EE558 jmp cmdline +FB6E: +FB6E: * Find register for TFR and PSH instruction +FB6E: C60C findreg ldb #12 +FB70: 3424 pshs y,b +FB72: CEF2FB ldu #asmregtab +FB75: 1F12 findregloop tfr x,y +FB77: 8603 lda #3 +FB79: E6C4 frcmps ldb ,u +FB7B: C120 cmpb #' ' +FB7D: 2606 bne frcmps1 +FB7F: E6A4 ldb ,y +FB81: C141 cmpb #'A' +FB83: 2D18 blt frfound +FB85: E6A0 frcmps1 ldb ,y+ +FB87: C4DF andb #CASEMASK +FB89: E1C0 cmpb ,u+ +FB8B: 2606 bne frnextreg +FB8D: 4A deca +FB8E: 26E9 bne frcmps +FB90: 4C inca +FB91: 200A bra frfound +FB93: 4C frnextreg inca +FB94: 33C6 leau a,u +FB96: 6AE4 dec ,s +FB98: 26DB bne findregloop +FB9A: 16FFB9 lbra moderr +FB9D: 33C6 frfound leau a,u +FB9F: 1F21 tfr y,x +FBA1: 3524 puls y,b +FBA3: 39 rts +FBA4: +FBA4: * This is the code for the A command, assemble instructions. +FBA4: * Syntax: Aaddr +FBA4: 8E0201 asm ldx #linebuf+1 +FBA7: BDE70F jsr scanhex +FBAA: FD029D std addr +FBAD: FC029D asmloop ldd addr +FBB0: BDE6DE jsr outd +FBB3: C620 ldb #' ' +FBB5: 9D03 jsr putchar ;Print address and space. +FBB7: 8E0200 ldx #linebuf +FBBA: C680 ldb #128 +FBBC: 9D06 jsr getline ;Get new line +FBBE: 5D tstb +FBBF: 1027E995 lbeq cmdline ;Exit on empty line. +FBC3: 3A abx +FBC4: 6F84 clr ,x ;Make line zero terminated. +FBC6: 8E0200 ldx #linebuf +FBC9: BDF709 jsr asminstr +FBCC: 20DF bra asmloop +FBCE: +FBCE: * Jump table for monitor routines that are usable by other programs. +FBCE: org $ffc0 +FFC0: 7EE6D0 jmp outbyte +FFC3: 7EE6DE jmp outd +FFC6: 7EE74A jmp scanbyte +FFC9: 7EE70F jmp scanhex +FFCC: 7EF6B9 jmp scanfact +FFCF: 7EF709 jmp asminstr +FFD2: +FFD2: +FFD2: * Interrupt vector addresses at top of ROM. Most are vectored through jumps +FFD2: * in RAM. +FFD2: org $fff2 +FFF2: 0280 fdb swi3vec +FFF4: 0283 fdb swi2vec +FFF6: 0286 fdb firqvec +FFF8: 0289 fdb irqvec +FFFA: 028C fdb swivec +FFFC: 028F fdb nmivec +FFFE: E400 fdb reset +0000: +0000: end +0 Pass 2 errors. + +SYMBOL TABLE + ACC8 02 f824 ACIACTL 00 e000 ACIADAT 00 e001 ACIAIRQ 02 e4f5 + ACIASTA 00 e000 ACK 00 0006 ACKLOOP 02 ecbf ADDCHK 02 ea06 + ADDR 02 029d ADECEND 02 f9b0 ADECLOOP 02 f9a7 ADJDIR 02 f8dc + ADJIND 02 f8d9 ADJOPC 02 f8cb AINCEND 02 f9cb AINCLOOP 02 f9c2 + AMODE 02 02c3 AREGS 02 f30a AREGU 02 f305 ARM 02 e98a + ARM1 02 e98f ARM2 02 e9a0 ASM 02 fba4 ASMERR 02 fb5c + ASMERRVEC 02 0298 ASMINSTR 02 f709 ASMLOOP 02 fbad ASMREGTAB 02 f2fb + ASMTAB 02 f792 AUTODEC 02 f9ea AUTOINC 02 f9e0 BACKSP 02 e491 + BLOCKMOVE 02 e44a BP1 02 e9ba BP2 02 e9c6 BPADDR 02 02a1 + BPEXIT 02 e9d7 BPFULL 02 e9e8 BREAK 02 e9a6 BRERR 02 fb4a + BRKMSG 02 e5ee BRKPOINTS 00 0004 BRMSG 02 e6b5 BS 00 0008 + BSCMPEXIT 02 f76a BSCMPLOOP 02 f75eBSCMPLOWER 02 f773 BSRCHLOOP 02 f739 + BUF0 02 0100 BUF1 02 0180 BUFLEN 00 0080 CAN 00 0018 + CASEMASK 00 00df CB2 02 e702 CHECKOUT 02 eb0b CLEARIT 02 e9df + CLRMSG 02 e5fd CLVAR 02 e434 CMDLINE 02 e558 CMDTAB 02 e580 + COMMAPC 02 f610 CONVB 02 e6ee CONVEXIT 02 e705 CR 00 000d + DBP1 02 e9f0 DBP2 02 e9fb DDEC1 02 f37b DDEC2 02 f380 + DDEC3 02 f3ae DDEC4 02 f397 DDEC5 02 f3cc DDEC6 02 f3e0 + DDEC7 02 f3f1 DDECFOUND 02 f3d0 DDECLOOP 02 f3a0 DEL 00 007f + DELAY 02 0021 DH1 02 e770 DH2 02 e77d DH3 02 e796 + DH4 02 e79e DH5 02 e7a4 DH6 02 e78c DISADEC1 02 f57e + DISADEC2 02 f57a DISADECA 02 f580 DISADLOOP 02 f583 DISADR16 02 f47b + DISADR8 02 f483 DISAILOOP 02 f59c DISAINC1 02 f590 DISAINC2 02 f58c + DISAINCA 02 f592 DISARM 02 e970 DISARM1 02 e975 DISARM2 02 e981 + DISAX 02 f5a6 DISBX 02 f5ad DISCOMMA 02 f557 DISDECODE 02 f36b + DISDECTAB 02 f3faDISDECTAB1 02 f40e DISDIRECT 02 f604 DISDISP 02 f44e +DISDISPTAB 02 f461 DISDX 02 f5b4 DISIDX 02 f53b DISIDX1 02 f565 + DISIDX2 02 f56f DISIDXEND 02 f564 DISIDXREG 02 f52a DISIDXTAB 02 f614 + DISIM16 02 f479 DISIM8 02 f475 DISINDEX 02 f55a DISINDIR 02 f55c + DISINVAL 02 f5bb DISNNPC 02 f5fc DISNNX 02 f5d7 DISNPC 02 f5e3 + DISNPCA 02 f5ea DISNX 02 f5c2 DISNX1 02 f5c7 DISNXNEG 02 f5d0 + DISP16 02 e8b5 DISP8 02 e8a7 DISPBP 02 e9ed DISPREGS 02 e8c5 + DISPUSH 02 f4b0 DISPUSH1 02 f4f3 DISPUSH2 02 f4ed DISPUSH3 02 f4ce + DISPUSH4 02 f4deDISREGNAME 02 f51a DISREL16 02 f499 DISREL8 02 f48b + DISTFR 02 f4f9 DISTFREND 02 f517DISTFRLOOP 02 f50e DISTFRSUB 02 f509 + DLYLOOP 02 e4f9 DOA1 02 fab9 DOA2 02 fac8 DOADDR 02 faa5 + DOAPCREL 02 face DOIMM 02 f987 DOINDEX 02 f9f5 DOPCREL 02 fa5c + DOSPECIAL 02 f9a0 DPSETTING 02 02cd DR8A 02 f491 DREG1 02 f835 + DREG2 02 f846 DRNEND 02 f529 DRNLOOP 02 f51e DUMP 02 e763 + ENDIRQ 02 e4f6 ENDMSG 02 e6c5 ENDREC 02 ea66 ENDREC1 02 ea79 + ENDSS 02 eb00 ENDVARS 02 02cf ENDVECS 02 e53e ENT1 02 e7c8 + ENT2 02 e7ce ENTASC 02 e809 ENTDONE 02 e81a ENTER 02 e7bd + ENTEXIT 02 e821 ENTL2 02 e800 ENTL3 02 e80d ENTLINE 02 e7f0 + EOT 00 0004 EXPR 02 f69b EXPREND 02 f6b5 EXPREND1 02 f6b6 + EXPRERR 02 fb50 EXPRMSG 02 e68e EXPRVEC 02 0295 FHEXLOOP 02 eb7c + FILLER 02 02bb FIND 02 eb56 FINDHEX 02 eb76 FINDREG 02 fb6e +FINDREGLOOP 02 fb75 FIRQVEC 02 0286 FRCMPS 02 fb79 FRCMPS1 02 fb85 + FRFOUND 02 fb9d FRNEXTREG 02 fb93 FSTRLOOP 02 eb69 FULLMSG 02 e610 + GETCHAR 02 0000 GETLINE 02 0006 GETPOLL 02 000fGETTIMEOUT 02 ec2d + GO 02 e86a GT1 02 ec2f GTEXIT 02 ec3b HEX 02 e836 + HEX1 02 e84e HEXDIGIT 02 e6c5 HEXEND 02 e860 HEXLOOP 02 e83e + IMMBYTE 02 f7bc INITACIA 02 e452 INP 02 e824 INTVECTBL 02 e4ff + INVMMSG 02 e67d INVMNEM 02 f778 IRQVEC 02 0289 IXFOUND 02 fa8f + IXREGS 02 f33a JUMP 02 e879 LASTOK 02 002f LASTREC 02 e633 + LASTTERM 02 02ba LAUNCH 02 e874 LBRA 02 f81d LBRA1 02 f80e + LBRANCH 02 f80a LEA 02 f7d1 LENGTH 02 029f LF 00 000a + LINEBUF 02 0200 LONGINDEX 02 fa4c LONGREL 02 fb32 MNCPDONE 02 f731 + MNCPEXIT 02 f727 MNCPLOOP 02 f70e MNEMBSR 02 ef6b MNEMBUF 02 02c6 + MNEMCP1 02 f722 MNEMFCB 02 f033 MNEMFOUND 02 f77e MNEMJSR 02 f06b + MNEMSIZE 00 0093 MNEMTAB 02 ee63 MNFILLOOP 02 f72c MODEMSG 02 e69f + MODERR 02 fb56 MODETAB 02 f34e MODETAB2 02 f35e MOVE 02 eb19 + MVLOOP 02 eb4b NAK 00 0015 NEGOFFS 02 f54d NEWLINE 02 e4ad + NMIVEC 02 028f NOCOMMA 02 f92e NOEXPR 02 f706 NOINDIR 02 f8fa + NOLET 02 f720 NOOP 02 f434 OADIR 02 f875 OAIND 02 f873 + OD1A 02 f431 ODB1 02 f63e ODPA 02 f43b OLDGETC 02 02b4 + OLDPC 02 029b OLDPUTC 02 02b6 OLDPUTCR 02 02b8 ONEADDR 02 f859 + ONEBYTE 02 f7b4 OPC1 02 02c0 OPCODE 02 02c1 OPCOFFS 02 f33e + OPDEC1 02 f42e OPDEC2 02 f435 OPDECIDX 02 f43f OPDECPB 02 f439 + OPERAND 02 02c4 OPSIZE 02 02cb OPSZ1 02 f94c OPSZ2 02 f94a + OPSZ3 02 f962 OPSZ4 02 f967 OSCR 02 e4d4 OSDLY 02 e4f7 + OSGETC 02 e45a OSGETL 02 e480 OSGETL1 02 e485 OSGETL2 02 e4a5 + OSGETL3 02 e4b4 OSGETPOLL 02 e465 OSPUTC 02 e471 OSPUTL 02 e4c3 + OSPUTL1 02 e4d1 OSPUTL2 02 e4ca OSVECTBL 02 e51a OUTBYTE 02 e6d0 + OUTCOUNT 02 e4e1 OUTD 02 e6deOUTDECBYTE 02 f634 PCRELEND 02 fa6a + PCRLONG 02 faf4 POLTRUE 02 e46e POS 02 f6a4 POSTBYTE 02 02c2 + PPLOOP 02 f8b1 PREBYTE 02 02bf PROG 02 e898 PSEUDO 02 f8ca + PURGE 02 ec41 PURGEIT 02 ecb6 PUSHPUL 02 f8a4 PUTBYTE 02 f7ae + PUTCHAR 02 0003 PUTCLOOP 02 e473 PUTCOMMA 02 f4a8 PUTCR 02 000c + PUTDOL 02 f4a4 PUTHASH 02 f4a0 PUTLINE 02 0009 PUTSPACE 02 f4ac + PUTWORD 02 f7b1 RAMSTART 00 0400 RAMTOP 00 8000 READREC 02 ea31 + REGINVAL 02 f337 REGLOOP 02 f4b7 REGS 02 e90c REGTAB 02 e966 + RESET 02 e400 RR1 02 ea57 RR2 02 ea5c RSTVECS 02 ecd6 + SAVESP 02 02bd SAVEVECS 02 ecc6 SB1 02 e762 SBRANCH 02 f7f7 +SCAN2PARMS 02 e732 SCANACIDX 02 f91a SCANBYTE 02 e74a SCANCHAR2 02 f6cf + SCANDEC 02 f6d3 SCANDLOOP 02 f6df SCANEND 02 f96f SCANEND2 02 f986 + SCANEXIT 02 e708 SCANFACT 02 f6b9 SCANHEX 02 e70f SCANIXREG 02 fa7a + SCANLAB 02 f930 SCANOPS 02 f8ed SCIDXLOOP 02 fa84 SCLOOP 02 e717 + SDEXIT 02 f6ff SENDNAK 02 ec58 SENDREC 02 ea9f SET3 02 fa98 + SET3A 02 faa4 SETREG 02 e91a SETSORG 02 ea91 SHORTIND1 02 fa3e +SHORTINDEX 02 fa32 SHORTREL 02 fb0e SKIPSPACE 02 e6e7 SMSG 02 e621 + SOFFS 02 02b2 SOH 00 0001 SORG 02 02b0 SP2 02 e749 + SR1 02 e921 SR2 02 e92e SR3 02 e944 SR4 02 e954 + SRCH1 02 eba7 SRCH2 02 ebac SRCH3 02 ebc6 SRCHLOOP 02 eb95 + SREC 02 ea14 SRECERR 02 ea84 SS1 02 eab3 SS2 02 eac0 + SS3 02 eaeb STAKREGS 02 e53eSTARTBLOCK 02 ec5d STARTOP 02 f8e5 + STARTSRCH 02 eb8c STEPBP 02 02ad SWI2VEC 02 0283 SWI3VEC 02 0280 + SWIVEC 02 028c TEMP 02 0024 TEMP2 02 0026 TEMP3 02 0028 + TFREXG 02 f87b TIMER 02 002a TIMERIRQ 02 e4ea TRACE 02 e8a4 + TWOBYTE 02 f7b8 UNADISHEX 02 f66e UNADISSPC 02 f67b UNASM 02 f644 + UNASMLOOP 02 f65a UNCERT 02 02cc UNK 02 e5b4 UNKNOWN 02 e5de + UNLAUNCH 02 e549 UNLAUNCH1 02 e550 WAITACK 02 ebf2 WAITACK2 02 ec1c + WAITNAK 02 ec0a WELCOME 02 e5c1 XABORTIN 02 0018 XABTIN 02 ed2e + XABTLOOP 02 ed3b XAMSG 02 e665 XCLOSEIN 02 001b XCLOSEOUT 02 001e + XCLSDONE 02 ed64 XCLSEND 02 ed70 XCLSIN 02 ed71 XCLSLOOP 02 ed5c + XCLSOUT 02 ed4e XCOUNT 02 0030 XEQ 02 ee49 XERRHAND 02 eded + XERROR 02 eddd XERRVEC 02 0292 XGETC 02 edb4 XGETC1 02 edc7 + XGETCTERM 02 edd3 XLOAD 02 ee36 XLODLOOP 02 ee3d XMCR 02 02bc + XMODE 02 0031 XMODEM 02 edf4 XOPENIN 02 0012 XOPENOUT 02 0015 + XOPIN 02 ece6 XOPOUT 02 ed09 XOPTS 02 ee4e XPACKNUM 02 002d + XPUTC 02 ed7b XPUTC1 02 ed97 XPUTCR 02 ed99 XPUTCR1 02 eda6 + XPUTCR2 02 edb1 XR1 02 ec7e XRCVBUF 02 ec49 XRCVEOT 02 ecbb + XRLOOP 02 ec90 XRMSG 02 e650 XSABT 02 ec05 XSBINLOOP 02 ee24 + XSENDBUF 02 ebca XSENDEOT 02 ec17 XSENDINIT 02 ec06 XSLOOP 02 ebdf + XSMSG 02 e63e XSOK 02 ec03 XSS 02 ee2f XSUM 02 002e + + +\end{verbatim} +} + +\end{document} \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 doc/origin/sbc09.tex --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/origin/sbc09.tex Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,874 @@ +\documentstyle[12pt,a4wide]{report} +\title{SBC09, an Emulator for a 6809-Based Single Board Compuer.} +\author{L.C. Benschop} +\begin{document} +\def\SetFigFont#1#2#3{\rm} + +\maketitle +\tableofcontents +\chapter{Introduction} + +The {\tt sbc09} package contains an emulator of a 6809-based single board +computer that runs under UNIX. It contains all the programs needed to work +with the emulator, such as the emulator itself, an assembler, a monitor +program, a BASIC interpreter, a Forth interpreter, several example programs +and several tools needed to build the programs. The program should work +under most more-or-less POSIX-compliant versions of UNIX and they were +developed under Linux. Of course I believe that the programs that currently +run on the emulator would also run on a real 6809 machine. + +\section{A Bit of Background on SBCs.} + +In the seventies you could buy single board microcomputers that had a +hexadecimal keypad and 7-segment displays. These computers typically had +less than 1 kilobyte of RAM and a simple monitor program in ROM. An +interface to a cassette recorder (or paper tape reader/writer) and a +terminal was possible, but not standard. The typical way to program the +machine was entering hexadecimal machine codes on the keypad. Machine code +was the only language in which you could program them, especially if you +only had a hexadecimal keypad and 7-segment led displays. You typically used +these machines to experiment with hardware interfacing, as games and +calculations were a bit limited with only six 7-sengment digits. + +Next came simple home computers, like the TRS80, the Apple ][ and the +Commodore PET. These machines had BASIC in ROM and they used a simple +cassette recorder to store data. These computers had a TV or a low quality +monitor as display and a QWERTY keyboard. These machines could be upgraded +with a floppy disk drive and a printer and then they could be used for +professional work. These machines had 4 to 64 kilobyts of memory. +Apart from assembly language you could use BASIC, Forth +and sometimes Pascal to program these machines. Most useful programs (and +the best games) were programmed in assembly language. Many of these machines +had BASIC in ROM and no machine code monitor. You had to load that +separately. + +Today we have personal computers that run DOS, Windows, UNIX or something +else. New computers have 4 to 16 megabytes of RAM and hard disks of more +than 500 Megabytes. Apart from having in the order of 1000 times more +storage, they are also 1000 times faster than the old 8-bit home computers. +Programming? You can use Visual BASIC, C++ and about +every other programming language on the planet. But programs have become +bigger and bigger. Programming is not the same as it was before. + +I guess there is some demand for small 8-bit computer systems that are simple +to build, easy to interface to all kinds of hobby projects, fun to program +and small enough to integrate into a home-built project. +Do we want to use hexadecimal keyboards and 7-segment displays? I guess not +many people want to use them. Do we want to use a cassette recorder for data +storage and a TV as a display? Not me. And if you build your own 8-bit +microprocessor, do you want to waste your time and money on a hexadecimal +keypad or a cassette interface that you do not like to use and that you do +not need anyway? PCs of five years ago are more than adequate to run an +editor, a terminal program and a cross assembler for your favourite 8-bit +processor. The terminal program can then be used to send the programs to the +8-bit micro. +If you equip an 8-bit system with some static CMOS RAM, a serial +interface and a monitor in ROM, you can use the keyboard, hard disk and +monitor of your PC for program development and the 8-bit micro can be +disconnected from the PC and do its task, once it is programmed. + +Cross development is nothing special. How do you think the microprocessor in +you microwave was programmed? But it is not practical for a hobbyist to +program an EPROM for each program change. Professional developers of +embedded processors have expensive tools, like ROM emulators, processor +emulators etc. to see what the processor is doing on its way to the next +crash. For a hobbyist it is much more practical to have a slightly more +expensive embedded computer that you can run an interactive debugger on. +And you are not even limited to assembly language. If you have 32k ROM you +can have both the monitor program and a BASIC interpreter and some +aplication code in ROM. Nothing prevents you from having Forth as well. + +\section{The Emulated System.} + +\begin{figure} +\input{sbc09fig.tex} +\caption{Block Diagram of SBC.} +\end{figure} + +The program {\tt sbc09} emulates the abovementioned single board computer +{\em plus} the terminal program that communicates with it. + +\chapter{Building the Programs.} + +\chapter{The 6809 Assembler {\tt a09}.} + +The assembler is a09. Run it with +\begin{verbatim} + a09 [-l listing] [-o object|-s object] source +\end{verbatim} + +Source is a mandatory argument. The -l listing and {\tt -o} or {\tt -s} + object arguments are +optional. By default there is no listing and the object file is the +sourcefile name without an extension and if the source file name has no +extension it is the source file name with {\tt .b} extension. + +A09 recognizes standard 6809 mnemonics. Labels should start in the first +column and may or may not be terminated by a colon. Every line starting with +a non-alphanumeric is taken to be a comment line. Everything after the +operand field is taken to be comment. There is a full expression evaluator +with C-style operators (and Motorola style number bases). + +There are the usual pseudo-ops such as ORG EQU SET SETDP RMB FCB FDB FCC etc. +Strings within double quotes may be mixed with numbers on FCB lines. There +is conditional assembly with IF/ELSE/ENDIF and there is INCLUDE. The +assembler is case-insensitive. + +The object file is either a binary image file (-o) or Motorola S-records (-s). +In the former case it contains a binary image of the assembled data starting +at the first address where something is assembled. In the following case +\begin{verbatim} + ORG 0 +VAR1 RMB 2 +VAR2 RMB 2 + + ORG $100 +START LDS #$400 + ... +\end{verbatim} + +the RMB statements generate no data so the object file contains the memory +image from address \$100. + +The list file contains no pretty lay-out and no pagination. It is assumed +that utilities (Unix pr or enscript) are available for that. + +There are no macros and no linkable modules yet. Some provisions are taken +for it in the code. + +After the assembler has finished, it prints the number of pass 2 errors. +This should be zero. So if you see +\begin{verbatim} + 0 Pass 2 Errors. +\end{verbatim} +then you are lucky. + +\chapter{The Virtual SBC {\tt v09}.} + +The simulator is v09. Run it with +\begin{verbatim} + v09 [-t tracefile [-tl tracelo] [-th tracehi]] [-e escchar] +\end{verbatim} + +{\tt tracelo} and {\tt tracehi} are addresses. They can be entered in +decimal, octal or hex using the C conventions for number input. + +If a tracefile is specified, all instructions at addresses between +{\tt tracelo} and {\tt tracehi} are traced. Tracing information such as program +location, register contents and opcodes are written to the trace file. + +{\tt escchar} is the escape character. It must be entered as a number. This is +the character that you must type to get the v09 prompt. This is control-] +by default. (0x1d) + +The program loads its ROM image from the file {\tt v09.rom}, which is a 32 +kiliobyte binary file. This file should have been generated by the {\tt +Makefile}. The program starts executing at the address found at \$FFFE in +the ROM, just like a real 6809 would do on reset. + +The address map is as follows. +\begin{description} +\item[\$0000--\$7FFF] RAM. +\item[\$8000--\$FFFF] ROM (except the I/O addresses). These addresses are +write-protected. +\item[\$E000--\$E0FF] I/O addresses. Currently only one ACIA is mapped. +\end{description} + +At addresses \$E000 and \$E001 there is an emulated serial port (ACIA). All +bytes sent to it (or read from it) are send to (read from) the terminal and +sometimes to/from a file. +Terminal I/O is in raw mode. + +If you press the escape char, you get the v09 prompt. At the prompt you +can enter the following things. +\begin{description} +\item[X] to exit the simulator. +\item[R] to reset the emulated 6809 (very useful). +\item[Lfilename] (no space in between) to log terminal output to a file. + Control chars and cr are filtered to make the output a normal + text file. L without a file name stops logging. +\item[Sfilename] to send a specified file to the simulator through its terminal + input. LF is converted to CR to mimic raw terminal input. +\item[Ufilename] (terminal upload command) to send a file to the 6809 using the + X-modem protocol. The 6809 must already run an X-modem receiving + program. +\item[Dfilename] (terminal download command) to receive a file from the 6809 using + the X-modem protocol. The 6809 must already run an X-modem + sending program. +\end{description} +All of these commands, except the R command, can be seen as commands of the +communication program that is used to access the single board computer. +The R command is a subsitute for pushing the RESET button on the emulated +computer. + +\chapter{Machine Language Monitor.} + +The program {\tt monitor.asm} is a program that is intended to be included +in the ROM of a 6809 based single board computer. The program allows a user +to communicate with the single board computer through a serial port. It +allows a user to enter machine code, examine memory and registers, to set +breakpoints, to trace a program and more. Furthermore, data can be sent to +and be received from the single board computer through the X-MODEM protocol. + +\subsection{Getting Started.} + +If you start v09 with the standard ROM, then you will run the monitor +program. +If all goes well you see something like +\begin{verbatim} +Welcome to BUGGY 1.0 +\end{verbatim} +and you can type text. Excellent, you are now running 6809 code. + +The following example programs you can run from the 6809 monitor. +All of them start at address \$400. For example to run the program bin2dec +you type. + +XL400 + +Then press your escape character (default is control-] ). + +Then at the v09 prompt type + +ubin2dec + +Now you see some lines displaying the progress of the X-modem session. +If that is finished, you type + +G400 + +Now it runs and exits to the monitor with SWI, so that the registers are +displayed. + +\begin{description} +\item[cond09.asm] +\item[cond09.inc] Nonsense program to show conditional assembly and the like. + +\item[bench09.asm] Benchmark program. Executes tight loop. Takes 83 secs on + 25 MHz 386. Should take about 8 sec. on 1MHz real 6809. :-( + +\item[test09.asm] Tests some nasty features of the 6809. Prints a few lines + of PASSED nn and should never print ERROR nn. + +\item[bin2dec.asm] Unusual way to convert numbers to decimal using DAA instruction. + Prints some test numbers. + +\item[basic.asm] Tiny BASIC by John Byrns. Docs are in basic.doc. + To test it start the monitor and run basic. + + Then press your escape char. + At the v09 prompt type: sexampl.bas + + Now a BASIC program is input. + Type RUN to run it. + + Leave BASIC by pressing the escape char and entering x at the + prompt. +\end{description} + + +\section{Use of the monitor commands} + + +\subsection{Single Letter Commands} + +\begin{description} +\item[D] Dump memory. + +Syntax: +\begin{description} +\item[Daddr,len] Hex/ascii dump of memory region. +\item[Daddr] length=64 bytes by default. +\item[D] address is address after previous dump by default. +\end{description} + +Examples: +\begin{verbatim} +DE400,100 +\end{verbatim} +Dump 256 bytes starting at \$E400 +\begin{verbatim} +D +\end{verbatim} +Dump the next 64 bytes. + +\item[E] Enter data into memory, + +\begin{description} +\item[Eaddr bytes] Enter hexadecimal bytes at address. +\item[Eaddr"ascii"] Enter ascii at address. +\item[Eaddr] Enter interactively at address (until empty line). +\end{description} + +Examples: +\begin{verbatim} +E0400 86449D033F +\end{verbatim} +Enter the bytes 86 44 9D 03 3F at address \$400. +\begin{verbatim} +E5000"Welcome" +\end{verbatim} +Enter the ASCII codes of "Welcome" at address \$400. + +\item[F] Find string in memory. + +Syntax: +\begin{description} +\item[Faddr bytes] Find byte string string from address. +\item[Faddr"ascii"] Find ASCII string. +\end{description} + +Find the specified string in memory, starting at the specified address. The +I/O addresses \$E000-\$E0FF are skipped. The addresses of the first 16 +occurrences are shown. + +Example: +\begin{verbatim} +FE400"SEX" +\end{verbatim} +Search for the word "SEX" starting in the monitor. + +\item[M] Move memory region. + +\begin{description} +\item[Maddr1,addr2,len] Move region of memory from addr1 to addr2. If addr2 is + 1 higher than addr1, a region is filled. +\end{description} + +Example: +\begin{verbatim} + M400,500,80 +\end{verbatim} +Move 128 bytes from address \$400 to \$500. + +\item[A] Assemble instructions. + +Syntax: +\begin{description} +\item[Aaddr] Enter line-by-line assembler. +\end{description} + +You are in the assembler until you make an error or until you enter an empty +line. + +Example: +\begin{verbatim} +A400 +LDB #$4B +JSR $03 +SWI + +\end{verbatim} + +\item[U] Disassemble instructions. + +Syntax: +\begin{description} +\item[Uaddr,len] Disassemble memory region. +\item[Uaddr] (disassemble 21 bytes) +\item[U] +\end{description} + +Examples: +\begin{verbatim} +UE400,20 +\end{verbatim} +Diassemble first 32 bytes of monitor program. +\begin{verbatim} +U +\end{verbatim} +Disassemble next 21 bytes. + +\item[B] Set, clear and show breakpoints. + +Syntax: +\begin{description} +\item[Baddr] Set/reset breakpoint at address. +\item[B] Display active breakpoints. +\end{description} +Four breakpoints can be active simultaneously. + +Examples: +\begin{verbatim} +B403 +B408 +\end{verbatim} +Set the breakpoints at the addresses \$403 and \$408. +\begin{verbatim} +B +\end{verbatim} +Show the breakpoints. +\begin{verbatim} +B403 +\end{verbatim} +Remove the breakpoint at \$403. + +\item[J] Call a subroutine. +\item[G] Go to specified address. + +Syntax: +\begin{description} +\item[Jaddr] JSR to specified address. +\item[Gaddr] Go to specified address. +\item[G] Go to address in PC register. +\end{description} +The registers are loaded from where they are saved (on the stack) and at the +breakpoints SWI instructions are entered. Next the code is executed at the +indicated address. The SWI instruction (or RTS for the J command) returns to +the monitor, saving the registers. + +\item[H] Calculate HEX expression. + +Syntax: + +\begin{description} +\item[Hhexnum\{(+|-)hexnum\}] Calculate simple expression in hex with + and - +\end{description} + +Examples: +\begin{verbatim} +H4444+A5 +H4444-44F3 +\end{verbatim} + +\item[P] Put a temporary breakpoint after current instruction and exeucte it, + +P is similar to T, because it usually executes one instruction and returns +to the monitor after it. That does not work for jumps though. Normally you +use P only with JSR instructions if you want to execute the whole subroutine +without single-stepping through it. + +\item[R] Display or modify registers. + +Syntax: +\begin{description} +\item[R] Register display. +\item[Rregvalue] Enter new value into register Supported registers: + X,Y,U,S,A,B,D (direct page),P (program counter),C (condition code). +\end{description} +The R command uses the saved register values (on the stack). There are some +restrictions on changing the S register. + +Examples: +\begin{verbatim} +R +\end{verbatim} +Display all registers. +\begin{verbatim} +RB03 +RP4444 +\end{verbatim} +Load the B register with \$03 and the program counter with \$4444. + +\item[T] Single step trace. + +\item[I] Show the contents of one address. + +Syntax: +\begin{description} +\item[Iaddr] Display the contents of the given address. (used to read input + port) +\end{description} + +Example: +\begin{verbatim} + IE001 +\end{verbatim} +Show the ACIA status. +\end{description} + +\subsection{S-Records Related Commands.} + +\begin{description} +\item[S1bytes] Enter Motorola S records. +\item[S9bytes] Last S record in series. + +S records are usually entered from a file, either ASCII transfer (S command +from the v09 prompt) or X-MODEM transfer (XX command in monitor, U command +from v09 prompt). Most Motorola cross assemblers generate S records. + +\item[SSaddr,len] Dump memory region as Motorola S records. + +These S records can be loaded later by the monitor program. + +Usually you capture the S records into a file (use L command at v09 prompt) +or use XSS instead. +The XSS command is the same as SS, except that it outputs the S records +through the X-modem protocol (use D command at v09 prompt). + +\item[SOaddr] Set origin address for S-record transfer. + +Before entering S records, it sets the first memory address where S records +will be loaded, regardless of the address contained in the S records. + +Before the SS command, it sets the first address that will go into the S +records. + +Examples. +\begin{verbatim} +SO800 +S1130400etc... +\end{verbatim} +Load the S records at address \$800 even though the address in the S records +is \$400 +\begin{verbatim} +SO8000 +SS400,100 +\end{verbatim} +Save the memory region of 256 bytes starting at \$400 as S records. The S +records contain addresses starting at \$8000. +\end{description} + +\subsection{X-Modem Related Commands.} + +\begin{description} +\item[XLaddr] Load binary data using X-modem protocol + +Example: +\begin{verbatim} +XL400 +\end{verbatim} +Type your escape character and at the v09 prompt type +\begin{verbatim} +ubasic +\end{verbatim} +to load the binary file "basic" at address \$400. + +\item[XSaddr,len] Save binary data using X-modem protocol. + +Example: +\begin{verbatim} +XS400,100 +\end{verbatim} +to save the memory region of 128 bytes starting at \$400 +Type your escape character and at the v09 prompt type: +\begin{verbatim} +dfoo +\end{verbatim} +Now the bytes are saved into the file "foo". + +\item[XSSaddr,len] Save memory region as S records through X-modem protocol. + +See SS command for more details. + +\item[XX] Execute commands received through X-modem protocol + This is usually used to receive S-records. + +Example: +\begin{verbatim} +XX +\end{verbatim} +Now press the escape character and at the v09 prompt type +\begin{verbatim} +usfile +\end{verbatim} +where {\tt sfile} is a file with S-records. + +\item[XOnl,eof] Set X-modem text output options, first number type of newline. + 1=LF, 2=CR, 3=CRLF, second number filler byte at end of file + (sensible options include 0,4,1A) These options are used by + the XSS command. + +Example: Under a UNIX system you want X-modem's text output with just LF + and a filler byte of 0. Type: +\begin{verbatim} +XO1,0 +\end{verbatim} +\end{description} + +\section{Memory Map} + +\section{Operating System Facilities} + +\begin{description} +\item[getchar] address \$00. +\item[putchar] address \$03. +\item[getline] address \$06. +\item[putline] address \$09. +\item[putcr] address \$0C. +\item[getpoll] address \$0F. +\item[xopenin] address \$12. +\item[xopenout] address \$15. +\item[xabortin] address \$18. +\item[xclosein] address \$1B. +\item[xcloseout] address \$1E. +\item[delay] address \$21. On input the D register contains the number of +timer ticks to wait. Each timer tick is 20ms. +\end{description} + +\section{Extending the built-in Assembler} + +\chapter{The Forth Language.} + +\begin{verbatim} +kernel09 and the *.4 files. FORTH for the 6809. To run it, type + XX + + Then press the escape char and at the v09 prompt type + + ukernel09 + + Then type + + G400 + + From FORTH type + + XLOAD + + Then press your escape char and at the v09 prompt type + + uextend09.4 + + From FORTH type + + XLOAD + + Then press your escape char and at the v09 prompt type + + utetris.4 + + From FORTH type + + TT + + And play tetris under FORTH on the 6809! +\end{verbatim} + +\chapter{The BASIC Interpreter.} + +\chapter{History of the Project.} + +\section{Introduction.} + +Of all the 8-bit home computers only a few had the Motorola 6809 CPU, the +most famous of which was the Tandy Color Computer. Then there was its clone +(from Wales) the Dragon and there was an old obscure SuperPet that I have +never seen. The 6809 was the 8-bit processor finally done right, but it came +a bit too late to have a real influence on the market. + +The book that raised my enthousiasm for the Motorola 6809 processor was: +Lance A. Leventhal, ``6809 Assembly Language Programming", 1981 +Osborne/McGrawhill. ISBN 0-07-931035-4. I borrowed it several times from the +university library and finally I bought my own copy. + +The first sentence on the back of that book reads: +\begin{quote} +While everyone's been talking about new 16-bit microprocessors, the 6809 has +emerged as {\em the} important new device. +\end{quote} + +Though it was not the processor that changed the world, it certainly was the +processor that changed my idea of what a good instruction set should look +like. Before that I thought that the Z80 was superior to everything else on +the planet, at least superior to every other 8-bit processor. + +It was in April 1987. I borrowed the book for the first time and I had just +written a Forth interpreter for my Z80 machine. It struck me that the +following 7-instruction sequence on a Z80 +\begin{verbatim} +EX DE,HL +LD E,(HL) +INC HL +LD D,(HL) +INC HL +EX DE,HL +JMP (HL) +\end{verbatim} + +could be replaced by just {\em one} instruction on the 6809. +\begin{verbatim} +JMP [,Y++] +\end{verbatim} + +BTW the above instructions are the heart of a Forth interpreter and making +them more efficient has a tremendous effect on efficiency. + +\section{The 6809 Emulator in Forth.} + +The years went by and I had bought an XT compatible computer in 1988. I +didn't buy a 6809 system though I could have done so. But it would either be +too expensive or I would have to build it myself (I wasn't too handy with +soldering) or it would be a primitive machine like the Tandy Color Computer +without expansions and I didn't like to use cassettes and a 32-column +display. + +In 1989 I saw a 6502 simulator at a meeting of our Forth club. One could +interactively enter hex codes, page through memory, modify registers, trace +intructions etc. I just got to have this, but for a 6809 instead. + +Around Christmas of that year I wrote a 6809 Forth assembler and an +interactive simulator, like the one I had seen on the club meeting. +Everything was written in F-PC, a very comprehensive Forth system for the +PC. + +\begin{figure} +\begin{verbatim} + 0 1 2 3 4 5 6 7 8 9 A B C D E F 0123456789ABCDEF +0000 10 8E 00 40 E6 A0 D7 80 8E 00 81 3A 5D 27 07 A6 ...@f W ...:]'.& +0010 A0 A7 82 5A 26 F9 7E FF FF 00 00 00 00 00 00 00 '.Z&y~ ....... +0020 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0030 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0040 05 46 4F 52 54 48 00 00 00 00 00 00 00 00 00 00 .FORTH.......... +0050 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0060 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0070 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0080 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0090 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00A0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00B0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00C0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00D0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00E0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00F0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +CC=00000000 A=$00 B=$00 DP=$00 X=$0000 Y=$0000 U=$0000 S=$0000 + EFHINZVC PC=$0000 LDY # $0040 +\end{verbatim} +\caption{Screen snapshot of the Forth-based 6809 simulator.} +\end{figure} + +I even made a start with writing an implementation of Forth for it, but the +obvious lack of speed (among other things) witheld me from finishing it. +I had a fairly complete set of assembly routines though. +The estimated speed was around one thousand instructions per second, good +for an equivalent processor speed of around 4kHz. + +In May 1992 I changed my trusted 8MHz Turbo XT for a blistering fast 25MHz +80386 and it could run the simulator more than 5 times as fast. But then I +wasn't really working on it. In the summer of 1992 I changed to Linux, which +I have been using ever since. + +Around the summer of 1993 I was working with pfe, a brand new Forth system +for Unix written by Dirk Zoller. It had reached such state of completeness +and usability that porting the 6809 simulator to it would be feasible. +I ported it and by doing so I regained interest in the 6809 processor. +PFE is written in C instead of assembler and at least on the 80386 it is +considerably slower than a Forth written in Assembler, like FPC. My +simulated processor speed was around 5kHz, nothing to write home +about. It was faster than on the XT, but not much. + +\section{The Assembler and Simulator in C.} + +The switch from Forth to C was caused by the fact that I wanted a +traditional 6809 assembler, instead of the 'Forth' assembler, in which the +syntax is slightly tweaked to make the thing easy to implement in Forth and +easy to use within Forth. In the fall of 1993 I wrote a traditional two pass +assembler in a few days. It worked more or less, but only recently it has +become bug-free in that it assembles all the instructions and all the +addressing modes (even PC relative) without error. + +Now that I had a real assembler, I could write real 6809 assembly programs, +such as a BASIC interpreter (maybe kidding) or a monitor program or god +knows what. If I would ever run real code on that 6809 simulator, I had to +increase its speed considerably. So I wrote a very straightforward +6809 simulator in C using tables of function pointers. It did really well in +terms of speed, I could reach an equivalent processor clock speed of around +200kHz. The C simulator didn't have any fancy display, memory edit or single +step functions. Its only I/O was through the SWI2 instruction for character +output and SWI3 for character input, something I had added to the +Forth-based simulator quite some time ago. + +One afternoon in optimized hack mode brought me a crude port of E-Forth, a +tiny and very slow (most was interpreted, very few assembler words) +implementation of Forth. The original was written in MASM for the 8086 and +other ports (like the 8051) wre already around. That was the first time I +had Forth on an emulated 6809. BTW this Forth would also run, or should I +say crawl, on the Forth-based simulator. + +I released the assembler, simulator and EForth on {\tt alt.sources} in November +1993. + +Of course I also wrote some test and toy programs (what about a program to +convert binary numbers to decimal using that oddball DAA instruction?). + +In the spring of 1994 I picked up that old TINY BASIC interpreter written by +John Byrns. And tiny it was. Not even arrays were supported. I ported it to +my simulator and found some bugs, both in my simulator and in TINY BASIC +itself. + +I made some improvements to the 6809 simulator. Now I could send ASCII files +to it and log the output to another ASCII file. That way I could 'load' and +'save' BASIC programs for one thing. Further I had a trace facility to write +a trace of all the instructions in a certain address range to a file. Last I +cleaned up the I/O and signal handling somewhat, making it portable across +several Unix versions. + +That version of the software, along with some example programs, was also +released on {\tt alt.sources}. The assembler implemented includes and conditional +assembly in that version. + +\section{The Virtual SBC.} + +That blistering fast 80386 that I bought back in 1992 has become slow as +molasses. It has actually become slower since the memory upgrade with +slow memory (it was cheap) that necessitated an extra wait state. +Fortunately I recently pruchased a Pentium. + +At the moment I actually have plans to build (or have somebody build for me) +a single board computer containing a 6809. I would like to have 32k RAM plus +32k EPROM. I definitely like to have a monitor program with the features I +want. Hence another project was born, the virtual SBC that I could prototype +my monitor ROM and some other software on. + +The virtual SBC emulates a single board computer that communicates with a PC +through an ACIA. On that PC there runs a simple terminal program that +supports XMODEM file transfer. Things I recently did. + +\begin{itemize} +\item I rewrote the 6809 emulator engine with giant switch statements to hammer + out all unnecessary procedure calls and to gain some speed by enabling the + compiler to use register variables where appropriate. On my 386 the + speed increase was disappointing. The equivalent processor speed is now + 250kHz, up from about 170kHz (remember that extra wait state?). On a HPUX + workstation, I got a factor of 2 speed increase. That sucker runs at an + emulated processor speed of about 3.5MHz. A Pentium-90 is even faster, + more than any real 6809 can (officially) run. +\item I added XMODEM upload/download features to the 'terminal front end' of the + simulator. On the other end of the 'serial link' a 6809 machine code + program runs the other end of the XMODEM file transfer protocol. +\item I changed the SWI2/SWI3 hack to real ACIA emulation at a port address. +\item I write-protected the ROM area. +\item I added a 20ms timer interrupt. +\item I wrote a monitor program for the virtual SBC that has to followin + features. + \begin{itemize} + \item Simple (vectorized) operating system functions, like character I/O + line I/O, XMODEM transfer. Usable by application programs. + \item a hex/ascii dump command. + \item a hex/ascii enter command. + \item a hex/ascii memory search command. + \item memory move command. + \item S-record send and receive capabilities (directly in ASCII or + through XMODEM). + \item Binary load and save of memory region through XMODEM + \item register display and modify. + \item go to address (or current program counter) and call subroutine commands. + \item breakpoints. + \item program step tracing (breakpoint after next instruction), DEBUG P + command + \item single step tracing (based on timer interrupt). I had to cheat with the + emulator to implement this. + \item one-pass (no labels) disassembler (DEBUG U command). + \item line-by-line assembler (DEBUG A command) I wrote + this one such that an additional real assembler can use most of the guts of + it. + \end{itemize} +\end{itemize} + +Finally I wrote a real 6809 Forth, based on some other Forth I wrote for an +imaginary stack machine. Those old dusty primitives that I had written back in +1990 proved very useful now. This Forth can load programs through XMODEM +too. It can recompile (metacompile) itself and, very importantly, it runs +tetris! (crawls on the 386) This is the tetris implementation written in +ANSI Forth by Dirk Zoller and it is used as a test program. +Next I have to make this Forth ROM-able. + +What else will go into that 32k ROM area? The monitor will be around 7k, 1k +is reserved for the I/O space. Forth (with its own Forth assembler) will +take about 12k, 8k without. A few additional k could be used for a 'real' +assemler, but I doubt I will ever use that. A cross assembler is much more +convenient. BASIC no doubt. But I'm afraid I'll have to write it myself, +more so as I want to have {\em source code} of all my 6809 stuff. I already have +the floating point routines for it. + +\end{document} diff -r 4fa2bdb0c457 -r 2088fd998865 doc/origin/sbc09fig.tex --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/origin/sbc09fig.tex Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,26 @@ +\setlength{\unitlength}{0.009in}% +\begin{picture}(510,355)(125,400) +\thicklines +\put(370,665){\framebox(170,90){}} +\put(370,535){\framebox(170,90){}} +\put(370,400){\framebox(170,90){}} +\put(125,535){\framebox(170,90){}} +\put(295,585){\line( 1, 0){ 75}} +\put(320,585){\makebox(0.4444,0.6667){\SetFigFont{10}{12}{rm}.}} +\put(325,585){\line( 0, 1){140}} +\put(325,725){\line( 1, 0){ 45}} +\put(325,585){\line( 0,-1){135}} +\put(325,450){\line( 1, 0){ 45}} +\put(155,440){\framebox(100,50){}} +\put(210,490){\vector( 0, 1){ 45}} +\put(195,690){\vector( 0,-1){ 65}} +\put(635,445){\vector(-1, 0){ 95}} +\put(415,570){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}32K RAM}}} +\put(415,440){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}6850 ACIA}}} +\put(180,570){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}6809 CPU}}} +\put(420,705){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}32K ROM}}} +\put(190,460){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}TIMER}}} +\put(175,700){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}RESET}}} +\put(220,505){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}FIRQ}}} +\put(605,460){\makebox(0,0)[lb]{\smash{\SetFigFont{12}{14.4}{rm}RS232}}} +\end{picture} diff -r 4fa2bdb0c457 -r 2088fd998865 doc/sbc09.creole --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/sbc09.creole Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,985 @@ + += SBC09, an Emulator for a 6809-Based Single Board Compuer. = + +author: **L.C. Benschop** + +This file is the content of **sbc09.tex** converted 2013 by Jens Diemer into +this creole markup. + + Revisions: + 2014-06-26 Jens Diemer + Merge some text parts from the origin README textfile + + +== Introduction == + + +The {{{sbc09}}} package contains an emulator of a 6809-based single board +computer that runs under UNIX. It contains all the programs needed to work +with the emulator, such as the emulator itself, an assembler, a monitor +program, a BASIC interpreter, a Forth interpreter, several example programs +and several tools needed to build the programs. The program should work +under most more-or-less POSIX-compliant versions of UNIX and they were +developed under Linux. Of course I believe that the programs that currently +run on the emulator would also run on a real 6809 machine. + + +=== A Bit of Background on SBCs. === + + +In the seventies you could buy single board microcomputers that had a +hexadecimal keypad and 7-segment displays. These computers typically had +less than 1 kilobyte of RAM and a simple monitor program in ROM. An +interface to a cassette recorder (or paper tape reader/writer) and a +terminal was possible, but not standard. The typical way to program the +machine was entering hexadecimal machine codes on the keypad. Machine code +was the only language in which you could program them, especially if you +only had a hexadecimal keypad and 7-segment led displays. You typically used +these machines to experiment with hardware interfacing, as games and +calculations were a bit limited with only six 7-segment digits. + +Next came simple home computers, like the TRS80, the Apple ][ and the +Commodore PET. These machines had BASIC in ROM and they used a simple +cassette recorder to store data. These computers had a TV or a low quality +monitor as display and a QWERTY keyboard. These machines could be upgraded +with a floppy disk drive and a printer and then they could be used for +professional work. These machines had 4 to 64 kilobytes of memory. +Apart from assembly language you could use BASIC, Forth +and sometimes Pascal to program these machines. Most useful programs (and +the best games) were programmed in assembly language. Many of these machines +had BASIC in ROM and no machine code monitor. You had to load that +separately. + +Today we have personal computers that run DOS, Windows, UNIX or something +else. New computers have 4 to 16 megabytes of RAM and hard disks of more +than 500 Megabytes. Apart from having in the order of 1000 times more +storage, they are also 1000 times faster than the old 8-bit home computers. +Programming? You can use Visual BASIC, C++ and about +every other programming language on the planet. But programs have become +bigger and bigger. Programming is not the same as it was before. + +I guess there is some demand for small 8-bit computer systems that are simple +to build, easy to interface to all kinds of hobby projects, fun to program +and small enough to integrate into a home-built project. +Do we want to use hexadecimal keyboards and 7-segment displays? I guess not +many people want to use them. Do we want to use a cassette recorder for data +storage and a TV as a display? Not me. And if you build your own 8-bit +microprocessor, do you want to waste your time and money on a hexadecimal +keypad or a cassette interface that you do not like to use and that you do +not need anyway? PCs of five years ago are more than adequate to run an +editor, a terminal program and a cross assembler for your favourite 8-bit +processor. The terminal program can then be used to send the programs to the +8-bit micro. +If you equip an 8-bit system with some static CMOS RAM, a serial +interface and a monitor in ROM, you can use the keyboard, hard disk and +monitor of your PC for program development and the 8-bit micro can be +disconnected from the PC and do its task, once it is programmed. + +Cross development is nothing special. How do you think the microprocessor in +you microwave was programmed? But it is not practical for a hobbyist to +program an EPROM for each program change. Professional developers of +embedded processors have expensive tools, like ROM emulators, processor +emulators etc. to see what the processor is doing on its way to the next +crash. For a hobbyist it is much more practical to have a slightly more +expensive embedded computer that you can run an interactive debugger on. +And you are not even limited to assembly language. If you have 32k ROM you +can have both the monitor program and a BASIC interpreter and some +application code in ROM. Nothing prevents you from having Forth as well. + + +=== The Emulated System. === + +{{{ + RESET + | /---- 32K ROM + | | + v | + 6809 CPU --|---- 32K RAM + ^ | + | FIRQ | + | \---- 6850 ACIA <--- RS232 + TIMER +}}} +Block Diagram of SBC. + +The program {{{sbc09}}} emulates the above mentioned single board computer +{{{plus}}} the terminal program that communicates with it. + + +== Building the Programs. == + + + +== The 6809 Assembler a09. == + + +The assembler is a09. Run it with +{{{ +a09 [-l listing] [-o object|-s object] source +}}} + +Source is a mandatory argument. The -l listing and {{{-o}}} or {{{-s}}} +object arguments are +optional. By default there is no listing and the object file is the +sourcefile name without an extension and if the source file name has no +extension it is the source file name with {{{.b}}} extension. + +A09 recognises standard 6809 mnemonics. Labels should start in the first +column and may or may not be terminated by a colon. Every line starting with +a non-alphanumeric is taken to be a comment line. Everything after the +operand field is taken to be comment. There is a full expression evaluator +with C-style operators (and Motorola style number bases). + +There are the usual pseudo-ops such as ORG EQU SET SETDP RMB FCB FDB FCC etc. +Strings within double quotes may be mixed with numbers on FCB lines. There +is conditional assembly with IF/ELSE/ENDIF and there is INCLUDE. The +assembler is case-insensitive. + +The object file is either a binary image file (-o) or Motorola S-records (-s). +In the former case it contains a binary image of the assembled data starting +at the first address where something is assembled. In the following case +{{{ +ORG 0 +VAR1 RMB 2 +VAR2 RMB 2 + +ORG $100 +START LDS #$400 +... +}}} + +the RMB statements generate no data so the object file contains the memory +image from address $100. + +The list file contains no pretty lay-out and no pagination. It is assumed +that utilities (Unix pr or enscript) are available for that. + +There are no macros and no linkable modules yet. Some provisions are taken +for it in the code. + +After the assembler has finished, it prints the number of pass 2 errors. +This should be zero. So if you see +{{{ +0 Pass 2 Errors. +}}} +then you are lucky. + + +== The Virtual SBC v09. == + + +The simulator is v09. Run it with +{{{ +v09 [-t tracefile [-tl tracelo] [-th tracehi]] [-e escchar] +}}} + +{{{tracelo}}} and {{{tracehi}}} are addresses. They can be entered in +decimal, octal or hex using the C conventions for number input. + +If a tracefile is specified, all instructions at addresses between +{{{tracelo}}} and {{{tracehi}}} are traced. Tracing information such as program +location, register contents and opcodes are written to the trace file. + +{{{escchar}}} is the escape character. It must be entered as a number. This is +the character that you must type to get the v09 prompt. This is control-] +by default. (0x1d) + +The program loads its ROM image from the file {{{v09.rom}}}, which is a 32 +kilobyte binary file. This file should have been generated by the {{{Makefile}}}. +The program starts executing at the address found at $FFFE in +the ROM, just like a real 6809 would do on reset. + +The address map is as follows: +| **$0000--$7FFF** | RAM. +| **$8000--$FFFF** | ROM (except the I/O addresses). These addresses are write-protected. +| **$E000--$E0FF** | I/O addresses. Currently only one ACIA is mapped. + +At addresses $E000 and $E001 there is an emulated serial port (ACIA). All +bytes sent to it (or read from it) are send to (read from) the terminal and +sometimes to/from a file. +Terminal I/O is in raw mode. + +If you press the escape char, you get the v09 prompt. At the prompt you +can enter the following things: + +**X** +to exit the simulator. + +**R** +to reset the emulated 6809 (very useful). + +**L**//filename// +(no space in between) to log terminal output to a file. +Control chars and cr are filtered to make the output a normal +text file. L without a file name stops logging. + +**S**//filename// +to send a specified file to the simulator through its terminal +input. LF is converted to CR to mimic raw terminal input. + +**U**//filename// +(terminal upload command) to send a file to the 6809 using the +X-modem protocol. The 6809 must already run an X-modem receiving +program. + +**D**//filename// +(terminal download command) to receive a file from the 6809 using +the X-modem protocol. The 6809 must already run an X-modem +sending program. + +All of these commands, except the R command, can be seen as commands of the +communication program that is used to access the single board computer. +The R command is a subsitute for pushing the RESET button on the emulated +computer. + + +== Machine Language Monitor. == + + +The program {{{monitor.asm}}} is a program that is intended to be included +in the ROM of a 6809 based single board computer. The program allows a user +to communicate with the single board computer through a serial port. It +allows a user to enter machine code, examine memory and registers, to set +breakpoints, to trace a program and more. Furthermore, data can be sent to +and be received from the single board computer through the X-MODEM protocol. + + +==== Getting Started. ==== + + +If you start v09 with the standard ROM, then you will run the monitor +program. +If all goes well you see something like +{{{ +Welcome to BUGGY 1.0 +}}} +and you can type text. Excellent, you are now running 6809 code. + +The following example programs you can run from the 6809 monitor. +All of them start at address $400. For example to run the program bin2dec +you type. + +{{{ +XL400 +}}} + +Then press your escape character (default is control-] ). + +Then at the v09 prompt type + +{{{ +ubin2dec +}}} + +Now you see some lines displaying the progress of the X-modem session. +If that is finished, you type + +{{{ +G400 +}}} + +Now it runs and exits to the monitor with SWI, so that the registers are +displayed. + +** cond09.asm ** + +** cond09.inc ** +Nonsense program to show conditional assembly and the like. + +** bench09.asm ** +Benchmark program. Executes tight loop. Takes 83 secs on +25 MHz 386. Should take about 8 sec. on 1MHz real 6809. :-( + +** test09.asm ** +Tests some nasty features of the 6809. Prints a few lines +of PASSED nn and should never print ERROR nn. + +** bin2dec.asm ** +Unusual way to convert numbers to decimal using DAA instruction. +Prints some test numbers. + +** basic.asm ** +Tiny BASIC by John Byrns. Docs are in basic.doc. +To test it start the monitor and run basic. + +Then press your escape char. +At the v09 prompt type: sexampl.bas + +Now a BASIC program is input. +Type RUN to run it. + +Leave BASIC by pressing the escape char and entering x at the +prompt. + + + +=== Use of the monitor commands === + + + + +==== Single Letter Commands ==== + + +===== D - Dump memory ===== + +Syntax: + +** Daddr,len ** Hex/ascii dump of memory region. +** Daddr ** length=64 bytes by default. +** D ** address is address after previous dump by default. + +Examples: +{{{ +DE400,100 +}}} +Dump 256 bytes starting at $E400 +{{{ +D +}}} +Dump the next 64 bytes. + + +===== E - Enter data into memory ===== + +** Eaddr bytes ** +Enter hexadecimal bytes at address. +** Eaddr"ascii" ** +Enter ascii at address. +** Eaddr ** +Enter interactively at address (until empty line). + +Examples: +{{{ +E0400 86449D033F +}}} +Enter the bytes 86 44 9D 03 3F at address $400. +{{{ +E5000"Welcome" +}}} +Enter the ASCII codes of "Welcome" at address $400. + + +===== F - Find string in memory ===== + +Syntax: +** Faddr bytes ** +Find byte string string from address. +** Faddr"ascii" ** +Find ASCII string. + +Find the specified string in memory, starting at the specified address. The +I/O addresses $E000-$E0FF are skipped. The addresses of the first 16 +occurrences are shown. + +Example: +{{{ +FE400"SEX" +}}} +Search for the word "SEX" starting in the monitor. + + +===== M - Move memory region ===== + +** Maddr1,addr2,len ** +Move region of memory from addr1 to addr2. If addr2 is +1 higher than addr1, a region is filled. + +Example: +{{{ +M400,500,80 +}}} +Move 128 bytes from address $400 to $500. + + +===== A - Assemble instructions ===== + +Syntax: +** Aaddr ** +Enter line-by-line assembler. + +You are in the assembler until you make an error or until you enter an empty +line. + +Example: +{{{ +A400 +LDB #$4B +JSR $03 +SWI + +}}} + + +===== U - Disassemble instructions ===== + +Syntax: +** Uaddr,len ** +Disassemble memory region. +** Uaddr ** +(disassemble 21 bytes) +** U ** + + +Examples: +{{{ +UE400,20 +}}} +Diassemble first 32 bytes of monitor program. +{{{ +U +}}} +Disassemble next 21 bytes. + + +===== B - Set, clear and show breakpoints ===== + +Syntax: +** Baddr ** +Set/reset breakpoint at address. +** B ** +Display active breakpoints. +Four breakpoints can be active simultaneously. + +Examples: +{{{ +B403 +B408 +}}} +Set the breakpoints at the addresses $403 and $408. +{{{ +B +}}} +Show the breakpoints. +{{{ +B403 +}}} +Remove the breakpoint at $403. + +===== J - Call a subroutine / G - Go to specified address ===== + +Syntax: +** Jaddr ** +JSR to specified address. +** Gaddr ** +Go to specified address. +** G ** +Go to address in PC register. +The registers are loaded from where they are saved (on the stack) and at the +breakpoints SWI instructions are entered. Next the code is executed at the +indicated address. The SWI instruction (or RTS for the J command) returns to +the monitor, saving the registers. + + +===== H - Calculate HEX expression ===== + +Syntax: + +** Hhexnum{(+|-)hexnum} ** +Calculate simple expression in hex with + and - + +Examples: +{{{ +H4444+A5 +H4444-44F3 +}}} + +===== P - Put a temporary breakpoint after current instruction and execute it, + +P is similar to T, because it usually executes one instruction and returns +to the monitor after it. That does not work for jumps though. Normally you +use P only with JSR instructions if you want to execute the whole subroutine +without single-stepping through it. + + +===== R - Display or modify registers ===== + +Syntax: +** R ** +Register display. +** Rregvalue ** +Enter new value into register Supported registers: +X,Y,U,S,A,B,D (direct page),P (program counter),C (condition code). +The R command uses the saved register values (on the stack). There are some +restrictions on changing the S register. + +Examples: +{{{ +R +}}} +Display all registers. +{{{ +RB03 +RP4444 +}}} +Load the B register with $03 and the program counter with $4444. + + +===== T - Single step trace ===== + +===== I - Show the contents of one address ===== + +Syntax: +** Iaddr ** +Display the contents of the given address. (used to read input +port) + +Example: +{{{ +IE001 +}}} +Show the ACIA status. + + +==== S-Records Related Commands. ==== + + +** S1bytes ** +Enter Motorola S records. +** S9bytes ** +Last S record in series. + +S records are usually entered from a file, either ASCII transfer (S command +from the v09 prompt) or X-MODEM transfer (XX command in monitor, U command +from v09 prompt). Most Motorola cross assemblers generate S records. + +** SSaddr,len ** +Dump memory region as Motorola S records. + +These S records can be loaded later by the monitor program. + +Usually you capture the S records into a file (use L command at v09 prompt) +or use XSS instead. +The XSS command is the same as SS, except that it outputs the S records +through the X-modem protocol (use D command at v09 prompt). + +** SOaddr ** +Set origin address for S-record transfer. + +Before entering S records, it sets the first memory address where S records +will be loaded, regardless of the address contained in the S records. + +Before the SS command, it sets the first address that will go into the S +records. + +Examples. +{{{ +SO800 +S1130400etc... +}}} +Load the S records at address $800 even though the address in the S records +is $400 +{{{ +SO8000 +SS400,100 +}}} +Save the memory region of 256 bytes starting at $400 as S records. The S +records contain addresses starting at $8000. + + +==== X-Modem Related Commands. ==== + + +** XLaddr ** +Load binary data using X-modem protocol + +Example: +{{{ +XL400 +}}} +Type your escape character and at the v09 prompt type +{{{ +ubasic +}}} +to load the binary file "basic" at address $400. + +** XSaddr,len ** +Save binary data using X-modem protocol. + +Example: +{{{ +XS400,100 +}}} +to save the memory region of 128 bytes starting at $400 +Type your escape character and at the v09 prompt type: +{{{ +dfoo +}}} +Now the bytes are saved into the file "foo". + +** XSSaddr,len ** +Save memory region as S records through X-modem protocol. + +See SS command for more details. + +** XX ** +Execute commands received through X-modem protocol +This is usually used to receive S-records. + +Example: +{{{ +XX +}}} +Now press the escape character and at the v09 prompt type +{{{ +usfile +}}} +where {{{sfile}}} is a file with S-records. + +** XOnl,eof ** +Set X-modem text output options, first number type of newline. +1=LF, 2=CR, 3=CRLF, second number filler byte at end of file +(sensible options include 0,4,1A) These options are used by +the XSS command. + +Example: Under a UNIX system you want X-modem's text output with just LF +and a filler byte of 0. Type: +{{{ +XO1,0 +}}} + + +=== Memory Map === + +Apart from the monitor commands, the monitor program contains I/O routines +that can be used by applications started from it. + +=== Operating System Facilities === + + +| **getchar** | address **$00** Input one character into B register. +| **putchar** | address **$03** Output one character in B register. +| **getline** | address **$06** Input line at address in X, length in B. +| **putline** | address **$09** Output string at address in X, length in B. +| **putcr** | address **$0C** Output a newline. +| **getpoll** | address **$0F** +| **xopenin** | address **$12** +| **xopenout** | address **$15** +| **xabortin** | address **$18** +| **xclosein** | address **$1B** +| **xcloseout** | address **$1E** +| **delay** | address **$21** On input the D register contains the number of timer ticks to wait. Each timer tick is 20ms + +There are other routines that redirect these I/O operations through the +X-modem protocol. + + + + +=== Extending the built-in Assembler === + +EXAMPLE PROGRAMS + +The following example programs you can run from the 6809 monitor. +All of them start at address $400. For example to run the program bin2dec +you type. + +XL400 + +Then press your escape character (default is control-] ). + +Then at the v09 prompt type + +ubin2dec + +Now you see some lines displaying the progress of the X-modem session. +If that is finished, you type + +G400 + +Now it runs and exits to the monitor with SWI, so that the registers are +displayed. + + +cond09.asm +cond09.inc Nonsense program to show conditional assembly and the like. + +bench09.asm Benchmark program. Executes tight loop. Takes 83 secs on + 25 MHz 386. Should take about 8 sec. on 1MHz real 6809. :-( + +test09.asm Tests some nasty features of the 6809. Prints a few lines + of PASSED nn and should never print ERROR nn. + +bin2dec.asm Unusual way to convert numbers to decimal using DAA instruction. + Prints some test numbers. + +mon2.asm is an alternative version of the monitor program. + +alt09.rom is a version of the ROM that contains the alternative monitor and +Forth. Forth is transferrred to RAM by a small loader. +To start Forth type G8000. To start it again, type G400. + + + +== The Forth Language. == + + +kernel09 and the *.4 files. FORTH for the 6809. To run it, type +**XX** + +Then press the escape char (default is control-] ) and at the v09 prompt type: + +**ukernel09** + +Then type + +**G400** + +From FORTH type + +**XLOAD** + +Then press your escape char and at the v09 prompt type + +**uextend09.4** + +From FORTH type + +**XLOAD** + +Then press your escape char and at the v09 prompt type + +**utetris.4** + +From FORTH type + +**TT** + +And play tetris under FORTH on the 6809! + + +== The BASIC Interpreter. == + +basic.asm Tiny BASIC by John Byrns. Docs are in basic.doc. + To test it start the monitor and run basic. + + Then press your escape char. + At the v09 prompt type: sexampl.bas + + Now a BASIC program is input. + Type RUN to run it. + + Leave BASIC by pressing the escape char and entering x at the + prompt. + + +== History of the Project. == + + + +=== Introduction. === + + +Of all the 8-bit home computers only a few had the Motorola 6809 CPU, the +most famous of which was the Tandy Color Computer. Then there was its clone +(from Wales) the Dragon and there was an old obscure SuperPet that I have +never seen. The 6809 was the 8-bit processor finally done right, but it came +a bit too late to have a real influence on the market. + +The book that raised my enthousiasm for the Motorola 6809 processor was: +Lance A. Leventhal, //6809 Assembly Language Programming//, 1981 +Osborne/McGrawhill. ISBN 0-07-931035-4. I borrowed it several times from the +university library and finally I bought my own copy. + +The first sentence on the back of that book reads: +While everyone's been talking about new 16-bit microprocessors, the 6809 has +emerged as {{{the}}} important new device. + +Though it was not the processor that changed the world, it certainly was the +processor that changed my idea of what a good instruction set should look +like. Before that I thought that the Z80 was superior to everything else on +the planet, at least superior to every other 8-bit processor. + +It was in April 1987. I borrowed the book for the first time and I had just +written a Forth interpreter for my Z80 machine. It struck me that the +following 7-instruction sequence on a Z80 +{{{ +EX DE,HL +LD E,(HL) +INC HL +LD D,(HL) +INC HL +EX DE,HL +JMP (HL) +}}} + +could be replaced by just {{{one}}} instruction on the 6809. +{{{ +JMP [,Y++] +}}} + +BTW the above instructions are the heart of a Forth interpreter and making +them more efficient has a tremendous effect on efficiency. + + +=== The 6809 Emulator in Forth. === + + +The years went by and I had bought an XT compatible computer in 1988. I +didn't buy a 6809 system though I could have done so. But it would either be +too expensive or I would have to build it myself (I wasn't too handy with +soldering) or it would be a primitive machine like the Tandy Color Computer +without expansions and I didn't like to use cassettes and a 32-column +display. + +In 1989 I saw a 6502 simulator at a meeting of our Forth club. One could +interactively enter hex codes, page through memory, modify registers, trace +intructions etc. I just got to have this, but for a 6809 instead. + +Around Christmas of that year I wrote a 6809 Forth assembler and an +interactive simulator, like the one I had seen on the club meeting. +Everything was written in F-PC, a very comprehensive Forth system for the +PC. + +{{{ +0 1 2 3 4 5 6 7 8 9 A B C D E F 0123456789ABCDEF +0000 10 8E 00 40 E6 A0 D7 80 8E 00 81 3A 5D 27 07 A6 ...@f W ...:]'.& +0010 A0 A7 82 5A 26 F9 7E FF FF 00 00 00 00 00 00 00 '.Z&y~ ....... +0020 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0030 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0040 05 46 4F 52 54 48 00 00 00 00 00 00 00 00 00 00 .FORTH.......... +0050 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0060 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0070 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0080 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +0090 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00A0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00B0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00C0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00D0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00E0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +00F0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ +CC=00000000 A=$00 B=$00 DP=$00 X=$0000 Y=$0000 U=$0000 S=$0000 +EFHINZVC PC=$0000 LDY # $0040 +}}} +Screen snapshot of the Forth-based 6809 simulator + +I even made a start with writing an implementation of Forth for it, but the +obvious lack of speed (among other things) witheld me from finishing it. +I had a fairly complete set of assembly routines though. +The estimated speed was around one thousand instructions per second, good +for an equivalent processor speed of around 4kHz. + +In May 1992 I changed my trusted 8MHz Turbo XT for a blistering fast 25MHz +80386 and it could run the simulator more than 5 times as fast. But then I +wasn't really working on it. In the summer of 1992 I changed to Linux, which +I have been using ever since. + +Around the summer of 1993 I was working with pfe, a brand new Forth system +for Unix written by Dirk Zoller. It had reached such state of completeness +and usability that porting the 6809 simulator to it would be feasible. +I ported it and by doing so I regained interest in the 6809 processor. +PFE is written in C instead of assembler and at least on the 80386 it is +considerably slower than a Forth written in Assembler, like FPC. My +simulated processor speed was around 5kHz, nothing to write home +about. It was faster than on the XT, but not much. + + +=== The Assembler and Simulator in C. === + + +The switch from Forth to C was caused by the fact that I wanted a +traditional 6809 assembler, instead of the 'Forth' assembler, in which the +syntax is slightly tweaked to make the thing easy to implement in Forth and +easy to use within Forth. In the fall of 1993 I wrote a traditional two pass +assembler in a few days. It worked more or less, but only recently it has +become bug-free in that it assembles all the instructions and all the +addressing modes (even PC relative) without error. + +Now that I had a real assembler, I could write real 6809 assembly programs, +such as a BASIC interpreter (maybe kidding) or a monitor program or god +knows what. If I would ever run real code on that 6809 simulator, I had to +increase its speed considerably. So I wrote a very straightforward +6809 simulator in C using tables of function pointers. It did really well in +terms of speed, I could reach an equivalent processor clock speed of around +200kHz. The C simulator didn't have any fancy display, memory edit or single +step functions. Its only I/O was through the SWI2 instruction for character +output and SWI3 for character input, something I had added to the +Forth-based simulator quite some time ago. + +One afternoon in optimized hack mode brought me a crude port of E-Forth, a +tiny and very slow (most was interpreted, very few assembler words) +implementation of Forth. The original was written in MASM for the 8086 and +other ports (like the 8051) wre already around. That was the first time I +had Forth on an emulated 6809. BTW this Forth would also run, or should I +say crawl, on the Forth-based simulator. + +I released the assembler, simulator and EForth on {{{alt.sources}}} in November +1993. + +Of course I also wrote some test and toy programs (what about a program to +convert binary numbers to decimal using that oddball DAA instruction?). + +In the spring of 1994 I picked up that old TINY BASIC interpreter written by +John Byrns. And tiny it was. Not even arrays were supported. I ported it to +my simulator and found some bugs, both in my simulator and in TINY BASIC +itself. + +I made some improvements to the 6809 simulator. Now I could send ASCII files +to it and log the output to another ASCII file. That way I could 'load' and +'save' BASIC programs for one thing. Further I had a trace facility to write +a trace of all the instructions in a certain address range to a file. Last I +cleaned up the I/O and signal handling somewhat, making it portable across +several Unix versions. + +That version of the software, along with some example programs, was also +released on {{{alt.sources}}}. The assembler implemented includes and conditional +assembly in that version. + + +=== The Virtual SBC. === + + +That blistering fast 80386 that I bought back in 1992 has become slow as +molasses. It has actually become slower since the memory upgrade with +slow memory (it was cheap) that necessitated an extra wait state. +Fortunately I recently pruchased a Pentium. + +At the moment I actually have plans to build (or have somebody build for me) +a single board computer containing a 6809. I would like to have 32k RAM plus +32k EPROM. I definitely like to have a monitor program with the features I +want. Hence another project was born, the virtual SBC that I could prototype +my monitor ROM and some other software on. + +The virtual SBC emulates a single board computer that communicates with a PC +through an ACIA. On that PC there runs a simple terminal program that +supports XMODEM file transfer. Things I recently did. + + +* I rewrote the 6809 emulator engine with giant switch statements to hammerout all unnecessary procedure calls and to gain some speed by enabling thecompiler to use register variables where appropriate. On my 386 thespeed increase was disappointing. The equivalent processor speed is now250kHz, up from about 170kHz (remember that extra wait state?). On a HPUXworkstation, I got a factor of 2 speed increase. That sucker runs at anemulated processor speed of about 3.5MHz. A Pentium-90 is even faster,more than any real 6809 can (officially) run. +* I added XMODEM upload/download features to the 'terminal front end' of thesimulator. On the other end of the 'serial link' a 6809 machine codeprogram runs the other end of the XMODEM file transfer protocol. +* I changed the SWI2/SWI3 hack to real ACIA emulation at a port address. +* I write-protected the ROM area. +* I added a 20ms timer interrupt. +* I wrote a monitor program for the virtual SBC that has to followinfeatures. +** Simple (vectorized) operating system functions, like character I/Oline I/O, XMODEM transfer. Usable by application programs. +** a hex/ascii dump command. +** a hex/ascii enter command. +** a hex/ascii memory search command. +** memory move command. +** S-record send and receive capabilities (directly in ASCII orthrough XMODEM). +** Binary load and save of memory region through XMODEM +** register display and modify. +** go to address (or current program counter) and call subroutine commands. +** breakpoints. +** program step tracing (breakpoint after next instruction), DEBUG Pcommand +** single step tracing (based on timer interrupt). I had to cheat with theemulator to implement this. +** one-pass (no labels) disassembler (DEBUG U command). +** line-by-line assembler (DEBUG A command) I wrotethis one such that an additional real assembler can use most of the guts ofit. + +Finally I wrote a real 6809 Forth, based on some other Forth I wrote for an +imaginary stack machine. Those old dusty primitives that I had written back in +1990 proved very useful now. This Forth can load programs through XMODEM +too. It can recompile (metacompile) itself and, very importantly, it runs +tetris! (crawls on the 386) This is the tetris implementation written in +ANSI Forth by Dirk Zoller and it is used as a test program. +Next I have to make this Forth ROM-able. + +What else will go into that 32k ROM area? The monitor will be around 7k, 1k +is reserved for the I/O space. Forth (with its own Forth assembler) will +take about 12k, 8k without. A few additional k could be used for a 'real' +assemler, but I doubt I will ever use that. A cross assembler is much more +convenient. BASIC no doubt. But I'm afraid I'll have to write it myself, +more so as I want to have {{{source code}}} of all my 6809 stuff. I already have +the floating point routines for it. + diff -r 4fa2bdb0c457 -r 2088fd998865 engine.c --- a/engine.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1259 +0,0 @@ -/* 6809 Simulator V09. - - created 1994,1995 by L.C. Benschop. - copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. - license: GNU General Public License version 2, see LICENSE for more details. - - This program simulates a 6809 processor. - - System dependencies: short must be 16 bits. - char must be 8 bits. - long must be more than 16 bits. - arrays up to 65536 bytes must be supported. - machine must be twos complement. - Most Unix machines will work. For MSODS you need long pointers - and you may have to malloc() the mem array of 65536 bytes. - - Special instructions: - SWI2 writes char to stdout from register B. - SWI3 reads char from stdout to register B, sets carry at EOF. - (or when no key available when using term control). - SWI retains its normal function. - CWAI and SYNC stop simulator. - Note: special instructions are gone for now. - - ACIA emulation at port $E000 - - Note: BIG_ENDIAN option is no longer needed. -*/ - -#include -#include - -#define engine -#include "v09.h" - -#define USLEEP 1000 -Byte aca,acb; -Byte *breg=&aca,*areg=&acb; -static int tracetrick=0; -extern long romstart; - -#ifndef USE_MMU - -static Byte mem1(Word adr) { - if ((adr&0xfe00)==(IOPAGE&0xfe00)) return do_input(adr&0x1ff); - return mem[adr]; -} - -static void SETBYTE1(Word a,Byte n) { - if ((a&0xfe00)==(IOPAGE&0xfe00)) do_output(a&0x1ff,n); - if(!(a>=romstart))mem[a]=n; -} -#define mem(a) mem1(a) -#define SETBYTE(a,n) SETBYTE1(a,n); - -#else - -int paddr(Word adr, Byte *immu) { - if ((adr&0xfe00)==(IOPAGE&0xfe00)) return memsize-0x10000+adr; - return (immu[ (adr) >> 13 ] <<13 ) + ((adr) & 0x1fff ); -} - -Byte * mem0(Byte *iphymem, Word adr, Byte *immu) { - return & iphymem[ paddr(adr,immu) ]; -} - -Byte mem1(Byte *iphymem, Word adr, Byte *immu) { - if ((adr&0xfe00)==(IOPAGE&0xfe00)) return do_input(adr&0x1ff); - Byte *p = mem0(iphymem, adr, immu); - if(!(p-phymem>=rommemsize)) { - return *p; - } else { - return 0xff; - } -} - -#define mem(a) mem1(iphymem,a,immu) - -Byte * SETBYTE1(Word a,Byte n, Byte *iphymem, Byte *immu) { - Word adr = a; - if ((adr&0xfe00)==(IOPAGE&0xfe00)) { - do_output(adr&0x1ff,n); - return mmu; - } else { - Byte *p = mem0(iphymem, adr,immu); - if(!(p-phymem>=romstart)) { - *p=n; - } - } - return immu; -} - -#define SETBYTE(a,n) immu=SETBYTE1(a,n,iphymem,immu); - -#endif - -#define GETWORD(a) (mem(a)<<8|mem((a)+1)) -#define SETWORD(a,n) {Word a1=a;SETBYTE(a1,n>>8);SETBYTE(a1+1,n);} - -/* Macros for load and store of accumulators. Can be modified to check - for port addresses */ -// #define LOADAC(reg) if((eaddr&0xff00)!=(IOPAGE&0xff00))reg=mem(eaddr);else\ -// reg=do_input(eaddr&0xff); -// #define STOREAC(reg) if((eaddr&0xff00)!=(IOPAGE&0xff00))SETBYTE(eaddr,reg)else\ -// do_output(eaddr&0xff,reg); - -/* Two bytes of a word are fetched separately because of - the possible wrap-around at address $ffff and alignment -*/ - -#define IMMBYTE(b) b=mem(ipcreg++); -#define IMMWORD(w) {w=GETWORD(ipcreg);ipcreg+=2;} - -#define PUSHBYTE(b) {--isreg;SETBYTE(isreg,b)} -#define PUSHWORD(w) {isreg-=2;SETWORD(isreg,w)} -#define PULLBYTE(b) b=mem(isreg++); -#define PULLWORD(w) {w=GETWORD(isreg);isreg+=2;} -#define PSHUBYTE(b) {--iureg;SETBYTE(iureg,b)} -#define PSHUWORD(w) {iureg-=2;SETWORD(iureg,w)} -#define PULUBYTE(b) b=mem(iureg++); -#define PULUWORD(w) {w=GETWORD(iureg);iureg+=2;} - -#define SIGNED(b) ((Word)(b&0x80?b|0xff00:b)) - -#define GETDREG ((iareg<<8)|ibreg) -#define SETDREG(n) {iareg=(n)>>8;ibreg=(n);} - -/* Macros for addressing modes (postbytes have their own code) */ -#define DIRECT {IMMBYTE(eaddr) eaddr|=(idpreg<<8);} -#define IMM8 {eaddr=ipcreg++;} -#define IMM16 {eaddr=ipcreg;ipcreg+=2;} -#define EXTENDED {IMMWORD(eaddr)} - -/* macros to set status flags */ -#define SEC iccreg|=0x01; -#define CLC iccreg&=0xfe; -#define SEZ iccreg|=0x04; -#define CLZ iccreg&=0xfb; -#define SEN iccreg|=0x08; -#define CLN iccreg&=0xf7; -#define SEV iccreg|=0x02; -#define CLV iccreg&=0xfd; -#define SEH iccreg|=0x20; -#define CLH iccreg&=0xdf; - -/* set N and Z flags depending on 8 or 16 bit result */ -#define SETNZ8(b) {if(b)CLZ else SEZ if(b&0x80)SEN else CLN} -#define SETNZ16(b) {if(b)CLZ else SEZ if(b&0x8000)SEN else CLN} - -#define SETSTATUS(a,b,res) if((a^b^res)&0x10) SEH else CLH \ - if((a^b^res^(res>>1))&0x80)SEV else CLV \ - if(res&0x100)SEC else CLC SETNZ8((Byte)res) - -#define SETSTATUSD(a,b,res) {if(res&0x10000) SEC else CLC \ - if(((res>>1)^a^b^res)&0x8000) SEV else CLV \ - SETNZ16((Word)res)} - -/* Macros for branch instructions */ -#define BRANCH(f) if(!iflag){IMMBYTE(tb) if(f)ipcreg+=SIGNED(tb);}\ - else{IMMWORD(tw) if(f)ipcreg+=tw;} -#define NXORV ((iccreg&0x08)^((iccreg&0x02)<<2)) - -/* MAcros for setting/getting registers in TFR/EXG instructions */ -#define GETREG(val,reg) switch(reg) {\ - case 0: val=GETDREG;break;\ - case 1: val=ixreg;break;\ - case 2: val=iyreg;break;\ - case 3: val=iureg;break;\ - case 4: val=isreg;break;\ - case 5: val=ipcreg;break;\ - case 8: val=iareg;break;\ - case 9: val=ibreg;break;\ - case 10: val=iccreg;break;\ - case 11: val=idpreg;break;} - -#define SETREG(val,reg) switch(reg) {\ - case 0: SETDREG(val) break;\ - case 1: ixreg=val;break;\ - case 2: iyreg=val;break;\ - case 3: iureg=val;break;\ - case 4: isreg=val;break;\ - case 5: ipcreg=val;break;\ - case 8: iareg=val;break;\ - case 9: ibreg=val;break;\ - case 10: iccreg=val;break;\ - case 11: idpreg=val;break;} - - -#define LOADAC(reg) reg=mem(eaddr); -#define STOREAC(reg) SETBYTE(eaddr,reg); - -#define LOADREGS ixreg=xreg;iyreg=yreg;\ - iureg=ureg;isreg=sreg;\ - ipcreg=pcreg;\ - iareg=*areg;ibreg=*breg;\ - idpreg=dpreg;iccreg=ccreg;immu=mmu; - -#define SAVEREGS xreg=ixreg;yreg=iyreg;\ - ureg=iureg;sreg=isreg;\ - pcreg=ipcreg;\ - *areg=iareg;*breg=ibreg;\ - dpreg=idpreg;ccreg=iccreg;mmu=immu; - - -unsigned char haspostbyte[] = { - /*0*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*1*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*2*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*3*/ 1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0, - /*4*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*5*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*6*/ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - /*7*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*8*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*9*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*A*/ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - /*B*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*C*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*D*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - /*E*/ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, - /*F*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - }; - -extern char *prog ; - -void interpr(void) -{ - Word ixreg,iyreg,iureg,isreg,ipcreg; - Byte idpreg,iccreg,iareg,ibreg; - /* Make local variables for the registers. On a real processor (non-Intel) - these could be implemented as fast registers. */ - Word eaddr; /* effective address */ - Byte ireg; /* instruction register */ - Byte iflag; /* flag to indicate $10 or $11 prebyte */ - Byte tb;Word tw; - Byte *immu = 0; -#ifdef USE_MMU - Byte *iphymem = (Byte *)phymem; -#endif - LOADREGS - for(;;){ - if(attention) { - if(tracing && ipcreg>=tracelo && ipcreg<=tracehi) { - SAVEREGS -#ifdef USE_MMU - Byte *phyadr = mem0(phymem,ipcreg,immu); - prog = (char *)(phyadr - ipcreg); -#endif - do_trace(tracefile); - } - if(irq) { - if(irq==1&&!(iccreg&0x10)) { /* standard IRQ */ - PUSHWORD(ipcreg) - PUSHWORD(iureg) - PUSHWORD(iyreg) - PUSHWORD(ixreg) - PUSHBYTE(idpreg) - PUSHBYTE(ibreg) - PUSHBYTE(iareg) - iccreg|=0x80; - PUSHBYTE(iccreg) - iccreg|=0x90; - ipcreg=GETWORD(0xfff8); - } - if(irq==2&&!(iccreg&0x40)) { /* Fast IRQ */ - PUSHWORD(ipcreg) - iccreg&=0x7f; - PUSHBYTE(iccreg) - iccreg|=0x50; - ipcreg=GETWORD(0xfff6); - } - if(!tracing)attention=0; - irq=0; - } - } - if(escape){ SAVEREGS do_escape(); LOADREGS } - iflag=0; - flaginstr: /* $10 and $11 instructions return here */ - ireg=mem(ipcreg++); - if(haspostbyte[ireg]) { - Byte postbyte=mem(ipcreg++); - switch(postbyte) { - case 0x00: eaddr=ixreg;break; - case 0x01: eaddr=ixreg+1;break; - case 0x02: eaddr=ixreg+2;break; - case 0x03: eaddr=ixreg+3;break; - case 0x04: eaddr=ixreg+4;break; - case 0x05: eaddr=ixreg+5;break; - case 0x06: eaddr=ixreg+6;break; - case 0x07: eaddr=ixreg+7;break; - case 0x08: eaddr=ixreg+8;break; - case 0x09: eaddr=ixreg+9;break; - case 0x0A: eaddr=ixreg+10;break; - case 0x0B: eaddr=ixreg+11;break; - case 0x0C: eaddr=ixreg+12;break; - case 0x0D: eaddr=ixreg+13;break; - case 0x0E: eaddr=ixreg+14;break; - case 0x0F: eaddr=ixreg+15;break; - case 0x10: eaddr=ixreg-16;break; - case 0x11: eaddr=ixreg-15;break; - case 0x12: eaddr=ixreg-14;break; - case 0x13: eaddr=ixreg-13;break; - case 0x14: eaddr=ixreg-12;break; - case 0x15: eaddr=ixreg-11;break; - case 0x16: eaddr=ixreg-10;break; - case 0x17: eaddr=ixreg-9;break; - case 0x18: eaddr=ixreg-8;break; - case 0x19: eaddr=ixreg-7;break; - case 0x1A: eaddr=ixreg-6;break; - case 0x1B: eaddr=ixreg-5;break; - case 0x1C: eaddr=ixreg-4;break; - case 0x1D: eaddr=ixreg-3;break; - case 0x1E: eaddr=ixreg-2;break; - case 0x1F: eaddr=ixreg-1;break; - case 0x20: eaddr=iyreg;break; - case 0x21: eaddr=iyreg+1;break; - case 0x22: eaddr=iyreg+2;break; - case 0x23: eaddr=iyreg+3;break; - case 0x24: eaddr=iyreg+4;break; - case 0x25: eaddr=iyreg+5;break; - case 0x26: eaddr=iyreg+6;break; - case 0x27: eaddr=iyreg+7;break; - case 0x28: eaddr=iyreg+8;break; - case 0x29: eaddr=iyreg+9;break; - case 0x2A: eaddr=iyreg+10;break; - case 0x2B: eaddr=iyreg+11;break; - case 0x2C: eaddr=iyreg+12;break; - case 0x2D: eaddr=iyreg+13;break; - case 0x2E: eaddr=iyreg+14;break; - case 0x2F: eaddr=iyreg+15;break; - case 0x30: eaddr=iyreg-16;break; - case 0x31: eaddr=iyreg-15;break; - case 0x32: eaddr=iyreg-14;break; - case 0x33: eaddr=iyreg-13;break; - case 0x34: eaddr=iyreg-12;break; - case 0x35: eaddr=iyreg-11;break; - case 0x36: eaddr=iyreg-10;break; - case 0x37: eaddr=iyreg-9;break; - case 0x38: eaddr=iyreg-8;break; - case 0x39: eaddr=iyreg-7;break; - case 0x3A: eaddr=iyreg-6;break; - case 0x3B: eaddr=iyreg-5;break; - case 0x3C: eaddr=iyreg-4;break; - case 0x3D: eaddr=iyreg-3;break; - case 0x3E: eaddr=iyreg-2;break; - case 0x3F: eaddr=iyreg-1;break; - case 0x40: eaddr=iureg;break; - case 0x41: eaddr=iureg+1;break; - case 0x42: eaddr=iureg+2;break; - case 0x43: eaddr=iureg+3;break; - case 0x44: eaddr=iureg+4;break; - case 0x45: eaddr=iureg+5;break; - case 0x46: eaddr=iureg+6;break; - case 0x47: eaddr=iureg+7;break; - case 0x48: eaddr=iureg+8;break; - case 0x49: eaddr=iureg+9;break; - case 0x4A: eaddr=iureg+10;break; - case 0x4B: eaddr=iureg+11;break; - case 0x4C: eaddr=iureg+12;break; - case 0x4D: eaddr=iureg+13;break; - case 0x4E: eaddr=iureg+14;break; - case 0x4F: eaddr=iureg+15;break; - case 0x50: eaddr=iureg-16;break; - case 0x51: eaddr=iureg-15;break; - case 0x52: eaddr=iureg-14;break; - case 0x53: eaddr=iureg-13;break; - case 0x54: eaddr=iureg-12;break; - case 0x55: eaddr=iureg-11;break; - case 0x56: eaddr=iureg-10;break; - case 0x57: eaddr=iureg-9;break; - case 0x58: eaddr=iureg-8;break; - case 0x59: eaddr=iureg-7;break; - case 0x5A: eaddr=iureg-6;break; - case 0x5B: eaddr=iureg-5;break; - case 0x5C: eaddr=iureg-4;break; - case 0x5D: eaddr=iureg-3;break; - case 0x5E: eaddr=iureg-2;break; - case 0x5F: eaddr=iureg-1;break; - case 0x60: eaddr=isreg;break; - case 0x61: eaddr=isreg+1;break; - case 0x62: eaddr=isreg+2;break; - case 0x63: eaddr=isreg+3;break; - case 0x64: eaddr=isreg+4;break; - case 0x65: eaddr=isreg+5;break; - case 0x66: eaddr=isreg+6;break; - case 0x67: eaddr=isreg+7;break; - case 0x68: eaddr=isreg+8;break; - case 0x69: eaddr=isreg+9;break; - case 0x6A: eaddr=isreg+10;break; - case 0x6B: eaddr=isreg+11;break; - case 0x6C: eaddr=isreg+12;break; - case 0x6D: eaddr=isreg+13;break; - case 0x6E: eaddr=isreg+14;break; - case 0x6F: eaddr=isreg+15;break; - case 0x70: eaddr=isreg-16;break; - case 0x71: eaddr=isreg-15;break; - case 0x72: eaddr=isreg-14;break; - case 0x73: eaddr=isreg-13;break; - case 0x74: eaddr=isreg-12;break; - case 0x75: eaddr=isreg-11;break; - case 0x76: eaddr=isreg-10;break; - case 0x77: eaddr=isreg-9;break; - case 0x78: eaddr=isreg-8;break; - case 0x79: eaddr=isreg-7;break; - case 0x7A: eaddr=isreg-6;break; - case 0x7B: eaddr=isreg-5;break; - case 0x7C: eaddr=isreg-4;break; - case 0x7D: eaddr=isreg-3;break; - case 0x7E: eaddr=isreg-2;break; - case 0x7F: eaddr=isreg-1;break; - case 0x80: eaddr=ixreg;ixreg++;break; - case 0x81: eaddr=ixreg;ixreg+=2;break; - case 0x82: ixreg--;eaddr=ixreg;break; - case 0x83: ixreg-=2;eaddr=ixreg;break; - case 0x84: eaddr=ixreg;break; - case 0x85: eaddr=ixreg+SIGNED(ibreg);break; - case 0x86: eaddr=ixreg+SIGNED(iareg);break; - case 0x87: eaddr=0;break; /*ILELGAL*/ - case 0x88: IMMBYTE(eaddr);eaddr=ixreg+SIGNED(eaddr);break; - case 0x89: IMMWORD(eaddr);eaddr+=ixreg;break; - case 0x8A: eaddr=0;break; /*ILLEGAL*/ - case 0x8B: eaddr=ixreg+GETDREG;break; - case 0x8C: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr);break; - case 0x8D: IMMWORD(eaddr);eaddr+=ipcreg;break; - case 0x8E: eaddr=0;break; /*ILLEGAL*/ - case 0x8F: IMMWORD(eaddr);break; - case 0x90: eaddr=ixreg;ixreg++;eaddr=GETWORD(eaddr);break; - case 0x91: eaddr=ixreg;ixreg+=2;eaddr=GETWORD(eaddr);break; - case 0x92: ixreg--;eaddr=ixreg;eaddr=GETWORD(eaddr);break; - case 0x93: ixreg-=2;eaddr=ixreg;eaddr=GETWORD(eaddr);break; - case 0x94: eaddr=ixreg;eaddr=GETWORD(eaddr);break; - case 0x95: eaddr=ixreg+SIGNED(ibreg);eaddr=GETWORD(eaddr);break; - case 0x96: eaddr=ixreg+SIGNED(iareg);eaddr=GETWORD(eaddr);break; - case 0x97: eaddr=0;break; /*ILELGAL*/ - case 0x98: IMMBYTE(eaddr);eaddr=ixreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0x99: IMMWORD(eaddr);eaddr+=ixreg;eaddr=GETWORD(eaddr);break; - case 0x9A: eaddr=0;break; /*ILLEGAL*/ - case 0x9B: eaddr=ixreg+GETDREG;eaddr=GETWORD(eaddr);break; - case 0x9C: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0x9D: IMMWORD(eaddr);eaddr+=ipcreg;eaddr=GETWORD(eaddr);break; - case 0x9E: eaddr=0;break; /*ILLEGAL*/ - case 0x9F: IMMWORD(eaddr);eaddr=GETWORD(eaddr);break; - case 0xA0: eaddr=iyreg;iyreg++;break; - case 0xA1: eaddr=iyreg;iyreg+=2;break; - case 0xA2: iyreg--;eaddr=iyreg;break; - case 0xA3: iyreg-=2;eaddr=iyreg;break; - case 0xA4: eaddr=iyreg;break; - case 0xA5: eaddr=iyreg+SIGNED(ibreg);break; - case 0xA6: eaddr=iyreg+SIGNED(iareg);break; - case 0xA7: eaddr=0;break; /*ILELGAL*/ - case 0xA8: IMMBYTE(eaddr);eaddr=iyreg+SIGNED(eaddr);break; - case 0xA9: IMMWORD(eaddr);eaddr+=iyreg;break; - case 0xAA: eaddr=0;break; /*ILLEGAL*/ - case 0xAB: eaddr=iyreg+GETDREG;break; - case 0xAC: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr);break; - case 0xAD: IMMWORD(eaddr);eaddr+=ipcreg;break; - case 0xAE: eaddr=0;break; /*ILLEGAL*/ - case 0xAF: IMMWORD(eaddr);break; - case 0xB0: eaddr=iyreg;iyreg++;eaddr=GETWORD(eaddr);break; - case 0xB1: eaddr=iyreg;iyreg+=2;eaddr=GETWORD(eaddr);break; - case 0xB2: iyreg--;eaddr=iyreg;eaddr=GETWORD(eaddr);break; - case 0xB3: iyreg-=2;eaddr=iyreg;eaddr=GETWORD(eaddr);break; - case 0xB4: eaddr=iyreg;eaddr=GETWORD(eaddr);break; - case 0xB5: eaddr=iyreg+SIGNED(ibreg);eaddr=GETWORD(eaddr);break; - case 0xB6: eaddr=iyreg+SIGNED(iareg);eaddr=GETWORD(eaddr);break; - case 0xB7: eaddr=0;break; /*ILELGAL*/ - case 0xB8: IMMBYTE(eaddr);eaddr=iyreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0xB9: IMMWORD(eaddr);eaddr+=iyreg;eaddr=GETWORD(eaddr);break; - case 0xBA: eaddr=0;break; /*ILLEGAL*/ - case 0xBB: eaddr=iyreg+GETDREG;eaddr=GETWORD(eaddr);break; - case 0xBC: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0xBD: IMMWORD(eaddr);eaddr+=ipcreg;eaddr=GETWORD(eaddr);break; - case 0xBE: eaddr=0;break; /*ILLEGAL*/ - case 0xBF: IMMWORD(eaddr);eaddr=GETWORD(eaddr);break; - case 0xC0: eaddr=iureg;iureg++;break; - case 0xC1: eaddr=iureg;iureg+=2;break; - case 0xC2: iureg--;eaddr=iureg;break; - case 0xC3: iureg-=2;eaddr=iureg;break; - case 0xC4: eaddr=iureg;break; - case 0xC5: eaddr=iureg+SIGNED(ibreg);break; - case 0xC6: eaddr=iureg+SIGNED(iareg);break; - case 0xC7: eaddr=0;break; /*ILELGAL*/ - case 0xC8: IMMBYTE(eaddr);eaddr=iureg+SIGNED(eaddr);break; - case 0xC9: IMMWORD(eaddr);eaddr+=iureg;break; - case 0xCA: eaddr=0;break; /*ILLEGAL*/ - case 0xCB: eaddr=iureg+GETDREG;break; - case 0xCC: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr);break; - case 0xCD: IMMWORD(eaddr);eaddr+=ipcreg;break; - case 0xCE: eaddr=0;break; /*ILLEGAL*/ - case 0xCF: IMMWORD(eaddr);break; - case 0xD0: eaddr=iureg;iureg++;eaddr=GETWORD(eaddr);break; - case 0xD1: eaddr=iureg;iureg+=2;eaddr=GETWORD(eaddr);break; - case 0xD2: iureg--;eaddr=iureg;eaddr=GETWORD(eaddr);break; - case 0xD3: iureg-=2;eaddr=iureg;eaddr=GETWORD(eaddr);break; - case 0xD4: eaddr=iureg;eaddr=GETWORD(eaddr);break; - case 0xD5: eaddr=iureg+SIGNED(ibreg);eaddr=GETWORD(eaddr);break; - case 0xD6: eaddr=iureg+SIGNED(iareg);eaddr=GETWORD(eaddr);break; - case 0xD7: eaddr=0;break; /*ILELGAL*/ - case 0xD8: IMMBYTE(eaddr);eaddr=iureg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0xD9: IMMWORD(eaddr);eaddr+=iureg;eaddr=GETWORD(eaddr);break; - case 0xDA: eaddr=0;break; /*ILLEGAL*/ - case 0xDB: eaddr=iureg+GETDREG;eaddr=GETWORD(eaddr);break; - case 0xDC: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0xDD: IMMWORD(eaddr);eaddr+=ipcreg;eaddr=GETWORD(eaddr);break; - case 0xDE: eaddr=0;break; /*ILLEGAL*/ - case 0xDF: IMMWORD(eaddr);eaddr=GETWORD(eaddr);break; - case 0xE0: eaddr=isreg;isreg++;break; - case 0xE1: eaddr=isreg;isreg+=2;break; - case 0xE2: isreg--;eaddr=isreg;break; - case 0xE3: isreg-=2;eaddr=isreg;break; - case 0xE4: eaddr=isreg;break; - case 0xE5: eaddr=isreg+SIGNED(ibreg);break; - case 0xE6: eaddr=isreg+SIGNED(iareg);break; - case 0xE7: eaddr=0;break; /*ILELGAL*/ - case 0xE8: IMMBYTE(eaddr);eaddr=isreg+SIGNED(eaddr);break; - case 0xE9: IMMWORD(eaddr);eaddr+=isreg;break; - case 0xEA: eaddr=0;break; /*ILLEGAL*/ - case 0xEB: eaddr=isreg+GETDREG;break; - case 0xEC: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr);break; - case 0xED: IMMWORD(eaddr);eaddr+=ipcreg;break; - case 0xEE: eaddr=0;break; /*ILLEGAL*/ - case 0xEF: IMMWORD(eaddr);break; - case 0xF0: eaddr=isreg;isreg++;eaddr=GETWORD(eaddr);break; - case 0xF1: eaddr=isreg;isreg+=2;eaddr=GETWORD(eaddr);break; - case 0xF2: isreg--;eaddr=isreg;eaddr=GETWORD(eaddr);break; - case 0xF3: isreg-=2;eaddr=isreg;eaddr=GETWORD(eaddr);break; - case 0xF4: eaddr=isreg;eaddr=GETWORD(eaddr);break; - case 0xF5: eaddr=isreg+SIGNED(ibreg);eaddr=GETWORD(eaddr);break; - case 0xF6: eaddr=isreg+SIGNED(iareg);eaddr=GETWORD(eaddr);break; - case 0xF7: eaddr=0;break; /*ILELGAL*/ - case 0xF8: IMMBYTE(eaddr);eaddr=isreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0xF9: IMMWORD(eaddr);eaddr+=isreg;eaddr=GETWORD(eaddr);break; - case 0xFA: eaddr=0;break; /*ILLEGAL*/ - case 0xFB: eaddr=isreg+GETDREG;eaddr=GETWORD(eaddr);break; - case 0xFC: IMMBYTE(eaddr);eaddr=ipcreg+SIGNED(eaddr); - eaddr=GETWORD(eaddr);break; - case 0xFD: IMMWORD(eaddr);eaddr+=ipcreg;eaddr=GETWORD(eaddr);break; - case 0xFE: eaddr=0;break; /*ILLEGAL*/ - case 0xFF: IMMWORD(eaddr);eaddr=GETWORD(eaddr);break; - } - } - switch(ireg) { - case 0x00: /*NEG direct*/ DIRECT tw=-mem(eaddr);SETSTATUS(0,mem(eaddr),tw) - SETBYTE(eaddr,tw)break; - case 0x01: break;/*ILLEGAL*/ - case 0x02: break;/*ILLEGAL*/ - case 0x03: /*COM direct*/ DIRECT tb=~mem(eaddr);SETNZ8(tb);SEC CLV - SETBYTE(eaddr,tb)break; - case 0x04: /*LSR direct*/ DIRECT tb=mem(eaddr);if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1;SETNZ8(tb) - SETBYTE(eaddr,tb)break; - case 0x05: break;/* ILLEGAL*/ - case 0x06: /*ROR direct*/ DIRECT tb=(iccreg&0x01)<<7; - if(mem(eaddr)&0x01)SEC else CLC - tw=(mem(eaddr)>>1)+tb;SETNZ8(tw) - SETBYTE(eaddr,tw) - break; - case 0x07: /*ASR direct*/ DIRECT tb=mem(eaddr);if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1; - if(tb&0x40)tb|=0x80;SETBYTE(eaddr,tb)SETNZ8(tb) - break; - case 0x08: /*ASL direct*/ DIRECT tw=mem(eaddr)<<1; - SETSTATUS(mem(eaddr),mem(eaddr),tw) - SETBYTE(eaddr,tw)break; - case 0x09: /*ROL direct*/ DIRECT tb=mem(eaddr);tw=iccreg&0x01; - if(tb&0x80)SEC else CLC - if((tb&0x80)^((tb<<1)&0x80))SEV else CLV - tb=(tb<<1)+tw;SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x0A: /*DEC direct*/ DIRECT tb=mem(eaddr)-1;if(tb==0x7F)SEV else CLV - SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x0B: break; /*ILLEGAL*/ - case 0x0C: /*INC direct*/ DIRECT tb=mem(eaddr)+1;if(tb==0x80)SEV else CLV - SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x0D: /*TST direct*/ DIRECT tb=mem(eaddr);SETNZ8(tb) break; - case 0x0E: /*JMP direct*/ DIRECT ipcreg=eaddr;break; - case 0x0F: /*CLR direct*/ DIRECT SETBYTE(eaddr,0);CLN CLV SEZ CLC break; - case 0x10: /* flag10 */ iflag=1;goto flaginstr; - case 0x11: /* flag11 */ iflag=2;goto flaginstr; - case 0x12: /* NOP */ break; - case 0x13: /* SYNC */ - do usleep(USLEEP); /* Wait for IRQ */ - while(!irq && !attention); - if(iccreg&0x40)tracetrick=1; - break; - case 0x14: break; /*ILLEGAL*/ - case 0x15: break; /*ILLEGAL*/ - case 0x16: /*LBRA*/ IMMWORD(eaddr) ipcreg+=eaddr;break; - case 0x17: /*LBSR*/ IMMWORD(eaddr) PUSHWORD(ipcreg) ipcreg+=eaddr;break; - case 0x18: break; /*ILLEGAL*/ - case 0x19: /* DAA*/ tw=iareg; - if(iccreg&0x20)tw+=6; - if((tw&0x0f)>9)tw+=6; - if(iccreg&0x01)tw+=0x60; - if((tw&0xf0)>0x90)tw+=0x60; - if(tw&0x100)SEC - iareg=tw;break; - case 0x1A: /* ORCC*/ IMMBYTE(tb) iccreg|=tb;break; - case 0x1B: break; /*ILLEGAL*/ - case 0x1C: /* ANDCC*/ IMMBYTE(tb) iccreg&=tb;break; - case 0x1D: /* SEX */ tw=SIGNED(ibreg); SETNZ16(tw) SETDREG(tw) break; - case 0x1E: /* EXG */ IMMBYTE(tb) {Word t2;GETREG(tw,tb>>4) GETREG(t2,tb&15) - SETREG(t2,tb>>4) SETREG(tw,tb&15) } break; - case 0x1F: /* TFR */ IMMBYTE(tb) GETREG(tw,tb>>4) SETREG(tw,tb&15) break; - case 0x20: /* (L)BRA*/ BRANCH(1) break; - case 0x21: /* (L)BRN*/ BRANCH(0) break; - case 0x22: /* (L)BHI*/ BRANCH(!(iccreg&0x05)) break; - case 0x23: /* (L)BLS*/ BRANCH(iccreg&0x05) break; - case 0x24: /* (L)BCC*/ BRANCH(!(iccreg&0x01)) break; - case 0x25: /* (L)BCS*/ BRANCH(iccreg&0x01) break; - case 0x26: /* (L)BNE*/ BRANCH(!(iccreg&0x04)) break; - case 0x27: /* (L)BEQ*/ BRANCH(iccreg&0x04) break; - case 0x28: /* (L)BVC*/ BRANCH(!(iccreg&0x02)) break; - case 0x29: /* (L)BVS*/ BRANCH(iccreg&0x02) break; - case 0x2A: /* (L)BPL*/ BRANCH(!(iccreg&0x08)) break; - case 0x2B: /* (L)BMI*/ BRANCH(iccreg&0x08) break; - case 0x2C: /* (L)BGE*/ BRANCH(!NXORV) break; - case 0x2D: /* (L)BLT*/ BRANCH(NXORV) break; - case 0x2E: /* (L)BGT*/ BRANCH(!(NXORV||iccreg&0x04)) break; - case 0x2F: /* (L)BLE*/ BRANCH(NXORV||iccreg&0x04) break; - case 0x30: /* LEAX*/ ixreg=eaddr; if(ixreg) CLZ else SEZ break; - case 0x31: /* LEAY*/ iyreg=eaddr; if(iyreg) CLZ else SEZ break; - case 0x32: /* LEAS*/ isreg=eaddr;break; - case 0x33: /* LEAU*/ iureg=eaddr;break; - case 0x34: /* PSHS*/ IMMBYTE(tb) - if(tb&0x80)PUSHWORD(ipcreg) - if(tb&0x40)PUSHWORD(iureg) - if(tb&0x20)PUSHWORD(iyreg) - if(tb&0x10)PUSHWORD(ixreg) - if(tb&0x08)PUSHBYTE(idpreg) - if(tb&0x04)PUSHBYTE(ibreg) - if(tb&0x02)PUSHBYTE(iareg) - if(tb&0x01)PUSHBYTE(iccreg) break; - case 0x35: /* PULS*/ IMMBYTE(tb) - if(tb&0x01)PULLBYTE(iccreg) - if(tb&0x02)PULLBYTE(iareg) - if(tb&0x04)PULLBYTE(ibreg) - if(tb&0x08)PULLBYTE(idpreg) - if(tb&0x10)PULLWORD(ixreg) - if(tb&0x20)PULLWORD(iyreg) - if(tb&0x40)PULLWORD(iureg) - if(tb&0x80)PULLWORD(ipcreg) - if(tracetrick&&tb==0xff) { /* Arrange fake FIRQ after next insn - for hardware tracing */ - tracetrick=0; - irq=2; - attention=1; - goto flaginstr; - } - break; - case 0x36: /* PSHU*/ IMMBYTE(tb) - if(tb&0x80)PSHUWORD(ipcreg) - if(tb&0x40)PSHUWORD(isreg) - if(tb&0x20)PSHUWORD(iyreg) - if(tb&0x10)PSHUWORD(ixreg) - if(tb&0x08)PSHUBYTE(idpreg) - if(tb&0x04)PSHUBYTE(ibreg) - if(tb&0x02)PSHUBYTE(iareg) - if(tb&0x01)PSHUBYTE(iccreg) break; - case 0x37: /* PULU*/ IMMBYTE(tb) - if(tb&0x01)PULUBYTE(iccreg) - if(tb&0x02)PULUBYTE(iareg) - if(tb&0x04)PULUBYTE(ibreg) - if(tb&0x08)PULUBYTE(idpreg) - if(tb&0x10)PULUWORD(ixreg) - if(tb&0x20)PULUWORD(iyreg) - if(tb&0x40)PULUWORD(isreg) - if(tb&0x80)PULUWORD(ipcreg) break; - case 0x39: /* RTS*/ PULLWORD(ipcreg) break; - case 0x3A: /* ABX*/ ixreg+=ibreg; break; - case 0x3B: /* RTI*/ PULLBYTE(iccreg) - tb=iccreg&0x80; - if(tb) - { - PULLBYTE(iareg) - PULLBYTE(ibreg) - PULLBYTE(idpreg) - PULLWORD(ixreg) - PULLWORD(iyreg) - PULLWORD(iureg) - } - PULLWORD(ipcreg) break; - case 0x3C: /* CWAI*/ IMMBYTE(tb) - PUSHWORD(ipcreg) - PUSHWORD(iureg) - PUSHWORD(iyreg) - PUSHWORD(ixreg) - PUSHBYTE(idpreg) - PUSHBYTE(ibreg) - PUSHBYTE(iareg) - PUSHBYTE(iccreg) - iccreg&=tb; - iccreg|=0x80; - do usleep(USLEEP); /* Wait for IRQ */ - while(!attention && !((irq==1&&!(iccreg&0x10))||(irq==2&&!(iccreg&0x040)))); - if(irq==1)ipcreg=GETWORD(0xfff8); - else ipcreg=GETWORD(0xfff6); - irq=0; - if(!tracing)attention=0; - break; - case 0x3D: /* MUL*/ tw=iareg*ibreg; if(tw)CLZ else SEZ - if(tw&0x80) SEC else CLC SETDREG(tw) break; - case 0x3E: break; /*ILLEGAL*/ - case 0x3F: /* SWI (SWI2 SWI3)*/ { - PUSHWORD(ipcreg) - PUSHWORD(iureg) - PUSHWORD(iyreg) - PUSHWORD(ixreg) - PUSHBYTE(idpreg) - PUSHBYTE(ibreg) - PUSHBYTE(iareg) - iccreg|=0x80; - PUSHBYTE(iccreg) - if(!iflag)iccreg|=0x50; - switch(iflag) { - case 0:ipcreg=GETWORD(0xfffa);break; - case 1:ipcreg=GETWORD(0xfff4);break; - case 2:ipcreg=GETWORD(0xfff2);break; - } - }break; - case 0x40: /*NEGA*/ tw=-iareg;SETSTATUS(0,iareg,tw) - iareg=tw;break; - case 0x41: break;/*ILLEGAL*/ - case 0x42: break;/*ILLEGAL*/ - case 0x43: /*COMA*/ tb=~iareg;SETNZ8(tb);SEC CLV - iareg=tb;break; - case 0x44: /*LSRA*/ tb=iareg;if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1;SETNZ8(tb) - iareg=tb;break; - case 0x45: break;/* ILLEGAL*/ - case 0x46: /*RORA*/ tb=(iccreg&0x01)<<7; - if(iareg&0x01)SEC else CLC - iareg=(iareg>>1)+tb;SETNZ8(iareg) - break; - case 0x47: /*ASRA*/ tb=iareg;if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1; - if(tb&0x40)tb|=0x80;iareg=tb;SETNZ8(tb) - break; - case 0x48: /*ASLA*/ tw=iareg<<1; - SETSTATUS(iareg,iareg,tw) - iareg=tw;break; - case 0x49: /*ROLA*/ tb=iareg;tw=iccreg&0x01; - if(tb&0x80)SEC else CLC - if((tb&0x80)^((tb<<1)&0x80))SEV else CLV - tb=(tb<<1)+tw;SETNZ8(tb) iareg=tb;break; - case 0x4A: /*DECA*/ tb=iareg-1;if(tb==0x7F)SEV else CLV - SETNZ8(tb) iareg=tb;break; - case 0x4B: break; /*ILLEGAL*/ - case 0x4C: /*INCA*/ tb=iareg+1;if(tb==0x80)SEV else CLV - SETNZ8(tb) iareg=tb;break; - case 0x4D: /*TSTA*/ SETNZ8(iareg) break; - case 0x4E: break; /*ILLEGAL*/ - case 0x4F: /*CLRA*/ iareg=0;CLN CLV SEZ CLC break; - case 0x50: /*NEGB*/ tw=-ibreg;SETSTATUS(0,ibreg,tw) - ibreg=tw;break; - case 0x51: break;/*ILLEGAL*/ - case 0x52: break;/*ILLEGAL*/ - case 0x53: /*COMB*/ tb=~ibreg;SETNZ8(tb);SEC CLV - ibreg=tb;break; - case 0x54: /*LSRB*/ tb=ibreg;if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1;SETNZ8(tb) - ibreg=tb;break; - case 0x55: break;/* ILLEGAL*/ - case 0x56: /*RORB*/ tb=(iccreg&0x01)<<7; - if(ibreg&0x01)SEC else CLC - ibreg=(ibreg>>1)+tb;SETNZ8(ibreg) - break; - case 0x57: /*ASRB*/ tb=ibreg;if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1; - if(tb&0x40)tb|=0x80;ibreg=tb;SETNZ8(tb) - break; - case 0x58: /*ASLB*/ tw=ibreg<<1; - SETSTATUS(ibreg,ibreg,tw) - ibreg=tw;break; - case 0x59: /*ROLB*/ tb=ibreg;tw=iccreg&0x01; - if(tb&0x80)SEC else CLC - if((tb&0x80)^((tb<<1)&0x80))SEV else CLV - tb=(tb<<1)+tw;SETNZ8(tb) ibreg=tb;break; - case 0x5A: /*DECB*/ tb=ibreg-1;if(tb==0x7F)SEV else CLV - SETNZ8(tb) ibreg=tb;break; - case 0x5B: break; /*ILLEGAL*/ - case 0x5C: /*INCB*/ tb=ibreg+1;if(tb==0x80)SEV else CLV - SETNZ8(tb) ibreg=tb;break; - case 0x5D: /*TSTB*/ SETNZ8(ibreg) break; - case 0x5E: break; /*ILLEGAL*/ - case 0x5F: /*CLRB*/ ibreg=0;CLN CLV SEZ CLC break; - case 0x60: /*NEG indexed*/ tw=-mem(eaddr);SETSTATUS(0,mem(eaddr),tw) - SETBYTE(eaddr,tw)break; - case 0x61: break;/*ILLEGAL*/ - case 0x62: break;/*ILLEGAL*/ - case 0x63: /*COM indexed*/ tb=~mem(eaddr);SETNZ8(tb);SEC CLV - SETBYTE(eaddr,tb)break; - case 0x64: /*LSR indexed*/ tb=mem(eaddr);if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1;SETNZ8(tb) - SETBYTE(eaddr,tb)break; - case 0x65: break;/* ILLEGAL*/ - case 0x66: /*ROR indexed*/ tb=(iccreg&0x01)<<7; - if(mem(eaddr)&0x01)SEC else CLC - tw=(mem(eaddr)>>1)+tb;SETNZ8(tw) - SETBYTE(eaddr,tw) - break; - case 0x67: /*ASR indexed*/ tb=mem(eaddr);if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1; - if(tb&0x40)tb|=0x80;SETBYTE(eaddr,tb)SETNZ8(tb) - break; - case 0x68: /*ASL indexed*/ tw=mem(eaddr)<<1; - SETSTATUS(mem(eaddr),mem(eaddr),tw) - SETBYTE(eaddr,tw)break; - case 0x69: /*ROL indexed*/ tb=mem(eaddr);tw=iccreg&0x01; - if(tb&0x80)SEC else CLC - if((tb&0x80)^((tb<<1)&0x80))SEV else CLV - tb=(tb<<1)+tw;SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x6A: /*DEC indexed*/ tb=mem(eaddr)-1;if(tb==0x7F)SEV else CLV - SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x6B: break; /*ILLEGAL*/ - case 0x6C: /*INC indexed*/ tb=mem(eaddr)+1;if(tb==0x80)SEV else CLV - SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x6D: /*TST indexed*/ tb=mem(eaddr);SETNZ8(tb) break; - case 0x6E: /*JMP indexed*/ ipcreg=eaddr;break; - case 0x6F: /*CLR indexed*/ SETBYTE(eaddr,0)CLN CLV SEZ CLC break; - case 0x70: /*NEG ext*/ EXTENDED tw=-mem(eaddr);SETSTATUS(0,mem(eaddr),tw) - SETBYTE(eaddr,tw)break; - case 0x71: break;/*ILLEGAL*/ - case 0x72: break;/*ILLEGAL*/ - case 0x73: /*COM ext*/ EXTENDED tb=~mem(eaddr);SETNZ8(tb);SEC CLV - SETBYTE(eaddr,tb)break; - case 0x74: /*LSR ext*/ EXTENDED tb=mem(eaddr);if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1;SETNZ8(tb) - SETBYTE(eaddr,tb)break; - case 0x75: break;/* ILLEGAL*/ - case 0x76: /*ROR ext*/ EXTENDED tb=(iccreg&0x01)<<7; - if(mem(eaddr)&0x01)SEC else CLC - tw=(mem(eaddr)>>1)+tb;SETNZ8(tw) - SETBYTE(eaddr,tw) - break; - case 0x77: /*ASR ext*/ EXTENDED tb=mem(eaddr);if(tb&0x01)SEC else CLC - if(tb&0x10)SEH else CLH tb>>=1; - if(tb&0x40)tb|=0x80;SETBYTE(eaddr,tb)SETNZ8(tb) - break; - case 0x78: /*ASL ext*/ EXTENDED tw=mem(eaddr)<<1; - SETSTATUS(mem(eaddr),mem(eaddr),tw) - SETBYTE(eaddr,tw)break; - case 0x79: /*ROL ext*/ EXTENDED tb=mem(eaddr);tw=iccreg&0x01; - if(tb&0x80)SEC else CLC - if((tb&0x80)^((tb<<1)&0x80))SEV else CLV - tb=(tb<<1)+tw;SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x7A: /*DEC ext*/ EXTENDED tb=mem(eaddr)-1;if(tb==0x7F)SEV else CLV - SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x7B: break; /*ILLEGAL*/ - case 0x7C: /*INC ext*/ EXTENDED tb=mem(eaddr)+1;if(tb==0x80)SEV else CLV - SETNZ8(tb) SETBYTE(eaddr,tb)break; - case 0x7D: /*TST ext*/ EXTENDED tb=mem(eaddr);SETNZ8(tb) break; - case 0x7E: /*JMP ext*/ EXTENDED ipcreg=eaddr;break; - case 0x7F: /*CLR ext*/ EXTENDED SETBYTE(eaddr,0)CLN CLV SEZ CLC break; - case 0x80: /*SUBA immediate*/ IMM8 tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x81: /*CMPA immediate*/ IMM8 tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) break; - case 0x82: /*SBCA immediate*/ IMM8 tw=iareg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x83: /*SUBD (CMPD CMPU) immediate*/ IMM16 - {unsigned long res,dreg,breg; - if(iflag==2)dreg=iureg;else dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - if(iflag==0) SETDREG(res) - }break; - case 0x84: /*ANDA immediate*/ IMM8 iareg=iareg&mem(eaddr);SETNZ8(iareg) - CLV break; - case 0x85: /*BITA immediate*/ IMM8 tb=iareg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0x86: /*LDA immediate*/ IMM8 LOADAC(iareg) CLV SETNZ8(iareg) - break; - case 0x87: /*STA immediate (for the sake of orthogonality) */ IMM8 - SETNZ8(iareg) CLV STOREAC(iareg) break; - case 0x88: /*EORA immediate*/ IMM8 iareg=iareg^mem(eaddr);SETNZ8(iareg) - CLV break; - case 0x89: /*ADCA immediate*/ IMM8 tw=iareg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x8A: /*ORA immediate*/ IMM8 iareg=iareg|mem(eaddr);SETNZ8(iareg) - CLV break; - case 0x8B: /*ADDA immediate*/ IMM8 tw=iareg+mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x8C: /*CMPX (CMPY CMPS) immediate */ IMM16 - {unsigned long dreg,breg,res; - if(iflag==0)dreg=ixreg;else if(iflag==1) - dreg=iyreg;else dreg=isreg;breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - }break; - case 0x8D: /*BSR */ IMMBYTE(tb) PUSHWORD(ipcreg) ipcreg+=SIGNED(tb); - break; - case 0x8E: /* LDX (LDY) immediate */ IMM16 tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)ixreg=tw; else - iyreg=tw;break; - case 0x8F: /* STX (STY) immediate (orthogonality) */ IMM16 - if(!iflag) tw=ixreg; else tw=iyreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0x90: /*SUBA direct*/ DIRECT tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x91: /*CMPA direct*/ DIRECT tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) break; - case 0x92: /*SBCA direct*/ DIRECT tw=iareg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x93: /*SUBD (CMPD CMPU) direct*/ DIRECT - {unsigned long res,dreg,breg; - if(iflag==2)dreg=iureg;else dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - if(iflag==0) SETDREG(res) - }break; - case 0x94: /*ANDA direct*/ DIRECT iareg=iareg&mem(eaddr);SETNZ8(iareg) - CLV break; - case 0x95: /*BITA direct*/ DIRECT tb=iareg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0x96: /*LDA direct*/ DIRECT LOADAC(iareg) CLV SETNZ8(iareg) - break; - case 0x97: /*STA direct */ DIRECT - SETNZ8(iareg) CLV STOREAC(iareg) break; - case 0x98: /*EORA direct*/ DIRECT iareg=iareg^mem(eaddr);SETNZ8(iareg) - CLV break; - case 0x99: /*ADCA direct*/ DIRECT tw=iareg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x9A: /*ORA direct*/ DIRECT iareg=iareg|mem(eaddr);SETNZ8(iareg) - CLV break; - case 0x9B: /*ADDA direct*/ DIRECT tw=iareg+mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0x9C: /*CMPX (CMPY CMPS) direct */ DIRECT - {unsigned long dreg,breg,res; - if(iflag==0)dreg=ixreg;else if(iflag==1) - dreg=iyreg;else dreg=isreg;breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - }break; - case 0x9D: /*JSR direct */ DIRECT PUSHWORD(ipcreg) ipcreg=eaddr; - break; - case 0x9E: /* LDX (LDY) direct */ DIRECT tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)ixreg=tw; else - iyreg=tw;break; - case 0x9F: /* STX (STY) direct */ DIRECT - if(!iflag) tw=ixreg; else tw=iyreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0xA0: /*SUBA indexed*/ tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xA1: /*CMPA indexed*/ tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) break; - case 0xA2: /*SBCA indexed*/ tw=iareg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xA3: /*SUBD (CMPD CMPU) indexed*/ - {unsigned long res,dreg,breg; - if(iflag==2)dreg=iureg;else dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - if(iflag==0) SETDREG(res) - }break; - case 0xA4: /*ANDA indexed*/ iareg=iareg&mem(eaddr);SETNZ8(iareg) - CLV break; - case 0xA5: /*BITA indexed*/ tb=iareg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0xA6: /*LDA indexed*/ LOADAC(iareg) CLV SETNZ8(iareg) - break; - case 0xA7: /*STA indexed */ - SETNZ8(iareg) CLV STOREAC(iareg) break; - case 0xA8: /*EORA indexed*/ iareg=iareg^mem(eaddr);SETNZ8(iareg) - CLV break; - case 0xA9: /*ADCA indexed*/ tw=iareg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xAA: /*ORA indexed*/ iareg=iareg|mem(eaddr);SETNZ8(iareg) - CLV break; - case 0xAB: /*ADDA indexed*/ tw=iareg+mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xAC: /*CMPX (CMPY CMPS) indexed */ - {unsigned long dreg,breg,res; - if(iflag==0)dreg=ixreg;else if(iflag==1) - dreg=iyreg;else dreg=isreg;breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - }break; - case 0xAD: /*JSR indexed */ PUSHWORD(ipcreg) ipcreg=eaddr; - break; - case 0xAE: /* LDX (LDY) indexed */ tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)ixreg=tw; else - iyreg=tw;break; - case 0xAF: /* STX (STY) indexed */ - if(!iflag) tw=ixreg; else tw=iyreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0xB0: /*SUBA ext*/ EXTENDED tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xB1: /*CMPA ext*/ EXTENDED tw=iareg-mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) break; - case 0xB2: /*SBCA ext*/ EXTENDED tw=iareg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xB3: /*SUBD (CMPD CMPU) ext*/ EXTENDED - {unsigned long res,dreg,breg; - if(iflag==2)dreg=iureg;else dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - if(iflag==0) SETDREG(res) - }break; - case 0xB4: /*ANDA ext*/ EXTENDED iareg=iareg&mem(eaddr);SETNZ8(iareg) - CLV break; - case 0xB5: /*BITA ext*/ EXTENDED tb=iareg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0xB6: /*LDA ext*/ EXTENDED LOADAC(iareg) CLV SETNZ8(iareg) - break; - case 0xB7: /*STA ext */ EXTENDED - SETNZ8(iareg) CLV STOREAC(iareg) break; - case 0xB8: /*EORA ext*/ EXTENDED iareg=iareg^mem(eaddr);SETNZ8(iareg) - CLV break; - case 0xB9: /*ADCA ext*/ EXTENDED tw=iareg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xBA: /*ORA ext*/ EXTENDED iareg=iareg|mem(eaddr);SETNZ8(iareg) - CLV break; - case 0xBB: /*ADDA ext*/ EXTENDED tw=iareg+mem(eaddr); - SETSTATUS(iareg,mem(eaddr),tw) - iareg=tw;break; - case 0xBC: /*CMPX (CMPY CMPS) ext */ EXTENDED - {unsigned long dreg,breg,res; - if(iflag==0)dreg=ixreg;else if(iflag==1) - dreg=iyreg;else dreg=isreg;breg=GETWORD(eaddr); - res=dreg-breg; - SETSTATUSD(dreg,breg,res) - }break; - case 0xBD: /*JSR ext */ EXTENDED PUSHWORD(ipcreg) ipcreg=eaddr; - break; - case 0xBE: /* LDX (LDY) ext */ EXTENDED tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)ixreg=tw; else - iyreg=tw;break; - case 0xBF: /* STX (STY) ext */ EXTENDED - if(!iflag) tw=ixreg; else tw=iyreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0xC0: /*SUBB immediate*/ IMM8 tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xC1: /*CMPB immediate*/ IMM8 tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) break; - case 0xC2: /*SBCB immediate*/ IMM8 tw=ibreg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xC3: /*ADDD immediate*/ IMM16 - {unsigned long res,dreg,breg; - dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg+breg; - SETSTATUSD(dreg,breg,res) - SETDREG(res) - }break; - case 0xC4: /*ANDB immediate*/ IMM8 ibreg=ibreg&mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xC5: /*BITB immediate*/ IMM8 tb=ibreg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0xC6: /*LDB immediate*/ IMM8 LOADAC(ibreg) CLV SETNZ8(ibreg) - break; - case 0xC7: /*STB immediate (for the sake of orthogonality) */ IMM8 - SETNZ8(ibreg) CLV STOREAC(ibreg) break; - case 0xC8: /*EORB immediate*/ IMM8 ibreg=ibreg^mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xC9: /*ADCB immediate*/ IMM8 tw=ibreg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xCA: /*ORB immediate*/ IMM8 ibreg=ibreg|mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xCB: /*ADDB immediate*/ IMM8 tw=ibreg+mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xCC: /*LDD immediate */ IMM16 tw=GETWORD(eaddr);SETNZ16(tw) - CLV SETDREG(tw) break; - case 0xCD: /*STD immediate (orthogonality) */ IMM16 - tw=GETDREG; SETNZ16(tw) CLV - SETWORD(eaddr,tw) break; - case 0xCE: /* LDU (LDS) immediate */ IMM16 tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)iureg=tw; else - isreg=tw;break; - case 0xCF: /* STU (STS) immediate (orthogonality) */ IMM16 - if(!iflag) tw=iureg; else tw=isreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0xD0: /*SUBB direct*/ DIRECT tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xD1: /*CMPB direct*/ DIRECT tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) break; - case 0xD2: /*SBCB direct*/ DIRECT tw=ibreg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xD3: /*ADDD direct*/ DIRECT - {unsigned long res,dreg,breg; - dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg+breg; - SETSTATUSD(dreg,breg,res) - SETDREG(res) - }break; - case 0xD4: /*ANDB direct*/ DIRECT ibreg=ibreg&mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xD5: /*BITB direct*/ DIRECT tb=ibreg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0xD6: /*LDB direct*/ DIRECT LOADAC(ibreg) CLV SETNZ8(ibreg) - break; - case 0xD7: /*STB direct */ DIRECT - SETNZ8(ibreg) CLV STOREAC(ibreg) break; - case 0xD8: /*EORB direct*/ DIRECT ibreg=ibreg^mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xD9: /*ADCB direct*/ DIRECT tw=ibreg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xDA: /*ORB direct*/ DIRECT ibreg=ibreg|mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xDB: /*ADDB direct*/ DIRECT tw=ibreg+mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xDC: /*LDD direct */ DIRECT tw=GETWORD(eaddr);SETNZ16(tw) - CLV SETDREG(tw) break; - case 0xDD: /*STD direct */ DIRECT - tw=GETDREG; SETNZ16(tw) CLV -#ifdef USE_MMU - STOREAC((tw>>8)&0x0ff); eaddr++; - STOREAC(tw&0x0ff); break; -#else - SETWORD(eaddr,tw) break; -#endif - case 0xDE: /* LDU (LDS) direct */ DIRECT tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)iureg=tw; else - isreg=tw;break; - case 0xDF: /* STU (STS) direct */ DIRECT - if(!iflag) tw=iureg; else tw=isreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0xE0: /*SUBB indexed*/ tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xE1: /*CMPB indexed*/ tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) break; - case 0xE2: /*SBCB indexed*/ tw=ibreg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xE3: /*ADDD indexed*/ - {unsigned long res,dreg,breg; - dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg+breg; - SETSTATUSD(dreg,breg,res) - SETDREG(res) - }break; - case 0xE4: /*ANDB indexed*/ ibreg=ibreg&mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xE5: /*BITB indexed*/ tb=ibreg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0xE6: /*LDB indexed*/ LOADAC(ibreg) CLV SETNZ8(ibreg) - break; - case 0xE7: /*STB indexed */ - SETNZ8(ibreg) CLV STOREAC(ibreg) break; - case 0xE8: /*EORB indexed*/ ibreg=ibreg^mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xE9: /*ADCB indexed*/ tw=ibreg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xEA: /*ORB indexed*/ ibreg=ibreg|mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xEB: /*ADDB indexed*/ tw=ibreg+mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xEC: /*LDD indexed */ tw=GETWORD(eaddr);SETNZ16(tw) - CLV SETDREG(tw) break; - case 0xED: /*STD indexed */ - tw=GETDREG; SETNZ16(tw) CLV -#ifdef USE_MMU - STOREAC((tw>>8)&0x0ff); eaddr++; - STOREAC(tw&0x0ff); - break; -#else - SETWORD(eaddr,tw) break; -#endif - case 0xEE: /* LDU (LDS) indexed */ tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)iureg=tw; else - isreg=tw;break; - case 0xEF: /* STU (STS) indexed */ - if(!iflag) tw=iureg; else tw=isreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - case 0xF0: /*SUBB ext*/ EXTENDED tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xF1: /*CMPB ext*/ EXTENDED tw=ibreg-mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) break; - case 0xF2: /*SBCB ext*/ EXTENDED tw=ibreg-mem(eaddr)-(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xF3: /*ADDD ext*/ EXTENDED - {unsigned long res,dreg,breg; - dreg=GETDREG; - breg=GETWORD(eaddr); - res=dreg+breg; - SETSTATUSD(dreg,breg,res) - SETDREG(res) - }break; - case 0xF4: /*ANDB ext*/ EXTENDED ibreg=ibreg&mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xF5: /*BITB ext*/ EXTENDED tb=ibreg&mem(eaddr);SETNZ8(tb) - CLV break; - case 0xF6: /*LDB ext*/ EXTENDED LOADAC(ibreg) CLV SETNZ8(ibreg) - break; - case 0xF7: /*STB ext */ EXTENDED - SETNZ8(ibreg) CLV STOREAC(ibreg) break; - case 0xF8: /*EORB ext*/ EXTENDED ibreg=ibreg^mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xF9: /*ADCB ext*/ EXTENDED tw=ibreg+mem(eaddr)+(iccreg&0x01); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xFA: /*ORB ext*/ EXTENDED ibreg=ibreg|mem(eaddr);SETNZ8(ibreg) - CLV break; - case 0xFB: /*ADDB ext*/ EXTENDED tw=ibreg+mem(eaddr); - SETSTATUS(ibreg,mem(eaddr),tw) - ibreg=tw;break; - case 0xFC: /*LDD ext */ EXTENDED tw=GETWORD(eaddr);SETNZ16(tw) - CLV SETDREG(tw) break; - case 0xFD: /*STD ext */ EXTENDED - tw=GETDREG; SETNZ16(tw) CLV -#ifdef USE_MMU - STOREAC((tw>>8)&0x0ff); eaddr++; - STOREAC(tw&0x0ff); - break; -#else - SETWORD(eaddr,tw) break; -#endif - case 0xFE: /* LDU (LDS) ext */ EXTENDED tw=GETWORD(eaddr); - CLV SETNZ16(tw) if(!iflag)iureg=tw; else - isreg=tw;break; - case 0xFF: /* STU (STS) ext */ EXTENDED - if(!iflag) tw=iureg; else tw=isreg; - CLV SETNZ16(tw) SETWORD(eaddr,tw) break; - - - } - } -} - diff -r 4fa2bdb0c457 -r 2088fd998865 examples/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/Makefile Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,65 @@ +# +# Makefile examples SBC09/Sim6809 +# +# created 1994 by L.C. Benschop +# 2013-10-28 - Jens Diemer: add "clean" section +# 2014-06-25 - J.E. Klasek +# +# copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +# license: GNU General Public License version 2, see LICENSE for more details. +# + +ASM=../a09 + +EXAMPLES=asmtest bench09 bin2dec cond09 crc16 crc32 ef09 erat-sieve input printval test09 uslash + + + +all: $(ASM) $(EXAMPLES) + +$(ASM): + $(MAKE) -c ../src a09 install + +# ------------------------------------ +# rules + +.SUFFIXES: .asm + +.asm: + $(ASM) -l $@.lst $< + +# ------------------------------------ + +asmtest: asmtest.asm + +bench09: bench09.asm + +bin2dec: bin2dec.asm + +cond09: cond09.asm + +crc16: crc16.asm + +crc32: crc32.asm + +ef09: ef09.asm + +erat-sieve: erat-sieve.asm + +printval: printval.asm + +input: input.asm + +test09: test09.asm + +uslash: uslash.asm + + + +# ------------------------------------ + +cleanall: clean + +clean: + rm -f core *.BAK *.lst $(EXAMPLES) + diff -r 4fa2bdb0c457 -r 2088fd998865 examples/asmtest.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/asmtest.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,406 @@ + org $400 +addr8 equ $80h +addr16 equ $1234 + + neg addr8 + com addr8 + lsr addr8 + ror addr8 + asr addr8 + asl addr8 + lsl addr8 + rol addr8 + dec addr8 + inc addr8 + tst addr8 + jmp addr8 + clr addr8 + + lbrn addr16 + lbhi addr16 + lbls addr16 + lbhs addr16 + lbcc addr16 + lblo addr16 + lbcs addr16 + lbne addr16 + lbeq addr16 + lbvc addr16 + lbvs addr16 + lbpl addr16 + lbmi addr16 + lbge addr16 + lblt addr16 + lbgt addr16 + lble addr16 + + swi2 + cmpd #$4444 + cmpy #$4444 + ldy #$4444 + cmpd addr8 + cmpy addr8 + ldy addr8 + sty addr8 + cmpd ,x + cmpy ,x + ldy ,x + sty ,x + cmpd addr16 + cmpy addr16 + ldy addr16 + sty addr16 + lds #$4444 + lds addr8 + sts addr8 + lds ,x + sts ,x + lds addr16 + sts addr16 + swi3 + cmpu #$4444 + cmps #$4444 + cmpu addr8 + cmps addr8 + cmpu ,x + cmps ,x + cmpu addr16 + cmps addr16 + + nop + sync + lbra addr16 + lbsr addr16 + daa + orcc #$ff + andcc #$00 + sex + exg a,b + tfr a,b + + +labx bra labx + brn labx + bhi labx + bls labx + bhs labx + bcc labx + blo labx + bcs labx + bne labx + beq labx + bvc labx + bvs labx + bpl labx + bmi labx + bge labx + blt labx + bgt labx + ble labx + + leax ,x + leay ,x + leas ,x + leau ,x + pshs x + puls x + pshu x + pulu x + rts + abx + rti + cwai #$00 + mul + swi + + nega + coma + lsra + rora + asra + asla + lsla + rola + deca + inca + tsta + clra + + negb + comb + lsrb + rorb + asrb + aslb + lslb + rolb + decb + incb + tstb + clrb + + neg ,x + com ,x + lsr ,x + ror ,x + asr ,x + asl ,x + lsl ,x + rol ,x + dec ,x + inc ,x + tst ,x + jmp ,x + clr ,x + + neg addr16 + com addr16 + lsr addr16 + ror addr16 + asr addr16 + asl addr16 + lsl addr16 + rol addr16 + dec addr16 + inc addr16 + tst addr16 + jmp addr16 + clr addr16 + + suba #$22 + cmpa #$22 + sbca #$22 + subd #$4444 + anda #$22 + bita #$22 + lda #$22 + eora #$22 + adca #$22 + ora #$22 + adda #$22 + cmpx #$4444 +laby bsr laby + ldx #$4444 + + suba addr8 + cmpa addr8 + sbca addr8 + subd addr8 + anda addr8 + bita addr8 + lda addr8 + sta addr8 + eora addr8 + adca addr8 + ora addr8 + adda addr8 + cmpx addr8 + jsr addr8 + ldx addr8 + stx addr8 + + suba ,x + cmpa ,x + sbca ,x + subd ,x + anda ,x + bita ,x + lda ,x + sta ,x + eora ,x + adca ,x + ora ,x + adda ,x + cmpx ,x + jsr ,x + ldx ,x + stx ,x + + suba addr16 + cmpa addr16 + sbca addr16 + subd addr16 + anda addr16 + bita addr16 + lda addr16 + sta addr16 + eora addr16 + adca addr16 + ora addr16 + adda addr16 + cmpx addr16 + jsr addr16 + ldx addr16 + stx addr16 + + subb #$22 + cmpb #$22 + sbcb #$22 + addd #$4444 + andb #$22 + bitb #$22 + ldb #$22 + eorb #$22 + adcb #$22 + orb #$22 + addb #$22 + ldd #$4444 + ldu #$4444 + + subb addr8 + cmpb addr8 + sbcb addr8 + addd addr8 + andb addr8 + bitb addr8 + ldb addr8 + stb addr8 + eorb addr8 + adcb addr8 + orb addr8 + addb addr8 + ldd addr8 + std addr8 + ldu addr8 + stu addr8 + + subb ,x + cmpb ,x + sbcb ,x + addd ,x + andb ,x + bitb ,x + ldb ,x + stb ,x + eorb ,x + adcb ,x + orb ,x + addb ,x + ldd ,x + std ,x + ldu ,x + stu ,x + + subb addr16 + cmpb addr16 + sbcb addr16 + addd addr16 + andb addr16 + bitb addr16 + ldb addr16 + stb addr16 + eorb addr16 + adcb addr16 + orb addr16 + addb addr16 + ldd addr16 + std addr16 + ldu addr16 + stu addr16 + + tfr d,d + tfr d,x + tfr d,y + tfr d,u + tfr d,s + tfr d,pc + tfr a,a + tfr a,b + tfr a,cc + tfr a,dp + tfr d,d + tfr x,d + tfr y,d + tfr u,d + tfr s,d + tfr pc,d + tfr a,a + tfr b,a + tfr cc,a + tfr dp,a + + pshs pc + pshs u + pshu s + pshs x + pshs y + pshs dp + pshs d + pshs a,b + pshs a + pshs b + pshs cc + pshs pc,u,x,y,dp,a,b,cc + + lda 0,x + lda 1,x + lda 2,x + lda 3,x + lda 4,x + lda 5,x + lda 6,x + lda 7,x + lda 8,x + lda 9,x + lda 10,x + lda 11,x + lda 12,x + lda 13,x + lda 14,x + lda 15,x + lda -16,x + lda -15,x + lda -14,x + lda -13,x + lda -12,x + lda -11,x + lda -10,x + lda -9,x + lda -8,x + lda -7,x + lda -6,x + lda -5,x + lda -4,x + lda -3,x + lda -2,x + lda -1,x + lda 1,y + lda -1,y + lda 1,u + lda -1,u + lda 1,s + lda -1,s + lda ,x+ + ldd ,x++ + lda ,-x + ldd ,--x + lda ,x + lda b,x + lda a,x + lda -128,x + lda 33,x + lda 127,x + lda -129,x + lda $1234,x + lda d,x +labz lda labz,pcr + lda addr16,pcr + lda [,x++] + lda [,--x] + lda [,x] + lda [b,x] + lda [a,x] + lda [33,x] + lda [1,x] + lda [$1234,x] + lda [d,x] + lda [labz,pcr] + lda [addr16,pcr] + lda [addr16] + lda ,y+ + lda ,u+ + lda ,s+ + ldy [addr16] + ldy addr16,pcr + + \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 examples/bench09.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/bench09.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,40 @@ + ;6809 Benchmark program. + + org $100 + + lds #$100 + + ldb #'a' + jsr outc + + + ldy #0 +loop ldx #data + lda #(enddata-data) + clrb +loop2: addb ,x+ + deca + bne loop2 + cmpb #210 + lbne error + leay -1,y + bne loop + + ldb #'b' + jsr outc + jmp realexit + +error ldb #'e' + jsr outc + jmp realexit + +outc swi2 + rts + +realexit sync + +data fcb 1,2,3,4,5,6,7,8,9,10 + fcb 11,12,13,14,15,16,17,18,19,20 +enddata + + end diff -r 4fa2bdb0c457 -r 2088fd998865 examples/bin2dec.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/bin2dec.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,85 @@ +* Convert 32-bits binary number to decimal. + org $400 + +main lds #$8000 + ldx #num1 + jsr prtdec + ldx #num2 + jsr prtdec + ldx #num3 + jsr prtdec + ldx #num4 + jsr prtdec + ldx #num5 + jsr prtdec + ldx #num6 + jsr prtdec + swi + + +* Print double number (including leading zeros) pointed to by X. +* Number at that location is destroyed by the process. +prtdec jsr bin2bcd ;Convert to bcd + ldx #bcdbuf ;Traverse 5-byte buffer. + ldb #5 + stb temp +pdloop lda ,x+ + tfr a,b + lsrb + lsrb + lsrb + lsrb ;Extract higher digit from bcd byte. + addb #'0 + jsr outch + tfr a,b + andb #15 ;Extract lower digit. + addb #'0 + jsr outch + dec temp + bne pdloop + ldb #13 ;output newline. + jsr outch + ldb #10 + jsr outch + rts + +* Convert 4-byte number pointed to by X to 5-byte (10 digit) bcd. +bin2bcd ldu #bcdbuf + ldb #5 +bbclr clr ,u+ ;Clear the 5-byte bcd buffer. + decb + bne bbclr + ldb #4 ;traverse 4 bytes of bin number + stb temp +bbloop ldb #8 ;and 8 bits of each byte. (msb to lsb) + stb temp2 +bbl1 rol ,x ;Extract next bit from binary number. + ldb #5 + ldu #bcdbuf+5 +bbl2 lda ,-u ;multiply bcd number by 2 and add extracted bit + adca ,u ;into it. + daa + sta ,u + decb + bne bbl2 + dec temp2 + bne bbl1 + leax 1,x + dec temp + bne bbloop + rts + +* Output character B +outch jsr 3 + rts + +bcdbuf rmb 5 +temp rmb 1 +temp2 rmb 1 + +num1 fdb -1,-1 ; should be 4294967295 +num2 fdb 0,0 ; should be 0000000000 +num3 fdb 32768,0 ; should be 2147483648 +num4 fdb $3b9A,$c9ff ; should be 0999999999 +num5 fdb $3b9a,$ca00 ; should be 1000000000 +num6 fdb 0,5501 ; should be 0000005501 \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 examples/cond09.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/cond09.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,21 @@ +* Conditional assembly. + +jantje equ 2 + + org $100 + if jantje=1 +main ldx #12 + else +man2 ldx #13 + endif +labx ldy #25 + + include cond09.inc + + ldb #23 + ldu labx,pcr + ldy laby,pcr + sex + mul +laby sync + end \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 examples/cond09.inc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/cond09.inc Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,2 @@ + addb ,y+ + adda ,x+ diff -r 4fa2bdb0c457 -r 2088fd998865 examples/crc16.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/crc16.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,68 @@ +; 6809 CRC16 with tests +; +; Johann E. Klasek, j AT klasek at +; +; Testprogram and finaly submitted to http://beebwiki.mdfs.net/index.php/CRC-16#6809 + + org $100 + lds #$8000 + +; Calculate an XMODEM 16-bit CRC from data in memory. This code is as +; tight and as fast as it can be, moving as much code out of inner +; loops as possible. +; +; On entry, reg. D = incoming CRC +; reg. U = start address of data +; reg. X = number of bytes +; On exit, reg. D = updated CRC +; reg. U = points to first byte behind data +; reg. X = 0 +; reg. Y = 0 +; +; Value order in memory is H,L (big endian) +; +; Multiple passes over data in memory can be made to update the CRC. +; For XMODEM, initial CRC must be 0000. +; +; XMODEM setup: +; polynomic +CRCH EQU $10 +CRCL EQU $21 +; initial CRC +CRCINIT EQU $0000 + +; input parameters ... + ldu #s2 ; data (samples: s1 or s2) + ldb ,u+ + clra + tfr d,x ; data size + ldd #CRCINIT ; incoming CRC + +crc16: + +bl: + eora ,u+ ; fetch byte and XOR into CRC high byte + ldy #8 ; rotate loop counter +rl: aslb ; shift CRC left, first low + rola ; and than high byte + bcc cl ; Justify or ... + eora #CRCH ; CRC=CRC XOR polynomic, high + eorb #CRCL ; and low byte +cl: leay -1,y ; shift loop (8 bits) + bne rl + leax -1,x ; byte loop + bne bl + + ; CRC in D + +realexit: + sync + +s1: fcb 19,"An Arbitrary String" + ; CRC=$DDFC +s2: fcb 26,"ZYXWVUTSRQPONMLKJIHGFEDBCA" + ; CRC=$B199 + +enddata + + end diff -r 4fa2bdb0c457 -r 2088fd998865 examples/crc32.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/crc32.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,98 @@ +; 6809 CRC32 with tests +; +; Johann E. Klasek, j AT klasek at +; +; Testprogram, previous version submitted to http://beebwiki.mdfs.net/index.php/CRC-32#6809 + + org $100 + lds #$8000 + +; Calculate a ZIP 32-bit CRC from data in memory. This code is as +; tight and nearly as fast as it can be, moving as much code out of inner +; loops as possible. With the included optimisation, moving the whole +; CRC in registers, the performane gain on average data is only slight +; (estimated 2% but at losing clarity of implementation; +; worst case gain is 18%, best case worsens at 29%) +; +; On entry, crc..crc+3 = incoming CRC +; reg. U = start address of data +; reg. X = number of bytes +; On exit, crc..crc+3 = updated CRC +; reg. U = points to first byte behind data +; reg. X = 0 +; reg. Y = 0 +; +; Value order in memory is H,L (big endian) +; +; Multiple passes over data in memory can be made to update the CRC. +; For ZIP, initial CRC must be $FFFFFFFF, and the final CRC must +; be EORed with $FFFFFFFF before being stored in the ZIP file. +; Total 47 bytes (if above parameters are located in direct page). +; +; ZIP polynomic, reflected (bit reversed) from $04C11DB7 +CRCHH EQU $ED +CRCHL EQU $B8 +CRCLH EQU $83 +CRCLL EQU $20 +CRCINITH EQU $FFFF +CRCINITL EQU $FFFF + +; CRC 32 bit in DP (4 bytes) +crc EQU $80 + + ldu #s1 ; start address in u + ldb ,u+ ; + clra ; length in d + leax d,u ; + pshs x ; end address +1 to TOS + ldd #CRCINITL + std crc+2 + ldx #CRCINITH + stx crc + ; d/x contains the CRC +bl: + eorb ,u+ ; XOR with lowest byte + ldy #8 ; bit counter +rl: + exg d,x +rl1: + lsra ; shift CRC right, beginning with high word + rorb + exg d,x + rora ; low word + rorb + bcc cl + ; CRC=CRC XOR polynomic + eora #CRCLH ; apply CRC polynomic low word + eorb #CRCLL + exg d,x + eora #CRCHH ; apply CRC polynomic high word + eorb #CRCHL + leay -1,y ; bit count down + bne rl1 + exg d,x ; CRC: restore correct order + beq el ; leave bit loop +cl: + leay -1,y ; bit count down + bne rl ; bit loop +el: + cmpu ,s ; end address reached? + bne bl ; byte loop + + std crc+2 ; CRC low word + stx crc ; CRC high word + + +realexit: + sync + + +s1: fcb 19,"An Arbitrary String" + ; CRC=$90415518 + +s2: fcb 26,"ZYXWVUTSRQPONMLKJIHGFEDBCA" + ; CRC32=$6632024D + +enddata + + end diff -r 4fa2bdb0c457 -r 2088fd998865 examples/ef09.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/ef09.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,3326 @@ + ;TITLE 6809 eForth + +; $Id: ef09.asm,v 1.1 1997/11/24 02:56:01 root Exp $ +; +;=============================================================== +; +; eForth 1.0 by Bill Muench and C. H. Ting, 1990 +; Much of the code is derived from the following sources: +; 8086 figForth by Thomas Newman, 1981 and Joe smith, 1983 +; aFORTH by John Rible +; bFORTH by Bill Muench +; +; The goal of this implementation is to provide a simple eForth Model +; which can be ported easily to many 8, 16, 24 and 32 bit CPU's. +; The following attributes make it suitable for CPU's of the '90: +; +; small machine dependent kernel and portable high level code +; source code in the MASM format +; direct threaded code +; separated code and name dictionaries +; simple vectored terminal and file interface to host computer +; aligned with the proposed ANS Forth Standard +; easy upgrade path to optimize for specific CPU +; +; You are invited to implement this Model on your favorite CPU and +; contribute it to the eForth Library for public use. You may use +; a portable implementation to advertise more sophisticated and +; optimized version for commercial purposes. However, you are +; expected to implement the Model faithfully. The eForth Working +; Group reserves the right to reject implementation which deviates +; significantly from this Model. +; +; As the ANS Forth Standard is still evolving, this Model will +; change accordingly. Implementations must state clearly the +; version number of the Model being tracked. +; +; Representing the eForth Working Group in the Silicon Valley FIG Chapter. +; Send contributions to: +; +; Dr. C. H. Ting +; 156 14th Avenue +; San Mateo, CA 94402 +; (415) 571-7639 +; +;=============================================================== +; $Log: ef09.asm,v $ +; Revision 1.1 1997/11/24 02:56:01 root +; Initial revision +; +;=============================================================== +;; Version control + +VER EQU 1 ;major release version +EXT EQU 0 ;minor extension + +;; Constants + +TRUEE EQU -1 ;true flag + +COMPO EQU $40 ;lexicon compile only bit +IMEDD EQU $80 ;lexicon immediate bit +MASKK EQU $1F7F ;lexicon bit mask + +CFAOFF EQU 3 ;offset from word entry to code field area + ; (length of JSR) +CELLL EQU 2 ;size of a cell +BASEE EQU 10 ;default radix +VOCSS EQU 8 ;depth of vocabulary stack + +BKSPP EQU 8 ;back space +BKSPP2 EQU 127 ;back space +LF EQU 10 ;line feed +CRR EQU 13 ;carriage return +ERR EQU 27 ;error escape +TIC EQU 39 ;tick + +CALLL EQU $12BD ;NOP CALL opcodes + +;; Memory allocation + +EM EQU $4000 ;top of memory +US EQU 64*CELLL ;user area size in cells +RTS EQU 128*CELLL ;return stack/TIB size + +UPP EQU EM-US ;start of user area (UP0) +RPP EQU UPP-8*CELLL ;start of return stack (RP0) +TIBB EQU RPP-RTS ;terminal input buffer (TIB) +SPP EQU TIBB-8*CELLL ;start of data stack (SP0) + +COLDD EQU $100 ;cold start vector +CODEE EQU COLDD+US ;code dictionary +NAMEE EQU EM-$0400 ;name dictionary + +;; Initialize assembly variables + + +;; Main entry points and COLD start data + + + ORG COLDD ;beginning of cold boot area + SETDP 0 + +ORIG lds #SPP ;Init stack pointer. + ldy #RPP ;Init return stack pointer + ldu #COLD1 ;Init Instr pointer. + pulu pc ;next. + +; COLD start moves the following to USER variables. +; MUST BE IN SAME ORDER AS USER VARIABLES. + + +UZERO RMB 8 ;reserved space in user area + FDB SPP ;SP0 + FDB RPP ;RP0 + FDB QRX ;'?KEY + FDB TXSTO ;'EMIT + FDB ACCEP ;'EXPECT + FDB KTAP ;'TAP + FDB TXSTO ;'ECHO + FDB DOTOK ;'PROMPT + FDB BASEE ;BASE + FDB 0 ;tmp + FDB 0 ;SPAN + FDB 0 ;>IN + FDB 0 ;#TIB + FDB TIBB ;TIB + FDB 0 ;CSP + FDB INTER ;'EVAL + FDB NUMBQ ;'NUMBER + FDB 0 ;HLD + FDB 0 ;HANDLER + FDB 0 ;CONTEXT pointer + RMB VOCSS*2 ;vocabulary stack + FDB 0 ;CURRENT pointer + FDB 0 ;vocabulary link pointer + FDB CTOP ;CP + FDB NTOP ;NP + FDB LASTN ;LAST +ULAST + + ORG CODEE ;beginning of the code dictionary + +;; Device dependent I/O + +; BYE ( -- ) +; Exit eForth. + + FDB BYE,0 +L100 FCB 3,"BYE" +BYE sync + +; ?RX ( -- c T | F ) +; Return input character and true, or a false if no input. + + FDB QRX,L100 +L110 FCB 3,"?RX" +QRX ldx #0 + swi3 + bcc qrx1 + stx ,--s + pulu pc +qrx1 clra + std ,--s + leax -1,x + stx ,--s + pulu pc + +; TX! ( c -- ) +; Send character c to the output device. + FDB TXSTO,L110 +L120 FCB 3,"TX!" +TXSTO ldd ,s++ + cmpb #$ff + bne tx1 + ldb #32 +tx1 swi2 + pulu pc + + +; !IO ( -- ) +; Initialize the serial I/O devices. + + FDB STOIO,L120 +L130 FCB 3,"!IO" +STOIO pulu pc + +;; The kernel + +; doLIT ( -- w ) +; Push an inline literal. + + FDB DOLIT,L130 +L140 FCB COMPO+5,"doLIT" +DOLIT +;;;; ldd ,u++ + pulu d +; 7 cycles + pshs d +;;;; 8 cycles +;;;; std ,--s + pulu pc + +; doCLIT ( -- w ) +; Push an inline 8-bit literal. + + FDB DOCLIT,L140 +L141 FCB COMPO+6,"doCLIT" +DOCLIT + pulu b + sex ; sign extended + pshs d + pulu pc + +; doLIST ( a -- ) +; Process colon list. + + FDB DOLST,L141 +L150 FCB COMPO+6,"doLIST" +DOLST stu ,--y ; IP on return stack + puls u ; JSR left new IP on parameter stack +;;;; ldu ,s++ + pulu pc ; FORTH NEXT IP + +; next ( -- ) +; Run time code for the single index loop. +; : next ( -- ) \ hilevel model +; r> r> dup if 1 - >r @ >r exit then drop cell+ >r ; + + FDB DONXT,L150 +L160 FCB COMPO+4,"next" +DONXT ldd ,y ; counter on return stack + subd #1 ; decrement + bcs next1 ; < -> exit loop + std ,y ; decremented value back on stack + ldu ,u ; branch to begin of loop + pulu pc +next1 leay 2,y ; remove counter from stack + leau 2,u ; skip branch destination + pulu pc + + +; ?branch ( f -- ) +; Branch if flag is zero. + + FDB QBRAN,L160 +L170 FCB COMPO+7,"?branch" +QBRAN ;$CODE COMPO+7,'?branch',QBRAN + ldd ,s++ + beq bran1 + leau 2,u ; skip new IP, no branch + pulu pc +bran1 ldu ,u ; go to new IP + pulu pc + +; branch ( -- ) +; Branch to an inline address. + + FDB BRAN,L170 +L180 FCB COMPO+6,"branch" +BRAN ldu ,u ; destination immediate after BRANCH + pulu pc + +; EXECUTE ( ca -- ) +; Execute the word at ca. + + FDB EXECU,L180 +L190 FCB 7,"EXECUTE" +EXECU rts ; code pointer on parameter stack + +; EXIT ( -- ) +; SEMIS +; Terminate a colon definition. + + FDB EXIT,L190 +L200 FCB 4,"EXIT" +EXIT ldu ,y++ ; get calling IP from return stack + pulu pc + +; ! ( w a -- ) +; Pop the data stack to memory. + + FDB STORE,L200 +L210 FCB 1,"!" +STORE +;;;; ldx ,s++ +;;;; ldd ,s++ +;;;; faster ... + puls x + puls d + ; we cannot use puls x,d because the order fetched would be wrong :( + std ,x + pulu pc + +; @ ( a -- w ) +; Push memory location to the data stack. + + FDB AT,L210 +L220 FCB 1,"@" +AT ldd [,s] + std ,s + pulu pc + +; C! ( c b -- ) +; Pop the data stack to byte memory. + + FDB CSTOR,L220 +L230 FCB 2,"C!" +CSTOR +;;;; ldx ,s++ +;;;; ldd ,s++ +;;;; faster ... + puls x + puls d + ; we cannot use puls x,d because the order fetched would be wrong :( + stb ,x + pulu pc + + +; C@ ( b -- c ) +; Push byte memory location to the data stack. + + FDB CAT,L230 +L240 FCB 2,"C@" +CAT ldb [,s] + clra + std ,s + pulu pc + +; RP@ ( -- a ) +; Push the current RP to the data stack. + + FDB RPAT,L240 +L250 FCB 3,"RP@" +RPAT pshs y + pulu pc + +; RP! ( a -- ) +; Set the return stack pointer. + + FDB RPSTO,L250 +L260 FCB 3,"RP!" +RPSTO puls y + pulu pc + +; R> ( -- w ) +; Pop the return stack to the data stack. + + FDB RFROM,L260 +L270 FCB 2,"R>" +RFROM ldd ,y++ +;;;; std ,--s + pshs d + pulu pc + +; I ( -- w ) +; Copy top of return stack (current index from DO/LOOP) to the data stack. + + FDB RAT,L270 +L279 FCB 1,"I" + +; R@ ( -- w ) +; Copy top of return stack to the data stack. + + FDB RAT,L279 +L280 FCB 2,"R@" +RAT +I + ldd ,y +;;;; std ,--s + pshs d + pulu pc + +; >R ( w -- ) +; Push the data stack to the return stack. + + FDB TOR,L280 +L290 FCB 2,">R" +TOR +;;;; ldd ,s++ + puls d + std ,--y + pulu pc + +; SP@ ( -- a ) +; Push the current data stack pointer. + + FDB SPAT,L290 +L300 FCB 3,"SP@" +SPAT + tfr s,d + std ,--s +;;;; alternatively +;;;; sts ,--s ; does this work? + pulu pc + +; SP! ( a -- ) +; Set the data stack pointer. + + FDB SPSTO,L300 +L310 FCB 3,"SP!" +SPSTO lds ,s + pulu pc + +; DROP ( w -- ) +; Discard top stack item. + + FDB DROP,L310 +L320 FCB 4,"DROP" +DROP leas 2,s + pulu pc + +; DUP ( w -- w w ) +; Duplicate the top stack item. + + FDB DUPP,L320 +L330 FCB 3,"DUP" +DUPP ldd ,s +;;;; std ,--s + pshs d + pulu pc + +; SWAP ( w1 w2 -- w2 w1 ) +; Exchange top two stack items. + + FDB SWAP,L330 +L340 FCB 4,"SWAP" +SWAP +;;;;OLD 1: slow +;;;; ldx ,s++ +;;;; ldd ,s++ +;;;;OLD 2: faster +;;;; puls x +;;;; puls d +;;;; pshs d,x +;more efficient, without unnecessary stack pointer manipulations + ldd ,s + ldx 2,s + std 2,s + stx ,s + pulu pc + +; OVER ( w1 w2 -- w1 w2 w1 ) +; Copy second stack item to top. + + FDB OVER,L340 +L350 FCB 4,"OVER" +OVER ldd 2,s +;;;; std ,--s + pshs d + pulu pc + +; 0< ( n -- t ) +; Return true if n is negative. + + FDB ZLESS,L350 +L360 FCB 2,"0<" +ZLESS ldb ,s ; input high byte, as D low + sex ; sign extend to b to a/b + tfr a,b ; high byte: 0 or FF copy to D low + std ,s ; D: 0000 or FFFF (= -1) + pulu pc + +; 0= ( n -- t ) +; Return true if n is zero + + FDB ZEQUAL,L360 +L365 FCB 2,"0=" +ZEQUAL + ldx #TRUEE ; true + ldd ,s ; TOS + beq ZEQUAL1 ; -> true + ldx #0 ; false +ZEQUAL1 stx ,s ; D: 0000 or FFFF (= -1) + pulu pc + +; AND ( w w -- w ) +; Bitwise AND. + + FDB ANDD,L365 +L370 FCB 3,"AND" +ANDD ldd ,s++ + anda ,s + andb 1,s + std ,s + pulu pc + +; OR ( w w -- w ) +; Bitwise inclusive OR. + + FDB ORR,L370 +L380 FCB 2,"OR" +ORR ldd ,s++ + ora ,s + orb 1,s + std ,s + pulu pc + +; XOR ( w w -- w ) +; Bitwise exclusive OR. + + FDB XORR,L380 +L390 FCB 3,"XOR" +XORR ldd ,s++ + eora ,s + eorb 1,s + std ,s + pulu pc + +; D+ ( ud ud -- udsum ) +; Add two unsigned double numbers and return a double sum. + + FDB DPLUS,L390 +L391 FCB 2,"D+" +DPLUS ldd 2,s ; add low words + addd 6,s + std 6,s + ldd ,s ; add hig words + adcb 5,s + adca 4,s + std 4,s + leas 4,s ; drop one double + pulu pc + +; D- ( ud ud -- uddiff ) +; Subtract two unsigned double numbers and return a double sum. + + FDB DSUB,L391 +L392 FCB 2,"D-" +DSUB jsr DOLST + FDB DNEGA,DPLUS,EXIT + + +; UM+ ( u u -- udsum ) +; Add two unsigned single numbers and return a double sum. + + FDB UPLUS,L392 +L400 FCB 3,"UM+" +UPLUS ldd ,s + addd 2,s + std 2,s + ldd #0 + adcb #0 + std ,s + pulu pc + +;; Constants + +; doCONST ( -- w ) +; Run time routine for CONSTANT + + FDB DOCONST,L400 +L401 FCB COMPO+7,"doCONST" +DOCONST +FDOCONST + ldd [,s] ; contents of W (on TOS because of JSR) + std ,s ; to TOS (replacing W) + pulu pc + +; 0 ( -- 0 ) +; Constant 0 + + FDB ZERO,L401 +L402 FCB 1,"0" +ZERO jsr FDOCONST + FDB 0 + +; 1 ( -- 1 ) +; Constant 1 + + FDB ONE,L402 +L403 FCB 1,"1" +ONE jsr FDOCONST + FDB 1 + +; 2 ( -- 2 ) +; Constant 2 + + FDB TWO,L403 +L404 FCB 1,"2" +TWO jsr FDOCONST + FDB 2 + + +; -1 ( -- -1 ) +; Constant -1 + + FDB MONE,L404 +L405 FCB 2,"-1" +MONE jsr FDOCONST + FDB -1 + +;; System and user variables + +; doVAR ( -- a ) +; Run time routine for VARIABLE and CREATE. + + FDB DOVAR,L405 +L410 FCB COMPO+5,"doVAR" +DOVAR + jsr DOLST + FDB RFROM,EXIT + +;; fast native DOVAR implementation +FDOVAR pulu pc + + +; UP ( -- a ) +; Pointer to the user area. + + FDB UP,L410 +L420 FCB 2,"UP" +UP +;; jsr DOLST +;; FDB DOVAR +;; fast (native) DOVAR + jsr FDOVAR + FDB UPP + +; doUSER ( -- a ) +; Run time routine for user variables. + + FDB DOUSE,L420 +L430 FCB COMPO+5,"doUSER" +DOUSE + jsr DOLST + FDB RFROM,AT,UP,AT,PLUS,EXIT + +;; fast (native) DOUSE implementation (*NOT COMPLETE*) +FDOUSE + ldd [,s] ; pointer to value (from JSR) + addd UP+CFAOFF ; dirty access to start of USER area: + ; var. UP value direct access (not + ; as a high level word) + std ,s ; resulting address returned on p-stack + pulu pc + +; SP0 ( -- a ) +; Pointer to bottom of the data stack. + + FDB SZERO,L430 +L440 FCB 3,"SP0" +SZERO + jsr FDOUSE + FDB 8 +;;;; jsr DOLST +;;;; FDB DOUSE,8 + +; RP0 ( -- a ) +; Pointer to bottom of the return stack. + + FDB RZERO,L440 +L450 FCB 3,"RP0" +RZERO + jsr FDOUSE + FDB 10 +;;;; jsr DOLST +;;;; FDB DOUSE,10 + +; '?KEY ( -- a ) +; Execution vector of ?KEY. + + FDB TQKEY,L450 +L460 FCB 5,"'?KEY" +TQKEY + jsr FDOUSE + FDB 12 +;;;; jsr DOLST +;;;; FDB DOUSE,12 + +; 'EMIT ( -- a ) +; Execution vector of EMIT. + + FDB TEMIT,L460 +L470 FCB 5,"'EMIT" +TEMIT + jsr FDOUSE + FDB 14 +;; jsr DOLST +;; FDB DOUSE,14 + +; 'EXPECT ( -- a ) +; Execution vector of EXPECT. + + FDB TEXPE,L470 +L480 FCB 7,"'EXPECT" +TEXPE + jsr FDOUSE + FDB 16 +;;;; jsr DOLST +;;;; FDB DOUSE,16 + +; 'TAP ( -- a ) +; Execution vector of TAP. + + FDB TTAP,L480 +L490 FCB 4,"'TAP" +TTAP + jsr FDOUSE + FDB 18 +;;;; jsr DOLST +;;;; FDB DOUSE,18 + +; 'ECHO ( -- a ) +; Execution vector of ECHO. + + FDB TECHO,L490 +L500 FCB 5,"'ECHO" +TECHO + jsr FDOUSE + FDB 20 +;;;; jsr DOLST +;;;; FDB DOUSE,20 + +; 'PROMPT ( -- a ) +; Execution vector of PROMPT. + + FDB TPROM,L500 +L510 FCB 7,"'PROMPT" +TPROM + jsr FDOUSE + FDB 22 +;;;; jsr DOLST +;;;; FDB DOUSE,22 + + +; BASE ( -- a ) +; Storage of the radix base for numeric I/O. + + FDB BASE,L510 +L520 FCB 4,"BASE" +BASE + jsr FDOUSE + FDB 24 +;;;; jsr DOLST +;;;; FDB DOUSE,24 + +; tmp ( -- a ) +; A temporary storage location used in parse and find. + + FDB TEMP,L520 +L530 FCB COMPO+3,"tmp" +TEMP + jsr FDOUSE + FDB 26 +;;;; jsr DOLST +;;;; FDB DOUSE,26 + +; SPAN ( -- a ) +; Hold character count received by EXPECT. + + FDB SPAN,L530 +L540 FCB 4,"SPAN" +SPAN + jsr FDOUSE + FDB 28 +;;;; jsr DOLST +;;;; FDB DOUSE,28 + +; >IN ( -- a ) +; Hold the character pointer while parsing input stream. + + FDB INN,L540 +L550 FCB 3,">IN" +INN + jsr FDOUSE + FDB 30 +;;;; jsr DOLST +;;;; FDB DOUSE,30 + +; #TIB ( -- a ) +; Hold the current count in and address of the terminal input buffer. + + FDB NTIB,L550 +L560 FCB 4,"#TIB" +NTIB + jsr FDOUSE + FDB 32 +;;;; jsr DOLST +;;;; FDB DOUSE,32 ;It contains TWO cells!!!! + +; CSP ( -- a ) +; Hold the stack pointer for error checking. + + FDB CSP,L560 +L570 FCB 3,"CSP" +CSP + jsr FDOUSE + FDB 36 +;;;; jsr DOLST +;;;; FDB DOUSE 36 + +; 'EVAL ( -- a ) +; Execution vector of EVAL. + + FDB TEVAL,L570 +L580 FCB 5,"'EVAL" +TEVAL + jsr FDOUSE + FDB 38 +;;;; jsr DOLST +;;;; FDB DOUSE,38 + +; 'NUMBER ( -- a ) +; Execution vector of NUMBER?. + + FDB TNUMB,L580 +L590 FCB 7,"'NUMBER" +TNUMB + jsr FDOUSE + FDB 40 +;;;; jsr DOLST +;;;; FDB DOUSE,40 + +; HLD ( -- a ) +; Hold a pointer in building a numeric output string. + + FDB HLD,L590 +L600 FCB 3,"HLD" +HLD + jsr FDOUSE + FDB 42 +;;;; jsr DOLST +;;;; FDB DOUSE,42 + +; HANDLER ( -- a ) +; Hold the return stack pointer for error handling. + + FDB HANDL,L600 +L610 FCB 7,"HANDLER" +HANDL + jsr FDOUSE + FDB 44 +;;;; jsr DOLST +;;;; FDB DOUSE,44 + +; CONTEXT ( -- a ) +; A area to specify vocabulary search order. + + FDB CNTXT,L610 +L620 FCB 7,"CONTEXT" +CNTXT + jsr FDOUSE + FDB 46 +;;;; jsr DOLST +;;;; FDB DOUSE,46 ;plus space for voc stack. + +; CURRENT ( -- a ) +; Point to the vocabulary to be extended. + + FDB CRRNT,L620 +L630 FCB 7,"CURRENT" +CRRNT + jsr FDOUSE + FDB 48+VOCSS*2 ;Extra cell +;;;; jsr DOLST +;;;; FDB DOUSE,48+VOCSS*2 ;Extra cell + +; CP ( -- a ) +; Point to the top of the code dictionary. + + FDB CP,L630 +L640 FCB 2,"CP" +CP + jsr FDOUSE + FDB 52+VOCSS*2 +;;;; jsr DOLST +;;;; FDB DOUSE,52+VOCSS*2 + +; NP ( -- a ) +; Point to the bottom of the name dictionary. + + FDB NP,L640 +L650 FCB 2,"NP" +NP + jsr FDOUSE + FDB 54+VOCSS*2 +;;;; jsr DOLST +;;;; FDB DOUSE,54+VOCSS*2 + +; LAST ( -- a ) +; Point to the last name in the name dictionary. + + FDB LAST,L650 +L660 FCB 4,"LAST" +LAST + jsr FDOUSE + FDB 56+VOCSS*2 +;;;; jsr DOLST +;;;; FDB DOUSE,56+VOCSS*2 + +;; Common functions + +; doVOC ( -- ) +; Run time action of VOCABULARY's. + + FDB DOVOC,L660 +L670 FCB COMPO+5,"doVOC" +DOVOC + jsr DOLST + FDB RFROM,CNTXT,STORE,EXIT + +; FORTH ( -- ) +; Make FORTH the context vocabulary. + + FDB FORTH,L670 +L680 FCB 5,"FORTH" +FORTH + jsr DOLST + FDB DOVOC + FDB 0 ;vocabulary head pointer + FDB 0 ;vocabulary link pointer + +; ?DUP ( w -- w w | 0 ) +; Dup tos if its is not zero. + + FDB QDUP,L680 +L690 FCB 4,"?DUP" +QDUP + jsr DOLST + FDB DUPP + FDB QBRAN,QDUP1 + FDB DUPP +QDUP1 FDB EXIT + +; ROT ( w1 w2 w3 -- w2 w3 w1 ) +; Rot 3rd item to top. + + FDB ROT,L690 +L700 FCB 3,"ROT" +ROT + jsr DOLST + FDB TOR,SWAP,RFROM,SWAP,EXIT + +; 2DROP ( w w -- ) +; Discard two items on stack. + + FDB DDROP,L700 +L710 FCB 5,"2DROP" +DDROP + jsr DOLST + FDB DROP,DROP,EXIT + +; 2DUP ( w1 w2 -- w1 w2 w1 w2 ) +; Duplicate top two items. + + FDB DDUP,L710 +L720 FCB 4,"2DUP" +DDUP + jsr DOLST + FDB OVER,OVER,EXIT + +; LSHIFT ( w n -- w ) +; Shift word left n times. + FDB LSHIFT,L720 +L721 FCB 6,"LSHIFT" +LSHIFT ldx ,s++ ;shift count + beq LSHIFT2 + ldd ,s ;value to shift +LSHIFT1 aslb ;low + rola ;high + leax -1,x ;count down + bne LSHIFT1 + std ,s +LSHIFT2 + pulu pc + +; RSHIFT ( w n -- w ) +; Shift word right n times. + FDB RSHIFT,L721 +L721A FCB 6,"RSHIFT" +RSHIFT ldx ,s++ ;shift count + beq RSHIFT2 + ldd ,s ;value to shift +RSHIFT1 lsra ;high + rorb ;low + leax -1,x ;count down + bne RSHIFT1 + std ,s +RSHIFT2 + pulu pc + +; >< ( w -- w ) +; swap high and low byte + FDB SWAPHL,L721A +L722 FCB 2,"><" +SWAPHL ldb ,s ;high -> D low + lda 1,s ;low -> D high + std ,s + pulu pc + +; 256/ ( w -- w ) +; multiply with 256 (shift left 8 times) + FDB SLASH256,L722 +L723 FCB 4,"256/" +SLASH256 ldb ,s ;high -> D low + clra ;D high = 0 + std ,s + pulu pc + +; 256* ( w -- w ) +; multiply with 256 (shift left 8 times) + FDB STAR256,L723 +L724 FCB 4,"256*" +STAR256 lda 1,s ;low -> D high + clrb ;D low = 0 + std ,s + pulu pc + +; 1+ ( w -- w ) +; Shortcut, quick add 1 + FDB PLUS1,L724 +L725 FCB 2,"1+" +PLUS1 ldd ,s + addd #1 + std ,s + pulu pc + +; -+ ( w -- w ) +; Shortcut, quick subtract 1 + FDB MINUS1,L725 +L726 FCB 2,"1-" +MINUS1 ldd ,s + subd #1 + std ,s + pulu pc + +; 2* ( w -- w ) +; multiply by 2 using shift operation + FDB TWOSTAR,L726 +L727 FCB 2,"2*" +TWOSTAR asl 1,s ;low + rol 0,s ;high + pulu pc + +; 2/ ( w -- w ) +; divide by 2 using shift operation + FDB TWOSLASH,L727 +L728 FCB 2,"2/" +TWOSLASH asr 0,s ;high + ror 1,s ;low + pulu pc + +; + ( w w -- sum ) +; Add top two items. + + FDB PLUS,L728 +L730 FCB 1,"+" +PLUS + ldd ,s++ + addd ,s + std ,s + pulu pc +;;; HL with UPLUS!? Too inefficient ... +;;; jsr DOLST +;;; FDB UPLUS,DROP,EXIT + +; NOT ( w -- w ) +; One's complement of tos. + + FDB INVER,L730 +L740 FCB 3,"NOT" +INVER +;;;; fastest ... (13T) + com ,s ; 6T + com 1,s ; 7T + pulu pc +;;;; alternative ... (14T) + ldd ,s ;TOS 5T + coma ; 2T + comb ; 2T + std ,s ; 5T + pulu pc +;;; slow HL ... +;;; jsr DOLST +;;; FDB DOLIT,-1,XORR,EXIT + +; NEGATE ( n -- -n ) +; Two's complement of tos. + + FDB NEGAT,L740 +L750 FCB 6,"NEGATE" +NEGAT +;;;; fastest? .... (3+6+5 = 14T) + ldd #0 ; 3T + subd ,s ; 6T + std ,s ; 5T + pulu pc +;;;; alternate ... (7+3+6 = 16T) + neg 1,s ; high 7T + bne NEGAT1 ; 3T + neg ,s ; low with 1+ carry 6T + pulu pc +NEGAT1 com ,s ; low, no 1+ carry 6T + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB INVER,PLUS1,EXIT + +; DNEGATE ( d -- -d ) +; Two's complement of top double. + + FDB DNEGA,L750 +L760 FCB 7,"DNEGATE" +DNEGA + ldd #0 + subd 2,s ; low word + std 2,s + ldd #0 + sbcb 1,s ; high word low byte + sbca ,s ; high word high byte + std ,s + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB INVER,TOR,INVER +;;;; FDB DOLIT,1,UPLUS +;;;; FDB RFROM,PLUS,EXIT + +; - ( n1 n2 -- n1-n2 ) +; Subtraction. + + FDB SUBB,L760 +L770 FCB 1,"-" +SUBB ldd 2,s + subd ,s++ + std ,s + pulu pc +;;; slow HL ... +;;; jsr DOLST +;;; FDB NEGAT,PLUS,EXIT + +; ABS ( n -- n ) +; Return the absolute value of n. + + FDB ABSS,L770 +L780 FCB 3,"ABS" +ABSS jsr DOLST + FDB DUPP,ZLESS + FDB QBRAN,ABS1 + FDB NEGAT +ABS1 FDB EXIT + +; = ( w w -- t ) +; Return true if top two are equal. + + FDB EQUAL,L780 +L790 FCB 1,"=" +EQUAL + ldx #TRUEE + puls d ; first value + cmpd ,s ; compare to 2nd value + beq EQUAL1 ; equal -> true + ldx #0 ; false (leax 1,x save 1 byte, but is slower) +EQUAL1 stx ,s + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB XORR +;;;; FDB QBRAN,EQU1 +;;;; FDB DOLIT,0,EXIT +;;;;EQU1: FDB DOLIT,TRUEE,EXIT + +; U< ( u1 u2 -- t ) +; Unsigned compare of top two items. + + FDB ULESS,L790 +L800 FCB 2,"U<" +ULESS + ldx #TRUEE ; true + puls d ; u2 + cmpd ,s ; u2 - u1 + bhi ULES1 ; unsigned: u2 higher u1 + ldx #0 ; false +ULES1 stx ,s ; replace TOS with result + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB DDUP,XORR,ZLESS +;;;; FDB QBRAN,ULES1 +;;;; FDB SWAP,DROP,ZLESS,EXIT +;;;;ULES1: FDB SUBB,ZLESS,EXIT + +; < ( n1 n2 -- t ) +; Signed compare of top two items. + + FDB LESS,L800 +L810 FCB 1,"<" +LESS + ldx #TRUEE ; true + puls d ; n2 + cmpd ,s ; n2 - n1 + bgt LESS1 ; signed: n2 greater than n1 + ldx #0 ; false +LESS1 stx ,s ; replace TOS with result + pulu pc + +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB DDUP,XORR,ZLESS +;;;; FDB QBRAN,LESS1 +;;;; FDB DROP,ZLESS,EXIT +;;;;LESS1: FDB SUBB,ZLESS,EXIT + +; MAX ( n n -- n ) +; Return the greater of two top stack items. + + FDB MAX,L810 +L820 FCB 3,"MAX" +MAX jsr DOLST + FDB DDUP,LESS + FDB QBRAN,MAX1 + FDB SWAP +MAX1 FDB DROP,EXIT + +; MIN ( n n -- n ) +; Return the smaller of top two stack items. + + FDB MIN,L820 +L830 FCB 3,"MIN" +MIN jsr DOLST + FDB DDUP,SWAP,LESS + FDB QBRAN,MIN1 + FDB SWAP +MIN1 FDB DROP,EXIT + +; WITHIN ( u ul uh -- t ) +; Return true if u is within the range of ul and uh. ( ul <= u < uh ) + + FDB WITHI,L830 +L840 FCB 6,"WITHIN" +WITHI jsr DOLST + FDB OVER,SUBB,TOR + FDB SUBB,RFROM,ULESS,EXIT + +;; Divide + +; U/ ( udl udh un -- ur uq ) +; Unsigned divide of a double by a single. Return mod and quotient. +; +; Special cases: +; 1. overflow: quotient overflow if dividend is to great (remainder = divisor), +; remainder is set to $FFFF -> special handling. +; This is checked also right before the main loop. +; 2. underflow: divisor does not fit into dividend -> remainder +; get the value of the dividend -> automatically covered. +; +; overflow: quotient = $FFFF, remainder = divisor +; underflow: quotient = $0000, remainder = dividend low +; division by zero: quotient = $FFFF, remainder = $0000 +; +; Testvalues: +; +; DIVH DIVL DVSR QUOT REM comment +; +; 0100 0000 FFFF 0100 0100 maximum divisor +; 0000 0001 8000 0000 0001 underflow (REM = DIVL) +; 0000 5800 3000 0001 1800 normal divsion +; 5800 0000 3000 FFFF 3000 overflow +; 0000 0001 0000 FFFF 0000 overflow (division by zero) + + FDB USLASH,L840 +L845 FCB 2,"U/" + +USLASH + ldx #16 + ldd 2,s ; udh + cmpd ,s ; dividend to great? + bhs UMMODOV ; quotient overflow! + asl 5,s ; udl low + rol 4,s ; udl high + +UMMOD1 rolb ; got one bit from udl + rola + bcs UMMOD2 ; bit 16 means always greater as divisor + cmpd ,s ; divide by un + bhs UMMOD2 ; higher or same as divisor? + andcc #$fe ; clc - clear carry flag + bra UMMOD3 +UMMOD2 subd ,s + orcc #$01 ; sec - set carry flag +UMMOD3 rol 5,s ; udl, quotient shifted in + rol 4,s + leax -1,x + bne UMMOD1 + + ldx 4,s ; quotient + cmpd ,s ; remainder >= divisor -> overflow + blo UMMOD4 +UMMODOV + ldd ,s ; remainder set to divisor + ldx #$FFFF ; quotient = FFFF (-1) marks overflow + ; (case 1) +UMMOD4 + leas 2,s ; un (divisor thrown away) + stx ,s ; quotient to TOS + std 2,s ; remainder 2nd + + pulu pc ; NEXT + + +; UM/MOD ( udl udh un -- ur uq ) +; Unsigned divide of a double by a single. Return mod and quotient. + + FDB UMMOD,L845 +L850 FCB 6,"UM/MOD" +UMMOD + jmp USLASH +;;;; slow HL ... + jsr DOLST + FDB DDUP,ULESS + FDB QBRAN,UMM4 + FDB NEGAT,DOLIT,15,TOR +UMM1 FDB TOR,DUPP,UPLUS + FDB TOR,TOR,DUPP,UPLUS + FDB RFROM,PLUS,DUPP + FDB RFROM,RAT,SWAP,TOR + FDB UPLUS,RFROM,ORR + FDB QBRAN,UMM2 + FDB TOR,DROP,PLUS1,RFROM + FDB BRAN,UMM3 +UMM2 FDB DROP +UMM3 FDB RFROM + FDB DONXT,UMM1 + FDB DROP,SWAP,EXIT +UMM4 FDB DROP,DDROP + FDB DOLIT,-1,DUPP,EXIT + +; M/MOD ( d n -- r q ) +; Signed floored divide of double by single. Return mod and quotient. + + FDB MSMOD,L850 +L860 FCB 5,"M/MOD" +MSMOD + jsr DOLST + FDB DUPP,ZLESS,DUPP,TOR + FDB QBRAN,MMOD1 + FDB NEGAT,TOR,DNEGA,RFROM +MMOD1 FDB TOR,DUPP,ZLESS + FDB QBRAN,MMOD2 + FDB RAT,PLUS +MMOD2 FDB RFROM,UMMOD,RFROM + FDB QBRAN,MMOD3 + FDB SWAP,NEGAT,SWAP +MMOD3 FDB EXIT + +; /MOD ( n n -- r q ) +; Signed divide. Return mod and quotient. + + FDB SLMOD,L860 +L870 FCB 4,"/MOD" +SLMOD jsr DOLST + FDB OVER,ZLESS,SWAP,MSMOD,EXIT + +; MOD ( n n -- r ) +; Signed divide. Return mod only. + + FDB MODD,L870 +L880 FCB 3,"MOD" +MODD jsr DOLST + FDB SLMOD,DROP,EXIT + +; / ( n n -- q ) +; Signed divide. Return quotient only. + + FDB SLASH,L880 +L890 FCB 1,"/" +SLASH + jsr DOLST + FDB SLMOD,SWAP,DROP,EXIT + +;; Multiply + +; UM* ( u u -- ud ) +; Unsigned multiply. Return double product. + + FDB UMSTA,L890 +L900 FCB 3,"UM*" +UMSTA + ldx #17 ; 16 adds and 17 shifts ... + clra ; result high word + clrb + bra UUMSTA3 +UUMSTA1 bcc UUMSTA2 + addd ,s +UUMSTA2 rora ; high, result high word + rorb ; low, result high word +UUMSTA3 ror 2,s ; shift multiplier high, result low word + ror 3,s ; shift multiplier low, result low word + leax -1,x + bne UUMSTA1 + std ,s + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB DOLIT,0,SWAP,DOLIT,15,TOR +;;;;UMST1: FDB DUPP,UPLUS,TOR,TOR +;;;; FDB DUPP,UPLUS,RFROM,PLUS,RFROM +;;;; FDB QBRAN,UMST2 +;;;; FDB TOR,OVER,UPLUS,RFROM,PLUS +;;;;UMST2: FDB DONXT,UMST1 +;;;; FDB ROT,DROP,EXIT + +; _UM* ( u u -- ud ) +; Unsigned multiply. Return double product. + + FDB UUMSTA,L900 +L900A FCB 4,"_UM*" +UUMSTA + jsr DOLST + FDB DOLIT,0,SWAP,DOLIT,15,TOR +UMST1 FDB DUPP,UPLUS,TOR,TOR + FDB DUPP,UPLUS,RFROM,PLUS,RFROM + FDB QBRAN,UMST2 + FDB TOR,OVER,UPLUS,RFROM,PLUS +UMST2 FDB DONXT,UMST1 + FDB ROT,DROP,EXIT + +; * ( n n -- n ) +; Signed multiply. Return single product. +; XXX Not really signed, -200 -200 * -> -25536 + + FDB STAR,L900A +L910 FCB 1,"*" +STAR + jsr DOLST + FDB MSTAR,DROP,EXIT + +; M* ( n n -- d ) +; Signed multiply. Return double product. + + FDB MSTAR,L910 +L920 FCB 2,"M*" +MSTAR + jsr DOLST + FDB DDUP,XORR,ZLESS,TOR + FDB ABSS,SWAP,ABSS,UMSTA + FDB RFROM + FDB QBRAN,MSTA1 + FDB DNEGA +MSTA1 FDB EXIT + +; */MOD ( n1 n2 n3 -- r q ) +; Multiply n1 and n2, then divide by n3. Return mod and quotient. + + FDB SSMOD,L920 +L930 FCB 5,"*/MOD" +SSMOD jsr DOLST + FDB TOR,MSTAR,RFROM,MSMOD,EXIT + +; */ ( n1 n2 n3 -- q ) +; Multiply n1 by n2, then divide by n3. Return quotient only. + + FDB STASL,L930 +L940 FCB 2,"*/" +STASL jsr DOLST + FDB SSMOD,SWAP,DROP,EXIT + +;; Miscellaneous + +; CELL+ ( a -- a ) +; Add cell size in byte to address. + + FDB CELLP,L940 +L950 FCB 5,"CELL+" +CELLP jsr DOLST + FDB DOCLIT + FCB CELLL + FDB PLUS,EXIT + +; CELL- ( a -- a ) +; Subtract cell size in byte from address. + + FDB CELLM,L950 +L960 FCB 5,"CELL-" +CELLM jsr DOLST + FDB DOCLIT + FCB 0-CELLL + FDB PLUS,EXIT + +; CELLS ( n -- n ) +; Multiply tos by cell size in bytes. + + FDB CELLS,L960 +L970 FCB 5,"CELLS" +CELLS jsr DOLST + FDB DOCLIT + FCB CELLL + FDB STAR,EXIT + +; ALIGNED ( b -- a ) +; Align address to the cell boundary. + + FDB ALGND,L970 +L975 FCB 7,"ALIGNED" +ALGND jsr DOLST + FDB EXIT + +; BL ( -- 32 ) +; Return 32, the blank character. + + FDB BLANK,L975 +L980 FCB 2,"BL" +BLANK + jsr DOCONST + FDB ' ' +;;; jsr DOLST +;;; FDB DOLIT,' ',EXIT + +; >CHAR ( c -- c ) +; Filter non-printing characters. + + FDB TCHAR,L980 +L990 FCB 5,">CHAR" +TCHAR jsr DOLST + FDB DOLIT,$7F,ANDD,DUPP ;mask msb + FDB DOCLIT + FCB 127 + FDB BLANK,WITHI ;check for printable + FDB QBRAN,TCHA1 + FDB DROP,DOLIT,'_' ;replace non-printables +TCHA1 FDB EXIT + +; DEPTH ( -- n ) +; Return the depth of the data stack. + + FDB DEPTH,L990 +L1000 FCB 5,"DEPTH" +DEPTH jsr DOLST + FDB SPAT,SZERO,AT,SWAP,SUBB + FDB DOCLIT + FCB CELLL + FDB SLASH,EXIT + +; PICK ( ... +n -- ... w ) +; Copy the nth stack item to tos. + + FDB PICK,L1000 +L1010 FCB 4,"PICK" +PICK + ldd ,s + addd #1 ; correct index + aslb ; CELLL* (ASSERT: CELLL=2!!!) + rola + ldx d,s ; pick value + stx ,s ; replace TOP + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB PLUS1,CELLS +;;;; FDB SPAT,PLUS,AT,EXIT + + +; ROLL ( ... +n -- ... w ) +; Copy the nth stack item to tos. + + FDB ROLL,L1010 +L1015 FCB 4,"ROLL" +ROLL +;;;; XXX als Primitive! +;;;; slow HL ... + jsr DOLST + FDB DUPP,TWO + FDB LESS,QBRAN,ROL1 + FDB DROP,BRAN,ROL2 +ROL1 FDB SWAP,TOR,ONE + FDB SUBB + FDB ROLL,RFROM,SWAP +ROL2 FDB EXIT + +;; Memory access + +; +! ( n a -- ) +; Add n to the contents at address a. + + FDB PSTOR,L1015 +L1020 FCB 2,"+!" +PSTOR + puls x ; address + puls d ; value + addd ,x ; add to value from address + std ,x ; store back + pulu pc + +;;;; XXX als Primitive! +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB SWAP,OVER,AT,PLUS +;;;; FDB SWAP,STORE,EXIT + +; 2! ( d a -- ) +; Store the double integer to address a. + + FDB DSTOR,L1020 +L1030 FCB 2,"2!" +DSTOR +;;;; XXX als Primitive! +;;;; slow HL ... + jsr DOLST + FDB SWAP,OVER,STORE + FDB CELLP,STORE,EXIT + +; 2@ ( a -- d ) +; Fetch double integer from address a. + + FDB DAT,L1030 +L1040 FCB 2,"2@" +DAT +;;;; XXX als Primitive! +;;;; slow HL ... + jsr DOLST + FDB DUPP,CELLP,AT + FDB SWAP,AT,EXIT + +; COUNT ( b -- b +n ) +; Return count byte of a string and add 1 to byte address. + + FDB COUNT,L1040 +L1050 FCB 5,"COUNT" +COUNT jsr DOLST + FDB DUPP,PLUS1 + FDB SWAP,CAT,EXIT + +; HERE ( -- a ) +; Return the top of the code dictionary. + + FDB HERE,L1050 +L1060 FCB 4,"HERE" +HERE jsr DOLST + FDB CP,AT,EXIT + +; PAD ( -- a ) +; Return the address of the text buffer above the code dictionary. + + FDB PAD,L1060 +L1070 FCB 3,"PAD" +PAD jsr DOLST + FDB HERE,DOLIT,80,PLUS,EXIT + +; TIB ( -- a ) +; Return the address of the terminal input buffer. + + FDB TIB,L1070 +L1080 FCB 3,"TIB" +TIB jsr DOLST + FDB NTIB,CELLP,AT,EXIT + +; @EXECUTE ( a -- ) +; Execute vector stored in address a. + + FDB ATEXE,L1080 +L1090 FCB 8,"@EXECUTE" +ATEXE jsr DOLST + FDB AT,QDUP ;?address or zero + FDB QBRAN,EXE1 + FDB EXECU ;execute if non-zero +EXE1 FDB EXIT ;do nothing if zero + +; CMOVE ( b1 b2 u -- ) +; Copy u bytes from b1 to b2. + + FDB CMOVE,L1090 +L1100 FCB 5,"CMOVE" +CMOVE + jmp CMOVEW + ldd ,s ;count + beq CMOVE3 ;zero -> leave + tstb ;count low + beq CMOVE1 + inc ,s ;ajust high for to-0 decrementation +CMOVE1 + ldx 2,s ;to addr + stu 2,s ;save reg on stack + ldu 4,s ;from addr +CMOVE2 lda ,u+ ;from -> + sta ,x+ ;to + decb ;low count + bne CMOVE2 + dec ,s ;high count + bne CMOVE2 + ldu 2,s +CMOVE3 leas 6,s ;drop 3 parameters from stack + pulu pc +;;;; +;;;; alternative, wordwise copy ... +CMOVEW ldd ,s ; count + ldx 2,s ; destination + sty ,s ; save RP + stu 2,s ; save IP + ldy 4,s ; source + lsra ; divide by 2, count words + rorb ; + pshs cc + beq CMOVEW1 ; byte decrement correction + inca ; byte decrement high byte correction +CMOVEW1 subd #0 ; word count zero (=65536)? + beq CMOVEW3 +CMOVEW2 ldu ,y++ ; source + stu ,x++ ; destination + decb ; count low + bne CMOVEW2 + deca ; count high (count to 0 corrected) + bne CMOVEW2 +CMOVEW3 puls CC ; check if odd count? + bcc CMOVEW4 + lda ,y + sta ,x +CMOVEW4 puls y,u ; y first + leas 2,s ; drop 3rd parameter + pulu pc ; next +;;;; +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB TOR +;;;; FDB BRAN,CMOV2 +;;;;CMOV1: FDB TOR,DUPP,CAT +;;;; FDB RAT,CSTOR +;;;; FDB PLUS1 +;;;; FDB RFROM,PLUS1 +;;;;CMOV2: FDB DONXT,CMOV1 +;;;; FDB DDROP,EXIT +;;;; + +; FILL ( b u c -- ) +; Fill u bytes of character c to area beginning at b. + + FDB FILL,L1100 +L1110 FCB 4,"FILL" +FILL + ldd 2,s ;count + beq NFILL3 ;zero -> leave + tstb ;count low + beq NFILL1 + inc 2,s ;ajust high for to-0 decrementation +NFILL1 + ldx 4,s ;to addr + lda 1,s ;fill byte, low byte from TOS +NFILL2 + sta ,x+ ;to + decb ;low count + bne NFILL2 + dec 2,s ;high count + bne NFILL2 +NFILL3 leas 6,s ;drop 3 parameters from stack + pulu pc +;;;; slow HL ... +;;;; jsr DOLST +;;;; FDB SWAP,TOR,SWAP +;;;; FDB BRAN,FILL2 +;;;;FILL1: FDB DDUP,CSTOR,PLUS1 +;;;;FILL2: FDB DONXT,FILL1 +;;;; FDB DDROP,EXIT + +; -TRAILING ( b u -- b u ) +; Adjust the count to eliminate trailing white space. + + FDB DTRAI,L1110 +L1120 FCB 9,"-TRAILING" +DTRAI jsr DOLST + FDB TOR + FDB BRAN,DTRA2 +DTRA1 FDB BLANK,OVER,RAT,PLUS,CAT,LESS + FDB QBRAN,DTRA2 + FDB RFROM,PLUS1,EXIT +DTRA2 FDB DONXT,DTRA1 + FDB ZERO,EXIT + +; PACK$ ( b u a -- a ) +; Build a counted string with u characters from b. Null fill. + + FDB PACKS,L1120 +L1130 FCB 5,"PACK$" +PACKS jsr DOLST + FDB DUPP,TOR ;strings only on cell boundary + FDB DDUP,CSTOR + FDB PLUS1 ;count mod cell + FDB DDUP,PLUS + FDB ZERO,SWAP,CSTOR ;null fill cell + FDB SWAP,CMOVE,RFROM,EXIT ;move string + +;; Numeric output, single precision + +; DIGIT ( u -- c ) +; Convert digit u to a character. + + FDB DIGIT,L1130 +L1140 FCB 5,"DIGIT" +DIGIT jsr DOLST + FDB DOCLIT + FCB 9 + FDB OVER,LESS + FDB DOCLIT + FCB 7 + FDB ANDD,PLUS + FDB DOLIT,'0',PLUS,EXIT + +; EXTRACT ( n base -- n c ) +; Extract the least significant digit from n. + + FDB EXTRC,L1140 +L1150 FCB 7,"EXTRACT" +EXTRC jsr DOLST + FDB ZERO,SWAP,UMMOD + FDB SWAP,DIGIT,EXIT + +; <# ( -- ) +; Initiate the numeric output process. + + FDB BDIGS,L1150 +L1160 FCB 2,"<#" +BDIGS jsr DOLST + FDB PAD,HLD,STORE,EXIT + +; HOLD ( c -- ) +; Insert a character into the numeric output string. + + + FDB HOLD,L1160 +L1170 FCB 4,"HOLD" +HOLD jsr DOLST + FDB HLD,AT,MINUS1 + FDB DUPP,HLD,STORE,CSTOR,EXIT + +; # ( u -- u ) +; Extract one digit from u and append the digit to output string. + + FDB DIG,L1170 +L1180 FCB 1,"#" +DIG jsr DOLST + FDB BASE,AT,EXTRC,HOLD,EXIT + +; #S ( u -- 0 ) +; Convert u until all digits are added to the output string. + + FDB DIGS,L1180 +L1190 FCB 2,"#S" +DIGS jsr DOLST +DIGS1 FDB DIG,DUPP + FDB QBRAN,DIGS2 + FDB BRAN,DIGS1 +DIGS2 FDB EXIT + +; SIGN ( n -- ) +; Add a minus sign to the numeric output string. + + FDB SIGN,L1190 +L1200 FCB 4,"SIGN" +SIGN jsr DOLST + FDB ZLESS + FDB QBRAN,SIGN1 + FDB DOLIT,'-',HOLD +SIGN1 FDB EXIT + +; #> ( w -- b u ) +; Prepare the output string to be TYPE'd. + + FDB EDIGS,L1200 +L1210 FCB 2,"#>" +EDIGS jsr DOLST + FDB DROP,HLD,AT + FDB PAD,OVER,SUBB,EXIT + +; str ( w -- b u ) +; Convert a signed integer to a numeric string. + + FDB STR,L1210 +L1220 FCB 3,"str" +STR jsr DOLST + FDB DUPP,TOR,ABSS + FDB BDIGS,DIGS,RFROM + FDB SIGN,EDIGS,EXIT + +; HEX ( -- ) +; Use radix 16 as base for numeric conversions. + + FDB HEX,L1220 +L1230 FCB 3,"HEX" +HEX jsr DOLST + FDB DOCLIT + FCB 16 + FDB BASE,STORE,EXIT + +; DECIMAL ( -- ) +; Use radix 10 as base for numeric conversions. + + FDB DECIM,L1230 +L1240 FCB 7,"DECIMAL" +DECIM jsr DOLST + FDB DOCLIT + FCB 10 + FDB BASE,STORE,EXIT + +;; Numeric input, single precision + +; DIGIT? ( c base -- u t ) +; Convert a character to its numeric value. A flag indicates success. + + FDB DIGTQ,L1240 +L1250 FCB 6,"DIGIT?" +DIGTQ jsr DOLST + FDB TOR,DOLIT,'0',SUBB + FDB DOCLIT + FCB 9 + FDB OVER,LESS + FDB QBRAN,DGTQ1 + FDB DOCLIT + FCB 7 + FDB SUBB + FDB DUPP,DOLIT,10,LESS,ORR +DGTQ1 FDB DUPP,RFROM,ULESS,EXIT + +; NUMBER? ( a -- n T | a F ) +; Convert a number string to integer. Push a flag on tos. + + FDB NUMBQ,L1250 +L1260 FCB 7,"NUMBER?" +NUMBQ jsr DOLST + FDB BASE,AT,TOR,ZERO,OVER,COUNT + FDB OVER,CAT,DOLIT,'$',EQUAL + FDB QBRAN,NUMQ1 + FDB HEX,SWAP,PLUS1 + FDB SWAP,MINUS1 +NUMQ1 FDB OVER,CAT,DOLIT,'-',EQUAL,TOR + FDB SWAP,RAT,SUBB,SWAP,RAT,PLUS,QDUP + FDB QBRAN,NUMQ6 + FDB MINUS1,TOR +NUMQ2 FDB DUPP,TOR,CAT,BASE,AT,DIGTQ + FDB QBRAN,NUMQ4 + FDB SWAP,BASE,AT,STAR,PLUS,RFROM + FDB PLUS1 + FDB DONXT,NUMQ2 + FDB RAT,SWAP,DROP + FDB QBRAN,NUMQ3 + FDB NEGAT +NUMQ3 FDB SWAP + FDB BRAN,NUMQ5 +NUMQ4 FDB RFROM,RFROM,DDROP,DDROP,ZERO +NUMQ5 FDB DUPP +NUMQ6 FDB RFROM,DDROP + FDB RFROM,BASE,STORE,EXIT + +;; Basic I/O + +; ?KEY ( -- c T | F ) +; Return input character and true, or a false if no input. + + + FDB QKEY,L1260 +L1270 FCB 4,"?KEY" +QKEY jsr DOLST + FDB TQKEY,ATEXE,EXIT + +; KEY ( -- c ) +; Wait for and return an input character. + + FDB KEY,L1270 +L1280 FCB 3,"KEY" +KEY jsr DOLST +KEY1 FDB QKEY + FDB QBRAN,KEY1 + FDB EXIT + +; EMIT ( c -- ) +; Send a character to the output device. + + FDB EMIT,L1280 +L1290 FCB 4,"EMIT" +EMIT jsr DOLST + FDB TEMIT,ATEXE,EXIT + +; NUF? ( -- t ) +; Return false if no input, else pause and if CR return true. + + FDB NUFQ,L1290 +L1300 FCB 4,"NUF?" +NUFQ jsr DOLST + FDB QKEY,DUPP + FDB QBRAN,NUFQ1 + FDB DDROP,KEY,DOCLIT + FCB CRR + FDB EQUAL +NUFQ1 FDB EXIT + +; PACE ( -- ) +; Send a pace character for the file downloading process. + + FDB PACE,L1300 +L1310 FCB 4,"PACE" +PACE jsr DOLST + FDB DOCLIT + FCB 11 + FDB EMIT,EXIT + +; SPACE ( -- ) +; Send the blank character to the output device. + + FDB SPACE,L1310 +L1320 FCB 5,"SPACE" +SPACE jsr DOLST + FDB BLANK,EMIT,EXIT + +; SPACES ( +n -- ) +; Send n spaces to the output device. + + FDB SPACS,L1320 +L1330 FCB 6,"SPACES" +SPACS jsr DOLST + FDB ZERO,MAX,TOR + FDB BRAN,CHAR2 +CHAR1 FDB SPACE +CHAR2 FDB DONXT,CHAR1 + FDB EXIT + +; TYPE ( b u -- ) +; Output u characters from b. + + FDB TYPES,L1330 +L1340 FCB 4,"TYPE" +TYPES jsr DOLST + FDB TOR + FDB BRAN,TYPE2 +TYPE1 FDB DUPP,CAT,EMIT + FDB PLUS1 +TYPE2 FDB DONXT,TYPE1 + FDB DROP,EXIT + +; CR ( -- ) +; Output a carriage return and a line feed. + + FDB CR,L1340 +L1350 FCB 2,"CR" +CR jsr DOLST + FDB DOCLIT + FCB CRR + FDB EMIT + FDB DOCLIT + FCB LF + FDB EMIT,EXIT + +; do$ ( -- a ) +; Return the address of a compiled string. + + FDB DOSTR,L1350 +L1360 FCB COMPO+3,"do$" +DOSTR jsr DOLST + FDB RFROM,RAT,RFROM,COUNT,PLUS + FDB ALGND,TOR,SWAP,TOR,EXIT + +; $"| ( -- a ) +; Run time routine compiled by $". Return address of a compiled string. + + FDB STRQP,L1360 +L1370 FCB COMPO+3,'$','"','|' +STRQP jsr DOLST + FDB DOSTR,EXIT ;force a call to do$ + +; ."| ( -- ) +; Run time routine of ." . Output a compiled string. + + FDB DOTQP,L1370 +L1380 FCB COMPO+3,'.','"','|' +DOTQP jsr DOLST + FDB DOSTR,COUNT,TYPES,EXIT + +; .R ( n +n -- ) +; Display an integer in a field of n columns, right justified. + + FDB DOTR,L1380 +L1390 FCB 2,".R" +DOTR jsr DOLST + FDB TOR,STR,RFROM,OVER,SUBB + FDB SPACS,TYPES,EXIT + +; U.R ( u +n -- ) +; Display an unsigned integer in n column, right justified. + + FDB UDOTR,L1390 +L1400 FCB 3,"U.R" +UDOTR jsr DOLST + FDB TOR,BDIGS,DIGS,EDIGS + FDB RFROM,OVER,SUBB + FDB SPACS,TYPES,EXIT + +; U. ( u -- ) +; Display an unsigned integer in free format. + + FDB UDOT,L1400 +L1410 FCB 2,"U." +UDOT jsr DOLST + FDB BDIGS,DIGS,EDIGS + FDB SPACE,TYPES,EXIT + +; . ( w -- ) +; Display an integer in free format, preceeded by a space. + + FDB DOT,L1410 +L1420 FCB 1,"." +DOT jsr DOLST + FDB BASE,AT,DOCLIT + FCB 10 + FDB XORR ;?decimal + FDB QBRAN,DOT1 + FDB UDOT,EXIT ;no, display unsigned +DOT1 FDB STR,SPACE,TYPES,EXIT ;yes, display signed + +; ? ( a -- ) +; Display the contents in a memory cell. + + FDB QUEST,L1420 +L1430 FCB 1,"?" +QUEST jsr DOLST + FDB AT,DOT,EXIT + +;; Parsing + +; parse ( b u c -- b u delta ; ) +; Scan string delimited by c. Return found string and its offset. + + FDB PARS,L1430 +L1440 FCB 5,"parse" +PARS jsr DOLST + FDB TEMP,STORE,OVER,TOR,DUPP + FDB QBRAN,PARS8 + FDB MINUS1,TEMP,AT,BLANK,EQUAL + FDB QBRAN,PARS3 + FDB TOR +PARS1 FDB BLANK,OVER,CAT ;skip leading blanks ONLY + FDB SUBB,ZLESS,INVER + FDB QBRAN,PARS2 + FDB PLUS1 + FDB DONXT,PARS1 + FDB RFROM,DROP,ZERO,DUPP,EXIT +PARS2 FDB RFROM +PARS3 FDB OVER,SWAP + FDB TOR +PARS4 FDB TEMP,AT,OVER,CAT,SUBB ;scan for delimiter + FDB TEMP,AT,BLANK,EQUAL + FDB QBRAN,PARS5 + FDB ZLESS +PARS5 FDB QBRAN,PARS6 + FDB PLUS1 + FDB DONXT,PARS4 + FDB DUPP,TOR + FDB BRAN,PARS7 +PARS6 FDB RFROM,DROP,DUPP + FDB PLUS1,TOR +PARS7 FDB OVER,SUBB + FDB RFROM,RFROM,SUBB,EXIT +PARS8 FDB OVER,RFROM,SUBB,EXIT + +; PARSE ( c -- b u ; ) +; Scan input stream and return counted string delimited by c. + + FDB PARSE,L1440 +L1450 FCB 5,"PARSE" +PARSE jsr DOLST + FDB TOR,TIB,INN,AT,PLUS ;current input buffer pointer + FDB NTIB,AT,INN,AT,SUBB ;remaining count + FDB RFROM,PARS,INN,PSTOR,EXIT + +; .( ( -- ) +; Output following string up to next ) . + + FDB DOTPR,L1450 +L1460 FCB IMEDD+2,".(" +DOTPR jsr DOLST + FDB DOLIT,')',PARSE,TYPES,EXIT + +; ( ( -- ) +; Ignore following string up to next ) . A comment. + + FDB PAREN,L1460 +L1470 FCB IMEDD+1,"(" +PAREN jsr DOLST + FDB DOLIT,')',PARSE,DDROP,EXIT + +; \ ( -- ) +; Ignore following text till the end of line. + + FDB BKSLA,L1470 +L1480 FCB IMEDD+1,92 ; '\' but give as numeric to avoid different escap char processing in different assemblers +BKSLA jsr DOLST + FDB NTIB,AT,INN,STORE,EXIT + +; CHAR ( -- c ) +; Parse next word and return its first character. + + FDB CHAR,L1480 +L1490 FCB 4,"CHAR" +CHAR jsr DOLST + FDB BLANK,PARSE,DROP,CAT,EXIT + +; TOKEN ( -- a ; ) +; Parse a word from input stream and copy it to name dictionary. + + FDB TOKEN,L1490 +L1500 FCB 5,"TOKEN" +TOKEN jsr DOLST + FDB BLANK,PARSE,DOCLIT + FCB 31 + FDB MIN + FDB NP,AT,OVER,SUBB,CELLM + FDB PACKS,EXIT + +; WORD ( c -- a ; ) +; Parse a word from input stream and copy it to code dictionary. + + FDB WORD,L1500 +L1510 FCB 4,"WORD" +WORD jsr DOLST + FDB PARSE,HERE,PACKS,EXIT + +;; Dictionary search + +; NAME> ( na -- ca ) +; Return a code address given a name address. + + FDB NAMET,L1510 +L1520 FCB 5,"NAME>" +NAMET jsr DOLST + FDB CELLM,CELLM,AT,EXIT + +; SAME? ( a a u -- a a f \ -0+ ) +; Compare u bytes in two strings. Return 0 if identical. + + FDB SAMEQ,L1520 +L1530 FCB 5,"SAME?" +SAMEQ jsr DOLST + FDB TOR + FDB BRAN,SAME2 +SAME1 FDB OVER,RAT,PLUS,CAT + FDB OVER,RAT,PLUS,CAT + FDB SUBB,QDUP + FDB QBRAN,SAME2 + FDB RFROM,DROP,EXIT +SAME2 FDB DONXT,SAME1 + FDB DOLIT,0,EXIT + +; find ( a va -- ca na | a F ) +; Search a vocabulary for a string. Return ca and na if succeeded. + + FDB FIND,L1530 +L1540 FCB 4,"find" +FIND jsr DOLST + FDB SWAP,DUPP,CAT,MINUS1 + FDB TEMP,STORE + FDB DUPP,AT,TOR,CELLP,SWAP +FIND1 FDB AT,DUPP + FDB QBRAN,FIND6 + FDB DUPP,AT,DOLIT,MASKK,ANDD,RAT,XORR + FDB QBRAN,FIND2 + FDB CELLP,MONE + FDB BRAN,FIND3 +FIND2 FDB CELLP,TEMP,AT,SAMEQ +FIND3 FDB BRAN,FIND4 +FIND6 FDB RFROM,DROP + FDB SWAP,CELLM,SWAP,EXIT +FIND4 FDB QBRAN,FIND5 + FDB CELLM,CELLM + FDB BRAN,FIND1 +FIND5 FDB RFROM,DROP,SWAP,DROP + FDB CELLM + FDB DUPP,NAMET,SWAP,EXIT + +; NAME? ( a -- ca na | a F ) +; Search all context vocabularies for a string. + + FDB NAMEQ,L1540 +L1550 FCB 5,"NAME?" +NAMEQ jsr DOLST + FDB CNTXT,DUPP,DAT,XORR + FDB QBRAN,NAMQ1 + FDB CELLM +NAMQ1 FDB TOR +NAMQ2 FDB RFROM,CELLP,DUPP,TOR + FDB AT,QDUP + FDB QBRAN,NAMQ3 + FDB FIND,QDUP + FDB QBRAN,NAMQ2 + FDB RFROM,DROP,EXIT +NAMQ3 FDB RFROM,DROP + FDB ZERO,EXIT + +;; Terminal response + +; ^H ( bot eot cur -- bot eot cur ) +; Backup the cursor by one character. + + FDB BKSP,L1550 +L1560 FCB 2,"^H" +BKSP jsr DOLST + FDB TOR,OVER,RFROM,SWAP,OVER,XORR + FDB QBRAN,BACK1 + FDB DOLIT,BKSPP,TECHO,ATEXE,MINUS1 + FDB BLANK,TECHO,ATEXE + FDB DOLIT,BKSPP,TECHO,ATEXE +BACK1 FDB EXIT + +; TAP ( bot eot cur c -- bot eot cur ) +; Accept and echo the key stroke and bump the cursor. + + FDB TAP,L1560 +L1570 FCB 3,"TAP" +TAP jsr DOLST + FDB DUPP,TECHO,ATEXE + FDB OVER,CSTOR,PLUS1,EXIT + +; kTAP ( bot eot cur c -- bot eot cur ) +; Process a key stroke, CR or backspace. + + FDB KTAP,L1570 +L1580 FCB 4,"kTAP" +KTAP jsr DOLST + FDB DUPP,DOCLIT + FCB CRR + FDB XORR + FDB QBRAN,KTAP2 + FDB DUPP,DOLIT,BKSPP,XORR + FDB SWAP,DOLIT,BKSPP2,XORR,ANDD + FDB QBRAN,KTAP1 + FDB BLANK,TAP,EXIT +KTAP1 FDB BKSP,EXIT +KTAP2 FDB DROP,SWAP,DROP,DUPP,EXIT + +; accept ( b u -- b u ) +; Accept characters to input buffer. Return with actual count. + + FDB ACCEP,L1580 +L1590 FCB 6,"ACCEPT" +ACCEP jsr DOLST + FDB OVER,PLUS,OVER +ACCP1 FDB DDUP,XORR + FDB QBRAN,ACCP4 + FDB KEY,DUPP +; FDB BLANK,SUBB,DOLIT,95,ULESS + FDB BLANK,DOLIT,127,WITHI + FDB QBRAN,ACCP2 + FDB TAP + FDB BRAN,ACCP3 +ACCP2 FDB TTAP,ATEXE +ACCP3 FDB BRAN,ACCP1 +ACCP4 FDB DROP,OVER,SUBB,EXIT + +; EXPECT ( b u -- ) +; Accept input stream and store count in SPAN. + + FDB EXPEC,L1590 +L1600 FCB 6,"EXPECT" +EXPEC jsr DOLST + FDB TEXPE,ATEXE,SPAN,STORE,DROP,EXIT + +; QUERY ( -- ) +; Accept input stream to terminal input buffer. + + FDB QUERY,L1600 +L1610 FCB 5,"QUERY" +QUERY jsr DOLST + FDB TIB,DOCLIT + FCB 80 + FDB TEXPE,ATEXE,NTIB,STORE + FDB DROP,ZERO,INN,STORE,EXIT + +;; Error handling + +; CATCH ( ca -- 0 | err# ) +; Execute word at ca and set up an error frame for it. + + FDB CATCH,L1610 +L1620 FCB 5,"CATCH" +CATCH jsr DOLST + FDB SPAT,TOR,HANDL,AT,TOR ;save error frame + FDB RPAT,HANDL,STORE,EXECU ;execute + FDB RFROM,HANDL,STORE ;restore error frame + FDB RFROM,DROP,ZERO,EXIT ;no error + +; THROW ( err# -- err# ) +; Reset system to current local error frame an update error flag. + + FDB THROW,L1620 +L1630 FCB 5,"THROW" +THROW jsr DOLST + FDB HANDL,AT,RPSTO ;restore return stack + FDB RFROM,HANDL,STORE ;restore handler frame + FDB RFROM,SWAP,TOR,SPSTO ;restore data stack + FDB DROP,RFROM,EXIT + +; NULL$ ( -- a ) +; Return address of a null string with zero count. + + FDB NULLS,L1630 +L1640 FCB 5,"NULL$" +NULLS +;;;; jsr DOLST +;;;; FDB DOVAR ;emulate CREATE + jsr FDOVAR + FDB 0 + FCB 99,111,121,111,116,101 + +; ABORT ( -- ) +; Reset data stack and jump to QUIT. + + FDB ABORT,L1640 +L1650 FCB 5,"ABORT" +ABORT jsr DOLST + FDB NULLS,THROW + +; abort" ( f -- ) +; Run time routine of ABORT" . Abort with a message. + + FDB ABORQ,L1650 +L1660 FCB COMPO+6,"abort",'"' +ABORQ jsr DOLST + FDB QBRAN,ABOR1 ;text flag + FDB DOSTR,THROW ;pass error string +ABOR1 FDB DOSTR,DROP,EXIT ;drop error + +;; The text interpreter + +; $INTERPRET ( a -- ) +; Interpret a word. If failed, try to convert it to an integer. + + FDB INTER,L1660 +L1670 FCB 10,"$INTERPRET" +INTER jsr DOLST + FDB NAMEQ,QDUP ;?defined + FDB QBRAN,INTE1 + FDB AT,DOLIT,COMPO<<8,ANDD ;?compile only lexicon bits + FDB ABORQ + FCB 13," compile only" + FDB EXECU,EXIT ;execute defined word +INTE1 FDB TNUMB,ATEXE ;convert a number + FDB QBRAN,INTE2 + FDB EXIT +INTE2 FDB THROW ;error + +; [ ( -- ) +; Start the text interpreter. + + FDB LBRAC,L1670 +L1680 FCB IMEDD+1,"[" +LBRAC jsr DOLST + FDB DOLIT,INTER,TEVAL,STORE,EXIT + +; .OK ( -- ) +; Display 'ok' only while interpreting. + + FDB DOTOK,L1680 +L1690 FCB 3,".OK" +DOTOK jsr DOLST + FDB DOLIT,INTER,TEVAL,AT,EQUAL + FDB QBRAN,DOTO1 + FDB DOTQP + FCB 3," ok" +DOTO1 FDB CR,EXIT + +; ?STACK ( -- ) +; Abort if the data stack underflows. + + FDB QSTAC,L1690 +L1700 FCB 6,"?STACK" +QSTAC jsr DOLST + FDB DEPTH,ZLESS ;check only for underflow + FDB ABORQ + FCB 10," underflow" + FDB EXIT + +; EVAL ( -- ) +; Interpret the input stream. + + FDB EVAL,L1700 +L1710 FCB 4,"EVAL" +EVAL jsr DOLST +EVAL1 FDB TOKEN,DUPP,CAT ;?input stream empty + FDB QBRAN,EVAL2 + FDB TEVAL,ATEXE,QSTAC ;evaluate input, check stack + FDB BRAN,EVAL1 +EVAL2 FDB DROP,TPROM,ATEXE,EXIT ;prompt + +;; Shell + +; PRESET ( -- ) +; Reset data stack pointer and the terminal input buffer. + + FDB PRESE,L1710 +L1720 FCB 6,"PRESET" +PRESE jsr DOLST + FDB SZERO,AT,SPSTO + FDB DOLIT,TIBB,NTIB,CELLP,STORE,EXIT + +; xio ( a a a -- ) +; Reset the I/O vectors 'EXPECT, 'TAP, 'ECHO and 'PROMPT. + + FDB XIO,L1720 +L1730 FCB COMPO+3,"xio" +XIO jsr DOLST + FDB DOLIT,ACCEP,TEXPE,DSTOR + FDB TECHO,DSTOR,EXIT + +; FILE ( -- ) +; Select I/O vectors for file download. + + FDB FILE,L1730 +L1740 FCB 4,"FILE" +FILE jsr DOLST + FDB DOLIT,PACE,DOLIT,DROP + FDB DOLIT,KTAP,XIO,EXIT + +; HAND ( -- ) +; Select I/O vectors for terminal interface. + + FDB HAND,L1740 +L1750 FCB 4,"HAND" +HAND jsr DOLST + FDB DOLIT,DOTOK,DOLIT,EMIT + FDB DOLIT,KTAP,XIO,EXIT + +; I/O ( -- a ) +; Array to store default I/O vectors. + + FDB ISLO,L1750 +L1760 FCB 3,"I/O" +ISLO +;; jsr DOLST +;; FDB DOVAR ;emulate CREATE + jsr FDOVAR + FDB QRX,TXSTO ;default I/O vectors + +; CONSOLE ( -- ) +; Initiate terminal interface. + + FDB CONSO,L1760 +L1770 FCB 7,"CONSOLE" +CONSO jsr DOLST + FDB ISLO,DAT,TQKEY,DSTOR ;restore default I/O device + FDB HAND,EXIT ;keyboard input + +; QUIT ( -- ) +; Reset return stack pointer and start text interpreter. + + FDB QUIT,L1770 +L1780 FCB 4,"QUIT" +QUIT jsr DOLST + FDB RZERO,AT,RPSTO ;reset return stack pointer +QUIT1 FDB LBRAC ;start interpretation +QUIT2 FDB QUERY ;get input + FDB DOLIT,EVAL,CATCH,QDUP ;evaluate input + FDB QBRAN,QUIT2 ;continue till error + FDB TPROM,AT,TOR ;save input device + FDB CONSO,NULLS,OVER,XORR ;?display error message + FDB QBRAN,QUIT3 + FDB SPACE,COUNT,TYPES ;error message + FDB DOTQP + FCB 3," ? " ;error prompt +QUIT3 FDB RFROM,DOLIT,DOTOK,XORR ;?file input + FDB QBRAN,QUIT4 + FDB DOLIT,ERR,EMIT ;file error, tell host +QUIT4 FDB PRESE ;some cleanup + FDB BRAN,QUIT1 + +;; The compiler + +; ' ( -- ca ) +; Search context vocabularies for the next word in input stream. + + FDB TICK,L1780 +L1790 FCB 1,"'" +TICK jsr DOLST + FDB TOKEN,NAMEQ ;?defined + FDB QBRAN,TICK1 + FDB EXIT ;yes, push code address +TICK1 FDB THROW ;no, error + +; ALLOT ( n -- ) +; Allocate n bytes to the code dictionary. + + FDB ALLOT,L1790 +L1800 FCB 5,"ALLOT" +ALLOT jsr DOLST + FDB CP,PSTOR,EXIT ;adjust code pointer + +; , ( w -- ) +; Compile an integer into the code dictionary. + + FDB COMMA,L1800 +L1810 FCB 1,"," +COMMA jsr DOLST + FDB HERE,DUPP,CELLP ;cell boundary + FDB CP,STORE,STORE,EXIT ;adjust code pointer and compile + +; [COMPILE] ( -- ; ) +; Compile the next immediate word into code dictionary. + + FDB BCOMP,L1810 +L1820 FCB IMEDD+9,"[COMPILE]" +BCOMP jsr DOLST + FDB TICK,COMMA,EXIT + +; COMPILE ( -- ) +; Compile the next address in colon list to code dictionary. + + FDB COMPI,L1820 +L1830 FCB COMPO+7,"COMPILE" +COMPI jsr DOLST + FDB RFROM,DUPP,AT,COMMA ;compile address + FDB CELLP,TOR,EXIT ;adjust return address + +; LITERAL ( w -- ) +; Compile tos to code dictionary as an integer literal. + + FDB LITER,L1830 +L1840 FCB IMEDD+7,"LITERAL" +LITER jsr DOLST + FDB COMPI,DOLIT,COMMA,EXIT + +; $," ( -- ) +; Compile a literal string up to next " . + + FDB STRCQ,L1840 +L1850 FCB 3,"$,",'"' +STRCQ jsr DOLST + FDB DOLIT,'"',WORD ;move string to code dictionary + FDB COUNT,PLUS,ALGND ;calculate aligned end of string + FDB CP,STORE,EXIT ;adjust the code pointer + +; RECURSE ( -- ) +; Make the current word available for compilation. + + FDB RECUR,L1850 +L1860 FCB IMEDD+7,"RECURSE" +RECUR jsr DOLST + FDB LAST,AT,NAMET,COMMA,EXIT + +;; Structures + +; DO ( -- a m ) +; Start a DO-LOOP/+LOOP structure in a colon definition. + + FDB DO,L1860 +L1861 FCB IMEDD+2,"DO" +DO jsr DOLST + FDB COMPI,DODO,HERE + FDB ONE ; marker for DO + FDB EXIT + +; ?DO ( -- a m ) +; Start a ?DO-LOOP/+LOOP structure in a colon definition. + + FDB QDO,L1861 +L1862 FCB IMEDD+3,"?DO" +QDO jsr DOLST + FDB COMPI,DOQDO,HERE + FDB COMPI,0 ; branch destination placeholder + FDB TWO ; marker for ?DO + FDB EXIT + +; (?DO) ( w w -- ) +; Runtime part of DO in a DO-LOOP/+LOOP structure. + + FDB DOQDO,L1862 +L1862A FCB 5,"(?DO)" +DOQDO + puls d ;start + cmpd ,s ;start < end -> ok + blt DOQDO1 + leas 2,s ;drop end + ldu ,u + pulu pc ;branch past loop +DOQDO1 + puls x ;end + stx ,--y ;end to return stack + std ,--y ;start to return stack + leau 2,u ;skip jump forward + pulu pc + +; -DO ( -- a m ) +; Start a -DO-LOOP/+LOOP structure in a colon definition. + + FDB MDO,L1862A +L1862B FCB IMEDD+3,"-DO" +MDO jsr DOLST + FDB COMPI,DOMDO,HERE + FDB COMPI,0 ; branch destination placeholder + FDB TWO ; marker for ?DO/-DO + FDB EXIT + +; (-DO) ( w w -- ) +; Runtime part of -DO in a -DO-LOOP/+LOOP structure. + + FDB DOMDO,L1862B +L1862C FCB 5,"(-DO)" +DOMDO + puls d ;start + cmpd ,s ;start > end -> ok + bgt DOMDO1 + leas 2,s ;drop end + ldu ,u + pulu pc ;branch past loop +DOMDO1 + puls x ;end + stx ,--y ;end to return stack + std ,--y ;start to return stack + leau 2,u ;skip jump forward + pulu pc + +; (DO) ( w w -- ) +; Runtime part of DO in a DO-LOOP/+LOOP structure. + + FDB DODO,L1862C +L1863 FCB 4,"(DO)" +DODO + puls d,x ;start first, end second + stx ,--y ;end to return stack + std ,--y ;start to return stack + pulu pc + +; (LOOP) ( -- ) +; Runtime part of LOOP + + FDB DOLOOP,L1863 +L1864 FCB 6,"(LOOP)" +DOLOOP + ldd #1 + bra DOPLOF + +; (+LOOP) ( -- ) +; Runtime part of +LOOP + + FDB DOPLOOP,L1864 +L1865 FCB IMEDD+7,"(+LOOP)" +DOPLOOP + ldd ,s++ ; increment + bpl DOPLOF ; forward + addd ,y ; start/index + cmpd 2,y ; end + ble DOPLO1 ; index <= end -> leave + std ,y + ldu ,u ; branch to begin of loop + pulu pc + +DOPLOF addd ,y ; start/index + cmpd 2,y ; end + bge DOPLO1 ; index >= end -> leave + std ,y ; save back + ldu ,u ; branch to begin of loop + pulu pc +DOPLO1 + leau 2,u ; skip back destination + leay 4,y ; remove index and upper from r stack + pulu pc + +; LOOP ( a m -- ) +; Terminate a DO/?DO-LOOP loop structure. + + FDB LOOP,L1865 +L1866 FCB IMEDD+4,"LOOP" +LOOP jsr DOLST + FDB COMPI,DOLOOP + FDB TWO,EQUAL,QBRAN,LOOP1 + FDB HERE,CELLP,OVER,STORE,CELLP ; branch forward destination +LOOP1 FDB COMMA,EXIT + + +; +LOOP ( a m -- ) +; Terminate a DO/?DO-+LOOP loop structure. + + FDB PLOOP,L1866 +L1867 FCB IMEDD+5,"+LOOP" +PLOOP jsr DOLST + FDB COMPI,DOPLOOP + FDB TWO,EQUAL,QBRAN,PLOOP1 + FDB HERE,CELLP,OVER,STORE,CELLP ; branch forward destination +PLOOP1 FDB COMMA,EXIT + +; LEAVE ( -- ) +; Leave DO/LOOP + + FDB LEAVE,L1867 +L1868 FCB 5,"LEAVE" +LEAVE + ldd ,y ;take index on return stack + std 2,y ;and change end to it + pulu pc + +; FOR ( -- a ) +; Start a FOR-NEXT loop structure in a colon definition. + + FDB FOR,L1867 +L1870 FCB IMEDD+3,"FOR" +FOR jsr DOLST + FDB COMPI,TOR,HERE,EXIT + +; BEGIN ( -- a ) +; Start an infinite or indefinite loop structure. + + FDB BEGIN,L1870 +L1880 FCB IMEDD+5,"BEGIN" +BEGIN jsr DOLST + FDB HERE,EXIT + +; NEXT ( a -- ) +; Terminate a FOR-NEXT loop structure. + + FDB NEXT,L1880 +L1890 FCB IMEDD+4,"NEXT" +NEXT jsr DOLST + FDB COMPI,DONXT,COMMA,EXIT + +; UNTIL ( a -- ) +; Terminate a BEGIN-UNTIL indefinite loop structure. + + FDB UNTIL,L1890 +L1900 FCB IMEDD+5,"UNTIL" +UNTIL jsr DOLST + FDB COMPI,QBRAN,COMMA,EXIT + +; AGAIN ( a -- ) +; Terminate a BEGIN-AGAIN infinite loop structure. + + FDB AGAIN,L1900 +L1910 FCB IMEDD+5,"AGAIN" +AGAIN jsr DOLST + FDB COMPI,BRAN,COMMA,EXIT + +; IF ( -- A ) +; Begin a conditional branch structure. + + FDB IFF,L1910 +L1920 FCB IMEDD+2,"IF" +IFF jsr DOLST + FDB COMPI,QBRAN,HERE + FDB ZERO,COMMA,EXIT + +; AHEAD ( -- A ) +; Compile a forward branch instruction. + + FDB AHEAD,L1920 +L1930 FCB IMEDD+5,"AHEAD" +AHEAD jsr DOLST + FDB COMPI,BRAN,HERE,ZERO,COMMA,EXIT + +; REPEAT ( A a -- ) +; Terminate a BEGIN-WHILE-REPEAT indefinite loop. + + FDB REPEA,L1930 +L1940 FCB IMEDD+6,"REPEAT" +REPEA jsr DOLST + FDB AGAIN,HERE,SWAP,STORE,EXIT + +; THEN ( A -- ) +; Terminate a conditional branch structure. + + FDB THENN,L1940 +L1950 FCB IMEDD+4,"THEN" +THENN jsr DOLST + FDB HERE,SWAP,STORE,EXIT + +; AFT ( a -- a A ) +; Jump to THEN in a FOR-AFT-THEN-NEXT loop the first time through. + + FDB AFT,L1950 +L1960 FCB IMEDD+3,"AFT" +AFT jsr DOLST + FDB DROP,AHEAD,BEGIN,SWAP,EXIT + +; ELSE ( A -- A ) +; Start the false clause in an IF-ELSE-THEN structure. + + FDB ELSEE,L1960 +L1970 FCB IMEDD+4,"ELSE" +ELSEE jsr DOLST + FDB AHEAD,SWAP,THENN,EXIT + +; WHILE ( a -- A a ) +; Conditional branch out of a BEGIN-WHILE-REPEAT loop. + + FDB WHILE,L1970 +L1980 FCB IMEDD+5,"WHILE" +WHILE jsr DOLST + FDB IFF,SWAP,EXIT + +; ABORT" ( -- ; ) +; Conditional abort with an error message. + + FDB ABRTQ,L1980 +L1990 FCB IMEDD+6,"ABORT",'"' +ABRTQ jsr DOLST + FDB COMPI,ABORQ,STRCQ,EXIT + +; $" ( -- ; ) +; Compile an inline string literal. + + FDB STRQ,L1990 +L2000 FCB IMEDD+2,'$','"' +STRQ jsr DOLST + FDB COMPI,STRQP,STRCQ,EXIT + +; ." ( -- ; ) +; Compile an inline string literal to be typed out at run time. + + FDB DOTQ,L2000 +L2010 FCB IMEDD+2,'.','"' +DOTQ jsr DOLST + FDB COMPI,DOTQP,STRCQ,EXIT + +;; Name compiler + +; ?UNIQUE ( a -- a ) +; Display a warning message if the word already exists. + + FDB UNIQU,L2010 +L2020 FCB 7,"?UNIQUE" +UNIQU jsr DOLST + FDB DUPP,NAMEQ ;?name exists + FDB QBRAN,UNIQ1 + FDB DOTQP ;redefinitions are OK + FCB 7," reDef " ;but the user should be warned + FDB OVER,COUNT,TYPES ;just in case its not planned +UNIQ1 FDB DROP,EXIT + +; $,n ( na -- ) +; Build a new dictionary name using the string at na. + + FDB SNAME,L2020 +L2030 FCB 3,"$,n" +SNAME jsr DOLST + FDB DUPP,CAT ;?null input + FDB QBRAN,PNAM1 + FDB UNIQU ;?redefinition + FDB DUPP,LAST,STORE ;save na for vocabulary link + FDB HERE,ALGND,SWAP ;align code address + FDB CELLM ;link address + FDB CRRNT,AT,AT,OVER,STORE + FDB CELLM,DUPP,NP,STORE ;adjust name pointer + FDB STORE,EXIT ;save code pointer +PNAM1 FDB STRQP + FCB 5," name" ;null input + FDB THROW + +;; FORTH compiler + +; $COMPILE ( a -- ) +; Compile next word to code dictionary as a token or literal. + + FDB SCOMP,L2030 +L2040 FCB 8,"$COMPILE" +SCOMP jsr DOLST + FDB NAMEQ,QDUP ;?defined + FDB QBRAN,SCOM2 + FDB AT,DOLIT,IMEDD<<8,ANDD ;?immediate + FDB QBRAN,SCOM1 + FDB EXECU,EXIT ;its immediate, execute +SCOM1 FDB COMMA,EXIT ;its not immediate, compile +SCOM2 FDB TNUMB,ATEXE ;try to convert to number + FDB QBRAN,SCOM3 + FDB LITER,EXIT ;compile number as integer +SCOM3 FDB THROW ;error + +; OVERT ( -- ) +; Link a new word into the current vocabulary. + + FDB OVERT,L2040 +L2050 FCB 5,"OVERT" +OVERT jsr DOLST + FDB LAST,AT,CRRNT,AT,STORE,EXIT + +; ; ( -- ) +; Terminate a colon definition. + + FDB SEMIS,L2050 +L2060 FCB IMEDD+COMPO+1,";" +SEMIS jsr DOLST + FDB COMPI,EXIT,LBRAC,OVERT,EXIT + +; ] ( -- ) +; Start compiling the words in the input stream. + + FDB RBRAC,L2060 +L2070 FCB 1,"]" +RBRAC jsr DOLST + FDB DOLIT,SCOMP,TEVAL,STORE,EXIT + +; call, ( ca -- ) +; Assemble a call instruction to ca. + + FDB CALLC,L2070 +L2080 FCB 5,"call," +CALLC jsr DOLST + FDB DOCLIT + FCB CALLL + FDB HERE,CSTOR ;Direct Threaded Code + FDB ONE,ALLOT + FDB COMMA,EXIT ;DTC 6809 extended addr jsr + +; : ( -- ; ) +; Start a new colon definition using next word as its name. + + FDB COLON,L2080 +L2090 FCB 1,":" +COLON jsr DOLST + FDB TOKEN,SNAME,DOLIT,DOLST + FDB CALLC,RBRAC,EXIT + +; IMMEDIATE ( -- ) +; Make the last compiled word an immediate word. + + FDB IMMED,L2090 +L2100 FCB 9,"IMMEDIATE" +IMMED jsr DOLST + FDB DOLIT,IMEDD<<8,LAST,AT,AT,ORR + FDB LAST,AT,STORE,EXIT + +;; Defining words + +; USER ( u -- ; ) +; Compile a new user variable. + + FDB USER,L2100 +L2110 FCB 4,"USER" +USER jsr DOLST + FDB TOKEN,SNAME,OVERT +;;;; FDB DOLIT,DOLST,CALLC +;;;; FDB DOLIT,DOUSE,COMMA +; fast implementation .... + FDB DOLIT,FDOUSE,CALLC + FDB COMMA,EXIT + +; CREATE ( -- ; ) +; Compile a new array entry without allocating code space. + + FDB CREAT,L2110 +L2120 FCB 6,"CREATE" +CREAT jsr DOLST + FDB TOKEN,SNAME,OVERT +;;;; FDB DOLIT,DOLST,CALLC +;;;; FDB DOLIT,DOVAR,COMMA,EXIT +; fast implementation .... + FDB DOLIT,FDOVAR,CALLC,EXIT + +; VARIABLE ( -- ; ) +; Compile a new variable initialized to 0. + + FDB VARIA,L2120 +L2130 FCB 8,"VARIABLE" +VARIA jsr DOLST + FDB CREAT,ZERO,COMMA,EXIT + +; CONSTANT ( w -- ; ) +; Compile a new constant with value w. + + FDB CONST,L2130 +L2135 FCB 8,"CONSTANT" +CONST jsr DOLST + FDB TOKEN,SNAME,OVERT + FDB DOLIT,DOCONST,CALLC + FDB COMMA,EXIT + +;; Tools + +; _TYPE ( b u -- ) +; Display a string. Filter non-printing characters. + + FDB UTYPE,L2135 +L2140 FCB 5,"_TYPE" +UTYPE jsr DOLST + FDB TOR ;start count down loop + FDB BRAN,UTYP2 ;skip first pass +UTYP1 FDB DUPP,CAT,TCHAR,EMIT ;display only printable + FDB PLUS1 ;increment address +UTYP2 FDB DONXT,UTYP1 ;loop till done + FDB DROP,EXIT + +; dm+ ( a u -- a ) +; Dump u bytes from , leaving a+u on the stack. + + FDB DUMPP,L2140 +L2150 FCB 3,"dm+" +DUMPP jsr DOLST + FDB OVER,DOLIT,4,UDOTR ;display address + FDB SPACE,TOR ;start count down loop + FDB BRAN,PDUM2 ;skip first pass +PDUM1 FDB DUPP,CAT,DOLIT,3,UDOTR ;display numeric data + FDB PLUS1 ;increment address +PDUM2 FDB DONXT,PDUM1 ;loop till done + FDB EXIT + +; DUMP ( a u -- ) +; Dump u bytes from a, in a formatted manner. + + FDB DUMP,L2150 +L2160 FCB 4,"DUMP" +DUMP jsr DOLST + FDB BASE,AT,TOR,HEX ;save radix, set hex + FDB DOCLIT + FCB 16 + FDB SLASH ;change count to lines + FDB TOR ;start count down loop +DUMP1 FDB CR,DOCLIT + FCB 16 + FDB DDUP,DUMPP ;display numeric + FDB ROT,ROT + FDB TWO,SPACS,UTYPE ;display printable characters + FDB NUFQ,INVER ;user control + FDB QBRAN,DUMP2 + FDB DONXT,DUMP1 ;loop till done + FDB BRAN,DUMP3 +DUMP2 FDB RFROM,DROP ;cleanup loop stack, early exit +DUMP3 FDB DROP,RFROM,BASE,STORE ;restore radix + FDB EXIT + +; .S ( ... -- ... ) +; Display the contents of the data stack. + + FDB DOTS,L2160 +L2170 FCB 2,".S" +DOTS jsr DOLST + FDB CR,DEPTH ;stack depth + FDB TOR ;start count down loop + FDB BRAN,DOTS2 ;skip first pass +DOTS1 FDB RAT,PICK,DOT ;index stack, display contents +DOTS2 FDB DONXT,DOTS1 ;loop till done + FDB DOTQP + FCB 4," NAME ( ca -- na | F ) +; Convert code address to a name address. + + FDB TNAME,L2190 +L2200 FCB 5,">NAME" +TNAME jsr DOLST + FDB CRRNT ;vocabulary link +TNAM1 FDB CELLP,AT,QDUP ;check all vocabularies + FDB QBRAN,TNAM4 + FDB DDUP +TNAM2 FDB AT,DUPP ;?last word in a vocabulary + FDB QBRAN,TNAM3 + FDB DDUP,NAMET,XORR ;compare + FDB QBRAN,TNAM3 + FDB CELLM ;continue with next word + FDB BRAN,TNAM2 +TNAM3 FDB SWAP,DROP,QDUP + FDB QBRAN,TNAM1 + FDB SWAP,DROP,SWAP,DROP,EXIT +TNAM4 FDB DROP,DOLIT,0,EXIT + +; .ID ( na -- ) +; Display the name at address. + + FDB DOTID,L2200 +L2210 FCB 3,".ID" +DOTID jsr DOLST + FDB QDUP ;if zero no name + FDB QBRAN,DOTI1 + FDB COUNT,DOCLIT + FCB $1F + FDB ANDD ;mask lexicon bits + FDB UTYPE,EXIT ;display name string +DOTI1 FDB DOTQP + FCB 9," {noName}" + FDB EXIT + +; SEE ( -- ; ) +; A simple decompiler. + + FDB SEE,L2210 +L2220 FCB 3,"SEE" +SEE jsr DOLST + FDB TICK ;starting address + FDB PLUS1 ;skip JSR + ;primitive check ... + FDB BASE,AT,TOR,HEX ;switch to hex base + FDB DUPP,AT,DOLIT,DOLST,XORR + ;high level word? + FDB QBRAN,SEE1 ;yes! + FDB CR,DOTQP ;primitive word only + FCB 9, " PRIMITVE" + FDB BRAN,SEE5 ;exit +SEE1 FDB CR,CELLP,DUPP,UDOT,SPACE + FDB DUPP,AT,DUPP ;?does it contain a zero + FDB QBRAN,SEE2 + FDB TNAME ;?is it a name +SEE2 FDB QDUP ;name address or zero + FDB QBRAN,SEE3 + + FDB SPACE,DOTID ;display name + FDB DUPP,AT + + FDB DUPP,DOLIT,DOCLIT,EQUAL ; doCLIT? + FDB QBRAN,SEE21 + FDB OVER,CELLP,CAT,SPACE,UDOT ; CLIT: get only single byte + FDB SWAP,PLUS1,SWAP + FDB BRAN,SEE28 + +SEE21 FDB DUPP,DOLIT,DOLIT,EQUAL ; doCLIT? + FDB OVER,DOLIT,QBRAN,EQUAL,ORR ; ?BRAN ? + FDB OVER,DOLIT,BRAN,EQUAL,ORR; BRANCH ? + FDB OVER,DOLIT,DONXT,EQUAL,ORR; next ? (from FOR/NEXT) + FDB OVER,DOLIT,DOLOOP,EQUAL,ORR; (LOOP) ? + FDB OVER,DOLIT,DOPLOOP,EQUAL,ORR; (+LOOP) ? + FDB OVER,DOLIT,DODO,EQUAL,ORR; (DO) ? + FDB OVER,DOLIT,DOQDO,EQUAL,ORR; (?DO) ? + FDB OVER,DOLIT,DOMDO,EQUAL,ORR; (-DO) ? + FDB QBRAN,SEE27 + FDB SWAP,CELLP,DUPP,AT,SPACE,UDOT,SWAP ; LIT: get word + FDB BRAN,SEE28 +SEE27 + FDB DUPP,DOLIT,DOTQP,EQUAL ; ." ..." + FDB OVER,DOLIT,ABORQ,EQUAL,ORR ; ABORT" ..." + FDB OVER,DOLIT,STRQP,EQUAL,ORR ; $" ..." + FDB QBRAN,SEE29 ; last case aalway to SEE29!! + FDB SWAP,CELLP ; print compiled string + FDB DUPP,COUNT,TYPES,DOCLIT + FCB 34 + FDB EMIT + FDB COUNT,PLUS,CELLM,SWAP ; adjust continuation address + +SEE28 FDB DROP ; LEAVL, without EXIT check + FDB BRAN,SEE4 +SEE29 FDB DROP ; ELSE + FDB BRAN,SEE31 ; cleanup, check for EXIT + +SEE3 FDB DUPP,AT,UDOT ;display number + FDB BRAN,SEE4 +SEE31 FDB DUPP,AT,DOLIT,EXIT,XORR ; stop on EXIT word + ; but not if SEE decompiles itself! + FDB QBRAN,SEE5 +SEE4 FDB NUFQ ;user control + FDB QBRAN,SEE1 +SEE5 FDB RFROM,BASE,STORE,DROP,EXIT + +; WORDS ( -- ) +; Display the names in the context vocabulary. + + FDB WORDS,L2220 +L2230 FCB 5,"WORDS" +WORDS jsr DOLST + FDB CR,CNTXT,AT ;only in context +WORS1 FDB AT,QDUP ;?at end of list + FDB QBRAN,WORS2 + FDB DUPP,SPACE,DOTID ;display a name + FDB CELLM,NUFQ ;user control + FDB QBRAN,WORS1 + FDB DROP +WORS2 FDB EXIT + +;; Hardware reset + +; VER ( -- n ) +; Return the version number of this implementation. + + FDB VERSN,L2230 +L2240 FCB 3,"VER" +VERSN jsr DOLST + FDB DOLIT,VER*256+EXT,EXIT + +; hi ( -- ) +; Display the sign-on message of eForth. + + FDB HI,L2240 +L2250 FCB 2,"hi" +HI jsr DOLST + FDB STOIO,CR,DOTQP ;initialize I/O + FCB 11,"eForth v" ;model + FCB VER+'0','.',EXT+'0' ;version + FDB CR,EXIT + +; 'BOOT ( -- a ) +; The application startup vector. + + FDB TBOOT,L2250 +L2260 FCB 5,"'BOOT" +TBOOT +;;;; jsr DOLST +;;;; FDB DOVAR + jsr FDOVAR + FDB HI ;application to boot + +; COLD ( -- ) +; The hilevel cold start sequence. + + FDB COLD,L2260 +L2270 FCB 4,"COLD" +COLD jsr DOLST +COLD1 FDB DOLIT,UZERO,DOLIT,UPP + FDB DOLIT,ULAST-UZERO,CMOVE ;initialize user area + FDB PRESE ;initialize data stack and TIB + FDB TBOOT,ATEXE ;application boot + FDB FORTH,CNTXT,AT,DUPP ;initialize search order + FDB CRRNT,DSTOR,OVERT +; TEST +; FDB DOLIT,10,DOLIT,1 +; FDB DODO +; + FDB QUIT ;start interpretation + FDB BRAN,COLD1 ;just in case + +;=============================================================== + +LASTN EQU L2270 ;last name address in name dictionary + +NTOP EQU NAMEE ;next available memory in name dictionary +CTOP EQU * ;next available memory in code dictionary + + + END ORIG + +;=============================================================== + diff -r 4fa2bdb0c457 -r 2088fd998865 examples/erat-sieve.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/erat-sieve.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,67 @@ +; ERATOSTHENES SIEVE PRIMES +; BYTE MAGAZINE 9/1981 BENCHMARK +; Adapted by Johann Klasek, j AT klasek at +; Previously implemented for a Dragon 32, +; later also for a the sim6809 simulator. +; + org $c000 + +FLAG EQU $5000 ; array of bytes, length SIZE +SIZE EQU $2000 + +START + + lds #FLAG ; stack below flags array + +; lda #$42 +; jsr >$b54a ; char out Dragon Basic + ldb #'B + swi2 + + lda #$0a + pshs a + +ITER ldx #FLAG ; array + ldu #$ffff ; filled with + ldd #(SIZE/2) ; words +CLEAR stu ,x++ ; word fill + decb ; byte decrement works only + bne CLEAR ; low byte of count is 0 + deca + bne CLEAR + + leau 1,u ; prime counter to 0 + ldy #FLAG ; array + +PRIMES tst ,y+ ; is prime? + beq NPRIME + leax -1,y ; prime found + tfr x,d + suba #(FLAG>>8) + lslb + rola + addd #3 ; prime = step + bra STEP + +NMARK clr ,x ; mark all non-primes +STEP leax d,x ; step to next + cmpx #(FLAG+SIZE) + bcs NMARK + + leau 1,u ; count primes +NPRIME cmpy #(FLAG+SIZE) + bcs PRIMES + + ldb #'. + swi2 ; print +; lda #$2e +; jsr >$b54a ; char out Dragon Basic + + dec ,s + bne ITER + + puls a ; drop counter + pshs u ; store count on stack +; rts + sync + diff -r 4fa2bdb0c457 -r 2088fd998865 examples/erat-sieve.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/erat-sieve.txt Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,33 @@ + +Eratostenes Sieve +================= +J.E. Klasek j AT klasek at + + + +# compile + +make + +# start (with memory dump) + +v09 -d erat-sieve + +# hex editor on memory dump ... + +he dump.v09 + +# variable area ... +# prime count: vv vv +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 +00005000 FF FF FF 00 FF FF 00 FF FF 00 FF 00 00 FF FF 00 00 FF 00 FF .................... + + +# convert hex value to decimal with dc command ... +dc +16 i +076B p +1899 + +# 1899 is the correct value for the prime count! + diff -r 4fa2bdb0c457 -r 2088fd998865 examples/input.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/input.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,35 @@ + ;6809 Benchmark program. + + org $100 + + lds #$100 + + ldb #'a' + jsr outc + + + ldx #40 +inloop jsr inc + jsr outc + leax -1,x + bne inloop + + ldb #'b' + jsr outc + jmp realexit + +error ldb #'e' + jsr outc + jmp realexit + +outc swi2 + rts + +inc swi3 + rts + +realexit sync + +enddata + + end diff -r 4fa2bdb0c457 -r 2088fd998865 examples/printval.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/printval.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,46 @@ + ;print value as decimal + + org $100 + + ldx #$ff00 +loop: + bsr printdec + ldb #32 + swi2 + leax 1,x + bne loop + sync + + +printdec: + pshs cc,d,x ; save regs + lda #$80 ; init. terminator +nxtdg: + sta ,-s ; push digit term + ldb #16 ; 16 bit counter for rotate + clra ; clear accu and carry +roll: + rola ; divide by 10 using binary + adda #$f6 ; long division, shifting X one + bcs sub ; bit at a time info A and + suba #$f6 ; subtracting 10 which sets +sub: + exg d,x ; C if sub goes, else add 10 + rolb ; back and reset C. Rotating X + rola ; by means of A & B both shifts + exg d,x ; X bits into A and shifts + decb ; result bits into X. Do 17 + bpl roll ; times to get last result bit. + leax ,x ; test X and repeat if + bne nxtdg ; X is not zero + tfr a,b +prog: + orb #$30 ; make into ASCII digit, call + swi2 ; print char + ldb ,s+ ; pull next digit of stack and + bpl prog ; repeat if not terminator + puls cc,d,x,pc ; restore regs and return + + + end + diff -r 4fa2bdb0c457 -r 2088fd998865 examples/test09.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/test09.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,463 @@ + ; 6809 Test program. + +testnr equ 32 + + org $100 + jmp entry +error ldx #errmsg + bsr outs + lda testnr + bsr outa + ldx #newline + bsr outs + sync + +errmsg fcb "ERROR ",0 +newline fcb 13,10,0 +outs ldb ,x+ + beq done1 + swi2 + bra outs +done1 rts +outdig addb # 48 + cmpb # 57 + bls od2 + addb #7 +od2 swi2 + rts +outa tfr a,b + lsrb + lsrb + lsrb + lsrb + bsr outdig + tfr a,b + andb # 15 + bra outdig +passmsg fcb "PASSED ",0 +good ldx #passmsg + jsr outs + lda testnr + jsr outa + ldx #newline + jsr outs + inc testnr + rts + +entry clr testnr + jsr good ;test #0, does it print msg? + andcc #0 ;test #1, conditional (long) branches + lbvs error ; andcc, orcc + lbcs error + lbeq error + lbmi error + lbls error + lblt error + lble error + lbrn error + bvs errt1 + bcs errt1 + beq errt1 + bmi errt1 + bls errt1 + blt errt1 + ble errt1 + brn errt1 + lbvc goot1 +errt1 jmp error +goot1 lbcc goot2 + jmp error +goot2 lbne goot3 + jmp error +goot3 lbpl goot4 + jmp error +goot4 lbhi goot5 + jmp error +goot5 lbge goot6 + jmp error +goot6 lbgt goot7 + jmp error +goot7 lbra goot8 + jmp error +goot8 bvc goot9 + jmp error +goot9 bcc goot10 + jmp error +goot10 bne goot11 + jmp error +goot11 bpl goot12 + jmp error +goot12 bhi goot13 + jmp error +goot13 bge goot14 + jmp error +goot14 bgt goot15 + jmp error +goot15 bra goot16 + jmp error +goot16 tfr cc,a + tsta + lbne error + andcc #0 + orcc #1 + lbcc error + lbeq error + lbvs error + lbmi error + orcc #2 + lbvc error + lbeq error + lbmi error + orcc #4 + lbne error + lbmi error + orcc #8 + lbpl error + tfr cc,a + cmpa #15 + lbne error + orcc #15 + orcc #240 + tfr cc,a + inca + lbne error + orcc #255 + andcc #$aa + tfr cc,a + cmpa #$aa + lbne error + jsr good + + lds #0 ; test #2: registers and their values, tfr, exg + lda #$28 + ldb #$7f + ldu #3417 + ldx #2221 + ldy #16555 + cmpa #$28 + lbne error + cmpb #$7f + lbne error + cmpd #$287f + lbne error + cmpx #2221 + lbne error + cmpy #13 + lbeq error + cmpy #16555 + lbne error + cmpu #3417 + lbne error + cmps #0 + lbne error + exg x,y + cmpx #16555 + lbne error + cmpy #2221 + lbne error + exg x,d + cmpd #16555 + lbne error + cmpx #$287f + lbne error + cmpy #2221 + lbne error + exg x,d + exg a,dp + tsta + lbne error + exg a,dp + exg a,b + cmpa #$7f + lbne error + cmpb #$28 + lbne error + tfr b,a + cmpb #$28 + lbne error + cmpa #$28 + lbne error + tfr u,x + cmpu #3417 + lbne error + cmpx #3417 + lbne error + tfr pc,x +here cmpx #here + lbne error + tfr u,s + cmps #3417 + lbne error + lds #0 + clra + tfr b,cc + tfr cc,a + cmpa #$28 + lbne error + jsr good + + lda #128 ;Arithmetic and their status. + adda #255 + lbcc error + lbvc error + lbmi error + cmpa #127 + lbne error + lda #0 + adda #255 + lbcs error + lbvs error + lbpl error + cmpa #255 + lbne error + orcc #1 + lda #255 + adca #0 + lbne error + lbmi error + lbcc error + lda #216 + adda #40 + lbne error + lda #80 + adda #40 + lbcs error + lbvs error + cmpa #120 + lbne error + orcc #1 + lda #80 + adca #40 + lbcs error + lbvs error + cmpa #121 + lbne error + andcc #254 + ldb #80 + adcb #40 + lbcs error + lbvs error + cmpb #120 + lbne error + ldb #80 + subb #120 + lbcc error + lbvs error + cmpb #216 + lbne error + andcc #254 + lda #140 + sbca #20 + lbvc error + lbcs error + cmpa #120 + lbne error + orcc #1 + lda #140 + sbca #20 + lbvc error + lbcs error + cmpa #119 + lbne error + ldd #40000 + subd #20000 + lbvc error + lbcs error + cmpd #20000 + lbne error + ldd #20000 + subd #40000 + lbvc error + lbcc error + cmpd #-20000 + lbne error + ldd #30000 + addd #-20000 + lbcc error + lbvs error + cmpd #10000 + lbne error + jsr good + + lda #$23 ;Test #4 decimal arithmetic. + adda #$34 + daa + lbcs error + cmpa #$57 + lbne error + orcc #1 + lda #$19 + adca #$29 + daa + lbcs error + cmpa #$49 + lbne error + lda #$92 + adda #$8 + daa + lbcc error + cmpa #$00 + jsr good + + lda #128 ;Test#5 MUL and SEX + ldb #2 + mul + lbeq error + lbcs error + cmpd #256 + lbne error + lda #0 + ldb #23 + mul + lbne error + lbcs error + cmpd #0 + lbne error + lda #10 + ldb #20 + mul + lbcc error + cmpd #200 + lbne error + lda #100 + ldb #49 + mul + cmpd #4900 + lbne error + clrb + sex + cmpd #0 + lbne error + ldb #128 + sex + cmpd #-128 + lbne error + ldb #50 + sex + cmpd #50 + lbne error + jsr good + + lda #$55 ; Test #6 Shifts and rotates. + asla + lbcs error + cmpa #$aa + lbne error + asla + lbcc error + cmpa #$54 + lbne error + lda #$0 + andcc #254 + rola + lbne error + orcc #1 + rola + deca + lbne error + andcc #254 + rora + lbne error + orcc #1 + rora + cmpa #128 + lbne error + asra + cmpa #192 + lbne error + lsra + cmpa #96 + lbne error + ldb # 54 + aslb + cmpb # 108 + lbne error + jsr good + + orcc #15 ; Test #7 INC, DEC and NEG + lda # 33 + inca + lbeq error + lbvs error + lbcc error + lbmi error + deca + lbeq error + lbvs error + lbcc error + lbmi error + clra + andcc #254 + deca + lbcs error + lbpl error + inca + lbne error + ldb #126 + negb + lbvs error + lbcc error + cmpb #130 + lbne error + decb + decb + negb + lbvc error + cmpb #128 + lbne error + clrb + negb + lbcs error + lbne error + jsr good + + ;test #8 Addessing modes. + ldx #testdat+4 + lda ,x + cmpa #5 + lbne error + lda ,x+ + cmpa #5 + lbne error + cmpx #testdat+5 + lbne error + ldd ,x++ + cmpd #6*256+7 + lbne error + cmpx #testdat+7 + lbne error + ldx #testdat+4 + lda ,-x + cmpa #4 + lbne error + cmpx #testdat+3 + lbne error + ldd ,--x + cmpd #2*256+3 + lbne error + cmpx #testdat+1 + lbne error + ldx #testdat+4 + lda -2,x + cmpa #3 + lbne error + lda 2,x + cmpa #7 + lbne error + ldx #td1 + ldd [,x] + cmpd #3*256+4 + lbne error + cmpx #td1 + lbne error + jsr good + bra next1 +testdat fcb 1,2,3,4,5,6,7,8,9,10 +td1 fdb testdat+2 +next1 + + sync + end $100 + + + diff -r 4fa2bdb0c457 -r 2088fd998865 examples/uslash.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/uslash.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,145 @@ + ; 6809 32/16 divison for a forth environment + ; 2012-06-20, 2014-07-01 J.E. Klasek j+forth@klasek.at + ; + ; There are two implementations: + ; TALBOT just for analysis, not really used here. + ; EFORTH advanced and optimized version for ef09 + ; + ; EFORTH version's special cases: + ; overflow: quotient = $FFFF, remainder = divisor + ; underflow: quotient = $0000, remainder = dividend low + ; division by zero: quotient = $FFFF, remainder = $0000 + + org $100 + lds #$100 + ldu #$8000 + +; Testvalues: +; +; DIVH DIVL DVSR QUOT REM comment +; +; 0100 0000 FFFF 0100 0100 maximum divisor +; 0000 0001 8000 0000 0001 underflow (REM = DIVL) +; 0000 5800 3000 0001 1800 normal divsion +; 5800 0000 3000 FFFF 3000 overflow +; 0000 0001 0000 FFFF 0000 overflow (division by zero) +; + +DIVH EQU $0000 +DIVL EQU $5800 +DVSR EQU $3000 + + bra EFORTH ; comment out to try TALBOT's version + + ; ------------------------------------ + ; Version from Talbot System FIG Forth + ; ------------------------------------ + +TALBOT: + + ; sample parameters on forth parameter stack (U) ... + ldd #DIVL ; dividend low word + pshu d + ldd #DIVH ; dividend high word + pshu d + ldd #DVSR ; divisor + pshu d + +USLASH: ldd 2,u ; dividend swap H/L word + ldx 4,u + stx 2,u + std 4,u + asl 3,u ; initial shift of L word + rol 2,u + ldx #$10 +USL1: rol 5,u ; shift H word + rol 4,u + ldd 4,u + subd ,u ; does divisor fit? + andcc #$fe ; clc - clear carry flag + bmi USL2 + std 4,u ; fits -> quotient = 1 + orcc #$01 ; sec - set carry flag +USL2: rol 3,u ; L word/quotient + rol 2,u + leax -1,x + bne USL1 + leau 2,u ; drop divisor from parameter stack + + ; into registers for simulator ... + + ldx ,u ; quotient on TOS + ldd 2,u ; remainder on 2nd + +realexit: + sync + + + + + ; ------------------------------------ + ; Version from J.E. Klasek, replacing + ; high-level variant in eFORTH. + ; ------------------------------------ + +EFORTH: + ; sample parameters on forth parameter stack (S) ... + ldd #DIVL ; dividend low word + pshs d + ldd #DIVH ; dividend high word + pshs d + ldd #DVSR ; divisor + pshs d + +; U/ ( udl udh un -- ur uq ) +; Unsigned divide of a double by a single. Return mod and quotient. +; +; Special cases: +; 1. overflow: quotient overflow if dividend is to great (remainder = divisor), +; remainder is set to $FFFF -> special handling. +; This is checked also right before the main loop. +; 2. underflow: divisor does not fit into dividend -> remainder +; get the value of the dividend -> automatically covered. + +USLASH2: + ldx #16 + ldd 2,s ; udh + cmpd ,s ; dividend to great? + bhs UMMODOV ; quotient overflow! + asl 5,s ; udl low + rol 4,s ; udl high + +UMMOD1: rolb ; got one bit from udl + rola + bcs UMMOD2 ; bit 16 means always greater as divisor + cmpd ,s ; divide by un + bhs UMMOD2 ; higher or same as divisor? + andcc #$fe ; clc - clear carry flag + bra UMMOD3 +UMMOD2: subd ,s + orcc #$01 ; sec - set carry flag +UMMOD3: rol 5,s ; udl, quotient shifted in + rol 4,s + leax -1,x + bne UMMOD1 + + ldx 4,s ; quotient + cmpd ,s ; remainder >= divisor -> overflow + blo UMMOD4 +UMMODOV: + ldd ,s ; remainder set to divisor + ldx #$FFFF ; quotient = FFFF (-1) marks overflow + ; (case 1) +UMMOD4: + leas 2,s ; un (divisor thrown away) + stx ,s ; quotient to TOS + std 2,s ; remainder 2nd + + bra realexit + + ; not reached + pulu pc ; eFORTH NEXT + +enddata + + end diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/Makefile Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,44 @@ +# +# Makefile examples_forth SBC09/Sim6809 +# +# created 1994 by L.C. Benschop +# 2013-10-28 - Jens Diemer: add "clean" section +# 2014-07-16 - J.E. Klasek +# +# copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +# license: GNU General Public License version 2, see LICENSE for more details. +# + +ASM=../a09 + +PROGS=forthload.s + + + +all: $(ASM) $(PROGS) + +$(ASM): + $(MAKE) -c ../src a09 install + + +# ------------------------------------ +# rules + +.SUFFIXES: .asm .s + +.asm.s: + $(ASM) -s $@ $< + +# +# ------------------------------------ + +forthload.s: forthload.asm + + +# ------------------------------------ + +cleanall: clean + +clean: + rm -f core *.BAK *.lst $(PROGS) + diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/asm09.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/asm09.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,335 @@ +\ 6809 assembler + +BASE @ HEX + +: DEFER CREATE 0 , DOES> @ EXECUTE ; +: IS ' >BODY ! ; + +VOCABULARY ASSEMBLER +ASSEMBLER ALSO DEFINITIONS + +' C! DEFER VC! IS VC! \ Vectorize the important words so we can cross +' C@ DEFER VC@ IS VC@ \ assemble and self-assemble using the same code. +' ! DEFER V! IS V! +' @ DEFER V@ IS V@ +' C, DEFER C, IS C, +' , DEFER , IS , +' HERE DEFER HERE IS HERE +' ALLOT DEFER ALLOT IS ALLOT + +VARIABLE VDP +: VHERE ( --- addr) + VDP @ ; +: VALLOT VDP +! ; +: VC, ( c --- ) + VHERE VC! 1 VALLOT ; +: V, ( n ---) + VHERE V! 2 VALLOT ; +: ORG VDP ! ; + +: MARK ( --- addr ) + HERE 0 C, ; +: >RESOLVE ( addr --- ) + HERE OVER 1+ - SWAP VC! ; + +VARIABLE ?PREBYTE VARIABLE PREBYTE \ Byte $10 or $11 before opcode +VARIABLE ?OPCODE VARIABLE OPCODE \ Opcode byte +VARIABLE ?POSTBYTE VARIABLE POSTBYTE \ Byte after opcode indicating mode. +VARIABLE ?OPERAND \ Address or data after instruction. +VARIABLE MODE \ True is direct addressing false is other. +VARIABLE DPAGE \ Direct page address. +: SETDP ( n ---) \ Set direct page. + 100 * DPAGE ! ; +0 SETDP + +: NOINSTR \ Reset all the instruction flags so there will be no instruction. + ?PREBYTE OFF ?OPCODE OFF ?POSTBYTE OFF ?OPERAND OFF MODE OFF ; +: A; \ Assemble current instruction and reset instruction flags. + MODE @ IF \ direct addresiing? + DUP DPAGE @ - 0FF U> IF \ Is address 16 bits? + 2 ?OPERAND ! \ Indicate 16 bits address. + OPCODE @ 0F0 AND 0= \ Change opcode byte. + IF 70 OPCODE +! + ELSE 20 OPCODE +! + THEN + ELSE 1 ?OPERAND ! \ Indicate 8 bis address. + THEN + THEN + ?PREBYTE @ IF PREBYTE @ C, THEN + ?OPCODE @ IF OPCODE @ C, THEN + ?POSTBYTE @ IF POSTBYTE @ C, THEN + ?OPERAND @ IF + CASE ?OPERAND @ + 1 OF C, ENDOF \ 8 bits data/address. + 2 OF , ENDOF \ 16 bits data/address. + 3 OF HERE 1+ - C, ENDOF \ 8 bits relative address. + 4 OF HERE 2 + - , ENDOF \ 16 bits realtive address. + ENDCASE + THEN NOINSTR ; + + +: LABEL A; HERE CONSTANT ; + + +HEX +: flag10 \ Indicate that next instruction has prebyte $10 + ?PREBYTE ON 10 PREBYTE ! ; +: flag11 \ Indicate that next instruction has prebyte $11 + ?PREBYTE ON 11 PREBYTE ! ; + +: # \ Signal immediate mode. + MODE OFF -10 OPCODE +! ; + +: USE-POSTBYTE \ Signal that postbyte must be used. + MODE OFF + ?POSTBYTE ON + OPCODE @ 0F0 AND 0= IF + 60 OPCODE +! + ELSE + OPCODE @ 80 AND IF + 10 OPCODE +! + THEN + THEN ; + +: [] \ Signal indirect mode. + MODE @ IF \ Indirect addressing with 16-bits addres, no postbyte made yet. + USE-POSTBYTE + 9F POSTBYTE ! \ Make postbyte. + 2 ?OPERAND ! \ Indicate 16-bits address. + ELSE + POSTBYTE @ 80 AND 0= IF \ 5-bits address format already assembled? + POSTBYTE @ 1F AND DUP 10 AND 0<> 0E0 AND OR + 1 ?OPERAND ! \ Signal operand. + POSTBYTE @ 60 AND 98 OR POSTBYTE ! \ Change postbyte. + ELSE + POSTBYTE @ 10 OR POSTBYTE ! \ Indicate indirect addressing. + THEN + THEN ; + +: ,R \ Modes with a constant offset from a register. + CREATE C, + DOES> USE-POSTBYTE + C@ POSTBYTE ! \ Make register field in postbyte. + DUP 0= IF + 84 POSTBYTE +! DROP \ Zero offset. + ?OPERAND OFF + ELSE + DUP -10 >= OVER 0F <= AND IF \ 5-bit offset. + 1F AND POSTBYTE +! + ?OPERAND OFF + ELSE + DUP 80 + 100 U< IF \ 8-bit offset. + 88 POSTBYTE +! + 1 ?OPERAND ! + ELSE + 89 POSTBYTE +! \ 16-bit offset. + 2 ?OPERAND ! + THEN + THEN + THEN ; +00 ,R ,X +20 ,R ,Y +40 ,R ,U +60 ,R ,S + +: AMODE \ addressing modes with no operands. + CREATE C, + DOES> USE-POSTBYTE + C@ POSTBYTE ! + ?OPERAND OFF ; +080 AMODE ,X+ 081 AMODE ,X++ 082 AMODE ,-X 083 AMODE ,--X +085 AMODE B,X 086 AMODE A,X 08B AMODE D,X +0A0 AMODE ,Y+ 0A1 AMODE ,Y++ 0A2 AMODE ,-Y 0A3 AMODE ,--Y +0A5 AMODE B,Y 0A6 AMODE A,Y 0AB AMODE D,Y +0C0 AMODE ,U+ 0C1 AMODE ,U++ 0C2 AMODE ,-U 0C3 AMODE ,--U +0C5 AMODE B,U 0C6 AMODE A,U 0CB AMODE D,U +0E0 AMODE ,S+ 0E1 AMODE ,S++ 0E2 AMODE ,-S 0E3 AMODE ,--S +0E5 AMODE B,S 0E6 AMODE A,S 0EB AMODE D,S + +: ,PCR \ Signal program counter relative. + USE-POSTBYTE + DUP + HERE ?PREBYTE @ - 3 + - \ Subtract address after instruction + 80 + 100 U< IF \ 8-bits offset good? + 3 ?OPERAND ! + 8C POSTBYTE ! + ELSE + 4 ?OPERAND ! + 8D POSTBYTE ! + THEN ; + +: USE-OPCODE ( c ---) + ?OPCODE ON + OPCODE ! ; + +: IN1 \ Simple instructions with one byte opcode + CREATE C, + DOES> >R A; R> C@ USE-OPCODE ; +12 IN1 NOP 13 IN1 SYNC +19 IN1 DAA 1D IN1 SEX +39 IN1 RTS 3A IN1 ABX +3B IN1 RTI 3D IN1 MUL +3F IN1 SWI : SWI2 SWI flag10 ; : SWI3 SWI flag11 ; +40 IN1 NEGA 50 IN1 NEGB +43 IN1 COMA 53 IN1 COMB +44 IN1 LSRA 54 IN1 LSRB +46 IN1 RORA 56 IN1 RORB +47 IN1 ASRA 57 IN1 ASRB +48 IN1 ASLA 58 IN1 ASLB +48 IN1 LSLA 58 IN1 LSLB +49 IN1 ROLA 59 IN1 ROLB +4A IN1 DECA 5A IN1 DECB +4C IN1 INCA 5C IN1 INCB +4D IN1 TSTA 5D IN1 TSTB +4F IN1 CLRA 5F IN1 CLRB +\ Though not no-operand instructions the LEA instructions +\ are treated correctly as the postbyte is added by the mode words. +30 IN1 LEAX 31 IN1 LEAY +32 IN1 LEAS 33 IN1 LEAU +: DEX LEAX -1 ,X ; : INX LEAX 1 ,X ; +: DES LEAS -1 ,S ; : INS LEAS 1 ,S ; +: DEY LEAY -1 ,Y ; : INY LEAY 1 ,Y ; + +: BR-8 \ relative branches with 8-bit offset + CREATE C, + DOES> >R A; R> C@ USE-OPCODE 3 ?OPERAND ! ; + 20 BR-8 BRA 21 BR-8 BRN + 22 BR-8 BHI 23 BR-8 BLS + 24 BR-8 BCC 25 BR-8 BCS + 24 BR-8 BHS 25 BR-8 BLO + 26 BR-8 BNE 27 BR-8 BEQ + 28 BR-8 BVC 29 BR-8 BVS + 2A BR-8 BPL 2B BR-8 BMI + 2C BR-8 BGE 2D BR-8 BLT + 2E BR-8 BGT 2F BR-8 BLE + 8D BR-8 BSR + +: LBRA + A; 16 USE-OPCODE 4 ?OPERAND ! ; +: LBSR + A; 17 USE-OPCODE 4 ?OPERAND ! ; + +: BR16 \ Relative branches with 16-bit offset. + CREATE C, + DOES> >R A; R> C@ USE-OPCODE flag10 4 ?OPERAND ! ; + 21 BR16 LBRN + 22 BR16 LBHI 23 BR16 LBLS + 24 BR16 LBCC 25 BR16 LBCS + 24 BR16 LBHS 25 BR16 LBLO + 26 BR16 LBNE 27 BR16 LBEQ + 28 BR16 LBVC 29 BR16 LBVS + 2A BR16 LBPL 2B BR16 LBMI + 2C BR16 LBGE 2D BR16 LBLT + 2E BR16 LBGT 2F BR16 LBLE + +: IN2 \ Instructions with one immediate data byte. + CREATE C, + DOES> >R A; R> C@ USE-OPCODE 1 ?OPERAND ! ; +1A IN2 ORCC 1C IN2 ANDCC 3C IN2 CWAI +: CLC ANDCC 0FE ; : SEC ORCC 01 ; +: CLF ANDCC 0BF ; : SEF ORCC 40 ; +: CLI ANDCC 0EF ; : SEI ORCC 10 ; +: CLIF ANDCC 0AF ; : SEIF ORCC 50 ; +: CLV ANDCC 0FD ; : SEV ORCC 02 ; +: % ( --- n) \ Interpret next word as a binary number. + BASE @ 2 BASE ! BL WORD NUMBER? drop DROP SWAP BASE ! ; + +: REG \ Registers as used in PUSH PULL TFR and EXG instructions. + CREATE C, C, + DOES> ?OPERAND @ IF \ Is a PUSH/PULL instruction meant? + 1+ C@ OR + ELSE + C@ POSTBYTE +! \ It's a TFR,EXG instruction. + THEN ; +06 00 REG D, 06 00 REG D +10 10 REG X, 10 01 REG X +20 20 REG Y, 20 02 REG Y +40 30 REG U, 40 03 REG U +40 40 REG S, 40 04 REG S +80 50 REG PC, 80 05 REG PC +02 80 REG A, 02 08 REG A +04 90 REG B, 04 09 REG B +01 A0 REG CC, 01 0A REG CC +08 B0 REG DP, 08 0B REG DP + +: EXG A; 1E USE-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; +: TFR A; 1F USE-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; +: STK \ Stack instructions. + CREATE C, + DOES> >R A; R> C@ USE-OPCODE + 1 ?OPERAND ! 0 ; +34 STK PSHS 35 STK PULS +36 STK PSHU 37 STK PULU + +: OP-8 \ Instructions with 8-bits data. + CREATE C, + DOES> >R A; R> C@ USE-OPCODE + MODE ON + 1 ?OPERAND ! ; +00 OP-8 NEG 03 OP-8 COM +04 OP-8 LSR 06 OP-8 ROR +07 OP-8 ASR 08 OP-8 ASL +08 OP-8 LSL 09 OP-8 ROL +0A OP-8 DEC 0C OP-8 INC +0D OP-8 TST 0E OP-8 JMP +0F OP-8 CLR +90 OP-8 SUBA 0D0 OP-8 SUBB +91 OP-8 CMPA 0D1 OP-8 CMPB +92 OP-8 SBCA 0D2 OP-8 SBCB +94 OP-8 ANDA 0D4 OP-8 ANDB +95 OP-8 BITA 0D5 OP-8 BITB +96 OP-8 LDA 0D6 OP-8 LDB +97 OP-8 STA 0D7 OP-8 STB +98 OP-8 EORA 0D8 OP-8 EORB +99 OP-8 ADCA 0D9 OP-8 ADCB +9A OP-8 ORA 0DA OP-8 ORB +9B OP-8 ADDA 0DB OP-8 ADDB +9D OP-8 JSR + +: OP16 \ Instructions with 16-bits daia. + CREATE C, + DOES> >R A; R> C@ USE-OPCODE + MODE ON + 2 ?OPERAND ! ; +93 OP16 SUBD 0D3 OP16 ADDD +9C OP16 CMPX 0DC OP16 LDD 0DD OP16 STD +9E OP16 LDX 0DE OP16 LDU +9F OP16 STX 0DF OP16 STU +: CMPD SUBD flag10 ; : CMPY CMPX flag10 ; +: LDY LDX flag10 ; : STY STX flag10 ; +: LDS LDU flag10 ; : STS STU flag10 ; +: CMPU SUBD flag11 ; : CMPS CMPX flag11 ; + +\ Structured assembler constructs. +: IF >R A; R> C, >MARK ; +: THEN A; >RESOLVE ; +: ELSE A; 20 C, >MARK SWAP >RESOLVE ; +: BEGIN A; R A; R> C, R A; R> C, >MARK ; +: REPEAT A; 20 C, SWAP RESOLVE ; +: AGAIN 20 UNTIL ; +22 CONSTANT U<= 23 CONSTANT U> +24 CONSTANT U< 25 CONSTANT U>= +26 CONSTANT 0= 27 CONSTANT 0<> +28 CONSTANT VS 29 CONSTANT VC +2A CONSTANT 0< 2B CONSTANT 0>= +2C CONSTANT < 2D CONSTANT >= +2E CONSTANT <= 2F CONSTANT > + +: ENDASM \ End assembly. + A; PREVIOUS ; +FORTH DEFINITIONS +: ASSEMBLE \ Start assembly. + ALSO ASSEMBLER NOINSTR ; + +: CODE CREATE -3 ALLOT ASSEMBLE ; +: END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; + +PREVIOUS FORTH DEFINITIONS + +BASE ! \ Restore the original base. diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/asm6309.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/asm6309.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,454 @@ +\ 6309 assembler + +BASE @ HEX + +: DEFER CREATE 0 , DOES> @ EXECUTE ; +: IS ' >BODY ! ; + +VOCABULARY ASSEMBLER +ASSEMBLER ALSO DEFINITIONS + +' C! DEFER VC! IS VC! \ Vectorize the important words so we can cross +' C@ DEFER VC@ IS VC@ \ assemble and self-assemble using the same code. +' ! DEFER V! IS V! +' @ DEFER V@ IS V@ +' C, DEFER C, IS C, +' , DEFER , IS , +' HERE DEFER HERE IS HERE +' ALLOT DEFER ALLOT IS ALLOT + +VARIABLE VDP +: VHERE ( --- addr) + VDP @ ; +: VALLOT VDP +! ; +: VC, ( c --- ) + VHERE VC! 1 VALLOT ; +: V, ( n ---) + VHERE V! 2 VALLOT ; +: ORG VDP ! ; + +: MARK ( --- addr ) + HERE 0 C, ; +: >RESOLVE ( addr --- ) + HERE OVER 1+ - SWAP VC! ; + +VARIABLE ?MEMIMM \ Memory + immediate (AIM, OIM, EOIM) +VARIABLE ?OPCODE VARIABLE OPCODE \ Opcode byte +VARIABLE ?POSTBYTE VARIABLE POSTBYTE \ Byte after opcode indicating mode. +VARIABLE ?OPERAND \ Address or data after instruction. +VARIABLE MODE \ True is direct addressing false is other. +VARIABLE DPAGE \ Direct page address. +: SETDP ( n ---) \ Set direct page. + 100 * DPAGE ! ; +0 SETDP + +: NOINSTR \ Reset all the instruction flags so there will be no instruction. + ?OPCODE OFF ?POSTBYTE OFF ?OPERAND OFF MODE OFF ?MEMIMM OFF ; +: A; \ Assemble current instruction and reset instruction flags. + MODE @ IF \ direct addresiing? + DUP DPAGE @ - 0FF U> IF \ Is address 16 bits? + 2 ?OPERAND ! \ Indicate 16 bits address. + OPCODE @ 0F0 AND 0= \ Change opcode byte. + IF 70 OPCODE +! + ELSE 20 OPCODE +! + THEN + ELSE 1 ?OPERAND ! \ Indicate 8 bis address. + THEN + THEN + ?OPCODE @ IF + OPCODE @ DUP 100 > IF + DUP 8 RSHIFT C, \ assemble prebyte + THEN + C, + THEN + ?MEMIMM @ IF + ?OPERAND @ IF SWAP THEN \ move immediate byte from under operand. + C, + THEN + ?POSTBYTE @ IF POSTBYTE @ C, THEN + ?OPERAND @ IF + CASE ?OPERAND @ + 1 OF C, ENDOF \ 8 bits data/address. + 2 OF , ENDOF \ 16 bits data/address. + 3 OF HERE 1+ - C, ENDOF \ 8 bits relative address. + 4 OF HERE 2 + - , ENDOF \ 16 bits relative address. + 5 OF , , ENDOF \ 32 bits immediate (LDQ) + 6 OF \ single-bit operations. + >R \ Save DP address. + SWAP 3 LSHIFT OR \ or the bit numbers together. + SWAP 6 AND 5 LSHIFT OR \ Add register number. + C, \ Store post-byte (reg-srcbit-dstbit) + R> C, \ Store direct address. + ENDOF \ LDBT etc. + ENDCASE + THEN NOINSTR ; + + +: LABEL A; HERE CONSTANT ; + + +HEX + +: # \ Signal immediate mode. + MODE OFF -10 OPCODE +! + ?OPERAND @ 5 = IF \ Special case is LDQ immediate. + 0CD OPCODE ! + THEN +; + +: USE-POSTBYTE \ Signal that postbyte must be used. + MODE OFF + ?POSTBYTE ON + OPCODE @ 0F0 AND 0= IF + 60 OPCODE +! + ELSE + OPCODE @ 80 AND IF + 10 OPCODE +! + THEN + THEN ; + +: [] \ Signal indirect mode. + MODE @ IF \ Indirect addressing with 16-bits addres, no postbyte made yet. + USE-POSTBYTE + 9F POSTBYTE ! \ Make postbyte. + 2 ?OPERAND ! \ Indicate 16-bits address. + ELSE + POSTBYTE @ 80 AND 0= IF \ 5-bits address format already assembled? + POSTBYTE @ 1F AND DUP 10 AND 0<> 0E0 AND OR + 1 ?OPERAND ! \ Signal operand. + POSTBYTE @ 60 AND 98 OR POSTBYTE ! \ Change postbyte. + ELSE + POSTBYTE @ 9F AND 8F = + IF + POSTBYTE @ 1+ POSTBYTE ! \ special case for ,W indexing + ELSE + POSTBYTE @ 10 OR POSTBYTE ! \ Indicate indirect addressing. + THEN + THEN + THEN ; + +: ,R \ Modes with a constant offset from a register. + CREATE C, + DOES> USE-POSTBYTE + C@ POSTBYTE ! \ Make register field in postbyte. + DUP 0= IF + 84 POSTBYTE +! DROP \ Zero offset. + ?OPERAND OFF + ELSE + DUP -10 >= OVER 0F <= AND IF \ 5-bit offset. + 1F AND POSTBYTE +! + ?OPERAND OFF + ELSE + DUP 80 + 100 U< IF \ 8-bit offset. + 88 POSTBYTE +! + 1 ?OPERAND ! + ELSE + 89 POSTBYTE +! \ 16-bit offset. + 2 ?OPERAND ! + THEN + THEN + THEN ; +00 ,R ,X +20 ,R ,Y +40 ,R ,U +60 ,R ,S + +: ,W \ Addressing with constant offset from W register. + USE-POSTBYTE + DUP 0= IF + 8F POSTBYTE ! DROP \ offset = 0 + ?OPERAND OFF + ELSE + 0AF POSTBYTE ! \ 16-bit offset + 2 ?OPERAND ! + THEN +; + +: AMODE \ addressing modes with no operands. + CREATE C, + DOES> USE-POSTBYTE + C@ POSTBYTE ! + ?OPERAND OFF ; +080 AMODE ,X+ 081 AMODE ,X++ 082 AMODE ,-X 083 AMODE ,--X +085 AMODE B,X 086 AMODE A,X 08B AMODE D,X +087 AMODE E,X 08A AMODE F,X 08E AMODE W,X +0A0 AMODE ,Y+ 0A1 AMODE ,Y++ 0A2 AMODE ,-Y 0A3 AMODE ,--Y +0A5 AMODE B,Y 0A6 AMODE A,Y 0AB AMODE D,Y +0A7 AMODE E,Y 0AA AMODE F,Y 0AE AMODE W,Y +0C0 AMODE ,U+ 0C1 AMODE ,U++ 0C2 AMODE ,-U 0C3 AMODE ,--U +0C5 AMODE B,U 0C6 AMODE A,U 0CB AMODE D,U +0C7 AMODE E,U 0CA AMODE F,U 0CE AMODE W,U +0E0 AMODE ,S+ 0E1 AMODE ,S++ 0E2 AMODE ,-S 0E3 AMODE ,--S +0E5 AMODE B,S 0E6 AMODE A,S 0EB AMODE D,S +0E7 AMODE E,S 0EA AMODE F,S 0EE AMODE W,S +0CF AMODE ,W++ 0EF AMODE ,--W + +: ,PCR \ Signal program counter relative. + USE-POSTBYTE + DUP + HERE OPCODE @ 0FF U> - 3 + - \ Subtract address after instruction + 80 + 100 U< IF \ 8-bits offset good? + 3 ?OPERAND ! + 8C POSTBYTE ! + ELSE + 4 ?OPERAND ! + 8D POSTBYTE ! + THEN ; + +: USE-OPCODE ( w ---) + ?OPCODE ON + OPCODE ! ; + +: GET-OPCODE ( addr -- )\ + >R A; R> @ USE-OPCODE ; + +: IN1 \ Simple instructions with only opcode, possibly prebyte + CREATE , + DOES> GET-OPCODE ; +12 IN1 NOP 13 IN1 SYNC +14 IN1 SEXW +19 IN1 DAA 1D IN1 SEX +39 IN1 RTS 3A IN1 ABX +3B IN1 RTI 3D IN1 MUL +1038 IN1 PSHSW 1039 IN1 PULSW +103A IN1 PSHUW 103B IN1 PULUW +3F IN1 SWI 103F IN1 SWI2 113F IN1 SWI3 +40 IN1 NEGA 50 IN1 NEGB +43 IN1 COMA 53 IN1 COMB +44 IN1 LSRA 54 IN1 LSRB +46 IN1 RORA 56 IN1 RORB +47 IN1 ASRA 57 IN1 ASRB +48 IN1 ASLA 58 IN1 ASLB +48 IN1 LSLA 58 IN1 LSLB +49 IN1 ROLA 59 IN1 ROLB +4A IN1 DECA 5A IN1 DECB +4C IN1 INCA 5C IN1 INCB +4D IN1 TSTA 5D IN1 TSTB +4F IN1 CLRA 5F IN1 CLRB +1040 IN1 NEGD 1050 IN1 NEGW +1043 IN1 COMD 1051 IN1 COMW +1044 IN1 LSRD 1054 IN1 LSRW +1046 IN1 RORD 1056 IN1 RORW +1047 IN1 ASRD \ what were they smoking when they decided to leave out ASRW/ASLW +1048 IN1 ASLD +1048 IN1 LSRD +1049 IN1 ROLD 1059 IN1 ROLW +104A IN1 DECD 105A IN1 DECW +104C IN1 INCD 105C IN1 INCW +104D IN1 TSTD 105D IN1 TSTW +104F IN1 CLRD 105F IN1 CLRW +1143 IN1 COME 1153 IN1 COMF +114A IN1 DECE 115A IN1 DECF +114C IN1 INCE 115C IN1 INCF +114D IN1 TSTE 115D IN1 TSTF +114F IN1 CLRE 115F IN1 CLRF + +\ Though not no-operand instructions the LEA instructions +\ are treated correctly as the postbyte is added by the mode words. +30 IN1 LEAX 31 IN1 LEAY +32 IN1 LEAS 33 IN1 LEAU + +: BR-8 \ relative branches with 8-bit offset + CREATE , + DOES> GET-OPCODE 3 ?OPERAND ! ; + 20 BR-8 BRA 21 BR-8 BRN + 22 BR-8 BHI 23 BR-8 BLS + 24 BR-8 BCC 25 BR-8 BCS + 24 BR-8 BHS 25 BR-8 BLO + 26 BR-8 BNE 27 BR-8 BEQ + 28 BR-8 BVC 29 BR-8 BVS + 2A BR-8 BPL 2B BR-8 BMI + 2C BR-8 BGE 2D BR-8 BLT + 2E BR-8 BGT 2F BR-8 BLE + 8D BR-8 BSR + +: LBRA + A; 16 USE-OPCODE 4 ?OPERAND ! ; +: LBSR + A; 17 USE-OPCODE 4 ?OPERAND ! ; + +: BR16 \ Relative branches with 16-bit offset. + CREATE , + DOES> GET-OPCODE 4 ?OPERAND ! ; + 1021 BR16 LBRN + 1022 BR16 LBHI 1023 BR16 LBLS + 1024 BR16 LBCC 1025 BR16 LBCS + 1024 BR16 LBHS 1025 BR16 LBLO + 1026 BR16 LBNE 1027 BR16 LBEQ + 1028 BR16 LBVC 1029 BR16 LBVS + 102A BR16 LBPL 102B BR16 LBMI + 102C BR16 LBGE 102D BR16 LBLT + 102E BR16 LBGT 102F BR16 LBLE + +: IN2 \ Instructions with one immediate data byte. + CREATE , + DOES> GET-OPCODE 1 ?OPERAND ! ; +1A IN2 ORCC 1C IN2 ANDCC 3C IN2 CWAI +113C IN2 BITMD 113D IN2 LDMD +: % ( --- n) \ Interpret next word as a binary number. + BASE @ 2 BASE ! BL WORD NUMBER? drop DROP SWAP BASE ! ; + +: REG \ Registers as used in PUSH PULL TFR and EXG instructions. + CREATE C, C, + DOES> ?OPERAND @ IF \ Is a PUSH/PULL instruction meant? + 1+ C@ OR + ELSE + C@ POSTBYTE +! \ It's a TFR,EXG instruction. + THEN ; +06 00 REG D, 06 00 REG D +10 10 REG X, 10 01 REG X +20 20 REG Y, 20 02 REG Y +40 30 REG U, 40 03 REG U +40 40 REG S, 40 04 REG S +80 50 REG PC, 80 05 REG PC +00 60 REG W, 00 06 REG W +00 70 REG V, 00 07 REG V +02 80 REG A, 02 08 REG A +04 90 REG B, 04 09 REG B +01 A0 REG CC, 01 0A REG CC +08 B0 REG DP, 08 0B REG DP +00 C0 REG Z, 08 0C REG Z \ Zero register. +00 E0 REG E, 00 0E REG E +00 F0 REG F, 00 0F REG F + +: R2R \ Reg to reg instructions + CREATE , DOES> GET-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; + 1E R2R EXG + 1F R2R TFR +1030 R2R ADDR +1031 R2R ADCR +1032 R2R SUBR +1033 R2R SBCR +1034 R2R ANDR +1035 R2R ORR +1036 R2R EORR +1037 R2R CMPR + +1138 R2R TFM++ \ TFM++ X, Y for tfm x+,y+ +1139 R2R TFM-- \ TFM-- X, Y for tfm x-,y- +113A R2R TFM+0 \ TFM+0 X, Y for tfm x+,y +113B R2R TFM0+ \ TFM0+ X, Y for tfm x,y+ + + +: STK \ Stack instructions. + CREATE , + DOES> GET-OPCODE + 1 ?OPERAND ! 0 ; +34 STK PSHS 35 STK PULS +36 STK PSHU 37 STK PULU + +: OP-8 \ Instructions with 8-bits data. + CREATE , + DOES> GET-OPCODE + MODE ON + 1 ?OPERAND ! ; +00 OP-8 NEG 03 OP-8 COM +04 OP-8 LSR 06 OP-8 ROR +07 OP-8 ASR 08 OP-8 ASL +08 OP-8 LSL 09 OP-8 ROL +0A OP-8 DEC 0C OP-8 INC +0D OP-8 TST 0E OP-8 JMP +0F OP-8 CLR +90 OP-8 SUBA 0D0 OP-8 SUBB +91 OP-8 CMPA 0D1 OP-8 CMPB +92 OP-8 SBCA 0D2 OP-8 SBCB +94 OP-8 ANDA 0D4 OP-8 ANDB +95 OP-8 BITA 0D5 OP-8 BITB +96 OP-8 LDA 0D6 OP-8 LDB +97 OP-8 STA 0D7 OP-8 STB +98 OP-8 EORA 0D8 OP-8 EORB +99 OP-8 ADCA 0D9 OP-8 ADCB +9A OP-8 ORA 0DA OP-8 ORB +9B OP-8 ADDA 0DB OP-8 ADDB +9D OP-8 JSR +1190 OP-8 SUBE 11D0 OP-8 SUBF +1191 OP-8 CMPE 11D1 OP-8 CMPF +1196 OP-8 LDE 11D6 OP-8 LDF +1197 OP-8 STE 11D7 OP-8 STF +119B OP-8 ADDE 11DB OP-8 ADDF +119D OP-8 DIVD + +: OP16 \ Instructions with 16-bits daia. + CREATE , + DOES> GET-OPCODE + MODE ON + 2 ?OPERAND ! ; +93 OP16 SUBD 0D3 OP16 ADDD +9C OP16 CMPX 0DC OP16 LDD 0DD OP16 STD +9E OP16 LDX 0DE OP16 LDU +9F OP16 STX 0DF OP16 STU +1090 OP16 SUBW 1091 OP16 CMPW +1092 OP16 SBCD 1093 OP16 CMPD +1094 OP16 ANDD 1095 OP16 BITD +1096 OP16 LDW 1097 OP16 STW +1098 OP16 EORD 1099 OP16 ADCD +109A OP16 ORD 109B OP16 ADDW +109C OP16 CMPY +109E OP16 LDY 109F OP16 STY +10DE OP16 LDS 10DF OP16 STS +1193 OP16 CMPU 119C OP16 CMPS +119E OP16 DIVQ 119F OP16 MULD + +: OP32 \ Instructions with 32-bits daia. + CREATE , + DOES> GET-OPCODE + MODE ON + 5 ?OPERAND ! ; +10DC OP32 LDQ 10DD OP32 STQ + +: OP-MEMIMM \ Instructions with memory addressing and 8-bit immediate + CREATE , + DOES> GET-OPCODE + MODE ON ?MEMIMM ON + 1 ?OPERAND ! ; +01 OP-MEMIMM OIM +02 OP-MEMIMM AIM +05 OP-MEMIMM EIM +0B OP-MEMIMM TIM + +: OP-BIT \ Instructions for single bit in A,B,CC register and direct page. + CREATE , + DOES> GET-OPCODE + 6 ?OPERAND ! 0 ; +1130 OP-BIT BAND +1131 OP-BIT BIAND +1132 OP-BIT BOR +1133 OP-BIT BIOR +1134 OP-BIT BEOR +1135 OP-BIT BIEOR +1136 OP-BIT LDBT +1137 OP-BIT STBT + +\ Structured assembler constructs. +: IF >R A; R> C, >MARK ; +: THEN A; >RESOLVE ; +: ELSE A; 20 C, >MARK SWAP >RESOLVE ; +: BEGIN A; R A; R> C, R A; R> C, >MARK ; +: REPEAT A; 20 C, SWAP RESOLVE ; +: AGAIN 20 UNTIL ; +22 CONSTANT U<= 23 CONSTANT U> +24 CONSTANT U< 25 CONSTANT U>= +26 CONSTANT 0= 27 CONSTANT 0<> +28 CONSTANT VS 29 CONSTANT VC +2A CONSTANT 0< 2B CONSTANT 0>= +2C CONSTANT < 2D CONSTANT >= +2E CONSTANT <= 2F CONSTANT > + +: ENDASM \ End assembly. + A; PREVIOUS ; +FORTH DEFINITIONS +: ASSEMBLE \ Start assembly. + ALSO ASSEMBLER NOINSTR ; + +: CODE CREATE -3 ALLOT ASSEMBLE ; +: END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; + +PREVIOUS FORTH DEFINITIONS + +BASE ! \ Restore the original base. diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/core.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/core.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,957 @@ +\ (C) 1993 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY +\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. +\ VERSION 1.0 +\ THIS PROGRAM TESTS THE CORE WORDS OF AN ANS FORTH SYSTEM. +\ THE PROGRAM ASSUMES A TWO'S COMPLEMENT IMPLEMENTATION WHERE +\ THE RANGE OF SIGNED NUMBERS IS -2^(N-1) ... 2^(N-1)-1 AND +\ THE RANGE OF UNSIGNED NUMBER IS 0 ... 2^(N)-1. +\ I HAVEN'T FIGURED OUT HOW TO TEST KEY, QUIT, ABORT, OR ABORT"... +\ I ALSO HAVEN'T THOUGHT OF A WAY TO TEST ENVIRONMENT?... + +TESTING CORE WORDS +HEX + +\ ------------------------------------------------------------------------ +TESTING BOOLEANS: INVERT AND OR XOR + +{ 0 0 AND -> 0 } +{ 0 1 AND -> 0 } +{ 1 0 AND -> 0 } +{ 1 1 AND -> 1 } + +{ 0 INVERT 1 AND -> 1 } +{ 1 INVERT 1 AND -> 0 } + +0 CONSTANT 0S +0 INVERT CONSTANT 1S + +{ 0S INVERT -> 1S } +{ 1S INVERT -> 0S } + +{ 0S 0S AND -> 0S } +{ 0S 1S AND -> 0S } +{ 1S 0S AND -> 0S } +{ 1S 1S AND -> 1S } + +{ 0S 0S OR -> 0S } +{ 0S 1S OR -> 1S } +{ 1S 0S OR -> 1S } +{ 1S 1S OR -> 1S } + +{ 0S 0S XOR -> 0S } +{ 0S 1S XOR -> 1S } +{ 1S 0S XOR -> 1S } +{ 1S 1S XOR -> 0S } + +\ ------------------------------------------------------------------------ +TESTING 2* 2/ LSHIFT RSHIFT + +: FIND-MSB + 1 BEGIN DUP 2* WHILE 2* REPEAT ; +FIND-MSB CONSTANT MSB + +{ 0 2* -> 0 } +{ 1 2* -> 2 } +{ 4000 2* -> 8000 } +{ 0 INVERT 2* 1 XOR -> 0 INVERT } +{ MSB 2* -> 0 } + +{ 0 2/ -> 0 } +{ 1 2/ -> 0 } +{ 4000 2/ -> 2000 } +{ 0 INVERT 2/ -> 0 INVERT } \ MSB PROPOGATED +{ 0 INVERT 1 XOR 2/ -> 0 INVERT } +{ MSB 2/ MSB AND -> MSB } + +{ 1 0 LSHIFT -> 1 } +{ 1 1 LSHIFT -> 2 } +{ 1 2 LSHIFT -> 4 } +{ 1 F LSHIFT -> 8000 } \ BIGGEST GUARANTEED SHIFT +{ 0 INVERT 1 LSHIFT 1 XOR -> 0 INVERT } +{ MSB 1 LSHIFT -> 0 } + +{ 1 0 RSHIFT -> 1 } +{ 1 1 RSHIFT -> 0 } +{ 2 1 RSHIFT -> 1 } +{ 4 2 RSHIFT -> 1 } +{ 8000 F RSHIFT -> 1 } \ BIGGEST +{ MSB 1 RSHIFT MSB AND -> 0 } \ RSHIFT ZERO FILLS MSBS +{ MSB 1 RSHIFT 2* -> MSB } + +\ ------------------------------------------------------------------------ +TESTING COMPARISONS: 0= = 0< < > U< MIN MAX +0 INVERT CONSTANT MAX-UINT +0 INVERT 1 RSHIFT CONSTANT MAX-INT +0 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT +0 INVERT 1 RSHIFT CONSTANT MID-UINT +0 INVERT 1 RSHIFT INVERT CONSTANT MID-UINT+1 + +0S CONSTANT +1S CONSTANT + +{ -> } \ START WITH CLEAN SLATE +{ 0 0= -> } +{ 1 0= -> } +{ 2 0= -> } +{ -1 0= -> } +{ MAX-UINT 0= -> } +{ MIN-INT 0= -> } +{ MAX-INT 0= -> } + +{ 0 0 = -> } +{ 1 1 = -> } +{ -1 -1 = -> } +{ 1 0 = -> } +{ -1 0 = -> } +{ 0 1 = -> } +{ 0 -1 = -> } + +{ 0 0< -> } +{ -1 0< -> } +{ MIN-INT 0< -> } +{ 1 0< -> } +{ MAX-INT 0< -> } + +{ 0 1 < -> } +{ 1 2 < -> } +{ -1 0 < -> } +{ -1 1 < -> } +{ MIN-INT 0 < -> } +{ MIN-INT MAX-INT < -> } +{ 0 MAX-INT < -> } +{ 0 0 < -> } +{ 1 1 < -> } +{ 1 0 < -> } +{ 2 1 < -> } +{ 0 -1 < -> } +{ 1 -1 < -> } +{ 0 MIN-INT < -> } +{ MAX-INT MIN-INT < -> } +{ MAX-INT 0 < -> } + +{ 0 1 > -> } +{ 1 2 > -> } +{ -1 0 > -> } +{ -1 1 > -> } +{ MIN-INT 0 > -> } +{ MIN-INT MAX-INT > -> } +{ 0 MAX-INT > -> } +{ 0 0 > -> } +{ 1 1 > -> } +{ 1 0 > -> } +{ 2 1 > -> } +{ 0 -1 > -> } +{ 1 -1 > -> } +{ 0 MIN-INT > -> } +{ MAX-INT MIN-INT > -> } +{ MAX-INT 0 > -> } + +{ 0 1 U< -> } +{ 1 2 U< -> } +{ 0 MID-UINT U< -> } +{ 0 MAX-UINT U< -> } +{ MID-UINT MAX-UINT U< -> } +{ 0 0 U< -> } +{ 1 1 U< -> } +{ 1 0 U< -> } +{ 2 1 U< -> } +{ MID-UINT 0 U< -> } +{ MAX-UINT 0 U< -> } +{ MAX-UINT MID-UINT U< -> } + +{ 0 1 MIN -> 0 } +{ 1 2 MIN -> 1 } +{ -1 0 MIN -> -1 } +{ -1 1 MIN -> -1 } +{ MIN-INT 0 MIN -> MIN-INT } +{ MIN-INT MAX-INT MIN -> MIN-INT } +{ 0 MAX-INT MIN -> 0 } +{ 0 0 MIN -> 0 } +{ 1 1 MIN -> 1 } +{ 1 0 MIN -> 0 } +{ 2 1 MIN -> 1 } +{ 0 -1 MIN -> -1 } +{ 1 -1 MIN -> -1 } +{ 0 MIN-INT MIN -> MIN-INT } +{ MAX-INT MIN-INT MIN -> MIN-INT } +{ MAX-INT 0 MIN -> 0 } + +{ 0 1 MAX -> 1 } +{ 1 2 MAX -> 2 } +{ -1 0 MAX -> 0 } +{ -1 1 MAX -> 1 } +{ MIN-INT 0 MAX -> 0 } +{ MIN-INT MAX-INT MAX -> MAX-INT } +{ 0 MAX-INT MAX -> MAX-INT } +{ 0 0 MAX -> 0 } +{ 1 1 MAX -> 1 } +{ 1 0 MAX -> 1 } +{ 2 1 MAX -> 2 } +{ 0 -1 MAX -> 0 } +{ 1 -1 MAX -> 1 } +{ 0 MIN-INT MAX -> 0 } +{ MAX-INT MIN-INT MAX -> MAX-INT } +{ MAX-INT 0 MAX -> MAX-INT } + +\ ------------------------------------------------------------------------ +TESTING STACK OPS: 2DROP 2DUP 2OVER 2SWAP ?DUP DEPTH DROP DUP OVER ROT SWAP + +{ 1 2 2DROP -> } +{ 1 2 2DUP -> 1 2 1 2 } +{ 1 2 3 4 2OVER -> 1 2 3 4 1 2 } +{ 1 2 3 4 2SWAP -> 3 4 1 2 } +{ 0 ?DUP -> 0 } +{ 1 ?DUP -> 1 1 } +{ -1 ?DUP -> -1 -1 } +{ DEPTH -> 0 } +{ 0 DEPTH -> 0 1 } +{ 0 1 DEPTH -> 0 1 2 } +{ 0 DROP -> } +{ 1 2 DROP -> 1 } +{ 1 DUP -> 1 1 } +{ 1 2 OVER -> 1 2 1 } +{ 1 2 3 ROT -> 2 3 1 } +{ 1 2 SWAP -> 2 1 } + +\ ------------------------------------------------------------------------ +TESTING >R R> R@ + +{ : GR1 >R R> ; -> } +{ : GR2 >R R@ R> DROP ; -> } +{ 123 GR1 -> 123 } +{ 123 GR2 -> 123 } + +\ ------------------------------------------------------------------------ +TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE + +{ 0 5 + -> 5 } +{ 5 0 + -> 5 } +{ 0 -5 + -> -5 } +{ -5 0 + -> -5 } +{ 1 2 + -> 3 } +{ 1 -2 + -> -1 } +{ -1 2 + -> 1 } +{ -1 -2 + -> -3 } +{ -1 1 + -> 0 } +{ MID-UINT 1 + -> MID-UINT+1 } + +{ 0 5 - -> -5 } +{ 5 0 - -> 5 } +{ 0 -5 - -> 5 } +{ -5 0 - -> -5 } +{ 1 2 - -> -1 } +{ 1 -2 - -> 3 } +{ -1 2 - -> -3 } +{ -1 -2 - -> 1 } +{ 0 1 - -> -1 } +{ MID-UINT+1 1 - -> MID-UINT } + +{ 0 1+ -> 1 } +{ -1 1+ -> 0 } +{ 1 1+ -> 2 } +{ MID-UINT 1+ -> MID-UINT+1 } + +{ 2 1- -> 1 } +{ 1 1- -> 0 } +{ 0 1- -> -1 } +{ MID-UINT+1 1- -> MID-UINT } + +{ 0 NEGATE -> 0 } +{ 1 NEGATE -> -1 } +{ -1 NEGATE -> 1 } +{ 2 NEGATE -> -2 } +{ -2 NEGATE -> 2 } + +{ 0 ABS -> 0 } +{ 1 ABS -> 1 } +{ -1 ABS -> 1 } +{ MIN-INT ABS -> MID-UINT+1 } + +\ ------------------------------------------------------------------------ +TESTING MULTIPLY: S>D * M* UM* + +{ 0 S>D -> 0 0 } +{ 1 S>D -> 1 0 } +{ 2 S>D -> 2 0 } +{ -1 S>D -> -1 -1 } +{ -2 S>D -> -2 -1 } +{ MIN-INT S>D -> MIN-INT -1 } +{ MAX-INT S>D -> MAX-INT 0 } + +{ 0 0 M* -> 0 S>D } +{ 0 1 M* -> 0 S>D } +{ 1 0 M* -> 0 S>D } +{ 1 2 M* -> 2 S>D } +{ 2 1 M* -> 2 S>D } +{ 3 3 M* -> 9 S>D } +{ -3 3 M* -> -9 S>D } +{ 3 -3 M* -> -9 S>D } +{ -3 -3 M* -> 9 S>D } +{ 0 MIN-INT M* -> 0 S>D } +{ 1 MIN-INT M* -> MIN-INT S>D } +{ 2 MIN-INT M* -> 0 1S } +{ 0 MAX-INT M* -> 0 S>D } +{ 1 MAX-INT M* -> MAX-INT S>D } +{ 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 } +{ MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT } +{ MAX-INT MIN-INT M* -> MSB MSB 2/ } +{ MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT } + +{ 0 0 * -> 0 } \ TEST IDENTITIES +{ 0 1 * -> 0 } +{ 1 0 * -> 0 } +{ 1 2 * -> 2 } +{ 2 1 * -> 2 } +{ 3 3 * -> 9 } +{ -3 3 * -> -9 } +{ 3 -3 * -> -9 } +{ -3 -3 * -> 9 } + +{ MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 } +{ MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 } +{ MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 } + +{ 0 0 UM* -> 0 0 } +{ 0 1 UM* -> 0 0 } +{ 1 0 UM* -> 0 0 } +{ 1 2 UM* -> 2 0 } +{ 2 1 UM* -> 2 0 } +{ 3 3 UM* -> 9 0 } + +{ MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 } +{ MID-UINT+1 2 UM* -> 0 1 } +{ MID-UINT+1 4 UM* -> 0 2 } +{ 1S 2 UM* -> 1S 1 LSHIFT 1 } +{ MAX-UINT MAX-UINT UM* -> 1 1 INVERT } + +\ ------------------------------------------------------------------------ +TESTING DIVIDE: FM/MOD SM/REM UM/MOD */ */MOD / /MOD MOD + +{ 0 S>D 1 FM/MOD -> 0 0 } +{ 1 S>D 1 FM/MOD -> 0 1 } +{ 2 S>D 1 FM/MOD -> 0 2 } +{ -1 S>D 1 FM/MOD -> 0 -1 } +{ -2 S>D 1 FM/MOD -> 0 -2 } +{ 0 S>D -1 FM/MOD -> 0 0 } +{ 1 S>D -1 FM/MOD -> 0 -1 } +{ 2 S>D -1 FM/MOD -> 0 -2 } +{ -1 S>D -1 FM/MOD -> 0 1 } +{ -2 S>D -1 FM/MOD -> 0 2 } +{ 2 S>D 2 FM/MOD -> 0 1 } +{ -1 S>D -1 FM/MOD -> 0 1 } +{ -2 S>D -2 FM/MOD -> 0 1 } +{ 7 S>D 3 FM/MOD -> 1 2 } +{ 7 S>D -3 FM/MOD -> -2 -3 } +{ -7 S>D 3 FM/MOD -> 2 -3 } +{ -7 S>D -3 FM/MOD -> -1 2 } +{ MAX-INT S>D 1 FM/MOD -> 0 MAX-INT } +{ MIN-INT S>D 1 FM/MOD -> 0 MIN-INT } +{ MAX-INT S>D MAX-INT FM/MOD -> 0 1 } +{ MIN-INT S>D MIN-INT FM/MOD -> 0 1 } +{ 1S 1 4 FM/MOD -> 3 MAX-INT } +{ 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT } +{ 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 } +{ 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT } +{ 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 } +{ 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT } +{ 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 } +{ 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT } +{ 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 } +{ MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT } +{ MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT } +{ MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT } +{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT } + +{ 0 S>D 1 SM/REM -> 0 0 } +{ 1 S>D 1 SM/REM -> 0 1 } +{ 2 S>D 1 SM/REM -> 0 2 } +{ -1 S>D 1 SM/REM -> 0 -1 } +{ -2 S>D 1 SM/REM -> 0 -2 } +{ 0 S>D -1 SM/REM -> 0 0 } +{ 1 S>D -1 SM/REM -> 0 -1 } +{ 2 S>D -1 SM/REM -> 0 -2 } +{ -1 S>D -1 SM/REM -> 0 1 } +{ -2 S>D -1 SM/REM -> 0 2 } +{ 2 S>D 2 SM/REM -> 0 1 } +{ -1 S>D -1 SM/REM -> 0 1 } +{ -2 S>D -2 SM/REM -> 0 1 } +{ 7 S>D 3 SM/REM -> 1 2 } +{ 7 S>D -3 SM/REM -> 1 -2 } +{ -7 S>D 3 SM/REM -> -1 -2 } +{ -7 S>D -3 SM/REM -> -1 2 } +{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT } +{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT } +{ MAX-INT S>D MAX-INT SM/REM -> 0 1 } +{ MIN-INT S>D MIN-INT SM/REM -> 0 1 } +{ 1S 1 4 SM/REM -> 3 MAX-INT } +{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT } +{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 } +{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT } +{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 } +{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT } +{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT } +{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT } +{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT } + +{ 0 0 1 UM/MOD -> 0 0 } +{ 1 0 1 UM/MOD -> 0 1 } +{ 1 0 2 UM/MOD -> 1 0 } +{ 3 0 2 UM/MOD -> 1 1 } +{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT } +{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 } +{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT } + +: IFFLOORED + [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ; +: IFSYM + [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ; + +\ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION. +\ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST. +IFFLOORED : T/MOD >R S>D R> FM/MOD ; +IFFLOORED : T/ T/MOD SWAP DROP ; +IFFLOORED : TMOD T/MOD DROP ; +IFFLOORED : T*/MOD >R M* R> FM/MOD ; +IFFLOORED : T*/ T*/MOD SWAP DROP ; +IFSYM : T/MOD >R S>D R> SM/REM ; +IFSYM : T/ T/MOD SWAP DROP ; +IFSYM : TMOD T/MOD DROP ; +IFSYM : T*/MOD >R M* R> SM/REM ; +IFSYM : T*/ T*/MOD SWAP DROP ; + +{ 0 1 /MOD -> 0 1 T/MOD } +{ 1 1 /MOD -> 1 1 T/MOD } +{ 2 1 /MOD -> 2 1 T/MOD } +{ -1 1 /MOD -> -1 1 T/MOD } +{ -2 1 /MOD -> -2 1 T/MOD } +{ 0 -1 /MOD -> 0 -1 T/MOD } +{ 1 -1 /MOD -> 1 -1 T/MOD } +{ 2 -1 /MOD -> 2 -1 T/MOD } +{ -1 -1 /MOD -> -1 -1 T/MOD } +{ -2 -1 /MOD -> -2 -1 T/MOD } +{ 2 2 /MOD -> 2 2 T/MOD } +{ -1 -1 /MOD -> -1 -1 T/MOD } +{ -2 -2 /MOD -> -2 -2 T/MOD } +{ 7 3 /MOD -> 7 3 T/MOD } +{ 7 -3 /MOD -> 7 -3 T/MOD } +{ -7 3 /MOD -> -7 3 T/MOD } +{ -7 -3 /MOD -> -7 -3 T/MOD } +{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD } +{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD } +{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD } +{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD } + +{ 0 1 / -> 0 1 T/ } +{ 1 1 / -> 1 1 T/ } +{ 2 1 / -> 2 1 T/ } +{ -1 1 / -> -1 1 T/ } +{ -2 1 / -> -2 1 T/ } +{ 0 -1 / -> 0 -1 T/ } +{ 1 -1 / -> 1 -1 T/ } +{ 2 -1 / -> 2 -1 T/ } +{ -1 -1 / -> -1 -1 T/ } +{ -2 -1 / -> -2 -1 T/ } +{ 2 2 / -> 2 2 T/ } +{ -1 -1 / -> -1 -1 T/ } +{ -2 -2 / -> -2 -2 T/ } +{ 7 3 / -> 7 3 T/ } +{ 7 -3 / -> 7 -3 T/ } +{ -7 3 / -> -7 3 T/ } +{ -7 -3 / -> -7 -3 T/ } +{ MAX-INT 1 / -> MAX-INT 1 T/ } +{ MIN-INT 1 / -> MIN-INT 1 T/ } +{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ } +{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ } + +{ 0 1 MOD -> 0 1 TMOD } +{ 1 1 MOD -> 1 1 TMOD } +{ 2 1 MOD -> 2 1 TMOD } +{ -1 1 MOD -> -1 1 TMOD } +{ -2 1 MOD -> -2 1 TMOD } +{ 0 -1 MOD -> 0 -1 TMOD } +{ 1 -1 MOD -> 1 -1 TMOD } +{ 2 -1 MOD -> 2 -1 TMOD } +{ -1 -1 MOD -> -1 -1 TMOD } +{ -2 -1 MOD -> -2 -1 TMOD } +{ 2 2 MOD -> 2 2 TMOD } +{ -1 -1 MOD -> -1 -1 TMOD } +{ -2 -2 MOD -> -2 -2 TMOD } +{ 7 3 MOD -> 7 3 TMOD } +{ 7 -3 MOD -> 7 -3 TMOD } +{ -7 3 MOD -> -7 3 TMOD } +{ -7 -3 MOD -> -7 -3 TMOD } +{ MAX-INT 1 MOD -> MAX-INT 1 TMOD } +{ MIN-INT 1 MOD -> MIN-INT 1 TMOD } +{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD } +{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD } + +{ 0 2 1 */ -> 0 2 1 T*/ } +{ 1 2 1 */ -> 1 2 1 T*/ } +{ 2 2 1 */ -> 2 2 1 T*/ } +{ -1 2 1 */ -> -1 2 1 T*/ } +{ -2 2 1 */ -> -2 2 1 T*/ } +{ 0 2 -1 */ -> 0 2 -1 T*/ } +{ 1 2 -1 */ -> 1 2 -1 T*/ } +{ 2 2 -1 */ -> 2 2 -1 T*/ } +{ -1 2 -1 */ -> -1 2 -1 T*/ } +{ -2 2 -1 */ -> -2 2 -1 T*/ } +{ 2 2 2 */ -> 2 2 2 T*/ } +{ -1 2 -1 */ -> -1 2 -1 T*/ } +{ -2 2 -2 */ -> -2 2 -2 T*/ } +{ 7 2 3 */ -> 7 2 3 T*/ } +{ 7 2 -3 */ -> 7 2 -3 T*/ } +{ -7 2 3 */ -> -7 2 3 T*/ } +{ -7 2 -3 */ -> -7 2 -3 T*/ } +{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ } +{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ } + +{ 0 2 1 */MOD -> 0 2 1 T*/MOD } +{ 1 2 1 */MOD -> 1 2 1 T*/MOD } +{ 2 2 1 */MOD -> 2 2 1 T*/MOD } +{ -1 2 1 */MOD -> -1 2 1 T*/MOD } +{ -2 2 1 */MOD -> -2 2 1 T*/MOD } +{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD } +{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD } +{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD } +{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD } +{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD } +{ 2 2 2 */MOD -> 2 2 2 T*/MOD } +{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD } +{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD } +{ 7 2 3 */MOD -> 7 2 3 T*/MOD } +{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD } +{ -7 2 3 */MOD -> -7 2 3 T*/MOD } +{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD } +{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD } +{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD } + +\ ------------------------------------------------------------------------ +TESTING HERE , @ ! CELL+ CELLS C, C@ C! CHARS 2@ 2! ALIGN ALIGNED +! ALLOT + +HERE 1 ALLOT +HERE +CONSTANT 2NDA +CONSTANT 1STA +{ 1STA 2NDA U< -> } \ HERE MUST GROW WITH ALLOT +{ 1STA 1+ -> 2NDA } \ ... BY ONE ADDRESS UNIT +( MISSING TEST: NEGATIVE ALLOT ) + +HERE 1 , +HERE 2 , +CONSTANT 2ND +CONSTANT 1ST +{ 1ST 2ND U< -> } \ HERE MUST GROW WITH ALLOT +{ 1ST CELL+ -> 2ND } \ ... BY ONE CELL +{ 1ST 1 CELLS + -> 2ND } +{ 1ST @ 2ND @ -> 1 2 } +{ 5 1ST ! -> } +{ 1ST @ 2ND @ -> 5 2 } +{ 6 2ND ! -> } +{ 1ST @ 2ND @ -> 5 6 } +{ 1ST 2@ -> 6 5 } +{ 2 1 1ST 2! -> } +{ 1ST 2@ -> 2 1 } + +HERE 1 C, +HERE 2 C, +CONSTANT 2NDC +CONSTANT 1STC +{ 1STC 2NDC U< -> } \ HERE MUST GROW WITH ALLOT +{ 1STC CHAR+ -> 2NDC } \ ... BY ONE CHAR +{ 1STC 1 CHARS + -> 2NDC } +{ 1STC C@ 2NDC C@ -> 1 2 } +{ 3 1STC C! -> } +{ 1STC C@ 2NDC C@ -> 3 2 } +{ 4 2NDC C! -> } +{ 1STC C@ 2NDC C@ -> 3 4 } + +HERE 1 ALLOT ALIGN 123 , CONSTANT X +{ X 1+ ALIGNED @ -> 123 } +( MISSING TEST: CHARS AT ALIGNED ADDRESS ) + +{ 1 CELLS 1 CHARS MOD -> 0 } \ SIZE OF CELL MULTIPLE OF SIZE OF CHAR + +{ 0 1ST ! -> } +{ 1 1ST +! -> } +{ 1ST @ -> 1 } +{ -1 1ST +! 1ST @ -> 0 } + +\ ------------------------------------------------------------------------ +TESTING CHAR [CHAR] [ ] BL S" + +{ BL -> 20 } +{ CHAR X -> 58 } +{ CHAR HELLO -> 48 } +{ : GC1 [CHAR] X ; -> } +{ : GC2 [CHAR] HELLO ; -> } +{ GC1 -> 58 } +{ GC2 -> 48 } +{ : GC3 [ GC1 ] LITERAL ; -> } +{ GC3 -> 58 } +{ : GC4 S" XY" ; -> } +{ GC4 SWAP DROP -> 2 } +{ GC4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 } + +\ ------------------------------------------------------------------------ +TESTING ' ['] FIND EXECUTE IMMEDIATE COUNT LITERAL POSTPONE STATE + +{ : GT1 123 ; -> } +{ ' GT1 EXECUTE -> 123 } +{ : GT2 ['] GT1 ; IMMEDIATE -> } +{ GT2 EXECUTE -> 123 } +HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING +HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING +{ GT1STRING FIND -> ' GT1 -1 } +{ GT2STRING FIND -> ' GT2 1 } +( HOW TO SEARCH FOR NON-EXISTENT WORD? ) +{ : GT3 GT2 LITERAL ; -> } +{ GT3 -> ' GT1 } +{ GT1STRING COUNT -> GT1STRING CHAR+ 3 } + +{ : GT4 POSTPONE GT1 ; IMMEDIATE -> } +{ : GT5 GT4 ; -> } +{ GT5 -> 123 } +{ : GT6 345 ; IMMEDIATE -> } +{ : GT7 POSTPONE GT6 ; -> } +{ GT7 -> 345 } + +{ : GT8 STATE @ ; IMMEDIATE -> } +{ GT8 -> 0 } +{ : GT9 GT8 LITERAL ; -> } +{ GT9 0= -> } + +\ ------------------------------------------------------------------------ +TESTING IF ELSE THEN BEGIN WHILE REPEAT UNTIL RECURSE + +{ : GI1 IF 123 THEN ; -> } +{ : GI2 IF 123 ELSE 234 THEN ; -> } +{ 0 GI1 -> } +{ 1 GI1 -> 123 } +{ -1 GI1 -> 123 } +{ 0 GI2 -> 234 } +{ 1 GI2 -> 123 } +{ -1 GI1 -> 123 } + +{ : GI3 BEGIN DUP 5 < WHILE DUP 1+ REPEAT ; -> } +{ 0 GI3 -> 0 1 2 3 4 5 } +{ 4 GI3 -> 4 5 } +{ 5 GI3 -> 5 } +{ 6 GI3 -> 6 } + +{ : GI4 BEGIN DUP 1+ DUP 5 > UNTIL ; -> } +{ 3 GI4 -> 3 4 5 6 } +{ 5 GI4 -> 5 6 } +{ 6 GI4 -> 6 7 } + +{ : GI5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> } +{ 1 GI5 -> 1 345 } +{ 2 GI5 -> 2 345 } +{ 3 GI5 -> 3 4 5 123 } +{ 4 GI5 -> 4 5 123 } +{ 5 GI5 -> 5 123 } + +{ : GI6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> THEN ; -> } +{ 0 GI6 -> 0 } +{ 1 GI6 -> 0 1 } +{ 2 GI6 -> 0 1 2 } +{ 3 GI6 -> 0 1 2 3 } +{ 4 GI6 -> 0 1 2 3 4 } + +\ ------------------------------------------------------------------------ +TESTING DO LOOP +LOOP I J UNLOOP LEAVE EXIT + +{ : GD1 DO I LOOP ; -> } +{ 4 1 GD1 -> 1 2 3 } +{ 2 -1 GD1 -> -1 0 1 } +{ MID-UINT+1 MID-UINT GD1 -> MID-UINT } + +{ : GD2 DO I -1 +LOOP ; -> } +{ 1 4 GD2 -> 4 3 2 1 } +{ -1 2 GD2 -> 2 1 0 -1 } +{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT } + +{ : GD3 DO 1 0 DO J LOOP LOOP ; -> } +{ 4 1 GD3 -> 1 2 3 } +{ 2 -1 GD3 -> -1 0 1 } +{ MID-UINT+1 MID-UINT GD3 -> MID-UINT } + +{ : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> } +{ 1 4 GD4 -> 4 3 2 1 } +{ -1 2 GD4 -> 2 1 0 -1 } +{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT } + +{ : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> } +{ 1 GD5 -> 123 } +{ 5 GD5 -> 123 } +{ 6 GD5 -> 234 } + +{ : GD6 ( PAT: {0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} ) + 0 SWAP 0 DO + I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP + LOOP ; -> } +{ 1 GD6 -> 1 } +{ 2 GD6 -> 3 } +{ 3 GD6 -> 4 1 2 } + +\ ------------------------------------------------------------------------ +TESTING DEFINING WORDS: : ; CONSTANT VARIABLE CREATE DOES> >BODY + +{ 123 CONSTANT X123 -> } +{ X123 -> 123 } +{ : EQU CONSTANT ; -> } +{ X123 EQU Y123 -> } +{ Y123 -> 123 } + +{ VARIABLE V1 -> } +{ 123 V1 ! -> } +{ V1 @ -> 123 } + +{ : NOP : POSTPONE ; ; -> } +{ NOP NOP1 NOP NOP2 -> } +{ NOP1 -> } +{ NOP2 -> } + +{ : DOES1 DOES> @ 1 + ; -> } +{ : DOES2 DOES> @ 2 + ; -> } +{ CREATE CR1 -> } +{ CR1 -> HERE } +{ ' CR1 >BODY -> HERE } +{ 1 , -> } +{ CR1 @ -> 1 } +{ DOES1 -> } +{ CR1 -> 2 } +{ DOES2 -> } +{ CR1 -> 3 } + +{ : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> } +{ WEIRD: W1 -> } +{ ' W1 >BODY -> HERE } +{ W1 -> HERE 1 + } +{ W1 -> HERE 2 + } + +\ ------------------------------------------------------------------------ +TESTING EVALUATE + +: GE1 S" 123" ; IMMEDIATE +: GE2 S" 123 1+" ; IMMEDIATE +: GE3 S" : GE4 345 ;" ; +: GE5 EVALUATE ; IMMEDIATE + +{ GE1 EVALUATE -> 123 } ( TEST EVALUATE IN INTERP. STATE ) +{ GE2 EVALUATE -> 124 } +{ GE3 EVALUATE -> } +{ GE4 -> 345 } + +{ : GE6 GE1 GE5 ; -> } ( TEST EVALUATE IN COMPILE STATE ) +{ GE6 -> 123 } +{ : GE7 GE2 GE5 ; -> } +{ GE7 -> 124 } + +\ ------------------------------------------------------------------------ +TESTING SOURCE >IN WORD + +: GS1 S" SOURCE" 2DUP EVALUATE + >R SWAP >R = R> R> = ; +{ GS1 -> } + +VARIABLE SCANS +: RESCAN? -1 SCANS +! SCANS @ IF 0 >IN ! THEN ; + +{ 2 SCANS ! +345 RESCAN? +-> 345 345 } + +: GS2 5 SCANS ! S" 123 RESCAN?" EVALUATE ; +{ GS2 -> 123 123 123 123 123 } + +: GS3 BL WORD COUNT SWAP C@ ; +{ GS3 HELLO -> 5 CHAR H } + +: GS4 SOURCE >IN ! DROP ; +{ GS4 123 456 +-> } + +\ ------------------------------------------------------------------------ +TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL + +: S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS. + >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH + R> ?DUP IF \ IF NON-EMPTY STRINGS + 0 DO + OVER C@ OVER C@ - IF 2DROP UNLOOP EXIT THEN + SWAP CHAR+ SWAP CHAR+ + LOOP + THEN + 2DROP \ IF WE GET HERE, STRINGS MATCH + ELSE + R> DROP 2DROP \ LENGTHS MISMATCH + THEN ; + +: GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ; +{ GP1 -> } + +: GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ; +{ GP2 -> } + +: GP3 <# 1 0 # # #> S" 01" S= ; +{ GP3 -> } + +: GP4 <# 1 0 #S #> S" 1" S= ; +{ GP4 -> } + +24 CONSTANT MAX-BASE \ BASE 2 .. 36 +: COUNT-BITS + 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ; +COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD + +: GP5 + BASE @ + MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE + I BASE ! \ TBD: ASSUMES BASE WORKS + I 0 <# #S #> S" 10" S= AND + LOOP + SWAP BASE ! ; +{ GP5 -> } + +: GP6 + BASE @ >R 2 BASE ! + MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY + R> BASE ! \ S: C-ADDR U + DUP #BITS-UD = SWAP + 0 DO \ S: C-ADDR FLAG + OVER C@ [CHAR] 1 = AND \ ALL ONES + >R CHAR+ R> + LOOP SWAP DROP ; +{ GP6 -> } + +\ This is a version I changed from the above + +: GP7 + BASE @ >R MAX-BASE BASE ! + + A 0 DO + I 0 <# #S #> + 1 = SWAP C@ 30 I + = AND AND + LOOP + MAX-BASE A DO + I 0 <# #S #> + 1 = SWAP C@ 41 I A - + = AND AND + LOOP + R> BASE ! ; +{ GP7 -> } + +\ >NUMBER TESTS +CREATE GN-BUF 0 C, +: GN-STRING GN-BUF 1 ; +: GN-CONSUMED GN-BUF CHAR+ 0 ; +: GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ; + +{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED } +{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED } +{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED } +{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING } \ SHOULD FAIL TO CONVERT THESE +{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING } +{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING } + +: >NUMBER-BASED + BASE @ >R BASE ! >NUMBER R> BASE ! ; + +{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED } +{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING } +{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED } +{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING } +{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED } +{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED } + +: GN1 \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO. + BASE @ >R BASE ! + <# #S #> + 0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY + R> BASE ! ; +{ 0 0 2 GN1 -> 0 0 0 } +{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 } +{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 } +{ 0 0 MAX-BASE GN1 -> 0 0 0 } +{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 } +{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 } + +: GN2 \ ( -- 16 10 ) + BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ; +{ GN2 -> 10 A } + +\ ------------------------------------------------------------------------ +TESTING FILL MOVE + +CREATE FBUF 00 C, 00 C, 00 C, +CREATE SBUF 12 C, 34 C, 56 C, +: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ; + +{ FBUF 0 20 FILL -> } +{ SEEBUF -> 00 00 00 } + +{ FBUF 1 20 FILL -> } +{ SEEBUF -> 20 00 00 } + +{ FBUF 3 20 FILL -> } +{ SEEBUF -> 20 20 20 } + +{ FBUF FBUF 3 CHARS MOVE -> } \ BIZARRE SPECIAL CASE +{ SEEBUF -> 20 20 20 } + +{ SBUF FBUF 0 CHARS MOVE -> } +{ SEEBUF -> 20 20 20 } + +{ SBUF FBUF 1 CHARS MOVE -> } +{ SEEBUF -> 12 20 20 } + +{ SBUF FBUF 3 CHARS MOVE -> } +{ SEEBUF -> 12 34 56 } + +{ FBUF FBUF CHAR+ 2 CHARS MOVE -> } +{ SEEBUF -> 12 12 34 } + +{ FBUF CHAR+ FBUF 2 CHARS MOVE -> } +{ SEEBUF -> 12 34 34 } + +\ ------------------------------------------------------------------------ +TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U. + +: OUTPUT-TEST + ." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR + 9 1+ 0 DO I . LOOP CR + ." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR + [CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR + ." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR + [CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR + ." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR + 5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR + ." YOU SHOULD SEE TWO SEPARATE LINES:" CR + S" LINE 1" TYPE CR S" LINE 2" TYPE CR + ." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR + ." SIGNED: " MIN-INT . MAX-INT . CR + ." UNSIGNED: " 0 U. MAX-UINT U. CR +; + +{ OUTPUT-TEST -> } + +\ ------------------------------------------------------------------------ +TESTING INPUT: ACCEPT + +CREATE ABUF 80 CHARS ALLOT + +: ACCEPT-TEST + CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR + ABUF 80 ACCEPT + CR ." RECEIVED: " [CHAR] " EMIT + ABUF SWAP TYPE [CHAR] " EMIT CR +; + +{ ACCEPT-TEST -> } + +\ ------------------------------------------------------------------------ +TESTING DICTIONARY SEARCH RULES + +{ : GDX 123 ; : GDX GDX 234 ; -> } + +{ GDX -> 123 234 } + diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/cross09.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/cross09.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,54 @@ +\ 6809 meta compiler to be run from an ANSI standard FORTH system +\ that contains the FILE wordset. + +\ We need the word VOCABULARY. It's not in the standard though it will +\ be in most actual implementations. +: VOCABULARY WORDLIST CREATE , \ Make a new wordlist and store it in def. + DOES> >R \ Replace last item in the search order. + GET-ORDER SWAP DROP R> @ SWAP SET-ORDER ; + +.( Loading the assembler "asm09.4") CR +S" asm09.4" INCLUDED + +.( Loading the meta compiler "meta09.4") CR +S" meta09.4" INCLUDED + +.( Compiling the kernel from "kernel09.4") CR +S" kernel09.4" INCLUDED + +\ Save the binary image of the Forth system as Motorola S records. + +DECIMAL +VARIABLE CHKSUM +CREATE SBUF 42 CHARS ALLOT +CHAR S SBUF C! +CHAR 1 SBUF CHAR+ C! +VARIABLE BYTECOUNT +VARIABLE ADDR +VARIABLE FILEHAND +: TOHEX ( byte addr ---) \ Conert byte to two-digit hex at addr + BASE @ >R HEX SWAP 0 <# # # #> DROP SWAP 2 CHARS CMOVE R> BASE ! ; +: FLUSHHEX \ Store the S-record buffer in a file + BYTECOUNT @ IF + BYTECOUNT @ 3 + DUP CHKSUM +! SBUF 2 CHARS + TOHEX + ADDR @ 8 RSHIFT 255 AND DUP CHKSUM +! SBUF 4 CHARS + TOHEX + ADDR @ 255 AND DUP CHKSUM +! SBUF 6 CHARS + TOHEX + 255 CHKSUM @ 255 AND - SBUF 8 BYTECOUNT @ 2* + CHARS + TOHEX + SBUF 10 BYTECOUNT @ 2* + FILEHAND @ WRITE-LINE THROW + THEN BYTECOUNT @ ADDR +! 0 BYTECOUNT ! 0 CHKSUM ! ; +: PUTHEX ( byte ---) \ Store the byte in the S-record buffer + BYTECOUNT @ 16 = IF FLUSHHEX THEN + DUP CHKSUM +! SBUF 8 BYTECOUNT @ 2* + CHARS + TOHEX + 1 BYTECOUNT +! +; +: SAVE-IMAGE ( --- ) + S" kernel09" W/O CREATE-FILE THROW FILEHAND ! + 0 CHKSUM ! 0 BYTECOUNT ! ORIGIN ADDR ! + THERE ORIGIN - 0 DO IMAGE I + C@ PUTHEX LOOP FLUSHHEX + S" S9030000FC" FILEHAND @ WRITE-LINE THROW + FILEHAND @ CLOSE-FILE THROW +; +SAVE-IMAGE +.( Image saved as "kernel09") CR + +BYE diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/extend09.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/extend09.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,264 @@ +\ Extensions to sod Forth kernel to make a complete Forth system. +\ created 1994 by L.C. Benschop. +\ copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +\ license: GNU General Public License version 2, see LICENSE for more details. + +: \G POSTPONE \ ; IMMEDIATE +\G comment till end of line for inclusion in glossary. + +\ PART 1: MISCELLANEOUS WORDS. + +: COMPARE ( addr1 u1 addr2 u2 --- diff ) +\G Compare two strings. diff is negative if addr1 u1 is smaller, 0 if it +\G is equal and positive if it is greater than addr2 u2. + ROT 2DUP - >R + MIN DUP IF + >R + BEGIN + OVER C@ OVER C@ - IF + SWAP C@ SWAP C@ - R> DROP R> DROP EXIT + THEN + 1+ SWAP 1+ SWAP + R> 1- DUP >R 0= + UNTIL R> + THEN DROP + DROP DROP R> NEGATE +; + +: ERASE 0 FILL ; + +: <= ( n1 n2 --- f) +\G f is true if and only if n1 is less than or equal to n2. + > 0= ; + +: 0<= ( n1 --- f) +\G f is true if and only if n1 is less than zero. + 0 <= ; + +: >= + < 0= ; + +: 0<> + 0= 0= ; + +: BOUNDS ( addr1 n --- addr2 addr1) +\G Convert address and length to two bounds addresses for DO LOOP + OVER + SWAP ; + +: WITHIN ( u1 u2 u3 --- f) +\G f is true if u1 is greater or equal to u2 and less than u3 + 2 PICK U> ROT ROT U< 0= AND ; + +: -TRAILING ( c-addr1 u1 --- c-addr2 u2) +\G Adjust the length of the string such that trailing spaces are excluded. + BEGIN + 2DUP + 1- C@ BL = + WHILE + 1- + REPEAT +; + +: NIP ( x1 x2 --- x2) +\G Discard the second item on the stack. + SWAP DROP ; + +\ PART 2: SEARCH ORDER WORDLIST + +: GET-ORDER ( --- w1 w2 ... wn n ) +\G Return all wordlists in the search order, followed by the count. + #ORDER @ 0 ?DO CONTEXT I CELLS + @ LOOP #ORDER @ ; + +: SET-ORDER ( w1 w2 ... wn n --- ) +\G Set the search order to the n wordlists given on the stack. + #ORDER ! 0 #ORDER @ 1- DO CONTEXT I CELLS + ! -1 +LOOP ; + +: ALSO ( --- ) +\G Duplicate the last wordlist in the search order. + CONTEXT #ORDER @ CELLS + DUP CELL- @ SWAP ! 1 #ORDER +! ; + +: PREVIOUS ( --- ) +\G Remove the last wordlist from search order. + -1 #ORDER +! ; + +VARIABLE #THREADS ( --- a-addr) +\G This variable holds the number of threads a word list will have. + +: WORDLIST ( --- wid) +\G Make a new wordlist and give its address. + HERE #THREADS @ , #THREADS @ CELLS ALLOT HERE #THREADS @ CELLS - + #THREADS @ CELLS ERASE ; + +: DEFINITIONS ( --- ) +\G Set the definitions wordlist to the last wordlist in the search order. +CONTEXT #ORDER @ 1- CELLS + @ CURRENT ! ; + +: FORTH ( --- ) +\G REplace the last wordlist in the search order with FORTH-WORDLIST + FORTH-WORDLIST CONTEXT #ORDER @ 1- CELLS + ! ; + +1 #THREADS ! +WORDLIST +CONSTANT ROOT-WORDLIST ( --- wid ) +\G Minimal wordlist for ONLY + +4 #THREADS ! + +: ONLY ( --- ) +\G Set the search order to the minimal wordlist. + 1 #ORDER ! ROOT-WORDLIST CONTEXT ! ; + +: VOCABULARY ( --- ) +\G Make a definition that will replace the last word in the search order +\G by its wordlist. + WORDLIST CREATE , \ Make a new wordlist and store it in def. + DOES> >R \ Replace last item in the search order. + GET-ORDER SWAP DROP R> @ SWAP SET-ORDER ; + + +\ PART 3: SOME UTILITIES, DUMP .S WORDS + +: DL ( addr1 --- addr2 ) +\G hex/ascii dump in one line of 16 bytes at addr1 addr2 is addr1+16 + BASE @ >R 16 BASE ! CR + DUP 0 <# # # # # #> TYPE ." : " + 16 0 DO + DUP I + C@ 0 <# # # #> TYPE SPACE + LOOP + 16 0 DO + DUP I + C@ DUP 127 AND 31 < IF DROP ." ." ELSE EMIT THEN + LOOP + 16 + R> BASE ! ; + + +: DUMP ( addr len --- ) +\G Show a hex/ascii dump of the memory block of len bytes at addr + 15 + 4 RSHIFT 0 DO + DL + LOOP DROP ; + +: .S ( --- ) +\G Show the contents of the stack. + DEPTH IF + 0 DEPTH 2 - DO I PICK . -1 +LOOP + ELSE ." Empty " THEN ; + + +: ID. ( nfa --- ) +\G Show the name of the word with name field address nfa. + COUNT 31 AND TYPE SPACE ; + +: WORDS ( --- ) +\G Show all words in the last wordlist of the search order. + CONTEXT #ORDER @ 1- CELLS + @ + DUP @ >R \ number of threads to return stack. + CELL+ R@ 0 DO DUP I CELLS + @ SWAP LOOP DROP \ All thread pointers to stack. + BEGIN + 0 0 + R@ 0 DO + I 2 + PICK OVER U> IF + DROP DROP I I 1 + PICK + THEN + LOOP \ Find the thread pointer with the highest address. + WHILE + DUP 1+ PICK DUP ID. \ Print the name. + CELL- @ \ Link to previous. + SWAP 2 + CELLS SP@ + ! \ Update the right thread pointer. + REPEAT + DROP R> 0 DO DROP LOOP \ Drop the thread pointers. +; + + +ROOT-WORDLIST CURRENT ! +: FORTH FORTH ; +: ALSO ALSO ; +: ONLY ONLY ; +: PREVIOUS PREVIOUS ; +: DEFINITIONS DEFINITIONS ; +: WORDS WORDS ; +DEFINITIONS +\ Fill the ROOT wordlist. + +\ PART 4: ERROR MESSAGES + +: MESS" ( n "cccq" --- ) +\G Create an error message for throw code n. + ALIGN , ERRORS @ , HERE 2 CELLS - ERRORS ! 34 WORD C@ 1+ ALLOT ; + +-3 MESS" Stack overflow" +-4 MESS" Stack underflow" +-10 MESS" Divide overflow" +-13 MESS" Undefined word" +-22 MESS" Incomplete control structure" +-28 MESS" BREAK key pressed" +-37 MESS" File I/O error" +-38 MESS" File does not exist" + +: 2CONSTANT ( d --- ) +\G Create a new definition that has the following runtime behavior. +\G Runtime: ( --- d) push the constant double number on the stack. + CREATE HERE 2! 2 CELLS ALLOT DOES> 2@ ; + +: D.R ( d n --- ) +\G Print double number d right-justified in a field of width n. + >R SWAP OVER DABS <# #S ROT SIGN #> R> OVER - 0 MAX SPACES TYPE ; + +: U.R ( u n --- ) +\G Print unsigned number u right-justified in a field of width n. + >R 0 R> D.R ; + +: .R ( n1 n2 --- ) +\G Print number n1 right-justified in a field of width n2. + >R S>D R> D.R ; + +: AT-XY ( x y --- ) +\G Put screen cursor at location (x,y) (0,0) is upper left corner. + 27 EMIT [CHAR] [ EMIT SWAP 1+ SWAP 0 .R [CHAR] ; EMIT + 1+ 0 .R [CHAR] H EMIT ; + +: PAGE +\G Clear the screen. + 27 EMIT ." [2J" 0 0 AT-XY ; + +: VALUE ( n --- ) + CREATE , DOES> @ ; + +: TO + ' >BODY STATE @ IF + POSTPONE LITERAL POSTPONE ! + ELSE + ! + THEN +; IMMEDIATE + +: D- ( d1 d2 --- d3) + DNEGATE D+ ; + +: D0= + OR 0= ; + +: D= + D- D0= ; + +: BLANK + 32 FILL ; + +: AGAIN + POSTPONE 0 POSTPONE UNTIL ; IMMEDIATE + +: CASE + CSP @ SP@ CSP ! ; IMMEDIATE +: OF + POSTPONE OVER POSTPONE = POSTPONE IF POSTPONE DROP ; IMMEDIATE +: ENDOF + POSTPONE ELSE ; IMMEDIATE +: ENDCASE + POSTPONE DROP BEGIN SP@ CSP @ - WHILE POSTPONE THEN REPEAT + CSP ! ; IMMEDIATE + + +: MS ( n --- ) +\G Delay for n milliseconds. + 5 + 20 / $2B @ + BEGIN DUP $2B @ = UNTIL DROP ; + +CAPS ON + diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/forthload.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/forthload.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,11 @@ +* Load Forth into RAM. + org $8000 + ldy #$8020 + ldu #$0400 + ldx #$3741 +movloop lda ,y+ + sta ,u+ + leax -1,x + bne movloop + jmp $400 + \ No newline at end of file diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/kernel09 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/kernel09 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,423 @@ +S11304007E1E467E1DF5ECF4EDE43780EFA3EEE1AD +S11304103780AEF16E840000834C4954ECC1EDE3A7 +S113042037800000864252414E4348EEC437800074 +S113043000873F4252414E4348ECE127EE334237B6 +S1130440800431874558454355544539042484452F +S1130450584954EEA13780000086554E4E455354FA +S1130460EEA1378004598428444F29ECE1A3E488A1 +S113047080AEE1AFA3EDA33780044385283F444F0A +S113048029ECE110A3E42704334220E13262209BEB +S1130490044E86284C4F4F5029ECA4C30001290672 +S11304A0EDA4EEC437803124334237800418872802 +S11304B02B4C4F4F5029ECA4E3E120E204AE8728F3 +S11304C04C4541564529EEC43124378004668828BA +S11304D03F4C4541564529ECE127EB334237800434 +S11304E0BE8149ECA48880E322EDE3378004CE8208 +S11304F04927EC22EDE33780047B814AEC24888091 +S1130500E326EDE3378004EF86554E4C4F4F5031D0 +S11305102437800492825240ECA4EDE33780051521 +S1130520823E52ECE1EDA33780052082523EECA1DD +S1130530EDE3378004E183525040342037800536A0 +S1130540835250213520378004FA835350401F4092 +S1130550EDE33780054A83535021ECE11F043780D3 +S1130560055683554D2A327CA667E6653DED62A6A5 +S113057067E6643DEB628900ED61A666E6653DE3EE +S113058061ED6186008900A7E4A666E6643DE3E4C4 +S1130590ED64EC62ED6632643780050886554D2FB4 +S11305A04D4F44327F8610A7E468666965696469C3 +S11305B063EC632408A361ED636C662008A36125E2 +S11305C004ED636C666AE426E03263EC62AEE4AF89 +S11305D062EDE437800540812BECE1E3E4EDE437A0 +S11305E08005D7812DEC62A3E1EDE43780052B86ED +S11305F04E45474154454F5FA3E4EDE4378005621F +S113060083414E44EC62A4E0E4E0EDE43780059CD1 +S1130610824F52EC62AAE0EAE0EDE4378005E3831E +S1130620584F52EC62A8E0E8E0EDE437800610820F +S1130630312B6C6126026CE43780062F82312DEC5D +S1130640E4830001EDE4378005EF82322BECE4C350 +S11306500002EDE43780064A82322DECE483000286 +S1130660EDE43780065882322AECE45849EDE43749 +S113067080066682322FECE44756EDE43780067339 +S113068082442BEC66E362ED66EC64E961A9E4ED77 +S11306906432643780061F87444E45474154454FB2 +S11306A05FA362ED62CC0000E261A2E4EDE4378076 +S11306B00680864C534849465435065D27076861D1 +S11306C069E45A26F9378006B2865253484946549B +S11306D035065D270764E466615A26F93780063CCF +S11306E08444524F5032623780069783445550EC0D +S11306F0E4EDE3378006C98453574150ECE4AE621D +S1130700AFE4ED62378006F7844F564552EC62ED54 +S1130710E3378006EB83524F54EC64AEE4EDE4EC33 +S113072062AF62ED6437800708842D524F54EC6445 +S1130730AE62ED62ECE4AFE4ED643780060085322E +S113074044524F503264378006E08432445550AEF0 +S113075062ECE434163780073E853253574150EC3F +S113076066AE62ED62AF66EC64AEE4EDE4AF6437AE +S113077080075985324F564552AE66EC64341637BD +S113078080074A845049434BECE4E3E1ECEBEDE3AE +S11307903780078384524F4C4CECE4327EC3000113 +S11307A0EDE4E362C3000330EB3002ECEBED626C8A +S11307B0E4EC1CED836A6126F86AE426F4326437BB +S11307C0800794824340E6F44FEDE4378007738159 +S11307D040ECF4EDE4378007C3824321E663E7F499 +S11307E03264378007158121EC62EDF4326437807E +S11307F007D9822B2135103506E384ED8437800731 +S113080029823240AEE4EC84AE02AFE4EDE33780FB +S11308100801823221AEE4EC62ED84EC64ED023234 +S1130820663780301FAFE43780081282303D8E0077 +S113083000ECE427EEAFE43780082B82303C8E00D6 +S113084000ECE42BDEAFE4378007CF813C8E000060 +S1130850EC62A3E12DCDAFE4378007F282553C8EE4 +S11308600000EC62A3E125BBAFE4378007E68543D3 +S11308704D4F5645AE6410AF6410AE62ECE4270DE4 +S11308806CE4A680A7A05A26F96AE426F510AE64A3 +S113089032663780085C86434D4F56453EAE641041 +S11308A0AF6410AE62ECE4308B31ABECE4270D6C3A +S11308B0E4A682A7A25A26F96AE426F510AE6432A9 +S11308C066378008968446494C4CAE64EC62270D2A +S11308D06C62A661A7805A26FB6A6226F7326637E5 +S11308E080083B862846494E4429AEE42750EFE46D +S11308F0EE6210AF6234401F12A680841FA1C0268E +S11309002C4AE680E1C027F94C262232621F2110CE +S1130910AE62EEE4A68484402605CCFFFF2003CC1F +S11309200001EDE4E680C41F3AAF623780EEE4AE26 +S11309303E26C4326210AE62EF62EEE4AFE437806A +S113094008E384534B4950EFA33506351035403046 +S1130950842712E1C0270A335F34403410EEA137F4 +S113096080301F26EE34403410EEA13780094284D3 +S11309705343414EEFA335063510354030842712DA +S1130980E1C0260A335F34403410EEA13780301FB3 +S113099026EE34403410EEA13780084B834B455982 +S11309A09D004FEDE33780096F84454D4954ECE1D8 +S11309B09D03378009A9844B45593F9D0F1D34067B +S11309C03780086E834259457EE400378008C5822B +S11309D043529D0C378009C487584F50454E494EA9 +S11309E09D12378009CF885841424F5254494E34A2 +S11309F0609D183560378009E6844E4F4F50BD0422 +S1130A000C0460099C8130BD0406000009D88131C2 +S1130A10BD040600010A058132BD0406000209F97D +S1130A20822D31BD0406FFFF0A0E813DBD040C0575 +S1130A30E5082E046009B6823C3EBD040C0A2C086D +S1130A402E04600A17813EBD040C06FC084D0460A8 +S1130A500A3782303EBD040C0A070A4704600A20A4 +S1130A6082553EBD040C06FC085F04600A60825394 +S1130A7030BD040A00000A52825230BD040A00004C +S1130A800A45854445505448BD040C054E0A710777 +S1130A90D106FC05E5067604600A2A85434F554EC7 +S1130AA054BD040C06EF0A1005D906FC07C6046001 +S1130AB00A6E8454595045BD040C06EF04390AD813 +S1130AC00A07046B06EF04E305D907C609AE0499C7 +S1130AD00AC406E5042B0ADC06E506E504600A827E +S1130AE087414C49474E4544BD040C04600AB28416 +S1130AF0282E2229BD040C052E0AA1070D070D0A74 +S1130B00B705D90AE8052304600AEF84285322298B +S1130B10BD040C052E0AA1070D070D05D90AE80529 +S1130B202304600AE08546414C5345BD0406000099 +S1130B300B0B8454525545BD0406FFFF0A788242CC +S1130B404CBD040600200B25834F4646BD040C0A09 +S1130B500706FC07E804600B32824F4EBD040C0A02 +S1130B602306FC07E804600B5986494E5645525447 +S1130B70BD040C0A23062304600A9B8543484152A2 +S1130B802BBD040C063204600B7B85434841525351 +S1130B90BD040C04600B8A85434841522DBD040CEE +S1130BA0063F04600B978543454C4C2BBD040C0653 +S1130BB04D04600BA68543454C4C53BD040C0A10F0 +S1130BC006B904600BB58543454C4C2DBD040C0699 +S1130BD05B04600B3E843F445550BD040C06EF0497 +S1130BE0390BE506EF04600B48834D494EBD040CF8 +S1130BF0070D070D0A4704390BFC06FC06E50460E3 +S1130C000BE9834D4158BD040C070D070D084D0435 +S1130C10390C1506FC06E504600C0283414253BD01 +S1130C20040C06EF083E04390C2C05F604600B692D +S1130C308444414253BD040C06EF083E04390C427F +S1130C40069F04600C3086534D2F52454DBD040C55 +S1130C50074F06230523070D05230C1F05230C3519 +S1130C60052E05A306FC052E083E04390C7005F676 +S1130C7006FC052E083E04390C7C05F604600BD5F1 +S1130C8086464D2F4D4F44BD040C06EF0523070D3A +S1130C90070D062305230C4D070D052E083E0604FB +S1130CA004390CB006FC051805D906FC0A1005E544 +S1130CB0052E06E504600C46824D2ABD040C074F40 +S1130CC0062305230C1F06FC0C1F0566052E083E93 +S1130CD004390CD6069F04600C1B812ABD040C0544 +S1130CE06606E504600CDA852A2F4D4F44BD040CDA +S1130CF005230CBB052E0C8704600C80822A2FBDB3 +S1130D00040C0CED06FC06E504600CE783533E443A +S1130D10BD040C06EF083E04600CFC842F4D4F44C8 +S1130D20BD040C06FC0D1007190C8704600BC6816A +S1130D302FBD040C0D2006FC06E504600D0C834D4C +S1130D404F44BD040C0D2006E504600CB8863F54E6 +S1130D5048524F57BD040C06FC04390D63151104A9 +S1130D602B0D6506E504600D4D8442415345BD04D9 +S1130D700A00000D1B824450BD040A1E590D2F8326 +S1130D80484C44BD040A00000D7F8344504CBD040C +S1130D900A00000D8A87444543494D414CBD040C6B +S1130DA0041C000A0D6E07E804600D95834845583D +S1130DB0BD040C041C00100D6E07E804600DAC8526 +S1130DC05350414345BD040C041C002009AE04608B +S1130DD00D6986535041434553BD040C0BDA043965 +S1130DE00DEC0A07046B0DC504990DE604600DD2E1 +S1130DF08448455245BD040C0D7807D104600DBFED +S1130E0083504144BD040C0D7807D1041C005405E3 +S1130E10D904600DF0864D552F4D4F44BD040C058B +S1130E20230A07051805A3052E06FC052305A305BB +S1130E302E04600E1584484F4C44BD040C0A100562 +S1130E40F60D8307F50D8307D107DC04600E0081DE +S1130E5023BD040C0D6E07D10E1C071906EF041CEC +S1130E6000090A4704390E6E041C000705D9041C46 +S1130E70003005D90E3A04600E35822353BD040CAC +S1130E800E51070D070D0613082E04390E80046059 +S1130E900D75845349474EBD040C083E04390EA613 +S1130EA0041C002D0E3A04600E92823C23BD040CF7 +S1130EB00E040D8307E804600E7A82233EBD040C01 +S1130EC006E506E50D8307D10E04070D05E504606C +S1130ED00EAA82442EBD040C06FC070D0C350EAD83 +S1130EE00E7D07190E970EBD0AB70DC504600EBA24 +S1130EF082552EBD040C0A070ED504600D3E812ECA +S1130F00BD040C0D100ED504600ED2844D4F564511 +S1130F10BD040C0523070D070D085F04390F2705D1 +S1130F202E089D042B0F2B052E087404600EF086EA +S1130F3041434345505435169D064F340637800EC1 +S1130F404F83544942BD040602000F0B84535041A1 +S1130F504EBD040A00000F4C8423544942BD040AC8 +S1130F6000000F41833E494EBD040A00000EFE837B +S1130F70534944BD040A00000F6F83535243BD0418 +S1130F800A00000F588423535243BD040A00000F83 +S1130F902F884C4F41444C494E45BD040A00000F74 +S1130FA09186455850454354BD040C0F360F5107E4 +S1130FB0E804600F64855155455259BD040C0F4532 +S1130FC0041C00800F360F5D07E804600FA18653F0 +S1130FD04F55524345BD040C0F7E07D10F8A07D1EC +S1130FE004600FB589534F555243452D4944BD0400 +S1130FF00C0F7307D104600F8586524546494C4C4B +S1131000BD040C0FEE0A230A2C043910130A07043A +S11310102B102B0FBB0F5D07D10F8A07E80A070FB0 +S11310206807E80A230A100F9A07F504600F7A8507 +S11310305041525345BD040C05230FD50F6807D109 +S113104005E506FC0F6807D105D9052E070D052314 +S1131050052306FC05180947070D052E06FC052384 +S113106009740439106C0A100F6807F506EF0518A7 +S113107005E5052E06FC0719052E05E50F6807F59D +S11310800460102F85504C414345BD040C070D07E7 +S11310900D07DC063206FC087404600FF984574F10 +S11310A05244BD040C10350DF5108A0DF50B410D9D +S11310B0F50AA105D907DC0460109D84434150530F +S11310C0BD040A00000FCE8A555050455243415387 +S11310D0453FBD040C10C007D10DF507C606040436 +S11310E03911230DF50AA10A07046B06EF04E30581 +S11310F0D907C606EF041C00600A4706FC041C005E +S11311007B084D06040439111D06EF04E305D906D6 +S1131110EF07C6041C002005E506FC07DC04991053 +S1131120EB06E504600FE4874E414D45425546BD4C +S1131130040A00000000000000000000000000009D +S1131140000000000000000000000000000000009B +S1131150000010BB8E464F5254482D574F52444CFA +S1131160495354BD040A00041CE61DD51E411C113C +S113117010C7844C415354BD040A000010848743B3 +S11311804F4E54455854BD040A00000000000000AE +S1131190000000000000000000000000000000004B +S11311A000000000000000117286234F5244455293 +S11311B0BD040A0000117E8743555252454E54BD6A +S11311C0040A000011A98448415348BD040C0523B6 +S11311D0070D07C60A1006B9070D0A100A47043995 +S11311E011F207190B8107C60A1906B90623042B45 +S11311F011F6071906E50623052E063F06040460CA +S113120011C6884E414D453E425546BD040C112F32 +S1131210041C00200A0708CA041C00200BED112F2F +S1131220108A046011B78F5345415243482D574FDC +S113123052444C495354BD040C07190719120B119D +S11312402F0AA10A19078807D111CB06320BBB0656 +S1131250FC05D907D106EF04391271112F06FC08D9 +S1131260EA06EF082E0439126F06E506E50A0704BC +S11312705306E50A07046012028446494E44BD043D +S11312800C11B007D106EF0A100A47043912AB114A +S11312908611B007D1063F0BBB05D906EF07D1066F +S11312A0FC0BCC07D10A2C042B12AD0A070439120B +S11312B0B3063F06EF043912E5063F052306EF0A9D +S11312C0A105180BBB118605D907D1123606EF0408 +S11312D03912DD052E06E5071906E5045306E50572 +S11312E02E042B12B3046011548644494749543FD9 +S11312F0BD040C041C003005E506EF083E04391358 +S11313000706E50A07045306EF041C00090A470709 +S11313100D041C0011084D06040439132306E50AC4 +S113132007045306EF041C00090A47043913350463 +S11313301C000705E506EF0D6E07D1084D082E04C5 +S113134039134906E50A0704530A23046011278761 +S11313503E4E554D424552BD040C06EF043913A8C8 +S11313600A1005E505230AA112F0082E0439137E9C +S1131370052E063206FC0A1005E506FC045306FC9D +S11313800523052306FC0D6E07D1056607190D6EAE +S113139007D10CDC0A0706FC0683052E0A07068320 +S11313A0052E052E042B135A0460122687434F4E34 +S11313B056455254BD040C0A1005E50A231357067A +S11313C0E50460134F874E554D4245523FBD040C12 +S11313D00A230D8E07E80D6E07D105230AA1070D18 +S11313E007C6041C002D0A2C06EF0523043913FC40 +S11313F00A1005E506FC0A1005D906FC070D07C608 +S1131400041C00240A2C0439141E041C00100D6E44 +S113141007E80A1005E506FC0A1005D906FC070DC5 +S113142007C6041C00230A2C04391440041C000AB7 +S11314300D6E07E80A1005E506FC0A1005D906FC3E +S113144006EF0A070A47082E0439145A052E06E542 +S1131450052E0D6E07E80A070453052305230A0722 +S11314600A07052E052E135706EF043914A0070D9D +S113147007C6041C002E0A2C043914920A1005E530 +S113148006EF0D8E07E806FC0A1005D906FC042BAE +S113149014A0052E06E5052E0D6E07E80A07045371 +S11314A006EF082E0439146606E506E5052E043910 +S11314B014B4069F052E0D6E07E80A230460127902 +S11314C0864552524F5224BD040A000013C5874872 +S11314D0414E444C4552BD040A000014C0882841C2 +S11314E0424F52542229BD040C043914FD052E1414 +S11314F0C707E8041CFFFE1511042B1507052E0A67 +S1131500A105D90AE80523046013AC855448524F59 +S113151057BD040C06EF0439155014D607D104390D +S1131520154A14D607D10544053A041C000405D90C +S113153007D114D607E8052E06FC0523055A06E54F +S1131540052E052E06E5042B154C1DF5042B15520E +S113155006E5046014CE854341544348BD040C148D +S1131560D607D10523054E0523053A14D607E8040A +S11315704B053A041C000405D907D114D607E80525 +S11315802E06E5052E06E50A070460155685414C2E +S11315904C4F54BD040C0D7807F50460150B812CD9 +S11315A0BD040C0DF507E80A100BBB159304601479 +S11315B0DD82432CBD040C0DF507DC0A10159304E1 +S11315C060158D85414C49474EBD040C0460159E41 +S11315D0853E4E414D45BD040C063F06EF07C6044B +S11315E01C00800604043915D9046015D0854E41C9 +S11315F04D453EBD040C0AA1041C001F060405D978 +S11316000AE8046012E986484541444552BD040C89 +S113161015C90A0715A00DF5117707E8041C002069 +S113162010A210D206EF127E043916430AF40C52AB +S113163065646566696E696E673A200DF50AA10AEC +S1131640B709D206E506EF0AA111BF07D107D111E8 +S1131650CB06320BBB11BF07D105D907D10DF50B52 +S1131660CC07E807C606320DF507C6041C00800542 +S1131670D90DF507DC159315C9046015B1844A53D7 +S1131680522CBD040C041C00BD15B404601606865F +S113169052455645414CBD040C117707D106EF0A5B +S11316A0A1041C001F060411BF07D107D111CB06EA +S11316B0320BBB11BF07D105D907E80460167D863C +S11316C0435245415445BD040C160D16961682042A +S11316D01C040A15A0046016BF88564152494142B1 +S11316E04C45BD040C16C60A0715A00460168F8865 +S11316F0434F4E5354414E54BD040C160D169616CA +S113170082041C040615A015A0046015C385535457 +S1131710415445BD040A0000170D815DBD040C0A47 +S113172010171307E80460171AC15BBD040C0A07FD +S1131730171307E804601729C74C49544552414C14 +S1131740BD040C17C2041C15A0046016EF88434F97 +S11317504D50494C452CBD040C15A0046015ED8377 +S1131760435350BD040A000016D986274C45415600 +S113177045BD040A0000174D8421435350BD040C99 +S1131780054E176307E804601778843F435350BD40 +S1131790040C054E176307D105E5041CFFEA0D543C +S11317A004601738C13BBD040C17C20460172B1723 +S11317B08F16960460178A8A28504F5354504F4E00 +S11317C04529BD040C052E06EF07D106FC0BAC051C +S11317D02306EF15D607C6041C0040060404391777 +S11317E0E7044B042B17E917560460175F813ABDD1 +S11317F0040C177D160D1682041C040C15A0171C6E +S1131800046017EDC5424547494EBD040C0DF5046F +S11318106017A4C5554E54494CBD040C17C2043975 +S113182015A00460176AC24946BD040C17C20439E6 +S11318300DF50A100BBB159304601826C4544845D3 +S11318404EBD040C0DF506FC07E8046017B7C4454B +S11318504C5345BD040C17C2042B0DF50A100BBBE9 +S1131860159306FC17C2184104601813C55748495C +S11318704C45BD040C17C2182906FC0460184EC65A +S1131880524550454154BD040C17C2042B15A017F2 +S1131890C218410460187F86504F434B4554BD0421 +S11318A00A0000000000000000000000000000002A +S11318B00000000000000000000000000000000024 +S11318C00000000000000000000000000000000014 +S11318D00000000000000000000000000000000004 +S11318E000000000000000000000000000000000F4 +S11318F000000000000000000000000000000000E4 +S113190000000000000000000000000000000000D3 +S113191000000000000000000000000000000000C3 +S113192000000000000000000000000000000000B3 +S113193000000000000000000000000000000000A3 +S11319400000000000000000000000000000000093 +S11319500000000000000000000000000000000083 +S11319600000000000000000000000000000000073 +S11319700000000000000000000000000000000063 +S11319800000000000000000000000000000000053 +S1131990000000000000000000000000000000182B +S11319A06C8127BD040C041C002010A210D2127EEE +S11319B0082E041CFFF30D5404601804C35B275D58 +S11319C0BD040C19A317400460189784434841527E +S11319D0BD040C0B4110A20A1005D907C6046018F7 +S11319E03CC65B434841525DBD040C19D01740040A +S11319F06019CBC2444FBD040C17C2046B177107A6 +S1131A00D10DF50A07177107E8046019BCC33F44F8 +S1131A104FBD040C17C20481177107D10DF517715E +S1131A2007E80A0715A00DF504601A0DC54C4541D9 +S1131A305645BD040C17C204C60DF5177107D11520 +S1131A40A0177107E804601A2C8D5245534F4C5669 +S1131A50452D4C45415645BD040C177107D106EF81 +S1131A6004391A7206EF07D10DF5071907E8042B9C +S1131A701A5E06E5046019E1C44C4F4F50BD040CD6 +S1131A8017C2049915A01A57177107E8046019A121 +S1131A90C52B4C4F4F50BD040C17C204B615A01AE9 +S1131AA057177107E804601A90C7524543555253BB +S1131AB045BD040C117707D115F31756046019F3CB +S1131AC0C22E22BD040C17C20AF4041C002210A268 +S1131AD007C60632159315C904601A78C25322BD8D +S1131AE0040C171307D104391B0017C20B10041C74 +S1131AF0002210A207C60632159315C9042B1B1029 +S1131B00041C002210A20AA1189E108A189E0AA181 +S1131B1004601ADCC641424F525422BD040C17C261 +S1131B2014E6041C002210A207C60632159315C938 +S1131B3004601AA98541424F5254BD040C0A23156E +S1131B401104601B14C8504F5354504F4E45BD04EC +S1131B500C17C217C219A315A004601B3489494D80 +S1131B604D454449415445BD040C117707D106EF56 +S1131B7007C6041C0040061306FC07DC04601A496F +S1131B80C128BD040C041C0029103506E506E50433 +S1131B90601B80C15CBD040C0FD50F6807E806E527 +S1131BA004601B93853E424F4459BD040C041C0041 +S1131BB00305D904601B5D87283B434F444529BD79 +S1131BC0040C052E117707D115F3063207E80460DB +S1131BD01BA4C5444F45533EBD040C17C21BBF167E +S1131BE082041C040C15A004601B45863F53544119 +S1131BF0434BBD040C0A8806EF083E041CFFFC0D91 +S1131C0054041C27100A47041CFFFD0D5404601BD8 +S1131C10B789494E54455250524554BD040C041CD6 +S1131C20002010A210D206EF07C604391C8A127EC7 +S1131C3006EF04391C500A230A2C171307D1060493 +S1131C4004391C4A1756042B1C4C044B042B1C84CB +S1131C5006E513CD082E041CFFF30D540D8E07D199 +S1131C60063204391C78171307D104391C7406FC96 +S1131C7017401740042B1C8406E5171307D10439B9 +S1131C801C8417401BF2042B1C1E06E504601AC0BA +S1131C90884556414C55415445BD040C0F7307D13A +S1131CA005230F7E07D105230F8A07D105230F686B +S1131CB007D105230F8A07E80F7E07E80A070F6894 +S1131CC007E80A230F7307E81C1B052E0F6807E8B3 +S1131CD0052E0F8A07E8052E0F7E07E8052E0F73E1 +S1131CE007E804601BEB864552524F5253BD040A69 +S1131CF000001C908C4552524F522D534F55524365 +S1131D0045BD040C0F7307D10A070A4704391D2186 +S1131D100AF408696E206C696E65200F9A07D10F6A +S1131D20000DF50AA10AB709D21DF504601CF4845C +S1131D3051554954BD040C0A7B07D10544172B0F98 +S1131D40450F7E07E80A070F7307E8100006E5044D +S1131D501C1C1B155C06EF082E04391D7406E517C0 +S1131D601307D1082E04391D6E0AF4024F4B09D211 +S1131D70042B1DCB09EF06EF041CFFFE0A2C0439CB +S1131D801D9014C707D10AA10AB70DC5042B1DC99C +S1131D901CED07D106EF04391DBC070D070D07D153 +S1131DA00A2C04391DB4041C000405D90AA10AB77D +S1131DB00DC51D010BAC07D1042B1D9406E50AF4D7 +S1131DC0064572726F72200F001D010A0704391D47 +S1131DD04B04601BD285584C4F4144BD040C09E0B0 +S1131DE00A100F7307E80A070F9A07E804601D2F0B +S1131DF0845741524DBD040C0A7B07D105440A7136 +S1131E0007D1055A0D9D0A1911B007E8116311860F +S1131E1007E8116311860BAC07E8116311BF07E8EB +S1131E200A0714D607E80AF41057656C636F6D65EA +S1131E3020746F20466F72746809D21D3404601DCB +S1131E40F084434F4C44108E800010BF0A7E10CEA5 +S10C1E507C0010FF0A747E1DF5EC +S9030000FC diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/kernel09.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/kernel09.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,1800 @@ +\ This is the file kernel.4, included by the cross compiler. +\ created 1994 by L.C. Benschop. +\ copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +\ license: GNU General Public License version 2, see LICENSE for more details. + +\ It is excessively commented as it must serve as an introduction to the +\ construction of Forth compilers. + +\ Lines starting with \G are comments that are included in the glossary. + +ALSO TRANSIENT DEFINITIONS +FORWARD THROW +FORWARD COLD +FORWARD WARM +PREVIOUS DEFINITIONS + +ALSO ASSEMBLER DEFINITIONS + +: NEXT +\ JMP $300 \ For tracing/debugging. + PULU PC \ For normal use. +; + +PREVIOUS DEFINITIONS + +ASSEMBLE HEX + +ORIGIN ORG + 7E C, TRANSIENT COLD ASSEMBLER + 7E C, TRANSIENT WARM ASSEMBLER \ Jumps to cold and warm entry points. + +ENDASM + +DECIMAL +CROSS-COMPILE + +LABEL DOCON + LDD 0 ,S [] \ Get constant. + STD 0 ,S \ Store it on stack. +LABEL DOVAR + NEXT + +LABEL DOCOL + STU ,--Y \ Save IP on return stack. + LDU ,S++ \ Pop IP from stack where it is left by JSR DOCOL. + NEXT + +LABEL DODEFER + LDX ,S++ [] \ Get jump address. + JMP 0 ,X +ENDASM + +CODE LIT ( --- n) + LDD ,U++ \ Get literal from instruction stream. + STD ,--S + NEXT +END-CODE + +CODE BRANCH +LABEL BR + LDU 0 ,U + NEXT +END-CODE + +CODE ?BRANCH ( f ---) + LDD ,S++ + BEQ BR \ Bracnh if TOS is zero. + LEAU 2 ,U \ Skip branch address. + NEXT +END-CODE + +CODE EXECUTE ( a ---) + RTS +END-CODE + +CODE EXIT + LDU ,Y++ + NEXT +END-CODE + +CODE UNNEST + LDU ,Y++ + NEXT +END-CODE + +CODE (DO) ( l s ---) + LDD ,S++ +LABEL DO1 + SUBD 0 ,S + EORA # $80 \ Now START-LIMIT-$8000 Initial value for counter. + LDX ,S++ + STX ,--Y \ Push limit value. + STD ,--Y + NEXT +END-CODE + +CODE (?DO) ( l s ---) + LDD ,S++ + CMPD 0 ,S + 0<> IF + LEAU 2 ,U \ Skip branch address. + BRA DO1 + THEN + LEAS 2 ,S + BRA BR +END-CODE + +CODE (LOOP) + LDD 0 ,Y + ADDD # 1 + LABEL LOOP1 + VC IF + STD 0 ,Y + LDU 0 ,U + NEXT + THEN + LEAY 4 ,Y \ Discard parameters from return stack. + LEAU 2 ,U \ Skip branch address. + NEXT +END-CODE + +CODE (+LOOP) ( n ---) + LDD 0 ,Y + ADDD ,S++ + BRA LOOP1 +END-CODE + +CODE (LEAVE) +LABEL LEAV1 + LDU 0 ,U + LEAY 4 ,Y + NEXT +END-CODE + +CODE (?LEAVE) ( f ---) + LDD ,S++ + BEQ LEAV1 + LEAU 2 ,U + NEXT +END-CODE + +CODE I ( --- n) + LDD 0 ,Y + EORA # $80 + ADDD 2 ,Y + STD ,--S + NEXT +END-CODE + +CODE I' ( ---n) + LDD 2 ,Y + STD ,--S + NEXT +END-CODE + +CODE J ( ---n) + LDD 4 ,Y + EORA # $80 + ADDD 6 ,Y + STD ,--S + NEXT +END-CODE + +CODE UNLOOP + LEAY 4 ,Y + NEXT +END-CODE + +CODE R@ ( --- n) + LDD 0 ,Y + STD ,--S + NEXT +END-CODE + +CODE >R ( n ---) + LDD ,S++ + STD ,--Y + NEXT +END-CODE + +CODE R> ( --- n) + LDD ,Y++ + STD ,--S + NEXT +END-CODE + +CODE RP@ ( --- addr) + PSHS Y + NEXT +END-CODE + +CODE RP! ( addr --- ) + PULS Y + NEXT +END-CODE + +CODE SP@ ( --- addr) + TFR S, D + STD ,--S + NEXT +END-CODE + +CODE SP! ( addr ---) + LDD ,S++ + TFR D, S + NEXT +END-CODE + +CODE UM* ( u1 u2 --- ud) + LEAS -4 ,S \ Create room for result. + LDA 7 ,S + LDB 5 ,S + MUL \ Multiply least significant bytes. + STD 2 ,S + LDA 7 ,S + LDB 4 ,S + MUL \ Multiply LSB of n1 and MSB of n2. + ADDB 2 ,S + ADCA # 0 + STD 1 ,S + LDA 6 ,S + LDB 5 ,S + MUL \ Multiply LSB of n2 and MSB of n1. + ADDD 1 ,S + STD 1 ,S + LDA # 0 + ADCA # 0 + STA 0 ,S + LDA 6 ,S + LDB 4 ,S + MUL \ Multiply most significant bytes. + ADDD 0 ,S + STD 4 ,S + LDD 2 ,S + STD 6 ,S \ Move result to position of numbers. + LEAS 4 ,S \ Reclaim extra space for result. + NEXT +END-CODE + +CODE UM/MOD ( ud u --- rem quot) + LEAS -1 ,S \ Create room for iteration counter. + LDA # 16 + STA 0 ,S + BEGIN + ASL 6 ,S + ROL 5 ,S + ROL 4 ,S + ROL 3 ,S + LDD 3 ,S + U< IF \ Account for extra bit shifted out, perform subtraction anyway. + SUBD 1 ,S + STD 3 ,S + INC 6 ,S + ELSE + SUBD 1 ,S \ Perform trial subtraction. + U>= IF + STD 3 ,S + INC 6 ,S \ Add 1-bit to quotient. + THEN + THEN + DEC 0 ,S + 0= UNTIL + LEAS 3 ,S + LDD 2 ,S + LDX 0 ,S + STX 2 ,S + STD 0 ,S + NEXT +END-CODE + +CODE + ( n1 n2 ---n3) + LDD ,S++ + ADDD 0 ,S + STD 0 ,S + NEXT +END-CODE + +CODE - ( n1 n2 ---n3) + LDD 2 ,S + SUBD ,S++ + STD 0 ,S + NEXT +END-CODE + +CODE NEGATE ( n1 --- n2) + CLRA + CLRB + SUBD 0 ,S + STD 0 ,S + NEXT +END-CODE + +CODE AND ( n1 n2 ---n3) + LDD 2 ,S + ANDA ,S+ + ANDB ,S+ + STD 0 ,S + NEXT +END-CODE + +CODE OR ( n1 n2 ---n3) + LDD 2 ,S + ORA ,S+ + ORB ,S+ + STD 0 ,S + NEXT +END-CODE + +CODE XOR ( n1 n2 ---n3) + LDD 2 ,S + EORA ,S+ + EORB ,S+ + STD 0 ,S + NEXT +END-CODE + +CODE 1+ ( n1 --- n2) + INC 1 ,S + 0= IF INC 0 ,S THEN + NEXT +END-CODE + +CODE 1- ( n1 --- n2) + LDD 0 ,S + SUBD # 1 + STD 0 ,S + NEXT +END-CODE + +CODE 2+ ( n1 --- n2) + LDD 0 ,S + ADDD # 2 + STD 0 ,S + NEXT +END-CODE + +CODE 2- ( n1 --- n2) + LDD 0 ,S + SUBD # 2 + STD 0 ,S + NEXT +END-CODE + +CODE 2* ( n1 --- n2) + LDD 0 ,S + ASLB + ROLA + STD 0 ,S + NEXT +END-CODE + +CODE 2/ ( n1 --- n2) + LDD 0 ,S + ASRA + RORB + STD 0 ,S + NEXT +END-CODE + +CODE D+ ( d1 d2 --- d3) + LDD 6 ,S + ADDD 2 ,S + STD 6 ,S + LDD 4 ,S + ADCB 1 ,S + ADCA 0 ,S + STD 4 ,S + LEAS 4 ,S + NEXT +END-CODE + +CODE DNEGATE ( d1 --- d2) + CLRA + CLRB + SUBD 2 ,S + STD 2 ,S + LDD # 0 + SBCB 1 ,S + SBCA 0 ,S + STD 0 ,S + NEXT +END-CODE + +CODE LSHIFT ( u1 n1 --- u2) + PULS D + TSTB + 0<> IF + BEGIN + ASL 1 ,S + ROL 0 ,S + DECB + 0= UNTIL + THEN + NEXT +END-CODE + +CODE RSHIFT ( u1 n1 --- u2) + PULS D + TSTB + 0<> IF + BEGIN + LSR 0 ,S + ROR 1 ,S + DECB + 0= UNTIL + THEN + NEXT +END-CODE + +CODE DROP ( n --- ) + LEAS 2 ,S + NEXT +END-CODE + +CODE DUP ( n --- n n ) + LDD 0 ,S + STD ,--S + NEXT +END-CODE + +CODE SWAP ( n1 n2 --- n2 n1) + LDD 0 ,S + LDX 2 ,S + STX 0 ,S + STD 2 ,S + NEXT +END-CODE + +CODE OVER ( n1 n2 --- n1 n2 n1) + LDD 2 ,S + STD ,--S + NEXT +END-CODE + +CODE ROT ( n1 n2 n3 --- n2 n3 n1) + LDD 4 ,S + LDX 0 ,S + STD 0 ,S + LDD 2 ,S + STX 2 ,S + STD 4 ,S + NEXT +END-CODE + +CODE -ROT ( n1 n2 n3 --- n3 n1 n2) + LDD 4 ,S + LDX 2 ,S + STD 2 ,S + LDD 0 ,S + STX 0 ,S + STD 4 ,S + NEXT +END-CODE + +CODE 2DROP ( d ---) + LEAS 4 ,S + NEXT +END-CODE + +CODE 2DUP ( d --- d d ) + LDX 2 ,S + LDD 0 ,S + PSHS X, D + NEXT +END-CODE + +CODE 2SWAP ( d1 d2 --- d2 d1) + LDD 6 ,S + LDX 2 ,S + STD 2 ,S + STX 6 ,S + LDD 4 ,S + LDX 0 ,S + STD 0 ,S + STX 4 ,S + NEXT +END-CODE + +CODE 2OVER ( d1 d2 --- d1 d2 d1) + LDX 6 ,S + LDD 4 ,S + PSHS X, D + NEXT +END-CODE + +CODE PICK ( n1 --- n2) + LDD 0 ,S + ADDD ,S++ + LDD D,S + STD ,--S + NEXT +END-CODE + +CODE ROLL ( n1 ---) + LDD 0 ,S + LEAS -2 ,S \ Make room to store counter. + ADDD # 1 + STD 0 ,S \ Store 1 plus the counter. + ADDD 2 ,S \ Double counter. + ADDD # 3 + LEAX D,S \ Point past last elemtn to roll on stack. + LEAX 2 ,X + LDD D,S + STD 2 ,S \ Store element picked. + INC 0 ,S + BEGIN + BEGIN + LDD -4 ,X + STD ,--X + DEC 1 ,S + 0= UNTIL + DEC 0 ,S + 0= UNTIL + LEAS 4 ,S + NEXT +END-CODE + +CODE C@ ( addr --- c) + LDB 0 ,S [] + CLRA + STD 0 ,S + NEXT +END-CODE + +CODE @ ( addr --- n) + LDD 0 ,S [] + STD 0 ,S + NEXT +END-CODE + +CODE C! ( c addr ---) + LDB 3 ,S + STB 0 ,S [] + LEAS 4 ,S + NEXT +END-CODE + +CODE ! ( n addr ---) + LDD 2 ,S + STD 0 ,S [] + LEAS 4 ,S + NEXT +END-CODE + +CODE +! ( n addr ---) + PULS X + PULS D + ADDD 0 ,X + STD 0 ,X + NEXT +END-CODE + +CODE 2@ ( addr --- d) + LDX 0 ,S + LDD 0 ,X + LDX 2 ,X + STX 0 ,S + STD ,--S + NEXT +END-CODE + +CODE 2! ( d addr ---) + LDX 0 ,S + LDD 2 ,S + STD 0 ,X + LDD 4 ,S + STD 2 ,X + LEAS 6 ,S + NEXT +END-CODE + +LABEL YES \ Store a true flag on stack. + LEAX -1 ,X + STX 0 ,S + NEXT +ENDASM + +CODE 0= ( n --- f) + LDX # 0 + LDD 0 ,S + BEQ YES + STX 0 ,S + NEXT +END-CODE + +CODE 0< ( n --- f) + LDX # 0 + LDD 0 ,S + BMI YES + STX 0 ,S + NEXT +END-CODE + +CODE < ( n1 n2 --- f) + LDX # 0 + LDD 2 ,S + SUBD ,S++ + BLT YES + STX 0 ,S + NEXT +END-CODE + +CODE U< ( n1 n2 --- f) + LDX # 0 + LDD 2 ,S + SUBD ,S++ + BLO YES + STX 0 ,S + NEXT +END-CODE + +CODE CMOVE ( addr1 addr2 n ---) + LDX 4 ,S + STY 4 ,S + LDY 2 ,S + LDD 0 ,S + 0<> IF + INC 0 ,S + BEGIN + BEGIN + LDA ,X+ + STA ,Y+ + DECB + 0= UNTIL + DEC 0 ,S + 0= UNTIL + THEN + LDY 4 ,S + LEAS 6 ,S + NEXT +END-CODE + +CODE CMOVE> ( addr1 addr2 n ---) + LDX 4 ,S + STY 4 ,S + LDY 2 ,S + LDD 0 ,S + LEAX D,X + LEAY D,Y + LDD 0 ,S + 0<> IF + INC 0 ,S + BEGIN + BEGIN + LDA ,-X + STA ,-Y + DECB + 0= UNTIL + DEC 0 ,S + 0= UNTIL + THEN + LDY 4 ,S + LEAS 6 ,S + NEXT +END-CODE + +CODE FILL ( addr n c ---) + LDX 4 ,S + LDD 2 ,S + 0<> IF + INC 2 ,S + LDA 1 ,S + BEGIN + BEGIN + STA ,X+ + DECB + 0= UNTIL + DEC 2 ,S + 0= UNTIL + THEN + LEAS 6 ,S + NEXT +END-CODE + +CODE (FIND) ( word firstnfa --- cfa/word f ) + LDX 0 ,S + 0<> IF + STU 0 ,S + LDU 2 ,S + STY 2 ,S + PSHS U + BEGIN + TFR X, Y + LDA ,X+ + ANDA # $1F + CMPA ,U+ \ Compare count bytes. + 0= IF \ Do count bytes match? + BEGIN + DECA + LDB ,X+ + CMPB ,U+ + 0<> UNTIL \ Compare strings until difference encountered. + INCA + 0= IF + LEAS 2 ,S \ Yes, then word is found. + TFR Y, X + LDY 2 ,S + LDU 0 ,S + LDA 0 ,X + ANDA # $40 + 0= IF + LDD # -1 + ELSE + LDD # 1 \ Make flag that indicates immediate bit. + THEN + STD 0 ,S + LDB ,X+ + ANDB # $1F + ABX \ Compute CFA + STX 2 ,S + NEXT + THEN + THEN + LDU 0 ,S + LDX -2 ,Y \ Point to next word in linked list. + 0= UNTIL + LEAS 2 ,S + LDY 2 ,S + STU 2 ,S + LDU 0 ,S + STX 0 ,S + THEN + NEXT +END-CODE + +CODE SKIP ( addr1 len1 c --- addr2 len2 ) + STU ,--Y + PULS D + PULS X + PULS U + LEAX 0 ,X + 0<> IF + BEGIN + CMPB ,U+ + 0<> IF + LEAU -1 ,U + PSHS U + PSHS X + LDU ,Y++ + NEXT + THEN + LEAX -1 ,X + 0= UNTIL + THEN + PSHS U + PSHS X + LDU ,Y++ + NEXT +END-CODE + +CODE SCAN ( addr1 len1 c --- addr2 len2 ) + STU ,--Y + PULS D + PULS X + PULS U + LEAX 0 ,X + 0<> IF + BEGIN + CMPB ,U+ + 0= IF + LEAU -1 ,U + PSHS U + PSHS X + LDU ,Y++ + NEXT + THEN + LEAX -1 ,X + 0= UNTIL + THEN + PSHS U + PSHS X + LDU ,Y++ + NEXT +END-CODE + +CODE KEY ( --- c) + JSR 0 + CLRA + STD ,--S + NEXT +END-CODE + +CODE EMIT ( c ---) + LDD ,S++ + JSR 3 + NEXT +END-CODE + +CODE KEY? ( --- f) + JSR 15 + SEX + PSHS D + NEXT +END-CODE + +CODE BYE + JMP $E400 + NEXT +END-CODE + +CODE CR + JSR 12 + NEXT +END-CODE + +CODE XOPENIN + JSR 18 + NEXT +END-CODE + +CODE XABORTIN + PSHS Y, U + JSR 24 + PULS Y, U + NEXT +END-CODE + +: NOOP ; + +00 CONSTANT 0 +01 CONSTANT 1 +02 CONSTANT 2 +-1 CONSTANT -1 + +\ PART 3: SIMPLE DEFINITIONS + +\ This is a large class of words, which would be written in machine code +\ on most non-native code systems. Many contain just a few words, so they +\ are implemented as macros. + +\ This category contains simple arithmetic and compare words, the runtime +\ parts of DO LOOP and string related words etc, many on which are +\ dependent on each other, so they are in a less than logical order to +\ avoid large numbers of forward references. + +: = ( x1 x2 --- f) +\G f is true if and only if x1 is equal to x2. + - 0= ; + +: <> ( x1 x2 --- f) +\G f is true if and only if x1 is not equal to x2. + = 0= ; + +: > ( n1 n2 --- f) +\G f is true if and only if the signed number n1 is less than n2. + SWAP < ; + +: 0> ( n --- f) +\G f is true if and only if n is greater than 0. + 0 > ; + +: U> ( u1 u2 --- f) +\G f is true if and only if the unsigned number u1 is greater than u2. + SWAP U< ; + +VARIABLE S0 ( --- a-addr) +\G Variable that holds the bottom address of the stack. + -2 ALLOT-T +LABEL S0ADDR ENDASM + 02 ALLOT-T + +VARIABLE R0 ( --- a-addr) +\G Variable that holds the bottom address of the return stack. + -2 ALLOT-T +LABEL R0ADDR ENDASM + 02 ALLOT-T + +: DEPTH ( --- n ) +\G n is the number of cells on the stack (before DEPTH was executed). + SP@ S0 @ SWAP - 2/ ; + +: COUNT ( c-addr1 --- c-addr2 c) +\G c-addr2 is the next address after c-addr1 and c is the character +\G stored at c-addr1. +\G This word is intended to be used with 'counted strings' where the +\G first character indicates the length of the string. + DUP 1 + SWAP C@ ; + +: TYPE ( c-addr1 u --- ) +\G Output the string starting at c-addr and length u to the terminal. + DUP IF 0 DO DUP I + C@ EMIT LOOP DROP ELSE DROP DROP THEN ; + +: ALIGNED ( c-addr --- a-addr ) +\G a-addr is the first aligned address after c-addr. + ; + +: (.") ( --- ) +\G Runtime part of ." +\ This expects an in-line counted string. + R> COUNT OVER OVER TYPE + ALIGNED >R ; +: (S") ( --- c-addr u ) +\G Runtime part of S" +\ It returns address and length of an in-line counted string. + R> COUNT OVER OVER + ALIGNED >R ; + + +00 +CONSTANT FALSE ( --- 0) +\G Constant 0, indicates FALSE + +-01 +CONSTANT TRUE ( --- -1) +\G Constant -1, indicates TRUE + +32 +CONSTANT BL ( --- 32 ) +\G Constant 32, the blank character + +: OFF ( a-addr ---) +\G Store FALSE at a-addr. + 0 SWAP ! ; + +: ON ( a-addr ---) +\G Store TRUE at a-addr. + -1 SWAP ! ; + +: INVERT ( x1 --- x2) +\G Invert all the bits of x1 (one's complement) + -1 XOR ; + + +\ The next few words manipulate addresses in a system-independent way. +\ Use CHAR+ instead of 1+ and it will be portable to systems where you +\ have to add something different from 1. + +: CHAR+ ( c-addr1 --- c-addr2) +\G c-addr2 is the next character address after c-addr1. + 1+ ; + +: CHARS ( n1 --- n2) +\G n2 is the number of address units occupied by n1 characters. +; \ A no-op. + +: CHAR- ( c-addr1 --- c-addr2) +\G c-addr2 is the previous character address before c-addr1. + 1- ; + +: CELL+ ( a-addr1 --- a-addr2) +\G a-addr2 is the address of the next cell after a-addr2. + 2+ ; + +: CELLS ( n2 --- n1) +\G n2 is the number of address units occupied by n1 cells. + 1 LSHIFT ; + +: CELL- ( a-addr1 --- a-addr2) +\G a-addr2 is the address of the previous cell before a-addr1. + 2- ; + +: ?DUP ( n --- 0 | n n) +\G Duplicate the top cell on the stack, but only if it is nonzero. + DUP IF DUP THEN ; + +: MIN ( n1 n2 --- n3) +\G n3 is the minimum of n1 and n2. + OVER OVER > IF SWAP THEN DROP ; + +: MAX ( n1 n2 --- n3) +\G n3 is the maximum of n1 and n2. + OVER OVER < IF SWAP THEN DROP ; + +: ABS ( n --- u) +\G u is the absolute value of n. + DUP 0< IF NEGATE THEN ; + +: DABS ( d --- ud) +\G ud is the absolute value of d. + DUP 0< IF DNEGATE THEN ; + +: SM/REM ( d n1 --- nrem nquot ) +\G Divide signed double number d by single number n1, giving quotient and +\G remainder. Round towards zero, remainder has same sign as dividend. + 2DUP XOR >R OVER >R \ Push signs of quot and rem. + ABS >R DABS R> + UM/MOD + SWAP R> 0< IF NEGATE THEN SWAP + R> 0< IF NEGATE THEN ; + +: FM/MOD ( d n1 --- nrem nquot ) +\G Divide signed double number d by single number n1, giving quotient and +\G remainder. Round always down (floored division), +\G remainder has same sign as divisor. + DUP >R OVER OVER XOR >R + SM/REM + OVER R> 0< AND IF SWAP R@ + SWAP 1 - THEN R> DROP ; + +: M* ( n1 n2 --- d ) +\G Multiply the signed numbers n1 and n2, giving the signed double number d. + 2DUP XOR >R ABS SWAP ABS UM* R> 0< IF DNEGATE THEN ; + +: * ( w1 w2 --- w3) +\G Multiply single numbers, signed or unsigned give the same result. + UM* DROP ; + +: */MOD ( n1 n2 n3 --- nrem nquot) +\G Multiply signed numbers n1 by n2 and divide by n3, giving quotient and +\G remainder. Intermediate result is double. + >R M* R> FM/MOD ; + +: */ ( n1 n2 n3 --- n4 ) +\G Multiply signed numbers n1 by n2 and divide by n3, giving quotient n4. +\G Intermediate result is double. + */MOD SWAP DROP ; + +: S>D ( n --- d) +\G Convert single number to double number. + DUP 0< ; + +: /MOD ( n1 n2 --- nrem nquot) +\G Divide signed number n1 by n2, giving quotient and remainder. + SWAP S>D ROT FM/MOD ; + +: / ( n1 n2 --- n3) +\G n3 is n1 divided by n2. + /MOD SWAP DROP ; + +: MOD ( n1 n2 --- n3) +\G n3 is the remainder of n1 and n2. + /MOD DROP ; + +: ?THROW ( f n --- ) +\G Perform n THROW if f is nonzero. + SWAP IF THROW ELSE DROP THEN ; + +\ PART 4: NUMERIC OUTPUT WORDS. + +VARIABLE BASE ( --- a-addr) +\G Variable that contains the numerical conversion base. + +VARIABLE DP ( --- a-addr) +\G Variable that contains the dictionary pointer. New space is allocated +\G from the address in DP + +VARIABLE HLD ( --- a-addr) +\G Variable that holds the address of the numerical output conversion +\G character. + +VARIABLE DPL ( --- a-addr) +\G Variable that holds the decimal point location for numerical conversion. + +: DECIMAL ( --- ) +\G Set numerical conversion to decimal. + 10 BASE ! ; + +: HEX ( --- ) +\G Set numerical conversion to hexadecimal. + 16 BASE ! ; + +: SPACE ( ---) +\G Output a space to the terminal. + 32 EMIT ; + +: SPACES ( u --- ) +\G Output u spaces to the terminal. + ?DUP IF 0 DO SPACE LOOP THEN ; + +: HERE ( --- c-addr ) +\G The address of the dictionary pointer. New space is allocated here. + DP @ ; + +: PAD ( --- c-addr ) +\G The address of a scratch pad area. Right below this address there is +\G the numerical conversion buffer. + DP @ 84 + ; + +: MU/MOD ( ud u --- urem udquot ) +\G Divide unsigned double number ud by u and return a double quotient and +\G a single remainder. + >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ; + +\ The numerical conversion buffer starts right below PAD and grows down. +\ Characters are added to it from right to left, as as the div/mod algorithm +\ to convert numbers to an arbitrary base produces the digits from right to +\ left. + +: HOLD ( c ---) +\G Insert character c into the numerical conversion buffer. + 1 NEGATE HLD +! HLD @ C! ; + +: # ( ud1 --- ud2) +\G Extract the rightmost digit of ud1 and put it into the numerical +\G conversion buffer. + BASE @ MU/MOD ROT DUP 9 > IF 7 + THEN 48 + HOLD ; + +: #S ( ud --- 0 0 ) +\G Convert ud by repeated use of # until ud is zero. + BEGIN # OVER OVER OR 0= UNTIL ; + +: SIGN ( n ---) +\G Insert a - sign in the numerical conversion buffer if n is negative. + 0< IF 45 HOLD THEN ; + +: <# ( --- ) +\G Reset the numerical conversion buffer. + PAD HLD ! ; + +: #> ( ud --- addr u ) +\G Discard ud and give the address and length of the numerical conversion +\G buffer. + DROP DROP HLD @ PAD OVER - ; + +: D. ( d --- ) +\G Type the double number d to the terminal. + SWAP OVER DABS <# #S ROT SIGN #> TYPE SPACE ; + +: U. ( u ---) +\G Type the unsigned number u to the terminal. + 0 D. ; + +: . ( n ---) +\G Type the signed number n to the terminal. + S>D D. ; + +: MOVE ( c-addr1 c-addr2 u --- ) +\G Copy a block of u bytes starting at c-addr1 to c-addr2. Order is such +\G that partially overlapping blocks are copied intact. + >R OVER OVER U< IF R> CMOVE> ELSE R> CMOVE THEN ; + + +CODE ACCEPT ( c-addr n1 --- n2 ) +\G Read a line from the terminal to a buffer starting at c-addr with +\G length n1. n2 is the number of characters read, +PULS X, D +JSR 6 +CLRA +PSHS D +NEXT +END-CODE + + +$200 CONSTANT TIB ( --- addr) +\G is the standard terminal input buffer. + +VARIABLE SPAN ( --- addr) +\G This variable holds the number of characters read by EXPECT. + +VARIABLE #TIB ( --- addr) +\G This variable holds the number of characters in the terminal input buffer. + +VARIABLE >IN ( --- addr) +\G This variable holds an index in the current input source where the next word +\G will be parsed. + +VARIABLE SID ( --- addr) +\G This variable holds the source i.d. returned by SOURCE-ID. + +VARIABLE SRC ( --- addr) +\G This variable holds the address of the current input source. + +VARIABLE #SRC ( --- addr) +\G This variable holds the length of the current input source. + +VARIABLE LOADLINE ( --- addr) +\G This variable holds the line number in the file being included. + + +: EXPECT ( c-addr u --- ) +\G Read a line from the terminal to a buffer at c-addr with length u. +\G Store the length of the line in SPAN. + ACCEPT SPAN ! ; + +: QUERY ( --- ) +\G Read a line from the terminal into the terminal input buffer. + TIB 128 ACCEPT #TIB ! ; + +: SOURCE ( --- addr len) +\G Return the address and length of the current input source. + SRC @ #SRC @ ; + +: SOURCE-ID ( --- sid) +\G Return the i.d. of the current source i.d., 0 for terminal, -1 +\G for EVALUATE and positive number for INCLUDE file. + SID @ ; + +: REFILL ( --- f) +\G Refill the current input source when it is exhausted. f is +\G true if it was successfully refilled. + SOURCE-ID -1 = IF + 0 \ Not refillable for EVALUATE + ELSE + QUERY #TIB @ #SRC ! 0 >IN ! -1 \ Always successful from terminal. + 1 LOADLINE +! + THEN +; + +: PARSE ( c --- addr len ) +\G Find a character sequence in the current source that is delimited by +\G character c. Adjust >IN to 1 past the end delimiter character. + >R SOURCE >IN @ - SWAP >IN @ + R> OVER >R >R SWAP + R@ SKIP OVER R> SWAP >R SCAN IF 1 >IN +! THEN + DUP R@ - R> SWAP + ROT R> - >IN +! ; + +: PLACE ( addr len c-addr --- ) +\G Place the string starting at addr with length len at c-addr as +\G a counted string. + OVER OVER C! + 1+ SWAP CMOVE ; + +: WORD ( c --- addr ) +\G Parse a character sequence delimited by character c and return the +\G address of a counted string that is a copy of it. The counted +\G string is actually placed at HERE. The character after the counted +\G string is set to a space. + PARSE HERE PLACE HERE BL HERE COUNT + C! ; + +VARIABLE CAPS ( --- a-addr) +\G This variable contains a nonzero number if input is case insensitive. + +: UPPERCASE? ( --- ) +\G Convert the parsed word to uppercase is CAPS is true. + CAPS @ HERE C@ AND IF + HERE COUNT 0 DO + DUP I + C@ DUP 96 > SWAP 123 < AND IF DUP I + DUP C@ 32 - SWAP C! THEN + LOOP DROP + THEN +; + + +\ PART 8: INTERPRETER HELPER WORDS + +\ First we need FIND and related words. + +\ Each word list consists of a number of linked list of definitions (number +\ is a power of 2). Hashing +\ is used to speed up dictionary search. All names in the dictionary +\ are at aligned addresses and FIND is optimized to compare one 4-byte +\ cell at a time. + +\ Dictionary definitions are built as follows: +\ +\ LINK field: 1 cell, aligned, contains name field of previous word in thread. +\ NAME field: counted string of at most 31 characters. +\ bits 5-7 of length byte have special meaning. +\ 7 is always set to mark start of name ( for >NAME) +\ 6 is set if the word is immediate. +\ CODE field: first aligned address after name, is execution token for word. +\ here the executable code for the word starts. (is 3 bytes for +\ variables etc.) +\ PARAMETER field: (body) Contains the data of constants and variables etc. + +VARIABLE NAMEBUF ( --- a-addr) +\G An aligned buffer that holds a copy of the name that is searched. +30 ALLOT-T + +VARIABLE FORTH-WORDLIST ( --- addr) +4 CELLS-T ALLOT-T +\G This array holds pointers to the last definition of each thread in the Forth +\G word list. + +VARIABLE LAST ( --- addr) +\G This variable holds a pointer to the last definition created. + +VARIABLE CONTEXT 28 ALLOT-T ( --- a-addr) +\G This variable holds the addresses of up to 8 word lists that are +\G in the search order. + +VARIABLE #ORDER ( --- addr) +\G This variable holds the number of word list that are in the search order. + +VARIABLE CURRENT ( --- addr) +\G This variable holds the address of the word list to which new definitions +\G are added. + +: HASH ( c-addr u #threads --- n) +\G Compute the hash function for the name c-addr u with the indicated number +\G of threads. + >R OVER C@ 1 LSHIFT OVER 1 > IF ROT CHAR+ C@ 2 LSHIFT XOR ELSE ROT DROP + THEN XOR + R> 1- AND +; + +: NAME>BUF ( c-addr u ---) +\G Move the name c-addr u to the aligned buffer NAMEBUF. + NAMEBUF 32 0 FILL 32 MIN NAMEBUF PLACE ; + + +: SEARCH-WORDLIST ( c-addr u wid --- 0 | xt 1 xt -1) +\G Search the wordlist with address wid for the name c-addr u. +\G Return 0 if not found, the execution token xt and -1 for non-immediate +\G words and xt and 1 for immediate words. + ROT ROT + NAME>BUF + NAMEBUF COUNT 2 PICK @ HASH 1+ CELLS SWAP + @ \ Get the right thread. + DUP IF + NAMEBUF SWAP (FIND) DUP 0= IF DROP DROP 0 THEN EXIT + THEN + DROP 0 \ Not found. +; + +: FIND ( c-addr --- c-addr 0| xt 1|xt -1 ) +\G Search all word lists in the search order for the name in the +\G counted string at c-addr. If not found return the name address and 0. +\G If found return the execution token xt and -1 if the word is non-immediate +\G and 1 if the word is immediate. + #ORDER @ DUP 1 > IF + CONTEXT #ORDER @ 1- CELLS + DUP @ SWAP CELL- @ = + ELSE 0 THEN + IF 1- THEN \ If last wordlist is double, don't search it twice. + BEGIN + DUP + WHILE + 1- >R + DUP COUNT + R@ CELLS CONTEXT + @ SEARCH-WORDLIST + DUP + IF + R> DROP ROT DROP EXIT \ Exit if found. + THEN + DROP R> + REPEAT +; + +\ The following words are related to numeric input. + +: DIGIT? ( c -- 0| c--- n -1) +\G Convert character c to its digit value n and return true if c is a +\G digit in the current base. Otherwise return false. + 48 - DUP 0< IF DROP 0 EXIT THEN + DUP 9 > OVER 17 < AND IF DROP 0 EXIT THEN + DUP 9 > IF 7 - THEN + DUP BASE @ < 0= IF DROP 0 EXIT THEN + -1 +; + +: >NUMBER ( ud1 c-addr1 u1 --- ud2 c-addr2 u2 ) +\G Convert the string at c-addr with length u1 to binary, multiplying ud1 +\G by the number in BASE and adding the digit value to it for each digit. +\G c-addr2 u2 is the remainder of the string starting at the first character +\G that is no digit. + BEGIN + DUP + WHILE + 1 - >R + COUNT DIGIT? 0= + IF + R> 1+ SWAP 1 - SWAP EXIT + THEN + SWAP >R + >R + SWAP BASE @ UM* ROT BASE @ * 0 SWAP D+ \ Multiply ud by base. + R> 0 D+ \ Add new digit. + R> R> + REPEAT +; + +: CONVERT ( ud1 c-addr1 --- ud2 c-addr2) +\G Convert the string starting at c-addr1 + 1 to binary. c-addr2 is the +\G address of the first non-digit. Digits are added into ud1 as in >NUMBER + 1 - -1 >NUMBER DROP ; + +: NUMBER? ( c-addr ---- d f) +\G Convert the counted string at c-addr to a double binary number. +\G f is true if and only if the conversion was successful. DPL contains +\G -1 if there was no point in the number, else the position of the point +\G from the right. Special prefixes: # means decimal, $ means hex. + -1 DPL ! + BASE @ >R + COUNT + OVER C@ 45 = DUP >R IF 1 - SWAP 1 + SWAP THEN \ Get any - sign + OVER C@ 36 = IF 16 BASE ! 1 - SWAP 1 + SWAP THEN \ $ sign for hex. + OVER C@ 35 = IF 10 BASE ! 1 - SWAP 1 + SWAP THEN \ # sign for decimal + DUP 0 > 0= IF R> DROP R> BASE ! 0 EXIT THEN \ Length 0 or less? + >R >R 0 0 R> R> + BEGIN + >NUMBER + DUP IF OVER C@ 46 = IF 1 - DUP DPL ! SWAP 1 + SWAP ELSE \ handle point. + R> DROP R> BASE ! 0 EXIT THEN \ Error if anything but point + THEN + DUP 0= UNTIL DROP DROP R> IF DNEGATE THEN + R> BASE ! -1 +; + +\ PART 9: THE COMPILER + +VARIABLE ERROR$ ( --- a-addr ) +\G Variable containing string address of ABORT" message. + +VARIABLE HANDLER ( --- a-addr ) +\G Variable containing return stack address where THROW should return. + +: (ABORT") ( f -- - ) +\G Runtime part of ABORT" + IF R> ERROR$ ! -2 THROW + ELSE R> COUNT + ALIGNED >R THEN ; + +: THROW ( n --- ) +\G If n is nonzero, cause the corresponding CATCH to return with n. +DUP IF + HANDLER @ IF + HANDLER @ RP! + RP@ 4 + @ HANDLER ! \ point to previous exception frame. + R> \ get old stack pointer. + SWAP >R SP! DROP R> \ save throw code temp. on ret. stack set old sp. + R> DROP \ remove address of handler. + \ return stack points to return address of CATCH. + ELSE + WARM \ Warm start if no exception frame on stack. + THEN +ELSE + DROP \ continue if zero. +THEN +; + +: CATCH ( xt --- n ) +\G Execute the word with execution token xt. If it returns normally, return +\G 0. If it executes a THROW, return the throw parameter. + HANDLER @ >R \ push handler on ret stack. + SP@ >R \ push stack pointer on ret stack, + RP@ HANDLER ! + EXECUTE + RP@ 4 + @ HANDLER ! \ set handler to previous exception frame. + R> DROP R> DROP \ remove exception frame. + 0 \ return 0 +; + +: ALLOT ( n --- ) +\G Allot n extra bytes of memory, starting at HERE to the dictionary. + DP +! ; + +: , ( x --- ) +\G Append cell x to the dictionary at HERE. + HERE ! 1 CELLS ALLOT ; + +: C, ( n --- ) +\G Append character c to the dictionary at HERE. + HERE C! 1 ALLOT ; + +: ALIGN ( --- ) +\G Add as many bytes to the dictionary as needed to align dictionary pointer. + ; + +: >NAME ( addr1 --- addr2 ) +\G Convert execution token addr1 (address of code) to address of name. + BEGIN 1- DUP C@ 128 AND UNTIL ; + +: NAME> ( addr1 --- addr2 ) +\G Convert address of name to address of code. + COUNT 31 AND + ALIGNED ; + +: HEADER ( --- ) +\G Create a header for a new definition without a code field. + ALIGN 0 , \ Create link field. + HERE LAST ! \ Set LAST so definition can be linked by REVEAL + 32 WORD UPPERCASE? + DUP FIND IF ." Redefining: " HERE COUNT TYPE CR THEN DROP + \ Give warning if existing word redefined. + DUP COUNT CURRENT @ @ HASH 1+ CELLS CURRENT @ + @ HERE CELL- ! + \ Set link field to point to the right thread + C@ 1+ HERE C@ 128 + HERE C! ALLOT ALIGN + \ Allot the name and set bit 7 in length byte. +; + +: JSR, $BD C, ; + +: REVEAL ( --- ) +\G Add the last created definition to the CURRENT wordlist. + LAST @ DUP COUNT 31 AND \ Get address and length of name + CURRENT @ @ HASH \ compute hash code. + 1+ CELLS CURRENT @ + ! ; + +: CREATE ( "ccc" --- ) +\G Create a definition that returns its parameter field address when +\G executed. Storage can be added to it with ALLOT. + HEADER REVEAL JSR, LIT DOVAR , ; + +: VARIABLE ( "ccc" --- ) +\G Create a variable where 1 cell can be stored. When executed it +\G returns the address. + CREATE 0 , ; + +: CONSTANT ( x "ccc" ---) +\G Create a definition that returns x when executed. +\ Definition contains lit & return in its code field. + HEADER REVEAL JSR, LIT DOCON , , ; + + +VARIABLE STATE ( --- a-addr) +\G Variable that holds the compiler state, 0 is interpreting 1 is compiling. + +: ] ( --- ) +\G Start compilation mode. + 1 STATE ! ; + +: [ ( --- ) +\G Leave compilation mode. + 0 STATE ! ; IMMEDIATE + +: LITERAL ( n --- ) +\G Add a literal to the current definition. + POSTPONE LIT , ; IMMEDIATE + +: COMPILE, ( xt --- ) +\G Add the execution semantics of the definition xt to the current definition. + , +; + +VARIABLE CSP ( --- a-addr ) +\G This variable is used for stack checking between : and ; + +VARIABLE 'LEAVE ( --- a-addr) +\ This variable is used for LEAVE address resolution. + +: !CSP ( --- ) +\G Store current stack pointer in CSP. + SP@ CSP ! ; + +: ?CSP ( --- ) +\G Check that stack pointer is equal to value contained in CSP. + SP@ CSP @ - -22 ?THROW ; + +: ; ( --- ) +\G Finish the current definition by adding a return to it, make it +\G visible and leave compilation mode. + POSTPONE UNNEST [ + ?CSP REVEAL +; IMMEDIATE + +: (POSTPONE) ( --- ) +\G Runtime for POSTPONE. +\ has inline argument. + R> DUP @ SWAP CELL+ >R + DUP >NAME C@ 64 AND IF EXECUTE ELSE COMPILE, THEN +; + +: : ( "ccc" --- ) +\G Start a new definition, enter compilation mode. + !CSP HEADER JSR, LIT DOCOL , ] ; + +: BEGIN ( --- x ) +\G Start a BEGIN UNTIL or BEGIN WHILE REPEAT loop. + HERE ; IMMEDIATE + +: UNTIL ( x --- ) +\G Form a loop with matching BEGIN. +\G Runtime: A flag is take from the stack +\G each time UNTIL is encountered and the loop iterates until it is nonzero. + POSTPONE ?BRANCH , ; IMMEDIATE + +: IF ( --- x) +\G Start an IF THEN or IF ELSE THEN construction. +\G Runtime: At IF a flag is taken from +\G the stack and if it is true the part between IF and ELSE is executed, +\G otherwise the part between ELSE and THEN. If there is no ELSE, the part +\G between IF and THEN is executed only if flag is true. + POSTPONE ?BRANCH HERE 1 CELLS ALLOT ; IMMEDIATE + +: THEN ( x ---) +\G End an IF THEN or IF ELSE THEN construction. + HERE SWAP ! ; IMMEDIATE + +: ELSE ( x1 --- x2) +\G part of IF ELSE THEN construction. + POSTPONE BRANCH HERE 1 CELLS ALLOT SWAP POSTPONE THEN ; IMMEDIATE + +: WHILE ( x1 --- x2 x1 ) +\G part of BEGIN WHILE REPEAT construction. +\G Runtime: At WHILE a flag is taken from the stack. If it is false, +\G the program jumps out of the loop, otherwise the part between WHILE +\G and REPEAT is executed and the loop iterates to BEGIN. + POSTPONE IF SWAP ; IMMEDIATE + +: REPEAT ( x1 x2 --- ) +\G part of BEGIN WHILE REPEAT construction. + POSTPONE BRANCH , POSTPONE THEN ; IMMEDIATE + +VARIABLE POCKET ( --- a-addr ) +\G Buffer for S" strings that are interpreted. + 252 ALLOT-T + +: ' ( "ccc" --- xt) +\G Find the word with name ccc and return its execution token. + 32 WORD UPPERCASE? FIND 0= -13 ?THROW ; + +: ['] ( "ccc" ---) +\G Copile the execution token of the word with name ccc as a literal. + ' LITERAL ; IMMEDIATE + +: CHAR ( "ccc" --- c) +\G Return the first character of "ccc". + BL WORD 1 + C@ ; + +: [CHAR] ( "ccc" --- ) +\G Compile the first character of "ccc" as a literal. + CHAR LITERAL ; IMMEDIATE + +: DO ( --- x) +\G Start a DO LOOP. +\G Runtime: ( n1 n2 --- ) start a loop with initial count n2 and +\G limit n1. + POSTPONE (DO) 'LEAVE @ HERE 0 'LEAVE ! ; IMMEDIATE + +: ?DO ( --- x ) +\G Start a ?DO LOOP. +\G Runtime: ( n1 n2 --- ) start a loop with initial count n2 and +\G limit n1. Exit immediately if n1 = n2. + POSTPONE (?DO) 'LEAVE @ HERE 'LEAVE ! 0 , HERE ; IMMEDIATE + +: LEAVE ( --- ) +\G Runtime: leave the matching DO LOOP immediately. +\ All places where a leave address for the loop is needed are in a linked +\ list, starting with 'LEAVE variable, the other links in the cells where +\ the leave addresses will come. + POSTPONE (LEAVE) HERE 'LEAVE @ , 'LEAVE ! ; IMMEDIATE + +: RESOLVE-LEAVE +\G Resolve the references to the leave addresses of the loop. + 'LEAVE @ + BEGIN DUP WHILE DUP @ HERE ROT ! REPEAT DROP ; + +: LOOP ( x --- ) +\G End a DO LOOP. +\G Runtime: Add 1 to the count and if it is equal to the limit leave the loop. + POSTPONE (LOOP) , RESOLVE-LEAVE 'LEAVE ! ; IMMEDIATE + +: +LOOP ( x --- ) +\G End a DO +LOOP +\G Runtime: ( n ---) Add n to the count and exit if this crosses the +\G boundary between limit-1 and limit. + POSTPONE (+LOOP) , RESOLVE-LEAVE 'LEAVE ! ; IMMEDIATE + +: RECURSE ( --- ) +\G Compile a call to the current (not yet finished) definition. + LAST @ NAME> COMPILE, ; IMMEDIATE + +: ." ( "ccc" --- ) +\G Parse a string delimited by " and compile the following runtime semantics. +\G Runtime: type that string. + POSTPONE (.") 34 WORD C@ 1+ ALLOT ALIGN ; IMMEDIATE + + +: S" ( "ccc" --- ) +\G Parse a string delimited by " and compile the following runtime semantics. +\G Runtime: ( --- c-addr u) Return start address and length of that string. + STATE @ IF POSTPONE (S") 34 WORD C@ 1+ ALLOT ALIGN + ELSE 34 WORD COUNT POCKET PLACE POCKET COUNT THEN ; IMMEDIATE + +: ABORT" ( "ccc" --- ) +\G Parse a string delimited by " and compile the following runtime semantics. +\G Runtime: ( f --- ) if f is nonzero, print the string and abort program. + POSTPONE (ABORT") 34 WORD C@ 1+ ALLOT ALIGN ; IMMEDIATE + +: ABORT ( --- ) +\G Abort unconditionally without a message. + -1 THROW ; + +: POSTPONE ( "ccc" --- ) +\G Parse the next word delimited by spaces and compile the following runtime. +\G Runtime: depending on immediateness EXECUTE or compile the execution +\G semantics of the parsed word. + POSTPONE (POSTPONE) ' , ; IMMEDIATE + +: IMMEDIATE ( --- ) +\G Make last definition immediate, so that it will be executed even in +\G compilation mode. + LAST @ DUP C@ 64 OR SWAP C! ; + +: ( ( "ccc" --- ) +\G Comment till next ). + 41 PARSE DROP DROP ; IMMEDIATE + +: \ +\G Comment till end of line. + SOURCE >IN ! DROP ; IMMEDIATE + +: >BODY ( xt --- a-addr) +\G Convert execution token to parameter field address. + 3 + ; + +: (;CODE) ( --- ) +\G Runtime for DOES>, exit calling definition and make last defined word +\G execute the calling definition after (;CODE) + R> LAST @ NAME> 1+ ! ; + +: DOES> ( --- ) +\G Word that contains DOES> will change the behavior of the last created +\G word such that it pushes its parameter field address onto the stack +\G and then executes whatever comes after DOES> + POSTPONE (;CODE) + JSR, LIT DOCOL , +; IMMEDIATE + +\ PART 10: TOP LEVEL OF INTERPRETER + +: ?STACK ( ---) +\G Check for stack over/underflow and abort with an error if needed. + DEPTH DUP 0< -4 ?THROW 10000 > -3 ?THROW ; + +: INTERPRET ( ---) +\G Interpret words from the current source until the input source is exhausted. + BEGIN + 32 WORD UPPERCASE? DUP C@ + WHILE + FIND DUP + IF + -1 = STATE @ AND + IF + COMPILE, + ELSE + EXECUTE + THEN + ELSE DROP + NUMBER? 0= -13 ?THROW + DPL @ 1+ IF + STATE @ IF SWAP LITERAL LITERAL THEN + ELSE + DROP STATE @ IF LITERAL THEN + THEN + THEN ?STACK + REPEAT DROP +; + +: EVALUATE ( c-addr u --- ) +\G Evaluate the string c-addr u as if it were typed on the terminal. + SID @ >R SRC @ >R #SRC @ >R >IN @ >R + #SRC ! SRC ! 0 >IN ! -1 SID ! INTERPRET + R> >IN ! R> #SRC ! R> SRC ! R> SID ! ; + +VARIABLE ERRORS ( --- a-addr) +\G This variable contains the head of a linked list of error messages. + +: ERROR-SOURCE ( --- ) +\G Print location of error source. + SID @ 0 > IF + ." in line " LOADLINE @ . + THEN + HERE COUNT TYPE CR WARM +; + +: QUIT ( --- ) +\G This word resets the return stack, resets the compiler state, the include +\G buffer and then it reads and interprets terminal input. + R0 @ RP! [ + TIB SRC ! 0 SID ! + BEGIN + REFILL DROP ['] INTERPRET CATCH DUP 0= IF + DROP STATE @ 0= IF ." OK" THEN CR + ELSE \ throw occured. + XABORTIN + DUP -2 = IF + ERROR$ @ COUNT TYPE SPACE + ELSE + ERRORS @ + BEGIN DUP WHILE + OVER OVER @ = IF 4 + COUNT TYPE SPACE ERROR-SOURCE THEN CELL+ @ + REPEAT DROP + ." Error " . + THEN ERROR-SOURCE + THEN + 0 UNTIL +; + +: XLOAD + XOPENIN 1 SID ! 0 LOADLINE ! ; + +: WARM ( ---) +\G This word is called when an error occurs. Clears the stacks, sets +\G BASE to decimal, closes the files and resets the search order. + R0 @ RP! S0 @ SP! DECIMAL + 2 #ORDER ! + FORTH-WORDLIST CONTEXT ! + FORTH-WORDLIST CONTEXT CELL+ ! + FORTH-WORDLIST CURRENT ! + 0 HANDLER ! + ." Welcome to Forth" CR + QUIT ; + +CODE COLD ( --- ) +\G The first word that is called at the start of Forth. + LDY # $8000 + STY R0ADDR + LDS # $7C00 + STS S0ADDR A; + $7E C, WARM +END-CODE + + +END-CROSS + +\ PART 10: FINISHING AND SAVING THE TARGET IMAGE. + +\ Resolve the forward references created by the cross compiler. +RESOLVE DOCOL RESOLVE DOCON RESOLVE LIT RESOLVE BRANCH RESOLVE ?BRANCH +RESOLVE (DO) RESOLVE DOVAR RESOLVE UNNEST +RESOLVE (LOOP) RESOLVE (.") +RESOLVE COLD RESOLVE WARM +RESOLVE THROW +RESOLVE (POSTPONE) + +\ Store appropriate values into some of the new Forth's variables. +: CELLS>TARGET + 0 DO OVER I CELLS + @ OVER I CELLS-T + !-T LOOP 2DROP ; + +#THREADS T' FORTH-WORDLIST >BODY-T !-T +TLINKS T' FORTH-WORDLIST >BODY-T 2 + #THREADS CELLS>TARGET +THERE T' DP >BODY-T !-T + +: TELLMEHOW BASE @ HEX + ." Type SO" ORIGIN . ." ,then SS" IMAGE . ." ," THERE ORIGIN - . + BYE ; diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/meta09.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/meta09.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,337 @@ +\ CROSS COMPILER FOR THE MOTORAOLA 6809 PROCESSOR +\ created 1995 by L.C. Benschop. +\ copyleft (c) 1995-2014 by the sbc09 team, see AUTHORS for more details. +\ license: GNU General Public License version 2, see LICENSE for more details. +\ +\ This serves as an introduction to Forth cross compiling, so it is excessively +\ commented. +\ +\ This cross compiler can be run on any ANS Forth with the necessary +\ extension wordset that is at least 16-bit, including Motorola 6809 Forth. +\ +\ It creates the memory image of a new Forth system that is to be run +\ by the Motorola 6809 processor. +\ +\ The cross compiler (or meta compiler or target compiler) is similar +\ to a regular Forth compiler, except that it builds definitions in +\ a dictionary in the memory image of a different Forth system. +\ We call this the target dictionary in the target space of the +\ target system. +\ +\ As the new definitions are for a different Forth system, the cross +\ compiler cannot EXECUTE them. Neither can it easily find the new +\ definitions in the target dictionary. Hence a shadow definition +\ for each target definition is made in the normal Forth dictionary. +\ +\ The names of the new definitions overlap with the names of existing +\ elementary. Forth words. Therefore they need to be in a wordlist +\ different from the normal Forth wordlist. + +\ PART 1: THE VOCABULARIES. + +VOCABULARY TARGET +\ This vocabulary will hold shadow definitions for all words that are in +\ the target dictionary. When a shadow definition is executed, it +\ performs the compile action in the target dictionary. + +VOCABULARY TRANSIENT +\ This vocabulary will hold definitions that must be executed by the +\ host system ( the system on which the cross compiler runs) and that +\ compile to the target system. + +\ Expl: The word IF occurs in all three vocabularies. The word IF in the +\ FORTH vocabulary is run by the host system and is used when +\ compiling host definitions. A different version is in the +\ TRANSIENT vocabulary. This one runs on the host system and +\ is used when compiling target definitions. The version in the +\ TARGET vocabulary is the version that will run on the target +\ system. + +\ : \D ; \ Uncomment one of these. If uncommented, display debug info. + : \D POSTPONE \ ; IMMEDIATE + +\ PART 2: THE TARGET DICTIONARY SPACE. + +\ Next we need to define the target space and the words to access it. + +1024 CONSTANT ORIGIN \ Start address of Forth image. +8192 CONSTANT IMAGE_SIZE + + +CREATE IMAGE IMAGE_SIZE CHARS ALLOT \ This space contains the target image. + IMAGE IMAGE_SIZE 0 FILL \ Initialize it to zero. + +\ Fetch and store characters in the target space. +: C@-T ( t-addr --- c) ORIGIN - CHARS IMAGE + C@ ; +: C!-T ( c t-addr ---) ORIGIN - CHARS IMAGE + C! ; + +\ Fetch and store cells in the target space. +\ M6809 is big endian 32 bit so store explicitly big-endian. +: @-T ( t-addr --- x) + ORIGIN - CHARS IMAGE + DUP C@ 8 LSHIFT SWAP 1 CHARS + C@ + ; + +: !-T ( x t-addr ---) + ORIGIN - CHARS IMAGE + OVER 8 RSHIFT OVER C! 1 CHARS + C! ; + +\ A dictionary is constructed in the target space. Here are the primitives +\ to maintain the dictionary pointer and to reserve space. + +VARIABLE DP-T \ Dictionary pointer for target dictionary. +ORIGIN DP-T ! \ Initialize it to origin. +: THERE ( --- t-addr) DP-T @ ; \ Equivalent of HERE in target space. +: ALLOT-T ( n --- ) DP-T +! ; \ Reserve n bytes in the dictionary. +: CHARS-T ( n1 --- n2 ) ; +: CELLS-T ( n1 --- n2 ) 1 LSHIFT ; \ Cells are 2 chars. +: ALIGN-T ; \ No alignment used. +: ALIGNED-T ( n1 --- n2 ) ; +: C,-T ( c --- ) THERE C!-T 1 CHARS ALLOT-T ; +: ,-T ( x --- ) THERE !-T 1 CELLS-T ALLOT-T ; + +: PLACE-T ( c-addr len t-addr --- ) \ Move counted string to target space. + OVER OVER C!-T 1+ CHARS ORIGIN - IMAGE + SWAP CHARS CMOVE ; + +\ 6809 cross assembler already loaded, configure it for cross assembly. + +FORTH ' ,-T ASSEMBLER IS , +FORTH ' C,-T ASSEMBLER IS C, +FORTH ' !-T ASSEMBLER IS V! +FORTH ' @-T ASSEMBLER IS V@ +FORTH ' C!-T ASSEMBLER IS VC! +FORTH ' C@-T ASSEMBLER IS VC@ +FORTH ' THERE ASSEMBLER IS HERE +FORTH + +\ PART 3: CREATING NEW DEFINITIONS IN THE TARGET SYSTEM. + +\ These words create new target definitions, both the shadow definition +\ and the header in the target dictionary. The layout of target headers +\ can be changed but FIND in the target system must be changed accordingly. + +\ All definitions are linked together in a number of threads. Each word +\ is linked in only one thread. Which thread the word is linked to, can be +\ determined from the name by a 'hash' code. To find a word, one can compute +\ the hash code and then one can search just one thread that contains a +\ small fraction of the words. + +4 CONSTANT #THREADS \ Number of threads + +CREATE TLINKS #THREADS CELLS ALLOT \ This array points to the names + \ of the last definition in each thread. +TLINKS #THREADS CELLS 0 FILL + +VARIABLE LAST-T \ Address of last definition. + +: HASH ( c-addr u #threads --- n) + >R OVER C@ 1 LSHIFT OVER 1 > IF ROT CHAR+ C@ 2 LSHIFT XOR ELSE ROT DROP + THEN XOR + R> 1- AND +; + +: "HEADER >IN @ CREATE >IN ! \ Create the shadow definition. + BL WORD + DUP COUNT #THREADS HASH >R \ Compute the hash code. + ALIGN-T TLINKS R@ CELLS + @ ,-T \ Lay out the link field. +\D DUP COUNT CR ." Creating: " TYPE ." Hash:" R@ . + COUNT DUP >R THERE PLACE-T \ Place name in target dictionary. + THERE TLINKS R> R> SWAP >R CELLS + ! + THERE LAST-T ! + THERE C@-T 128 OR THERE C!-T R> 1+ ALLOT-T ALIGN-T ; + \ Set bit 7 of count byte as a marker. + +\ : "HEADER CREATE ALIGN-T ; \ Alternative for "HEADER in case the target system + \ is just an application without headers. + + +ALSO TRANSIENT DEFINITIONS +: IMMEDIATE LAST-T @ DUP C@-T 64 OR SWAP C!-T ; + \ Set the IMMEDIATE bit of last name. +PREVIOUS DEFINITIONS + +\ PART 4: FORWARD REFERENCES + +\ Some definitions are referenced before they are defined. A definition +\ in the TRANSIENT voc is created for each forward referenced definition. +\ This links all addresses together where the forward reference is used. +\ The word RESOLVE stores the real address everywhere it is needed. + +: FORWARD + CREATE 0 , \ Store head of list in the definition. + DOES> + DUP @ ,-T THERE 1 CELLS-T - SWAP ! \ Reserve a cell in the dictionary + \ where the call to the forward definition must come. + \ As the call address is unknown, store link to next + \ reference instead. +; + +: RESOLVE + ALSO TARGET >IN @ ' >BODY @ >R >IN ! \ Find the resolving word in the + \ target voc. and take the CFA out of the definition. +\D >IN @ BL WORD COUNT CR ." Resolving: " TYPE >IN ! + TRANSIENT ' >BODY @ \ Find the forward ref word in the + \ TRANSIENT VOC and take list head. + BEGIN + DUP \ Traverse all the links until end. + WHILE + DUP @-T \ Take address of next link from dict. + R@ ROT !-T \ Set resolved address in dict. + REPEAT DROP R> DROP PREVIOUS +; + + +\ PART 5: CODE GENERATION + +\ Motorola 6809 Forth is a direct threaded Forth. It uses the following +\ registers: S for stack pointer, Y for return stack pointer, U for +\ instruction pointer. NEXT is the single instruction PULU PC. +\ THe code field of a definition contains a JSR instruction. + +: JSR, [ HEX ] BD C,-T [ DECIMAL ] ; + +VARIABLE STATE-T 0 STATE-T ! \ State variable for cross compiler. +: T] 1 STATE-T ! ; +: T[ 0 STATE-T ! ; + +VARIABLE CSP \ Stack pointer checking between : and ; +: !CSP DEPTH CSP ! ; +: ?CSP DEPTH CSP @ - ABORT" Incomplete control structure" ; + +TRANSIENT DEFINITIONS FORTH +FORWARD LIT +FORWARD DOCOL +FORWARD DOCON +FORWARD DOVAR +FORWARD UNNEST +FORWARD BRANCH +FORWARD ?BRANCH +FORTH DEFINITIONS + +: LITERAL-T ( n --- ) +\D DUP ." Literal:" . CR + [ TRANSIENT ] LIT [ FORTH ] ,-T ; + +TRANSIENT DEFINITIONS FORTH +\ Now define the words that do compile code. + + +: : !CSP "HEADER THERE , JSR, [ TRANSIENT ] DOCOL [ FORTH ] T] + DOES> @ ,-T ; + +: ; [ TRANSIENT ] UNNEST [ FORTH ] \ Compile the unnest primitive. + T[ ?CSP \ Quit compilation state. + ; + + +: CODE "HEADER ASSEMBLE THERE , + DOES> @ ,-T ; +: END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; +: LABEL THERE CONSTANT ASSEMBLE ; + +FORTH DEFINITIONS + +\ PART 6: DEFINING WORDS. + +TRANSIENT DEFINITIONS FORTH + +: VARIABLE "HEADER THERE , JSR, [ TRANSIENT ] DOVAR [ FORTH ] 0 ,-T +\ Create a variable. +DOES> @ ,-T ; + +: CONSTANT "HEADER THERE , JSR, [ TRANSIENT ] DOCON [ FORTH ] + ,-T + DOES> @ ,-T ; + +FORTH DEFINITIONS + +: T' ( --- t-addr) \ Find the execution token of a target definition. + ALSO TARGET ' +\D ." T' shadow address, target address " DUP . DUP >BODY @ . + >BODY @ \ Get the address from the shadow definition. + PREVIOUS +; + +: >BODY-T ( t-addr1 --- t-addr2 ) \ Convert executing token to param address. + 3 + ; + +\ PART 7: COMPILING WORDS + +TRANSIENT DEFINITIONS FORTH + +\ The TRANSIENT definitions for IF, THEN etc. compile the +\ branch primitives BRAMCH and ?BRANCH. + +: BEGIN THERE ; +: UNTIL [ TRANSIENT ] ?BRANCH [ FORTH ] ,-T ; +: IF [ TRANSIENT ] ?BRANCH [ FORTH ] THERE 1 CELLS-T ALLOT-T ; +: THEN THERE SWAP !-T ; TARGET +: ELSE [ TRANSIENT ] BRANCH THERE 1 CELLS-T ALLOT-T SWAP THEN [ FORTH ] ; +: WHILE [ TRANSIENT ] IF [ FORTH ] SWAP ; TARGET +: REPEAT [ TRANSIENT ] BRANCH ,-T THEN [ FORTH ] ; + +FORWARD (DO) +FORWARD (LOOP) +FORWARD (.") +FORWARD (POSTPONE) + +: DO [ TRANSIENT ] (DO) [ FORTH ] THERE ; +: LOOP [ TRANSIENT ] (LOOP) [ FORTH ] ,-T ; +: ." [ TRANSIENT ] (.") [ FORTH ] 34 WORD COUNT DUP 1+ >R + THERE PLACE-T R> ALLOT-T ALIGN-T ; +: POSTPONE [ TRANSIENT ] (POSTPONE) [ FORTH ] T' ,-T ; + +: \ POSTPONE \ ; IMMEDIATE +: \G POSTPONE \ ; IMMEDIATE +: ( POSTPONE ( ; IMMEDIATE \ Move duplicates of comment words to TRANSIENT +: CHARS-T CHARS-T ; \ Also words that must be executed while cross compiling. +: CELLS-T CELLS-T ; +: ALLOT-T ALLOT-T ; +: ['] T' LITERAL-T ; + +FORTH DEFINITIONS + +\ PART 8: THE CROSS COMPILER ITSELF. + +VARIABLE DPL +: NUMBER? ( c-addr ---- d f) + -1 DPL ! + BASE @ >R + COUNT + OVER C@ 45 = DUP >R IF 1 - SWAP 1 + SWAP THEN \ Get any - sign + OVER C@ 36 = IF 16 BASE ! 1 - SWAP 1 + SWAP THEN \ $ sign for hex. + OVER C@ 35 = IF 10 BASE ! 1 - SWAP 1 + SWAP THEN \ # sign for decimal + DUP 0 > 0= IF R> DROP R> BASE ! 0 EXIT THEN \ Length 0 or less? + >R >R 0 0 R> R> + BEGIN + >NUMBER + DUP IF OVER C@ 46 = IF 1 - DUP DPL ! SWAP 1 + SWAP ELSE \ handle point. + R> DROP R> BASE ! 0 EXIT THEN \ Error if anything but point + THEN + DUP 0= UNTIL DROP DROP R> IF DNEGATE THEN + R> BASE ! -1 +; + + +: CROSS-COMPILE + ONLY TARGET DEFINITIONS ALSO TRANSIENT \ Restrict search order. + BEGIN + BL WORD + \D CR DUP COUNT TYPE + DUP C@ 0= IF \ Get new word + DROP REFILL DROP \ If empty, get new line. + ELSE + DUP COUNT S" END-CROSS" COMPARE 0= \ Exit cross compiler on END-CROSS + IF + ONLY FORTH ALSO DEFINITIONS \ Normal search order again. + DROP EXIT + THEN + FIND IF \ Execute if found. + EXECUTE + ELSE + NUMBER? 0= ABORT" Undefined word" DROP + STATE-T @ IF \ Parse it as a number. + LITERAL-T \ If compiling then compile as a literal. + THEN + THEN + THEN + 0 UNTIL +; + diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/test6309.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/test6309.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,54 @@ +\ Test for the 6309 assembler + +CODE TEST + PSHSW + PULSW + PSHUW + PULUW + LDW 0 ,W + STW $1234 ,W + ADDW ,--W + SUBW ,W++ + ANDD 0 ,W [] + ORD $1234 ,W [] + EORD ,--W [] + CMPD ,W++ [] + SEXW + TFM++ X, Y + TFM-- D, U + TFM+0 X, D + TFM0+ U, X + ADDR A, B + ADCR B, A + ORR D, W + ANDR W, Y + EORR X, U + CMPR E, F + LDQ # $1234.5678 + LDQ $1f + STQ $1234 + ADDD E,X + ADDD F,X + ADDD W,X + ASLD + RORW + COME + INCF + AIM $80 $12 + OIM $40 $1234 + EIM $20 5 ,U + TIM $10 0 ,W + LDBT A 1 0 $FE + BOR B 0 1 $FE + STBT CC 0 7 $FE + BIAND A 1 4 $FE + MULD # $12 + DIVD # $12 + DIVQ $1234 [] + LDE # 4 + STE $34 ,X [] + LDMD $01 + BITMD $80 + PULU A, B, X, S +END-CODE + diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/test6309.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/test6309.asm Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,50 @@ +* Test for 6309 instructions, compare with Forth assembler output. + PSHSW + PULSW + PSHUW + PULUW + LDW ,W + STW $1234,W + ADDW ,--W + SUBW ,W++ + ANDD [,W] + ORD [$1234,W] + EORD [,--W] + CMPD [,W++] + SEXW + TFM X+,Y+ + TFM D-,U- + TFM X+,D + TFM U,X+ + ADDR A,B + ADCR B,A + ORR D,W + ANDR W,Y + EORR X,U + CMPR E,F + LDQ #$12345678 + LDQ <$1f + STQ $1234 + ADDD E,X + ADDD F,X + ADDD W,X + ASLD + RORW + COME + INCF + AIM #$80,<$12 + OIM #$40,$1234 + EIM #$20,5,U + TIM #$10,,W + LDBT A,1,0,$FE + BOR B,0,1,$FE + STBT CC,0,7,$FE + BIAND A,1,4,$FE + MULD # $12 + DIVD # $12 + DIVQ [$1234] + LDE #4 + STE [$34,X] + LDMD #$01 + BITMD #$80 + PULU A, B, X, S diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/tester.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/tester.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,49 @@ +\ (C) 1993 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY +\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. +\ VERSION 1.0 +HEX + +\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY +\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. +VARIABLE VERBOSE + FALSE VERBOSE ! + +: EMPTY-STACK \ ( ... -- ) EMPTY STACK. + DEPTH ?DUP IF 0 DO DROP LOOP THEN ; + +: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY + \ THE LINE THAT HAD THE ERROR. + TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR + EMPTY-STACK \ THROW AWAY EVERY THING ELSE +; + +VARIABLE ACTUAL-DEPTH \ STACK RECORD +CREATE ACTUAL-RESULTS 20 CELLS ALLOT + +: { \ ( -- ) SYNTACTIC SUGAR. + ; + +: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. + DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH + ?DUP IF \ IF THERE IS SOMETHING ON STACK + 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM + THEN ; + +: } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED + \ (ACTUAL) CONTENTS. + DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH + DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK + 0 DO \ FOR EACH STACK ITEM + ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED + <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN + LOOP + THEN + ELSE \ DEPTH MISMATCH + S" WRONG NUMBER OF RESULTS: " ERROR + THEN ; + +: TESTING \ ( -- ) TALKING COMMENT. + SOURCE VERBOSE @ + IF DUP >R TYPE CR R> >IN ! + ELSE >IN ! DROP + THEN ; diff -r 4fa2bdb0c457 -r 2088fd998865 examples_forth/tetris.4 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples_forth/tetris.4 Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,374 @@ +\ +\ tetris.4th Tetris for terminals, redone in ANSI-Forth. +\ Written 05Apr94 by Dirk Uwe Zoller, e-mail: +\ duz@roxi.rz.fht-mannheim.de. +\ Look&feel stolen from Mike Taylor's "TETRIS FOR TERMINALS" +\ +\ Please copy and share this program, modify it for your system +\ and improve it as you like. But don't remove this notice. +\ +\ Thank you. +\ +\ Changes: +\ +\ + +ONLY FORTH DEFINITIONS +\ S" FORGET-TT" DROP 1 CHARS - FIND NIP [IF] FORGET-TT [THEN] +\ MARKER FORGET-TT + +DECIMAL + +WORDLIST CONSTANT TETRIS +GET-ORDER TETRIS DUP ROT 2 + SET-ORDER DEFINITIONS + + +\ Variables, constants + +BL BL 2CONSTANT EMPTY \ an empty position +VARIABLE WIPING \ if true: wipe brick, else draw brick +2 CONSTANT COL0 \ position of the pit on screen +0 CONSTANT ROW0 + +10 CONSTANT WIDE \ size of pit in brick positions +20 CONSTANT DEEP + +CHAR J VALUE LEFT-KEY \ customize if you don't like them +CHAR K VALUE ROT-KEY +CHAR L VALUE RIGHT-KEY +BL VALUE DROP-KEY +CHAR P VALUE PAUSE-KEY +12 VALUE REFRESH-KEY +CHAR Q VALUE QUIT-KEY + +VARIABLE SCORE +VARIABLE PIECES +VARIABLE LEVELS +VARIABLE DELAY + +VARIABLE BROW \ where the brick is +VARIABLE BCOL + + +\ stupid random number generator + +VARIABLE SEED + +: RANDOMIZE 0 ." Press any key." CR BEGIN 1+ KEY? UNTIL KEY DROP SEED ! ; + +: RANDOM \ max --- n ; return random number < max + SEED @ 1103515245 * 12345 + [ HEX ] 07FFF [ DECIMAL ] AND + DUP SEED ! SWAP MOD ; + + +\ Access pairs of characters in memory: + +: 2C@ DUP 1+ C@ SWAP C@ ; +: 2C! DUP >R C! R> 1+ C! ; + + +: <= > INVERT ; +: >= < INVERT ; +: D<> D= INVERT ; + + +\ Drawing primitives: + +: 2EMIT EMIT EMIT ; + +: POSITION \ row col --- ; cursor to the position in the pit + 2* COL0 + SWAP ROW0 + AT-XY ; + +: STONE \ c1 c2 --- ; draw or undraw these two characters + WIPING @ IF 2DROP 2 SPACES ELSE 2EMIT THEN ; + + +\ Define the pit where bricks fall into: + +: DEF-PIT CREATE WIDE DEEP * 2* ALLOT + DOES> ROT WIDE * ROT + 2* CHARS + ; + +DEF-PIT PIT + +: EMPTY-PIT DEEP 0 DO WIDE 0 DO EMPTY J I PIT 2C! + LOOP LOOP ; + + +\ Displaying: + +: DRAW-BOTTOM \ --- ; redraw the bottom of the pit + DEEP -1 POSITION + [CHAR] + DUP STONE + WIDE 0 DO [CHAR] = DUP STONE LOOP + [CHAR] + DUP STONE ; + +: DRAW-FRAME \ --- ; draw the border of the pit + DEEP 0 DO + I -1 POSITION [CHAR] | DUP STONE + I WIDE POSITION [CHAR] | DUP STONE + LOOP DRAW-BOTTOM ; + +: BOTTOM-MSG \ addr cnt --- ; output a message in the bottom of the pit + DEEP OVER 2/ WIDE SWAP - 2/ POSITION TYPE ; + +: DRAW-LINE \ line --- + DUP 0 POSITION WIDE 0 DO DUP I PIT 2C@ 2EMIT LOOP DROP ; + +: DRAW-PIT \ --- ; draw the contents of the pit + DEEP 0 DO I DRAW-LINE LOOP ; + +: SHOW-KEY \ char --- ; visualization of that character + DUP BL < + IF [CHAR] @ OR [CHAR] ^ EMIT EMIT SPACE + ELSE [CHAR] ` EMIT EMIT [CHAR] ' EMIT + THEN ; + +: SHOW-HELP \ --- ; display some explanations + 30 1 AT-XY ." ***** T E T R I S *****" + 30 2 AT-XY ." =======================" + 30 4 AT-XY ." Use keys:" + 32 5 AT-XY LEFT-KEY SHOW-KEY ." Move left" + 32 6 AT-XY ROT-KEY SHOW-KEY ." Rotate" + 32 7 AT-XY RIGHT-KEY SHOW-KEY ." Move right" + 32 8 AT-XY DROP-KEY SHOW-KEY ." Drop" + 32 9 AT-XY PAUSE-KEY SHOW-KEY ." Pause" + 32 10 AT-XY REFRESH-KEY SHOW-KEY ." Refresh" + 32 11 AT-XY QUIT-KEY SHOW-KEY ." Quit" + 32 13 AT-XY ." -> " + 30 16 AT-XY ." Score:" + 30 17 AT-XY ." Pieces:" + 30 18 AT-XY ." Levels:" + 0 22 AT-XY ." ======= This program was written 1994 in ANS Forth by Dirk Uwe Zoller ========" + 0 23 AT-XY ." =================== Copy it, port it, play it, enjoy it! =====================" ; + +: UPDATE-SCORE \ --- ; display current score + 38 16 AT-XY SCORE @ 3 .R + 38 17 AT-XY PIECES @ 3 .R + 38 18 AT-XY LEVELS @ 3 .R ; + +: REFRESH \ --- ; redraw everything on screen + PAGE DRAW-FRAME DRAW-PIT SHOW-HELP UPDATE-SCORE ; + + +\ Define shapes of bricks: + +: DEF-BRICK CREATE 4 0 DO + ' EXECUTE 0 DO DUP I CHARS + C@ C, LOOP DROP + REFILL DROP + LOOP + DOES> ROT 4 * ROT + 2* CHARS + ; + +DEF-BRICK BRICK1 S" " + S" ###### " + S" ## " + S" " + +DEF-BRICK BRICK2 S" " + S" <><><><>" + S" " + S" " + +DEF-BRICK BRICK3 S" " + S" {}{}{}" + S" {} " + S" " + +DEF-BRICK BRICK4 S" " + S" ()()() " + S" () " + S" " + +DEF-BRICK BRICK5 S" " + S" [][] " + S" [][] " + S" " + +DEF-BRICK BRICK6 S" " + S" @@@@ " + S" @@@@ " + S" " + +DEF-BRICK BRICK7 S" " + S" %%%% " + S" %%%% " + S" " + +\ this brick is actually in use: + +DEF-BRICK BRICK S" " + S" " + S" " + S" " + +DEF-BRICK SCRATCH S" " + S" " + S" " + S" " + +CREATE BRICKS ' BRICK1 , ' BRICK2 , ' BRICK3 , ' BRICK4 , + ' BRICK5 , ' BRICK6 , ' BRICK7 , + +CREATE BRICK-VAL 1 C, 2 C, 3 C, 3 C, 4 C, 5 C, 5 C, + + +: IS-BRICK \ brick --- ; activate a shape of brick + >BODY ['] BRICK >BODY 32 CMOVE ; + +: NEW-BRICK \ --- ; select a new brick by random, count it + 1 PIECES +! 7 RANDOM + BRICKS OVER CELLS + @ IS-BRICK + BRICK-VAL SWAP CHARS + C@ SCORE +! ; + +: ROTLEFT 4 0 DO 4 0 DO + J I BRICK 2C@ 3 I - J SCRATCH 2C! + LOOP LOOP + ['] SCRATCH IS-BRICK ; + +: ROTRIGHT 4 0 DO 4 0 DO + J I BRICK 2C@ I 3 J - SCRATCH 2C! + LOOP LOOP + ['] SCRATCH IS-BRICK ; + +: DRAW-BRICK \ row col --- + 4 0 DO 4 0 DO + J I BRICK 2C@ EMPTY D<> + IF OVER J + OVER I + POSITION + J I BRICK 2C@ STONE + THEN + LOOP LOOP 2DROP ; + +: SHOW-BRICK FALSE WIPING ! DRAW-BRICK ; +: HIDE-BRICK TRUE WIPING ! DRAW-BRICK ; + +: PUT-BRICK \ row col --- ; put the brick into the pit + 4 0 DO 4 0 DO + J I BRICK 2C@ EMPTY D<> + IF OVER J + OVER I + PIT + J I BRICK 2C@ ROT 2C! + THEN + LOOP LOOP 2DROP ; + +: REMOVE-BRICK \ row col --- ; remove the brick from that position + 4 0 DO 4 0 DO + J I BRICK 2C@ EMPTY D<> + IF OVER J + OVER I + PIT EMPTY ROT 2C! THEN + LOOP LOOP 2DROP ; + +: TEST-BRICK \ row col --- flag ; could the brick be there? + 4 0 DO 4 0 DO + J I BRICK 2C@ EMPTY D<> + IF OVER J + OVER I + + OVER DUP 0< SWAP DEEP >= OR + OVER DUP 0< SWAP WIDE >= OR + 2SWAP PIT 2C@ EMPTY D<> + OR OR IF UNLOOP UNLOOP 2DROP FALSE EXIT THEN + THEN + LOOP LOOP 2DROP TRUE ; + +: MOVE-BRICK \ rows cols --- flag ; try to move the brick + BROW @ BCOL @ REMOVE-BRICK + SWAP BROW @ + SWAP BCOL @ + 2DUP TEST-BRICK + IF BROW @ BCOL @ HIDE-BRICK + 2DUP BCOL ! BROW ! 2DUP SHOW-BRICK PUT-BRICK TRUE + ELSE 2DROP BROW @ BCOL @ PUT-BRICK FALSE + THEN ; + +: ROTATE-BRICK \ flag --- flag ; left/right, success + BROW @ BCOL @ REMOVE-BRICK + DUP IF ROTRIGHT ELSE ROTLEFT THEN + BROW @ BCOL @ TEST-BRICK + OVER IF ROTLEFT ELSE ROTRIGHT THEN + IF BROW @ BCOL @ HIDE-BRICK + IF ROTRIGHT ELSE ROTLEFT THEN + BROW @ BCOL @ PUT-BRICK + BROW @ BCOL @ SHOW-BRICK TRUE + ELSE DROP FALSE THEN ; + +: INSERT-BRICK \ row col --- flag ; introduce a new brick + 2DUP TEST-BRICK + IF 2DUP BCOL ! BROW ! + 2DUP PUT-BRICK DRAW-BRICK TRUE + ELSE 2DROP FALSE THEN ; + +: DROP-BRICK \ --- ; move brick down fast + BEGIN 1 0 MOVE-BRICK 0= UNTIL ; + +: MOVE-LINE \ from to --- + OVER 0 PIT OVER 0 PIT WIDE 2* CMOVE DRAW-LINE + DUP 0 PIT WIDE 2* BLANK DRAW-LINE ; + +: LINE-FULL \ line-no --- flag + TRUE WIDE 0 + DO OVER I PIT 2C@ EMPTY D= + IF DROP FALSE LEAVE THEN + LOOP NIP ; + +: REMOVE-LINES \ --- + DEEP DEEP + BEGIN + SWAP + BEGIN 1- DUP 0< IF 2DROP EXIT THEN DUP LINE-FULL + WHILE 1 LEVELS +! 10 SCORE +! REPEAT + SWAP 1- + 2DUP <> IF 2DUP MOVE-LINE THEN + AGAIN ; + +: TO-UPPER \ char --- char ; convert to upper case + DUP [CHAR] a >= OVER [CHAR] z <= AND + IF [ CHAR A CHAR a - ] LITERAL + THEN ; + +: DISPATCH \ key --- flag + CASE TO-UPPER + LEFT-KEY OF 0 -1 MOVE-BRICK DROP ENDOF + RIGHT-KEY OF 0 1 MOVE-BRICK DROP ENDOF + ROT-KEY OF 0 ROTATE-BRICK DROP ENDOF + DROP-KEY OF DROP-BRICK ENDOF + PAUSE-KEY OF S" Paused " BOTTOM-MSG KEY DROP + DRAW-BOTTOM ENDOF + REFRESH-KEY OF REFRESH ENDOF + QUIT-KEY OF FALSE EXIT ENDOF + ENDCASE TRUE ; + +: INITIALIZE \ --- ; prepare for playing + RANDOMIZE EMPTY-PIT REFRESH + 0 SCORE ! 0 PIECES ! 0 LEVELS ! 100 DELAY ! ; + +: ADJUST-DELAY \ --- ; make it faster with increasing score + LEVELS @ + DUP 50 < IF 100 OVER - ELSE + DUP 100 < IF 62 OVER 4 / - ELSE + DUP 500 < IF 31 OVER 16 / - ELSE 0 THEN THEN THEN + DELAY ! DROP ; + +: PLAY-GAME \ --- ; play one tetris game + BEGIN + NEW-BRICK + -1 3 INSERT-BRICK + WHILE + BEGIN 4 0 + DO 35 13 AT-XY + DELAY @ MS KEY? + IF BEGIN KEY KEY? WHILE DROP REPEAT + DISPATCH 0= + IF UNLOOP EXIT THEN + THEN + LOOP + 1 0 MOVE-BRICK 0= + UNTIL + REMOVE-LINES + UPDATE-SCORE + ADJUST-DELAY + REPEAT ; + +FORTH DEFINITIONS + +: TT \ --- ; play the tetris game + INITIALIZE + S" Press any key " BOTTOM-MSG KEY DROP DRAW-BOTTOM + BEGIN + PLAY-GAME + S" Again? " BOTTOM-MSG KEY TO-UPPER [CHAR] Y = + WHILE INITIALIZE REPEAT + 0 23 AT-XY CR ; + +ONLY FORTH ALSO DEFINITIONS diff -r 4fa2bdb0c457 -r 2088fd998865 io.c --- a/io.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,421 +0,0 @@ -/* 6808 Simulator V092 - created 1993,1994 by L.C. Benschop. copyleft (c) 1994-2014 -by the sbc09 team, see AUTHORS for more details. license: GNU -General Public License version 2, see LICENSE for more details. - - This program simulates a 6809 processor. - - System dependencies: short must be 16 bits. - char must be 8 bits. - long must be more than 16 bits. - arrays up to 65536 bytes must be supported. - machine must be twos complement. - Most Unix machines will work. For MSODS you need long pointers - and you may have to malloc() the mem array of 65536 bytes. - - Define BIG_ENDIAN if you have a big-endian machine (680x0 etc) - - Special instructions: - SWI2 writes char to stdout from register B. - SWI3 reads char from stdout to register B, sets carry at EOF. - (or when no key available when using term control). - SWI retains its normal function. - CWAI and SYNC stop simulator. - -*/ - -#include -#include -#include -#include -#include - -#include -#include -#include -#include - -#ifdef USE_TERMIOS -#include -#endif - -#define engine extern -#include "v09.h" - -/* - * IO Map ( can be overrupped by ROM ) - * - * In do_input/do_output call, we cannot access 6809 registers, since it is in i*reg, - * which is a local variable of interpr - * - * IOPAGE ~ IOPAGE+0x7f - * for OS9 level2 - * IOPAGE 0xff80 means ioport beging 0xff80 but IOPAGE itself starts 0xff00 - * 0xfe00-0xff7f, 0xffe0-0xffff can be used as RAM in fixed area in level2 - * and these are ROM in level1 - * - * - * IOPAGE + 0x00 ACIA control - * IOPAGE + 0x01 ACIA data - * - * IOPAGE + 0x11 MMU Taskreg 0 system map, 1 user map - * IOPAGE + 0x20-0x27 MMU reg system map - * IOPAGE + 0x28-0x2f MMU reg user map - * - * on reset tr==0 and only IOPAGE is valid - * translatation occur only on non-IOPAGE - * mem == phymem + 0x70000 - * phy addr = phymem[ ( mmu[ adr >> 13 ] <<13 ) + (adr & 0x1fff ) ] - * tr=0 mmu=IOPAGE+0xa0 - * tr=1 mmu=IOPAGE+0xa8 - * - * IOPAGE + 0x30 Timer control 0x8f start timer/0x80 stop timer/0x04 update date - * read 0x10 bit menas timer - * IOPAGE + 0x31- YY/MM/DD/HH/MM/SS - * - * IOPAGE + 0x40 Disk control 0x81 read/0x55 write 0 ... ok / 0xff .. error - * 0xd1- VDISK command - * IOPAGE + 0x41 drive no / VDISK drv - * IOPAGE + 0x42 LSN2 / VDISK sysmode 0 for system, 1 for user - * IOPAGE + 0x43 LSN1 - * IOPAGE + 0x44 LSN0 / VDISK Curdir pd number - * IOPAGE + 0x45 ADR2 / VDISK caller stack - * IOPAGE + 0x46 ADR1 - * IOPAGE + 0x47 / VDISK path descriptor address (Y) - * IOPAGE + 0x48 - * - * - */ - -#define SECSIZE 256 - - -int timer = 1; -int timer_usec = 20000; // 50Hz -struct termios termsetting; -struct termios newterm; -struct itimerval timercontrol; - -int tflags; -int xmstat; /* 0= no XMODEM transfer, 1=send, 2=receiver */ -unsigned char xmbuf[132]; -int xidx; -int acknak; -int rcvdnak; -int blocknum; -int timer_irq = 2 ; // 2 = FIRQ, 1 = IRQ - -FILE *infile; -FILE *xfile; -FILE *logfile; -FILE *disk[] = {0,0}; - -#ifdef USE_VDISK -extern void do_vdisk(int c); -#endif - - -#ifdef USE_MMU -extern char *prog ; // for disass -extern Byte * mem0(Byte *iphymem, Word adr, Byte *immu) ; -#define pmem(a) mem0(phymem,a,mmu) -#else -#define pmem(a) (&mem[a]) -#endif - - -extern int bpskip ; -extern int stkskip ; -extern FILE *logfile; - -void do_timer(int,int); -void do_disk(int,int); -void do_mmu(int,int); - -int char_input(void) { - int c, w, sum; - if (!xmstat) { - if (infile) { - c = getc(infile); - if (c == EOF) { - fclose(infile); - infile = 0; - return char_input(); - } - if (c == '\n') - c = '\r'; - return c; - } else { - usleep(100); - return getchar(); - } - } else if (xmstat == 1) { - if (xidx) { - c = xmbuf[xidx++]; - if (xidx == 132) { - xidx = 0; - rcvdnak = EOF; - acknak = 6; - } - } else { - if ((acknak == 21 && rcvdnak == 21) || (acknak == 6 && rcvdnak == 6)) { - rcvdnak = 0; - memset(xmbuf, 0, 132); - w = fread(xmbuf + 3, 1, 128, xfile); - if (w) { - printf("Block %3d transmitted, ", blocknum); - xmbuf[0] = 1; - xmbuf[1] = blocknum; - xmbuf[2] = 255 - blocknum; - blocknum = (blocknum + 1) & 255; - sum = 0; - for (w = 3; w < 131; w++) - sum = (sum + xmbuf[w]) & 255; - xmbuf[131] = sum; - acknak = 6; - c = 1; - xidx = 1; - } else { - printf("EOT transmitted, "); - acknak = 4; - c = 4; - } - } else if (rcvdnak == 21) { - rcvdnak = 0; - printf("Block %3d retransmitted, ", xmbuf[1]); - c = xmbuf[xidx++]; /*retransmit the same block */ - } else - c = EOF; - } - return c; - } else { - if (acknak == 4) { - c = 6; - acknak = 0; - fclose(xfile); - xfile = 0; - xmstat = 0; - } else if (acknak) { - c = acknak; - acknak = 0; - } else - c = EOF; - if (c == 6) - printf("ACK\n"); - if (c == 21) - printf("NAK\n"); - return c; - } -} - -int do_input(int a) { - static int c, f = EOF; - if (a == 0+(IOPAGE&0x1ff)) { - if (f == EOF) - f = char_input(); - if (f != EOF) { - c = f; - mem[(IOPAGE&0xfe00) + a] = c; - } - mem[(IOPAGE&0xfe00) + a] = c = 2 + (f != EOF); - return c; - } else if (a == 1+(IOPAGE&0x1ff)) { /*data port*/ - if (f == EOF) - f = char_input(); - if (f != EOF) { - c = f; - f = EOF; - mem[(IOPAGE&0xfe00) + a] = c; - } - return c; - } - return mem[(IOPAGE&0xfe00) + a]; -} - -void do_output(int a, int c) { - int i, sum; - if (a == 1+(IOPAGE&0x1ff)) { /* ACIA data port,ignore address */ - if (!xmstat) { - if (logfile && c != 127 && (c >= ' ' || c == '\n')) - putc(c, logfile); - putchar(c); - fflush(stdout); - } else if (xmstat == 1) { - rcvdnak = c; - if (c == 6 && acknak == 4) { - fclose(xfile); - xfile = 0; - xmstat = 0; - } - if (c == 6) - printf("ACK\n"); - if (c == 21) - printf("NAK\n"); - if (c == 24) { - printf("CAN\n"); - fclose(xfile); - xmstat = 0; - xfile = 0; - } - } else { - if (xidx == 0 && c == 4) { - acknak = 4; - printf("EOT received, "); - } - xmbuf[xidx++] = c; - if (xidx == 132) { - sum = 0; - for (i = 3; i < 131; i++) - sum = (sum + xmbuf[i]) & 255; - if (xmbuf[0] == 1 && xmbuf[1] == 255 - xmbuf[2] - && sum == xmbuf[131]) - acknak = 6; - else - acknak = 21; - printf("Block %3d received, ", xmbuf[1]); - if (blocknum == xmbuf[1]) { - blocknum = (blocknum + 1) & 255; - fwrite(xmbuf + 3, 1, 128, xfile); - } - xidx = 0; - } - } - } else if (a >= 0x40+(IOPAGE&0x1ff)) { /* disk */ - do_disk(a,c); - } else if (a >= 0x30+(IOPAGE&0x1ff)) { /* timer */ - do_timer(a,c); - } else if (a >= 0x10+(IOPAGE&0x1ff)) { /* mmu */ - do_mmu(a,c); -#ifdef USE_MMU - } else { /* fixed ram */ - mem[ a + 0xfe00 ] = c; -#endif - } -} - - -void do_timer(int a, int c) { - struct itimerval timercontrol; - if (a==0x30+(IOPAGE&0x1ff) && c==0x8f) { - timercontrol.it_interval.tv_sec = 0; - timercontrol.it_interval.tv_usec = timer_usec; - timercontrol.it_value.tv_sec = 0; - timercontrol.it_value.tv_usec = timer_usec; - timer_irq = 1; - setitimer(ITIMER_REAL, &timercontrol, NULL); - mem[(IOPAGE&0xfe00)+a]=c; - } else if (a==0x30+(IOPAGE&0x1ff) && c==0x80) { - timercontrol.it_interval.tv_sec = 0; - timercontrol.it_interval.tv_usec = 0; - setitimer(ITIMER_REAL, &timercontrol, NULL); - mem[(IOPAGE&0xfe00)+a]=c; - } else if (a==0x30+(IOPAGE&0x1ff) && c==0x04) { - time_t tm = time(0); - struct tm *t = localtime(&tm); - mem[IOPAGE+0x31] = t->tm_year; - mem[IOPAGE+0x32] = t->tm_mon+1; - mem[IOPAGE+0x33] = t->tm_mday; - mem[IOPAGE+0x34] = t->tm_hour; - mem[IOPAGE+0x35] = t->tm_min; - mem[IOPAGE+0x36] = t->tm_sec; - } else { - mem[(IOPAGE&0xfe00)+a]=c; - } -} - - -void do_disk(int a, int c) { - if (a!=0x40+(IOPAGE&0x1ff)) { - mem[(IOPAGE&0xfe00)+a]=c; - return; - } - int drv = mem[IOPAGE+0x41]; - int lsn = (mem[IOPAGE+0x42]<<16) + (mem[IOPAGE+0x43]<<8) + mem[IOPAGE+0x44]; - int buf = (mem[IOPAGE+0x45]<<8) + mem[IOPAGE+0x46]; - Byte *phy = pmem(buf); - if (c==0x81) { - if (drv > 1 || disk[drv]==0) goto error; - if (lseek(fileno(disk[drv]),lsn*SECSIZE,SEEK_SET)==-1) goto error; - if (read(fileno(disk[drv]),phy,SECSIZE)==-1) goto error; - } else if (c==0x55) { - if (drv > 1 || disk[drv]==0) goto error; - if (lseek(fileno(disk[drv]),lsn*SECSIZE,SEEK_SET)==-1) goto error; - if (write(fileno(disk[drv]),phy,SECSIZE)==-1) goto error; -#ifdef USE_VDISK - } else { - do_vdisk(c); - return; -#endif - } - mem[IOPAGE+0x40] = 0; - return; -error : - mem[IOPAGE+0x40] = 0xff; -} - -void do_mmu(int a, int c) -{ -#ifdef USE_MMU - - if (a==0x11+(IOPAGE&0x1ff)) { - if (c&1) { - mmu = &mem[0xffa8]; - } else { - mmu = &mem[0xffa0]; - } - } - mem[(IOPAGE&0xfe00)+a] = c; // other register such as 0xffa0-0xffaf -#endif -} - -void timehandler(int sig) { - attention = 1; - irq = timerirq; - mem[IOPAGE+0x30] |= 0x10 ; - // signal(SIGALRM, timehandler); -} - -void handler(int sig) { - escape = 1; - attention = 1; - bpskip = 0; - stkskip = 0; -} - -void init_term(void) { - tcgetattr(0, &termsetting); - tflags = fcntl(0, F_GETFL, 0); -} - -void set_term(char c) { - signal(SIGQUIT, SIG_IGN); - signal(SIGTSTP, SIG_IGN); - signal(SIGINT, handler); - signal(SIGUSR1, handler); - newterm = termsetting; - newterm.c_iflag = newterm.c_iflag & ~INLCR & ~ICRNL; - newterm.c_lflag = newterm.c_lflag & ~ECHO & ~ICANON; - newterm.c_cc[VTIME] = 0; - newterm.c_cc[VMIN] = 1; - newterm.c_cc[VINTR] = escchar; - tcsetattr(0, TCSAFLUSH, &newterm); - fcntl(0, F_SETFL, tflags | O_NDELAY); /* Make input from stdin non-blocking */ - signal(SIGALRM, timehandler); - timercontrol.it_interval.tv_sec = 0; - timercontrol.it_interval.tv_usec = timer_usec; - timercontrol.it_value.tv_sec = 0; - timercontrol.it_value.tv_usec = timer_usec; - if (timer) - setitimer(ITIMER_REAL, &timercontrol, NULL); -} - -void restore_term(void) { - termsetting.c_iflag = termsetting.c_iflag | INLCR | ICRNL; - tcsetattr(0, TCSAFLUSH, &termsetting); - fcntl(0, F_SETFL, tflags); - signal(SIGALRM, SIG_IGN); -} - - - - diff -r 4fa2bdb0c457 -r 2088fd998865 makerom.c --- a/makerom.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,78 +0,0 @@ -/* makerom.c - Read standard input as S-records and build ROM image file v09.rom - ROM starts at 0x8000 and is 32K. -*/ - -#include -#include -#include - -static int sum,charindex; -unsigned char mem[0x8000]; -char linebuf[130]; - -void -hexerr() -{ - fprintf(stderr,"Illegal character in hex number\n"); - exit(1); -} - -int gethex() -{ - int c; - c=linebuf[charindex++]; - if(c<'0')hexerr(); - if(c>'9') { if(c<'A')hexerr();else c-=7; } - c-='0'; - return c; -} - -int getbyte() -{ - int b; - b=gethex(); - b=b*16+gethex(); - sum=(sum+b)&0xff; - return b; -} - -int -main() -{ - FILE *romfile; - unsigned int i,length,addr; - for(i=0;i<0x8000;i++)mem[i]=0xff; /*set unused locations to FF */ - for(;;) { - if(fgets(linebuf,128,stdin)==NULL)break; - if(strlen(linebuf))linebuf[strlen(linebuf)]=0; - if(linebuf[0]=='S'&&linebuf[1]=='1') { - sum=0;charindex=2; - length=getbyte(); - if(length<3) { - fprintf(stderr,"Illegal length in data record\n"); - exit(1); - } - addr=getbyte(); - addr=(addr<<8)+getbyte(); - if((long)addr+length-3>0x10000||addr<0x8000) { - fprintf(stderr,"Address 0x%x out of range\n",addr); - exit(1); - } - for(i=0;i!=length-3;i++)mem[addr-0x8000+i]=getbyte(); - getbyte(); - if(sum!=0xff) { - fprintf(stderr,"Checksum error\n"); - exit(1); - } - } - } - romfile=fopen("v09.rom","wb"); - if(!romfile) { - fprintf(stderr,"Cannot create file v09.rom\n"); - exit(1); - } - fwrite(mem,0x8000,1,romfile); - fclose(romfile); - exit(0); -} diff -r 4fa2bdb0c457 -r 2088fd998865 mon2.asm --- a/mon2.asm Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3080 +0,0 @@ - ;Buggy machine language monitor and rudimentary O.S. version 1.0 - -* Memory map of SBC -* $0-$40 Zero page variables reserved by monitor and O.S. -* $40-$FF Zero page portion for user programs. -* $100-$17F Xmodem buffer 0, terminal input buffer, -* $180-$1FF Xmodem buffer 1, terminal output buffer. -* $200-$27F Terminal input line. -* $280-$2FF Variables reserved by monitor and O.S. -* $300-$400 System stack. -* $400-$7FFF RAM for user programs and data. -* $8000-$DFFF PROM for user programs. -* $E000-$E1FF I/O addresses. -* $E200-$E3FF Reserved. -* $E400-$FFFF Monitor ROM - -* Reserved Zero page addresses - org $0000 -* First the I/O routine vectors. -getchar rmb 3 ;Jump to getchar routine. -putchar rmb 3 ;Jump to putchar routine. -getline rmb 3 ;Jump to getline routine. -putline rmb 3 ;Jump to putline routine. -putcr rmb 3 ;Jump to putcr routine. -getpoll rmb 3 ;Jump to getpoll routine. -xopenin rmb 3 ;Jump to xopenin routine. -xopenout rmb 3 ;Jump to xopenout routine. -xabortin rmb 3 ;Jump to xabortin routine. -xclosein rmb 3 ;Jump to xclosein routine. -xcloseout rmb 3 ;Jump to xcloseout routine. -delay rmb 3 ;Jump to delay routine. - -*Next the system variables in the zero page. -temp rmb 2 ;hex scanning/disasm -temp2 rmb 2 ;Hex scanning/disasm -temp3 rmb 2 ;Used in Srecords, H command -timer rmb 3 ;3 byte timer, incremented every 20ms -xpacknum rmb 1 ;Packet number for XMODEM block, -xsum rmb 1 ;XMODEM checksum -lastok rmb 1 ;flag to indicate last block was OK -xcount rmb 1 ;Count of characters in buffer. -xmode rmb 1 ;XMODEM mode, 0 none, 1 out, 2 in. -disflg rmb 1 - -* I/O buffers. -buflen equ 128 ;Length of input line buffer. - org $100 -buf0 rmb 128 ;Xmodem buffer 0, serial input buffer. -buf1 rmb 128 ;Xmodem buffer 1, serial output buffer. -linebuf rmb buflen ;Input line buffer. - - -* Interrupt vectors (start at $280) -* All interrupts except RESET are vectored through jumps. -* FIRQ is timer interrupt, IRQ is ACIA interrupt. -swi3vec rmb 3 -swi2vec rmb 3 -firqvec rmb 3 -irqvec rmb 3 -swivec rmb 3 -nmivec rmb 3 -xerrvec rmb 3 ;Error handler for XMODEM error. -exprvec rmb 3 ;Expression evaluator in assembler. -asmerrvec rmb 3 ;Error handler for assembler errors. -pseudovec rmb 3 ;Vector for asm pseudo instructions. - -* Next the non zero page system variables. -oldpc rmb 2 ;Saved pc value for J command. -addr rmb 2 ;Address parameter. -length rmb 2 ;Length parameter. - -brkpoints equ 8 ;Number of settable breakpoints. -bpaddr rmb brkpoints*3 ;Address and byte for each break point. -stepbp rmb 3 ;Address of P command break point. - -sorg rmb 2 ;Origin address of S record entry. -soffs rmb 2 ;Offset load adrr-addr in record - -oldgetc rmb 2 ;Old getchar address. -oldputc rmb 2 ;Old putchar address. -oldputcr rmb 2 ;Old putcr address. -lastterm rmb 1 ;Last terminating character. -filler rmb 1 ;Filler at end of XMODEM file. -xmcr rmb 1 ;end-of-line characters for XMODEM send. -savesp rmb 2 ;Save sp to restore it on error. -nxtadd rmb 2 - -* Following variables are used by assembler/disassembler. -prebyte rmb 1 -opc1 rmb 1 -opcode rmb 1 -postbyte rmb 1 -amode rmb 1 -operand rmb 2 -mnembuf rmb 5 ;Buffer to store capitalized mnemonic. -opsize rmb 1 ;SIze (in bytes) of extra oeprand (0--2) -uncert rmb 1 ;Flag to indicate that op is unknown. -dpsetting rmb 2 - -endvars equ * - -ramstart equ $400 ;first free RAM address. - -ramtop equ $8000 ;top of RAM. - -* I/O port addresses -aciactl equ $e000 ;Control port of ACIA -aciasta equ $e000 ;Status port of ACIA -aciadat equ $e001 ;Data port of ACIA - -* ASCII control characters. -SOH equ 1 -EOT equ 4 -ACK equ 6 -BS equ 8 -TAB equ 9 -LF equ 10 -CR equ 13 -NAK equ 21 -CAN equ 24 -DEL equ 127 - -CASEMASK equ $DF ;Mask to make lowercase into uppercase. - -* Monitor ROM starts here. - org $E400 - -reset orcc #$FF ;Disable interrupts. - clra - tfr a,dp ;Set direct page register to 0. - clr disflg - lds #ramstart - ldx #intvectbl - ldu #swi3vec - ldb #osvectbl-intvectbl - bsr blockmove ;Initialize interrupt vectors from ROM. - ldx #osvectbl - ldu #0 - ldb #endvecs-osvectbl - bsr blockmove ;Initialize I/O vectors from ROM. - bsr initacia ;Initialize serial port. - andcc #$0 ;Enable interrupts -* Put the 'saved' registers of the program being monitored on top of the -* stack. There are 12 bytes on the stack for cc,b,a,dp,x,y,u and pc -* pc is initialized to $400, the rest to zero. - ldx #0 - tfr x,y - ldu #ramstart - pshs x,u - pshs x,y - pshs x,y - ldx #oldpc - ldb #endvars-oldpc -clvar clr ,x+ - decb - bne clvar ;Clear the variable area. - ldd #$1A03 - std filler ;Set XMODEM filler and end-of-line. - ldx #welcome - jsr outcount - jsr putcr ;Print a welcome message. - jmp cmdline -* Block move routine, from X to U length B. Modifies them all and A. -blockmove lda ,x+ - sta ,u+ - decb - bne blockmove - rts - -* Initialize serial communications port, buffers, interrupts. -initacia ldb #$03 - stb aciactl - ldb #%00110101 - rts - -* O.S. routine to read a character into B register. -osgetc ldb aciasta - bitb #$01 - beq osgetc - ldb aciadat - rts - -;O.S. rotuine to check if there is a character ready to be read. -osgetpoll ldb aciasta - bitb #$01 - bne poltrue - clrb - rts -poltrue ldb #$ff - rts - -* O.S. routine to write the character in the B register. -osputc pshs a -putcloop lda aciasta - bita #$02 - beq putcloop - stb aciadat - puls a - rts - -* O.S. routine to read a line into memory at address X, at most B chars -* long, return actual length in B. Permit backspace editing. -osgetl pshs a,x - stb temp - clra -osgetl1 jsr getchar - andb #$7F - cmpb #BS - beq backsp - cmpb #DEL - bne osgetl2 -backsp tsta ;Recognize BS and DEL as backspace key. - beq osgetl1 ;ignore if line already zero length. - ldb #BS - jsr putchar - ldb #' ' - jsr putchar - ldb #BS ;Send BS,space,BS. This erases last - jsr putchar ;character on most terminals. - leax -1,x ;Decrement address. - deca - bra osgetl1 -osgetl2 cmpb #CR - beq newline - cmpb #LF - bne osgetl3 ;CR or LF character ends line. - ldb lastterm - cmpb #CR - beq osgetl1 ;Ignore LF if it comes after CR - ldb #LF -newline stb lastterm - jsr putcr - tfr a,b ;Move length to B - puls a,x ;restore registers. - rts ;<--- Here is the exit point. -osgetl3 cmpb #TAB - beq dotab - cmpb #' ' - blo osgetl1 ;Ignore control characters. - cmpa temp - beq osgetl1 ;Ignore char if line full. - jsr putchar ;Echo the character. - stb ,x+ ;Store it in memory. - inca - bra osgetl1 -dotab ldb #' ' - cmpa temp - beq osgetl1 - jsr putchar - stb ,x+ - inca - bita #7 ;Insert spaces until length mod 8=0 - bne dotab - bra osgetl1 - -* O.S. routine to write a line starting at address X, B chars long. -osputl pshs a,b,x - tfr b,a - tsta - beq osputl1 -osputl2 ldb ,x+ - jsr putchar - deca - bne osputl2 -osputl1 puls a,b,x - rts - -* O.S. routine to terminate a line. -oscr pshs b - ldb #CR - jsr putchar - ldb #LF - jsr putchar ;Send the CR and LF characters. - puls b - rts - -* Output a counted string at addr X -outcount pshs x,b - ldb ,x+ - jsr putline - puls x,b - rts - -timerirq inc timer+2 - bne endirq - inc timer+1 - bne endirq - inc timer - rti -aciairq nop -endirq rti - -* Wait D times 20ms. -osdly addd timer+1 -dlyloop cmpd timer+1 - bne dlyloop - rts - -* This table will be copied to the interrupt vector area in RAM. -intvectbl jmp endirq - jmp endirq - jmp timerirq - jmp aciairq - jmp unlaunch - jmp endirq - jmp xerrhand - jmp expr - jmp asmerrvec - jmp pseudo -* And this one to the I/O vector table. -osvectbl jmp osgetc - jmp osputc - jmp osgetl - jmp osputl - jmp oscr - jmp osgetpoll - jmp xopin - jmp xopout - jmp xabtin - jmp xclsin - jmp xclsout - jmp osdly -endvecs equ * - -* The J command returns here. -stakregs pshs x ;Stack something where the pc comes - pshs ccr,b,a,dp,x,y,u ;Stack the normal registers. - ldx oldpc - stx 10,s ;Stack the old pc value. - bra unlaunch1 -* The G and P commands return here through a breakpoint. -* Registers are already stacked. -unlaunch ldd 10,s - subd #1 - std 10,s ;Decrement pc before breakpoint -unlaunch1 andcc #$0 ;reenable the interrupts. - jsr disarm ;Disarm the breakpoints. - jsr dispregs -cmdline jsr xcloseout - sts savesp - ldb #'.' - jsr putchar - ldx #linebuf - ldb #buflen - jsr getline - tstb - beq cmdline ;Ignore line if it is empty - abx - clr ,x ;Make location after line zero. - ldx #linebuf - ldb ,x+ - andb #CASEMASK ;Make 1st char uppercase. - subb #'A' - bcs unk - cmpb #26 - bcc unk ;Unknown cmd if it is not a letter. - ldx #cmdtab - aslb ;Index into command table. - jmp [b,x] - -cmdtab fdb asm,break,calc,dump - fdb enter,find,go,help - fdb inp,jump,unk,unk - fdb move,unk,unk,prog - fdb unk,regs,srec,trace - fdb unasm,unk,unk,xmodem - fdb unk,unk - -* Unknown command handling routine. -unk jsr xabortin - ldx #unknown - jsr outcount - jsr putcr - jmp cmdline - -help ldx #mhelp ;Print a help message. -help1 ldb ,x+ - beq endhlp - lbsr osputc - bra help1 -endhlp jmp cmdline -mhelp fcb CR,LF - fcc 'Commands list' - fcb CR,LF - - fcc '-------------' - fcb CR,LF - - fcc 'Asm ' - fcc '{Aaddr}' - fcb CR,LF - - fcc 'Unasm ' - fcc '{U or Uaddr or Uaddr,length}' - fcb CR,LF - - fcc 'Dump ' - fcc '{D or D or D,}' - fcb CR,LF - - fcc 'Enter ' - fcc '{E or E or E or Estring}' - fcb CR,LF - - fcc 'Break ' - fcc '{B or B. B displays, B sets or clears breakpoint}' - fcb CR,LF - - fcc 'Find ' - fcb "{Faddr bytes or Faddr",34,"ascii",34,"}" - fcb CR,LF - - fcc 'Go ' - fcc '{G or G}' - fcb CR,LF - - fcc 'Calc ' - fcc '{Chexnum{+|-hexnum}}' - fcb CR,LF - - fcc 'Inp ' - fcc '{Iaddr}' - fcb CR,LF - - fcc 'Jump ' - fcc '{J}' - fcb CR,LF - - fcc 'Move ' - fcc '{M,,}' - fcb CR,LF - - fcc 'Prog ' - fcc '{P}' - fcb CR,LF - - fcc 'Regs ' - fcc '{R or R}' - fcb CR,LF - - fcc 'Srec ' - fcc '{SO or SS, or S1 or S9}' - fcb CR,LF - - fcc 'Trace ' - fcc '{T}' - fcb CR,LF - - fcc 'Xmodem ' - fcc '{XSaddr,len XLaddr,len XX XOcrlf,filler, XSSaddr,len}' - fcb CR,LF - - fcc 'Help ' - fcc '{H}' - fcb CR,LF,0 - - - -* Here are some useful messages. -welcome fcb unknown-welcome-1 - fcc "Welcome to BUGGY version 1.0" -unknown fcb brkmsg-unknown-1 - fcc "Unknown command" -brkmsg fcb clrmsg-brkmsg-1 - fcc "Breakpoint set" -clrmsg fcb fullmsg-clrmsg-1 - fcc "Breakpoint cleared" -fullmsg fcb smsg-fullmsg-1 - fcc "Breakpoints full" -smsg fcb lastrec-smsg-1 - fcc "Error in S record" -lastrec fcb xsmsg-lastrec-1 - fcc "S9030000FC" -xsmsg fcb xrmsg-xsmsg-1 - fcc "Start XMODEM Send" -xrmsg fcb xamsg-xrmsg-1 - fcc "Start XMODEM Receive" -xamsg fcb invmmsg-xamsg-1 - fcc "XMODEM transfer aborted" -invmmsg fcb exprmsg-invmmsg-1 - fcc "Invalid mnemonic" -exprmsg fcb modemsg-exprmsg-1 - fcc "Expression error" -modemsg fcb brmsg-modemsg-1 - fcc "Addressing mode error" -brmsg fcb endmsg-brmsg-1 - fcc "Branch too long" -endmsg equ * - -* Output hex digit contained in A -hexdigit adda #$90 - daa - adca #$40 - daa ;It's the standard conversion trick ascii - tfr a,b ;to hex without branching. - jsr putchar - rts - -* Output contents of A as two hex digits -outbyte pshs a - lsra - lsra - lsra - lsra - bsr hexdigit - puls a - anda #$0f - bra hexdigit - -* Output contents of d as four hex digits -outd pshs b - bsr outbyte - puls a - bsr outbyte - rts - -* Skip X past spaces, B is first non-space character. -skipspace ldb ,x+ - cmpb #' ' - beq skipspace - rts - -* Convert ascii hex digit in B register to binary Z flag set if no hex digit. -convb subb #'0' - blo convexit - cmpb #9 - bls cb2 - andb #CASEMASK ;Make uppercase. - subb #7 ;If higher than digit 9 it must be a letter. - cmpb #9 - bls convexit - cmpb #15 - bhi convexit -cb2 andcc #$FB ;clear zero - rts -convexit orcc #$04 - rts - -scanexit ldd temp - leax -1,x - tst temp2 - rts <-- exit point of scanhex - -* Scan for hexadecimal number at address X return in D, Z flag is set it no -* number found. -scanhex clr temp - clr temp+1 - clr temp2 - bsr skipspace -scloop jsr convb - beq scanexit - pshs b - ldd temp - aslb - rola - aslb - rola - aslb - rola - aslb - rola - addb ,s+ - std temp - inc temp2 - ldb ,x+ - bra scloop - -scan2parms std length - bsr scanhex - beq sp2 - std addr - bsr skipspace - cmpb #',' - bne sp2 - bsr scanhex - beq sp2 - std length -sp2 rts - -* Scan two hexdigits at in and convert to byte into A, Z flag if error. -scanbyte bsr skipspace - bsr convb - beq sb1 - tfr b,a - ldb ,x+ - bsr convb - beq sb1 - asla - asla - asla - asla - stb temp - adda temp - andcc #$fb ;Clear zero flag -sb1 rts - - -* This is the code for the D command, hex/ascii dump of memory -* Syntax: D or D or D, -dump ldx #linebuf+1 - ldd #$40 - jsr scan2parms ;Scan address and length, default length=64 - ldy addr -dh1 lda #16 - sta temp+1 - tfr y,d - jsr outd - ldb #' ' - jsr putchar -dh2 lda ,y+ ;display row of 16 mem locations as hex - jsr outbyte - ldb #' ' - lda temp+1 - cmpa #9 - bne dh6 - ldb #'-' ;Do a - after the eighth byte. -dh6 jsr putchar - dec temp+1 - bne dh2 - leay -16,y ;And now for the ascii dump. - lda #16 -dh3 ldb ,y+ - cmpb #' ' - bhs dh4 - ldb #'.' -dh4 cmpb #DEL - blo dh5 - ldb #'.' ;Convert all nonprintables to . -dh5 jsr putchar - deca - bne dh3 - jsr putcr - ldd length - subd #16 - std length - bhi dh1 - sty addr - jmp cmdline - -* This is the code for the E command, enter hex bytes or ascii string. -* Syntax E or E or E or E"string" -enter ldx #linebuf+1 - jsr scanhex - beq ent1 - std addr -ent1 bsr entline - lbne cmdline ;No bytes, then enter interactively. -ent2 ldb #'E' - jsr putchar - ldd addr - jsr outd - ldb #' ' - jsr putchar ;Display Eaddr + space - lda [addr] - jsr outbyte - ldb #' ' - jsr putchar - ldx #linebuf - ldb #buflen - jsr getline ;Get the line. - tstb - beq skipbyte - abx - clr ,x - ldx #linebuf - bsr entline - bne ent2 - jmp cmdline -skipbyte ldd addr - addd #1 - std addr - bra ent2 - -* Enter a line of hex bytes or ascci string at address X, Z if empty. -entline jsr skipspace - tstb - beq entexit - cmpb #'.' - beq entexit - cmpb #'"' - beq entasc - leax -1,x - ldy addr -entl2 jsr scanbyte ;Enter hex digits. - beq entdone - sta ,y+ - bra entl2 -entasc ldy addr -entl3 lda ,x+ - tsta - beq entdone - cmpa #'"' - beq entdone - sta ,y+ - bra entl3 -entdone sty addr - andcc #$fb - rts -entexit orcc #$04 - rts - -*This is the code for the I command, display the contents of an address -* Syntax: Iaddr -inp ldx #linebuf+1 - jsr scanhex - tfr d,x - lda ,x ;Read the byte from memory. - jsr outbyte ;Display itin hex. - jsr putcr - jmp cmdline - -*This is the code for the H command, display result of simple hex expression -*Syntax Hhexnum{+|-hexnum} -calc ldx #linebuf+1 - jsr scanhex - std temp3 -hexloop jsr skipspace - cmpb #'+' - bne hex1 - jsr scanhex - addd temp3 - std temp3 - bra hexloop -hex1 cmpb #'-' - bne hexend - jsr scanhex - comb - coma - addd #1 - addd temp3 - std temp3 - bra hexloop -hexend ldd temp3 - jsr outd - jsr putcr - jmp cmdline - -* This is the code for the G command, jump to the program -* Syntax G or G -go ldx #linebuf+1 - jsr scanhex - beq launch - std 10,s ;Store parameter in pc location. -launch jsr arm ;Arm the breakpoints. - puls ccr,b,a,dp,x,y,u,pc - -* This is the code for the J command, run a subroutine. -* Syntax J -jump ldx #linebuf+1 - ldd 10,s - std oldpc ;Save old pc - jsr scanhex - std 10,s ;Store parameter in PC location - tfr s,x - leas -2,s - tfr s,u - ldb #12 ;Move the saved register set 2 addresses - jsr blockmove ;down on the stack. - ldd #stakregs - std 12,s ;Prepare subroutine return address. - bra launch ;Jump to the routine. - - -* This is the code for the P command, run instruction followed by breakpoint -* Syntax P -prog ldy 10,s ;Get program counter value. - jsr disdecode ;Find out location past current insn. - sty stepbp - bra launch - -* This is the code for the T command, single step trace an instruction. -* Syntax T -trace jsr traceone - jsr dispregs - jmp cmdline - -traceone orcc #$50 ;Disable the interrupts. - ldd ,s++ - std oldpc ;Remove saved pc from stack. - ldd #traceret - std firqvec+1 ;Adjust timer IRQ vector. - sync ;Synchronize on the next timer interrupt. - ;1 cycle - ldx #4441 ;3 cycles -traceloop leax -1,x ;6 cycles\x4441= 39969 cycles. - bne traceloop ;3 cycles/ - nop ;2 cycles. - nop ;2 cycles. - nop ;2 cycles. - brn traceret ;3 cycles. - puls x,y,u,a,b,dp,cc,pc ;17 cycles, total=39999 20ms @ 2MHz - ;Pull all registers and execute. - ;Is timed such that next timer IRQ - ;occurs right after it. -traceret puls cc - pshs x,y,u,a,b,dp,cc;Store full register set instead of cc. - ldd #timerirq - std firqvec+1 ;Restore timer IRQ vector. - jmp [oldpc] - - -* Display the contents of 8 bit register, name in B, contents in A -disp8 jsr putchar - ldb #'=' - jsr putchar - jsr outbyte - ldb #' ' - jsr putchar - rts - -* Display the contents of 16 bit register, name in B, contents in Y -disp16 jsr putchar - ldb #'=' - jsr putchar - tfr y,d - jsr outd - ldb #' ' - jsr putchar - rts - -* Display the contents of the registers and disassemble instruction at -* PC location. -dispregs ldb #'X' - ldy 6,s ;Note that there's one return address on - bsr disp16 ;stack so saved register offsets are - ldb #'Y' ;inremented by 2. - ldy 8,s - bsr disp16 - ldb #'U' - ldy 10,s - bsr disp16 - ldb #'S' - tfr s,y - leay 14,y ;S of the running program is 12 higher, - ;because regs are not stacked when running. - bsr disp16 - ldb #'A' - lda 3,s - bsr disp8 - ldb #'B' - lda 4,s - bsr disp8 - ldb #'D' - lda 5,s - bsr disp8 - ldb #'C' - lda 2,s - bsr disp8 - jsr putcr - ldb #'P' - ldy 12,s - bsr disp16 - jsr disdecode - jsr disdisp ;Disassemble instruction at PC - jsr putcr - rts - - -* This is the code for the R command, display or alter the registers. -* Syntax R or R -regs ldx #linebuf+1 - jsr skipspace - tstb - bne setreg - bsr dispregs ;Display regs ifnothing follows. - jmp cmdline -setreg ldy #regtab - clra - andb #CASEMASK ;Make letter uppercase. -sr1 tst ,y - lbeq unk ;At end of register tab, unknown reg - cmpb ,y+ - beq sr2 ;Found the register? - inca - bra sr1 -sr2 pshs a - jsr scanhex ;Convert the hex argument. - pshs d - lda 2,s ;Get register number. - cmpa #4 - bcc sr3 - ldb 1,s ;It's 8 bit. - leas 3,s ;Remove temp stuff from stack. - stb a,s ;Store it in the reg on stack. - jmp cmdline -sr3 cmpa #8 - bcc sr4 - puls x ;It's 16 bit. - leas 1,s - lsla - suba #4 ;Convert reg no to stack offset. - stx a,s - jmp cmdline -sr4 puls u ;It's the stack pointer. - leas 1,s - leau -12,u - tfr s,x - tfr u,s ;Set new stack pointer. - ldb #12 - jsr blockmove ;Move register set to new stack location. - jmp cmdline - -regtab FCC "CABDXYUPS " - -* Disarm the breakpoints, this is replace the SWI instructions with the -* original byte. -disarm ldx #bpaddr - lda #brkpoints+1 -disarm1 ldu ,x++ - ldb ,x+ ;Get address in u, byte in b - cmpu #0 - beq disarm2 - stb ,u -disarm2 deca - bne disarm1 - ldu #0 - stu -3,x ;Clear the step breakpoint. - rts - -* Arm the breakponts, this is replace the byte at the breakpoint address -* with an SWI instruction. -arm ldx #bpaddr+brkpoints*3 - lda #brkpoints+1 ;Arm them in reverse order of disarming. -arm1 ldu ,x ;Get address in u. - beq arm2 - ldb ,u - stb 2,x - cmpu 12,s ;Compare to program counter location - beq arm2 - ldb #$3F - stb ,u ;Store SWI instruction if not equal. -arm2 leax -3,x - deca - bne arm1 - rts - -* This is the code for the break command, set, clear display breakpoints. -* Syntax B or B. B displays, B sets or clears breakpoint. -break lda #brkpoints - sta temp2+1 ;Store number of breakpoints to visit. - ldx #linebuf+1 - jsr scanhex - beq dispbp ;No number then display breakpoints - ldx #bpaddr - ldu #0 - tfr u,y -bp1 cmpd ,x - beq clearit ;Found the breakpoint, so clear it, - cmpu ,x ;Is location zero - bne bp2 - tfr x,y ;Set free address to y -bp2 leax 3,x - dec temp2+1 - bne bp1 - cmpy #0 ;Address not found in list of breakpoints - beq bpfull ;Was free address found. - std ,y ;If so, store breakpoint there. - ldx #brkmsg -bpexit jsr outcount - jsr putcr - jmp cmdline -clearit clra - clrb - std ,x - ldx #clrmsg - bra bpexit -bpfull ldx #fullmsg - bra bpexit - -dispbp ldx #bpaddr -dbp1 ldd ,x - beq dbp2 - jsr outd - ldb #' ' - jsr putchar -dbp2 leax 3,x - dec temp2+1 - bne dbp1 - jsr putcr - jmp cmdline - -* Scan hex byte into a and add it to check sum in temp2+1 -addchk jsr scanbyte - lbeq srecerr - tfr a,b - addb temp2+1 - stb temp2+1 - rts - -* This tis the code for the S command, the Motorola S records entry. -* Syntax SO or SS, or S1 or S9 -srec ldx #linebuf+1 - ldb ,x+ - andb #CASEMASK - cmpb #'O' - beq setsorg - cmpb #'S' - beq sendrec - ldb -1,x - clr temp3 - cmpb #'1' - beq readrec - cmpb #'9' - bne srecerr - inc temp3 -readrec clr temp2+1 ;clear checksum. - bsr addchk - suba #2 ;discount the address bytes from the count. - sta temp3+1 ;Read length byte. - bsr addchk - pshs a - bsr addchk - puls b - exg a,b ;Read address into d. - ldu sorg - beq rr1 - ldu soffs - bne rr1 - pshs d ;Sorg is nonzero and soffs is zero, now - subd sorg ;set soffs - std soffs - puls d -rr1 subd soffs ;Subtract the address offset. - tfr d,y -rr2 bsr addchk - dec temp3+1 - beq endrec - sta ,y+ - bra rr2 -endrec inc temp2+1 ;Check checksum. - bne srecerr - tst temp3 - lbeq cmdline ;Was it no S9 record? - cmpy #0 - beq endrec1 - sty 10,s ;Store address into program counter. -endrec1 clra - clrb - std sorg ;Reset sorg, next S loads will be normal. - std soffs - jmp cmdline -srecerr jsr xabortin - ldx #smsg ;Error in srecord, display message. - jsr outcount - jsr putcr - jmp cmdline -setsorg jsr scanhex ;Set S record origin. - std sorg - clra - clrb - std soffs - jmp cmdline -* Send a memory region as S-records. -sendrec ldd #$100 ;Scan address and length parameter. - jsr scan2parms - ldd sorg - beq ss1 - ldd addr - subd sorg - std soffs ;Compute offset for origin. -ss1 ldd length - beq endss ;All bytes sent? - cmpd #16 - blo ss2 - ldb #16 ;If more than 16 left, then send 16. -ss2 stb temp - negb - ldu length - leau b,u - stu length ;Discount line length from length. - ldb #'S' - jsr putchar - ldb #'1' - jsr putchar - clr temp+1 ;Clear check sum - ldb temp - addb #3 - bsr checkout ;Output byte b as hex and add to check sum. - ldd addr - tfr d,y - subd soffs - exg a,b - bsr checkout - exg a,b - bsr checkout ;Output address (add into check sum) -ss3 ldb ,y+ - bsr checkout - dec temp - bne ss3 - sty addr - ldb temp+1 - comb - bsr checkout ;Output checksum byte. - jsr putcr - bra ss1 -endss ldx #lastrec - jsr outcount - jsr putcr - jmp cmdline -* Output byte in register B and add it into check sum at temp+1 -checkout pshs a - tfr b,a - addb temp+1 - stb temp+1 - jsr outbyte - puls a - rts - -* This is the code for the M command, move memory region. -* Syntax: Maddr1,addr2,length -move ldx #linebuf+1 - jsr scanhex - lbeq unk - std temp3 - jsr skipspace - cmpb #',' - lbne unk - jsr scanhex - lbeq unk - tfr d,u - jsr skipspace - cmpb #',' - lbne unk - jsr scanhex - lbeq unk - tfr d,y ;Read the argument separated by commas - ldx temp3 ;src addr to x, dest addr to u, length to y - ;Don't tolerate syntax deviations. -mvloop lda ,x+ - sta ,u+ - leay -1,y - bne mvloop ;Perform the block move. - jmp cmdline - - -* This is the code for the F command, find byte/ascii string in memory. -* Syntax: Faddr bytes or Faddr "ascii" -find ldx #linebuf+1 - jsr scanhex - tfr d,y ;Scan the start address. - jsr skipspace - cmpb #'"' - bne findhex - ldu #linebuf ;Quote found, so scan for quoted string. - clra -fstrloop ldb ,x+ - beq startsrch ;End of line without final quote. - cmpb #'"' - beq startsrch ;End quote found - stb ,u+ - inca - bra fstrloop -findhex ldu #linebuf ;Convert string of hex bytes. - leax -1,x ;String will be stored at start of line - clra ;buffer and may overwrite part of the -fhexloop pshs a ;already converted string. - jsr scanbyte - tfr a,b - puls a - beq startsrch - stb ,u+ - inca - bra fhexloop -startsrch tsta ;Start searching, start addr in Y, - ;string starts at linebuf, length A - lbeq cmdline ;Quit with zero length string. - clr temp3 - sta temp3+1 -srchloop tfr y,x - lda temp3+1 - cmpx #$e100 - bcc srch1 - leax a,x - cmpx #$e000 ;Stop at I/O addresses. - lbcc cmdline -srch1 tfr y,x - ldu #linebuf -srch2 ldb ,x+ - cmpb ,u+ - bne srch3 ;Not equal, try next address. - deca - bne srch2 - tfr y,d - jsr outd ;String found - jsr putcr - inc temp3 - lda temp3 - cmpa #$10 - lbeq cmdline ;If 10 matches found, just stop. -srch3 leay 1,y - bra srchloop - -* Send the contents of the xmodem buffer and get it acknowledged, zero flag -* is set if transfer aborted. -xsendbuf ldb #SOH - jsr osputc ;Send SOH - ldb xpacknum - jsr osputc ;Send block number. - comb - jsr osputc ;and its complement. - clr xsum - lda #128 - ldx #buf0 -xsloop ldb ,x - addb xsum - stb xsum - ldb ,x+ - jsr osputc - deca - bne xsloop ;Send the buffer contents. - ldb xsum - jsr osputc ;Send the check sum -waitack jsr osgetc - cmpb #CAN - beq xsabt ;^X for abort. - cmpb #NAK - beq xsendbuf ;Send again if NAK - cmpb #ACK - bne waitack - inc xpacknum -xsok andcc #$fb ;Clear zero flag after ACK -xsabt rts - -* Start an XMODEM send session. -xsendinit ldb #1 - stb xpacknum ;Initialize block number. -waitnak jsr osgetc - cmpb #CAN - beq xsabt ;If ^X exit with zero flag. - cmpb #NAK - beq xsok - bra waitnak ;Wait until NAK received. - -* Send ETX and wait for ack. -xsendeot ldb #EOT - jsr osputc -waitack2 jsr osgetc - cmpb #CAN - beq xsabt - cmpb #NAK - beq xsendeot - cmpb #ACK - beq xsok - bra waitack2 - -* Read character into B with a timeout of A seconds, Carry set if timeout. -gettimeout asla - ldb #50 - mul - tfr b,a - adda timer+2 -gt1 jsr osgetpoll - tstb - bne gtexit - cmpa timer+2 - bne gt1 - orcc #$1 - rts -gtexit jsr osgetc - andcc #$fe - rts - -* Wait until line becomes quiet. -purge lda #3 - jsr gettimeout - bcc purge - rts - -* Receive an XMODEM block and wait till it is OK, Z set if etx. -xrcvbuf lda #3 - tst lastok - beq sendnak - ldb #ACK - jsr osputc ;Send an ack. - lda #5 - bra startblock -sendnak ldb #NAK - jsr osputc ;Send a NAK -startblock clr lastok - bsr gettimeout - lda #3 - bcs sendnak ;Keep sending NAKs when timed out. - cmpb #EOT - beq xrcveot ;End of file reached, acknowledge EOT. - cmpb #SOH - bne purgeit ;Not, SOH, bad block. - lda #1 - bsr gettimeout - bcs purgeit - cmpb xpacknum ;Is it the right block? - beq xr1 - incb - cmpb xpacknum ;Was it the previous block. - bne purgeit - inc lastok -xr1 stb xsum - lda #1 - bsr gettimeout - bcs purgeit - comb - cmpb xsum ;Is the complement of the block number OK - bne purgeit - ldx #buf0 - clr xsum -xrloop lda #1 - bsr gettimeout - bcs purgeit - stb ,x+ - addb xsum - stb xsum - cmpx #buf0+128 - bne xrloop ;Get the data bytes. - lda #1 - bsr gettimeout - bcs purgeit - cmpb xsum - bne purgeit ;Check the check sum. - tst lastok - bne xrcvbuf ;Block was the previous block, get next one - inc lastok - inc xpacknum - andcc #$fb - rts -purgeit jsr purge - bra sendnak -xrcveot lda #3 ;EOT was received. - ldb #ACK -ackloop jsr osputc - deca - bne ackloop ;Send 3 acks in a row. - rts - - -savevecs ldx getchar+1 - stx oldgetc - ldx putchar+1 - stx oldputc - ldx putcr+1 - stx oldputcr - clr lastterm - rts - -rstvecs ldx oldgetc - stx getchar+1 - ldx oldputc - stx putchar+1 - ldx oldputcr - stx putcr+1 - clr lastterm - rts - -* O.S. routine to open input through XMODEM transfer. -xopin pshs x,a,b - ldx #xsmsg - jsr outcount - jsr putcr ;Display message to start XMODEM send. - bsr savevecs - ldx #noop - stx putchar+1 ;Disable character output. - ldx #xgetc - stx getchar+1 ; - clr lastok - clr xcount - lda #1 - sta xpacknum - inca - sta xmode ;set xmode to 2. - puls x,a,b,pc - -* O.S. routine to open output through XMODEM transfer. -xopout pshs x,a,b - bsr savevecs - ldx #xrmsg - jsr outcount ;Display message to start XMODEM receive - jsr putcr - ldx #xputc - stx putchar+1 - ldx #xputcr - stx putcr+1 - jsr xsendinit - lbeq xerror - clr xcount - lda #1 - sta xmode - puls x,a,b,pc - - -* O.S. routine to abort input through XMODEM transfer. -xabtin lda xmode - cmpa #2 - bne xclsend - jsr purge - ldb #CAN - lda #8 -xabtloop jsr osputc - deca - bne xabtloop ;Send 8 CAN characters to kill transfer. - bsr rstvecs - clr xmode - ldx #xamsg - jsr outcount - jsr putcr ;Send diagnostic message. - rts - -* O.S. routine to close output through XMODEM transfer. -xclsout lda xmode - cmpa #1 - bne xclsend - tst xcount - beq xclsdone - lda #128 - suba xcount -xclsloop ldb filler - bsr xputc - deca - bne xclsloop ;Transfer filler chars to force block out. -xclsdone jsr xsendeot ;Send EOT - lbeq xerror - jsr rstvecs - clr xmode -xclsend rts - -* O.S. routine to close input through XMODEM, by gobbling up the remaining -* bytes. -xclsin ldb xmode - cmpb #2 - bne xclsend - jsr putchar - bra xclsin - -* putchar routine for XMODEM -xputc pshs x,a,b - lda xcount - inc xcount - ldx #buf0 - stb a,x ;Store character in XMODEM buffer. - cmpa #127 - bne xputc1 ;is buffer full? - clr xcount - pshs y,u - jsr xsendbuf - lbeq xerror - puls y,u -xputc1 puls x,a,b,pc - -* putcr routine for XMODEM -xputcr pshs b - ldb xmcr - bitb #2 - beq xputcr1 - ldb #CR - bsr xputc -xputcr1 ldb xmcr - bitb #1 - beq xputcr2 - ldb #LF - bsr xputc -xputcr2 puls b - rts - -* getchar routine for XMODEM -xgetc pshs x,a - tst xcount ;No characters left? - bne xgetc1 - pshs y,u - jsr xrcvbuf ;Receive new block. - puls y,u - beq xgetcterm ;End of input? - lda #128 - sta xcount -xgetc1 lda xcount - nega - ldx #buf0+128 - ldb a,x ;Get character from buffer - dec xcount - puls x,a,pc -xgetcterm jsr rstvecs - clr xmode - ldb filler - puls x,a,pc - -xerror jsr rstvecs ;Restore I/O vectors - clr xmode - ldx #xamsg - jsr outcount - jsr putcr - jmp xerrvec - -xerrhand lds savesp - jmp cmdline - -* This is the code for the X command, various XMODEM related commands. -* Syntax: XSaddr,len XLaddr,len XX XOcrlf,filler, XSSaddr,len -xmodem ldx #linebuf+1 - lda ,x+ - anda #CASEMASK ;Convert to uppercase. - cmpa #'X' - beq xeq - cmpa #'L' - beq xload - cmpa #'O' - beq xopts - cmpa #'S' - lbne unk - lda ,x - anda #CASEMASK - cmpa #'S' - beq xss - ldd #$100 ;XSaddr,len command. - jsr scan2parms ;Send binary through XMODEM - jsr xopenout - ldu addr - ldy length -xsbinloop ldb ,u+ - jsr putchar - leay -1,y - bne xsbinloop ;Send all the bytes through XMODEM. - jmp cmdline -xss leax 1,x ;XSSaddr,len command. - jsr xopenout ;Send Srecords through XMODEM - jmp sendrec -xload jsr scanhex ;XLaddr command - tfr d,y ;Load binary through XMODEM - jsr xopenin -xlodloop jsr getchar - tst xmode ;File ended? then done - lbeq cmdline - stb ,y+ - bra xlodloop -xeq jsr xopenin ;XX command - jmp cmdline ;Execute commands received from XMODEM -xopts ldd #$1a - jsr scan2parms - lda addr+1 - sta xmcr - lda length+1 - sta filler - jmp cmdline - -* mnemonics table, ordered alphabetically. -* 5 bytes name, 1 byte category, 2 bytes opcode, 8 bytes total. -mnemtab fcc "ABX " - fcb 0 - fdb $3a - fcc "ADCA " - fcb 7 - fdb $89 - fcc "ADCB " - fcb 7 - fdb $c9 - fcc "ADDA " - fcb 7 - fdb $8b - fcc "ADDB " - fcb 7 - fdb $cb - fcc "ADDD " - fcb 8 - fdb $c3 - fcc "ANDA " - fcb 7 - fdb $84 - fcc "ANDB " - fcb 7 - fdb $c4 - fcc "ANDCC" - fcb 2 - fdb $1c - fcc "ASL " - fcb 10 - fdb $08 - fcc "ASLA " - fcb 0 - fdb $48 - fcc "ASLB " - fcb 0 - fdb $58 - fcc "ASR " - fcb 10 - fdb $07 - fcc "ASRA " - fcb 0 - fdb $47 - fcc "ASRB " - fcb 0 - fdb $57 - fcc "BCC " - fcb 4 - fdb $24 - fcc "BCS " - fcb 4 - fdb $25 - fcc "BEQ " - fcb 4 - fdb $27 - fcc "BGE " - fcb 4 - fdb $2c - fcc "BGT " - fcb 4 - fdb $2e - fcc "BHI " - fcb 4 - fdb $22 - fcc "BHS " - fcb 4 - fdb $24 - fcc "BITA " - fcb 7 - fdb $85 - fcc "BITB " - fcb 7 - fdb $c5 - fcc "BLE " - fcb 4 - fdb $2f - fcc "BLO " - fcb 4 - fdb $25 - fcc "BLS " - fcb 4 - fdb $23 - fcc "BLT " - fcb 4 - fdb $2d - fcc "BMI " - fcb 4 - fdb $2b - fcc "BNE " - fcb 4 - fdb $26 - fcc "BPL " - fcb 4 - fdb $2a - fcc "BRA " - fcb 4 - fdb $20 - fcc "BRN " - fcb 4 - fdb $21 -mnembsr fcc "BSR " - fcb 4 - fdb $8d - fcc "BVC " - fcb 4 - fdb $28 - fcc "BVS " - fcb 4 - fdb $29 - fcc "CLR " - fcb 10 - fdb $0f - fcc "CLRA " - fcb 0 - fdb $4f - fcc "CLRB " - fcb 0 - fdb $5f - fcc "CMPA " - fcb 7 - fdb $81 - fcc "CMPB " - fcb 7 - fdb $c1 - fcc "CMPD " - fcb 9 - fdb $1083 - fcc "CMPS " - fcb 9 - fdb $118c - fcc "CMPU " - fcb 9 - fdb $1183 - fcc "CMPX " - fcb 8 - fdb $8c - fcc "CMPY " - fcb 9 - fdb $108c - fcc "COM " - fcb 10 - fdb $03 - fcc "COMA " - fcb 0 - fdb $43 - fcc "COMB " - fcb 0 - fdb $53 - fcc "CWAI " - fcb 2 - fdb $3c - fcc "DAA " - fcb 0 - fdb $19 - fcc "DEC " - fcb 10 - fdb $0a - fcc "DECA " - fcb 0 - fdb $4a - fcc "DECB " - fcb 0 - fdb $5a - fcc "EORA " - fcb 7 - fdb $88 - fcc "EORB " - fcb 7 - fdb $c8 - fcc "EQU " - fcb 13 - fdb 0 - fcc "EXG " - fcb 11 - fdb $1e -mnemfcb fcc "FCB " - fcb 13 - fdb 1 - fcc "FCC " - fcb 13 - fdb 2 - fcc "FDB " - fcb 13 - fdb 3 - fcc "INC " - fcb 10 - fdb $0c - fcc "INCA " - fcb 0 - fdb $4c - fcc "INCB " - fcb 0 - fdb $5c - fcc "JMP " - fcb 10 - fdb $0e -mnemjsr fcc "JSR " - fcb 8 - fdb $8d - fcc "LBCC " - fcb 5 - fdb $1024 - fcc "LBCS " - fcb 5 - fdb $1025 - fcc "LBEQ " - fcb 5 - fdb $1027 - fcc "LBGE " - fcb 5 - fdb $102c - fcc "LBGT " - fcb 5 - fdb $102e - fcc "LBHI " - fcb 5 - fdb $1022 - fcc "LBHS " - fcb 5 - fdb $1024 - fcc "LBLE " - fcb 5 - fdb $102f - fcc "LBLO " - fcb 5 - fdb $1025 - fcc "LBLS " - fcb 5 - fdb $1023 - fcc "LBLT " - fcb 5 - fdb $102d - fcc "LBMI " - fcb 5 - fdb $102b - fcc "LBNE " - fcb 5 - fdb $1026 - fcc "LBPL " - fcb 5 - fdb $102a - fcc "LBRA " - fcb 6 - fdb $16 - fcc "LBRN " - fcb 5 - fdb $1021 - fcc "LBSR " - fcb 6 - fdb $17 - fcc "LBVC " - fcb 5 - fdb $1028 - fcc "LBVS " - fcb 5 - fdb $1029 - fcc "LDA " - fcb 7 - fdb $86 - fcc "LDB " - fcb 7 - fdb $c6 - fcc "LDD " - fcb 8 - fdb $cc - fcc "LDS " - fcb 9 - fdb $10ce - fcc "LDU " - fcb 8 - fdb $ce - fcc "LDX " - fcb 8 - fdb $8e - fcc "LDY " - fcb 9 - fdb $108e - fcc "LEAS " - fcb 3 - fdb $32 - fcc "LEAU " - fcb 3 - fdb $33 - fcc "LEAX " - fcb 3 - fdb $30 - fcc "LEAY " - fcb 3 - fdb $31 - fcc "LSL " - fcb 10 - fdb $08 - fcc "LSLA " - fcb 0 - fdb $48 - fcc "LSLB " - fcb 0 - fdb $58 - fcc "LSR " - fcb 10 - fdb $04 - fcc "LSRA " - fcb 0 - fdb $44 - fcc "LSRB " - fcb 0 - fdb $54 - fcc "MUL " - fcb 0 - fdb $3d - fcc "NEG " - fcb 10 - fdb $00 - fcc "NEGA " - fcb 0 - fdb $40 - fcc "NEGB " - fcb 0 - fdb $50 - fcc "NOP " - fcb 0 - fdb $12 - fcc "ORA " - fcb 7 - fdb $8a - fcc "ORB " - fcb 7 - fdb $ca - fcc "ORCC " - fcb 2 - fdb $1a - fcc "ORG " - fcb 13 - fdb 4 - fcc "PSHS " - fcb 12 - fdb $34 - fcc "PSHU " - fcb 12 - fdb $36 - fcc "PULS " - fcb 12 - fdb $35 - fcc "PULU " - fcb 12 - fdb $37 - fcc "RMB " - fcb 13 - fdb 5 - fcc "ROL " - fcb 10 - fdb $09 - fcc "ROLA " - fcb 0 - fdb $49 - fcc "ROLB " - fcb 0 - fdb $59 - fcc "ROR " - fcb 10 - fdb $06 - fcc "RORA " - fcb 0 - fdb $46 - fcc "RORB " - fcb 0 - fdb $56 - fcc "RTI " - fcb 0 - fdb $3b - fcc "RTS " - fcb 0 - fdb $39 - fcc "SBCA " - fcb 7 - fdb $82 - fcc "SBCB " - fcb 7 - fdb $c2 - fcc "SET " - fcb 13 - fdb 6 - fcc "SETDP" - fcb 13 - fdb 7 - fcc "SEX " - fcb 0 - fdb $1d - fcc "STA " - fcb 7 - fdb $87 - fcc "STB " - fcb 7 - fdb $c7 - fcc "STD " - fcb 8 - fdb $cd - fcc "STS " - fcb 9 - fdb $10cf - fcc "STU " - fcb 8 - fdb $cf - fcc "STX " - fcb 8 - fdb $8f - fcc "STY " - fcb 9 - fdb $108f - fcc "SUBA " - fcb 7 - fdb $80 - fcc "SUBB " - fcb 7 - fdb $c0 - fcc "SUBD " - fcb 8 - fdb $83 - fcc "SWI " - fcb 0 - fdb $3f - fcb "SWI2 " - fcb 1 - fdb $103f - fcb "SWI3 " - fcb 1 - fdb $113f - fcc "SYNC " - fcb 0 - fdb $13 - fcc "TFR " - fcb 11 - fdb $1f - fcc "TST " - fcb 10 - fdb $0d - fcc "TSTA " - fcb 0 - fdb $4d - fcc "TSTB " - fcb 0 - fdb $5d - -mnemsize equ (*-mnemtab)/8 - -* Register table for PUSH/PULL and TFR/EXG instructions. -* 3 bytes for name, 1 for tfr/exg, 1 for push/pull, 5 total -asmregtab fcc "X " - fcb $01,$10 - fcc "Y " - fcb $02,$20 -aregu fcc "U " - fcb $03,$40 -aregs fcc "S " - fcb $04,$40 - fcc "PC " - fcb $05,$80 - fcc "A " - fcb $08,$02 - fcc "B " - fcb $09,$04 - fcc "D " - fcb $00,$06 - fcc "CC " - fcb $0a,$01 - fcc "CCR" - fcb $0a,$01 - fcc "DP " - fcb $0b,$08 - fcc "DPR" - fcb $0b,$08 -reginval fcc "? " - -ixregs fcc "XYUS" - -* opcode offsets to basic opcode, depends on first nibble. -opcoffs fcb 0,0,0,0,0,0,-$60,-$70 - fcb 0,-$10,-$20,-$30,0,-$10,-$20,-$30 -* mode depending on first nibble of opcode. -modetab fcb 3,0,0,0,0,0,5,4,1,3,5,4,1,3,5,4 -* mode depending on category code stored in mnemtab -modetab2 fcb 0,0,1,5,6,7,7,1,2,2,0,8,9 -* modes in this context: 0 no operands, 1 8-bit immediate, 2 16 bit imm, -* 3, 8-bit address, 4 16 bit address, 5 indexed with postbyte, 6 short -* relative, 7 long relative, 8 pushpul, 9 tftetx - -* Decode instruction pointed to by Y for disassembly (and to find out -* how long it is). On return, U points to appropriate mnemonic table entry, -* Y points past instruction. -* It's rather clumsy code, but we do want to reuse the same table -* as used with assembling. -disdecode clr prebyte - clr amode - lda ,y+ - cmpa #$10 - beq ddec1 - cmpa #$11 - bne ddec2 -ddec1 sta prebyte ;Store $10 or $11 prebyte. - lda ,y+ ;Get new opcode. -ddec2 sta opcode - lsra - lsra - lsra - lsra ;Get high nibble. - ldx #modetab - ldb a,x - stb amode - ldx #opcoffs - lda a,x - adda opcode ;Add opcode offset to opcode. -ddec4 sta opc1 ;Store the 'basis' opcode. - ldu #mnemtab - ldx #mnemsize -ddecloop ldb #13 - cmpb 5,u ;Compare category code with 13 - beq ddec3 ;13=pseudo op, no valid opcode - ldd prebyte - cmpd 6,u - beq ddecfound ;Opcode&prebyte agree, operation found. -ddec3 leau 8,u ;point to next mnemonic - leax -1,x - bne ddecloop - ldu #mnemfcb ;mnemonic not found, use FCB byte. - lda #3 - sta amode ;Store mode 3, 8 bit address. - lda opcode - tst prebyte - beq ddec5 - lda prebyte ;if it was the combination prebyte - clr prebyte ;and opcode that was not found, - leay -1,y ;FCB just the prebyte -ddec5 sta operand+1 ;The byte must be stored as operand. - rts -ddecfound cmpu #mnembsr - bne ddec6 - lda #$8d ;Is it really the BSR opcode? - cmpa opcode - beq ddec6 - ldu #mnemjsr ;We mistakenly found BSR instead of JSR -ddec6 lda amode - anda #$FE - bne ddec7 - lda 5,u ;nibble-dependent mode was 0 or 1, - ldx #modetab2 ;use category dependent mode instead. - lda a,x - sta amode -ddec7 lda amode - asla - ldx #disdectab - jmp [a,x] ;jump dependent on definitive mode. -disdectab fdb noop,opdec1,opdec2,opdec1,opdec2,opdecidx - fdb opdec1,opdec2,opdecpb,opdecpb -disdectab1 fdb noop,noop,noop,noop,noop,noop,noop,noop - fdb opdec1,opdec2,noop,noop,opdec1,opdec2,noop,opdec2 -opdec1 ldb ,y+ - sex -od1a std operand -noop rts -opdec2 ldd ,y++ - bra od1a -opdecpb ldb ,y+ -odpa stb postbyte - rts -opdecidx ldb ,y+ - bpl odpa ;postbytes <$80 have no extra operands. - stb postbyte - andb #$0f - aslb - ldx #disdectab1 - jmp [b,x] - -* Display disassembled instruction after the invocation of disdecode. -* U points to mnemonic table entry. -disdisp tfr u,x - ldb #5 - jsr putline ;Display the mnemonic. - ldb #' ' - jsr putchar - lda amode - asla - ldx #disdisptab - jmp [a,x] ;Perform action dependent on mode. -disdisptab fdb noop,disim8,disim16,disadr8,disadr16 - fdb disidx,disrel8,disrel16,distfr,dispush -disim8 bsr puthash - bra disadr8 -disim16 bsr puthash -disadr16 bsr putdol - ldd operand - jmp outd -disadr8 bsr putdol - lda operand+1 - jmp outbyte -disrel8 bsr putdol - ldb operand+1 - sex -dr8a sty temp - addd temp - jmp outd -disrel16 bsr putdol - ldd operand - bra dr8a - -puthash ldb #'#' - jmp putchar -putdol ldb #'$' - jmp putchar -putcomma ldb #',' - jmp putchar -putspace ldb #' ' - jmp putchar - -dispush ldb #12 - ldx #asmregtab ;Walk through the register table. - clr temp -regloop lda postbyte - anda 4,x - beq dispush1 ;Is bit corresponding to reg set in postbyte - cmpx #aregu - bne dispush3 - sta temp+1 - lda opcode - anda #2 - bne dispush1 ;no u register in pshu pulu. - lda temp+1 -dispush3 cmpx #aregs - bne dispush4 - sta temp+1 - lda opcode - anda #2 - beq dispush1 ;no s register in pshs puls. - lda temp+1 -dispush4 coma - anda postbyte ;remove the bits from postbyte. - sta postbyte - pshs b - tst temp - beq dispush2 - bsr putcomma ;print comma after first register. -dispush2 bsr disregname - inc temp - puls b -dispush1 leax 5,x - decb - bne regloop - rts - -distfr lda postbyte - lsra - lsra - lsra - lsra - bsr distfrsub - bsr putcomma - lda postbyte - anda #$0f -distfrsub ldb #12 - ldx #asmregtab -distfrloop cmpa 3,x - beq distfrend - leax 5,x - decb - bne distfrloop -distfrend bsr disregname - rts - -disregname lda #3 - tfr x,u -drnloop ldb ,u+ - cmpb #' ' - beq drnend - jsr putchar - deca - bne drnloop -drnend rts - -disidxreg lda postbyte - lsra - lsra - lsra - lsra - lsra - anda #3 - ldx #ixregs - ldb a,x - jmp putchar - -disidx clr temp - lda postbyte - bmi disidx1 - anda #$1f - bita #$10 - bne negoffs - jsr outdecbyte - bra discomma -negoffs ldb #'-' - jsr putchar - ora #$f0 - nega - jsr outdecbyte -discomma jsr putcomma ;Display ,Xreg and terminating ] -disindex bsr disidxreg -disindir tst temp ;Display ] if indirect. - beq disidxend - ldb #']' - jsr putchar -disidxend rts -disidx1 bita #$10 - beq disidx2 - ldb #'[' - jsr putchar - inc temp -disidx2 lda postbyte - anda #$0f - asla - ldx #disidxtab - jmp [a,x] ;Jump to routine for indexed mode -disadec2 lda #2 - bra disadeca -disadec1 lda #1 -disadeca jsr putcomma -disadloop ldb #'-' - jsr putchar - deca - bne disadloop - bra disindex -disainc2 lda #2 - bra disainca -disainc1 lda #1 -disainca sta temp+1 - jsr putcomma - jsr disidxreg - lda temp+1 -disailoop ldb #'+' - jsr putchar - deca - bne disailoop - jmp disindir -disax ldb #'A' - jsr putchar - jmp discomma -disbx ldb #'B' - jsr putchar - jmp discomma -disdx ldb #'D' - jsr putchar - jmp discomma -disinval ldb #'?' - jsr putchar - jmp disindir -disnx lda operand+1 - bmi disnxneg -disnx1 jsr putdol - jsr outbyte - jmp discomma -disnxneg ldb #'-' - jsr putchar - nega - bra disnx1 -disnnx jsr putdol - ldd operand - jsr outd - jmp discomma -disnpc jsr putdol - ldb operand+1 - sex -disnpca sty temp2 - addd temp2 - jsr outd - ldx #commapc - ldb #4 - jsr putline - jmp disindir -disnnpc jsr putdol - ldd operand - bra disnpca -disdirect jsr putdol - ldd operand - jsr outd - jmp disindir - -commapc fcc ",PCR" - -disidxtab fdb disainc1,disainc2,disadec1,disadec2 - fdb discomma,disbx,disax,disinval - fdb disnx,disnnx,disinval,disdx - fdb disnpc,disnnpc,disinval,disdirect - -* Display byte A in decimal (0<=A<20) -outdecbyte cmpa #10 - blo odb1 - suba #10 - ldb #'1' - jsr putchar -odb1 adda #'0' - tfr a,b - jmp putchar - -* This is the code for the U command, unassemble instructions in memory. -* Syntax: U or Uaddr or Uaddr,length -unasm bsr disasm - jmp cmdline -disasm ldx #linebuf+1 - ldd #20 - jsr scan2parms ;Scan address,length parameters. -dis1 ldd addr - addd length - std length - ldy addr -unasmloop tfr y,d - jsr outd ;Display instruction address - jsr putspace - pshs y - jsr disdecode - puls x - sty temp - clr temp2 -unadishex lda ,x+ - jsr outbyte - inc temp2 - inc temp2 - cmpx temp - bne unadishex ;Display instruction bytes as hex. -unadisspc ldb #' ' - jsr putchar - inc temp2 - lda #11 - cmpa temp2 ;Fill out with spaces to width 11. - bne unadisspc - bne unadishex - jsr disdisp ;Display disassembled instruction. - tst disflg - bne skipcr - jsr putcr -skipcr cmpy length - bls unasmloop - sty addr - rts - -* Simple 'expression evaluator' for assembler. -expr ldb ,x - cmpb #'-' - bne pos - clrb - leax 1,x -pos pshs b - bsr scanfact - beq exprend1 - tst ,s+ - bne exprend ;Was the minus sign there. - coma - comb - addd #1 - andcc #$fb ;Clear Z flag for valid result. -exprend rts -exprend1 puls b - rts - -scanfact ldb ,x+ - cmpb #'$' - lbeq scanhex ;Hex number if starting with dollar. - cmpb #''' - bne scandec ;char if starting with ' else decimal - ldb ,x+ - lda ,x - cmpa #''' - bne scanchar2 - leax 1,x ;Increment past final quote if it's there. -scanchar2 clra - andcc #$fb ;Clear zero flag. - rts -scandec cmpb #'0' - blo noexpr - cmpb #'9' - bhi noexpr - clr temp - clr temp+1 -scandloop subb #'0' - bcs sdexit - cmpb #10 - bcc sdexit - pshs b - ldd temp - aslb - rola - pshs d - aslb - rola - aslb - rola - addd ,s++ ;Multiply number by 10. - addb ,s+ - adca #0 ;Add digit to 10. - std temp - ldb ,x+ ;Get next character. - bra scandloop -sdexit ldd temp - leax -1,x - andcc #$fb - rts -noexpr orcc #$04 - rts - -* Assemble the instruction pointed to by X. -* Fisrt stage: copy mnemonic to mnemonic buffer. -asminstr lda #5 - ldu #mnembuf -mncploop ldb ,x+ - beq mncpexit - cmpb #' ' - beq mncpexit ;Mnemonic ends at first space or null - andb #CASEMASK - cmpb #'A' - blo nolet - cmpb #'Z' - bls mnemcp1 ;Capitalize letters, but only letters. -nolet ldb -1,x -mnemcp1 stb ,u+ ;Copy to mnemonic buffer. - deca - bne mncploop -mncpexit tsta - beq mncpdone - ldb #' ' -mnfilloop stb ,u+ - deca - bne mnfilloop ;Fill the rest of mnem buffer with spaces. -* Second stage: look mnemonic up using binary search. -mncpdone stx temp3 - clr temp ;Low index=0 - lda #mnemsize - sta temp+1 ;High index=mnemsize. -bsrchloop ldb temp+1 - cmpb #$ff - beq invmnem ;lower limit -1? - cmpb temp - blo invmnem ;hi index lower than low index? - clra - addb temp ;Add indexes. - adca #0 - lsra - rorb ;Divide by 2 to get average - stb temp2 - aslb - rola - aslb - rola - aslb - rola ;Multiply by 8 to get offset. - ldu #mnemtab - leau d,u ;Add offset to table base - tfr u,y - lda #5 - ldx #mnembuf -bscmploop ldb ,x+ - cmpb ,y+ - bne bscmpexit ;Characters don't match? - deca - bne bscmploop - jmp mnemfound ;We found the mnemonic. -bscmpexit ldb temp2 - bcc bscmplower - decb - stb temp+1 ;mnembuftable, adjust low limit. - bra bsrchloop -invmnem ldx #invmmsg - jmp asmerrvec -* Stage 3: Perform routine depending on category code. -mnemfound clr uncert - ldy addr - lda 5,u - asla - ldx #asmtab - jsr [a,x] - sty addr - rts -asmtab fdb onebyte,twobyte,immbyte,lea - fdb sbranch,lbranch,lbra,acc8 - fdb dreg1,dreg2,oneaddr,tfrexg - fdb pushpul,pseudovec - -putbyte stb ,y+ - rts -putword std ,y++ - rts - -onebyte ldb 7,u ;Cat 0, one byte opcode w/o operands RTS - bra putbyte -twobyte ldd 6,u ;Cat 1, two byte opcode w/o operands SWI2 - bra putword -immbyte ldb 7,u ;Cat 2, opcode w/ immdiate operand ANDCC - bsr putbyte - jsr scanops - ldb amode - cmpb #1 - lbne moderr - ldb operand+1 - bra putbyte -lea ldb 7,u ;Cat 3, LEA - bsr putbyte - jsr scanops - lda amode - cmpa #1 - lbeq moderr ;No immediate w/ lea - cmpa #3 - lbhs doaddr - jsr set3 - lda #$8f - sta postbyte - lda #2 - sta opsize ;Use 8F nn nn for direct mode. - jmp doaddr -sbranch ldb 7,u ;Cat 4, short branch instructions - bsr putbyte - jsr startop - leax -1,x - jsr exprvec - lbeq exprerr - jmp shortrel -lbranch ldd 6,u ;Cat 5, long brach w/ two byte opcode - bsr putword -lbra1 jsr startop - leax -1,x - jsr exprvec - lbeq exprerr - jmp longrel -lbra ldb 7,u ;Cat 6, long branch w/ one byte opcode. - jsr putbyte - bra lbra1 -acc8 lda #1 ;Cat 7, 8-bit two operand instructions ADDA - sta opsize - jsr scanops - jsr adjopc - jsr putbyte - jmp doaddr -dreg1 lda #2 ;Cat 8, 16-bit 2operand insns 1byte opc LDX - sta opsize - jsr scanops - jsr adjopc - jsr putbyte - jmp doaddr -dreg2 lda #2 ;Cat 9, 16-bit 2operand insns 2byte opc LDY - sta opsize - jsr scanops - jsr adjopc - lda 6,u - jsr putword - jmp doaddr -oneaddr jsr scanops ;Cat 10, one-operand insns NEG..CLR - ldb 7,u - lda amode - cmpa #1 - lbeq moderr ;No immediate mode - cmpa #3 - bhs oaind ;indexed etc - lda opsize - deca - beq oadir - addb #$10 ;Add $70 for extended direct. -oaind addb #$60 ;And $60 for indexed etc. -oadir jsr putbyte ;And nothing for direct8. - jmp doaddr -tfrexg jsr startop ;Cat 11, TFR and EXG - leax -1,x - ldb 7,u - jsr putbyte - jsr findreg - ldb ,u - aslb - aslb - aslb - aslb - stb postbyte - ldb ,x+ - cmpb #',' - lbne moderr - jsr findreg - ldb ,u - orb postbyte - jmp putbyte -pushpul jsr startop ;Cat 12, PSH and PUL - leax -1,x - ldb 7,u - jsr putbyte - clr postbyte -pploop jsr findreg - ldb 1,u - orb postbyte - stb postbyte - ldb ,x+ - cmpb #',' - beq pploop - leax -1,x - ldb postbyte - jmp putbyte -pseudo ldb 7,u ;Cat 13, pseudo oeprations - aslb - ldx #pseudotab - jmp [b,x] -pseudotab fdb pseudoend,dofcb,dofcc,dofdb - fdb doorg,dormb,pseudoend,pseudoend -dofcb jsr startop - leax -1,x -fcbloop jsr exprvec - lbeq exprerr - jsr putbyte - ldb ,x+ - cmpb #',' - beq fcbloop -pseudoend rts -dofcc jsr startop - tfr b,a ;Save delimiter. -fccloop ldb ,x+ - beq pseudoend - pshs a - cmpb ,s+ - beq pseudoend - jsr putbyte - bra fccloop -dofdb jsr startop - leax -1,x -fdbloop jsr exprvec - lbeq exprerr - jsr putword - ldb ,x+ - cmpb #',' - beq fdbloop - rts -doorg jsr startop - leax -1,x - jsr exprvec - lbeq exprerr - tfr d,y - rts -dormb jsr startop - leax -1,x - jsr exprvec - lbeq exprerr - leay d,y - rts - - -* Adjust opcdoe depending on mode (in $80-$FF range) -adjopc ldb 7,u - lda amode - cmpa #2 - beq adjdir ;Is it direct? - cmpa #3 - bhs adjind ;Indexed etc? - rts ;Not, then immediate, no adjust. -adjind addb #$20 ;Add $20 to opcode for indexed etc modes. - rts -adjdir addb #$10 ;Add $10 to opcode for direct8 - lda opsize - deca - bne adjind ;If opsize=2, add another $20 for extended16 - rts - -* Start scanning of operands. -startop ldx temp3 - clr amode - jmp skipspace - -* amode settings in assembler: 1=immediate, 2=direct/extended, 3=indexed -* etc. 4=pc relative, 5=indirect, 6=pcrelative and indirect. - -* This subroutine scans the assembler operands. -scanops bsr startop - cmpb #'[' - bne noindir - lda #5 ;operand starts with [, then indirect. - sta amode - ldb ,x+ -noindir cmpb #'#' - lbeq doimm - cmpb #',' - lbeq dospecial - andb #CASEMASK ;Convert to uppercase. - lda #$86 - cmpb #'A' - beq scanacidx - lda #$85 - cmpb #'B' - beq scanacidx - lda #$8B - cmpb #'D' - bne scanlab -scanacidx ldb ,x+ ;Could it be A,X B,X or D,X - cmpb #',' - bne nocomma - sta postbyte - clr opsize - jsr set3 - jsr scanixreg - bra scanend -nocomma leax -1,x -scanlab leax -1,x ;Point to the start of the operand - jsr exprvec - lbeq exprerr - std operand - tst uncert - bne opsz2 ;Go for extended if operand unknown. - subd dpsetting - tsta ;Can we use 8-bit operand? - bne opsz2 - inca - bra opsz1 -opsz2 lda #2 -opsz1 sta opsize ;Set opsize depending on magnitude of op. - lda amode - cmpa #5 - bne opsz3 ;Or was it indirect. - lda #2 ;Then we have postbyte and opsize=2 - sta opsize - lda #$8F - sta postbyte - bra opsz4 -opsz3 lda #2 - sta amode ;Assume direct or absolute addressing -opsz4 ldb ,x+ - cmpb #',' - lbeq doindex ;If followed by, then indexed. -scanend lda amode - cmpa #5 - blo scanend2 ;Was it an indirect mode? - lda postbyte - ora #$10 ;Set indirect bit. - sta postbyte - ldb ,x+ - cmpb #']' ;Check for the other ] - lbeq moderr -scanend2 rts -doimm jsr exprvec ;Immediate addressing. - lbeq exprerr - std operand - lda amode - cmpa #5 - lbeq moderr ;Inirect mode w/ imm is illegal. - lda #$01 - sta amode - rts -dospecial jsr set3 - clr opsize - clra -adecloop ldb ,x+ - cmpb #'-' - bne adecend - inca ;Count the - signs for autodecrement. - bra adecloop -adecend leax -1,x - cmpa #2 - lbhi moderr - tsta - bne autodec - clr postbyte - jsr scanixreg - clra -aincloop ldb ,x+ - cmpb #'+' - bne aincend - inca - bra aincloop ;Count the + signs for autoincrement. -aincend leax -1,x - cmpa #2 - lbhi moderr - tsta - bne autoinc - lda #$84 - ora postbyte - sta postbyte - bra scanend -autoinc adda #$7f - ora postbyte - sta postbyte - bra scanend -autodec adda #$81 - sta postbyte - jsr scanixreg - lbra scanend -doindex clr postbyte - jsr set3 - ldb ,x+ - andb #CASEMASK ;Convert to uppercase. - cmpb #'P' - lbeq dopcrel ;Check for PC relative. - leax -1,x - clr opsize - bsr scanixreg - ldd operand - tst uncert - bne longindex ;Go for long index if operand unknown. - cmpd #-16 - blt shortindex - cmpd #15 - bgt shortindex - lda amode - cmpa #5 - beq shortind1 ;Indirect may not be 5-bit index - ;It's a five-bit index. - andb #$1f - orb postbyte - stb postbyte - lbra scanend -shortindex cmpd #-128 - blt longindex - cmpd #127 - bgt longindex -shortind1 inc opsize - ldb #$88 - orb postbyte - stb postbyte - lbra scanend -longindex lda #$2 - sta opsize - ldb #$89 - orb postbyte - stb postbyte - lbra scanend -dopcrel ldb ,x+ - andb #CASEMASK ;Convert to uppercase - cmpb #'C' - blo pcrelend - cmpb #'R' - bhi pcrelend - bra dopcrel ;Scan past the ,PCR -pcrelend leax -1,x - ldb #$8C - orb postbyte ;Set postbyte - stb postbyte - inc amode ;Set addr mode to PCR - lbra scanend - -* Scan for one of the 4 index registers and adjust postbyte. -scanixreg ldb ,x+ - andb #CASEMASK ;Convert to uppercase. - pshs x - ldx #ixregs - clra -scidxloop cmpb ,x+ - beq ixfound - adda #$20 - bpl scidxloop - jmp moderr ;Index register not found where expected. -ixfound ora postbyte - sta postbyte ;Set index reg bits in postbyte. - puls x - rts - -* This routine sets amode to 3, if it was less. -set3 lda amode - cmpa #3 - bhs set3a - lda #3 - sta amode -set3a rts - -* This subroutine lays down the address. -doaddr lda amode - cmpa #3 - blo doa1 - ldb postbyte - jsr putbyte - lda amode - anda #1 - beq doapcrel ;pc rel modes. -doa1 lda opsize - tsta - beq set3a - deca - beq doa2 - ldd operand - jmp putword -doa2 ldb operand+1 - jmp putbyte -doapcrel sty addr - ldd operand - subd addr - subd #1 - tst uncert - bne pcrlong - cmpd #-128 - blt pcrlong - cmpd #-127 - bgt pcrlong - lda #1 - sta opsize - jmp putbyte -pcrlong subd #1 - leay -1,y - inc postbyte - pshs d - ldb postbyte - jsr putbyte - lda #2 - sta opsize - puls d - jmp putword - -* This routine checks and lays down short relative address. -shortrel sty addr - subd addr - subd #1 - cmpd #-128 - blt brerr - cmpd #127 - bgt brerr - jsr putbyte - lda #4 - sta amode - lda #1 - sta opsize - rts -* This routine lays down long relative address. -longrel sty addr - subd addr - subd #2 - jsr putword - lda #4 - sta amode - lda #2 - sta opsize - rts - -brerr ldx #brmsg - jmp asmerrvec -exprerr ldx #exprmsg - jmp asmerrvec -moderr ldx #modemsg - jmp asmerrvec -asmerr pshs x - jsr xabortin - puls x - jsr outcount - jsr putcr - lds savesp - jmp cmdline - -* Find register for TFR and PSH instruction -findreg ldb #12 - pshs y,b - ldu #asmregtab -findregloop tfr x,y - lda #3 -frcmps ldb ,u - cmpb #' ' - bne frcmps1 - ldb ,y - cmpb #'A' - blt frfound -frcmps1 ldb ,y+ - andb #CASEMASK - cmpb ,u+ - bne frnextreg - deca - bne frcmps - inca - bra frfound -frnextreg inca - leau a,u - dec ,s - bne findregloop - lbra moderr -frfound leau a,u - tfr y,x - puls y,b - rts - -* This is the code for the A command, assemble instructions. -* Syntax: Aaddr -asm ldx #linebuf+1 - jsr scanhex - std addr - inc disflg - - -asmloop ldy #0 - sty length - ldd addr - pshs d - jsr dis1 ;display unassembled line - ldd addr - std nxtadd - - puls d - std addr - -* ldd addr -* jsr outd - - ldb #TAB - jsr putchar ;Print TAB - ldx #linebuf - ldb #128 - jsr getline ;Get new line - tstb - beq next - -*** beq asmend ;Exit on empty line. - abx - clr ,x ;Make line zero terminated. - ldx #linebuf - lda ,x - cmpa #'.' - beq asmend - jsr asminstr - bra asmloop - -next ldd nxtadd - std addr - bra asmloop - -asmend clr disflg - jmp cmdline - - -* Jump table for monitor routines that are usable by other programs. - org $ffc0 - jmp outbyte - jmp outd - jmp scanbyte - jmp scanhex - jmp scanfact - jmp asminstr - - -* Interrupt vector addresses at top of ROM. Most are vectored through jumps -* in RAM. - org $fff2 - fdb swi3vec - fdb swi2vec - fdb firqvec - fdb irqvec - fdb swivec - fdb nmivec - fdb reset - - end diff -r 4fa2bdb0c457 -r 2088fd998865 monitor.asm --- a/monitor.asm Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2905 +0,0 @@ - ;Buggy machine language monitor and rudimentary O.S. version 1.0 - -* Memory map of SBC -* $0-$40 Zero page variables reserved by monitor and O.S. -* $40-$FF Zero page portion for user programs. -* $100-$17F Xmodem buffer 0, terminal input buffer, -* $180-$1FF Xmodem buffer 1, terminal output buffer. -* $200-$27F Terminal input line. -* $280-$2FF Variables reserved by monitor and O.S. -* $300-$400 System stack. -* $400-$7FFF RAM for user programs and data. -* $8000-$DFFF PROM for user programs. -* $E000-$E1FF I/O addresses. -* $E200-$E3FF Reserved. -* $E400-$FFFF Monitor ROM - -* Reserved Zero page addresses - org $0000 - setdp 0 -* First the I/O routine vectors. -getchar rmb 3 ;Jump to getchar routine. -putchar rmb 3 ;Jump to putchar routine. -getline rmb 3 ;Jump to getline routine. -putline rmb 3 ;Jump to putline routine. -putcr rmb 3 ;Jump to putcr routine. -getpoll rmb 3 ;Jump to getpoll routine. -xopenin rmb 3 ;Jump to xopenin routine. -xopenout rmb 3 ;Jump to xopenout routine. -xabortin rmb 3 ;Jump to xabortin routine. -xclosein rmb 3 ;Jump to xclosein routine. -xcloseout rmb 3 ;Jump to xcloseout routine. -delay rmb 3 ;Jump to delay routine. - -*Next the system variables in the zero page. -temp rmb 2 ;hex scanning/disasm -temp2 rmb 2 ;Hex scanning/disasm -temp3 rmb 2 ;Used in Srecords, H command -timer rmb 3 ;3 byte timer, incremented every 20ms -xpacknum rmb 1 ;Packet number for XMODEM block, -xsum rmb 1 ;XMODEM checksum -lastok rmb 1 ;flag to indicate last block was OK -xcount rmb 1 ;Count of characters in buffer. -xmode rmb 1 ;XMODEM mode, 0 none, 1 out, 2 in. - -* I/O buffers. -buflen equ 128 ;Length of input line buffer. - org $100 -buf0 rmb 128 ;Xmodem buffer 0, serial input buffer. -buf1 rmb 128 ;Xmodem buffer 1, serial output buffer. -linebuf rmb buflen ;Input line buffer. - - -* Interrupt vectors (start at $280) -* All interrupts except RESET are vectored through jumps. -* FIRQ is timer interrupt, IRQ is ACIA interrupt. -swi3vec rmb 3 -swi2vec rmb 3 -firqvec rmb 3 -irqvec rmb 3 -swivec rmb 3 -nmivec rmb 3 -xerrvec rmb 3 ;Error handler for XMODEM error. -exprvec rmb 3 ;Expression evaluator in assembler. -asmerrvec rmb 3 ;Error handler for assembler errors. - -* Next the non zero page system variables. -oldpc rmb 2 ;Saved pc value for J command. -addr rmb 2 ;Address parameter. -length rmb 2 ;Length parameter. - -brkpoints equ 4 ;Number of settable breakpoints. -bpaddr rmb brkpoints*3 ;Address and byte for each break point. -stepbp rmb 3 ;Address of P command break point. - -sorg rmb 2 ;Origin address of S record entry. -soffs rmb 2 ;Offset load adrr-addr in record - -oldgetc rmb 2 ;Old getchar address. -oldputc rmb 2 ;Old putchar address. -oldputcr rmb 2 ;Old putcr address. -lastterm rmb 1 ;Last terminating character. -filler rmb 1 ;Filler at end of XMODEM file. -xmcr rmb 1 ;end-of-line characters for XMODEM send. -savesp rmb 2 ;Save sp to restore it on error. - -* Following variables are used by assembler/disassembler. -prebyte rmb 1 -opc1 rmb 1 -opcode rmb 1 -postbyte rmb 1 -amode rmb 1 -operand rmb 2 -mnembuf rmb 5 ;Buffer to store capitalized mnemonic. -opsize rmb 1 ;SIze (in bytes) of extra oeprand (0--2) -uncert rmb 1 ;Flag to indicate that op is unknown. -dpsetting rmb 2 - -endvars equ * - -ramstart equ $400 ;first free RAM address. - -ramtop equ $8000 ;top of RAM. - -* I/O port addresses -aciactl equ $e000 ;Control port of ACIA -aciasta equ $e000 ;Status port of ACIA -aciadat equ $e001 ;Data port of ACIA - -* ASCII control characters. -SOH equ 1 -EOT equ 4 -ACK equ 6 -BS equ 8 -TAB equ 9 -LF equ 10 -CR equ 13 -NAK equ 21 -CAN equ 24 -DEL equ 127 - -CASEMASK equ $DF ;Mask to make lowercase into uppercase. - -* Monitor ROM starts here. - org $E400 - -reset orcc #$FF ;Disable interrupts. - clra - tfr a,dp ;Set direct page register to 0. - lds #ramstart - ldx #intvectbl - ldu #swi3vec - ldb #osvectbl-intvectbl - bsr blockmove ;Initialize interrupt vectors from ROM. - ldx #osvectbl - ldu #0 - ldb #endvecs-osvectbl - bsr blockmove ;Initialize I/O vectors from ROM. - bsr initacia ;Initialize serial port. - andcc #$0 ;Enable interrupts -* Put the 'saved' registers of the program being monitored on top of the -* stack. There are 12 bytes on the stack for cc,b,a,dp,x,y,u and pc -* pc is initialized to $400, the rest to zero. - ldx #0 - tfr x,y - ldu #ramstart - pshs x,u - pshs x,y - pshs x,y - ldx #oldpc - ldb #endvars-oldpc -clvar clr ,x+ - decb - bne clvar ;Clear the variable area. - ldd #$1A03 - std filler ;Set XMODEM filler and end-of-line. - ldx #welcome - jsr outcount - jsr putcr ;Print a welcome message. - jmp cmdline -* Block move routine, from X to U length B. Modifies them all and A. -blockmove lda ,x+ - sta ,u+ - decb - bne blockmove - rts - -* Initialize serial communications port, buffers, interrupts. -initacia ldb #$03 - stb aciactl - ldb #%00110101 - rts - -* O.S. routine to read a character into B register. -osgetc ldb aciasta - bitb #$01 - beq osgetc - ldb aciadat - rts - -;O.S. rotuine to check if there is a character ready to be read. -osgetpoll ldb aciasta - bitb #$01 - bne poltrue - clrb - rts -poltrue ldb #$ff - rts - -* O.S. routine to write the character in the B register. -osputc pshs a -putcloop lda aciasta - bita #$02 - beq putcloop - stb aciadat - puls a - rts - -* O.S. routine to read a line into memory at address X, at most B chars -* long, return actual length in B. Permit backspace editing. -osgetl pshs a,x - stb temp - clra -osgetl1 jsr getchar - andb #$7F - cmpb #BS - beq backsp - cmpb #DEL - bne osgetl2 -backsp tsta ;Recognize BS and DEL as backspace key. - beq osgetl1 ;ignore if line already zero length. - ldb #BS - jsr putchar - ldb #' ' - jsr putchar - ldb #BS ;Send BS,space,BS. This erases last - jsr putchar ;character on most terminals. - leax -1,x ;Decrement address. - deca - bra osgetl1 -osgetl2 cmpb #CR - beq newline - cmpb #LF - bne osgetl3 ;CR or LF character ends line. - ldb lastterm - cmpb #CR - beq osgetl1 ;Ignore LF if it comes after CR - ldb #LF -newline stb lastterm - jsr putcr - tfr a,b ;Move length to B - puls a,x ;restore registers. - rts ;<--- Here is the exit point. -osgetl3 cmpb #TAB - beq dotab - cmpb #' ' - blo osgetl1 ;Ignore control characters. - cmpa temp - beq osgetl1 ;Ignore char if line full. - jsr putchar ;Echo the character. - stb ,x+ ;Store it in memory. - inca - bra osgetl1 -dotab ldb #' ' - cmpa temp - beq osgetl1 - jsr putchar - stb ,x+ - inca - bita #7 ;Insert spaces until length mod 8=0 - bne dotab - bra osgetl1 - -* O.S. routine to write a line starting at address X, B chars long. -osputl pshs a,b,x - tfr b,a - tsta - beq osputl1 -osputl2 ldb ,x+ - jsr putchar - deca - bne osputl2 -osputl1 puls a,b,x - rts - -* O.S. routine to terminate a line. -oscr pshs b - ldb #CR - jsr putchar - ldb #LF - jsr putchar ;Send the CR and LF characters. - puls b - rts - -* Output a counted string at addr X -outcount pshs x,b - ldb ,x+ - jsr putline - puls x,b - rts - -timerirq inc timer+2 - bne endirq - inc timer+1 - bne endirq - inc timer - rti -aciairq nop -endirq rti - -* Wait D times 20ms. -osdly addd timer+1 -dlyloop cmpd timer+1 - bne dlyloop - rts - -* This table will be copied to the interrupt vector area in RAM. -intvectbl jmp endirq - jmp endirq - jmp timerirq - jmp aciairq - jmp unlaunch - jmp endirq - jmp xerrhand - jmp expr - jmp asmerrvec -* And this one to the I/O vector table. -osvectbl jmp osgetc - jmp osputc - jmp osgetl - jmp osputl - jmp oscr - jmp osgetpoll - jmp xopin - jmp xopout - jmp xabtin - jmp xclsin - jmp xclsout - jmp osdly -endvecs equ * - -* The J command returns here. -stakregs pshs x ;Stack something where the pc comes - pshs cc,b,a,dp,x,y,u ;Stack the normal registers. - ldx oldpc - stx 10,s ;Stack the old pc value. - bra unlaunch1 -* The G and P commands return here through a breakpoint. -* Registers are already stacked. -unlaunch ldd 10,s - subd #1 - std 10,s ;Decrement pc before breakpoint -unlaunch1 andcc #$0 ;reenable the interrupts. - jsr disarm ;Disarm the breakpoints. - jsr dispregs -cmdline jsr xcloseout - sts savesp - ldx #linebuf - ldb #buflen - jsr getline - tstb - beq cmdline ;Ignore line if it is empty - abx - clr ,x ;Make location after line zero. - ldx #linebuf - ldb ,x+ - andb #CASEMASK ;Make 1st char uppercase. - subb #'A' - bcs unk - cmpb #26 - bcc unk ;Unknown cmd if it is not a letter. - ldx #cmdtab - aslb ;Index into command table. - jmp [b,x] - -cmdtab fdb asm,break,unk,dump - fdb enter,find,go,hex - fdb inp,jump,unk,unk - fdb move,unk,unk,prog - fdb unk,regs,srec,trace - fdb unasm,unk,unk,xmodem - fdb unk,unk - -* Unknown command handling routine. -unk jsr xabortin - ldx #unknown - jsr outcount - jsr putcr - jmp cmdline - - - -* Here are some useful messages. -welcome fcb unknown-welcome-1 - fcc "Welcome to BUGGY version 1.0" -unknown fcb brkmsg-unknown-1 - fcc "Unknown command" -brkmsg fcb clrmsg-brkmsg-1 - fcc "Breakpoint set" -clrmsg fcb fullmsg-clrmsg-1 - fcc "Breakpoint cleared" -fullmsg fcb smsg-fullmsg-1 - fcc "Breakpoints full" -smsg fcb lastrec-smsg-1 - fcc "Error in S record" -lastrec fcb xsmsg-lastrec-1 - fcc "S9030000FC" -xsmsg fcb xrmsg-xsmsg-1 - fcc "Start XMODEM Send" -xrmsg fcb xamsg-xrmsg-1 - fcc "Start XMODEM Receive" -xamsg fcb invmmsg-xamsg-1 - fcc "XMODEM transfer aborted" -invmmsg fcb exprmsg-invmmsg-1 - fcc "Invalid mnemonic" -exprmsg fcb modemsg-exprmsg-1 - fcc "Expression error" -modemsg fcb brmsg-modemsg-1 - fcc "Addressing mode error" -brmsg fcb endmsg-brmsg-1 - fcc "Branch too long" -endmsg equ * - -* Output hex digit contained in A -hexdigit adda #$90 - daa - adca #$40 - daa ;It's the standard conversion trick ascii - tfr a,b ;to hex without branching. - jsr putchar - rts - -* Output contents of A as two hex digits -outbyte pshs a - lsra - lsra - lsra - lsra - bsr hexdigit - puls a - anda #$0f - bra hexdigit - -* Output contents of d as four hex digits -outd pshs b - bsr outbyte - puls a - bsr outbyte - rts - -* Skip X past spaces, B is first non-space character. -skipspace ldb ,x+ - cmpb #' ' - beq skipspace - rts - -* Convert ascii hex digit in B register to binary Z flag set if no hex digit. -convb subb #'0' - blo convexit - cmpb #9 - bls cb2 - andb #CASEMASK ;Make uppercase. - subb #7 ;If higher than digit 9 it must be a letter. - cmpb #9 - bls convexit - cmpb #15 - bhi convexit -cb2 andcc #$FB ;clear zero - rts -convexit orcc #$04 - rts - -scanexit ldd temp - leax -1,x - tst temp2 - rts ;<-- exit point of scanhex - -* Scan for hexadecimal number at address X return in D, Z flag is set it no -* number found. -scanhex clr temp - clr temp+1 - clr temp2 - bsr skipspace -scloop jsr convb - beq scanexit - pshs b - ldd temp - aslb - rola - aslb - rola - aslb - rola - aslb - rola - addb ,s+ - std temp - inc temp2 - ldb ,x+ - bra scloop - -scan2parms std length - bsr scanhex - beq sp2 - std addr - bsr skipspace - cmpb #',' - bne sp2 - bsr scanhex - beq sp2 - std length -sp2 rts - -* Scan two hexdigits at in and convert to byte into A, Z flag if error. -scanbyte bsr skipspace - bsr convb - beq sb1 - tfr b,a - ldb ,x+ - bsr convb - beq sb1 - asla - asla - asla - asla - stb temp - adda temp - andcc #$fb ;Clear zero flag -sb1 rts - - -* This is the code for the D command, hex/ascii dump of memory -* Syntax: D or D or D, -dump ldx #linebuf+1 - ldd #$40 - jsr scan2parms ;Scan address and length, default length=64 - ldy addr -dh1 lda #16 - sta temp+1 - tfr y,d - jsr outd - ldb #' ' - jsr putchar -dh2 lda ,y+ ;display row of 16 mem locations as hex - jsr outbyte - ldb #' ' - lda temp+1 - cmpa #9 - bne dh6 - ldb #'-' ;Do a - after the eighth byte. -dh6 jsr putchar - dec temp+1 - bne dh2 - leay -16,y ;And now for the ascii dump. - lda #16 -dh3 ldb ,y+ - cmpb #' ' - bhs dh4 - ldb #'.' -dh4 cmpb #DEL - blo dh5 - ldb #'.' ;Convert all nonprintables to . -dh5 jsr putchar - deca - bne dh3 - jsr putcr - ldd length - subd #16 - std length - bhi dh1 - sty addr - jmp cmdline - -* This is the code for the E command, enter hex bytes or ascii string. -* Syntax E or E or E or E"string" -enter ldx #linebuf+1 - jsr scanhex - beq ent1 - std addr -ent1 bsr entline - lbne cmdline ;No bytes, then enter interactively. -ent2 ldb #'E' - jsr putchar - ldd addr - jsr outd - ldb #' ' - jsr putchar ;Display Eaddr + space - ldx #linebuf - ldb #buflen - jsr getline ;Get the line. - abx - clr ,x - ldx #linebuf - bsr entline - bne ent2 - jmp cmdline - -* Enter a line of hex bytes or ascci string at address X, Z if empty. -entline jsr skipspace - tstb - beq entexit - cmpb #'"' - beq entasc - leax -1,x - ldy addr -entl2 jsr scanbyte ;Enter hex digits. - beq entdone - sta ,y+ - bra entl2 -entasc ldy addr -entl3 lda ,x+ - tsta - beq entdone - cmpa #'"' - beq entdone - sta ,y+ - bra entl3 -entdone sty addr - andcc #$fb - rts -entexit orcc #$04 - rts - -*This is the code for the I command, display the contents of an address -* Syntax: Iaddr -inp ldx #linebuf+1 - jsr scanhex - tfr d,x - lda ,x ;Read the byte from memory. - jsr outbyte ;Display itin hex. - jsr putcr - jmp cmdline - -*This is the code for the H command, display result of simple hex expression -*Syntax Hhexnum{+|-hexnum} -hex ldx #linebuf+1 - jsr scanhex - std temp3 -hexloop jsr skipspace - cmpb #'+' - bne hex1 - jsr scanhex - addd temp3 - std temp3 - bra hexloop -hex1 cmpb #'-' - bne hexend - jsr scanhex - comb - coma - addd #1 - addd temp3 - std temp3 - bra hexloop -hexend ldd temp3 - jsr outd - jsr putcr - jmp cmdline - -* This is the code for the G command, jump to the program -* Syntax G or G -go ldx #linebuf+1 - jsr scanhex - beq launch - std 10,s ;Store parameter in pc location. -launch jsr arm ;Arm the breakpoints. - puls cc,b,a,dp,x,y,u,pc - -* This is the code for the J command, run a subroutine. -* Syntax J -jump ldx #linebuf+1 - ldd 10,s - std oldpc ;Save old pc - jsr scanhex - std 10,s ;Store parameter in PC location - tfr s,x - leas -2,s - tfr s,u - ldb #12 ;Move the saved register set 2 addresses - jsr blockmove ;down on the stack. - ldd #stakregs - std 12,s ;Prepare subroutine return address. - bra launch ;Jump to the routine. - - -* This is the code for the P command, run instruction followed by breakpoint -* Syntax P -prog ldy 10,s ;Get program counter value. - jsr disdecode ;Find out location past current insn. - sty stepbp - bra launch - -* This is the code for the T command, single step trace an instruction. -* Syntax T -trace jsr traceone - jsr dispregs - jmp cmdline - -traceone orcc #$50 ;Disable the interrupts. - ldd ,s++ - std oldpc ;Remove saved pc from stack. - ldd #traceret - std firqvec+1 ;Adjust timer IRQ vector. - sync ;Synchronize on the next timer interrupt. - ;1 cycle - ldx #4441 ;3 cycles -traceloop leax -1,x ;6 cycles\x4441= 39969 cycles. - bne traceloop ;3 cycles/ - nop ;2 cycles. - nop ;2 cycles. - nop ;2 cycles. - brn traceret ;3 cycles. - puls x,y,u,a,b,dp,cc,pc ;17 cycles, total=39999 20ms @ 2MHz - ;Pull all registers and execute. - ;Is timed such that next timer IRQ - ;occurs right after it. -traceret puls cc - pshs x,y,u,a,b,dp,cc;Store full register set instead of cc. - ldd #timerirq - std firqvec+1 ;Restore timer IRQ vector. - jmp [oldpc] - - -* Display the contents of 8 bit register, name in B, contents in A -disp8 jsr putchar - ldb #'=' - jsr putchar - jsr outbyte - ldb #' ' - jsr putchar - rts - -* Display the contents of 16 bit register, name in B, contents in Y -disp16 jsr putchar - ldb #'=' - jsr putchar - tfr y,d - jsr outd - ldb #' ' - jsr putchar - rts - -* Display the contents of the registers and disassemble instruction at -* PC location. -dispregs ldb #'X' - ldy 6,s ;Note that there's one return address on - bsr disp16 ;stack so saved register offsets are - ldb #'Y' ;inremented by 2. - ldy 8,s - bsr disp16 - ldb #'U' - ldy 10,s - bsr disp16 - ldb #'S' - tfr s,y - leay 14,y ;S of the running program is 12 higher, - ;because regs are not stacked when running. - bsr disp16 - ldb #'A' - lda 3,s - bsr disp8 - ldb #'B' - lda 4,s - bsr disp8 - ldb #'D' - lda 5,s - bsr disp8 - ldb #'C' - lda 2,s - bsr disp8 - jsr putcr - ldb #'P' - ldy 12,s - bsr disp16 - jsr disdecode - jsr disdisp ;Disassemble instruction at PC - jsr putcr - rts - - -* This is the code for the R command, display or alter the registers. -* Syntax R or R -regs ldx #linebuf+1 - jsr skipspace - tstb - bne setreg - bsr dispregs ;Display regs ifnothing follows. - jmp cmdline -setreg ldy #regtab - clra - andb #CASEMASK ;Make letter uppercase. -sr1 tst ,y - lbeq unk ;At end of register tab, unknown reg - cmpb ,y+ - beq sr2 ;Found the register? - inca - bra sr1 -sr2 pshs a - jsr scanhex ;Convert the hex argument. - pshs d - lda 2,s ;Get register number. - cmpa #4 - bcc sr3 - ldb 1,s ;It's 8 bit. - leas 3,s ;Remove temp stuff from stack. - stb a,s ;Store it in the reg on stack. - jmp cmdline -sr3 cmpa #8 - bcc sr4 - puls x ;It's 16 bit. - leas 1,s - lsla - suba #4 ;Convert reg no to stack offset. - stx a,s - jmp cmdline -sr4 puls u ;It's the stack pointer. - leas 1,s - leau -12,u - tfr s,x - tfr u,s ;Set new stack pointer. - ldb #12 - jsr blockmove ;Move register set to new stack location. - jmp cmdline - -regtab FCC "CABDXYUPS " - -* Disarm the breakpoints, this is replace the SWI instructions with the -* original byte. -disarm ldx #bpaddr - lda #brkpoints+1 -disarm1 ldu ,x++ - ldb ,x+ ;Get address in u, byte in b - cmpu #0 - beq disarm2 - stb ,u -disarm2 deca - bne disarm1 - ldu #0 - stu -3,x ;Clear the step breakpoint. - rts - -* Arm the breakponts, this is replace the byte at the breakpoint address -* with an SWI instruction. -arm ldx #bpaddr+brkpoints*3 - lda #brkpoints+1 ;Arm them in reverse order of disarming. -arm1 ldu ,x ;Get address in u. - beq arm2 - ldb ,u - stb 2,x - cmpu 12,s ;Compare to program counter location - beq arm2 - ldb #$3F - stb ,u ;Store SWI instruction if not equal. -arm2 leax -3,x - deca - bne arm1 - rts - -* This is the code for the break command, set, clear display breakpoints. -* Syntax B or B. B displays, B sets or clears breakpoint. -break lda #brkpoints - sta temp2+1 ;Store number of breakpoints to visit. - ldx #linebuf+1 - jsr scanhex - beq dispbp ;No number then display breakpoints - ldx #bpaddr - ldu #0 - tfr u,y -bp1 cmpd ,x - beq clearit ;Found the breakpoint, so clear it, - cmpu ,x ;Is location zero - bne bp2 - tfr x,y ;Set free address to y -bp2 leax 3,x - dec temp2+1 - bne bp1 - cmpy #0 ;Address not found in list of breakpoints - beq bpfull ;Was free address found. - std ,y ;If so, store breakpoint there. - ldx #brkmsg -bpexit jsr outcount - jsr putcr - jmp cmdline -clearit clra - clrb - std ,x - ldx #clrmsg - bra bpexit -bpfull ldx #fullmsg - bra bpexit - -dispbp ldx #bpaddr -dbp1 ldd ,x - beq dbp2 - jsr outd - ldb #' ' - jsr putchar -dbp2 leax 3,x - dec temp2+1 - bne dbp1 - jsr putcr - jmp cmdline - -* Scan hex byte into a and add it to check sum in temp2+1 -addchk jsr scanbyte - lbeq srecerr - tfr a,b - addb temp2+1 - stb temp2+1 - rts - -* This tis the code for the S command, the Motorola S records entry. -* Syntax SO or SS, or S1 or S9 -srec ldx #linebuf+1 - ldb ,x+ - andb #CASEMASK - cmpb #'O' - beq setsorg - cmpb #'S' - beq sendrec - ldb -1,x - clr temp3 - cmpb #'1' - beq readrec - cmpb #'9' - bne srecerr - inc temp3 -readrec clr temp2+1 ;clear checksum. - bsr addchk - suba #2 ;discount the address bytes from the count. - sta temp3+1 ;Read length byte. - bsr addchk - pshs a - bsr addchk - puls b - exg a,b ;Read address into d. - ldu sorg - beq rr1 - ldu soffs - bne rr1 - pshs d ;Sorg is nonzero and soffs is zero, now - subd sorg ;set soffs - std soffs - puls d -rr1 subd soffs ;Subtract the address offset. - tfr d,y -rr2 bsr addchk - dec temp3+1 - beq endrec - sta ,y+ - bra rr2 -endrec inc temp2+1 ;Check checksum. - bne srecerr - tst temp3 - lbeq cmdline ;Was it no S9 record? - cmpy #0 - beq endrec1 - sty 10,s ;Store address into program counter. -endrec1 clra - clrb - std sorg ;Reset sorg, next S loads will be normal. - std soffs - jmp cmdline -srecerr jsr xabortin - ldx #smsg ;Error in srecord, display message. - jsr outcount - jsr putcr - jmp cmdline -setsorg jsr scanhex ;Set S record origin. - std sorg - clra - clrb - std soffs - jmp cmdline -* Send a memory region as S-records. -sendrec ldd #$100 ;Scan address and length parameter. - jsr scan2parms - ldd sorg - beq ss1 - ldd addr - subd sorg - std soffs ;Compute offset for origin. -ss1 ldd length - beq endss ;All bytes sent? - cmpd #16 - blo ss2 - ldb #16 ;If more than 16 left, then send 16. -ss2 stb temp - negb - ldu length - leau b,u - stu length ;Discount line length from length. - ldb #'S' - jsr putchar - ldb #'1' - jsr putchar - clr temp+1 ;Clear check sum - ldb temp - addb #3 - bsr checkout ;Output byte b as hex and add to check sum. - ldd addr - tfr d,y - subd soffs - exg a,b - bsr checkout - exg a,b - bsr checkout ;Output address (add into check sum) -ss3 ldb ,y+ - bsr checkout - dec temp - bne ss3 - sty addr - ldb temp+1 - comb - bsr checkout ;Output checksum byte. - jsr putcr - bra ss1 -endss ldx #lastrec - jsr outcount - jsr putcr - jmp cmdline -* Output byte in register B and add it into check sum at temp+1 -checkout pshs a - tfr b,a - addb temp+1 - stb temp+1 - jsr outbyte - puls a - rts - -* This is the code for the M command, move memory region. -* Syntax: Maddr1,addr2,length -move ldx #linebuf+1 - jsr scanhex - lbeq unk - std temp3 - jsr skipspace - cmpb #',' - lbne unk - jsr scanhex - lbeq unk - tfr d,u - jsr skipspace - cmpb #',' - lbne unk - jsr scanhex - lbeq unk - tfr d,y ;Read the argument separated by commas - ldx temp3 ;src addr to x, dest addr to u, length to y - ;Don't tolerate syntax deviations. -mvloop lda ,x+ - sta ,u+ - leay -1,y - bne mvloop ;Perform the block move. - jmp cmdline - - -* This is the code for the F command, find byte/ascii string in memory. -* Syntax: Faddr bytes or Faddr "ascii" -find ldx #linebuf+1 - jsr scanhex - tfr d,y ;Scan the start address. - jsr skipspace - cmpb #'"' - bne findhex - ldu #linebuf ;Quote found, so scan for quoted string. - clra -fstrloop ldb ,x+ - beq startsrch ;End of line without final quote. - cmpb #'"' - beq startsrch ;End quote found - stb ,u+ - inca - bra fstrloop -findhex ldu #linebuf ;Convert string of hex bytes. - leax -1,x ;String will be stored at start of line - clra ;buffer and may overwrite part of the -fhexloop pshs a ;already converted string. - jsr scanbyte - tfr a,b - puls a - beq startsrch - stb ,u+ - inca - bra fhexloop -startsrch tsta ;Start searching, start addr in Y, - ;string starts at linebuf, length A - lbeq cmdline ;Quit with zero length string. - clr temp3 - sta temp3+1 -srchloop tfr y,x - lda temp3+1 - cmpx #$e100 - bcc srch1 - leax a,x - cmpx #$e000 ;Stop at I/O addresses. - lbcc cmdline -srch1 tfr y,x - ldu #linebuf -srch2 ldb ,x+ - cmpb ,u+ - bne srch3 ;Not equal, try next address. - deca - bne srch2 - tfr y,d - jsr outd ;String found - jsr putcr - inc temp3 - lda temp3 - cmpa #$10 - lbeq cmdline ;If 10 matches found, just stop. -srch3 leay 1,y - bra srchloop - -* Send the contents of the xmodem buffer and get it acknowledged, zero flag -* is set if transfer aborted. -xsendbuf ldb #SOH - jsr osputc ;Send SOH - ldb xpacknum - jsr osputc ;Send block number. - comb - jsr osputc ;and its complement. - clr xsum - lda #128 - ldx #buf0 -xsloop ldb ,x - addb xsum - stb xsum - ldb ,x+ - jsr osputc - deca - bne xsloop ;Send the buffer contents. - ldb xsum - jsr osputc ;Send the check sum -waitack jsr osgetc - cmpb #CAN - beq xsabt ;^X for abort. - cmpb #NAK - beq xsendbuf ;Send again if NAK - cmpb #ACK - bne waitack - inc xpacknum -xsok andcc #$fb ;Clear zero flag after ACK -xsabt rts - -* Start an XMODEM send session. -xsendinit ldb #1 - stb xpacknum ;Initialize block number. -waitnak jsr osgetc - cmpb #CAN - beq xsabt ;If ^X exit with zero flag. - cmpb #NAK - beq xsok - bra waitnak ;Wait until NAK received. - -* Send ETX and wait for ack. -xsendeot ldb #EOT - jsr osputc -waitack2 jsr osgetc - cmpb #CAN - beq xsabt - cmpb #NAK - beq xsendeot - cmpb #ACK - beq xsok - bra waitack2 - -* Read character into B with a timeout of A seconds, Carry set if timeout. -gettimeout asla - ldb #50 - mul - tfr b,a - adda timer+2 -gt1 jsr osgetpoll - tstb - bne gtexit - cmpa timer+2 - bne gt1 - orcc #$1 - rts -gtexit jsr osgetc - andcc #$fe - rts - -* Wait until line becomes quiet. -purge lda #3 - jsr gettimeout - bcc purge - rts - -* Receive an XMODEM block and wait till it is OK, Z set if etx. -xrcvbuf lda #3 - tst lastok - beq sendnak - ldb #ACK - jsr osputc ;Send an ack. - lda #5 - bra startblock -sendnak ldb #NAK - jsr osputc ;Send a NAK -startblock clr lastok - bsr gettimeout - lda #3 - bcs sendnak ;Keep sending NAKs when timed out. - cmpb #EOT - beq xrcveot ;End of file reached, acknowledge EOT. - cmpb #SOH - bne purgeit ;Not, SOH, bad block. - lda #1 - bsr gettimeout - bcs purgeit - cmpb xpacknum ;Is it the right block? - beq xr1 - incb - cmpb xpacknum ;Was it the previous block. - bne purgeit - inc lastok -xr1 stb xsum - lda #1 - bsr gettimeout - bcs purgeit - comb - cmpb xsum ;Is the complement of the block number OK - bne purgeit - ldx #buf0 - clr xsum -xrloop lda #1 - bsr gettimeout - bcs purgeit - stb ,x+ - addb xsum - stb xsum - cmpx #buf0+128 - bne xrloop ;Get the data bytes. - lda #1 - bsr gettimeout - bcs purgeit - cmpb xsum - bne purgeit ;Check the check sum. - tst lastok - bne xrcvbuf ;Block was the previous block, get next one - inc lastok - inc xpacknum - andcc #$fb - rts -purgeit jsr purge - bra sendnak -xrcveot lda #3 ;EOT was received. - ldb #ACK -ackloop jsr osputc - deca - bne ackloop ;Send 3 acks in a row. - rts - - -savevecs ldx getchar+1 - stx oldgetc - ldx putchar+1 - stx oldputc - ldx putcr+1 - stx oldputcr - clr lastterm - rts - -rstvecs ldx oldgetc - stx getchar+1 - ldx oldputc - stx putchar+1 - ldx oldputcr - stx putcr+1 - clr lastterm - rts - -* O.S. routine to open input through XMODEM transfer. -xopin pshs x,a,b - ldx #xsmsg - jsr outcount - jsr putcr ;Display message to start XMODEM send. - bsr savevecs - ldx #noop - stx putchar+1 ;Disable character output. - ldx #xgetc - stx getchar+1 ; - clr lastok - clr xcount - lda #1 - sta xpacknum - inca - sta xmode ;set xmode to 2. - puls x,a,b,pc - -* O.S. routine to open output through XMODEM transfer. -xopout pshs x,a,b - bsr savevecs - ldx #xrmsg - jsr outcount ;Display message to start XMODEM receive - jsr putcr - ldx #xputc - stx putchar+1 - ldx #xputcr - stx putcr+1 - jsr xsendinit - lbeq xerror - clr xcount - lda #1 - sta xmode - puls x,a,b,pc - - -* O.S. routine to abort input through XMODEM transfer. -xabtin lda xmode - cmpa #2 - bne xclsend - jsr purge - ldb #CAN - lda #8 -xabtloop jsr osputc - deca - bne xabtloop ;Send 8 CAN characters to kill transfer. - bsr rstvecs - clr xmode - ldx #xamsg - jsr outcount - jsr putcr ;Send diagnostic message. - rts - -* O.S. routine to close output through XMODEM transfer. -xclsout lda xmode - cmpa #1 - bne xclsend - tst xcount - beq xclsdone - lda #128 - suba xcount -xclsloop ldb filler - bsr xputc - deca - bne xclsloop ;Transfer filler chars to force block out. -xclsdone jsr xsendeot ;Send EOT - lbeq xerror - jsr rstvecs - clr xmode -xclsend rts - -* O.S. routine to close input through XMODEM, by gobbling up the remaining -* bytes. -xclsin ldb xmode - cmpb #2 - bne xclsend - jsr putchar - bra xclsin - -* putchar routine for XMODEM -xputc pshs x,a,b - lda xcount - inc xcount - ldx #buf0 - stb a,x ;Store character in XMODEM buffer. - cmpa #127 - bne xputc1 ;is buffer full? - clr xcount - pshs y,u - jsr xsendbuf - lbeq xerror - puls y,u -xputc1 puls x,a,b,pc - -* putcr routine for XMODEM -xputcr pshs b - ldb xmcr - bitb #2 - beq xputcr1 - ldb #CR - bsr xputc -xputcr1 ldb xmcr - bitb #1 - beq xputcr2 - ldb #LF - bsr xputc -xputcr2 puls b - rts - -* getchar routine for XMODEM -xgetc pshs x,a - tst xcount ;No characters left? - bne xgetc1 - pshs y,u - jsr xrcvbuf ;Receive new block. - puls y,u - beq xgetcterm ;End of input? - lda #128 - sta xcount -xgetc1 lda xcount - nega - ldx #buf0+128 - ldb a,x ;Get character from buffer - dec xcount - puls x,a,pc -xgetcterm jsr rstvecs - clr xmode - ldb filler - puls x,a,pc - -xerror jsr rstvecs ;Restore I/O vectors - clr xmode - ldx #xamsg - jsr outcount - jsr putcr - jmp xerrvec - -xerrhand lds savesp - jmp cmdline - -* This is the code for the X command, various XMODEM related commands. -* Syntax: XSaddr,len XLaddr,len XX XOcrlf,filler, XSSaddr,len -xmodem ldx #linebuf+1 - lda ,x+ - anda #CASEMASK ;Convert to uppercase. - cmpa #'X' - beq xeq - cmpa #'L' - beq xload - cmpa #'O' - beq xopts - cmpa #'S' - lbne unk - lda ,x - anda #CASEMASK - cmpa #'S' - beq xss - ldd #$100 ;XSaddr,len command. - jsr scan2parms ;Send binary through XMODEM - jsr xopenout - ldu addr - ldy length -xsbinloop ldb ,u+ - jsr putchar - leay -1,y - bne xsbinloop ;Send all the bytes through XMODEM. - jmp cmdline -xss leax 1,x ;XSSaddr,len command. - jsr xopenout ;Send Srecords through XMODEM - jmp sendrec -xload jsr scanhex ;XLaddr command - tfr d,y ;Load binary through XMODEM - jsr xopenin -xlodloop jsr getchar - tst xmode ;File ended? then done - lbeq cmdline - stb ,y+ - bra xlodloop -xeq jsr xopenin ;XX command - jmp cmdline ;Execute commands received from XMODEM -xopts ldd #$1a - jsr scan2parms - lda addr+1 - sta xmcr - lda length+1 - sta filler - jmp cmdline - -* mnemonics table, ordered alphabetically. -* 5 bytes name, 1 byte category, 2 bytes opcode, 8 bytes total. -mnemtab fcc "ABX " - fcb 0 - fdb $3a - fcc "ADCA " - fcb 7 - fdb $89 - fcc "ADCB " - fcb 7 - fdb $c9 - fcc "ADDA " - fcb 7 - fdb $8b - fcc "ADDB " - fcb 7 - fdb $cb - fcc "ADDD " - fcb 8 - fdb $c3 - fcc "ANDA " - fcb 7 - fdb $84 - fcc "ANDB " - fcb 7 - fdb $c4 - fcc "ANDCC" - fcb 2 - fdb $1c - fcc "ASL " - fcb 10 - fdb $08 - fcc "ASLA " - fcb 0 - fdb $48 - fcc "ASLB " - fcb 0 - fdb $58 - fcc "ASR " - fcb 10 - fdb $07 - fcc "ASRA " - fcb 0 - fdb $47 - fcc "ASRB " - fcb 0 - fdb $57 - fcc "BCC " - fcb 4 - fdb $24 - fcc "BCS " - fcb 4 - fdb $25 - fcc "BEQ " - fcb 4 - fdb $27 - fcc "BGE " - fcb 4 - fdb $2c - fcc "BGT " - fcb 4 - fdb $2e - fcc "BHI " - fcb 4 - fdb $22 - fcc "BHS " - fcb 4 - fdb $24 - fcc "BITA " - fcb 7 - fdb $85 - fcc "BITB " - fcb 7 - fdb $c5 - fcc "BLE " - fcb 4 - fdb $2f - fcc "BLO " - fcb 4 - fdb $25 - fcc "BLS " - fcb 4 - fdb $23 - fcc "BLT " - fcb 4 - fdb $2d - fcc "BMI " - fcb 4 - fdb $2b - fcc "BNE " - fcb 4 - fdb $26 - fcc "BPL " - fcb 4 - fdb $2a - fcc "BRA " - fcb 4 - fdb $20 - fcc "BRN " - fcb 4 - fdb $21 -mnembsr fcc "BSR " - fcb 4 - fdb $8d - fcc "BVC " - fcb 4 - fdb $28 - fcc "BVS " - fcb 4 - fdb $29 - fcc "CLR " - fcb 10 - fdb $0f - fcc "CLRA " - fcb 0 - fdb $4f - fcc "CLRB " - fcb 0 - fdb $5f - fcc "CMPA " - fcb 7 - fdb $81 - fcc "CMPB " - fcb 7 - fdb $c1 - fcc "CMPD " - fcb 9 - fdb $1083 - fcc "CMPS " - fcb 9 - fdb $118c - fcc "CMPU " - fcb 9 - fdb $1183 - fcc "CMPX " - fcb 8 - fdb $8c - fcc "CMPY " - fcb 9 - fdb $108c - fcc "COM " - fcb 10 - fdb $03 - fcc "COMA " - fcb 0 - fdb $43 - fcc "COMB " - fcb 0 - fdb $53 - fcc "CWAI " - fcb 2 - fdb $3c - fcc "DAA " - fcb 0 - fdb $19 - fcc "DEC " - fcb 10 - fdb $0a - fcc "DECA " - fcb 0 - fdb $4a - fcc "DECB " - fcb 0 - fdb $5a - fcc "EORA " - fcb 7 - fdb $88 - fcc "EORB " - fcb 7 - fdb $c8 - fcc "EQU " - fcb 13 - fdb 5 - fcc "EXG " - fcb 11 - fdb $1e -mnemfcb fcc "FCB " - fcb 13 - fdb 7 - fcc "FCC " - fcb 13 - fdb 8 - fcc "FDB " - fcb 13 - fdb 9 - fcc "INC " - fcb 10 - fdb $0c - fcc "INCA " - fcb 0 - fdb $4c - fcc "INCB " - fcb 0 - fdb $5c - fcc "JMP " - fcb 10 - fdb $0e -mnemjsr fcc "JSR " - fcb 8 - fdb $8d - fcc "LBCC " - fcb 5 - fdb $1024 - fcc "LBCS " - fcb 5 - fdb $1025 - fcc "LBEQ " - fcb 5 - fdb $1027 - fcc "LBGE " - fcb 5 - fdb $102c - fcc "LBGT " - fcb 5 - fdb $102e - fcc "LBHI " - fcb 5 - fdb $1022 - fcc "LBHS " - fcb 5 - fdb $1024 - fcc "LBLE " - fcb 5 - fdb $102f - fcc "LBLO " - fcb 5 - fdb $1025 - fcc "LBLS " - fcb 5 - fdb $1023 - fcc "LBLT " - fcb 5 - fdb $102d - fcc "LBMI " - fcb 5 - fdb $102b - fcc "LBNE " - fcb 5 - fdb $1026 - fcc "LBPL " - fcb 5 - fdb $102a - fcc "LBRA " - fcb 6 - fdb $16 - fcc "LBRN " - fcb 5 - fdb $1021 - fcc "LBSR " - fcb 6 - fdb $17 - fcc "LBVC " - fcb 5 - fdb $1028 - fcc "LBVS " - fcb 5 - fdb $1029 - fcc "LDA " - fcb 7 - fdb $86 - fcc "LDB " - fcb 7 - fdb $c6 - fcc "LDD " - fcb 8 - fdb $cc - fcc "LDS " - fcb 9 - fdb $10ce - fcc "LDU " - fcb 8 - fdb $ce - fcc "LDX " - fcb 8 - fdb $8e - fcc "LDY " - fcb 9 - fdb $108e - fcc "LEAS " - fcb 3 - fdb $32 - fcc "LEAU " - fcb 3 - fdb $33 - fcc "LEAX " - fcb 3 - fdb $30 - fcc "LEAY " - fcb 3 - fdb $31 - fcc "LSL " - fcb 10 - fdb $08 - fcc "LSLA " - fcb 0 - fdb $48 - fcc "LSLB " - fcb 0 - fdb $58 - fcc "LSR " - fcb 10 - fdb $04 - fcc "LSRA " - fcb 0 - fdb $44 - fcc "LSRB " - fcb 0 - fdb $54 - fcc "MUL " - fcb 0 - fdb $3d - fcc "NEG " - fcb 10 - fdb $00 - fcc "NEGA " - fcb 0 - fdb $40 - fcc "NEGB " - fcb 0 - fdb $50 - fcc "NOP " - fcb 0 - fdb $12 - fcc "ORA " - fcb 7 - fdb $8a - fcc "ORB " - fcb 7 - fdb $ca - fcc "ORCC " - fcb 2 - fdb $1a - fcc "ORG " - fcb 13 - fdb 12 - fcc "PSHS " - fcb 12 - fdb $34 - fcc "PSHU " - fcb 12 - fdb $36 - fcc "PULS " - fcb 12 - fdb $35 - fcc "PULU " - fcb 12 - fdb $37 - fcc "RMB " - fcb 13 - fdb 0 - fcc "ROL " - fcb 10 - fdb $09 - fcc "ROLA " - fcb 0 - fdb $49 - fcc "ROLB " - fcb 0 - fdb $59 - fcc "ROR " - fcb 10 - fdb $06 - fcc "RORA " - fcb 0 - fdb $46 - fcc "RORB " - fcb 0 - fdb $56 - fcc "RTI " - fcb 0 - fdb $3b - fcc "RTS " - fcb 0 - fdb $39 - fcc "SBCA " - fcb 7 - fdb $82 - fcc "SBCB " - fcb 7 - fdb $c2 - fcc "SET " - fcb 13 - fdb 15 - fcc "SETDP" - fcb 13 - fdb 14 - fcc "SEX " - fcb 0 - fdb $1d - fcc "STA " - fcb 7 - fdb $87 - fcc "STB " - fcb 7 - fdb $c7 - fcc "STD " - fcb 8 - fdb $cd - fcc "STS " - fcb 9 - fdb $10cf - fcc "STU " - fcb 8 - fdb $cf - fcc "STX " - fcb 8 - fdb $8f - fcc "STY " - fcb 9 - fdb $108f - fcc "SUBA " - fcb 7 - fdb $80 - fcc "SUBB " - fcb 7 - fdb $c0 - fcc "SUBD " - fcb 8 - fdb $83 - fcc "SWI " - fcb 0 - fdb $3f - fcb "SWI2 " - fcb 1 - fdb $103f - fcb "SWI3 " - fcb 1 - fdb $113f - fcc "SYNC " - fcb 0 - fdb $13 - fcc "TFR " - fcb 11 - fdb $1f - fcc "TST " - fcb 10 - fdb $0d - fcc "TSTA " - fcb 0 - fdb $4d - fcc "TSTB " - fcb 0 - fdb $5d - -mnemsize equ (*-mnemtab)/8 - -* Register table for PUSH/PULL and TFR/EXG instructions. -* 3 bytes for name, 1 for tfr/exg, 1 for push/pull, 5 total -asmregtab fcc "X " - fcb $01,$10 - fcc "Y " - fcb $02,$20 -aregu fcc "U " - fcb $03,$40 -aregs fcc "S " - fcb $04,$40 - fcc "PC " - fcb $05,$80 - fcc "A " - fcb $08,$02 - fcc "B " - fcb $09,$04 - fcc "D " - fcb $00,$06 - fcc "CC " - fcb $0a,$01 - fcc "CCR" - fcb $0a,$01 - fcc "DP " - fcb $0b,$08 - fcc "DPR" - fcb $0b,$08 -reginval fcc "? " - -ixregs fcc "XYUS" - -* opcode offsets to basic opcode, depends on first nibble. -opcoffs fcb 0,0,0,0,0,0,-$60,-$70 - fcb 0,-$10,-$20,-$30,0,-$10,-$20,-$30 -* mode depending on first nibble of opcode. -modetab fcb 3,0,0,0,0,0,5,4,1,3,5,4,1,3,5,4 -* mode depending on category code stored in mnemtab -modetab2 fcb 0,0,1,5,6,7,7,1,2,2,0,8,9 -* modes in this context: 0 no operands, 1 8-bit immediate, 2 16 bit imm, -* 3, 8-bit address, 4 16 bit address, 5 indexed with postbyte, 6 short -* relative, 7 long relative, 8 pushpul, 9 tftetx - -* Decode instruction pointed to by Y for disassembly (and to find out -* how long it is). On return, U points to appropriate mnemonic table entry, -* Y points past instruction. -* It's rather clumsy code, but we do want to reuse the same table -* as used with assembling. -disdecode clr prebyte - clr amode - lda ,y+ - cmpa #$10 - beq ddec1 - cmpa #$11 - bne ddec2 -ddec1 sta prebyte ;Store $10 or $11 prebyte. - lda ,y+ ;Get new opcode. -ddec2 sta opcode - lsra - lsra - lsra - lsra ;Get high nibble. - ldx #modetab - ldb a,x - stb amode - ldx #opcoffs - lda a,x - adda opcode ;Add opcode offset to opcode. -ddec4 sta opc1 ;Store the 'basis' opcode. - ldu #mnemtab - ldx #mnemsize -ddecloop ldb #13 - cmpb 5,u ;Compare category code with 13 - beq ddec3 ;13=pseudo op, no valid opcode - ldd prebyte - cmpd 6,u - beq ddecfound ;Opcode&prebyte agree, operation found. -ddec3 leau 8,u ;point to next mnemonic - leax -1,x - bne ddecloop - ldu #mnemfcb ;mnemonic not found, use FCB byte. - lda #3 - sta amode ;Store mode 3, 8 bit address. - lda opcode - tst prebyte - beq ddec5 - lda prebyte ;if it was the combination prebyte - clr prebyte ;and opcode that was not found, - leay -1,y ;FCB just the prebyte -ddec5 sta operand+1 ;The byte must be stored as operand. - rts -ddecfound cmpu #mnembsr - bne ddec6 - lda #$8d ;Is it really the BSR opcode? - cmpa opcode - beq ddec6 - ldu #mnemjsr ;We mistakenly found BSR instead of JSR -ddec6 lda amode - anda #$FE - bne ddec7 - lda 5,u ;nibble-dependent mode was 0 or 1, - ldx #modetab2 ;use category dependent mode instead. - lda a,x - sta amode -ddec7 lda amode - asla - ldx #disdectab - jmp [a,x] ;jump dependent on definitive mode. -disdectab fdb noop,opdec1,opdec2,opdec1,opdec2,opdecidx - fdb opdec1,opdec2,opdecpb,opdecpb -disdectab1 fdb noop,noop,noop,noop,noop,noop,noop,noop - fdb opdec1,opdec2,noop,noop,opdec1,opdec2,noop,opdec2 -opdec1 ldb ,y+ - sex -od1a std operand -noop rts -opdec2 ldd ,y++ - bra od1a -opdecpb ldb ,y+ -odpa stb postbyte - rts -opdecidx ldb ,y+ - bpl odpa ;postbytes <$80 have no extra operands. - stb postbyte - andb #$0f - aslb - ldx #disdectab1 - jmp [b,x] - -* Display disassembled instruction after the invocation of disdecode. -* U points to mnemonic table entry. -disdisp tfr u,x - ldb #5 - jsr putline ;Display the mnemonic. - ldb #' ' - jsr putchar - lda amode - asla - ldx #disdisptab - jmp [a,x] ;Perform action dependent on mode. -disdisptab fdb noop,disim8,disim16,disadr8,disadr16 - fdb disidx,disrel8,disrel16,distfr,dispush -disim8 bsr puthash - bra disadr8 -disim16 bsr puthash -disadr16 bsr putdol - ldd operand - jmp outd -disadr8 bsr putdol - lda operand+1 - jmp outbyte -disrel8 bsr putdol - ldb operand+1 - sex -dr8a sty temp - addd temp - jmp outd -disrel16 bsr putdol - ldd operand - bra dr8a - -puthash ldb #'#' - jmp putchar -putdol ldb #'$' - jmp putchar -putcomma ldb #',' - jmp putchar -putspace ldb #' ' - jmp putchar - -dispush ldb #12 - ldx #asmregtab ;Walk through the register table. - clr temp -regloop lda postbyte - anda 4,x - beq dispush1 ;Is bit corresponding to reg set in postbyte - cmpx #aregu - bne dispush3 - sta temp+1 - lda opcode - anda #2 - bne dispush1 ;no u register in pshu pulu. - lda temp+1 -dispush3 cmpx #aregs - bne dispush4 - sta temp+1 - lda opcode - anda #2 - beq dispush1 ;no s register in pshs puls. - lda temp+1 -dispush4 coma - anda postbyte ;remove the bits from postbyte. - sta postbyte - pshs b - tst temp - beq dispush2 - bsr putcomma ;print comma after first register. -dispush2 bsr disregname - inc temp - puls b -dispush1 leax 5,x - decb - bne regloop - rts - -distfr lda postbyte - lsra - lsra - lsra - lsra - bsr distfrsub - bsr putcomma - lda postbyte - anda #$0f -distfrsub ldb #12 - ldx #asmregtab -distfrloop cmpa 3,x - beq distfrend - leax 5,x - decb - bne distfrloop -distfrend bsr disregname - rts - -disregname lda #3 - tfr x,u -drnloop ldb ,u+ - cmpb #' ' - beq drnend - jsr putchar - deca - bne drnloop -drnend rts - -disidxreg lda postbyte - lsra - lsra - lsra - lsra - lsra - anda #3 - ldx #ixregs - ldb a,x - jmp putchar - -disidx clr temp - lda postbyte - bmi disidx1 - anda #$1f - bita #$10 - bne negoffs - jsr outdecbyte - bra discomma -negoffs ldb #'-' - jsr putchar - ora #$f0 - nega - jsr outdecbyte -discomma jsr putcomma ;Display ,Xreg and terminating ] -disindex bsr disidxreg -disindir tst temp ;Display ] if indirect. - beq disidxend - ldb #']' - jsr putchar -disidxend rts -disidx1 bita #$10 - beq disidx2 - ldb #'[' - jsr putchar - inc temp -disidx2 lda postbyte - anda #$0f - asla - ldx #disidxtab - jmp [a,x] ;Jump to routine for indexed mode -disadec2 lda #2 - bra disadeca -disadec1 lda #1 -disadeca jsr putcomma -disadloop ldb #'-' - jsr putchar - deca - bne disadloop - bra disindex -disainc2 lda #2 - bra disainca -disainc1 lda #1 -disainca sta temp+1 - jsr putcomma - jsr disidxreg - lda temp+1 -disailoop ldb #'+' - jsr putchar - deca - bne disailoop - jmp disindir -disax ldb #'A' - jsr putchar - jmp discomma -disbx ldb #'B' - jsr putchar - jmp discomma -disdx ldb #'D' - jsr putchar - jmp discomma -disinval ldb #'?' - jsr putchar - jmp disindir -disnx lda operand+1 - bmi disnxneg -disnx1 jsr putdol - jsr outbyte - jmp discomma -disnxneg ldb #'-' - jsr putchar - nega - bra disnx1 -disnnx jsr putdol - ldd operand - jsr outd - jmp discomma -disnpc jsr putdol - ldb operand+1 - sex -disnpca sty temp2 - addd temp2 - jsr outd - ldx #commapc - ldb #4 - jsr putline - jmp disindir -disnnpc jsr putdol - ldd operand - bra disnpca -disdirect jsr putdol - ldd operand - jsr outd - jmp disindir - -commapc fcc ",PCR" - -disidxtab fdb disainc1,disainc2,disadec1,disadec2 - fdb discomma,disbx,disax,disinval - fdb disnx,disnnx,disinval,disdx - fdb disnpc,disnnpc,disinval,disdirect - -* Display byte A in decimal (0<=A<20) -outdecbyte cmpa #10 - blo odb1 - suba #10 - ldb #'1' - jsr putchar -odb1 adda #'0' - tfr a,b - jmp putchar - -* This is the code for the U command, unassemble instructions in memory. -* Syntax: U or Uaddr or Uaddr,length -unasm ldx #linebuf+1 - ldd #20 - jsr scan2parms ;Scan address,length parameters. - ldd addr - addd length - std length - ldy addr -unasmloop tfr y,d - jsr outd ;Display instruction address - jsr putspace - pshs y - jsr disdecode - puls x - sty temp - clr temp2 -unadishex lda ,x+ - jsr outbyte - inc temp2 - inc temp2 - cmpx temp - bne unadishex ;Display instruction bytes as hex. -unadisspc ldb #' ' - jsr putchar - inc temp2 - lda #11 - cmpa temp2 ;Fill out with spaces to width 11. - bne unadisspc - bne unadishex - jsr disdisp ;Display disassembled instruction. - jsr putcr - cmpy length - bls unasmloop - sty addr - jmp cmdline - -* Simple 'expression evaluator' for assembler. -expr ldb ,x - cmpb #'-' - bne pos - clrb - leax 1,x -pos pshs b - bsr scanfact - beq exprend1 - tst ,s+ - bne exprend ;Was the minus sign there. - coma - comb - addd #1 - andcc #$fb ;Clear Z flag for valid result. -exprend rts -exprend1 puls b - rts - -scanfact ldb ,x+ - cmpb #'$' - lbeq scanhex ;Hex number if starting with dollar. - cmpb #''' - bne scandec ;char if starting with ' else decimal - ldb ,x+ - lda ,x - cmpa #''' - bne scanchar2 - leax 1,x ;Increment past final quote if it's there. -scanchar2 clra - andcc #$fb ;Clear zero flag. - rts -scandec cmpb #'0' - blo noexpr - cmpb #'9' - bhi noexpr - clr temp - clr temp+1 -scandloop subb #'0' - bcs sdexit - cmpb #10 - bcc sdexit - pshs b - ldd temp - aslb - rola - pshs d - aslb - rola - aslb - rola - addd ,s++ ;Multiply number by 10. - addb ,s+ - adca #0 ;Add digit to 10. - std temp - ldb ,x+ ;Get next character. - bra scandloop -sdexit ldd temp - leax -1,x - andcc #$fb - rts -noexpr orcc #$04 - rts - -* Assemble the instruction pointed to by X. -* Fisrt stage: copy mnemonic to mnemonic buffer. -asminstr lda #5 - ldu #mnembuf -mncploop ldb ,x+ - beq mncpexit - cmpb #' ' - beq mncpexit ;Mnemonic ends at first space or null - andb #CASEMASK - cmpb #'A' - blo nolet - cmpb #'Z' - bls mnemcp1 ;Capitalize letters, but only letters. -nolet ldb -1,x -mnemcp1 stb ,u+ ;Copy to mnemonic buffer. - deca - bne mncploop -mncpexit tsta - beq mncpdone - ldb #' ' -mnfilloop stb ,u+ - deca - bne mnfilloop ;Fill the rest of mnem buffer with spaces. -* Second stage: look mnemonic up using binary search. -mncpdone stx temp3 - clr temp ;Low index=0 - lda #mnemsize - sta temp+1 ;High index=mnemsize. -bsrchloop ldb temp+1 - cmpb #$ff - beq invmnem ;lower limit -1? - cmpb temp - blo invmnem ;hi index lower than low index? - clra - addb temp ;Add indexes. - adca #0 - lsra - rorb ;Divide by 2 to get average - stb temp2 - aslb - rola - aslb - rola - aslb - rola ;Multiply by 8 to get offset. - ldu #mnemtab - leau d,u ;Add offset to table base - tfr u,y - lda #5 - ldx #mnembuf -bscmploop ldb ,x+ - cmpb ,y+ - bne bscmpexit ;Characters don't match? - deca - bne bscmploop - jmp mnemfound ;We found the mnemonic. -bscmpexit ldb temp2 - bcc bscmplower - decb - stb temp+1 ;mnembuftable, adjust low limit. - bra bsrchloop -invmnem ldx #invmmsg - jmp asmerrvec -* Stage 3: Perform routine depending on category code. -mnemfound clr uncert - ldy addr - lda 5,u - asla - ldx #asmtab - jsr [a,x] - sty addr - rts -asmtab fdb onebyte,twobyte,immbyte,lea - fdb sbranch,lbranch,lbra,acc8 - fdb dreg1,dreg2,oneaddr,tfrexg - fdb pushpul,pseudo - -putbyte stb ,y+ - rts -putword std ,y++ - rts - -onebyte ldb 7,u ;Cat 0, one byte opcode w/o operands RTS - bra putbyte -twobyte ldd 6,u ;Cat 1, two byte opcode w/o operands SWI2 - bra putword -immbyte ldb 7,u ;Cat 2, opcode w/ immdiate operand ANDCC - bsr putbyte - jsr scanops - ldb amode - cmpb #1 - lbne moderr - ldb operand+1 - bra putbyte -lea ldb 7,u ;Cat 3, LEA - bsr putbyte - jsr scanops - lda amode - cmpa #1 - lbeq moderr ;No immediate w/ lea - cmpa #3 - lbhs doaddr - jsr set3 - lda #$8f - sta postbyte - lda #2 - sta opsize ;Use 8F nn nn for direct mode. - jmp doaddr -sbranch ldb 7,u ;Cat 4, short branch instructions - bsr putbyte - jsr startop - leax -1,x - jsr exprvec - lbeq exprerr - jmp shortrel -lbranch ldd 6,u ;Cat 5, long brach w/ two byte opcode - bsr putword -lbra1 jsr startop - leax -1,x - jsr exprvec - lbeq exprerr - jmp longrel -lbra ldb 7,u ;Cat 6, long branch w/ one byte opcode. - jsr putbyte - bra lbra1 -acc8 lda #1 ;Cat 7, 8-bit two operand instructions ADDA - sta opsize - jsr scanops - jsr adjopc - jsr putbyte - jmp doaddr -dreg1 lda #2 ;Cat 8, 16-bit 2operand insns 1byte opc LDX - sta opsize - jsr scanops - jsr adjopc - jsr putbyte - jmp doaddr -dreg2 lda #2 ;Cat 9, 16-bit 2operand insns 2byte opc LDY - sta opsize - jsr scanops - jsr adjopc - lda 6,u - jsr putword - jmp doaddr -oneaddr jsr scanops ;Cat 10, one-operand insns NEG..CLR - ldb 7,u - lda amode - cmpa #1 - lbeq moderr ;No immediate mode - cmpa #3 - bhs oaind ;indexed etc - lda opsize - deca - beq oadir - addb #$10 ;Add $70 for extended direct. -oaind addb #$60 ;And $60 for indexed etc. -oadir jsr putbyte ;And nothing for direct8. - jmp doaddr -tfrexg jsr startop ;Cat 11, TFR and EXG - leax -1,x - ldb 7,u - jsr putbyte - jsr findreg - ldb ,u - aslb - aslb - aslb - aslb - stb postbyte - ldb ,x+ - cmpb #',' - lbne moderr - jsr findreg - ldb ,u - orb postbyte - jmp putbyte -pushpul jsr startop ;Cat 12, PSH and PUL - leax -1,x - ldb 7,u - jsr putbyte - clr postbyte -pploop jsr findreg - ldb 1,u - orb postbyte - stb postbyte - ldb ,x+ - cmpb #',' - beq pploop - leax -1,x - ldb postbyte - jmp putbyte -pseudo ;Cat 13, pseudo oeprations - rts - -* Adjust opcdoe depending on mode (in $80-$FF range) -adjopc ldb 7,u - lda amode - cmpa #2 - beq adjdir ;Is it direct? - cmpa #3 - bhs adjind ;Indexed etc? - rts ;Not, then immediate, no adjust. -adjind addb #$20 ;Add $20 to opcode for indexed etc modes. - rts -adjdir addb #$10 ;Add $10 to opcode for direct8 - lda opsize - deca - bne adjind ;If opsize=2, add another $20 for extended16 - rts - -* Start scanning of operands. -startop ldx temp3 - clr amode - jmp skipspace - -* amode settings in assembler: 1=immediate, 2=direct/extended, 3=indexed -* etc. 4=pc relative, 5=indirect, 6=pcrelative and indirect. - -* This subroutine scans the assembler operands. -scanops bsr startop - cmpb #'[' - bne noindir - lda #5 ;operand starts with [, then indirect. - sta amode - ldb ,x+ -noindir cmpb #'#' - lbeq doimm - cmpb #',' - lbeq dospecial - andb #CASEMASK ;Convert to uppercase. - lda #$86 - cmpb #'A' - beq scanacidx - lda #$85 - cmpb #'B' - beq scanacidx - lda #$8B - cmpb #'D' - bne scanlab -scanacidx ldb ,x+ ;Could it be A,X B,X or D,X - cmpb #',' - bne nocomma - sta postbyte - clr opsize - jsr set3 - jsr scanixreg - bra scanend -nocomma leax -1,x -scanlab leax -1,x ;Point to the start of the operand - jsr exprvec - lbeq exprerr - std operand - tst uncert - bne opsz2 ;Go for extended if operand unknown. - subd dpsetting - tsta ;Can we use 8-bit operand? - bne opsz2 - inca - bra opsz1 -opsz2 lda #2 -opsz1 sta opsize ;Set opsize depending on magnitude of op. - lda amode - cmpa #5 - bne opsz3 ;Or was it indirect. - lda #2 ;Then we have postbyte and opsize=2 - sta opsize - lda #$8F - sta postbyte - bra opsz4 -opsz3 lda #2 - sta amode ;Assume direct or absolute addressing -opsz4 ldb ,x+ - cmpb #',' - lbeq doindex ;If followed by, then indexed. -scanend lda amode - cmpa #5 - blo scanend2 ;Was it an indirect mode? - lda postbyte - ora #$10 ;Set indirect bit. - sta postbyte - ldb ,x+ - cmpb #']' ;Check for the other ] - lbeq moderr -scanend2 rts -doimm jsr exprvec ;Immediate addressing. - lbeq exprerr - std operand - lda amode - cmpa #5 - lbeq moderr ;Inirect mode w/ imm is illegal. - lda #$01 - sta amode - rts -dospecial jsr set3 - clr opsize - clra -adecloop ldb ,x+ - cmpb #'-' - bne adecend - inca ;Count the - signs for autodecrement. - bra adecloop -adecend leax -1,x - cmpa #2 - lbhi moderr - tsta - bne autodec - clr postbyte - jsr scanixreg - clra -aincloop ldb ,x+ - cmpb #'+' - bne aincend - inca - bra aincloop ;Count the + signs for autoincrement. -aincend leax -1,x - cmpa #2 - lbhi moderr - tsta - bne autoinc - lda #$84 - ora postbyte - sta postbyte - bra scanend -autoinc adda #$7f - ora postbyte - sta postbyte - bra scanend -autodec adda #$81 - sta postbyte - jsr scanixreg - lbra scanend -doindex clr postbyte - jsr set3 - ldb ,x+ - andb #CASEMASK ;Convert to uppercase. - cmpb #'P' - lbeq dopcrel ;Check for PC relative. - leax -1,x - clr opsize - bsr scanixreg - ldd operand - tst uncert - bne longindex ;Go for long index if operand unknown. - cmpd #-16 - blt shortindex - cmpd #15 - bgt shortindex - lda amode - cmpa #5 - beq shortind1 ;Indirect may not be 5-bit index - ;It's a five-bit index. - andb #$1f - orb postbyte - stb postbyte - lbra scanend -shortindex cmpd #-128 - blt longindex - cmpd #127 - bgt longindex -shortind1 inc opsize - ldb #$88 - orb postbyte - stb postbyte - lbra scanend -longindex lda #$2 - sta opsize - ldb #$89 - orb postbyte - stb postbyte - lbra scanend -dopcrel ldb ,x+ - andb #CASEMASK ;Convert to uppercase - cmpb #'C' - blo pcrelend - cmpb #'R' - bhi pcrelend - bra dopcrel ;Scan past the ,PCR -pcrelend leax -1,x - ldb #$8C - orb postbyte ;Set postbyte - stb postbyte - inc amode ;Set addr mode to PCR - lbra scanend - -* Scan for one of the 4 index registers and adjust postbyte. -scanixreg ldb ,x+ - andb #CASEMASK ;Convert to uppercase. - pshs x - ldx #ixregs - clra -scidxloop cmpb ,x+ - beq ixfound - adda #$20 - bpl scidxloop - jmp moderr ;Index register not found where expected. -ixfound ora postbyte - sta postbyte ;Set index reg bits in postbyte. - puls x - rts - -* This routine sets amode to 3, if it was less. -set3 lda amode - cmpa #3 - bhs set3a - lda #3 - sta amode -set3a rts - -* This subroutine lays down the address. -doaddr lda amode - cmpa #3 - blo doa1 - ldb postbyte - jsr putbyte - lda amode - anda #1 - beq doapcrel ;pc rel modes. -doa1 lda opsize - tsta - beq set3a - deca - beq doa2 - ldd operand - jmp putword -doa2 ldb operand+1 - jmp putbyte -doapcrel sty addr - ldd operand - subd addr - subd #1 - tst uncert - bne pcrlong - cmpd #-128 - blt pcrlong - cmpd #-127 - bgt pcrlong - lda #1 - sta opsize - jmp putbyte -pcrlong subd #1 - leay -1,y - inc postbyte - pshs d - ldb postbyte - jsr putbyte - lda #2 - sta opsize - puls d - jmp putword - -* This routine checks and lays down short relative address. -shortrel sty addr - subd addr - subd #1 - cmpd #-128 - blt brerr - cmpd #127 - bgt brerr - jsr putbyte - lda #4 - sta amode - lda #1 - sta opsize - rts -* This routine lays down long relative address. -longrel sty addr - subd addr - subd #2 - jsr putword - lda #4 - sta amode - lda #2 - sta opsize - rts - -brerr ldx #brmsg - jmp asmerrvec -exprerr ldx #exprmsg - jmp asmerrvec -moderr ldx #modemsg - jmp asmerrvec -asmerr pshs x - jsr xabortin - puls x - jsr outcount - jsr putcr - lds savesp - jmp cmdline - -* Find register for TFR and PSH instruction -findreg ldb #12 - pshs y,b - ldu #asmregtab -findregloop tfr x,y - lda #3 -frcmps ldb ,u - cmpb #' ' - bne frcmps1 - ldb ,y - cmpb #'A' - blt frfound -frcmps1 ldb ,y+ - andb #CASEMASK - cmpb ,u+ - bne frnextreg - deca - bne frcmps - inca - bra frfound -frnextreg inca - leau a,u - dec ,s - bne findregloop - lbra moderr -frfound leau a,u - tfr y,x - puls y,b - rts - -* This is the code for the A command, assemble instructions. -* Syntax: Aaddr -asm ldx #linebuf+1 - jsr scanhex - std addr -asmloop ldd addr - jsr outd - ldb #' ' - jsr putchar ;Print address and space. - ldx #linebuf - ldb #128 - jsr getline ;Get new line - tstb - lbeq cmdline ;Exit on empty line. - abx - clr ,x ;Make line zero terminated. - ldx #linebuf - jsr asminstr - bra asmloop - -* Jump table for monitor routines that are usable by other programs. - org $ffc0 - jmp outbyte - jmp outd - jmp scanbyte - jmp scanhex - jmp scanfact - jmp asminstr - - -* Interrupt vector addresses at top of ROM. Most are vectored through jumps -* in RAM. - org $fff2 - fdb swi3vec - fdb swi2vec - fdb firqvec - fdb irqvec - fdb swivec - fdb nmivec - fdb reset - - end diff -r 4fa2bdb0c457 -r 2088fd998865 os9/Makefile --- a/os9/Makefile Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,29 +0,0 @@ -all: os9mod makerom os9d.rom os9lv2.rom os9v.rom - -CC=clang -CFLAGS = -g - -os9mod : crc.c os9.h os9mod.c os9.h - $(CC) $(CFLAGS) -o os9mod crc.c os9mod.c - -makerom : makerom.c - $(CC) $(CFLAGS) -o makerom makerom.c - -clean : - rm -rf makerom *.rom os9mod *.dSYM - -os9v1.rom : makerom level1/init - ./makerom -o os9v1.rom level1/shell level1/sysgo level1/ioman level1/term level1/pty level1/pdisk level1/d0 level1/d1 level1/vrbf level1/v0 level1/clock level1/scf level1/rbf level1/init level1/os9p2 level1/os9p1 - -os9v2.rom : makerom level2/init - ./makerom -o os9v2.rom -2 level2/Shell level2/dir level2/d1 level2/ioman level2/os9p3_perr level2/os9p4_regdump level2/pipe level2/piper level2/pipeman level2/v0 level2/vrbf level2/scf level2/rbf level2/os9p2 level2/sysgo level2/clock level2/pdisk level2/d0 level2/pty level2/term level2/init level2/boot level2/os9p1 - -level1/init : nitros9-code - cd level1 ; make - -level2/init : nitros9-code - cd level2 ; make - -nitros9-code : - hg clone http://hg.code.sf.net/p/nitros9/code nitros9-code - diff -r 4fa2bdb0c457 -r 2088fd998865 os9/crc.c --- a/os9/crc.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -#include - -#include "os9.h" - -int os9_crc(OS9_MODULE_t *mod) -{ - int i; - u_char crc[3] = {0xff, 0xff, 0xff}; - u_char *ptr = (u_char *) mod; - u_char a; - - for (i = 0; i < INT(mod->size); i++) - { - a = *(ptr++); - - a ^= crc[0]; - crc[0] = crc[1]; - crc[1] = crc[2]; - crc[1] ^= (a >> 7); - crc[2] = (a << 1); - crc[1] ^= (a >> 2); - crc[2] ^= (a << 6); - a ^= (a << 1); - a ^= (a << 2); - a ^= (a << 4); - if (a & 0x80) { - crc[0] ^= 0x80; - crc[2] ^= 0x21; - } - } - if ((crc[0] == OS9_CRC0) && - (crc[1] == OS9_CRC1) && - (crc[2] == OS9_CRC2)) - return 1; - - return 0; -} - -int os9_header(OS9_MODULE_t *mod) -{ - u_char tmp = 0x00; - u_char *ptr = (u_char *) mod; - int i; - - for (i = 0; i < OS9_HEADER_SIZE; i++) - tmp ^= *(ptr++); - - return tmp; -} diff -r 4fa2bdb0c457 -r 2088fd998865 os9/level1/Makefile --- a/os9/level1/Makefile Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ - -OS9SRC = ../nitros9-code -SRCDIR = $(OS9SRC)/level1/modules -SRCCMD = $(OS9SRC)/level1/cmds -SRCDIR2 = $(OS9SRC)/level2/modules - -A09 = ../../a09 -I $(OS9SRC)/defs/ - -MOD = pdisk init os9p1 os9p2 ioman pipe piper rbf scf term pty d0 d1 vrbf v0 clock shell dir mdir sysgo shell - -all : ${MOD} - -clean : - rm -f $(MOD) *.lst krn.asm - -LST = -l $@.lst - -# our own module for sbc09 -# CoCoOS9's level1/os9p1.asm has wrong vector value, use our own - -pdisk : - $(A09) pdisk.asm -o pdisk $(LST) - -#boot : boot.asm -# $(A09) boot.asm -o boot $(LST) - -init : init.asm - $(A09) ${SRCDIR}/init.asm -o $@ $(LST) -# $(A09) init.asm -o init $(LST) - -pty : pty.asm - $(A09) pty.asm -o pty $(LST) - -term : pty-dd.asm - $(A09) pty-dd.asm -o term $(LST) - -d0 : d0.asm - $(A09) d0.asm -o d0 $(LST) - -d1 : d1.asm - $(A09) d1.asm -o d1 $(LST) - -clock : clock.asm - $(A09) clock.asm -o clock $(LST) - -vrbf : - $(A09) ../level2/vrbf.asm -o $@ $(LST) - -v0 : - $(A09) v0.asm -o $@ $(LST) - -# os9 level1 moduels - -shell : $(SRCCMD)/shell_21.asm - $(A09) $< -o $@ $(LST) - -mdir : ${SRCCMD}/mdir.asm - $(A09) $< -o $@ $(LST) - -dir : ${SRCCMD}/dir.asm - $(A09) ${SRCCMD}/dir.asm -o dir $(LST) - -os9p1 : - cat ${OS9SRC}//defs/coco.d ${SRCDIR}/kernel/krn.asm > krn.asm - $(A09) -I ../nitros9-code/level1/modules/kernel/ krn.asm -o os9p1 $(LST) - -os9p2 : - $(A09) ${SRCDIR}/kernel/krnp2.asm -o os9p2 $(LST) - -sysgo : - $(A09) sysgo.asm -o sysgo $(LST) - -ioman : - $(A09) ${SRCDIR}/ioman.asm -o ioman $(LST) - -pipe : - $(A09) ${SRCDIR}/pipe.asm -o pipe $(LST) - -piper : - $(A09) ${SRCDIR}/piper.asm -o piper $(LST) - -rbf : - $(A09) ${SRCDIR}/rbf.asm -o rbf $(LST) - -scf : - $(A09) ${SRCDIR}/scf.asm -o scf $(LST) - diff -r 4fa2bdb0c457 -r 2088fd998865 os9/level1/clock.asm --- a/os9/level1/clock.asm Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -******************************************************************** -* Clock - OS-9 Level One V2 Clock module -* -* $Id: clock.asm,v 1.1.1.1 2001/02/21 23:30:52 boisy Exp $ -* -* NOTE: This clock is TOTALLY VALID for ALL DATES between 1900-2155 -* -* Ed. Comments Who YY/MM/DD -* ------------------------------------------------------------------ -* 5 Tandy/Microware original version -* 6 Modified to handle leap years properly for BGP 99/05/03 -* 1900 and 2100 A.D. - - nam Clock - ttl OS-9 Level One V2 Clock module - - ifp1 - use defsfile - endc - -tylg set Systm+Objct -atrv set ReEnt+rev -rev set $01 -edition set $06 -TimerPort set $e030 -TkPerSec set 60 -TkPerTS equ TkPerSec/10 ticks per time slice - - - mod eom,name,tylg,atrv,ClkEnt,size - -size equ . - -name fcs /Clock/ - fcb edition - -SysTbl fcb F$Time - fdb FTime-*-2 - fcb $80 - - -ClockIRQ clra - tfr a,dp - ldx #TimerPort - lda ,x - bita #$10 - beq L00B4 - ldb #$8f start timer - stb ,x -L00B4 - jmp [>D.SvcIRQ] - -ClkEnt equ * - ldd #59*256+$01 last second and last tick - std PIA0Base+3 -* nop -* nop -* sta >$FFDF turn off ROM mode -* jmp >Bt.Start+2 jump to boot -* BasicRL equ *-BasicRst - ENDC - ENDC - -Init fcs /Init/ - -* Entry: X = pointer to start of nul terminated string -* Exit: D = length of string -strlen pshs x - ldd #-1 -go@ addd #$0001 - tst ,x+ - bne go@ - puls x,pc - -* Display carriage-return/line-feed. -WriteCR pshs y - leax CrRtn,pcr - ldy #$0001 - os9 I$WritLn - puls y,pc - -********************************************************** -* SysGo Entry Point -********************************************************** -start leax >IcptRtn,pcr - os9 F$Icpt -* Set priority of this process - os9 F$ID - ldb #DefPrior - os9 F$SPrior - -* Write OS name and Machine name strings - leax Init,pcr - clra - pshs u - os9 F$Link - bcs SignOn - stx Banner,pcr - ldy #BannLen - lda #$01 standard output - os9 I$Write write out banner - -* Set default time and start Clock module - leax >DefTime,pcr - os9 F$STime set time to default - - IFEQ 1 - leax >MDIR,pcr - leau >mdirprm,pcr - ldd #$0100 - ldy #$0003 - os9 F$Fork - bcs mdirend AutoEx failed.. - os9 F$Wait - ldu ,s - bra mdirend -MDIR fcc "mdir" - fcb $0d -mdirprm fcc "-e" - fcb C$CR -mdirend - ldu ,s - ENDC - -* IFEQ ROM -* Change EXEC and DATA dirs - leax >ExecDir,pcr - lda #EXEC. - os9 I$ChgDir change exec. dir - leax >DefDev,pcr -* Made READ. so that no write occurs at boot (Boisy on Feb 5, 2012) - lda #READ. - os9 I$ChgDir change data dir. - bcs L0125 -* leax >HDDev,pcr -* lda #EXEC. -* os9 I$ChgDir change exec. dir to HD -* ENDC - -L0125 equ * - IFEQ atari+corsham - IFEQ Level-1 -* Setup BASIC code (CoCo port only) -* leax >BasicRst,pcr -* ldu #D.CBStrt -* ldb #BasicRL -*CopyLoop lda ,x+ -* sta ,u+ -* decb -* bne CopyLoop - ELSE - os9 F$ID get process ID - lbcs L01A9 fail - leax ,u - os9 F$GPrDsc get process descriptor copy - lbcs L01A9 fail - leay ,u - ldx #$0000 - ldb #$01 - os9 F$MapBlk - bcs L01A9 - -* lda #$55 set flag for Color BASIC -* sta Shell,pcr -* leau >Startup,pcr -* ldd #256 -* ldy #StartupL -* os9 F$Fork -* bcs DoAuto Startup failed.. -* os9 F$Wait -* ENDC - -* Fork AutoEx here -*DoAuto leax >AutoEx,pcr -* leau >CRtn,pcr -* ldd #$0100 -* ldy #$0001 -* os9 F$Fork -* bcs L0186 AutoEx failed.. -* os9 F$Wait - -L0186 equ * - ldu ,s -FrkShell leax >ShellPrm,pcr - leay ,u - ldb #ShellPL -L0190 lda ,x+ - sta ,y+ - decb - bne L0190 -* Fork final shell here - leax >Shell,pcr - lda #$01 D = 256 (B already 0 from above) - ldy #ShellPL - IFGT Level-1 - os9 F$Chain Level 2/3. Should not return.. - ldb #$06 it did! Fatal. Load error code - bra Crash - -L01A9 ldb #$04 error code -Crash clr >DPort+$08 turn off disk motor - jmp TimerPort - jmp [>D.Clock] - -TkPerTS equ 2 - -ClkEnt equ * - pshs cc - orcc #FIRQMask+IRQMask mask ints - leax >ClockIRQ,pcr - stx ClockFIRQ,pcr - stx $FFF6 must be a RAM - endc -* install system calls - leay >SysTbl,pcr - os9 F$SSvc - ldd #59*256+TkPerTS last second and time slice in minute - std PIA0Base+3 -* nop -* nop -* sta >$FFDF turn off ROM mode -* jmp >Bt.Start+2 jump to boot -* BasicRL equ *-BasicRst - ENDC - ENDC - -Init fcs /Init/ - -* Entry: X = pointer to start of nul terminated string -* Exit: D = length of string -strlen pshs x - ldd #-1 -go@ addd #$0001 - tst ,x+ - bne go@ - puls x,pc - -* Display carriage-return/line-feed. -WriteCR pshs y - leax CrRtn,pcr - ldy #$0001 - os9 I$WritLn - puls y,pc - -********************************************************** -* SysGo Entry Point -********************************************************** -start leax >IcptRtn,pcr - os9 F$Icpt -* Set priority of this process - os9 F$ID - ldb #DefPrior - os9 F$SPrior - -* Write OS name and Machine name strings - leax Init,pcr - clra - pshs u - os9 F$Link - bcs SignOn - stx Banner,pcr - ldy #BannLen - lda #$01 standard output - os9 I$Write write out banner - -* Set default time - leax >DefTime,pcr - os9 F$STime set time to default - - IFEQ ROM -* Change EXEC and DATA dirs - leax >ExecDir,pcr - lda #EXEC. - os9 I$ChgDir change exec. dir - leax >DefDev,pcr -* Made READ. so that no write occurs at boot (Boisy on Feb 5, 2012) - lda #READ. - os9 I$ChgDir change data dir. - bcs L0125 -* leax >HDDev,pcr -* lda #EXEC. -* os9 I$ChgDir change exec. dir to HD - ENDC - -L0125 equ * - pshs u,y - IFEQ atari+corsham - IFEQ Level-1 -* Setup BASIC code (CoCo port only) -* leax >BasicRst,pcr -* ldu #D.CBStrt -* ldb #BasicRL -*CopyLoop lda ,x+ -* sta ,u+ -* decb -* bne CopyLoop - ELSE - os9 F$ID get process ID - lbcs L01A9 fail - leax ,u - os9 F$GPrDsc get process descriptor copy - lbcs L01A9 fail - leay ,u - ldx #$0000 - ldb #$01 - os9 F$MapBlk - bcs L01A9 - -* lda #$55 set flag for Color BASIC -* sta Shell,pcr -* leau >Startup,pcr -* ldd #256 -* ldy #StartupL -* os9 F$Fork -* bcs DoAuto Startup failed.. -* os9 F$Wait -* ENDC - -* Fork AutoEx here -*DoAuto leax >AutoEx,pcr -* leau >CRtn,pcr -* ldd #$0100 -* ldy #$0001 -* os9 F$Fork -* bcs L0186 AutoEx failed.. -* os9 F$Wait - - IFEQ Level-1 - leax >MDIR,pcr - leau >mdirprm,pcr - ldd #$0100 - ldy #$0003 - os9 F$Fork - bcs L0186 AutoEx failed.. - os9 F$Wait - bra L0186 -MDIR fcs "mdir" - fcb $0d - ENDC -L0186 equ * - puls u,y -FrkShell leax >ShellPrm,pcr - leay ,u - ldb #ShellPL -L0190 lda ,x+ - sta ,y+ - decb - bne L0190 -* Fork final shell here - leax >Shell,pcr - lda #$01 D = 256 (B already 0 from above) - ldy #ShellPL - IFGT Level-1 - os9 F$Chain Level 2/3. Should not return.. - ldb #$06 it did! Fatal. Load error code - bra Crash - -L01A9 ldb #$04 error code -Crash clr >DPort+$08 turn off disk motor - jmp -#include -#include -#include - -// #define DEBUG 1 - -/* - * Level1 - * os9p1 should be 0xf800 - * it searches ram from the beginning - * rom modules are searched from just after the end of RAM - * - * Level2 - * Coco 512kb memory space - * last 8k is a ROM (can be switched?) ( block 0x3f ) - * os9p1 search module on 0x0d00~0x1e00 at block 0x3f - * - * 8k block ( offset 0xc000 ) - * - * 0xe000 - 0xccff 0xff - * 0xed00 - 0xfeff os9 modules, os9p1 should be the last - * MMU doesnot touch below - * 0xff80 - 0xffdf IO port ( ACIA, clock, pdisk, MMU ) - * 0xffd0 - 0xffef boot code - * 0xfff0 - 0xffff intr vector - * ... next few blocks as extended ROM - * - */ - -int level = 1; -int IOBASE = 0xe000; -int IOSIZE = 0x100; -char * outfile ; - -#define LV2START 0xffd0 // our own small boot for mmu -#define LV2ROMEND 0xff80 - -// #define DEBUG - -typedef struct os9module { - int size; - int entry; - int location; - int ioflag; - unsigned char *mod; - char *name; - struct os9module *next; -} *MPTR ; - -unsigned short vec[8]; - -struct os9module * -readOS9module(char *filename) -{ - FILE *fp = fopen(filename,"rb"); - if (fp==0) { - fprintf(stderr,"cannot read %s\n",filename); - exit(1); - } - struct stat st; - fstat(fileno(fp),&st); - int size = st.st_size; - struct os9module *m = malloc(size + sizeof(struct os9module)); - m->size = size; - m->next = 0; - m->ioflag = 0; - m->mod = (unsigned char*)m + sizeof(struct os9module); - fread(m->mod , size, 1, fp); - m->name = (char*) (m->mod + (m->mod[4]*256 + m->mod[5]) ); - m->entry = m->mod[9]*256 + m->mod[10] ; - fclose(fp); - return m; -} - -void -fputword(unsigned short x, FILE *fp) -{ - fputc((x>>8)&0xff,fp); - fputc(x&0xff,fp); -} - -void printOs9Str(char *p) -{ - char *q = p; - while((*p & 0x80)==0) { - putchar(*p); - p++; - } - putchar(*p & 0x7f); - while(p>8; - adr[1] = vec&0xff; - adr += 2; - } -} - -int search_vector(MPTR m) { - unsigned char v[] = { 0x6E, 0x9F, 0x00, 0x2C, 0x6E}; - for( unsigned char *p = m->mod ; p < m->mod + m->size; p++ ) { - int i=0; - for(; i< sizeof(v); i++) { - if (p[i]!=v[i]) break; - } - if (i==sizeof(v)) - return p - m->mod; - } - return 0; -} - -// calcurate position from the botton -// avoid v09 IO map on 0xe000-0xe800 -// os9p1 have to be last and at 0xf800 -int findLocation(MPTR m, int loc) { - if (m==0) return loc; - int top = findLocation(m->next, loc) - m->size; - if (m->next==0) { - if (level == 1) - if (m->size > 0xff80-0xf800 ) { - top = 0x10000-(m->size+0x80); - } else { - top = 0xf800; // OS9p1 - } - else { -#if 0 - // old level2 kernel has vector at the bottom - top = 0x10000-(m->size+0x80); - rewrite_vector(m,m->size,m->mod+getword(m->mod+2),7); -#else - top = 0xf000; // level2 OS9p1 starts here - // and theses area are RAM /REGISTER STACK/ -#endif - } - } - if (level==1 && !(( top+m->size < IOBASE ) || ( IOBASE+IOSIZE < top)) ) { - top = IOBASE-m->size-1; - m->ioflag = 1; -#ifdef DEBUG - printf("*"); -#endif - } else if (level==2 && 0xed00 > top) { - m->ioflag = 1; - } - m->location = top; -#ifdef DEBUG - printf("mod "); - printOs9Str(m->name); - printf(" \t: 0x%x - 0x%x\n",top, top + m->size); -#endif - return top; -} - -int -main(int ac, char *av[]) -{ - int vectable = 0; - struct os9module *m = 0, root ; - root.size = 0; - root.mod = 0; - m = &root; - - for(int i = 1 ; inext = cur; - m = cur; - } - - FILE *romfile; - unsigned pos; - if (outfile==0) return 1; - - romfile=fopen(outfile,"wb"); - if(!romfile) { - fprintf(stderr,"Cannot create file %s\n",av[1]); - exit(1); - } - - - int start = findLocation(root.next,0); - start = start&0xf800; - printf("\n\n"); - - if (level==2) { - for(int i=0; i<0xd00; i++) fputc(0xff,romfile); - pos = 0xed00; - } else { - pos = start; - } - int ofs = 0; - struct os9module *os9p1 = 0; - for(struct os9module *cur = root.next; cur ; cur = cur->next ) { - if ( level==2 && cur->ioflag ==1) continue; - // last module have to os9p1 - if ( cur->next == 0 ) { - os9p1 = cur; - if ( level==1 ) { - if (os9p1->size > 0x07f0) { - ofs = (os9p1->size+0xf)&0xfff0; - ofs -= 0x07f0; - } - for(; pos < 0xf800-ofs ; pos++) { // os9p1 begins at 0xf800 - fputc(0xff,romfile); - } - } else { -#if 0 - int pend = 0x10000-( cur->size +0x80); - for(; pos < pend ; pos++) { // os9p1 ends 0xff7f - fputc(0xff,romfile); - } -#endif - for(; pos < 0xf000 ; pos++) { // level2 os9p1 start from 0xf000 - fputc(0xff,romfile); - } - } - } - printf("mod "); - printOs9Str(cur->name); - cur->location = pos; - fwrite(cur->mod, cur->size, 1, romfile); - printf(" \t: 0x%x - 0x%x size 0x%04x entry 0x%x\n",pos, pos + cur->size-1,cur->size,cur->entry+cur->location); -#ifdef DEBUG - printf(" \t: 0x%x \n",cur->location); - printf(" \t: 0x%x - 0x%x : 0x%lx \n",pos, pos + cur->size, ftell(romfile)+start); -#endif - pos = pos+cur->size; - if (level==1 && cur->ioflag) { - if (level==1) { - for(; pos < IOBASE + IOSIZE; pos++) { - fputc(0xff,romfile); - } - printf("*"); - } - } - } - printf("os9 end %x\n",pos); - if (level==1) { - vectable = 0x10000 - 2*7; - for( ; poslocation +vecofs+perm[i]*4,romfile); - } - int entry_ofs = (m->mod[9]<<8) + m->mod[10]; - fputword( os9p1->location + entry_ofs ,romfile); - // printf("os9p1 location ofs %0x\n", os9p1->location); - // printf("vector ofs %0x\n", vecofs); - // printf("reset ofs %0x\n", entry_ofs); - } else { - fputword(0xF82d-ofs,romfile); - fputword(0xF831-ofs,romfile); - fputword(0xF835-ofs,romfile); - fputword(0xF839-ofs,romfile); - fputword(0xF83d-ofs,romfile); - fputword(0xF841-ofs,romfile); - fputword(0xF876-ofs,romfile); - } - } else { - char vector[] = "level2/vector"; - FILE *fp = fopen(vector,"rb"); - if (fp==0) { - fprintf(stderr,"cannot read %s\n",vector); - exit(1); - } - for( ; poslocation); -#endif - printf("os9entry %x\n",os9p1->location+getword(os9p1->mod+9)); - - fputword(os9p1->location+getword(os9p1->mod+9),romfile); // os9p1 entry point - unsigned short vec = os9p1->location+os9p1->size - 18; - fputword(vec,romfile); - fputword(vec+3,romfile); - fputword(vec+6,romfile); - - fputword(vec+9,romfile); - fputword(vec+12,romfile); - fputword(vec+15,romfile); - fputword(LV2START,romfile); - - pos = 0x10000; - int bootsize = 2; - for(struct os9module *cur = root.next; cur ; cur = cur->next ) { - if ( cur->ioflag ==0) continue; - bootsize += cur->size; - } - fputc(bootsize>>8,romfile); - fputc(bootsize&0xff,romfile); - pos += 2; - for(struct os9module *cur = root.next; cur ; cur = cur->next ) { - if ( cur->ioflag ==0) continue; - cur->location = pos; - printf("mod "); - printOs9Str(cur->name); - fwrite(cur->mod, cur->size, 1, romfile); - printf(" \t: 0x%x - 0x%x size 0x%04x entry 0x%x\n",pos, pos + cur->size-1, cur->size, cur->entry+cur->location); -#ifdef DEBUG - printf(" \t: 0x%x \n",cur->location); - printf(" \t: 0x%x - 0x%x : 0x%lx \n",pos, pos + cur->size, ftell(romfile)+start); -#endif - pos += cur->size; - } - while(pos++ & 0xff) fputc(0xff,romfile); - } - if (level==1) - printf("boot rom from 0x%lx\n",0x10000-ftell(romfile)); - else { - long size; - printf("boot rom from 0xc000 size 0x%lx\n",(size=ftell(romfile))); - if (size > 0x4d00 + 0x2000) { - printf(" was too big. make it less than 0x6d00\n"); - } - } - fclose(romfile); - return 0; -} - - diff -r 4fa2bdb0c457 -r 2088fd998865 os9/os9.h --- a/os9/os9.h Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -typedef unsigned char u_char; - -typedef struct os9_module_t { - u_char id[2]; - u_char size[2]; - u_char name[2]; - u_char tyla; - u_char atrv; - u_char parity; - union { - u_char data[1]; /* plain modules */ - struct { - u_char exec[2]; - u_char data[1]; - } system; - struct { - u_char exec[2]; - u_char mem[2]; - u_char data[1]; - } program; - struct { - u_char exec[2]; - u_char mem[2]; - u_char mode[1]; - u_char data[1]; - } driver; - struct { - u_char exec[2]; - u_char data[1]; - } file_mgr; - struct { - u_char fmgr[2]; - u_char driver[2]; - u_char mode; - u_char port[3]; - u_char opt; - u_char dtype; - u_char data[1]; - } descriptor; - } data; -} OS9_MODULE_t; - -#define OS9_HEADER_SIZE 9 - -#define TYPE_MASK 0xF0 -typedef enum os9_type_t { - NULL_TYPE = 0, - Prgrm, - Sbtrn, - Multi, - Data, - SSbtrn, - TYPE_6, - TYPE_7, - TYPE_8, - TYPE_9, - TYPE_A, - TYPE_B, - Systm, - FlMgr, - Drivr, - Devic -} OS9_TYPE_t; - -#define LANG_MASK 0x0F -typedef enum os9_lang_t { - NULL_LANG = 0, - Objct, - ICode, - PCode, - CCode, - CblCode, - FrtnCode, - Obj6309, -} OS9_LANG_t; - -#define ATTR_MASK 0xF0 -typedef enum os9_attr_t { - ReEnt = 0x80, - Modprot = 0x40, -} OS9_attr_t; - -#define REVS_MASK 0x0F - -#define OS9_ID0 0x87 -#define OS9_ID1 0xcd - -#define OS9_CRC0 0x80 -#define OS9_CRC1 0x0F -#define OS9_CRC2 0xE3 - -#define INT(foo) (foo[0] * 256 + foo[1]) -int os9_crc(OS9_MODULE_t *mod); -int os9_header(OS9_MODULE_t *mod); diff -r 4fa2bdb0c457 -r 2088fd998865 os9/os9mod.c --- a/os9/os9mod.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,187 +0,0 @@ -#include -#include -#include -#include -#include "os9.h" - - -u_char *os9_string(u_char *string); -void ident(OS9_MODULE_t *mod); -void usage(void); -long pos; - -static char *types[16] = { - "???", "Prog", "Subr", "Multi", "Data", "USR 5", "USR 6", "USR 7", - "USR 8", "USR 9", "USR A", "USR B", "System", "File Manager", - "Device Driver", "Device Descriptor" -}; - -static char *langs[16] = { - "Data", "6809 Obj", "Basic09 I-Code", "Pascal P-Code", "C I-Code", - "Cobol I-Code", "Fortran I-Code", "6309 Obj", "???", "???", "???", - "???", "???", "???", "???", "???" -}; - -int offset = 0; - -int main(int argc, char **argv) -{ - char *filename = NULL; - FILE *fp; - u_char buffer[65536]; /* OS9 Module can't be larger than this */ - OS9_MODULE_t *mod = (OS9_MODULE_t *) buffer; - int i=0, j; - int flag = 0; - - argv++; /* skip my name */ - - if (argc == 1) - usage(); - - while ((argc >= 2) && (*argv[0] == '-')) { - if (*(argv[0] + 1) == 's') { - argc--; - flag = 1; - } else if (*(argv[0] + 1) == 'o') { - argc--; argc--; - argv++; - offset = strtol(argv[0],(char**)0,0); - } else - usage(); - argv++; - } - - - while (argc-- > 1) { - if (*argv==0) return 0; - filename = *(argv++); - - if ((fp = fopen(filename,"rb")) == NULL) { - fprintf(stderr, "Error opening file %s: %s\n", - filename, strerror(errno)); - return 1; - } - - while (!feof(fp)) { - - if (flag) { - int c; - while( !feof(fp) && (c = fgetc(fp)) != 0x87 ); - ungetc(c, fp); - } - - pos = ftell(fp); - if (fread(buffer, OS9_HEADER_SIZE, 1, fp) != 1) { - if (feof(fp)) - break; - else { - fprintf(stderr, "Error reading file %s: %s\n", - filename, strerror(errno)); - return 1; - } - } - - if ((mod->id[0] != OS9_ID0) && (mod->id[1] != OS9_ID1)) { - fprintf(stderr,"Not OS9 module, skipping.\n"); - return 1; - } - - if ((i = os9_header(mod))!=0xff) { - fprintf(stderr, "Bad header parity. Expected 0xFF, got 0x%02X\n", i); - return 1; - } - - i = INT(mod->size) - OS9_HEADER_SIZE; - if ((j = fread(buffer + OS9_HEADER_SIZE, 1, i, fp)) != i) { - fprintf(stderr,"Module short. Expected 0x%04X, got 0x%04X\n", - i + OS9_HEADER_SIZE, j + OS9_HEADER_SIZE); - return 1; - } - ident(mod); - } - fclose(fp); - } - return 0; - -} - -void ident(OS9_MODULE_t *mod) -{ - int i, j; - u_char *name, *ptr, tmp, *buffer = (u_char *) mod; - - i = INT(mod->name); - j = INT(mod->size); - name = os9_string(&buffer[i]); - printf("Offset : 0x%04lx\n", pos + offset); - printf("Header for : %s\n", name); - printf("Module size: $%X #%d\n", j, j); - ptr = &buffer[j - 3]; - printf("Module CRC : $%02X%02X%02X (%s)\n", ptr[0], ptr[1], ptr[2], - os9_crc(mod) ? "Good" : "Bad" ); - printf("Hdr parity : $%02X\n", mod->parity); - - switch ((mod->tyla & TYPE_MASK) >> 4) - { - - case Drivr: - case Prgrm: - i = INT(mod->data.program.exec); - printf("Exec. off : $%04X #%d\n", i, i); - i = INT(mod->data.program.mem); - printf("Data size : $%04X #%d\n", i, i); - break; - - case Devic: - printf("File Mgr : %s\n", - os9_string(&buffer[INT(mod->data.descriptor.fmgr)])); - printf("Driver : %s\n", - os9_string(&buffer[INT(mod->data.descriptor.driver)])); - break; - - case NULL_TYPE: - case TYPE_6: - case TYPE_7: - case TYPE_8: - case TYPE_9: - case TYPE_A: - case TYPE_B: - case Systm: - break; - } - - - - - tmp = buffer[i + strlen((const char *)name)]; - printf("Edition : $%02X #%d\n", tmp, tmp); - printf("Ty/La At/Rv: $%02X $%02x\n", mod->tyla, mod->atrv); - printf("%s mod, ", types[(mod->tyla & TYPE_MASK) >> 4]); - printf("%s, ", langs[mod->tyla & LANG_MASK]); - printf("%s, %s\n", (mod->atrv & ReEnt) ? "re-ent" : "non-share", - (mod->atrv & Modprot) ? "R/W" : "R/O" ); - printf("\n"); -} - -u_char *os9_string(u_char *string) -{ - static u_char cleaned[80]; /* strings shouldn't be longer than this */ - u_char *ptr = cleaned; - int i = 0; - - while (((*(ptr++) = *(string++)) < 0x7f) && - (i++ < sizeof(cleaned) - 1)) - ; - - *(ptr - 1) &= 0x7f; - *ptr = '\0'; - return cleaned; -} -void usage(void) -{ - printf("Usage: os9mod [-s] [-o offset] file [ file ... ]\n"); - printf("Performs an OS-9: 6809 'ident' on the specified files.\n"); - printf(" -s : skip to valid module\n"); - printf(" -o : offset \n\n"); - exit(0); -} diff -r 4fa2bdb0c457 -r 2088fd998865 os9crc.c --- a/os9crc.c Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -/* - * Generate OS9 CRC value - * - * This is a direct replacement for the Microware/Ultra-C - * library function crc() - * by Steve Rance - * https://groups.google.com/forum/#!topic/comp.os.os9/jJONahOrBX8 - */ - -static long crctable[256] = { -0x000000, 0x800063, 0x8000a5, 0x0000c6, 0x800129, 0x00014a, 0x00018c, 0x8001ef, -0x800231, 0x000252, 0x000294, 0x8002f7, 0x000318, 0x80037b, 0x8003bd, 0x0003de, -0x800401, 0x000462, 0x0004a4, 0x8004c7, 0x000528, 0x80054b, 0x80058d, 0x0005ee, -0x000630, 0x800653, 0x800695, 0x0006f6, 0x800719, 0x00077a, 0x0007bc, 0x8007df, -0x800861, 0x000802, 0x0008c4, 0x8008a7, 0x000948, 0x80092b, 0x8009ed, 0x00098e, -0x000a50, 0x800a33, 0x800af5, 0x000a96, 0x800b79, 0x000b1a, 0x000bdc, 0x800bbf, -0x000c60, 0x800c03, 0x800cc5, 0x000ca6, 0x800d49, 0x000d2a, 0x000dec, 0x800d8f, -0x800e51, 0x000e32, 0x000ef4, 0x800e97, 0x000f78, 0x800f1b, 0x800fdd, 0x000fbe, -0x8010a1, 0x0010c2, 0x001004, 0x801067, 0x001188, 0x8011eb, 0x80112d, 0x00114e, -0x001290, 0x8012f3, 0x801235, 0x001256, 0x8013b9, 0x0013da, 0x00131c, 0x80137f, -0x0014a0, 0x8014c3, 0x801405, 0x001466, 0x801589, 0x0015ea, 0x00152c, 0x80154f, -0x801691, 0x0016f2, 0x001634, 0x801657, 0x0017b8, 0x8017db, 0x80171d, 0x00177e, -0x0018c0, 0x8018a3, 0x801865, 0x001806, 0x8019e9, 0x00198a, 0x00194c, 0x80192f, -0x801af1, 0x001a92, 0x001a54, 0x801a37, 0x001bd8, 0x801bbb, 0x801b7d, 0x001b1e, -0x801cc1, 0x001ca2, 0x001c64, 0x801c07, 0x001de8, 0x801d8b, 0x801d4d, 0x001d2e, -0x001ef0, 0x801e93, 0x801e55, 0x001e36, 0x801fd9, 0x001fba, 0x001f7c, 0x801f1f, -0x802121, 0x002142, 0x002184, 0x8021e7, 0x002008, 0x80206b, 0x8020ad, 0x0020ce, -0x002310, 0x802373, 0x8023b5, 0x0023d6, 0x802239, 0x00225a, 0x00229c, 0x8022ff, -0x002520, 0x802543, 0x802585, 0x0025e6, 0x802409, 0x00246a, 0x0024ac, 0x8024cf, -0x802711, 0x002772, 0x0027b4, 0x8027d7, 0x002638, 0x80265b, 0x80269d, 0x0026fe, -0x002940, 0x802923, 0x8029e5, 0x002986, 0x802869, 0x00280a, 0x0028cc, 0x8028af, -0x802b71, 0x002b12, 0x002bd4, 0x802bb7, 0x002a58, 0x802a3b, 0x802afd, 0x002a9e, -0x802d41, 0x002d22, 0x002de4, 0x802d87, 0x002c68, 0x802c0b, 0x802ccd, 0x002cae, -0x002f70, 0x802f13, 0x802fd5, 0x002fb6, 0x802e59, 0x002e3a, 0x002efc, 0x802e9f, -0x003180, 0x8031e3, 0x803125, 0x003146, 0x8030a9, 0x0030ca, 0x00300c, 0x80306f, -0x8033b1, 0x0033d2, 0x003314, 0x803377, 0x003298, 0x8032fb, 0x80323d, 0x00325e, -0x803581, 0x0035e2, 0x003524, 0x803547, 0x0034a8, 0x8034cb, 0x80340d, 0x00346e, -0x0037b0, 0x8037d3, 0x803715, 0x003776, 0x803699, 0x0036fa, 0x00363c, 0x80365f, -0x8039e1, 0x003982, 0x003944, 0x803927, 0x0038c8, 0x8038ab, 0x80386d, 0x00380e, -0x003bd0, 0x803bb3, 0x803b75, 0x003b16, 0x803af9, 0x003a9a, 0x003a5c, 0x803a3f, -0x003de0, 0x803d83, 0x803d45, 0x003d26, 0x803cc9, 0x003caa, 0x003c6c, 0x803c0f, -0x803fd1, 0x003fb2, 0x003f74, 0x803f17, 0x003ef8, 0x803e9b, 0x803e5d, 0x003e3e -}; - -#define UPDCRC(crc,i) (crctable[((crc) >> 16 ^ (i)) & 0xff] ^ (crc) << 8) - -int os9crc(unsigned char c, int crcp) -{ - return UPDCRC(crcp, c); -} - - diff -r 4fa2bdb0c457 -r 2088fd998865 run09.sh --- a/run09.sh Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2 +0,0 @@ -#!/bin/sh -./v09 -rom os9/os9d.rom -0 ../../osnine-java/emulations/os9dragon/OS9.dsk -1 ../../osnine-java/emulations/os9dragon/WORK.dsk diff -r 4fa2bdb0c457 -r 2088fd998865 run29.sh --- a/run29.sh Mon Jul 23 10:52:33 2018 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2 +0,0 @@ -#!/bin/sh -./v09c -rom os9/os9lv2.rom -0 ../../osnine-java/emulations/os9dragon/OS9.dsk -1 ../../osnine-java/emulations/os9dragon/WORK.dsk $* diff -r 4fa2bdb0c457 -r 2088fd998865 src/.gdbinit --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/.gdbinit Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,15 @@ +handle 2 pass +define regs +call (void)printf("rax=%08lx rbx=%08lx rcx=%08lx rdx=%08lx\nrsi=%08lx rdi=%08lx rbp=%08lx rsp=%08lx rip=%08lx\n",$rax,$rbx,$rcx,$rdx,$rsi,$rdi,$rbp,$rsp,$rip) +end +define si +stepi +regs +x/1i $rip +end +define ni +nexti +regs +x/1i $rip +end + diff -r 4fa2bdb0c457 -r 2088fd998865 src/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Makefile Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,113 @@ +# +# Makefile Sim6809 +# +# created 1994 by L.C. Benschop +# 2013-10-28 - Jens Diemer: add "clean" section +# 2014-06-25 - J.E. Klasek +# +# copyleft (c) 1994-2014 by the sbc09 team, see AUTHORS for more details. +# license: GNU General Public License version 2, see LICENSE for more details. +# + +# CFLAGS=-O3 -fomit-frame-pointer -DTERM_CONTROL +CFLAGS=-g -DTERM_CONTROL + +V09FLAGS= -DUSE_TERMIOS #-DBIG_ENDIAN + + +SIM_BIN=v09s v09st + +APPS=mon2.s + +# will be installed to ".." +BIN=a09 v09 v09c d09 $(SIM_BIN) v09.rom + +TARGETS=$(BIN) $(APPS) + +OTHER=monitor.s makerom + +all: $(TARGETS) + +# ------------------------------------ + +a09 : a09.o os9crc.o + $(CC) $(CFLAGS) $(V09FLAGS) a09.o os9crc.o -o $@ + +v09: v09.o engine.o io.o d09.o trace.o vdisk.o + $(CC) -o v09 $(CFLAGS) v09.o engine.o io.o d09.o trace.o vdisk.o + +# with Coco MMU +v09c: v09.c engine.c io.c d09.o trace.o vdisk.o + $(CC) -o v09c $(CFLAGS) $(V09FLAGS) -DIOPAGE=0xff80 -DUSE_MMU=1 -DUSE_VDISK v09.c engine.c io.c d09.o trace.c vdisk.c + +a09.o : a09.c + $(CC) -c $(CFLAGS) $(V09FLAGS) $< + +v09.o: v09.c + $(CC) -c $(CFLAGS) $(V09FLAGS) $< + +d09 : d09.c + $(CC) -Wno-format-security $(CFLAGS) $(V09FLAGS) $< -o $@ + +d09.o : d09.c + $(CC) -c -DNO_MAIN -Wno-format-security $(CFLAGS) $(V09FLAGS) $< + +engine.o: engine.c + $(CC) -c $(CFLAGS) $(V09FLAGS) $< + +io.o: io.c + $(CC) -c $(CFLAGS) -DUSE_VDISK $(V09FLAGS) $< + +vdisk.o: vdisk.c v09.h + $(CC) -c $(CFLAGS) $(V09FLAGS) $< + +trace.o: trace.c v09.h + $(CC) -c $(CFLAGS) $(V09FLAGS) $< + +v09.rom: makerom monitor.s + ./makerom +#include +#include +#include + +#define NLABELS 2048 +#define MAXIDLEN 16 +#define MAXLISTBYTES 8 +#define FNLEN 30 +#define LINELEN 128 + +static int debug=0; +static struct incl { + char *name; + struct incl *next; +} *incls = 0; + +static struct longer { + int gline; + int change; + struct longer *next; +} *lglist = 0; + + +struct oprecord{char * name; + unsigned char cat; + unsigned short code;}; + +/* Instruction categories: + 0 one byte oprcodes NOP + 1 two byte opcodes SWI2 + 2 opcodes w. imm byte ANDCC + 3 LEAX etc. + 4 short branches. BGE + 5 long branches 2byte opc LBGE + 6 long branches 1byte opc LBRA + 7 accumulator instr. ADDA + 8 double reg instr 1byte opc LDX + 9 double reg instr 2 byte opc LDY + 10 single address instrs NEG + 11 TFR, EXG + 12 push,pull + 13 pseudoops +*/ + +struct oprecord optable[]={ + {"ABX",0,0x3a},{"ADCA",7,0x89},{"ADCB",7,0xc9}, + {"ADDA",7,0x8b},{"ADDB",7,0xcb},{"ADDD",8,0xc3}, + {"ANDA",7,0X84},{"ANDB",7,0xc4},{"ANDCC",2,0x1c}, + {"ASL",10,0x08},{"ASLA",0,0x48},{"ASLB",0,0x58}, + {"ASR",10,0x07},{"ASRA",0,0x47},{"ASRB",0,0x57}, + {"BCC",4,0x24},{"BCS",4,0x25},{"BEQ",4,0x27}, + {"BGE",4,0x2c},{"BGT",4,0x2e},{"BHI",4,0x22}, + {"BHS",4,0x24},{"BITA",7,0x85},{"BITB",7,0xc5}, + {"BLE",4,0x2f},{"BLO",4,0x25},{"BLS",4,0x23}, + {"BLT",4,0x2d},{"BMI",4,0x2b},{"BNE",4,0x26}, + {"BPL",4,0x2a},{"BRA",4,0x20},{"BRN",4,0x21}, + {"BSR",4,0x8d}, + {"BVC",4,0x28},{"BVS",4,0x29}, + {"CLC",1,0x1cfe},{"CLF",1,0x1cbf},{"CLI",1,0x1cef}, + {"CLIF",1,0x1caf}, + {"CLR",10,0x0f},{"CLRA",0,0x4f},{"CLRB",0,0x5f}, + {"CLV",1,0x1cfd}, + {"CMPA",7,0x81},{"CMPB",7,0xc1},{"CMPD",9,0x1083}, + {"CMPS",9,0x118c},{"CMPU",9,0x1183},{"CMPX",8,0x8c}, + {"CMPY",9,0x108c}, + {"COM",10,0x03},{"COMA",0,0x43},{"COMB",0,0x53}, + {"CWAI",2,0x3c},{"DAA",0,0x19}, + {"DEC",10,0x0a},{"DECA",0,0x4a},{"DECB",0,0x5a}, + {"DES",1,0x327f},{"DEU",1,0x335f},{"DEX",1,0x301f}, + {"DEY",1,0x313f}, + {"ELSE",13,1}, + {"EMOD",13,25}, + {"END",13,2}, + {"ENDC",13,3}, + {"ENDIF",13,3}, + {"ENDM",13,4}, + {"EORA",7,0x88},{"EORB",7,0xc8}, + {"EQU",13,5},{"EXG",11,0x1e},{"EXTERN",13,6}, + {"FCB",13,7},{"FCC",13,8}, + {"FCS",13,23}, + {"FCW",13,9}, + {"FDB",13,9}, + {"IF",13,10}, + {"IFEQ",13,30}, + {"IFGT",13,29}, + {"IFNDEF",13,33}, + {"IFNE",13,28}, + {"IFP1",13,21}, + {"INC",10,0x0c},{"INCA",0,0x4c},{"INCB",0,0x5c}, + {"INCLUDE",13,16}, + {"INS",1,0x3261},{"INU",1,0x3341},{"INX",1,0x3001}, + {"INY",1,0x3121},{"JMP",10,0x0e},{"JSR",8,0x8d}, + {"LBCC",5,0x1024},{"LBCS",5,0x1025},{"LBEQ",5,0x1027}, + {"LBGE",5,0x102c},{"LBGT",5,0x102e},{"LBHI",5,0x1022}, + {"LBHS",5,0x1024}, + {"LBLE",5,0x102f},{"LBLO",5,0x1025},{"LBLS",5,0x1023}, + {"LBLT",5,0x102d},{"LBMI",5,0x102b},{"LBNE",5,0x1026}, + {"LBPL",5,0x102a},{"LBRA",6,0x16},{"LBRN",5,0x1021}, + {"LBSR",6,0x17}, + {"LBVC",5,0x1028},{"LBVS",5,0x1029}, + {"LDA",7,0x86},{"LDB",7,0xc6},{"LDD",8,0xcc}, + {"LDS",9,0x10ce},{"LDU",8,0xce},{"LDX",8,0x8e}, + {"LDY",9,0x108e},{"LEAS",3,0x32}, + {"LEAU",3,0x33},{"LEAX",3,0x30},{"LEAY",3,0x31}, + {"LSL",10,0x08},{"LSLA",0,0x48},{"LSLB",0,0x58}, + {"LSR",10,0x04},{"LSRA",0,0x44},{"LSRB",0,0x54}, + {"MACRO",13,11}, + {"MOD",13,24}, + {"MUL",0,0x3d}, + {"NAM",13,26}, + {"NEG",10,0x00},{"NEGA",0,0x40},{"NEGB",0,0x50}, + {"NOP",0,0x12}, + {"OPT",13,19}, + {"ORA",7,0x8a},{"ORB",7,0xca},{"ORCC",2,0x1a}, + {"ORG",13,12}, + {"OS9",13,32}, + {"PAG",13,20}, {"PAGE",13,20}, + {"PSHS",12,0x34},{"PSHU",12,0x36},{"PUBLIC",13,13}, + {"PULS",12,0x35},{"PULU",12,0x37},{"RMB",13,0}, + {"ROL",10,0x09},{"ROLA",0,0x49},{"ROLB",0,0x59}, + {"ROR",10,0x06},{"RORA",0,0x46},{"RORB",0,0x56}, + {"RTI",0,0x3b},{"RTS",0,0x39}, + {"SBCA",7,0x82},{"SBCB",7,0xc2}, + {"SEC",1,0x1a01},{"SEF",1,0x1a40},{"SEI",1,0x1a10}, + {"SEIF",1,0x1a50},{"SET",13,15}, + {"SETDP",13,14},{"SEV",1,0x1a02},{"SEX",0,0x1d}, + {"STA",7,0x87},{"STB",7,0xc7},{"STD",8,0xcd}, + {"STS",9,0x10cf},{"STU",8,0xcf},{"STX",8,0x8f}, + {"STY",9,0x108f}, + {"SUBA",7,0x80},{"SUBB",7,0xc0},{"SUBD",8,0x83}, + {"SWI",0,0x3f},{"SWI2",1,0x103f},{"SWI3",1,0x113f}, + {"SYNC",0,0x13},{"TFR",11,0x1f}, + {"TITLE",13,18}, + {"TST",10,0x0d},{"TSTA",0,0x4d},{"TSTB",0,0x5d}, + {"TTL",13,18}, + {"USE",13,27}, +}; + +struct symrecord{char name[MAXIDLEN+1]; + char cat; + unsigned short value; + struct symrecord *next; + }; + +int symcounter=0; +int os9 = 0; // os9 flag +int rmbmode = 0; // in os9 work area +struct symrecord * prevlp = 0; + +/* expression categories... + ECORD all zeros is ordinary constant. + ECADR bit 1 indicates address within module. + ECEXT bit 2 indicates external address. + ECLBL bit 3 public label + ECABS bit 4 indicates this can't be relocated if it's an address. + ECNEG bit 5 indicates address (if any) is negative. +*/ + + +/* Symbol categories. exprcat ( symcat & 0xe ) + 0 SCC Constant value (from equ). ECORD + 1 SCV Variable value (from set) ECORD + 2 SCC__ADR Address within program module (label). ECADR + 3 SCV__ADR Variable containing address. ECADR + 4 SC_E_ADR Adress in other program module (extern) ECEXT + 5 SCVE_ADR Variable containing external address. ECEXT + 6 SCU _ADR Unresolved address. ECEXT+ECADR + 7 SCV_UADR Variable containing unresolved address. ECEXT+ECADR + 8 SC___LBL Public label. ECLBL + 9 SCMACRO Macro definition. xxx + 10 SCU__LBL Public label (yet undefined). ECADR+ECLBL + 11 SCPARAM parameter name. ECADR+ECLBL + 12 SCLOCAL local label. ECEXT+ECLBL + 13 SCEMPTY empty. xxx +*/ + +struct symrecord symtable[NLABELS]; + +void processfile(char *name); + +struct oprecord * findop(char * nm) +/* Find operation (mnemonic) in table using binary search */ +{ + int lo,hi,i,s; + lo=0;hi=sizeof(optable)/sizeof(optable[0])-1; + do { + i=(lo+hi)/2; + s=strcmp(optable[i].name,nm); + if(s<0) lo=i+1; + else if(s>0) hi=i-1; + else break; + } while(hi>=lo); + if (s) return NULL; + return optable+i; +} + +struct symrecord * findsym(char * nm) { +/* finds symbol table record; inserts if not found + uses binary search, maintains sorted table */ + int lo,hi,i,j,s; + lo=0;hi=symcounter-1; + s=1;i=0; + while (hi>=lo) { + i=(lo+hi)/2; + s=strcmp(symtable[i].name,nm); + if(s<0) lo=i+1; + else if(s>0) hi=i-1; + else break; + } + if(s) { + i=(s<0?i+1:i); + if(symcounter==NLABELS) { + fprintf(stderr,"Sorry, no storage for symbols!!!"); + exit(4); + } + for(j=symcounter;j>i;j--) { + struct symrecord *from = &symtable[j-1]; + if (prevlp == from) prevlp++; + if (from->next && from->next - symtable > i) from->next ++; + symtable[j]=symtable[j-1]; + } + symcounter++; + strcpy(symtable[i].name,nm); + symtable[i].cat=13; + } + return symtable+i; +} + +FILE *listfile,*objfile; +char *listname,*objname,*srcname,*curname; +int lineno,glineno; + +void +outsymtable() +{ + int i,j=0; + fprintf(listfile,"\nSYMBOL TABLE"); + for(i=0;inext) { + if (p->gline==gl) { // already fixed + p->change = 1; + return; + } + } + struct longer *p = (struct longer *)calloc(sizeof(struct longer *),1); + p->gline=gl; + p->next = lglist; + lglist = p; +} + +int longer() { + for(struct longer *p=lglist;p;p=p->next) { + if (p->change == 0) return 1; + } + return 0; +} +void generate() +{ + generating = 1; + if (rmbmode) { + rmbcounter = loccounter; + oldlc = loccounter = prevloc; + rmbmode = 0; + } +} + + +char namebuf[MAXIDLEN+1]; + +void +err(int er) { + error |= er ; +} + +void +scanname() +{ + int i=0; + char c; + while(1) { + c=*srcptr++; + if(c>='a'&&c<='z')c-=32; + if(c!='_'&&c!='@'&&c!='.'&&c!='$'&&(c<'0'||c>'9')&&(c<'A'||c>'Z'))break; + if(i='0'&&namebuf[i]<='F') { + t=t*16+namebuf[i]-'0'; + if(namebuf[i]>'9')t-=7; + i++; + } + if(i==0)error|=1; + return t; +} + +int scanchar() +{ + int t; + srcptr++; + t=*srcptr; + if(t)srcptr++; + if (*srcptr=='\'')srcptr++; + return t; +} + +int scanbin() +{ + char c; + int t=0; + srcptr++; + c=*srcptr++; + while(c=='0'||c=='1') { + t=t*2+c-'0'; + c=*srcptr++; + } + srcptr--; + return t; +} + +int scanoct() +{ + char c; + int t=0; + srcptr++; + c=*srcptr++; + while(c>='0'&&c<='7') { + t=t*8+c-'0'; + c=*srcptr++; + } + srcptr--; + return t; +} + + +int scanlabel() +{ + struct symrecord * p; + scanname(); + p=findsym(namebuf); + if(p->cat==13) { + p->cat=6; + p->value=0; + } + if(p->cat==9||p->cat==11)error|=1; + exprcat=p->cat&14; + if(exprcat==6||exprcat==10)unknown=1; + if(((exprcat==2||exprcat==8) + && (unsigned short)(p->value)>(unsigned short)loccounter)|| + exprcat==4) + certain=0; + if(exprcat==8||exprcat==6||exprcat==10)exprcat=2; + return p->value; +} + + +int scanfactor() +{ + char c; + int t; + skipspace(); + c=*srcptr; + if(isalpha(c))return scanlabel(); + else if(isdigit(c))return scandecimal(); + else switch(c) { + case '*' : srcptr++;exprcat|=2; if(rmbmode) return prevloc; else return loccounter; + case '.' : srcptr++;exprcat|=2; if(os9&&!rmbmode) return rmbcounter; else return loccounter; + case '$' : return scanhex(); + case '%' : return scanbin(); + case '&' : /* compatibility */ + case '@' : return scanoct(); + case '\'' : return scanchar(); + case '(' : srcptr++;t=scanexpr(0);skipspace(); + if(*srcptr==')')srcptr++;else error|=1; + return t; + case '-' : srcptr++;exprcat^=32;return -scanfactor(); + case '+' : srcptr++;return scanfactor(); + case '!' : srcptr++;exprcat|=16;return !scanfactor(); + case '^' : + case '~' : srcptr++;exprcat|=16;return ~scanfactor(); + } + error|=1; + return 0; +} + +#define EXITEVAL {srcptr--;return t;} + +#define RESOLVECAT if((oldcat&15)==0)oldcat=0;\ + if((exprcat&15)==0)exprcat=0;\ + if((exprcat==2&&oldcat==34)||(exprcat==34&&oldcat==2)) {\ + exprcat=0;\ + oldcat=0;}\ + exprcat|=oldcat;\ +/* resolve such cases as constant added to address or difference between + two addresses in same module */ + + +int scanexpr(int level) /* This is what you call _recursive_ descent!!!*/ +{ + int t,u; + char oldcat,c; + exprcat=0; + if(level==10)return scanfactor(); + t=scanexpr(level+1); + while(1) { + // skipspace(); + c=*srcptr++; + switch(c) { + case '*':oldcat=exprcat; + t*=scanexpr(10); + exprcat|=oldcat|16; + break; + case '/':oldcat=exprcat; + u=scanexpr(10); + if(u)t/=u;else error|=1; + exprcat|=oldcat|16; + break; + case '%':oldcat=exprcat; + u=scanexpr(10); + if(u)t%=u;else error|=1; + exprcat|=oldcat|16; + break; + case '+':if(level==9)EXITEVAL + oldcat=exprcat; + t+=scanexpr(9); + RESOLVECAT + break; + case '-':if(level==9)EXITEVAL + oldcat=exprcat; + t-=scanexpr(9); + exprcat^=32; + RESOLVECAT + break; + case '<':if(*(srcptr)=='<') { + if(level>=8)EXITEVAL + srcptr++; + oldcat=exprcat; + t<<=scanexpr(8); + exprcat|=oldcat|16; + break; + } else if(*(srcptr)=='=') { + if(level>=7)EXITEVAL + srcptr++; + oldcat=exprcat; + t=t<=scanexpr(7); + exprcat|=oldcat|16; + break; + } else { + if(level>=7)EXITEVAL + oldcat=exprcat; + t=t':if(*(srcptr)=='>') { + if(level>=8)EXITEVAL + srcptr++; + oldcat=exprcat; + t>>=scanexpr(8); + exprcat|=oldcat|16; + break; + } else if(*(srcptr)=='=') { + if(level>=7)EXITEVAL + srcptr++; + oldcat=exprcat; + t=t>=scanexpr(7); + exprcat|=oldcat|16; + break; + } else { + if(level>=7)EXITEVAL + oldcat=exprcat; + t=t>scanexpr(7); + exprcat|=oldcat|16; + break; + } + case '!':if(level>=6) { + if (*srcptr=='=') { + srcptr++; + oldcat=exprcat; + t=t!=scanexpr(6); + exprcat|=oldcat|16; + } else { + oldcat=exprcat; + t|=scanexpr(6); + exprcat|=oldcat|16; + } + } + break; + case '=':if(level>=6)EXITEVAL + if(*srcptr=='=')srcptr++; + oldcat=exprcat; + t=t==scanexpr(6); + exprcat|=oldcat|16; + break; + case '&':if(level>=5)EXITEVAL + oldcat=exprcat; + t&=scanexpr(5); + exprcat|=oldcat|16; + break; + case '^':if(level>=4)EXITEVAL + oldcat=exprcat; + t^=scanexpr(4); + exprcat|=oldcat|16; + break; + case '|':if(level>=3)EXITEVAL + oldcat=exprcat; + t|=scanexpr(3); + exprcat|=oldcat|16; + default: EXITEVAL + } + } +} + +char mode; /* addressing mode 0=immediate,1=direct,2=extended,3=postbyte + 4=pcrelative(with postbyte) 5=indirect 6=pcrel&indirect*/ +char opsize; /*desired operand size 0=dunno,1=5,2=8,3=16*/ +short operand; +unsigned char postbyte; + +int dpsetting; + + +int scanindexreg() +{ + char c; + c=*srcptr; + if(islower(c))c-=32; + if (debug) fprintf(stderr,"DEBUG: scanindexreg: indexreg=%d, mode=%d, opsize=%d, error=%d, postbyte=%02X\n",c,mode,opsize,error,postbyte); + switch(c) { + case 'X':return 1; + case 'Y':postbyte|=0x20;return 1; + case 'U':postbyte|=0x40;return 1; + case 'S':postbyte|=0x60;return 1; + default: return 0; + } +} + +void +set3() +{ + if(mode<3)mode=3; +} + +void +scanspecial() +{ + set3(); + skipspace(); + if(*srcptr=='-') { + srcptr++; + if(*srcptr=='-') { + srcptr++; + postbyte=0x83; + } else postbyte=0x82; + if(!scanindexreg())error|=2;else srcptr++; + } else { + postbyte=0x80; + if(!scanindexreg())error|=2;else srcptr++; + if(*srcptr=='+') { + srcptr++; + if(*srcptr=='+') { + srcptr++; + postbyte+=1; + } + } else postbyte+=4; + } +} + +void +scanindexed() +{ + set3(); + postbyte=0; + if(scanindexreg()) { + srcptr++; + if(opsize==0) { + if(unknown||!certain)opsize=3; + else if(operand>=-16&&operand<16&&mode==3)opsize=1; + else if(operand>=-128&&operand<128)opsize=2; + else opsize=3; + } + switch(opsize) { + case 1:postbyte+=(operand&31);opsize=0;break; + case 2:postbyte+=0x88;break; + case 3:postbyte+=0x89;break; + } + } else { /*pc relative*/ + if(toupper(*srcptr)!='P')error|=2; + else { + srcptr++; + if(toupper(*srcptr)!='C')error|=2; + else { + srcptr++; + if(toupper(*srcptr)=='R')srcptr++; + } + } + mode++;postbyte+=0x8c; + if(opsize==1)opsize=2; + } +} + +#define RESTORE {srcptr=oldsrcptr;c=*srcptr;goto dodefault;} + +void +scanoperands() +{ + char c,d,*oldsrcptr; + unknown=0; + opsize=0; + certain=1; + skipspace(); + c=*srcptr; + mode=0; + if(c=='[') { + srcptr++; + c=*srcptr; + mode=5; + } + if (debug) fprintf(stderr,"DEBUG: scanoperands: c=%c (%02X)\n",c,c); + switch(c) { + case 'D': case 'd': + oldsrcptr=srcptr; + srcptr++; + skipspace(); + if(*srcptr!=',')RESTORE else { + postbyte=0x8b; + srcptr++; + if(!scanindexreg())RESTORE else {srcptr++;set3();} + } + break; + case 'A': case 'a': + oldsrcptr=srcptr; + srcptr++; + skipspace(); + if(*srcptr!=',')RESTORE else { + postbyte=0x86; + srcptr++; + if(!scanindexreg())RESTORE else {srcptr++;set3();} + } + break; + case 'B': case 'b': + oldsrcptr=srcptr; + srcptr++; + skipspace(); + if(*srcptr!=',')RESTORE else { + postbyte=0x85; + srcptr++; + if (debug) fprintf(stderr,"DEBUG: scanoperands: breg preindex: c=%c (%02X)\n",*srcptr,*srcptr); + if(!scanindexreg())RESTORE else {srcptr++;set3();} + if (debug) fprintf(stderr,"DEBUG: scanoperands: breg: postindex c=%c (%02X)\n",*srcptr,*srcptr); + } + break; + case ',': + srcptr++; + scanspecial(); + break; + case '#': + if(mode==5)error|=2;else mode=0; + srcptr++; + if (*srcptr=='"') { + operand = (srcptr[1]<<8) + srcptr[2] ; + srcptr += 3; + break; + } + operand=scanexpr(0); + break; + case '<': + srcptr++; + if(*srcptr=='<') { + srcptr++; + opsize=1; + } else opsize=2; + goto dodefault; + case '>': + srcptr++; + opsize=3; + default: dodefault: + operand=scanexpr(0); + skipspace(); + if(*srcptr==',') { + srcptr++; + scanindexed(); + } else { + if(opsize==0) { + if(unknown||!certain||dpsetting==-1|| + (unsigned short)(operand-dpsetting*256)>=256) + opsize=3; else opsize=2; + } + if(opsize==1)opsize=2; + if(mode==5){ + postbyte=0x8f; + opsize=3; + } else mode=opsize-1; + } + } + if (debug) fprintf(stderr,"DEBUG: scanoperands: mode=%d, error=%d, postbyte=%02X\n",mode,error,postbyte); + if(mode>=5) { + skipspace(); + postbyte|=0x10; + if(*srcptr!=']')error|=2;else srcptr++; + } + if(pass==2&&unknown)error|=4; +} + +unsigned char codebuf[128]; +int codeptr; /* byte offset within instruction */ +int suppress; /* 0=no suppress 1=until ENDIF 2=until ELSE 3=until ENDM */ +int ifcount; /* count of nested IFs within suppressed text */ + +unsigned char outmode; /* 0 is binary, 1 is s-records */ + +unsigned short hexaddr; +int hexcount; +unsigned char hexbuffer[16]; +unsigned int chksum; + +extern int os9crc(unsigned char c, int crcp); +int crc; + +void +reset_crc() +{ + crc = -1; +} + + +void +flushhex() +{ + int i; + if(hexcount){ + fprintf(objfile,"S1%02X%04X",(hexcount+3)&0xff,hexaddr&0xffff); + for(i=0;i>8)&0xff)+hexcount+3; + fprintf(objfile,"%02X\n",0xff-(chksum&0xff)); + hexaddr+=hexcount; + hexcount=0; + chksum=0; + } +} + +void +outhex(unsigned char x) +{ + if(hexcount==16)flushhex(); + hexbuffer[hexcount++]=x; + chksum+=x; +} + +void +outbuffer() +{ + int i; + for(i=0;i>=1; + } + error = 0; + errors++; +} + +void +outlist() +{ + int i; + fprintf(listfile,"%04X: ",oldlc); + for(i=0;inext; + l->next = 0; + setlabel(l); + } + if(lp) { + if(lp->cat!=13&&lp->cat!=6) { + if(lp->cat!=2||lp->value!=loccounter) + lp->value=loccounter; // error|=8; + } else { + lp->cat=2; + lp->value=loccounter; + } + } +} + +void +putbyte(unsigned char b) +{ + codebuf[codeptr++]=b; +} + +void +putword(unsigned short w) +{ + codebuf[codeptr++]=w>>8; + codebuf[codeptr++]=w&0x0ff; +} + +void +doaddress() /* assemble the right addressing bytes for an instruction */ +{ + int offs; + switch(mode) { + case 0: if(opsize==2)putbyte(operand);else putword(operand);break; + case 1: putbyte(operand);break; + case 2: putword(operand);break; + case 3: case 5: putbyte(postbyte); + switch(opsize) { + case 2: putbyte(operand);break; + case 3: putword(operand); + } + break; + case 4: case 6: offs=(unsigned short)operand-loccounter-codeptr-2; + if(offs<-128||offs>=128||opsize==3||unknown||!certain) { + if((!unknown)&&opsize==2&&(offs<-128||offs>=128) ) { + error|=16; makelonger(glineno); + } + offs--; + opsize=3; + postbyte++; + } + putbyte(postbyte); + if (debug) fprintf(stderr,"DEBUG: doaddress: mode=%d, opsize=%d, error=%d, postbyte=%02X, operand=%04X offs=%d\n",mode,opsize,error,postbyte,operand,offs); + if(opsize==3)putword(offs); + else putbyte(offs); + } +} + +void +onebyte(int co) +{ + putbyte(co); +} + +void +twobyte(int co) +{ + putword(co); +} + +void +oneimm(int co) +{ + scanoperands(); + if(mode>=3) + error|=2; + putbyte(co); + putbyte(operand); +} + +void +lea(int co) +{ + putbyte(co); + scanoperands(); + if(mode==0) error|=2; + if(mode<3) { + opsize=3; + postbyte=0x8f; + mode=3; + } + if (debug) fprintf(stderr,"DEBUG: lea: mode=%d, opsize=%d, error=%d, postbyte=%02X, *src=%c\n",mode,opsize,error,postbyte,*srcptr); + doaddress(); +} + +void +sbranch(int co) +{ + int offs; + scanoperands(); + if(mode!=1&&mode!=2)error|=2; + offs=(unsigned short)operand-loccounter-2; + if(!unknown&&(offs<-128||offs>=128)) { + error|=16;makelonger(glineno); + if (co==0x20) { + if(mode!=1&&mode!=2)error|=2; + putbyte(0x16); + putword(operand-loccounter-3); + } else { + if(mode!=1&&mode!=2)error|=2; + putbyte(0x10); + putbyte(co); + putword(operand-loccounter-4); + } + return; + } + if(pass==2&&unknown)error|=4; + putbyte(co); + putbyte(offs); +} + +void +lbra(int co) +{ + scanoperands(); + if(mode!=1&&mode!=2)error|=2; + putbyte(co); + putword(operand-loccounter-3); +} + +void +lbranch(int co) +{ + scanoperands(); + if(mode!=1&&mode!=2)error|=2; + putword(co); + putword(operand-loccounter-4); +} + +void +arith(int co) +{ + scanoperands(); + switch(mode) { + case 0:opsize=2;putbyte(co);break; + case 1:putbyte(co+0x010);break; + case 2:putbyte(co+0x030);break; + default:putbyte(co+0x020); + } + doaddress(); +} + +void +darith(int co) +{ + scanoperands(); + switch(mode) { + case 0:opsize=3;putbyte(co);break; + case 1:putbyte(co+0x010);break; + case 2:putbyte(co+0x030);break; + default:putbyte(co+0x020); + } + doaddress(); +} + +void +d2arith(int co) +{ + scanoperands(); + switch(mode) { + case 0:opsize=3;putword(co);break; + case 1:putword(co+0x010);break; + case 2:putword(co+0x030);break; + default:putword(co+0x020); + } + doaddress(); +} + +void +oneaddr(int co) +{ + scanoperands(); + switch(mode) { + case 0: error|=2;break; + case 1: putbyte(co);break; + case 2: putbyte(co+0x70);break; + default: putbyte(co+0x60);break; + } + doaddress(); +} + +void +tfrexg(int co) +{ + struct regrecord * p; + putbyte(co); + skipspace(); + scanname(); + if((p=findreg(namebuf))==0)error|=2; + else postbyte=(p->tfr)<<4; + skipspace(); + if(*srcptr==',')srcptr++;else error|=2; + skipspace(); + scanname(); + if((p=findreg(namebuf))==0)error|=2; + else postbyte|=p->tfr; + putbyte(postbyte); +} + +void +pshpul(int co) +{ + struct regrecord *p; + putbyte(co); + postbyte=0; + do { + if(*srcptr==',')srcptr++; + skipspace(); + scanname(); + if((p=findreg(namebuf))==0)error|=2; + else postbyte|=p->psh; + skipspace(); + }while (*srcptr==','); + putbyte(postbyte); +} + +void +skipComma() +{ + while(*srcptr && *srcptr!='\n' && *srcptr!=',')srcptr++; + if (*srcptr==',') { + srcptr++; + } else { + error|=1; + } +} + +void os9begin() +{ + generate(); + os9=1; // contiguous code generation ( seprate rmb and code ) + oldlc = loccounter = rmbcounter = rmbmode = 0; + reset_crc(); + putword(0x87cd); + putword(scanexpr(0)-loccounter); // module size + if(unknown&&pass==2)error|=4; + skipComma(); + putword(scanexpr(0)-loccounter); // offset to module name + if(unknown&&pass==2)error|=4; + skipComma(); + putbyte(scanexpr(0)); // type / language + if(unknown&&pass==2)error|=4; + skipComma(); + putbyte(scanexpr(0)); // attribute + if(unknown&&pass==2)error|=4; + int parity=0; + for(int i=0; i< 8; i++) parity^=codebuf[i]; + putbyte(parity^0xff); // header parity + skipspace(); + while (*srcptr==',') { // there are some more + srcptr++; + putword(scanexpr(0)); + if(unknown&&pass==2)error|=4; + skipspace(); + } + prevloc = codeptr; + rmbmode = 1; // next org works on rmb + rmbcounter=0; + loccounter = 0x10000-codeptr; // should start at 0 +} + +void os9end() +{ + crc = crc ^ 0xffffff; + + putbyte((crc>>16)&0xff); + putbyte((crc>>8)&0xff); + putbyte(crc&0xff); + os9 = 0; +} + + +void +pseudoop(int co,struct symrecord * lp) +{ + int i; + char c; + char *fname; + int locsave; + + switch(co) { + case 0:/* RMB */ + // in OS9 mode, this generates no data + // loccounter will be reset after any code to the current code generation + if (os9 && !rmbmode) { + prevloc = loccounter; + oldlc = loccounter = rmbcounter; + rmbmode = 1; + } + setlabel(lp); + oldlc = loccounter; + operand=scanexpr(0); + if(unknown)error|=4; + loccounter+=operand; + if(generating&&pass==2) { + if(!outmode && !os9 ) { + for(i=0;icat==13||lp->cat==6|| + (lp->value==(unsigned short)operand&&pass==2)) { + if(exprcat==2)lp->cat=2; + else lp->cat=0; + lp->value=oldlc=operand; + } else // else error|=8; + lp->value=oldlc=operand; + } + break; + case 7:/* FCB */ + generate(); + setlabel(lp); + do { + if(*srcptr==',')srcptr++; + skipspace(); + if(*srcptr=='\"') { + srcptr++; + while(*srcptr!='\"'&&*srcptr) + putbyte(*srcptr++); + if(*srcptr=='\"')srcptr++; + } else { + putbyte(scanexpr(0)); + if(unknown&&pass==2)error|=4; + } + skipspace(); + } while(*srcptr==','); + break; + case 8:/* FCC */ + generate(); + setlabel(lp); + skipspace(); + c=*srcptr++; + while(*srcptr!=c&&*srcptr) + putbyte(*srcptr++); + if(*srcptr==c)srcptr++; + break; + case 9:/* FDB */ + generate(); + setlabel(lp); + do { + if(*srcptr==',')srcptr++; + skipspace(); + putword(scanexpr(0)); + if(unknown&&pass==2)error|=4; + skipspace(); + } while(*srcptr==','); + break; + case 23 :/* FCS */ + generate(); + setlabel(lp); + skipspace(); + int sep = *srcptr; + if(sep=='\"' || sep=='/' || sep=='\'') { + srcptr++; + while(*srcptr!=sep&&*srcptr) + putbyte(*srcptr++); + if(*srcptr==sep)srcptr++; + codebuf[codeptr-1] |= 0x80; // os9 string termination + } + break; + case 1: /* ELSE */ + suppress=1; + break; + case 21: /* IFP1 */ + if(pass==2)suppress=2; + break; + case 29: /* IFGT */ + operand=scanexpr(0); + if(operand<=0)suppress=2; + break; + case 31: /* IFLT */ + operand=scanexpr(0); + if(operand>=0)suppress=2; + break; + case 30: /* IFEQ */ + operand=scanexpr(0); + if(operand!=0)suppress=2; + break; + case 28: /* IFNE */ + case 10: /* IF */ + operand=scanexpr(0); + if(operand==0)suppress=2; + break; + case 33: /* IFNDEF */ + operand=scanexpr(0); + if(!unknown)suppress=2; + break; + case 12: /* ORG */ + operand=scanexpr(0); + if(unknown)error|=4; + if(generating&&pass==2&&!outmode&&!os9) { + for(i=0;i<(unsigned short)operand-loccounter;i++) + fputc(0,objfile); + } else flushhex(); + loccounter=operand; + hexaddr=loccounter; + break; + case 14: /* SETDP */ + operand=scanexpr(0); + if(unknown)error|=4; + if(!(operand&255))operand=(unsigned short)operand>>8; + if((unsigned)operand>255)operand=-1; + dpsetting=operand; + break; + case 15: /* SET */ + operand=scanexpr(0); + if(!lp)error|=32; + else { + if(lp->cat&1||lp->cat==6) { + if(exprcat==2)lp->cat=3; + else lp->cat=1; + lp->value=oldlc=operand; + } else // else error|=8; + lp->value=oldlc=operand; + } + break; + case 2: /* END */ + terminate=1; + break; + case 27: /* USE */ + case 16: /* INCLUDE */ + skipspace(); + if(*srcptr=='"')srcptr++; + i = 0; + for(i=0; !(srcptr[i]==0||srcptr[i]=='"'); i++); + int len = i; + fname = calloc(1,len); + for(i=0;ivalue; + } + } + skipspace(); + if(isalnum(*srcptr)) { + scanname(); + op=findop(namebuf); + if(op) { + if(op->cat!=13){ + generate(); + setlabel(lp); + } + co=op->code; + switch(op->cat) { + case 0:onebyte(co);break; + case 1:twobyte(co);break; + case 2:oneimm(co);break; + case 3:lea(co);break; + case 4:sbranch(co);break; + case 5:lbranch(co);break; + case 6:lbra(co);break; + case 7:arith(co);break; + case 8:darith(co);break; + case 9:d2arith(co);break; + case 10:oneaddr(co);break; + case 11:tfrexg(co);break; + case 12:pshpul(co);break; + case 13:pseudoop(co,lp); + } + c=*srcptr; + if (debug) fprintf(stderr,"DEBUG: processline: mode=%d, opsize=%d, error=%d, postbyte=%02X c=%c\n",mode,opsize,error,postbyte,c); + if(c!=' '&&*(srcptr-1)!=' '&&c!=0&&c!=';')error|=2; + } + else error|=0x8000; + } else { + if (lp) { + lp->next = prevlp; + prevlp = lp; // os9 mode label can be data or code + } + } + if(pass==2) { + outbuffer(); + if(listing)outlist(); + } + if(error)report(); + loccounter+=codeptr; +} + +void +suppressline() +{ + struct oprecord * op; + srcptr=srcline; + oldlc=loccounter; + struct symrecord * lp = 0; + codeptr=0; + if(isalnum(*srcptr)) { + scanname();lp=findsym(namebuf); + if (lp) oldlc = lp->value; + if(*srcptr==':')srcptr++; + } + skipspace(); + scanname();op=findop(namebuf); + if(op && op->cat==13) { + if(op->code==10||op->code==13||op->code==29||op->code==28||op->code==21||op->code==30||op->code==31||op->code==33) ifcount++; + else if(op->code==3) { + if(ifcount>0)ifcount--;else if(suppress==1|suppress==2)suppress=0; + } else if(op->code==1) { + if(ifcount==0 && suppress==2)suppress=0; + } + } + if(pass==2&&listing)outlist(); } + +void +usage(char*nm) +{ + fprintf(stderr,"Usage: %s [-o objname] [-l listname] [-s srecord-file] srcname\n",nm); + exit(2); +} + +char * +strconcat(char *s,int spos,char *d) +{ + int slen = strlen(s); + int dlen = strlen(d); + if ( spos == 0) spos = slen; + char *out = calloc(1,spos+dlen+1); + int i = 0; + for(; i< spos; i++ ) out[i] = s[i]; + for(; i< spos+dlen+1; i++ ) out[i] = *d++; + return out; +} + + +void +getoptions(int c,char*v[]) +{ + int i=1; + if(c==1)usage(v[0]); + while(v[i]) { + if(strcmp(v[i],"-d")==0) { + debug=1; + i++; + } else if(strcmp(v[i],"-o")==0) { + objname = v[i+1]; + i+=2; + } else if(strcmp(v[i],"-s")==0) { + objname=v[i+1]; + outmode=1; + i+=2; + } else if(strcmp(v[i],"-l")==0) { + listname=v[i+1]; + i+=2; + } else if(strcmp(v[i],"-I")==0) { + struct incl *j = (struct incl *)malloc(sizeof(struct incl)); + j->name = v[i+1]; + j->next = 0; + if (!incls) incls = j; + else { + struct incl *k=incls ; + for(; k->next ; k = k->next ) ; + k->next = j; + } + i+=2; + } else if(*v[i]=='-') { + usage(v[0]); + } else { + if (srcname) usage(v[0]); + srcname=v[i]; + i++; + } + } + if(objname==0) { + for(i=0;srcname[i]!='.' && srcname[i]!=0 ;i++) ; + objname = strconcat(srcname,i,".b"); + } + listing=(listname!=0); +} + +void +expandline() +{ + int i=0,j=0,k,j1; + for(i=0;i<128&&j<128;i++) + { + if(inpline[i]=='\n') { + srcline[j]=0;break; + } + if(inpline[i]=='\t') { + j1=j; + for(k=0;k<8-j1%8 && j<128;k++)srcline[j++]=' '; + }else srcline[j++]=inpline[i]; + } + srcline[127]=0; +} + + +void +processfile(char *name) +{ + char *oldname; + int oldno; + FILE *srcfile; + oldname=curname; + curname=name; + oldno=lineno; + lineno=0; + if((srcfile=fopen(name,"r"))==0) { + int i = 0; + if (oldname) { + i = strlen(oldname); + while(i>0 && oldname[i]!='/') i--; + } + if (i>0) { + char *next = strconcat(oldname,i+1,name); + if((srcfile=fopen(next,"r"))!=0) { + curname = next; + } + } + if (!srcfile) { + for( struct incl *d = incls; d ; d = d->next) { + char *next = strconcat(d->name,0,name); + if((srcfile=fopen(next,"r"))!=0) { + curname = next; + break; + } + } + } + } + if (!srcfile) { + fprintf(stderr,"Cannot open source file %s\n",name); + exit(4); + } + while(!terminate&&fgets(inpline,128,srcfile)) { + expandline(); + lineno++; glineno++; + srcptr=srcline; + if(suppress) + suppressline(); + else + processline(); + } + setlabel(0); // process prevlp + fclose(srcfile); + if(suppress) { + fprintf(stderr,"improperly nested IF statements in %s",curname); + errors++; + suppress=0; + } + lineno=oldno; + curname=oldname; +} + +int +main(int argc,char *argv[]) +{ + char c; + getoptions(argc,argv); + pass=1; + errors=0; + generating=0; + terminate=0; + processfile(srcname); + if(errors) { + fprintf(stderr,"%d Pass 1 Errors, Continue?",errors); + c=getchar(); + if(c=='n'||c=='N') exit(3); + } + do { + pass=2; + prevloc = 0; + loccounter=0; + rmbcounter=0; + errors=0; + generating=0; + terminate=0; + glineno=0; + if(listing&&((listfile=fopen(listname,"w"))==0)) { + fprintf(stderr,"Cannot open list file"); + exit(4); + } + if((objfile=fopen(objname,outmode?"w":"wb"))==0) { + fprintf(stderr,"Cannot write object file\n"); + exit(4); + } + processfile(srcname); + fprintf(stderr,"%d Pass 2 errors.\n",errors); + if(listing) { + fprintf(listfile,"%d Pass 2 errors.\n",errors); + outsymtable(); + fclose(listfile); + } + if(outmode){ + flushhex(); + fprintf(objfile,"S9030000FC\n"); + } + fclose(objfile); + } while (longer()); + return 0; +} + diff -r 4fa2bdb0c457 -r 2088fd998865 src/d09.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/d09.c Mon Jul 23 16:07:12 2018 +0900 @@ -0,0 +1,1662 @@ +#include +#include +#include +#include +#include +#include +#include + + +/*************************************************************************** + Originally posted to comp.sys.m6809 by Didier Derny (didier@aida.remcomp.fr) + + Minor hacks by Alan DeKok + + Fixed: D_Indexed addressing used prog[2] and prog[3] when it meant + prog[pc+2] and prog[pc+3]: Would produce flawed disassemblies! + + changed addresses in D_Indexed to be all hex. + added 2 instances of 'extrabyte' in D_Indexed: would not skip them.. + Added PC offsets to D_Indexed ,PCR formats + added SWI2 print out as OS9 + + To do: + + handle command-line options properly... + + Fix handling of illegal opcodes so it doesn't skip a byte + i.e. $87 is a skip 2 + + Move defines to another file + + Add 6309 support + also add 6309 native-mode support, and listing of clock cycles for opcodes. + + Add OS-9 support + + add proper label-disassembly. i.e. 2-pass. + +****************************************************************************/ + +// extern int errno; +// extern char *sys_errlist[]; + +static unsigned char prog0[65536]; +unsigned char *prog = prog0; + +FILE *fp; + +typedef struct { + char *name; + int clock; + int bytes; + int (*display)(); + int (*execute)(); +} Opcode; + +typedef struct { + int address; + int length; + int width; +} String; + +int D_Illegal(Opcode *, int, int, char *); +int D_Direct(Opcode *, int, int, char *); +int D_Page10(Opcode *, int, int, char *); +int D_Page11(Opcode *, int, int, char *); +int D_Immediat(Opcode *, int, int, char *); +int D_ImmediatL(Opcode *, int, int, char *); +int D_Inherent(Opcode *, int, int, char *); +int D_Indexed(Opcode *, int, int, char *); +int D_Extended(Opcode *, int, int, char *); +int D_Relative(Opcode *, int, int, char *); +int D_RelativeL(Opcode *, int, int, char *); +int D_Register0(Opcode *, int, int, char *); +int D_Register1(Opcode *, int, int, char *); +int D_Register2(Opcode *, int, int, char *); +int D_Page10(Opcode *, int, int, char *); +int D_Page11(Opcode *, int, int, char *); +int D_OS9(Opcode *, int, int, char *); +char *IndexRegister(int); + +String stringtable[] = { + { 0xc321, 16, 16 }, + { 0xc395, 258, 16 }, + { 0xeb15, 50, 16 }, + { 0xee6f, 128, 16 }, + { 0xfdf4, 492, 16 }, + { 0xfff0, 16, 2 }, +}; + +int adoffset = 0; +int laststring = 6; + +Opcode optable[] = { + { "NEG ", 6, 2, D_Direct, NULL }, /* 0x00 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x01 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x02 */ + { "COM ", 6, 2, D_Direct, NULL }, /* 0x03 */ + { "LSR ", 6, 2, D_Direct, NULL }, /* 0x04 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x05 */ + { "ROR ", 6, 2, D_Direct, NULL }, /* 0x06 */ + { "ASR ", 6, 2, D_Direct, NULL }, /* 0x07 */ + { "LSL ", 6, 2, D_Direct, NULL }, /* 0x08 */ + { "ROR ", 6, 2, D_Direct, NULL }, /* 0x09 */ + { "DEC ", 6, 2, D_Direct, NULL }, /* 0x0a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0b */ + { "INC ", 6, 2, D_Direct, NULL }, /* 0x0c */ + { "TST ", 6, 2, D_Direct, NULL }, /* 0x0d */ + { "JMP ", 3, 2, D_Direct, NULL }, /* 0x0e */ + { "CLR ", 6, 2, D_Direct, NULL }, /* 0x0f */ + + { "", 0, 1, D_Page10, NULL }, /* 0x10 */ + { "", 0, 1, D_Page11, NULL }, /* 0x11 */ + { "NOP ", 2, 1, D_Inherent, NULL }, /* 0x12 */ + { "SYNC ", 4, 1, D_Inherent, NULL }, /* 0x13 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x14 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x15 */ + { "LBRA ", 5, 3, D_RelativeL, NULL }, /* 0x16 */ + { "LBSR ", 9, 3, D_RelativeL, NULL }, /* 0x17 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x18 */ + { "DAA ", 2, 1, D_Inherent, NULL }, /* 0x19 */ + { "ORCC ", 3, 2, D_Immediat, NULL }, /* 0x1a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1b */ + { "ANDCC", 3, 2, D_Immediat, NULL }, /* 0x1c */ + { "SEX ", 2, 1, D_Inherent, NULL }, /* 0x1d */ + { "EXG ", 8, 2, D_Register0, NULL }, /* 0x1e */ + { "TFR ", 6, 2, D_Register0, NULL }, /* 0x1f */ + + { "BRA ", 3, 2, D_Relative, NULL }, /* 0x20 */ + { "BRN ", 3, 2, D_Relative, NULL }, /* 0x21 */ + { "BHI ", 3, 2, D_Relative, NULL }, /* 0x22 */ + { "BLS ", 3, 2, D_Relative, NULL }, /* 0x23 */ + { "BCC ", 3, 2, D_Relative, NULL }, /* 0x24 */ + { "BCS ", 3, 2, D_Relative, NULL }, /* 0x25 */ + { "BNE ", 3, 2, D_Relative, NULL }, /* 0x26 */ + { "BEQ ", 3, 2, D_Relative, NULL }, /* 0x27 */ + { "BVC ", 3, 2, D_Relative, NULL }, /* 0x28 */ + { "BVS ", 3, 2, D_Relative, NULL }, /* 0x29 */ + { "BPL ", 3, 2, D_Relative, NULL }, /* 0x2a */ + { "BMI ", 3, 2, D_Relative, NULL }, /* 0x2b */ + { "BGE ", 3, 2, D_Relative, NULL }, /* 0x2c */ + { "BLT ", 3, 2, D_Relative, NULL }, /* 0x2d */ + { "BGT ", 3, 2, D_Relative, NULL }, /* 0x2e */ + { "BLE ", 3, 2, D_Relative, NULL }, /* 0x2f */ + + { "LEAX ", 4, 2, D_Indexed, NULL }, /* 0x30 */ + { "LEAY ", 4, 2, D_Indexed, NULL }, /* 0x31 */ + { "LEAS ", 4, 2, D_Indexed, NULL }, /* 0x32 */ + { "LEAU ", 4, 2, D_Indexed, NULL }, /* 0x33 */ + { "PSHS ", 5, 2, D_Register1, NULL }, /* 0x34 */ + { "PULS ", 5, 2, D_Register1, NULL }, /* 0x35 */ + { "PSHU ", 5, 2, D_Register2, NULL }, /* 0x36 */ + { "PULU ", 5, 2, D_Register2, NULL }, /* 0x37 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x38 */ + { "RTS ", 5, 1, D_Inherent, NULL }, /* 0x39 */ + { "ABX ", 3, 1, D_Inherent, NULL }, /* 0x3a */ + { "RTI ", 6, 1, D_Inherent, NULL }, /* 0x3b */ + { "CWAI ", 20, 2, D_Inherent, NULL }, /* 0x3c */ + { "MUL ", 11, 1, D_Inherent, NULL }, /* 0x3d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x3e */ + { "SWI ", 19, 1, D_Inherent, NULL }, /* 0x3f */ + + { "NEGA ", 2, 1, D_Inherent, NULL }, /* 0x40 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x41 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x42 */ + { "COMA ", 2, 1, D_Inherent, NULL }, /* 0x43 */ + { "LSRA ", 2, 1, D_Inherent, NULL }, /* 0x44 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x45 */ + { "RORA ", 2, 1, D_Inherent, NULL }, /* 0x46 */ + { "ASRA ", 2, 1, D_Inherent, NULL }, /* 0x47 */ + { "LSLA ", 2, 1, D_Inherent, NULL }, /* 0x48 */ + { "ROLA ", 2, 1, D_Inherent, NULL }, /* 0x49 */ + { "DECA ", 2, 1, D_Inherent, NULL }, /* 0x4a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4b */ + { "INCA ", 2, 1, D_Inherent, NULL }, /* 0x4c */ + { "TSTA ", 2, 1, D_Inherent, NULL }, /* 0x4d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4e */ + { "CLRA ", 2, 1, D_Inherent, NULL }, /* 0x4f */ + + { "NEGB ", 2, 1, D_Inherent, NULL }, /* 0x50 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x51 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x52 */ + { "COMB ", 2, 1, D_Inherent, NULL }, /* 0x53 */ + { "LSRB ", 2, 1, D_Inherent, NULL }, /* 0x54 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x55 */ + { "RORB ", 2, 1, D_Inherent, NULL }, /* 0x56 */ + { "ASRB ", 2, 1, D_Inherent, NULL }, /* 0x57 */ + { "LSLB ", 2, 1, D_Inherent, NULL }, /* 0x58 */ + { "ROLB ", 2, 1, D_Inherent, NULL }, /* 0x59 */ + { "DECB ", 2, 1, D_Inherent, NULL }, /* 0x5a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5b */ + { "INCB ", 2, 1, D_Inherent, NULL }, /* 0x5c */ + { "TSTB ", 2, 1, D_Inherent, NULL }, /* 0x5d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5e */ + { "CLRB ", 2, 1, D_Inherent, NULL }, /* 0x5f */ + + { "NEG ", 6, 2, D_Indexed, NULL }, /* 0x60 */ + { "?????", 0, 2, D_Illegal, NULL }, /* 0x61 */ + { "?????", 0, 2, D_Illegal, NULL }, /* 0x62 */ + { "COM ", 6, 2, D_Indexed, NULL }, /* 0x63 */ + { "LSR ", 6, 2, D_Indexed, NULL }, /* 0x64 */ + { "?????", 0, 2, D_Indexed, NULL }, /* 0x65 */ + { "ROR ", 6, 2, D_Indexed, NULL }, /* 0x66 */ + { "ASR ", 6, 2, D_Indexed, NULL }, /* 0x67 */ + { "LSL ", 6, 2, D_Indexed, NULL }, /* 0x68 */ + { "ROL ", 6, 2, D_Indexed, NULL }, /* 0x69 */ + { "DEC ", 6, 2, D_Indexed, NULL }, /* 0x6a */ + { "?????", 0, 2, D_Illegal, NULL }, /* 0x6b */ + { "INC ", 6, 2, D_Indexed, NULL }, /* 0x6c */ + { "TST ", 6, 2, D_Indexed, NULL }, /* 0x6d */ + { "JMP ", 3, 2, D_Indexed, NULL }, /* 0x6e */ + { "CLR ", 6, 2, D_Indexed, NULL }, /* 0x6f */ + + { "NEG ", 7, 3, D_Extended, NULL }, /* 0x70 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x71 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x72 */ + { "COM ", 7, 3, D_Extended, NULL }, /* 0x73 */ + { "LSR ", 7, 3, D_Extended, NULL }, /* 0x74 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x75 */ + { "ROR ", 7, 3, D_Extended, NULL }, /* 0x76 */ + { "ASR ", 7, 3, D_Extended, NULL }, /* 0x77 */ + { "LSL ", 7, 3, D_Extended, NULL }, /* 0x78 */ + { "ROL ", 7, 3, D_Extended, NULL }, /* 0x79 */ + { "DEC ", 7, 3, D_Extended, NULL }, /* 0x7a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7b */ + { "INC ", 7, 3, D_Extended, NULL }, /* 0x7c */ + { "TST ", 7, 3, D_Extended, NULL }, /* 0x7d */ + { "JMP ", 4, 3, D_Extended, NULL }, /* 0x7e */ + { "CLR ", 7, 3, D_Extended, NULL }, /* 0x7f */ + + { "SUBA ", 2, 2, D_Immediat, NULL }, /* 0x80 */ + { "CMPA ", 2, 2, D_Immediat, NULL }, /* 0x81 */ + { "SBCA ", 2, 2, D_Immediat, NULL }, /* 0x82 */ + { "SUBD ", 4, 3, D_ImmediatL, NULL }, /* 0x83 */ + { "ANDA ", 2, 2, D_Immediat, NULL }, /* 0x84 */ + { "BITA ", 2, 2, D_Immediat, NULL }, /* 0x85 */ + { "LDA ", 2, 2, D_Immediat, NULL }, /* 0x86 */ + { "?????", 0, 2, D_Illegal, NULL }, /* 0x87 */ + { "EORA ", 2, 2, D_Immediat, NULL }, /* 0x88 */ + { "ADCA ", 2, 2, D_Immediat, NULL }, /* 0x89 */ + { "ORA ", 2, 2, D_Immediat, NULL }, /* 0x8a */ + { "ADDA ", 2, 2, D_Immediat, NULL }, /* 0x8b */ + { "CMPX ", 4, 3, D_ImmediatL, NULL }, /* 0x8c */ + { "BSR ", 7, 2, D_Relative, NULL }, /* 0x8d */ + { "LDX ", 3, 3, D_ImmediatL, NULL }, /* 0x8e */ + { "?????", 0, 2, D_Illegal, NULL }, /* 0x8f */ + + { "SUBA ", 4, 2, D_Direct, NULL }, /* 0x90 */ + { "CMPA ", 4, 2, D_Direct, NULL }, /* 0x91 */ + { "SBCA ", 4, 2, D_Direct, NULL }, /* 0x92 */ + { "SUBD ", 6, 2, D_Direct, NULL }, /* 0x93 */ + { "ANDA ", 4, 2, D_Direct, NULL }, /* 0x94 */ + { "BITA ", 4, 2, D_Direct, NULL }, /* 0x95 */ + { "LDA ", 4, 2, D_Direct, NULL }, /* 0x96 */ + { "STA ", 4, 2, D_Direct, NULL }, /* 0x97 */ + { "EORA ", 4, 2, D_Direct, NULL }, /* 0x98 */ + { "ADCA ", 4, 2, D_Direct, NULL }, /* 0x99 */ + { "ORA ", 4, 2, D_Direct, NULL }, /* 0x9a */ + { "ADDA ", 4, 2, D_Direct, NULL }, /* 0x9b */ + { "CMPX ", 6, 2, D_Direct, NULL }, /* 0x9c */ + { "JSR ", 7, 2, D_Direct, NULL }, /* 0x9d */ + { "LDX ", 5, 2, D_Direct, NULL }, /* 0x9e */ + { "STX ", 5, 2, D_Direct, NULL }, /* 0x9f */ + + { "SUBA ", 4, 2, D_Indexed, NULL }, /* 0xa0 */ + { "CMPA ", 4, 2, D_Indexed, NULL }, /* 0xa1 */ + { "SBCA ", 4, 2, D_Indexed, NULL }, /* 0xa2 */ + { "SUBD ", 6, 2, D_Indexed, NULL }, /* 0xa3 */ + { "ANDA ", 4, 2, D_Indexed, NULL }, /* 0xa4 */ + { "BITA ", 4, 2, D_Indexed, NULL }, /* 0xa5 */ + { "LDA ", 4, 2, D_Indexed, NULL }, /* 0xa6 */ + { "STA ", 4, 2, D_Indexed, NULL }, /* 0xa7 */ + { "EORA ", 4, 2, D_Indexed, NULL }, /* 0xa8 */ + { "ADCA ", 4, 2, D_Indexed, NULL }, /* 0xa9 */ + { "ORA ", 4, 2, D_Indexed, NULL }, /* 0xaa */ + { "ADDA ", 4, 2, D_Indexed, NULL }, /* 0xab */ + { "CMPX ", 6, 2, D_Indexed, NULL }, /* 0xac */ + { "JSR ", 7, 2, D_Indexed, NULL }, /* 0xad */ + { "LDX ", 5, 2, D_Indexed, NULL }, /* 0xae */ + { "STX ", 5, 2, D_Indexed, NULL }, /* 0xaf */ + + { "SUBA ", 5, 3, D_Extended, NULL }, /* 0xb0 */ + { "CMPA ", 5, 3, D_Extended, NULL }, /* 0xb1 */ + { "SBCA ", 5, 3, D_Extended, NULL }, /* 0xb2 */ + { "SUBD ", 7, 3, D_Extended, NULL }, /* 0xb3 */ + { "ANDA ", 5, 3, D_Extended, NULL }, /* 0xb4 */ + { "BITA ", 5, 3, D_Extended, NULL }, /* 0xb5 */ + { "LDA ", 5, 3, D_Extended, NULL }, /* 0xb6 */ + { "STA ", 5, 3, D_Extended, NULL }, /* 0xb7 */ + { "EORA ", 5, 3, D_Extended, NULL }, /* 0xb8 */ + { "ADCA ", 5, 3, D_Extended, NULL }, /* 0xb9 */ + { "ORA ", 5, 3, D_Extended, NULL }, /* 0xba */ + { "ADDA ", 5, 3, D_Extended, NULL }, /* 0xbb */ + { "CMPX ", 7, 3, D_Extended, NULL }, /* 0xbc */ + { "JSR ", 8, 3, D_Extended, NULL }, /* 0xbd */ + { "LDX ", 6, 3, D_Extended, NULL }, /* 0xbe */ + { "STX ", 6, 3, D_Extended, NULL }, /* 0xbf */ + + { "SUBB ", 2, 2, D_Immediat, NULL }, /* 0xc0 */ + { "CMPB ", 2, 2, D_Immediat, NULL }, /* 0xc1 */ + { "SBCB ", 2, 2, D_Immediat, NULL }, /* 0xc2 */ + { "ADDD ", 4, 3, D_ImmediatL, NULL }, /* 0xc3 */ + { "ANDB ", 2, 2, D_Immediat, NULL }, /* 0xc4 */ + { "BITB ", 2, 2, D_Immediat, NULL }, /* 0xc5 */ + { "LDB ", 2, 2, D_Immediat, NULL }, /* 0xc6 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xc7 */ + { "EORB ", 2, 2, D_Immediat, NULL }, /* 0xc8 */ + { "ADCB ", 2, 2, D_Immediat, NULL }, /* 0xc9 */ + { "ORB ", 2, 2, D_Immediat, NULL }, /* 0xca */ + { "ADDB ", 2, 2, D_Immediat, NULL }, /* 0xcb */ + { "LDD ", 3, 3, D_ImmediatL, NULL }, /* 0xcc */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xcd */ + { "LDU ", 3, 3, D_ImmediatL, NULL }, /* 0xce */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xcf */ + + { "SUBB ", 4, 2, D_Direct, NULL }, /* 0xd0 */ + { "CMPB ", 4, 2, D_Direct, NULL }, /* 0xd1 */ + { "SBCB ", 4, 2, D_Direct, NULL }, /* 0xd2 */ + { "ADDD ", 6, 2, D_Direct, NULL }, /* 0xd3 */ + { "ANDB ", 4, 2, D_Direct, NULL }, /* 0xd4 */ + { "BITB ", 4, 2, D_Direct, NULL }, /* 0xd5 */ + { "LDB ", 4, 2, D_Direct, NULL }, /* 0xd6 */ + { "STB ", 4, 2, D_Direct, NULL }, /* 0xd7 */ + { "EORB ", 4, 2, D_Direct, NULL }, /* 0xd8 */ + { "ADCB ", 4, 2, D_Direct, NULL }, /* 0xd9 */ + { "ORB ", 4, 2, D_Direct, NULL }, /* 0xda */ + { "ADDB ", 4, 2, D_Direct, NULL }, /* 0xdb */ + { "LDD ", 5, 2, D_Direct, NULL }, /* 0xdc */ + { "STD ", 5, 2, D_Direct, NULL }, /* 0xdd */ + { "LDU ", 5, 2, D_Direct, NULL }, /* 0xde */ + { "STU ", 5, 2, D_Direct, NULL }, /* 0xdf */ + + { "SUBB ", 4, 2, D_Indexed, NULL }, /* 0xe0 */ + { "CMPB ", 4, 2, D_Indexed, NULL }, /* 0xe1 */ + { "SBCB ", 4, 2, D_Indexed, NULL }, /* 0xe2 */ + { "ADDD ", 6, 2, D_Indexed, NULL }, /* 0xe3 */ + { "ANDB ", 4, 2, D_Indexed, NULL }, /* 0xe4 */ + { "BITB ", 4, 2, D_Indexed, NULL }, /* 0xe5 */ + { "LDB ", 4, 2, D_Indexed, NULL }, /* 0xe6 */ + { "STB ", 4, 2, D_Indexed, NULL }, /* 0xe7 */ + { "EORB ", 4, 2, D_Indexed, NULL }, /* 0xe8 */ + { "ADCB ", 4, 2, D_Indexed, NULL }, /* 0xe9 */ + { "ORB ", 4, 2, D_Indexed, NULL }, /* 0xea */ + { "ADDB ", 4, 2, D_Indexed, NULL }, /* 0xeb */ + { "LDD ", 5, 2, D_Indexed, NULL }, /* 0xec */ + { "STD ", 5, 2, D_Indexed, NULL }, /* 0xed */ + { "LDU ", 5, 2, D_Indexed, NULL }, /* 0xee */ + { "STU ", 5, 2, D_Indexed, NULL }, /* 0xef */ + + { "SUBB ", 5, 3, D_Extended, NULL }, /* 0xf0 */ + { "CMPB ", 5, 3, D_Extended, NULL }, /* 0xf1 */ + { "SBCB ", 5, 3, D_Extended, NULL }, /* 0xf2 */ + { "ADDD ", 7, 3, D_Extended, NULL }, /* 0xf3 */ + { "ANDB ", 5, 3, D_Extended, NULL }, /* 0xf4 */ + { "BITB ", 5, 3, D_Extended, NULL }, /* 0xf5 */ + { "LDB ", 5, 3, D_Extended, NULL }, /* 0xf6 */ + { "STB ", 5, 3, D_Extended, NULL }, /* 0xf7 */ + { "EORB ", 5, 3, D_Extended, NULL }, /* 0xf8 */ + { "ADCB ", 5, 3, D_Extended, NULL }, /* 0xf9 */ + { "ORB ", 5, 3, D_Extended, NULL }, /* 0xfa */ + { "ADDB ", 5, 3, D_Extended, NULL }, /* 0xfb */ + { "LDD ", 6, 3, D_Extended, NULL }, /* 0xfc */ + { "STD ", 6, 3, D_Extended, NULL }, /* 0xfd */ + { "LDU ", 6, 3, D_Extended, NULL }, /* 0xfe */ + { "STU ", 6, 3, D_Extended, NULL }, /* 0xff */ +}; + +Opcode optable10[] = { + { "?????", 0, 1, D_Illegal, NULL }, /* 0x00 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x01 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x02 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x03 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x04 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x05 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x06 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x07 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x08 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x09 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x0f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x10 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x11 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x12 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x13 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x14 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x15 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x16 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x17 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x18 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x19 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x1f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x20 */ + { "LBRN ", 5, 4, D_RelativeL, NULL }, /* 0x21 */ + { "LBHI ", 5, 4, D_RelativeL, NULL }, /* 0x22 */ + { "LBLS ", 5, 4, D_RelativeL, NULL }, /* 0x23 */ + { "LBCC ", 5, 4, D_RelativeL, NULL }, /* 0x24 */ + { "LBCS ", 5, 4, D_RelativeL, NULL }, /* 0x25 */ + { "LBNE ", 5, 4, D_RelativeL, NULL }, /* 0x26 */ + { "LBEQ ", 5, 4, D_RelativeL, NULL }, /* 0x27 */ + { "LBVC ", 5, 4, D_RelativeL, NULL }, /* 0x28 */ + { "LBVS ", 5, 4, D_RelativeL, NULL }, /* 0x29 */ + { "LBPL ", 5, 4, D_RelativeL, NULL }, /* 0x2a */ + { "LBMI ", 5, 4, D_RelativeL, NULL }, /* 0x2b */ + { "LBGE ", 5, 4, D_RelativeL, NULL }, /* 0x2c */ + { "LBLT ", 5, 4, D_RelativeL, NULL }, /* 0x2d */ + { "LBGT ", 5, 4, D_RelativeL, NULL }, /* 0x2e */ + { "LBLE ", 5, 4, D_RelativeL, NULL }, /* 0x2f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x30 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x31 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x32 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x33 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x34 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x35 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x36 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x37 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x38 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x39 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x3a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x3b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x3c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x3d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x3e */ +/* Fake SWI2 as an OS9 F$xxx system call */ + { "OS9 ", 20, 3, D_OS9, NULL }, /* 0x3f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x40 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x41 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x42 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x43 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x44 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x45 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x46 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x47 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x48 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x49 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x4f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x50 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x51 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x52 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x53 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x54 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x55 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x56 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x57 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x58 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x59 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x5f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x60 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x61 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x62 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x63 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x64 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x65 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x66 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x67 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x68 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x69 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x6a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x6b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x6c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x6d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x6e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x6f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x70 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x71 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x72 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x73 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x74 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x75 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x76 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x77 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x78 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x79 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7b */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7d */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x7f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x80 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x81 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x82 */ + { "CMPD ", 5, 4, D_ImmediatL, NULL }, /* 0x83 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x84 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x85 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x86 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x87 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x88 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x89 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x8a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x8b */ + { "CMPY ", 5, 4, D_ImmediatL, NULL }, /* 0x8c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x8d */ + { "LDY ", 4, 4, D_ImmediatL, NULL }, /* 0x8e */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x8f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0x90 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x91 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x92 */ + { "CMPD ", 7, 3, D_Direct, NULL }, /* 0x93 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x94 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x95 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x96 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x97 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x98 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x99 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x9a */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x9b */ + { "CMPY ", 7, 3, D_Direct, NULL }, /* 0x9c */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0x9d */ + { "LDY ", 6, 3, D_Direct, NULL }, /* 0x9e */ + { "STY ", 6, 3, D_Direct, NULL }, /* 0x9f */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa0 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa1 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa2 */ + { "CMPD ", 7, 3, D_Indexed, NULL }, /* 0xa3 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa4 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa5 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa6 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa7 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa8 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xa9 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xaa */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xab */ + { "CMPY ", 7, 3, D_Indexed, NULL }, /* 0xac */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xad */ + { "LDY ", 6, 3, D_Indexed, NULL }, /* 0xae */ + { "STY ", 6, 3, D_Indexed, NULL }, /* 0xaf */ + + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb0 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb1 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb2 */ + { "CMPD ", 8, 4, D_Extended, NULL }, /* 0xb3 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb4 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb5 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb6 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb7 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb8 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xb9 */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xba */ + { "?????", 0, 1, D_Illegal, NULL }, /* 0xbb */ + { "CMPY ", 8, 4, D_Extended, NULL }, /* 0xbc */ + { "?????", 0, 1, D_Illegal