fig-FORTH
INSTALLATION MANUAL
GLOSSARY
MODEL
EDITOR
RELEASE 1
WITH COMPILER SECURITY
AND
VARIABLE LENGTH NAMES
BY
WILLIAM F. RAGSDALE
November 1980
Provided through the courtesy of the FORTH INTEREST GROUP, PO Box
1105, San Carlos, CA 94070
Further distribution of this public domain publication must include
this notice.
fig-FORTH INSTALLATION MANUAL
1.0 INTRODUCTION
2.0 DISTRIBUTION
3.0 MODEL ORGANIZATION
4.0 INSTALLATION
5.0 MEMORY MAP
6.0 DOCUMENTATION SUMMARY
1.0 INTRODUCTION
The fig-FORTH implementation project occurred because a key group of
Forth fanciers wished to make this valuable tool available on a
personal computing level. In June of 1978, we gathered a team of
nine systems level programmers, each with a particular target
computer. The charter of the group was to translate a common model
of Forth into assembly language listings for each computer. It was
agreed that the group's work would be distributed in the public
domain by FIG. This publication series is the conclusion of the
work.
2.0 DISTRIBUTION
All publications of the Forth Interest Group are public domain.
They may be further reproduced and distributed by inclusion of this
credit notice:
This publication has been made available
by the Forth Interest Group,
P. O. box 1105, San Carlos, CA 94070
We intend that our primary recipients of the Implementation Project
be computer users groups, libraries, and commercial vendors. We
expect that each will further customize for particular computers and
redistribute. No restrictions are placed on cost, but we expect
faithfulness to the model. FIG does not intend to distribute
machine readable versions, as that entails customization, revision,
and customer support better reserved for commercial vendors. Of
course, another broad group of recipients of the work is the
community of personal computer users. We hope that our publications
will aid in the use of Forth and increase the user expectation of
the performance of high level computer languages.
1
3.0 MODEL ORGANIZATION
The fig-FORTH model deviates a bit from the usual loading method of
Forth. Existing systems load about 2k bytes in object form and then
self-compile the resident system (6 to 8 k bytes). This technique
allows customization within the high level portion, but is
impractical for new implementors.
Our model has 4 to 5 k bytes written as assembler listings. The
remainder may be compiled typing in the Forth high-level source, by
more assembly source, or by disc compilation. This method enhances
transportability, although the larger portion in assembly code
entails more effort. About 8k bytes of memory is used plus 2 to 8k
for workspace.
3.1 MODEL OVER-VIEW
The model consists of 7 distinct areas. They occur sequentially
from low memory to high.
Boot-up parameters
Machine code definitions
High level utility definitions
Installation dependent code
High level definitions
System tools (optional)
RAM memory workspace
3.2 MODEL DETAILS
Boot-up Parameters
This area consists of 34 bytes containing a jump to the cold start,
jump to the warm re-start and initial values for user variables and
registers. These values are altered as you make permanent
extensions to your installation.
Machine Code Definitions
This area consists of about 600 to 800 bytes of machine executable
code in the form of Forth word definitions. Its purpose is to
convert your computer into a standard Forth stack computer. Above
this code, the balance of Forth contains a pseudo-code compiled of
"execution-addresses" which are sequences of the machine address of
the "code-fields" of other Forth definitions. All execution
ultimately refers to the machine code definitions.
2
High-level Utility Definitions
These are colon-definitions, user variables, constants, and
variables that allow you to control the "Forth stack computer".
They comprise the bulk of the system, enabling you to execute and
compile from the terminal. If disc storage (or a RAM simulation of
disc) is available, you may also execute and compile from this
facility. Changes in the high-level area are infrequent. They may
be made thru the assembler source listings.
Installation Dependent Code
This area is the only portion that need change between different
installations of the same computer cpu. There are four code
fragments:
(KEY) Push the next ascii value (7 bits) from the terminal
keystroke to the computation stack and execute NEXT. High 9
bits are zero. Do not echo this character, especially a
control character.
(EMIT) Pop the computation stack (16 bit value). Display the
low 7 bits on the terminal device, then execute NEXT. Control
characters have their natural functions.
(?TERMINAL) For terminals with a break key, wait till released
and push to the computation stack 0001 if it was found
depressed; otherwise 0000. Execute NEXT. If no break key is
available, sense any key depression as a break (sense but don't
wait for a key). If both the above are unavailable, simply
push 0000 and execute NEXT.
(CR) Execute a terminal carriage return and line feed. Execute
NEXT.
When each of these words is executed, the interpreter vectors from
the definition header to these code sequences. On specific
implementations it may be necessary to preserve certain registers
and observe operating system protocols. Understand the implementors
methods in the listing before proceeding!
R/W This colon-definition is the standard linkage to your
disc. It requests the read or write of a disc sector. It
usually requires supporting code definitions. It may consist
of self-contained code or call ROM monitor code. When R/W is
assembled, its code field address is inserted once in BLOCK and
once in BUFFER.
An alternate version of R/W is included that simulates disc
storage in RAM. If you have over 16 k bytes this is practical
for startup and limited operation with cassette.
3
High-level Definitions
The next section contains about 30 definitions involving user
interaction: compiling aids, finding, forgetting, listing, and
number formatting. These definitions are placed above the
installation dependent code to facilitate modification. That is,
once your full system is up, you may FORGET part of the high-level
and re-compile altered definitions from disc.
System Tools
A text editor and machine code assembler are normally resident. We
are including a sample editor, and hope to provide Forth assemblers.
The editor is compiled from the terminal the first time, and then
used to place the editor and assembler source code on disc.
It is essential that you regard the assembly listing as just a way
to get Forth installed on your system. Additions and changes must
be planned and tested at the usual Forth high level and then the
assembly routines updated. Forth work planned and executed only at
an assembly level tends to be non-portable, and confusing.
RAM Workspace
For a single user system, at least 2k bytes must be available above
the compiled system (the dictionary). A 16k byte total system is
most typical.
The RAM workspace contains the computation and return stacks, user
area, terminal input buffer, disc buffer and compilation space for
the dictionary.
4.0 INSTALLATION
We see the following methods of getting a functioning fig-FORTH
system:
1. Buy loadable object code from a vendor who has customized.
2. Obtain an assembly listing with the installation dependent code
supplied by the vendor. Assemble and execute.
3. Edit the FIG assembly listing on your system, re-write the I-O
routines, and assemble.
4. Load someone else's object code up to the installation dependent
code. Hand assemble equivalents for your system and poke in
with your monitor. Begin execution and type in (self-compile)
the rest of the system. This takes about two hours once you
understand the structure of Forth (but that will take much more
time!).
4
Let us examine Step 3, above, in fuller detail. If you wish to
bring up Forth only from this model, here are the sequential steps:
4.1 Familiarize yourself with the model written in Forth, the
glossary, and specific assembly listings.
4.2 Edit the assembly listings into your system. Set the boot-up
parameters at origin offset 0A, 0B (bytes) to 0000
(warning=00).
4.3 Alter the terminal support code (KEY, EMIT, etc,) to match your
system. Observe register protocol specific to your
implementation!
4.4 Place a break to your monitor at the end of NEXT, just before
indirectly jumping via register W to execution. W is the Forth
name for the register holding a code field address, and may be
differently referenced in your listings.
4.5 Enter the cold start at the origin. Upon the break, check that
the interpretive pointer IP points within ABORT and W points to
SP!. If COLD is a colon-definition, then the IP has been
initialized on the way to NEXT and your testing will begin in
COLD. The purpose of COLD is to initialize IP, SP, RP, UP, and
some user variables from the start-up parameters at the origin.
4.6 Continue execution one word at a time. Clever individuals
could write a simple trace routine to print IP, W, SP, RP and
the top of the stacks. Run in this single step mode until the
greeting message is printed. Note that the interpretation is
several hundred cycles to this stage!
4.7 Execution errors may be localized by observing the above
pointers when a crash occurs.
4.8 After the word QUIT is executed (incrementally), and you can
input a "return" key and get OK printed, remove the break. You
may have some remaining errors, but a reset and examination of
the above registers will again localize problems.
4.9 When the system is interpreting from the keyboard, execute
EMPTY-BUFFERS to clear the disc buffer area. You may test the
disc access by typing: 0 BLOCK 64 TYPE
This should bring sector zero from the disc to a buffer and
type the first 64 characters. This sector usually contains
ascii text of the disc directory. If BLOCK (and R/W) doesn't
function--happy hunting!
5.0 If your disc driver differs from the assembly version, you must
create your own R/W. This word does a range check (with error
message), modulo math to derive sector, track, and drive and
passes values to a sector-read and sector-write routine.
5
RAM DISC SIMULATION
If disc is not available, a simulation of BLOCK and BUFFER may be
made in RAM. The following definitions setup high memory as mass
storage. Referenced 'screens' are then brought to the 'disc buffer'
area. This is a good method to test the start-up program even if
disc may be available.
HEX
4000 CONSTANT LO ( START OF BUFFER AREA )
6800 CONSTANT HI ( 10 SCREEN EQUIVALENT )
: R/W >R ( save boolean )
B/BUF * LO + DUP
HI > 6 ?ERROR ( range check )
R> IF ( read ) SWAP ENDIF
B/BUF CMOVE ;
Insert the code field address of R/W into BLOCK and BUFFER and
proceed as if testing disc. R/W simulates screens 0 thru 9 when
B/BUF is 128, in the memory area $4000 thru $6BFF.
fig-FORTH VARIABLE NAME FIELD
A major FIG innovation in this model, is the introduction of
variable length definition names in compiled dictionary entries.
Previous methods only saved three letters and the character count.
The user may select the letter count saved, up to the full natural
length. See the glossary definition for WIDTH.
In this model, the following conventions have been established.
1. The first byte of the name field has the natural character count
in the low 5 bits.
2. The sixth bit = 1 when smudged, and will prevent a match by
(FIND).
3. The seventh bit = 1 for IMMEDIATE definitions; it is called the
precedence bit.
4. The eighth or sign bit is always = 1.
5. The following bytes contain the names' letters, up to the value
in WIDTH.
6. In the byte containing the last letter saved, the sign bit = 1.
7. In word addressing computer, a name may be padded with a blank to
a word boundary.
6
The above methods are implemented in CREATE. Remember that -FIND
uses BL WORD to bring the next text to HERE with the count
preceding. All that is necessary, is to limit by WIDTH and toggle
the proper delimiting bits.
5.0 MEMORY MAP
The following memory map is broadly used. Specific installations may
require alterations but you may forfeit functions in future FIG
offerings.
The disc buffer area is at the upper bound of RAM memory. It is
comprised of an integral number of buffers, each B/BUF+4 bytes.
B/BUF is the number of bytes read from the disc, usually one sector.
B/BUF must be a power of two (64, 128, 256, 512 or 1024). The
constant FIRST has the value of the address of the start of the
first buffer. LIMIT has the value of the first address beyond the
top buffer. The distance between FIRST and LIMIT must be
N*(B/BUF+4) bytes. This N must be two or more.
Constant B/SCR has the value of the number of buffers per screen;
i.e. 1024 / B/BUF.
The user area must be at least 34 bytes; 48 is more appropriate. In
a multi-user system, each user has his own user area, for his copy
of system variables. This method allows re-entrant use of the Forth
vocabulary.
The terminal input buffer is decimal 80 bytes (the hex 50 in QUERY)
plus 2 at the end. If a different value is desired, change the
limit in QUERY. A parameter in the boot-up literals locates the
address of this area for TIB. The backspace character is also in
the boot-up origin parameters. It is universally expected that
"rubout" is the backspace.
The return stack grows downward from the user area toward the
terminal buffer. Forty-eight bytes are sufficient. The origin is
in R0 (R-zero) and is loaded from a boot-up literal.
The computation stack grows downward from the terminal buffer toward
the dictionary, which grows upward. The origin of the stack is in
variable S0 (S-zero) and is loaded from a boot-up literal.
After a cold start, the user variables contain the addresses of the
above memory assignments. An advanced user may relocate while the
system is running. A newcomer should alter the startup literals and
execute COLD. The word +ORIGIN is provided for this purpose.
+ORIGIN gives the address byte or word relative to the origin
depending on the computer addressing method. To change the
backspace to control H type:
HEX 08 0E +ORIGIN ! ( byte addresses)
7
6.0 DOCUMENTATION SUMMARY
The following manuals are in print:
Caltech FORTH Manual, an advanced manual with internal details of
Forth. Has some implementation peculiarities. Approx. $6.50 from
the Caltech Book Store, Pasadena, CA.
Kitt Peak Forth Primer, $20.00 postpaid from the Forth Interest
Group, P.O. Box 1105, San Carlos, CA 94070.
microFORTH Primer, $15.00 Forth, Inc. 815 Manhattan Ave. Manhattan
Beach, CA 90266
Forth Dimensions, newsletter of the Forth Interest Group, $5.00 for
6 issues including membership. F.I.G. P.O. Box 1105 San Carlos, CA.
94070
8
STANDARD
fig-FORTH MEMORY MAP
LIMIT ---> +----------------------------------+ <--- USE
| |
| DISC BUFFERS |
| |
FIRST ---> +----------------------------------+ <--- PREV
+----------------------------------+
| |
| USER AREA |
| |
UP ---> +----------------------------------+
R0 ---> +----------------------------------+
| | \
| RETURN STACK | \
| | ^ | \ IN
| v | | /
| TERMINAL BUFFER | /
| | /
RP ---> +----------------------------------+ <--- TIB
S0 ---> +----------------------------------+
| | |
| | STACK |
| v |
SP ---> +----------------------------------+
+----------------------------------+
| |
| TEXT BUFFER |
| |
+----------------------------------+ <--- PAD
"WORD" BUFFER
DP ---> +----------------------------------+
| |
| DICTIONARY |
| |
+----------------------------------+
+----------------------------------+
| |
| BOOT-UP LITERALS |
| |
+----------------------------------+ <--- 0 +ORIGIN
9
6502
fig-FORTH MEMORY MAP
LIMIT ---> +----------------------------------+ <--- USE
| |
| DISC BUFFERS |
| |
FIRST ---> +----------------------------------+ <--- PREV
+----------------------------------+
| |
| USER AREA |
| |
UP ---> +----------------------------------+
+----------------------------------+
| |
| TEXT BUFFER |
| |
+----------------------------------+ <--- PAD
"WORD" BUFFER
DP ---> +----------------------------------+
| |
| DICTIONARY |
| |
| -------------------------------- |
| |
$200 | BOOT-UP LITERALS |
| |
+----------------------------------+ <--- 0 +ORIGIN
$01FF ---> +----------------------------------+
R0 | | \
| RETURN STACK | \
| | ^ | \ IN
| V | | /
RP ---> | TERMINAL BUFFER | /
| | /
$0100 ---> +----------------------------------+ <--- TIB
+----------------------------------+
| |
Z-PAGE | UP N IP W |
| |
+----------------------------------+
S0 ---> +----------------------------------+ SP IS X REGISTER
| | | RP IS STACK POINTER
| | STACK | OF CPU
| | $009F - $0010 |
| v |
SP ---> +----------------------------------+
10
fig-FORTH GLOSSARY
This glossary contains all of the word definitions in Release 1 of
fig-FORTH. The definitions are present in order of their ascii
sort.
The first line of each entry shows a symbolic description of the
action of the procedure on the parameter stack. The symbols
indicate the order in which input parameters have been placed on the
stack. The three dashes "---" indicate the execution point; any
parameters left on the stack are listed. In this notation, the top
of the stack is to the right.
The symbols include:
addr memory address
b 8 bit byte (ie. hi 8 bits zero)
c 7 bit ascii character (hi 9 bits zero)
d 32 bit signed double integer, most significant portion
with sign on top of stack.
f boolean flag. 0=false, non-zero=true
ff boolean false flag=0
n 16 bit signed integer number
u 16 bit unsigned integer
tf boolean true flag=non zero
The capital letters on the right show definition characteristics:
C May only be used within a colon definition. A digit
indicates number of memory addresses used, if other than
one.
E Intended for execution only.
L0 Level Zero definition of FORTH-78
L1 Level One definition of FORTH-78
P Has precedence bit set. Will execute even when compiling.
U A user variable.
Unless otherwise noted, all references to numbers are for 16 bit
signed integers. On 8 bit data bus computers, the high byte of a
number is on top of the stack, with the sign in the leftmost bit.
For 32 bit signed double numbers, the most significant (with the
sign) is on top.
All arithmetic is implicitly 16 bit signed integer math, with error
and under-flow indication unspecified.
11
! n addr --- L0
Store 16 bits of n at address. Pronounced "store".
!CSP
Save the stack position in CSP. Used as part of the
compiler security.
# d1 --- d2 L0
Generate from a double number d1, the next ascii character
which is placed in an output string. Result d2 is the
quotient after division by BASE, and is maintained for
further processing. Used between <# and #>. See #S.
#> d --- addr count L0
Terminates numeric output conversion by dropping d,
leaving the text address and character count suitable for
TYPE.
#S d1 --- d2 L0
Generates ascii text in the text output buffer, by the use
of #, until a zero double number n2 results. Used between
<# and #>.
' --- addr P,L0
Used in the form:
' nnnn
Leaves the parameter field address of dictionary word
nnnn. As a compiler directive, executes in a colon
definition to compile the address as a literal. If the
word is not found after a search of CONTEXT and CURRENT,
an appropriate error message is given. Pronounced "tick".
( P,L0
Used in the form:
( cccc)
Ignore a comment that will be delimited by a right
parenthesis on the same line. May occur during execution
or in a colon-definition. A blank after the leading
parenthesis is required.
(.") C+
The run-time procedure, compiled by ." which transmits the
following in-line text to the selected output device. See
."
(;CODE) C
The run-time procedure, compiled by ;CODE, that rewrites
the code field of the most recently defined word to point
to the following machine code sequence. See ;CODE.
(+LOOP) n --- C2
The run-time procedure compiled by +LOOP, which increments
the loop index by n and tests for loop completion. See
+LOOP.
12
(ABORT)
Executes after an error when WARNING is -1. This word
normally executes ABORT, but may be altered (with care) to
a user's alternative procedure.
(DO) C
The run-time procedure compiled by DO which moves the loop
control parameters to the return stack. See DO.
(FIND) addr1 addr2 --- pfa b tf (ok)
addr1 addr2 --- ff (bad)
Searches the dictionary starting at the name field address
addr2, matching to the text at addr1. Returns parameter
field address, length byte of name field and boolean true
for a good match. If no match is found, only a boolean
false is left.
(LINE) n1 n2 --- addr count
Convert the line number n1 and the screen n2 to the disc
buffer address containing the data. A count of 64
indicates the full line text length.
(LOOP) C2
The run-time procedure compiled by LOOP which increments
the loop index and tests for loop completion. See LOOP.
(NUMBER) d1 addr1 --- d2 addr2
Convert the ascii text beginning at addr1+1 with regard to
BASE. The new value is accumulated into double number d1,
being left as d2. Addr2 is the address of the first
unconvertable digit. Used by NUMBER.
* n1 n2 --- prod L0
Leave the signed product of two signed numbers.
*/ n1 n2 n3 --- n4 L0
Leave the ratio n4 = n1*n2/n3 where all are signed
numbers. Retention of an intermediate 31 bit product
permits greater accuracy than would be available with the
sequence: n1 n2 * n3 /
*/MOD n1 n2 n3 --- n4 n5 L0
Leave the quotient n5 and remainder n4 of the operation
n1*n2/n3. A 31 bit intermediate product is used as for
*/.
+ n1 n2 --- sum L0
Leave the sum of n1+n2.
+! n addr --- L0
Add n to the value at the address. Pronounced "plus-
store".
13
+- n1 n2 --- n3
Apply the sign of n2 to n1, which is left as n3.
+BUF addr1 --- addr2 f
Advance the disc buffer address addr1 to the address of
the next buffer addr2. Boolean f is false when addr2 is
the buffer presently pointed to by variable PREV.
+LOOP n1 --- (run)
addr n2 --- (compile) P,C2,L0
Used in a colon-definition in the form:
DO ... n1 +LOOP
At run-time, +LOOP selectively controls branching back to
the corresponding DO based on n1, the loop index and the
loop limit. The signed increment n1 is added to the index
and the total compared to the limit. The branch back to
DO occurs until the new index is equal to or greater than
the limit (n1>0), or until the new index is equal to or
less than the limit (n1<0). Upon exiting the loop, the
parameters are discarded and execution continues ahead.
At compile time, +LOOP compiles the run-time word (+LOOP)
and the branch offset computed from HERE to the address
left on the stack by DO. n2 is used for compile-time
error checking.
+ORIGIN n --- addr
Leave the memory address relative by n to the origin
parameter area. n is the minimum address unit, either
byte or word. This definition is used to access or modify
the boot-up parameters at the origin area.
, n --- L0
Store n into the next available dictionary memory cell,
advancing the dictionary pointer. (comma)
- n1 n2 --- diff L0
Leave the difference of n1-n2.
--> P,L0
Continue interpretation with the next disc screen.
(pronounced next-screen).
-DUP n1 --- n1 (if zero)
n1 --- n1 n1 (non-zero) L0
Reproduce n1 only if it is non-zero. This is usually used
to copy a value just before IF, to eliminate the need for
an ELSE part to drop it.
14
-FIND --- pfa b tf (found)
--- ff (not found)
Accepts the next text word (delimited by blanks) in the
input stream to HERE, and searches the CONTEXT and then
CURRENT vocabularies for a matching entry. If found, the
dictionary entry's parameter field address, its length
byte, and a boolean true is left. Otherwise, only a
boolean false is left.
-TRAILING addr n1 --- addr n2
Adjusts the character count n1 of a text string beginning
address to suppress the output of trailing blanks. ie.
the characters at addr+n2 are blanks.
. n --- L0
Print a number from a signed 16 bit two's complement
value, converted according to the numeric BASE. A
trailing blank follows. Pronounced "dot".
." P,L0
Used in the form:
." cccc"
Compiles an in-line string cccc (delimited by the trailing
") with an execution procedure to transmit the text to the
selected output device. If executed outside a definition,
." will immediately print the text until the final ". The
maximum number of characters may be an installation
dependent value. See (.").
.LINE line scr ---
Print on the terminal device, a line of text from the disc
by its line and screen number. Trailing blanks are
suppressed.
.R n1 n2 ---
Print the number n1 right aligned in a field of whose
width is n2. No following blank is printed.
/ n1 n2 --- quot L0
Leave the signed quotient of n1/n2.
/MOD n1 n2 --- rem quot L0
Leave the remainder and signed quotient of n1/n2. The
remainder has the sign of the dividend.
0 1 2 3 --- n
These small numbers are used so often that it is
attractive to define them by name in the dictionary as
constants.
0< n --- f L0
Leave a true flag if the number is less than zero
(negative), otherwise leave a false flag.
15
0= n --- f L0
Leave a true flag if the number is equal to zero,
otherwise leave a false flag.
0BRANCH f --- C2
The run-time procedure to conditionally branch. If f is
false (zero), the following in-line parameter is added to
the interpretive pointer to branch ahead or back.
Compiled by IF, UNTIL, and WHILE.
1+ n1 --- n2 L1
Increment n1 by 1.
2+ n1 --- n2
Leave n1 incremented by 2.
: P,E,L0
Used in the form called a colon-definition:
: cccc ... ;
Creates a dictionary entry defining cccc as equivalent to
the following sequence of Forth word definitions '...'
until the next ';' or ';CODE'. The compiling process is
done by the text interpreter as long as STATE is non-zero.
Other details are that the CONTEXT vocabulary is set to
the CURRENT vocabulary and that words with the precedence
bit set (P) are executed rather than being compiled.
; P,C,L0
Terminate a colon-definition and stop further compilation.
Compiles the run-time ;S.
;CODE P,C,L0
Used in the form:
: cccc ... ;CODE
assembly mnemonics
Stop compilation and terminate a new defining word cccc by
compiling (;CODE). Set the CONTEXT vocabulary to
ASSEMBLER, assembling to machine code the following
mnemonics.
When cccc later executes in the form:
cccc nnnn
the word nnnn will be created with its execution procedure
given by the machine code following cccc. That is, when
nnnn is executed, it does so by jumping to the code after
nnnn. An existing defining word must exist in cccc prior
to ;CODE.
;S P,L0
Stop interpretation of a screen. ;S is also the run-time
word compiled at the end of a colon-definition which
returns execution to the calling procedure.
16
< n1 n2 --- f L0
Leave a true flag if n1 is less than n2; otherwise leave a
false flag.
<# L0
Setup for pictured numeric output formatting using the
words:
<# # #S SIGN #>
The conversion is done on a double number producing text
at PAD.
<BUILDS C,L0
Used within a colon-definition:
: cccc <BUILDS ... DOES> ... ;
Each time cccc is executed, <BUILDS defines a new word
with a high-level execution procedure. Executing cccc in
the form:
cccc nnnn
uses <BUILDS to create a dictionary entry for nnnn with a
call to the DOES> part for nnnn. When nnnn is later
executed, it has the address of its parameter area on the
stack and executes the words after DOES> in cccc. <BUILDS
and DOES> allow run-time procedures to be written in high-
level rather than in assembler code (as required by
;CODE ).
= n1 n2 --- f L0
Leave a true flag if n1=n2; otherwise leave a false flag.
> n1 n2 --- f L0
Leave a true flag if n1 is greater than n2; otherwise a
false flag.
>R n --- C,L0
Remove a number from the computation stack and place as
the most accessable on the return stack. Use should be
balanced with R> in the same definition.
? addr --- L0
Print the value contained at the address in free format
according to the current base.
?COMP
Issue error message if not compiling.
?CSP
Issue error message if stack position differs from value
saved in CSP.
?ERROR f n ---
Issue an error message number n, if the boolean flag is
true.
17
?EXEC
Issue an error message if not executing.
?LOADING
Issue an error message if not loading.
?PAIRS n1 n2 ---
Issue an error message if n1 does not equal n2. The
message indicates that compiled conditionals do not match.
?STACK
Issue an error message if the stack is out of bounds.
This definition may be installation dependent.
?TERMINAL --- f
Perform a test of the terminal keyboard for actuation of
the break key. A true flag indicates actuation. This
definition is installation dependent.
@ addr --- n L0
Leave the 16 bit contents of address.
ABORT L0
Clear the stacks and enter the execution state. Return
control to the operators terminal, printing a message
appropriate to the installation.
ABS n --- u L0
Leave the absolute value of n as u.
AGAIN addr n --- (compiling) P,C2,L0
Used in a colon-definition in the form:
BEGIN ... AGAIN
At run-time, AGAIN forces execution to return to
corresponding BEGIN. There is no effect on the stack.
Execution cannot leave this loop (unless R> DROP is
executed one level below).
At compile time, AGAIN compiles BRANCH with an offset from
HERE to addr. n is used for compile-time error checking.
ALLOT n --- L0
Add the signed number to the dictionary pointer DP. May
be used to reserve dictionary space or re-origin memory.
n is with regard to computer address type (byte or word).
AND n1 n2 --- n3 L0
Leave the bitwise logical and of n1 and n2 as n3.
B/BUF --- n
This constant leaves the number of bytes per disc buffer,
the byte count read from disc by BLOCK.
18
B/SCR --- n
This constant leaves the number of blocks per editing
screen. By convention, an editing screen is 1024 bytes
organised as 16 lines of 64 characters each.
BACK addr ---
Calculate the backward branch offset from HERE to addr and
compile into the next available dictionary memory address.
BASE --- addr U,L0
A user variable containing the current number base used
for input and output conversion.
BEGIN --- addr n (compiling) P,L0
Occurs in a colon-definition in form:
BEGIN ... UNTIL
BEGIN ... AGAIN
BEGIN ... WHILE ... REPEAT
At run-time, BEGIN marks the start of a sequence that may
be repetitively executed. It serves as a return point
from the corresponding UNTIL, AGAIN or REPEAT. When
executing UNTIL, a return to BEGIN will occur if the top
of the stack is false; for AGAIN and REPEAT a return to
BEGIN always occurs.
At compile time BEGIN leaves its return address and n for
compiler error checking.
BL --- c
A constant that leaves the ascii value for "blank".
BLANKS addr count ---
Fill an area of memory begining at addr with blanks.
BLK --- addr U,L0
A user variable containing the block number being
interpreted. If zero, input is being taken from the
terminal input buffer.
BLOCK n --- addr L0
Leave the memory address of the block buffer containing
block n. If the block is not already in memory, it is
transferred from disc to which ever buffer was least
recently written. If the block occupying that buffer has
been marked as being updated, it is re-written to disc
before block n is read into the buffer. See also BUFFER,
R/W UPDATE FLUSH
BLOCK-READ
BLOCK-WRITE
These are preferred names for the installation dependent
code to read and write one block to the disc.
19
BRANCH C2,L0
The run-time procedure to unconditionally branch. An in-
line offset is added to the interpretive pointer IP to
branch ahead or back. BRANCH is compiled by ELSE, AGAIN,
REPEAT.
BUFFER n --- addr
Obtain the next memory buffer, assigning it to block n.
If the contents of the buffer is marked as updated, it is
written to the disc. The block is not read from the disc.
The address left is the first cell within the buffer for
data storage.
C! b addr ---
Store 8 bits at address. On word addressing computers,
further specification is necessary regarding byte
addressing.
C, b ---
Store 8 bits of b into the next available dictionary byte,
advancing the dictionary pointer. This is only available
on byte addressing computers, and should be used with
caution on byte addressing minicomputers.
C@ addr --- b
Leave the 8 bit contents of memory address. On word
addressing computers, further specification is needed
regarding byte addressing.
CFA pfa --- cfa
Convert the parameter field address of a definition to its
code field address.
CMOVE from to count ---
Move the specified quantity of bytes beginning at address
from to address to. The contents of address from is moved
first proceeding toward high memory. Further
specification is necessary on word addressing computers.
COLD
The cold start procedure to adjust the dictionary pointer
to the minimum standard and restart via ABORT. May be
called from the terminal to remove application programs
and restart.
COMPILE C2
When the word containing COMPILE executes, the execution
address of the word following COMPILE is copied (compiled)
into the dictionary. This allows specific compilation
situations to be handled in addition to simply compiling
an execution address (which the interpreter already does).
20
CONSTANT n --- L0
A defining word used in the form:
n CONSTANT cccc
to create word cccc, with its parameter field containing
n. When cccc is later executed, it will push the value of
n to the stack.
CONTEXT --- addr U,L0
A user variable containing a pointer to the vocabulary
within which dictionary searches will first begin.
COUNT addr1 --- addr2 n L0
Leave the byte address addr2 and byte count n of a message
text beginning at addr1. It is presumed that the first
byte at addr1 contains the text byte count and the actual
text starts with the second byte. Typically COUNT is
followed by TYPE.
CR L0
Transmit a carriage return and line feed to the selected
output device.
CREATE
A defining word used in the form:
CREATE cccc
by such words as CODE and CONSTANT to create a dictionary
header for a Forth definition. The code field contains
the address of the word's parameter field. The new word
is created in the CURRENT vocabulary.
CSP --- addr U
A user variable temporarily storing the stack pointer
position, for compilation error checking.
D+ d1 d2 --- dsum
Leave the double number sum of two double numbers.
D+- d1 n --- d2
Apply the sign of n to the double number d1, leaving it as
d2.
D. d --- L1
Print a signed double number from a 32 bit two's
complement value. The high-order 16 bits are most
accessable on the stack. Conversion is performed
according to the current BASE. A blank follows.
Pronounced D-dot.
D.R d n ---
Print a signed double number d right aligned in a field n
characters wide.
DABS d --- ud
Leave the absolute value ud of a double number.
21
DECIMAL L0
Set the numeric conversion BASE for decimal input-output.
DEFINITIONS L1
Used in the form:
cccc DEFINITIONS
Set the CURRENT vocabulary to the CONTEXT vocabulary. In
the example, executing vocabulary name cccc made it the
CONTEXT vocabulary and executing DEFINITIONS made both
specify vocabulary cccc.
DIGIT c n1 --- n2 tf (ok)
c n1 --- ff (bad)
Converts the ascii character c (using base n1) to its
binary equivalent n2, accompanied by a true flag. If the
conversion is invalid, leaves only a false flag.
DLIST
List the names of the dictionary entries in the CONTEXT
vocabulary.
DLITERAL d --- d (executing)
d --- (compiling) P
If compiling, compile a stack double number into a
literal. Later execution of the definition containing
the literal will push it to the stack. If executing, the
number will remain on the stack.
DMINUS d1 --- d2
Convert d1 to its double number two's complement.
DO n1 n2 --- (execute)
addr n --- (compile) P,C2,L0
Occurs in a colon-definition in the form:
DO ... LOOP
DO ... +LOOP
At run-time, DO begins a sequence with repetitive
execution controlled by a loop limit n1 and an index with
initial value n2. DO removes these from the stack. Upon
reaching LOOP the index is incremented by one. Until the
new index equals or exceeds the limit, execution loops
back to just after DO; otherwise the loop parameters are
discarded and execution continues ahead. Both n1 and n2
are determined at run-time and may be the result of other
operations. Within a loop 'I' will copy the current value
of the index to the stack. See I, LOOP, +LOOP, LEAVE.
When compiling within the colon-definition, DO compiles
(DO), leaves the following address addr and n for later
error checking.
22
DOES> L0
A word which defines the run-time action within a high-
level defining word. DOES> alters the code field and
first parameter of the new word to execute the sequence of
compiled word addresses following DOES>. Used in
combination with <BUILDS. When the DOES> part executes it
begins with the address of the first parameter of the new
word on the stack. This allows interpretation using this
area or its contents. Typical uses include the Forth
assembler, multi-dimensional arrays, and compiler
generation.
DP --- addr U,L
A user variable, the dictionary pointer, which contains
the address of the next free memory above the dictionary.
The value may be read by HERE and altered by ALLOT.
DPL --- addr U,L0
A user variable containing the number of digits to the
right of the decimal on double integer input. It may also
be used to hold output column location of a decimal point,
in user generated formatting. The default value on single
number input is -1.
DR0 Installation dependent commands to select disc drives, by
DR1 presetting OFFSET. The contents of OFFSET is added to the
block number in BLOCK to allow for this selection. Offset
is suppressed for error text so that it may always
originate from drive 0.
DROP n --- L0
Drop the number from the stack.
DUMP addr n --- L0
Print the contents of n memory locations beginning at
addr. Both addresses and contents are shown in the
current numeric base.
DUP n --- n n L0
Duplicate the value on the stack.
ELSE addr1 n1 --- addr2 n2 (compiling) P,C2,L0
Occurs within a colon-definition in the form:
IF ... ELSE ... ENDIF
At run-time, ELSE executes after the true part following
IF. ELSE forces execution to skip over the following
false part and resumes execution after the ENDIF. It has
no stack effect.
At compile-time ELSE emplaces BRANCH reserving a branch
offset, leaves the address addr2 and n2 for error testing.
ELSE also resolves the pending forward branch from IF by
calculating the offset from addr1 to HERE and storing at
addr1.
23
EMIT c --- L0
Transmit ascii character c to the selected output device.
OUT is incremented for each character output.
EMPTY-BUFFERS L0
Mark all block-buffers as empty, not necessarily affecting
the contents. Updated blocks are not written to the disc.
This is also an initialisation procedure before first use
of the disc.
ENCLOSE addr1 c --- addr1 n1 n2 n3
The text scanning primitive used by WORD. From the text
address addr1 and an ascii delimiting character c, is
determined the byte offset to the first non-delimiting
character n1, the offset to the first delimiter after the
text n2, and the offset to the first character not
included. This procedure will not process past an ascii
'null', treating it as an unconditional delimiter.
END P,C2,L0
This is an 'alias' or duplicate definition for UNTIL.
ENDIF addr1 n --- (compile) P,C0,L0
Occurs in a colon-definition in the form:
IF ... ENDIF
IF ... ELSE ... ENDIF
At run-time, ENDIF serves only as the destination of a
forward branch from IF or ELSE. It marks the conclusion
of the conditional structure. THEN is another name for
ENDIF. Both names are supported in fig-FORTH. See also
IF and ELSE.
At compile-time, ENDIF computes the forward branch offset
from addr to HERE and stores it at addr. n is used for
error tests.
ERASE addr n ---
Clear a region of memory to zero from addr over n
addresses.
ERROR line --- in blk
Execute error notification and restart of system. WARNING
is first examined. If 1, the text of line n, relative to
screen 4 of drive 0 is printed. This line number may be
positive or negative, and beyond just screen 4. If
WARNING=0, n is just printed as a message number (non-disc
installation). If WARNING is -1, the definition (ABORT)
is executed, which executes the system ABORT. The user
may cautiously modify this execution by altering (ABORT).
fig-FORTH saves the contents of IN and BLK to assist in
determining the location of the error. Final action is
execution of QUIT.
24
EXECUTE addr ---
Execute the definition whose code field address is on the
stack. The code field address is also called the
compilation address.
EXPECT addr count --- L0
Transfer characters from the terminal to address, until a
"return" or the count of characters have been received.
One or more nulls are added at the end of the text.
FENCE --- addr U
A user variable containing an address below which
FORGETting is trapped. To forget below this point the
user must alter the contents of FENCE.
FILL addr quan b ---
Fill memory at the address with the specified quantity of
bytes b.
FIRST --- n
A constant that leaves the address of the first (lowest)
block buffer.
FLD --- addr U
A user variable for control of number output field width.
Presently unused in fig-FORTH.
FORGET E,L0
Executed in the form:
FORGET cccc
Deletes definition named cccc from the dictionary with all
entries physically following it. In fig-FORTH, an error
message will occur if the CURRENT and CONTEXT vocabularies
are not currently the same.
FORTH P,L1
The name of the primary vocabulary. Execution makes FORTH
the CONTEXT vocabulary. Until additional user
vocabularies are defined, new user definitions become a
part of FORTH. FORTH is immediate, so it will execute
during the creation of a colon-definition, to select this
vocabulary at compile-time.
HERE --- addr L0
Leave the address of the next available dictionary
location.
HEX L0
Set the numeric conversion base to sixteen (hexadecimal).
HLD --- addr L0
A user variable that holds the address of the latest
character of text during numeric output conversion.
25
HOLD c --- L0
Used between <# and #> to insert an ascii character into a
pictured numeric output string. e.g. 2E HOLD will place a
decimal point.
I --- n C,L0
Used within a DO-LOOP to copy the loop index to the stack.
Other use is implementation dependent. See R.
ID. addr ---
Print a definition's name from its name field address.
IF f --- (run-time)
--- addr n (compile) P,C2,L0
Occurs in a colon definition in the form:
IF (tp) ... ENDIF
IF (tp) ... ELSE (fp) ... ENDIF
At run-time, IF selects execution based on a boolean flag.
If f is true (non-zero), execution continues ahead thru
the true part. If f is false (zero), execution skips till
just after ELSE to execute the false part. After either
part, execution resumes after ENDIF. ELSE and its false
part are optional; if missing, false execution skips to
just after ENDIF.
At compile-time IF compiles 0BRANCH and reserves space for
an offset at addr. addr and n are used later for
resolution of the offset and error testing.
IMMEDIATE
Mark the most recently made definition so that when
encountered at compile time, it will be executed rather
than being compiled. i.e. the precedence bit in its header
is set. This method allows definitions to handle unusual
compiling situations, rather than build them into the
fundamental compiler. The user may force compilation of
an immediate definition by preceding it with [COMPILE].
IN --- addr L0
A user variable containing the byte offset within the
current input text buffer (terminal or disc) from which
the next text will be accepted. WORD uses and moves the
value of IN.
INDEX from to ---
Print the first line of each screen over the range from,
to. This is used to view the comment lines of an area of
text on disc screens.
26
INTERPRET
The outer text interpreter which sequentially executes or
compiles text from the input stream (terminal or disc)
depending on STATE. If the word name cannot be found
after a search of CONTEXT and then CURRENT it is converted
to a number according to the current base. That also
failing, an error message echoing the name with a " ?"
will be given.
Text input will be taken according to the convention for
WORD. If a decimal point is found as part of a number, a
double number value will be left. The decimal point has
no other purpose than to force this action. See NUMBER.
KEY --- c L0
Leave the ascii value of the next terminal key struck.
LATEST --- addr
Leave the name field address of the topmost word in the
CURRENT vocabulary.
LEAVE C,L0
Force termination of a DO-LOOP at the next opportunity by
setting the loop limit to the current value of the index.
The index itself remains unchanged, and execution proceeds
normally until LOOP or +LOOP is encountered.
LFA pfa --- lfa
Convert the parameter field address of a dictionary
definition to its link field address.
LIMIT --- n
A constant leaving the address just above the highest
memory available for a disc buffer. Usually this is the
highest system memory.
LIST n --- L0
Display the ascii text of screen n on the selected output
device. SCR contains the screen number during and after
this process.
LIT --- n C2,L0
Within a colon-definition, LIT is automatically compiled
before each 16 bit literal number encountered in input
text. Later execution of LIT causes the contents of the
next dictionary address to be pushed to the stack.
LITERAL n --- (compiling) P,C2,L0
If compiling, then compile the stack value n as a 16 bit
literal. This definition is immediate so that it will
execute during a colon definition. The intended use is:
: xxx [ calculate ] LITERAL ;
Compilation is suspended for the compile time calculation
of a value. Compilation is resumed and LITERAL compiles
this value.
27
LOAD n --- L0
Begin interpretation of screen n. Loading will terminate
at the end of the screen or at ;S. See ;S and -->.
LOOP addr n --- (compiling) P,C2,L0
Occurs in a colon-definition in the form:
DO ... LOOP
At run-time, LOOP selectively controls branching back to
the corresponding DO based on the loop index and limit.
The loop index is incremented by one and compared to the
limit. The branch back to DO occurs until the index
equals or exceeds the limit; at that time, the parameters
are discarded and execution continues ahead.
At compile-time, LOOP compiles (LOOP) and uses addr to
calculate an offset to DO. n is used for error testing.
M* n1 n2 --- d
A mixed magnitude math operation which leaves the double
number signed product of two signed numbers.
M/ d n1 --- n2 n3
A mixed magnitude math operator which leaves the signed
remainder n2 and signed quotient n3, from a double number
dividend and divisor n1. The remainder takes its sign
from the dividend.
M/MOD ud1 u2 --- u3 u4
An unsigned mixed magnitude math operation which leaves a
double quotient ud4 and remainder u3, from a double
dividend ud1 and single divisor u2.
MAX n1 n2 --- max L0
Leave the greater of two numbers.
MESSAGE n ---
Print on the selected output device the text of line n
relative to screen 4 of drive 0. n may be positive or
negative. MESSAGE may be used to print incidental text
such as report headers. IF WARNING is zero, the message
will simply be printed as a number (disc-unavailable).
MIN n1 n2 --- min L0
Leave the smaller of two numbers.
MINUS n1 --- n2 L0
Leave the two's complement of a number.
MOD n1 n2 --- mod L0
Leave the remainder of n1/n2, with the same sign as n1.
28
MON
Exit to the system monitor, leaving a re-entry to Forth,
if possible.
MOVE addr1 addr2 n ---
Move the contents of n memory cells (16 bit contents)
beginning at addr1 into n cells beginning at addr2. The
contents of addr1 is moved first. This definition is
appropriate on word addressing computers.
NEXT
This is the inner interpreter that uses the interpretive
pointer IP to execute compiled Forth definitions. It is
not directly executed but is the return point for all code
procedures. It acts by fetching the address pointed by
IP, storing this value in register W. It then jumps to
the address pointed to by W. W points to the code field
of a definition which contains the address of the code
which executes for that definition. This usage of
indirect threaded code is a major contributor to the
power, portability, and extensibility of forth. Locations
of IP and W are computer specific.
NFA pfa --- nfa
Convert the parameter field address of a definition to its
name field.
NUMBER addr --- d
Convert a character string left at addr with a preceding
count, to a signed double number, using the current base.
If a decimal point is encountered in the text, its
position will be given in DPL, but no other effect occurs.
If numeric conversion is not possible, an error message
will be given.
OFFSET --- addr U
A user variable which may contain a block offset to disc
drives. The contents of OFFSET is added to the stack
number by BLOCK. Messages by MESSAGE are independent of
OFFSET. See BLOCK, DR0, DR1, MESSAGE.
OR n1 n2 --- or L0
Leave the bit-wise logical or of two 16 bit values.
OUT --- addr U
A user variable that contains a value incremented by EMIT.
The user may alter and examine OUT to control display
formatting.
OVER n1 n2 --- n1 n2 n1 L0
Copy the second stack value, placing it as the new top.
29
PAD --- addr L0
Leave the address of the text output buffer, which is a
fixed offset above HERE.
PFA nfa --- pfa
Convert the name field address of a compiled definition to
its parameter field address.
POP
The code sequence to remove a stack value and return to
NEXT. POP is not directly executable, but is a forth re-
entry point after machine code.
PREV --- addr
A variable containing the address of the disc buffer most
recently referenced. The UPDATE command marks this buffer
to be later written to disc.
PUSH
This code sequence pushes machine registers to the
computation stack and returns to NEXT. It is not directly
executable, but is a Forth re-entry point after machine
code.
PUT
This code sequence stores machine register contents over
the topmost computation stack value and returns to NEXT.
It is not directly executable, but is a Forth re-entry
point after machine code.
QUERY
Input 80 characters of text (or until a "return") from the
operators terminal. Text is positioned at the address
contained in TIB with IN set to zero.
QUIT L1
Clear the return stack, stop compilation, and return
control to the operators terminal. No message is given.
R --- n
Copy the top of the return stack to the computation stack.
R# --- addr U
A user variable which may contain the location of an
editing cursor, or other file related function.
R/W addr blk f ---
The fig-FORTH standard disc read-write linkage. addr
specifies the source or destination block buffer, blk is
the sequential number of the referenced block; and f is a
flag for f=0 write and f=1 for read. R/W determines the
location on mass storage, performs the read-write and
performs any error checking.
30
R> --- n L0
Remove the top value from the return stack and leave it on
the computation stack. See >R and R.
R0 --- addr U
A user variable containing the initial location of the
return stack. Pronounced R-zero. See RP!
REPEAT addr n --- (compiling) P,C2
Used within a colon-definition in the form:
BEGIN ... WHILE ... REPEAT
At run-time, REPEAT forces an unconditional branch back to
just after the corresponding BEGIN.
At compile-time, REPEAT compiles BRANCH and the offset
from HERE to addr. n is used for error testing.
ROT n1 n2 n3 --- n2 n3 n1 L0
Rotate the top three values on the stack, bringing the
third to the top.
RP!
A computer dependent procedure to initialise the return
stack pointer from user variable R0.
S->D n --- d
Sign extend a single number to form a double number.
S0 --- addr U
A user variable that contains the initial value for the
stack pointer. Pronounced S-zero. See SP!
SCR --- addr U
A user variable containing the screen number most recently
referenced by LIST.
SIGN n d --- d L0
Stores an ascii "-" sign just before a converted numeric
output string in the text output buffer when n is
negative. n is discarded, but double number d is
maintained. Must be between <# and #>.
SMUDGE
Used during word definition to toggle the "smudge bit" in
a definition's name field. This prevents an un-completed
definition from being found during dictionary searches,
until compiling is completed without error.
SP!
A computer dependent procedure to initialise the stack
pointer from S0.
31
SP@ --- addr
A computer dependent procedure to return the address of
the stack position to the top of the stack, as it was
before SP@ was executed. (e.g. 1 2 SP@ @ . . . would type
2 2 1 )
SPACE L0
Transmit an ascii blank to the output device.
SPACES n --- L0
Transmit n ascii blanks to the output device.
STATE --- addr L0,U
A user variable containing the compilation state. A non-
zero value indicates compilation. The value itself may be
implementation dependent.
SWAP n1 n2 --- n2 n1 L0
Exchange the top two values on the stack.
TASK
A no-operation word which can mark the boundary between
applications. By forgetting TASK and re-compiling, an
application can be discarded in its entirety.
THEN P,C0,L0
An alias for ENDIF.
TIB --- addr U
A user variable containing the address of the terminal
input buffer.
TOGGLE addr b ---
Complement the contents of addr by the bit pattern b.
TRAVERSE addr1 n --- addr2
Move across the name field of a fig-FORTH variable length
name field. addr1 is the address of either the length
byte or the last letter. If n=1, the motion is toward
high memory; if n= -1, the motion is toward low memory.
The addr2 resulting is address of the other end of the
name.
TRIAD scr ---
Display on the selected output device the three screens
which include that numbered scr, beginning with a screen
evenly divisible by three. Output is suitable for source
text records, and includes a reference line at the bottom
taken from line 15 of screen 4.
TYPE addr count --- L0
Transmit count characters from addr to the selected output
device.
32
U* u1 u2 --- ud
Leave the unsigned double number product of two unsigned
numbers.
U/ ud u1 --- u2 u3
Leave the unsigned remainder u2 and unsigned quotient u3
from the unsigned double dividend ud and unsigned divisor
u1.
UNTIL f --- (run-time)
addr n --- (compile) P,C2,L0
Occurs within a colon-definition in the form:
BEGIN ... UNTIL
At run-time, UNTIL controls the conditional branch back to
the corresponding BEGIN. If f is false, execution returns
to just after begin; if true, execution continues ahead.
At compile-time, UNTIL compiles (0BRANCH) and an offset
from HERE to addr. n is used for error tests.
UPDATE L0
Marks the most recently referenced block (pointed to by
PREV) as altered. The block will subsequently be
transferred automatically to disc should its buffer be
required for storage of a different block.
USE --- addr
A variable containing the address of the block buffer to
use next, as the least recently written.
USER n --- L0
A defining word used in the form:
n USER cccc
which creates a user variable cccc. The parameter field
of cccc contains n as a fixed offset relative to the user
pointer register UP for this user variable. When cccc is
later executed, it places the sum of its offset and the
user area base address on the stack as the storage address
of that particular variable.
VARIABLE E,L0
A defining word used in the form:
n VARIABLE cccc
When VARIABLE is executed, it creates the definition cccc
with its parameter field initialised to n. When cccc is
later executed, the address of its parameter field
(containing n) is left on the stack, so that a fetch or
store may access this location.
VOC-LINK --- addr U
A user variable containing the address of a field in the
definition of the most recently created vocabulary. All
vocabulary names are linked by these fields to allow
control for FORGETting through multiple vocabularies.
33
VOCABULARY E,L
A defining word used in the form:
VOCABULARY cccc
to create a vocabulary definition cccc. Subsequent use of
cccc will make it the CONTEXT vocabulary which is searched
first by INTERPRET. The sequence "cccc DEFINITIONS" will
also make cccc the CURRENT vocabulary into which new
definitions are placed.
In fig-FORTH, cccc will be so chained as to include all
definitions of the vocabulary in which cccc is itself
defined. All vocabularies ultimately chain to Forth. By
convention, vocabulary names are to be declared IMMEDIATE.
See VOC-LINK.
VLIST
List the names of the definitions in the context
vocabulary. "Break" will terminate the listing.
WARNING --- addr U
A user variable containing a value controlling messages.
If = 1, disc is present and screen 4 of drive 0 is the
base location for messages. If = 0, no disc is present
and messages will be presented by number. If = -1,
execute (ABORT) for a user specified procedure. See
MESSAGE, ERROR.
WHILE f --- (run-time)
ad1 n1 --- ad1 n1 ad2 n2 P,C2
Occurs in a colon-definition in the form:
BEGIN ... WHILE (tp) ... REPEAT
At run-time, WHILE selects conditional execution based on
boolean flag f. If f is true (non-zero), WHILE continues
execution of the true part through to REPEAT, which then
branches back to BEGIN. If f is false (zero), execution
skips to just after REPEAT, exiting the structure.
At compile time, WHILE emplaces (0BRANCH) and leaves ad2
of the reserved offset. The stack values will be resolved
by REPEAT.
WIDTH --- addr U
In fig-FORTH, a user variable containing the maximum
number of letters saved in the compilation of a
definition's name. It must be 1 through 31, with a
default value of 31. The name character count and its
natural characters are saved, up to the value in width.
The value may be changed at any time within the above
limits.
34
WORD c --- L0
Read the next text characters from the input stream being
interpreted, until a delimiter c is found, storing the
packed character string beginning at the dictionary buffer
HERE. WORD leaves the character count in the first byte,
the characters, and ends with two or more blanks. Leading
occurances of c are ignored. If BLK is zero, text is
taken from the terminal input buffer, otherwise from the
disc block stored in BLK. See BLK, IN.
X
This is a psuedonym for the "null" or dictionary entry for
a name of one character of ascii null. It is the
execution procedure to terminate interpretation of a line
of text from the terminal or within a disc buffer, as both
buffers always have a null at the end.
XOR n1 n2 --- xor L1
Leave the bitwise logical exclusive-or of two values.
[ P,L1
Used in a colon-definition in the form:
: xxx [ words ] more ;
Suspend compilation. The words after [ are executed, not
compiled. This allows calculation or compilation
exceptions before resuming compilation with ]. See
LITERAL, ].
[COMPILE] P,C
Used in a colon-definition in the form:
: xxx [COMPILE] FORTH ;
[COMPILE] will force the compilation of an immediate
definition, that would otherwise execute during
compilation. The above example will select the FORTH
vocabulary when xxx executes, rather than at compile time.
] L1
Resume compilation, to the completion of a colon-
definition. See [.
35
36
SCR # 3
0 ********************** fig-FORTH MODEL **********************
1
2 Through the courtesy of
3
4 FORTH INTEREST GROUP
5 P. O. BOX 1105
6 SAN CARLOS, CA. 94070
7
8
9 RELEASE 1
10 WITH COMPILER SECURITY
11 AND
12 VARIABLE LENGTH NAMES
13
14
15 Further distribution must include the above notice.
SCR # 4
0 ( ERROR MESSAGES )
1 EMPTY STACK
2 DICTIONARY FULL
3 HAS INCORRECT ADDRESS MODE
4 ISN'T UNIQUE
5
6 DISC RANGE ?
7 FULL STACK
8 DISC ERROR !
9
10
11
12
13
14
15 FORTH INTEREST GROUP MAY 1, 1979
SCR # 5
0 ( ERROR MESSAGES )
1 COMPILATION ONLY, USE IN DEFINITION
2 EXECUTION ONLY
3 CONDITIONALS NOT PAIRED
4 DEFINITION NOT FINISHED
5 IN PROTECTED DICTIONARY
6 USE ONLY WHEN LOADING
7 OFF CURRENT EDITING SCREEN
8 DECLARE VOCABULARY
9
10
11
12
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
37
SOURCE CODE FOR WORD IS ON LINE, SCREEN
CODE LIT ( PUSH FOLLOWING LITERAL TO STACK *) 1 13
LABEL PUSH ( PUSH ACCUM AS HI-BYTE, ML STACK AS LO-BYTE *) 4 13
LABEL PUT ( REPLACE BOTTOM WITH ACCUM. AND ML STACK *) 6 13
LABEL NEXT ( EXECUTE NEXT FORTH ADDRESS, MOVING IP *) 8 13
HERE ' <CLIT> ! HERE 2+ , ( MAKE SILENT WORD *) 1 14
LABEL SETUP ( MOVE # ITEMS FROM STACK TO 'N' AREA OF Z-PAGE *) 4 14
CODE EXECUTE ( EXECUTE A WORD BY ITS CODE FIELD *) 9 14
( ADDRESS ON THE STACK *) 10 14
CODE BRANCH ( ADJUST IP BY IN-LINE 16 BIT LITERAL *) 1 15
CODE 0BRANCH ( IF BOT IS ZERO, BRANCH FROM LITERAL *) 6 15
CODE (LOOP) ( INCREMENT LOOP INDEX, LOOP UNTIL => LIMIT *) 1 16
CODE (+LOOP) ( INCREMENT INDEX BY STACK VALUE +/- *) 8 16
CODE (DO) ( MOVE TWO STACK ITEMS TO RETURN STACK *) 2 17
CODE I ( COPY CURRENT LOOP INDEX TO STACK *) 9 17
CODE DIGIT ( CONVERT ASCII CHAR-SECOND, WITH BASE-BOTTOM *) 1 18
( IF OK RETURN DIGIT-SECOND, TRUE-BOTTOM; *) 2 18
( OTHERWISE FALSE-BOTTOM. *) 3 18
CODE (FIND) ( HERE, NFA ... PFA, LEN BYTE, TRUE; ELSE FALSE *) 1 19
CODE ENCLOSE ( ENTER WITH ADDRESS-2, DELIM-1. RETURN WITH *) 1 20
( ADDR-4, AND OFFSET TO FIRST CH-3, END WORD-2, NEXT CH-1 *) 2 20
CODE EMIT ( PRINT ASCII VALUE ON BOTTOM OF STACK *) 5 21
CODE KEY ( ACCEPT ONE TERMINAL CHARACTER TO THE STACK *) 7 21
CODE ?TERMINAL ( 'BREAK' LEAVES 1 ON STACK; OTHERWISE 0 *) 9 21
CODE CR ( EXECUTE CAR. RETURN, LINE FEED ON TERMINAL *) 11 21
CODE CMOVE ( WITHIN MEMORY; ENTER W/ FROM-3, TO-2, QUAN-1 *) 1 22
CODE U* ( 16 BIT MULTIPLICAND-2, 16 BIT MULTIPLIER-1 *) 1 23
( 32 BIT UNSIGNED PRODUCT: LO WORD-2, HI WORD-1 *) 2 23
CODE U/ ( 31 BIT DIVIDEND-2, -3, 16 BIT DIVISOR-1 *) 1 24
( 16 BIT REMAINDER-2, 16 BIT QUOTIENT-1 *) 2 24
CODE AND ( LOGICAL BITWISE AND OF BOTTOM TWO ITEMS *) 2 25
CODE OR ( LOGICAL BITWISE 'OR' OF BOTTOM TWO ITEMS *) 6 25
CODE XOR ( LOGICAL 'EXCLUSIVE-OR' OF BOTTOM TWO ITEMS *) 10 25
CODE SP@ ( FETCH STACK POINTER TO STACK *) 1 26
CODE SP! ( LOAD SP FROM 'S0' *) 5 26
CODE RP! ( LOAD RP FROM R0 *) 8 26
CODE ;S ( RESTORE IP REGISTER FROM RETURN STACK *) 12 26
CODE LEAVE ( FORCE EXIT OF DO-LOOP BY SETTING LIMIT *) 1 27
XSAVE STX, TSX, R LDA, R 2+ STA, ( TO INDEX *) 2 27
CODE >R ( MOVE FROM COMP. STACK TO RETURN STACK *) 5 27
CODE R> ( MOVE FROM RETURN STACK TO COMP. STACK *) 8 27
CODE R ( COPY THE BOTTOM OF RETURN STACK TO COMP. STACK *) 11 27
CODE 0= ( REVERSE LOGICAL STATE OF BOTTOM OF STACK *) 2 28
CODE 0< ( LEAVE TRUE IF NEGATIVE; OTHERWISE FALSE *) 6 28
CODE + ( LEAVE THE SUM OF THE BOTTOM TWO STACK ITEMS *) 1 29
CODE D+ ( ADD TWO DOUBLE INTEGERS, LEAVING DOUBLE *) 4 29
CODE MINUS ( TWOS COMPLEMENT OF BOTTOM SINGLE NUMBER *) 9 29
CODE DMINUS ( TWOS COMPLEMENT OF BOTTOM DOUBLE NUMBER *) 12 29
CODE OVER ( DUPLICATE SECOND ITEM AS NEW BOTTOM *) 1 30
CODE DROP ( DROP BOTTOM STACK ITEM *) 4 30
CODE SWAP ( EXCHANGE BOTTOM AND SECOND ITEMS ON STACK *) 7 30
CODE DUP ( DUPLICATE BOTTOM ITEM ON STACK *) 11 30
CODE +! ( ADD SECOND TO MEMORY 16 BITS ADDRESSED BY BOTTOM *) 2 31
38
CODE TOGGLE ( BYTE AT ADDRESS-2, BIT PATTERN-1 ... *) 7 31
CODE @ ( REPLACE STACK ADDRESS WITH 16 BIT *) 1 32
BOT X) LDA, PHA, ( CONTENTS OF THAT ADDRESS *) 2 32
CODE C@ ( REPLACE STACK ADDRESS WITH POINTED 8 BIT BYTE *) 5 32
CODE ! ( STORE SECOND AT 16 BITS ADDRESSED BY BOTTOM *) 8 32
CODE C! ( STORE SECOND AT BYTE ADDRESSED BY BOTTOM *) 12 32
: : ( CREATE NEW COLON-DEFINITION UNTIL ';' *) 2 33
: ; ( TERMINATE COLON-DEFINITION *) 9 33
: CONSTANT ( WORD WHICH LATER CREATES CONSTANTS *) 1 34
: VARIABLE ( WORD WHICH LATER CREATES VARIABLES *) 5 34
: USER ( CREATE USER VARIABLE *) 10 34
20 CONSTANT BL CR ( ASCII BLANK *) 4 35
40 CONSTANT C/L ( TEXT CHARACTERS PER LINE *) 5 35
3BE0 CONSTANT FIRST ( FIRST BYTE RESERVED FOR BUFFERS *) 7 35
4000 CONSTANT LIMIT ( JUST BEYOND TOP OF RAM *) 8 35
80 CONSTANT B/BUF ( BYTES PER DISC BUFFER *) 9 35
8 CONSTANT B/SCR ( BLOCKS PER SCREEN = 1024 B/BUF / *) 10 35
: +ORIGIN LITERAL + ; ( LEAVES ADDRESS RELATIVE TO ORIGIN *) 13 35
HEX ( 0 THRU 5 RESERVED, REFERENCED TO $00A0 *) 1 36
( 06 USER S0 ) ( TOP OF EMPTY COMPUTATION STACK *) 2 36
( 08 USER R0 ) ( TOP OF EMPTY RETURN STACK *) 3 36
0A USER TIB ( TERMINAL INPUT BUFFER *) 4 36
0C USER WIDTH ( MAXIMUM NAME FIELD WIDTH *) 5 36
0E USER WARNING ( CONTROL WARNING MODES *) 6 36
10 USER FENCE CR ( BARRIER FOR FORGETTING *) 7 36
12 USER DP ( DICTIONARY POINTER *) 8 36
14 USER VOC-LINK ( TO NEWEST VOCABULARY *) 9 36
16 USER BLK ( INTERPRETATION BLOCK *) 10 36
18 USER IN ( OFFSET INTO SOURCE TEXT *) 11 36
1A USER OUT ( DISPLAY CURSOR POSITION *) 12 36
1C USER SCR ( EDITING SCREEN *) 13 36
1E USER OFFSET ( POSSIBLY TO OTHER DRIVES *) 1 37
20 USER CONTEXT ( VOCABULARY FIRST SEARCHED *) 2 37
22 USER CURRENT ( SEARCHED SECOND, COMPILED INTO *) 3 37
24 USER STATE ( COMPILATION STATE *) 4 37
26 USER BASE CR ( FOR NUMERIC INPUT-OUTPUT *) 5 37
28 USER DPL ( DECIMAL POINT LOCATION *) 6 37
2A USER FLD ( OUTPUT FIELD WIDTH *) 7 37
2C USER CSP ( CHECK STACK POSITION *) 8 37
2E USER R# ( EDITING CURSOR POSITION *) 9 37
30 USER HLD ( POINTS TO LAST CHARACTER HELD IN PAD *) 10 31
: 1+ 1 + ; ( INCREMENT STACK NUMBER BY ONE *) 1 38
: 2+ 2 + ; ( INCREMENT STACK NUMBER BY TWO *) 2 38
: HERE DP @ ; ( FETCH NEXT FREE ADDRESS IN DICT. *) 3 38
: ALLOT DP +! ; ( MOVE DICT. POINTER AHEAD *) 4 38
: , HERE ! 2 ALLOT ; CR ( ENTER STACK NUMBER TO DICT. *) 5 38
: C, HERE C! 1 ALLOT ; ( ENTER STACK BYTE TO DICT. *) 6 38
: - MINUS + ; ( LEAVE DIFF. SEC - BOTTOM *) 7 38
: = - 0= ; ( LEAVE BOOLEAN OF EQUALITY *) 8 38
: < - 0< ; ( LEAVE BOOLEAN OF SEC < BOT *) 9 38
: > SWAP < ; ( LEAVE BOOLEAN OF SEC > BOT *) 10 38
: ROT >R SWAP R> SWAP ; ( ROTATE THIRD TO BOTTOM *) 11 38
: SPACE BL EMIT ; CR ( PRINT BLANK ON TERMINAL *) 12 38
: -DUP DUP IF DUP ENDIF ; ( DUPLICATE NON-ZERO *) 13 38
39
: TRAVERSE ( MOVE ACROSS NAME FIELD *) 1 39
( ADDRESS-2, DIRECTION-1, I.E. -1=R TO L, +1=L TO R *) 2 39
: LATEST CURRENT @ @ ; ( NFA OF LATEST WORD *) 6 39
: LFA 4 - ; ( CONVERT A WORDS PFA TO LFA *) 11 39
: CFA 2 - ; CR ( CONVERT A WORDS PFA TO CFA *) 12 39
: NFA 5 - -1 TRAVERSE ; ( CONVERT A WORDS PFA TO NFA *) 13 39
: PFA 1 TRAVERSE 5 + ; ( CONVERT A WORDS NFA TO PFA *) 14 39
: !CSP SP@ CSP ! ; ( SAVE STACK POSITION IN 'CSP' *) 1 40
: ?ERROR ( BOOLEAN-2, ERROR TYPE-1, WARN FOR TRUE *) 3 40
: ?COMP STATE @ 0= 11 ?ERROR ; ( ERROR IF NOT COMPILING *) 6 40
: ?EXEC STATE @ 12 ?ERROR ; ( ERROR IF NOT EXECUTING *) 8 40
: ?PAIRS - 13 ?ERROR ; ( VERIFY STACK VALUES ARE PAIRED *) 10 40
: ?CSP SP@ CSP @ - 14 ?ERROR ; ( VERIFY STACK POSITION *) 12 40
: ?LOADING ( VERIFY LOADING FROM DISC *) 14 40
: COMPILE ( COMPILE THE EXECUTION ADDRESS FOLLOWING *) 2 41
: [ 0 STATE ! ; IMMEDIATE ( STOP COMPILATION *) 5 41
: ] C0 STATE ! ; ( ENTER COMPILATION STATE *) 7 41
: SMUDGE LATEST 20 TOGGLE ; ( ALTER LATEST WORD NAME *) 9 41
: HEX 10 BASE ! ; ( MAKE HEX THE IN-OUT BASE *) 11 41
: DECIMAL 0A BASE ! ; ( MAKE DECIMAL THE IN-OUT BASE *) 13 41
: (;CODE) ( WRITE CODE FIELD POINTING TO CALLING ADDRESS *) 2 42
: ;CODE ( TERMINATE A NEW DEFINING WORD *) 6 42
: <BUILDS 0 CONSTANT ; ( CREATE HEADER FOR 'DOES>' WORD *) 2 43
: DOES> ( REWRITE PFA WITH CALLING HI-LEVEL ADDRESS *) 4 43
( REWRITE CFA WITH 'DOES>' CODE *) 5 43
: COUNT DUP 1+ SWAP C@ ; ( LEAVE TEXT ADDR. CHAR. COUNT *) 1 44
: TYPE ( TYPE STRING FROM ADDRESS-2, CHAR.COUNT-1 *) 2 44
: -TRAILING ( ADJUST CHAR. COUNT TO DROP TRAILING BLANKS *) 5 44
: (.") ( TYPE IN-LINE STRING, ADJUSTING RETURN *) 8 44
: ." 22 STATE @ ( COMPILE OR PRINT QUOTED STRING *) 12 44
: EXPECT ( TERMINAL INPUT MEMORY-2, CHAR LIMIT-1 *) 2 45
: X BLK @ ( END-OF-TEXT IS NULL *) 11 45
: FILL ( FILL MEMORY BEGIN-3, QUAN-2, BYTE-1 *) 1 46
: ERASE ( FILL MEMORY WITH ZEROS BEGIN-2, QUAN-1 *) 4 46
: BLANKS ( FILL WITH BLANKS BEGIN-2, QUAN-1 *) 7 46
: HOLD ( HOLD CHARACTER IN PAD *) 10 46
: PAD HERE 44 + ; ( PAD IS 68 BYTES ABOVE HERE *) 13 46
( DOWNWARD HAS NUMERIC OUTPUTS; UPWARD MAY HOLD TEXT *) 14 46
: WORD ( ENTER WITH DELIMITER, MOVE STRING TO 'HERE' *) 1 47
: (NUMBER) ( CONVERT DOUBLE NUMBER, LEAVING UNCONV. ADDR. *) 1 48
: NUMBER ( ENTER W/ STRING ADDR. LEAVE DOUBLE NUMBER *) 6 48
: -FIND ( RETURN PFA-3, LEN BYTE-2, TRUE-1; ELSE FALSE *) 12 48
: (ABORT) GAP ( ABORT ) ; ( USER ALTERABLE ERROR ABORT *) 2 49
: ERROR ( WARNING: -1=ABORT, 0=NO DISC, 1=DISC *) 4 49
WARNING @ 0< ( PRINT TEXT LINE REL TO SCR #4 *) 5 49
: ID. ( PRINT NAME FIELD FROM ITS HEADER ADDRESS *) 9 49
: CREATE ( A SMUDGED CODE HEADER TO PARAM FIELD *) 2 50
( WARNING IF DUPLICATING A CURRENT NAME *) 3 50
: [COMPILE] ( FORCE COMPILATION OF AN IMMEDIATE WORD *) 2 51
: LITERAL ( IF COMPILING, CREATE LITERAL *) 5 51
: DLITERAL ( IF COMPILING, CREATE DOUBLE LITERAL *) 8 51
: ?STACK ( QUESTION UPON OVER OR UNDERFLOW OF STACK *) 13 51
: INTERPRET ( INTERPRET OR COMPILE SOURCE TEXT INPUT WORDS *) 2 52
: IMMEDIATE ( TOGGLE PREC. BIT OF LATEST CURRENT WORD *) 1 53
40
: VOCABULARY ( CREATE VOCAB WITH 'V-HEAD' AT VOC INTERSECT. *) 4 53
VOCABULARY FORTH IMMEDIATE ( THE TRUNK VOCABULARY *) 9 53
: DEFINITIONS ( SET THE CONTEXT ALSO AS CURRENT VOCAB *) 11 53
: ( ( SKIP INPUT TEXT UNTIL RIGHT PARENTHESIS *) 14 53
: QUIT ( RESTART, INTERPRET FROM TERMINAL *) 2 54
: ABORT ( WARM RESTART, INCLUDING REGISTERS *) 7 54
CODE COLD ( COLD START, INITIALIZING USER AREA *) 1 55
CODE S->D ( EXTEND SINGLE INTEGER TO DOUBLE *) 1 56
: +- 0< IF MINUS ENDIF ; ( APPLY SIGN TO NUMBER BENEATH *) 4 56
: D+- ( APPLY SIGN TO DOUBLE NUMBER BENEATH *) 6 56
: ABS DUP +- ; ( LEAVE ABSOLUTE VALUE *) 9 56
: DABS DUP D+- ; ( DOUBLE INTEGER ABSOLUTE VALUE *) 10 56
: MIN ( LEAVE SMALLER OF TWO NUMBERS *) 12 56
: MAX ( LEAVE LARGER OF TWO NUMBERS *) 14 56
: M* ( LEAVE SIGNED DOUBLE PRODUCT OF TWO SINGLE NUMBERS *) 1 57
: M/ ( FROM SIGNED DOUBLE-3-2, SIGNED DIVISOR-1 *) 3 57
( LEAVE SIGNED REMAINDER-2, SIGNED QUOTIENT-1 *) 4 57
: * U* DROP ; ( SIGNED PRODUCT *) 7 57
: /MOD >R S->D R> M/ ; ( LEAVE REM-2, QUOT-1 *) 8 57
: / /MOD SWAP DROP ; ( LEAVE QUOTIENT *) 9 57
: MOD /MOD DROP ; CR ( LEAVE REMAINDER *) 10 57
: */MOD ( TAKE RATION OF THREE NUMBERS, LEAVING *) 11 57
>R M* R> M/ ; ( REM-2, QUOTIENT-1 *) 12 57
: */ */MOD SWAP DROP ; ( LEAVE RATIO OF THREE NUMBS *) 13 57
: M/MOD ( DOUBLE, SINGLE DIVISOR ... REMAINDER, DOUBLE *) 14 57
FIRST VARIABLE USE ( NEXT BUFFER TO USE, STALEST *) 1 58
FIRST VARIABLE PREV ( MOST RECENTLY REFERENCED BUFFER *) 2 58
: +BUF ( ADVANCE ADDRESS-1 TO NEXT BUFFER. RETURNS FALSE *) 4 58
84 ( I.E. B/BUF+4 ) + DUP LIMIT = ( IF AT PREV *) 5 58
: UPDATE ( MARK THE BUFFER POINTED TO BY PREV AS ALTERED *) 8 58
: EMPTY-BUFFERS ( CLEAR BLOCK BUFFERS; DON'T WRITE TO DISC *) 11 58
: DR0 0 OFFSET ! ; ( SELECT DRIVE #0 *) 14 58
: DR1 07D0 OFFSET ! ; ( SELECT DRIVE #1 *) 15 58
: BUFFER ( CONVERT BLOCK# TO STORAGE ADDRESS *) 1 59
: BLOCK ( CONVERT BLOCK NUMBER TO ITS BUFFER ADDRESS *) 1 60
: (LINE) ( LINE#, SCR#, ... BUFFER ADDRESS, 64 COUNT *) 2 61
: .LINE ( LINE#, SCR#, ... PRINTED *) 6 61
: MESSAGE ( PRINT LINE RELATIVE TO SCREEN #4 OF DRIVE 0 *) 9 61
: LOAD ( INTERPRET SCREENS FROM DISC *) 2 62
: --> ( CONTINUE INTERPRETATION ON NEXT SCREEN *) 6 62
6900 CONSTANT DATA ( CONTROLLER PORT *) 1 65
6901 CONSTANT STATUS ( CONTROLLER PORT *) 2 65
: #HL ( CONVERT DECIMAL DIGIT FOR DISC CONTROLLER *) 5 65
CODE D/CHAR ( TEST CHAR-1. EXIT TEST BOOL-2, NEW CHAR-1 *) 1 66
: ?DISC ( UPON NAK SHOW ERR MSG, QUIT. ABSORBS TILL *) 7 66
1 D/CHAR >R 0= ( EOT, EXCEPT FOR SOH *) 8 66
CODE BLOCK-WRITE ( SEND TO DISC FROM ADDRESS-2, COUNT-1 *) 1 67
2 # LDA, SETUP JSR, ( WITH EOT AT END *) 2 67
CODE BLOCK-READ ( BUF.ADDR-1. EXIT AT 128 CHAR OR CONTROL *) 2 68
( C = 1 TO READ, 0 TO WRITE *) 3 69
: R/W ( READ/WRITE DISC BLOCK *) 4 69
( BUFFER ADDRESS-3, BLOCK #-2, 1-READ 0-WRITE *) 5 69
: ' ( FIND NEXT WORDS PFA; COMPILE IT, IF COMPILING *) 2 72
: FORGET ( FOLLOWING WORD FROM CURRENT VOCABULARY *) 6 72
41
: \ ( SKIP INTERPRETATION OF THE REMAINDER OF LINE *) 11 72
: BACK HERE - , ; ( RESOLVE BACKWARD BRANCH *) 1 73
: D.R ( DOUBLE INTEGER OUTPUT, RIGHT ALIGNED IN FIELD *) 1 76
: D. 0 D.R SPACE ; ( DOUBLE INTEGER OUTPUT *) 5 76
: .R >R S->D R> D.R ; ( ALIGNED SINGLE INTEGER *) 7 76
: . S->D D. ; ( SINGLE INTEGER OUTPUT *) 9 76
: ? @ . ; ( PRINT CONTENTS OF MEMORY *) 11 76
: LIST ( LIST SCREEN BY NUMBER ON STACK *) 2 77
: INDEX ( PRINT FIRST LINE OF EACH SCREEN FROM-2, TO-1 *) 7 77
: TRIAD ( PRINT 3 SCREENS ON PAGE, CONTAINING # ON STACK *) 12 77
: VLIST ( LIST CONTEXT VOCABULARY *) 2 78
CREATE MON ( CALL MONITOR, SAVING RE-ENTRY TO FORTH *) 3 79
42
FORTH MODEL IMPLEMENTATION
This model is presented for the serious student as both an example
of a large FORTH program and as a complete nucleus of FORTH. That
is, it is sufficient to run and to continue to compile itself.
When compiled, the model requires about 2800 bytes of memory. An
expanded version with formatted output and compiling aids would
require about 4000 bytes. A 'full' implementation usually requires
6000 to 7000 bytes (including editor, assembler, and disk
interface).
The following information consists of word definitions you will find
in the CODE definitions. These are dependent on the micro-computer
used, these being for the MOS Technology 6502.
Note that the notation in the CODE definitions is 'reverse Polish'
as is all of FORTH. This means that the operand comes before the
operator. Each equivalent of a 'line' of assembly code has a
symbolic operand, then any address mode modifier, and finally the
op-code mnemonic. (Note that words that generate actual machine
code end in a ',' ; i.e. LDA, ). Therefore:
BOT 1+ LDA, in FORTH would be:
LDA 1,X in usual assembler.
And also:
POINTER )Y STA, in FORTH would be:
STA (POINTER),Y in usual assembler.
It takes a bit of getting used to, but reverse Polish assembler
allows full use of FORTH in evaluation of expressions and the easy
generation of the equivalent of macros.
GLOSSARY OF FORTH MODEL
IP address of the Interpretive Pointer in zero-page.
W address of the code field pointer in zero-page.
N address of an 8 byte scratch area in zero-page.
XSAVE address of a temporary register for X in zero-page.
UP address of the User Pointer in zero-page.
.A specify accumulator address mode.
43
# specify immediate mode for machine byte literals.
,X ,Y specify memory indexed address mode.
X) )Y specify indirect memory reference by a zero-page register.
BOT address of low byte of a 16-bit stack item with
,X address mode. X register locates computation
stack in zero-page, relative to address $0000.
BOT 1+ address of the high byte of the bottom stack item
with ,X mode preset.
SEC and SEC 1+ address the second stack item as for BOT.
TSX, move the return stack pointer (which is located in
the CPU machine stack in page-one) to X register.
R address of low byte of return stack with ,X mode preset.
R n + address of the n-th byte of the return stack with ,X
mode preset. Note that the low byte is at low
memory, so 1+ gets the high byte, and 3 + gets
the high byte of the second item of return stack.
PUT address of routine to replace the present computation
stack high byte from accumulator, and put from
the machine stack one byte which replaces the
present low stack byte; continue on to NEXT.
PUSH address of routine to repeat PUT but creating a new
bottom item on the computation stack.
PUSH0A PUT0A address of routine to place the accumulator
at the low stack byte, with the high byte zero.
PUT0A over-writes, while PUSH0A creates new item.
POP POPTWO address of routine to remove one or two 16-bit
items from computation stack.
BINARY address of routine to pop one item and PUT the accumulator
(high) and ML stack (low) over what was second.
SETUP address of a routine to move 16-bit items to zero-page.
Item quantity is in accumulator.
NEXT address of the inner-interpreter, to which all
code routines must return. NEXT fetches
indirectly referred to IP the next compiled
FORTH word address. It then jumps indirectly
to pointed machine code.
44
SCR # 6
0 ( INPUT-OUTPUT, TIM WFR-780519 )
1 CODE EMIT XSAVE STX, BOT 1+ LDA, 7F # AND,
2 72C6 JSR, XSAVE LDX, POP JMP,
3 CODE KEY XSAVE STX, BEGIN, BEGIN, 8 # LDX,
4 BEGIN, 6E02 LDA, .A LSR, CS END, 7320 JSR,
5 BEGIN, 731D JSR, 0 X) CMP, 0 X) CMP, 0 X) CMP,
6 0 X) CMP, 0 X) CMP, 6E02 LDA, .A LSR, PHP, TYA,
7 .A LSR, PLP, CS IF, 80 # ORA, THEN, TAY, DEX,
8 0= END, 731D JSR, FF # EOR, 7F # AND, 0= NOT END,
9 7F # CMP, 0= NOT END, XSAVE LDX, PUSH0A JMP,
10 CODE CR XSAVE STX, 728A JSR, XSAVE LDX, NEXT JMP,
11
12 CODE ?TERMINAL 1 # LDA, 6E02 BIT, 0= NOT IF,
13 BEGIN, 731D JSR, 6E02 BIT, 0= END, INY, THEN,
14 TYA, PUSH0A JMP,
15 DECIMAL ;S
SCR # 7
0 ( INPUT-OUTPUT, APPLE WPR-780730 )
1 CODE HOME FC58 JSR, NEXT JMP,
2 CODE SCROLL FC70 JSR, NEXT JMP,
3
4 HERE ' KEY 2 - ! ( POINT KEY TO HERE )
5 FD0C JSR, 7F # AND, PUSH0A JMP,
6 HERE ' EMIT 2 - ! ( POINT EMIT TO HERE )
7 BOT 1+ LDA, 80 # ORA, FDED JSR, POP JMP,
8 HERE ' CR 2 - ! ( POINT CR TO HERE )
9 FD8E JSR, NEXT JMP,
10 HERE ' ?TERMINAL 2 - ! ( POINT ?TERM TO HERE )
11 C000 BIT, 0<
12 IF, BEGIN, C010 BIT, C000 BIT, 0< NOT END, INY,
13 THEN, TYA, PUSH0A JMP,
14
15 DECIMAL ;S
SCR # 8
0 ( INPUT-OUTPUT, SYM-1 WFR-781015 )
1 HEX
2 CODE KEY 8A58 JSR, 7F # AND, PUSH0A JMP,
3
4 CODE EMIT BOT 1+ LDA, 8A47 JSR, POP JMP,
5
6 CODE CR 834D JSR, NEXT JMP,
7
8 CODE ?TERMINAL ( BREAK TEST FOR ANY KEY )
9 8B3C JSR, CS
10 IF, BEGIN, 8B3C JSR, CS NOT END, INY, THEN,
11 TYA, PUSH0A JMP,
12
13
14
15 DECIMAL ;S
FORTH INTEREST GROUP MAY 1, 1979
45
SCR # 12
0 ( COLD AND WARM ENTRY, USER PARAMETERS WFR-79APR29 )
1 ASSEMBLER OBJECT MEM HEX
2 NOP, HERE JMP, ( WORD ALIGNED VECTOR TO COLD )
3 NOP, HERE JMP, ( WORD ALIGNED VECTOR TO WARM )
4 0000 , 0001 , ( CPU, AND REVISION PARAMETERS )
5 0000 , ( TOPMOST WORD IN FORTH VOCABULARY )
6 7F , ( BACKSPACE CHARACTER )
7 3BA0 , ( INITIAL USER AREA )
8 009E , ( INITIAL TOP OF STACK )
9 01FF , ( INITIAL TOP OF RETURN STACK )
10 0100 , ( TERMINAL INPUT BUFFER )
11 001F , ( INITIAL NAME FIELD WIDTH )
12 0001 , ( INITIAL WARNING = 1 )
13 0200 , ( INITIAL FENCE )
14 0000 , ( COLD START VALUE FOR DP )
15 0000 , ( COLD START VALUE FOR VOC-LINK ) -->
SCR # 13
0 ( START OF NUCLEUS, LIT, PUSH, PUT, NEXT WFR-78DEC26 )
1 CODE LIT ( PUSH FOLLOWING LITERAL TO STACK *)
2 IP )Y LDA, PHA, IP INC, 0= IF, IP 1+ INC, THEN,
3 IP )Y LDA, IP INC, 0= IF, IP 1+ INC, THEN,
4 LABEL PUSH ( PUSH ACCUM AS HI-BYTE, ML STACK AS LO-BYTE *)
5 DEX, DEX,
6 LABEL PUT ( REPLACE BOTTOM WITH ACCUM. AND ML STACK *)
7 BOT 1+ STA, PLA, BOT STA,
8 LABEL NEXT ( EXECUTE NEXT FORTH ADDRESS, MOVING IP *)
9 1 # LDY, IP )Y LDA, W 1+ STA, ( FETCH CODE ADDRESS )
10 DEY, IP )Y LDA, W STA,
11 CLC, IP LDA, 2 # ADC, IP STA, ( MOVE IP AHEAD )
12 CS IF, IP 1+ INC, THEN,
13 W 1 - JMP, ( JUMP INDIR. VIA W THRU CODE FIELD TO CODE )
14
15 -->
SCR # 14
0 ( SETUP WFR-790225 )
1 HERE 2+ , ( MAKE SILENT WORD *)
2 IP )Y LDA, PHA, TYA, 'T LIT 0B + 0= NOT END,
3
4 LABEL SETUP ( MOVE # ITEMS FROM STACK TO 'N' AREA OF Z-PAGE *)
5 .A ASL, N 1 - STA,
6 BEGIN, BOT LDA, N ,Y STA, INX, INY,
7 N 1 - CPY, 0= END, 0 # LDY, RTS,
8
9 CODE EXECUTE ( EXECUTE A WORD BY ITS CODE FIELD *)
10 ( ADDRESS ON THE STACK *)
11 BOT LDA, W STA, BOT 1+ LDA, W 1+ STA,
12 INX, INX, W 1 - JMP,
13
14
15 -->
FORTH INTEREST GROUP MAY 1, 1979
46
SCR # 15
0 ( BRANCH, 0BRANCH W/16-BIT OFFSET WFR-79APR01 )
1 CODE BRANCH ( ADJUST IP BY IN-LINE 16 BIT LITERAL *)
2 CLC, IP )Y LDA, IP ADC, PHA,
3 INY, IP )Y LDA, IP 1+ ADC, IP 1+ STA,
4 PLA, IP STA, NEXT 2+ JMP,
5
6 CODE 0BRANCH ( IF BOT IS ZERO, BRANCH FROM LITERAL *)
7 INX, INX, FE ,X LDA, FF ,X ORA,
8 ' BRANCH 0= NOT END, ( USE 'BRANCH' FOR FALSE )
9 LABEL BUMP: ( TRUE JUST MOVES IP 2 BYTES *)
10 CLC, IP LDA, 2 # ADC, IP STA,
11 CS IF, IP 1+ INC, THEN, NEXT JMP,
12
13 -->
14
15
SCR # 16
0 ( LOOP CONTROL WFR-79MAR20 )
1 CODE (LOOP) ( INCREMENT LOOP INDEX, LOOP UNTIL => LIMIT *)
2 XSAVE STX, TSX, R INC, 0= IF, R 1+ INC, THEN,
3 LABEL L1: CLC, R 2+ LDA, R SBC, R 3 + LDA, R 1+ SBC,
4 LABEL L2: XSAVE LDX, ( LIMIT-INDEX-1 )
5 .A ASL, ' BRANCH CS END, ( BRANCH UNTIL D7 SIGN=1 )
6 PLA, PLA, PLA, PLA, BUMP: JMP, ( ELSE EXIT LOOP )
7
8 CODE (+LOOP) ( INCREMENT INDEX BY STACK VALUE +/- *)
9 INX, INX, XSAVE STX, ( POP INCREMENT )
10 FF ,X LDA, PHA, PHA, FE ,X LDA, TSX, INX, INX,
11 CLC, R ADC, R STA, PLA, R 1 + ADC, R 1 + STA,
12 PLA, L1: 0< END, ( AS FOR POSITIVE INCREMENT )
13 CLC, R LDA, R 2+ SBC, ( INDEX-LIMIT-1 )
14 R 1+ LDA, R 3 + SBC, L2: JMP,
15 -->
SCR # 17
0 ( (DO- WFR-79MAR30 )
1
2 CODE (DO) ( MOVE TWO STACK ITEMS TO RETURN STACK *)
3 SEC 1+ LDA, PHA, SEC LDA, PHA,
4 BOT 1+ LDA, PHA, BOT LDA, PHA,
5
6 LABEL POPTWO INX, INX,
7 LABEL POP INX, INX, NEXT JMP,
8
9 CODE I ( COPY CURRENT LOOP INDEX TO STACK *)
10 ( THIS WILL LATER BE POINTED TO 'R' )
11
12 -->
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
47
SCR # 18
0 ( DIGIT WFR-781202 )
1 CODE DIGIT ( CONVERT ASCII CHAR-SECOND, WITH BASE-BOTTOM *)
2 ( IF OK RETURN DIGIT-SECOND, TRUE-BOTTOM; *)
3 ( OTHERWISE FALSE-BOTTOM. *)
4 SEC, SEC LDA, 30 # SBC,
5 0< NOT IF, 0A # CMP, ( ADJUST FOR ASCII LETTER )
6 0< NOT IF, SEC, 07 # SBC, 0A # CMP,
7 0< NOT IF,
8 SWAP ( AT COMPILE TIME ) THEN, BOT CMP, ( TO BASE )
9 0< IF, SEC STA, 1 # LDA,
10 PHA, TYA, PUT JMP,
11 ( STORE RESULT SECOND AND RETURN TRUE )
12 THEN, THEN, THEN, ( CONVERSION FAILED )
13 TYA, PHA, INX, INX, PUT JMP, ( LEAVE BOOLEAN FALSE )
14
15 -->
SCR # 19
0 ( FIND FOR VARIABLE LENGTH NAMES WFR-790225 )
1 CODE (FIND) ( HERE, NFA ... PFA, LEN BYTE, TRUE; ELSE FALSE *)
2 2 # LDA, SETUP JSR, XSAVE STX,
3 BEGIN, 0 # LDY, N )Y LDA, N 2+ )Y EOR, 3F # AND, 0=
4 IF, ( GOOD ) BEGIN, INY, N )Y LDA, N 2+ )Y EOR, .A ASL, 0=
5 IF, ( STILL GOOD ) SWAP CS ( LOOP TILL D7 SET )
6 END, XSAVE LDX, DEX, DEX, DEX, DEX, CLC,
7 TYA, 5 # ADC, N ADC, SEC STA, 0 # LDY,
8 TYA, N 1+ ADC, SEC 1+ STA, BOT 1+ STY,
9 N )Y LDA, BOT STA, 1 # LDA, PHA, PUSH JMP, ( FALSE )
10 THEN, CS NOT ( AT LAST CHAR? ) IF, SWAP THEN,
11 BEGIN, INY, N )Y LDA, 0< END, ( TO LAST CHAR )
12 THEN, INY, ( TO LINK ) N )Y LDA, TAX, INY,
13 N )Y LDA, N 1+ STA, N STX, N ORA, ( 0 LINK ? )
14 0= END, ( LOOP FOR ANOTHER NAME )
15 XSAVE LDX, 0 # LDA, PHA, PUSH JMP, ( FALSE ) -->
SCR # 20
0 ( ENCLOSE WFR-780926 )
1 CODE ENCLOSE ( ENTER WITH ADDRESS-2, DELIM-1. RETURN WITH *)
2 ( ADDR-4, AND OFFSET TO FIRST CH-3, END WORD-2, NEXT CH-1 *)
3 2 # LDA, SETUP JSR, TXA, SEC, 8 # SBC, TAX,
4 SEC 1+ STY, BOT 1+ STY, ( CLEAR HI BYTES ) DEY,
5 BEGIN, INY, N 2+ )Y LDA, ( FETCH CHAR )
6 N CMP, 0= NOT END, ( STEP OVER LEADING DELIMITERS )
7 BOT 4 + STY, ( SAVE OFFSET TO FIRST CHAR )
8 BEGIN, N 2+ )Y LDA, 0=
9 IF, ( NULL ) SEC STY, ( IN EW ) BOT STY, ( IN NC )
10 TYA, BOT 4 + CMP, 0=
11 IF, ( Y=FC ) SEC INC, ( BUMP EW ) THEN, NEXT JMP,
12 THEN, SEC STY, ( IN EW ) INY, N CMP, ( DELIM ? )
13 0= END, ( IS DELIM ) BOT STY, ( IN NC ) NEXT JMP,
14
15 -->
FORTH INTEREST GROUP MAY 1, 1979
48
SCR # 21
0 ( TERMINAL VECTORS WFR-79MAR30 )
1 ( THESE WORDS ARE CREATED WITH NO EXECUTION CODE, YET.
2 ( THEIR CODE FIELDS WILL BE FILLED WITH THE ADDRESS OF THEIR )
3 ( INSTALLATION SPECIFIC CODE.
4
5 CODE EMIT ( PRINT ASCII VALUE ON BOTTOM OF STACK *)
6
7 CODE KEY ( ACCEPT ONE TERMINAL CHARACTER TO THE STACK *)
8
9 CODE ?TERMINAL ( 'BREAK' LEAVES 1 ON STACK; OTHERWISE 0 *)
10
11 CODE CR ( EXECUTE CAR. RETURN, LINE FEED ON TERMINAL *)
12
13 -->
14
15
SCR # 22
0 ( CMOVE, WFR-79MAR20 )
1 CODE CMOVE ( WITHIN MEMORY; ENTER W/ FROM-3, TO-2, QUAN-1 *)
2 3 # LDA, SETUP JSR, ( MOVE 3 ITEMS TO 'N' AREA )
3 BEGIN, BEGIN, N CPY, 0= ( DECREMENT BYTE COUNTER AT 'N' )
4 IF, N 1+ DEC, 0< ( EXIT WHEN DONE )
5 IF, NEXT JMP, THEN, THEN,
6 N 4 + )Y LDA, N 2+ )Y STA, INY, 0=
7 END, ( LOOP TILL Y WRAPS, 22 CYCLES/BYTE )
8 N 5 + INC, N 3 + INC, ( BUMP HI BYTES OF POINTERS
9 JMP, ( BACK TO FIRST 'BEGIN' )
10
11 -->
12
13
14
15
SCR # 23
0 ( U*, UNSIGNED MULTIPLY FOR 16 BITS RS-WFR-80AUG16 )
1 CODE U* ( 16 BIT MULTIPLICAND-2, 16 BIT MULTIPLIER-1 *)
2 ( 32 BIT UNSIGNED PRODUCT: LO WORD-2, HI WORD-1 *)
3 SEC LDA, N STA, SEC STY,
4 SEC 1+ LDA, N 1+ STA, SEC 1+ STY, ( multiplicand to n )
5 10 # LDY,
6 BEGIN, BOT 2+ ASL, BOT 3 + ROL, BOT ROL, BOT 1+ ROL,
7 ( double product while sampling D15 of multiplier )
8 CS IF, ( set ) CLC,
9 ( add multiplicant to partial product 32 bits )
10 N LDA, BOT 2 + ADC, BOT 2 + STA,
11 N 1+ LDA, BOT 3 + ADC, BOT 3 + STA,
12 CS IF, BOT INC, 0= IF, BOT 1+ INC, ENDIF, ENDIF,
13 ENDIF, DEY, 0= ( corrected for carry bug )
14 UNTIL, NEXT JMP, C;
15 -->
FORTH INTEREST GROUP Aug 23, 1980
49
SCR # 24
0 ( U/, UNSIGNED DIVIDE FOR 31 BITS WFR-79APR29 )
1 CODE U/ ( 31 BIT DIVIDEND-2, -3, 16 BIT DIVISOR-1 *)
2 ( 16 BIT REMAINDER-2, 16 BIT QUOTIENT-1 *)
3 SEC 2 + LDA, SEC LDY, SEC 2 + STY, .A ASL, SEC STA,
4 SEC 3 + LDA, SEC 1+ LDY, SEC 3 + STY, .A ROL, SEC 1+ STA,
5 10 # LDA, N STA,
6 BEGIN, SEC 2 + ROL, SEC 3 + ROL, SEC,
7 SEC 2 + LDA, BOT SBC, TAY,
8 SEC 3 + LDA, BOT 1+ SBC,
9 CS IF, SEC 2+ STY, SEC 3 + STA, THEN,
10 SEC ROL, SEC 1+ ROL,
11 N DEC, 0=
12 END, POP JMP,
13 -->
14
15
SCR # 25
0 ( LOGICALS WFR-79APR20 )
1
2 CODE AND ( LOGICAL BITWISE AND OF BOTTOM TWO ITEMS *)
3 BOT LDA, SEC AND, PHA,
4 BOT 1+ LDA, SEC 1+ AND, INX, INX, PUT JMP,
5
6 CODE OR ( LOGICAL BITWISE 'OR' OF BOTTOM TWO ITEMS *)
7 BOT LDA, SEC ORA, PHA,
8 BOT 1+ LDA, SEC 1 + ORA, INX, INX, PUT JMP,
9
10 CODE XOR ( LOGICAL 'EXCLUSIVE-OR' OF BOTTOM TWO ITEMS *)
11 BOT LDA, SEC EOR, PHA,
12 BOT 1+ LDA, SEC 1+ EOR, INX, INX, PUT JMP,
13
14 -->
15
SCR # 26
0 ( STACK INITIALIZATION WFR-79MAR30 )
1 CODE SP@ ( FETCH STACK POINTER TO STACK *)
2 TXA,
3 LABEL PUSH0A PHA, 0 # LDA, PUSH JMP,
4
5 CODE SP! ( LOAD SP FROM 'S0' *)
6 06 # LDY, UP )Y LDA, TAX, NEXT JMP,
7
8 CODE RP! ( LOAD RP FROM R0 *)
9 XSAVE STX, 08 # LDY, UP )Y LDA, TAX, TXS,
10 XSAVE LDX, NEXT JMP,
11
12 CODE ;S ( RESTORE IP REGISTER FROM RETURN STACK *)
13 PLA, IP STA, PLA, IP 1+ STA, NEXT JMP,
14
15 -->
FORTH INTEREST GROUP MAY 1, 1979
50
SCR # 27
0 ( RETURN STACK WORDS WFR-79MAR29 )
1 CODE LEAVE ( FORCE EXIT OF DO-LOOP BY SETTING LIMIT *)
2 XSAVE STX, TSX, R LDA, R 2+ STA, ( TO INDEX *)
3 R 1+ LDA, R 3 + STA, XSAVE LDX, NEXT JMP,
4
5 CODE >R ( MOVE FROM COMP. STACK TO RETURN STACK *)
6 BOT 1+ LDA, PHA, BOT LDA, PHA, INX, INX, NEXT JMP,
7
8 CODE R> ( MOVE FROM RETURN STACK TO COMP. STACK *)
9 DEX, DEX, PLA, BOT STA, PLA, BOT 1+ STA, NEXT JMP,
10
11 CODE R ( COPY THE BOTTOM OF RETURN STACK TO COMP. STACK *)
12 XSAVE STX, TSX, R LDA, PHA, R 1+ LDA,
13 XSAVE LDX, PUSH JMP,
14 ' R -2 BYTE.IN I !
15 -->
SCR # 28
0 ( TESTS AND LOGICALS WFR-79MAR19 )
1
2 CODE 0= ( REVERSE LOGICAL STATE OF BOTTOM OF STACK *)
3 BOT LDA, BOT 1+ ORA, BOT 1+ STY,
4 0= IF, INY, THEN, BOT STY, NEXT JMP,
5
6 CODE 0< ( LEAVE TRUE IF NEGATIVE; OTHERWISE FALSE *)
7 BOT 1+ ASL, TYA, .A ROL, BOT 1+ STY, BOT STA, NEXT JMP,
8
9
10 -->
11
12
13
14
15
SCR # 29
0 ( MATH WFR-79MAR19 )
1 CODE + ( LEAVE THE SUM OF THE BOTTOM TWO STACK ITEMS *)
2 CLC, BOT LDA, SEC ADC, SEC STA, BOT 1+ LDA, SEC 1+ ADC,
3 SEC 1+ STA, INX, INX, NEXT JMP,
4 CODE D+ ( ADD TWO DOUBLE INTEGERS, LEAVING DOUBLE *)
5 CLC, BOT 2 + LDA, BOT 6 + ADC, BOT 6 + STA,
6 BOT 3 + LDA, BOT 7 + ADC, BOT 7 + STA,
7 BOT LDA, BOT 4 + ADC, BOT 4 + STA,
8 BOT 1 + LDA, BOT 5 + ADC, BOT 5 + STA, POPTWO JMP,
9 CODE MINUS ( TWOS COMPLEMENT OF BOTTOM SINGLE NUMBER *)
10 SEC, TYA, BOT SBC, BOT STA,
11 TYA, BOT 1+ SBC, BOT 1+ STA, NEXT JMP,
12 CODE DMINUS ( TWOS COMPLEMENT OF BOTTOM DOUBLE NUMBER *)
13 SEC, TYA, BOT 2 + SBC, BOT 2 + STA,
14 TYA, BOT 3 + SBC, BOT 3 + STA,
15 1 BYTE.IN MINUS JMP, -->
FORTH INTEREST GROUP MAY 1, 1979
51
SCR # 30
0 ( STACK MANIPULATION WFR-79MAR29 )
1 CODE OVER ( DUPLICATE SECOND ITEM AS NEW BOTTOM *)
2 SEC LDA, PHA, SEC 1+ LDA, PUSH JMP,
3
4 CODE DROP ( DROP BOTTOM STACK ITEM *)
5 POP -2 BYTE.IN DROP ! ( C.F. VECTORS DIRECTLY TO 'POP' )
6
7 CODE SWAP ( EXCHANGE BOTTOM AND SECOND ITEMS ON STACK *)
8 SEC LDA, PHA, BOT LDA, SEC STA,
9 SEC 1+ LDA, BOT 1+ LDY, SEC 1+ STY, PUT JMP,
10
11 CODE DUP ( DUPLICATE BOTTOM ITEM ON STACK *)
12 BOT LDA, PHA, BOT 1+ LDA, PUSH JMP,
13
14 -->
15
SCR # 31
0 ( MEMORY INCREMENT, WFR-79MAR30 )
1
2 CODE +! ( ADD SECOND TO MEMORY 16 BITS ADDRESSED BY BOTTOM *)
3 CLC, BOT X) LDA, SEC ADC, BOT X) STA,
4 BOT INC, 0= IF, BOT 1+ INC, THEN,
5 BOT X) LDA, SEC 1+ ADC, BOT X) STA, POPTWO JMP,
6
7 CODE TOGGLE ( BYTE AT ADDRESS-2, BIT PATTERN-1 ... *)
8 SEC X) LDA, BOT EOR, SEC X) STA, POPTWO JMP,
9
10 -->
11
12
13
14
15
SCR # 32
0 ( MEMORY FETCH AND STORE WFR-781202 )
1 CODE @ ( REPLACE STACK ADDRESS WITH 16 BIT *)
2 BOT X) LDA, PHA, ( CONTENTS OF THAT ADDRESS *)
3 BOT INC, 0= IF, BOT 1+ INC, THEN, BOT X) LDA, PUT JMP,
4
5 CODE C@ ( REPLACE STACK ADDRESS WITH POINTED 8 BIT BYTE *)
6 BOT X) LDA, BOT STA, BOT 1+ STY, NEXT JMP,
7
8 CODE ! ( STORE SECOND AT 16 BITS ADDRESSED BY BOTTOM *)
9 SEC LDA, BOT X) STA, BOT INC, 0= IF, BOT 1+ INC, THEN,
10 SEC 1+ LDA, BOT X) STA, POPTWO JMP,
11
12 CODE C! ( STORE SECOND AT BYTE ADDRESSED BY BOTTOM *)
13 SEC LDA, BOT X) STA, POPTWO JMP,
14
15 DECIMAL ;S
FORTH INTEREST GROUP MAY 1, 1979
52
SCR # 33
0 ( :, ;, WFR-79MAR30 )
1
2 : : ( CREATE NEW COLON-DEFINITION UNTIL ';' *)
3 ?EXEC !CSP CURRENT @ CONTEXT !
4 CREATE ] ;CODE IMMEDIATE
5 IP 1+ LDA, PHA, IP LDA, PHA, CLC, W LDA, 2 # ADC,
6 IP STA, TYA, W 1+ ADC, IP 1+ STA, NEXT JMP,
7
8
9 : ; ( TERMINATE COLON-DEFINITION *)
10 ?CSP COMPILE ;S
11 SMUDGE [ ; IMMEDIATE
12
13
14
15 -->
SCR # 34
0 ( CONSTANT, VARIABLE, USER WFR-79MAR30 )
1 : CONSTANT ( WORD WHICH LATER CREATES CONSTANTS *)
2 CREATE SMUDGE , ;CODE
3 2 # LDY, W )Y LDA, PHA, INY, W )Y LDA, PUSH JMP,
4
5 : VARIABLE ( WORD WHICH LATER CREATES VARIABLES *)
6 CONSTANT ;CODE
7 CLC, W LDA, 2 # ADC, PHA, TYA, W 1+ ADC, PUSH JMP,
8
9
10 : USER ( CREATE USER VARIABLE *)
11 CONSTANT ;CODE
12 2 # LDY, CLC, W )Y LDA, UP ADC, PHA,
13 0 # LDA, UP 1+ ADC, PUSH JMP,
14
15 -->
SCR # 35
0 ( DEFINED CONSTANTS WFR-78MAR22 )
1 HEX
2 00 CONSTANT 0 01 CONSTANT 1
3 02 CONSTANT 2 03 CONSTANT 3
4 20 CONSTANT BL ( ASCII BLANK *)
5 40 CONSTANT C/L ( TEXT CHARACTERS PER LINE *)
6
7 3BE0 CONSTANT FIRST ( FIRST BYTE RESERVED FOR BUFFERS *)
8 4000 CONSTANT LIMIT ( JUST BEYOND TOP OF RAM *)
9 80 CONSTANT B/BUF ( BYTES PER DISC BUFFER *)
10 8 CONSTANT B/SCR ( BLOCKS PER SCREEN = 1024 B/BUF / *)
11
12 00 +ORIGIN
13 : +ORIGIN LITERAL + ; ( LEAVES ADDRESS RELATIVE TO ORIGIN *)
14 -->
15
FORTH INTEREST GROUP MAY 1, 1979
53
SCR # 36
0 ( USER VARIABLES WFR-78APR29 )
1 HEX ( 0 THRU 5 RESERVED, REFERENCED TO $00A0 *)
2 ( 06 USER S0 ) ( TOP OF EMPTY COMPUTATION STACK *)
3 ( 08 USER R0 ) ( TOP OF EMPTY RETURN STACK *)
4 0A USER TIB ( TERMINAL INPUT BUFFER *)
5 0C USER WIDTH ( MAXIMUM NAME FIELD WIDTH *)
6 0E USER WARNING ( CONTROL WARNING MODES *)
7 10 USER FENCE ( BARRIER FOR FORGETTING *)
8 12 USER DP ( DICTIONARY POINTER *)
9 14 USER VOC-LINK ( TO NEWEST VOCABULARY *)
10 16 USER BLK ( INTERPRETATION BLOCK *)
11 18 USER IN ( OFFSET INTO SOURCE TEXT *)
12 1A USER OUT ( DISPLAY CURSOR POSITION *)
13 1C USER SCR ( EDITING SCREEN *)
14 -->
15
SCR # 37
0 ( USER VARIABLES, CONT. WFR-79APR29 )
1 1E USER OFFSET ( POSSIBLY TO OTHER DRIVES *)
2 20 USER CONTEXT ( VOCABULARY FIRST SEARCHED *)
3 22 USER CURRENT ( SEARCHED SECOND, COMPILED INTO *)
4 24 USER STATE ( COMPILATION STATE *)
5 26 USER BASE ( FOR NUMERIC INPUT-OUTPUT *)
6 28 USER DPL ( DECIMAL POINT LOCATION *)
7 2A USER FLD ( OUTPUT FIELD WIDTH *)
8 2C USER CSP ( CHECK STACK POSITION *)
9 2E USER R# ( EDITING CURSOR POSITION *)
10 30 USER HLD ( POINTS TO LAST CHARACTER HELD IN PAD *)
11 -->
12
13
14
15
SCR # 38
0 ( HI-LEVEL MISC. WFR-79APR29 )
1 : 1+ 1 + ; ( INCREMENT STACK NUMBER BY ONE *)
2 : 2+ 2 + ; ( INCREMENT STACK NUMBER BY TWO *)
3 : HERE DP @ ; ( FETCH NEXT FREE ADDRESS IN DICT. *)
4 : ALLOT DP +! ; ( MOVE DICT. POINTER AHEAD *)
5 : , HERE ! 2 ALLOT ; ( ENTER STACK NUMBER TO DICT. *)
6 : C, HERE C! 1 ALLOT ; ( ENTER STACK BYTE TO DICT. *)
7 : - MINUS + ; ( LEAVE DIFF. SEC - BOTTOM *)
8 : = - 0= ; ( LEAVE BOOLEAN OF EQUALITY *)
9 : < - 0< ; ( LEAVE BOOLEAN OF SEC < BOT *)
10 : > SWAP < ; ( LEAVE BOOLEAN OF SEC > BOT *)
11 : ROT >R SWAP R> SWAP ; ( ROTATE THIRD TO BOTTOM *)
12 : SPACE BL EMIT ; ( PRINT BLANK ON TERMINAL *)
13 : -DUP DUP IF DUP ENDIF ; ( DUPLICATE NON-ZERO *)
14 -->
15
FORTH INTEREST GROUP MAY 1, 1979
54
SCR # 39
0 ( VARIABLE LENGTH NAME SUPPORT WFR-79MAR30 )
1 : TRAVERSE ( MOVE ACROSS NAME FIELD *)
2 ( ADDRESS-2, DIRECTION-1, I.E. -1=R TO L, +1=L TO R *)
3 SWAP
4 BEGIN OVER + 7F OVER C@ < UNTIL SWAP DROP ;
5
6 : LATEST CURRENT @ @ ; ( NFA OF LATEST WORD *)
7
8
9 ( FOLLOWING HAVE LITERALS DEPENDENT ON COMPUTER WORD SIZE )
10
11 : LFA 4 - ; ( CONVERT A WORDS PFA TO LFA *)
12 : CFA 2 - ; ( CONVERT A WORDS PFA TO CFA *)
13 : NFA 5 - -1 TRAVERSE ; ( CONVERT A WORDS PFA TO NFA *)
14 : PFA 1 TRAVERSE 5 + ; ( CONVERT A WORDS NFA TO PFA *)
15 -->
SCR # 40
0 ( ERROR PROCEDURES, PER SHIRA WFR-79MAR23 )
1 : !CSP SP@ CSP ! ; ( SAVE STACK POSITION IN 'CSP' *)
2
3 : ?ERROR ( BOOLEAN-2, ERROR TYPE-1, WARN FOR TRUE *)
4 SWAP IF ERROR ELSE DROP ENDIF ;
5
6 : ?COMP STATE @ 0= 11 ?ERROR ; ( ERROR IF NOT COMPILING *)
7
8 : ?EXEC STATE @ 12 ?ERROR ; ( ERROR IF NOT EXECUTING *)
9
10 : ?PAIRS - 13 ?ERROR ; ( VERIFY STACK VALUES ARE PAIRED *)
11
12 : ?CSP SP@ CSP @ - 14 ?ERROR ; ( VERIFY STACK POSITION *)
13
14 : ?LOADING ( VERIFY LOADING FROM DISC *)
15 BLK @ 0= 16 ?ERROR ; -->
SCR # 41
0 ( COMPILE, SMUDGE, HEX, DECIMAL WFR-79APR20 )
1
2 : COMPILE ( COMPILE THE EXECUTION ADDRESS FOLLOWING *)
3 ?COMP R> DUP 2+ >R @ , ;
4
5 : [ 0 STATE ! ; IMMEDIATE ( STOP COMPILATION *)
6
7 : ] C0 STATE ! ; ( ENTER COMPILATION STATE *)
8
9 : SMUDGE LATEST 20 TOGGLE ; ( ALTER LATEST WORD NAME *)
10
11 : HEX 10 BASE ! ; ( MAKE HEX THE IN-OUT BASE *)
12
13 : DECIMAL 0A BASE ! ; ( MAKE DECIMAL THE IN-OUT BASE *)
14 -->
15
FORTH INTEREST GROUP MAY 1, 1979
55
SCR # 42
0 ( ;CODE WFR-79APR20 )
1
2 : (;CODE) ( WRITE CODE FIELD POINTING TO CALLING ADDRESS *)
3 R> LATEST PFA CFA ! ;
4
5
6 : ;CODE ( TERMINATE A NEW DEFINING WORD *)
7 ?CSP COMPILE (;CODE)
8 [COMPILE] [ SMUDGE ; IMMEDIATE
9 -->
10
11
12
13
14
15
SCR # 43
0 ( <BUILD, DOES> WFR-79MAR20 )
1
2 : <BUILDS 0 CONSTANT ; ( CREATE HEADER FOR 'DOES>' WORD *)
3
4 : DOES> ( REWRITE PFA WITH CALLING HI-LEVEL ADDRESS *)
5 ( REWRITE CFA WITH 'DOES>' CODE *)
6 R> LATEST PFA ! ;CODE
7 IP 1+ LDA, PHA, IP LDA, PHA, ( BEGIN FORTH NESTING )
8 2 # LDY, W )Y LDA, IP STA, ( FETCH FIRST PARAM )
9 INY, W )Y LDA, IP 1+ STA, ( AS NEXT INTERP. PTR )
10 CLC, W LDA, 4 # ADC, PHA, ( PUSH ADDRESS OF PARAMS )
11 W 1+ LDA, 00 # ADC, PUSH JMP,
12
13 -->
14
15
SCR # 44
0 ( TEXT OUTPUTS WFR-79APR02 )
1 : COUNT DUP 1+ SWAP C@ ; ( LEAVE TEXT ADDR. CHAR. COUNT *)
2 : TYPE ( TYPE STRING FROM ADDRESS-2, CHAR.COUNT-1 *)
3 -DUP IF OVER + SWAP
4 DO I C@ EMIT LOOP ELSE DROP ENDIF ;
5 : -TRAILING ( ADJUST CHAR. COUNT TO DROP TRAILING BLANKS *)
6 DUP 0 DO OVER OVER + 1 - C@
7 BL - IF LEAVE ELSE 1 - ENDIF LOOP ;
8 : (.") ( TYPE IN-LINE STRING, ADJUSTING RETURN *)
9 R COUNT DUP 1+ R> + >R TYPE ;
10
11
12 : ." 22 STATE @ ( COMPILE OR PRINT QUOTED STRING *)
13 IF COMPILE (.") WORD HERE C@ 1+ ALLOT
14 ELSE WORD HERE COUNT TYPE ENDIF ;
15 IMMEDIATE -->
FORTH INTEREST GROUP MAY 1, 1979
56
SCR # 45
0 ( TERMINAL INPUT WFR-79APR29 )
1
2 : EXPECT ( TERMINAL INPUT MEMORY-2, CHAR LIMIT-1 *)
3 OVER + OVER DO KEY DUP 0E +ORIGIN ( BS ) @ =
4 IF DROP 08 OVER I = DUP R> 2 - + >R -
5 ELSE ( NOT BS ) DUP 0D =
6 IF ( RET ) LEAVE DROP BL 0 ELSE DUP ENDIF
7 I C! 0 I 1+ !
8 ENDIF EMIT LOOP DROP ;
9 : QUERY TIB @ 50 EXPECT 0 IN ! ;
10 8081 HERE
11 : X BLK @ ( END-OF-TEXT IS NULL *)
12 IF ( DISC ) 1 BLK +! 0 IN ! BLK @ 7 AND 0=
13 IF ( SCR END ) ?EXEC R> DROP ENDIF ( disc dependent )
14 ELSE ( TERMINAL ) R> DROP
15 ENDIF ; ! IMMEDIATE -->
SCR # 46
0 ( FILL, ERASE, BLANKS, HOLD, PAD WFR-79APR02 )
1 : FILL ( FILL MEMORY BEGIN-3, QUAN-2, BYTE-1 *)
2 SWAP >R OVER C! DUP 1+ R> 1 - CMOVE ;
3
4 : ERASE ( FILL MEMORY WITH ZEROS BEGIN-2, QUAN-1 *)
5 0 FILL ;
6
7 : BLANKS ( FILL WITH BLANKS BEGIN-2, QUAN-1 *)
8 BL FILL ;
9
10 : HOLD ( HOLD CHARACTER IN PAD *)
11 -1 HLD +! HLD @ C! ;
12
13 : PAD HERE 44 + ; ( PAD IS 68 BYTES ABOVE HERE *)
14 ( DOWNWARD HAS NUMERIC OUTPUTS; UPWARD MAY HOLD TEXT *)
15 -->
SCR # 47
0 ( WORD, WFR-79APR02 )
1 : WORD ( ENTER WITH DELIMITER, MOVE STRING TO 'HERE' *)
2 BLK @ IF BLK @ BLOCK ELSE TIB @ ENDIF
3 IN @ + SWAP ( ADDRESS-2, DELIMITER-1 )
4 ENCLOSE ( ADDRESS-4, START-3, END-2, TOTAL COUNT-1 )
5 HERE 22 BLANKS ( PREPARE FIELD OF 34 BLANKS )
6 IN +! ( STEP OVER THIS STRING )
7 OVER - >R ( SAVE CHAR COUNT )
8 R HERE C! ( LENGTH STORED FIRST )
9 + HERE 1+
10 R> CMOVE ; ( MOVE STRING FROM BUFFER TO HERE+1 )
11
12
13
14
15 -->
FORTH INTEREST GROUP MAY 1, 1979
57
SCR # 48
0 ( (NUMBER-, NUMBER, -FIND, WFR-79APR29 )
1 : (NUMBER) ( CONVERT DOUBLE NUMBER, LEAVING UNCONV. ADDR. *)
2 BEGIN 1+ DUP >R C@ BASE @ DIGIT
3 WHILE SWAP BASE @ U* DROP ROT BASE @ U* D+
4 DPL @ 1+ IF 1 DPL +! ENDIF R> REPEAT R> ;
5
6 : NUMBER ( ENTER W/ STRING ADDR. LEAVE DOUBLE NUMBER *)
7 0 0 ROT DUP 1+ C@ 2D = DUP >R + -1
8 BEGIN DPL ! (NUMBER) DUP C@ BL -
9 WHILE DUP C@ 2E - 0 ?ERROR 0 REPEAT
10 DROP R> IF DMINUS ENDIF ;
11
12 : -FIND ( RETURN PFA-3, LEN BYTE-2, TRUE-1; ELSE FALSE *)
13 BL WORD HERE CONTEXT @ @ (FIND)
14 DUP 0= IF DROP HERE LATEST (FIND) ENDIF ;
15 -->
SCR # 49
0 ( ERROR HANDLER WFR-79APR20 )
1
2 : (ABORT) ABORT ; ( USER ALTERABLE ERROR ABORT *)
3
4 : ERROR ( WARNING: -1=ABORT, 0=NO DISC, 1-DISC *)
5 WARNING @ 0< ( PRINT TEXT LINE REL TO SCR #4 *)
6 IF (ABORT) ENDIF HERE COUNT TYPE ." ? "
7 MESSAGE SP! IN @ BLK @ QUIT ;
8
9 : ID. ( PRINT NAME FIELD FROM ITS HEADER ADDRESS *)
10 PAD 020 5F FILL DUP PFA LFA OVER -
11 PAD SWAP CMOVE PAD COUNT 01F AND TYPE SPACE ;
12 -->
13
14
15
SCR # 50
0 ( CREATE WFR-79APR28 )
1
2 : CREATE ( A SMUDGED CODE HEADER TO PARAM FIELD *)
3 ( WARNING IF DUPLICATING A CURRENT NAME *)
4 TIB HERE 0A0 + < 2 ?ERROR ( 6502 only )
5 -FIND ( CHECK IF UNIQUE IN CURRENT AND CONTEXT )
6 IF ( WARN USER ) DROP NFA ID.
7 4 MESSAGE SPACE ENDIF
8 HERE DUP C@ WIDTH @ MIN 1+ ALLOT
9 DP C@ 0FD = ALLOT ( 6502 only )
10 DUP A0 TOGGLE HERE 1 - 80 TOGGLE ( DELIMIT BITS )
11 LATEST , CURRENT @ !
12 HERE 2+ , ;
13 -->
14
15
FORTH INTEREST GROUP MAY 1, 1979
58
SCR # 51
0 ( LITERAL, DLITERAL, [COMPILE], ?STACK WFR-79APR29 )
1
2 : [COMPILE] ( FORCE COMPILATION OF AN IMMEDIATE WORD *)
3 -FIND 0= 0 ?ERROR DROP CFA , ; IMMEDIATE
4
5 : LITERAL ( IF COMPILING, CREATE LITERAL *)
6 STATE @ IF COMPILE LIT , ENDIF ; IMMEDIATE
7
8 : DLITERAL ( IF COMPILING, CREATE DOUBLE LITERAL *)
9 STATE @ IF SWAP [COMPILE] LITERAL
10 [COMPILE] LITERAL ENDIF ; IMMEDIATE
11
12 ( FOLLOWING DEFINITION IS INSTALLATION DEPENDENT )
13 : ?STACK ( QUESTION UPON OVER OR UNDERFLOW OF STACK *)
14 09E SP@ < 1 ?ERROR SP@ 020 < 7 ?ERROR ;
15 -->
SCR # 52
0 ( INTERPRET, WFR-79APR18 )
1
2 : INTERPRET ( INTERPRET OR COMPILE SOURCE TEXT INPUT WORDS *)
3 BEGIN -FIND
4 IF ( FOUND ) STATE @ <
5 IF CFA , ELSE CFA EXECUTE ENDIF ?STACK
6 ELSE HERE NUMBER DPL @ 1+
7 IF [COMPILE] DLITERAL
8 ELSE DROP [COMPILE] LITERAL ENDIF ?STACK
9 ENDIF AGAIN ;
10 -->
11
12
13
14
15
SCR # 53
0 ( IMMEDIATE, VOCAB, DEFIN, FORTH, ( DJK-WFR-79APR29 )
1 : IMMEDIATE ( TOGGLE PREC. BIT OF LATEST CURRENT WORD *)
2 LATEST 40 TOGGLE ;
3
4 : VOCABULARY ( CREATE VOCAB WITH 'V-HEAD' AT VOC INTERSECT. *)
5 <BUILDS A081 , CURRENT @ CFA ,
6 HERE VOC-LINK @ , VOC-LINK !
7 DOES> 2+ CONTEXT ! ;
8
9 VOCABULARY FORTH IMMEDIATE ( THE TRUNK VOCABULARY *)
10
11 : DEFINITIONS ( SET THE CONTEXT ALSO AS CURRENT VOCAB *)
12 CONTEXT @ CURRENT ! ;
13
14 : ( ( SKIP INPUT TEXT UNTIL RIGHT PARENTHESIS *)
15 29 WORD ; IMMEDIATE -->
FORTH INTEREST GROUP MAY 1, 1979
59
SCR # 54
0 ( QUIT, ABORT WFR-79MAR30 )
1
2 : QUIT ( RESTART, INTERPRET FROM TERMINAL *)
3 0 BLK ! [COMPILE] [
4 BEGIN RP! CR QUERY INTERPRET
5 STATE @ 0= IF ." OK" ENDIF AGAIN ;
6
7 : ABORT ( WARM RESTART, INCLUDING REGISTERS *)
8 SP! DECIMAL DR0
9 CR ." FORTH-65 V 4.0"
10 [COMPILE] FORTH DEFINITIONS QUIT ;
11
12
13 -->
14
15
SCR # 55
0 ( COLD START WFR-79APR29 )
1 CODE COLD ( COLD START, INITIALIZING USER AREA *)
2 HERE 02 +ORIGIN ! ( POINT COLD ENTRY TO HERE )
3 0C +ORIGIN LDA, 'T FORTH 4 + STA, ( FORTH VOCAB. )
4 0D +ORIGIN LDA, 'T FORTH 5 + STA,
5 15 # LDY, ( INDEX TO VOC-LINK ) 0= IF, ( FORCED )
6 HERE 06 +ORIGIN ! ( POINT RE-ENTRY TO HERE )
7 0F # LDY, ( INDEX TO WARNING ) THEN, ( FROM IF, )
8 10 +ORIGIN LDA, UP STA, ( LOAD UP )
9 11 +ORIGIN LDA, UP 1+ STA,
10 BEGIN, 0C +ORIGIN ,Y LDA, ( FROM LITERAL AREA )
11 UP )Y STA, ( TO USER AREA )
12 DEY, 0< END,
13 'T ABORT 100 /MOD # LDA, IP 1+ STA,
14 # LDA, IP STA,
15 6C # LDA, W 1 - STA, 'T RP! JMP, ( RUN ) -->
SCR # 56
0 ( MATH UTILITY DJK-WFR-79APR29 )
1 CODE S->D ( EXTEND SINGLE INTEGER TO DOUBLE *)
2 BOT 1+ LDA, 0< IF, DEY, THEN, TYA, PHA, PUSH JMP,
3
4 : +- 0< IF MINUS ENDIF ; ( APPLY SIGN TO NUMBER BENEATH *)
5
6 : D+- ( APPLY SIGN TO DOUBLE NUMBER BENEATH *)
7 0< IF DMINUS ENDIF ;
8
9 : ABS DUP +- ; ( LEAVE ABSOLUTE VALUE *)
10 : DABS DUP D+- ; ( DOUBLE INTEGER ABSOLUTE VALUE *)
11
12 : MIN ( LEAVE SMALLER OF TWO NUMBERS *)
13 OVER OVER > IF SWAP ENDIF DROP ;
14 : MAX ( LEAVE LARGER OF TWO NUMBERS *)
15 OVER OVER < IF SWAP ENDIF DROP ; -->
FORTH INTEREST GROUP MAY 1, 1979
60
SCR # 57
0 ( MATH PACKAGE DJK-WFR-79APR29 )
1 : M* ( LEAVE SIGNED DOUBLE PRODUCT OF TWO SINGLE NUMBERS *)
2 OVER OVER XOR >R ABS SWAP ABS U* R> D+- ;
3 : M/ ( FROM SIGNED DOUBLE-3-2, SIGNED DIVISOR-1 *)
4 ( LEAVE SIGNED REMAINDER-2, SIGNED QUOTIENT-1 *)
5 OVER >R >R DABS R ABS U/
6 R> R XOR +- SWAP R> +- SWAP ;
7 : * U* DROP ; ( SIGNED PRODUCT *)
8 : /MOD >R S->D R> M/ ; ( LEAVE REM-2, QUOT-1 *)
9 : / /MOD SWAP DROP ; ( LEAVE QUOTIENT *)
10 : MOD /MOD DROP ; ( LEAVE REMAINDER *)
11 : */MOD ( TAKE RATION OF THREE NUMBERS, LEAVING *)
12 >R M* R> M/ ; ( REM-2, QUOTIENT-1 *)
13 : */ */MOD SWAP DROP ; ( LEAVE RATIO OF THREE NUMBS *)
14 : M/MOD ( DOUBLE, SINGLE DIVISOR ... REMAINDER, DOUBLE *)
15 >R 0 R U/ R> SWAP >R U/ R> ; -->
SCR # 58
0 ( DISC UTILITY, GENERAL USE WFR-79APR02 )
1 FIRST VARIABLE USE ( NEXT BUFFER TO USE, STALEST *)
2 FIRST VARIABLE PREV ( MOST RECENTLY REFERENCED BUFFER *)
3
4 : +BUF ( ADVANCE ADDRESS-1 TO NEXT BUFFER. RETURNS FALSE *)
5 84 ( I.E. B/BUF+4 ) + DUP LIMIT = ( IF AT PREV *)
6 IF DROP FIRST ENDIF DUP PREV @ - ;
7
8 : UPDATE ( MARK THE BUFFER POINTED TO BY PREV AS ALTERED *)
9 PREV @ @ 8000 OR PREV @ ! ;
10
11 : EMPTY-BUFFERS ( CLEAR BLOCK BUFFERS; DON'T WRITE TO DISC *)
12 FIRST LIMIT OVER - ERASE ;
13
14 : DR0 0 OFFSET ! ; ( SELECT DRIVE #0 *)
15 : DR1 07D0 OFFSET ! ; --> ( SELECT DRIVE #1 *)
SCR # 59
0 ( BUFFER WFR-79APR02 )
1 : BUFFER ( CONVERT BLOCK# TO STORAGE ADDRESS *)
2 USE @ DUP >R ( BUFFER ADDRESS TO BE ASSIGNED )
3 BEGIN +BUF UNTIL ( AVOID PREV ) USE ! ( FOR NEXT TIME )
4 R @ 0< ( TEST FOR UPDATE IN THIS BUFFER )
5 IF ( UPDATED, FLUSH TO DISC )
6 R 2+ ( STORAGE LOC. )
7 R @ 7FFF AND ( ITS BLOCK # )
8 0 R/W ( WRITE SECTOR TO DISC )
9 ENDIF
10 R ! ( WRITE NEW BLOCK # INTO THIS BUFFER )
11 R PREV ! ( ASSIGN THIS BUFFER AS 'PREV' )
12 R> 2+ ( MOVE TO STORAGE LOCATION ) ;
13
14 -->
15
FORTH INTEREST GROUP MAY 1, 1979
61
SCR # 60
0 ( BLOCK WFR-79APR02 )
1 : BLOCK ( CONVERT BLOCK NUMBER TO ITS BUFFER ADDRESS *)
2 OFFSET @ + >R ( RETAIN BLOCK # ON RETURN STACK )
3 PREV @ DUP @ R - DUP + ( BLOCK = PREV ? )
4 IF ( NOT PREV )
5 BEGIN +BUF 0= ( TRUE UPON REACHING 'PREV' )
6 IF ( WRAPPED ) DROP R BUFFER
7 DUP R 1 R/W ( READ SECTOR FROM DISC )
8 2 - ( BACKUP )
9 ENDIF
10 DUP @ R - DUP + 0=
11 UNTIL ( WITH BUFFER ADDRESS )
12 DUP PREV !
13 ENDIF
14 R> DROP 2+ ;
15 -->
SCR # 61
0 ( TEXT OUTPUT FORMATTING WFR-79MAY03 )
1
2 : (LINE) ( LINE#, SCR#, ... BUFFER ADDRESS, 64 COUNT *)
3 >R C/L B/BUF */MOD R> B/SCR * +
4 BLOCK + C/L ;
5
6 : .LINE ( LINE#, SCR#, ... PRINTED *)
7 (LINE) -TRAILING TYPE ;
8
9 : MESSAGE ( PRINT LINE RELATIVE TO SCREEN #4 OF DRIVE 0 *)
10 WARNING @
11 IF ( DISC IS AVAILABLE )
12 -DUP IF 4 OFFSET @ B/SCR / - .LINE ENDIF
13 ELSE ." MSG # " . ENDIF ;
14 -->
15
SCR # 62
0 ( LOAD, --> WFR-79APR02 )
1
2 : LOAD ( INTERPRET SCREENS FROM DISC *)
3 BLK @ >R IN @ >R 0 IN ! B/SCR * BLK !
4 INTERPRET R> IN ! R> BLK ! ;
5
6 : --> ( CONTINUE INTERPRETATION ON NEXT SCREEN *)
7 ?LOADING 0 IN ! B/SCR BLK @ OVER
8 MOD - BLK +! ; IMMEDIATE
9
10 -->
11
12
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
62
SCR # 63
0 ( INSTALLATION DEPENDENT TERMINAL I-O, TIM WFR-79APR26 )
1 ( EMIT ) ASSEMBLER
2 HERE -2 BYTE.IN EMIT ! ( VECTOR EMITS' CF TO HERE )
3 XSAVE STX, BOT LDA, 7F # AND, 72C6 JSR, XSAVE LDX,
4 CLC, 1A # LDY, UP )Y LDA, 01 # ADC, UP )Y STA,
5 INY, UP )Y LDA, 00 # ADC, UP )Y STA, POP JMP,
6 ( AND INCREMENT 'OUT' )
7 ( KEY )
8 HERE -2 BYTE.IN KEY ! ( VECTOR KEYS' CF TO HERE )
9 XSAVE STX, BEGIN, 8 # LDX,
10 BEGIN, 6E02 LDA, .A LSR, CS END, 7320 JSR,
11 BEGIN, 731D JSR, 0 X) CMP, 0 X) CMP, 0 X) CMP,
12 0 X) CMP, 0 X) CMP, 6E02 LDA, .A LSR, PHP, TYA,
13 .A LSR, PLP, CS IF, 80 # ORA, THEN, TAY, DEX,
14 0= END, 731D JSR, FF # EOR, 7F # AND, 0= NOT END,
15 XSAVE LDX, PUSH0A JMP, -->
SCR # 64
0 ( INSTALLATION DEPENDENT TERMINAL I-O, TIM WFR-79APR02 )
1
2 ( ?TERMINAL )
3 HERE -2 BYTE.IN ?TERMINAL ! ( VECTOR LIKEWISE )
4 1 # LDA, 6E02 BIT, 0= NOT IF,
5 BEGIN, 731D JSR, 6E02 BIT, 0= END, INY, THEN,
6 TYA, PUSH0A JMP,
7
8 ( CR )
9 HERE -2 BYTE.IN CR ! ( VECTOR CRS' CF TO HERE )
10 XSAVE STX, 728A JSR, XSAVE LDX, NEXT JMP,
11
12 -->
13
14
15
SCR # 65
0 ( INSTALLATION DEPENDENT DISC WFR-79APR02 )
1 6900 CONSTANT DATA ( CONTROLLER PORT *)
2 6901 CONSTANT STATUS ( CONTROLLER PORT *)
3
4
5 : #HL ( CONVERT DECIMAL DIGIT FOR DISC CONTROLLER *)
6 0 0A U/ SWAP 30 + HOLD ;
7
8 -->
9
10
11
12
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
63
SCR # 66
0 ( D/CHAR, ?DISC, WFR-79MAR23 )
1 CODE D/CHAR ( TEST CHAR-1. EXIT TEST BOOL-2, NEW CHAR-1 *)
2 DEX, DEX, BOT 1+ STY, C0 # LDA,
3 BEGIN, STATUS BIT, 0= NOT END, ( TILL CONTROL READY )
4 DATA LDA, BOT STA, ( SAVE CHAR )
5 SEC CMP, 0= IF, INY, THEN, SEC STY, NEXT JMP,
6
7 : ?DISC ( UPON NAK SHOW ERR MSG, QUIT. ABSORBS TILL *)
8 1 D/CHAR >R 0= ( EOT, EXCEPT FOR SOH *)
9 IF ( NOT SOH ) R 15 =
10 IF ( NAK ) CR
11 BEGIN 4 D/CHAR EMIT
12 UNTIL ( PRINT ERR MSG TIL EOT ) QUIT
13 ENDIF ( FOR ENQ, ACK )
14 BEGIN 4 D/CHAR DROP UNTIL ( AT EOT )
15 ENDIF R> DROP ; -->
SCR # 67
0 ( BLOCK-WRITE WFR-790103 )
1 CODE BLOCK-WRITE ( SEND TO DISC FROM ADDRESS-2, COUNT-1 *)
2 2 # LDA, SETUP JSR, ( WITH EOT AT END *)
3 BEGIN, 02 # LDA,
4 BEGIN, STATUS BIT, 0= END, ( TILL IDLE )
5 N CPY, 0=
6 IF, ( DONE ) 04 # LDA, STATUS STA, DATA STA,
7 NEXT JMP,
8 THEN,
9 N 2+ )Y LDA, DATA STA, INY,
10 0= END, ( FORCED TO BEGIN )
11
12 -->
13
14
15
SCR # 68
0 ( BLOCK-READ, WFR-790103 )
1
2 CODE BLOCK-READ ( BUF.ADDR-1. EXIT AT 128 CHAR OR CONTROL *)
3 1 # LDA, SETUP JSR,
4 BEGIN, C0 # LDA,
5 BEGIN, STATUS BIT, 0= NOT END, ( TILL FLAG )
6 50 ( BVC, D6=DATA )
7 IF, DATA LDA, N )Y STA, INY, SWAP
8 0< END, ( LOOP TILL 128 BYTES )
9 THEN, ( OR D6=0, SO D7=1, )
10 NEXT JMP,
11
12 -->
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
64
SCR # 69
0 ( R/W FOR PERSCI 1070 CONTROLLER WFR-79MAY03 )
1 0A ALLOT HERE ( WORKSPACE TO PREPARE DISC CONTROL TEXT )
2 ( IN FORM: C TT SS /D, TT=TRACK, SS=SECTOR, D=DRIVE )
3 ( C = 1 TO READ, 0 TO WRITE *)
4 : R/W ( READ/WRITE DISC BLOCK *)
5 ( BUFFER ADDRESS-3, BLOCK #-2, 1=READ 0=WRITE *)
6 LITERAL HLD ! ( JUST AFTER WORKSPACE ) SWAP
7 0 OVER > OVER 0F9F > OR 6 ?ERROR
8 07D0 ( 2000 SECT/DR ) /MOD #HL DROP 2F HOLD BL HOLD
9 1A /MOD SWAP 1+ #HL #HL DROP BL HOLD ( SECTOR 01-26 )
1O #HL #HL DROP BL HOLD ( TRACK 00-76 )
11 DUP
12 IF 49 ( 1=READ) ELSE 4F ( 0=WRITE ) ENDIF
13 HOLD HLD @ 0A BLOCK-WRITE ( SEND TEXT ) ?DISC
14 IF BLOCK-READ ELSE B/BUF BLOCK-WRITE ENDIF
15 ?DISC ; -->
SCR # 70
0 ( FORWARD REFERENCES WFR-79MAR30 )
1 00 BYTE.IN : REPLACED.BY ?EXEC
2 02 BYTE.IN : REPLACED.BY !CSP
3 04 BYTE.IN : REPLACED.BY CURRENT
4 08 BYTE.IN : REPLACED.BY CONTEXT
5 0C BYTE.IN : REPLACED.BY CREATE
6 0E BYTE.IN : REPLACED.BY ]
7 10 BYTE.IN : REPLACED.BY (;CODE)
8 00 BYTE.IN ; REPLACED.BY ?CSP
9 02 BYTE.IN ; REPLACED.BY COMPILE
10 06 BYTE.IN ; REPLACED.BY SMUDGE
11 08 BYTE.IN ; REPLACED.BY [
12 00 BYTE.IN CONSTANT REPLACED.BY CREATE
13 02 BYTE.IN CONSTANT REPLACED.BY SMUDGE
14 04 BYTE.IN CONSTANT REPLACED.BY ,
15 06 BYTE.IN CONSTANT REPLACED.BY (;CODE) -->
SCR # 71
0 ( FORWARD REFERENCES WFR-79APR29 )
1 02 BYTE.IN VARIABLE REPLACED.BY (;CODE)
2 02 BYTE.IN USER REPLACED.BY (;CODE)
3 06 BYTE.IN ?ERROR REPLACED.BY ERROR
4 0F BYTE.IN ." REPLACED.BY WORD
5 1D BYTE.IN ." REPLACED.BY WORD
6 00 BYTE.IN (ABORT) REPLACED.BY ABORT
7 19 BYTE.IN ERROR REPLACED.BY MESSAGE
8 25 BYTE.IN ERROR REPLACED.BY QUIT
9 0C BYTE.IN WORD REPLACED.BY BLOCK
10 1E BYTE.IN CREATE REPLACED.BY MESSAGE
11 2C BYTE.IN CREATE REPLACED.BY MIN
12 04 BYTE.IN ABORT REPLACED.BY DR0
13 2C BYTE.IN BUFFER REPLACED.BY R/W
14 30 BYTE.IN BLOCK REPLACED.BY R/W DECIMAL ;S
15
FORTH INTEREST GROUP MAY 1, 1979
65
SCR # 72
0 ( ', FORGET, \ WFR-79APR28 )
1 HEX 3 WIDTH
2 : ' ( FIND NEXT WORDS PFA; COMPILE IT, IF COMPILING *)
3 -FIND 0= 0 ?ERROR DROP [COMPILE] LITERAL ;
4 IMMEDIATE
5
6 : FORGET ( FOLLOWING WORD FROM CURRENT VOCABULARY *)
7 CURRENT @ CONTEXT @ - 18 ?ERROR
8 [COMPILE] ' DUP FENCE @ < 15 ?ERROR
9 DUP NFA DP ! LFA @ CURRENT @ ! ;
10
11
12
13 -->
14
15
SCR # 73
0 ( CONDITIONAL COMPILER, PER SHIRA WFR-79APR01 )
1 : BACK HERE - , ; ( RESOLVE BACKWARD BRANCH *)
2
3 : BEGIN ?COMP HERE 1 ; IMMEDIATE
4
5 : ENDIF ?COMP 2 ?PAIRS HERE OVER - SWAP ! ; IMMEDIATE
6
7 : THEN [COMPILE] ENDIF ; IMMEDIATE
8
9 : DO COMPILE (DO) HERE 3 ; IMMEDIATE
10
11 : LOOP 3 ?PAIRS COMPILE (LOOP) BACK ; IMMEDIATE
12
13 : +LOOP 3 ?PAIRS COMPILE (+LOOP) BACK ; IMMEDIATE
14
15 : UNTIL 1 ?PAIRS COMPILE 0BRANCH BACK ; IMMEDIATE -->
SCR # 74
0 ( CONDITIONAL COMPILER WFR-79APR01 )
1 : END [COMPILE] UNTIL ; IMMEDIATE
2
3 : AGAIN 1 ?PAIRS COMPILE BRANCH BACK ; IMMEDIATE
4
5 : REPEAT >R >R [COMPILE] AGAIN
6 R> R> 2 - [COMPILE] ENDIF ; IMMEDIATE
7
8 : IF COMPILE 0BRANCH HERE 0 , 2 ; IMMEDIATE
9
10 : ELSE 2 ?PAIRS COMPILE BRANCH HERE 0 ,
11 SWAP 2 [COMPILE] ENDIF 2 ; IMMEDIATE
12
13 : WHILE [COMPILE] IF 2+ ; IMMEDIATE
14
15 -->
FORTH INTEREST GROUP MAY 1, 1979
66
SCR # 75
0 ( NUMERIC PRIMITIVES WFR-79APR01 )
1 : SPACES 0 MAX -DUP IF 0 DO SPACE LOOP ENDIF ;
2
3 : <# PAD HLD ! ;
4
5 : #> DROP DROP HLD @ PAD OVER - ;
6
7 : SIGN ROT 0< IF 2D HOLD ENDIF ;
8
9 : # ( CONVERT ONE DIGIT, HOLDING IN PAD * )
10 BASE @ M/MOD ROT 9 OVER < IF 7 + ENDIF 30 + HOLD ;
11
12 : #S BEGIN # OVER OVER OR 0= UNTIL ;
13 -->
14
15
SCR # 76
0 ( OUTPUT OPERATORS WFR-79APR20 )
1 : D.R ( DOUBLE INTEGER OUTPUT, RIGHT ALIGNED IN FIELD *)
2 >R SWAP OVER DABS <# #S SIGN #>
3 R> OVER - SPACES TYPE ;
4
5 : D. 0 D.R SPACE ; ( DOUBLE INTEGER OUTPUT *)
6
7 : .R >R S->D R> D.R ; ( ALIGNED SINGLE INTEGER *)
8
9 : . S->D D. ; ( SINGLE INTEGER OUTPUT *)
10
11 : ? @ . ; ( PRINT CONTENTS OF MEMORY *)
12
13 . CFA MESSAGE 2A + ! ( PRINT MESSAGE NUMBER )
14 -->
15
SCR # 77
0 ( PROGRAM DOCUMENTATION WFR-79APR20 )
1 HEX
2 : LIST ( LIST SCREEN BY NUMBER ON STACK *)
3 DECIMAL CR DUP SCR !
4 ." SCR # " . 10 0 DO CR I 3 .R SPACE
5 I SCR @ .LINE LOOP CR ;
6
7 : INDEX ( PRINT FIRST LINE OF EACH SCREEN FROM-2, TO-1 *)
8 0C EMIT ( FORM FEED ) CR 1+ SWAP
9 DO CR I 3 .R SPACE
10 0 I .LINE
11 ?TERMINAL IF LEAVE ENDIF LOOP ;
12 : TRIAD ( PRINT 3 SCREENS ON PAGE, CONTAINING # ON STACK *)
13 0C EMIT ( FF ) 3 / 3 * 3 OVER + SWAP
14 DO CR I LIST LOOP CR
15 0F MESSAGE CR ; DECIMAL -->
FORTH INTEREST GROUP MAY 1, 1979
67
SCR # 78
0 ( TOOLS WPR-79APR20 )
1 HEX
2 : VLIST ( LIST CONTEXT VOCABULARY *)
3 80 OUT ! CONTEXT @ @
4 BEGIN OUT @ C/L > IF CR 0 OUT ! ENDIF
5 DUP ID. SPACE SPACE PFA LFA @
6 DUP 0= ?TERMINAL OR UNTIL DROP ;
7 -->
8
9
10
11
12
13
14
15
SCR # 79
0 ( TOOLS WFR-79MAY03 )
1 HEX
2
3 CREATE MON ( CALL MONITOR, SAVING RE-ENTRY TO FORTH *)
4 0 C, 4C C, ' LIT 18 + , SMUDGE
5
6
7
8
9
10 DECIMAL
11 HERE FENCE !
12 HERE 28 +ORIGIN ! ( COLD START FENCE )
13 HERE 30 +ORIGIN ! ( COLD START DP )
14 LATEST 12 +ORIGIN ! ( TOPMOST WORD )
15 ' FORTH 6 + 32 +ORIGIN ! ( COLD VOC-LINK ) ;S
SCR # 80
0 -->
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
68
LINE EDITOR
This is a sample editor, compatible with the fig-FORTH model and
simple terminal devices. The line and screen editing functions are
portable. The code definition for the string MATCH could be written
high level or translated.
69
70
SCR # 87
0 ( TEXT, LINE WFR-79MAY01 )
1 FORTH DEFINITIONS HEX
2 : TEXT ( ACCEPT FOLLOWING TEXT TO PAD *)
3 HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ;
4
5 : LINE ( RELATIVE TO SCR, LEAVE ADDRESS OF LINE *)
6 DUP FFF0 AND 17 ?ERROR ( KEEP ON THIS SCREEN )
7 SCR @ (LINE) DROP ;
8 -->
9
10
11
12
13
14
15
SCR # 88
0 ( LINE EDITOR WFR-79MAY03 )
1 VOCABULARY EDITOR IMMEDIATE HEX
2 : WHERE ( PRINT SCREEN # AND IMAGE OF ERROR *)
3 DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL .
4 SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE
5 CR HERE C@ - SPACES 5E EMIT [COMPILE] EDITOR QUIT ;
6
7 EDITOR DEFINITIONS
8 : #LOCATE ( LEAVE CURSOR OFFSET-2, LINE-1 *)
9 R# @ C/L /MOD ;
10 : #LEAD ( LINE ADDRESS-2, OFFSET-1 TO CURSOR *)
11 #LOCATE LINE SWAP ;
12 : #LAG ( CURSOR ADDRESS-2, COUNT-1 AFTER CURSOR *)
13 #LEAD DUP >R + C/L R> - ;
14 : -MOVE ( MOVE IN BLOCK BUFFER ADDR FROM-2, LINE TO-1 *)
15 LINE C/L CMOVE UPDATE ; -->
SCR # 89
0 ( LINE EDITING COMMANDS WFR-79MAY03 )
1 : H ( HOLD NUMBERED LINE AT PAD *)
2 LINE PAD 1+ C/L DUP PAD C! CMOVE ;
3
4 : E ( ERASE LINE-1 WITH BLANKS *)
5 LINE C/L BLANKS UPDATE ;
6
7 : S ( SPREAD MAKING LINE # BLANK *)
8 DUP 1 - ( LIMIT ) 0E ( FIRST TO MOVE )
9 DO I LINE I 1+ -MOVE -1 +LOOP E ;
10
11 : D ( DELETE LINE-1, BUT HOLD IN PAD *)
12 DUP H 0F DUP ROT
13 DO I 1+ LINE I -MOVE LOOP E ;
14
15 -->
FORTH INTEREST GROUP MAY 1, 1979
71
SCR # 90
0 ( LINE EDITING COMMANDS WFR-79MAY03 )
1
2 : M ( MOVE CURSOR BY SIGNED AMOUNT-1, PRINT ITS LINE *)
3 R# +! CR SPACE #LEAD TYPE 5F EMIT
4 #LAG TYPE #LOCATE . DROP ;
5
6 : T ( TYPE LINE BY #-1, SAVE ALSO IN PAD *)
7 DUP C/L * R# ! DUP H 0 M ;
8
9 : L ( RE-LIST SCREEN *)
10 SCR @ LIST 0 M ;
11 -->
12
13
14
15
SCR # 91
0 ( LINE EDITING COMMANDS WFR-790105 )
1 : R ( REPLACE ON LINE #-1, FROM PAD *)
2 PAD 1+ SWAP -MOVE ;
3
4 : P ( PUT FOLLOWING TEXT ON LINE-1 *)
5 1 TEXT R ;
6
7 : I ( INSERT TEXT FROM PAD ONTO LINE # *)
8 DUP S R ;
9 CR
10 : TOP ( HOME CURSOR TO TOP LEFT OF SCREEN *)
11 0 R# ! ;
12 -->
13
14
15
SCR # 92
0 ( SCREEN EDITING COMMANDS WFR-79APR27 )
1 : CLEAR ( CLEAR SCREEN BY NUMBER-1 *)
2 SCR ! 10 0 DO FORTH I EDITOR E LOOP ;
3
4 : FLUSH ( WRITE ALL UPDATED BLOCKS TO DISC *)
5 [ LIMIT FIRST - B/BUF 4 + / ] ( NUMBER OF BUFFERS)
6 LITERAL 0 DO 7FFF BUFFER DROP LOOP ;
7
8 : COPY ( DUPLICATE SCREEN-2, ONTO SCREEN-1 *)
9 B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP
10 DO DUP FORTH I BLOCK 2 - ! 1+ UPDATE LOOP
11 DROP FLUSH ;
12 -->
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
72
SCR # 93
0 ( DOUBLE NUMBER SUPPORT WFR-80APR24 )
1 ( OPERATES ON 32 BIT DOUBLE NUMBERS OR TWO 16-BIT INTEGERS )
2 FORTH DEFINITIONS
3
4 : 2DROP DROP DROP ; ( DROP DOUBLE NUMBER )
5
6 : 2DUP OVER OVER ; ( DUPLICATE A DOUBLE NUMBER )
7
8 : 2SWAP ROT >R ROT R> ;
9 ( BRING SECOND DOUBLE TO TOP OF STACK )
10 EDITOR DEFINITIONS -->
11
12
13
14
15
SCR # 94
0 ( STRING MATCH FOR EDITOR PM-WFR-80APR25 )
1 : -TEXT ( ADDRESS-3, COUNT-2, ADDRESS-1 --- )
2 SWAP -DUP IF ( LEAVE BOOLEAN MATCHED-NON-ZERO, NOPE-ZERO )
3 OVER + SWAP (NEITHER ADDRESS MAY BE ZERO! )
4 DO DUP C@ FORTH I C@ -
5 IF 0= LEAVE ELSE 1+ THEN LOOP
6 ELSE DROP 0= THEN
7 : MATCH ( CURSOR ADDRESS-4, BYTES LEFT-3, STRING ADDRESS-2, )
8 ( STRING COUNT-1, --- BOOLEAN-2, CURSOR MOVEMENT-1 )
9 >R >R 2DUP R> R> 2SWAP OVER + SWAP
10 ( CADDR-6, BLEFT-5, $ADDR-4, $LEN-3, CADDR+BLEFT-2, CADDR-1 )
11 DO 2DUP FORTH I -TEXT
12 IF >R 2DROP R> - I SWAP - 0 SWAP 0 0 LEAVE
13 ( CADDR BLEFT $ADDR $LEN OR ELSE 0 OFFSET 0 0 )
14 THEN LOOP 2DROP ( CADDR-2, BLEFT-1, OR 0-2, OFFSET-1 )
15 SWAP 0= SWAP ; -->
SCR # 95
0 ( STRING EDITING COMMANDS WFR-79MAR24 )
1 : 1LINE ( SCAN LINE WITH CURSOR FOR MATCH TO PAD TEXT, *)
2 ( UPDATE CURSOR, RETURN BOOLEAN *)
3 #LAG PAD COUNT MATCH R# +! ;
4
5 : FIND ( STRING AT PAD OVER FULL SCREEN RANGE, ELSE ERROR *)
6 BEGIN 3FF R# @ <
7 IF TOP PAD HERE C/L 1+ CMOVE 0 ERROR ENDIF
8 1LINE UNTIL ;
9
10 : DELETE ( BACKWARDS AT CURSOR BY COUNT-1 *)
11 >R #LAG + FORTH R - ( SAVE BLANK FILL LOCATION )
12 #LAG R MINUS R# +! ( BACKUP CURSOR )
13 #LEAD + SWAP CMOVE
14 R> BLANKS UPDATE ; ( FILL FROM END OF TEXT )
15 -->
FORTH INTEREST GROUP NOVEMBER 1980
73
SCR # 96
0 ( STRING EDITOR COMMANDS WFR-79MAR24 )
1 : N ( FIND NEXT OCCURANCE OF PREVIOUS TEXT *)
2 FIND 0 M ;
3
4 : F ( FIND OCCURANCE OF FOLLOWING TEXT *)
5 1 TEXT N ;
6
7 : B ( BACKUP CURSOR BY TEXT IN PAD *)
8 PAD C@ MINUS M ;
9
10 : X ( DELETE FOLLOWING TEXT *)
11 1 TEXT FIND PAD C@ DELETE 0 M ;
12
13 : TILL ( DELETE ON CURSOR LINE, FROM CURSOR TO TEXT END *)
14 #LEAD + 1 TEXT 1LINE 0= 0 ?ERROR
15 #LEAD + SWAP - DELETE 0 M ; -->
SCR # 97
0 ( STRING EDITOR COMMANDS WFR-79MAR23 )
1 : C ( SPREAD AT CURSOR AND COPY IN THE FOLLOWING TEXT *)
2 1 TEXT PAD COUNT
3 #LAG ROT OVER MIN >R
4 FORTH R R# +! ( BUMP CURSOR )
5 R - >R ( CHARS TO SAVE )
6 DUP HERE R CMOVE ( FROM OLD CURSOR TO HERE )
7 HERE #LEAD + R> CMOVE ( HERE TO CURSOR LOCATION )
8 R> CMOVE UPDATE ( PAD TO OLD CURSOR )
9 0 M ( LOOK AT NEW LINE ) ;
10 FORTH DEFINITIONS DECIMAL
11 LATEST 12 +ORIGIN ! ( TOP NFA )
12 HERE 28 +ORIGIN ! ( FENCE )
13 HERE 30 +ORIGIN ! ( DP )
14 ' EDITOR 6 + 32 +ORIGIN ! ( VOC-LINK )
15 HERE FENCE ! ;S
SCR # 98
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
FORTH INTEREST GROUP MAY 1, 1979
74
EDITOR USER MANUAL
by Bill Stoddart
of FIG, United Kingdom
FORTH organizes its mass storage into "screens" of 1024 characters.
If, for example, a diskette of 250k byte capacity is used entirely
for storing text, it will appear to the user as 250 screens
numbered 0 to 249.
Each screen is organized as 16 lines with 64 characters per line.
The FORTH screens are merely an arrangement of virtual memory and
need not correspond exactly with the screen format of a particular
terminal.
Selecting a Screen and Input of Text
To start an editing session the user types EDITOR to invoke the
appropriate vocabulary.
The screen to be edited is then selected, using either:
n LIST ( list screen n and select it for editing ) OR
n CLEAR ( clear screen n and select for editing )
To input new test to screen n after LIST or CLEAR the P (put)
command is used.
Example:
0 P THIS IS HOW
1 P TO INPUT TEXT
2 P TO LINES 0, 1, AND 2 OF THE SELECTED SCREEN.
75
Line Editing
During this description of the editor, reference is made to PAD.
This is a text buffer which may hold a line of text used by or
saved with a line editing command, or a text string to be found or
deleted by a string editing command.
PAD can be used to transfer a line from one screen to another, as
well as to perform edit operations within a single screen.
Line Editor Commands
n H Hold line n at PAD (used by system more often than by user).
n D Delete line n but hold it in PAD. Line 15 becomes blank
as lines n+1 to 15 move up 1 line.
n T Type line n and save it in PAD.
n R Replace line n with the text in PAD.
n I Insert the text from PAD at line n, moving the old line n
and following lines down. Line 15 is lost.
n E Erase line n with blanks.
n S Spread at line n. n and subsequent lines move down 1
line. Line n becomes blank. Line 15 is lost.
76
Cursor Control and String Editing
The screen of text being edited resides in a buffer area of
storage. The editing cursor is a variable holding an offset into
this buffer area. Commands are provided for the user to position
the cursor, either directly or by searching for a string of buffer
text, and to insert or delete text at the cursor position.
Commands to Position the Cursor
TOP Position the cursor at the start of the screen.
n M Move the cursor by a signed amount n and print the cursor
line. The position of the cursor on its line is shown by
a __ (underline).
String Editing Commands
F text Search forward from the current cursor position until
string "text" is found. The cursor is left at the end
of the text string, and the cursor line is printed.
If the string is not found an error message is given
and the cursor is repositioned at the top of screen.
B Used after F to back up the cursor by the length of
the most recent text.
N Find the next occurrence of the string found by an F
command.
X text Find and delete the string "text."
C text Copy in text to the cursor line at the cursor position.
TILL text Delete on the cursor line from the cursor till the end
of the text string "text."
NOTE: Typing C with no text will copy a null into the text
at the cursor position. This will abruptly stop later
compiling! To delete this error type TOP X 'return'.
77
Screen Editing Commands
n LIST List screen n and select it for editing
n CLEAR Clear screen n with blanks and select it for editing
n1 n2 COPY Copy screen n1 to screen n2.
L List the current screen. The cursor line is relisted
after the screen listing, to show the cursor position.
FLUSH Used at the end of an editing session to ensure that
all entries and updates of text have been transferred
to disc.
78
Editor Glossary
TEXT c ---
Accept following text to pad. c is text delimiter.
LINE n --- addr
Leave address of line n of current screen. This address will
be in the disc buffer area.
WHERE n1 n2 ---
n2 is the block no., n1 is offset into block. If an error is
found in the source when loading from disc, the recovery
routine ERROR leaves these values on the stack to help the user
locate the error. WHERE uses these to print the screen and
line nos. and a picture of where the error occurred.
R# --- addr
A user variable which contains the offset of the editing cursor
from the start of the screen.
#LOCATE --- n1 n2
From the cursor position determine the line-no n2 and the
offset into the line n1.
#LEAD --- line-address offset-to-cursor
#LAG --- cursor-address count-after-cursor-till-EOL
-MOVE addr line-no ---
Move a line of text from addr to line of current screen.
H n ---
Hold numbered line at PAD.
E n ---
Erase line n with blanks.
S n ---
Spread. Lines n and following move down. n becomes blank.
D n ---
Delete line n, but hold in pad.
M n ---
Move cursor by a signed amount and print its line.
T n ---
Type line n and save in PAD.
L ---
List the current screen.
79
R n ---
Replace line n with the text in PAD.
P n ---
Put the following text on line n.
I n ---
Spread at line n and insert text from PAD.
TOP ---
Position editing cursor at top of screen.
CLEAR n ---
Clear screen n, can be used to select screen n for editing.
FLUSH ---
Write all updated buffers to disc. This has been modified to
cope with an error in the Micropolis CPM disc drivers.
COPY n1 n2 ---
Copy screen n1 to screen n2.
-TEXT Addr 1 count Addr 2 -- boolean
True if strings exactly match.
MATCH cursor-addr bytes-left-till-EOL str-addr str-count
--- tf cursor-advance-till-end-of-matching-text
--- ff bytes-left-till-EOL
Match the string at str-addr with all strings on the cursor
line forward from the cursor. The arguments left allow the
cursor R# to be updated either to the end of the matching text
or to the start of the next line.
1LINE --- f
Scan the cursor line for a match to PAD text. Return flag and
update the cursor R# to the end of matching text, or to the
start of the next line if no match is found.
FIND ---
Search for a match to the string at PAD, from the cursor
position till the end of screen. If no match found issue an
error message and reposition the cursor at the top of screen.
DELETE n ---
Delete n characters prior to the cursor.
N ---
Find next occurrence of PAD text.
F ---
Input following text to PAD and search for match from cursor
position till end of screen.
80
B ---
Backup cursor by text in PAD.
X ---
Delete next occurrence of following text.
TILL ---
Delete on cursor line from cursor to end of the following text.
C ---
Spread at cursor and copy the following text into the cursor
line.
81