Not yet tested in any real sense.
--- /dev/null
+\r
+ BIF Documentation\r
+ By Joel Matthew Rees\r
+ 19 January 1992, \r
+ 8 April 2019\r
+\r
+\r
+ BIF documentation Copyright Joel Matthew Rees 1992, 2019\r
+\r
+\r
+In the spirit of fig-FORTH, the author grants permission as follows:\r
+=========\r
+Permission to use, copy, modify, and/or distribute this software for \r
+any purpose with or without fee is hereby granted, provided that the \r
+accompanying copyright notices and this permission notice appear in \r
+all copies.\r
+\r
+THE SOFTWARE IS PROVIDED “AS IS” AND ISC DISCLAIMS ALL WARRANTIES \r
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF \r
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY \r
+SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES \r
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN \r
+AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, \r
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS \r
+SOFTWARE.\r
+=========\r
+\r
+If the copyright notices in this file and the README.TXT file are \r
+retained, including that file and this with your distribution will\r
+fulfill the copyright notice obligation.\r
+\r
+But you really should include both anyway, just to be kind to the \r
+people who receive it.\r
+\r
+Note that:\r
+\r
+BIF is architecturally derived from fig-FORTH. fig-FORTH comes courtesy\r
+of the FORTH INTEREST GROUP, PO Box 1105, San Carlos, CA 94070.\r
+\r
+This is not a commercial product; it was a student project, use it at\r
+your own risk. No warranty whatsoever is made concerning it. (If, by\r
+chance, anyone is interested in using BIF in a commercial product, I\r
+would appreciate knowing about it in advance.) The author's intent is\r
+only to make it available for experimentation, and it should be treated\r
+as strictly experimental software. DO NOT ATTEMPT TO ACCESS ORDINARY\r
+DISKS FORMATTED FOR USE BY OTHER OPERATING SYSTEMS WHILE BIF IS RUNNING!\r
+\r
+Contact as of January 2000:\r
+ joel_rees@sannet.ne.jp\r
+ http://www.page.sannet.ne.jp/joel_rees\r
+ reiisi@nettaxi.com\r
+ http://www.nettaxi.com/citizens/reiisi\r
+\r
+\r
+*******************************************************************************\r
+ General Information\r
+\r
+\r
+BIF (BInary tree, fig-FORTH) is a dialect of FORTH for the Tandy Color\r
+Computer. It is a direct-threaded version of the pre-FORTH-79 fORTH\r
+interest group publication of FORTH (fig-FORTH), using a non-standard\r
+binary tree dictionary structure. The direct-threading mechanism uses\r
+the direct-page addressing mode of the 6809, and thus may not be easily\r
+adaptable to FORTH-83. It also uses absolute addressing, and thus does\r
+not comform to the requirements of OS-9. (I am working on an\r
+indirect-threaded version of BIF for OS-9 in my spare time.)\r
+\r
+BIF.BIN is the executable object; after LOADMing it, EXEC the address\r
+&H1300 (see below). BIFSOURC.ARC contains the archived (TC31) source\r
+files; the assembler used is Disk EDTASM+. I used TSEdit to generate\r
+the source files in EDTASM+ format:\r
+\r
+line-number SPACE [label] TAB mnemonic etc. LF\r
+\r
+Using a text editor to replace the macros with their expansions should\r
+make it compatible with most other assemblers. An object which will run\r
+under the EDTASM+ "stand-alone" debugger may be generated by changing\r
+ORG $1200 in BIF.ASM to ORG $3F00.\r
+\r
+BIFSCREE.ARC contains the BIF/FORTH source for several utilities, the\r
+assembler, and double integer definitions (TOOLS.G00) and a definition\r
+pairing example (PAIRS.G28) useful for making paired lists. Using\r
+TOOLS.G00 and PAIRS.G28 directly will require moving the two files to\r
+their original granules, 0 and 28, on an ECB disk. Once they are moved,\r
+protecting the BIF screens with ECB directory entries may be a good\r
+idea. But resist the temptation to use a text editor on them. Messing\r
+with the whitespace will move the source code out of alignment with the\r
+physical FORTH/BIF screens, and thus cause the source code not to load.\r
+\r
+If you want to look at these two files with an editor, I suggest copying\r
+them to a different disk and looking at the copies. Even my favorite\r
+IBM PC editor, QEDIT, will insert a CR/LF at the end of every 512 bytes\r
+on saving, which is not good. (I wonder how many letters from OS-9\r
+users it would take to convince the folks at SEMWARE/Applied Systems\r
+Technologies to make an OS-9 version of their editor?)\r
+\r
+For $5.00, to cover postage, time, and the cost of floppies, I will send\r
+a copy of the BIF screens disk on a standard 5 1/4" (ECB formatted)\r
+floppy. If you request the EDTASM+ compatible source code, I will send\r
+that as well, on the same format disks. For $5.00 more, I will include\r
+a photo-copy of the documentation (useful if you don't have a way to\r
+print it).\r
+\r
+The documentation which follows is written in the standard FORTH\r
+documentation style. It is not intended as a primer or study guide.\r
+Brodie's Starting FORTH, Winfield's THE COMPLETE FORTH, or some other\r
+text is suggested to those unfamiliar with FORTH. Much of the code and\r
+examples should work as shown in the textbooks I recommend Leo Brodie's\r
+work, because he points out most of the places the user will have to\r
+refer to this documentation. Some of the descriptions are incomplete,\r
+particularly where definitions are intended to be used inside other\r
+definitions.\r
+\r
+The object contains a simple one-sector editor (for 32-column screens)\r
+in the EDITOR vocabulary. It does not provide search and replace, but\r
+it is sufficient, for the patient, to write code. My apologies for it.\r
+I did not have a Color Computer 3 when I wrote the original code, and\r
+haven't had the time to update it. Those with access to the fig-FORTH\r
+Installation Manual should have no problem installing the editor shown\r
+there.\r
+\r
+The assembler in the BIF screens is a full postfix assembler. The\r
+double integer screens show a quick example of its use.\r
+\r
+\r
+*******************************************************************************\r
+ Getting BIF Running\r
+\r
+\r
+Before you start, remember that BIF has the same post-fix grammar as\r
+FORTH. Think Reverse Polish, as in HP calculators.\r
+\r
+Computer: Comments:\r
+\r
+ In Disk ECB, type:\r
+LOADM "BIF.BIN" from whichever drive it is on, then remove all disks and\r
+EXEC &H1300 BIF should tell you it is running with\r
+6809 BIF V1.0\r
+OK\r
+ At this point, see if BIF is really running by typing\r
+VLIST and hitting ENTER. You should see a listing of your\r
+ main vocabulary (symbol table) which should run on for\r
+ about 200 entries, and then the computer responds with\r
+OK If this doesn't happen, you have a bad object file, get\r
+ a new copy. Otherwise, you have BIF!\r
+\r
+ If you have my BIF screens disk, put it in drive 0.\r
+ Then type\r
+6 LOAD to load the utilities starting at screen 6. After the\r
+ utilities are loaded, you can load the assembler by\r
+ typing\r
+DECIMAL 16 LOAD\r
+\r
+ If you don't have the BIF screens disk with the error\r
+ messages, type\r
+0 WARNING ! and BIF responds with\r
+OK but now tells you error numbers instead of messages.\r
+\r
+Okay, a few examples:\r
+\r
+ 42 EMIT\r
+\r
+puts the ascii character 42 (asterisk if the current BASE is DECIMAL) on\r
+the output device.\r
+\r
+ 5 6 * .\r
+\r
+prints the product of 5 and 6 (30, base ten) on the output device.\r
+\r
+ DECIMAL : CHARS 32 DO I . I EMIT CR LOOP ;\r
+ HEX 45 CHARS\r
+\r
+will set up a BIF "word" called CHARS, which, being invoked on the second\r
+line, will print the characters and hexadecimal ascii codes from SPACE\r
+up to, but not including, DASH.\r
+\r
+The BIF screens disk should always be in drive 0 if you want real error\r
+messages. If you want to look at the message text, the messages are at\r
+the front of TOOLS.G00, after the directory screen and title screen.\r
+Each message takes exactly 32 characters, including spaces and\r
+non-printing characters. Numbering starts with 0. If you have some\r
+other disk in drive 0 you will get funny and not exactly intelligent\r
+error messages. I know it's weird, but I was following the fig-FORTH\r
+model, which is designed for very limited memory.\r
+\r
+If you haven't been able to put the BIF screens disk together, you don't\r
+really need it to play around with BIF, but do clear the WARNING\r
+variable so BIF will know error messages are not available. Aside from\r
+the error messages in drive 0, there is nothing special about screens\r
+disks, except they do not have directory tracks. You should generally\r
+not put them in your drives when running under BASIC (DECB), OS-9 or\r
+some other system. By tradition, programmers use the first several\r
+screens as a hand-typed directory. You can format fresh BIF disks with\r
+either Disk Extended Color BASIC's DSKINI or OS-9's format. BIF ignores\r
+the directory information both systems write, so you also generally\r
+should not put a real DECB or OS-9 disk in while BIF is running.\r
+\r
+If you do format with OS-9, format single-sided (I used DECB's disk\r
+interface routines so BIF can't do double sided) with as many tracks as\r
+you want. To use the extra tracks, or a third or fourth drive, you will\r
+need to modify the DRIVE-OFFSET array. Pick a standard disk\r
+configuration and stick with it.\r
+\r
+An important word of warning. BIF, like FORTH, uses buffered I/O. Your\r
+screens are not actually saved to disk until you cause the system to\r
+need enough new buffers to write your editing back to the disk. To\r
+force the system to save the buffers, give BIF the SAVE-BUFFERS command.\r
+\r
+\r
+*******************************************************************************\r
+ BIF's QUICK Editor\r
+\r
+\r
+EDITOR gets you into the EDITOR vocabulary.\r
+0 QLIST lets you look at the first sector of the directory.\r
+4 B/SCR * QLIST lets you look at the first eight error messages.\r
+DECIMAL makes sure your conversion base is base ten.\r
+64 B/SCR * QUICK\r
+ lets you edit the first sector of the pairing example.\r
+ Use the cursor keys to move around; use the BREAK key to\r
+ get out. If you modified something you don't want to\r
+ change, type\r
+EMPTY-BUFFERS and ENTER. If you want to make sure your changes are\r
+ written to the disk, type\r
+SAVE-BUFFERS and ENTER.\r
+\r
+The QUICK editor is in the EDITOR vocabulary. It is available at boot\r
+up. You'll need to get into the EDITOR vocabulary, to access it. Pass\r
+it a sector number, not a screen number. Multiplying by B/SCR (which\r
+happens to be 4) will convert a screen number to a sector number. Add\r
+1, 2, or 3 to the base sector number of a screen to get the sector\r
+numbers for the second, third, and fourth sectors of that screen.\r
+\r
+The editor has no find/replace or block functions. Again I apologize\r
+for the editor, but I found it surprisingly workable. Note that the\r
+utility screens contain routines to move/copy sectors, so all is not\r
+entirely mud. One more glitch. Lower case letters will show as VDG\r
+codes until you run the cursor over them. What can I say?\r
+\r
+During editing, all arrow keys are cursor controls. Use SHIFT-LEFTARROW\r
+for destructive backspace, SHIFT-DOWNARROW for `[' left bracket,\r
+SHIFT-RIGHTARROW for `]' right bracket, SHIFT-UPARROW for `_' underscore\r
+(back-arrow on CoCo2). SHIFT-CLEAR escapes the UP-ARROW to provide the\r
+`^' caret. SHIFT-CLEAR also escapes itself to provide the backslash.\r
+\r
+Perhaps this is as good a place as any to mention a few points of\r
+terminology. A block is a sector. Sectors are numbered sequentially\r
+from 0. Sector numbering continues sequentially from drive n to drive\r
+n+1, see DRIVE-OFFSET, but also see OFFSET. A SCREEN is a kilobyte\r
+worth of blocks, in this case, four 256-byte sectors. SCREEN numbering\r
+also begins with 0. (SCREENs are called SCREENs because a SCREEN can be\r
+displayed on 16 lines of a 64-column CRT screen.) You will notice that\r
+a CoCo 2 can't properly display and edit a whole SCREEN. Finally,\r
+forward blocks are control constructs, not disk sectors.\r
+\r
+\r
+*******************************************************************************\r
+ The BIF Virtual Machine\r
+\r
+{ bifc_vm.h ---\r
+fig 6809\r
+UP [DP] pointer to the per-USER variable table (USER Pointer)\r
+IP Y pointer to the next definition (Instruction Pointer)\r
+RP S return/control stack pointer\r
+SP U parameter/data stack pointer\r
+W [S] pointer to executing definition's parameter field\r
+}\r
+ The BIF Virtual Machine\r
+\r
+fig 6809\r
+{ bifc_vm.c bif.m bifdp.a\r
+NEXT ( --- ) jmp [,y++] (macro in bif.m)\r
+ Causes the next definition to execute.\r
+\r
+DOCOL ( *** IP ) jsr <XCOL (see bif.m, bifdp.a)\r
+ Characteristic of a colon (:) definition. Begins execution of a\r
+ high-level definition, i. e., nests the definition and begins\r
+ processing icodes. Mechanically, it pushes the IP (Y register)\r
+ and loads the Parameter Field Address of the definition which\r
+ called it into the IP.\r
+}\r
+{ symbol.c bif.m bifdp.a\r
+DOVAR ( --- vadr ) jsr <XVAR (bif.m, bifdp.a)\r
+ Characteristic of a VARIABLE. A VARIABLE pushes its PFA address\r
+ on the stack. The parameter field of a VARIABLE is the actual\r
+ allocation of the variable, so that pushing its address allows\r
+ its contents to be @ed (fetched). Ordinary arrays and strings\r
+ that do not subscript themselves may be allocated by defining a\r
+ variable and immediately ALLOTting the remaining space.\r
+ VARIABLES are global to all users, and thus should have been\r
+ hidden in resource monitors, but aren't.\r
+\r
+DOCON ( --- n ) jsr <XCON (bif.m, bifdp.a)\r
+ Characteristic of a CONSTANT. A CONSTANT simply loads its value\r
+ from its parameter field and pushes it on the stack.\r
+\r
+DOUSER ( --- vadr ) jsr <XUSER (bif.m, bifdp.a)\r
+ Characteristic of a per-USER variable. USER variables are\r
+ similiar to VARIABLEs, but are allocated (by hand!) in the\r
+ per-user table. A USER variable's parameter field contains its\r
+ offset in the per-user table.\r
+\r
+DOVOC ( --- ) jsr <XVOC (bif.m, bifdp.a)\r
+ Characteristic of a VOCABULARY. A VOCABULARY stores a pointer\r
+ to itself in the current interpretation ROOT per-USER variable.\r
+ It contains a pointer to the definition at the root of its\r
+ symbol table tree. This allows the symbol table routines to\r
+ treat the root as a leaf node. This is also not standard FORTH!\r
+\r
+ ( --- PFA ) ( *** IP ) jsr <XDOES (routine in bifdp.a)\r
+ Characteristic of a DOES> defined word. The characteristics of\r
+ DOES> definitions are written in high-level icodes rather than\r
+ machine level code. The first parameter word points to the\r
+ high-level characteristic. This routine's job is to push the\r
+ IP, load the high level characteristic pointer in IP, and leave\r
+ the address following the characteristic pointer on the stack so\r
+ the parameter field can be accessed.\r
+\r
+The following are not standard FORTH characteristics:\r
+\r
+DO1ARR ( index --- eadr ) jsr <X1ARR (bif.m, bifdp.a)\r
+ Characteristic of a linear array. Linear arrays take the top\r
+ word on the stack as an index to the array, and return the\r
+ address of the element indexed. So this routine subtracts the\r
+ base index of the array, limit checks the result, then\r
+ multiplies by the size of the array elements. If the index is\r
+ out of bounds, it returns a NULL pointer (0). At some point I\r
+ intended to implement multi-dimensional arrays in a similar\r
+ manner, but I haven't. It would be a quick and interesting\r
+ project for anyone interested.\r
+\r
+DOUCON ( --- n ) jsr <XUCON (bif.m, bifdp.a)\r
+ Characteristic of a USER variable treated as a CONSTANT, i. e.,\r
+ fetches the value stored at the specified offset in the per-user\r
+ table.\r
+\r
+ ( --- d ) jsr <XDCON (bifdp.a)\r
+ Characteristic of a double integer constant; the parameter field\r
+ contains two words instead of one, both of which get pushed.\r
+}\r
+{ unused\r
+ADDTOP (MACRO in BIF.M) is not a characteristic; is used in several\r
+ routines to add a value to the top of stack.\r
+}\r
+\r
+One of the primary problems with extending BIF is that calls to the\r
+built-in characteristics are not conform to ;CODE. Defining definitions\r
+which use (;CODE) to establish the characteristics of the\r
+sybmbols/definitions they define will hav a three-byte code field, where\r
+the built-in compiling definitions -- VARIABLE, (1ARRAY, etc.,)\r
+CONSTANT, USER, :, and VOCABULARY have two-byte code fields. One\r
+specific example of the difficulties this can create is that\r
+vocabularies with special properties built in BIF, rather than by hand,\r
+can't be searched by BIF's symbol table search routine, -FIND. Of\r
+course, XVOC could be moved to VOCABULARY, where it belongs, (and might\r
+also be changed to a DOES> definition, but I don't think that's\r
+necessary on the 6809).\r
+\r
+\r
+*******************************************************************************\r
+ The BIF Symbols/Definitions/Routines\r
+\r
+\r
+I have added slightly to the FORTH documentation methods. I also show\r
+the results on the return stack and in the input buffer, where\r
+appropriate. The name on the left is the definition name, as it will be\r
+found by ' (TICK) and the outer interpreter. To the right I indicate\r
+precedence (P for higher Precedence than definition) and restrictions (C\r
+for Compile-only). Below the name, I indicate the assembler source\r
+label, where it is different from the name. The definitions on the\r
+SCREENS disk also indicate screen and sector for the source.\r
+ \r
+The parameters attempt to be mnemonic. It will help to remember that\r
+there are no stack items smaller than 16 bits; character and byte\r
+parameters will be integers with their high-bytes ignored. Double\r
+integers are 32 bits. A further reminder, parameters are listed Pascal\r
+order, first pushed first; thus, the right-most is at the top of stack,\r
+or the lowest address. I specify a list of doubles pushed onto the\r
+stack (used in the assembler) as dl. Finally, I will try to mean 16-bit\r
+integer when I say word, but I may sometimes slip and mean (per FORTH\r
+jargon) a definition/routine.\r
+\r
+Flags are slightly different than fig-FORTH -- true is set as -1, sensed\r
+as non-zero. False is zero, of course.\r
+\r
+A number of routines (such as ENCLOSE) accept and return different\r
+parameters than specified in fig-FORTH. I assume that those for whom\r
+this fact may be of consequence will have copies of the standard and can\r
+compare at their leisure.\r
+\r
+The definitions are not alphabetized, nor are they listed in order of\r
+immediate interest, but they are organized by the source file they occur\r
+in. The following file descriptions are generally accurate, but some\r
+code is out of place.\r
+\r
+ BIF contains most of the virtual machine.\r
+\r
+ BIF.M contains the inner interpreter macro, some important\r
+ symbol table offsets, and a few other general EQUates and\r
+ macros.\r
+\r
+ BIFDP contains the rest of the virtual machine.\r
+\r
+ BIFU contains the allocation of the per-user system variables.\r
+\r
+ BIFST contains the boot up code and definitions.\r
+\r
+ BIF1 contains most of the calculator-style expression evaluator.\r
+\r
+ BIF2 is mostly constants and system variables, but contains the\r
+ memory management primitives.\r
+\r
+ Most of BIF3 is code which interacts with system variables, for\r
+ example, the words which set the conversion base to sixteen,\r
+ ten, or eight.\r
+\r
+ BIF4 contains multiplication and division, and the disk\r
+ interface primitives.\r
+\r
+ BIF5 is mostly output formatting.\r
+\r
+ BIF6 is mostly input formatting and terminal interface.\r
+\r
+ BIF7 contains most of the dictionary (interactive symbol table)\r
+ machinery.\r
+\r
+Unless otherwise noted, all definitions are in the BIF vocabulary.\r
+\r
+There is much that is not sacred about FORTH and its dialects. For\r
+many, the attraction of FORTH is the great abandon with which one may\r
+play games with its inner workings. I have taken a number of liberties\r
+and these routines still function. If you have an idea, back your disks\r
+up and try it.\r
+\r
+\r
+**** Definitions/Routines in BIF.ASM and BIFB.A:\r
+{ vm_alu.c bif.asm\r
+@ ( adr --- n )\r
+FETCH Replace address on stack with the word at the address.\r
+\r
+\r
+! ( n adr --- )\r
+STORE Store second word on stack at address on top of stack.\r
+\r
+LIT ( --- n ) C\r
+ Push the following word from the instruction stream as a\r
+ literal, or immediate value.\r
+\r
+DLIT ( --- d ) C\r
+ Push a double integer literal (see LIT).\r
+}\r
+\r
+{ bifc_vm.c bif.asm\r
+EXECUTE ( adr --- ) C\r
+EXEC Jump to address on stack. Used by the "outer" interpreter to\r
+ interactively invoke routines. (Not compile-only in fig.)\r
+\r
+0BRANCH ( f --- ) C\r
+ZBR BRANCH if flag is zero.\r
+\r
+1BRANCH ( f --- ) C\r
+TBR BRANCH if not zero. Not as useful as it might appear.\r
+\r
+BRANCH ( --- ) C\r
+ Add the following word from the instruction stream to the\r
+ instruction pointer (Y++). Causes a program branch.\r
+}\r
+\r
+(LOOP) ( --- ) ( limit index *** limit index+1) C\r
+XLOOP ( limit index *** )\r
+ Counting loop primitive. The counter and limit are the top two\r
+ words on the return stack. If the updated index/counter does\r
+ not exceed the limit, a branch occurs. If it does, the branch\r
+ does not occur, and the index and limit are dropped from the\r
+ return stack.\r
+\r
+(+LOOP) ( n --- ) ( limit index *** limit index+n ) C\r
+XPLOOP ( limit index *** )\r
+ Loop with a variable increment. Terminates when the index\r
+ crosses the boundary from one below the limit to the limit. A\r
+ positive n will cause termination if the result index equals the\r
+ limit. A negative n must cause the index to become less than\r
+ the limit to cause loop termination.\r
+\r
+(DO) ( limit index --- ) ( *** limit index )\r
+XDO Move the loop parameters to the return stack. Synonym for D>R.\r
+\r
+I ( --- index ) ( limit index *** limit index )\r
+ Copy the loop index from the return stack. Synonym for R.\r
+\r
+J ( --- index2 ) ( index2 limit1 index1 *** index2 limit1 index1 )\r
+ Copy the outer loop index from the return stack. As with (DO)\r
+ and I, J may be useful outside looping contexts.\r
+\r
+DIGIT ( c base --- ff )\r
+ ( c base --- n tf )\r
+ Translate C in base, yielding a translation valid flag. If the\r
+ translation is not valid in the specified base, only the false\r
+ flag is returned.\r
+\r
+(FIND) ( name vocptr --- locptr f )\r
+PFIND Search vocabulary for a symbol called name. Name is a pointer\r
+ to a NUL terminated string of characters without count, vocptr\r
+ is a pointer to a pointer to a definition (the length byte of a\r
+ symbol table entry). Locptr is also a pointer to a pointer to a\r
+ definition, such that, if the flag is false, a symbol with the\r
+ name searched for may be inserted in proper order at that point.\r
+ Vocptr and locptr may point to either the right or left entry of\r
+ the order-parent entry in the symbol table, or to pointer to the\r
+ root of a vocabulary. HIDDEN (smudged) definitions are\r
+ lexically less than their name strings. Searches only the local\r
+ vocabulary, from the order-parent node passed. Uses (REFIND).\r
+\r
+ vocptr is a pointer to the parameter field of a vocabulary \r
+ header.\r
+\r
+ENCLOSE ( buffer c --- s length )\r
+ENCLOS Scan buffer for a symbol delimited by c or ASCII NUL; return the\r
+ length of the symbol scanned and the address of its first\r
+ character. A length 0 and a pointer to a NUL means no symbol\r
+ was scanned before NUL terminator was reached. (Buffer is the\r
+ address of the buffer array to scan.)\r
+\r
+LITERAL ( n --- ) P\r
+LITER ( n --- n ) if interpreting.\r
+ Compile n as a literal, if compiling.\r
+\r
+DLITERAL ( d --- ) P\r
+DLITER ( d --- d ) if interpreting.\r
+ Compile d as a double literal, if compiling.\r
+\r
+EMIT ( c --- )\r
+ Write c to the output device (screen or printer). Uses the ECB\r
+ device number at address $6F, -2 is printer, 0 is screen.\r
+\r
+KEY ( --- c )\r
+ ( --- BREAK )\r
+ Wait for a key from the keyboard. If the key is BREAK, set the\r
+ high byte (result $FF03).\r
+\r
+?TERMINAL ( --- f )\r
+QTERM Scan keyboard, but do not wait. Return 0 if no key, BREAK\r
+ ($ff03) if BREAK is pressed, or key currently pressed.\r
+\r
+CR ( --- )\r
+ EMIT a Carriage Return (ASCII CR).\r
+\r
+(;CODE) ( --- ) ( IP *** ) C\r
+XSCODE Compile the latest symbol as a reference to a ;CODE definition;\r
+ overwrite the first three (3!) bytes of the code field of the\r
+ symbol found by LATEST with a jump to the low-level\r
+ characteristic code provided in the defining definition, and pop\r
+ IP. The machine-level code which follows (;CODE) in the\r
+ instruction stream is not executed by the defining symbol, but\r
+ becomes the characteristic of the defined symbol. This is the\r
+ usual way to generate the characteristics of VARIABLEs,\r
+ CONSTANTs, etc., when FORTH compiles itself. BIF, however, was\r
+ hand-optimized to take advantage of direct-page jumps. So its\r
+ pre-compiled defining symbols with low-level characteristics\r
+ look different from those compiled by BIF, having two bytes in\r
+ their code fields instead of three.\r
+\r
+>PRT ( --- )\r
+TOPRT Send output to printer via CoCo's ROM routines and the device\r
+ number variable (see EMIT).\r
+\r
+>VID ( --- )\r
+TOVID Send output to CRT, converse of >PRT.\r
+\r
+2* ( n --- n*2 )\r
+LSHIFT Fast multiply by two.\r
+\r
+2/ ( n --- n/2 )\r
+RSHIFT Fast divide by two.\r
+\r
+(REFIND) ( name vocptr --- name locptr f )\r
+PREF Search vocabulary for the first symbol called name. (Will find\r
+ HIDDEN/SMUDGEd definitions.) Name is a pointer to a string of\r
+ characters without count, vocptr is a pointer to a pointer to a\r
+ definition (the length byte of a symbol table entry). Locptr is\r
+ also a pointer to a pointer to a definition, such that, if the\r
+ pointer at the pointer is NULL, a symbol with the name searched\r
+ for may be inserted in proper order at that point. Vocptr and\r
+ locptr may be either the right or left entry of the order-parent\r
+ entry in the symbol table, or a pointer to the root of a\r
+ vocabulary. Flag f will indicate by offset whether the child or\r
+ empty slot is a left link (LFTOFF), right link (RTOFF), or\r
+ vocabulary (PFAOFF).\r
+\r
+ vocptr is a pointer to the parameter field of a vocabulary \r
+ header.\r
+\r
+\r
+**** Definitions/Routines in BIF1.A and BIF1B.A:\r
+\r
+MOVE ( source target count --- )\r
+ Copy/move count words from source to target. Moves ascending\r
+ addresses, so that overlapping only works if the source is\r
+ above the destination.\r
+\r
+CMOVE ( source target count --- )\r
+ Copy/move count bytes from source to target. Moves ascending\r
+ addresses, so that overlapping only works if the source is\r
+ above the destination.\r
+\r
+U* ( u1 u2 --- ud )\r
+USTAR Multiplies the top two unsigned integers, yielding a double\r
+ integer product.\r
+\r
+U/ ( ud u --- uremainder uquotient )\r
+USLASH Divides the top unsigned integer into the second and third words\r
+ on the stack as a single unsigned double integer, leaving the\r
+ remainder and quotient (quotient on top) as unsigned integers.\r
+ \r
+ The smaller the divisor, the more likely dropping the high word \r
+ of the quotient loses significant bits.\r
+\r
+AND ( n1 n2 --- n )\r
+ Bitwise and the top two integers.\r
+\r
+OR ( n1 n2 --- n )\r
+ Bitwise or.\r
+\r
+XOR ( n1 n2 --- n )\r
+ Bitwise exclusive or.\r
+\r
+SP@ ( --- adr )\r
+SPFEH Fetch the parameter stack pointer (before it is pushed).\r
+\r
+SP! ( whatever --- nothing )\r
+SPSTO Initialize the parameter stack pointer from the USER variable\r
+ S0. Effectively clears the stack.\r
+\r
+RP! ( whatever *** nothing )\r
+RPSTO Initialize the return stack pointer from the USER variable R0.\r
+ Effectively aborts all in process definitions, except the active\r
+ one. An emergency measure, to be sure.\r
+\r
+;S ( ip *** )\r
+SEMIS Pop IP from return stack (return from high-level definition).\r
+ Can be used in a screen to force interpretion to terminate.\r
+\r
+LEAVE ( limit index *** index index )\r
+ Force the terminating condition for the innermost loop by\r
+ copying its index to its limit. Termination is postponed until\r
+ the next LOOP or +LOOP instruction is executed. The index\r
+ remains available for use until the LOOP or +LOOP instruction is\r
+ encountered.\r
+\r
+>R ( n --- ) ( *** n ) C\r
+TOR Move top of parameter stack to top of return stack.\r
+\r
+R> ( --- n ) (n *** ) C\r
+RFROM Move top of return stack to top of parameter stack.\r
+\r
+R ( --- n ) ( n *** n )\r
+ Copy the top of return stack to top of parameter stack. A\r
+ synonym for I.\r
+\r
+= ( n1 n2 --- n1=n2 )\r
+EQ Flag true if n1 and n2 are equal, otherwise false.\r
+\r
+< ( n1 n2 --- n1<n2 )\r
+LT Flag true if n1 is less than n2, otherwise false.\r
+\r
+0= ( n --- n=0 )\r
+ZEQ Logically invert top of stack; or flag true if top is zero,\r
+ otherwise false.\r
+\r
+0< ( n --- n<0 )\r
+ZLESS Flag true if top is negative (MSbit set), otherwise false.\r
+\r
+> ( n1 n2 --- n1>n2 )\r
+GT Flag true if n1 is greater than n2, false otherwise.\r
+\r
+{ vm_alu.c bif1.a\r
++ ( n1 n2 --- n1+n2 )\r
+ADD Add top two words.\r
+\r
+- ( n1 n2 --- n1-n2 )\r
+SUB Subtract top two words.\r
+}\r
+\r
+D+ ( d1 d2 --- d1+d2 )\r
+DADD Add top two double integers.\r
+\r
+D- ( d1 d2 --- d1-d2 )\r
+DSUB Subtract top two double integers.\r
+\r
+MINUS ( n --- -n )\r
+ Negate (two's complement) top of stack.\r
+\r
+DMINUS ( d --- -d )\r
+ Negate (two's complement) top two words on stack as a double\r
+ integer.\r
+\r
+OVER ( n1 n2 --- n1 n2 n1 )\r
+ Push a copy of the second word on stack.\r
+\r
+DROP ( n --- )\r
+ Discard the top word on stack.\r
+\r
+SWAP ( n1 n2 --- n2 n1 )\r
+ Swap the top two words on stack.\r
+\r
+DUP ( n1 --- n1 n1 )\r
+ Push a copy of the top word on stack.\r
+\r
++! ( n adr --- )\r
+ADDSTO Add the second word on stack to the word at the adr on top of\r
+ stack.\r
+\r
+TOGGLE ( adr b --- )\r
+TOG Exclusive or byte at adr with low byte of top word.\r
+\r
+C@ ( adr --- b )\r
+CFEH Replace address on top of stack with the byte at the address.\r
+ High byte of result is clear.\r
+\r
+C! ( b adr --- )\r
+CSTO Store low byte of second word on stack at address on top of\r
+ stack. High byte is ignored.\r
+\r
+ROT ( n1 n2 n3 --- n2 n3 n1 )\r
+ Rotate the top three words on stack, bringing the third word to\r
+ the top.\r
+\r
+BACK ( adr --- ) C\r
+ Calculate a back reference from HERE and compile it. The result\r
+ compiled is adr-HERE-2, being adjusted for post-increment\r
+ addressing.\r
+\r
+NOT ( n --- ~n )\r
+ Bit (one's) complement the top of stack.\r
+\r
+' ( --- ) compiling P\r
+TICK ( --- adr ) interpreting\r
+ { ' name } input\r
+ Parse a symbol name from input and search, -DFIND, the\r
+ dictionary for it; compile the address as a literal if\r
+ compiling, otherwise just push it. Recursively searches parent\r
+ vocabularies, aborts if the parsed symbol name is not found.\r
+\r
+--> ( --- ) P\r
+NEXSCR Continue interpreting source code on the next screen.\r
+\r
+1ARRAY ( start end size --- )\r
+ONEARR { 1ARRAY name } input\r
+ Parse name and compile it as a linear array of size elements\r
+ from start index to end index inclusive. The number of bytes in\r
+ the array is (end-start+1)*size. The 1ARRAY characteristic is a\r
+ direct page routine.\r
+\r
+UTILITIES ( --- )\r
+UTIL The UTILITIES vocabulary.\r
+\r
+DP@ ( --- adr ) in UTILITIES\r
+DPFEH Calculate and push the address of the direct page.\r
+\r
+DCONSTANT ( d --- )\r
+DCON { DCONSTANT name } input\r
+ Parse name and compile it as a double constant with a value of\r
+ d. The DCONSTANT characteristic is a direct page routine.\r
+\r
+SWAB ( n --- ns )\r
+ Swap the bytes of the top word on stack.\r
+\r
+SWAN ( n --- ns )\r
+ Swap the nibbles of the top word on stack. The low-level code\r
+ looks funny, but it was the fastest way I could think up.\r
+\r
+\r
+**** Definitions/Routines in BIF2.A and BIF2B.A:\r
+\r
+Increments and decrements for top of stack:\r
+1+ ADD1 ( n --- n+1 )\r
+1- SUB1 ( n --- n-1 )\r
+2+ ADD2 ( n --- n+2 )\r
+2- SUB2 ( n --- n-2 )\r
+\r
+Constants:\r
+0 ZERO ( --- 0 )\r
+1 ONE ( --- 1 )\r
+-1 MONE ( --- -1 )\r
+2 TWO ( --- 2 )\r
+3 THREE ( --- 3 )\r
+BL BL ( --- SP ) ASCII SPACE character\r
+C/L CPERL ( --- 32 ) The number of columns per line on the\r
+ CRT. Determines the length of error messages and the\r
+ width and length of screen listings, among other things.\r
+FIRST ( --- adr ) The base of the disk buffer space.\r
+LIMIT ( --- adr ) The limit of the disk buffer space.\r
+B/BUF BPBUF ( --- 256 ) The size, in bytes, of a buffer.\r
+B/SCR BPSCR ( --- 4 ) The size, in buffers, of a screen.\r
+\r
++ORIGIN ( n --- adr )\r
+PORIG Calculate the address of the (n/2)th entry in the boot-up\r
+ parameter table. (Adds the base of the boot-up table to n.)\r
+\r
+Variables:\r
+TIB ( --- vadr ) Terminal Input Buffer address. Note\r
+ that is a variable, so users may allocate their own\r
+ buffers, but it must be @ed.\r
+WARNING WARN ( --- vadr ) Availability of error messages on disk.\r
+ Contains 1 if messages available, 0 if not, -1 if a disk\r
+ error has occurred.\r
+ In bif-c, add 2 for internal error strings.\r
+FENCE ( --- vadr ) Boundary for FORGET.\r
+DP DPC ( --- vadr ) Dictionary pointer, fetched by HERE.\r
+ROOT ( --- vadr ) Current local/context interpretation\r
+ vocabulary root. Not a fig variable.\r
+BLK ( --- vadr ) Block being interpreted. Zero refers to\r
+ terminal.\r
+IN ( --- vadr ) Input buffer offset/cursor.\r
+OUT ( --- vadr ) Output buffer offset/cursor.\r
+SCR ( --- vadr ) Screen being edited. Unused in BIF.\r
+OFFSET ( --- vadr ) Sector offset for LOADing screens, set\r
+ by DRIVE to make a new drive the default.\r
+STATE ( --- vadr ) Compiler/interpreter state.\r
+BASE ( --- vadr ) Numeric conversion base.\r
+DPL ( --- vadr ) Output decimal point locator.\r
+FLD ( --- vadr ) Field width for I/O formatting.\r
+CSP ( --- vadr ) Compiler stack mark for stack check.\r
+R# RNUM ( --- vadr ) Editing cursor location. Unused in BIF.\r
+HLD ( --- vadr ) Pointer to last HELD character in PAD.\r
+FOREWARD FORE ( --- vadr ) Pointer to earliest definition in active\r
+ forward block. Not fig.\r
+CURRENT CURR ( --- vadr ) NFA of LATEST definition. Not fig.\r
+PREV ( --- vadr ) Most Recently Used buffer.\r
+USE ( --- vadr ) Least Recently Used buffer.\r
+DROOT ( --- vadr ) Current defining/compiling vocabulary\r
+ root. Not fig.\r
+\r
+HERE ( --- adr )\r
+ Get contents of DP, with heap/stack overflow ERROR check. More\r
+ than a pseudo-constant.\r
+\r
+ALLOT ( n --- )\r
+ Increase heap (add n to DP), ERROR check stack/heap.\r
+\r
+, ( n --- )\r
+COMMA Store word n at DP++, ERROR check stack/heap.\r
+\r
+C, ( b --- )\r
+CCOMMA Store byte b at DP+, ERROR check stack/heap.\r
+\r
+SPACE ( --- )\r
+ EMIT a SPACE.\r
+\r
+-DUP ( 0 --- 0 )\r
+DDUP ( n --- n n )\r
+ DUP if non-zero.\r
+\r
+?CST ( --- f )\r
+QCST Push compile/interpret state bits.\r
+\r
+IF ( --- cdptr $4946 ) P,C\r
+ Compile a 0BRANCH and dummy offset and push IF reference to fill\r
+ in and IF control construct flag.\r
+\r
+ELSE ( cdptr1 $4946 --- cdptr2 $4946 ) P,C\r
+ ERROR check IF flag, compile BRANCH with dummy offset, resolve\r
+ IF reference (FILL-IN offset-2 to HERE at cdptr1), and leave\r
+ reference to BRANCH for ELSE.\r
+\r
+\r
+ENDIF ( cdptr $4946 --- ) P,C\r
+ ERROR check IF flag, resolve IF reference (FILL-IN offset-2 to\r
+ HERE at cdptr) and pop reference/flag.\r
+\r
+\r
+**** Definitions/Routines in BIF3.A and BIF3B.A:\r
+\r
+LATEST ( --- symptr )\r
+ Fetch CURRENT as a per-USER constant.\r
+\r
+Symbol table conversions:\r
+LFA ( n --- n+LFAOFF ) Convert NFA (not PFA) to LFA.\r
+ --> Convert header address to LFA.\r
+CFA ( n --- n+CFAOFF ) Convert NFA (not PFA) to CFA.\r
+ --> Convert header address to CFA.\r
+GFA ( n --- n+GFAOFF ) Convert NFA (not PFA) to CFA.\r
+ --> Convert header address to GFA.\r
+PFA ( n --- n+PFAOFF ) Convert NFA to PFA.\r
+ --> Convert header address to PFA.\r
+NFA ( n --- n-PFAOFF ) Convert PFA to NFA.\r
+ --> Convert PFA to header address.\r
+ NFA is the address of the length byte in a symbol table header.\r
+ --> Now we use the header address instead of the NFA.\r
+ PFA is the address at which a high-level definition's icode list\r
+ begins, or a variable's, constant's, or vocabulary's value is\r
+ stored.\r
+ CFA is where a definition's code begins, or where the jump to\r
+ its characteristic is stored.\r
+ LFA is the address of a definition's allocation link.\r
+ GFA is the address of a definition's vocabulary link.\r
+\r
+!CSP ( --- )\r
+STOCSP Save the parameter stack pointer in CSP for compiler checks.\r
+\r
+Set the conversion base:\r
+HEX ( --- ) Sixteen.\r
+DECIMAL DEC ( --- ) Ten.\r
+OCTAL OCT ( --- ) Eight.\r
+\r
+FILL ( adr n b --- )\r
+ Fill n bytes at adr with b.\r
+\r
+ERASE ( adr n --- )\r
+ Fill n bytes with 0.\r
+\r
+BLANKS ( adr n --- )\r
+ Fill n bytes with ASCII SPACE.\r
+\r
+HOLD ( c --- )\r
+ Format a character at the left of the HLD output buffer.\r
+\r
+PAD ( --- adr )\r
+ Give the address of the output PAD buffer. Not same as fig. PAD\r
+ points to the end of a 34 byte buffer for numeric conversion.\r
+\r
+S->D ( n0 --- d0 )\r
+STOD Sign extend n0 to a double integer.\r
+\r
++- ( n0 n1>=0 --- n0 )\r
+CHS ( n0 n1<0 --- -n0 )\r
+ Change sign of second iff top is negative.\r
+\r
+D+- ( d0 n0>=0 --- d0 )\r
+DCHS ( d0 n0<0 --- -d0 )\r
+ Change sign of second and third as double iff top is negative.\r
+\r
+ABS ( n>=0 --- n )\r
+ ( n<0 --- -n )\r
+ Change the top of stack to its absolute value.\r
+\r
+DABS ( d>=0 --- d )\r
+ ( d<0 --- -d )\r
+ Change the top double to its absolute value.\r
+\r
+MIN ( n0 n1 --- min(n0,n1) )\r
+ Leave the minimum of the top two integers.\r
+\r
+MAX ( n0 n1 --- max(n0,n1) )\r
+ Leave the maximum of the top two integers.\r
+\r
+[ ( --- ) P\r
+LBRAK Clear the compile state bits (shift to interpret).\r
+\r
+] ( --- )\r
+RBRAK Set the compile state bits (shift to compile).\r
+\r
+IMMEDIATE ( --- )\r
+IMMED Toggle precedence bit of LATEST definition header. During\r
+ compiling, most symbols scanned are compiled. IMMEDIATE\r
+ definitions execute whenever the outer INTERPRETer scans them,\r
+ but may be compiled via ' (TICK).\r
+\r
+SMUDGE ( --- )\r
+ Toggle HIDDEN bit of LATEST definition header, to hide it until\r
+ defined or reveal it after definition.\r
+\r
+COMPILE-ONLY ( --- )\r
+COMPO Toggle compile only bit of LATEST definition header.\r
+\r
+COUNT ( strptr --- strptr+1 count )\r
+ Convert counted string to string and count. (Fetch the byte at\r
+ strptr, post-increment.)\r
+\r
+-TRAILING ( strptr count1 --- strptr count2 )\r
+DTRAIL Supress trailing blanks (subtract count of trailing blanks from\r
+ strptr).\r
+\r
+(MACHINE) ( ip *** ) C\r
+XMACH Change from executing icodes to machine code in a definition by\r
+ saving IP and jumping to it after popping the old IP.\r
+\r
+TYPE ( strptr count --- )\r
+ EMIT count characters at strptr.\r
+\r
+CTS-TYPE ( adr --- ) in UTILITIES (bif-c)\r
+CTD_TYPE TYPE the (byte) counted string at adr.\r
+\r
+(.") ( --- ) C\r
+XDOTQ TYPE counted string out of instruction stream (updating IP).\r
+\r
+ID. ( symptr --- )\r
+IDDOT Print definition's name from its NFA.\r
+\r
+FILL-IN ( cdptr --- ) C\r
+FILLIN Resolve the reference at cdptr by writing the offset from\r
+ cdptr+2 to HERE at cdptr. Offset is adjusted for post-increment\r
+ IP (ldd ,y++).\r
+\r
+BEGIN ( --- cdptr $4245 ) P,C\r
+ Push HERE for BACK reference for general (non-counting) loops,\r
+ with BEGIN construct flag.\r
+\r
+AGAIN ( cdptr $4245 --- ) P,C\r
+ ERROR check BEGIN flag, compile BRANCH and BACK resolve it to\r
+ cdptr.\r
+\r
+UNTIL ( cdptr $4245 --- ) P,C\r
+ ERROR check BEGIN flag, compile 0BRANCH and BACK resolve it to\r
+ cdptr.\r
+\r
+WHILE ( $4245 --- $4245 cdptr $5748 ) P,C\r
+ ERROR check BEGIN flag, compile 0BRANCH with dummy offset, push\r
+ WHILE reference -- HERE -- /flag on top of BEGIN reference/flag.\r
+\r
+REPEAT ( cdptr1 $4245 cdptr2 $5748 --- ) P,C\r
+ ERROR check WHILE and BEGIN flags, compile BRANCH and BACK fill\r
+ cdptr1 reference, FILL-IN 0BRANCH reference at cdptr2.\r
+\r
+DO ( --- cdptr $444F ) P,C\r
+ Compile (DO), push HERE for BACK refenece, and push DO control\r
+ construct flag.\r
+\r
+\r
+**** Definitions/Routines in BIF4.A and BIF4B.A:\r
+\r
+M* ( n1 n2 --- d )\r
+MSTAR Multiply top two words as signed integers with a signed double\r
+ result.\r
+\r
+M/ ( d n --- remainder quotient )\r
+MSLASH Divide signed double dividend d (2nd & 3rd words) by signed\r
+ word divisor n (top) yielding signed word remainder and quotient.\r
+ Quotient is top, remainder takes sign of dividend.\r
+ \r
+ Thus, dividend == quotient * divisor + remainder \r
+ with truncating toward zero.\r
+ This can overflow in quotient.\r
+\r
+* ( multiplier multiplicand --- product )\r
+STAR Signed word multiply.\r
+\r
+/MOD ( dividend divisor --- remainder quotient )\r
+SLAMOD M/ in word-only form, i. e., signed division of 2nd word by top\r
+ word yielding signed word quotient and remainder.\r
+\r
+/ ( dividend divisor --- quotient )\r
+SLASH Signed word divide without remainder.\r
+\r
+MOD ( dividend divisor --- remainder )\r
+ Remainder function, result takes sign of dividend.\r
+\r
+*/MOD ( multiplier multiplicand divisor --- remainder quotient )\r
+SSMOD Signed precise division of product: multiply 2nd and 3rd\r
+ words on stack and divide the 31-bit product by the top word,\r
+ leaving both quotient and remainder. Remainder takes sign of\r
+ product. Guaranteed not to lose significant bits.\r
+\r
+*/ ( multiplier multiplicand divisor --- quotient )\r
+STARSL */MOD without remainder.\r
+\r
+M/MOD ( ud1 u1 --- u2 ud2 )\r
+MSMOD U/ with an (unsigned) double quotient. Guaranteed not to lose\r
+ significant bits, if you are prepared to deal with them.\r
+\r
++BUF ( buffer1 --- buffer2 f )\r
+ADDBUF Bump to next buffer, flag false if result is PREVious buffer,\r
+ otherwise flag true. Used in the LRU allocation routines.\r
+\r
+UPDATE ( --- )\r
+ Mark PREVious buffer dirty, in need of being written out.\r
+\r
+EMPTY-BUFFERS ( --- )\r
+EMTBUF Mark all buffers empty. Standard method of discarding changes.\r
+\r
+DRIVE-OFFSET ( n --- eadr )\r
+DROFFS 1ARRAY of drive offsets (see DO1ARR in the description of the\r
+ virtual machine). Contains the size, in sectors, of four\r
+ drives, plus a fifth entry to end the table if all four drives\r
+ are defined. To make drive 2 a 40 track SS-DD drive:\r
+ 40 18 * 2 DRIVE-OFFSET !\r
+ (Formatting the extra tracks can be handled with OS-9.)\r
+\r
+DRIVE ( n --- )\r
+ Add up the sector offset to sector 0 of drive n and store it in\r
+ OFFSET. This changes the logically lowest drive for LOADING.\r
+\r
+R/W ( buffer sector f --- )\r
+RW Read or Write the specified (absolute -- ignores OFFSET) sector\r
+ from or to the specified buffer. A zero flag specifies write,\r
+ non-zero specifies read. Sector is an unsigned integer, buffer\r
+ is the buffer's address. Uses the CoCo ROM disk routines. This\r
+ is where you would want to handle double-sided drives.\r
+\r
+?ERROR ( 0 n --- ) ( *** )\r
+QERROR ( true n --- IN BLK ) ( anything *** nothing )\r
+ If flag is false, do nothing. If flag is true, issue error\r
+ MESSAGE and QUIT or ABORT, via ERROR. Leaves cursor position\r
+ (IN) and currently loading block number (BLK) on stack, for\r
+ analysis.\r
+\r
+?COMP ( --- ) ( *** )\r
+QCOMP ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if not compiling.\r
+\r
+?EXEC ( --- ) ( *** )\r
+QEXEC ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if not executing.\r
+\r
+?PAIRS ( n1 n2 --- ) ( *** )\r
+QPAIRS ( n1 n2 --- IN BLK ) ( anything *** nothing )\r
+ ERROR if n1 and n2 are unequal. MESSAGE says compiled\r
+ conditionals do not match.\r
+\r
+?CSP ( --- ) ( *** )\r
+QCSP ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if return/control stack is not at same level as last !CSP.\r
+ Used to indicate that a definition has been left incomplete.\r
+ *** Actually, this checks the parameter stack. ***\r
+\r
+?LOADING ( --- ) ( *** )\r
+QLOAD ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if not loading, i. e., if BLK is non-zero. [correction: if BLK _is_ zero!]\r
+\r
+COMPILE ( --- )\r
+COMP Compile an in-line literal value from the instruction stream.\r
+\r
+LOOP ( cdptr $444f --- ) P,C\r
+ ERROR check DO flag, compile (LOOP), fill in BACK reference.\r
+\r
++LOOP ( cdptr $444f --- ) P,C\r
+PLOOP ERROR check DO flag, compile (+LOOP), fill in BACK reference.\r
+\r
+LOAD ( n --- )\r
+ Begin interpretation of screen (block) n. See also NEXSRC,\r
+ SEMIS, and ***NULLL****GGGGGHHHHTHNiTHNiTHNi\r
+\r
+<BUILDS ( --- ) C\r
+BUILDS Build a header for DOES> definitions. Actually just compiles a\r
+ CONSTANT zero which can be overwritten later by DOES>. Note\r
+ that <BUILDS is not IMMEDIATE, and therefore executes during a\r
+ definition's run-time, rather than its compile-time. It is not\r
+ intended to be used directly, but rather so that one definition\r
+ can build another. Also, note that nothing particularly special\r
+ happens in the defining definition until DOES> executes. The\r
+ name <BUILDS is intended to be a reminder of what is about to\r
+ occur.\r
+\r
+DOES> ( --- ) ( IP *** ) C\r
+DOES Define run-time behavior of definitions compiled/defined by a\r
+ high-level defining definition -- the FORTH equivalent of a\r
+ compiler-compiler. DOES> assumes that the LATEST symbol table\r
+ entry has at least one word of parameter field, which <BUILDS\r
+ provides. Note that DOES> is also not IMMEDIATE. When the\r
+ defining word containing DOES> executes the DOES> icode, it\r
+ overwrites the LATEST symbol's CFA with jsr <XDOES, overwrites\r
+ the first word of that symbol's parameter field with its own IP,\r
+ and pops the previous IP from the return stack. The icodes which\r
+ follow DOES> in the stream do not execute at the defining word's\r
+ run-time. Examining XDOES in the virtual machine shows that the\r
+ defined word will execute those icodes which follow DOES> at its\r
+ own run-time. The advantage of this kind of behaviour, which\r
+ you will also note in ;CODE, is that the defined word can\r
+ contain both operations and data to be operated on. This is how\r
+ FORTH data objects define their own behavior. Finally, note\r
+ that the effective code field for DOES> definitions is four\r
+ bytes.\r
+\r
+;CODE ( --- ) P,C\r
+SCODE ?CSP to see if there are loose ends in the defining definition\r
+ before shifting to the assembler, compile (;CODE) in\r
+ the defining definition's instruction stream, shift to\r
+ interpreting, make the ASSEMBLER vocabulary current, and !CSP to\r
+ mark the stack in preparation for assembling low-level code.\r
+ Note that ;CODE, unlike DOES>, is IMMEDIATE, and compiles\r
+ (;CODE),which will do the actual work of changing the LATEST\r
+ definition's characteristic when the defining word runs.\r
+ Assembly is done by the interpreter, rather than the compiler.\r
+ I could have avoided the anomalous three-byte code fields by\r
+ having ;CODE compile in the direct page jumps to the actual\r
+ low-level characteristics in the defining definition, thus\r
+ allowing (;CODE) to write a two-byte direct-page jumps into the\r
+ code fields of defined words. But that's a lot of work!\r
+\r
+\r
+**** Definitions/Routines in BIF5.A and BIF5B.A:\r
+\r
+\r
+IP, ( --- ) C\r
+IPCOM COMPILE a literal out of the instruction stream, without\r
+ checking compiler state. Used by the assembler to stuff\r
+ op-codes into the instruction stream, since the assembler runs\r
+ in interpretation mode.\r
+\r
+?STACK ( --- ) ( *** )\r
+QSTACK ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if either stack out of bounds, or on evidence of stack\r
+ boundary problems. There is a word below the bottom of each\r
+ stack, which ABORT clears before it starts interpreting. In\r
+ addition to checking that both stacks have not overflowed, this\r
+ routine checks those two words, to see if underflow has\r
+ occurred.\r
+\r
+BUFFER ( n --- buffer )\r
+ Get a free buffer, assign it to block n, return buffer address.\r
+ Will free a buffer by writing it, if necessary. Does not\r
+ actually read the block. A bug in the fig LRU algorithm, which\r
+ I have not fixed, gives the PREVious buffer if USE gets set to\r
+ PREVious (the bug is that it happens). This bug sometimes\r
+ causes sector moves to become sector fills.\r
+\r
+BLOCK ( n --- buffer )\r
+ Get BUFFER containing block n, relative to OFFSET. If block n\r
+ is not in a buffer, bring it in. Returns buffer address.\r
+\r
+(LINE) ( line screen --- buffer C/L)\r
+XLINE Bring in the sector containing the specified line of the\r
+ specified screen. Returns the buffer address and the width of\r
+ the screen. Screen number is relative to OFFSET. The line\r
+ number may be beyond screen 4, (LINE) will get the appropriate\r
+ screen.\r
+\r
+.LINE ( line screen --- )\r
+DOTLIN Print the line of the screen as found by (LINE), suppress\r
+ trailing BLANKS.\r
+\r
+SPACES ( count --- )\r
+ EMIT count spaces, for non-zero, non-negative counts.\r
+\r
+<# ( --- )\r
+BEGHSH Initialize HLD for converting a double integer. Stores the PAD\r
+ address in HLD.\r
+\r
+#> ( d --- string length )\r
+ENDHSH Terminate numeric conversion, drop the number being converted,\r
+ leave the address of the conversion string and the length, ready\r
+ for TYPE.\r
+\r
+SIGN ( n d --- d )\r
+ Put sign of n (as a flag) in front of the conversion string.\r
+ Drop the sign flag.\r
+\r
+# ( d --- d/base )\r
+HASH Generate next most significant digit in the conversion BASE,\r
+ putting the digit in front of the conversion string.\r
+\r
+#S ( d --- dzero )\r
+HASHS Convert d to a numeric string using # until the result is zero.\r
+ Leave the double result on the stack for #> to drop.\r
+\r
+D.R ( d width --- )\r
+DDOTR Print d on the output device in the current conversion base,\r
+ with sign, right aligned in a field at least width wide.\r
+\r
+D. ( d --- )\r
+DDOT Print d on the output device in the current conversion base,\r
+ with sign, in free format with trailing space.\r
+\r
+.R ( n width --- )\r
+DOTR Print n on the output device in the current conversion base,\r
+ with sign, right aligned in a field at least width wide.\r
+\r
+. ( n --- )\r
+DOT Print n on the output device in the current conversion base,\r
+ with sign, in free format with trailing space.\r
+\r
+? ( adr --- )\r
+QDOT Print signed word at adr, per DOT.\r
+\r
+MESSAGE ( n --- )\r
+MESS If WARNING is 0, print "MESSAGE #n"; otherwise, print line n\r
+ relative to screen 4, the line number may be negative. Uses\r
+ .LINE, but counter-adjusts to be relative to the real drive 0.\r
+ \r
+ In bif-c, add value of 2 for WARNING, for internal error message \r
+ strings.\r
+\r
+(ABORT) ( anything --- nothing ) ( anything *** nothing )\r
+IABORT An indirection for ABORT, for ERROR, which may be modified\r
+ carefully.\r
+\r
+ERROR ( anything line --- IN BLK ) ( anything *** nothing )\r
+ ( anything --- nothing ) ( anything *** nothing ) WARNING < 0\r
+ Prints out the last symbol scanned and MESSAGE number line. If\r
+ WARNING is less than zero, ABORTs through (ABORT), otherwise,\r
+ clears the parameter stack, pushes the INput cursor and\r
+ interpretaion BLK, and QUITs.\r
+\r
+EDITOR ( --- ) in EDITOR P\r
+ Set the current interpretation vocabulary to EDITOR.\r
+\r
+QSYNC ( --- ) in EDITOR\r
+ Synchronize the ECB cursor with R#.\r
+\r
+EBLK ( --- vadr ) in EDITOR\r
+ USER variable containing the current editing block.\r
+\r
+CURSOR ( --- adr ) in EDITOR\r
+ Calculates the address of the edit cursor, R#, within the\r
+ current editing block, bringing that block in if necessary.\r
+\r
+QDUMP ( adr --- ) in EDITOR\r
+ Dump the 256 bytes at adr to the screen memory, at the top half\r
+ of the screen (bottom half of screen memory).\r
+\r
+QARROW ( c --- c )\r
+ ( c --- 0 )\r
+ Adjust the cursor according to the key passed. If the key is a\r
+ cursor control key, return 0; otherwise, leave the key\r
+ unchanged. The regular back-arrow is used for cursor movement,\r
+ so the shifted back-arrow is used for destructive backspace.\r
+ Also, the up arrow is used for cursor movement, so caret is not\r
+ available without escaping. See QUICK.\r
+\r
+\r
+**** Definitions/Routines in BIF6.A and BIF6B.A:\r
+\r
+\r
+(NUMBER) ( d1 string --- d2 adr )\r
+INUMB Convert the text at string into a number, accumulating the\r
+ result into d1, leaving adr pointing to the first character not\r
+ converted. If DPL is non-negative at entry, accumulates the\r
+ number of characters converted into DPL.\r
+\r
+NUMBER ( ctstr --- d )\r
+ Convert text at ctstr to a double integer, taking the 0 ERROR if\r
+ the conversion is not valid. If a decimal point is present,\r
+ accumulate the count of digits to the decimal point's right into\r
+ DPL (negative DPL at exit indicates single precision). ctstr is\r
+ a counted string -- the first byte at ctstr is the length of the\r
+ string, but NUMBER ignores the count and expects a NUL\r
+ terminator instead.\r
+\r
+WORDPAD ( --- vadr )\r
+WORDPD The per-USER constant pointing to an intermediate\r
+ buffer for text scanning.\r
+\r
+WORD ( c --- )\r
+ Scan a string terminated by the character c or ASCII NUL out of\r
+ input; store symbol at WORDPAD with leading count byte and\r
+ trailing ASCII NUL. Leading c are passed over, per ENCLOSE.\r
+ Scans from BLK, or from TIB if BLK is zero. May overwrite the\r
+ numeric conversion pad, if really long (length > 31) symbols are\r
+ scanned.\r
+\r
+BS ( --- c )\r
+ The per-USER backspace constant.\r
+\r
+EXPECT ( buffer n --- )\r
+ Get up to n-1 characters from the keyboard, storing at buffer\r
+ and echoing, with backspace editing, quitting when a CR is read.\r
+ Terminate it with a NUL.\r
+\r
+QUERY ( --- )\r
+ EXPECT 128 (TWID) characters to TIB.\r
+\r
+ ( --- ) P\r
+NUBLK End interpretation of a line or screen, and/or prepare for a new\r
+ block. Note that the name of this definition is an empty\r
+ string, so it matches on the terminating NUL in the terminal or\r
+ block buffer.\r
+\r
+FIND ( namstr vocptr1 --- nfa vocptr2 )\r
+ Search a vocabulary, and its parents, if necessary, for a\r
+ definition called namstr. namstr is a counted (leading count\r
+ byte is ignored) string, vocptr1 is a pointer to a pointer to\r
+ a vocabulary tree or subtree. It will usually be the address of\r
+ the per-USER variable ROOT or DROOT, but may be a pointer to a\r
+ left or right link of an entry in the symbol tree. nfa will be\r
+ the name field address of the definition found, or a NULL.\r
+ vocptr2 will be the pointer-pointer to the last vocabulary\r
+ searched. vocptr2 will be the last vocabulary searche. See\r
+ (FIND).\r
+\r
+-DFIND ( --- nfa vocptr ) { -DFIND name } typical input\r
+DDFIND Parse a word, then FIND, first in the definition vocabulary,\r
+ then in the CONTEXT (interpretation) vocabulary, if necessary.\r
+ Returns the address of the symbol table entry or a NULL, and the\r
+ last vocabulary searched, per FIND.\r
+\r
+-IFIND ( --- nfa vocptr ) { -DFIND name } typical input\r
+DIFIND Same as -DFIND, except search the CONTEXT vocabulary first.\r
+\r
+NAME, ( --- ctStrPtr length )\r
+NCOMMA Store counted string at WORDPAD into dictionary, return HERE\r
+ pointer and length of string. Note that the count is not stored\r
+ in the dictionary, but that the address returned will be the\r
+ address to store the count at. (The length of the names of\r
+ definitions are stored after the actual names in the dictionary!)\r
+ \r
+ But in BIF-C, the lengths are stored with the strings, and the\r
+ address returned points to where the counted string was stored.\r
+\r
+FORE_MARK ( --- )\r
+FOREMK Set forward reference bit in LATEST definition, if FOREWARD is\r
+ non-NULL.\r
+\r
+(INSTALL) ( nfa vocptr --- ) P\r
+PINSTA Install the header at nfa into the specified vocabulary, hiding\r
+ (SMUDGEing) any existing definitions of the same name in that\r
+ vocabulary. In BIF-6809, vocptr was a pointer to the parameter \r
+ field of the vocabulary, and we follow that in BIF-C v. 0.\r
+\r
+0! ( --- )\r
+INULL Store 0 word at NULL pointer (address 0).\r
+\r
+?0 ( --- )\r
+TNULL Set warning to -1 and jmp to ERROR if the word at address 0\r
+ (NULL pointer) is not 0.\r
+\r
+QUICK ( n --- ) in EDITOR\r
+ Quick and dirty editor; edits sectors, not screens. See above\r
+ description.\r
+\r
+NODE. ( nfa --- flag )\r
+NDOT ID. with some formatting, extra information useful for\r
+ debugging, and a keyboard pause/abort test. Returns flag less\r
+ than 0 if BREAK key was pressed.\r
+\r
+VISIT ( defptr vocptr --- )\r
+ Scan vocabulary at vocptr in ascending order, performing\r
+ definition at defptr at every node. defptr is an nfa, vocptr is\r
+ the pfa of a vocabulary, per FIND and ROOT/DROOT. The\r
+ definition to be executed will have parameters of the same form\r
+ as NDOT, doing something at a symbol tree node and leaving a\r
+ termination flag. VISIT checks for stack overflow and watches\r
+ the termination flag between executions. The VISITing\r
+ definition may have other parameters, but if it changes the\r
+ stack pointer from execution to execution VISIT will complain.\r
+\r
+VLIST ( --- )\r
+ Alphabetically list the definitions in the current vocabulary.\r
+\r
+\r
+**** Definitions/Routines in BIF7.A and BIF7B.A:\r
+\r
+\r
+CREATE ( --- ) { CREATE name } input\r
+ Parse a name (length < 32 characters) and create a header,\r
+ reporting first duplicate found in either the defining\r
+ vocabulary or the context (interpreting) vocabulary. (INSTALL)\r
+ the header in the local vocabulary.\r
+\r
+CONSTANT ( n --- )\r
+CONST { value CONSTANT name } typical input\r
+ CREATE a header, compile a call to XCON, compile the constant\r
+ value.\r
+\r
+VARIABLE ( init --- )\r
+VAR { init VARIABLE name } typical input\r
+ CREATE a header, compile a call to XVAR, compile the initial\r
+ value init.\r
+\r
+USER ( ub --- )\r
+USER { uboffset USER name } typical input\r
+ CREATE a header, compile a call to XUSER, compile the unsigned\r
+ byte offset in the per-USER table. The USER is entirely\r
+ responsible for maintaining allocation!\r
+\r
+: ( --- ) P\r
+COLON { : name sundry-activities ; } typical input\r
+ If executing, record the data stack mark in CSP, CREATE a\r
+ header, compile a call to XCOL, and set state to compile. (SCOMP\r
+ is defined in this file.) CONTEXT (interpretation) vocabulary\r
+ is unchanged.\r
+\r
+; ( --- ) P\r
+SEMI { : name sundry-activities ; } typical input\r
+ ERROR check data stack against mark in CSP, compile ;S, unSMUDGE\r
+ LATEST definition, and set state to interpretation.\r
+\r
+." ( --- ) P\r
+DOTQ { ." something-to-be-printed " } typical input\r
+ Use WORD to parse to trailing quote, if compiling, compile XDOTQ\r
+ and string parsed, otherwise, TYPE string.\r
+\r
+[COMPILE] ( --- ) P\r
+BCOMP { [COMPILE] name } typical use\r
+ -DFIND next WORD and COMPILE it, literally; used to compile\r
+ immediate definitions.\r
+\r
+INTERPRET ( --- )\r
+INTERP Interpret or compile, according to STATE. Searches words parsed\r
+ in dictionary first, via -IFIND, then checks for valid NUMBER.\r
+ Pushes or COMPILEs double literal if NUMBER leaves DPL\r
+ non-negative. ERROR checks the stack via ?STACK before\r
+ returning to its caller. Sensitive to COMPILE-ONLY bit in\r
+ headers.\r
+\r
+QUIT ( anything *** nothing )\r
+ Clear return stack. Then INTERPRET and, if not compiling,\r
+ prompt with OK, in infinite loop.\r
+\r
+BIF ( --- ) P\r
+ Makes BIF the current interpretation vocabulary.\r
+\r
+ASSEMBLER ( --- ) P\r
+ASMBLR Makes ASSEMBLER the current interpretation vocabulary. Might\r
+ ought not to be IMMEDIATE.\r
+\r
+DEFINITIONS ( --- )\r
+DEFS Makes the current interpretation vocabulary also the current\r
+ defining vocabulary.\r
+\r
+ABORT ( anything --- nothing ) ( anything *** nothing )\r
+ Clear parameter stack, intialize the NULL vector, set STATE to\r
+ interpret and BASE to DECIMAL, return to input from terminal,\r
+ restore DRIVE OFFSET to 0, set interpret and define vocabularies\r
+ to BIF, print out "6809 BIF Vx.x", and finally, QUIT. Used to\r
+ force the system to a known state and return control to the\r
+ standard INTERPRETer.\r
+\r
+VOCABULARY ( --- ) { VOCABULARY name } input\r
+VOCAB Create a vocabulary entry with a NULL local pointer, linked by\r
+ the parent pointer to the current defining vocabulary. The\r
+ vocabulary parameter passed to the various searching routines is\r
+ usually a pointer to the parameter field of a vocabulary. That\r
+ way, the root is functionally identically to a left or right\r
+ link in a node or leaf, particularly for insertion.\r
+\r
+( ( --- )\r
+PAREN Parse out a comment and toss it away. This is probably not\r
+ useful, but it leaves the first 32 characters in WORDPAD.\r
+\r
+DAD ( nfa --- name linkadr flag )\r
+ Search the parent vocabulary of the definition at nfa for nfa,\r
+ returning the address of the first character of the definition's\r
+ name, a pointer to the left or right link which links the\r
+ definition in, and a flag indicating whether the definition is\r
+ linked left or right. ERROR if the definition can't be found.\r
+ The return parameters are appropriate for REPEALing the\r
+ definition.\r
+\r
+REPEAL ( --- )\r
+ Remove the CURRENT/LATEST definition from the dictionary, from\r
+ the vocabulary in which it is defined. Updates CURRENT, alsoe\r
+ updates DROOT or ROOT and clears FOREWARD, if appropriate. If\r
+ the CURRENT definition is in a closed forward block, repeals the\r
+ entire block, so that forward references aren't pointing to\r
+ trash.\r
+ \r
+ Except that I never got that last part written and working. So \r
+ you have to do that by hand. It does clear FOREWARD if FOREWARD \r
+ is pointing to the REPEALed definition.\r
+\r
+FORGET ( --- ) { FORGET name } input\r
+ Parse out name of definition to FORGET to, -DFIND it, then\r
+ REPEAL until it is removed from the dictionary. Will not FORGET\r
+ if definition is not found, if it is in a recursive block, or if\r
+ it is below FENCE; the ERROR message will include the offending\r
+ name.\r
+ \r
+ (Does it really?)\r
+\r
+\r
+**** Definitions/Routines in BIFST.A\r
+\r
+\r
+COLD COLD boot. Initializes the system variables, prunes the\r
+ dictionary of everything beyond the initial FENCE, then WARM\r
+ boots.\r
+\r
+WARM Resets stack areas and per-USER variables, clears the buffers,\r
+ then yields control to BIF via ABORT.\r
+\r
+\r
+****\r
+Definitions on the SCREENs disk follow. The vocabulary names are\r
+abbreviated here under the definition names, A for ASSEMBLER, B for BIF,\r
+U for UTILITIES, ^a for ^asm-util.\r
+\r
+**** SCREEN 0\r
+Index to the screens disk.\r
+\r
+**** SCREEN 2\r
+Title page and copyright notice.\r
+\r
+**** SCREEN 3\r
+MON ( --- )\r
+- Call the debugging monitor: SWI followed by a jmp [,y++], so\r
+ that BIF can be continued.\r
+\r
+After screen 2 creates MON, it updates FENCE to protect MON from WARM\r
+boots. Will load in the active vocabulary.\r
+\r
+**** SCREENs 4 & 5\r
+Error and other Messages:\r
+0: number conversion/unknown definition, no message text.\r
+1: DATA STACK UNDERFLOW\r
+2: DICTIONARY FULL\r
+3: ADDRESS RESOLUTION ERROR for control structures\r
+4: HIDES DEFINITION IN some vocabulary\r
+5: NULL VECTOR WRITTEN\r
+6: DISC RANGE? disk sector number out of range\r
+7: DATA STACK OVERFLOW\r
+8: DISC ERROR! of some sort -- is your drive door closed?\r
+9: CAN'T EXECUTE A NULL!\r
+10: CONTROL STACK UNDERFLOW\r
+11: CONTROL STACK OVERFLOW\r
+12: ARRAY REFERENCE OUT OF BOUNDS\r
+13: ARRAY DIMENSION NOT VALID\r
+14: NO PROCEDURE TO ENTER\r
+15: ( was register error message for assembler )\r
+16:\r
+17: COMPILATION ONLY, USE IN DEFinition\r
+18: EXECUTION ONLY do not use while compiling\r
+19: CONDITIONALS NOT PAIRED where's your if/loop end statement?\r
+20: DEFINITION INCOMPLETE often same as 18, but hit ;\r
+21: IN PROTECTED DICTIONARY don't try to forget below FENCE.\r
+22: USE ONLY WHEN LOADING\r
+23: OFF CURRENT EDITING SCREEN an editor cursor problem\r
+24: DECLARE VOCABULARY\r
+25: DEFINITION NOT IN VOCABULARY\r
+26: IN FORWARD BLOCK\r
+27: ALLOCATION LIST CORRUPTED: LOST\r
+28: CAN'T REDEFINE nul! You tried to CREATE something without a name.\r
+29: NOT FORWARD REFERENCE\r
+30: ( was message about IMMEDIATE )\r
+31:\r
+32:\r
+33: HAS INCORRECT ADDRESS MODE for 6809\r
+34: HAS INCORRECT INDEX MODE for 6809\r
+35: OPERAND NOT REGISTER in 6809\r
+36: HAS ILLEGAL IMMEDIATE for 6809\r
+37: PC OFFSET MUST BE ABSOLUTE pc-relative addressing error\r
+38: ACCUMULATOR OFFSET REQUIRED for indexing mode\r
+39: ILLEGAL MEMORY INDIRECTION for 6809\r
+40: ILLEGAL INDEX BASE for 6809\r
+41: ILLEGAL TARGET SPECIFIED for 6809 addressing mode or register\r
+42: CAN'T STACK ON SELF for push/pull, try other stack pointer\r
+43: DUPLICATE IN LIST of operands\r
+44: REGISTER NOT STACK trying to push on a non-stack register?\r
+45: EMPTY REGISTER LIST best supply some registers\r
+46: IMMEDIATE OPERAND REQUIRED for 6809\r
+47: REQUIRES CONDITION for control operator\r
+48:\r
+49: COMPILE-TIME STACK UNDERFLOW\r
+50: COMPILE-TIME STACK OVERFLOW\r
+\r
+**** SCREEN 6\r
+\r
+BYTE-DUMP ( adr n --- )\r
+U Dump n bytes to output device, right adjusted in 4 character\r
+ columns. Field width is not big enough if BASE is six or less.\r
+\r
+DUMP ( adr n --- )\r
+B Formatted dump to output device, with ASCII interpretation.\r
+ Hard coded to 4 bytes per line.\r
+\r
+QLIST ( n --- )\r
+B QDUMP a block/sector and set the cursor to the middle of the\r
+ screen so the dump remains visible.\r
+\r
+QINDEX ( start end --- )\r
+B QLIST block/sectors from number start to end, inclusive.\r
+\r
+L/SCR ( --- n )\r
+U Calculate the number of terminal lines per disc screen at\r
+ run-time. Sixteen, at present.\r
+\r
+ULIST ( n --- flag )\r
+U List screen n, with line numbers in the current base, leave\r
+ BREAK key flag. Uses C/L, to automatically adjust for screen\r
+ width (if C/L is set), but you may not want to use this\r
+ definition if you set C/L to something besides 32 or 64.\r
+\r
+**** SCREEN 7\r
+\r
+LIST ( n --- )\r
+B ULIST screen n, line numbers in decimal.\r
+\r
+INDEX ( start end --- )\r
+B Print comment lines (line 0, and line 1 if C/L < 41) of screens\r
+ from start to end.\r
+\r
+TRIAD ( n --- )\r
+B List a printer page full of screens to the printer, formatted by\r
+ C/L. Line and screen number are in current base. Lists the\r
+ group containing screen n, will print 2 screens if C/L is 32,\r
+ three if C/L is 64. (Two may not fit well.)\r
+\r
+**** SCREEN 8\r
+\r
+HOME ( --- )\r
+U Put the cursor at the (CoCo 2) CRT screen HOME position.\r
+\r
+MID ( --- )\r
+U Put the cursor 8 lines down the (CoCo 2) CRT screen.\r
+\r
+CLS ( --- )\r
+B Clear the (CoCo 2) CRT screen.\r
+\r
+CAN-UP ( adr -- adr )\r
+U Clear the UPDATE bit (MSB) for the buffer whose block word is at\r
+ adr. The characters in the buffer should be stored at adr+2.\r
+\r
+W-BUF ( adr --- adr )\r
+U Write the characters at adr+2 to the sector specified at adr,\r
+ clear the UPDATE flag.\r
+\r
+SAVE-BUF ( adr --- adr )\r
+U W-BUF, if UPDATEd.\r
+\r
+QSAVE ( --- )\r
+B Save the PREViously edited buffer, if it was UPDATEd.\r
+\r
+SAVE-BUFFERS ( --- )\r
+B Write all buffers flagged for UPDATE, clear UPDATE bits.\r
+\r
+QCAN ( --- )\r
+B Cancel UPDATE of PREViously edited buffer.\r
+\r
+**** SCREEN 9\r
+\r
+CANCEL-UPDATES ( --- )\r
+B Cancel UPDATEs of all buffers.\r
+\r
+RE-QUICK ( --- )\r
+B Re-edit PREVious buffer.\r
+\r
+.BUF ( adr --- adr )\r
+U Dump buffer characters at adr+2, showing the sector number\r
+ indicated at adr.\r
+\r
+.BUFFERS ( --- )\r
+B Dump all buffers, with block number, per .BUF.\r
+\r
+.PREV ( --- )\r
+B Dump contents and block number of PREVious buffer, per .BUF.\r
+\r
+EDIT ( n --- )\r
+B QUICK edit block n, showing the block number.\r
+\r
+QPREV ( --- )\r
+B QUICK edit the PREVious block.\r
+\r
+**** SCREEN 10\r
+\r
+QOPY ( src dest --- )\r
+B Move content of block/sector src to block dest. BUG: Doesn't\r
+ copy if src is already in a buffer (problem with LRU).\r
+\r
+COPY ( src dest --- )\r
+B Copy SCREEN src to SCREEN dest. Uses QOPY, so you should\r
+ EMPTY-BUFFERS before using COPY.\r
+\r
+QBACK ( start end --- )\r
+B Copy blocks from start to end to the next higher disc, at the\r
+ same sector offset.\r
+\r
+EEDIT ( n --- )\r
+B Erase and then EDIT block n.\r
+\r
+**** SCREEN 11\r
+\r
+RES-ERROR ( --- )\r
+U ERROR #3\r
+\r
+FORWARD ( --- ) { FORWARD name } input\r
+B Compile a forward reference header: CREATE, set FOREWARD if not\r
+ already set, compile jmp to RES-ERROR, unSMUDGE header.\r
+\r
+:RESOLVE ( --- ) { :RESOLVE name } input P\r
+A If the characteristic of name is a jmp to RES-ERROR, make it\r
+ LATEST, re-SMUDGE it, change jmp address to HERE; if the header\r
+ of name is the base of the forward block, clear FOREWARD.\r
+ Forward blocks should end with the definition of the first\r
+ forward reference in the block, to maintain the block's\r
+ integrity. (However, the FOREWARD USER variable can be modified\r
+ by hand, if necessary.)\r
+\r
+:RES ( --- ) { :RES name } input\r
+B Do ASSEMBLER's resolve, then compile jmp <XCOL and switch state\r
+ to compile.\r
+\r
+;RES ( --- ) P\r
+B ; but SMUDGE LATEST one more time.\r
+\r
+**** SCREEN 11 does not continue LOADing! ****\r
+\r
+**** SCREEN 12\r
+\r
+PL ( --- )\r
+B Print 80 ASCII characters starting with '!'.\r
+\r
+PT ( --- )\r
+B PL until any key is hit.\r
+\r
+PTEST ( --- )\r
+B PT, but send the output to the printer.\r
+\r
+**** SCREEN 13\r
+\r
+SLIST ( start end --- )\r
+- ULIST SCREENs to printer from start to end inclusive.\r
+\r
+**** SCREEN 14\r
+This contains some experimental stuff that I was using to test my a\r
+Sardis Technologies disk controller.\r
+\r
+**** SCREEN 15\r
+\r
+NAME ( cfa --- )\r
+B Convert the CFA on the stack to an nfa and ID. it.\r
+\r
+NAMES ( adr n --- )\r
+B NAME n icodes at adr. Naively interprets anything as an icode.\r
+\r
+**** SCREEN 16\r
+**** The assembler starts here! ****\r
+\r
+^asm-util ( --- )\r
+A Vocabulary for assembler support stuff. (Note that the name is\r
+ in lower case and looks funny when editing until the cursor\r
+ moves over it.)\r
+\r
+DREG ( n --- ) { n DREG name } input -> compile-time\r
+^a ( --- d ) -> run-time\r
+ Define register double constants. Most significant word is\r
+ `RE', the index and operand encodings are masked into the least\r
+ significant word.\r
+\r
+xx ( --- d ) high word is HEX 5245\r
+A The register double constants in hex:\r
+ D 52458B00 A 52458608 B 52458509 PC 52458C05\r
+ U 52454003 S 52456004 Y 52452002 X 52450001\r
+ CC 5245EF0A DP 5245EF0B\r
+ Example: DP A EXG is exg dp,a\r
+\r
+# ( --- n )\r
+A Suffix constant for immediate values. Becomes the high byte:\r
+ 4 # A LD is lda #4\r
+\r
+DPREG ( --- adr )\r
+^a DP register emulator for the assembler. A per-USER variable at\r
+ offset HEX 42, initialized to whatever the load-time DP is.\r
+\r
+DPR ( --- adr )\r
+A Push the current DPREG value, as a constant. To use as an\r
+ absolute address, push a 0 or -1 after.\r
+ Example: DPR 7 + 0 JMP is jmp <7\r
+\r
+SETDP ( adr --- )\r
+A Set the DPREG value, masks the low byte of adr out.\r
+\r
+**** SCREEN 17\r
+\r
+OFF, (n b --- )\r
+^a Compile an index byte b with signed, constant, byte or word\r
+ offset, n. Sets bit 0 in the index byte if it compiles a word\r
+ offset.\r
+\r
+OP, ( u --- )\r
+^a Compile opcode u. Compiles 16 bits if high byte of u is\r
+ non-zero.\r
+\r
+ABS, ( adr u1 u2 --- )\r
+^a Compile an absolute address mode (direct page or extended)\r
+ op-code u1, oring u2 into u1 before compiling if the address is\r
+ not in the direct page.\r
+\r
+PCOFF ( adr n1 --- n2 flag )\r
+^a Generate a pc-relative offset n2 from adr, adjusted by n1 bytes\r
+ of op-code/index. Flags true if offset fit in a byte, false if\r
+ it required 16 bits.\r
+\r
+?ABS ( d --- adr flag )\r
+^a Convert high word of d to flag showing true if high word was 0\r
+ or -1, false otherwise. A 0 or -1 high word indicates an\r
+ absolute address as an operand.\r
+ Example: HEX .FF20 B OR is orb $FF20\r
+\r
+PCR, ( d b --- )\r
+^a ERROR if d is not absolute mode operand. Calculate offset and\r
+ compile index byte b and offset.\r
+\r
+**** SCREEN 18\r
+\r
+Auto-indexing address mode double constants, in ASSEMBLER vocabulary:\r
+-) ( --- 4155.0082 ) ,-r\r
+)++ ( --- 4155.0081 ) ,r++\r
+)+ ( --- 4155.0080 ) ,r+\r
+--) ( --- 4155.0083 ) ,--r\r
+ Example: )++ X , D ST is std ,x++\r
+\r
+MASK, ( b1 b2 --- )\r
+^a Compile the bit-or of the top two words's low bytes.\r
+\r
+REG, ( u b --- )\r
+^a Convert a register offset specified by u to its extension byte\r
+ representation, mask in the index register and indirection\r
+ specifier b, and compile the resulting index byte.\r
+\r
+IXOFF, ( n b --- )\r
+^a Generate the appropriate index extension byte for the constant\r
+ offset n and indirection level specified, mask in the index\r
+ register and indirection specifier b, and compile both the\r
+ extension byte and the offset. Handles zero and 5-bit offsets.\r
+\r
+EI, ( d b --- )\r
+^a Compile a (completely specified) extended-indirect extension\r
+ byte b and the absolute address d.\r
+\r
+**** SCREEN 19\r
+\r
+IX, ( d n --- )\r
+^a Compile an index mode address operand. n contains the index\r
+ register and indirection level encoding, d contains the offset\r
+ or auto-mode specification. Zero offset must be explicit. Does\r
+ not block out unsupported [,r+] and [,-r] modes.\r
+\r
+, ( d1 --- d2 )\r
+A Convert indexable register d1 to index mode specifier d2.\r
+ Examples: 0. X , B OR is orb ,x\r
+ A X , JMP is jmp a,x\r
+ TABLE 0 PC , X LEA is leax table,pcr\r
+\r
+) ( d1 --- d2 )\r
+A Convert indexable register, absolute address, or index operand\r
+ d1 to memory indirect operand. Note that this will NOT\r
+ interfere with comments.\r
+ Examples: TABLE 6 + 0 PC ) JMP is jmp [6,pcr]\r
+ )++ S ) JSR is jsr ,s++\r
+\r
+**** SCREEN 20\r
+\r
+ACCM ( n1 n2 n3 --- n4 )\r
+^a Convert op-code n1, register n2, and mask bits n3 to accumulator\r
+ encoded op-code n4. Used for encoding ACCM destination\r
+ op-codes.\r
+\r
+UNARY ( u --- ) >--> compile-time\r
+^a { u UNARY name } input >-/\r
+ ( do dx --- ) indexed modes >-\\r
+ ( d --- ) non-indexed modes >--> run-time\r
+ Unary op-code compiler -- compiles an assembler of unary\r
+ op-codes with op-code (u) and name. Run-time parameters: d is\r
+ the destination register or address, dx is the index\r
+ mode/register, do is the offset/auto mode.\r
+ Examples: A NEG is nega\r
+ 7. U , ROR is ror 7,u\r
+\r
+REG ( d adr --- d u sz ) -- JSR\r
+^a ( d adr --- u sz )\r
+ Encode binary destination register d into op-code from table at\r
+ adr. Table format is primary (byte), highest (byte), secondary\r
+ (word) secondary (word) .... Leave op-code u and size sz (-1 is\r
+ word, 0 is byte) of register encoded. Helps to reduce the\r
+ complexity of the binary operators op-code map, see BINARY\r
+ concerning constructing the tables.\r
+\r
+**** SCREEN 21\r
+\r
+#, ( n u sz --- )\r
+^a Compile an immediate op-code u with immediate operand n of size\r
+ byte, if sz == 0, or word, ERROR if op-code is ST or JSR.\r
+\r
+BINARY ( ul b ub --- ) >--> compile-time\r
+^a { ul b ub BINARY name } input >-/\r
+ ( ds --- ) JSR >-\\r
+ ( ds dd --- ) non-indexed mode >--> run-time\r
+ ( do dx dd --- ) indexed mode >-/\r
+ Compile an assembler of binary operators, with primary op-code\r
+ (accumulator form, any mode) ub, count of other codes (0, 1, or\r
+ 5) b, and optional list of other codes ul. The list of other\r
+ op-codes must be pushed on the stack in the order S, U, Y, X,\r
+ and D (LD, ST, and CMP), or must be just the op-code for D (ADD\r
+ and SUB). Page escape codes must be included in the op-codes.\r
+ Run-time operands: ds is the source, do is the source\r
+ offset/auto mode, dx is the index mode/register, dd is the\r
+ destination register. Example: 12 # D CMP is cmpd #12 -800. X )\r
+ X LD is ldx [-800,x]\r
+\r
+REG-REG ( b --- ) { b REG-REG name } input -> compile-time\r
+^a ( d1 d2 --- ) -> run-time\r
+ Compile an assembler of register d1 to register d2 moves.\r
+ Examples: D Y EXG is exg d,y\r
+ A CC TFR is tfr a,c\r
+\r
+**** SCREEN 22\r
+\r
+REG-BITS ( n --- vadr )\r
+^a 1ARRAY of register bits for push/pull extension byte. The\r
+ Undefined slots set all bits to stabilize PACK. Use the low\r
+ word of a register specifier to index the array (see the DREG\r
+ constants).\r
+\r
+PACK ( n dl n --- n b )\r
+^ Pack register list dl into result byte b. Terminates when the\r
+ n, which is not the high word of a register specifier, is DUPed\r
+ and compared to HEX 5245; thus, any word or double which won't\r
+ be interpreted as a register specifier (see DREG) will terminate\r
+ the list, including the stack hole. ERRORs on attempt to push a\r
+ stack register on itself. May underflow the parameter\r
+ stack if the stack hole is corrupted with HEX 5245, of course,\r
+ but will not attempt to draw more than 8 doubles from the stack\r
+ unless REG-BITS is corrupted.\r
+\r
+MOVEM ( b --- ) { b MOVEM name } input -> compile-time\r
+^a ( n dl d --- n ) -> run-time\r
+ Compile a push or pull instruction assembler. d is the stack\r
+ register to push or pull. See PACK.\r
+ Example: D X Y U PSH is pshu d,x,y\r
+ (But don't leave stray register specifiers on the stack!)\r
+\r
+**** SCREEN 23\r
+\r
+BR ( d1 d2 --- )\r
+A Assemble a branch on condition d2 to absolute address d1.\r
+ Converts to PC relative, assembles a short branch if branch\r
+ target is close enough.\r
+ Example: LABEL 0 CCLR BR is bcc [LABEL]\r
+\r
+DCOND ( n --- ) { n DCOND name } input -> compile-time\r
+^a ( --- d )\r
+ Compile a branch condition constant; high word is HEX 434F.\r
+ Always (AL), never (NV), and subroutine (SR) are provided as\r
+ DCONDs.\r
+ Example: ' BMUL CFA 0 AL BR is bra BMUL\r
+\r
+CC-IMM ( b --- ) { b CC-IMM name } -> compile-time\r
+^a ( d --- ) -> run-time\r
+ Compile ORCC, ANDCC, EORCC, or CWAI assemblers. The assemblers\r
+ will ERROR if the operand is not immediate.\r
+ Example: HEX EF # CWAI is cwai #$EF\r
+\r
+IMPLY ( b --- ) { b IMPLY name } input >--> compile-time\r
+^a ( --- ) run-time\r
+ Compile assemblers of implicit operand instructions.\r
+ Example: NOP is nop\r
+\r
+**** The next two SCREENs contain op-code assemblers. ****\r
+See the compilers for run-time descriptions. The odd organization keeps\r
+the trees balanced. The assemblers, or, in other words, the mnemonics,\r
+are in the ASSEMBLER vocabulary.\r
+\r
+**** SCREEN 24\r
+\r
+BINARYs LD ST and CMP with their associated 16-bit register op-code\r
+ lists.\r
+MOVEMs PUL PSH UNARYs ROR ROL IMPLYs RTS RTI\r
+BINARY SBC DCOND SR (subroutine) REG-REG TFR\r
+UNARY TST BINARY SUB with D\r
+IMPLYs SWI2 SWI3 SWI SYNC BINARYs AND ADC\r
+UNARYs ASL ASR BINARY ADD with D IMPLY ABX\r
+DCOND CS UNARYs COM CLR DCOND AL (always)\r
+BINARY BIT UNARY DEC IMPLY DAA\r
+DCONDs HI MI EQ GE REG-REG EXG UNARY INC\r
+BINARY JSR UNARY JMP BINARY EOR\r
+DCONDs GT HS IMPLY NOP DCONDS LS PL\r
+\r
+**** SCREEN 25\r
+\r
+UNARYs LSR LSL DCONDs LT NE IMPLY MUL\r
+UNARY NEG BINARY OR CC-IMM ORCC\r
+DONCD NV (never) IMPLY SEX (blush) CC-IMMs ANDCC CWAI\r
+DCONDs VC VS CCLR (Carry CLeaR)\r
+\r
+EA-IX ( n --- vadr )\r
+^a 1ARRAY of translations from register (DREG) to LEA arguments.\r
+\r
+LEA ( do dx dd --- )\r
+A Assembler for LEA instructions. do is the offset/auto mode, dx\r
+ is the source index register, dr is the destination index\r
+ register.\r
+ Example: D Y , X LEA is leax d,y\r
+\r
+DCONDs LE LO\r
+\r
+**** SCREEN 26\r
+\r
+[CD] ( --- dcfa ) { [CD] name } input P\r
+A Produce the CFA of the following definition header, for use as a\r
+ jump or indexing target. If compiling, causes the code address\r
+ to be compiled as a double literal; otherwise, pushes the cfa as\r
+ a double, so the assemblers can use it for addressing.\r
+\r
+& ! ^ ( n1 n2 --- n3 )\r
+A Aliases for AND OR and XOR for the assembler vocabulary.\r
+\r
+NEXT ( --- )\r
+A Assembler the NEXT instruction, jmp [,y++].\r
+\r
+**** The assembler control constructs are patterned after FORTH\r
+control constructs, but test the Condition Code register.\r
+****\r
+\r
+**** SCREEN 27\r
+\r
+INVERTCC ( dcond --- ~dcond )\r
+^a Invert the assembler branch condition (double word) on top of\r
+ stack.\r
+\r
+LIF ( dcond --- daddr )\r
+A Mark HERE as a double with the address in the low word and HEX\r
+ 4146 in the high word. Assemble a long branch on the inverse of\r
+ the condition given, and leave the mark. Temporarily set the\r
+ branch address to the RES-ERROR routine.\r
+\r
+IF ( dcond --- daddr )\r
+A Same as LIF, but assembles short branch with 0 offset.\r
+\r
+**** SCREEN 28\r
+\r
+FILL-IN ( dadr --- )\r
+^a Resolve offset of branch at mark to HERE, handle two, three, and\r
+ four byte branches.\r
+\r
+**** SCREEN 29\r
+\r
+ELSE ( daddr1 --- daddr2 )\r
+A ERROR check the mark daddr1, mark HERE and assemble short branch\r
+ always, via IF, and FILL-IN the previously marked IF or LIF.\r
+\r
+LELSE ( daddr1 --- daddr2 )\r
+A Same as ELSE except mark and assemble long branch always via\r
+ LIF.\r
+\r
+ENDIF ( daddr --- )\r
+A ERROR check the mark, and resolve the IF or LIF.\r
+\r
+BEGIN ( --- daddr )\r
+A Mark indefinite loop beginning with HERE. High word of mark is\r
+ HEX 4142.\r
+\r
+UNTIL ( daddr dcond --- )\r
+A ERROR if daddr is not BEGIN mark; assemble branch on inverse of\r
+ condition dcond to address marked in daddr.\r
+\r
+WHILE ( daddr dcond --- adr daddr )\r
+A ERROR if daddr is not BEGIN mark; assemble forward branch on\r
+ inverse of condition dcond, leave BEGIN address on stack and\r
+ extend mark with WHILE address and mark, HEX 4157.\r
+\r
+REPEAT ( adr daddr --- )\r
+A ERROR if not WHILE mark, assemble a branch to the BEGIN address\r
+ and FILL-IN the WHILE address.\r
+\r
+LWHILE ( daddr dcond --- adr daddr )\r
+A Forced long branch version of WHILE.\r
+\r
+**** SCREEN 30\r
+\r
+:ASM ( --- )\r
+A CREATE a header and store the parameter stack pointer in CSP to\r
+ mark the stack for assembler control construct and other errors.\r
+\r
+;ASM ( --- )\r
+A ERROR check CSP and un-smudge the definion. NEXT must be\r
+ explicitly assembled.\r
+\r
+I-CODE ( --- )\r
+A Shift to high-level compiling. (Assembles jmp <XCOL, changes\r
+ state to compiling, changes interpretation vocabulary to\r
+ definition vocabulary.)\r
+\r
+MACHINE ( --- ) P\r
+A Shift to assembly language. (Compiles (MACHINE), changes state\r
+ to interpretation, sets interpretation vocabulary to assembler.)\r
+\r
+**** SCREEN 32\r
+ Some Doubles\r
+\r
+D! ( d adr --- )\r
+B Store double d at adr.\r
+\r
+D@ ( adr --- d )\r
+B Fetch double (two words) at adr.\r
+\r
+DOVER ( d1 d2 --- d1 d2 d1 )\r
+B Copy the second double (bytes 4-7) on the stack to the top.\r
+\r
+DSWAP ( d1 d2 --- d2 d1 )\r
+B Swap the top two doubles (bytes 0-3 with bytes 4-7).\r
+\r
+**** SCREEN 64\r
+\r
+ This is an example showing use of the dictionary to associate\r
+pairs, from one of the textbooks I have. I apologize to the source for\r
+not giving proper credit, but I can't find it. It is included to show\r
+use of DOES> and to show how having the symbol table handy at run-time\r
+can be taken advantage of. It builds pairs of objects linked to each\r
+other such that typing one in results in printing the other out.\r
+\r
+\r
+*******************************************************************************\r
+ Some Thoughts and Comments:\r
+\r
+\r
+Hey, it's not a professional package, so I can put this here if I want!\r
+\r
+One of the problems with BIF is the power of the 6809. It is all too\r
+easy to use 6809 instructions instead of icodes. This means that the\r
+6809 architecture gets woven into BIF, as mentioned at the end of the\r
+discussion on the virtual machine.\r
+\r
+BIF can probably be made to conform with one of the standards by moving\r
+the virtual machine routines to their associated definitions (XCOLON to\r
+COLON, XVAR to VARIABLE, etc.) and by making all code fields three-byte\r
+jumps (JSRs). Direct threading will probably not be a problem, as long\r
+as code fields are uniform in size.\r
+\r
+The constant shifting between modes which I have done makes a built-in\r
+debugger more complex, as well. One specific example is that using a\r
+macro instead of a jump to a NEXT inner interpreter makes debugging more\r
+complex. If there is an inner interpreter, and if the low level\r
+routines are known to be error free, the debugger can simply be a jump\r
+inserted in the NEXT routine. Use of a macro forces the debugger to be\r
+sensitive to the 6809 architecture, and requires either use of the SWI\r
+method (which can't be used in ROM), CPU emulation, or external\r
+breakpoint/single-step hardware. The latter method is more complete,\r
+but inserting a debugging routine in the inner interpreter is often all\r
+that is necessary.\r
+\r
+A possible inner interpreter for a direct threaded FORTH (could be\r
+located in the direct page):\r
+\r
+ NEXT ldx ,y++ 8~\r
+ jmp ,x 3~ 14~ (w/ jmp <NEXT)\r
+\r
+Or for indirect threading:\r
+ NEXT ldx ,y++ 8~\r
+ jmp [,x] 6~ 17~ (w/ jmp <NEXT)\r
+\r
+Compared to BIF:\r
+ jmp [,y++] 9~\r
+\r
+The apparent disadvantages of the above are at least partially offset by\r
+the fact that X will contain the CFA on entry to the characteristic\r
+routines. In other words, X can substitute for W, and there is no need\r
+to store the CFA of the executing low level routine in an external\r
+register (on the stack, in the case of BIF). Showing how this affects\r
+XCOL, for direct threading:\r
+\r
+ someDEF jmp XCOL 4~\r
+ . . .\r
+ XCOL pshs y 7~\r
+ leay 3,x 5~\r
+ jmp <next 3~ 19~, total 33~\r
+\r
+For indirect threading:\r
+\r
+ someDEF fdb XCOL 0~\r
+ . . .\r
+ XCOL pshs y 7~\r
+ leay 2,x 5~\r
+ jmp <NEXT 3~ 15~, total 32~\r
+\r
+Compared to BIF:\r
+ someDEF jsr <XCOL 7~\r
+ . . .\r
+ XCOL ldx ,s 5~\r
+ sty ,s 6~\r
+ tfr x,y (leay ,x) 6~ (4~)\r
+ jmp [,y++] 9~ 33~, total 42~\r
+\r
+SURPRISED? I was. Of course, the characteristic routines must be a\r
+little careful to use or save X before they clobber it, but that isn't\r
+as difficult as it might seem.\r
+\r
+The direct page might still be used to locate the per-USER table, or\r
+might even contain it. At first glance, it would appear too expensive\r
+to offset the DP register with a variable index. But compare the\r
+following to the code in BIF:\r
+\r
+ XUSER tfr dp,a 6~\r
+ ldb [,s++] 10~ (stored as byte offset)\r
+ pshu d 7~ (there's the address)\r
+ jmp [,y++] 9~ 32~ compared to 34~\r
+\r
+If X is used for the temporary W register as in the indirect threaded\r
+inner interpreter example above, we can get the following, which speaks\r
+for itself:\r
+\r
+ XUSER tfr dp,a 6~\r
+ clrb 2~ (showing word offset, )\r
+ addd 2,x 7~ (byte would be shorter)\r
+ pshu d 7~\r
+ jmp <NEXT 3~ 25~\r
+\r
+Ah, experience. What we have to go through to get it!\r
+\r
+The key to FORTH and its dialects is found in ;CODE and DOES>. By\r
+providing both characteristic behaviour and data allocation, FORTH words\r
+(symbols/definitions) are primitive objects. A full object-oriented\r
+language could be generated with FORTH, but then you would probably have\r
+SMALLTALK!. A standard compiling language keeps the symbol table, its\r
+data, and the code that accesses it entirely separate, and wastes a lot\r
+of code space doing so. Professional FORTH systems can strip the symbol\r
+table out of compiled applications, if necessary, but the symbol table\r
+is available at run-time until the programmer is satisfied that his\r
+program is bug-free. Moreover, the programmer has access to the same\r
+library used by the language, which is usually not the case with\r
+compiled languages, even with C.\r
+\r
+A careful examination of the overhead in FORTH shows that it is\r
+approximately the same as the overhead in a good C compiler. While it\r
+would appear that constantly moving stuff on and off the stack would be\r
+a hindrance to progress, a second look reveals that the accumulator\r
+bottleneck requires this kind of movement. I wish I had time and\r
+facilities to examine this specific question in relation to a large\r
+register set.\r
+\r
+I sometimes wonder if management paranoia (PROTECT OUR INTELLECTUAL\r
+PROPERTY!) is the primary reason FORTH, LISP, and SMALLTALK have not\r
+entirely supplanted the compiled languages. If so, why is management\r
+willing to hide, protect, and hang on to code, but not willing to hang\r
+on to the engineers in whose brains the technology really resides? Or\r
+in the converse, if management can see that it is sometimes necessary to\r
+let people go, why can't they see that there are some things that are\r
+not worth the cost of trying to protect their tools from? And why can't\r
+they see that a intellectual property stolen by copying still requires a\r
+large investment in somebody's time to learn to use it? Why doesn't\r
+public domain code get used? Because it costs better than an order of\r
+magnitude more to learn how to use it than it does to get it.\r
+\r
--- /dev/null
+\r
+ BIF Documentation\r
+ By Joel Matthew Rees\r
+ 19 January 1992, \r
+ 8 April 2019\r
+\r
+\r
+ BIF documentation Copyright Joel Matthew Rees 1992, 2019\r
+\r
+\r
+In the spirit of fig-FORTH, the author grants permission as follows:\r
+=========\r
+Permission to use, copy, modify, and/or distribute this software for \r
+any purpose with or without fee is hereby granted, provided that the \r
+accompanying copyright notices and this permission notice appear in \r
+all copies.\r
+\r
+THE SOFTWARE IS PROVIDED “AS IS” AND ISC DISCLAIMS ALL WARRANTIES \r
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF \r
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY \r
+SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES \r
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN \r
+AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, \r
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS \r
+SOFTWARE.\r
+=========\r
+\r
+If the copyright notices in this file and the README.TXT file are \r
+retained, including that file and this with your distribution will\r
+fulfill the copyright notice obligation.\r
+\r
+But you really should include both anyway, just to be kind to the \r
+people who receive it.\r
+\r
+Note that:\r
+\r
+BIF is architecturally derived from fig-FORTH. fig-FORTH comes courtesy\r
+of the FORTH INTEREST GROUP, PO Box 1105, San Carlos, CA 94070.\r
+\r
+The author also grants permission to use and copy the source and object\r
+code for BIF freely, with the same stipulations, i. e.,\r
+that any distribution of significant portions of either must be\r
+accompanied by this notice, and the additional stipulation that any\r
+distribution of the entire code, whether source, object, or both, must\r
+be accompanied by the entire documentation, including Copyright and\r
+acknowledgements.\r
+\r
+This is not a commercial product; it was a student project, use it at\r
+your own risk. No warranty whatsoever is made concerning it. (If, by\r
+chance, anyone is interested in using BIF in a commercial product, I\r
+would appreciate knowing about it in advance.) The author's intent is\r
+only to make it available for experimentation, and it should be treated\r
+as strictly experimental software. DO NOT ATTEMPT TO ACCESS ORDINARY\r
+DISKS FORMATTED FOR USE BY OTHER OPERATING SYSTEMS WHILE BIF IS RUNNING!\r
+\r
+Contact as of January 2000:\r
+ joel_rees@sannet.ne.jp\r
+ http://www.page.sannet.ne.jp/joel_rees\r
+ reiisi@nettaxi.com\r
+ http://www.nettaxi.com/citizens/reiisi\r
+\r
+\r
+*******************************************************************************\r
+ General Information\r
+\r
+\r
+BIF (BInary tree, fig-FORTH) is a dialect of FORTH for the Tandy Color\r
+Computer. It is a direct-threaded version of the pre-FORTH-79 fORTH\r
+interest group publication of FORTH (fig-FORTH), using a non-standard\r
+binary tree dictionary structure. The direct-threading mechanism uses\r
+the direct-page addressing mode of the 6809, and thus may not be easily\r
+adaptable to FORTH-83. It also uses absolute addressing, and thus does\r
+not comform to the requirements of OS-9. (I am working on an\r
+indirect-threaded version of BIF for OS-9 in my spare time.)\r
+\r
+BIF.BIN is the executable object; after LOADMing it, EXEC the address\r
+&H1300 (see below). BIFSOURC.ARC contains the archived (TC31) source\r
+files; the assembler used is Disk EDTASM+. I used TSEdit to generate\r
+the source files in EDTASM+ format:\r
+\r
+line-number SPACE [label] TAB mnemonic etc. LF\r
+\r
+Using a text editor to replace the macros with their expansions should\r
+make it compatible with most other assemblers. An object which will run\r
+under the EDTASM+ "stand-alone" debugger may be generated by changing\r
+ORG $1200 in BIF.ASM to ORG $3F00.\r
+\r
+BIFSCREE.ARC contains the BIF/FORTH source for several utilities, the\r
+assembler, and double integer definitions (TOOLS.G00) and a definition\r
+pairing example (PAIRS.G28) useful for making paired lists. Using\r
+TOOLS.G00 and PAIRS.G28 directly will require moving the two files to\r
+their original granules, 0 and 28, on an ECB disk. Once they are moved,\r
+protecting the BIF screens with ECB directory entries may be a good\r
+idea. But resist the temptation to use a text editor on them. Messing\r
+with the whitespace will move the source code out of alignment with the\r
+physical FORTH/BIF screens, and thus cause the source code not to load.\r
+\r
+If you want to look at these two files with an editor, I suggest copying\r
+them to a different disk and looking at the copies. Even my favorite\r
+IBM PC editor, QEDIT, will insert a CR/LF at the end of every 512 bytes\r
+on saving, which is not good. (I wonder how many letters from OS-9\r
+users it would take to convince the folks at SEMWARE/Applied Systems\r
+Technologies to make an OS-9 version of their editor?)\r
+\r
+For $5.00, to cover postage, time, and the cost of floppies, I will send\r
+a copy of the BIF screens disk on a standard 5 1/4" (ECB formatted)\r
+floppy. If you request the EDTASM+ compatible source code, I will send\r
+that as well, on the same format disks. For $5.00 more, I will include\r
+a photo-copy of the documentation (useful if you don't have a way to\r
+print it).\r
+\r
+The documentation which follows is written in the standard FORTH\r
+documentation style. It is not intended as a primer or study guide.\r
+Brodie's Starting FORTH, Winfield's THE COMPLETE FORTH, or some other\r
+text is suggested to those unfamiliar with FORTH. Much of the code and\r
+examples should work as shown in the textbooks I recommend Leo Brodie's\r
+work, because he points out most of the places the user will have to\r
+refer to this documentation. Some of the descriptions are incomplete,\r
+particularly where definitions are intended to be used inside other\r
+definitions.\r
+\r
+The object contains a simple one-sector editor (for 32-column screens)\r
+in the EDITOR vocabulary. It does not provide search and replace, but\r
+it is sufficient, for the patient, to write code. My apologies for it.\r
+I did not have a Color Computer 3 when I wrote the original code, and\r
+haven't had the time to update it. Those with access to the fig-FORTH\r
+Installation Manual should have no problem installing the editor shown\r
+there.\r
+\r
+The assembler in the BIF screens is a full postfix assembler. The\r
+double integer screens show a quick example of its use.\r
+\r
+\r
+*******************************************************************************\r
+ Getting BIF Running\r
+\r
+\r
+Before you start, remember that BIF has the same post-fix grammar as\r
+FORTH. Think Reverse Polish, as in HP calculators.\r
+\r
+Computer: Comments:\r
+\r
+ In Disk ECB, type:\r
+LOADM "BIF.BIN" from whichever drive it is on, then remove all disks and\r
+EXEC &H1300 BIF should tell you it is running with\r
+6809 BIF V1.0\r
+OK\r
+ At this point, see if BIF is really running by typing\r
+VLIST and hitting ENTER. You should see a listing of your\r
+ main vocabulary (symbol table) which should run on for\r
+ about 200 entries, and then the computer responds with\r
+OK If this doesn't happen, you have a bad object file, get\r
+ a new copy. Otherwise, you have BIF!\r
+\r
+ If you have my BIF screens disk, put it in drive 0.\r
+ Then type\r
+6 LOAD to load the utilities starting at screen 6. After the\r
+ utilities are loaded, you can load the assembler by\r
+ typing\r
+DECIMAL 16 LOAD\r
+\r
+ If you don't have the BIF screens disk with the error\r
+ messages, type\r
+0 WARNING ! and BIF responds with\r
+OK but now tells you error numbers instead of messages.\r
+\r
+Okay, a few examples:\r
+\r
+ 42 EMIT\r
+\r
+puts the ascii character 42 (asterisk if the current BASE is DECIMAL) on\r
+the output device.\r
+\r
+ 5 6 * .\r
+\r
+prints the product of 5 and 6 (30, base ten) on the output device.\r
+\r
+ DECIMAL : CHARS 32 DO I . I EMIT CR LOOP ;\r
+ HEX 45 CHARS\r
+\r
+will set up a BIF "word" called CHARS, which, being invoked on the second\r
+line, will print the characters and hexadecimal ascii codes from SPACE\r
+up to, but not including, DASH.\r
+\r
+The BIF screens disk should always be in drive 0 if you want real error\r
+messages. If you want to look at the message text, the messages are at\r
+the front of TOOLS.G00, after the directory screen and title screen.\r
+Each message takes exactly 32 characters, including spaces and\r
+non-printing characters. Numbering starts with 0. If you have some\r
+other disk in drive 0 you will get funny and not exactly intelligent\r
+error messages. I know it's weird, but I was following the fig-FORTH\r
+model, which is designed for very limited memory.\r
+\r
+If you haven't been able to put the BIF screens disk together, you don't\r
+really need it to play around with BIF, but do clear the WARNING\r
+variable so BIF will know error messages are not available. Aside from\r
+the error messages in drive 0, there is nothing special about screens\r
+disks, except they do not have directory tracks. You should generally\r
+not put them in your drives when running under BASIC (DECB), OS-9 or\r
+some other system. By tradition, programmers use the first several\r
+screens as a hand-typed directory. You can format fresh BIF disks with\r
+either Disk Extended Color BASIC's DSKINI or OS-9's format. BIF ignores\r
+the directory information both systems write, so you also generally\r
+should not put a real DECB or OS-9 disk in while BIF is running.\r
+\r
+If you do format with OS-9, format single-sided (I used DECB's disk\r
+interface routines so BIF can't do double sided) with as many tracks as\r
+you want. To use the extra tracks, or a third or fourth drive, you will\r
+need to modify the DRIVE-OFFSET array. Pick a standard disk\r
+configuration and stick with it.\r
+\r
+An important word of warning. BIF, like FORTH, uses buffered I/O. Your\r
+screens are not actually saved to disk until you cause the system to\r
+need enough new buffers to write your editing back to the disk. To\r
+force the system to save the buffers, give BIF the SAVE-BUFFERS command.\r
+\r
+\r
+*******************************************************************************\r
+ BIF's QUICK Editor\r
+\r
+\r
+EDITOR gets you into the EDITOR vocabulary.\r
+0 QLIST lets you look at the first sector of the directory.\r
+4 B/SCR * QLIST lets you look at the first eight error messages.\r
+DECIMAL makes sure your conversion base is base ten.\r
+64 B/SCR * QUICK\r
+ lets you edit the first sector of the pairing example.\r
+ Use the cursor keys to move around; use the BREAK key to\r
+ get out. If you modified something you don't want to\r
+ change, type\r
+EMPTY-BUFFERS and ENTER. If you want to make sure your changes are\r
+ written to the disk, type\r
+SAVE-BUFFERS and ENTER.\r
+\r
+The QUICK editor is in the EDITOR vocabulary. It is available at boot\r
+up. You'll need to get into the EDITOR vocabulary, to access it. Pass\r
+it a sector number, not a screen number. Multiplying by B/SCR (which\r
+happens to be 4) will convert a screen number to a sector number. Add\r
+1, 2, or 3 to the base sector number of a screen to get the sector\r
+numbers for the second, third, and fourth sectors of that screen.\r
+\r
+The editor has no find/replace or block functions. Again I apologize\r
+for the editor, but I found it surprisingly workable. Note that the\r
+utility screens contain routines to move/copy sectors, so all is not\r
+entirely mud. One more glitch. Lower case letters will show as VDG\r
+codes until you run the cursor over them. What can I say?\r
+\r
+During editing, all arrow keys are cursor controls. Use SHIFT-LEFTARROW\r
+for destructive backspace, SHIFT-DOWNARROW for `[' left bracket,\r
+SHIFT-RIGHTARROW for `]' right bracket, SHIFT-UPARROW for `_' underscore\r
+(back-arrow on CoCo2). SHIFT-CLEAR escapes the UP-ARROW to provide the\r
+`^' caret. SHIFT-CLEAR also escapes itself to provide the backslash.\r
+\r
+Perhaps this is as good a place as any to mention a few points of\r
+terminology. A block is a sector. Sectors are numbered sequentially\r
+from 0. Sector numbering continues sequentially from drive n to drive\r
+n+1, see DRIVE-OFFSET, but also see OFFSET. A SCREEN is a kilobyte\r
+worth of blocks, in this case, four 256-byte sectors. SCREEN numbering\r
+also begins with 0. (SCREENs are called SCREENs because a SCREEN can be\r
+displayed on 16 lines of a 64-column CRT screen.) You will notice that\r
+a CoCo 2 can't properly display and edit a whole SCREEN. Finally,\r
+forward blocks are control constructs, not disk sectors.\r
+\r
+\r
+*******************************************************************************\r
+ The BIF Virtual Machine\r
+\r
+{ bifc_vm.h ---\r
+fig 6809\r
+UP [DP] pointer to the per-USER variable table (USER Pointer)\r
+IP Y pointer to the next definition (Instruction Pointer)\r
+RP S return/control stack pointer\r
+SP U parameter/data stack pointer\r
+W [S] pointer to executing definition's parameter field\r
+}\r
+ The BIF Virtual Machine\r
+\r
+fig 6809\r
+{ bifc_vm.c bif.m bifdp.a\r
+NEXT ( --- ) jmp [,y++] (macro in bif.m)\r
+ Causes the next definition to execute.\r
+\r
+DOCOL ( *** IP ) jsr <XCOL (see bif.m, bifdp.a)\r
+ Characteristic of a colon (:) definition. Begins execution of a\r
+ high-level definition, i. e., nests the definition and begins\r
+ processing icodes. Mechanically, it pushes the IP (Y register)\r
+ and loads the Parameter Field Address of the definition which\r
+ called it into the IP.\r
+}\r
+{ symbol.c bif.m bifdp.a\r
+DOVAR ( --- vadr ) jsr <XVAR (bif.m, bifdp.a)\r
+ Characteristic of a VARIABLE. A VARIABLE pushes its PFA address\r
+ on the stack. The parameter field of a VARIABLE is the actual\r
+ allocation of the variable, so that pushing its address allows\r
+ its contents to be @ed (fetched). Ordinary arrays and strings\r
+ that do not subscript themselves may be allocated by defining a\r
+ variable and immediately ALLOTting the remaining space.\r
+ VARIABLES are global to all users, and thus should have been\r
+ hidden in resource monitors, but aren't.\r
+\r
+DOCON ( --- n ) jsr <XCON (bif.m, bifdp.a)\r
+ Characteristic of a CONSTANT. A CONSTANT simply loads its value\r
+ from its parameter field and pushes it on the stack.\r
+\r
+DOUSER ( --- vadr ) jsr <XUSER (bif.m, bifdp.a)\r
+ Characteristic of a per-USER variable. USER variables are\r
+ similiar to VARIABLEs, but are allocated (by hand!) in the\r
+ per-user table. A USER variable's parameter field contains its\r
+ offset in the per-user table.\r
+\r
+DOVOC ( --- ) jsr <XVOC (bif.m, bifdp.a)\r
+ Characteristic of a VOCABULARY. A VOCABULARY stores a pointer\r
+ to itself in the current interpretation ROOT per-USER variable.\r
+ It contains a pointer to the definition at the root of its\r
+ symbol table tree. This allows the symbol table routines to\r
+ treat the root as a leaf node. This is also not standard FORTH!\r
+\r
+ ( --- PFA ) ( *** IP ) jsr <XDOES (routine in bifdp.a)\r
+ Characteristic of a DOES> defined word. The characteristics of\r
+ DOES> definitions are written in high-level icodes rather than\r
+ machine level code. The first parameter word points to the\r
+ high-level characteristic. This routine's job is to push the\r
+ IP, load the high level characteristic pointer in IP, and leave\r
+ the address following the characteristic pointer on the stack so\r
+ the parameter field can be accessed.\r
+\r
+The following are not standard FORTH characteristics:\r
+\r
+DO1ARR ( index --- eadr ) jsr <X1ARR (bif.m, bifdp.a)\r
+ Characteristic of a linear array. Linear arrays take the top\r
+ word on the stack as an index to the array, and return the\r
+ address of the element indexed. So this routine subtracts the\r
+ base index of the array, limit checks the result, then\r
+ multiplies by the size of the array elements. If the index is\r
+ out of bounds, it returns a NULL pointer (0). At some point I\r
+ intended to implement multi-dimensional arrays in a similar\r
+ manner, but I haven't. It would be a quick and interesting\r
+ project for anyone interested.\r
+\r
+DOUCON ( --- n ) jsr <XUCON (bif.m, bifdp.a)\r
+ Characteristic of a USER variable treated as a CONSTANT, i. e.,\r
+ fetches the value stored at the specified offset in the per-user\r
+ table.\r
+\r
+ ( --- d ) jsr <XDCON (bifdp.a)\r
+ Characteristic of a double integer constant; the parameter field\r
+ contains two words instead of one, both of which get pushed.\r
+}\r
+{ unused\r
+ADDTOP (MACRO in BIF.M) is not a characteristic; is used in several\r
+ routines to add a value to the top of stack.\r
+}\r
+\r
+One of the primary problems with extending BIF is that calls to the\r
+built-in characteristics are not conform to ;CODE. Defining definitions\r
+which use (;CODE) to establish the characteristics of the\r
+sybmbols/definitions they define will hav a three-byte code field, where\r
+the built-in compiling definitions -- VARIABLE, (1ARRAY, etc.,)\r
+CONSTANT, USER, :, and VOCABULARY have two-byte code fields. One\r
+specific example of the difficulties this can create is that\r
+vocabularies with special properties built in BIF, rather than by hand,\r
+can't be searched by BIF's symbol table search routine, -FIND. Of\r
+course, XVOC could be moved to VOCABULARY, where it belongs, (and might\r
+also be changed to a DOES> definition, but I don't think that's\r
+necessary on the 6809).\r
+\r
+\r
+*******************************************************************************\r
+ The BIF Symbols/Definitions/Routines\r
+\r
+\r
+I have added slightly to the FORTH documentation methods. I also show\r
+the results on the return stack and in the input buffer, where\r
+appropriate. The name on the left is the definition name, as it will be\r
+found by ' (TICK) and the outer interpreter. To the right I indicate\r
+precedence (P for higher Precedence than definition) and restrictions (C\r
+for Compile-only). Below the name, I indicate the assembler source\r
+label, where it is different from the name. The definitions on the\r
+SCREENS disk also indicate screen and sector for the source.\r
+ \r
+The parameters attempt to be mnemonic. It will help to remember that\r
+there are no stack items smaller than 16 bits; character and byte\r
+parameters will be integers with their high-bytes ignored. Double\r
+integers are 32 bits. A further reminder, parameters are listed Pascal\r
+order, first pushed first; thus, the right-most is at the top of stack,\r
+or the lowest address. I specify a list of doubles pushed onto the\r
+stack (used in the assembler) as dl. Finally, I will try to mean 16-bit\r
+integer when I say word, but I may sometimes slip and mean (per FORTH\r
+jargon) a definition/routine.\r
+\r
+Flags are slightly different than fig-FORTH -- true is set as -1, sensed\r
+as non-zero. False is zero, of course.\r
+\r
+A number of routines (such as ENCLOSE) accept and return different\r
+parameters than specified in fig-FORTH. I assume that those for whom\r
+this fact may be of consequence will have copies of the standard and can\r
+compare at their leisure.\r
+\r
+The definitions are not alphabetized, nor are they listed in order of\r
+immediate interest, but they are organized by the source file they occur\r
+in. The following file descriptions are generally accurate, but some\r
+code is out of place.\r
+\r
+ BIF contains most of the virtual machine.\r
+\r
+ BIF.M contains the inner interpreter macro, some important\r
+ symbol table offsets, and a few other general EQUates and\r
+ macros.\r
+\r
+ BIFDP contains the rest of the virtual machine.\r
+\r
+ BIFU contains the allocation of the per-user system variables.\r
+\r
+ BIFST contains the boot up code and definitions.\r
+\r
+ BIF1 contains most of the calculator-style expression evaluator.\r
+\r
+ BIF2 is mostly constants and system variables, but contains the\r
+ memory management primitives.\r
+\r
+ Most of BIF3 is code which interacts with system variables, for\r
+ example, the words which set the conversion base to sixteen,\r
+ ten, or eight.\r
+\r
+ BIF4 contains multiplication and division, and the disk\r
+ interface primitives.\r
+\r
+ BIF5 is mostly output formatting.\r
+\r
+ BIF6 is mostly input formatting and terminal interface.\r
+\r
+ BIF7 contains most of the dictionary (interactive symbol table)\r
+ machinery.\r
+\r
+Unless otherwise noted, all definitions are in the BIF vocabulary.\r
+\r
+There is much that is not sacred about FORTH and its dialects. For\r
+many, the attraction of FORTH is the great abandon with which one may\r
+play games with its inner workings. I have taken a number of liberties\r
+and these routines still function. If you have an idea, back your disks\r
+up and try it.\r
+\r
+\r
+**** Definitions/Routines in BIF.ASM and BIFB.A:\r
+{ vm_alu.c bif.asm\r
+@ ( adr --- n )\r
+FETCH Replace address on stack with the word at the address.\r
+\r
+\r
+! ( n adr --- )\r
+STORE Store second word on stack at address on top of stack.\r
+\r
+LIT ( --- n ) C\r
+ Push the following word from the instruction stream as a\r
+ literal, or immediate value.\r
+\r
+DLIT ( --- d ) C\r
+ Push a double integer literal (see LIT).\r
+}\r
+\r
+{ bifc_vm.c bif.asm\r
+EXECUTE ( adr --- ) C\r
+EXEC Jump to address on stack. Used by the "outer" interpreter to\r
+ interactively invoke routines. (Not compile-only in fig.)\r
+\r
+0BRANCH ( f --- ) C\r
+ZBR BRANCH if flag is zero.\r
+\r
+1BRANCH ( f --- ) C\r
+TBR BRANCH if not zero. Not as useful as it might appear.\r
+\r
+BRANCH ( --- ) C\r
+ Add the following word from the instruction stream to the\r
+ instruction pointer (Y++). Causes a program branch.\r
+}\r
+\r
+(LOOP) ( --- ) ( limit index *** limit index+1) C\r
+XLOOP ( limit index *** )\r
+ Counting loop primitive. The counter and limit are the top two\r
+ words on the return stack. If the updated index/counter does\r
+ not exceed the limit, a branch occurs. If it does, the branch\r
+ does not occur, and the index and limit are dropped from the\r
+ return stack.\r
+\r
+(+LOOP) ( n --- ) ( limit index *** limit index+n ) C\r
+XPLOOP ( limit index *** )\r
+ Loop with a variable increment. Terminates when the index\r
+ crosses the boundary from one below the limit to the limit. A\r
+ positive n will cause termination if the result index equals the\r
+ limit. A negative n must cause the index to become less than\r
+ the limit to cause loop termination.\r
+\r
+(DO) ( limit index --- ) ( *** limit index )\r
+XDO Move the loop parameters to the return stack. Synonym for D>R.\r
+\r
+I ( --- index ) ( limit index *** limit index )\r
+ Copy the loop index from the return stack. Synonym for R.\r
+\r
+J ( --- index2 ) ( index2 limit1 index1 *** index2 limit1 index1 )\r
+ Copy the outer loop index from the return stack. As with (DO)\r
+ and I, J may be useful outside looping contexts.\r
+\r
+DIGIT ( c base --- ff )\r
+ ( c base --- n tf )\r
+ Translate C in base, yielding a translation valid flag. If the\r
+ translation is not valid in the specified base, only the false\r
+ flag is returned.\r
+\r
+(FIND) ( name vocptr --- locptr f )\r
+PFIND Search vocabulary for a symbol called name. Name is a pointer\r
+ to a NUL terminated string of characters without count, vocptr\r
+ is a pointer to a pointer to a definition (the length byte of a\r
+ symbol table entry). Locptr is also a pointer to a pointer to a\r
+ definition, such that, if the flag is false, a symbol with the\r
+ name searched for may be inserted in proper order at that point.\r
+ Vocptr and locptr may point to either the right or left entry of\r
+ the order-parent entry in the symbol table, or to pointer to the\r
+ root of a vocabulary. HIDDEN (smudged) definitions are\r
+ lexically less than their name strings. Searches only the local\r
+ vocabulary, from the order-parent node passed. Uses (REFIND).\r
+\r
+ vocptr is a pointer to the parameter field of a vocabulary \r
+ header.\r
+\r
+ENCLOSE ( buffer c --- s length )\r
+ENCLOS Scan buffer for a symbol delimited by c or ASCII NUL; return the\r
+ length of the symbol scanned and the address of its first\r
+ character. A length 0 and a pointer to a NUL means no symbol\r
+ was scanned before NUL terminator was reached. (Buffer is the\r
+ address of the buffer array to scan.)\r
+\r
+LITERAL ( n --- ) P\r
+LITER ( n --- n ) if interpreting.\r
+ Compile n as a literal, if compiling.\r
+\r
+DLITERAL ( d --- ) P\r
+DLITER ( d --- d ) if interpreting.\r
+ Compile d as a double literal, if compiling.\r
+\r
+EMIT ( c --- )\r
+ Write c to the output device (screen or printer). Uses the ECB\r
+ device number at address $6F, -2 is printer, 0 is screen.\r
+\r
+KEY ( --- c )\r
+ ( --- BREAK )\r
+ Wait for a key from the keyboard. If the key is BREAK, set the\r
+ high byte (result $FF03).\r
+\r
+?TERMINAL ( --- f )\r
+QTERM Scan keyboard, but do not wait. Return 0 if no key, BREAK\r
+ ($ff03) if BREAK is pressed, or key currently pressed.\r
+\r
+CR ( --- )\r
+ EMIT a Carriage Return (ASCII CR).\r
+\r
+(;CODE) ( --- ) ( IP *** ) C\r
+XSCODE Compile the latest symbol as a reference to a ;CODE definition;\r
+ overwrite the first three (3!) bytes of the code field of the\r
+ symbol found by LATEST with a jump to the low-level\r
+ characteristic code provided in the defining definition, and pop\r
+ IP. The machine-level code which follows (;CODE) in the\r
+ instruction stream is not executed by the defining symbol, but\r
+ becomes the characteristic of the defined symbol. This is the\r
+ usual way to generate the characteristics of VARIABLEs,\r
+ CONSTANTs, etc., when FORTH compiles itself. BIF, however, was\r
+ hand-optimized to take advantage of direct-page jumps. So its\r
+ pre-compiled defining symbols with low-level characteristics\r
+ look different from those compiled by BIF, having two bytes in\r
+ their code fields instead of three.\r
+\r
+>PRT ( --- )\r
+TOPRT Send output to printer via CoCo's ROM routines and the device\r
+ number variable (see EMIT).\r
+\r
+>VID ( --- )\r
+TOVID Send output to CRT, converse of >PRT.\r
+\r
+2* ( n --- n*2 )\r
+LSHIFT Fast multiply by two.\r
+\r
+2/ ( n --- n/2 )\r
+RSHIFT Fast divide by two.\r
+\r
+(REFIND) ( name vocptr --- name locptr f )\r
+PREF Search vocabulary for the first symbol called name. (Will find\r
+ HIDDEN/SMUDGEd definitions.) Name is a pointer to a string of\r
+ characters without count, vocptr is a pointer to a pointer to a\r
+ definition (the length byte of a symbol table entry). Locptr is\r
+ also a pointer to a pointer to a definition, such that, if the\r
+ pointer at the pointer is NULL, a symbol with the name searched\r
+ for may be inserted in proper order at that point. Vocptr and\r
+ locptr may be either the right or left entry of the order-parent\r
+ entry in the symbol table, or a pointer to the root of a\r
+ vocabulary. Flag f will indicate by offset whether the child or\r
+ empty slot is a left link (LFTOFF), right link (RTOFF), or\r
+ vocabulary (PFAOFF).\r
+\r
+ vocptr is a pointer to the parameter field of a vocabulary \r
+ header.\r
+\r
+\r
+**** Definitions/Routines in BIF1.A and BIF1B.A:\r
+\r
+MOVE ( source target count --- )\r
+ Copy/move count words from source to target. Moves ascending\r
+ addresses, so that overlapping only works if the source is\r
+ above the destination.\r
+\r
+CMOVE ( source target count --- )\r
+ Copy/move count bytes from source to target. Moves ascending\r
+ addresses, so that overlapping only works if the source is\r
+ above the destination.\r
+\r
+U* ( u1 u2 --- ud )\r
+USTAR Multiplies the top two unsigned integers, yielding a double\r
+ integer product.\r
+\r
+U/ ( ud u --- uremainder uquotient )\r
+USLASH Divides the top unsigned integer into the second and third words\r
+ on the stack as a single unsigned double integer, leaving the\r
+ remainder and quotient (quotient on top) as unsigned integers.\r
+ \r
+ The smaller the divisor, the more likely dropping the high word \r
+ of the quotient loses significant bits.\r
+\r
+AND ( n1 n2 --- n )\r
+ Bitwise and the top two integers.\r
+\r
+OR ( n1 n2 --- n )\r
+ Bitwise or.\r
+\r
+XOR ( n1 n2 --- n )\r
+ Bitwise exclusive or.\r
+\r
+SP@ ( --- adr )\r
+SPFEH Fetch the parameter stack pointer (before it is pushed).\r
+\r
+SP! ( whatever --- nothing )\r
+SPSTO Initialize the parameter stack pointer from the USER variable\r
+ S0. Effectively clears the stack.\r
+\r
+RP! ( whatever *** nothing )\r
+RPSTO Initialize the return stack pointer from the USER variable R0.\r
+ Effectively aborts all in process definitions, except the active\r
+ one. An emergency measure, to be sure.\r
+\r
+;S ( ip *** )\r
+SEMIS Pop IP from return stack (return from high-level definition).\r
+ Can be used in a screen to force interpretion to terminate.\r
+\r
+LEAVE ( limit index *** index index )\r
+ Force the terminating condition for the innermost loop by\r
+ copying its index to its limit. Termination is postponed until\r
+ the next LOOP or +LOOP instruction is executed. The index\r
+ remains available for use until the LOOP or +LOOP instruction is\r
+ encountered.\r
+\r
+>R ( n --- ) ( *** n ) C\r
+TOR Move top of parameter stack to top of return stack.\r
+\r
+R> ( --- n ) (n *** ) C\r
+RFROM Move top of return stack to top of parameter stack.\r
+\r
+R ( --- n ) ( n *** n )\r
+ Copy the top of return stack to top of parameter stack. A\r
+ synonym for I.\r
+\r
+= ( n1 n2 --- n1=n2 )\r
+EQ Flag true if n1 and n2 are equal, otherwise false.\r
+\r
+< ( n1 n2 --- n1<n2 )\r
+LT Flag true if n1 is less than n2, otherwise false.\r
+\r
+0= ( n --- n=0 )\r
+ZEQ Logically invert top of stack; or flag true if top is zero,\r
+ otherwise false.\r
+\r
+0< ( n --- n<0 )\r
+ZLESS Flag true if top is negative (MSbit set), otherwise false.\r
+\r
+> ( n1 n2 --- n1>n2 )\r
+GT Flag true if n1 is greater than n2, false otherwise.\r
+\r
+{ vm_alu.c bif1.a\r
++ ( n1 n2 --- n1+n2 )\r
+ADD Add top two words.\r
+\r
+- ( n1 n2 --- n1-n2 )\r
+SUB Subtract top two words.\r
+}\r
+\r
+D+ ( d1 d2 --- d1+d2 )\r
+DADD Add top two double integers.\r
+\r
+D- ( d1 d2 --- d1-d2 )\r
+DSUB Subtract top two double integers.\r
+\r
+MINUS ( n --- -n )\r
+ Negate (two's complement) top of stack.\r
+\r
+DMINUS ( d --- -d )\r
+ Negate (two's complement) top two words on stack as a double\r
+ integer.\r
+\r
+OVER ( n1 n2 --- n1 n2 n1 )\r
+ Push a copy of the second word on stack.\r
+\r
+DROP ( n --- )\r
+ Discard the top word on stack.\r
+\r
+SWAP ( n1 n2 --- n2 n1 )\r
+ Swap the top two words on stack.\r
+\r
+DUP ( n1 --- n1 n1 )\r
+ Push a copy of the top word on stack.\r
+\r
++! ( n adr --- )\r
+ADDSTO Add the second word on stack to the word at the adr on top of\r
+ stack.\r
+\r
+TOGGLE ( adr b --- )\r
+TOG Exclusive or byte at adr with low byte of top word.\r
+\r
+C@ ( adr --- b )\r
+CFEH Replace address on top of stack with the byte at the address.\r
+ High byte of result is clear.\r
+\r
+C! ( b adr --- )\r
+CSTO Store low byte of second word on stack at address on top of\r
+ stack. High byte is ignored.\r
+\r
+ROT ( n1 n2 n3 --- n2 n3 n1 )\r
+ Rotate the top three words on stack, bringing the third word to\r
+ the top.\r
+\r
+BACK ( adr --- ) C\r
+ Calculate a back reference from HERE and compile it. The result\r
+ compiled is adr-HERE-2, being adjusted for post-increment\r
+ addressing.\r
+\r
+NOT ( n --- ~n )\r
+ Bit (one's) complement the top of stack.\r
+\r
+' ( --- ) compiling P\r
+TICK ( --- adr ) interpreting\r
+ { ' name } input\r
+ Parse a symbol name from input and search, -DFIND, the\r
+ dictionary for it; compile the address as a literal if\r
+ compiling, otherwise just push it. Recursively searches parent\r
+ vocabularies, aborts if the parsed symbol name is not found.\r
+\r
+--> ( --- ) P\r
+NEXSCR Continue interpreting source code on the next screen.\r
+\r
+1ARRAY ( start end size --- )\r
+ONEARR { 1ARRAY name } input\r
+ Parse name and compile it as a linear array of size elements\r
+ from start index to end index inclusive. The number of bytes in\r
+ the array is (end-start+1)*size. The 1ARRAY characteristic is a\r
+ direct page routine.\r
+\r
+UTILITIES ( --- )\r
+UTIL The UTILITIES vocabulary.\r
+\r
+DP@ ( --- adr ) in UTILITIES\r
+DPFEH Calculate and push the address of the direct page.\r
+\r
+DCONSTANT ( d --- )\r
+DCON { DCONSTANT name } input\r
+ Parse name and compile it as a double constant with a value of\r
+ d. The DCONSTANT characteristic is a direct page routine.\r
+\r
+SWAB ( n --- ns )\r
+ Swap the bytes of the top word on stack.\r
+\r
+SWAN ( n --- ns )\r
+ Swap the nibbles of the top word on stack. The low-level code\r
+ looks funny, but it was the fastest way I could think up.\r
+\r
+\r
+**** Definitions/Routines in BIF2.A and BIF2B.A:\r
+\r
+Increments and decrements for top of stack:\r
+1+ ADD1 ( n --- n+1 )\r
+1- SUB1 ( n --- n-1 )\r
+2+ ADD2 ( n --- n+2 )\r
+2- SUB2 ( n --- n-2 )\r
+\r
+Constants:\r
+0 ZERO ( --- 0 )\r
+1 ONE ( --- 1 )\r
+-1 MONE ( --- -1 )\r
+2 TWO ( --- 2 )\r
+3 THREE ( --- 3 )\r
+BL BL ( --- SP ) ASCII SPACE character\r
+C/L CPERL ( --- 32 ) The number of columns per line on the\r
+ CRT. Determines the length of error messages and the\r
+ width and length of screen listings, among other things.\r
+FIRST ( --- adr ) The base of the disk buffer space.\r
+LIMIT ( --- adr ) The limit of the disk buffer space.\r
+B/BUF BPBUF ( --- 256 ) The size, in bytes, of a buffer.\r
+B/SCR BPSCR ( --- 4 ) The size, in buffers, of a screen.\r
+\r
++ORIGIN ( n --- adr )\r
+PORIG Calculate the address of the (n/2)th entry in the boot-up\r
+ parameter table. (Adds the base of the boot-up table to n.)\r
+\r
+Variables:\r
+TIB ( --- vadr ) Terminal Input Buffer address. Note\r
+ that is a variable, so users may allocate their own\r
+ buffers, but it must be @ed.\r
+WARNING WARN ( --- vadr ) Availability of error messages on disk.\r
+ Contains 1 if messages available, 0 if not, -1 if a disk\r
+ error has occurred.\r
+ In bif-c, add 2 for internal error strings.\r
+FENCE ( --- vadr ) Boundary for FORGET.\r
+DP DPC ( --- vadr ) Dictionary pointer, fetched by HERE.\r
+ROOT ( --- vadr ) Current local/context interpretation\r
+ vocabulary root. Not a fig variable.\r
+BLK ( --- vadr ) Block being interpreted. Zero refers to\r
+ terminal.\r
+IN ( --- vadr ) Input buffer offset/cursor.\r
+OUT ( --- vadr ) Output buffer offset/cursor.\r
+SCR ( --- vadr ) Screen being edited. Unused in BIF.\r
+OFFSET ( --- vadr ) Sector offset for LOADing screens, set\r
+ by DRIVE to make a new drive the default.\r
+STATE ( --- vadr ) Compiler/interpreter state.\r
+BASE ( --- vadr ) Numeric conversion base.\r
+DPL ( --- vadr ) Output decimal point locator.\r
+FLD ( --- vadr ) Field width for I/O formatting.\r
+CSP ( --- vadr ) Compiler stack mark for stack check.\r
+R# RNUM ( --- vadr ) Editing cursor location. Unused in BIF.\r
+HLD ( --- vadr ) Pointer to last HELD character in PAD.\r
+FOREWARD FORE ( --- vadr ) Pointer to earliest definition in active\r
+ forward block. Not fig.\r
+CURRENT CURR ( --- vadr ) NFA of LATEST definition. Not fig.\r
+PREV ( --- vadr ) Most Recently Used buffer.\r
+USE ( --- vadr ) Least Recently Used buffer.\r
+DROOT ( --- vadr ) Current defining/compiling vocabulary\r
+ root. Not fig.\r
+\r
+HERE ( --- adr )\r
+ Get contents of DP, with heap/stack overflow ERROR check. More\r
+ than a pseudo-constant.\r
+\r
+ALLOT ( n --- )\r
+ Increase heap (add n to DP), ERROR check stack/heap.\r
+\r
+, ( n --- )\r
+COMMA Store word n at DP++, ERROR check stack/heap.\r
+\r
+C, ( b --- )\r
+CCOMMA Store byte b at DP+, ERROR check stack/heap.\r
+\r
+SPACE ( --- )\r
+ EMIT a SPACE.\r
+\r
+-DUP ( 0 --- 0 )\r
+DDUP ( n --- n n )\r
+ DUP if non-zero.\r
+\r
+?CST ( --- f )\r
+QCST Push compile/interpret state bits.\r
+\r
+IF ( --- cdptr $4946 ) P,C\r
+ Compile a 0BRANCH and dummy offset and push IF reference to fill\r
+ in and IF control construct flag.\r
+\r
+ELSE ( cdptr1 $4946 --- cdptr2 $4946 ) P,C\r
+ ERROR check IF flag, compile BRANCH with dummy offset, resolve\r
+ IF reference (FILL-IN offset-2 to HERE at cdptr1), and leave\r
+ reference to BRANCH for ELSE.\r
+\r
+\r
+ENDIF ( cdptr $4946 --- ) P,C\r
+ ERROR check IF flag, resolve IF reference (FILL-IN offset-2 to\r
+ HERE at cdptr) and pop reference/flag.\r
+\r
+\r
+**** Definitions/Routines in BIF3.A and BIF3B.A:\r
+\r
+LATEST ( --- symptr )\r
+ Fetch CURRENT as a per-USER constant.\r
+\r
+Symbol table conversions:\r
+LFA ( n --- n+LFAOFF ) Convert NFA (not PFA) to LFA.\r
+ --> Convert header address to LFA.\r
+CFA ( n --- n+CFAOFF ) Convert NFA (not PFA) to CFA.\r
+ --> Convert header address to CFA.\r
+GFA ( n --- n+GFAOFF ) Convert NFA (not PFA) to CFA.\r
+ --> Convert header address to GFA.\r
+PFA ( n --- n+PFAOFF ) Convert NFA to PFA.\r
+ --> Convert header address to PFA.\r
+NFA ( n --- n-PFAOFF ) Convert PFA to NFA.\r
+ --> Convert PFA to header address.\r
+ NFA is the address of the length byte in a symbol table header.\r
+ --> Now we use the header address instead of the NFA.\r
+ PFA is the address at which a high-level definition's icode list\r
+ begins, or a variable's, constant's, or vocabulary's value is\r
+ stored.\r
+ CFA is where a definition's code begins, or where the jump to\r
+ its characteristic is stored.\r
+ LFA is the address of a definition's allocation link.\r
+ GFA is the address of a definition's vocabulary link.\r
+\r
+!CSP ( --- )\r
+STOCSP Save the parameter stack pointer in CSP for compiler checks.\r
+\r
+Set the conversion base:\r
+HEX ( --- ) Sixteen.\r
+DECIMAL DEC ( --- ) Ten.\r
+OCTAL OCT ( --- ) Eight.\r
+\r
+FILL ( adr n b --- )\r
+ Fill n bytes at adr with b.\r
+\r
+ERASE ( adr n --- )\r
+ Fill n bytes with 0.\r
+\r
+BLANKS ( adr n --- )\r
+ Fill n bytes with ASCII SPACE.\r
+\r
+HOLD ( c --- )\r
+ Format a character at the left of the HLD output buffer.\r
+\r
+PAD ( --- adr )\r
+ Give the address of the output PAD buffer. Not same as fig. PAD\r
+ points to the end of a 34 byte buffer for numeric conversion.\r
+\r
+S->D ( n0 --- d0 )\r
+STOD Sign extend n0 to a double integer.\r
+\r
++- ( n0 n1>=0 --- n0 )\r
+CHS ( n0 n1<0 --- -n0 )\r
+ Change sign of second iff top is negative.\r
+\r
+D+- ( d0 n0>=0 --- d0 )\r
+DCHS ( d0 n0<0 --- -d0 )\r
+ Change sign of second and third as double iff top is negative.\r
+\r
+ABS ( n>=0 --- n )\r
+ ( n<0 --- -n )\r
+ Change the top of stack to its absolute value.\r
+\r
+DABS ( d>=0 --- d )\r
+ ( d<0 --- -d )\r
+ Change the top double to its absolute value.\r
+\r
+MIN ( n0 n1 --- min(n0,n1) )\r
+ Leave the minimum of the top two integers.\r
+\r
+MAX ( n0 n1 --- max(n0,n1) )\r
+ Leave the maximum of the top two integers.\r
+\r
+[ ( --- ) P\r
+LBRAK Clear the compile state bits (shift to interpret).\r
+\r
+] ( --- )\r
+RBRAK Set the compile state bits (shift to compile).\r
+\r
+IMMEDIATE ( --- )\r
+IMMED Toggle precedence bit of LATEST definition header. During\r
+ compiling, most symbols scanned are compiled. IMMEDIATE\r
+ definitions execute whenever the outer INTERPRETer scans them,\r
+ but may be compiled via ' (TICK).\r
+\r
+SMUDGE ( --- )\r
+ Toggle HIDDEN bit of LATEST definition header, to hide it until\r
+ defined or reveal it after definition.\r
+\r
+COMPILE-ONLY ( --- )\r
+COMPO Toggle compile only bit of LATEST definition header.\r
+\r
+COUNT ( strptr --- strptr+1 count )\r
+ Convert counted string to string and count. (Fetch the byte at\r
+ strptr, post-increment.)\r
+\r
+-TRAILING ( strptr count1 --- strptr count2 )\r
+DTRAIL Supress trailing blanks (subtract count of trailing blanks from\r
+ strptr).\r
+\r
+(MACHINE) ( ip *** ) C\r
+XMACH Change from executing icodes to machine code in a definition by\r
+ saving IP and jumping to it after popping the old IP.\r
+\r
+TYPE ( strptr count --- )\r
+ EMIT count characters at strptr.\r
+\r
+CTS-TYPE ( adr --- ) in UTILITIES (bif-c)\r
+CTD_TYPE TYPE the (byte) counted string at adr.\r
+\r
+(.") ( --- ) C\r
+XDOTQ TYPE counted string out of instruction stream (updating IP).\r
+\r
+ID. ( symptr --- )\r
+IDDOT Print definition's name from its NFA.\r
+\r
+FILL-IN ( cdptr --- ) C\r
+FILLIN Resolve the reference at cdptr by writing the offset from\r
+ cdptr+2 to HERE at cdptr. Offset is adjusted for post-increment\r
+ IP (ldd ,y++).\r
+\r
+BEGIN ( --- cdptr $4245 ) P,C\r
+ Push HERE for BACK reference for general (non-counting) loops,\r
+ with BEGIN construct flag.\r
+\r
+AGAIN ( cdptr $4245 --- ) P,C\r
+ ERROR check BEGIN flag, compile BRANCH and BACK resolve it to\r
+ cdptr.\r
+\r
+UNTIL ( cdptr $4245 --- ) P,C\r
+ ERROR check BEGIN flag, compile 0BRANCH and BACK resolve it to\r
+ cdptr.\r
+\r
+WHILE ( $4245 --- $4245 cdptr $5748 ) P,C\r
+ ERROR check BEGIN flag, compile 0BRANCH with dummy offset, push\r
+ WHILE reference -- HERE -- /flag on top of BEGIN reference/flag.\r
+\r
+REPEAT ( cdptr1 $4245 cdptr2 $5748 --- ) P,C\r
+ ERROR check WHILE and BEGIN flags, compile BRANCH and BACK fill\r
+ cdptr1 reference, FILL-IN 0BRANCH reference at cdptr2.\r
+\r
+DO ( --- cdptr $444F ) P,C\r
+ Compile (DO), push HERE for BACK refenece, and push DO control\r
+ construct flag.\r
+\r
+\r
+**** Definitions/Routines in BIF4.A and BIF4B.A:\r
+\r
+M* ( n1 n2 --- d )\r
+MSTAR Multiply top two words as signed integers with a signed double\r
+ result.\r
+\r
+M/ ( d n --- remainder quotient )\r
+MSLASH Divide signed double dividend d (2nd & 3rd words) by signed\r
+ word divisor n (top) yielding signed word remainder and quotient.\r
+ Quotient is top, remainder takes sign of dividend.\r
+ \r
+ Thus, dividend == quotient * divisor + remainder \r
+ with truncating toward zero.\r
+ This can overflow in quotient.\r
+\r
+* ( multiplier multiplicand --- product )\r
+STAR Signed word multiply.\r
+\r
+/MOD ( dividend divisor --- remainder quotient )\r
+SLAMOD M/ in word-only form, i. e., signed division of 2nd word by top\r
+ word yielding signed word quotient and remainder.\r
+\r
+/ ( dividend divisor --- quotient )\r
+SLASH Signed word divide without remainder.\r
+\r
+MOD ( dividend divisor --- remainder )\r
+ Remainder function, result takes sign of dividend.\r
+\r
+*/MOD ( multiplier multiplicand divisor --- remainder quotient )\r
+SSMOD Signed precise division of product: multiply 2nd and 3rd\r
+ words on stack and divide the 31-bit product by the top word,\r
+ leaving both quotient and remainder. Remainder takes sign of\r
+ product. Guaranteed not to lose significant bits.\r
+\r
+*/ ( multiplier multiplicand divisor --- quotient )\r
+STARSL */MOD without remainder.\r
+\r
+M/MOD ( ud1 u1 --- u2 ud2 )\r
+MSMOD U/ with an (unsigned) double quotient. Guaranteed not to lose\r
+ significant bits, if you are prepared to deal with them.\r
+\r
++BUF ( buffer1 --- buffer2 f )\r
+ADDBUF Bump to next buffer, flag false if result is PREVious buffer,\r
+ otherwise flag true. Used in the LRU allocation routines.\r
+\r
+UPDATE ( --- )\r
+ Mark PREVious buffer dirty, in need of being written out.\r
+\r
+EMPTY-BUFFERS ( --- )\r
+EMTBUF Mark all buffers empty. Standard method of discarding changes.\r
+\r
+DRIVE-OFFSET ( n --- eadr )\r
+DROFFS 1ARRAY of drive offsets (see DO1ARR in the description of the\r
+ virtual machine). Contains the size, in sectors, of four\r
+ drives, plus a fifth entry to end the table if all four drives\r
+ are defined. To make drive 2 a 40 track SS-DD drive:\r
+ 40 18 * 2 DRIVE-OFFSET !\r
+ (Formatting the extra tracks can be handled with OS-9.)\r
+\r
+DRIVE ( n --- )\r
+ Add up the sector offset to sector 0 of drive n and store it in\r
+ OFFSET. This changes the logically lowest drive for LOADING.\r
+\r
+R/W ( buffer sector f --- )\r
+RW Read or Write the specified (absolute -- ignores OFFSET) sector\r
+ from or to the specified buffer. A zero flag specifies write,\r
+ non-zero specifies read. Sector is an unsigned integer, buffer\r
+ is the buffer's address. Uses the CoCo ROM disk routines. This\r
+ is where you would want to handle double-sided drives.\r
+\r
+?ERROR ( 0 n --- ) ( *** )\r
+QERROR ( true n --- IN BLK ) ( anything *** nothing )\r
+ If flag is false, do nothing. If flag is true, issue error\r
+ MESSAGE and QUIT or ABORT, via ERROR. Leaves cursor position\r
+ (IN) and currently loading block number (BLK) on stack, for\r
+ analysis.\r
+\r
+?COMP ( --- ) ( *** )\r
+QCOMP ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if not compiling.\r
+\r
+?EXEC ( --- ) ( *** )\r
+QEXEC ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if not executing.\r
+\r
+?PAIRS ( n1 n2 --- ) ( *** )\r
+QPAIRS ( n1 n2 --- IN BLK ) ( anything *** nothing )\r
+ ERROR if n1 and n2 are unequal. MESSAGE says compiled\r
+ conditionals do not match.\r
+\r
+?CSP ( --- ) ( *** )\r
+QCSP ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if return/control stack is not at same level as last !CSP.\r
+ Used to indicate that a definition has been left incomplete.\r
+ *** Actually, this checks the parameter stack. ***\r
+\r
+?LOADING ( --- ) ( *** )\r
+QLOAD ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if not loading, i. e., if BLK is non-zero. [correction: if BLK _is_ zero!]\r
+\r
+COMPILE ( --- )\r
+COMP Compile an in-line literal value from the instruction stream.\r
+\r
+LOOP ( cdptr $444f --- ) P,C\r
+ ERROR check DO flag, compile (LOOP), fill in BACK reference.\r
+\r
++LOOP ( cdptr $444f --- ) P,C\r
+PLOOP ERROR check DO flag, compile (+LOOP), fill in BACK reference.\r
+\r
+LOAD ( n --- )\r
+ Begin interpretation of screen (block) n. See also NEXSRC,\r
+ SEMIS, and ***NULLL****GGGGGHHHHTHNiTHNiTHNi\r
+\r
+<BUILDS ( --- ) C\r
+BUILDS Build a header for DOES> definitions. Actually just compiles a\r
+ CONSTANT zero which can be overwritten later by DOES>. Note\r
+ that <BUILDS is not IMMEDIATE, and therefore executes during a\r
+ definition's run-time, rather than its compile-time. It is not\r
+ intended to be used directly, but rather so that one definition\r
+ can build another. Also, note that nothing particularly special\r
+ happens in the defining definition until DOES> executes. The\r
+ name <BUILDS is intended to be a reminder of what is about to\r
+ occur.\r
+\r
+DOES> ( --- ) ( IP *** ) C\r
+DOES Define run-time behavior of definitions compiled/defined by a\r
+ high-level defining definition -- the FORTH equivalent of a\r
+ compiler-compiler. DOES> assumes that the LATEST symbol table\r
+ entry has at least one word of parameter field, which <BUILDS\r
+ provides. Note that DOES> is also not IMMEDIATE. When the\r
+ defining word containing DOES> executes the DOES> icode, it\r
+ overwrites the LATEST symbol's CFA with jsr <XDOES, overwrites\r
+ the first word of that symbol's parameter field with its own IP,\r
+ and pops the previous IP from the return stack. The icodes which\r
+ follow DOES> in the stream do not execute at the defining word's\r
+ run-time. Examining XDOES in the virtual machine shows that the\r
+ defined word will execute those icodes which follow DOES> at its\r
+ own run-time. The advantage of this kind of behaviour, which\r
+ you will also note in ;CODE, is that the defined word can\r
+ contain both operations and data to be operated on. This is how\r
+ FORTH data objects define their own behavior. Finally, note\r
+ that the effective code field for DOES> definitions is four\r
+ bytes.\r
+\r
+;CODE ( --- ) P,C\r
+SCODE ?CSP to see if there are loose ends in the defining definition\r
+ before shifting to the assembler, compile (;CODE) in\r
+ the defining definition's instruction stream, shift to\r
+ interpreting, make the ASSEMBLER vocabulary current, and !CSP to\r
+ mark the stack in preparation for assembling low-level code.\r
+ Note that ;CODE, unlike DOES>, is IMMEDIATE, and compiles\r
+ (;CODE),which will do the actual work of changing the LATEST\r
+ definition's characteristic when the defining word runs.\r
+ Assembly is done by the interpreter, rather than the compiler.\r
+ I could have avoided the anomalous three-byte code fields by\r
+ having ;CODE compile in the direct page jumps to the actual\r
+ low-level characteristics in the defining definition, thus\r
+ allowing (;CODE) to write a two-byte direct-page jumps into the\r
+ code fields of defined words. But that's a lot of work!\r
+\r
+\r
+**** Definitions/Routines in BIF5.A and BIF5B.A:\r
+\r
+\r
+IP, ( --- ) C\r
+IPCOM COMPILE a literal out of the instruction stream, without\r
+ checking compiler state. Used by the assembler to stuff\r
+ op-codes into the instruction stream, since the assembler runs\r
+ in interpretation mode.\r
+\r
+?STACK ( --- ) ( *** )\r
+QSTACK ( --- IN BLK ) ( anything *** nothing )\r
+ ERROR if either stack out of bounds, or on evidence of stack\r
+ boundary problems. There is a word below the bottom of each\r
+ stack, which ABORT clears before it starts interpreting. In\r
+ addition to checking that both stacks have not overflowed, this\r
+ routine checks those two words, to see if underflow has\r
+ occurred.\r
+\r
+BUFFER ( n --- buffer )\r
+ Get a free buffer, assign it to block n, return buffer address.\r
+ Will free a buffer by writing it, if necessary. Does not\r
+ actually read the block. A bug in the fig LRU algorithm, which\r
+ I have not fixed, gives the PREVious buffer if USE gets set to\r
+ PREVious (the bug is that it happens). This bug sometimes\r
+ causes sector moves to become sector fills.\r
+\r
+BLOCK ( n --- buffer )\r
+ Get BUFFER containing block n, relative to OFFSET. If block n\r
+ is not in a buffer, bring it in. Returns buffer address.\r
+\r
+(LINE) ( line screen --- buffer C/L)\r
+XLINE Bring in the sector containing the specified line of the\r
+ specified screen. Returns the buffer address and the width of\r
+ the screen. Screen number is relative to OFFSET. The line\r
+ number may be beyond screen 4, (LINE) will get the appropriate\r
+ screen.\r
+\r
+.LINE ( line screen --- )\r
+DOTLIN Print the line of the screen as found by (LINE), suppress\r
+ trailing BLANKS.\r
+\r
+SPACES ( count --- )\r
+ EMIT count spaces, for non-zero, non-negative counts.\r
+\r
+<# ( --- )\r
+BEGHSH Initialize HLD for converting a double integer. Stores the PAD\r
+ address in HLD.\r
+\r
+#> ( d --- string length )\r
+ENDHSH Terminate numeric conversion, drop the number being converted,\r
+ leave the address of the conversion string and the length, ready\r
+ for TYPE.\r
+\r
+SIGN ( n d --- d )\r
+ Put sign of n (as a flag) in front of the conversion string.\r
+ Drop the sign flag.\r
+\r
+# ( d --- d/base )\r
+HASH Generate next most significant digit in the conversion BASE,\r
+ putting the digit in front of the conversion string.\r
+\r
+#S ( d --- dzero )\r
+HASHS Convert d to a numeric string using # until the result is zero.\r
+ Leave the double result on the stack for #> to drop.\r
+\r
+D.R ( d width --- )\r
+DDOTR Print d on the output device in the current conversion base,\r
+ with sign, right aligned in a field at least width wide.\r
+\r
+D. ( d --- )\r
+DDOT Print d on the output device in the current conversion base,\r
+ with sign, in free format with trailing space.\r
+\r
+.R ( n width --- )\r
+DOTR Print n on the output device in the current conversion base,\r
+ with sign, right aligned in a field at least width wide.\r
+\r
+. ( n --- )\r
+DOT Print n on the output device in the current conversion base,\r
+ with sign, in free format with trailing space.\r
+\r
+? ( adr --- )\r
+QDOT Print signed word at adr, per DOT.\r
+\r
+MESSAGE ( n --- )\r
+MESS If WARNING is 0, print "MESSAGE #n"; otherwise, print line n\r
+ relative to screen 4, the line number may be negative. Uses\r
+ .LINE, but counter-adjusts to be relative to the real drive 0.\r
+ \r
+ In bif-c, add value of 2 for WARNING, for internal error message \r
+ strings.\r
+\r
+(ABORT) ( anything --- nothing ) ( anything *** nothing )\r
+IABORT An indirection for ABORT, for ERROR, which may be modified\r
+ carefully.\r
+\r
+ERROR ( anything line --- IN BLK ) ( anything *** nothing )\r
+ ( anything --- nothing ) ( anything *** nothing ) WARNING < 0\r
+ Prints out the last symbol scanned and MESSAGE number line. If\r
+ WARNING is less than zero, ABORTs through (ABORT), otherwise,\r
+ clears the parameter stack, pushes the INput cursor and\r
+ interpretaion BLK, and QUITs.\r
+\r
+EDITOR ( --- ) in EDITOR P\r
+ Set the current interpretation vocabulary to EDITOR.\r
+\r
+QSYNC ( --- ) in EDITOR\r
+ Synchronize the ECB cursor with R#.\r
+\r
+EBLK ( --- vadr ) in EDITOR\r
+ USER variable containing the current editing block.\r
+\r
+CURSOR ( --- adr ) in EDITOR\r
+ Calculates the address of the edit cursor, R#, within the\r
+ current editing block, bringing that block in if necessary.\r
+\r
+QDUMP ( adr --- ) in EDITOR\r
+ Dump the 256 bytes at adr to the screen memory, at the top half\r
+ of the screen (bottom half of screen memory).\r
+\r
+QARROW ( c --- c )\r
+ ( c --- 0 )\r
+ Adjust the cursor according to the key passed. If the key is a\r
+ cursor control key, return 0; otherwise, leave the key\r
+ unchanged. The regular back-arrow is used for cursor movement,\r
+ so the shifted back-arrow is used for destructive backspace.\r
+ Also, the up arrow is used for cursor movement, so caret is not\r
+ available without escaping. See QUICK.\r
+\r
+\r
+**** Definitions/Routines in BIF6.A and BIF6B.A:\r
+\r
+\r
+(NUMBER) ( d1 string --- d2 adr )\r
+INUMB Convert the text at string into a number, accumulating the\r
+ result into d1, leaving adr pointing to the first character not\r
+ converted. If DPL is non-negative at entry, accumulates the\r
+ number of characters converted into DPL.\r
+\r
+NUMBER ( ctstr --- d )\r
+ Convert text at ctstr to a double integer, taking the 0 ERROR if\r
+ the conversion is not valid. If a decimal point is present,\r
+ accumulate the count of digits to the decimal point's right into\r
+ DPL (negative DPL at exit indicates single precision). ctstr is\r
+ a counted string -- the first byte at ctstr is the length of the\r
+ string, but NUMBER ignores the count and expects a NUL\r
+ terminator instead.\r
+\r
+WORDPAD ( --- vadr )\r
+WORDPD The per-USER constant pointing to an intermediate\r
+ buffer for text scanning.\r
+\r
+WORD ( c --- )\r
+ Scan a string terminated by the character c or ASCII NUL out of\r
+ input; store symbol at WORDPAD with leading count byte and\r
+ trailing ASCII NUL. Leading c are passed over, per ENCLOSE.\r
+ Scans from BLK, or from TIB if BLK is zero. May overwrite the\r
+ numeric conversion pad, if really long (length > 31) symbols are\r
+ scanned.\r
+\r
+BS ( --- c )\r
+ The per-USER backspace constant.\r
+\r
+EXPECT ( buffer n --- )\r
+ Get up to n-1 characters from the keyboard, storing at buffer\r
+ and echoing, with backspace editing, quitting when a CR is read.\r
+ Terminate it with a NUL.\r
+\r
+QUERY ( --- )\r
+ EXPECT 128 (TWID) characters to TIB.\r
+\r
+ ( --- ) P\r
+NUBLK End interpretation of a line or screen, and/or prepare for a new\r
+ block. Note that the name of this definition is an empty\r
+ string, so it matches on the terminating NUL in the terminal or\r
+ block buffer.\r
+\r
+FIND ( namstr vocptr1 --- nfa vocptr2 )\r
+ Search a vocabulary, and its parents, if necessary, for a\r
+ definition called namstr. namstr is a counted (leading count\r
+ byte is ignored) string, vocptr1 is a pointer to a pointer to\r
+ a vocabulary tree or subtree. It will usually be the address of\r
+ the per-USER variable ROOT or DROOT, but may be a pointer to a\r
+ left or right link of an entry in the symbol tree. nfa will be\r
+ the name field address of the definition found, or a NULL.\r
+ vocptr2 will be the pointer-pointer to the last vocabulary\r
+ searched. vocptr2 will be the last vocabulary searche. See\r
+ (FIND).\r
+\r
+-DFIND ( --- nfa vocptr ) { -DFIND name } typical input\r
+DDFIND Parse a word, then FIND, first in the definition vocabulary,\r
+ then in the CONTEXT (interpretation) vocabulary, if necessary.\r
+ Returns the address of the symbol table entry or a NULL, and the\r
+ last vocabulary searched, per FIND.\r
+\r
+-IFIND ( --- nfa vocptr ) { -DFIND name } typical input\r
+DIFIND Same as -DFIND, except search the CONTEXT vocabulary first.\r
+\r
+NAME, ( --- ctStrPtr length )\r
+NCOMMA Store counted string at WORDPAD into dictionary, return HERE\r
+ pointer and length of string. Note that the count is not stored\r
+ in the dictionary, but that the address returned will be the\r
+ address to store the count at. (The length of the names of\r
+ definitions are stored after the actual names in the dictionary!)\r
+ \r
+ But in BIF-C, the lengths are stored with the strings, and the\r
+ address returned points to where the counted string was stored.\r
+\r
+FORE_MARK ( --- )\r
+FOREMK Set forward reference bit in LATEST definition, if FOREWARD is\r
+ non-NULL.\r
+\r
+(INSTALL) ( nfa vocptr --- ) P\r
+PINSTA Install the header at nfa into the specified vocabulary, hiding\r
+ (SMUDGEing) any existing definitions of the same name in that\r
+ vocabulary. In BIF-6809, vocptr was a pointer to the parameter \r
+ field of the vocabulary, and we follow that in BIF-C v. 0.\r
+\r
+0! ( --- )\r
+INULL Store 0 word at NULL pointer (address 0).\r
+\r
+?0 ( --- )\r
+TNULL Set warning to -1 and jmp to ERROR if the word at address 0\r
+ (NULL pointer) is not 0.\r
+\r
+QUICK ( n --- ) in EDITOR\r
+ Quick and dirty editor; edits sectors, not screens. See above\r
+ description.\r
+\r
+NODE. ( nfa --- flag )\r
+NDOT ID. with some formatting, extra information useful for\r
+ debugging, and a keyboard pause/abort test. Returns flag less\r
+ than 0 if BREAK key was pressed.\r
+\r
+VISIT ( defptr vocptr --- )\r
+ Scan vocabulary at vocptr in ascending order, performing\r
+ definition at defptr at every node. defptr is an nfa, vocptr is\r
+ the pfa of a vocabulary, per FIND and ROOT/DROOT. The\r
+ definition to be executed will have parameters of the same form\r
+ as NDOT, doing something at a symbol tree node and leaving a\r
+ termination flag. VISIT checks for stack overflow and watches\r
+ the termination flag between executions. The VISITing\r
+ definition may have other parameters, but if it changes the\r
+ stack pointer from execution to execution VISIT will complain.\r
+\r
+VLIST ( --- )\r
+ Alphabetically list the definitions in the current vocabulary.\r
+\r
+\r
+**** Definitions/Routines in BIF7.A and BIF7B.A:\r
+\r
+\r
+CREATE ( --- ) { CREATE name } input\r
+ Parse a name (length < 32 characters) and create a header,\r
+ reporting first duplicate found in either the defining\r
+ vocabulary or the context (interpreting) vocabulary. (INSTALL)\r
+ the header in the local vocabulary.\r
+\r
+CONSTANT ( n --- )\r
+CONST { value CONSTANT name } typical input\r
+ CREATE a header, compile a call to XCON, compile the constant\r
+ value.\r
+\r
+VARIABLE ( init --- )\r
+VAR { init VARIABLE name } typical input\r
+ CREATE a header, compile a call to XVAR, compile the initial\r
+ value init.\r
+\r
+USER ( ub --- )\r
+USER { uboffset USER name } typical input\r
+ CREATE a header, compile a call to XUSER, compile the unsigned\r
+ byte offset in the per-USER table. The USER is entirely\r
+ responsible for maintaining allocation!\r
+\r
+: ( --- ) P\r
+COLON { : name sundry-activities ; } typical input\r
+ If executing, record the data stack mark in CSP, CREATE a\r
+ header, compile a call to XCOL, and set state to compile. (SCOMP\r
+ is defined in this file.) CONTEXT (interpretation) vocabulary\r
+ is unchanged.\r
+\r
+; ( --- ) P\r
+SEMI { : name sundry-activities ; } typical input\r
+ ERROR check data stack against mark in CSP, compile ;S, unSMUDGE\r
+ LATEST definition, and set state to interpretation.\r
+\r
+." ( --- ) P\r
+DOTQ { ." something-to-be-printed " } typical input\r
+ Use WORD to parse to trailing quote, if compiling, compile XDOTQ\r
+ and string parsed, otherwise, TYPE string.\r
+\r
+[COMPILE] ( --- ) P\r
+BCOMP { [COMPILE] name } typical use\r
+ -DFIND next WORD and COMPILE it, literally; used to compile\r
+ immediate definitions.\r
+\r
+INTERPRET ( --- )\r
+INTERP Interpret or compile, according to STATE. Searches words parsed\r
+ in dictionary first, via -IFIND, then checks for valid NUMBER.\r
+ Pushes or COMPILEs double literal if NUMBER leaves DPL\r
+ non-negative. ERROR checks the stack via ?STACK before\r
+ returning to its caller. Sensitive to COMPILE-ONLY bit in\r
+ headers.\r
+\r
+QUIT ( anything *** nothing )\r
+ Clear return stack. Then INTERPRET and, if not compiling,\r
+ prompt with OK, in infinite loop.\r
+\r
+BIF ( --- ) P\r
+ Makes BIF the current interpretation vocabulary.\r
+\r
+ASSEMBLER ( --- ) P\r
+ASMBLR Makes ASSEMBLER the current interpretation vocabulary. Might\r
+ ought not to be IMMEDIATE.\r
+\r
+DEFINITIONS ( --- )\r
+DEFS Makes the current interpretation vocabulary also the current\r
+ defining vocabulary.\r
+\r
+ABORT ( anything --- nothing ) ( anything *** nothing )\r
+ Clear parameter stack, intialize the NULL vector, set STATE to\r
+ interpret and BASE to DECIMAL, return to input from terminal,\r
+ restore DRIVE OFFSET to 0, set interpret and define vocabularies\r
+ to BIF, print out "6809 BIF Vx.x", and finally, QUIT. Used to\r
+ force the system to a known state and return control to the\r
+ standard INTERPRETer.\r
+\r
+VOCABULARY ( --- ) { VOCABULARY name } input\r
+VOCAB Create a vocabulary entry with a NULL local pointer, linked by\r
+ the parent pointer to the current defining vocabulary. The\r
+ vocabulary parameter passed to the various searching routines is\r
+ usually a pointer to the parameter field of a vocabulary. That\r
+ way, the root is functionally identically to a left or right\r
+ link in a node or leaf, particularly for insertion.\r
+\r
+( ( --- )\r
+PAREN Parse out a comment and toss it away. This is probably not\r
+ useful, but it leaves the first 32 characters in WORDPAD.\r
+\r
+DAD ( nfa --- name linkadr flag )\r
+ Search the parent vocabulary of the definition at nfa for nfa,\r
+ returning the address of the first character of the definition's\r
+ name, a pointer to the left or right link which links the\r
+ definition in, and a flag indicating whether the definition is\r
+ linked left or right. ERROR if the definition can't be found.\r
+ The return parameters are appropriate for REPEALing the\r
+ definition.\r
+\r
+REPEAL ( --- )\r
+ Remove the CURRENT/LATEST definition from the dictionary, from\r
+ the vocabulary in which it is defined. Updates CURRENT, alsoe\r
+ updates DROOT or ROOT and clears FOREWARD, if appropriate. If\r
+ the CURRENT definition is in a closed forward block, repeals the\r
+ entire block, so that forward references aren't pointing to\r
+ trash.\r
+ \r
+ Except that I never got that last part written and working. So \r
+ you have to do that by hand. It does clear FOREWARD if FOREWARD \r
+ is pointing to the REPEALed definition.\r
+\r
+FORGET ( --- ) { FORGET name } input\r
+ Parse out name of definition to FORGET to, -DFIND it, then\r
+ REPEAL until it is removed from the dictionary. Will not FORGET\r
+ if definition is not found, if it is in a recursive block, or if\r
+ it is below FENCE; the ERROR message will include the offending\r
+ name.\r
+ \r
+ (Does it really?)\r
+\r
+\r
+**** Definitions/Routines in BIFST.A\r
+\r
+\r
+COLD COLD boot. Initializes the system variables, prunes the\r
+ dictionary of everything beyond the initial FENCE, then WARM\r
+ boots.\r
+\r
+WARM Resets stack areas and per-USER variables, clears the buffers,\r
+ then yields control to BIF via ABORT.\r
+\r
+\r
+****\r
+Definitions on the SCREENs disk follow. The vocabulary names are\r
+abbreviated here under the definition names, A for ASSEMBLER, B for BIF,\r
+U for UTILITIES, ^a for ^asm-util.\r
+\r
+**** SCREEN 0\r
+Index to the screens disk.\r
+\r
+**** SCREEN 2\r
+Title page and copyright notice.\r
+\r
+**** SCREEN 3\r
+MON ( --- )\r
+- Call the debugging monitor: SWI followed by a jmp [,y++], so\r
+ that BIF can be continued.\r
+\r
+After screen 2 creates MON, it updates FENCE to protect MON from WARM\r
+boots. Will load in the active vocabulary.\r
+\r
+**** SCREENs 4 & 5\r
+Error and other Messages:\r
+0: number conversion/unknown definition, no message text.\r
+1: DATA STACK UNDERFLOW\r
+2: DICTIONARY FULL\r
+3: ADDRESS RESOLUTION ERROR for control structures\r
+4: HIDES DEFINITION IN some vocabulary\r
+5: NULL VECTOR WRITTEN\r
+6: DISC RANGE? disk sector number out of range\r
+7: DATA STACK OVERFLOW\r
+8: DISC ERROR! of some sort -- is your drive door closed?\r
+9: CAN'T EXECUTE A NULL!\r
+10: CONTROL STACK UNDERFLOW\r
+11: CONTROL STACK OVERFLOW\r
+12: ARRAY REFERENCE OUT OF BOUNDS\r
+13: ARRAY DIMENSION NOT VALID\r
+14: NO PROCEDURE TO ENTER\r
+15: ( was register error message for assembler )\r
+16:\r
+17: COMPILATION ONLY, USE IN DEFinition\r
+18: EXECUTION ONLY do not use while compiling\r
+19: CONDITIONALS NOT PAIRED where's your if/loop end statement?\r
+20: DEFINITION INCOMPLETE often same as 18, but hit ;\r
+21: IN PROTECTED DICTIONARY don't try to forget below FENCE.\r
+22: USE ONLY WHEN LOADING\r
+23: OFF CURRENT EDITING SCREEN an editor cursor problem\r
+24: DECLARE VOCABULARY\r
+25: DEFINITION NOT IN VOCABULARY\r
+26: IN FORWARD BLOCK\r
+27: ALLOCATION LIST CORRUPTED: LOST\r
+28: CAN'T REDEFINE nul! You tried to CREATE something without a name.\r
+29: NOT FORWARD REFERENCE\r
+30: ( was message about IMMEDIATE )\r
+31:\r
+32:\r
+33: HAS INCORRECT ADDRESS MODE for 6809\r
+34: HAS INCORRECT INDEX MODE for 6809\r
+35: OPERAND NOT REGISTER in 6809\r
+36: HAS ILLEGAL IMMEDIATE for 6809\r
+37: PC OFFSET MUST BE ABSOLUTE pc-relative addressing error\r
+38: ACCUMULATOR OFFSET REQUIRED for indexing mode\r
+39: ILLEGAL MEMORY INDIRECTION for 6809\r
+40: ILLEGAL INDEX BASE for 6809\r
+41: ILLEGAL TARGET SPECIFIED for 6809 addressing mode or register\r
+42: CAN'T STACK ON SELF for push/pull, try other stack pointer\r
+43: DUPLICATE IN LIST of operands\r
+44: REGISTER NOT STACK trying to push on a non-stack register?\r
+45: EMPTY REGISTER LIST best supply some registers\r
+46: IMMEDIATE OPERAND REQUIRED for 6809\r
+47: REQUIRES CONDITION for control operator\r
+48:\r
+49: COMPILE-TIME STACK UNDERFLOW\r
+50: COMPILE-TIME STACK OVERFLOW\r
+\r
+**** SCREEN 6\r
+\r
+BYTE-DUMP ( adr n --- )\r
+U Dump n bytes to output device, right adjusted in 4 character\r
+ columns. Field width is not big enough if BASE is six or less.\r
+\r
+DUMP ( adr n --- )\r
+B Formatted dump to output device, with ASCII interpretation.\r
+ Hard coded to 4 bytes per line.\r
+\r
+QLIST ( n --- )\r
+B QDUMP a block/sector and set the cursor to the middle of the\r
+ screen so the dump remains visible.\r
+\r
+QINDEX ( start end --- )\r
+B QLIST block/sectors from number start to end, inclusive.\r
+\r
+L/SCR ( --- n )\r
+U Calculate the number of terminal lines per disc screen at\r
+ run-time. Sixteen, at present.\r
+\r
+ULIST ( n --- flag )\r
+U List screen n, with line numbers in the current base, leave\r
+ BREAK key flag. Uses C/L, to automatically adjust for screen\r
+ width (if C/L is set), but you may not want to use this\r
+ definition if you set C/L to something besides 32 or 64.\r
+\r
+**** SCREEN 7\r
+\r
+LIST ( n --- )\r
+B ULIST screen n, line numbers in decimal.\r
+\r
+INDEX ( start end --- )\r
+B Print comment lines (line 0, and line 1 if C/L < 41) of screens\r
+ from start to end.\r
+\r
+TRIAD ( n --- )\r
+B List a printer page full of screens to the printer, formatted by\r
+ C/L. Line and screen number are in current base. Lists the\r
+ group containing screen n, will print 2 screens if C/L is 32,\r
+ three if C/L is 64. (Two may not fit well.)\r
+\r
+**** SCREEN 8\r
+\r
+HOME ( --- )\r
+U Put the cursor at the (CoCo 2) CRT screen HOME position.\r
+\r
+MID ( --- )\r
+U Put the cursor 8 lines down the (CoCo 2) CRT screen.\r
+\r
+CLS ( --- )\r
+B Clear the (CoCo 2) CRT screen.\r
+\r
+CAN-UP ( adr -- adr )\r
+U Clear the UPDATE bit (MSB) for the buffer whose block word is at\r
+ adr. The characters in the buffer should be stored at adr+2.\r
+\r
+W-BUF ( adr --- adr )\r
+U Write the characters at adr+2 to the sector specified at adr,\r
+ clear the UPDATE flag.\r
+\r
+SAVE-BUF ( adr --- adr )\r
+U W-BUF, if UPDATEd.\r
+\r
+QSAVE ( --- )\r
+B Save the PREViously edited buffer, if it was UPDATEd.\r
+\r
+SAVE-BUFFERS ( --- )\r
+B Write all buffers flagged for UPDATE, clear UPDATE bits.\r
+\r
+QCAN ( --- )\r
+B Cancel UPDATE of PREViously edited buffer.\r
+\r
+**** SCREEN 9\r
+\r
+CANCEL-UPDATES ( --- )\r
+B Cancel UPDATEs of all buffers.\r
+\r
+RE-QUICK ( --- )\r
+B Re-edit PREVious buffer.\r
+\r
+.BUF ( adr --- adr )\r
+U Dump buffer characters at adr+2, showing the sector number\r
+ indicated at adr.\r
+\r
+.BUFFERS ( --- )\r
+B Dump all buffers, with block number, per .BUF.\r
+\r
+.PREV ( --- )\r
+B Dump contents and block number of PREVious buffer, per .BUF.\r
+\r
+EDIT ( n --- )\r
+B QUICK edit block n, showing the block number.\r
+\r
+QPREV ( --- )\r
+B QUICK edit the PREVious block.\r
+\r
+**** SCREEN 10\r
+\r
+QOPY ( src dest --- )\r
+B Move content of block/sector src to block dest. BUG: Doesn't\r
+ copy if src is already in a buffer (problem with LRU).\r
+\r
+COPY ( src dest --- )\r
+B Copy SCREEN src to SCREEN dest. Uses QOPY, so you should\r
+ EMPTY-BUFFERS before using COPY.\r
+\r
+QBACK ( start end --- )\r
+B Copy blocks from start to end to the next higher disc, at the\r
+ same sector offset.\r
+\r
+EEDIT ( n --- )\r
+B Erase and then EDIT block n.\r
+\r
+**** SCREEN 11\r
+\r
+RES-ERROR ( --- )\r
+U ERROR #3\r
+\r
+FORWARD ( --- ) { FORWARD name } input\r
+B Compile a forward reference header: CREATE, set FOREWARD if not\r
+ already set, compile jmp to RES-ERROR, unSMUDGE header.\r
+\r
+:RESOLVE ( --- ) { :RESOLVE name } input P\r
+A If the characteristic of name is a jmp to RES-ERROR, make it\r
+ LATEST, re-SMUDGE it, change jmp address to HERE; if the header\r
+ of name is the base of the forward block, clear FOREWARD.\r
+ Forward blocks should end with the definition of the first\r
+ forward reference in the block, to maintain the block's\r
+ integrity. (However, the FOREWARD USER variable can be modified\r
+ by hand, if necessary.)\r
+\r
+:RES ( --- ) { :RES name } input\r
+B Do ASSEMBLER's resolve, then compile jmp <XCOL and switch state\r
+ to compile.\r
+\r
+;RES ( --- ) P\r
+B ; but SMUDGE LATEST one more time.\r
+\r
+**** SCREEN 11 does not continue LOADing! ****\r
+\r
+**** SCREEN 12\r
+\r
+PL ( --- )\r
+B Print 80 ASCII characters starting with '!'.\r
+\r
+PT ( --- )\r
+B PL until any key is hit.\r
+\r
+PTEST ( --- )\r
+B PT, but send the output to the printer.\r
+\r
+**** SCREEN 13\r
+\r
+SLIST ( start end --- )\r
+- ULIST SCREENs to printer from start to end inclusive.\r
+\r
+**** SCREEN 14\r
+This contains some experimental stuff that I was using to test my a\r
+Sardis Technologies disk controller.\r
+\r
+**** SCREEN 15\r
+\r
+NAME ( cfa --- )\r
+B Convert the CFA on the stack to an nfa and ID. it.\r
+\r
+NAMES ( adr n --- )\r
+B NAME n icodes at adr. Naively interprets anything as an icode.\r
+\r
+**** SCREEN 16\r
+**** The assembler starts here! ****\r
+\r
+^asm-util ( --- )\r
+A Vocabulary for assembler support stuff. (Note that the name is\r
+ in lower case and looks funny when editing until the cursor\r
+ moves over it.)\r
+\r
+DREG ( n --- ) { n DREG name } input -> compile-time\r
+^a ( --- d ) -> run-time\r
+ Define register double constants. Most significant word is\r
+ `RE', the index and operand encodings are masked into the least\r
+ significant word.\r
+\r
+xx ( --- d ) high word is HEX 5245\r
+A The register double constants in hex:\r
+ D 52458B00 A 52458608 B 52458509 PC 52458C05\r
+ U 52454003 S 52456004 Y 52452002 X 52450001\r
+ CC 5245EF0A DP 5245EF0B\r
+ Example: DP A EXG is exg dp,a\r
+\r
+# ( --- n )\r
+A Suffix constant for immediate values. Becomes the high byte:\r
+ 4 # A LD is lda #4\r
+\r
+DPREG ( --- adr )\r
+^a DP register emulator for the assembler. A per-USER variable at\r
+ offset HEX 42, initialized to whatever the load-time DP is.\r
+\r
+DPR ( --- adr )\r
+A Push the current DPREG value, as a constant. To use as an\r
+ absolute address, push a 0 or -1 after.\r
+ Example: DPR 7 + 0 JMP is jmp <7\r
+\r
+SETDP ( adr --- )\r
+A Set the DPREG value, masks the low byte of adr out.\r
+\r
+**** SCREEN 17\r
+\r
+OFF, (n b --- )\r
+^a Compile an index byte b with signed, constant, byte or word\r
+ offset, n. Sets bit 0 in the index byte if it compiles a word\r
+ offset.\r
+\r
+OP, ( u --- )\r
+^a Compile opcode u. Compiles 16 bits if high byte of u is\r
+ non-zero.\r
+\r
+ABS, ( adr u1 u2 --- )\r
+^a Compile an absolute address mode (direct page or extended)\r
+ op-code u1, oring u2 into u1 before compiling if the address is\r
+ not in the direct page.\r
+\r
+PCOFF ( adr n1 --- n2 flag )\r
+^a Generate a pc-relative offset n2 from adr, adjusted by n1 bytes\r
+ of op-code/index. Flags true if offset fit in a byte, false if\r
+ it required 16 bits.\r
+\r
+?ABS ( d --- adr flag )\r
+^a Convert high word of d to flag showing true if high word was 0\r
+ or -1, false otherwise. A 0 or -1 high word indicates an\r
+ absolute address as an operand.\r
+ Example: HEX .FF20 B OR is orb $FF20\r
+\r
+PCR, ( d b --- )\r
+^a ERROR if d is not absolute mode operand. Calculate offset and\r
+ compile index byte b and offset.\r
+\r
+**** SCREEN 18\r
+\r
+Auto-indexing address mode double constants, in ASSEMBLER vocabulary:\r
+-) ( --- 4155.0082 ) ,-r\r
+)++ ( --- 4155.0081 ) ,r++\r
+)+ ( --- 4155.0080 ) ,r+\r
+--) ( --- 4155.0083 ) ,--r\r
+ Example: )++ X , D ST is std ,x++\r
+\r
+MASK, ( b1 b2 --- )\r
+^a Compile the bit-or of the top two words's low bytes.\r
+\r
+REG, ( u b --- )\r
+^a Convert a register offset specified by u to its extension byte\r
+ representation, mask in the index register and indirection\r
+ specifier b, and compile the resulting index byte.\r
+\r
+IXOFF, ( n b --- )\r
+^a Generate the appropriate index extension byte for the constant\r
+ offset n and indirection level specified, mask in the index\r
+ register and indirection specifier b, and compile both the\r
+ extension byte and the offset. Handles zero and 5-bit offsets.\r
+\r
+EI, ( d b --- )\r
+^a Compile a (completely specified) extended-indirect extension\r
+ byte b and the absolute address d.\r
+\r
+**** SCREEN 19\r
+\r
+IX, ( d n --- )\r
+^a Compile an index mode address operand. n contains the index\r
+ register and indirection level encoding, d contains the offset\r
+ or auto-mode specification. Zero offset must be explicit. Does\r
+ not block out unsupported [,r+] and [,-r] modes.\r
+\r
+, ( d1 --- d2 )\r
+A Convert indexable register d1 to index mode specifier d2.\r
+ Examples: 0. X , B OR is orb ,x\r
+ A X , JMP is jmp a,x\r
+ TABLE 0 PC , X LEA is leax table,pcr\r
+\r
+) ( d1 --- d2 )\r
+A Convert indexable register, absolute address, or index operand\r
+ d1 to memory indirect operand. Note that this will NOT\r
+ interfere with comments.\r
+ Examples: TABLE 6 + 0 PC ) JMP is jmp [6,pcr]\r
+ )++ S ) JSR is jsr ,s++\r
+\r
+**** SCREEN 20\r
+\r
+ACCM ( n1 n2 n3 --- n4 )\r
+^a Convert op-code n1, register n2, and mask bits n3 to accumulator\r
+ encoded op-code n4. Used for encoding ACCM destination\r
+ op-codes.\r
+\r
+UNARY ( u --- ) >--> compile-time\r
+^a { u UNARY name } input >-/\r
+ ( do dx --- ) indexed modes >-\\r
+ ( d --- ) non-indexed modes >--> run-time\r
+ Unary op-code compiler -- compiles an assembler of unary\r
+ op-codes with op-code (u) and name. Run-time parameters: d is\r
+ the destination register or address, dx is the index\r
+ mode/register, do is the offset/auto mode.\r
+ Examples: A NEG is nega\r
+ 7. U , ROR is ror 7,u\r
+\r
+REG ( d adr --- d u sz ) -- JSR\r
+^a ( d adr --- u sz )\r
+ Encode binary destination register d into op-code from table at\r
+ adr. Table format is primary (byte), highest (byte), secondary\r
+ (word) secondary (word) .... Leave op-code u and size sz (-1 is\r
+ word, 0 is byte) of register encoded. Helps to reduce the\r
+ complexity of the binary operators op-code map, see BINARY\r
+ concerning constructing the tables.\r
+\r
+**** SCREEN 21\r
+\r
+#, ( n u sz --- )\r
+^a Compile an immediate op-code u with immediate operand n of size\r
+ byte, if sz == 0, or word, ERROR if op-code is ST or JSR.\r
+\r
+BINARY ( ul b ub --- ) >--> compile-time\r
+^a { ul b ub BINARY name } input >-/\r
+ ( ds --- ) JSR >-\\r
+ ( ds dd --- ) non-indexed mode >--> run-time\r
+ ( do dx dd --- ) indexed mode >-/\r
+ Compile an assembler of binary operators, with primary op-code\r
+ (accumulator form, any mode) ub, count of other codes (0, 1, or\r
+ 5) b, and optional list of other codes ul. The list of other\r
+ op-codes must be pushed on the stack in the order S, U, Y, X,\r
+ and D (LD, ST, and CMP), or must be just the op-code for D (ADD\r
+ and SUB). Page escape codes must be included in the op-codes.\r
+ Run-time operands: ds is the source, do is the source\r
+ offset/auto mode, dx is the index mode/register, dd is the\r
+ destination register. Example: 12 # D CMP is cmpd #12 -800. X )\r
+ X LD is ldx [-800,x]\r
+\r
+REG-REG ( b --- ) { b REG-REG name } input -> compile-time\r
+^a ( d1 d2 --- ) -> run-time\r
+ Compile an assembler of register d1 to register d2 moves.\r
+ Examples: D Y EXG is exg d,y\r
+ A CC TFR is tfr a,c\r
+\r
+**** SCREEN 22\r
+\r
+REG-BITS ( n --- vadr )\r
+^a 1ARRAY of register bits for push/pull extension byte. The\r
+ Undefined slots set all bits to stabilize PACK. Use the low\r
+ word of a register specifier to index the array (see the DREG\r
+ constants).\r
+\r
+PACK ( n dl n --- n b )\r
+^ Pack register list dl into result byte b. Terminates when the\r
+ n, which is not the high word of a register specifier, is DUPed\r
+ and compared to HEX 5245; thus, any word or double which won't\r
+ be interpreted as a register specifier (see DREG) will terminate\r
+ the list, including the stack hole. ERRORs on attempt to push a\r
+ stack register on itself. May underflow the parameter\r
+ stack if the stack hole is corrupted with HEX 5245, of course,\r
+ but will not attempt to draw more than 8 doubles from the stack\r
+ unless REG-BITS is corrupted.\r
+\r
+MOVEM ( b --- ) { b MOVEM name } input -> compile-time\r
+^a ( n dl d --- n ) -> run-time\r
+ Compile a push or pull instruction assembler. d is the stack\r
+ register to push or pull. See PACK.\r
+ Example: D X Y U PSH is pshu d,x,y\r
+ (But don't leave stray register specifiers on the stack!)\r
+\r
+**** SCREEN 23\r
+\r
+BR ( d1 d2 --- )\r
+A Assemble a branch on condition d2 to absolute address d1.\r
+ Converts to PC relative, assembles a short branch if branch\r
+ target is close enough.\r
+ Example: LABEL 0 CCLR BR is bcc [LABEL]\r
+\r
+DCOND ( n --- ) { n DCOND name } input -> compile-time\r
+^a ( --- d )\r
+ Compile a branch condition constant; high word is HEX 434F.\r
+ Always (AL), never (NV), and subroutine (SR) are provided as\r
+ DCONDs.\r
+ Example: ' BMUL CFA 0 AL BR is bra BMUL\r
+\r
+CC-IMM ( b --- ) { b CC-IMM name } -> compile-time\r
+^a ( d --- ) -> run-time\r
+ Compile ORCC, ANDCC, EORCC, or CWAI assemblers. The assemblers\r
+ will ERROR if the operand is not immediate.\r
+ Example: HEX EF # CWAI is cwai #$EF\r
+\r
+IMPLY ( b --- ) { b IMPLY name } input >--> compile-time\r
+^a ( --- ) run-time\r
+ Compile assemblers of implicit operand instructions.\r
+ Example: NOP is nop\r
+\r
+**** The next two SCREENs contain op-code assemblers. ****\r
+See the compilers for run-time descriptions. The odd organization keeps\r
+the trees balanced. The assemblers, or, in other words, the mnemonics,\r
+are in the ASSEMBLER vocabulary.\r
+\r
+**** SCREEN 24\r
+\r
+BINARYs LD ST and CMP with their associated 16-bit register op-code\r
+ lists.\r
+MOVEMs PUL PSH UNARYs ROR ROL IMPLYs RTS RTI\r
+BINARY SBC DCOND SR (subroutine) REG-REG TFR\r
+UNARY TST BINARY SUB with D\r
+IMPLYs SWI2 SWI3 SWI SYNC BINARYs AND ADC\r
+UNARYs ASL ASR BINARY ADD with D IMPLY ABX\r
+DCOND CS UNARYs COM CLR DCOND AL (always)\r
+BINARY BIT UNARY DEC IMPLY DAA\r
+DCONDs HI MI EQ GE REG-REG EXG UNARY INC\r
+BINARY JSR UNARY JMP BINARY EOR\r
+DCONDs GT HS IMPLY NOP DCONDS LS PL\r
+\r
+**** SCREEN 25\r
+\r
+UNARYs LSR LSL DCONDs LT NE IMPLY MUL\r
+UNARY NEG BINARY OR CC-IMM ORCC\r
+DONCD NV (never) IMPLY SEX (blush) CC-IMMs ANDCC CWAI\r
+DCONDs VC VS CCLR (Carry CLeaR)\r
+\r
+EA-IX ( n --- vadr )\r
+^a 1ARRAY of translations from register (DREG) to LEA arguments.\r
+\r
+LEA ( do dx dd --- )\r
+A Assembler for LEA instructions. do is the offset/auto mode, dx\r
+ is the source index register, dr is the destination index\r
+ register.\r
+ Example: D Y , X LEA is leax d,y\r
+\r
+DCONDs LE LO\r
+\r
+**** SCREEN 26\r
+\r
+[CD] ( --- dcfa ) { [CD] name } input P\r
+A Produce the CFA of the following definition header, for use as a\r
+ jump or indexing target. If compiling, causes the code address\r
+ to be compiled as a double literal; otherwise, pushes the cfa as\r
+ a double, so the assemblers can use it for addressing.\r
+\r
+& ! ^ ( n1 n2 --- n3 )\r
+A Aliases for AND OR and XOR for the assembler vocabulary.\r
+\r
+NEXT ( --- )\r
+A Assembler the NEXT instruction, jmp [,y++].\r
+\r
+**** The assembler control constructs are patterned after FORTH\r
+control constructs, but test the Condition Code register.\r
+****\r
+\r
+**** SCREEN 27\r
+\r
+INVERTCC ( dcond --- ~dcond )\r
+^a Invert the assembler branch condition (double word) on top of\r
+ stack.\r
+\r
+LIF ( dcond --- daddr )\r
+A Mark HERE as a double with the address in the low word and HEX\r
+ 4146 in the high word. Assemble a long branch on the inverse of\r
+ the condition given, and leave the mark. Temporarily set the\r
+ branch address to the RES-ERROR routine.\r
+\r
+IF ( dcond --- daddr )\r
+A Same as LIF, but assembles short branch with 0 offset.\r
+\r
+**** SCREEN 28\r
+\r
+FILL-IN ( dadr --- )\r
+^a Resolve offset of branch at mark to HERE, handle two, three, and\r
+ four byte branches.\r
+\r
+**** SCREEN 29\r
+\r
+ELSE ( daddr1 --- daddr2 )\r
+A ERROR check the mark daddr1, mark HERE and assemble short branch\r
+ always, via IF, and FILL-IN the previously marked IF or LIF.\r
+\r
+LELSE ( daddr1 --- daddr2 )\r
+A Same as ELSE except mark and assemble long branch always via\r
+ LIF.\r
+\r
+ENDIF ( daddr --- )\r
+A ERROR check the mark, and resolve the IF or LIF.\r
+\r
+BEGIN ( --- daddr )\r
+A Mark indefinite loop beginning with HERE. High word of mark is\r
+ HEX 4142.\r
+\r
+UNTIL ( daddr dcond --- )\r
+A ERROR if daddr is not BEGIN mark; assemble branch on inverse of\r
+ condition dcond to address marked in daddr.\r
+\r
+WHILE ( daddr dcond --- adr daddr )\r
+A ERROR if daddr is not BEGIN mark; assemble forward branch on\r
+ inverse of condition dcond, leave BEGIN address on stack and\r
+ extend mark with WHILE address and mark, HEX 4157.\r
+\r
+REPEAT ( adr daddr --- )\r
+A ERROR if not WHILE mark, assemble a branch to the BEGIN address\r
+ and FILL-IN the WHILE address.\r
+\r
+LWHILE ( daddr dcond --- adr daddr )\r
+A Forced long branch version of WHILE.\r
+\r
+**** SCREEN 30\r
+\r
+:ASM ( --- )\r
+A CREATE a header and store the parameter stack pointer in CSP to\r
+ mark the stack for assembler control construct and other errors.\r
+\r
+;ASM ( --- )\r
+A ERROR check CSP and un-smudge the definion. NEXT must be\r
+ explicitly assembled.\r
+\r
+I-CODE ( --- )\r
+A Shift to high-level compiling. (Assembles jmp <XCOL, changes\r
+ state to compiling, changes interpretation vocabulary to\r
+ definition vocabulary.)\r
+\r
+MACHINE ( --- ) P\r
+A Shift to assembly language. (Compiles (MACHINE), changes state\r
+ to interpretation, sets interpretation vocabulary to assembler.)\r
+\r
+**** SCREEN 32\r
+ Some Doubles\r
+\r
+D! ( d adr --- )\r
+B Store double d at adr.\r
+\r
+D@ ( adr --- d )\r
+B Fetch double (two words) at adr.\r
+\r
+DOVER ( d1 d2 --- d1 d2 d1 )\r
+B Copy the second double (bytes 4-7) on the stack to the top.\r
+\r
+DSWAP ( d1 d2 --- d2 d1 )\r
+B Swap the top two doubles (bytes 0-3 with bytes 4-7).\r
+\r
+**** SCREEN 64\r
+\r
+ This is an example showing use of the dictionary to associate\r
+pairs, from one of the textbooks I have. I apologize to the source for\r
+not giving proper credit, but I can't find it. It is included to show\r
+use of DOES> and to show how having the symbol table handy at run-time\r
+can be taken advantage of. It builds pairs of objects linked to each\r
+other such that typing one in results in printing the other out.\r
+\r
+\r
+*******************************************************************************\r
+ Some Thoughts and Comments:\r
+\r
+\r
+Hey, it's not a professional package, so I can put this here if I want!\r
+\r
+One of the problems with BIF is the power of the 6809. It is all too\r
+easy to use 6809 instructions instead of icodes. This means that the\r
+6809 architecture gets woven into BIF, as mentioned at the end of the\r
+discussion on the virtual machine.\r
+\r
+BIF can probably be made to conform with one of the standards by moving\r
+the virtual machine routines to their associated definitions (XCOLON to\r
+COLON, XVAR to VARIABLE, etc.) and by making all code fields three-byte\r
+jumps (JSRs). Direct threading will probably not be a problem, as long\r
+as code fields are uniform in size.\r
+\r
+The constant shifting between modes which I have done makes a built-in\r
+debugger more complex, as well. One specific example is that using a\r
+macro instead of a jump to a NEXT inner interpreter makes debugging more\r
+complex. If there is an inner interpreter, and if the low level\r
+routines are known to be error free, the debugger can simply be a jump\r
+inserted in the NEXT routine. Use of a macro forces the debugger to be\r
+sensitive to the 6809 architecture, and requires either use of the SWI\r
+method (which can't be used in ROM), CPU emulation, or external\r
+breakpoint/single-step hardware. The latter method is more complete,\r
+but inserting a debugging routine in the inner interpreter is often all\r
+that is necessary.\r
+\r
+A possible inner interpreter for a direct threaded FORTH (could be\r
+located in the direct page):\r
+\r
+ NEXT ldx ,y++ 8~\r
+ jmp ,x 3~ 14~ (w/ jmp <NEXT)\r
+\r
+Or for indirect threading:\r
+ NEXT ldx ,y++ 8~\r
+ jmp [,x] 6~ 17~ (w/ jmp <NEXT)\r
+\r
+Compared to BIF:\r
+ jmp [,y++] 9~\r
+\r
+The apparent disadvantages of the above are at least partially offset by\r
+the fact that X will contain the CFA on entry to the characteristic\r
+routines. In other words, X can substitute for W, and there is no need\r
+to store the CFA of the executing low level routine in an external\r
+register (on the stack, in the case of BIF). Showing how this affects\r
+XCOL, for direct threading:\r
+\r
+ someDEF jmp XCOL 4~\r
+ . . .\r
+ XCOL pshs y 7~\r
+ leay 3,x 5~\r
+ jmp <next 3~ 19~, total 33~\r
+\r
+For indirect threading:\r
+\r
+ someDEF fdb XCOL 0~\r
+ . . .\r
+ XCOL pshs y 7~\r
+ leay 2,x 5~\r
+ jmp <NEXT 3~ 15~, total 32~\r
+\r
+Compared to BIF:\r
+ someDEF jsr <XCOL 7~\r
+ . . .\r
+ XCOL ldx ,s 5~\r
+ sty ,s 6~\r
+ tfr x,y (leay ,x) 6~ (4~)\r
+ jmp [,y++] 9~ 33~, total 42~\r
+\r
+SURPRISED? I was. Of course, the characteristic routines must be a\r
+little careful to use or save X before they clobber it, but that isn't\r
+as difficult as it might seem.\r
+\r
+The direct page might still be used to locate the per-USER table, or\r
+might even contain it. At first glance, it would appear too expensive\r
+to offset the DP register with a variable index. But compare the\r
+following to the code in BIF:\r
+\r
+ XUSER tfr dp,a 6~\r
+ ldb [,s++] 10~ (stored as byte offset)\r
+ pshu d 7~ (there's the address)\r
+ jmp [,y++] 9~ 32~ compared to 34~\r
+\r
+If X is used for the temporary W register as in the indirect threaded\r
+inner interpreter example above, we can get the following, which speaks\r
+for itself:\r
+\r
+ XUSER tfr dp,a 6~\r
+ clrb 2~ (showing word offset, )\r
+ addd 2,x 7~ (byte would be shorter)\r
+ pshu d 7~\r
+ jmp <NEXT 3~ 25~\r
+\r
+Ah, experience. What we have to go through to get it!\r
+\r
+The key to FORTH and its dialects is found in ;CODE and DOES>. By\r
+providing both characteristic behaviour and data allocation, FORTH words\r
+(symbols/definitions) are primitive objects. A full object-oriented\r
+language could be generated with FORTH, but then you would probably have\r
+SMALLTALK!. A standard compiling language keeps the symbol table, its\r
+data, and the code that accesses it entirely separate, and wastes a lot\r
+of code space doing so. Professional FORTH systems can strip the symbol\r
+table out of compiled applications, if necessary, but the symbol table\r
+is available at run-time until the programmer is satisfied that his\r
+program is bug-free. Moreover, the programmer has access to the same\r
+library used by the language, which is usually not the case with\r
+compiled languages, even with C.\r
+\r
+A careful examination of the overhead in FORTH shows that it is\r
+approximately the same as the overhead in a good C compiler. While it\r
+would appear that constantly moving stuff on and off the stack would be\r
+a hindrance to progress, a second look reveals that the accumulator\r
+bottleneck requires this kind of movement. I wish I had time and\r
+facilities to examine this specific question in relation to a large\r
+register set.\r
+\r
+I sometimes wonder if management paranoia (PROTECT OUR INTELLECTUAL\r
+PROPERTY!) is the primary reason FORTH, LISP, and SMALLTALK have not\r
+entirely supplanted the compiled languages. If so, why is management\r
+willing to hide, protect, and hang on to code, but not willing to hang\r
+on to the engineers in whose brains the technology really resides? Or\r
+in the converse, if management can see that it is sometimes necessary to\r
+let people go, why can't they see that there are some things that are\r
+not worth the cost of trying to protect their tools from? And why can't\r
+they see that a intellectual property stolen by copying still requires a\r
+large investment in somebody's time to learn to use it? Why doesn't\r
+public domain code get used? Because it costs better than an order of\r
+magnitude more to learn how to use it than it does to get it.\r
+\r
--- /dev/null
+Information about BIF as of April 2019.\r
+\r
+ Joel Matthew Rees, Amagasaki, Hyogo, Japan.\r
+ joel.rees@gmail.com\r
+ http://reiisi.blogspot.com\r
+ https://defining-computers.blogspot.com/\r
+ etc.\r
+ Copyright 2000, 2019 Joel Matthew Rees\r
+\r
+-----\r
+\r
+(The following can be found in its original form in the bif-c \r
+repositories. bif-c is buggy, by the way.)\r
+\r
+-----\r
+\r
+BIF was a dialect of the early fig-standard FORTH. It was a student\r
+project, not a commercial product, and no warranty has ever been made \r
+concerning it, whatsoever. It was written on the Color Computer 2 in \r
+6809 assembler; the assembler used was disk EDTASM+. It also ran on \r
+the Color Computer 3, with the expected limitations of requiring the \r
+32 column screen, etc. \r
+\r
+License information -- the rights to BIF and the materials with it, \r
+and restrictions on distribution -- are described in the file \r
+BIFDOC.TXT, which really should distributed with the source along with \r
+this README.TXT. \r
+\r
+The short version of the licensing information is that I am distributing \r
+BIF6809 under the essential terms of the Internet Systems Consortium \r
+ISC License:\r
+\r
+=========\r
+Permission to use, copy, modify, and/or distribute this software for \r
+any purpose with or without fee is hereby granted, provided that the \r
+accompanying copyright notices and this permission notice appear in \r
+all copies.\r
+\r
+THE SOFTWARE IS PROVIDED “AS IS” AND ISC DISCLAIMS ALL WARRANTIES \r
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF \r
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY \r
+SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES \r
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN \r
+AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, \r
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS \r
+SOFTWARE.\r
+=========\r
+\r
+I add here the stipulation that I claim right to the word "BIF" as \r
+the name of a programming language.\r
+\r
+If you are going to distribute or redistribute the obect or source of \r
+bif in any of its forms, it really makes no sense not to include the \r
+BIFDOC.TXT and this README.TXT. If you do something like that and \r
+you or anyone that gets the results has problems with it, and you come \r
+to me looking for help, expect to be teased mercilessly about it. And \r
+expect to be on the bottom of my priority list, not out of spite, \r
+out of self-protection.\r
+\r
+-----\r
+\r
+I have reconstructed something approximating my source disks (using the \r
+great emulator, xroar: https://www.6809.org.uk/xroar/ and the imgtool\r
+distributed with MAME, along with the *nix tools). Some useful commands \r
+are noted in commands.txt.\r
+\r
+The name of the disk image is (appropriately?) bifsource.dsk. It can be \r
+directly attached by xroar's disk emulator tools, and should be similarly \r
+useable with VCC, MAME, etc. al.\r
+\r
+-----\r
+\r
+The assembler source files are readable by the a variety of text editors,\r
+that respond flexibly about line termination. But if you try editing them\r
+with a normal editor and then assembling the result with EDTASM+, be very \r
+careful about line termination. Be prepared to use *nix command line tools \r
+like tr, cut, sed/awk, perl, etc. \r
+\r
+The source files retain the original line numbers as used by EDTASM+, \r
+which is why you will want the *nix tools. But I have included source to a \r
+short C program, stripln.c, which strips the line numbers. This program \r
+may also be useful for converting line endings, if that is necessary. Look \r
+for it in the junkbox directory, and be prepared to compile it. \r
+\r
+If you are under the burden of using Microsoft OSses, the Cygwin project \r
+should be of quite a bit of assistance, including the *nix command line \r
+tools and gcc and clang, etc.\r
+\r
+-----\r
+\r
+Macros are used in the source, but shouldn't cause too much confusion \r
+to a programmer with assembler experience. If anyone is brave enough \r
+to try to port it, key routines will be EMIT, KEY, ?TERMINAL, CR, R/W, \r
+and several routines in the EDITOR vocabulary where I used direct \r
+video I/O out of laziness.\r
+\r
+-----\r
+\r
+BIF might be useful for experimentation and for learning about FORTH, \r
+for someone who has access to a Color Computer or an emulator. The \r
+executable file may be run on the Color Computer by LOADMing it via \r
+Color Computer Disk BASIC. (More details in BIFDOC.TXT.) \r
+\r
+It is assembled to be EXECed at hexadecimal 1300 (&H1300). \r
+\r
+-----\r
+\r
+One specific warning must be given:\r
+\r
+DO NOT ATTEMPT TO ACCESS ORDINARY DISKS FORMATTED FOR USE BY OTHER\r
+OPERATING SYSTEMS WHILE BIF IS RUNNING! Because of disk buffering, it \r
+will be difficult to avoid unintentional writes to the disk. \r
+\r
+If you do try looking at an OS-9 or Color Computer DOS (etc.) disk with \r
+BIF, don't blame me if you destroy the directory and/or other valuable \r
+data.\r
+\r
+-----\r
+\r
+I tried a re-write in C (bif-c), but it's not working well. Issues with \r
+file systems (no real file system in BIF) and the current standardization \r
+committees ideas about what is meaningful code, problems with my own \r
+attention span, etc. keep it full of bugs. And I used a number of neat \r
+tricks that get in the way in C. \r
+\r
+One thing I want to retain is the use of nested binary trees in the \r
+symbol table. \r
+\r
+Incidentally, said re-write has been in process for over thirty years.\r
+Real life keeps getting in the way.\r
+\r
+-----\r
+\r
+I am including source to a Q&D C program, 32col.c, which will re-format \r
+files extracted from BIF disks for normal text editors. Mac-isms and \r
+Codwarrior-isms can probably be discerned by comparing it with stripln.c, \r
+mentioned above. \r
+\r
+When I brought the BIF high-level source with me, I used some feature of \r
+Color Computer BASIC and BIF that I have forgotten to dump some of the \r
+Forth style screen listings. \r
+\r
+The program stripln can be used to strip line numbers from such screen \r
+listings, as well. \r
+\r
+The documentation is ASCII text, with CR/LF line termination, and should\r
+be examined carefully by anyone considering a port. Bear in mind that\r
+it was written toward Color Computer users.\r
+\r
+I apologize for not alphabetizing the FORTH words by name. I did it once \r
+with a C program, but got too ambitious and lost the results in the \r
+process of trying to split it up into modules. I haven't had enough time \r
+to finish the modularization, yet, either. (Getting an iBook so I could \r
+work on the train just gave me more things to do on the train.)\r
+\r
+Files in this distribution --\r
+\r
+6809 Assembly Language Source files:\r
+\r
+README.TXT\r
+ this file.\r
+BIFDOC.TXT\r
+ general explanations, including descriptions of every word.\r
+BIFU.I\r
+ structure of the per-user variable page.\r
+BIF.M\r
+ macros, including the inner interpreter (basis of the virtual machine),\r
+ the dictionary (symbol table) structure offsets,\r
+ and invocations for the fundamental objects.\r
+BIFDP.A\r
+ things kept in the direct page, \r
+ including the behaviours for the fundamental objects (was not a good idea after all),\r
+ and the index to the per user variable page. \r
+BIFST.A\r
+ cold and warm boot routines and the initial value table for the per-user variable page.\r
+BIF.ASM\r
+ the main source file (includes other parts),\r
+ basic expression evaluation, more of the inner interpreter, \r
+ basic vocabulary access, basic symbol parsing.\r
+BIFB.A\r
+ basic I/O, more of the inner interpreter, extended expression evaluation,\r
+ the rest of the basic symbol table access.\r
+BIF1.A\r
+ data movers, common expression evaluation,\r
+ stack pointer access, more of the inner interpreter,\r
+ high-level compiler.\r
+BIF1B.A\r
+ common expression evaluation, extended expression evaluation,\r
+ innards of the high-level compiler, more of the high-level compiler,\r
+ compiler directive.\r
+BIF2.A\r
+ more common expression evaluation, common constants,\r
+ I/O constants, character typing constants,\r
+ symbol table globals, compiler globals, parser globals, I/O globals.\r
+BIF2B.A\r
+ compiler globals, more high-level compiler,\r
+ more common expression evaluation, formatted output.\r
+BIF3.A\r
+ more basic symbol table, symbol table, more compiler, more formatted output,\r
+ more data movers, more low-level parser (formatted input), more I/O,\r
+ more extended expression evaluation, more expression evaluation, \r
+ more compiler directives, an extension to the inner interpreter.\r
+BIF3B.A\r
+ more formatted output, more innards of the high-level compiler,\r
+ more high-level compiler.\r
+BIF4.A\r
+ more innards of the expression evaluator, more common expression evaluation,\r
+ more I/O (buffer handling).\r
+BIF4B.A\r
+ more high-level compiler, more compiler directive.\r
+BIF5.A\r
+ more innards of the high-level compiler, more I/O (buffering),\r
+ disk access, error handling, more formatted output.\r
+BIF5B.A\r
+ more error handling, screen-based sector (character) editor.\r
+BIF6.A\r
+ more parser (formatted input), I/O (terminal), compiler (input),\r
+ symbol table (lookup).\r
+BIF6B.A\r
+ symbol table, compiler innards, null vector test, \r
+ more screen-based sector editor.\r
+BIF7.A\r
+ compiler, formatted output, compiler directives\r
+BIF7B.A\r
+ error handling, symbol tables, compiler directives.\r
+stripln.c,\r
+32col.c, \r
+ C language source and Macintosh executables for stripping line \r
+ numbers and reformatting 32 column source code "screens". The two \r
+ XXX.GXX.out files below are output of the 32col program.\r
+\r
+-----\r
+\r
+Hopefully, I will shortly have time to reconstruct useful things from the \r
+following files on the tools.dsk disk image and/or the cs431 disk image:\r
+\r
+TOOLS.G00, TOOLS.G00.out\r
+ FORTH source for disk listing, screen handling, definition dumping, \r
+ sector copying, forward referencing, buffer maintenance, \r
+ experimenting with hardware, double (32 bit) integer math, etc.,\r
+ and a post-fix assembler.\r
+PAIRS.G28, PAIRS.G28.out\r
+ a "database" example from one of my FORTH books.\r
+\r
+and\r
+\r
+SCR33.ARR\r
+ arrays for CS431.\r
+SCR34.LOC\r
+ some math for CS431.\r
+SCR40.431\r
+ test suite for CS431.\r
+\r
+\r
+\r
--- /dev/null
+Information about BIF as of April 2019.\r
+\r
+ Joel Rees, Amagasaki, Hyogo, Japan.\r
+ joel.rees@gmail.com\r
+ http://reiisi.blogspot.com\r
+ https://defining-computers.blogspot.com/\r
+ etc.\r
+ \r
+-----\r
+\r
+(The following can be found in its original form in the bif-c \r
+repositories. bif-c is buggy, by the way.)\r
+\r
+-----\r
+\r
+BIF was a dialect of the early fig-standard FORTH. It was a student\r
+project, not a commercial product, and no warranty has ever been made \r
+concerning it, whatsoever. It was written on the Color Computer 2 in \r
+6809 assembler; the assembler used was disk EDTASM+. It also ran on \r
+the Color Computer 3, with the expected limitations of requiring the \r
+32 column screen, etc. \r
+\r
+License information -- the rights to BIF and restrictions on \r
+distribution -- are described in the file BIFDOC.TXT, which really \r
+should distributed with the source.\r
+\r
+I add here the stipulation that I claim right to the word "BIF" as \r
+the name of a programming language.\r
+\r
+If you are going to distribute or redistribute the obect or source of \r
+bif in any of its forms, it really makes no sense not to include the \r
+BIFDOC.TXT. If you do something like that and you or anyone that gets \r
+the results has problems with it, and you come to me looking for help, \r
+expect to be teased mercilessly about it. And expect to be on the \r
+bottom of my priority list (not out of spite, out of self-protection).\r
+\r
+-----\r
+\r
+I have reconstructed something approximating my source disks (using the \r
+great emulator, xroar: https://www.6809.org.uk/xroar/ and the imgtool\r
+distributed with MAME, along with the *nix tools). Some useful commands \r
+are noted in commands.txt.\r
+\r
+The name of the disk image is (appropriately?) bifsource.dsk. It can be \r
+directly attached by xroar's disk emulator tools, and should be similarly \r
+useable with VCC, MAME, etc. al.\r
+\r
+-----\r
+\r
+The assembler source files are readable by the a variety of text editors,\r
+that respond flexibly about line termination. But if you try editing them\r
+with a normal editor and then assembling the result with EDTASM+, be very \r
+careful about line termination. Be prepared to use *nix command line tools \r
+like tr, cut, sed/awk, perl, etc. \r
+\r
+The source files retain the original line numbers as used by EDTASM+, \r
+which is why you will want the *nix tools. But I have included source to a \r
+short C program, stripln.c, which strips the line numbers. This program \r
+may also be useful for converting line endings, if that is necessary. Look \r
+for it in the junkbox directory, and be prepared to compile it. \r
+\r
+If you are under the burden of using Microsoft OSses, the Cygwin project \r
+should be of quite a bit of assistance, including the *nix command line \r
+tools and gcc and clang, etc.\r
+\r
+-----\r
+\r
+Macros are used in the source, but shouldn't cause too much confusion \r
+to a programmer with assembler experience. If anyone is brave enough \r
+to try to port it, key routines will be EMIT, KEY, ?TERMINAL, CR, R/W, \r
+and several routines in the EDITOR vocabulary where I used direct \r
+video I/O out of laziness.\r
+\r
+-----\r
+\r
+BIF might be useful for experimentation and for learning about FORTH, \r
+for someone who has access to a Color Computer or an emulator. The \r
+executable file may be run on the Color Computer by LOADMing it via \r
+Color Computer Disk BASIC. (More details in BIFDOC.TXT.) \r
+\r
+It is assembled to be EXECed at hexadecimal 1300 (&H1300). \r
+\r
+-----\r
+\r
+One specific warning must be given:\r
+\r
+DO NOT ATTEMPT TO ACCESS ORDINARY DISKS FORMATTED FOR USE BY OTHER\r
+OPERATING SYSTEMS WHILE BIF IS RUNNING! Because of disk buffering, it \r
+will be difficult to avoid unintentional writes to the disk. \r
+\r
+If you do try looking at an OS-9 or Color Computer DOS (etc.) disk with \r
+BIF, don't blame me if you destroy the directory and/or other valuable \r
+data.\r
+\r
+-----\r
+\r
+I tried a re-write in C (bif-c), but it's not working well. Issues with \r
+file systems (no real file system in BIF) and the current standardization \r
+committees ideas about what is meaningful code, problems with my own \r
+attention span, etc. keep it full of bugs. And I used a number of neat \r
+tricks that get in the way in C. \r
+\r
+One thing I want to retain is the use of nested binary trees in the \r
+symbol table. \r
+\r
+Incidentally, said re-write has been in process for over thirty years.\r
+Real life keeps getting in the way.\r
+\r
+-----\r
+\r
+I am including source to a Q&D C program, 32col.c, which will re-format \r
+files extracted from BIF disks for normal text editors. Mac-isms and \r
+Codwarrior-isms can probably be discerned by comparing it with stripln.c, \r
+mentioned above. \r
+\r
+When I brought the BIF high-level source with me, I used some feature of \r
+Color Computer BASIC and BIF that I have forgotten to dump some of the \r
+Forth style screen listings. \r
+\r
+The program stripln can be used to strip line numbers from such screen \r
+listings, as well. \r
+\r
+The documentation is ASCII text, with CR/LF line termination, and should\r
+be examined carefully by anyone considering a port. Bear in mind that\r
+it was written toward Color Computer users.\r
+\r
+I apologize for not alphabetizing the FORTH words by name. I did it once \r
+with a C program, but got too ambitious and lost the results in the \r
+process of trying to split it up into modules. I haven't had enough time \r
+to finish the modularization, yet, either. (Getting an iBook so I could \r
+work on the train just gave me more things to do on the train.)\r
+\r
+Files in this distribution --\r
+\r
+6809 Assembly Language Source files:\r
+\r
+README.TXT\r
+ this file.\r
+BIFDOC.TXT\r
+ general explanations, including descriptions of every word.\r
+BIFU.I\r
+ structure of the per-user variable page.\r
+BIF.M\r
+ macros, including the inner interpreter (basis of the virtual machine),\r
+ the dictionary (symbol table) structure offsets,\r
+ and invocations for the fundamental objects.\r
+BIFDP.A\r
+ things kept in the direct page, \r
+ including the behaviours for the fundamental objects (was not a good idea after all),\r
+ and the index to the per user variable page. \r
+BIFST.A\r
+ cold and warm boot routines and the initial value table for the per-user variable page.\r
+BIF.ASM\r
+ the main source file (includes other parts),\r
+ basic expression evaluation, more of the inner interpreter, \r
+ basic vocabulary access, basic symbol parsing.\r
+BIFB.A\r
+ basic I/O, more of the inner interpreter, extended expression evaluation,\r
+ the rest of the basic symbol table access.\r
+BIF1.A\r
+ data movers, common expression evaluation,\r
+ stack pointer access, more of the inner interpreter,\r
+ high-level compiler.\r
+BIF1B.A\r
+ common expression evaluation, extended expression evaluation,\r
+ innards of the high-level compiler, more of the high-level compiler,\r
+ compiler directive.\r
+BIF2.A\r
+ more common expression evaluation, common constants,\r
+ I/O constants, character typing constants,\r
+ symbol table globals, compiler globals, parser globals, I/O globals.\r
+BIF2B.A\r
+ compiler globals, more high-level compiler,\r
+ more common expression evaluation, formatted output.\r
+BIF3.A\r
+ more basic symbol table, symbol table, more compiler, more formatted output,\r
+ more data movers, more low-level parser (formatted input), more I/O,\r
+ more extended expression evaluation, more expression evaluation, \r
+ more compiler directives, an extension to the inner interpreter.\r
+BIF3B.A\r
+ more formatted output, more innards of the high-level compiler,\r
+ more high-level compiler.\r
+BIF4.A\r
+ more innards of the expression evaluator, more common expression evaluation,\r
+ more I/O (buffer handling).\r
+BIF4B.A\r
+ more high-level compiler, more compiler directive.\r
+BIF5.A\r
+ more innards of the high-level compiler, more I/O (buffering),\r
+ disk access, error handling, more formatted output.\r
+BIF5B.A\r
+ more error handling, screen-based sector (character) editor.\r
+BIF6.A\r
+ more parser (formatted input), I/O (terminal), compiler (input),\r
+ symbol table (lookup).\r
+BIF6B.A\r
+ symbol table, compiler innards, null vector test, \r
+ more screen-based sector editor.\r
+BIF7.A\r
+ compiler, formatted output, compiler directives\r
+BIF7B.A\r
+ error handling, symbol tables, compiler directives.\r
+stripln.c,\r
+32col.c, \r
+ C language source and Macintosh executables for stripping line \r
+ numbers and reformatting 32 column source code "screens". The two \r
+ XXX.GXX.out files below are output of the 32col program.\r
+\r
+-----\r
+\r
+Hopefully, I will shortly have time to reconstruct useful things from the \r
+following files on the tools.dsk disk image and/or the cs431 disk image:\r
+\r
+TOOLS.G00, TOOLS.G00.out\r
+ FORTH source for disk listing, screen handling, definition dumping, \r
+ sector copying, forward referencing, buffer maintenance, \r
+ experimenting with hardware, double (32 bit) integer math, etc.,\r
+ and a post-fix assembler.\r
+PAIRS.G28, PAIRS.G28.out\r
+ a "database" example from one of my FORTH books.\r
+\r
+and\r
+\r
+SCR33.ARR\r
+ arrays for CS431.\r
+SCR34.LOC\r
+ some math for CS431.\r
+SCR40.431\r
+ test suite for CS431.\r
+\r
+\r
+\r
--- /dev/null
+0) Index to BIF HI-LEVEL disk 2) Title page, Copr. notice 3) MONITOR CALL TO DEBUG 4) ERROR MESSAGES 6) HIGH LEVEL TOOLS & UTILITIES 7) LIST, INDEX, TRIAD 8) HIGH LEVEL DISK & SCREEN 11) FORWARD REFERENCING 12) PERIPHERAL UTILITIES 13) SLIST 15) DUMP DEFINITION BY NAME 16) ASSEMBLER 32) DOUBLES IN ASSEMBLER 40) HLL COMPILER 64) PAIR ASSOCIATION EXAMPLE 66) A TRY AT DIVIDE BY CONSTANT 100) SARDIS DMC STUFF 144) HOOCH COMPILER REMAINS BIF EDITOR, UTILITIES, ASSEMBLER, AND EXAMPLES VERSION 1.0 COPYRIGHT 1989 JOEL MATTHEW REES THESE ALGORITHMS ARE EXPRESSED IN THREE LANGUAGES: BIF, BIF ASSEMBLER FOR THE MOTOROLA M6809 MICROPROCESSOR, AND HEXADECIMAL MACHINE CODE FORTHE M6809. THE TEXT IS ORGANIZED FOR EDITING ON A 32-COLUMN TERMINAL,SUCH AS IS FOUND ON A RADIO SHACK COLOR COMPUTER 2. THESE ALGORITHMS AND THEIR TEXT ARE INTENDED FOR NO PURPOSEOTHER THAN EXPERIMENTATION, AND NO CLAIMS OR WARRANTIES ARE MADECONCERNING THEIR USEFULNESS IN ANY PARTICULAR APPLICATION. PUBLISHED 1989 JOEL MATTHEW REES SOUTH SALT LAKE CITY, UTAH ( CALL TO MONITOR, IF SWI IS BREAKPOINT JMR-88OCT?? ) CREATE MON HEX 3F C, 6EB1 , SMUDGE HERE 1- FENCE ! ;S ( ERROR MESSAGES ) DATA STACK UNDERFLOW DICTIONARY FULL ADDRESS RESOLUTION ERROR HIDES DEFINITION IN NULL VECTOR WRITTEN DISC RANGE? DATA STACK OVERFLOW DISC ERROR! CAN'T EXECUTE A NULL! CONTROL STACK UNDERFLOW CONTROL STACK OVERFLOW ARRAY REFERENCE OUT OF BOUNDS ARRAY DIMENSION NOT VALID NO PROCEDURE TO ENTER ( WAS REGISTER ) COMPILATION ONLY, USE IN DEF EXECUTION ONLY CONDITIONALS NOT PAIRED DEFINITION INCOMPLETE IN PROTECTED DICTIONARY USE ONLY WHEN LOADING OFF CURRENT EDITING SCREEN DECLARE VOCABULARY DEFINITION NOT IN VOCABULARY IN FORWARD BLOCK ALLOCATION LIST CORRUPTED: LOST CAN'T REDEFINE nul! NOT FORWARD REFERENCE ( WAS IMMEDIATE ) ( MORE ERROR MESSAGES ) HAS INCORRECT ADDRESS MODE HAS INCORRECT INDEX MODE OPERAND NOT REGISTER HAS ILLEGAL IMMEDIATE PC OFFSET MUST BE ABSOLUTE ACCUMULATOR OFFSET REQUIRED ILLEGAL MEMORY INDIRECTION ILLEGAL INDEX BASE ILLEGAL TARGET SPECIFIED CAN'T STACK ON SELF DUPLICATE IN LIST REGISTER NOT STACK EMPTY REGISTER LIST IMMEDIATE OPERAND REQUIRED REQUIRES CONDITION COMPILE-TIME STACK UNDERFLOW COMPILE-TIME STACK OVERFLOW ( UTILITIES DUMP QLIST QINDEX ) ( L/SCR ULIST JMR-88NOV16) BIF DEFINITIONS HEX ( UTILITIES IS NOW IN KERNEL ) UTILITIES DEFINITIONS : BYTE-DUMP -DUP IF 0 DO DUP I + C@ 4 .R LOOP ENDIF DROP ; ( BASE > 6) BIF DEFINITIONS : DUMP -DUP IF OVER + SWAP DO I 0 6 D.R I 4 [ UTILITIES ] BYTE-DUMP [ BIF ] 3A EMIT I 4 TYPE CR ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF 4 +LOOP ENDIF ; : QLIST BLOCK [ EDITOR ] QDUMP [ BIF ] 500 88 ! ( CENTER ) ; : QINDEX 1+ SWAP DO I QLIST ." SCREEN=" I 4 /MOD . 3A EMIT . ." BLOCK=" I . KEY 0< IF LEAVE ENDIF LOOP ; UTILITIES DEFINITIONS : L/SCR B/BUF B/SCR C/L */ ; : ULIST ( SCREEN N, FLAG BRK ) DUP SCR ! ." SCR # " . 0 ( F ) L/SCR 0 DO CR I 3 .R SPACE I SCR @ .LINE ?TERMINAL 0< IF ( BREAK? ) KEY 0< IF 1- LEAVE ENDIF ENDIF LOOP CR ; --> ( LIST INDEX TRIAD ) ( JMR-88NOV16 ) BIF DEFINITIONS : LIST ( WIDE OUTPUT ) DECIMAL CR UTILITIES ULIST BIF DROP ; : INDEX ( PRINT COMMENT LINES ) 0C EMIT ( FORM FEED ) CR 1+ SWAP DO CR I 3 .R SPACE 0 I .LINE C/L 49 < IF 1 I .LINE ENDIF ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF LOOP ; : TRIAD ( LIST MULTIPLE ) >PRT 0C EMIT ( FORM FEED ) [ DECIMAL ] UTILITIES L/SCR BIF 22 > IF 2 ELSE 3 ENDIF >R R / R * DUP R> + SWAP DO I UTILITIES ULIST BIF 0< IF LEAVE ENDIF UTILITIES L/SCR BIF DUP 32 = SWAP 22 = OR NOT IF CR CR ENDIF LOOP >VID ; HEX -->( HOME CLS QSAVE SAVE-BUFFERS QCAN ) ( JMR-88DEC10 ) UTILITIES DEFINITIONS HEX : HOME 400 88 ! ; : MID 500 88 ! ; BIF DEFINITIONS : CLS 400 200 60 FILL UTILITIES HOME BIF ; UTILITIES DEFINITIONS : CAN-UP ( CANCEL UPDATE IN BUF) DUP @ 7FFF AND OVER ! ; : W-BUF ( WRITE BUF AT ADR ) DUP 2+ OVER @ 7FFF AND 0 R/W CAN-UP ; : SAVE-BUF ( IF UPDATED ) DUP @ 0< IF W-BUF ENDIF ; BIF DEFINITIONS : QSAVE PREV @ ( SAVE PREVIOUS ) UTILITIES SAVE-BUF BIF DROP ; : SAVE-BUFFERS PREV @ BEGIN UTILITIES SAVE-BUF BIF +BUF NOT UNTIL DROP ; : QCAN PREV @ ( CAN UP OF PREV ) UTILITIES CAN-UP BIF DROP ; --> ( CANCEL-UPDATES RE-QUICK .PREV .BUFFERS QPREV JMR-88DEC10 ) : CANCEL-UPDATES PREV @ BEGIN UTILITIES CAN-UP BIF +BUF NOT UNTIL DROP ; : RE-QUICK ( QUICK OLD PREVIOUS) PREV @ DUP @ 7FFF AND 0 ROT ! [ EDITOR ] QUICK BIF ; UTILITIES DEFINITIONS : .BUF ( QLIST BUFFER, . BLOCK ) DUP @ DUP 7FFF AND DUP QLIST MID ." BLOCK=" . 0< IF ." UPDATED" ENDIF CR ; BIF DEFINITIONS : .BUFFERS PREV @ ( .BUF, PAUSE) BEGIN UTILITIES .BUF BIF +BUF DROP KEY 0< ( BREAK? ) UNTIL DROP ; : .PREV PREV @ UTILITIES .BUF BIF DROP ; : EDIT DUP UTILITIES MID BIF ." BLOCK=" . CR [ EDITOR ] QUICK BIF PREV @ @ 0< IF ." UPDATED" ENDIF ; : QPREV PREV @ @ 7FFF AND EDIT ; -->( QOPY COPY QBACK BACK-UP ) ( JMR-88DEC11 ) : QOPY SWAP BLOCK SWAP BLOCK B/BUF 2/ MOVE UPDATE ; : COPY 2* 2* ( SCREEN ) SWAP 2* 2* DUP 4 + SWAP DO I OVER QOPY 1+ LOOP DROP ; : QBACK 1+ SWAP DO I QLIST I BLOCK DUP [ EDITOR ] QDUMP ." BLOCK " I . ." TO " 0 DRIVE-OFFSET @ I + DUP . KEY 59 = IF 0 R/W ( YES? ) ELSE DROP DROP ENDIF LOOP ; : EEDIT ( ERASE AND EDIT BLOCK ) DUP BLOCK 2- UTILITIES .BUF 2+ MID BIF ." BLOCK=" OVER . ." CLEAR?" CR KEY 59 = IF ( YES? ) B/BUF BLANKS UPDATE ELSE DROP ( DON'T CLEAR ) ENDIF EDIT ; --> ( RES-ERROR FORWARD :RESOLVE :RESOLVE ;RES JMR-16MAY89 ) UTILITIES DEFINITIONS HEX : RES-ERROR ( ADR RESOLUTION ) 3 ERROR ; BIF DEFINITIONS UTILITIES : FORWARD ( REFERENCE HEADER ) CREATE 7E C, ( JMP EXTENDED ) IP, [ ' RES-ERROR CFA , ] ( INIT TO RES-ERROR ) SMUDGE FOREWARD @ 0= IF ( EARLIEST? ) LATEST FOREWARD ! ENDIF ; ASSEMBLER DEFINITIONS UTILITIES : :RESOLVE ( :ASM FORWARD REFS ) ?EXEC !CSP [COMPILE] ' DUP CFA DUP 1+ SWAP C@ 7E - ( JMP) OVER @ ' RES-ERROR CFA - OR 1D ?ERROR ( HEADER? ) HERE SWAP ! ( LINK IT ) FOREWARD @ = IF ( END FORWD? ) 0 FOREWARD ! ENDIF ; IMMEDIATE BIF DEFINITIONS ASSEMBLER : :RES ( RESOLVE : FORWARDS ) [COMPILE] :RESOLVE [ BIF ] ( ASSEMBLE JMP <XCOL, COMPILE) IP, [ LATEST CFA @ , ] ] ; : ;RES [COMPILE] ; SMUDGE ; IMMEDIATE ( PL PTEST ) ( JMR-89AUG25 ) BIF DEFINITIONS DECIMAL : PL 79 0 DO I 33 + EMIT LOOP ; : PT ( PL UNTIL KEY PRESS ) BEGIN PL ?TERMINAL UNTIL ; : PTEST >PRT PT >VID ; ;S ( SLIST ) ( JMR-16OCT90 ) ROOT @ UTILITIES : SLIST ( LIST SCREENS TO PRT ) >PRT 1+ SWAP DO I ULIST 0< IF LEAVE ENDIF LOOP >VID ; ROOT ! ;S ( DISK ACCESS WORDS JMR-900228) HEX : CM! FF48 C! ; : ST@ FF48 C@ ; : TR! FF49 C! ; : TR@ FF49 C@ ; : SE! FF4A C! ; : SE@ FF4A C@ ; : DA! FF4B C! ; : DA@ FF4B C@ ; : DR FF40 ! ; : DWAIT BEGIN ST@ DUP 1 AND WHILE DROP REPEAT ; : 1I DR 40 CM! DWAIT 0 DR . ; : 1O DR 60 CM! DWAIT 0 DR . ; : IN 0 DO DUP 1I LOOP DROP ; : OUT 0 DO DUP 1O LOOP DROP ; : ?ADR 0 FF42 C! 0 FF46 C! 28 OR DR ( MOTOR ON, DBL DNS) C4 FF4C C! DWAIT . FF44 @ DROP 0 FF42 C! 0 FF46 C! FF4E ? FF4E ? FF4E ? ; ;S ( NAMES ) ( JMR-89MAY16 ) BIF DEFINITIONS HEX : NAME ( CFA TO NAME ) 2+ NFA ID. ; : NAMES ( DUMP BY NAME ) -DUP IF 2* OVER + SWAP ( 0? ) DO I 0 6 D.R ( ADR ) I @ DUP 0 5 D.R ( NUMERIC) 3A EMIT NAME CR ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF 2 +LOOP ENDIF ; ;S ( ^asm-util DREG REGISTERS # DPREG DPR SETDP JMR-88DEC19 ) ASSEMBLER DEFINITIONS HEX VOCABULARY ^asm-util ( HIDDEN ) ^asm-util DEFINITIONS : DREG ( REGISTER OPERANDS ) 0FF0F AND 5245 DCONSTANT ; ASSEMBLER DEFINITIONS ^asm-util ( INDEX IN HI BYTE ) 8B00 DREG D 8608 DREG A 8509 DREG B 8C05 DREG PC 4003 DREG U 6004 DREG S 2002 DREG Y 0001 DREG X EF0A DREG CC EF0B DREG DP ( ALL OPERANDS ARE DBL INTS ) ( ABSOLUTE IS 0 OR -1 HI WORD ) ( DIRECT IS ABSOLUTE IN DPAGE ) 494D CONSTANT # ( HI WORD ) ^asm-util DEFINITIONS ( ASSEMBLY TIME DIRECT PAGE ) 42 USER DPREG ( EMULATOR ) ( INIT DPREG ) UTILITIES DP@ ASSEMBLER ^asm-util DPREG ! ASSEMBLER DEFINITIONS ( ACCESS DPREG ) : DPR [ ^asm-util ] DPREG BIF @ ; : SETDP 0FF00 AND [ ^asm-util ] DPREG BIF ! ; --> ( OFF, ABS, V, PCOFF PCR, ) ( JMR-89JAN2 ) ^asm-util DEFINITIONS : OFF, ( SET IX b0, COMPILE 2 ) OVER DUP 80 < SWAP -81 > AND IF C, C, ( SHORT ) ELSE 1 OR C, , ( LONG ) ENDIF ; : OP, ( COMPILE BYTE OR WORD ) DUP 0FF00 AND IF , ELSE C, ENDIF ; : ABS, >R ( COMPILE ABS ADR OP ) OVER 0FF00 AND DPR = IF R> DROP OP, C, ( DIR PAGE) ELSE R> OR OP, , ( EXT ) ENDIF ; : PCOFF ( ABSOLUTE TO PC REL ) HERE + 1+ - ( CALC OFFSET ) DUP 7F > OVER -80 < OR IF 1- 0 ( WORD OFF ) ELSE -1 ( BYTE OFF ) ENDIF ; : ?ABS ( TRUE IF ABSOLUTE ) DUP NOT 0= = ; ( USE T/F VAL) : PCR, ( COMPILE A PC REL INDEX) >R ?ABS NOT 25 ?ERROR 1 PCOFF IF R> C, C, ( BYTE ) ELSE R> 1 OR C, , ENDIF ; --> ( AUTO MASK, REG, IXOFF, EI, ) ( JMR-89JAN2 ) ASSEMBLER DEFINITIONS 4155.0082 DCONSTANT -) ( AUTO ) 4155.0081 DCONSTANT )++ ( REG ) 4155.0080 DCONSTANT )+ ( MODE ) 4155.0083 DCONSTANT --) ( CONS) ^asm-util DEFINITIONS : MASK, OR C, ; ( FOR POSTBYTE) : REG, ( REG OFF TO POST-BYTE ) SWAP DUP D DROP = OVER A DROP = OR OVER B DROP = OR NOT 26 ?ERROR SWAB OR C, ; ( REG, USES DUAL CODED REGS ) : IXOFF, ( REGISTER + CONSTANT ) OVER IF OVER ( NON-ZERO? ) DUP 0F > SWAP -10 < OR OVER 10 AND OR ( []? ) IF 88 OR OFF, ( EXTERNAL ) ELSE ( OFFSET IN POST-BYTE) SWAP 1F AND OR C, ENDIF ELSE 84 OR C, DROP ( 0 OFF ) ENDIF ; : EI, ( EXTENDED INDIRECT ) SWAP ?ABS NOT 27 ?ERROR C, , ; --> ( IX, , INDIRECT ) ( JMR-89JAN4 ) : IX, ( COMPILE AN INDEX MODE ) DUP 9F = IF EI, ELSE DUP 8F AND 8C = IF PCR, ELSE SWAP DUP 4155 = IF DROP MASK, ( AUTO ) ELSE DUP 5245 = IF DROP REG, ELSE ?ABS NOT 22 ?ERROR IXOFF, ENDIF ENDIF ENDIF ENDIF ; ASSEMBLER DEFINITIONS : , ( CONVERT TO INDEX ) 5245 = ( REGISTER? ) OVER 00FF AND DUP 0 > SWAP 6 < AND ( X Y U S PC ? ) AND NOT 28 ?ERROR SWAB 4958 ; : ) ( CONVERT TO INDIRECT ) DUP 5245 = ( REGISTER? ) IF ( ASSEMBLER ) , ELSE DUP [ ^asm-util ] ?ABS [ ASSEMBLER ] IF 4958.009F ELSE ( INDEX? ) DUP 4958 = NOT 27 ?ERROR ENDIF ENDIF ( SET BIT 4 ) SWAP 10 OR SWAP ; --> ( ACCM UNARY REG ) ( JMR-89JAN5 ) ^asm-util DEFINITIONS HEX : ACCM ( ENCODE ACCUMULATOR ) SWAP DUP 0FE AND ( A OR B? ) 8 = NOT 29 ?ERROR 1 AND ( MASK B IN? ) IF OR ELSE DROP ENDIF ; : UNARY ( OP-CODE COMPILER ) <BUILDS 0F AND C, ( OP-CODE ) DOES> C@ ( OP-CODE ) OVER 5245 = ( REGISTER? ) IF DUP 0E = 29 ?ERROR ( JMP?) 40 OR ROT 10 ACCM C, DROP ELSE OVER 4958 = ( INDEX? ) IF 60 OR C, DROP IX, ELSE SWAP ?ABS NOT 21 ?ERROR 70 ( EXT BITS ) ABS, ENDIF ENDIF ; : REG ( ENCODE TARGET REG ) DUP C@ 8D = IF C@ 1 ( JSR ) ELSE SWAP 5245 - 29 ?ERROR OVER DUP A DROP = SWAP B DROP = OR IF C@ SWAP 40 ACCM 0 ( BYTE) ELSE SWAP 00FF AND ( REG? ) OVER 1+ C@ ( CT? ) OVER > NOT 29 ?ERROR ( RANGE ) 2* + 2+ @ -1 ( WORD REG ) ENDIF ENDIF ; --> ( #, BINARY REG-REG ) ( JMR-89JAN12 ) : #, ( COMPILE AN IMMEDIATE ) SWAP DUP 0F AND 5 - ( BIT OK) OVER 5 AND 5 = ( ST OR JSR? ) AND 24 ?ERROR OP, IF BIF , [ ^asm-util ] ( WORD) ELSE C, ENDIF ; ( BYTE ) : BINARY ( OP-CODE COMPILER ) <BUILDS 8F AND C, ( A/B OP ) 05 AND DUP C, -DUP IF ( OP CT) 0 DO 11CF AND BIF , ( DXYUS) [ ^asm-util ] LOOP ENDIF DOES> REG ROT ( SOURCE ) DUP 4958 = IF ( INDEX ? ) DROP DROP 20 OR OP, IX, ELSE DUP 494D = ( IMMEDIATE? ) IF DROP #, ELSE ?ABS NOT 21 ?ERROR DROP 10 OR 20 ABS, ENDIF ENDIF ; : REG-REG ( OP-CODE COMPILER ) <BUILDS C, ( OP-CODE ) DOES> C@ C, ( OP-CODE ) 5245 = ROT 5245 = AND NOT 23 ?ERROR ( 2 REGS? ) 0F AND SWAP SWAN 0F0 AND OR C, ; --> ( REG-BITS PACK MOVEM ) ( JMR-89JAN12 ) 0 0B 1 1ARRAY REG-BITS ( PACK ) 0 REG-BITS ( INITIALIZE ) 06 OVER C! 1+ 10 OVER C! 1+ 20 OVER C! 1+ 40 OVER C! 1+ 40 OVER C! 1+ 80 OVER C! 1+ -1 OVER ! 2+ ( UNDEFINED ) 02 OVER C! 1+ 04 OVER C! 1+ 01 OVER C! 1+ 08 SWAP C! ( STABILIZE PACK: UNDEF=ALL ) : PACK >R 0 ( PSH/PUL LIST ) BEGIN OVER 5245 = WHILE SWAP DROP SWAP ( REG ) DUP R = 2A ?ERROR ( SELF? ) 0FF AND REG-BITS C@ ( BIT ) OVER OVER AND 2B ?ERROR OR REPEAT ( ^ IS DUPLICATE?) R> DROP ; : MOVEM ( OP-CODE COMPILER ) <BUILDS 0FD AND C, DOES> ( OP) C@ >R ( OP ) 5245 = OVER 1+ 0FE AND 4 = AND ( S OR U?) NOT 2C ?ERROR R> OVER U DROP = ( SELECT S/U) IF 2 OR ENDIF C, PACK DUP 0= 2D ?ERROR C, ; --> ( BR DCOND CC-IMM IMPLY ) ( JMR-89JAN13 ) ASSEMBLER DEFINITIONS : BR ( COMPILE CONDITIONAL BR ) 434F - 2F ?ERROR ( CONDITION?) [ ^asm-util ] SWAP ( ADR? ) ?ABS NOT 21 ?ERROR SWAP 1 PCOFF IF ( SHORT ) SWAP DUP 0< IF 0FF AND ( BSR ) ELSE 0F AND 20 OR ENDIF C, C, ( BOTH BYTES ) ELSE SWAP DUP 01000 AND IF SWAB 017 AND ( BSR/BRA ) ELSE 0F AND 1020 OR SWAP 1- SWAP ENDIF OP, BIF , ENDIF ; ASSEMBLER ^asm-util DEFINITIONS : DCOND ( CONDITIONAL OPERANDS) 434F DCONSTANT ; : CC-IMM ( OP-CODE COMPILER ) <BUILDS C, ( OP-CODE ) DOES> C@ C, ( OP-CODE ) 494D - 2E ?ERROR ( IMMEDIATE?) C, ; : IMPLY ( OP-CODE COMPILER ) <BUILDS BIF , ( OP-CODE ) DOES> @ OP, ; --> ( MNEMONICS ) ( JMR-89JAN13 ) ASSEMBLER DEFINITIONS ^asm-util 10CE 0CE 108E 8E 0CC 5 86 BINARY LD 10CF 0CF 108F 8F 0CD 5 87 BINARY ST 118C 1183 108C 8C 1083 5 81 BINARY CMP 35 MOVEM PUL 34 MOVEM PSH 46 UNARY ROR 49 UNARY ROL 39 IMPLY RTS 3B IMPLY RTI 0 82 BINARY SBC 978D DCOND SR 1F REG-REG TFR 4D UNARY TST 83 1 80 BINARY SUB 103F IMPLY SWI2 113F IMPLY SWI3 3F IMPLY SWI 13 IMPLY SYNC 0 84 BINARY AND 0 89 BINARY ADC 48 UNARY ASL 47 UNARY ASR 0C3 1 8B BINARY ADD 3A IMPLY ABX 5 DCOND CS 43 UNARY COM 4F UNARY CLR 1600 DCOND AL 0 85 BINARY BIT 4A UNARY DEC 19 IMPLY DAA 2 DCOND HI 0B DCOND MI 7 DCOND EQ 0C DCOND GE 1E REG-REG EXG 4C UNARY INC 0 8D BINARY JSR 4E UNARY JMP 0 88 BINARY EOR 0E DCOND GT 4 DCOND HS 12 IMPLY NOP 3 DCOND LS 0A DCOND PL --> ( MORE MNEMONICS ) ( JMR-89JAN13 ) 44 UNARY LSR 48 UNARY LSL 0D DCOND LT 6 DCOND NE 3D IMPLY MUL 40 UNARY NEG 0 8A BINARY OR 1A CC-IMM ORCC 1 DCOND NV 1D IMPLY SEX 1C CC-IMM ANDCC 3C CC-IMM CWAI 8 DCOND VC 9 DCOND VS 4 DCOND CCLR ( LO LE FOLLOW ) ^asm-util DEFINITIONS 1 4 1 1ARRAY EA-IX ( TRANSLATE) 1 EA-IX ( INITIALIZE ) 0 OVER C! 1+ 1 OVER C! 1+ 3 OVER C! 1+ 2 SWAP C! ASSEMBLER DEFINITIONS : LEA ( OP-CODE ASSEMBLER ) 5245 - 23 ?ERROR ( REGISTER?) 0F BIF AND [ ^asm-util ] EA-IX C@ 30 BIF OR C, 4958 - 21 ?ERROR ( INDEX? ) [ ^asm-util ] IX, ; 0F DCOND LE 5 DCOND LO --> ( [CD] & ! ^ NEXT ) ( JMR-89JAN17 ) ASSEMBLER DEFINITIONS BIF HEX : [CD] ( CFA OF DEF ) -IFIND DROP DUP 0= 0 ?ERROR CFA 0 [COMPILE] DLITERAL ; IMMEDIATE CREATE & [CD] AND JMP SMUDGE CREATE ! [CD] OR JMP SMUDGE CREATE ^ [CD] XOR JMP SMUDGE ASSEMBLER : NEXT )++ Y ) JMP ; --> ( INVERTCC LIF IF ) ( JMR-89FEB3 ) ^asm-util DEFINITIONS HEX CREATE INVERTCC ( CONDITIONS ) 0. U , X LD 434F # X CMP HERE DUP 2+ 0 NE BR ( CC? ) 2. U , D LD ( BSR? ) HERE DUP 2+ 0 MI BR A CLR 1 # B EOR ( TOGGLE CC ) HERE 4 + 0 NE BR ( ALWAYS? ) AL DROP SWAB # A LD 2. U , D ST NEXT ( FILL BR) 1+ HERE OVER 1+ - SWAP C! 1+ HERE OVER 1+ - SWAP C! 2F # D LD D U PSH ( TO ERROR) [CD] ERROR JMP SMUDGE ASSEMBLER DEFINITIONS : LIF ( MARK AND ASM LONG BR ) [ ^asm-util ] INVERTCC [ ASSEMBLER ] >R >R HERE 4146 ( MARK ) [ UTILITIES ] [CD] RES-ERROR [ ASSEMBLER ] R> R> BR ; : IF ( MARK AND ASM SHORT BR ) [ ^asm-util ] INVERTCC [ ASSEMBLER ] >R >R HERE 4146 ( MARK ) OVER 2+ 0 R> R> BR ; --> ( FILL-IN ) ( JMR-89FEB7 ) ^asm-util DEFINITIONS CREATE FILL-IN ( BR OFFSETS ) UTILITIES DP@ 0 X LD DP DP@ @ - ASSEMBLER 0 X , D LD 0. U , D SUB D U PSH ( OFFS) 2. U , X LD 0. X , D LD ( BR) 16 # A CMP ( ALWAYS? ) HERE DUP 2+ 0 EQ BR 0FE # A AND 0F0 # B AND 1020 # D CMP ( LONG? ) HERE DUP 2+ 0 EQ BR ( SHORT BRANCH ) 0F0 # A AND 20 # A CMP ( BR?) UTILITIES [CD] RES-ERROR ASSEMBLER NE BR 0. U , D LD 7E # D ADD A TST UTILITIES [CD] RES-ERROR ASSEMBLER NE BR ( TOO FAR? ) 80 # B SUB 1. X , B ST ( OFFSET ) HERE 4. U , U LEA NEXT ROT 1+ HERE OVER 1+ - SWAP C! 0. U , D LD ( LONG BR ALWAYS) 3 # D SUB 1. X , D ST DUP 0 AL BR SWAP 1+ HERE OVER 1+ - SWAP C! 0. U , D LD ( LONG BR COND ) 4 # D SUB 2. X , D ST 0 AL BR SMUDGE --> ( ELSE LELSE ENDIF ) ( JMR-89FEB6 ) ASSEMBLER DEFINITIONS HEX ^asm-util : ELSE ( SHORT BRANCH, RESOLVE) 4146 ?PAIRS >R NV IF R> FILL-IN ; : LELSE ( LONG BRANCH, RESOLVE) 4146 ?PAIRS >R NV LIF R> FILL-IN ; : ENDIF 4146 ?PAIRS FILL-IN ; : BEGIN HERE 4142 ; : UNTIL ( COND BR TO BEGIN ) >R >R 4142 ?PAIRS 0 R> R> INVERTCC BR ; : WHILE ( COND BR PAST REPEAT ) ROT 4142 ?PAIRS IF DROP 4157 ; : REPEAT ( LOOP, RESOLVE WHILE) 4157 ?PAIRS SWAP 0 AL BR FILL-IN ; : LWHILE ( LONG WHILE ) ROT 4142 ?PAIRS LIF DROP 4157 ; --> ( :ASM ;ASM ) ( JMR-89MAR28 ) ASSEMBLER DEFINITIONS HEX : :ASM CREATE !CSP ; : ;ASM ?CSP SMUDGE ; : I-CODE ( SHIFT TO HI-LEVEL ) [ ' :ASM CFA @ ] LITERAL [ BIF ] , ( ASMBL JMP <XCOL ) DROOT @ ROOT ! ] ; ( COMPILE) ASSEMBLER : MACHINE ( SHIFT TO LO-LEVEL ) COMPILE (MACHINE) ( IN DEF ) [COMPILE] [ ( NOW INTERPRET ) [COMPILE] ASSEMBLER ; IMMEDIATE ;S ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ( D! D@ ) ( JMR-89FEB16 ) BIF DEFINITIONS ASSEMBLER :ASM D! ( STORE DBL ) X U PUL D U PUL 0. X , D ST D U PUL 2. X , D ST NEXT ;ASM :ASM D@ ( FETCH DBL ) X U PUL 0. X , D LD 2. X , X LD D X U PSH NEXT ;ASM :ASM DOVER ( DOUBLE OVER DOUBLE) 4. U , D LD 6. U , X LD D X U PSH NEXT ;ASM :ASM DSWAP ( SWAP DOUBLES ) 4. U , D LD 0. U , X LD 4. U , X ST 0. U , D ST 6. U , D LD 2. U , X LD 6. U , X ST 2. U , D ST NEXT ;ASM ;S ( [& ,& ]& ) ( JMR-93MAR20 ) BIF DEFINITIONS HEX : [& ( START ARRAY INDEX LIST ) 0 0 4152 ; : ,& ( ACCUMULATE INDEX LIST ) ROT 4152 - 35 ?ERROR ( SPAN?) OVER - DUP F000 AND 33 ?ERROR 1+ SWAP >R ( SAVE LO ) DUP ROT * R> + ( NEW RELOC ) ROT 1+ DUP 7 > 34 ?ERROR SWAP 4152 ; : ]& ( COMPLETE THE ARRAY DEF ) DUP 1- FF00 AND 33 ?ERROR <BUILDS >R ,& DROP ( AR FLAG) R * ( NEW REL ) R> SWAP >R SWAP DUP , ( STORE COUNT ) 0 DO DUP , * LOOP ( SIZES ) DUP , ( ARR SZ ) R> , ( REL ) ALLOT ?STACK DOES> 0 ( SUM ) SWAP DUP 2+ SWAP @ ( COUNT ) 2* OVER + DUP >R ( SAVE END ) SWAP DO ( SUM OF PRODUCTS ) SWAP I @ * + 2 +LOOP R 2+ @ ( RELOCATE ) - DUP 0< OVER R @ < 0= ( BOUNDS? ) OR 0C ?ERROR R> 4 + + ; ( ^ LABEL LOCVOC ) ( JMR-93MAR21 ) BIF DEFINITIONS DECIMAL : ^ ( EXPONENT WITH ?ERROR ) -DUP 0= IF DROP 1 ( N 0 ^ ) ELSE OVER DUP 0= ( 0 N ^ ) SWAP 1 = OR ( 1 N ^ ) OVER 1 = OR ( N 1 ^ ) IF DROP ELSE 1 SWAP 0 DO OVER M* 54 ?ERROR LOOP SWAP DROP ENDIF ENDIF ; : LABEL ( --- ) ( BUILD GOTO ) <BUILDS IMMEDIATE COMPILE-ONLY 0 , DOES> DUP @ IF COMPILE BRANCH @ HERE - 2- , ELSE HERE SWAP ! ENDIF ; : LOCVOC VOCABULARY IMMEDIATE ; : GETNUMBER ( ADR N --- ) 1- OVER 1+ SWAP EXPECT BL ENCLOSE OVER + 0 SWAP C! NUMBER DROP ; : $ DUP . ; ( CS431 TESTPARAMS FACTORIAL ) ( JMR-93MAR24 ) DECIMAL 33 LOAD ( ARRAYS ) DECIMAL 34 LOAD ( ^ LABEL ) BIF DEFINITIONS LOCVOC CS431 CS431 DEFINITIONS DECIMAL 6805 VARIABLE X 6800 VARIABLE Y LOCVOC PARAMSLOCAL PARAMSLOCAL DEFINITIONS 0 VARIABLE A 0 VARIABLE B 0 VARIABLE C 0 VARIABLE X 0 2 2 1ARRAY D CS431 DEFINITIONS PARAMSLOCAL : TESTPARAMS ( N ADR --- ) 1 A ! 2 B ! 3 C ! 4 X ! 4 0 D ! 5 1 D ! 6 2 D ! SWAP ." BY-VAL WAS" . DUP @ 0 D @ * 2 D @ C @ / - 1 D @ A @ * B @ * + SWAP OVER 0 D @ / B @ * 2 D @ * OVER ! ." BY-VAL PARAMETER=" SWAP . ." BY-ADR PARAMETER=" @ . ." LOCAL X=" X @ . ; CS431 : FACTORIAL ( ADR --- ) [ SMUDGE ] ( RECURSIVE ) DUP @ 12 > IF ." TOO BIG " ELSE ." FACTOR" DUP ? DUP @ 2 > IF DUP @ 1- SP@ FACTORIAL OVER @ * OVER ! ENDIF ENDIF ." N!=" ? ; SMUDGE -->( CS431 RECORDS ) ( JMR-93MAR24 ) CS431 DEFINITIONS LOCVOC RECLOC RECLOC DEFINITIONS LOCVOC US US DEFINITIONS 0 VARIABLE ME 0 VARIABLE YOU 0 2 2 1ARRAY THEM RECLOC DEFINITIONS 0 VARIABLE X CS431 DEFINITIONS RECLOC : TESTRECORDS ( --- ) 1 X ! US 3 ME ! 6 YOU ! 2 0 THEM ! 4 1 THEM ! 6 2 THEM ! 2 THEM @ 10 * YOU @ / 1 THEM @ - 0 THEM @ + ME ! ." BEFORE CALL, US.ME=" ME ? ." US.THEM[2]=" 2 THEM ? ME @ 2 THEM TESTPARAMS ." AFTER CALL, LOCAL X=" X ? ." GLOBAL X=" CS431 X ? RECLOC US ." US.ME=" ME ? ." US.THEM[2]=" 2 THEM ? ; CS431 DEFINITIONS --> ( CS431 MAIN ) ( JMR-93MAR24 ) CS431 DEFINITIONS DECIMAL LOCVOC MAINLOC MAINLOC DEFINITIONS LABEL LOOPTO 0 VARIABLE A 0 VARIABLE B 0 VARIABLE C 0 VARIABLE D 0 VARIABLE E 0 VARIABLE F 0 VARIABLE G 0 VARIABLE I 0 VARIABLE J 0 VARIABLE K 0 VARIABLE X 0 VARIABLE CHOICE 0 VARIABLE RESULT [& -1 1 ,& 5 7 ,& 10 11 2 ]& ARRAY 0 79 1 1ARRAY STR 0 VARIABLE AA 0 VARIABLE BB 0 VARIABLE CC 0 VARIABLE DRES CS431 DEFINITIONS MAINLOC ( MIGHT AS WELL START HERE! ) : MAIN ( --- ) ( WE HOPE ) LOOPTO ." CHOICE (1 - 9): " 0 STR 80 GETNUMBER DUP CHOICE ! 0= IF ." I BE DONE!" QUIT ELSE CHOICE @ 1 = IF 1 A ! 2 B ! 3 C ! 4 D ! 5 E ! 6 F ! 7 G ! A @ B @ * $ C @ D @ * $ F @ B @ / $ D @ B @ / $ G @ 100 * $ --> ( CS431 CONTINUE MAIN ) E @ E @ * E @ * $ 23 C @ - $ B @ G @ B @ - * C @ * $ C @ A @ B @ D @ * + * E @ / $ A @ B @ + C @ + G @ F @ - D @ - * $ E @ F @ + G @ + A @ B @ + / $ G @ MINUS G @ - $ A @ MINUS B @ MINUS * G @ MINUS + $ F @ D @ * MINUS B @ C @ * MINUS / $ + + + + + + + + - + - + + RESULT ! ." RESULT=" RESULT ? ELSE CHOICE @ 2 = IF 2 AA ! 3 BB ! 4 CC ! AA @ AA @ ^ AA @ BB @ ^ + AA @ ^ AA @ CC @ ^ / DRES ! DRES @ RESULT ! ." RESULT=" RESULT ? ELSE CHOICE @ 3 = IF 2 -1 DO BIF I MAINLOC I ! 8 5 DO BIF I MAINLOC J ! 12 10 DO BIF I MAINLOC K ! ." ARRAY AT" I ? J ? K ? --> ( CS431 MAIN CONTINUED ) 0 STR 80 GETNUMBER I @ J @ K @ ARRAY ! LOOP LOOP LOOP 0 RESULT ! 2 -1 DO BIF I MAINLOC I ! 8 5 DO BIF I MAINLOC J ! 12 10 DO BIF I MAINLOC K ! I @ J @ K @ ARRAY @ RESULT +! LOOP LOOP LOOP ." RESULT=" RESULT ? ELSE CHOICE @ 4 = IF 21 0 DO BIF I MAINLOC I ! I @ 0= IF ." ZERO" ELSE I @ 10 < IF ." I=" I ? ELSE I @ 10 = IF 16 I ! R> DROP 16 >R ELSE ." NEAT-O" ENDIF ENDIF ENDIF 2 +LOOP ELSE CHOICE @ 5 = IF 2 A ! 4 B ! 0 X ! ." A BEFORE CALL=" A ? ." B BEFORE CALL=" B ? --> ( CS431 MAIN CONTINUED ) A @ B TESTPARAMS ." AFTER A=" A ? ." AFTER B=" B ? ." GLOBAL X=" CS431 X ? ." MAIN X=" MAINLOC X ? ELSE CHOICE @ 6 = IF 0 STR 80 GETNUMBER SP@ FACTORIAL ." ^:" 0 D. ELSE CHOICE @ 7 = IF TESTRECORDS ELSE CHOICE @ 8 = IF ." NO CASE " ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF CHOICE @ 9 < IF LOOPTO ENDIF ." THE WRONG END TO PRINT" ; ;S
\ No newline at end of file
--- /dev/null
+0) Index to BIF HI-LEVEL disk 2) Title page, Copr. notice 3) MONITOR CALL TO DEBUG 4) ERROR MESSAGES 6) HIGH LEVEL TOOLS & UTILITIES 7) LIST, INDEX, TRIAD 8) HIGH LEVEL DISK & SCREEN 11) FORWARD REFERENCING 12) PERIPHERAL UTILITIES 13) SLIST 15) DUMP DEFINITION BY NAME 16) ASSEMBLER 32) DOUBLES IN ASSEMBLER 40) HLL COMPILER 64) PAIR ASSOCIATION EXAMPLE 66) A TRY AT DIVIDE BY CONSTANT 100) SARDIS DMC STUFF 144) HOOCH COMPILER REMAINS BIF EDITOR, UTILITIES, ASSEMBLER, AND EXAMPLES VERSION 1.0 COPYRIGHT 1989 JOEL MATTHEW REES THESE ALGORITHMS ARE EXPRESSED IN THREE LANGUAGES: BIF, BIF ASSEMBLER FOR THE MOTOROLA M6809 MICROPROCESSOR, AND HEXADECIMAL MACHINE CODE FORTHE M6809. THE TEXT IS ORGANIZED FOR EDITING ON A 32-COLUMN TERMINAL,SUCH AS IS FOUND ON A RADIO SHACK COLOR COMPUTER 2. THESE ALGORITHMS AND THEIR TEXT ARE INTENDED FOR NO PURPOSEOTHER THAN EXPERIMENTATION, AND NO CLAIMS OR WARRANTIES ARE MADECONCERNING THEIR USEFULNESS IN ANY PARTICULAR APPLICATION. PUBLISHED 1989 JOEL MATTHEW REES SOUTH SALT LAKE CITY, UTAH ( CALL TO MONITOR, IF SWI IS BREAKPOINT JMR-88OCT?? ) CREATE MON HEX 3F C, 6EB1 , SMUDGE HERE 1- FENCE ! ;S ( ERROR MESSAGES ) DATA STACK UNDERFLOW DICTIONARY FULL ADDRESS RESOLUTION ERROR HIDES DEFINITION IN NULL VECTOR WRITTEN DISC RANGE? DATA STACK OVERFLOW DISC ERROR! CAN'T EXECUTE A NULL! CONTROL STACK UNDERFLOW CONTROL STACK OVERFLOW ARRAY REFERENCE OUT OF BOUNDS ARRAY DIMENSION NOT VALID NO PROCEDURE TO ENTER ( WAS REGISTER ) COMPILATION ONLY, USE IN DEF EXECUTION ONLY CONDITIONALS NOT PAIRED DEFINITION INCOMPLETE IN PROTECTED DICTIONARY USE ONLY WHEN LOADING OFF CURRENT EDITING SCREEN DECLARE VOCABULARY DEFINITION NOT IN VOCABULARY IN FORWARD BLOCK ALLOCATION LIST CORRUPTED: LOST CAN'T REDEFINE nul! NOT FORWARD REFERENCE ( WAS IMMEDIATE ) ( MORE ERROR MESSAGES ) HAS INCORRECT ADDRESS MODE HAS INCORRECT INDEX MODE OPERAND NOT REGISTER HAS ILLEGAL IMMEDIATE PC OFFSET MUST BE ABSOLUTE ACCUMULATOR OFFSET REQUIRED ILLEGAL MEMORY INDIRECTION ILLEGAL INDEX BASE ILLEGAL TARGET SPECIFIED CAN'T STACK ON SELF DUPLICATE IN LIST REGISTER NOT STACK EMPTY REGISTER LIST IMMEDIATE OPERAND REQUIRED REQUIRES CONDITION COMPILE-TIME STACK UNDERFLOW COMPILE-TIME STACK OVERFLOW ( UTILITIES DUMP QLIST QINDEX ) ( L/SCR ULIST JMR-88NOV16) BIF DEFINITIONS HEX ( UTILITIES IS NOW IN KERNEL ) UTILITIES DEFINITIONS : BYTE-DUMP -DUP IF 0 DO DUP I + C@ 4 .R LOOP ENDIF DROP ; ( BASE > 6) BIF DEFINITIONS : DUMP -DUP IF OVER + SWAP DO I 0 6 D.R I 4 [ UTILITIES ] BYTE-DUMP [ BIF ] 3A EMIT I 4 TYPE CR ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF 4 +LOOP ENDIF ; : QLIST BLOCK [ EDITOR ] QDUMP [ BIF ] 500 88 ! ( CENTER ) ; : QINDEX 1+ SWAP DO I QLIST ." SCREEN=" I 4 /MOD . 3A EMIT . ." BLOCK=" I . KEY 0< IF LEAVE ENDIF LOOP ; UTILITIES DEFINITIONS : L/SCR B/BUF B/SCR C/L */ ; : ULIST ( SCREEN N, FLAG BRK ) DUP SCR ! ." SCR # " . 0 ( F ) L/SCR 0 DO CR I 3 .R SPACE I SCR @ .LINE ?TERMINAL 0< IF ( BREAK? ) KEY 0< IF 1- LEAVE ENDIF ENDIF LOOP CR ; --> ( LIST INDEX TRIAD ) ( JMR-88NOV16 ) BIF DEFINITIONS : LIST ( WIDE OUTPUT ) DECIMAL CR UTILITIES ULIST BIF DROP ; : INDEX ( PRINT COMMENT LINES ) 0C EMIT ( FORM FEED ) CR 1+ SWAP DO CR I 3 .R SPACE 0 I .LINE C/L 49 < IF 1 I .LINE ENDIF ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF LOOP ; : TRIAD ( LIST MULTIPLE ) >PRT 0C EMIT ( FORM FEED ) [ DECIMAL ] UTILITIES L/SCR BIF 22 > IF 2 ELSE 3 ENDIF >R R / R * DUP R> + SWAP DO I UTILITIES ULIST BIF 0< IF LEAVE ENDIF UTILITIES L/SCR BIF DUP 32 = SWAP 22 = OR NOT IF CR CR ENDIF LOOP >VID ; HEX -->( HOME CLS QSAVE SAVE-BUFFERS QCAN ) ( JMR-88DEC10 ) UTILITIES DEFINITIONS HEX : HOME 400 88 ! ; : MID 500 88 ! ; BIF DEFINITIONS : CLS 400 200 60 FILL UTILITIES HOME BIF ; UTILITIES DEFINITIONS : CAN-UP ( CANCEL UPDATE IN BUF) DUP @ 7FFF AND OVER ! ; : W-BUF ( WRITE BUF AT ADR ) DUP 2+ OVER @ 7FFF AND 0 R/W CAN-UP ; : SAVE-BUF ( IF UPDATED ) DUP @ 0< IF W-BUF ENDIF ; BIF DEFINITIONS : QSAVE PREV @ ( SAVE PREVIOUS ) UTILITIES SAVE-BUF BIF DROP ; : SAVE-BUFFERS PREV @ BEGIN UTILITIES SAVE-BUF BIF +BUF NOT UNTIL DROP ; : QCAN PREV @ ( CAN UP OF PREV ) UTILITIES CAN-UP BIF DROP ; --> ( CANCEL-UPDATES RE-QUICK .PREV .BUFFERS QPREV JMR-88DEC10 ) : CANCEL-UPDATES PREV @ BEGIN UTILITIES CAN-UP BIF +BUF NOT UNTIL DROP ; : RE-QUICK ( QUICK OLD PREVIOUS) PREV @ DUP @ 7FFF AND 0 ROT ! [ EDITOR ] QUICK BIF ; UTILITIES DEFINITIONS : .BUF ( QLIST BUFFER, . BLOCK ) DUP @ DUP 7FFF AND DUP QLIST MID ." BLOCK=" . 0< IF ." UPDATED" ENDIF CR ; BIF DEFINITIONS : .BUFFERS PREV @ ( .BUF, PAUSE) BEGIN UTILITIES .BUF BIF +BUF DROP KEY 0< ( BREAK? ) UNTIL DROP ; : .PREV PREV @ UTILITIES .BUF BIF DROP ; : EDIT DUP UTILITIES MID BIF ." BLOCK=" . CR [ EDITOR ] QUICK BIF PREV @ @ 0< IF ." UPDATED" ENDIF ; : QPREV PREV @ @ 7FFF AND EDIT ; -->( QOPY COPY QBACK BACK-UP ) ( JMR-88DEC11 ) : QOPY SWAP BLOCK SWAP BLOCK B/BUF 2/ MOVE UPDATE ; : COPY 2* 2* ( SCREEN ) SWAP 2* 2* DUP 4 + SWAP DO I OVER QOPY 1+ LOOP DROP ; : QBACK 1+ SWAP DO I QLIST I BLOCK DUP [ EDITOR ] QDUMP ." BLOCK " I . ." TO " 0 DRIVE-OFFSET @ I + DUP . KEY 59 = IF 0 R/W ( YES? ) ELSE DROP DROP ENDIF LOOP ; : EEDIT ( ERASE AND EDIT BLOCK ) DUP BLOCK 2- UTILITIES .BUF 2+ MID BIF ." BLOCK=" OVER . ." CLEAR?" CR KEY 59 = IF ( YES? ) B/BUF BLANKS UPDATE ELSE DROP ( DON'T CLEAR ) ENDIF EDIT ; --> ( RES-ERROR FORWARD :RESOLVE :RESOLVE ;RES JMR-16MAY89 ) UTILITIES DEFINITIONS HEX : RES-ERROR ( ADR RESOLUTION ) 3 ERROR ; BIF DEFINITIONS UTILITIES : FORWARD ( REFERENCE HEADER ) CREATE 7E C, ( JMP EXTENDED ) IP, [ ' RES-ERROR CFA , ] ( INIT TO RES-ERROR ) SMUDGE FOREWARD @ 0= IF ( EARLIEST? ) LATEST FOREWARD ! ENDIF ; ASSEMBLER DEFINITIONS UTILITIES : :RESOLVE ( :ASM FORWARD REFS ) ?EXEC !CSP [COMPILE] ' DUP CFA DUP 1+ SWAP C@ 7E - ( JMP) OVER @ ' RES-ERROR CFA - OR 1D ?ERROR ( HEADER? ) HERE SWAP ! ( LINK IT ) FOREWARD @ = IF ( END FORWD? ) 0 FOREWARD ! ENDIF ; IMMEDIATE BIF DEFINITIONS ASSEMBLER : :RES ( RESOLVE : FORWARDS ) [COMPILE] :RESOLVE [ BIF ] ( ASSEMBLE JMP <XCOL, COMPILE) IP, [ LATEST CFA @ , ] ] ; : ;RES [COMPILE] ; SMUDGE ; IMMEDIATE ( PL PTEST ) ( JMR-89AUG25 ) BIF DEFINITIONS DECIMAL : PL 79 0 DO I 33 + EMIT LOOP ; : PT ( PL UNTIL KEY PRESS ) BEGIN PL ?TERMINAL UNTIL ; : PTEST >PRT PT >VID ; ;S ( SLIST ) ( JMR-16OCT90 ) ROOT @ UTILITIES : SLIST ( LIST SCREENS TO PRT ) >PRT 1+ SWAP DO I ULIST 0< IF LEAVE ENDIF LOOP >VID ; ROOT ! ;S ( DISK ACCESS WORDS JMR-900228) HEX : CM! FF48 C! ; : ST@ FF48 C@ ; : TR! FF49 C! ; : TR@ FF49 C@ ; : SE! FF4A C! ; : SE@ FF4A C@ ; : DA! FF4B C! ; : DA@ FF4B C@ ; : DR FF40 ! ; : DWAIT BEGIN ST@ DUP 1 AND WHILE DROP REPEAT ; : 1I DR 40 CM! DWAIT 0 DR . ; : 1O DR 60 CM! DWAIT 0 DR . ; : IN 0 DO DUP 1I LOOP DROP ; : OUT 0 DO DUP 1O LOOP DROP ; : ?ADR 0 FF42 C! 0 FF46 C! 28 OR DR ( MOTOR ON, DBL DNS) C4 FF4C C! DWAIT . FF44 @ DROP 0 FF42 C! 0 FF46 C! FF4E ? FF4E ? FF4E ? ; ;S ( NAMES ) ( JMR-89MAY16 ) BIF DEFINITIONS HEX : NAME ( CFA TO NAME ) 2+ NFA ID. ; : NAMES ( DUMP BY NAME ) -DUP IF 2* OVER + SWAP ( 0? ) DO I 0 6 D.R ( ADR ) I @ DUP 0 5 D.R ( NUMERIC) 3A EMIT NAME CR ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF 2 +LOOP ENDIF ; ;S ( ^asm-util DREG REGISTERS # DPREG DPR SETDP JMR-88DEC19 ) ASSEMBLER DEFINITIONS HEX VOCABULARY ^asm-util ( HIDDEN ) ^asm-util DEFINITIONS : DREG ( REGISTER OPERANDS ) 0FF0F AND 5245 DCONSTANT ; ASSEMBLER DEFINITIONS ^asm-util ( INDEX IN HI BYTE ) 8B00 DREG D 8608 DREG A 8509 DREG B 8C05 DREG PC 4003 DREG U 6004 DREG S 2002 DREG Y 0001 DREG X EF0A DREG CC EF0B DREG DP ( ALL OPERANDS ARE DBL INTS ) ( ABSOLUTE IS 0 OR -1 HI WORD ) ( DIRECT IS ABSOLUTE IN DPAGE ) 494D CONSTANT # ( HI WORD ) ^asm-util DEFINITIONS ( ASSEMBLY TIME DIRECT PAGE ) 42 USER DPREG ( EMULATOR ) ( INIT DPREG ) UTILITIES DP@ ASSEMBLER ^asm-util DPREG ! ASSEMBLER DEFINITIONS ( ACCESS DPREG ) : DPR [ ^asm-util ] DPREG BIF @ ; : SETDP 0FF00 AND [ ^asm-util ] DPREG BIF ! ; --> ( OFF, ABS, V, PCOFF PCR, ) ( JMR-89JAN2 ) ^asm-util DEFINITIONS : OFF, ( SET IX b0, COMPILE 2 ) OVER DUP 80 < SWAP -81 > AND IF C, C, ( SHORT ) ELSE 1 OR C, , ( LONG ) ENDIF ; : OP, ( COMPILE BYTE OR WORD ) DUP 0FF00 AND IF , ELSE C, ENDIF ; : ABS, >R ( COMPILE ABS ADR OP ) OVER 0FF00 AND DPR = IF R> DROP OP, C, ( DIR PAGE) ELSE R> OR OP, , ( EXT ) ENDIF ; : PCOFF ( ABSOLUTE TO PC REL ) HERE + 1+ - ( CALC OFFSET ) DUP 7F > OVER -80 < OR IF 1- 0 ( WORD OFF ) ELSE -1 ( BYTE OFF ) ENDIF ; : ?ABS ( TRUE IF ABSOLUTE ) DUP NOT 0= = ; ( USE T/F VAL) : PCR, ( COMPILE A PC REL INDEX) >R ?ABS NOT 25 ?ERROR 1 PCOFF IF R> C, C, ( BYTE ) ELSE R> 1 OR C, , ENDIF ; --> ( AUTO MASK, REG, IXOFF, EI, ) ( JMR-89JAN2 ) ASSEMBLER DEFINITIONS 4155.0082 DCONSTANT -) ( AUTO ) 4155.0081 DCONSTANT )++ ( REG ) 4155.0080 DCONSTANT )+ ( MODE ) 4155.0083 DCONSTANT --) ( CONS) ^asm-util DEFINITIONS : MASK, OR C, ; ( FOR POSTBYTE) : REG, ( REG OFF TO POST-BYTE ) SWAP DUP D DROP = OVER A DROP = OR OVER B DROP = OR NOT 26 ?ERROR SWAB OR C, ; ( REG, USES DUAL CODED REGS ) : IXOFF, ( REGISTER + CONSTANT ) OVER IF OVER ( NON-ZERO? ) DUP 0F > SWAP -10 < OR OVER 10 AND OR ( []? ) IF 88 OR OFF, ( EXTERNAL ) ELSE ( OFFSET IN POST-BYTE) SWAP 1F AND OR C, ENDIF ELSE 84 OR C, DROP ( 0 OFF ) ENDIF ; : EI, ( EXTENDED INDIRECT ) SWAP ?ABS NOT 27 ?ERROR C, , ; --> ( IX, , INDIRECT ) ( JMR-89JAN4 ) : IX, ( COMPILE AN INDEX MODE ) DUP 9F = IF EI, ELSE DUP 8F AND 8C = IF PCR, ELSE SWAP DUP 4155 = IF DROP MASK, ( AUTO ) ELSE DUP 5245 = IF DROP REG, ELSE ?ABS NOT 22 ?ERROR IXOFF, ENDIF ENDIF ENDIF ENDIF ; ASSEMBLER DEFINITIONS : , ( CONVERT TO INDEX ) 5245 = ( REGISTER? ) OVER 00FF AND DUP 0 > SWAP 6 < AND ( X Y U S PC ? ) AND NOT 28 ?ERROR SWAB 4958 ; : ) ( CONVERT TO INDIRECT ) DUP 5245 = ( REGISTER? ) IF ( ASSEMBLER ) , ELSE DUP [ ^asm-util ] ?ABS [ ASSEMBLER ] IF 4958.009F ELSE ( INDEX? ) DUP 4958 = NOT 27 ?ERROR ENDIF ENDIF ( SET BIT 4 ) SWAP 10 OR SWAP ; --> ( ACCM UNARY REG ) ( JMR-89JAN5 ) ^asm-util DEFINITIONS HEX : ACCM ( ENCODE ACCUMULATOR ) SWAP DUP 0FE AND ( A OR B? ) 8 = NOT 29 ?ERROR 1 AND ( MASK B IN? ) IF OR ELSE DROP ENDIF ; : UNARY ( OP-CODE COMPILER ) <BUILDS 0F AND C, ( OP-CODE ) DOES> C@ ( OP-CODE ) OVER 5245 = ( REGISTER? ) IF DUP 0E = 29 ?ERROR ( JMP?) 40 OR ROT 10 ACCM C, DROP ELSE OVER 4958 = ( INDEX? ) IF 60 OR C, DROP IX, ELSE SWAP ?ABS NOT 21 ?ERROR 70 ( EXT BITS ) ABS, ENDIF ENDIF ; : REG ( ENCODE TARGET REG ) DUP C@ 8D = IF C@ 1 ( JSR ) ELSE SWAP 5245 - 29 ?ERROR OVER DUP A DROP = SWAP B DROP = OR IF C@ SWAP 40 ACCM 0 ( BYTE) ELSE SWAP 00FF AND ( REG? ) OVER 1+ C@ ( CT? ) OVER > NOT 29 ?ERROR ( RANGE ) 2* + 2+ @ -1 ( WORD REG ) ENDIF ENDIF ; --> ( #, BINARY REG-REG ) ( JMR-89JAN12 ) : #, ( COMPILE AN IMMEDIATE ) SWAP DUP 0F AND 5 - ( BIT OK) OVER 5 AND 5 = ( ST OR JSR? ) AND 24 ?ERROR OP, IF BIF , [ ^asm-util ] ( WORD) ELSE C, ENDIF ; ( BYTE ) : BINARY ( OP-CODE COMPILER ) <BUILDS 8F AND C, ( A/B OP ) 05 AND DUP C, -DUP IF ( OP CT) 0 DO 11CF AND BIF , ( DXYUS) [ ^asm-util ] LOOP ENDIF DOES> REG ROT ( SOURCE ) DUP 4958 = IF ( INDEX ? ) DROP DROP 20 OR OP, IX, ELSE DUP 494D = ( IMMEDIATE? ) IF DROP #, ELSE ?ABS NOT 21 ?ERROR DROP 10 OR 20 ABS, ENDIF ENDIF ; : REG-REG ( OP-CODE COMPILER ) <BUILDS C, ( OP-CODE ) DOES> C@ C, ( OP-CODE ) 5245 = ROT 5245 = AND NOT 23 ?ERROR ( 2 REGS? ) 0F AND SWAP SWAN 0F0 AND OR C, ; --> ( REG-BITS PACK MOVEM ) ( JMR-89JAN12 ) 0 0B 1 1ARRAY REG-BITS ( PACK ) 0 REG-BITS ( INITIALIZE ) 06 OVER C! 1+ 10 OVER C! 1+ 20 OVER C! 1+ 40 OVER C! 1+ 40 OVER C! 1+ 80 OVER C! 1+ -1 OVER ! 2+ ( UNDEFINED ) 02 OVER C! 1+ 04 OVER C! 1+ 01 OVER C! 1+ 08 SWAP C! ( STABILIZE PACK: UNDEF=ALL ) : PACK >R 0 ( PSH/PUL LIST ) BEGIN OVER 5245 = WHILE SWAP DROP SWAP ( REG ) DUP R = 2A ?ERROR ( SELF? ) 0FF AND REG-BITS C@ ( BIT ) OVER OVER AND 2B ?ERROR OR REPEAT ( ^ IS DUPLICATE?) R> DROP ; : MOVEM ( OP-CODE COMPILER ) <BUILDS 0FD AND C, DOES> ( OP) C@ >R ( OP ) 5245 = OVER 1+ 0FE AND 4 = AND ( S OR U?) NOT 2C ?ERROR R> OVER U DROP = ( SELECT S/U) IF 2 OR ENDIF C, PACK DUP 0= 2D ?ERROR C, ; --> ( BR DCOND CC-IMM IMPLY ) ( JMR-89JAN13 ) ASSEMBLER DEFINITIONS : BR ( COMPILE CONDITIONAL BR ) 434F - 2F ?ERROR ( CONDITION?) [ ^asm-util ] SWAP ( ADR? ) ?ABS NOT 21 ?ERROR SWAP 1 PCOFF IF ( SHORT ) SWAP DUP 0< IF 0FF AND ( BSR ) ELSE 0F AND 20 OR ENDIF C, C, ( BOTH BYTES ) ELSE SWAP DUP 01000 AND IF SWAB 017 AND ( BSR/BRA ) ELSE 0F AND 1020 OR SWAP 1- SWAP ENDIF OP, BIF , ENDIF ; ASSEMBLER ^asm-util DEFINITIONS : DCOND ( CONDITIONAL OPERANDS) 434F DCONSTANT ; : CC-IMM ( OP-CODE COMPILER ) <BUILDS C, ( OP-CODE ) DOES> C@ C, ( OP-CODE ) 494D - 2E ?ERROR ( IMMEDIATE?) C, ; : IMPLY ( OP-CODE COMPILER ) <BUILDS BIF , ( OP-CODE ) DOES> @ OP, ; --> ( MNEMONICS ) ( JMR-89JAN13 ) ASSEMBLER DEFINITIONS ^asm-util 10CE 0CE 108E 8E 0CC 5 86 BINARY LD 10CF 0CF 108F 8F 0CD 5 87 BINARY ST 118C 1183 108C 8C 1083 5 81 BINARY CMP 35 MOVEM PUL 34 MOVEM PSH 46 UNARY ROR 49 UNARY ROL 39 IMPLY RTS 3B IMPLY RTI 0 82 BINARY SBC 978D DCOND SR 1F REG-REG TFR 4D UNARY TST 83 1 80 BINARY SUB 103F IMPLY SWI2 113F IMPLY SWI3 3F IMPLY SWI 13 IMPLY SYNC 0 84 BINARY AND 0 89 BINARY ADC 48 UNARY ASL 47 UNARY ASR 0C3 1 8B BINARY ADD 3A IMPLY ABX 5 DCOND CS 43 UNARY COM 4F UNARY CLR 1600 DCOND AL 0 85 BINARY BIT 4A UNARY DEC 19 IMPLY DAA 2 DCOND HI 0B DCOND MI 7 DCOND EQ 0C DCOND GE 1E REG-REG EXG 4C UNARY INC 0 8D BINARY JSR 4E UNARY JMP 0 88 BINARY EOR 0E DCOND GT 4 DCOND HS 12 IMPLY NOP 3 DCOND LS 0A DCOND PL --> ( MORE MNEMONICS ) ( JMR-89JAN13 ) 44 UNARY LSR 48 UNARY LSL 0D DCOND LT 6 DCOND NE 3D IMPLY MUL 40 UNARY NEG 0 8A BINARY OR 1A CC-IMM ORCC 1 DCOND NV 1D IMPLY SEX 1C CC-IMM ANDCC 3C CC-IMM CWAI 8 DCOND VC 9 DCOND VS 4 DCOND CCLR ( LO LE FOLLOW ) ^asm-util DEFINITIONS 1 4 1 1ARRAY EA-IX ( TRANSLATE) 1 EA-IX ( INITIALIZE ) 0 OVER C! 1+ 1 OVER C! 1+ 3 OVER C! 1+ 2 SWAP C! ASSEMBLER DEFINITIONS : LEA ( OP-CODE ASSEMBLER ) 5245 - 23 ?ERROR ( REGISTER?) 0F BIF AND [ ^asm-util ] EA-IX C@ 30 BIF OR C, 4958 - 21 ?ERROR ( INDEX? ) [ ^asm-util ] IX, ; 0F DCOND LE 5 DCOND LO --> ( [CD] & ! ^ NEXT ) ( JMR-89JAN17 ) ASSEMBLER DEFINITIONS BIF HEX : [CD] ( CFA OF DEF ) -IFIND DROP DUP 0= 0 ?ERROR CFA 0 [COMPILE] DLITERAL ; IMMEDIATE CREATE & [CD] AND JMP SMUDGE CREATE ! [CD] OR JMP SMUDGE CREATE ^ [CD] XOR JMP SMUDGE ASSEMBLER : NEXT )++ Y ) JMP ; --> ( INVERTCC LIF IF ) ( JMR-89FEB3 ) ^asm-util DEFINITIONS HEX CREATE INVERTCC ( CONDITIONS ) 0. U , X LD 434F # X CMP HERE DUP 2+ 0 NE BR ( CC? ) 2. U , D LD ( BSR? ) HERE DUP 2+ 0 MI BR A CLR 1 # B EOR ( TOGGLE CC ) HERE 4 + 0 NE BR ( ALWAYS? ) AL DROP SWAB # A LD 2. U , D ST NEXT ( FILL BR) 1+ HERE OVER 1+ - SWAP C! 1+ HERE OVER 1+ - SWAP C! 2F # D LD D U PSH ( TO ERROR) [CD] ERROR JMP SMUDGE ASSEMBLER DEFINITIONS : LIF ( MARK AND ASM LONG BR ) [ ^asm-util ] INVERTCC [ ASSEMBLER ] >R >R HERE 4146 ( MARK ) [ UTILITIES ] [CD] RES-ERROR [ ASSEMBLER ] R> R> BR ; : IF ( MARK AND ASM SHORT BR ) [ ^asm-util ] INVERTCC [ ASSEMBLER ] >R >R HERE 4146 ( MARK ) OVER 2+ 0 R> R> BR ; --> ( FILL-IN ) ( JMR-89FEB7 ) ^asm-util DEFINITIONS CREATE FILL-IN ( BR OFFSETS ) UTILITIES DP@ 0 X LD DP DP@ @ - ASSEMBLER 0 X , D LD 0. U , D SUB D U PSH ( OFFS) 2. U , X LD 0. X , D LD ( BR) 16 # A CMP ( ALWAYS? ) HERE DUP 2+ 0 EQ BR 0FE # A AND 0F0 # B AND 1020 # D CMP ( LONG? ) HERE DUP 2+ 0 EQ BR ( SHORT BRANCH ) 0F0 # A AND 20 # A CMP ( BR?) UTILITIES [CD] RES-ERROR ASSEMBLER NE BR 0. U , D LD 7E # D ADD A TST UTILITIES [CD] RES-ERROR ASSEMBLER NE BR ( TOO FAR? ) 80 # B SUB 1. X , B ST ( OFFSET ) HERE 4. U , U LEA NEXT ROT 1+ HERE OVER 1+ - SWAP C! 0. U , D LD ( LONG BR ALWAYS) 3 # D SUB 1. X , D ST DUP 0 AL BR SWAP 1+ HERE OVER 1+ - SWAP C! 0. U , D LD ( LONG BR COND ) 4 # D SUB 2. X , D ST 0 AL BR SMUDGE --> ( ELSE LELSE ENDIF ) ( JMR-89FEB6 ) ASSEMBLER DEFINITIONS HEX ^asm-util : ELSE ( SHORT BRANCH, RESOLVE) 4146 ?PAIRS >R NV IF R> FILL-IN ; : LELSE ( LONG BRANCH, RESOLVE) 4146 ?PAIRS >R NV LIF R> FILL-IN ; : ENDIF 4146 ?PAIRS FILL-IN ; : BEGIN HERE 4142 ; : UNTIL ( COND BR TO BEGIN ) >R >R 4142 ?PAIRS 0 R> R> INVERTCC BR ; : WHILE ( COND BR PAST REPEAT ) ROT 4142 ?PAIRS IF DROP 4157 ; : REPEAT ( LOOP, RESOLVE WHILE) 4157 ?PAIRS SWAP 0 AL BR FILL-IN ; : LWHILE ( LONG WHILE ) ROT 4142 ?PAIRS LIF DROP 4157 ; --> ( :ASM ;ASM ) ( JMR-89MAR28 ) ASSEMBLER DEFINITIONS HEX : :ASM CREATE !CSP ; : ;ASM ?CSP SMUDGE ; : I-CODE ( SHIFT TO HI-LEVEL ) [ ' :ASM CFA @ ] LITERAL [ BIF ] , ( ASMBL JMP <XCOL ) DROOT @ ROOT ! ] ; ( COMPILE) ASSEMBLER : MACHINE ( SHIFT TO LO-LEVEL ) COMPILE (MACHINE) ( IN DEF ) [COMPILE] [ ( NOW INTERPRET ) [COMPILE] ASSEMBLER ; IMMEDIATE ;S ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ( D! D@ ) ( JMR-89FEB16 ) BIF DEFINITIONS ASSEMBLER :ASM D! ( STORE DBL ) X U PUL D U PUL 0. X , D ST D U PUL 2. X , D ST NEXT ;ASM :ASM D@ ( FETCH DBL ) X U PUL 0. X , D LD 2. X , X LD D X U PSH NEXT ;ASM :ASM DOVER ( DOUBLE OVER DOUBLE) 4. U , D LD 6. U , X LD D X U PSH NEXT ;ASM :ASM DSWAP ( SWAP DOUBLES ) 4. U , D LD 0. U , X LD 4. U , X ST 0. U , D ST 6. U , D LD 2. U , X LD 6. U , X ST 2. U , D ST NEXT ;ASM ;S
\ No newline at end of file
--- /dev/null
+/* Convert Color Computer 32 column screens to terminated lines.\r// Written by Joel Rees, Takino, Hyogo, Japan, May 1997.\r// Assigned to the public domain.\r// Since it is in the public domain, it can't be copyrighted. \r// If you borrow this code directly, \r// please note the source and the fact that it is public domain in your source code comments.\r//\r// Current e-mail (January 2000): joel_rees@sannet.ne.jp, reiisi@nettaxi.com\r*/\r\r#include <stdio.h>\r#include <stdlib.h> /* for EXIT_SUCCESS */\r#include <ctype.h>\r/* It's Mac, yess! */\r#include <console.h>\r\r\rconst int ScreenWidth = 32;\rconst int ScreenHeight = 32;\rconst int BufferWidth = ScreenWidth + 1; /* room for NUL */\r\r\r\r\rint main(int argc, char * argv[] )\r{\r char buffer[ ScreenHeight ][ BufferWidth ];\r FILE * input = stdin;\r\r /* Use the pseudo-command-line as simple file interface */\r argc = ccommand( &argv );\r if ( argc > 1 )\r { input = fopen( argv[ 1 ], "rb" );\r if ( input == NULL )\r { return EXIT_FAILURE;\r }\r }\r\r while ( !feof( input ) )\r { int lineCount;\r for ( lineCount = 0; lineCount < ScreenHeight && !feof( input ); ++lineCount )\r { int length = fread( buffer[ lineCount ], sizeof (char), ScreenWidth, input );\r while ( --length >= 0 \r && ( isspace( buffer[ lineCount ][ length ] ) \r || !isprint( buffer[ lineCount ][ length ] ) ) )\r /* "empty" loop */;\r buffer[ lineCount ][ ++length ] = '\0';\r }\r if ( lineCount > 1 \r || ( lineCount == 1 && buffer[ 0 ][ 0 ] != '\0' ) )\r { while ( --lineCount > 0 && buffer[ lineCount ][ 0 ] == '\0' )\r /* "empty" loop */;\r for ( int line = 0; line <= lineCount; ++line )\r puts( buffer[ line ] );\r putchar( '\f' );\r }\r }\r\r return EXIT_SUCCESS;\r}\r\r
\ No newline at end of file
--- /dev/null
+ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ( PAIRS ASSOCIATION -- EXAMPLE OF BUILDS JMR-88DEC16 ) : WORD1 ( OF PAIR ) <BUILDS HERE 0 , ( FOR LINK ) LATEST ( LINK TO ) DOES> @ ID. ; ( ID LINKED ) : WORD2 ( OF PAIR -- LINK BOTH ) <BUILDS , ( LINK TO OTHER ) LATEST SWAP ! ( LINK OTHER ) DOES> @ ID. ; ( ID LINKED ) : PAIRS WORD1 WORD2 ; PAIRS John Lisa PAIRS Rinda 491-8011 PAIRS Sharlene 259-3329 PAIRS Jack 9/15/1941 ;S
\ No newline at end of file
--- /dev/null
+\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( PAIRS ASSOCIATION -- EXAMPLE O\rF BUILDS JMR-88DEC16 )\r\r: WORD1 ( OF PAIR )\r <BUILDS HERE 0 , ( FOR LINK )\r LATEST ( LINK TO )\r DOES> @ ID. ; ( ID LINKED )\r\r: WORD2 ( OF PAIR -- LINK BOTH )\r <BUILDS , ( LINK TO OTHER )\r LATEST SWAP ! ( LINK OTHER )\r DOES> @ ID. ; ( ID LINKED )\r\r: PAIRS WORD1 WORD2 ;\r\r\r PAIRS John Lisa\r PAIRS Rinda 491-8011\r PAIRS Sharlene 259-3329\r PAIRS Jack 9/15/1941\r\r ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r
\ No newline at end of file
--- /dev/null
+\rSCR # 33 \r 0 ( [& ,& ]& )\r 1 ( JMR-93MAR20 )\r 2 BIF DEFINITIONS HEX\r 3 \r 4 : [& ( START ARRAY INDEX LIST )\r 5 0 0 4152 ;\r 6 \r 7 : ,& ( ACCUMULATE INDEX LIST )\r 8 ROT 4152 - 35 ?ERROR ( SPAN?)\r 9 OVER - DUP F000 AND 33 ?ERROR\r 10 1+ SWAP >R ( SAVE LO )\r 11 DUP ROT * R> + ( NEW RELOC )\r 12 ROT 1+ DUP 7 > 34 ?ERROR\r 13 SWAP 4152 ;\r 14 \r 15 : ]& ( COMPLETE THE ARRAY DEF )\r 16 DUP 1- FF00 AND 33 ?ERROR\r 17 <BUILDS >R ,& DROP ( AR FLAG)\r 18 R * ( NEW REL ) R> SWAP >R\r 19 SWAP DUP , ( STORE COUNT )\r 20 0 DO DUP , * LOOP ( SIZES )\r 21 DUP , ( ARR SZ ) R> , ( REL )\r 22 ALLOT ?STACK DOES>\r 23 0 ( SUM ) SWAP\r 24 DUP 2+ SWAP @ ( COUNT )\r 25 2* OVER + DUP >R ( SAVE END )\r 26 SWAP DO ( SUM OF PRODUCTS )\r 27 SWAP I @ * + 2 +LOOP\r 28 R 2+ @ ( RELOCATE ) - DUP 0<\r 29 OVER R @ < 0= ( BOUNDS? )\r 30 OR 0C ?ERROR\r 31 R> 4 + + ;\r
\ No newline at end of file
--- /dev/null
+\rSCR # 34 \r 0 ( ^ LABEL LOCVOC )\r 1 ( JMR-93MAR21 )\r 2 BIF DEFINITIONS DECIMAL\r 3 \r 4 : ^ ( EXPONENT WITH ?ERROR )\r 5 -DUP 0= IF DROP 1 ( N 0 ^ )\r 6 ELSE OVER DUP 0= ( 0 N ^ )\r 7 SWAP 1 = OR ( 1 N ^ )\r 8 OVER 1 = OR ( N 1 ^ )\r 9 IF DROP\r 10 ELSE 1 SWAP\r 11 0 DO\r 12 OVER M* 54 ?ERROR\r 13 LOOP SWAP DROP\r 14 ENDIF ENDIF ;\r 15 \r 16 : LABEL ( --- ) ( BUILD GOTO )\r 17 <BUILDS IMMEDIATE COMPILE-ONLY\r 18 0 , DOES>\r 19 DUP @ IF COMPILE BRANCH\r 20 @ HERE - 2- ,\r 21 ELSE HERE SWAP !\r 22 ENDIF ;\r 23 \r 24 : LOCVOC VOCABULARY IMMEDIATE ;\r 25 \r 26 : GETNUMBER ( ADR N --- )\r 27 1- OVER 1+ SWAP EXPECT\r 28 BL ENCLOSE OVER + 0 SWAP C!\r 29 NUMBER DROP ;\r 30 \r 31 : $ DUP . ;\r
\ No newline at end of file
--- /dev/null
+\rSCR # 40 \r 0 ( CS431 TESTPARAMS FACTORIAL )\r 1 ( JMR-93MAR24 )\r 2 DECIMAL 33 LOAD ( ARRAYS )\r 3 DECIMAL 34 LOAD ( ^ LABEL )\r 4 BIF DEFINITIONS LOCVOC CS431\r 5 CS431 DEFINITIONS DECIMAL\r 6 6805 VARIABLE X 6800 VARIABLE Y\r 7 LOCVOC PARAMSLOCAL\r 8 PARAMSLOCAL DEFINITIONS\r 9 0 VARIABLE A 0 VARIABLE B\r 10 0 VARIABLE C 0 VARIABLE X\r 11 0 2 2 1ARRAY D\r 12 CS431 DEFINITIONS PARAMSLOCAL\r 13 : TESTPARAMS ( N ADR --- )\r 14 1 A ! 2 B ! 3 C ! 4 X !\r 15 4 0 D ! 5 1 D ! 6 2 D !\r 16 SWAP ." BY-VAL WAS" .\r 17 DUP @ 0 D @ * 2 D @ C @ / -\r 18 1 D @ A @ * B @ * + SWAP\r 19 OVER 0 D @ / B @ * 2 D @ *\r 20 OVER !\r 21 ." BY-VAL PARAMETER=" SWAP .\r 22 ." BY-ADR PARAMETER=" @ .\r 23 ." LOCAL X=" X @ . ; CS431\r 24 : FACTORIAL ( ADR --- )\r 25 [ SMUDGE ] ( RECURSIVE )\r 26 DUP @ 12 > IF ." TOO BIG "\r 27 ELSE ." FACTOR" DUP ?\r 28 DUP @ 2 > IF\r 29 DUP @ 1- SP@ FACTORIAL\r 30 OVER @ * OVER ! ENDIF\r 31 ENDIF ." N!=" ? ; SMUDGE -->\r\rSCR # 41 \r 0 ( CS431 RECORDS )\r 1 ( JMR-93MAR24 )\r 2 CS431 DEFINITIONS\r 3 LOCVOC RECLOC\r 4 RECLOC DEFINITIONS\r 5 LOCVOC US\r 6 US DEFINITIONS\r 7 0 VARIABLE ME 0 VARIABLE YOU\r 8 0 2 2 1ARRAY THEM\r 9 RECLOC DEFINITIONS\r 10 0 VARIABLE X\r 11 CS431 DEFINITIONS RECLOC\r 12 : TESTRECORDS ( --- )\r 13 1 X ! US 3 ME ! 6 YOU !\r 14 2 0 THEM ! 4 1 THEM !\r 15 6 2 THEM !\r 16 2 THEM @ 10 * YOU @ /\r 17 1 THEM @ - 0 THEM @ + ME !\r 18 ." BEFORE CALL, US.ME=" ME ?\r 19 ." US.THEM[2]=" 2 THEM ?\r 20 ME @ 2 THEM TESTPARAMS\r 21 ." AFTER CALL, LOCAL X=" X ?\r 22 ." GLOBAL X=" CS431 X ?\r 23 RECLOC US\r 24 ." US.ME=" ME ?\r 25 ." US.THEM[2]=" 2 THEM ? ;\r 26 CS431 DEFINITIONS\r 27 -->\r 28 \r 29 \r 30 \r 31 \r\rSCR # 42 \r 0 ( CS431 MAIN )\r 1 ( JMR-93MAR24 )\r 2 CS431 DEFINITIONS DECIMAL\r 3 LOCVOC MAINLOC\r 4 MAINLOC DEFINITIONS\r 5 LABEL LOOPTO\r 6 0 VARIABLE A 0 VARIABLE B\r 7 0 VARIABLE C 0 VARIABLE D\r 8 0 VARIABLE E 0 VARIABLE F\r 9 0 VARIABLE G\r 10 0 VARIABLE I 0 VARIABLE J\r 11 0 VARIABLE K 0 VARIABLE X\r 12 0 VARIABLE CHOICE\r 13 0 VARIABLE RESULT\r 14 [& -1 1 ,& 5 7 ,& 10 11\r 15 2 ]& ARRAY\r 16 0 79 1 1ARRAY STR\r 17 0 VARIABLE AA 0 VARIABLE BB\r 18 0 VARIABLE CC 0 VARIABLE DRES\r 19 CS431 DEFINITIONS MAINLOC\r 20 ( MIGHT AS WELL START HERE! )\r 21 : MAIN ( --- ) ( WE HOPE )\r 22 LOOPTO ." CHOICE (1 - 9): "\r 23 0 STR 80 GETNUMBER\r 24 DUP CHOICE ! 0= IF\r 25 ." I BE DONE!" QUIT\r 26 ELSE CHOICE @ 1 = IF\r 27 1 A ! 2 B ! 3 C ! 4 D !\r 28 5 E ! 6 F ! 7 G !\r 29 A @ B @ * $ C @ D @ * $\r 30 F @ B @ / $ D @ B @ / $\r 31 G @ 100 * $ -->\r\rSCR # 43 \r 0 ( CS431 CONTINUE MAIN )\r 1 \r 2 E @ E @ * E @ * $ 23 C @ - $\r 3 B @ G @ B @ - * C @ * $\r 4 C @ A @ B @ D @ * + * E @ / $\r 5 A @ B @ + C @ + G @ F @ -\r 6 D @ - * $\r 7 E @ F @ + G @ + A @ B @ + / $\r 8 G @ MINUS G @ - $\r 9 A @ MINUS B @ MINUS *\r 10 G @ MINUS + $\r 11 F @ D @ * MINUS\r 12 B @ C @ * MINUS / $\r 13 + + + + + + + +\r 14 - + - + +\r 15 RESULT !\r 16 ." RESULT=" RESULT ?\r 17 ELSE CHOICE @ 2 = IF\r 18 2 AA ! 3 BB ! 4 CC !\r 19 AA @ AA @ ^ AA @ BB @ ^ +\r 20 AA @ ^ AA @ CC @ ^ /\r 21 DRES ! DRES @ RESULT !\r 22 ." RESULT=" RESULT ?\r 23 ELSE CHOICE @ 3 = IF\r 24 2 -1 DO\r 25 BIF I MAINLOC I !\r 26 8 5 DO\r 27 BIF I MAINLOC J !\r 28 12 10 DO\r 29 BIF I MAINLOC K !\r 30 ." ARRAY AT"\r 31 I ? J ? K ? -->\r\rSCR # 44 \r 0 ( CS431 MAIN CONTINUED )\r 1 \r 2 0 STR 80\r 3 GETNUMBER\r 4 I @ J @ K @ ARRAY !\r 5 LOOP LOOP LOOP\r 6 0 RESULT !\r 7 2 -1 DO\r 8 BIF I MAINLOC I !\r 9 8 5 DO\r 10 BIF I MAINLOC J !\r 11 12 10 DO\r 12 BIF I MAINLOC K !\r 13 I @ J @ K @ ARRAY @\r 14 RESULT +!\r 15 LOOP LOOP LOOP\r 16 ." RESULT=" RESULT ?\r 17 ELSE CHOICE @ 4 = IF\r 18 21 0 DO\r 19 BIF I MAINLOC I !\r 20 I @ 0= IF ." ZERO"\r 21 ELSE I @ 10 < IF\r 22 ." I=" I ?\r 23 ELSE I @ 10 = IF\r 24 16 I ! R> DROP 16 >R\r 25 ELSE ." NEAT-O"\r 26 ENDIF ENDIF ENDIF\r 27 2 +LOOP\r 28 ELSE CHOICE @ 5 = IF\r 29 2 A ! 4 B ! 0 X !\r 30 ." A BEFORE CALL=" A ?\r 31 ." B BEFORE CALL=" B ? -->\r\rSCR # 45 \r 0 ( CS431 MAIN CONTINUED )\r 1 \r 2 A @ B TESTPARAMS\r 3 ." AFTER A=" A ?\r 4 ." AFTER B=" B ?\r 5 ." GLOBAL X=" CS431 X ?\r 6 ." MAIN X=" MAINLOC X ?\r 7 ELSE CHOICE @ 6 = IF\r 8 0 STR 80\r 9 GETNUMBER\r 10 SP@ FACTORIAL ." ^:" 0 D.\r 11 ELSE CHOICE @ 7 = IF\r 12 TESTRECORDS\r 13 ELSE CHOICE @ 8 = IF\r 14 ." NO CASE "\r 15 ENDIF ENDIF ENDIF ENDIF\r 16 ENDIF ENDIF ENDIF ENDIF\r 17 ENDIF\r 18 CHOICE @ 9 < IF LOOPTO ENDIF\r 19 \r 20 ." THE WRONG END TO PRINT" ;\r 21 ;S\r 22 \r 23 \r 24 \r 25 \r 26 \r 27 \r 28 \r 29 \r 30 \r 31 \r
\ No newline at end of file
--- /dev/null
+0) Index to BIF HI-LEVEL disk 2) Title page, Copr. notice 3) MONITOR CALL TO DEBUG 4) ERROR MESSAGES 6) HIGH LEVEL TOOLS & UTILITIES 7) LIST, INDEX, TRIAD 8) HIGH LEVEL DISK & SCREEN 11) FORWARD REFERENCING 12) PERIPHERAL UTILITIES 13) SLIST 15) DUMP DEFINITION BY NAME 16) ASSEMBLER 32) DOUBLES IN ASSEMBLER 40) HLL COMPILER 64) PAIR ASSOCIATION EXAMPLE 66) A TRY AT DIVIDE BY CONSTANT 100) SARDIS DMC STUFF 144) HOOCH COMPILER REMAINS BIF EDITOR, UTILITIES, ASSEMBLER, AND EXAMPLES VERSION 1.0 COPYRIGHT 1989 JOEL MATTHEW REES THESE ALGORITHMS ARE EXPRESSED IN THREE LANGUAGES: BIF, BIF ASSEMBLER FOR THE MOTOROLA M6809 MICROPROCESSOR, AND HEXADECIMAL MACHINE CODE FORTHE M6809. THE TEXT IS ORGANIZED FOR EDITING ON A 32-COLUMN TERMINAL,SUCH AS IS FOUND ON A RADIO SHACK COLOR COMPUTER 2. THESE ALGORITHMS AND THEIR TEXT ARE INTENDED FOR NO PURPOSEOTHER THAN EXPERIMENTATION, AND NO CLAIMS OR WARRANTIES ARE MADECONCERNING THEIR USEFULNESS IN ANY PARTICULAR APPLICATION. PUBLISHED 1989 JOEL MATTHEW REES SOUTH SALT LAKE CITY, UTAH ( CALL TO MONITOR, IF SWI IS BREAKPOINT JMR-88OCT?? ) CREATE MON HEX 3F C, 6EB1 , SMUDGE HERE 1- FENCE ! ;S ( ERROR MESSAGES ) DATA STACK UNDERFLOW DICTIONARY FULL ADDRESS RESOLUTION ERROR HIDES DEFINITION IN NULL VECTOR WRITTEN DISC RANGE? DATA STACK OVERFLOW DISC ERROR! CAN'T EXECUTE A NULL! CONTROL STACK UNDERFLOW CONTROL STACK OVERFLOW ARRAY REFERENCE OUT OF BOUNDS ARRAY DIMENSION NOT VALID NO PROCEDURE TO ENTER ( WAS REGISTER ) COMPILATION ONLY, USE IN DEF EXECUTION ONLY CONDITIONALS NOT PAIRED DEFINITION INCOMPLETE IN PROTECTED DICTIONARY USE ONLY WHEN LOADING OFF CURRENT EDITING SCREEN DECLARE VOCABULARY DEFINITION NOT IN VOCABULARY IN FORWARD BLOCK ALLOCATION LIST CORRUPTED: LOST CAN'T REDEFINE nul! NOT FORWARD REFERENCE ( WAS IMMEDIATE ) ( MORE ERROR MESSAGES ) HAS INCORRECT ADDRESS MODE HAS INCORRECT INDEX MODE OPERAND NOT REGISTER HAS ILLEGAL IMMEDIATE PC OFFSET MUST BE ABSOLUTE ACCUMULATOR OFFSET REQUIRED ILLEGAL MEMORY INDIRECTION ILLEGAL INDEX BASE ILLEGAL TARGET SPECIFIED CAN'T STACK ON SELF DUPLICATE IN LIST REGISTER NOT STACK EMPTY REGISTER LIST IMMEDIATE OPERAND REQUIRED REQUIRES CONDITION COMPILE-TIME STACK UNDERFLOW COMPILE-TIME STACK OVERFLOW ( UTILITIES DUMP QLIST QINDEX ) ( L/SCR ULIST JMR-88NOV16) BIF DEFINITIONS HEX ( UTILITIES IS NOW IN KERNEL ) UTILITIES DEFINITIONS : BYTE-DUMP -DUP IF 0 DO DUP I + C@ 4 .R LOOP ENDIF DROP ; ( BASE > 6) BIF DEFINITIONS : DUMP -DUP IF OVER + SWAP DO I 0 6 D.R I 4 [ UTILITIES ] BYTE-DUMP [ BIF ] 3A EMIT I 4 TYPE CR ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF 4 +LOOP ENDIF ; : QLIST BLOCK [ EDITOR ] QDUMP [ BIF ] 500 88 ! ( CENTER ) ; : QINDEX 1+ SWAP DO I QLIST ." SCREEN=" I 4 /MOD . 3A EMIT . ." BLOCK=" I . KEY 0< IF LEAVE ENDIF LOOP ; UTILITIES DEFINITIONS : L/SCR B/BUF B/SCR C/L */ ; : ULIST ( SCREEN N, FLAG BRK ) DUP SCR ! ." SCR # " . 0 ( F ) L/SCR 0 DO CR I 3 .R SPACE I SCR @ .LINE ?TERMINAL 0< IF ( BREAK? ) KEY 0< IF 1- LEAVE ENDIF ENDIF LOOP CR ; --> ( LIST INDEX TRIAD ) ( JMR-88NOV16 ) BIF DEFINITIONS : LIST ( WIDE OUTPUT ) DECIMAL CR UTILITIES ULIST BIF DROP ; : INDEX ( PRINT COMMENT LINES ) 0C EMIT ( FORM FEED ) CR 1+ SWAP DO CR I 3 .R SPACE 0 I .LINE C/L 49 < IF 1 I .LINE ENDIF ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF LOOP ; : TRIAD ( LIST MULTIPLE ) >PRT 0C EMIT ( FORM FEED ) [ DECIMAL ] UTILITIES L/SCR BIF 22 > IF 2 ELSE 3 ENDIF >R R / R * DUP R> + SWAP DO I UTILITIES ULIST BIF 0< IF LEAVE ENDIF UTILITIES L/SCR BIF DUP 32 = SWAP 22 = OR NOT IF CR CR ENDIF LOOP >VID ; HEX -->( HOME CLS QSAVE SAVE-BUFFERS QCAN ) ( JMR-88DEC10 ) UTILITIES DEFINITIONS HEX : HOME 400 88 ! ; : MID 500 88 ! ; BIF DEFINITIONS : CLS 400 200 60 FILL UTILITIES HOME BIF ; UTILITIES DEFINITIONS : CAN-UP ( CANCEL UPDATE IN BUF) DUP @ 7FFF AND OVER ! ; : W-BUF ( WRITE BUF AT ADR ) DUP 2+ OVER @ 7FFF AND 0 R/W CAN-UP ; : SAVE-BUF ( IF UPDATED ) DUP @ 0< IF W-BUF ENDIF ; BIF DEFINITIONS : QSAVE PREV @ ( SAVE PREVIOUS ) UTILITIES SAVE-BUF BIF DROP ; : SAVE-BUFFERS PREV @ BEGIN UTILITIES SAVE-BUF BIF +BUF NOT UNTIL DROP ; : QCAN PREV @ ( CAN UP OF PREV ) UTILITIES CAN-UP BIF DROP ; --> ( CANCEL-UPDATES RE-QUICK .PREV .BUFFERS QPREV JMR-88DEC10 ) : CANCEL-UPDATES PREV @ BEGIN UTILITIES CAN-UP BIF +BUF NOT UNTIL DROP ; : RE-QUICK ( QUICK OLD PREVIOUS) PREV @ DUP @ 7FFF AND 0 ROT ! [ EDITOR ] QUICK BIF ; UTILITIES DEFINITIONS : .BUF ( QLIST BUFFER, . BLOCK ) DUP @ DUP 7FFF AND DUP QLIST MID ." BLOCK=" . 0< IF ." UPDATED" ENDIF CR ; BIF DEFINITIONS : .BUFFERS PREV @ ( .BUF, PAUSE) BEGIN UTILITIES .BUF BIF +BUF DROP KEY 0< ( BREAK? ) UNTIL DROP ; : .PREV PREV @ UTILITIES .BUF BIF DROP ; : EDIT DUP UTILITIES MID BIF ." BLOCK=" . CR [ EDITOR ] QUICK BIF PREV @ @ 0< IF ." UPDATED" ENDIF ; : QPREV PREV @ @ 7FFF AND EDIT ; -->( QOPY COPY QBACK BACK-UP ) ( JMR-88DEC11 ) : QOPY SWAP BLOCK SWAP BLOCK B/BUF 2/ MOVE UPDATE ; : COPY 2* 2* ( SCREEN ) SWAP 2* 2* DUP 4 + SWAP DO I OVER QOPY 1+ LOOP DROP ; : QBACK 1+ SWAP DO I QLIST I BLOCK DUP [ EDITOR ] QDUMP ." BLOCK " I . ." TO " 0 DRIVE-OFFSET @ I + DUP . KEY 59 = IF 0 R/W ( YES? ) ELSE DROP DROP ENDIF LOOP ; : EEDIT ( ERASE AND EDIT BLOCK ) DUP BLOCK 2- UTILITIES .BUF 2+ MID BIF ." BLOCK=" OVER . ." CLEAR?" CR KEY 59 = IF ( YES? ) B/BUF BLANKS UPDATE ELSE DROP ( DON'T CLEAR ) ENDIF EDIT ; --> ( RES-ERROR FORWARD :RESOLVE :RESOLVE ;RES JMR-16MAY89 ) UTILITIES DEFINITIONS HEX : RES-ERROR ( ADR RESOLUTION ) 3 ERROR ; BIF DEFINITIONS UTILITIES : FORWARD ( REFERENCE HEADER ) CREATE 7E C, ( JMP EXTENDED ) IP, [ ' RES-ERROR CFA , ] ( INIT TO RES-ERROR ) SMUDGE FOREWARD @ 0= IF ( EARLIEST? ) LATEST FOREWARD ! ENDIF ; ASSEMBLER DEFINITIONS UTILITIES : :RESOLVE ( :ASM FORWARD REFS ) ?EXEC !CSP [COMPILE] ' DUP CFA DUP 1+ SWAP C@ 7E - ( JMP) OVER @ ' RES-ERROR CFA - OR 1D ?ERROR ( HEADER? ) HERE SWAP ! ( LINK IT ) FOREWARD @ = IF ( END FORWD? ) 0 FOREWARD ! ENDIF ; IMMEDIATE BIF DEFINITIONS ASSEMBLER : :RES ( RESOLVE : FORWARDS ) [COMPILE] :RESOLVE [ BIF ] ( ASSEMBLE JMP <XCOL, COMPILE) IP, [ LATEST CFA @ , ] ] ; : ;RES [COMPILE] ; SMUDGE ; IMMEDIATE ( PL PTEST ) ( JMR-89AUG25 ) BIF DEFINITIONS DECIMAL : PL 79 0 DO I 33 + EMIT LOOP ; : PT ( PL UNTIL KEY PRESS ) BEGIN PL ?TERMINAL UNTIL ; : PTEST >PRT PT >VID ; ;S ( SLIST ) ( JMR-16OCT90 ) ROOT @ UTILITIES : SLIST ( LIST SCREENS TO PRT ) >PRT 1+ SWAP DO I ULIST 0< IF LEAVE ENDIF LOOP >VID ; ROOT ! ;S ( DISK ACCESS WORDS JMR-900228) HEX : CM! FF48 C! ; : ST@ FF48 C@ ; : TR! FF49 C! ; : TR@ FF49 C@ ; : SE! FF4A C! ; : SE@ FF4A C@ ; : DA! FF4B C! ; : DA@ FF4B C@ ; : DR FF40 ! ; : DWAIT BEGIN ST@ DUP 1 AND WHILE DROP REPEAT ; : 1I DR 40 CM! DWAIT 0 DR . ; : 1O DR 60 CM! DWAIT 0 DR . ; : IN 0 DO DUP 1I LOOP DROP ; : OUT 0 DO DUP 1O LOOP DROP ; : ?ADR 0 FF42 C! 0 FF46 C! 28 OR DR ( MOTOR ON, DBL DNS) C4 FF4C C! DWAIT . FF44 @ DROP 0 FF42 C! 0 FF46 C! FF4E ? FF4E ? FF4E ? ; ;S ( NAMES ) ( JMR-89MAY16 ) BIF DEFINITIONS HEX : NAME ( CFA TO NAME ) 2+ NFA ID. ; : NAMES ( DUMP BY NAME ) -DUP IF 2* OVER + SWAP ( 0? ) DO I 0 6 D.R ( ADR ) I @ DUP 0 5 D.R ( NUMERIC) 3A EMIT NAME CR ?TERMINAL 0< IF KEY 0< IF LEAVE ENDIF ENDIF 2 +LOOP ENDIF ; ;S ( ^asm-util DREG REGISTERS # DPREG DPR SETDP JMR-88DEC19 ) ASSEMBLER DEFINITIONS HEX VOCABULARY ^asm-util ( HIDDEN ) ^asm-util DEFINITIONS : DREG ( REGISTER OPERANDS ) 0FF0F AND 5245 DCONSTANT ; ASSEMBLER DEFINITIONS ^asm-util ( INDEX IN HI BYTE ) 8B00 DREG D 8608 DREG A 8509 DREG B 8C05 DREG PC 4003 DREG U 6004 DREG S 2002 DREG Y 0001 DREG X EF0A DREG CC EF0B DREG DP ( ALL OPERANDS ARE DBL INTS ) ( ABSOLUTE IS 0 OR -1 HI WORD ) ( DIRECT IS ABSOLUTE IN DPAGE ) 494D CONSTANT # ( HI WORD ) ^asm-util DEFINITIONS ( ASSEMBLY TIME DIRECT PAGE ) 42 USER DPREG ( EMULATOR ) ( INIT DPREG ) UTILITIES DP@ ASSEMBLER ^asm-util DPREG ! ASSEMBLER DEFINITIONS ( ACCESS DPREG ) : DPR [ ^asm-util ] DPREG BIF @ ; : SETDP 0FF00 AND [ ^asm-util ] DPREG BIF ! ; --> ( OFF, ABS, V, PCOFF PCR, ) ( JMR-89JAN2 ) ^asm-util DEFINITIONS : OFF, ( SET IX b0, COMPILE 2 ) OVER DUP 80 < SWAP -81 > AND IF C, C, ( SHORT ) ELSE 1 OR C, , ( LONG ) ENDIF ; : OP, ( COMPILE BYTE OR WORD ) DUP 0FF00 AND IF , ELSE C, ENDIF ; : ABS, >R ( COMPILE ABS ADR OP ) OVER 0FF00 AND DPR = IF R> DROP OP, C, ( DIR PAGE) ELSE R> OR OP, , ( EXT ) ENDIF ; : PCOFF ( ABSOLUTE TO PC REL ) HERE + 1+ - ( CALC OFFSET ) DUP 7F > OVER -80 < OR IF 1- 0 ( WORD OFF ) ELSE -1 ( BYTE OFF ) ENDIF ; : ?ABS ( TRUE IF ABSOLUTE ) DUP NOT 0= = ; ( USE T/F VAL) : PCR, ( COMPILE A PC REL INDEX) >R ?ABS NOT 25 ?ERROR 1 PCOFF IF R> C, C, ( BYTE ) ELSE R> 1 OR C, , ENDIF ; --> ( AUTO MASK, REG, IXOFF, EI, ) ( JMR-89JAN2 ) ASSEMBLER DEFINITIONS 4155.0082 DCONSTANT -) ( AUTO ) 4155.0081 DCONSTANT )++ ( REG ) 4155.0080 DCONSTANT )+ ( MODE ) 4155.0083 DCONSTANT --) ( CONS) ^asm-util DEFINITIONS : MASK, OR C, ; ( FOR POSTBYTE) : REG, ( REG OFF TO POST-BYTE ) SWAP DUP D DROP = OVER A DROP = OR OVER B DROP = OR NOT 26 ?ERROR SWAB OR C, ; ( REG, USES DUAL CODED REGS ) : IXOFF, ( REGISTER + CONSTANT ) OVER IF OVER ( NON-ZERO? ) DUP 0F > SWAP -10 < OR OVER 10 AND OR ( []? ) IF 88 OR OFF, ( EXTERNAL ) ELSE ( OFFSET IN POST-BYTE) SWAP 1F AND OR C, ENDIF ELSE 84 OR C, DROP ( 0 OFF ) ENDIF ; : EI, ( EXTENDED INDIRECT ) SWAP ?ABS NOT 27 ?ERROR C, , ; --> ( IX, , INDIRECT ) ( JMR-89JAN4 ) : IX, ( COMPILE AN INDEX MODE ) DUP 9F = IF EI, ELSE DUP 8F AND 8C = IF PCR, ELSE SWAP DUP 4155 = IF DROP MASK, ( AUTO ) ELSE DUP 5245 = IF DROP REG, ELSE ?ABS NOT 22 ?ERROR IXOFF, ENDIF ENDIF ENDIF ENDIF ; ASSEMBLER DEFINITIONS : , ( CONVERT TO INDEX ) 5245 = ( REGISTER? ) OVER 00FF AND DUP 0 > SWAP 6 < AND ( X Y U S PC ? ) AND NOT 28 ?ERROR SWAB 4958 ; : ) ( CONVERT TO INDIRECT ) DUP 5245 = ( REGISTER? ) IF ( ASSEMBLER ) , ELSE DUP [ ^asm-util ] ?ABS [ ASSEMBLER ] IF 4958.009F ELSE ( INDEX? ) DUP 4958 = NOT 27 ?ERROR ENDIF ENDIF ( SET BIT 4 ) SWAP 10 OR SWAP ; --> ( ACCM UNARY REG ) ( JMR-89JAN5 ) ^asm-util DEFINITIONS HEX : ACCM ( ENCODE ACCUMULATOR ) SWAP DUP 0FE AND ( A OR B? ) 8 = NOT 29 ?ERROR 1 AND ( MASK B IN? ) IF OR ELSE DROP ENDIF ; : UNARY ( OP-CODE COMPILER ) <BUILDS 0F AND C, ( OP-CODE ) DOES> C@ ( OP-CODE ) OVER 5245 = ( REGISTER? ) IF DUP 0E = 29 ?ERROR ( JMP?) 40 OR ROT 10 ACCM C, DROP ELSE OVER 4958 = ( INDEX? ) IF 60 OR C, DROP IX, ELSE SWAP ?ABS NOT 21 ?ERROR 70 ( EXT BITS ) ABS, ENDIF ENDIF ; : REG ( ENCODE TARGET REG ) DUP C@ 8D = IF C@ 1 ( JSR ) ELSE SWAP 5245 - 29 ?ERROR OVER DUP A DROP = SWAP B DROP = OR IF C@ SWAP 40 ACCM 0 ( BYTE) ELSE SWAP 00FF AND ( REG? ) OVER 1+ C@ ( CT? ) OVER > NOT 29 ?ERROR ( RANGE ) 2* + 2+ @ -1 ( WORD REG ) ENDIF ENDIF ; --> ( #, BINARY REG-REG ) ( JMR-89JAN12 ) : #, ( COMPILE AN IMMEDIATE ) SWAP DUP 0F AND 5 - ( BIT OK) OVER 5 AND 5 = ( ST OR JSR? ) AND 24 ?ERROR OP, IF BIF , [ ^asm-util ] ( WORD) ELSE C, ENDIF ; ( BYTE ) : BINARY ( OP-CODE COMPILER ) <BUILDS 8F AND C, ( A/B OP ) 05 AND DUP C, -DUP IF ( OP CT) 0 DO 11CF AND BIF , ( DXYUS) [ ^asm-util ] LOOP ENDIF DOES> REG ROT ( SOURCE ) DUP 4958 = IF ( INDEX ? ) DROP DROP 20 OR OP, IX, ELSE DUP 494D = ( IMMEDIATE? ) IF DROP #, ELSE ?ABS NOT 21 ?ERROR DROP 10 OR 20 ABS, ENDIF ENDIF ; : REG-REG ( OP-CODE COMPILER ) <BUILDS C, ( OP-CODE ) DOES> C@ C, ( OP-CODE ) 5245 = ROT 5245 = AND NOT 23 ?ERROR ( 2 REGS? ) 0F AND SWAP SWAN 0F0 AND OR C, ; --> ( REG-BITS PACK MOVEM ) ( JMR-89JAN12 ) 0 0B 1 1ARRAY REG-BITS ( PACK ) 0 REG-BITS ( INITIALIZE ) 06 OVER C! 1+ 10 OVER C! 1+ 20 OVER C! 1+ 40 OVER C! 1+ 40 OVER C! 1+ 80 OVER C! 1+ -1 OVER ! 2+ ( UNDEFINED ) 02 OVER C! 1+ 04 OVER C! 1+ 01 OVER C! 1+ 08 SWAP C! ( STABILIZE PACK: UNDEF=ALL ) : PACK >R 0 ( PSH/PUL LIST ) BEGIN OVER 5245 = WHILE SWAP DROP SWAP ( REG ) DUP R = 2A ?ERROR ( SELF? ) 0FF AND REG-BITS C@ ( BIT ) OVER OVER AND 2B ?ERROR OR REPEAT ( ^ IS DUPLICATE?) R> DROP ; : MOVEM ( OP-CODE COMPILER ) <BUILDS 0FD AND C, DOES> ( OP) C@ >R ( OP ) 5245 = OVER 1+ 0FE AND 4 = AND ( S OR U?) NOT 2C ?ERROR R> OVER U DROP = ( SELECT S/U) IF 2 OR ENDIF C, PACK DUP 0= 2D ?ERROR C, ; --> ( BR DCOND CC-IMM IMPLY ) ( JMR-89JAN13 ) ASSEMBLER DEFINITIONS : BR ( COMPILE CONDITIONAL BR ) 434F - 2F ?ERROR ( CONDITION?) [ ^asm-util ] SWAP ( ADR? ) ?ABS NOT 21 ?ERROR SWAP 1 PCOFF IF ( SHORT ) SWAP DUP 0< IF 0FF AND ( BSR ) ELSE 0F AND 20 OR ENDIF C, C, ( BOTH BYTES ) ELSE SWAP DUP 01000 AND IF SWAB 017 AND ( BSR/BRA ) ELSE 0F AND 1020 OR SWAP 1- SWAP ENDIF OP, BIF , ENDIF ; ASSEMBLER ^asm-util DEFINITIONS : DCOND ( CONDITIONAL OPERANDS) 434F DCONSTANT ; : CC-IMM ( OP-CODE COMPILER ) <BUILDS C, ( OP-CODE ) DOES> C@ C, ( OP-CODE ) 494D - 2E ?ERROR ( IMMEDIATE?) C, ; : IMPLY ( OP-CODE COMPILER ) <BUILDS BIF , ( OP-CODE ) DOES> @ OP, ; --> ( MNEMONICS ) ( JMR-89JAN13 ) ASSEMBLER DEFINITIONS ^asm-util 10CE 0CE 108E 8E 0CC 5 86 BINARY LD 10CF 0CF 108F 8F 0CD 5 87 BINARY ST 118C 1183 108C 8C 1083 5 81 BINARY CMP 35 MOVEM PUL 34 MOVEM PSH 46 UNARY ROR 49 UNARY ROL 39 IMPLY RTS 3B IMPLY RTI 0 82 BINARY SBC 978D DCOND SR 1F REG-REG TFR 4D UNARY TST 83 1 80 BINARY SUB 103F IMPLY SWI2 113F IMPLY SWI3 3F IMPLY SWI 13 IMPLY SYNC 0 84 BINARY AND 0 89 BINARY ADC 48 UNARY ASL 47 UNARY ASR 0C3 1 8B BINARY ADD 3A IMPLY ABX 5 DCOND CS 43 UNARY COM 4F UNARY CLR 1600 DCOND AL 0 85 BINARY BIT 4A UNARY DEC 19 IMPLY DAA 2 DCOND HI 0B DCOND MI 7 DCOND EQ 0C DCOND GE 1E REG-REG EXG 4C UNARY INC 0 8D BINARY JSR 4E UNARY JMP 0 88 BINARY EOR 0E DCOND GT 4 DCOND HS 12 IMPLY NOP 3 DCOND LS 0A DCOND PL --> ( MORE MNEMONICS ) ( JMR-89JAN13 ) 44 UNARY LSR 48 UNARY LSL 0D DCOND LT 6 DCOND NE 3D IMPLY MUL 40 UNARY NEG 0 8A BINARY OR 1A CC-IMM ORCC 1 DCOND NV 1D IMPLY SEX 1C CC-IMM ANDCC 3C CC-IMM CWAI 8 DCOND VC 9 DCOND VS 4 DCOND CCLR ( LO LE FOLLOW ) ^asm-util DEFINITIONS 1 4 1 1ARRAY EA-IX ( TRANSLATE) 1 EA-IX ( INITIALIZE ) 0 OVER C! 1+ 1 OVER C! 1+ 3 OVER C! 1+ 2 SWAP C! ASSEMBLER DEFINITIONS : LEA ( OP-CODE ASSEMBLER ) 5245 - 23 ?ERROR ( REGISTER?) 0F BIF AND [ ^asm-util ] EA-IX C@ 30 BIF OR C, 4958 - 21 ?ERROR ( INDEX? ) [ ^asm-util ] IX, ; 0F DCOND LE 5 DCOND LO --> ( [CD] & ! ^ NEXT ) ( JMR-89JAN17 ) ASSEMBLER DEFINITIONS BIF HEX : [CD] ( CFA OF DEF ) -IFIND DROP DUP 0= 0 ?ERROR CFA 0 [COMPILE] DLITERAL ; IMMEDIATE CREATE & [CD] AND JMP SMUDGE CREATE ! [CD] OR JMP SMUDGE CREATE ^ [CD] XOR JMP SMUDGE ASSEMBLER : NEXT )++ Y ) JMP ; --> ( INVERTCC LIF IF ) ( JMR-89FEB3 ) ^asm-util DEFINITIONS HEX CREATE INVERTCC ( CONDITIONS ) 0. U , X LD 434F # X CMP HERE DUP 2+ 0 NE BR ( CC? ) 2. U , D LD ( BSR? ) HERE DUP 2+ 0 MI BR A CLR 1 # B EOR ( TOGGLE CC ) HERE 4 + 0 NE BR ( ALWAYS? ) AL DROP SWAB # A LD 2. U , D ST NEXT ( FILL BR) 1+ HERE OVER 1+ - SWAP C! 1+ HERE OVER 1+ - SWAP C! 2F # D LD D U PSH ( TO ERROR) [CD] ERROR JMP SMUDGE ASSEMBLER DEFINITIONS : LIF ( MARK AND ASM LONG BR ) [ ^asm-util ] INVERTCC [ ASSEMBLER ] >R >R HERE 4146 ( MARK ) [ UTILITIES ] [CD] RES-ERROR [ ASSEMBLER ] R> R> BR ; : IF ( MARK AND ASM SHORT BR ) [ ^asm-util ] INVERTCC [ ASSEMBLER ] >R >R HERE 4146 ( MARK ) OVER 2+ 0 R> R> BR ; --> ( FILL-IN ) ( JMR-89FEB7 ) ^asm-util DEFINITIONS CREATE FILL-IN ( BR OFFSETS ) UTILITIES DP@ 0 X LD DP DP@ @ - ASSEMBLER 0 X , D LD 0. U , D SUB D U PSH ( OFFS) 2. U , X LD 0. X , D LD ( BR) 16 # A CMP ( ALWAYS? ) HERE DUP 2+ 0 EQ BR 0FE # A AND 0F0 # B AND 1020 # D CMP ( LONG? ) HERE DUP 2+ 0 EQ BR ( SHORT BRANCH ) 0F0 # A AND 20 # A CMP ( BR?) UTILITIES [CD] RES-ERROR ASSEMBLER NE BR 0. U , D LD 7E # D ADD A TST UTILITIES [CD] RES-ERROR ASSEMBLER NE BR ( TOO FAR? ) 80 # B SUB 1. X , B ST ( OFFSET ) HERE 4. U , U LEA NEXT ROT 1+ HERE OVER 1+ - SWAP C! 0. U , D LD ( LONG BR ALWAYS) 3 # D SUB 1. X , D ST DUP 0 AL BR SWAP 1+ HERE OVER 1+ - SWAP C! 0. U , D LD ( LONG BR COND ) 4 # D SUB 2. X , D ST 0 AL BR SMUDGE --> ( ELSE LELSE ENDIF ) ( JMR-89FEB6 ) ASSEMBLER DEFINITIONS HEX ^asm-util : ELSE ( SHORT BRANCH, RESOLVE) 4146 ?PAIRS >R NV IF R> FILL-IN ; : LELSE ( LONG BRANCH, RESOLVE) 4146 ?PAIRS >R NV LIF R> FILL-IN ; : ENDIF 4146 ?PAIRS FILL-IN ; : BEGIN HERE 4142 ; : UNTIL ( COND BR TO BEGIN ) >R >R 4142 ?PAIRS 0 R> R> INVERTCC BR ; : WHILE ( COND BR PAST REPEAT ) ROT 4142 ?PAIRS IF DROP 4157 ; : REPEAT ( LOOP, RESOLVE WHILE) 4157 ?PAIRS SWAP 0 AL BR FILL-IN ; : LWHILE ( LONG WHILE ) ROT 4142 ?PAIRS LIF DROP 4157 ; --> ( :ASM ;ASM ) ( JMR-89MAR28 ) ASSEMBLER DEFINITIONS HEX : :ASM CREATE !CSP ; : ;ASM ?CSP SMUDGE ; : I-CODE ( SHIFT TO HI-LEVEL ) [ ' :ASM CFA @ ] LITERAL [ BIF ] , ( ASMBL JMP <XCOL ) DROOT @ ROOT ! ] ; ( COMPILE) ASSEMBLER : MACHINE ( SHIFT TO LO-LEVEL ) COMPILE (MACHINE) ( IN DEF ) [COMPILE] [ ( NOW INTERPRET ) [COMPILE] ASSEMBLER ; IMMEDIATE ;S ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ( D! D@ ) ( JMR-89FEB16 ) BIF DEFINITIONS ASSEMBLER :ASM D! ( STORE DBL ) X U PUL D U PUL 0. X , D ST D U PUL 2. X , D ST NEXT ;ASM :ASM D@ ( FETCH DBL ) X U PUL 0. X , D LD 2. X , X LD D X U PSH NEXT ;ASM :ASM DOVER ( DOUBLE OVER DOUBLE) 4. U , D LD 6. U , X LD D X U PSH NEXT ;ASM :ASM DSWAP ( SWAP DOUBLES ) 4. U , D LD 0. U , X LD 4. U , X ST 0. U , D ST 6. U , D LD 2. U , X LD 6. U , X ST 2. U , D ST NEXT ;ASM ;S
\ No newline at end of file
--- /dev/null
+0) Index to BIF HI-LEVEL disk\r2) Title page, Copr. notice\r3) MONITOR CALL TO DEBUG\r4) ERROR MESSAGES\r6) HIGH LEVEL TOOLS & UTILITIES\r7) LIST, INDEX, TRIAD\r8) HIGH LEVEL DISK & SCREEN\r11) FORWARD REFERENCING\r12) PERIPHERAL UTILITIES\r13) SLIST\r15) DUMP DEFINITION BY NAME\r16) ASSEMBLER\r32) DOUBLES IN ASSEMBLER\r\r40) HLL COMPILER\r64) PAIR ASSOCIATION EXAMPLE\r66) A TRY AT DIVIDE BY CONSTANT\r\r100) SARDIS DMC STUFF\r\r144) HOOCH COMPILER REMAINS\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r BIF\r EDITOR, UTILITIES,\r ASSEMBLER, AND EXAMPLES\r VERSION 1.0\r\r\r COPYRIGHT 1989\r JOEL MATTHEW REES\r\r THESE ALGORITHMS ARE\rEXPRESSED IN THREE LANGUAGES:\rBIF, BIF ASSEMBLER FOR THE\rMOTOROLA M6809 MICROPROCESSOR,\rAND HEXADECIMAL MACHINE CODE FOR\rTHE M6809.\r\r THE TEXT IS ORGANIZED FOR\rEDITING ON A 32-COLUMN TERMINAL,\rSUCH AS IS FOUND ON A RADIO\rSHACK COLOR COMPUTER 2.\r\r THESE ALGORITHMS AND THEIR\rTEXT ARE INTENDED FOR NO PURPOSE\rOTHER THAN EXPERIMENTATION, AND\rNO CLAIMS OR WARRANTIES ARE MADE\rCONCERNING THEIR USEFULNESS IN\rANY PARTICULAR APPLICATION.\r\rPUBLISHED 1989\r JOEL MATTHEW REES\r SOUTH SALT LAKE CITY, UTAH\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( CALL TO MONITOR, IF SWI IS BRE\rAKPOINT JMR-88OCT?? )\r\rCREATE MON HEX 3F C, 6EB1 ,\r SMUDGE HERE 1- FENCE ! ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ERROR MESSAGES )\rDATA STACK UNDERFLOW\rDICTIONARY FULL\rADDRESS RESOLUTION ERROR\rHIDES DEFINITION IN\rNULL VECTOR WRITTEN\rDISC RANGE?\rDATA STACK OVERFLOW\rDISC ERROR!\rCAN'T EXECUTE A NULL!\rCONTROL STACK UNDERFLOW\rCONTROL STACK OVERFLOW\rARRAY REFERENCE OUT OF BOUNDS\rARRAY DIMENSION NOT VALID\rNO PROCEDURE TO ENTER\r ( WAS REGISTER )\r\rCOMPILATION ONLY, USE IN DEF\rEXECUTION ONLY\rCONDITIONALS NOT PAIRED\rDEFINITION INCOMPLETE\rIN PROTECTED DICTIONARY\rUSE ONLY WHEN LOADING\rOFF CURRENT EDITING SCREEN\rDECLARE VOCABULARY\rDEFINITION NOT IN VOCABULARY\rIN FORWARD BLOCK\rALLOCATION LIST CORRUPTED: LOST\rCAN'T REDEFINE nul!\rNOT FORWARD REFERENCE\r ( WAS IMMEDIATE )\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( MORE ERROR MESSAGES )\rHAS INCORRECT ADDRESS MODE\rHAS INCORRECT INDEX MODE\rOPERAND NOT REGISTER\rHAS ILLEGAL IMMEDIATE\rPC OFFSET MUST BE ABSOLUTE\rACCUMULATOR OFFSET REQUIRED\rILLEGAL MEMORY INDIRECTION\rILLEGAL INDEX BASE\rILLEGAL TARGET SPECIFIED\rCAN'T STACK ON SELF\rDUPLICATE IN LIST\rREGISTER NOT STACK\rEMPTY REGISTER LIST\rIMMEDIATE OPERAND REQUIRED\rREQUIRES CONDITION\r\rCOMPILE-TIME STACK UNDERFLOW\rCOMPILE-TIME STACK OVERFLOW\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( UTILITIES DUMP QLIST QINDEX )\r( L/SCR ULIST JMR-88NOV16)\r BIF DEFINITIONS HEX\r ( UTILITIES IS NOW IN KERNEL )\r UTILITIES DEFINITIONS\r: BYTE-DUMP -DUP IF\r 0 DO DUP I + C@ 4 .R LOOP\r ENDIF DROP ; ( BASE > 6)\r BIF DEFINITIONS\r: DUMP -DUP IF OVER + SWAP\r DO I 0 6 D.R I 4\r [ UTILITIES ] BYTE-DUMP\r [ BIF ] 3A EMIT I 4 TYPE\r CR ?TERMINAL 0< IF\r KEY 0< IF LEAVE ENDIF\r ENDIF 4 +LOOP ENDIF ;\r: QLIST BLOCK [ EDITOR ] QDUMP\r [ BIF ] 500 88 ! ( CENTER ) ;\r: QINDEX 1+ SWAP DO I QLIST\r ." SCREEN=" I 4 /MOD .\r 3A EMIT . ." BLOCK=" I .\r KEY 0< IF LEAVE ENDIF\r LOOP ;\r UTILITIES DEFINITIONS\r: L/SCR B/BUF B/SCR C/L */ ;\r: ULIST ( SCREEN N, FLAG BRK )\r DUP SCR ! ." SCR # " . 0 ( F )\r L/SCR 0 DO CR I 3 .R SPACE\r I SCR @ .LINE\r ?TERMINAL 0< IF ( BREAK? )\r KEY 0< IF 1- LEAVE ENDIF\r ENDIF LOOP CR ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( LIST INDEX TRIAD )\r ( JMR-88NOV16 )\r BIF DEFINITIONS\r: LIST ( WIDE OUTPUT ) DECIMAL\r CR UTILITIES ULIST BIF DROP ;\r\r: INDEX ( PRINT COMMENT LINES )\r 0C EMIT ( FORM FEED ) CR\r 1+ SWAP DO\r CR I 3 .R SPACE\r 0 I .LINE\r C/L 49 < IF 1 I .LINE ENDIF\r ?TERMINAL 0< IF\r KEY 0< IF LEAVE ENDIF\r ENDIF\r LOOP ;\r\r: TRIAD ( LIST MULTIPLE ) >PRT\r 0C EMIT ( FORM FEED )\r [ DECIMAL ] UTILITIES L/SCR\r BIF 22 > IF 2 ELSE 3 ENDIF\r >R R / R * DUP R> + SWAP\r DO I UTILITIES ULIST BIF\r 0< IF LEAVE ENDIF\r UTILITIES L/SCR BIF DUP\r 32 = SWAP 22 = OR NOT IF\r CR CR ENDIF\r LOOP >VID ; HEX\r\r\r\r -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( HOME CLS QSAVE SAVE-BUFFERS\r QCAN ) ( JMR-88DEC10 )\r UTILITIES DEFINITIONS HEX\r: HOME 400 88 ! ;\r: MID 500 88 ! ;\r BIF DEFINITIONS\r: CLS 400 200 60 FILL\r UTILITIES HOME BIF ;\r UTILITIES DEFINITIONS\r: CAN-UP ( CANCEL UPDATE IN BUF)\r DUP @ 7FFF AND OVER ! ;\r\r: W-BUF ( WRITE BUF AT ADR )\r DUP 2+ OVER @ 7FFF AND 0 R/W\r CAN-UP ;\r\r: SAVE-BUF ( IF UPDATED )\r DUP @ 0< IF W-BUF ENDIF ;\r\r BIF DEFINITIONS\r: QSAVE PREV @ ( SAVE PREVIOUS )\r UTILITIES SAVE-BUF BIF DROP ;\r\r\r: SAVE-BUFFERS PREV @\r BEGIN UTILITIES SAVE-BUF BIF\r +BUF NOT UNTIL DROP ;\r\r: QCAN PREV @ ( CAN UP OF PREV )\r UTILITIES CAN-UP BIF DROP ;\r-->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( CANCEL-UPDATES RE-QUICK .PREV\r .BUFFERS QPREV JMR-88DEC10 )\r: CANCEL-UPDATES PREV @\r BEGIN UTILITIES CAN-UP BIF\r +BUF NOT UNTIL DROP ;\r\r: RE-QUICK ( QUICK OLD PREVIOUS)\r PREV @ DUP @ 7FFF AND 0 ROT !\r [ EDITOR ] QUICK BIF ;\r\rUTILITIES DEFINITIONS\r: .BUF ( QLIST BUFFER, . BLOCK )\r DUP @ DUP 7FFF AND DUP QLIST\r MID ." BLOCK=" .\r 0< IF ." UPDATED" ENDIF CR ;\r\r BIF DEFINITIONS\r: .BUFFERS PREV @ ( .BUF, PAUSE)\r BEGIN UTILITIES .BUF BIF\r +BUF DROP KEY 0< ( BREAK? )\r UNTIL DROP ;\r\r: .PREV PREV @ UTILITIES .BUF\r BIF DROP ;\r\r: EDIT DUP UTILITIES MID BIF\r ." BLOCK=" . CR [ EDITOR ]\r QUICK BIF PREV @ @\r 0< IF ." UPDATED" ENDIF ;\r\r: QPREV PREV @ @ 7FFF AND\r EDIT ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( QOPY COPY QBACK BACK-UP )\r ( JMR-88DEC11 )\r: QOPY SWAP BLOCK SWAP BLOCK\r B/BUF 2/ MOVE UPDATE ;\r\r: COPY 2* 2* ( SCREEN )\r SWAP 2* 2* DUP 4 + SWAP\r DO I OVER QOPY 1+ LOOP DROP ;\r: QBACK 1+ SWAP DO I QLIST\r I BLOCK DUP [ EDITOR ] QDUMP\r ." BLOCK " I . ." TO "\r 0 DRIVE-OFFSET @ I + DUP .\r KEY 59 = IF 0 R/W ( YES? )\r ELSE DROP DROP\r ENDIF LOOP ;\r\r: EEDIT ( ERASE AND EDIT BLOCK )\r DUP BLOCK 2- UTILITIES .BUF 2+\r MID BIF ." BLOCK=" OVER .\r ." CLEAR?" CR\r KEY 59 = IF ( YES? )\r B/BUF BLANKS UPDATE\r ELSE DROP ( DON'T CLEAR )\r ENDIF EDIT ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( RES-ERROR FORWARD :RESOLVE\r :RESOLVE ;RES JMR-16MAY89 )\r UTILITIES DEFINITIONS HEX\r: RES-ERROR ( ADR RESOLUTION )\r 3 ERROR ;\r\r BIF DEFINITIONS UTILITIES\r: FORWARD ( REFERENCE HEADER )\r CREATE 7E C, ( JMP EXTENDED )\r IP, [ ' RES-ERROR CFA , ]\r ( INIT TO RES-ERROR ) SMUDGE\r FOREWARD @ 0= IF ( EARLIEST? )\r LATEST FOREWARD ! ENDIF ;\r ASSEMBLER DEFINITIONS\r UTILITIES\r: :RESOLVE ( :ASM FORWARD REFS )\r ?EXEC !CSP [COMPILE] ' DUP\r CFA DUP 1+ SWAP C@ 7E - ( JMP)\r OVER @ ' RES-ERROR CFA -\r OR 1D ?ERROR ( HEADER? )\r HERE SWAP ! ( LINK IT )\r FOREWARD @ = IF ( END FORWD? )\r 0 FOREWARD ! ENDIF ;\r IMMEDIATE\r\r BIF DEFINITIONS ASSEMBLER\r: :RES ( RESOLVE : FORWARDS )\r [COMPILE] :RESOLVE [ BIF ]\r ( ASSEMBLE JMP <XCOL, COMPILE)\r IP, [ LATEST CFA @ , ] ] ;\r: ;RES [COMPILE] ; SMUDGE ;\r IMMEDIATE\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( PL PTEST )\r ( JMR-89AUG25 )\r BIF DEFINITIONS DECIMAL\r: PL 79 0 DO I 33 + EMIT LOOP ;\r\r: PT ( PL UNTIL KEY PRESS )\r BEGIN PL ?TERMINAL UNTIL ;\r\r: PTEST >PRT PT >VID ;\r ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( SLIST )\r ( JMR-16OCT90 )\r ROOT @ UTILITIES\r\r: SLIST ( LIST SCREENS TO PRT )\r >PRT 1+ SWAP DO\r I ULIST 0< IF LEAVE ENDIF\r LOOP >VID ;\r ROOT ! ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( DISK ACCESS WORDS JMR-900228)\r\rHEX\r: CM! FF48 C! ; : ST@ FF48 C@ ;\r: TR! FF49 C! ; : TR@ FF49 C@ ;\r: SE! FF4A C! ; : SE@ FF4A C@ ;\r: DA! FF4B C! ; : DA@ FF4B C@ ;\r: DR FF40 ! ;\r: DWAIT BEGIN ST@ DUP 1 AND\r WHILE DROP REPEAT ;\r: 1I DR 40 CM! DWAIT 0 DR . ;\r: 1O DR 60 CM! DWAIT 0 DR . ;\r: IN 0 DO DUP 1I LOOP DROP ;\r: OUT 0 DO DUP 1O LOOP DROP ;\r: ?ADR 0 FF42 C! 0 FF46 C!\r 28 OR DR ( MOTOR ON, DBL DNS)\r C4 FF4C C! DWAIT . FF44 @ DROP\r 0 FF42 C! 0 FF46 C!\r FF4E ? FF4E ? FF4E ? ; ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( NAMES )\r ( JMR-89MAY16 )\r BIF DEFINITIONS HEX\r: NAME ( CFA TO NAME )\r 2+ NFA ID. ;\r\r\r\r: NAMES ( DUMP BY NAME )\r -DUP IF 2* OVER + SWAP ( 0? )\r DO I 0 6 D.R ( ADR )\r I @ DUP 0 5 D.R ( NUMERIC)\r 3A EMIT NAME CR\r ?TERMINAL 0< IF\r KEY 0< IF LEAVE ENDIF\r ENDIF 2 +LOOP ENDIF ; ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ^asm-util DREG REGISTERS #\r DPREG DPR SETDP JMR-88DEC19 )\r ASSEMBLER DEFINITIONS HEX\rVOCABULARY ^asm-util ( HIDDEN )\r ^asm-util DEFINITIONS\r: DREG ( REGISTER OPERANDS )\r 0FF0F AND 5245 DCONSTANT ;\r ASSEMBLER DEFINITIONS\r ^asm-util ( INDEX IN HI BYTE )\r8B00 DREG D 8608 DREG A\r8509 DREG B 8C05 DREG PC\r4003 DREG U 6004 DREG S\r2002 DREG Y 0001 DREG X\rEF0A DREG CC EF0B DREG DP\r ( ALL OPERANDS ARE DBL INTS )\r\r( ABSOLUTE IS 0 OR -1 HI WORD )\r( DIRECT IS ABSOLUTE IN DPAGE )\r494D CONSTANT # ( HI WORD )\r\r ^asm-util DEFINITIONS\r ( ASSEMBLY TIME DIRECT PAGE )\r42 USER DPREG ( EMULATOR )\r ( INIT DPREG ) UTILITIES DP@\r ASSEMBLER ^asm-util DPREG !\r\r ASSEMBLER DEFINITIONS\r ( ACCESS DPREG )\r: DPR [ ^asm-util ] DPREG\r BIF @ ;\r: SETDP 0FF00 AND [ ^asm-util ]\r DPREG BIF ! ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( OFF, ABS, V, PCOFF PCR, )\r ( JMR-89JAN2 )\r ^asm-util DEFINITIONS\r: OFF, ( SET IX b0, COMPILE 2 )\r OVER DUP 80 < SWAP -81 > AND\r IF C, C, ( SHORT )\r ELSE 1 OR C, , ( LONG )\r ENDIF ;\r\r: OP, ( COMPILE BYTE OR WORD )\r DUP 0FF00 AND\r IF , ELSE C, ENDIF ;\r\r: ABS, >R ( COMPILE ABS ADR OP )\r OVER 0FF00 AND DPR =\r IF R> DROP OP, C, ( DIR PAGE)\r ELSE R> OR OP, , ( EXT )\r ENDIF ;\r\r: PCOFF ( ABSOLUTE TO PC REL )\r HERE + 1+ - ( CALC OFFSET )\r DUP 7F > OVER -80 < OR\r IF 1- 0 ( WORD OFF )\r ELSE -1 ( BYTE OFF ) ENDIF ;\r\r: ?ABS ( TRUE IF ABSOLUTE )\r DUP NOT 0= = ; ( USE T/F VAL)\r\r: PCR, ( COMPILE A PC REL INDEX)\r >R ?ABS NOT 25 ?ERROR\r 1 PCOFF IF R> C, C, ( BYTE )\r ELSE R> 1 OR C, , ENDIF ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( AUTO MASK, REG, IXOFF, EI, )\r ( JMR-89JAN2 )\r ASSEMBLER DEFINITIONS\r4155.0082 DCONSTANT -) ( AUTO )\r4155.0081 DCONSTANT )++ ( REG )\r4155.0080 DCONSTANT )+ ( MODE )\r4155.0083 DCONSTANT --) ( CONS)\r ^asm-util DEFINITIONS\r\r: MASK, OR C, ; ( FOR POSTBYTE)\r\r: REG, ( REG OFF TO POST-BYTE )\r SWAP DUP D DROP =\r OVER A DROP = OR OVER\r B DROP = OR NOT 26 ?ERROR\r SWAB OR C, ;\r ( REG, USES DUAL CODED REGS )\r\r: IXOFF, ( REGISTER + CONSTANT )\r OVER IF OVER ( NON-ZERO? )\r DUP 0F > SWAP -10 < OR\r OVER 10 AND OR ( []? )\r IF 88 OR OFF, ( EXTERNAL )\r ELSE ( OFFSET IN POST-BYTE)\r SWAP 1F AND OR C,\r ENDIF\r ELSE 84 OR C, DROP ( 0 OFF )\r ENDIF ;\r\r: EI, ( EXTENDED INDIRECT )\r SWAP ?ABS NOT 27 ?ERROR\r C, , ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( IX, , INDIRECT )\r ( JMR-89JAN4 )\r: IX, ( COMPILE AN INDEX MODE )\r DUP 9F = IF EI,\r ELSE DUP 8F AND 8C = IF PCR,\r ELSE SWAP DUP 4155 =\r IF DROP MASK, ( AUTO )\r ELSE DUP 5245 =\r IF DROP REG,\r ELSE ?ABS NOT 22 ?ERROR\r IXOFF, ENDIF\r ENDIF ENDIF ENDIF ;\r\r ASSEMBLER DEFINITIONS\r: , ( CONVERT TO INDEX )\r 5245 = ( REGISTER? )\r OVER 00FF AND DUP 0 > SWAP\r 6 < AND ( X Y U S PC ? )\r AND NOT 28 ?ERROR\r SWAB 4958 ;\r\r: ) ( CONVERT TO INDIRECT )\r DUP 5245 = ( REGISTER? )\r IF ( ASSEMBLER ) ,\r ELSE DUP [ ^asm-util ] ?ABS\r [ ASSEMBLER ] IF 4958.009F\r ELSE ( INDEX? )\r DUP 4958 = NOT 27 ?ERROR\r ENDIF ENDIF ( SET BIT 4 )\r SWAP 10 OR SWAP ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ACCM UNARY REG )\r ( JMR-89JAN5 )\r ^asm-util DEFINITIONS HEX\r: ACCM ( ENCODE ACCUMULATOR )\r SWAP DUP 0FE AND ( A OR B? )\r 8 = NOT 29 ?ERROR\r 1 AND ( MASK B IN? )\r IF OR ELSE DROP ENDIF ;\r\r: UNARY ( OP-CODE COMPILER )\r <BUILDS 0F AND C, ( OP-CODE )\r DOES> C@ ( OP-CODE )\r OVER 5245 = ( REGISTER? )\r IF DUP 0E = 29 ?ERROR ( JMP?)\r 40 OR ROT 10 ACCM C, DROP\r ELSE OVER 4958 = ( INDEX? )\r IF 60 OR C, DROP IX,\r ELSE SWAP ?ABS NOT 21 ?ERROR\r 70 ( EXT BITS ) ABS,\r ENDIF ENDIF ;\r\r: REG ( ENCODE TARGET REG )\r DUP C@ 8D = IF C@ 1 ( JSR )\r ELSE SWAP 5245 - 29 ?ERROR\r OVER DUP A DROP =\r SWAP B DROP = OR\r IF C@ SWAP 40 ACCM 0 ( BYTE)\r ELSE SWAP 00FF AND ( REG? )\r OVER 1+ C@ ( CT? ) OVER\r > NOT 29 ?ERROR ( RANGE )\r 2* + 2+ @ -1 ( WORD REG )\r ENDIF ENDIF ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( #, BINARY REG-REG )\r ( JMR-89JAN12 )\r: #, ( COMPILE AN IMMEDIATE )\r SWAP DUP 0F AND 5 - ( BIT OK)\r OVER 5 AND 5 = ( ST OR JSR? )\r AND 24 ?ERROR OP,\r IF BIF , [ ^asm-util ] ( WORD)\r ELSE C, ENDIF ; ( BYTE )\r\r: BINARY ( OP-CODE COMPILER )\r <BUILDS 8F AND C, ( A/B OP )\r 05 AND DUP C, -DUP IF ( OP CT)\r 0 DO 11CF AND BIF , ( DXYUS)\r [ ^asm-util ] LOOP ENDIF\r DOES> REG ROT ( SOURCE )\r DUP 4958 = IF ( INDEX ? )\r DROP DROP 20 OR OP, IX,\r ELSE DUP 494D = ( IMMEDIATE? )\r IF DROP #,\r ELSE ?ABS NOT 21 ?ERROR\r DROP 10 OR 20 ABS,\r ENDIF ENDIF ;\r\r\r: REG-REG ( OP-CODE COMPILER )\r <BUILDS C, ( OP-CODE ) DOES>\r C@ C, ( OP-CODE )\r 5245 = ROT 5245 = AND\r NOT 23 ?ERROR ( 2 REGS? )\r 0F AND SWAP SWAN 0F0 AND\r OR C, ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( REG-BITS PACK MOVEM )\r ( JMR-89JAN12 )\r0 0B 1 1ARRAY REG-BITS ( PACK )\r 0 REG-BITS ( INITIALIZE )\r 06 OVER C! 1+ 10 OVER C! 1+\r 20 OVER C! 1+ 40 OVER C! 1+\r 40 OVER C! 1+ 80 OVER C! 1+\r -1 OVER ! 2+ ( UNDEFINED )\r 02 OVER C! 1+ 04 OVER C! 1+\r 01 OVER C! 1+ 08 SWAP C!\r ( STABILIZE PACK: UNDEF=ALL )\r\r: PACK >R 0 ( PSH/PUL LIST )\r BEGIN OVER 5245 = WHILE\r SWAP DROP SWAP ( REG )\r DUP R = 2A ?ERROR ( SELF? )\r 0FF AND REG-BITS C@ ( BIT )\r OVER OVER AND 2B ?ERROR\r OR REPEAT ( ^ IS DUPLICATE?)\r R> DROP ;\r\r: MOVEM ( OP-CODE COMPILER )\r <BUILDS 0FD AND C, DOES> ( OP)\r C@ >R ( OP ) 5245 = OVER\r 1+ 0FE AND 4 = AND ( S OR U?)\r NOT 2C ?ERROR\r R> OVER U DROP = ( SELECT S/U)\r IF 2 OR ENDIF C,\r PACK DUP 0= 2D ?ERROR\r C, ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( BR DCOND CC-IMM IMPLY )\r ( JMR-89JAN13 )\r ASSEMBLER DEFINITIONS\r: BR ( COMPILE CONDITIONAL BR )\r 434F - 2F ?ERROR ( CONDITION?)\r [ ^asm-util ] SWAP ( ADR? )\r ?ABS NOT 21 ?ERROR\r SWAP 1 PCOFF IF ( SHORT )\r SWAP DUP 0<\r IF 0FF AND ( BSR )\r ELSE 0F AND 20 OR ENDIF\r C, C, ( BOTH BYTES )\r ELSE SWAP DUP 01000 AND\r IF SWAB 017 AND ( BSR/BRA )\r ELSE 0F AND 1020 OR\r SWAP 1- SWAP ENDIF\r OP, BIF , ENDIF ; ASSEMBLER\r ^asm-util DEFINITIONS\r: DCOND ( CONDITIONAL OPERANDS)\r 434F DCONSTANT ;\r\r: CC-IMM ( OP-CODE COMPILER )\r <BUILDS C, ( OP-CODE ) DOES>\r C@ C, ( OP-CODE )\r 494D - 2E ?ERROR ( IMMEDIATE?)\r C, ;\r\r: IMPLY ( OP-CODE COMPILER )\r <BUILDS BIF , ( OP-CODE )\r DOES> @ OP, ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( MNEMONICS )\r ( JMR-89JAN13 )\r ASSEMBLER DEFINITIONS\r ^asm-util\r 10CE 0CE 108E 8E 0CC 5 86\rBINARY LD\r 10CF 0CF 108F 8F 0CD 5 87\rBINARY ST\r 118C 1183 108C 8C 1083 5 81\rBINARY CMP\r35 MOVEM PUL 34 MOVEM PSH\r46 UNARY ROR 49 UNARY ROL\r39 IMPLY RTS 3B IMPLY RTI\r0 82 BINARY SBC 978D DCOND SR\r1F REG-REG TFR 4D UNARY TST\r83 1 80 BINARY SUB\r103F IMPLY SWI2 113F IMPLY SWI3\r3F IMPLY SWI 13 IMPLY SYNC\r0 84 BINARY AND 0 89 BINARY ADC\r48 UNARY ASL 47 UNARY ASR\r0C3 1 8B BINARY ADD\r3A IMPLY ABX 5 DCOND CS\r43 UNARY COM 4F UNARY CLR\r1600 DCOND AL 0 85 BINARY BIT\r4A UNARY DEC 19 IMPLY DAA\r2 DCOND HI 0B DCOND MI\r7 DCOND EQ 0C DCOND GE\r1E REG-REG EXG 4C UNARY INC\r0 8D BINARY JSR 4E UNARY JMP\r0 88 BINARY EOR 0E DCOND GT\r4 DCOND HS 12 IMPLY NOP\r3 DCOND LS 0A DCOND PL -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( MORE MNEMONICS )\r ( JMR-89JAN13 )\r44 UNARY LSR 48 UNARY LSL\r0D DCOND LT 6 DCOND NE\r3D IMPLY MUL 40 UNARY NEG\r0 8A BINARY OR 1A CC-IMM ORCC\r1 DCOND NV 1D IMPLY SEX\r1C CC-IMM ANDCC 3C CC-IMM CWAI\r8 DCOND VC 9 DCOND VS\r4 DCOND CCLR ( LO LE FOLLOW )\r\r ^asm-util DEFINITIONS\r1 4 1 1ARRAY EA-IX ( TRANSLATE)\r 1 EA-IX ( INITIALIZE )\r 0 OVER C! 1+ 1 OVER C! 1+\r 3 OVER C! 1+ 2 SWAP C!\r\r ASSEMBLER DEFINITIONS\r: LEA ( OP-CODE ASSEMBLER )\r 5245 - 23 ?ERROR ( REGISTER?)\r 0F BIF AND [ ^asm-util ]\r EA-IX C@ 30 BIF OR C,\r 4958 - 21 ?ERROR ( INDEX? )\r [ ^asm-util ] IX, ;\r\r0F DCOND LE 5 DCOND LO -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( [CD] & ! ^ NEXT )\r ( JMR-89JAN17 )\r ASSEMBLER DEFINITIONS BIF HEX\r: [CD] ( CFA OF DEF )\r -IFIND DROP DUP 0= 0 ?ERROR\r CFA 0 [COMPILE] DLITERAL ;\r IMMEDIATE\r\rCREATE & [CD] AND JMP SMUDGE\rCREATE ! [CD] OR JMP SMUDGE\rCREATE ^ [CD] XOR JMP SMUDGE\r\r ASSEMBLER\r: NEXT )++ Y ) JMP ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( INVERTCC LIF IF )\r ( JMR-89FEB3 )\r ^asm-util DEFINITIONS HEX\r\rCREATE INVERTCC ( CONDITIONS )\r 0. U , X LD 434F # X CMP\r HERE DUP 2+ 0 NE BR ( CC? )\r 2. U , D LD ( BSR? )\r HERE DUP 2+ 0 MI BR\r A CLR 1 # B EOR ( TOGGLE CC )\r HERE 4 + 0 NE BR ( ALWAYS? )\r AL DROP SWAB # A LD\r 2. U , D ST NEXT ( FILL BR)\r 1+ HERE OVER 1+ - SWAP C!\r 1+ HERE OVER 1+ - SWAP C!\r 2F # D LD D U PSH ( TO ERROR)\r [CD] ERROR JMP SMUDGE\r\r ASSEMBLER DEFINITIONS\r\r: LIF ( MARK AND ASM LONG BR )\r [ ^asm-util ] INVERTCC\r [ ASSEMBLER ] >R >R\r HERE 4146 ( MARK )\r [ UTILITIES ] [CD] RES-ERROR\r [ ASSEMBLER ] R> R> BR ;\r\r: IF ( MARK AND ASM SHORT BR )\r [ ^asm-util ] INVERTCC\r [ ASSEMBLER ] >R >R\r HERE 4146 ( MARK )\r OVER 2+ 0 R> R> BR ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( FILL-IN )\r ( JMR-89FEB7 )\r ^asm-util DEFINITIONS\r\rCREATE FILL-IN ( BR OFFSETS )\r UTILITIES DP@ 0 X LD DP DP@ @\r - ASSEMBLER 0 X , D LD\r 0. U , D SUB D U PSH ( OFFS)\r 2. U , X LD 0. X , D LD ( BR)\r 16 # A CMP ( ALWAYS? )\r HERE DUP 2+ 0 EQ BR\r 0FE # A AND 0F0 # B AND\r 1020 # D CMP ( LONG? )\r HERE DUP 2+ 0 EQ BR\r ( SHORT BRANCH )\r 0F0 # A AND 20 # A CMP ( BR?)\r UTILITIES [CD] RES-ERROR\r ASSEMBLER NE BR\r 0. U , D LD 7E # D ADD A TST\r UTILITIES [CD] RES-ERROR\r ASSEMBLER NE BR ( TOO FAR? )\r 80 # B SUB\r 1. X , B ST ( OFFSET )\r HERE 4. U , U LEA NEXT\r ROT 1+ HERE OVER 1+ - SWAP C!\r 0. U , D LD ( LONG BR ALWAYS)\r 3 # D SUB 1. X , D ST\r DUP 0 AL BR SWAP\r 1+ HERE OVER 1+ - SWAP C!\r 0. U , D LD ( LONG BR COND )\r 4 # D SUB 2. X , D ST\r 0 AL BR SMUDGE -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( ELSE LELSE ENDIF )\r ( JMR-89FEB6 )\r ASSEMBLER DEFINITIONS HEX\r ^asm-util\r\r: ELSE ( SHORT BRANCH, RESOLVE)\r 4146 ?PAIRS\r >R NV IF R> FILL-IN ;\r\r: LELSE ( LONG BRANCH, RESOLVE)\r 4146 ?PAIRS\r >R NV LIF R> FILL-IN ;\r\r: ENDIF 4146 ?PAIRS FILL-IN ;\r\r: BEGIN HERE 4142 ;\r\r: UNTIL ( COND BR TO BEGIN )\r >R >R 4142 ?PAIRS 0\r R> R> INVERTCC BR ;\r\r: WHILE ( COND BR PAST REPEAT )\r ROT 4142 ?PAIRS\r IF DROP 4157 ;\r\r: REPEAT ( LOOP, RESOLVE WHILE)\r 4157 ?PAIRS SWAP 0 AL BR\r FILL-IN ;\r\r: LWHILE ( LONG WHILE )\r ROT 4142 ?PAIRS\r LIF DROP 4157 ; -->\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( :ASM ;ASM )\r ( JMR-89MAR28 )\r ASSEMBLER DEFINITIONS HEX\r\r: :ASM CREATE !CSP ;\r\r: ;ASM ?CSP SMUDGE ;\r\r: I-CODE ( SHIFT TO HI-LEVEL )\r [ ' :ASM CFA @ ] LITERAL\r [ BIF ] , ( ASMBL JMP <XCOL )\r DROOT @ ROOT ! ] ; ( COMPILE)\r ASSEMBLER\r\r\r\r: MACHINE ( SHIFT TO LO-LEVEL )\r COMPILE (MACHINE) ( IN DEF )\r [COMPILE] [ ( NOW INTERPRET )\r [COMPILE] ASSEMBLER ;\r IMMEDIATE ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r( D! D@ )\r ( JMR-89FEB16 )\r BIF DEFINITIONS ASSEMBLER\r\r:ASM D! ( STORE DBL ) X U PUL\r D U PUL 0. X , D ST\r D U PUL 2. X , D ST\r NEXT ;ASM\r\r:ASM D@ ( FETCH DBL ) X U PUL\r 0. X , D LD 2. X , X LD\r D X U PSH NEXT ;ASM\r\r:ASM DOVER ( DOUBLE OVER DOUBLE)\r 4. U , D LD 6. U , X LD\r D X U PSH NEXT ;ASM\r\r:ASM DSWAP ( SWAP DOUBLES )\r 4. U , D LD 0. U , X LD\r 4. U , X ST 0. U , D ST\r 6. U , D LD 2. U , X LD\r 6. U , X ST 2. U , D ST\r NEXT ;ASM\r ;S\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r
\ No newline at end of file
--- /dev/null
+ 0: 0) Index to BIF HI-LEVEL disk
+ 1: 2) Title page, Copr. notice
+ 2: 3) MONITOR CALL TO DEBUG
+ 3: 4) ERROR MESSAGES
+ 4: 6) HIGH LEVEL TOOLS & UTILITIES
+ 5: 7) LIST, INDEX, TRIAD
+ 6: 8) HIGH LEVEL DISK & SCREEN
+ 7: 11) FORWARD REFERENCING
+ 8: 12) PERIPHERAL UTILITIES
+ 9: 13) SLIST
+10: 15) DUMP DEFINITION BY NAME
+11: 16) ASSEMBLER
+12: 32) DOUBLES IN ASSEMBLER
+13:
+14: 40) HLL COMPILER
+15: 64) PAIR ASSOCIATION EXAMPLE
+16: 66) A TRY AT DIVIDE BY CONSTANT
+17:
+18: 100) SARDIS DMC STUFF
+19:
+20: 144) HOOCH COMPILER REMAINS
+\f 0:
+\f 0: BIF
+ 1: EDITOR, UTILITIES,
+ 2: ASSEMBLER, AND EXAMPLES
+ 3: VERSION 1.0
+ 4:
+ 5:
+ 6: COPYRIGHT 1989
+ 7: JOEL MATTHEW REES
+ 8:
+ 9: THESE ALGORITHMS ARE
+10: EXPRESSED IN THREE LANGUAGES:
+11: BIF, BIF ASSEMBLER FOR THE
+12: MOTOROLA M6809 MICROPROCESSOR,
+13: AND HEXADECIMAL MACHINE CODE FOR
+14: THE M6809.
+15:
+16: THE TEXT IS ORGANIZED FOR
+17: EDITING ON A 32-COLUMN TERMINAL,
+18: SUCH AS IS FOUND ON A RADIO
+19: SHACK COLOR COMPUTER 2.
+20:
+21: THESE ALGORITHMS AND THEIR
+22: TEXT ARE INTENDED FOR NO PURPOSE
+23: OTHER THAN EXPERIMENTATION, AND
+24: NO CLAIMS OR WARRANTIES ARE MADE
+25: CONCERNING THEIR USEFULNESS IN
+26: ANY PARTICULAR APPLICATION.
+27:
+28: PUBLISHED 1989
+29: JOEL MATTHEW REES
+30: SOUTH SALT LAKE CITY, UTAH
+\f 0: ( CALL TO MONITOR, IF SWI IS BRE
+ 1: AKPOINT JMR-88OCT?? )
+ 2:
+ 3: CREATE MON HEX 3F C, 6EB1 ,
+ 4: SMUDGE HERE 1- FENCE ! ;S
+\f 0: ( ERROR MESSAGES )
+ 1: DATA STACK UNDERFLOW
+ 2: DICTIONARY FULL
+ 3: ADDRESS RESOLUTION ERROR
+ 4: HIDES DEFINITION IN
+ 5: NULL VECTOR WRITTEN
+ 6: DISC RANGE?
+ 7: DATA STACK OVERFLOW
+ 8: DISC ERROR!
+ 9: CAN'T EXECUTE A NULL!
+10: CONTROL STACK UNDERFLOW
+11: CONTROL STACK OVERFLOW
+12: ARRAY REFERENCE OUT OF BOUNDS
+13: ARRAY DIMENSION NOT VALID
+14: NO PROCEDURE TO ENTER
+15: ( WAS REGISTER )
+16:
+17: COMPILATION ONLY, USE IN DEF
+18: EXECUTION ONLY
+19: CONDITIONALS NOT PAIRED
+20: DEFINITION INCOMPLETE
+21: IN PROTECTED DICTIONARY
+22: USE ONLY WHEN LOADING
+23: OFF CURRENT EDITING SCREEN
+24: DECLARE VOCABULARY
+25: DEFINITION NOT IN VOCABULARY
+26: IN FORWARD BLOCK
+27: ALLOCATION LIST CORRUPTED: LOST
+28: CAN'T REDEFINE nul!
+29: NOT FORWARD REFERENCE
+30: ( WAS IMMEDIATE )
+\f 0: ( MORE ERROR MESSAGES )
+ 1: HAS INCORRECT ADDRESS MODE
+ 2: HAS INCORRECT INDEX MODE
+ 3: OPERAND NOT REGISTER
+ 4: HAS ILLEGAL IMMEDIATE
+ 5: PC OFFSET MUST BE ABSOLUTE
+ 6: ACCUMULATOR OFFSET REQUIRED
+ 7: ILLEGAL MEMORY INDIRECTION
+ 8: ILLEGAL INDEX BASE
+ 9: ILLEGAL TARGET SPECIFIED
+10: CAN'T STACK ON SELF
+11: DUPLICATE IN LIST
+12: REGISTER NOT STACK
+13: EMPTY REGISTER LIST
+14: IMMEDIATE OPERAND REQUIRED
+15: REQUIRES CONDITION
+16:
+17: COMPILE-TIME STACK UNDERFLOW
+18: COMPILE-TIME STACK OVERFLOW
+\f 0: ( UTILITIES DUMP QLIST QINDEX )
+ 1: ( L/SCR ULIST JMR-88NOV16)
+ 2: BIF DEFINITIONS HEX
+ 3: ( UTILITIES IS NOW IN KERNEL )
+ 4: UTILITIES DEFINITIONS
+ 5: : BYTE-DUMP -DUP IF
+ 6: 0 DO DUP I + C@ 4 .R LOOP
+ 7: ENDIF DROP ; ( BASE > 6)
+ 8: BIF DEFINITIONS
+ 9: : DUMP -DUP IF OVER + SWAP
+10: DO I 0 6 D.R I 4
+11: [ UTILITIES ] BYTE-DUMP
+12: [ BIF ] 3A EMIT I 4 TYPE
+13: CR ?TERMINAL 0< IF
+14: KEY 0< IF LEAVE ENDIF
+15: ENDIF 4 +LOOP ENDIF ;
+16: : QLIST BLOCK [ EDITOR ] QDUMP
+17: [ BIF ] 500 88 ! ( CENTER ) ;
+18: : QINDEX 1+ SWAP DO I QLIST
+19: ." SCREEN=" I 4 /MOD .
+20: 3A EMIT . ." BLOCK=" I .
+21: KEY 0< IF LEAVE ENDIF
+22: LOOP ;
+23: UTILITIES DEFINITIONS
+24: : L/SCR B/BUF B/SCR C/L */ ;
+25: : ULIST ( SCREEN N, FLAG BRK )
+26: DUP SCR ! ." SCR # " . 0 ( F )
+27: L/SCR 0 DO CR I 3 .R SPACE
+28: I SCR @ .LINE
+29: ?TERMINAL 0< IF ( BREAK? )
+30: KEY 0< IF 1- LEAVE ENDIF
+31: ENDIF LOOP CR ; -->
+\f 0: ( LIST INDEX TRIAD )
+ 1: ( JMR-88NOV16 )
+ 2: BIF DEFINITIONS
+ 3: : LIST ( WIDE OUTPUT ) DECIMAL
+ 4: CR UTILITIES ULIST BIF DROP ;
+ 5:
+ 6: : INDEX ( PRINT COMMENT LINES )
+ 7: 0C EMIT ( FORM FEED ) CR
+ 8: 1+ SWAP DO
+ 9: CR I 3 .R SPACE
+10: 0 I .LINE
+11: C/L 49 < IF 1 I .LINE ENDIF
+12: ?TERMINAL 0< IF
+13: KEY 0< IF LEAVE ENDIF
+14: ENDIF
+15: LOOP ;
+16:
+17: : TRIAD ( LIST MULTIPLE ) >PRT
+18: 0C EMIT ( FORM FEED )
+19: [ DECIMAL ] UTILITIES L/SCR
+20: BIF 22 > IF 2 ELSE 3 ENDIF
+21: >R R / R * DUP R> + SWAP
+22: DO I UTILITIES ULIST BIF
+23: 0< IF LEAVE ENDIF
+24: UTILITIES L/SCR BIF DUP
+25: 32 = SWAP 22 = OR NOT IF
+26: CR CR ENDIF
+27: LOOP >VID ; HEX
+28:
+29:
+30:
+31: -->
+\f 0: ( HOME CLS QSAVE SAVE-BUFFERS
+ 1: QCAN ) ( JMR-88DEC10 )
+ 2: UTILITIES DEFINITIONS HEX
+ 3: : HOME 400 88 ! ;
+ 4: : MID 500 88 ! ;
+ 5: BIF DEFINITIONS
+ 6: : CLS 400 200 60 FILL
+ 7: UTILITIES HOME BIF ;
+ 8: UTILITIES DEFINITIONS
+ 9: : CAN-UP ( CANCEL UPDATE IN BUF)
+10: DUP @ 7FFF AND OVER ! ;
+11:
+12: : W-BUF ( WRITE BUF AT ADR )
+13: DUP 2+ OVER @ 7FFF AND 0 R/W
+14: CAN-UP ;
+15:
+16: : SAVE-BUF ( IF UPDATED )
+17: DUP @ 0< IF W-BUF ENDIF ;
+18:
+19: BIF DEFINITIONS
+20: : QSAVE PREV @ ( SAVE PREVIOUS )
+21: UTILITIES SAVE-BUF BIF DROP ;
+22:
+23:
+24: : SAVE-BUFFERS PREV @
+25: BEGIN UTILITIES SAVE-BUF BIF
+26: +BUF NOT UNTIL DROP ;
+27:
+28: : QCAN PREV @ ( CAN UP OF PREV )
+29: UTILITIES CAN-UP BIF DROP ;
+30: -->
+\f 0: ( CANCEL-UPDATES RE-QUICK .PREV
+ 1: .BUFFERS QPREV JMR-88DEC10 )
+ 2: : CANCEL-UPDATES PREV @
+ 3: BEGIN UTILITIES CAN-UP BIF
+ 4: +BUF NOT UNTIL DROP ;
+ 5:
+ 6: : RE-QUICK ( QUICK OLD PREVIOUS)
+ 7: PREV @ DUP @ 7FFF AND 0 ROT !
+ 8: [ EDITOR ] QUICK BIF ;
+ 9:
+10: UTILITIES DEFINITIONS
+11: : .BUF ( QLIST BUFFER, . BLOCK )
+12: DUP @ DUP 7FFF AND DUP QLIST
+13: MID ." BLOCK=" .
+14: 0< IF ." UPDATED" ENDIF CR ;
+15:
+16: BIF DEFINITIONS
+17: : .BUFFERS PREV @ ( .BUF, PAUSE)
+18: BEGIN UTILITIES .BUF BIF
+19: +BUF DROP KEY 0< ( BREAK? )
+20: UNTIL DROP ;
+21:
+22: : .PREV PREV @ UTILITIES .BUF
+23: BIF DROP ;
+24:
+25: : EDIT DUP UTILITIES MID BIF
+26: ." BLOCK=" . CR [ EDITOR ]
+27: QUICK BIF PREV @ @
+28: 0< IF ." UPDATED" ENDIF ;
+29:
+30: : QPREV PREV @ @ 7FFF AND
+31: EDIT ; -->
+\f 0: ( QOPY COPY QBACK BACK-UP )
+ 1: ( JMR-88DEC11 )
+ 2: : QOPY SWAP BLOCK SWAP BLOCK
+ 3: B/BUF 2/ MOVE UPDATE ;
+ 4:
+ 5: : COPY 2* 2* ( SCREEN )
+ 6: SWAP 2* 2* DUP 4 + SWAP
+ 7: DO I OVER QOPY 1+ LOOP DROP ;
+ 8: : QBACK 1+ SWAP DO I QLIST
+ 9: I BLOCK DUP [ EDITOR ] QDUMP
+10: ." BLOCK " I . ." TO "
+11: 0 DRIVE-OFFSET @ I + DUP .
+12: KEY 59 = IF 0 R/W ( YES? )
+13: ELSE DROP DROP
+14: ENDIF LOOP ;
+15:
+16: : EEDIT ( ERASE AND EDIT BLOCK )
+17: DUP BLOCK 2- UTILITIES .BUF 2+
+18: MID BIF ." BLOCK=" OVER .
+19: ." CLEAR?" CR
+20: KEY 59 = IF ( YES? )
+21: B/BUF BLANKS UPDATE
+22: ELSE DROP ( DON'T CLEAR )
+23: ENDIF EDIT ; -->
+\f 0: ( RES-ERROR FORWARD :RESOLVE
+ 1: :RESOLVE ;RES JMR-16MAY89 )
+ 2: UTILITIES DEFINITIONS HEX
+ 3: : RES-ERROR ( ADR RESOLUTION )
+ 4: 3 ERROR ;
+ 5:
+ 6: BIF DEFINITIONS UTILITIES
+ 7: : FORWARD ( REFERENCE HEADER )
+ 8: CREATE 7E C, ( JMP EXTENDED )
+ 9: IP, [ ' RES-ERROR CFA , ]
+10: ( INIT TO RES-ERROR ) SMUDGE
+11: FOREWARD @ 0= IF ( EARLIEST? )
+12: LATEST FOREWARD ! ENDIF ;
+13: ASSEMBLER DEFINITIONS
+14: UTILITIES
+15: : :RESOLVE ( :ASM FORWARD REFS )
+16: ?EXEC !CSP [COMPILE] ' DUP
+17: CFA DUP 1+ SWAP C@ 7E - ( JMP)
+18: OVER @ ' RES-ERROR CFA -
+19: OR 1D ?ERROR ( HEADER? )
+20: HERE SWAP ! ( LINK IT )
+21: FOREWARD @ = IF ( END FORWD? )
+22: 0 FOREWARD ! ENDIF ;
+23: IMMEDIATE
+24:
+25: BIF DEFINITIONS ASSEMBLER
+26: : :RES ( RESOLVE : FORWARDS )
+27: [COMPILE] :RESOLVE [ BIF ]
+28: ( ASSEMBLE JMP <XCOL, COMPILE)
+29: IP, [ LATEST CFA @ , ] ] ;
+30: : ;RES [COMPILE] ; SMUDGE ;
+31: IMMEDIATE
+\f 0: ( PL PTEST )
+ 1: ( JMR-89AUG25 )
+ 2: BIF DEFINITIONS DECIMAL
+ 3: : PL 79 0 DO I 33 + EMIT LOOP ;
+ 4:
+ 5: : PT ( PL UNTIL KEY PRESS )
+ 6: BEGIN PL ?TERMINAL UNTIL ;
+ 7:
+ 8: : PTEST >PRT PT >VID ;
+ 9: ;S
+\f 0: ( SLIST )
+ 1: ( JMR-16OCT90 )
+ 2: ROOT @ UTILITIES
+ 3:
+ 4: : SLIST ( LIST SCREENS TO PRT )
+ 5: >PRT 1+ SWAP DO
+ 6: I ULIST 0< IF LEAVE ENDIF
+ 7: LOOP >VID ;
+ 8: ROOT ! ;S
+\f 0: ( DISK ACCESS WORDS JMR-900228)
+ 1:
+ 2: HEX
+ 3: : CM! FF48 C! ; : ST@ FF48 C@ ;
+ 4: : TR! FF49 C! ; : TR@ FF49 C@ ;
+ 5: : SE! FF4A C! ; : SE@ FF4A C@ ;
+ 6: : DA! FF4B C! ; : DA@ FF4B C@ ;
+ 7: : DR FF40 ! ;
+ 8: : DWAIT BEGIN ST@ DUP 1 AND
+ 9: WHILE DROP REPEAT ;
+10: : 1I DR 40 CM! DWAIT 0 DR . ;
+11: : 1O DR 60 CM! DWAIT 0 DR . ;
+12: : IN 0 DO DUP 1I LOOP DROP ;
+13: : OUT 0 DO DUP 1O LOOP DROP ;
+14: : ?ADR 0 FF42 C! 0 FF46 C!
+15: 28 OR DR ( MOTOR ON, DBL DNS)
+16: C4 FF4C C! DWAIT . FF44 @ DROP
+17: 0 FF42 C! 0 FF46 C!
+18: FF4E ? FF4E ? FF4E ? ; ;S
+\f 0: ( NAMES )
+ 1: ( JMR-89MAY16 )
+ 2: BIF DEFINITIONS HEX
+ 3: : NAME ( CFA TO NAME )
+ 4: 2+ NFA ID. ;
+ 5:
+ 6:
+ 7:
+ 8: : NAMES ( DUMP BY NAME )
+ 9: -DUP IF 2* OVER + SWAP ( 0? )
+10: DO I 0 6 D.R ( ADR )
+11: I @ DUP 0 5 D.R ( NUMERIC)
+12: 3A EMIT NAME CR
+13: ?TERMINAL 0< IF
+14: KEY 0< IF LEAVE ENDIF
+15: ENDIF 2 +LOOP ENDIF ; ;S
+\f 0: ( ^asm-util DREG REGISTERS #
+ 1: DPREG DPR SETDP JMR-88DEC19 )
+ 2: ASSEMBLER DEFINITIONS HEX
+ 3: VOCABULARY ^asm-util ( HIDDEN )
+ 4: ^asm-util DEFINITIONS
+ 5: : DREG ( REGISTER OPERANDS )
+ 6: 0FF0F AND 5245 DCONSTANT ;
+ 7: ASSEMBLER DEFINITIONS
+ 8: ^asm-util ( INDEX IN HI BYTE )
+ 9: 8B00 DREG D 8608 DREG A
+10: 8509 DREG B 8C05 DREG PC
+11: 4003 DREG U 6004 DREG S
+12: 2002 DREG Y 0001 DREG X
+13: EF0A DREG CC EF0B DREG DP
+14: ( ALL OPERANDS ARE DBL INTS )
+15:
+16: ( ABSOLUTE IS 0 OR -1 HI WORD )
+17: ( DIRECT IS ABSOLUTE IN DPAGE )
+18: 494D CONSTANT # ( HI WORD )
+19:
+20: ^asm-util DEFINITIONS
+21: ( ASSEMBLY TIME DIRECT PAGE )
+22: 42 USER DPREG ( EMULATOR )
+23: ( INIT DPREG ) UTILITIES DP@
+24: ASSEMBLER ^asm-util DPREG !
+25:
+26: ASSEMBLER DEFINITIONS
+27: ( ACCESS DPREG )
+28: : DPR [ ^asm-util ] DPREG
+29: BIF @ ;
+30: : SETDP 0FF00 AND [ ^asm-util ]
+31: DPREG BIF ! ; -->
+\f 0: ( OFF, ABS, V, PCOFF PCR, )
+ 1: ( JMR-89JAN2 )
+ 2: ^asm-util DEFINITIONS
+ 3: : OFF, ( SET IX b0, COMPILE 2 )
+ 4: OVER DUP 80 < SWAP -81 > AND
+ 5: IF C, C, ( SHORT )
+ 6: ELSE 1 OR C, , ( LONG )
+ 7: ENDIF ;
+ 8:
+ 9: : OP, ( COMPILE BYTE OR WORD )
+10: DUP 0FF00 AND
+11: IF , ELSE C, ENDIF ;
+12:
+13: : ABS, >R ( COMPILE ABS ADR OP )
+14: OVER 0FF00 AND DPR =
+15: IF R> DROP OP, C, ( DIR PAGE)
+16: ELSE R> OR OP, , ( EXT )
+17: ENDIF ;
+18:
+19: : PCOFF ( ABSOLUTE TO PC REL )
+20: HERE + 1+ - ( CALC OFFSET )
+21: DUP 7F > OVER -80 < OR
+22: IF 1- 0 ( WORD OFF )
+23: ELSE -1 ( BYTE OFF ) ENDIF ;
+24:
+25: : ?ABS ( TRUE IF ABSOLUTE )
+26: DUP NOT 0= = ; ( USE T/F VAL)
+27:
+28: : PCR, ( COMPILE A PC REL INDEX)
+29: >R ?ABS NOT 25 ?ERROR
+30: 1 PCOFF IF R> C, C, ( BYTE )
+31: ELSE R> 1 OR C, , ENDIF ; -->
+\f 0: ( AUTO MASK, REG, IXOFF, EI, )
+ 1: ( JMR-89JAN2 )
+ 2: ASSEMBLER DEFINITIONS
+ 3: 4155.0082 DCONSTANT -) ( AUTO )
+ 4: 4155.0081 DCONSTANT )++ ( REG )
+ 5: 4155.0080 DCONSTANT )+ ( MODE )
+ 6: 4155.0083 DCONSTANT --) ( CONS)
+ 7: ^asm-util DEFINITIONS
+ 8:
+ 9: : MASK, OR C, ; ( FOR POSTBYTE)
+10:
+11: : REG, ( REG OFF TO POST-BYTE )
+12: SWAP DUP D DROP =
+13: OVER A DROP = OR OVER
+14: B DROP = OR NOT 26 ?ERROR
+15: SWAB OR C, ;
+16: ( REG, USES DUAL CODED REGS )
+17:
+18: : IXOFF, ( REGISTER + CONSTANT )
+19: OVER IF OVER ( NON-ZERO? )
+20: DUP 0F > SWAP -10 < OR
+21: OVER 10 AND OR ( []? )
+22: IF 88 OR OFF, ( EXTERNAL )
+23: ELSE ( OFFSET IN POST-BYTE)
+24: SWAP 1F AND OR C,
+25: ENDIF
+26: ELSE 84 OR C, DROP ( 0 OFF )
+27: ENDIF ;
+28:
+29: : EI, ( EXTENDED INDIRECT )
+30: SWAP ?ABS NOT 27 ?ERROR
+31: C, , ; -->
+\f 0: ( IX, , INDIRECT )
+ 1: ( JMR-89JAN4 )
+ 2: : IX, ( COMPILE AN INDEX MODE )
+ 3: DUP 9F = IF EI,
+ 4: ELSE DUP 8F AND 8C = IF PCR,
+ 5: ELSE SWAP DUP 4155 =
+ 6: IF DROP MASK, ( AUTO )
+ 7: ELSE DUP 5245 =
+ 8: IF DROP REG,
+ 9: ELSE ?ABS NOT 22 ?ERROR
+10: IXOFF, ENDIF
+11: ENDIF ENDIF ENDIF ;
+12:
+13: ASSEMBLER DEFINITIONS
+14: : , ( CONVERT TO INDEX )
+15: 5245 = ( REGISTER? )
+16: OVER 00FF AND DUP 0 > SWAP
+17: 6 < AND ( X Y U S PC ? )
+18: AND NOT 28 ?ERROR
+19: SWAB 4958 ;
+20:
+21: : ) ( CONVERT TO INDIRECT )
+22: DUP 5245 = ( REGISTER? )
+23: IF ( ASSEMBLER ) ,
+24: ELSE DUP [ ^asm-util ] ?ABS
+25: [ ASSEMBLER ] IF 4958.009F
+26: ELSE ( INDEX? )
+27: DUP 4958 = NOT 27 ?ERROR
+28: ENDIF ENDIF ( SET BIT 4 )
+29: SWAP 10 OR SWAP ; -->
+\f 0: ( ACCM UNARY REG )
+ 1: ( JMR-89JAN5 )
+ 2: ^asm-util DEFINITIONS HEX
+ 3: : ACCM ( ENCODE ACCUMULATOR )
+ 4: SWAP DUP 0FE AND ( A OR B? )
+ 5: 8 = NOT 29 ?ERROR
+ 6: 1 AND ( MASK B IN? )
+ 7: IF OR ELSE DROP ENDIF ;
+ 8:
+ 9: : UNARY ( OP-CODE COMPILER )
+10: <BUILDS 0F AND C, ( OP-CODE )
+11: DOES> C@ ( OP-CODE )
+12: OVER 5245 = ( REGISTER? )
+13: IF DUP 0E = 29 ?ERROR ( JMP?)
+14: 40 OR ROT 10 ACCM C, DROP
+15: ELSE OVER 4958 = ( INDEX? )
+16: IF 60 OR C, DROP IX,
+17: ELSE SWAP ?ABS NOT 21 ?ERROR
+18: 70 ( EXT BITS ) ABS,
+19: ENDIF ENDIF ;
+20:
+21: : REG ( ENCODE TARGET REG )
+22: DUP C@ 8D = IF C@ 1 ( JSR )
+23: ELSE SWAP 5245 - 29 ?ERROR
+24: OVER DUP A DROP =
+25: SWAP B DROP = OR
+26: IF C@ SWAP 40 ACCM 0 ( BYTE)
+27: ELSE SWAP 00FF AND ( REG? )
+28: OVER 1+ C@ ( CT? ) OVER
+29: > NOT 29 ?ERROR ( RANGE )
+30: 2* + 2+ @ -1 ( WORD REG )
+31: ENDIF ENDIF ; -->
+\f 0: ( #, BINARY REG-REG )
+ 1: ( JMR-89JAN12 )
+ 2: : #, ( COMPILE AN IMMEDIATE )
+ 3: SWAP DUP 0F AND 5 - ( BIT OK)
+ 4: OVER 5 AND 5 = ( ST OR JSR? )
+ 5: AND 24 ?ERROR OP,
+ 6: IF BIF , [ ^asm-util ] ( WORD)
+ 7: ELSE C, ENDIF ; ( BYTE )
+ 8:
+ 9: : BINARY ( OP-CODE COMPILER )
+10: <BUILDS 8F AND C, ( A/B OP )
+11: 05 AND DUP C, -DUP IF ( OP CT)
+12: 0 DO 11CF AND BIF , ( DXYUS)
+13: [ ^asm-util ] LOOP ENDIF
+14: DOES> REG ROT ( SOURCE )
+15: DUP 4958 = IF ( INDEX ? )
+16: DROP DROP 20 OR OP, IX,
+17: ELSE DUP 494D = ( IMMEDIATE? )
+18: IF DROP #,
+19: ELSE ?ABS NOT 21 ?ERROR
+20: DROP 10 OR 20 ABS,
+21: ENDIF ENDIF ;
+22:
+23:
+24: : REG-REG ( OP-CODE COMPILER )
+25: <BUILDS C, ( OP-CODE ) DOES>
+26: C@ C, ( OP-CODE )
+27: 5245 = ROT 5245 = AND
+28: NOT 23 ?ERROR ( 2 REGS? )
+29: 0F AND SWAP SWAN 0F0 AND
+30: OR C, ; -->
+\f 0: ( REG-BITS PACK MOVEM )
+ 1: ( JMR-89JAN12 )
+ 2: 0 0B 1 1ARRAY REG-BITS ( PACK )
+ 3: 0 REG-BITS ( INITIALIZE )
+ 4: 06 OVER C! 1+ 10 OVER C! 1+
+ 5: 20 OVER C! 1+ 40 OVER C! 1+
+ 6: 40 OVER C! 1+ 80 OVER C! 1+
+ 7: -1 OVER ! 2+ ( UNDEFINED )
+ 8: 02 OVER C! 1+ 04 OVER C! 1+
+ 9: 01 OVER C! 1+ 08 SWAP C!
+10: ( STABILIZE PACK: UNDEF=ALL )
+11:
+12: : PACK >R 0 ( PSH/PUL LIST )
+13: BEGIN OVER 5245 = WHILE
+14: SWAP DROP SWAP ( REG )
+15: DUP R = 2A ?ERROR ( SELF? )
+16: 0FF AND REG-BITS C@ ( BIT )
+17: OVER OVER AND 2B ?ERROR
+18: OR REPEAT ( ^ IS DUPLICATE?)
+19: R> DROP ;
+20:
+21: : MOVEM ( OP-CODE COMPILER )
+22: <BUILDS 0FD AND C, DOES> ( OP)
+23: C@ >R ( OP ) 5245 = OVER
+24: 1+ 0FE AND 4 = AND ( S OR U?)
+25: NOT 2C ?ERROR
+26: R> OVER U DROP = ( SELECT S/U)
+27: IF 2 OR ENDIF C,
+28: PACK DUP 0= 2D ?ERROR
+29: C, ; -->
+\f 0: ( BR DCOND CC-IMM IMPLY )
+ 1: ( JMR-89JAN13 )
+ 2: ASSEMBLER DEFINITIONS
+ 3: : BR ( COMPILE CONDITIONAL BR )
+ 4: 434F - 2F ?ERROR ( CONDITION?)
+ 5: [ ^asm-util ] SWAP ( ADR? )
+ 6: ?ABS NOT 21 ?ERROR
+ 7: SWAP 1 PCOFF IF ( SHORT )
+ 8: SWAP DUP 0<
+ 9: IF 0FF AND ( BSR )
+10: ELSE 0F AND 20 OR ENDIF
+11: C, C, ( BOTH BYTES )
+12: ELSE SWAP DUP 01000 AND
+13: IF SWAB 017 AND ( BSR/BRA )
+14: ELSE 0F AND 1020 OR
+15: SWAP 1- SWAP ENDIF
+16: OP, BIF , ENDIF ; ASSEMBLER
+17: ^asm-util DEFINITIONS
+18: : DCOND ( CONDITIONAL OPERANDS)
+19: 434F DCONSTANT ;
+20:
+21: : CC-IMM ( OP-CODE COMPILER )
+22: <BUILDS C, ( OP-CODE ) DOES>
+23: C@ C, ( OP-CODE )
+24: 494D - 2E ?ERROR ( IMMEDIATE?)
+25: C, ;
+26:
+27: : IMPLY ( OP-CODE COMPILER )
+28: <BUILDS BIF , ( OP-CODE )
+29: DOES> @ OP, ; -->
+\f 0: ( MNEMONICS )
+ 1: ( JMR-89JAN13 )
+ 2: ASSEMBLER DEFINITIONS
+ 3: ^asm-util
+ 4: 10CE 0CE 108E 8E 0CC 5 86
+ 5: BINARY LD
+ 6: 10CF 0CF 108F 8F 0CD 5 87
+ 7: BINARY ST
+ 8: 118C 1183 108C 8C 1083 5 81
+ 9: BINARY CMP
+10: 35 MOVEM PUL 34 MOVEM PSH
+11: 46 UNARY ROR 49 UNARY ROL
+12: 39 IMPLY RTS 3B IMPLY RTI
+13: 0 82 BINARY SBC 978D DCOND SR
+14: 1F REG-REG TFR 4D UNARY TST
+15: 83 1 80 BINARY SUB
+16: 103F IMPLY SWI2 113F IMPLY SWI3
+17: 3F IMPLY SWI 13 IMPLY SYNC
+18: 0 84 BINARY AND 0 89 BINARY ADC
+19: 48 UNARY ASL 47 UNARY ASR
+20: 0C3 1 8B BINARY ADD
+21: 3A IMPLY ABX 5 DCOND CS
+22: 43 UNARY COM 4F UNARY CLR
+23: 1600 DCOND AL 0 85 BINARY BIT
+24: 4A UNARY DEC 19 IMPLY DAA
+25: 2 DCOND HI 0B DCOND MI
+26: 7 DCOND EQ 0C DCOND GE
+27: 1E REG-REG EXG 4C UNARY INC
+28: 0 8D BINARY JSR 4E UNARY JMP
+29: 0 88 BINARY EOR 0E DCOND GT
+30: 4 DCOND HS 12 IMPLY NOP
+31: 3 DCOND LS 0A DCOND PL -->
+\f 0: ( MORE MNEMONICS )
+ 1: ( JMR-89JAN13 )
+ 2: 44 UNARY LSR 48 UNARY LSL
+ 3: 0D DCOND LT 6 DCOND NE
+ 4: 3D IMPLY MUL 40 UNARY NEG
+ 5: 0 8A BINARY OR 1A CC-IMM ORCC
+ 6: 1 DCOND NV 1D IMPLY SEX
+ 7: 1C CC-IMM ANDCC 3C CC-IMM CWAI
+ 8: 8 DCOND VC 9 DCOND VS
+ 9: 4 DCOND CCLR ( LO LE FOLLOW )
+10:
+11: ^asm-util DEFINITIONS
+12: 1 4 1 1ARRAY EA-IX ( TRANSLATE)
+13: 1 EA-IX ( INITIALIZE )
+14: 0 OVER C! 1+ 1 OVER C! 1+
+15: 3 OVER C! 1+ 2 SWAP C!
+16:
+17: ASSEMBLER DEFINITIONS
+18: : LEA ( OP-CODE ASSEMBLER )
+19: 5245 - 23 ?ERROR ( REGISTER?)
+20: 0F BIF AND [ ^asm-util ]
+21: EA-IX C@ 30 BIF OR C,
+22: 4958 - 21 ?ERROR ( INDEX? )
+23: [ ^asm-util ] IX, ;
+24:
+25: 0F DCOND LE 5 DCOND LO -->
+\f 0: ( [CD] & ! ^ NEXT )
+ 1: ( JMR-89JAN17 )
+ 2: ASSEMBLER DEFINITIONS BIF HEX
+ 3: : [CD] ( CFA OF DEF )
+ 4: -IFIND DROP DUP 0= 0 ?ERROR
+ 5: CFA 0 [COMPILE] DLITERAL ;
+ 6: IMMEDIATE
+ 7:
+ 8: CREATE & [CD] AND JMP SMUDGE
+ 9: CREATE ! [CD] OR JMP SMUDGE
+10: CREATE ^ [CD] XOR JMP SMUDGE
+11:
+12: ASSEMBLER
+13: : NEXT )++ Y ) JMP ; -->
+\f 0: ( INVERTCC LIF IF )
+ 1: ( JMR-89FEB3 )
+ 2: ^asm-util DEFINITIONS HEX
+ 3:
+ 4: CREATE INVERTCC ( CONDITIONS )
+ 5: 0. U , X LD 434F # X CMP
+ 6: HERE DUP 2+ 0 NE BR ( CC? )
+ 7: 2. U , D LD ( BSR? )
+ 8: HERE DUP 2+ 0 MI BR
+ 9: A CLR 1 # B EOR ( TOGGLE CC )
+10: HERE 4 + 0 NE BR ( ALWAYS? )
+11: AL DROP SWAB # A LD
+12: 2. U , D ST NEXT ( FILL BR)
+13: 1+ HERE OVER 1+ - SWAP C!
+14: 1+ HERE OVER 1+ - SWAP C!
+15: 2F # D LD D U PSH ( TO ERROR)
+16: [CD] ERROR JMP SMUDGE
+17:
+18: ASSEMBLER DEFINITIONS
+19:
+20: : LIF ( MARK AND ASM LONG BR )
+21: [ ^asm-util ] INVERTCC
+22: [ ASSEMBLER ] >R >R
+23: HERE 4146 ( MARK )
+24: [ UTILITIES ] [CD] RES-ERROR
+25: [ ASSEMBLER ] R> R> BR ;
+26:
+27: : IF ( MARK AND ASM SHORT BR )
+28: [ ^asm-util ] INVERTCC
+29: [ ASSEMBLER ] >R >R
+30: HERE 4146 ( MARK )
+31: OVER 2+ 0 R> R> BR ; -->
+\f 0: ( FILL-IN )
+ 1: ( JMR-89FEB7 )
+ 2: ^asm-util DEFINITIONS
+ 3:
+ 4: CREATE FILL-IN ( BR OFFSETS )
+ 5: UTILITIES DP@ 0 X LD DP DP@ @
+ 6: - ASSEMBLER 0 X , D LD
+ 7: 0. U , D SUB D U PSH ( OFFS)
+ 8: 2. U , X LD 0. X , D LD ( BR)
+ 9: 16 # A CMP ( ALWAYS? )
+10: HERE DUP 2+ 0 EQ BR
+11: 0FE # A AND 0F0 # B AND
+12: 1020 # D CMP ( LONG? )
+13: HERE DUP 2+ 0 EQ BR
+14: ( SHORT BRANCH )
+15: 0F0 # A AND 20 # A CMP ( BR?)
+16: UTILITIES [CD] RES-ERROR
+17: ASSEMBLER NE BR
+18: 0. U , D LD 7E # D ADD A TST
+19: UTILITIES [CD] RES-ERROR
+20: ASSEMBLER NE BR ( TOO FAR? )
+21: 80 # B SUB
+22: 1. X , B ST ( OFFSET )
+23: HERE 4. U , U LEA NEXT
+24: ROT 1+ HERE OVER 1+ - SWAP C!
+25: 0. U , D LD ( LONG BR ALWAYS)
+26: 3 # D SUB 1. X , D ST
+27: DUP 0 AL BR SWAP
+28: 1+ HERE OVER 1+ - SWAP C!
+29: 0. U , D LD ( LONG BR COND )
+30: 4 # D SUB 2. X , D ST
+31: 0 AL BR SMUDGE -->
+\f 0: ( ELSE LELSE ENDIF )
+ 1: ( JMR-89FEB6 )
+ 2: ASSEMBLER DEFINITIONS HEX
+ 3: ^asm-util
+ 4:
+ 5: : ELSE ( SHORT BRANCH, RESOLVE)
+ 6: 4146 ?PAIRS
+ 7: >R NV IF R> FILL-IN ;
+ 8:
+ 9: : LELSE ( LONG BRANCH, RESOLVE)
+10: 4146 ?PAIRS
+11: >R NV LIF R> FILL-IN ;
+12:
+13: : ENDIF 4146 ?PAIRS FILL-IN ;
+14:
+15: : BEGIN HERE 4142 ;
+16:
+17: : UNTIL ( COND BR TO BEGIN )
+18: >R >R 4142 ?PAIRS 0
+19: R> R> INVERTCC BR ;
+20:
+21: : WHILE ( COND BR PAST REPEAT )
+22: ROT 4142 ?PAIRS
+23: IF DROP 4157 ;
+24:
+25: : REPEAT ( LOOP, RESOLVE WHILE)
+26: 4157 ?PAIRS SWAP 0 AL BR
+27: FILL-IN ;
+28:
+29: : LWHILE ( LONG WHILE )
+30: ROT 4142 ?PAIRS
+31: LIF DROP 4157 ; -->
+\f 0: ( :ASM ;ASM )
+ 1: ( JMR-89MAR28 )
+ 2: ASSEMBLER DEFINITIONS HEX
+ 3:
+ 4: : :ASM CREATE !CSP ;
+ 5:
+ 6: : ;ASM ?CSP SMUDGE ;
+ 7:
+ 8: : I-CODE ( SHIFT TO HI-LEVEL )
+ 9: [ ' :ASM CFA @ ] LITERAL
+10: [ BIF ] , ( ASMBL JMP <XCOL )
+11: DROOT @ ROOT ! ] ; ( COMPILE)
+12: ASSEMBLER
+13:
+14:
+15:
+16: : MACHINE ( SHIFT TO LO-LEVEL )
+17: COMPILE (MACHINE) ( IN DEF )
+18: [COMPILE] [ ( NOW INTERPRET )
+19: [COMPILE] ASSEMBLER ;
+20: IMMEDIATE ;S
+\f 0:
+\f 0: ( D! D@ )
+ 1: ( JMR-89FEB16 )
+ 2: BIF DEFINITIONS ASSEMBLER
+ 3:
+ 4: :ASM D! ( STORE DBL ) X U PUL
+ 5: D U PUL 0. X , D ST
+ 6: D U PUL 2. X , D ST
+ 7: NEXT ;ASM
+ 8:
+ 9: :ASM D@ ( FETCH DBL ) X U PUL
+10: 0. X , D LD 2. X , X LD
+11: D X U PSH NEXT ;ASM
+12:
+13: :ASM DOVER ( DOUBLE OVER DOUBLE)
+14: 4. U , D LD 6. U , X LD
+15: D X U PSH NEXT ;ASM
+16:
+17: :ASM DSWAP ( SWAP DOUBLES )
+18: 4. U , D LD 0. U , X LD
+19: 4. U , X ST 0. U , D ST
+20: 6. U , D LD 2. U , X LD
+21: 6. U , X ST 2. U , D ST
+22: NEXT ;ASM
+23: ;S
+\fchar * errorMessages[] =
+{ "",
+ "DATA STACK UNDERFLOW",
+ "DICTIONARY FULL",
+ "ADDRESS RESOLUTION ERROR",
+ "HIDES DEFINITION IN",
+ "NULL VECTOR WRITTEN",
+ "DISC RANGE?",
+ "DATA STACK OVERFLOW",
+ "DISC ERROR!",
+ "CAN'T EXECUTE A NULL!",
+ "CONTROL STACK UNDERFLOW",
+ "CONTROL STACK OVERFLOW",
+ "ARRAY REFERENCE OUT OF BOUNDS",
+ "ARRAY DIMENSION NOT VALID",
+ "NO PROCEDURE TO ENTER",
+ " ( WAS REGISTER )",
+ "",
+ "COMPILATION ONLY, USE IN DEF",
+ "EXECUTION ONLY",
+ "CONDITIONALS NOT PAIRED",
+ "DEFINITION INCOMPLETE",
+ "IN PROTECTED DICTIONARY",
+ "USE ONLY WHEN LOADING",
+ "OFF CURRENT EDITING SCREEN",
+ "DECLARE VOCABULARY",
+ "DEFINITION NOT IN VOCABULARY",
+ "IN FORWARD BLOCK",
+ "ALLOCATION LIST CORRUPTED: LOST",
+ "CAN'T REDEFINE nul!",
+ "NOT FORWARD REFERENCE",
+ " ( WAS IMMEDIATE )",
+ "",
+ "",
+ "HAS INCORRECT ADDRESS MODE",
+ "HAS INCORRECT INDEX MODE",
+ "OPERAND NOT REGISTER",
+ "HAS ILLEGAL IMMEDIATE",
+ "PC OFFSET MUST BE ABSOLUTE",
+ "ACCUMULATOR OFFSET REQUIRED",
+ "ILLEGAL MEMORY INDIRECTION",
+ "ILLEGAL INDEX BASE",
+ "ILLEGAL TARGET SPECIFIED",
+ "CAN'T STACK ON SELF",
+ "DUPLICATE IN LIST",
+ "REGISTER NOT STACK",
+ "EMPTY REGISTER LIST",
+ "IMMEDIATE OPERAND REQUIRED",
+ "REQUIRES CONDITION",
+ "",
+ "COMPILE-TIME STACK UNDERFLOW",
+ "COMPILE-TIME STACK OVERFLOW",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ "",
+ ""
+};
+#define DATA_STACK_UNDERFLOW 0x1
+#define DICTIONARY_FULL 0x2
+#define ADDRESS_RESOLUTION_ERROR 0x3
+#define HIDES_DEFINITION_IN 0x4
+#define NULL_VECTOR_WRITTEN 0x5
+#define DISC_RANGE_ 0x6
+#define DATA_STACK_OVERFLOW 0x7
+#define DISC_ERROR_ 0x8
+#define CAN_T_EXECUTE_A_NULL_ 0x9
+#define CONTROL_STACK_UNDERFLOW 0xa
+#define CONTROL_STACK_OVERFLOW 0xb
+#define ARRAY_REFERENCE_OUT_OF_BOUNDS 0xc
+#define ARRAY_DIMENSION_NOT_VALID 0xd
+#define NO_PROCEDURE_TO_ENTER 0xe
+#define COMPILATION_ONLY__USE_IN_DEF 0x11
+#define EXECUTION_ONLY 0x12
+#define CONDITIONALS_NOT_PAIRED 0x13
+#define DEFINITION_INCOMPLETE 0x14
+#define IN_PROTECTED_DICTIONARY 0x15
+#define USE_ONLY_WHEN_LOADING 0x16
+#define OFF_CURRENT_EDITING_SCREEN 0x17
+#define DECLARE_VOCABULARY 0x18
+#define DEFINITION_NOT_IN_VOCABULARY 0x19
+#define IN_FORWARD_BLOCK 0x1a
+#define ALLOCATION_LIST_CORRUPTED__LOST 0x1b
+#define CAN_T_REDEFINE_nul_ 0x1c
+#define NOT_FORWARD_REFERENCE 0x1d
+#define HAS_INCORRECT_ADDRESS_MODE 0x21
+#define HAS_INCORRECT_INDEX_MODE 0x22
+#define OPERAND_NOT_REGISTER 0x23
+#define HAS_ILLEGAL_IMMEDIATE 0x24
+#define PC_OFFSET_MUST_BE_ABSOLUTE 0x25
+#define ACCUMULATOR_OFFSET_REQUIRED 0x26
+#define ILLEGAL_MEMORY_INDIRECTION 0x27
+#define ILLEGAL_INDEX_BASE 0x28
+#define ILLEGAL_TARGET_SPECIFIED 0x29
+#define CAN_T_STACK_ON_SELF 0x2a
+#define DUPLICATE_IN_LIST 0x2b
+#define REGISTER_NOT_STACK 0x2c
+#define EMPTY_REGISTER_LIST 0x2d
+#define IMMEDIATE_OPERAND_REQUIRED 0x2e
+#define REQUIRES_CONDITION 0x2f
+#define COMPILE_TIME_STACK_UNDERFLOW 0x31
+#define COMPILE_TIME_STACK_OVERFLOW 0x32
+
+};
--- /dev/null
+/* The cheapest, quickest to write program I can make up to strip line numbers.\r// The line number field is variable width and has optional leading whitespace.\r// Written by Joel Rees, Takino, Hyogo, Japan, January 2000.\r// Too Q&D to bother copyrighting, assigned to the public domain.\r// Since it is in the public domain, it can't be copyrighted. \r// Your personal expression of it may be copyrightable, however.\r//\r// The changes in my programing style prove that I am turning Japanese.\r// Current e-mail: joel_rees@sannet.ne.jp, reiisi@nettaxi.com\r*/\r\r\r/* #define ON_Macintosh */\r\r\r#include <stdio.h>\r#include <stdlib.h>\r#include <ctype.h>\r\r\r#if defined ON_Macintosh\r# pragma push\r# pragma only_std_keywords off\r# include <Types.h>\r# include <Fonts.h>\r# pragma pop\r#endif\r\r\r#if defined ON_Macintosh\r# include <sioux.h>\r# include <console.h>\r#endif\r\r\r#define BUFFERCHARS 1024\r#define BUFFSIZE ( BUFFERCHARS + 1 ) /* One shot, should be no lines this large anyway. */\r#define LABELCHARS 16 /* I think it was only up to 8, but 16 to be safe. */\r#define LABELSIZE ( LABELCHARS + 1 ) /* I think it was only up to 8, but 16 to be safe. */\r#define NAMECHARS 31\r#define NAMESIZE ( NAMECHARS + 1 )\r#define EXPRESSIONCHARS 64 /* Way overkill. */\r#define EXPRESSIONSIZE ( EXPRESSIONCHARS + 1 )\r\r\r#define SPACE ' '\r\r\rchar * derelative( char buffer[] )\r{ char * scan = buffer;\r int ch;\r while ( ( ( ch = * scan ) != '\0' )\r && ( ch != '-' ) && ( ch != '+' ) )\r { ++scan;\r }\r if ( scan > buffer )\r { *scan = '\0';\r return buffer;\r }\r}\r\r\rchar * prefixHeaderAddress( char buffer[] )\r{ return isdigit( buffer[ 0 ] ) ? "" : "(natural_t) &h";\r}\r\r\rint nocaseCompare( char * range, char * object )\r{ int difference = 0;\r /* printf( "comparing %s in %s:", object, range ); */\r do\r { difference = ( toupper( * range++ ) - toupper( * object++ ) );\r /* printf( "%d,", difference ); */\r } while ( ( difference == 0 ) && ( * object != '\0' ) ); /* terminating NUL is convenient in the math. */\r /* printf( "%d\n", difference ); */\r return difference;\r}\r\r\rchar * nocaseScan( char * range, char * object )\r{ char * inObject = object;\r while ( ( * range != '\0' ) && ( nocaseCompare( range, object ) != 0 ) ) /* Not going for speed. */\r { ++range;\r }\r return ( * range == '\0' ) ? NULL : range;\r}\r\r\rchar * guardedCopy( char target[], char source[], size_t limit )\r{ target[ limit ] = '\0';\r strncpy( target, source, limit );\r}\r\r\r#if defined NOT_USING_THIS\r/* Decided I want to try to matche fgets(). */\rsize_t readline( FILE * file, char buffer[], size_t limit )\r{ size_t i;\r int ch;\r int lookahead;\r for ( i = 0; i < limit; ++i )\r { ch = fgetc( file );\r if ( ch == EOF )\r { buffer[ i ] = '\0';\r --i; /* Report the count of stored characters. */\r break;\r }\r else if ( ( ch == '\n') || ( ch == '\r' ) )\r { if ( i == limit - 1 )\r { ungetc( ch, file );\r buffer[ i ] = '\0';\r --i; /* Report the count of stored characters. */\r }\r else \r { buffer[ i ] = '\n'; /* convert to standard C library new line */\r buffer[ i + 1 ] = '\0';\r lookahead = fgetc( file );\r if ( ( ( ch == '\n' ) && ( lookahead != '\r' ) )\r || ( ( ch == '\r' ) && ( lookahead != '\n' ) ) )\r { ungetc( lookahead ); /* Don't drop it. */\r }\r /* If it was a CRLF or LFCR, drop the second of the pair. */\r }\r break;\r }\r else\r { buffer[ i ] = (char) ch;\r }\r }\r return i;\r}\r#endif /* defined NOT_USING_THIS */\rsize_t readline( FILE * file, char buffer[], size_t limit )\r{ size_t i;\r int ch;\r int lookahead;\r --limit; /* store limit - 1 characters */\r for ( i = 0; i < limit; ++i )\r { ch = fgetc( file );\r if ( ch == EOF )\r { break;\r }\r else if ( ( ch == '\n') || ( ch == '\r' ) )\r {\r buffer[ i++ ] = '\n'; /* convert to standard C library new line for the platform */\r lookahead = fgetc( file );\r if ( ( ( ch == '\n' ) && ( lookahead != '\r' ) )\r || ( ( ch == '\r' ) && ( lookahead != '\n' ) ) )\r { ungetc( lookahead, file ); /* Not a pair, don't drop it. */\r }\r /* If it was a CRLF or LFCR, drop the second of the pair. */\r break;\r }\r else\r { buffer[ i ] = (char) ch;\r }\r }\r buffer[ i ] = '\0';\r return i;\r}\r\r\rint main( int argc, char * argv[] )\r{\r int ch;\r FILE * input = stdin;\r int fdbFlag = 0;\r int dotHFlag = 0;\r char label[ LABELSIZE ] = { '\0' };\r char name[ NAMESIZE ] = { '\0' };\r char searchMode[ EXPRESSIONSIZE ] = { '\0' };\r char linkMode[ EXPRESSIONSIZE ] = { '\0' };\r char allocLink[ EXPRESSIONSIZE ] = { '\0' };\r char parentLink[ EXPRESSIONSIZE ] = { '\0' };\r char leftLink[ EXPRESSIONSIZE ] = { '\0' };\r char rightLink[ EXPRESSIONSIZE ] = { '\0' };\r char lastLabel[ LABELSIZE ] = { '\0' };\r char characteristic[ LABELSIZE ] = { '\0' };\r#define HeaderWait 0\r#define HeaderNameRead 1\r#define HeaderNamed 2\r#define HeaderLinkModeRead 3\r#define HeaderLinked 4\r#define HeaderParented 5\r#define HeaderLefted 6\r#define HeaderRighted 7\r#define HeaderComplete 8\r int headerState = HeaderWait;\r/* */\r# if defined ON_Macintosh\r { Str31 name = "\pOsaka\81|\93\99\95\9d";\r short familyID = 0;\r /* */\r GetFNum( name, &familyID );\r SIOUXSettings.fontsize = 12;\r SIOUXSettings.fontid = familyID;\r SIOUXSettings.showstatusline = 1;\r argc = ccommand( &argv );\r }\r# endif\r /* Use the pseudo-command-line as simple file interface\r // argc = ccommand( &argv ); \r */\r if ( argc > 1 )\r { int arg;\r for ( arg = 1; arg < argc; ++arg )\r { if ( ( argc == 2 ) || ( ( strcmp( argv[ arg ], "-f" ) == 0 ) && ( ++arg < argc ) ) )\r { input = fopen( argv[ arg ], "rb" );\r if ( input == NULL )\r { fprintf( stderr, "Failed to open %s\n", argv[ arg ] );\r return EXIT_FAILURE;\r }\r }\r else if ( strcmp( argv[ arg ], "-fdb" ) == 0 )\r { fdbFlag = 1;\r }\r else if ( strcmp( argv[ arg ], "-.h" ) == 0 )\r { dotHFlag = 1;\r }\r /* else if ( ( strcmp( argv[ arg ], "-e" ) == 0 ) && ( ++arg < argc ) )\r {\r } \r */\r else\r { fprintf( stderr, "Unknown option #%d: %s\n", arg, argv[ arg ] );\r }\r }\r }\r/* */\r while ( !feof( input ) )\r {\r char buffer[ BUFFSIZE ];\r char * scan = buffer;\r size_t lineLength;\r int found = 0;\r#define FoundFCC 1\r#define FoundFCB 2\r#define FoundFDB 3\r char * labelMark = NULL;\r char * operatorMark = NULL;\r char * operandMark = NULL;\r char * commentMark = NULL;\r \r buffer[ 0 ] = '\0'; /* In case EOF comes on a completely empty line. */\r lineLength = readline( input, buffer, BUFFSIZE );\r if ( buffer[ lineLength - 1 ] == '\n' ) /* Assuming all lines shorter than the buffer. */\r { buffer[ lineLength - 1 ] = '\0';\r }\r /* printf( "length of buffer: %d\n\n", strlen( buffer ) ); */\r while ( isspace( * scan ) )\r { ++scan; \r }\r while ( isdigit( * scan ) ) /* Bump past the line number. */\r { ++scan;\r }\r if ( * scan == SPACE )\r { ++scan; /* Move past the delimiting space. */\r }\r if ( !fdbFlag && !dotHFlag )\r { fputs( scan, stdout );\r fputc( '\n', stdout );\r continue; /* Nothing more to do in strip line number mode. */\r }\r if ( * scan == '\0' )\r { continue; /* empty line */\r }\r else if ( * scan == '*' )\r { continue; /* comment line */\r }\r if ( ( * scan != '\0' ) && !isspace( * scan ) ) /* Don't want to lose track of whether we tested NUL. */\r { labelMark = scan++; /* Saves us a symbol table. I'm pretty sure I didn't put any labels beyond this point. */\r while ( !isspace( * scan ) )\r { ++scan;\r }\r * scan++ = '\0'; /* Make the label its own string. */\r }\r while ( isspace( * scan ) )\r { ++scan;\r }\r if ( * scan != '\0' )\r { operatorMark = scan;\r while ( ( * scan != '\0' ) && !isspace( * scan ) )\r { ++scan;\r }\r if ( * scan != '\0' )\r { *scan++ = '\0';\r while ( isspace ( * scan ) )\r { ++scan;\r }\r }\r }\r if ( ( operatorMark != NULL ) && ( nocaseCompare( operatorMark, "FCC" ) == 0 ) )\r { char quotechar = * scan;\r found = FoundFCC;\r if ( quotechar != '\0' )\r { ++scan;\r operandMark = scan;\r }\r while ( ( * scan != '\0' ) && ( * scan != quotechar ) )\r { ++scan;\r }\r if ( * scan != '\0' )\r { * scan++ = '\0';\r while ( isspace ( * scan ) )\r { ++scan;\r }\r }\r if ( * scan != '\0' )\r { commentMark = scan;\r }\r if ( ( operandMark != NULL ) && ( headerState == HeaderWait ) )\r { guardedCopy( name, operandMark, NAMECHARS );\r headerState = HeaderNameRead;\r }\r }\r else if ( ( operatorMark != NULL ) && ( nocaseCompare( operatorMark, "FCB" ) == 0 ) )\r { found = FoundFCB;\r operandMark = scan;\r while ( ( * scan != '\0' ) && !isspace( * scan ) )\r { ++scan;\r }\r if ( * scan != '\0' )\r { * scan++ = '\0';\r while ( isspace ( * scan ) )\r { ++scan;\r }\r }\r if ( * scan != '\0' )\r { commentMark = scan;\r }\r switch ( headerState )\r {\r case HeaderNameRead:\r guardedCopy( searchMode, operandMark, EXPRESSIONCHARS );\r headerState = HeaderNamed;\r break;\r case HeaderNamed:\r guardedCopy( linkMode, operandMark, EXPRESSIONCHARS );\r headerState = HeaderLinkModeRead;\r break;\r }\r }\r else if ( ( operatorMark != NULL ) && ( nocaseCompare( operatorMark, "FDB" ) == 0 ) )\r { found = FoundFDB;\r operandMark = scan;\r while ( ( * scan != '\0' ) && !isspace( * scan ) )\r { ++scan;\r }\r if ( * scan != '\0' )\r { * scan++ = '\0';\r while ( isspace ( * scan ) )\r { ++scan;\r }\r }\r if ( * scan != '\0' )\r { commentMark = scan;\r }\r switch ( headerState )\r {\r case HeaderLinkModeRead:\r guardedCopy( allocLink, operandMark, EXPRESSIONCHARS );\r headerState = HeaderLinked;\r break;\r case HeaderLinked:\r guardedCopy( parentLink, operandMark, EXPRESSIONCHARS );\r headerState = HeaderParented;\r break;\r case HeaderParented:\r guardedCopy( leftLink, operandMark, EXPRESSIONCHARS );\r headerState = HeaderLefted;\r break;\r case HeaderLefted:\r guardedCopy( rightLink, operandMark, EXPRESSIONCHARS );\r headerState = HeaderRighted;\r break;\r }\r }\r else\r { if ( ( headerState == HeaderRighted ) && ( labelMark != NULL ) && ( operatorMark != NULL ) )\r { guardedCopy( label, labelMark, LABELCHARS );\r if ( ( toupper( operatorMark[ 0 ] ) == 'D' ) && ( ( toupper( operatorMark[ 1 ] ) == 'O' ) ) )\r { guardedCopy( characteristic, operatorMark + 1, LABELCHARS );\r characteristic[ 0 ] = 'X';\r }\r else\r { guardedCopy( characteristic, labelMark, LABELCHARS );\r }\r headerState = HeaderComplete;\r }\r }\r if ( headerState == HeaderComplete )\r { if ( dotHFlag )\r { printf( "extern definition_header_s h%s;\n", label );\r if ( strcmp( label, characteristic ) == 0 )\r { printf( "extern void %s(void);\n", label );\r }\r }\r if ( fdbFlag )\r {\r fputs( "*/\n", stdout );\r printf( "static character_t s%s[] = \"\\x%x\" \"%s\";\n", label, strlen( name ), name );\r printf( "definition_header_s h%s = \n", label );\r printf( "{\t{ (natural_t) s%s },\n", label );\r printf( "\t{ %s },\n", searchMode );\r derelative( allocLink );\r printf( "\t{ %s%s },\n", prefixHeaderAddress( allocLink ), allocLink ); /* Need to see comments? */\r printf( "\t{ %s },\n", linkMode );\r derelative( parentLink );\r printf( "\t{ %s%s },\n", prefixHeaderAddress( parentLink ), parentLink );\r derelative( leftLink );\r printf( "\t{ %s%s },\n", prefixHeaderAddress( leftLink ), leftLink );\r derelative( rightLink );\r printf( "\t{ %s%s },\n", prefixHeaderAddress( rightLink ), rightLink );\r printf( "\t{ (natural_t) %s }%s\n", \r characteristic, \r ( strcmp( label, characteristic ) == 0 ) ? "\n};" : "," \r );\r fputs( "/*\n", stdout );\r }\r headerState = HeaderWait;\r }\r else if ( fdbFlag && ( found == FoundFDB ) \r && ( ( headerState == HeaderComplete ) || ( headerState == HeaderWait ) ) )\r { if ( labelMark != NULL )\r { printf( "/* %s: */\n", labelMark );\r }\r fputs( "\t\t{ (natural_t) &h", stdout );\r if ( operandMark != NULL )\r { fputs( operandMark, stdout ); \r }\r fputs( "\t},", stdout );\r if ( commentMark != NULL )\r { fputs( "\t/* ", stdout );\r fputs( commentMark, stdout );\r fputs( " */", stdout );\r }\r fputc( '\n', stdout );\r }\r }\r return EXIT_SUCCESS;\r}\r\r
\ No newline at end of file
--- /dev/null
+/* The cheapest, quickest to write program I can make up to strip line numbers.\r// The line number field is variable width and has optional leading whitespace.\r// Written by Joel Rees, Takino, Hyogo, Japan, January 2000.\r// Too Q&D to bother copyrighting, assigned to the public domain.\r// Since it is in the public domain, it can't be copyrighted. \r// Your personal expression of it may be copyrightable, however.\r//\r// The changes in my programing style prove that I am turning Japanese.\r// Current e-mail: joel_rees@sannet.ne.jp, reiisi@nettaxi.com\r*/\r\r\r/* #define ON_Macintosh */\r\r\r#include <stdio.h>\r#include <stdlib.h>\r#include <ctype.h>\r\r\r#if defined ON_Macintosh\r# pragma push\r# pragma only_std_keywords off\r# include <Types.h>\r# include <Fonts.h>\r# pragma pop\r#endif\r\r\r#if defined ON_Macintosh\r# include <sioux.h>\r# include <console.h>\r#endif\r\r\r#define BUFFERCHARS 1024\r#define BUFFSIZE ( 1024 + 1 ) /* One shot, should be no lines this large anyway. */\r\r\rint nocaseCompare( char * range, char * object )\r{ int difference = 0\r while ( ( * object != '\0' ) && ( ( difference = ( toupper( * range++ ) - toupper( * object++ ) ) ) == 0 ) )\r { /* empty loop */ }\r return difference;\r}\r\r\rchar * nocaseScan( char * range, char * object )\r{ char * inObject = object;\r if ( ( * range == '\0' ) || ( * object == '\0' ) )\r { return NULL;\r }\r while ( ( * range != '\0' ) && ( toupper( * range ) != toupper( * inObject ) ) ) \r { ++range;\r }\r \r return range;\r}\r\r\rint main( int argc, char * argv[] )\r{\r int ch;\r FILE * input = stdin;\r int fdbFlag = 0;\r/* */\r# if defined ON_Macintosh\r { Str31 name = "\pOsaka\81|\93\99\95\9d";\r short familyID = 0;\r /* */\r GetFNum( name, &familyID );\r SIOUXSettings.fontsize = 12;\r SIOUXSettings.fontid = familyID;\r SIOUXSettings.showstatusline = 1;\r argc = ccommand( &argv );\r }\r# endif\r /* Use the pseudo-command-line as simple file interface\r // argc = ccommand( &argv ); \r */\r if ( argc > 1 )\r { int arg;\r for ( arg = 1; arg < argc; ++arg )\r { if ( ( argc == 2 ) || ( ( strcmp( argv[ arg ], "-f" ) == 0 ) && ( ++arg < argc ) ) )\r { input = fopen( argv[ arg ], "rb" );\r if ( input == NULL )\r { fprintf( stderr, "Failed to open %s\n", argv[ arg ] );\r return EXIT_FAILURE;\r }\r }\r else if ( strcmp( argv[ arg ], "-fdb" ) == 0 )\r { fdbFlag = 1;\r }\r /* else if ( ( strcmp( argv[ arg ], "-e" ) == 0 ) && ( ++arg < argc ) )\r {\r } \r */\r else\r { fprintf( stderr, "Unknown option #%d: %s\n", arg, argv[ arg ] );\r }\r }\r }\r/* */\r while ( !feof( input ) )\r {\r char buffer[ BUFFSIZE ];\r char * scan = buffer;\r char * printpoint;\r char * label = NULL;\r buffer[ 0 ] = '\0';\r fgets( buffer, BUFFSIZE, input );\r while ( isspace( * scan++ ) )\r { /* bit bucket */ }\r while ( isdigit( * scan++ ) ) /* Kill the line number. */\r { /* bit bucket */ }\r while ( isspace( * scan++ ) )\r { /* bit bucket */ }\r printpoint = scan;\r if ( fdbFlag )\r {\r if ( nocaseCompare( scan, "FDB" ) != 0 )\r { label = scan; /* wrong */\r /* I need to find FDB anywhere on the line, and if there's a label in front of it, save the label. */\r }\r size_t chCount = 0;\r size_t labelMarker = 0;\r size_t opcodeMarker = 0;\r while ( ( ch = getc( input ) ) != EOF && isspace( ch ) && chCount < BUFSIZE )\r { buffer[ chCount++ ] = (char) ch; \r }\r labelMarker = opcodeMarker = chCount;\r while ( ch != EOF && isalnum( ch ) )\r { buffer[ chCount++ ] = ch;\r ch = getc( input );\r }\r while ( ch != EOF && isspace( ch ) )\r { buffer[ chCount++ ] = ch;\r ch = getc( input );\r }\r /* And I realize that I need to take care of labels in some reasonable manner.\r // Maybe put the label in a comment after the icode?.\r */\r buffer[ chCount ] = '\0';\r fputs( buffer, stdout );\r }\r while ( ( ch = getc( input ) ) != EOF \r && ch != '\n' && ch != '\r' /* && ch != '\0' */ )\r { putchar( ch ); /* Copy, but eoln type characters go to bit bucket. */\r }\r putchar( '\n' ); /* At one time, this was supposed to output full CR/LF on DOS. */\r /* Rather than try to figure out the intricacies of the end-of-file and end-of-line \r // interaction, I am just letting an extra empty line be dumped to the output. \r // The present application is not sensitive to such things.\r */\r }\r return EXIT_SUCCESS;\r}\r\r
\ No newline at end of file
OSDN Git Service
