--- /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