Solo Forth development history in 2015-10
Description of the page content
Solo Forth development history in 2015-10.
2015-10-03
Added Leo Brodie's doer to the library.
( doer )
\ Credits:
\ Code adapted from PFE.
\ Original code by Leo Brodie, 1983,
\ published in _Thinking Forth_, Appendix A. Public domain.
: doer-noop ;
: doer ( "name" -- )
\ Define a word whose behaviour is vectorable.
create ['] doer-noop cfa>pfa ,
does> ( pfa ) @ >r ;
: (make)
\ Stuff the address of further code into the parameter field
\ of a doer word.
r> dup cell+ dup cell+
( a1 a2 a2 )
\ a1 = address of an optional continuation after `;and`,
\ or zero
\ a2 = address of the doer word
\ a3 = address of the code to associate the doer word with
swap @ cfa>pfa !
\ Get the pfa of the doer word and store the code address
\ into it.
@ ?dup if >r then ;
\ Manage the optional continuation after `;and`.
variable >;and
\ Hold the address of optional continuation pointer.
: make
\ Used interpretively:
\ make doer-name forth-code ;
\ Or inside a definition:
\ : definition make doer-name forth-code ;
compiling? if postpone (make) here >;and ! 0 ,
else here ' cfa>pfa ! ] then ; immediate
: ;and ( -- ) postpone exit here >;and @ ! ; immediate
\ Allow continuation of the "making" definition.
: undo ( "name" -- ) ['] doer-noop cfa>pfa ' cfa>pfa ! ;
\ Make the doer word "name" safe to execute.
2015-10-05
First working version of the Forth-94 Memory-Allocation Word Set, adapted from code written by Gordon Charlton in 1994. The unique error code has been changed to the specific codes of Forth-2012.
Fixed needed. The trailing and leading spaces of the string, sometimes used to prevent name clashes, had to be removed before undefined?:
: needed ( ca len -- )
2dup save-string -trailing -leading undefined?
\ a copy of the string is used because `undefined?`
\ converts it to uppercase
if reneeded else 2drop then ;
The fix of needed required -leading to be defined in the kernel.
_colon_header minus_leading_,'-LEADING'
; doc{
;
; -leading ( ca1 len1 -- ca2 len2 )
;
; Adjust the start and length of a string to suppress the
; leading blanks.
;
; }doc
dw b_l_,skip_
dw semicolon_s_
Added chars to the kernel.
Started adapting Tetris for terminals, written on 1994-05-05 by Dirk Uwe Zoller in ANS Forth. It will be included in the library as the second sample game. A version of Siderator was included some time ago.
2015-10-06
Substituted bl skip in parse-name with -leading.
Removed all the code related to the old parsing method with a trailing null word. That code was already commented out.
Moved word from the kernel to the library. It's not needed anymore with the new parsing method, but it could be useful for backward compatibility.
; ----------------------------------------------
_colon_header word_,'WORD'
; doc{
;
; word ( c "<c...>text<c>" -- ca )
;
; c = delimiter char
;
; Skip leading _c_ delimiters from the input stream. Parse the
; next text characters from the input stream, until a delimiter
; _c_ is found, storing the packed character string beginning at
; _ca_, as a counted string (the character count in the first
; byte), and with one blank at the end (not included in the count).
;
; Standard: Forth-94.
;
; }doc
; Credits:
; after Z88 CamelForth
; dup source >in @ /string ( c c a n )
; dup >r rot skip ( c a' n' )
; over >r rot scan ( a" n" )
; dup if char- then \ skip trailing delimiter
; r> r> rot - >in +! \ update >in offset
; tuck - ( a' n )
; here place ( )
; here ( a )
; bl over count + c! ; \ append trailing blank
dw dup_,stream_ ; ( c c ca len )
dw dup_,to_r_ ; ( c c ca len ) ( R: len )
dw rot_,skip_ ; ( c ca1 len1 ) ( R: len )
dw over_,to_r_ ; ( c ca1 len1 ) ( R: len ca1 )
dw rot_,scan_ ; ( ca2 len2 ) ( R: len ca1 )
dw dup_
dw zero_branch_,word.skip
dw char_minus_
word.skip:
dw from_r_,from_r_ ; ( ca2 len2 ca1 len )
dw rot_,minus_ ; ( ca2 ca1 len3 )
dw to_in_,plus_store_ ; ( ca2 ca1 )
dw tuck_,minus_ ; ( ca1 len4 )
dw here_,place_
dw here_
dw b_l_,over_,count_,plus_,c_store_ ; append trailing blank
dw semicolon_s_
( word )
\ Credits:
\ Code from Z88 CamelForth.
: word ( c "<c...>text<c>" -- ca )
dup stream ( c c ca len )
dup >r rot skip ( c ca' len' )
over >r rot scan ( ca" len" )
dup if char- then \ skip trailing delimiter
r> r> rot - >in +! \ update `>in`
tuck - ( ca' len )
here place here ( ca )
bl over count + c! ; \ append trailing blank
\ doc{
\
\ word ( c "<c...>text<c>" -- ca )
\
\ c = delimiter char
\
\ Skip leading _c_ delimiters from the input stream. Parse
\ the next text characters from the input stream, until a
\ delimiter _c_ is found, storing the packed character
\ string beginning at _ca_, as a counted string (the
\ character count in the first byte), and with one blank at
\ the end. byte), and with one blank at the end (not
\ included in the count).
\
\ Standard: Forth-94.
\
\ }doc
Removed from the library all words that create numerical prefixes using the fig-Forth's width trick. They don't work anymore with the current kernel, and most of them are unnecessary because the latest versions of >number and number? already recognize them.
( c>hex )
\ Credits:
\ Code adapted from lina.
hex
: c>hex ( c -- n ) upper 30 - dup 9 > 7 * + ;
\ Convert a character to its hexadecimal value.
decimal
( '. ) \ character prefix
\ Credits:
\ Code adapted from lina.
hex width @ 1 width !
: '. ( -- n )
\ leave ascii character; example: 'a leaves 0x41
here 2+ c@ postpone literal ; immediate
width ! decimal
( $.. $.... ) \ hex prefixes
\ Credits:
\ Code adapted from lina.
need c>hex
hex width @ 1 width !
: $.. ( -- n )
\ leave hex number; example: $0a leaves 0x0A
here 2+ c@ c>hex 10 * here 3 + c@ c>hex +
postpone literal ; immediate
: $.... ( -- n )
\ leave 16-bit hex number; example: $0aff leaves 0x0AFF
0 here 6 + here 2+ do 10 * i c@ c>hex + loop
postpone literal ; immediate
width ! decimal
( 0x.. 0x.... ) \ hex prefixes
\ Credits:
\ Code adapted from lina.
need c>hex
hex width @ 2 width !
: 0x.. ( -- n )
\ Leave hex number; example: 0x0A.
here 3 + c@ c>hex 10 * here 4 + c@ c>hex +
postpone literal ; immediate
: 0x.... ( -- n )
\ Leave hex number; example: 0x0AFF.
0 here 7 + here 3 + do 10 * i c@ c>hex + loop
postpone literal ; immediate
width ! decimal
( #... #..... ) \ hex prefixes
\ Credits:
\ Code adapted from lina.
need c>hex
width @ 1 width !
: #... ( -- n )
\ leave decimal number
here 2+ c@ c>hex 10 * here 3 + c@ c>hex +
postpone literal ; immediate
: #..... ( -- n )
\ leave 16-bit decimal number
0 here 6 + here 2 + do 10 * i c@ c>hex + loop
postpone literal ; immediate
width !
Adapted begin-stringtable from the stt module of Forth Foundation Library.
( begin-stringtable end-stringtable )
\ Credits:
\ Code adapted from Forth Foundation Library (stt module).
: begin-stringtable ( "name" -- stringtable-sys )
\ Start a named stringtable definition.
create here ( a1 ) cell allot here ( a1 a2 )
\ stringtable-sys:
\ a1 = pointer (address of address) to the strings index
\ a2 = address of the compiled strings
does> ( n -- ca len )
\ Return the nth string.
( n pfa ) @ swap cells + @ count ;
: end-stringtable ( stringtable-sys -- )
\ End the stringtable definition.
\ stringtable-sys:
\ a1 = pointer (address of address) to the strings index
\ a2 = address of the compiled strings
( a1 a2 )
here rot ! \ set the index
here swap ( a3 a2 )
begin 2dup <> while
dup , \ store the start of the string in the index
count chars + \ move to the next string
repeat 2drop ;
\ Usage example:
\
\ begin-stringtable esperanto-number
\ s" nulo" s, s" unu" s, s" du" s, s" tri" s,
\ end-stringtable
\ 0 esperanto-number type
\ 3 esperanto-number type
The original code provides a specific word to compile the strings of the table, +". In Solo Forth it could be defined simply: : +" ( "tex<quote>" -- ) [char] " parse s, ;. But it's more versatile to use s" and s, directly.
2015-10-07
Finished the improved port of tt (Tetris for Terminals), with configurable key sets.
Fixed error: error-pos was not updated when blk contained zero, what sometimes caused where to show the old value.
Finished the documentation of sm/rem and fm/mod.
Adapted the following words from Galope and included them in the library: less-of, greater-of, between-of, within-of, default-of and or-of.
Wrote cvalue and cto in the library, after the alternative non-standard version of 2value and 2to.
Started the port of Towers of Hanoi bundled with kForth.
2015-10-08
Moved the fig-Forth user variable r# to the library; it's used only by the editor.
2015-10-09
Started the implementation of the Forth-94 and Forth-2012 exception and exception extension word sets: abort, abort", catch and throw.
Fixed decode: slit was missing from the special cases.
Wrote an alternative definition of ." without interpretation semantics; this saves four bytes.
Benchmarked the current version of number-base and three alternatives:
( number-base-bench )
: number-base-1 ( ca len -- ca' len' n )
\ This is the current version defined in the kernel.
over c@ [char] $ = if 1 /string 16 exit then
over c@ [char] % = if 1 /string 2 exit then
over c@ [char] # = if 1 /string 10 exit then base @ ;
: number-base-2 ( ca len -- ca' len' n )
over c@ >r
r@ [char] $ = if 1 /string 16 rdrop exit then
r@ [char] % = if 1 /string 2 rdrop exit then
r> [char] # = if 1 /string 10 exit then base @ ;
: number-base-3 ( ca len -- ca' len' n )
over c@
dup >r [char] $ = if 1 /string 16 rdrop exit then
r@ [char] % = if 1 /string 2 rdrop exit then
r> [char] # = if 1 /string 10 exit then base @ ;
-->
( number-base-bench )
: number-base-4 ( ca len -- ca' len' n )
over c@
dup [char] $ = if drop 1 /string 16 exit then
dup [char] % = if drop 1 /string 2 exit then
[char] # = if 1 /string 10 exit then base @ ;
need frames@ need frames0 defer (number-base)
: (number-base-bench) ( n cfa -- )
['] (number-base) defer!
frames0 0 do s" 000" (number-base) drop 2drop loop
frames@ d. cr ;
: number-base-bench ( n -- )
dup ['] number-base-1 (number-base-bench)
dup ['] number-base-2 (number-base-bench)
dup ['] number-base-3 (number-base-bench)
['] number-base-4 (number-base-bench) ;
\ Times Frames (1 frame = 50th of second)
\ ----- -----------------------------------
\ 1 2 3 4
\ ---- ---- ---- ----
\ 01000 73 75 74 69
\ 10000 732 744 736 686
\ 32000 2343 2382 2367 2194
number-base-4 is a bit faster and does not need more space, so it substitutes the current version.
2015-10-10
Fixed error>line, the word that converts an ordinal error number to its line offset. I knew the code was buggy from the start. Finally I've coded a right algorithm:
\ XXX OLD -- buggy
: error>line ( n1 -- n2 )
error>ordinal dup 1+ 1 do i 16 mod 0= abs + loop ;
\ XXX NEW -- fixed
: error>line ( n1 -- n2 )
error>ordinal dup >r
begin
dup dup 16 / - r@ <> while 1+
repeat rdrop ;
error>line and error>ordinal may be moved to the library, because they are needed only when message prints complete messages, what is useful mainly for debugging. Most programs don't need this feature.
2015-10-11
Modified parsed: it doesn't add 1 to the count anymore; now it does just >in +!.
2015-10-13
Factored (smudge) from smudge, in order to choose any name field, as required by the port of privatize from pForth.
Fixed (find-name): the smudge bit was not included in the check, thus words with the smudge bit set were found!
( nfa<nfa )
: nfa<nfa ( nfa1 -- nfa2 ) nfa>lfa @n ;
\ Get the previous _nfa2_ from _nfa1_.
( privatize )
\ Credits:
\ Code adapted from pForth.
\ ____
\
\ @(#) private.fth 98/01/26 1.2
\ PRIVATIZE
\
\ Privatize words that are only needed within the file
\ and do not need to be exported.
\ Usage:
\ PRIVATE{
\ \ Everything between PRIVATE{ and }PRIVATE
\ \ will become private.
\ : FOO ;
\ : MOO ;
\ }PRIVATE
\ : GOO foo moo ; \ can use foo and moo
\ PRIVATIZE \ smudge foo and moo
\ ' foo \ will fail
\ Copyright 1996 Phil Burk
\
\ 19970701 PLB Use unsigned compares for machines with
\ "negative" addresses.
\ ____
need abort" need nfa<nfa
variable private-start variable private-stop
: private{ ( -- )
latest private-start ! private-stop off ;
: }private ( -- )
private-stop @ abort" Extra }private"
latest private-stop ! ;
: privatize ( -- )
\ Hide all words between `private{` and `}private`.
private-start @ 0= abort" Missing private{"
private-stop dup @ 0= abort" Missing }private"
begin dup private-start @ u>
while dup (smudge) nfa<nfa
repeat drop private-start off private-stop off ;
Added behead, clearer than (smudge) and definitive:
: behead ( nfa -- ) 0 swap c!n ;
\ Store zero at _nfa_, thus making the definition impossible
\ to find.
Tested the three versions of abort". The one from DZX-Forth uses less memory, because ," has already been included in the kernel, as a factor of .".
( abort" )
\ Version adapted from DZX-Forth:
\ XXX code: 38 bytes
\ XXX word with 4-char abort message: 11 bytes.
[defined] abort-message ?\ 2variable abort-message
\ XXX TMP
: (abort") ( n -- )
r> count rot if abort-message 2! -2 throw then + >r ;
: abort" ( compilation: "ccc<quote>" -- )
postpone (abort") ," ; immediate
( abort" )
\ Version adapted from hForth:
[defined] abort-message ?\ 2variable abort-message
\ XXX TMP
\ XXX code: 38 bytes
\ XXX word with 4-char abort message: 25 bytes.
: (abort") ( ca len -- ) abort-message 2! -2 throw ;
: abort" ( x "text<quote>" -- )
postpone s"
postpone rot ( ca len x )
postpone if postpone (abort")
postpone else postpone 2drop postpone then
; immediate
( abort" )
\ Version adapted from Gforth:
\ XXX code: 62 bytes with `csliteral`; 34 bytes per se.
\ XXX word with 4-char abort message: 17 bytes.
need csliteral
\ variable abort-message
: (abort") ( ca len -- ) abort-message ! -2 throw ;
: abort" ( n "text<quote>" -- )
postpone if
[char] " parse postpone csliteral postpone (abort")
postpone then ; immediate
2015-10-14
Removed the conditional compilation for the exception word set. Beside adding catch and throw it affected ?error, error and abort (abort" didn't existed, it has been recently included in the library, defined with throw). Code before removing the conditional compilation:
; ----------------------------------------------
_colon_header question_error_,'?ERROR'
; doc{
;
; ?error ( wf n -- )
;
; Issue error _n_ if the boolean flag _wf_ is `true`.
;
; }doc
if 1 ; exception_wordset
dw and_,throw_
dw semicolon_s_
else
; XXX OLD -- fig-Forth
dw swap_
dw zero_branch_,question_error.no_error
dw error_
dw semicolon_s_
question_error.no_error:
dw drop_
dw semicolon_s_
endif
; ----------------------------------------------
_colon_header error_,'ERROR'
if 1 ; exception_wordset
; doc{
;
; error ( n -- )
;
; Save the error number into `error-number`, and the current
; block and line into `error-pos`, to be used by `where`. Issue
; error _n_ and restart the system.
; ----
; : error ( n -- )
; dup error-number !
; >in @ blk @ error-pos 2!
; dup -1 = if (abort) then
; dup -2 = if abort-message 2@ type (abort) then
; parsed-name 2@ type ." ? " message (abort) ;
; ----
; }doc
dw dup_,error_number_,store_ ; save the error number
dw to_in_,fetch_,blk_,fetch_,error_pos_,two_store_
dw dup_
_literal -1
dw equals_
dw question_branch_,paren_abort_pfa
; No return from `(abort)`.
dw dup_
_literal -2
dw equals_
dw zero_branch_,error.message
dw space_,abort_message_,two_fetch_,type_,paren_abort_
; No return from `(abort)`.
error.message:
dw parsed_name_,two_fetch_,type_ ; last parsed word
dw paren_dot_quote_
_string '? '
dw message_,paren_abort_
; No return from `(abort)`.
; XXX FIXME -- the end of `error` will not be recognized by
; `decode`.
_two_variable_header abort_message_,"ABORT-MESSAGE"
dw 0,0
else
; doc{
;
; error ( n -- )
;
; Issue error message _n_ and restart the system. Save the
; error number into `error-number`, and the current block and
; line into `error-pos`, to be used by `where`.
;
; This word is a modified version of fig-Forth's `error`.
; ----
; : error ( n -- )
; dup error-number !
; >in @ blk @ error-pos 2!
; parsed-name 2@ type ." ? " message
; sp0 @ sp! quit ;
; ----
; }doc
dw dup_,error_number_,store_ ; save the error number
dw to_in_,fetch_,blk_,fetch_,error_pos_,two_store_
; XXX OLD
; dw warnings_,fetch_,zero_less_than_ ; custom error routine?
; dw question_branch_,paren_abort_pfa ; if so, branch to it
error.message:
dw parsed_name_,two_fetch_,type_ ; last parsed word
dw paren_dot_quote_
_string '? '
dw message_
dw sp0_,fetch_,sp_store_
dw quit_
endif
; ----------------------------------------------
if 1 ; exception_wordset
_colon_header catch_,'CATCH'
; doc{
; catch ( cfa -- 0 | err# )
; Push an exception frame on the exception stack and then
; execute _cfa_ (as with `execute`) in such a way that control
; can be transferred to a point just after `catch` if `throw` is
; executed during the execution of _cfa_.
;
; If the execution of _cfa_ completes normally (i.e., the
; exception frame pushed by this `catch` is not popped by an
; execution of `throw`) pop the exception frame and return zero
; on top of the data stack, above whatever stack items would
; have been returned by the execution of _cfa_. Otherwise, the
; remainder of the execution semantics are given by `throw`.
;
; Standard: Forth-94 (EXCEPTION), Forth-2012 (EXCEPTION).
;
;----
; : catch ( xt -- exception# | 0 )
; sp@ >r ( cfa ) \ save data stack pointer
; catcher @ >r ( cfa ) \ save previous catcher
; rp@ catcher ! ( cfa ) \ set current catcher
; execute ( ) \ `execute` returns if no `throw`
; r> catcher ! ( ) \ restore previous catcher
; r> drop ( ) \ discard saved stack pointer
; 0 ; ( 0 ) \ normal completion, no error
;----
; }doc
; Credits:
; Code from DZX-Forth and MPE Forth for TiniARM.
dw sp_fetch_,to_r_ ; save data stack pointer
dw catcher_,fetch_,to_r_ ; save previous catcher
dw rp_fetch_,catcher_,store_ ; set current catcher
dw execute_ ; `execute` returns if no `throw`
dw from_r_,catcher_,store_ ; restore error frame
dw from_r_,drop_ ; discard saved stack pointer
_literal 0 ; normal completion, no error
dw semicolon_s_
endif
; ----------------------------------------------
if 1 ; exception_wordset
_colon_header throw_,'THROW'
; XXX UNDER DEVELOPMENT
if 0
; Version from eForth:
; throw ( err# -- err# )
; reset system to current local error frame an update error flag.
dw catcher_,fetch_,rp_store_ ; restore return stack
dw from_r_,catcher_,store_ ; restore exception frame
dw from_r_,swap_,to_r_,sp_store_ ; restore data stack
dw drop_,from_r_
dw semicolon_s_
endif
if 0
; Version from hForth and MPE Forth for TiniARM.
; Comments from MPE Forth for TiniARM.
; : throw ( ??? exception# -- ??? exception# )
; ?dup if ( exc# )
; catcher @ rp! ( exc# ) \ restore previous return stack
; r> catcher ! ( exc# ) \ restore previous catcher
; r> swap >r ( saved-sp ) ( R: exc# )
; sp! drop r> ( exc# ) \ restore stack
; \ Return to the caller of `catch` because return stack is
; \ restored to the state that existed when `catch` began
; \ execution.
; then ;
dw question_dup_,zero_branch_,throw.end
dw catcher_,fetch_,rp_store_ ; restore previous return stack
dw from_r_,catcher_,store_ ; restore previous exception frame
dw from_r_,swap_,to_r_
dw sp_store_,drop_,from_r_ ; restore data stack
; Return to the caller of `catch` because return stack is
; restored to the state that existed when `catch` began
; execution.
throw.end:
dw semicolon_s_
endif
if 1
; Version from DZX-Forth:
; XXX TODO -- Comments from MPE Forth for TiniARM.
; throw ( n -- )
; ?dup if
; catcher @ ?dup 0= if error then
; rp! r> catcher ! r> swap >r sp! drop r>
; then ;
dw question_dup_
dw zero_branch_,throw.end
dw catcher_,fetch_
dw question_dup_,zero_equals_
dw zero_branch_,throw.catcher
dw error_
; No return from `error`.
throw.catcher:
dw rp_store_
dw from_r_,catcher_,store_
dw from_r_,swap_,to_r_
dw sp_store_
dw drop_,from_r_
throw.end:
dw semicolon_s_
endif
endif
; ----------------------------------------------
if 1 ; exception_wordset
_colon_header paren_abort_,'(ABORT)'
dw sp0_,fetch_,sp_store_
dw boot_
dw quit_
_colon_header abort_,'ABORT'
_literal -1
dw throw_
dw semicolon_s_
else
_colon_header paren_abort_,'(ABORT)'
dw abort_
dw semicolon_s_
_colon_header abort_,'ABORT'
dw sp0_,fetch_,sp_store_
dw boot_
dw quit_
endif
Substituted ?error with the clearer and more versatile ?throw:
; ----------------------------------------------
_colon_header question_throw_,'?THROW'
; doc{
;
; ?throw ( f n -- )
;
; Perform a `throw` of value _n_ if the boolean flag _f_ is
; non-zero.
; ----
; : ?throw ( f n -- )
; swap if throw else drop then ;
; ----
; }doc
dw swap_
dw question_branch_,throw_pfa
dw drop_
dw semicolon_s_
Renamed sign? to skip-sign?, after MPE Forth for TiniARM's skip-sign.
Benchmarked the three considered versions of number?.
( number?-bench )
need frames@ need frames0
: empty-stack ( -- ) sp0 @ sp! ;
defer num?
: number?-bench ( n -- )
frames0 0 do
s" " num? s" 12345" num? s" 12345." num?
s" -12345" num? s" -12345." num? empty-stack
loop frames@ cr d. ;
: benchs ( -- )
100 number?-bench 1000 number?-bench 10000 number?-bench ;
\ Version of `number?`
' number? ' num? defer! benchs \ pForth
' c.number? ' num? defer! benchs \ CamelForth
' dzx-number? ' num? defer! benchs \ DZX-Forth
\ Note: The CamelForth code is for single numbers only.
\ The DZX-Forth code is a bit obfuscated.
\ Times Frames (1 frame = 50th of second)
\ ----- -----------------------------------
\ pForth CamelForth DZX-Forth
\ ------ ---------- ---------
\ 00100 256 257 259
\ 01000 2559 2565 2594
\ 10000 25591 25652 25933
Speed differences are unimportant in this case, but since the version from DZX-Forth is less legible and the version from CamelForth is limited, the version from pForth is chosen.
\ Version adapted from pForth:
: number? ( ca len -- 0 | n 1 | d 2 )
dup 0= if 2drop 0 exit then
base @ >r number-base base !
skip-sign? >r
dpl on 0 0 2swap >number dup
if
1 = swap c@ [char] . = and
if r@ ?dnegate dpl off 2
else 2drop 0 then
else
2drop d>s r@ ?negate 1
then rdrop r> base ! ;
\ Version adapted from DZX-Forth:
: number? ( ca len -- d tf | ff )
dup 0= if 2drop false exit then
base @ >r number-base base !
skip-sign? >r
0 0 2swap ?dup if
>number dpl on
dup if 1- over c@ [char] . - or dpl off then
while then
r> 2drop 2drop false
else
drop r> ?dnegate true
then r> base ! ;
\ Version adapted from CamelForh (single numbers only):
: number? ( ca len -- n tf | ff )
base @ >r number-base base !
0 0 2swap
skip-sign? >r >number nip
if 2drop rdrop false
else r> if negate then true
then r> base ! ;
But double numbers are recognized only when the decimal point is at the end, and dpl is just a flag. This behaviour follows the Forth-94 and Forth-2012 standards, but an improved version is desirable, after fig-Forth: capable of recognizing the decimal point anywhere in the string, and using dpl to hold the number of digits after the decimal point.
( number? )
\ XXX UNDER DEVELOPMENT
\ Improved alternative to `number?`.
: solo-number? ( ca len -- 0 | n 1 | d 2 )
dup 0= if 2drop 0 exit then
base @ >r number-base base !
skip-sign? >r
0 0 2swap dpl on
begin
>number dup
while
over c@ [char] . <> \ not a decimal point?
dpl @ 0< 0= or \ or not the first decimal point?
if 2drop 2rdrop 0 exit then
dup 1- dpl ! 1 /string
repeat 2drop dpl @ 0<
if d>s r> ?negate 1
else r> ?dnegate 2 then r> base ! ;
Updated benchmarks:
\ Times Frames (1 frame = 50th of second)
\ ----- -----------------------------------
\ pForth CamelForth DZX-Forth Solo Forth
\ ------ ---------- --------- ----------
\ 00100 256 257 259 266
\ 01000 2559 2565 2594 2658
\ 10000 25591 25652 25933 26581
A modified benchmark with strings whose conversion fail:
( number?-bench )
need frames@ need frames0
: empty-stack ( -- ) sp0 @ sp! ;
defer num?
: number?-bench ( n -- )
frames0 0 do
s" " num? s" 123x45." num? s" 12345.999x" num?
s" -12345.x" num? s" -12345.999x" num?
s" -12345.000.000" num?
empty-stack
loop frames@ cr d. ;
: benchs ( -- )
100 number?-bench 1000 number?-bench 10000 number?-bench ;
' solo-number? ' num? defer! benchs
\ Times Frames (1 frame = 50th of second)
\ ----- -----------------------------------
\ 00100 416
\ 01000 4165
\ 10000 41649
The improved version is slower and occupies 26 bytes more, but the differences are unimportant and the new features are useful. I keep it as default. Both versions can be chosen with conditional compilation in the kernel. Eventually number? may be deferred and one of the definitions moved to the library.
Added some new words and tools to the library, adapted from Galope: xstack, hunt, column, row, at-x, at-y, random-range, prefix?, -prefix, suffix?, -suffix, d>str, ud>str, times-execute, chop.
2015-10-15
Finished porting the IsForth's control structure case:.
( options[ )
\ Credits:
\ `options[` is a port of IsForth's `case:`.
variable (default-option)
\ default option cfa
variable #options
\ number of compiled options
: default-option ( "name" -- ) ' (default-option) ! ;
\ Set the default option.
\ It can go anywhere inside a the options statement.
: (options) ( i*x x -- j*x )
\ Note: in the original IsForth code this word (called
\ `docase`) is written in x86 assembler. I rewrote it from
\ scratch, without investigating the assembler code.
\ x = option to search for
false swap ( false x ) \ default flag returned by the loop
r> dup cell+ dup cell+ ( false x a1 a2 a3 )
\ a1 = address of the exit point
\ a2 = address of the default option cfa
\ a3 = address of the number of options
rot @ >r ( false x a2 a3 ) \ set the exit point
swap >r ( false x a3 ) ( R: a2 ) \ save a2
dup cell- swap @ ( false x a4 n )
\ a4 = address of the first compiled option minus two cells
\ n = number of compiled options
-->
( options[ )
0 do
[ 2 cells ] literal + 2dup @ = ( false x a5 f ) \ match?
\ a5 = address of the current compiled option
if
nip nip cell+ perform
exhaust true 0 0 then
loop ( f x1 x2 ) 2drop
if rdrop \ discard the default option
else r> perform \ execute the default option
then ; -->
( options[ )
: options[ ( -- a1 a2 a3 )
\ a1 = address of exit point
\ a2 = address of default option cfa
\ a3 = address of number of options
(default-option) off \ assume no default option
#options off \ number of options is 0 so far
compile (options) \ compile run time handler
>mark >mark >mark ( a1 a2 a3 )
postpone [ ; immediate
: option ( x "name" -- )
\ Compile an option _x_ to execute the word _name_.
, \ compile the option
' , \ get cfa and compile it too
1 #options +! ;
: ]options ( a1 a2 a3 -- )
\ a1 = address of exit point
\ a2 = address of default option cfa
\ a3 = address of number of options
#options @ swap ! \ store number of options
(default-option) @ swap ! \ store default option cfa
>resolve \ store exit point
] ;
( options[-test )
: o1 ." option 1" ; : o2 ." option 2" ; : o3 ." option 3" ;
: test ( c -- )
options[
char a option o1 char b option o2 char c option o3
]options ;
: o0 ." default" ;
: testd ( c -- )
options[
char a option o1 char b option o2 char c option o3
default-option o0
]options ;
Wrote 2, in the kernel. Updated 2constant accordingly. Substituted the final part of 2variable with a branch to the same code in 2,. At the end only 7 bytes are used.
Wrote wdump, an alternative to dump that shows 16-bit values, useful for inspecting the code fields.
( wdump )
need break-key? need 16hex.
[defined] bs ?\ : bs ( -- ) 8 emit ;
: wdump ( a n -- )
\ Show the contents of _n_ cells starting from _a_.
0
\ XXX TODO use `?do` instead of `if` when available
2dup <> if
do
i 4 mod 0= if cr dup 16hex. space then \ show address
dup @ 16hex. cell+
break-key? ?exhaust
loop
else 2drop then drop ;
2015-10-16
Improved (options). Now it's smaller and faster:
: (options) ( i*x x -- j*x )
\ x = option to search for
false swap ( false x ) \ default flag returned by the loop
r> dup @ >r \ set the new exit point
cell+ dup >r \ save the address of the default option cfa
dup cell+ @ ( false x a n )
\ a = address of the first compiled option minus two cells
\ n = number of compiled options
0 do
[ 2 cells ] literal + 2dup @ = ( false x a' f ) \ match?
\ a' = address of the current compiled option
if nip nip cell+ perform exhaust true 0 0 then
loop ( f x1 x2 ) 2drop
if rdrop \ match, so discard the default option
else r> perform \ no match, so execute the default option
then ; -->
Changed the order of the parameters of emits. Now the count is the second one.
Wrote ?? without evaluate (not implemented yet):
( ?? )
\ Credits:
\ Code adapted from Galope.
\ Original code by Neil Bawd, presented at FORML 1986.
\ This version does not use `evaluate`.
: ?? ( Compilation: "name" -- ) ( Runtime: f -- )
postpone if
parse-name find-name 0= -13 ?throw compile,
postpone then
; immediate
But a simpler is possible:
: ?? ( f -- ) 0= if r> cell+ >r then ;
Improved located: now the string searched for is delimited with spaces. This prevents name clashes and makes it unnecessary to add the spaces explicitly in risky cases, for example s" j " needed.
: delimited ( ca1 len1 -- ca2 len2 )
dup 2+ dup allocate-string swap ( ca1 len1 ca2 len2 )
2dup blank 2dup 2>r drop char+ smove 2r> ;
\ Add a leading space and trailing space to the given string.
: located ( ca len -- screen | false )
delimited last-locatable @ 1+ first-locatable @
default-first-locatable @ first-locatable !
do 0 i line>string 2over
contains if 2drop i unloop exit then
\ break-key? ?exhaust
\ XXX TODO -- `break-key?` is not in the kernel
loop 2drop false ; -->
\ Locate the screen that contains the name _ca len_
\ (but delimited with spaces at both sides) in its first line.
\ If not found, return zero. The search is case-sensitive.
Implemented [needed]. It allows selective compilation depending on the word specified by need or needed:
2variable needed-word
: [needed] ( "name" -- f )
parse-name needed-word 2@ compare 0= ; immediate
: [unneeded] ( "name" -- f )
postpone [needed] 0= ; immediate
: needed ( ca len -- )
needed-word 2@ 2>r 2dup needed-word 2!
2dup save-string -trailing -leading undefined?
\ a copy of the string is used because `undefined?`
\ converts it to uppercase
if reneeded else 2drop then 2r> needed-word 2! ;
Usage example of [needed] and [unneeded]:
( within between )
[unneeded] within dup
?\ : within ( n1|u1 n2|u2 n3|u3 -- f ) over - >r - r> u< ;
?\ ;s
need -rot
: between ( n1|u1 n2|u2 n3|u3 -- f ) over - -rot - u< 0= ;
Implemented some bit-manipulation words in the library:
( test-bits set-bits reset-bits )
\ Credits:
\ Words inspired by MPE PowerForth for TiniARM.
need z80-asm need [if]
[needed] test-bits [if]
code test-bits ( b ca -- wf )
hl pop de pop e a ld m and
' true cfa>pfa jpnz ' false cfa>pfa jp
end-code ;s [then]
\ AND the bitmask _b_ with the contents of _ca_ and return
\ `true` if the result is non-zero or `false` if the result
\ is zero. Byte operation.
[needed] set-bits [if]
code set-bits ( b ca -- )
hl pop de pop e a ld m or a m ld jpnext
end-code ;s [then]
\ Apply the bitmask _b_ ORred with the contents of _ca_. Byte
\ operation.
[needed] reset-bits [if]
code reset-bits ( b ca -- )
hl pop de pop e a ld cpl m and a m ld jpnext
end-code ;s [then]
\ Apply the bitmask _b_ inverted and ANDed with the contents
\ of _ca_. Byte operation.
\ XXX `toggle-bits` is in the kernel
\ [needed] toggle-bits [if]
\ code toggle-bits ( b ca -- )
\ hl pop de pop m a ld e xor a m ld jpnext
\ end-code ;s [then]
\ \ Invert the bits at _ca_ specified by the bitmask _b_. Byte
\ \ operation.
The definition of fig-Forth's toggle in the kernel was modified to suit the word set: now it's called toggle-bits and the order of its parameters have been changed.
Renamed pixel? to test-pixel to make the pixel wordset analogous.
Moved roll to the library. 28 bytes saved.
2015-10-17
Substituted message with a deferred called .throw; wrote its default behaviour .throw#. Its extended behaviour, similar to the old message, is written in the library as (.throw). Moved all related words to the library: error>ordinal, error>line and .line. Commented out the unused word warning. All this saved 111 bytes: 33561 bytes free.
Alas, line>string can not be moved to the library because located uses it, before need has been defined.
2015-10-18
Wrote some words to increment and decrement the contents of memory addresses: 1+!, 1-!, c1+! and c1-!.
Renamed command (a factor of the editor's text) to parse-line; that's what it does.
Added the Forth-2012 data structures.
2015-10-19
Wrote an improved version of ?? that works with immediate and parsing words:
: ?? ( Compilation: "name" -- ) ( Runtime: f -- )
postpone if
parse-name find-name ( x 0 | cfa 1 | cfa -1 )
dup 0= -13 ?throw
1 = if execute else compile, then
postpone then
; immediate
2015-10-20
Wrote compile-only and started modifying interpret and find-name accordingly.
2015-10-21
Finished compile-only and all related changes. The old behaviour still can be selected with conditional compilation of the kernel.
2015-10-22
Removed state-smartness from the old fig-Forth version of literal. Modified interpret accordingly. Updated cliteral. Wrote 2lit, needed for the improved version of 2literal.
Wrote char? after DZX-Forth.
Fixed parse-char: a silly mistake, a missing drop.
Renamed all words that convert between components of a definition. The following table shows the old and the new names, compared with those used by several Forth standards and the Gforth system.
| Solo Forth (old) | fig-Forth | Forth-83 | Forth-94 | Gforth | Forth-2012 | Solo Forth (new) |
|---|---|---|---|---|---|---|
cfa>nfa |
>name |
>name |
>name | |||
cfa>pfa |
>body |
>body |
>body |
>body |
>body | |
cfap>lfa |
>>link | |||||
lfa>nfa |
l>name |
link>name | ||||
nfa>cfa |
name> |
name>int and name>comp |
name>compile and name>interpret |
name> | ||
nfa>lfa |
n>link |
name>link | ||||
nfa>string |
name>string |
name>string |
name>string | |||
pfa>cfa |
cfa |
body> |
body> | |||
pfa>lfa |
lfa |
body>link | ||||
pfa>nfa |
nfa |
body>name
|
name>compile and name>interpret will be implemented.
2015-10-23
Improved number-base: now empty strings are supported.
Improved number? to recognize chars between single quotes, after the Forth-2012 Standard. Wrote char? to do the actual recognition; it's called at the start of number? (2dup char? if nip nip 1 exit then). But there's a problem: the string received by number? has been already converted to uppercase by find-name in interpret.
_colon_header char_question_,'CHAR?'
; doc{
;
; char? ( ca len -- c true | false )
;
; ----
; : char? ( ca len -- c true | false )
; 3 <> if
; dup c@ [char] ' <> if
; dup [ 2 chars ] literal + c@ [char] ' <>
; if char+ c@ true exit then
; then
; then
; drop false ;
; }doc
_literal 3
dw equals_
dw zero_branch_,char_question.not
char_question.right_length:
dw dup_,c_fetch_
_literal "'"
dw equals_
dw zero_branch_,char_question.not
char_question.first_quote:
dw dup_,two_plus_,c_fetch_
_literal "'"
dw equals_
dw zero_branch_,char_question.not
char_question.match:
dw char_plus_,c_fetch_,true_,exit_
char_question.not:
dw drop_,false_,exit_
dw semicolon_s_
2015-10-24
Improved version of (find-name) that converts chars to uppercaso on the fly. The old problem was the strings had to be converted to uppercase first, what modified the contents input buffer. Fixed.
Moved the following words to the library: body>name, name>link, link>name, >>link, ?compiling, ?executing, save-counted-string, trail. They are not used in the kernel.
Fixed ' (for version 4 of find-name).
Removed versions 0..3 of find-name. Version 4 is chosen, written after Gforth: find-name ( ca len -- nfa | 0 ). Removed all unnecessary code from the kernel (many words had several versions, conditionally compiled depending on the active version of find-name).
_colon_header find_name_,'FIND-NAME'
; doc{
; find-name ( ca len -- nfa | 0 )
;
; Find the definition identified by the string _ca len_ in the
; current search order. If the definition is not found after
; searching all the vocabularies in the search order, return
; zero. If the definition is found, return its _nfa_.
;
; The search is case-insensitive.
; ----
; : find-name ( ca len -- nfa | 0 )
; 2dup uppers
; #vocs 0 do
; context i cells + @ ?dup
; if @ >r 2dup r> @ (find-name) ?dup
; ( ca len nfa nfa | ca len 0 )
; if nip nip unloop exit then
; then
; loop 2drop false ;
; ----
; }doc
dw hash_vocs_,zero_,paren_do_
find_name.do:
; ( ca len )
dw context_,i_,cells_,plus_,fetch_
dw question_dup_ ; a vocabulary in the search order?
dw zero_branch_,find_name.loop ; if not, next
; ( ca len wid )
; valid vocabulary in the search order
dw fetch_,to_r_,two_dup_,from_r_
dw paren_find_name_,question_dup_ ; ( nfa nfa | 0 ) word found?
dw zero_branch_,find_name.loop
dw nip_,nip_,unloop_,exit_
find_name.loop:
dw paren_loop_,find_name.do
dw two_drop_,false_
dw semicolon_s_
Added the constants immediate-mask and compile-only-mask. Formerly their values were coded as literals in 4 words, but they were not accessible from the application.
Converted 7 constants to byte constants. This saves 7 bytes.
Renamed (find-name) to find-name-from.
Adapted ?? to the final version of find-name:
: ?? ( Compilation: "name" -- ) ( Runtime: f -- )
postpone if
defined ( nfa | 0 ) ?dup 0= -13 ?throw
name>immediate? ( cfa f ) if execute else compile, then
postpone then
; immediate compile-only
Removed the old versions of defer, defer! and defer@ from the kernel, that were abandoned on 2015-09-22. The deferred words still could be compiled with the the old system.
2015-10-25
Implemented alias and synonym.
( alias synonym )
: alias ( cfa "name" -- ) defer latest name> defer! ;
\ doc{
\
\ alias ( cfa "name" -- )
\
\ Create an alias _name_ that will execute _cfa_.
\ In Solo Forth an alias is a deferred word.
\
\ }doc
\ Credits:
\ The code of `synonym` is adapted from the example provided in the
\ Forth-2012 documentation, and improved with `compile-only?`.
: synonym ( "newname" "oldname" -- )
create immediate
smudge ' , smudge
does> ( -- )
( pfa ) @ ( cfa ) dup >name dup ( cfa nfa nfa )
compile-only? executing? and -14 ?throw
immediate? executing? or
if execute else compile, then ;
\ doc{
\
\ synonym ( "newname" "oldname" -- )
\
\ Create a definition for _newname_ with the the semantics
\ defined below. _newname_ may be the same as _oldname_; when
\ looking up _oldname_, _newname_ shall not be found.
\ newname ( Interpretation: i*x -- j*x )
\ Perform the interpretation semantics of _oldname_.
\
\ newname ( Compilation: i*x -- j*x )
\ Perform the compilation semantics of _oldname_.
\
\ Standard: Forth-2012 (TOOLS EXT).
\
\ }doc
Wrote a Z80 macro to define deferred words in the kernel:
_defer_header: macro _base_label,_name,_flags,_cfa
_code_header _base_label,_name,_flags
ld hl,_cfa
jp next2
endm
; XXX OLD syntax:
_code_header home_,'HOME'
ld hl,paren_mode32_home_
jp next2
; XXX NEW syntax:
_defer_header home_,'HOME',,paren_mode32_home_
Improved alias:
: code? ( cfa -- f ) dup >body swap @ = ;
: defer-alias ( cfa "name" -- )
defer latest name> defer! ;
: code-alias ( cfa "name" -- )
@ header smudge latest name> ! ;
: alias ( cfa "name" -- )
dup code? if defer-code exit then defer-alias ;
\ doc{
\
\ alias ( cfa "name" -- )
\
\ Create an alias _name_ that will execute _cfa_. If _cfa_
\ is a primitive word, the address hold in _name_'s own cfa
\ will be the same than the address hold in _cfa_. Otherwise
\ _name_ will be a deferred word executing _cfa_.
\
\ }doc
And then improved alias once more:
: code? ( cfa -- wf ) dup >body swap @ = ;
\ Is _cfa_ a word created by `code`?
: code-alias? ( cfa -- wf ) @ dup body> @ = ;
\ Is _cfa_ a word created by `code-alias` or `code`?
: defer-alias ( cfa "name" -- ) defer latest name> defer! ;
\ Create a deferred word _name_ that executes _cfa_.
: (code-alias) ( a "name" -- )
header smudge latest name> ! ;
\ Create a code word that executes the code at _a_.
: code-alias ( cfa "name" -- ) @ (code-alias) ;
\ Create a code word that executes the code pointed by _cfa_.
: alias ( cfa "name" -- )
dup code? if code-alias exit then
dup code-alias? if @ (code-alias) exit then
defer-alias ;
Wrote a new version of case, modified from eForth, shorter than the previous one.
( case )
\ Credits:
\ Code adapted and modified from eForth.
\ This version uses 48 bytes.
0 constant case immediate compile-only
: of
\ Compilation: ( -- orig )
\ Run-time: ( x1 x2 -- )
postpone over postpone = postpone if postpone drop
; immediate compile-only
: endof ( orig1 -- orig2 )
postpone else ; immediate compile-only
: endcase
( Compilation: 0 orig1..orign -- )
( Run-time: x -- )
postpone drop begin ?dup while [compile] then repeat
; immediate compile-only
( case )
\ Credits:
\ Code adapted and modified from eForth.
\ This version uses 54 bytes.
0 constant case immediate compile-only
: of
\ Compilation: ( -- orig )
\ Run-time: ( x1 x2 -- )
postpone over postpone = postpone if postpone drop
; immediate compile-only
: endof ( orig1 -- orig2 )
postpone else ; immediate compile-only
: (endcase) ( 0 orig1..orign -- )
begin ?dup while [compile] then repeat ;
: endcase
( Compilation: 0 orig1..orign -- )
( Run-time: x -- )
postpone drop (endcase) ; immediate compile-only
Finished adding compile-only to all words that don't have interpretation semantics.
Started implementing the select control structure from Galope.
Started implementing the control-flow stack words.
Improved need and needed a bit.
2015-10-26
Renamed test-bits, set-bits, reset-bits and toggle-bits as c@test-bits?, c!set-bits, c!reset-bits and c!toggle-bits.
2015-10-27
Added to the library some words written by Wil Baden: r'@, possibly and anew.
Added >order (after Gforth) to the library.
Moved c@test-bits?, c!set-bits and c!reset-bits to the kernel, to be used by immediate, immediate?, compile-only compile-only? and the future hide and reveal.
Factored out set-latest-lex from immediate and compile-only. Factored out lex! (after eForth) from set-latest-lex.
Added the Solo Forth version to greeting. Unfortunately the Pasmo assembler can not manipulate 32-bit numbers, so the contents of version has to be calculated by hand:
; ----------------------------------------------
_two_constant_header version_,'VERSION'
dw 307,31475 ; = 20151027
Wrote a simpler alternative implementation of privatize:
( privatize )
\ Usage example:
\
\ ----
\ private{
\
\ : hello ( -- ) ." hello" ;
\
\ }private
\
\ : salute ( -- ) hello ;
\
\ privatize
\
\ salute \ ok!
\ hello \ error!
\ ----
\ Credits:
\
\ The idea for this code was taken from an article by Deway
\ Val Schorre, _Structured programming by adding modules to
\ FORTH_, published in Forth Dimensions 2/5 page 132
\ (1981-01). The following original code is for fig-Forth.
\ I added stack effects and comments:
\ : INTERNAL ( -- nfa ) CURRENT @ @ ;
\ \ Start the definition of internal words of the module.
\ \ Return the nfa of the latest word created in the
\ \ `current` vocabulary.
\
\ : EXTERNAL ( -- nfa ) HERE ;
\ \ Start the definition of external words of the module.
\ \ Return the nfa of the next word to be defined.
\
\ : MODULE ( nfa1 nfa2 -- ) PFA LFA ! ;
\ \ End the module.
\ \ Link the first external word to the word before the
\ \ first internal word, thus making the internal words
\ \ invisible.
\ The names have been changed after an analogous code from
\ pForth, for clarity.
need >>link
: private{ ( -- nfa ) latest ;
\ Start private definitions.
\ Return the nfa of the latest word created in the
\ `current` vocabulary.
: }private ( -- cfap ) np@ ;
\ End private definitions.
\ Return the cfap (code field address pointer) of the first
\ word to be defined as public, that is, the current value
\ of the names pointer.
: privatize ( nfa cfap -- ) >>link !n ;
\ Hide all words between `private{` and `}private`:
\ Link the first public word to the word before the
\ first private word, thus making the internal words
\ invisible.
2015-10-29
Wrote hide and reveal to substitute smudge. Moved smudge and its factor smudged to the library. Wrote hided and revealed, useful factors of hide and reveal.
Wrote default-bank and names-bank. They are code words that call alternative entry point of the Z80 routine used by bank. This way the code can be used by high-level and low-level words, and beside some memory is saved in both cases.
Removing smudge caused a problem: the old smudge in ; was compensated by another smudge in :noname, else the word defined before :noname would be affected. Now, in order to deactivate the reveal in ; when the word being defined was created by :noname, a flag has to be used, what makes ; slower. This method was adapted from hForth.
; ----------------------------------------------
_variable_header noname_question_,'NONAME?'
; doc{
;
; noname? ( -- a )
;
; A variable that holds a flag: was the word being defined
; created by `:noname`? This flag is set by `:noname` and reset
; by `;`.
;
; }doc
dw false
; ----------------------------------------------
_colon_header noname_,':NONAME',immediate
; doc{
;
; :noname ( -- xt )
;
; Standard: Forth-94 (CORE EXT), Forth-2012 (CORE EXT).
;
; }doc
; Credits:
; Code modified from the Afera library.
; XXX TODO move to the library?
; first `do_colon` must be defined as a constant
dw here_ ; cfa
dw store_csp_
dw lit_,do_colon,comma_ ; create the code field
dw noname_question_,on_
dw right_bracket_
dw semicolon_s_
; ----------------------------------------------
_colon_header semicolon_,';',immediate+compile_only
; doc{
;
; ; ( -- )
;
; ----
; : ; ( -- )
; ?csb postpone ;s
; postpone [
; noname? @ noname? off ?exit
; reveal ;
; }doc
dw question_csp_
dw compile_,semicolon_s_
dw left_bracket_
dw noname_question_,fetch_
dw noname_question_,off_
dw question_exit_
dw reveal_
dw semicolon_s_
2015-10-31
Started implementing the post-Forth-83 loops in the kernel, with alternative names, after Spectrum Forth-83.