PFE 0.33.70
Homepage
SourceForge
Download
Documentation
-Overview
-The PFE Manual
old manual
/ (book)
-ChangeLog
-Authors
-License
(LGPL)
-Wordsets /
(book)
-Functions .. (book)
-Dp of ANS Forth
-The 4thTutor
-Forthprimer.pdf
- Old Wordsets
- Old Words List
Forth Links
* Forth Repository
* Taygeta Compilation
* TinyBoot FirmWare
* FiCL, Free Forth
*
Research Vienna
*
Research Bournemouth
* zForth WebRing
Other Links
* Tektronix/MPT
* Forth Org. (FIG)
* Forth Inc.
* MPE Ltd. Forths
* SF Win32Forth
* PD Win32Forth
* Neil Bawd
generated
(C) Guido U. Draheim
guidod@gmx.de
|
ASSEMBLER
Programming-Tools (see TOOLS-EXT)
CODE ( "name" -- ) => "EXTENSIONS"
call ALSO and add ASSEMBLER wordlist if available. Add PROC ENTER
assembler snippet as needed for the architecture into the PFA. The
CFA is setup (a) with the PFA adress in traditional ITC or (b)
with an infoblock as for sbr-coded colon words.
Remember that not all architectures are support and that the
ASSEMBLER wordset is not compiled into pfe by default. Use always
the corresponding END-CODE for each CODE start. The new
word name is not smudged.
primitive code = [p4_asm_create_code]
;CODE ( -- ) => "EXTENSIONS"
Does end the latest word (being usually some DOES> part) and enters
machine-level (in EXEC-mode).
BE AWARE:
The TOOLS-EXT will not provide an END-CODE or any other word in the
ASSEMBLER wordlist which is required to start any useful assembler
programming. After requiring ASSEMBLER-EXT you will see a second ";CODE"
in the EXTENSIONS wordlist that will also provide an optimized execution
than the result of this standard-forth implemenation.
The Standard-Forth implementation will actually compile a derivate of
BRANCH into the dictionary followed by ; . The compiled word
will not jump to the target adress (following the execution token)
but it will call the target adress via the host C stack. The target
machine level word (C domain) will just return here for being
returned (Forth domain). Hence END-CODE may be a simple RET, comma!
primitive code = [p4_asm_semicolon_code]
END-CODE ( "name" -- ) => "ASSEMBLER"
call PREVIOUS and add PROC LEAVE assembler snippet as needed
for the architecture - usually includes bits to "return from
subroutine". Remember that not all architectures are support and
PFE usually does only do variants of call-threading with a separate
loop for the inner interpreter that does "call into subroutine".
Some forth implementations do "jump into routine" and the PROC
LEAVE part would do "jump to next routine" also known as
next-threading. The sbr-call-threading is usually similar to the
native subroutine-coding of the host operating system. See CODE
primitive code = [p4_asm_end_code]
Block
Words + extensions
BLOCK ( block-u -- block-addr ) [ANS] => "[ANS] FORTH"
load the specified block into a block buffer
and return the address of that block buffer
- see also BUFFER
primitive code = [p4_block]
BUFFER ( block-u -- block-addr ) [ANS] => "[ANS] FORTH"
get the block buffer address for the specified
block - if it had not been loaded already it
is not filled with data from the disk
unlike BLOCK does.
primitive code = [p4_buffer]
FLUSH ( -- ) [ANS] => "[ANS] FORTH"
call SAVE-BUFFERS and then unassign all
block buffers with EMPTY-BUFFERS
primitive code = [p4_flush]
LOAD ( block-u -- ?? ) [FORTH] => "[ANS] FORTH"
INTERPRET the specified BLOCK
primitive code = [p4_load]
SAVE-BUFFERS ( -- ) [ANS] => "[ANS] FORTH"
write all modified buffer to
the disk, see UPDATE and
FLUSH
primitive code = [p4_save_buffers]
UPDATE ( -- ) [ANS] => "[ANS] FORTH"
mark the current block buffer as modified,
see FLUSH
primitive code = [p4_update]
EMPTY-BUFFERS ( -- ) [ANS] => "[ANS] FORTH"
unassign all block buffers, does not even UPDATE
primitive code = [p4_empty_buffers]
LIST ( block-u -- ) [ANS] => "[ANS] FORTH"
display the block
primitive code = [p4_list]
THRU ( block1-u block2-u -- ) [ANS] => "[ANS] FORTH"
LOAD a number of block in sequence.
primitive code = [p4_thru]
BLOCK-Misc
Compatibility words
CLOSE-BLOCKFILE ( -- ) [FTH] w32for => [FORTH]
w32for-implementation:
blockhandle -1 <> if flush close-file drop then
-1 set-blockfile
in pfe:
: CLOSE-BLOCKFILE
BLOCK-FILE ?DUP IF FLUSH CLOSE-FILE DROP THEN
OFF> BLOCK-FILE ;
primitive code = [p4_close_blockfile]
OPEN-BLOCKFILE ( "filename" -- ) [FTH] w32for => [FORTH]
w32for-implementation:
close-blockfile
parse-word r/w open-file abort" failed to open block-file"
set-blockfile
empty-buffers
primitive code = [p4_open_blockfile]
CREATE-BLOCKFILE ( blocks-count "filename" -- ) [FTH] w32for => [FORTH]
w32for-implementation:
close-blockfile
parse-word r/w create-file abort" failed to create block-file"
set-blockfile
dup b/buf m* blockhandle resize-file
abort" unable to create a file of that size"
empty-buffers
0 do i wipe loop
flush
pfe does not wipe the buffers
primitive code = [p4_create_blockfile]
SET-BLOCKFILE ( block-file* -- ) [EXT] win32for => "EXTENSIONS"
win32forth uses a system-filedescriptor where -1 means unused
in the BLOCKHANDLE, but we use a "FILE*"-like structure, so NULL
means NOT-IN-USE. Here we set it.
primitive code = [p4_set_blockfile]
0 CREATE-BLOCKFILE => "EXTENSIONS"
(no description)
primitive code = [p4_zero_create_blockfile]
C-preprocessor
declaration syntax
#ELSE ( -- ) [FTH] => "FORTH"
The implementation of #ELSE is done in C for speed and
being less error prone. Better use the ANSI-compatible
[IF] [ELSE] [THEN] construct.
immediate code = [p4_sh_else]
#ENDIF ( -- ) [FTH] => "FORTH"
end of #IF #IFDEF #IFNOTDEF and #ELSE contructs
(a dummy word that does actually nothing, but #ELSE may look for it)
immediate code = [p4_sh_endif]
#IF ( -- C: state-save-flag mfth-if-magic S: ) [FTH] => "FORTH"
prepares for a following #IS_TRUE or #IS_FALSE ,
does basically switch off compile-mode for the enclosed
code.
better use the ANSI style [IF] [ELSE] [THEN] construct.
immediate code = [p4_sh_if]
#IFDEF ( "word" -- ) [FTH] => "FORTH"
better use [DEFINED] word [IF] - the word [IF]
is ANSI-conform.
immediate code = [p4_sh_ifdef]
#IFNDEF => "FORTH"
(no description)
immediate code = [p4_sh_ifnotdef]
#IFNOTDEF ( "word" -- ) [FTH] => "FORTH"
better use [DEFINED] word [NOT] [IF] - the word [IF]
and [ELSE] are ANSI-conform, while #IFDEF #ELSE are not.
immediate code = [p4_sh_ifnotdef]
#IS_TRUE ( C: state-save-flag mfth-if-magic S: test-flag -- ) [FTH] => "FORTH"
checks the condition on the CS-STACK .
Pairs with #IF
better use the ANSI style [IF] [ELSE] [THEN] construct.
immediate code = [p4_sh_is_true]
#IS_FALSE ( C: state-save-flag mfth-if-magic S: test-flag -- ) [FTH] => "FORTH"
checks the condition on the CS-STACK .
Pairs with #IF
better use the ANSI style [IF] [ELSE] [THEN] construct.
immediate code = [p4_sh_is_false]
#DEFINE => "FORTH"
(no description)
primitive code = [p4_sh_define]
#PRAGMA => "FORTH"
(no description)
primitive code = [p4_sh_pragma]
chain
of executions
link, ( some-list* -- ) [EXT] => "EXTENSIONS"
: link, here over @ a, swap ! ;
primitive code = [p4_link_comma]
.chain ( some-chain* -- ) [EXT] => "EXTENSIONS"
show chain - compare with WORDS
primitive code = [p4_dot_chain]
.chains ( -- ) [EXT] => "EXTENSIONS"
show all chains registered in the system - compare with VLIST
primitive code = [p4_dot_chains]
chain-add ( some-chain* "word-to-add" -- ) [EXT] => "EXTENSIONS"
add chain item, for normal setup, at end of do-chain
: chain-add ' >r begin dup @ while @ repeat here swap ! 0 , r> , ;
( chain-add begin dup @ while @ repeat here swap ! 0, ' , )
primitive code = [p4_chain_add]
chain-add-before ( some-chain* "word-to-add" -- ) [EXT] => "EXTENSIONS"
add chain item, for reverse chain like BYE
: chain-add-before ' >r here over @ , r> , swap ! ;
( chain-add-before link, ' , )
primitive code = [p4_chain_add_before]
do-chain ( some-chain* -- ) [EXT] => "EXTENSIONS"
execute chain
: do-chain being @ ?dup while dup>r cell+ @execute r> repeat ;
primitive code = [p4_do_chain]
chainlists
- executable wordlists
NEW-WORDLIST ( "name" -- ) [EXT] [DOES: -- new-wordlist* ] => "EXTENSIONS"
create a new WORDLIST and a "name" with a runtime of ( -- wordlist* )
: NEW-WORDLIST WORDLIST VALUE ;
: NEW-WORDLIST CREATE: WORDLIST ;
usually used for DO-ALL-WORDS / DO-SYNONYM
primitive code = [p4_new_wordlist]
.WORDS ( some-wordlist* -- ) [EXT] => "EXTENSIONS"
print the WORDLIST interactivly to the user
: .WORDS ALSO SET-CONTEXT WORDS PREVIOUS ;
WORDS / ORDER / NEW-WORDLIST / DO-ALL-WORDS
primitive code = [p4_dot_words]
REDO-ALL-WORDS ( some-wordlist* -- ) [EXT] => "EXTENSIONS"
EXECUTE each entry in the wordlist in the original order defined
: REDO-ALL-WORDS
0 FIRST-NAME
0 SWAP ( under )
BEGIN ?DUP WHILE
DUP NAME> SWAP ( under )
NAME-NEXT
REPEAT
BEGIN ?DUP WHILE
EXECUTE
REPEAT
;
to run the NEW-WORDLIST in last-run-first order, use DO-ALL-WORDS
primitive code = [p4_redo_all_words]
DO-ALL-WORDS ( some-wordlist* -- ) [EXT] => "EXTENSIONS"
EXECUTE each entry in the wordlist in the reverse order defined
: DO-ALL-WORDS
0 FIRST-NAME
BEGIN ?DUP WHILE
DUP NAME> EXECUTE
NAME-NEXT
REPEAT
;
to run the NEW-WORDLIST in original order, use REDO-ALL-WORDS
primitive code = [p4_do_all_words]
DO-ALL-WORDS-WHILE-LOOP ( some-wordlist* test-xt* -- ) [EXT] => "EXTENSIONS"
EXECUTE each entry in the wordlist in the reverse order defined
but only as long as after EXECUTE of "word" a TRUE flag is left
on the stack. The wordlist execution is cut when a FALSE flag is seen.
(the current wordlist entry is _not_ on the stack!)
: DO-ALL-WORDS-WHILE-LOOP >R
0 FIRST-NAME
BEGIN ?DUP WHILE
R@ EXECUTE 0= IF R>DROP DROP EXIT THEN
DUP NAME> EXECUTE
NAME-NEXT
REPEAT R>DROP
;
compare with DO-ALL-WORDS-WHILE
primitive code = [p4_do_all_words_while_loop]
DO-ALL-WORDS-WHILE ( some-wordlist* "word" -- ) [EXT] => "EXTENSIONS"
EXECUTE each entry in the wordlist in the reverse order defined
but only as long as after EXECUTE of "word" a TRUE flag is left
on the stack. The wordlist execution is cut when a FALSE flag is seen.
(the current wordlist entry is _not_ on the stack!)
: DO-ALL-WORDS-WHILE '
STATE @ IF LITERAL, COMPILE DO-ALL-WORDS-WHILE-LOOP EXIT THEN
>R 0 FIRST-NAME
BEGIN ?DUP WHILE
R@ EXECUTE 0= IF R>DROP DROP EXIT THEN
DUP NAME> EXECUTE
NAME-NEXT
REPEAT R>DROP
;
to run the NEW-WORDLIST in original order, use REDO-ALL-WORDS
compiling word = [p4_do_all_words_while]
DO-SYNONYM ( some-wordlist* "do-name" "orig-name" -- ) [EXT] => "EXTENSIONS"
create a SYNONYM in the specified wordlist.
: DO-SYNONYM GET-CURRENT SWAP SET-CURRENT SYNONYM SET-CURRENT ;
DO-ALIAS / DO-ALL-WORDS / NEW-WORDLIST / WORDLIST / ORDER
primitive code = [p4_do_synonym]
DO-ALIAS ( some-xt* definition-wordlist* "do-name" -- ) [EXT] => "EXTENSIONS"
create an ALIAS with the exec-token in the specified wordlist
: DO-ALIAS GET-CURRENT SWAP SET-CURRENT SWAP ALIAS SET-CURRENT ;
DO-SYNONYM
primitive code = [p4_do_alias]
ALIAS-ATEXIT ( some-xt* "name" -- ) [EXT] => "EXTENSIONS"
create a defer word that is initialized with the given x-token.
: ALIAS-ATEXIT ATEXIT-WORDLIST DO-ALIAS ;
ATEXIT-WORDLIST DO-ALL-WORDS
primitive code = [p4_alias_atexit]
Complex
floating point
R2P1 => "EXTENSIONS"
(no description)
primitive code = [r2p1]
T2P1 => "EXTENSIONS"
(no description)
primitive code = [t2p1]
LAMBDA/EPSILON => "EXTENSIONS"
(no description)
primitive code = [lambda_slash_epsilon]
Z@ ( addr -- f: z ) => "EXTENSIONS"
-
primitive code = [p4_z_fetch]
Z! ( addr f: z -- ) => "EXTENSIONS"
-
primitive code = [p4_z_store]
X@ ( zaddr -- f: x ) => "EXTENSIONS"
-
primitive code = [p4_x_fetch]
X! ( zaddr f: x -- ) => "EXTENSIONS"
-
primitive code = [p4_x_store]
Y@ ( zaddr -- f: y ) => "EXTENSIONS"
-
primitive code = [p4_y_fetch]
Y! ( zaddr f: x -- ) => "EXTENSIONS"
-
primitive code = [p4_y_store]
Z. (f: z -- ) => "EXTENSIONS"
Emit the complex number, including the sign of zero when
signbit() is available.
primitive code = [p4_z_dot]
ZS. (f: z -- ) => "EXTENSIONS"
Emit the complex number in scientific notation, including the
sign of zero when signbit() is available.
primitive code = [p4_z_s_dot]
REAL (f: x y -- x ) => "EXTENSIONS"
-
primitive code = [p4_real]
IMAG (f: x y -- y ) => "EXTENSIONS"
-
primitive code = [p4_imag]
CONJG (f: x y -- x -y ) => "EXTENSIONS"
-
primitive code = [p4_conjg]
ZDROP (f: z -- ) => "EXTENSIONS"
-
primitive code = [p4_z_drop]
ZDUP (f: z -- z z ) => "EXTENSIONS"
-
primitive code = [p4_z_dup]
ZSWAP (f: z1 z2 -- z2 z1 ) => "EXTENSIONS"
-
primitive code = [p4_z_swap]
ZOVER (f: z1 z2 -- z1 z2 z1 ) => "EXTENSIONS"
-
primitive code = [p4_z_over]
ZNIP (f: z1 z2 -- z2 ) => "EXTENSIONS"
-
primitive code = [p4_z_nip]
ZTUCK (f: z1 z2 -- z2 z1 z2 ) => "EXTENSIONS"
-
primitive code = [p4_z_tuck]
ZROT (f: z1 z2 z3 -- z2 z3 z1 ) => "EXTENSIONS"
-
primitive code = [p4_z_rot]
-ZROT (f: z1 z2 z3 -- z3 z1 z2 ) => "EXTENSIONS"
-
primitive code = [p4_minus_z_rot]
Z+ (f: z1 z2 -- z1+z2 ) => "EXTENSIONS"
-
primitive code = [p4_z_plus]
Z- (f: z1 z2 -- z1-z2 ) => "EXTENSIONS"
-
primitive code = [p4_z_minus]
Z* (f: x y u v -- x*u-y*v x*v+y*u ) => "EXTENSIONS"
Uses the algorithm followed by JVN:
(x+iy)*(u+iv) = [(x+y)*u - y*(u+v)] + i[(x+y)*u + x*(v-u)]
Requires 3 multiplications and 5 additions.
primitive code = [p4_z_star]
Z/ (f: u+iv z -- u/z+iv/z ) => "EXTENSIONS"
Kahan-like algorithm *without* due attention to spurious
over/underflows and zeros and infinities.
primitive code = [p4_z_slash]
ZNEGATE (f: z -- -z ) => "EXTENSIONS"
-
primitive code = [p4_z_negate]
Z2* (f: z -- z*2 ) => "EXTENSIONS"
-
primitive code = [p4_z_two_star]
Z2/ (f: z -- z/2 ) => "EXTENSIONS"
-
primitive code = [p4_z_two_slash]
I* (f: x y -- -y x ) => "EXTENSIONS"
-
primitive code = [p4_i_star]
-I* (f: x y -- y -x ) => "EXTENSIONS"
-
primitive code = [p4_minus_i_star]
1/Z (f: z -- 1/z ) => "EXTENSIONS"
Kahan algorithm *without* due attention to spurious
over/underflows and zeros and infinities.
primitive code = [p4_one_slash_z]
Z^2 (f: z -- z^2 ) => "EXTENSIONS"
Kahan algorithm without removal of any spurious NaN created
by overflow. It deliberately uses (x-y)(x+y) instead of
x^2-y^2 for the real part.
primitive code = [p4_z_hat_two]
|Z|^2 (f: x y -- |z|^2 ) => "EXTENSIONS"
-
primitive code = [p4_z_abs_hat_two]
Z^N ( n f: z -- z^n ) => "EXTENSIONS"
-
primitive code = [p4_z_hat_n]
X+ (f: z a -- x+a y ) => "EXTENSIONS"
-
primitive code = [p4_x_plus]
X- (f: z a -- x-a y ) => "EXTENSIONS"
-
primitive code = [p4_x_minus]
Y+ (f: z a -- x y+a ) => "EXTENSIONS"
-
primitive code = [p4_y_plus]
Y- (f: z a -- x y-a ) => "EXTENSIONS"
-
primitive code = [p4_y_minus]
Z*F (f: x y f -- x*f y*f ) => "EXTENSIONS"
-
primitive code = [p4_z_star_f]
Z/F (f: x y f -- x/f y/f ) => "EXTENSIONS"
-
primitive code = [p4_z_slash_f]
F*Z (f: f x y -- f*x f*y ) => "EXTENSIONS"
-
primitive code = [p4_f_star_z]
F/Z (f: f z -- f/z ) => "EXTENSIONS"
Kahan algorithm *without* due attention to spurious
over/underflows and zeros and infinities.
primitive code = [p4_f_slash_z]
Z*I*F (f: z f -- z*if ) => "EXTENSIONS"
-
primitive code = [p4_z_star_i_star_f]
-I*Z/F (f: z f -- z/[if] ) => "EXTENSIONS"
-
primitive code = [p4_minus_i_star_z_slash_f]
I*F*Z (f: f z -- if*z ) => "EXTENSIONS"
-
primitive code = [p4_i_star_f_star_z]
I*F/Z (f: f z -- [0+if]/z ) => "EXTENSIONS"
Kahan algorithm *without* due attention to spurious
over/underflows and zeros and infinities.
primitive code = [p4_i_star_f_slash_z]
Z*>REAL (f: z1 z2 -- Re[z1*z2] ) => "EXTENSIONS"
Compute the real part of the complex product without
computing the imaginary part. Recommended by Kahan to avoid
gratuitous overflow or underflow signals from the unnecessary
part.
primitive code = [p4_z_star_to_real]
Z*>IMAG (f: z1 z2 -- Im[z1*z2] ) => "EXTENSIONS"
Compute the imaginary part of the complex product without
computing the real part.
primitive code = [p4_z_star_to_imag]
|Z| (f: x y -- |z| ) => "EXTENSIONS"
-
primitive code = [p4_z_abs]
ZBOX (f: z -- box[z] ) => "EXTENSIONS"
Defined *only* for zero and infinite arguments. This difffers
from Kahan's CBOX [p. 198] by conserving signs when only
one of x or y is infinite, consistent with the other cases, and
with its use in his ARG [p. 199].
primitive code = [p4_z_box]
ARG (f: z -- principal.arg[z] ) => "EXTENSIONS"
-
primitive code = [p4_arg]
>POLAR (f: x y -- r theta ) => "EXTENSIONS"
Convert the complex number z to its polar representation,
where theta is the principal argument.
primitive code = [p4_to_polar]
POLAR> (f: r theta -- x y ) => "EXTENSIONS"
-
primitive code = [p4_polar_from]
ZSSQS (f: z -- rho s: k ) => "EXTENSIONS"
Compute rho = |(x+iy)/2^k|^2, scaled to avoid overflow or
underflow, and leave the scaling integer k. Kahan, p. 200.
primitive code = [p4_z_ssqs]
ZSQRT (f: z -- sqrt[z] ) => "EXTENSIONS"
Compute the principal branch of the square root, with
Re sqrt[z] >= 0. Kahan, p. 201.
primitive code = [p4_z_sqrt]
ZLN (f: z -- ln|z|+i*theta ) => "EXTENSIONS"
Compute the principal branch of the complex natural
logarithm. The angle theta is the principal argument. This
code uses Kahan's algorithm for the scaled logarithm
CLOGS(z,J) = ln(z*2^J), with J=0 and blind choices of the
threshholds T0, T1, and T2. Namely, T0 = 1/sqrt(2), T1 =
5/4, and T2 = 3;
primitive code = [p4_z_ln]
ZEXP (f: z -- exp[z] ) => "EXTENSIONS"
-
primitive code = [p4_z_exp]
Z^ (f: x y u v -- [x+iy]^[u+iv] ) => "EXTENSIONS"
Compute in terms of the principal argument of x+iy.
primitive code = [p4_z_hat]
ZCOSH (f: z -- cosh[z] ) => "EXTENSIONS"
-
primitive code = [p4_z_cosh]
ZSINH (f: z -- sinh[z] ) => "EXTENSIONS"
-
primitive code = [p4_z_sinh]
ZTANH (f: z -- tanh[z] ) => "EXTENSIONS"
Kahan, p. 204, including his divide by zero signal
suppression for infinite values of tan() . To quote the very
informative "=>'man math'" on our Darwin system about IEEE 754:
"Divide-by-Zero is signaled only when a function takes
exactly infinite values at finite operands."
primitive code = [p4_z_tanh]
ZCOTH (f: z -- 1/tanh[z] ) => "EXTENSIONS"
-
primitive code = [p4_z_coth]
ZCOS (f: z -- cosh[i*z] ) => "EXTENSIONS"
-
primitive code = [p4_z_cos]
ZSIN (f: z -- -i*sinh[i*z] ) => "EXTENSIONS"
-
primitive code = [p4_z_sin]
ZTAN (f: z -- -i*tanh[i*z] ) => "EXTENSIONS"
-
primitive code = [p4_z_tan]
ZCOT (f: z -- -i*coth[-i*z] ) => "EXTENSIONS"
-
primitive code = [p4_z_cot]
ZACOS (f: z -- u+iv=acos[z] ) => "EXTENSIONS"
Kahan, p.202.
primitive code = [p4_z_acos]
ZACOSH (f: z -- u+iv=acosh[z] ) => "EXTENSIONS"
Kahan, p.203.
primitive code = [p4_z_acosh]
ZASIN (f: z -- u+iv=asin[z] ) => "EXTENSIONS"
Kahan, p.203.
primitive code = [p4_z_asin]
ZASINH (f: z -- -i*asin[i*z] ) => "EXTENSIONS"
Kahan, p. 203, couth.
primitive code = [p4_z_asinh]
ZATANH (f: z -- u+iv=atanh[z] ) => "EXTENSIONS"
Kahan, p. 203.
primitive code = [p4_z_atanh]
ZATAN (f: z -- -i*atanh[i*z] ) => "EXTENSIONS"
Kahan, p. 204, couth.
primitive code = [p4_z_atan]
ZLITERAL => "EXTENSIONS"
(no description)
compiling word = [p4_z_literal]
Core
words + extensions
! ( value some-cell* -- | value addr* -- [?] ) [ANS] => "[ANS] FORTH"
store value at addr (sizeof CELL )
primitive code = [p4_store]
# ( n,n -- n,n' ) [ANS] => "[ANS] FORTH"
see also HOLD for old-style forth-formatting words
and PRINTF of the C-style formatting - this word
divides the argument by BASE and add it to the
picture space - it should be used inside of <#
and #>
primitive code = [p4_sh]
#> ( n,n -- hold-str-ptr hold-str-len ) [ANS] => "[ANS] FORTH"
see also HOLD for old-style forth-formatting words
and PRINTF of the C-style formatting - this word
drops the argument and returns the picture space
buffer
primitive code = [p4_sh_greater]
#S ( n,n -- 0,0 ) [ANS] => "[ANS] FORTH"
see also HOLD for old-style forth-formatting words
and PRINTF of the C-style formatting - this word
does repeat the word # for a number of times, until
the argument becomes zero. Hence the result is always
null - it should be used inside of <# and #>
primitive code = [p4_sh_s]
( ( 'comment<closeparen>' -- ) [ANS] => "[ANS] FORTH"
eat everything up to the next closing paren - treat it
as a comment.
immediate code = [p4_paren]
* ( a# b# -- mul-a#' | a b -- mul-a' [??] ) [ANS] => "[ANS] FORTH"
return the multiply of the two args
primitive code = [p4_star]
*/ ( a# b# c# -- scale-a#' | a b c -- scale-a' [??] ) [ANS] => "[ANS] FORTH"
regard the b/c as element Q - this word
has an advantage over the sequence of *
and / by using an intermediate double-cell
value
primitive code = [p4_star_slash]
*/MOD ( a# b# c# -- div-a# mod-a# | a b c -- div-a mod-a [??] ) [ANS] => "[ANS] FORTH"
has an adavantage over the sequence of *
and /MOD by using an intermediate double-cell
value.
primitive code = [p4_star_slash_mod]
+ ( a* b# -- a*' | a# b* -- b*' | a# b# -- a#' | a b -- a' [??] ) [ANS] => "[ANS] FORTH"
return the sum of the two args
primitive code = [p4_plus]
+! ( value# some-cell* -- | value some* -- [?] ) [ANS] => "[ANS] FORTH"
add val to the value found in addr
simulate:
: +! TUCK @ + SWAP ! ;
primitive code = [p4_plus_store]
+LOOP ( increment# R: some,loop -- ) [ANS] => "[ANS] FORTH"
compile ((+LOOP)) which will use the increment
as the loop-offset instead of just 1. See the
DO and LOOP construct.
compiling word = [p4_plus_loop]
, ( value* -- | value# -- | value -- [?] ) [ANS] => "[ANS] FORTH"
store the value in the dictionary
simulate:
: , DP 1 CELLS DP +! ! ;
primitive code = [p4_comma]
- ( a* b# -- a*' | a# b* -- b*' | a# b# -- a#' | a* b* -- diff-b#' | a b -- a' [??] ) [ANS] => "[ANS] FORTH"
return the difference of the two arguments
primitive code = [p4_minus]
. ( value# -- | value* -- [?] | value -- [??] ) [ANS] => "[ANS] FORTH"
print the numerical value to stdout - uses BASE
primitive code = [p4_dot]
." ( [string<">] -- ) [ANS] => "[ANS] FORTH"
print the string to stdout
compiling word = [p4_dot_quote]
/ ( a# b# -- a#' | a b -- a' [???] ) [ANS] => "[ANS] FORTH"
return the quotient of the two arguments
primitive code = [p4_slash]
/MOD ( a# b# -- div-a#' mod-a#' | a b -- div-a' mod-a' [??] ) [ANS] => "[ANS] FORTH"
divide a and b and return both
quotient n and remainder m
primitive code = [p4_slash_mod]
0< ( value -- test-flag ) [ANS] => "[ANS] FORTH"
return a flag that is true if val is lower than zero
simulate:
: 0< 0 < ;
primitive code = [p4_zero_less]
0= ( 0 -- test-flag! | value! -- 0 | value -- test-flag ) [ANS] => "[ANS] FORTH"
return a flag that is true if val is just zero
simulate:
: 0= 0 = ;
primitive code = [p4_zero_equal]
1+ ( value -- value' ) [ANS] => "[ANS] FORTH"
return the value incremented by one
simulate:
: 1+ 1 + ;
primitive code = [p4_one_plus]
1- ( value -- value' ) [ANS] => "[ANS] FORTH"
return the value decremented by one
simulate:
: 1- 1 - ;
primitive code = [p4_one_minus]
2! ( x,x variable* -- ) [ANS] => "[ANS] FORTH"
double-cell store
primitive code = [p4_two_store]
2* ( a# -- a#' | a -- a' [??] ) [ANS] => "[ANS] FORTH"
multiplies the value with two - but it
does actually use a shift1 to be faster
simulate:
: 2* 2 * ; ( canonic) : 2* 1 LSHIFT ; ( usual)
primitive code = [p4_two_star]
2/ ( a# -- a#' | a -- a' [??] ) [ANS] => "[ANS] FORTH"
divides the value by two - but it
does actually use a shift1 to be faster
simulate:
: 2/ 2 / ; ( canonic) : 2/ 1 RSHIFT ; ( usual)
primitive code = [p4_two_slash]
2@ ( variable* -- x,x ) [ANS] => "[ANS] FORTH"
double-cell fetch
primitive code = [p4_two_fetch]
2DROP ( a b -- ) [ANS] => "[ANS] FORTH"
double-cell drop, also used to drop two items
primitive code = [p4_two_drop]
2DUP ( a,a -- a,a a,a ) [ANS] => "[ANS] FORTH"
double-cell duplication, also used to duplicate
two items
simulate:
: 2DUP OVER OVER ; ( wrong would be : 2DUP DUP DUP ; !!)
primitive code = [p4_two_dup]
2OVER ( a,a b,b -- a,a b,b a,a ) [ANS] => "[ANS] FORTH"
double-cell over, see OVER and 2DUP
simulate:
: 2OVER SP@ 2 CELLS + 2@ ;
primitive code = [p4_two_over]
2SWAP ( a,a b,b -- b,b a,a ) [ANS] => "[ANS] FORTH"
double-cell swap, see SWAP and 2DUP
simulate:
: 2SWAP LOCALS| B1 B2 A1 A2 | B2 B1 A2 A1 ;
primitive code = [p4_two_swap]
; ( -- ) [ANS] [EXIT] [END] => "[ANS] FORTH"
compiles ((;)) which does EXIT the current
colon-definition. It does then end compile-mode
and returns to execute-mode. See : and :NONAME
compiling word = [p4_semicolon]
< ( a* b* -- test-flag | a# b# -- test-flag | a b -- test-flag [?] ) [ANS] => "[ANS] FORTH"
return a flag telling if a is lower than b
primitive code = [p4_less_than]
<# ( -- ) [ANS] => "[ANS] FORTH"
see also HOLD for old-style forth-formatting words
and PRINTF of the C-style formatting - this word
does initialize the pictured numeric output space.
primitive code = [p4_less_sh]
= ( a* b* -- test-flag | a# b# -- test-flag | a b -- test-flag [?] ) [ANS] => "[ANS] FORTH"
return a flag telling if a is equal to b
primitive code = [p4_equals]
> ( a* b* -- test-flag | a# b# -- test-flag | a b -- test-flag [?] ) [ANS] => "[ANS] FORTH"
return a flag telling if a is greater than b
primitive code = [p4_greater_than]
>BODY ( some-xt* -- some-body* ) [ANS] => "[ANS] FORTH"
adjust the execution-token (ie. the CFA) to point
to the parameter field (ie. the PFA) of a word.
this is not a constant operation - most words have their
parameters at "1 CELLS +" but CREATE/DOES-words have the
parameters at "2 CELLS +" and ROM/USER words go indirect
with a rom'ed offset i.e. "CELL + @ UP +"
primitive code = [p4_to_body]
>NUMBER ( a,a str-ptr str-len -- a,a' str-ptr' str-len) [ANS] => "[ANS] FORTH"
try to convert a string into a number, and place
that number at a,a respeciting BASE
primitive code = [p4_to_number]
>R ( value -- R: value ) [ANS] => "[ANS] FORTH"
save the value onto the return stack. The return
stack must be returned back to clean state before
an exit and you should note that the return-stack
is also touched by the DO ... WHILE loop.
Use R> to clean the stack and R@ to get the
last value put by >R
compiling word = [p4_to_r]
?DUP ( 0 -- 0 | value! -- value! value! | value -- 0 | value! value! ) [ANS] => "[ANS] FORTH"
one of the rare words whose stack-change is
condition-dependet. This word will duplicate
the value only if it is not zero. The usual
place to use it is directly before a control-word
that can go to different places where we can
spare an extra DROP on the is-null-part.
This makes the code faster and often a little
easier to read.
example:
: XX BEGIN ?DUP WHILE DUP . 2/ REPEAT ; instead of
: XX BEGIN DUP WHILE DUP . 2/ REPEAT DROP ;
primitive code = [p4_Q_dup]
@ ( value* -- value ) [ANS] => "[ANS] FORTH"
fetch the value from the variables address
primitive code = [p4_fetch]
ABS ( value# -- value#' ) [ANS] => "[ANS] FORTH"
return the absolute value
primitive code = [p4_abs]
ACCEPT ( buffer-ptr buffer-max -- buffer-len ) [ANS] => "[ANS] FORTH"
get a string from terminal into the named input
buffer, returns the number of bytes being stored
in the buffer. May provide line-editing functions.
primitive code = [p4_accept]
ALIGN ( -- ) [ANS] => "[ANS] FORTH"
will make the dictionary aligned, usually to a
cell-boundary, see ALIGNED
primitive code = [p4_align]
ALIGNED ( addr -- addr' ) [ANS] => "[ANS] FORTH"
uses the value (being usually a dictionary-address)
and increment it to the required alignment for the
dictionary which is usually in CELLS - see also
ALIGN
primitive code = [p4_aligned]
ALLOT ( allot-count -- ) [ANS] => "[ANS] FORTH"
make room in the dictionary - usually called after
a CREATE word like VARIABLE or VALUE
to make for an array of variables. Does not
initialize the space allocated from the dictionary-heap.
The count is in bytes - use CELLS ALLOT to allocate
a field of cells.
primitive code = [p4_allot]
AND ( value mask -- value' ) [ANS] => "[ANS] FORTH"
mask with a bitwise and - be careful when applying
it to logical values.
primitive code = [p4_and]
BEGIN ( -- ) [ANS] [LOOP] => "[ANS] FORTH"
start a control-loop, see WHILE and REPEAT
compiling word = [p4_begin]
C! ( value# variable#* -- | value# variable* [?] ) [ANS] => "[ANS] FORTH"
store the byte-value at address, see => !
primitive code = [p4_c_store]
C, ( value# -- ) [ANS] => "[ANS] FORTH"
store a new byte-value in the dictionary, implicit 1 ALLOT,
see => ,
primitive code = [p4_c_comma]
C@ ( value#* -- value# | value* -- value# [?] ) [ANS] => "[ANS] FORTH"
fetch a byte-value from the address, see @
primitive code = [p4_c_fetch]
CELL+ ( value -- value' ) [ANS] => "[ANS] FORTH"
adjust the value by adding a single Cell's width
- the value is often an address or offset, see CELLS
primitive code = [p4_cell_plus]
CELLS ( value# -- value#' ) [ANS] => "[ANS] FORTH"
scale the value by the sizeof a Cell
the value is then often applied to an address or
fed into ALLOT
primitive code = [p4_cells]
CHAR ( 'word' -- char# ) [ANS] => "[ANS] FORTH"
return the (ascii-)value of the following word's
first character.
primitive code = [p4_char]
CHAR+ ( value -- value' ) [ANS] => "[ANS] FORTH"
increment the value by the sizeof one char
- the value is often a pointer or an offset,
see CHARS
primitive code = [p4_char_plus]
CHARS ( value# -- value#' ) [ANS] => "[ANS] FORTH"
scale the value by the sizeof a char
- the value is then often applied to an address or
fed into ALLOT (did you expect that sizeof(p4char)
may actually yield 2 bytes?)
primitive code = [p4_chars]
COUNT ( string-bstr* -- string-ptr' string-len | some* -- some*' some-len [?] ) [ANS] => "[ANS] FORTH"
usually before calling TYPE
(as an unwarranted extension, this word does try to be idempotent).
primitive code = [p4_count]
CR ( -- ) [ANS] => "[ANS] FORTH"
print a carriage-return/new-line on stdout
primitive code = [p4_cr]
DECIMAL ( -- ) [ANS] => "[ANS] FORTH"
set the BASE to 10
simulate:
: DECIMAL 10 BASE ! ;
primitive code = [p4_decimal]
DEPTH ( -- depth# ) [ANS] => "[ANS] FORTH"
return the depth of the parameter stack before
the call, see SP@ - the return-value is in CELLS
primitive code = [p4_depth]
DO ( end# start# | end* start* -- R: some,loop ) [ANS] [LOOP] => "[ANS] FORTH"
pushes $end and $start onto the return-stack ( >R )
and starts a control-loop that ends with LOOP or
+LOOP and may get a break-out with LEAVE . The
loop-variable can be accessed with I
compiling word = [p4_do]
DOES> ( -- does* ) [ANS] [END] [NEW] => "[ANS] FORTH"
does twist the last CREATE word to carry
the (DOES>) runtime. That way, using the
word will execute the code-piece following DOES>
where the pfa of the word is already on stack.
(note: FIG option will leave pfa+cell since does-rt is stored in pfa)
compiling word = [p4_does]
DROP ( a -- ) [ANS] => "[ANS] FORTH"
just drop the word on the top of stack, see DUP
primitive code = [p4_drop]
DUP ( a -- a a ) [ANS] => "[ANS] FORTH"
duplicate the cell on top of the stack - so the
two topmost cells have the same value (they are
equal w.r.t = ) , see DROP for the inverse
primitive code = [p4_dup]
ELSE ( -- ) [HIDDEN] => "[ANS] FORTH"
will compile an ((ELSE)) BRANCH that performs an
unconditional jump to the next THEN - and it resolves
an IF for the non-true case
compiling word = [p4_else]
EMIT ( char# -- ) [ANS] => "[ANS] FORTH"
print the char-value on stack to stdout
primitive code = [p4_emit]
ENVIRONMENT? ( name-ptr name-len -- 0 | ?? name-flag! ) [ANS] => "[ANS] FORTH"
check the environment for a property, usually
a condition like questioning the existance of
specified wordset, but it can also return some
implementation properties like "WORDLISTS"
(the length of the search-order) or "#LOCALS"
(the maximum number of locals)
Here it implements the environment queries as a SEARCH-WORDLIST
in a user-visible vocabulary called ENVIRONMENT
: ENVIRONMENT?
['] ENVIRONMENT >WORDLIST SEARCH-WORDLIST
IF EXECUTE TRUE ELSE FALSE THEN ;
primitive code = [p4_environment_Q_core]
EVALUATE ( str-ptr str-len -- ) [ANS] => "[ANS] FORTH"
INTERPRET the given string, SOURCE id
is -1 during that time.
primitive code = [p4_evaluate]
EXECUTE ( some-xt* -- ??? ) [ANS] => "[ANS] FORTH"
run the execution-token on stack - this will usually
trap if it was null for some reason, see >EXECUTE
simulate:
: EXECUTE >R EXIT ;
primitive code = [p4_execute]
EXIT ( -- ) [ANS] [EXIT] => "[ANS] FORTH"
will unnest the current colon-word so it will actually
return the word calling it. This can be found in the
middle of a colon-sequence between : and ;
compiling word = [p4_exit]
FILL ( mem-ptr mem-len char# -- ) [ANS] => "[ANS] FORTH"
fill a memory area with the given char, does now
simply call p4_memset()
primitive code = [p4_fill]
FIND ( name-bstr* -- name-bstr* 0 | name-xt* -1|1 ) [ANS] => "[ANS] FORTH"
looks into the current search-order and tries to find
the name string as the name of a word. Returns its
execution-token or the original-bstring if not found,
along with a flag-like value that is zero if nothing
could be found. Otherwise it will be 1 (a positive value)
if the word had been immediate, -1 otherwise (a negative
value).
primitive code = [p4_find]
FM/MOD ( n1,n1# n2# -- div-n1# mod-n1# ) [ANS] => "[ANS] FORTH"
divide the double-cell value n1 by n2 and return
both (floored) quotient n and remainder m
primitive code = [p4_f_m_slash_mod]
HERE ( -- here* ) [ANS] => "[ANS] FORTH"
used with WORD and many compiling words
simulate: : HERE DP @ ;
primitive code = [p4_here]
HOLD ( char# -- ) [ANS] => "[ANS] FORTH"
the old-style forth-formatting system -- this
word adds a char to the picutred output string.
primitive code = [p4_hold]
I ( R: some,loop -- S: i# ) [ANS] => "[ANS] FORTH"
returns the index-value of the innermost DO .. LOOP
compiling word = [p4_i]
IF ( value -- ) [ANS] => "[ANS] FORTH"
checks the value on the stack (at run-time, not compile-time)
and if true executes the code-piece between IF and the next
ELSE or THEN . Otherwise it has compiled a branch over
to be executed if the value on stack had been null at run-time.
compiling word = [p4_if]
IMMEDIATE ( -- ) [ANS] => "[ANS] FORTH"
make the LATEST word immediate, see also CREATE
primitive code = [p4_immediate]
INVERT ( value# -- value#' ) [ANS] => "[ANS] FORTH"
make a bitwise negation of the value on stack.
see also NEGATE
primitive code = [p4_invert]
J ( R: some,loop -- S: j# ) [ANS] => "[ANS] FORTH"
get the current DO ... LOOP index-value being
the not-innnermost. (the second-innermost...)
see also for the other loop-index-values at
I and K
compiling word = [p4_j]
KEY ( -- char# ) [ANS] => "[ANS] FORTH"
return a single character from the keyboard - the
key is not echoed.
primitive code = [p4_key]
LEAVE ( R: some,loop -- R: some,loop ) [ANS] => "[ANS] FORTH"
quit the innermost DO .. LOOP - it does even
clean the return-stack and branches to the place directly
after the next LOOP
compiling word = [p4_leave]
LITERAL ( C: value -- S: value ) [ANS] => "[ANS] FORTH"
if compiling this will take the value from the compiling-stack
and puts in dictionary so that it will pop up again at the
run-time of the word currently in creation. This word is used
in compiling words but may also be useful in making a hard-constant
value in some code-piece like this:
: DCELLS [ 2 CELLS ] LITERAL * ; ( will save a multiplication at runtime)
(in most configurations this word is statesmart and it will do nothing
in interpret-mode. See LITERAL, for a non-immediate variant)
compiling word = [p4_literal]
LOOP ( R: some,loop -- ) [ANS] [REPEAT] => "[ANS] FORTH"
resolves a previous DO thereby compiling ((LOOP)) which
does increment/decrement the index-value and branch back if
the end-value of the loop has not been reached.
compiling word = [p4_loop]
LSHIFT ( value# shift-count -- value#' ) [ANS] => "[ANS] FORTH"
does a bitwise left-shift on value
primitive code = [p4_l_shift]
M* ( a# b# -- a,a#' ) [ANS] => "[ANS] FORTH"
multiply and return a double-cell result
primitive code = [p4_m_star]
MAX ( a# b# -- a#|b# | a* b* -- a*|b* | a b -- a|b [??] ) [ANS] => "[ANS] FORTH"
return the maximum of a and b
primitive code = [p4_max]
MIN ( a# b# -- a#|b# | a* b* -- a*|b* | a b -- a|b [??] ) [ANS] => "[ANS] FORTH"
return the minimum of a and b
primitive code = [p4_min]
MOD ( a# b# -- mod-a# | a b# -- mod-a# [??] ) [ANS] => "[ANS] FORTH"
return the module of "a mod b"
primitive code = [p4_mod]
MOVE ( from-ptr to-ptr move-len -- ) [ANS] => "[ANS] FORTH"
p4_memcpy an area
primitive code = [p4_move]
NEGATE ( value# -- value#' ) [ANS] => "[ANS] FORTH"
return the arithmetic negative of the (signed) cell
simulate: : NEGATE -1 * ;
primitive code = [p4_negate]
OR ( a b# -- a' | a# b -- b' | a b -- a' [??] ) [ANS] => "[ANS] FORTH"
return the bitwise OR of a and b - unlike AND this
is usually safe to use on logical values
primitive code = [p4_or]
OVER ( a b -- a b a ) [ANS] => "[ANS] FORTH"
get the value from under the top of stack. The inverse
operation would be TUCK
primitive code = [p4_over]
POSTPONE ( [word] -- ) [ANS] => "[ANS] FORTH"
will compile the following word at the run-time of the
current-word which is a compiling-word. The point is that
POSTPONE takes care of the fact that word may be
an IMMEDIATE-word that flags for a compiling word, so it
must be executed (and not pushed directly) to compile
sth. later. Choose this word in favour of COMPILE
(for non-immediate words) and [COMPILE] (for immediate
words)
compiling word = [p4_postpone]
QUIT ( -- ) [EXIT] => "[ANS] FORTH"
this will throw and lead back to the outer-interpreter.
traditionally, the outer-interpreter is called QUIT
in forth itself where the first part of the QUIT-word
had been to clean the stacks (and some other variables)
and then turn to an endless loop containing QUERY
and EVALUATE (otherwise known as INTERPRET )
- in pfe it is defined as a THROW ,
: QUIT -56 THROW ;
primitive code = [p4_quit]
R> ( R: a -- a R: ) [ANS] => "[ANS] FORTH"
get back a value from the return-stack that had been saved
there using >R . This is the traditional form of a local
var space that could be accessed with R@ later. If you
need more local variables you should have a look at LOCALS|
which does grab some space from the return-stack too, but names
them the way you like.
compiling word = [p4_r_from]
R@ ( R: a -- a R: a ) [ANS] => "[ANS] FORTH"
fetch the (upper-most) value from the return-stack that had
been saved there using >R - This is the traditional form of a local
var space. If you need more local variables you should have a
look at LOCALS| , see also >R and R> . Without LOCALS-EXT
there are useful words like 2R@ R'@ R"@ R!
compiling word = [p4_r_fetch]
RECURSE ( ? -- ? ) [ANS] => "[ANS] FORTH"
when creating a colon word the name of the currently-created
word is smudged, so that you can redefine a previous word
of the same name simply by using its name. Sometimes however
one wants to recurse into the current definition instead of
calling the older defintion. The RECURSE word does it
exactly this.
traditionally the following code had been in use:
: GREAT-WORD [ UNSMUDGE ] DUP . 1- ?DUP IF GREAT-WORD THEN ;
now use
: GREAT-WORD DUP . 1- ?DUP IF RECURSE THEN ;
immediate code = [p4_recurse]
REPEAT ( -- ) [ANS] [REPEAT] => "[ANS] FORTH"
ends an unconditional loop, see BEGIN
compiling word = [p4_repeat]
ROT ( a b c -- b c a ) [ANS] => "[ANS] FORTH"
rotates the three uppermost values on the stack,
the other direction would be with -ROT - please
have a look at LOCALS| and VAR that can avoid
its use.
primitive code = [p4_rot]
RSHIFT ( value# shift-count# -- value#' ) [ANS] => "[ANS] FORTH"
does a bitwise logical right-shift on value
(ie. the value is considered to be unsigned)
primitive code = [p4_r_shift]
S" ( [string<">] -- string-ptr string-len) [ANS] => "[ANS] FORTH"
if compiling then place the string into the currently
compiled word and on execution the string pops up
again as a double-cell value yielding the string's address
and length. To be most portable this is the word to be
best being used. Compare with C" and non-portable "
compiling word = [p4_s_quote]
S>D ( a# -- a,a#' | a -- a,a#' [??] ) [ANS] => "[ANS] FORTH"
signed extension of a single-cell value to a double-cell value
primitive code = [p4_s_to_d]
SIGN ( a# -- ) [ANS] => "[ANS] FORTH"
put the sign of the value into the hold-space, this is
the forth-style output formatting, see HOLD
primitive code = [p4_sign]
SM/REM ( a,a# b# -- div-a# rem-a# ) [ANS] => "[ANS] FORTH"
see /MOD or FM/MOD or UM/MOD or SM/REM
primitive code = [p4_s_m_slash_rem]
SOURCE ( -- buffer* IN-offset# ) [ANS] => "[ANS] FORTH"
the current point of interpret can be gotten through SOURCE.
The buffer may flag out TIB or BLK or a FILE and IN gives
you the offset therein. Traditionally, if the current SOURCE
buffer is used up, REFILL is called that asks for another
input-line or input-block. This scheme would have made it
impossible to stretch an [IF] ... [THEN] over different blocks,
unless [IF] does call REFILL
primitive code = [p4_source]
SPACE ( -- ) [ANS] => "[ANS] FORTH"
print a single space to stdout, see SPACES
simulate: : SPACE BL EMIT ;
primitive code = [p4_space]
SPACES ( space-count -- ) [ANS] => "[ANS] FORTH"
print n space to stdout, actually a loop over n calling SPACE ,
but the implemenation may take advantage of printing chunks of
spaces to speed up the operation.
primitive code = [p4_spaces]
SWAP ( a b -- b a ) [ANS] => "[ANS] FORTH"
exchanges the value on top of the stack with the value beneath it
primitive code = [p4_swap]
THEN ( -- ) [ANS] => "[ANS] FORTH"
does resolve a branch coming from either IF or ELSE
compiling word = [p4_then]
TYPE ( string-ptr string-len -- ) [ANS] => "[ANS] FORTH"
prints the string-buffer to stdout, see COUNT and EMIT
primitive code = [p4_type]
U. ( value# -- | value -- [?] ) [ANS] => "[ANS] FORTH"
print unsigned number to stdout
primitive code = [p4_u_dot]
U< ( a b -- test-flag ) [ANS] => "[ANS] FORTH"
unsigned comparison, see <
primitive code = [p4_u_less_than]
UM* ( a# b# -- a,a#' ) [ANS] => "[ANS] FORTH"
unsigned multiply returning double-cell value
primitive code = [p4_u_m_star]
UM/MOD ( a,a# b# -- div-a#' mod-a#' ) [ANS] => "[ANS] FORTH"
see /MOD and SM/REM
primitive code = [p4_u_m_slash_mod]
UNLOOP ( R: some,loop -- ) [ANS] => "[ANS] FORTH"
drop the DO .. LOOP runtime variables from the return-stack,
usually used just in before an EXIT call. Using this multiple
times can unnest multiple nested loops.
compiling word = [p4_unloop]
UNTIL ( test-flag -- ) [ANS] [REPEAT] => "[ANS] FORTH"
ends an control-loop, see BEGIN and compare with WHILE
compiling word = [p4_until]
WHILE ( test-flag -- ) [ANS] => "[ANS] FORTH"
middle part of a BEGIN .. WHILE .. REPEAT
control-loop - if cond is true the code-piece up to REPEAT
is executed which will then jump back to BEGIN - and if
the cond is null then WHILE will branch to right after
the REPEAT
(compare with UNTIL that forms a BEGIN .. UNTIL loop)
compiling word = [p4_while]
WORD ( delimiter-char# -- here* ) [ANS] => "[ANS] FORTH"
read the next SOURCE section (thereby moving >IN ) up
to the point reaching $delimiter-char - the text is placed
at HERE - where you will find a counted string. You may
want to use PARSE instead.
primitive code = [p4_word]
XOR ( a# b# -- a#' ) [ANS] => "[ANS] FORTH"
return the bitwise-or of the two arguments - it may be unsafe
use it on logical values. beware.
primitive code = [p4_xor]
[ ( -- ) [ANS] => "[ANS] FORTH"
leave compiling mode - often used inside of a colon-definition
to make fetch some very constant value and place it into the
currently compiled colon-defintion with => , or LITERAL
- the corresponding unleave word is ]
immediate code = [p4_left_bracket]
['] ( [name] -- name-xt* ) [ANS] => "[ANS] FORTH"
will place the execution token of the following word into
the dictionary. See ' for non-compiling variant.
compiling word = [p4_bracket_tick]
[CHAR] ( [word] -- char# ) [ANS] => "[ANS] FORTH"
in compile-mode, get the (ascii-)value of the first charachter
in the following word and compile it as a literal so that it
will pop up on execution again. See CHAR and forth-83 ASCII
compiling word = [p4_bracket_char]
] ( -- ) [ANS] => "[ANS] FORTH"
enter compiling mode - often used inside of a colon-definition
to end a previous [ - you may find a => , or LITERAL
nearby in example texts.
primitive code = [p4_right_bracket]
.( ( [message<closeparen>] -- ) [ANS] => "[ANS] FORTH"
print the message to the screen while reading a file. This works
too while compiling, so you can whatch the interpretation/compilation
to go on. Some Forth-implementations won't even accept a => ." message"
outside compile-mode while the (current) pfe does.
immediate code = [p4_dot_paren]
.R ( value# precision# -- | value precision# -- [??] ) [ANS] => "[ANS] FORTH"
print with precision - that is to fill
a field of the give prec-with with
right-aligned number from the converted value
primitive code = [p4_dot_r]
0<> ( 0 -- 0 | value! -- value-flag! | value -- value-flag ) [ANS] => "[ANS] FORTH"
returns a logical-value saying if the value was not-zero.
This is most useful in turning a numerical value into a
boolean value that can be fed into bitwise words like
AND and XOR - a simple IF or WHILE doesn't
need it actually.
primitive code = [p4_zero_not_equals]
0> ( 0 -- 0 | value! -- value-flag! | value -- value-flag ) [ANS] => "[ANS] FORTH"
return value greater than zero
simulate: : 0> 0 > ;
primitive code = [p4_zero_greater]
2>R ( a,a -- R: a,a ) [ANS] => "[ANS] FORTH"
save a double-cell value onto the return-stack, see >R
compiling word = [p4_two_to_r]
2R> ( R: a,a -- a,a R: ) [ANS] => "[ANS] FORTH"
pop back a double-cell value from the return-stack, see R>
and the earlier used 2>R
compiling word = [p4_two_r_from]
2R@ ( R: a,a -- a,a R: a,a ) [ANS] => "[ANS] FORTH"
fetch a double-cell value from the return-stack, that had been
previously been put there with 2>R - see R@ for single value.
This can partly be a two-cell LOCALS| value, without LOCALS-EXT
there are alos other useful words like 2R! R'@ R"@
compiling word = [p4_two_r_fetch]
<> ( a b -- a-flag ) [ANS] => "[ANS] FORTH"
return true if a and b are not equal, see =
primitive code = [p4_not_equals]
?DO ( end# start# | end* start* -- R: some,loop ) [ANS] => "[ANS] FORTH"
start a control-loop just like DO - but don't execute
atleast once. Instead jump over the code-piece if the loop's
variables are not in a range to allow any loop.
compiling word = [p4_Q_do]
AGAIN ( -- ) [ANS] [REPEAT] => "[ANS] FORTH"
ends an infinite loop, see BEGIN and compare with
WHILE
compiling word = [p4_again]
C" ( [string<">] -- string-bstr* ) [ANS] => "[ANS] FORTH"
in compiling mode place the following string in the current
word and return the address of the counted string on execution.
(in exec-mode use a POCKET and leave the bstring-address of it),
see S" string" and the non-portable " string"
compiling word = [p4_c_quote]
CASE ( value -- value ) [ANS] => "[ANS] FORTH"
start a CASE construct that ends at ENDCASE
and compares the value on stack at each OF place
compiling word = [p4_case]
COMPILE, ( some-xt* -- ) [ANS] => "[ANS] FORTH"
place the execution-token on stack into the dictionary - in
traditional forth this is not even the least different than
a simple => , but in call-threaded code there's a big
difference - so COMPILE, is the portable one. Unlike
COMPILE , [COMPILE] and POSTPONE this word does
not need the xt to have actually a name, see :NONAME
primitive code = [p4_compile_comma]
CONVERT ( a,a# string-bstr* -- a,a# a-len# ) [ANS] [OLD] => "[ANS] FORTH"
digit conversion, obsolete, superseded by >NUMBER
primitive code = [p4_convert]
ENDCASE ( value -- ) [ANS] => "[ANS] FORTH"
ends a CASE construct that may surround multiple sections of
OF ... ENDOF code-portions. The ENDCASE has to resolve the
branches that are necessary at each ENDOF to point to right after
ENDCASE
compiling word = [p4_endcase]
ENDOF ( -- ) [ANS] => "[ANS] FORTH"
resolve the branch need at the previous OF to mark
a code-piece and leave with an unconditional branch
at the next ENDCASE (opened by CASE )
compiling word = [p4_endof]
ERASE ( buffer-ptr buffer-len -- ) [ANS] => "[ANS] FORTH"
fill an area will zeros.
2000 CREATE DUP ALLOT ERASE
primitive code = [p4_erase]
EXPECT ( str-ptr str-len -- ) [ANS] [OLD] => "[ANS] FORTH"
input handling, see WORD and PARSE and QUERY
the input string is placed at str-adr and its length
in => SPAN - this word is superceded by => ACCEPT
primitive code = [p4_expect]
HEX ( -- ) [ANS] => "[ANS] FORTH"
set the input/output BASE to hexadecimal
simulate: : HEX 16 BASE ! ;
primitive code = [p4_hex]
NIP ( a b -- b ) [ANS] => "[ANS] FORTH"
drop the value under the top of stack, inverse of TUCK
simulate: : NIP SWAP DROP ;
primitive code = [p4_nip]
OF ( value test -- value ) [ANS] => "[ANS] FORTH"
compare the case-value placed lately with the comp-value
being available since CASE - if they are equal run the
following code-portion up to ENDOF after which the
case-construct ends at the next ENDCASE
compiling word = [p4_of]
PAD ( -- pad* ) [ANS] => "[ANS] FORTH"
transient buffer region
primitive code = [p4_pad]
PARSE ( delim-char# -- buffer-ptr buffer-len ) [ANS] => "[ANS] FORTH"
parse a piece of input (not much unlike WORD) and place
it into the given buffer. The difference with word is
also that WORD would first skip any delim-char while
PARSE does not and thus may yield that one. In a newer
version, PARSE will not copy but just return the word-span
being seen in the input-buffer - therefore a transient space.
primitive code = [p4_parse]
PICK ( value ...[n-1] n -- value ...[n-1] value ) [ANS] => "[ANS] FORTH"
pick the nth value from under the top of stack and push it
note that
0 PICK -> DUP 1 PICK -> OVER
primitive code = [p4_pick]
QUERY ( -- ) => "[ANS] FORTH"
source input: read from terminal using _accept_ with the
returned string to show up in TIB of /TIB size.
primitive code = [p4_query]
REFILL ( -- refill-flag ) [ANS] => "[ANS] FORTH"
try to get a new input line from the SOURCE and set
>IN accordingly. Return a flag if sucessful, which is
always true if the current input comes from a
terminal and which is always false if the current input
comes from EVALUATE - and may be either if the
input comes from a file
primitive code = [p4_refill]
RESTORE-INPUT ( input...[input-len] input-len -- ) [ANS] => "[ANS] FORTH"
inverse of SAVE-INPUT
primitive code = [p4_restore_input]
ROLL ( value ...[n-1] n -- ...[n-1] value ) [ANS] => "[ANS] FORTH"
the extended form of ROT
2 ROLL -> ROT
primitive code = [p4_roll]
SAVE-INPUT ( -- input...[input-len] input-len ) [ANS] => "[ANS] FORTH"
fetch the current state of the input-channel which
may be restored with RESTORE-INPUT later
primitive code = [p4_save_input]
TO ( value [name] -- ) [ANS] => "[ANS] FORTH"
set the parameter field of name to the value, this is used
to change the value of a VALUE and it can be also used
to change the value of LOCALS|
compiling word = [p4_to]
TUCK ( a b -- b a b ) [ANS] => "[ANS] FORTH"
shove the top-value under the value beneath. See OVER
and NIP
simulate: : TUCK SWAP OVER ;
primitive code = [p4_tuck]
U.R ( value# precision# -- ) [ANS] => "[ANS] FORTH"
print right-aligned in a prec-field, treat value to
be unsigned as opposed to => .R
primitive code = [p4_u_dot_r]
U> ( a b -- a-flag ) [ANS] => "[ANS] FORTH"
unsigned comparison of a and b, see >
primitive code = [p4_u_greater_than]
UNUSED ( -- unused-len ) [ANS] => "[ANS] FORTH"
return the number of cells that are left to be used
above HERE
primitive code = [p4_unused]
WITHIN ( a# b# c# -- a-flag | a* b* c* -- a-flag ) [ANS] => "[ANS] FORTH"
a widely used word, returns ( b <= a && a < c ) so
that is very useful to check an index a of an array
to be within range b to c
primitive code = [p4_within]
[COMPILE] ( [word] -- ) [ANS] => "[ANS] FORTH"
while compiling the next word will be place in the currently
defined word no matter if that word is immediate (like IF )
- compare with COMPILE and POSTPONE
immediate code = [p4_bracket_compile]
\ ( [comment<eol>] -- ) [ANS] => "[ANS] FORTH"
eat everything up to the next end-of-line so that it is
getting ignored by the interpreter.
immediate code = [p4_backslash]
PARSE-WORD ( "chars" -- buffer-ptr buffer-len ) [ANS] => "[ANS] FORTH"
the ANS'94 standard describes this word in a comment
under PARSE , section A.6.2.2008 - quote:
Skip leading spaces and parse name delimited by a space. c-addr
is the address within the input buffer and u is the length of the
selected string. If the parse area is empty, the resulting string
has a zero length.
If both PARSE and PARSE-WORD are present, the need for WORD
is largely eliminated. Note that Forth200x calls it PARSE-NAME
and clarifies that non-empty whitespace-only input is returned as
a zero length string as well.
primitive code = [p4_parse_word]
PARSE-NAME ( "chars" -- buffer-ptr buffer-len ) [Forth200x] => "[ANS] FORTH"
This word is identical with the PFE implementation PARSE-WORD
The only difference between the 1994 ANS-Forth PARSE-WORD
and the 2005 Forth200x PARSE-NAME is in the explicit condition
of whitespace-only - while 1994 reads "If the parse area is empty,
the resulting string has a zero length." you will find that the
2005 version says "If the parse area is empty or contains only
white space, the resulting string has length zero."
primitive code = [p4_parse_word]
CFA' ( 'name' -- name-xt* ) [FTH] => "[ANS] FORTH"
return the execution token of the following name. This word
is _not_ immediate and may not do what you expect in
compile-mode. See ['] and '> - note that in FIG-forth
the word ' had returned the PFA (not the CFA) and therefore
this word was introduced being the SYNONYM of the ans-like
word '
primitive code = [p4_tick]
STACK-CELLS => "ENVIRONMENT"
(no description)
primitive code = [p__stack_cells]
RETURN-STACK-CELLS => "ENVIRONMENT"
(no description)
primitive code = [p__return_stack_cells]
CORE-Misc
Compatibility words
0<= ( a -- flag ) => "FORTH"
simulate : 0<= 0> 0= ;
primitive code = [p4_zero_less_equal]
0>= ( a -- flag ) => "FORTH"
simulate : 0>= 0< 0= ;
primitive code = [p4_zero_greater_equal]
<= ( a b -- flag ) => "FORTH"
simulate : <= > 0= ;
primitive code = [p4_less_equal]
>= ( a b -- flag ) => "FORTH"
simulate : >= < 0= ;
primitive code = [p4_greater_equal]
U<= ( a b -- flag ) => "FORTH"
simulate : U<= U> 0= ;
primitive code = [p4_u_less_equal]
U>= ( a b -- flag ) => "FORTH"
simulate : U>= U< 0= ;
primitive code = [p4_u_greater_equal]
UMIN ( a b -- min ) => "FORTH"
see MIN , MAX and UMAX
primitive code = [p4_u_min]
UMAX ( a b -- max ) => "FORTH"
see MAX
primitive code = [p4_u_max]
.VERSION ( -- ) => "FORTH"
show the version of the current PFE system
: .VERSION [ ENVIRONMENT ] FORTH-NAME TYPE FORTH-VERSION TYPE ;
primitive code = [p4_dot_version]
.CVERSION ( -- ) => "FORTH"
show the compile date of the current PFE system
: .CVERSION [ ENVIRONMENT ] FORTH-NAME TYPE FORTH-DATE TYPE ;
primitive code = [p4_dot_date]
LICENSE ( -- ) => "FORTH"
show a lisence info - the basic PFE system is licensed under the terms
of the LGPL (Lesser GNU Public License) - binary modules loaded into
the system and hooking into the system may carry another LICENSE
: LICENSE [ ENVIRONMENT ] FORTH-LICENSE TYPE ;
primitive code = [p4_license]
WARRANTY ( -- ) => "FORTH"
show a warranty info - the basic PFE system is licensed under the terms
of the LGPL (Lesser GNU Public License) - which exludes almost any
liabilities whatsoever - however loadable binary modules may hook into
the system and their functionality may have different WARRANTY infos.
primitive code = [p4_warranty]
STRING, ( str len -- ) => "FORTH"
Store a string in data space as a counted string.
: STRING, HERE OVER 1+ ALLOT PLACE ;
primitive code = [p4_string_comma]
PARSE, ( "chars<">" -- ) => "FORTH"
Store a char-delimited string in data space as a counted
string. As seen in Bawd's
: ," [CHAR] " PARSE STRING, ; IMMEDIATE
this implementation is much different from Bawd's
: PARSE, PARSE STRING, ;
primitive code = [p4_parse_comma]
PARSE," => "FORTH"
(no description)
immediate code = [p4_parse_comma_quote]
DEFINED ( "name" -- flag ) => "FORTH"
Search the dictionary for _name_. If _name_ is found,
return TRUE; otherwise return FALSE. Immediate for use in
definitions.
This word will actually return what FIND returns (the NFA).
does check for the word using find (so it does not throw like ' )
and puts it on stack. As it is immediate it does work in compile-mode
too, so it places its argument in the cs-stack then. This is most
useful with a directly following [IF] clause, so that sth. like
an [IFDEF] word can be simulated through [DEFINED] word [IF]
: DEFINED BL WORD COUNT (FIND-NFA) ;
primitive code = [p4_defined]
[DEFINED] ( "name" -- flag ) => "FORTH"
Search the dictionary for _name_. If _name_ is found,
return TRUE; otherwise return FALSE. Immediate for use in
definitions.
[DEFINED] word ( -- nfa|0 ) immediate
does check for the word using find (so it does not throw like ' )
and puts it on stack. As it is immediate it does work in compile-mode
too, so it places its argument in the cs-stack then. This is most
useful with a directly following [IF] clause, so that sth. like
an [IFDEF] word can be simulated through [DEFINED] word [IF]
: [DEFINED] BL WORD FIND NIP ; IMMEDIATE
immediate code = [p4_defined]
[UNDEFINED] ( "name" -- flag ) => "FORTH"
Search the dictionary for _name_. If _name_ is found,
return FALSE; otherwise return TRUE. Immediate for use in
definitions.
see [DEFINED]
immediate code = [p4_undefined]
(MARKER) ( str-ptr str-len -- ) => "FORTH"
create a named marker that you can use to FORGET ,
running the created word will reset the dict/order variables
to the state at the creation of this name.
: (MARKER) (CREATE) HERE ,
GET-ORDER DUP , 0 DO ?DUP IF , THEN LOOP 0 ,
...
DOES> DUP @ (FORGET)
...
;
primitive code = [p4_paren_marker]
ANEW ( 'name' -- ) => "FORTH"
creates a MARKER if it doesn't exist,
or forgets everything after it if it does. (it just gets executed).
Note: in PFE the ANEW will always work on the ENVIRONMENT-WORDLIST
which has a reason: it is never quite sure whether the same
DEFINITIONS wordlist is in the search ORDER that the original
ANEW MARKER was defined in. Therefore, ANEW would be only safe
on systems that do always stick to FORTH DEFINITIONS . Instead
we will CREATE the ANEW MARKER in the ENVIRONMENT and use a
simple SEARCH-WORDLIST on the ENVIRONMENT-WORDLIST upon re-run.
\ old
: ANEW BL WORD DUP FIND NIP IF EXECUTE THEN (MARKER) ;
\ new
: ANEW
PARSE-WORD 2DUP ENVIRONMENT-WORDLIST SEARCH-WORDLIST IF EXECUTE THEN
GET-CURRENT >R ENVIRONMENT-WORDLIST SET-CURRENT (MARKER) R> SET-CURRENT ;
primitive code = [p4_anew]
Debugger
words
DEBUG ( "word" -- ) [FTH] => "FORTH"
this word will place an debug-runtime into
the CFA of the following word. If the
word gets executed later, the user will
be prompted and can decide to single-step
the given word. The debug-stepper is
interactive and should be self-explanatory.
(use NO-DEBUG to turn it off again)
primitive code = [p4_debug]
NO-DEBUG ( "word" -- ) [FTH] => "FORTH"
the inverse of " DEBUG word "
primitive code = [p4_no_debug]
(SEE) => "FORTH"
(no description)
primitive code = [p4_paren_see]
ADDR>NAME ( word-addr* -- word-nfa*!' | 0 ) [FTH] => "FORTH"
search the next corresponding namefield that address
is next too. If it is not in the base-dictionary, then
just return 0 as not-found.
primitive code = [p4_addr_to_name]
COME_BACK ( -- ) [FTH] => "FORTH"
show the return stack before last exception
along with the best names as given by ADDR>NAME
primitive code = [p4_come_back]
Dynamic-Loading
of code modules
(LOADM) => "FORTH"
(no description)
primitive code = [p4_paren_loadm]
LOADM ( "filename" -- ) [FTH] => "FORTH"
dlmap the shared object (or share an already mapped object)
and run the per-thread initialization code. This is the
user-convenient function, otherwise use (LOADM)
simulate:
: LOADM BL WORD
((IS_MODULE_LOADED)) IF EXIT THEN
HERE (LOADM) 0= IF ." -- load failed: " HERE COUNT TYPE CR THEN ;
primitive code = [p4_loadm]
LOCAL-DLSYM ( [symbol] -- symbol-addr ) [FTH] [EXEC] => "FORTH"
lookup the symbol that follows and leave the address (or null)
immediate code = [p4_local_dlsym]
LOCAL-DLCALL => "FORTH"
(no description)
immediate code = [p4_local_dlcall]
CALL-C => "EXTENSIONS"
(no description)
primitive code = [p4_call_c]
USELIBRARY => "EXTENSIONS"
(no description)
primitive code = [p4_uselibrary]
lt_dlinit ( -- dlinit-ior# ) [FTH] => "EXTENSIONS"
initialiize library, usually open the program itself so that its
handles can be found under "0"
primitive code = [p4_lt_dlinit]
lt_dlopenext ( module-ptr module-len -- module-dl-handle*! | 0 ) [FTH] => "EXTENSIONS"
walk the searchpath for dlopen and try to open a binary module
under the given name with the usual file extension for the
current system.
primitive code = [p4_lt_dlopenext]
lt_dlsym ( symbol-ptr symbol-len module-dl-handle* -- symbol*! | 0 ) [FTH] => "EXTENSIONS"
try to find the name in the binary module denoted by its handle
.. if handle is null, use the main body of the program
primitive code = [p4_lt_dlsym]
lt_dlclose ( module-dl-handle* -- module-ior# ) [FTH] => "EXTENSIONS"
close handle that was returned by lt_dlopenext
primitive code = [p4_lt_dlcose]
lt_dlerror ( -- dlerror-zstr* ) => "EXTENSIONS"
returns string describing the last dlerror as for lt_dlopenext
and lt_dlsym
primitive code = [p4_lt_dlerror]
Double
number + extensions
2LITERAL ( x1 x2 -- ) immediate => "[ANS] FORTH"
compile a double-cell number to the current definition. When
run, the doubele-cell is left on the stack for execution.
( -- x1 x2 )
(in most configurations this word is statesmart and it will do nothing
in interpret-mode. See 2LITERAL, for a non-immediate variant)
compiling word = [p4_two_literal]
D+ ( d1.ud1 d2.ud2 -- d3.ud3 ) => "[ANS] FORTH"
the double-cell sum operation ( + )
primitive code = [p4_d_plus]
D- => "[ANS] FORTH"
(no description)
primitive code = [p4_d_minus]
D. ( d1.d1 -- ) => "[ANS] FORTH"
freefield output for a double-cell number ( => . )
primitive code = [p4_d_dot]
D.R ( d1.d1 n -- ) => "[ANS] FORTH"
aligned output for a double-cell number ( => .R )
primitive code = [p4_d_dot_r]
D0< ( d1.d1 -- flag ) => "[ANS] FORTH"
the double-cell less-than-zero operation ( 0< )
primitive code = [p4_d_zero_less]
D0= ( d1.d1 -- flag ) => "[ANS] FORTH"
the double-cell equal-to-zero operation ( 0= )
primitive code = [p4_d_zero_equals]
D2* ( d1.d1 -- d1.d1' ) => "[ANS] FORTH"
the double-cell arithmetic shiftleft-by-1 operation ( 2* )
primitive code = [p4_d_two_star]
D2/ ( d1.d1 -- d1.d1' ) => "[ANS] FORTH"
the double-cell arithmetic shiftright-by-1 operation ( 2/ )
primitive code = [p4_d_two_slash]
D< ( d1.d1 d2.d2 -- flag ) => "[ANS] FORTH"
the double-cell is-less operation ( < )
primitive code = [p4_d_less]
D= ( d1.d1 d2.d2 -- flag ) => "[ANS] FORTH"
the double-cell is-equal operation ( = )
primitive code = [p4_d_equals]
D>S ( d.d -- n ) => "[ANS] FORTH"
result is the numeric equivalent of d. If the double number was
greater than what could fit into a single cell number, the
modulo cellsize will be left since the higher-significant bits
are just DROP ed
primitive code = [p4_d_to_s]
DABS ( d1.d1 -- d1.d1' ) => "[ANS] FORTH"
the double-cell abs operation ( ABS )
primitive code = [p4_d_abs]
DMAX ( d1.d1 d2.d2 -- d1.d1|d2.d2 ) => "[ANS] FORTH"
the double-cell max operation ( MAX )
primitive code = [p4_d_max]
DMIN ( d1.d1 d2.d2 -- d1.d1|d2.d2 ) => "[ANS] FORTH"
the double-cell max operation ( MIN )
primitive code = [p4_d_min]
DNEGATE ( d1.d1 -- d1.d1' ) => "[ANS] FORTH"
the double-cell arithmetic negate operation ( NEGATE )
primitive code = [p4_d_negate]
M*/ ( d1.d1 n1 +n2 -- d2.d2 ) => "[ANS] FORTH"
the double-cell multiply-divide operation
using a triple-cell intermediate result for *
( *\/ )
primitive code = [p4_m_star_slash]
M+ ( d1.d1 n1 -- d2.d2 ) => "[ANS] FORTH"
the double-cell mixed-operand sum operation ( + / D+ )
primitive code = [p4_m_plus]
DOUBLE-Misc
Compatibility words
2ROT ( d1,d1 d2,d2 d3,d3 -- d2,d2 d3,d3 d1,d1 ) => [FORTH]
the double-cell ROT operation.
actively moves six cells, i.e.
( x1 x2 x3 x4 x5 x6 -- x3 x4 x5 x6 x1 x2 )
primitive code = [p4_two_rot]
DU< ( d1,d1 d2,d2 -- flag ) => [FORTH]
the double-cell unsigned-is-less operation ( U< )
primitive code = [p4_d_u_less]
LITERAL, ( value -- ) => [FORTH]
take the value from stack (or cs-stack) and compile a runtime-code and
the value as for LITERAL ... this word is never state-smart, it
is not immediate, and has therefore no complications with POSTPONE
(compare also with COMPILE, to make a call-stub with an exectoken)
primitive code = [p4_literal_comma]
2LITERAL, ( x1,x2 -- ) => [FORTH]
take the double-value from stack (or cs-stack) and compile a runtime-code
and the value as for 2LITERAL ... this word is never state-smart, it
is not immediate, and has therefore no complications with POSTPONE
(compare also with COMPILE, to make a call-stub with an exectoken)
primitive code = [p4_two_literal_comma]
DCELLS ( x -- x' ) => [FORTH]
computes the number of address units for the specified number
of double-cells
: DCELLS CELLS 2* ;
primitive code = [p4_dcells]
DLSHIFT ( x1,x2 y -- z1,z2 ) => [FORTH]
shift-left a double-cell value.
The shift-count is given as a single-cell.
primitive code = [p4_d_shiftleft]
DRSHIFT ( x1,x2 y -- z1,z2 ) => [FORTH]
shift-right a double-cell value.
The shift-count is given as a single-cell.
This is an arithmetic shift as for a signed double-cell value.
primitive code = [p4_d_shiftright]
Dynamic-Strings
extension
EMPTY$ ( $: -- empty$ ) => [FORTH]
Push the MSA of a fixed, external representation of the empty
string onto the string stack. "empty-string"
primitive code = [p4_empty_str]
\n$ ( $: -- newline$ ) => [FORTH]
Push the MSA of a fixed, external string whose body is the
Unix newline character onto the string stack.
"newline-string"
primitive code = [p4_newline_str]
(M!) => [FORTH]
(no description)
primitive code = [p4_parens_m_store]
PARSE>S ( [ccc<char>] char -- addr len ) => [FORTH]
Parse the input stream up to the first occurrence of char,
which is parsed away. If executing in compilation mode,
append run-time semantics to the current definition that
leaves the ANS Forth string representation on the stack. In
interpretation mode, leave the ANS Forth string
representation for a stored copy, which may be transient in
the style of S ". In either mode, the format of the
stored string is implementation dependent.
"parse-to-s"
NOTE: The interpreted copy is a nontransient in this
implementation, and both copies are mstrings.
primitive code = [p4_parse_to_s]
S` ( [ccc<`>] -- addr len ) => [FORTH]
An immediate version of parse>s where the delimiter is `. In
particular, the stored string in interpret mode is not
transient. "s-back-tick"
compiling word = [p4_s_back_tick]
M,S ( addr len -- addr' len ) => [FORTH]
ALLOT room and store the ANS Forth string into aligned data
space as an mstring, leaving data space zero-filled to
alignment; and leave the length and new body address. It is
assumed that len is unsigned. An error is thrown if len is
larger than the system parameter MAX_DATA_STR .
"m-comma-s"
NOTE: MAX_DATA_STR is returned by
S" /SCOPY" ENVIRONMENT?
NOTE: M,S differs from STRING, in Wil Baden's Tool
Belt in that it stores an aligned, measured string with
zero-filled alignment instead of a counted string, and it
leaves the ANS Forth string representation of the stored
string.
primitive code = [p4_m_comma_s]
MCOUNT@ ( msa -- count ) => [FORTH]
Fetch the count of the mstring at msa.
"m-count-fetch"
primitive code = [p4_m_count_fetch]
MCOUNT! ( count msa -- ) => [FORTH]
Store the count in the measured string count field at msa,
without checking that it fits.
"m-count-store"
primitive code = [p4_m_count_store]
MCOUNT ( msa -- body.addr count ) => [FORTH]
Convert the mstring MSA to its ANS Forth string
representation. "m-count"
primitive code = [p4_m_count]
-MCOUNT ( addr len -- msa ) => [FORTH]
Convert the ANS Forth representation of an mstring to its
MSA. "minus-m-count"
primitive code = [p4_minus_m_count]
($: => [FORTH]
(no description)
immediate code = [p4_paren]
0STRINGS ( -- ) => [FORTH]
Set all string variables holding bound string values in string
space to the empty string, and clear string space, including
the string buffer, string stack, and string stack frames.
"zero-strings"
NOTE: If used for under the hood development, this word must
be executed only when string space is in a valid state.
primitive code = [p4_zero_strings]
$GARBAGE? ( -- flag ) => [FORTH]
Leave true if there is garbage in the current string space.
Not normally used, since garbage collection is transparent.
"string-garbage-question"
primitive code = [p4_str_garbage_Q]
$GC-OFF ( -- ) => [FORTH]
Disable garbage collection in the current string space. An
error will be thrown if garbage collection is attempted.
"string-g-c-off"
primitive code = [p4_str_gc_off]
$GC-ON ( -- ) => [FORTH]
Enable garbage collection in the current string space. This
is the default. "string-g-c-on"
primitive code = [p4_str_gc_on]
$GC-LOCK@ ( -- flag ) => [FORTH]
Fetch the dstring garbage collection "off" state. Intended
for saving the off state for later restoration after a usage
of $GC-ON or $GC-OFF .
"string-g-c-lock-fetch"
primitive code = [p4_str_gc_lock_fetch]
$GC-LOCK! ( flag -- ) => [FORTH]
Set the dstring garbage collection "off" state according to
flag. Intended for restoring the off state previously
fetched by $GC-LOCK@ .
"string-g-c-lock-fetch"
primitive code = [p4_str_gc_lock_store]
$UNUSED ( -- u ) => [FORTH]
Leave the number of bytes available for dynamic strings and
string stack entries in the string buffer.
"string-unused"
primitive code = [p4_str_unused]
COLLECT-$GARBAGE ( -- collected-flag ) => [FORTH]
If string space is not marked as containing garbage, return
false. If there is garbage, throw an error when garbage
collection is disabled. Otherwise remove the garbage and
return true. Garbage collection is "transparent", so the
user would not normally use this word.
"collect-string-garbage"
primitive code = [p4_collect_str_garbage]
MAKE-$SPACE ( size #frames -- addr ) => [FORTH]
Allocate and initialize a string space with size bytes
available for the string buffer including the string stack,
and with a string frame stack for frame description entries
holding up to #frames. The size is rounded up to cell
alignment, and the buffer begins and ends with cell alignment.
Return addr, the address of the string space. The standard
word FREE with addr as input can be used to release the space.
"make-string-space"
primitive code = [p4_make_str_space]
/$BUF ( -- u ) => [FORTH]
Leave the size in address units allocated for the current
string buffer. "slash-string-buf"
primitive code = [p4_slash_str_buf]
MAX-#$FRAMES ( -- u ) => [FORTH]
Leave the number of string frames allowed on the string frame
stack for the current string space.
"max-number-string-frames"
primitive code = [p4_max_num_str_frames]
$! ( $var.dfa $: a$ -- ) => [FORTH]
Store the string MSA on the string stack in the variable
whose DFA is on the parameter stack.
"string-store"
NOTES: The only situation in which $! copies the string
value is when it is a bound string already stored in another
variable. In that case, the new copy is the one that is
stored in the variable. In particular, external strings are
not copied.
If the string value held by the string variable on entry is a
bound string that is also referenced deeper on the string
stack, its back link is reset to point to the deepest string
stack reference. If it is a bound string not deeper on the
string stack and not identical to the input string, its back
link is set to zero, making it garbage. If it is an external
string, its MSA in the variable is simply written over by
that popped from the string stack.
primitive code = [p4_str_store]
$@ ( $var.pfa -- $: a$ ) => [FORTH]
Leave the MSA of the string held by the string variable.
"string-fetch"
primitive code = [p4_str_fetch]
(M$:) => [FORTH]
(no description)
compiling word = [p4_marg_execution]
$" ( [ccc<">] -- $: str ) => [FORTH]
Parse ccc delimited by " (double quote) and store it in data
space as an mstring. If interpreting, leave the MSA on the
string stack. If compiling, append run-time semantics to the
current definition that leaves the MSA on the string stack.
A program should not alter the stored string. An error is
thrown if the quoted string length is larger than the system
parameter MAX_DATA_STR (see SM, ).
"string-quote"
NOTE: In contrast to S" , the string stored by $" when
interpreting is not transient.
The implementation is based on PFE code for S" .
compiling word = [p4_str_quote]
$` ( [ccc<`>] -- $: str ) => [FORTH]
Parse ccc delimited by ` (back-tick). This is "$"" with
back tick instead of double quote as the delimiter.
"string-back-tick"
compiling word = [p4_str_back_tick]
$VARIABLE ( "name" -- ) => [FORTH]
"name" execution: ( -- dfa )
Create an ordinary Forth variable and initialize it to the
address of a fixed, external, measured representation of the
empty string, such as that pushed onto the string stack by
EMPTY$ . "string-variable""
primitive code = [p4_str_variable]
PARSE>$ ( [ccc<char>] char -- $: ccc$ ) => [FORTH]
Parse the input stream up to the first occurrence of char,
which is parsed away, and store the string as an external
measured string. If executing in compilation mode, append
run-time semantics to the current definition that leaves the
MSA on the string stack. In interpretation mode, leave the
MSA on the string stack, where the stored copy, unlike
PARSE>S , is required to be nontransient.
primitive code = [p4_parse_to_str]
$. ( $: a$ -- ) => [FORTH]
Display the string on the terminal. If the system
implementation of TYPE has its output vectored, $. uses the
same vector. "string-dot"
primitive code = [p4_str_dot]
$2DROP ( $: a$ b$ -- ) => [FORTH]
Drop the two topmost string stack entries, marking them as
garbage if appropriate. "string-two-drop"
primitive code = [p4_str_two_drop]
$2DUP ( $: a$ b$ -- a$ b$ a$ b$ ) => [FORTH]
Leave copies of the two topmost string stack entries. The string
values are not copied. "string-two-dupe"
primitive code = [p4_str_two_dup]
$DEPTH ( -- n ) => [FORTH]
Leave the number of items on the string stack.
"string-depth"
primitive code = [p4_str_depth]
$DROP ( $: a$ -- ) => [FORTH]
Drop the topmost string stack entry, marking it as garbage if
it is initially bound to the top of the string stack.
"string-drop"
primitive code = [p4_str_drop]
$DUP ( $: a$ -- a$ a$ ) => [FORTH]
Leave a copy of the topmost string stack entry. The string
value is not copied. "string-dupe"
primitive code = [p4_str_dup]
$NIP ($: a$ b$ -- b$ ) => [FORTH]
Drop the next to top item from the string stack.
"string-nip"
NOTE: Because of essential string space bookkeeping, the
system level implementation can be little more efficient than
the high-level definition:
: $NIP $SWAP $DROP ;
primitive code = [p4_str_nip]
$OVER ( $: a$ b$ -- a$ b$ a$ ) => [FORTH]
Leave a copy of the next most accessible string stack entry
on top of the string stack. The string value is not copied.
"string-over"
primitive code = [p4_str_over]
$PICK ( u $: au$ ... a0$ -- au$ ... a0$ au$ ) => [FORTH]
Copy the u-th string stack entry to the top of the string
stack. The string value is not copied. Throw an error if
the input string stack does not have at least u+1 items.
"string-pick"
primitive code = [p4_str_pick]
$SWAP ( $: a$ b$ -- b$ a$ ) => [FORTH]
Exchange the two most accessible strings on the string stack.
Throw an error if there are less than two strings on the
stack. Neither string value is copied.
"string-swap"
primitive code = [p4_str_swap]
$EXCHANGE ( i j -- ) => [FORTH]
($: maxth$ ... minth$ ... -- minth$ ... maxth$ ... )
Exchange the ith and jth strings on the string stack, where
the top is the 0th. Throw an error if there are not at least
max[i,j] + 1 strings on the stack. Neither string value is
copied.
"string-exchange"
primitive code = [p4_str_exchange]
$S> ( $: a$ -- S: a.s ) => [FORTH]
Drop a$ from the string stack and leave it as a ANS Forth
string a.s, without copying.
"string-s-from"
WARNING: If a$ is a bound string, it may move or disappear
at the next garbage collection, making a.s invalid. This can
be avoided by sandwiching sections of code where this could
occur between $GC-OFF and $GC-ON.
primitive code = [p4_str_s_from]
$,S ( $: a$ -- S: a.s ) => [FORTH]
Drop a$ from the string stack, copy it into data space as a
measured string, and leave it as an ANS Forth string a.s.
An error is thrown if the string length is larger than the
system parameter MAX_DATA_STR (see M,S ).
"string-comma-s"
primitive code = [p4_str_comma_s]
$S@ ( $: a$ -- a$ S: a.s ) => [FORTH]
Leave the string stack unchanged, and leave the string body
address and length on the data stack.
"string-s-fetch"
WARNING: If a$ is a bound string, it may move at the next
garbage collection, making a.s invalid. This can be avoided
by sandwiching sections of code where this could occur
between $GC-OFF and $GC-ON.
primitive code = [p4_str_s_fetch]
$TUCK ($: a$ b$ -- b$ a$ b$ ) => [FORTH]
Copy the top string stack item just below the second item. The
string value is not copied. "string-tuck"
NOTE: Because of essential string space bookkeeping, the
system level implementation can be little more efficient than
the high-level definition:
: $TUCK $SWAP $OVER ;
primitive code = [p4_str_tuck]
$TYPE ($: a$ -- ) => [FORTH]
Display the string on the terminal. A deprecated $.
synonym. "string-type"
primitive code = [p4_str_dot]
>$S-COPY ( a.s -- $: a$ ) => [FORTH]
Copy the external string value whose body address and count
are on the parameter stack into the string buffer and push it
onto the string stack. Errors are thrown if the count is
larger than MAX_MCOUNT , if there is not enough room in string
space, even after garbage collection, or if there is an
unterminated string concatenation. The input external string
need not exist as a measured string.
"to-string-s-copy"
NOTE: MAX_MCOUNT is the largest size the count field of a
measured string can hold, e.g., 255, 64K-1, or 4,096M-1. It
is returned by:
S" /DYNAMIC-STRING" ENVIRONMENT?
WARNING: This word should not be used when the input string
is a bound string because the copy operation may generate a
garbage collection which invalidates its MSA.
primitive code = [p4_to_str_s_copy]
>$S ( a.s -- $: a$ ) => [FORTH]
Push the external ANS Forth string a.s onto the string
stack, without copying the string value into the string
buffer. It is an unchecked error if the Forth string a.s
is not stored as an external measured string.
"to-string-s"
WARNING: If the string value of a.s is actually in the
string buffer and not external, the push operation may
generate a garbage collection that invalidates its MSA.
primitive code = [p4_to_str_s]
$+ ($: a$ -- ) => [FORTH]
If a$ is the empty string, drop it and do nothing else.
In particular, do not start a new concatenation, which would
lock string space against new nonconcatenating copies.
Otherwise append the string body to the end of the string
currently being concatenated as the last string in the string
buffer, and update its count field. If there is no
concatenating string, start one. An error is thrown if the
size of the combined string would be larger than
MAX_MCOUNT or if there is not enough room in string space
even after a garbage collection.
If garbage collection occurs, a$ remains valid even when
it is in the string buffer.
When there is a concatenating string, concatenation is the
only basic string operation that can copy a string into the
string buffer. "string-plus"
primitive code = [p4_str_plus]
S+ ( a.s -- ) => [FORTH]
If a.s is the empty string, drop it and do nothing else.
Append the ANS Forth string body to the end of the string
currently being concatenated as the last string in the string
buffer, and update its count field. If there is no
concatenating string, start one. An error is thrown if the
size of the combined string would be larger than MAX_MCOUNT
or if there is not enough room in string space even after a
garbage collection.
S+ is most commonly used on external strings, not
assumed to exist as mstrings. In contrast to $+ ,
garbage collection could invalidate a.s if it is a dynamic
string in the string buffer. S+ can be used in that
situation if garbage collection is turned off with
$GC-OFF .
When there is a concatenating string, concatenation is the
only basic string operation that can copy a string into the
string buffer. "s-plus"
primitive code = [p4_s_plus]
PARSE-S+ ( [ccc<char>] char -- ) => [FORTH]
Parse the input stream up to the first occurrence of char,
which is parsed away. If executing in compilation mode,
append run-time semantics to the current definition that
concatenates the characters parsed from the string.
Otherwise concatenate the characters.
"parse-s-plus"
primitive code = [p4_parse_s_plus]
ENDCAT ( -- $: cat$ | empty$ ) => [FORTH]
If there is no concatenating string, do nothing but leave the
empty string. If there is, leave it as a string bound to the
top of the string stack, and terminate concatenation,
permitting normal copies into the string buffer.
"end-cat"
primitive code = [p4_endcat]
$+" ( [ccc<quote>] -- ) => [FORTH]
This word is immediate. In compilation mode it appends
run-time semantics to the current definition that
concatenates the quoted string according to the specification
for $+ . In interpretation mode it concatenates the
string. An error is thrown if the length of the quoted
string is longer than the system parameter MAX_DATA_STR
(see M,S ). "string-plus-quote"
compiling word = [p4_str_plus_quote]
$+` ( [ccc<backtick>] -- ) => [FORTH]
The same as $+" but with back tick instead of double
quote as delimiter. "string-plus-back-tick"
compiling word = [p4_str_plus_back_tick]
#$ARGS ( -- u ) => [FORTH]
Leave the number of entries in the topmost string frame.
Throw an error if the frame stack is empty.
"number-string-args"
primitive code = [p4_num_str_args]
$ARGS{ ( arg1'$ ... argN'$ "arg1 ... argN <}>" -- ) => [FORTH]
compilation: ( -- $: arg1$ ... argN$ )
Immediate and compilation-only.
Copy the argument strings across lines to the string buffer,
push them onto the string stack with "argN" the most
accessible, and make them into the top compile-time string
stack frame. Compile the run-time code to make an argument
frame out of the N most accessible run-time string stack
entries. Inform the system text interpreter that it should
compile run-time code for any white-space delimited argument
encountered in the text of the definition, that concatenates
the corresponding string in the run-time frame. At the
semicolon terminating the definition, drop the compile-time
argument frame and compile code to drop the run-time argument
frame.
The code between $ARGS{ ... } and the terminating
semicolon is not allowed to make a net change in the string
stack depth, because that would interfere with the automatic
dropping of the string argument frame at the semicolon.
"string-args-brace"
Syntax for defining a string macro GEORGE:
: george ($: a$ b$ c$ -- cat$ )
$ARGS{ arg1 arg2 arg3 }
cat" This is arg1: " arg1 cat" ." ENDCAT $. ;
The blank following the last argument is required. For a
macro with no arguments, $ARGS{ } does nothing but add
useless overhead and should be omitted. Two of the
arguments in this example are ignored and could have been
left out. Note that ENDCAT would not be legal in this
word without something like $. to remove the concatenated
string from the string stack before the terminating
semicolon. It is normal to use an $ARGS{ } word as a step
in a concatenation that is terminated elsewhere.
Sample syntax using the string macro george :
$" bill" $" sue" $" marie" george $.
The resulting display is:
This is arg1: bill.
NOTE: Macro argument labels must be distinct from each other
and from any local labels that appear in the same definition,
and there is no check for that.
NOTE: At the moment the semantics of $ARGS{ is undefined
before DOES> .
immediate code = [p4_str_args_brace]
$FRAME ( u -- ) => [FORTH]
Push the description of a string stack frame starting at the
top of the string stack and containing u entries onto the
string frame stack. Errors are thrown if the frame stack
would overflow or if the depth of the string stack above the
top frame, if there is one, is less than u. The value u = 0
is allowed. "string-frame"
NOTE: This implementation pushes u and the string stack
pointer onto the frame stack.
primitive code = [p4_str_frame]
$FRAME-DEPTH ( -- u ) => [FORTH]
Leave the number of string frames currently on the string
frame stack. "string-frame-depth"
primitive code = [p4_str_frame_depth]
DROP-$FRAME ($: frame*$ i*$ -- i*s ) => [FORTH]
Drop the topmost string frame from the string frame stack,
and the corresponding strings, frame*$, from the string
stack. An error is thrown if either stack would underflow.
The cases where the frame has zero entries on the string
stack and/or there are zero or more items on the string stack
above the top frame item are handled properly.
"drop-string-frame"
primitive code = [p4_drop_str_frame]
FIND-$ARG ( s -- u true | false ) => [FORTH]
Leave true and its index u in the top string frame if the
ANS Forth string matches an element of the frame, else leave
false. The index of the top frame element is zero.
"find-string-arg"
primitive code = [p4_find_str_arg]
TH-$ARG ( u -- $: arg$ ) => [FORTH]
Leave the u-th string in the topmost string frame, where the
index u of the top element is zero. Throw an error if the
frame stack is empty or if the top frame contains less than
u+1 strings. "th-string-arg"
primitive code = [p4_th_str_arg]
(DROP-$FRAME) => [FORTH]
(no description)
compiling word = [p4_do_drop_str_frame]
$POP ( $: a$ -- s: a$) => [FORTH]
Abort if the string stack would underflow when popped.
Otherwise pop the top of the string stack and push it onto
the data stack.
If the string is in the current string space and initially
bound to the top of the string stack, mark it as garbage by
setting its back link to NULL and set the garbage flag.
This word violates the rule that only ANS Forth strings
should appear on the data stack, and so is under the hood.
"string-pop"
primitive code = [p4_str_pop]
$PUSH-EXT ( a$ -- $: a$ ) => [FORTH]
Pop an external mstring address from the data stack and push
it onto the string stack after checking for room, invoking
garbage collection if necessary. Not to be used with a
dynamic string because a garbage collection can invalidate
its address.
This word violates the normal rule that only ANS Forth
strings should appear on the data stack, and so is under the
hood.
"string-push-ext"
primitive code = [p4_str_push_ext]
$BREAKP@ ( -- $stack.break.addr ) => [FORTH]
"string-break-p-fetch"
primitive code = [p4_str_breakp_fetch]
$BUFP@ ( -- $buffer.addr ) => [FORTH]
"string-buf-p-fetch"
primitive code = [p4_str_bufp_fetch]
$FBREAKP@ ( -- frame.stack.break.addr ) => [FORTH]
"string-f-break-p-fetch"
primitive code = [p4_str_fbreakp_fetch]
$FSP@ ( -- frame.stack.top.addr ) => [FORTH]
"string-f-s-p-fetch"
primitive code = [p4_str_fsp_fetch]
$FSP0@ ( -- initial.frame.stack.top.addr ) => [FORTH]
"string-f-s-p-zero-fetch"
primitive code = [p4_str_fsp0_fetch]
$SP@ ( -- string.stack.top.addr ) => [FORTH]
"string-s-p-fetch"
primitive code = [p4_str_sp_fetch]
$SP0@ ( -- initial.string.stack.top.addr ) => [FORTH]
"string-s-p-zero-fetch"
primitive code = [p4_str_sp0_fetch]
/$FRAME-ITEM => [FORTH]
(no description)
primitive code = [p4_slash_str_frame_item]
/$FRAME-STACK => [FORTH]
(no description)
primitive code = [p4_slash_str_frame_stack]
/$SPACE-HEADER ( -- $space.header.size ) => [FORTH]
"slash-string-space-header"
primitive code = [p4_slash_str_space_header]
0$SPACE ( $space.addr -- ) => [FORTH]
Clear the string buffer, string stack, and string frame stack
in the string space starting at space.addr. Any string
variables holding strings in the string buffer are left
pointing into limbo. This may be executed with the string
space in an invalid state, as long as the /$BUF and
MAX-#$FRAMES fields of its string space structure are
intact. "zero-string-space"
NOTE: This word does not zero fill the string buffer.
primitive code = [p4_zero_str_space]
CAT$P@ ( -- cat$.msa | 0 ) => [FORTH]
"cat-string-fetch"
primitive code = [p4_cat_str_p_fetch]
IN-$BUFFER? ( msa -- flag ) => [FORTH]
Leave true if the mstring is in the string buffer.
"in-string-buffer-question"
primitive code = [p4_in_str_buffer_Q]
EDIT
- builtin forth editor
EDIT-BLOCK ( blk -- ) => [FORTH]
start the internal block-editor on the assigned block
primitive code = [p4_edit_block]
EDIT-TEXT => [FORTH]
(no description)
primitive code = [p4_edit_text]
EDIT-ERROR ( -- ) => [FORTH]
if an error occured, this routine can be called to invoke
an appropriate EDITOR (see also EDIT-BLOCK )
primitive code = [p4_edit_error]
EDIT-BLOCK-START => "FORTH"
(no description)
primitive code = [p4_edit_block]
Forth
Base system
INTERPRET-NEXT => "FORTH"
(no description)
compiling word = [p4_interpret_next]
INTERPRET-FIND ( CS: dest* -- dest* ) executes ( -- ) experimental => "FORTH"
check the next word from QUERY and try to look it up
with FIND - if found then execute the token right away
and branch out of the loop body (usually do it AGAIN )
compiling word = [p4_interpret_find]
INTERPRET-NUMBER ( CS: dest* -- dest* ) executes ( -- ) experimental => "FORTH"
check the next word from QUERY and try to parse it up
with => ?NUMBER - if parseable then postpone the number for execution
and branch out of the loop body (usually do it AGAIN )
compiling word = [p4_interpret_number]
INTERPRET-NOTHING => "FORTH"
(no description)
compiling word = [p4_interpret_nothing]
INTERPRET-UNDEFINED => "FORTH"
(no description)
compiling word = [p4_interpret_undefined]
Environment
related definitions
ENVIRONMENT? ( name-ptr name-len -- 0 | ?? name-flag! ) [ANS] => [FORTH]
check the environment for a property, usually
a condition like questioning the existance of
specified wordset, but it can also return some
implementation properties like "WORDLISTS"
(the length of the search-order) or "#LOCALS"
(the maximum number of locals)
Here it implements the environment queries as a SEARCH-WORDLIST
in a user-visible vocabulary called ENVIRONMENT
: ENVIRONMENT?
['] ENVIRONMENT >WORDLIST SEARCH-WORDLIST
IF EXECUTE TRUE ELSE FALSE THEN ;
primitive code = [p4_environment_Q]
REQUIRED ( ... str-ptr str-len -- ??? ) => [FORTH]
the filename argument is loaded via INCLUDED as
an extension package to the current system. The filename
is registered in the current ENVIRONMENT so that it is
only INCLUDED once (!!) if called multiple times via
REQUIRED or REQUIRES
primitive code = [p4_include_required]
REQUIRE ( ... "file-name" -- ... ) => [FORTH]
parses the next WORD and passes it to REQUIRED
this is the self-parsing version of REQUIRED and
it does parrallel INCLUDE w.r.t. INCLUDED
primitive code = [p4_include_require]
NEEDS ( name -- ) => [FORTH]
A self-parsing variant of an environment-query check. It is similar
to a simulation like
: NEEDS PARSE-WORD 2DUP ENVIRONMENT?
IF DROP ( extra value ) 2DROP ( success - be silent )
ELSE TYPE ." not available " CR THEN ;
however that would only match those worset-envqueries which return a
single extra item under the uppermost TRUE flag in the success case.
Instead it works more like
: NEEDS PARSE-WORD 2DUP ENVIRONMENT-WORDLIST SEARCH-WORDLIST
IF 2DROP ( success - be silent and just drop the parsed word )
ELSE TYPE ." not available " CR THEN ;
however we add the same extension as in ENVIRONMENT ? as that
it can automatically load a wordset module to fullfil a query
that looks like "[wordsetname]-ext". Therefore, the following
two lines are pretty much identical:
LOADM floating
NEEDS floating-ext
the difference between the two: if somebody did provide a forth
level implementation of floating-ext then that implementation might
have registered a hint "floating-ext" in the environment-wordlist.
This extra-hint will inhibit loading of the binary module even if
it exists and not been loaded so far. The LOADM however will
not check the ENVIRONMENT-WORDLIST and only check its loadlist
of binary wordset modules in the system.
It is therefore recommended to use NEEDS instead of LOADM
unless you know you want the binary module, quickly and uncondtionally.
primitive code = [p4_needs_environment]
Exception
+ extensions
CATCH ( catch-xt* -- 0 | throw#! ) [ANS] => "[ANS] FORTH"
execute the given execution-token and catch
any exception that can be caught therein.
software can arbitrarily raise an exception
using THROW - the value 0 means there
was no exception, other denote implementation
dependent exception-codes.
primitive code = [p4_catch]
THROW ( throw#! -- [THROW] | throw# -- ) [ANS] => "[ANS] FORTH"
raise an exception - it will adjust the depth
of all stacks and start interpreting at the point
of the latest CATCH
if n is null nothing happens, the -1 (ie. FALSE )
is the raise-code of ABORT - the other codes
are implementation dependent and will result in
something quite like ABORT
primitive code = [p4_throw]
ABORT ( -- [THROW] ) [ANS] => "[ANS] FORTH"
throw - cleanup some things and go back to the QUIT routine
: ABORT -1 THROW ;
primitive code = [p4_abort]
ABORT" ( [string<">] -- [THROW] ) [ANS] => "[ANS] FORTH"
throw like ABORT but print an additional error-message
to stdout telling what has happened.
compiling word = [p4_abort_quote]
Facility
+ extensions
AT-XY ( col# row# -- ) [ANS] => "[ANS] FORTH"
move the cursor position to the given row and column
of the screen. If the output device is not a terminal
this will have no effect but can still send an
escape sequence.
primitive code = [p4_at_x_y]
KEY? ( -- key-flag ) [ANS] => "[ANS] FORTH"
if a character is available from the keyboard, return true.
The KEY word will retrieve the actual character.
primitive code = [p4_key_question]
PAGE ( -- ) [ANS] => "[ANS] FORTH"
CLRSCR
primitive code = [p4_dot_clrscr]
EKEY ( -- key-code# ) [ANS] => "[ANS] FORTH"
return a keyboard event, the encoding may differ, esp.
that it can contain special keys.
primitive code = [p4_ekey]
EKEY>CHAR ( key-code# -- key-code# 0 | char# true! ) [ANS] => "[ANS] FORTH"
-
primitive code = [p4_ekey_to_char]
EKEY? ( -- ekey-flag ) [ANS] => "[ANS] FORTH"
check if a character is available from the keyboard
to be received - unlike KEY ? it will not discard
non-visible codes.
primitive code = [p4_ekey_question]
EMIT? ( -- emit-flag ) [ANS] => "[ANS] FORTH"
if EMIT can safely output characters without
blocking the forth by waiting for an indefinite time.
primitive code = [p4_emit_question]
MS ( milliseconds# -- ) [ANS] => "[ANS] FORTH"
wait at least the specified milliseconds
(suspend the forth tasklet)
primitive code = [p4_ms]
TIME&DATE => "[ANS] FORTH"
(no description)
primitive code = [p4_time_and_date]
FACILITY-MIX
extra words
#! ( "...<eol>" -- ) => "EXTENSIONS"
ignores the rest of the line,
defining `#!' is used to support forth scripts
executed by the unix kernel
primitive code = [p4_ignore_line]
GETTIMEOFDAY ( -- milliseconds# epochseconds# ) [EXT] => "EXTENSIONS"
returns SVR/BSD gettimeofday(2).
Incompatible with 16-bit systems as the numbers can not be properly
represented, hence TIME&DATE is more portable.
primitive code = [gettimeofday]
MS@ ( -- milliseconds# ) [EXT] => "EXTENSIONS"
elapsed time since start of process (or system) - in millseconds.
The granularity is per clockticks as per ENVIRONMENT CLOCKS_PER_SEC
For the current wallclock in milliseconds, ask GETTIMEOFDAY .
Remember that the process clock will wrap around at some point,
therefore only use difference values between two clock reads.
see also CLOCK@ and MS
primitive code = [p4_milliseconds_fetch]
CLOCK@ ( --- clock-ticks# ) [EXT] => "EXTENSIONS"
return clock(2) - the number of clocks of this proces.
To get the number of seconds, divide by CLOCKS_PER_SEC a.k.a. CLK_TCK
as represented in the ENVIROMENT for a hosted forth system.
Remember that the process clock will wrap around at some point,
therefore only use difference values between two clock reads.
primitive code = [p4_clock_fetch]
File-access
+ extensions
BIN ( access-mode# -- access-mode#' ) [ANS] => "[ANS] FORTH"
modify the give file access-mode to be a binary-mode
primitive code = [p4_bin]
CLOSE-FILE ( some-file* -- some-errno# ) [ANS] => "[ANS] FORTH"
close the file and return the status-code
primitive code = [p4_close_file]
CREATE-FILE ( name-ptr name-len open-mode# -- name-file* name-errno# ) [ANS] => "[ANS] FORTH"
create the file with the given name and open
it - returns the file id and a status code.
A code of zero means success. An existing file
of the same name is truncated upon open.
primitive code = [p4_create_file]
DELETE-FILE ( name-ptr name-len -- name-errno# ) [ANS] => "[ANS] FORTH"
delete the named file and return a status code
primitive code = [p4_delete_file]
FILE-POSITION ( some-file* -- p,pos# some-errno# ) [ANS] => "[ANS] FORTH"
return the current position in the file and
return a status code. A code of zero means success.
primitive code = [p4_file_position]
FILE-SIZE ( some-file* -- s,size# some-errno# ) [ANS] => "[ANS] FORTH"
return the current size of the file and
return a status code. A code of zero means success.
primitive code = [p4_file_size]
INCLUDE-FILE ( some-file* -- ) [ANS] => "[ANS] FORTH"
INTERPRET the given file
primitive code = [p4_include_file]
INCLUDED ( name-ptr name-len -- ) [ANS] => "[ANS] FORTH"
open the named file and then INCLUDE-FILE
see also the interactive INCLUDE
primitive code = [p4_included]
OPEN-FILE ( name-ptr name-len open-mode# -- name-file* name-errno# ) [ANS] => "[ANS] FORTH"
open the named file with mode. returns the
file id and a status code. A code of zero
means success.
primitive code = [p4_open_file]
READ-FILE ( buf-ptr buf-len some-file* -- buf-count some-errno# ) [ANS] => "[ANS] FORTH"
fill the given string buffer with characters
from the buffer. A status code of zero means
success and the returned count gives the
number of bytes actually read. If an error
occurs the number of already transferred bytes
is returned.
primitive code = [p4_read_file]
READ-LINE ( buf-ptr buf-len some-file* -- buf-count buf-flag some-errno# ) [ANS] => "[ANS] FORTH"
fill the given string buffer with one line
from the file. A line termination character
(or character sequence under WIN/DOS) may
also be placed in the buffer but is not
included in the final count. In other respects
this function performs a READ-FILE
primitive code = [p4_read_line]
REPOSITION-FILE ( o,offset# some-file* -- some-errno# ) [ANS] => "[ANS] FORTH"
reposition the file offset - the next FILE-POSITION
would return o.offset then. returns a status code where zero means success.
primitive code = [p4_reposition_file]
RESIZE-FILE ( s,size# some-file* -- some-errno# ) [ANS] => "[ANS] FORTH"
resize the give file, returns a status code where zero means success.
primitive code = [p4_resize_file]
WRITE-FILE ( buf-ptr buf-len some-file* -- some-errno# ) [ANS] => "[ANS] FORTH"
write characters from the string buffer to a file,
returns a status code where zero means success.
primitive code = [p4_write_file]
WRITE-LINE ( buf-ptr buf-len some-file* -- some-errno# ) [ANS] => "[ANS] FORTH"
write characters from the string buffer to a file,
and add the line-terminator to the end of it.
returns a status code.
primitive code = [p4_write_line]
FILE-STATUS ( file-ptr file-len -- file-subcode# file-errno# ) [ANS] => "[ANS] FORTH"
check the named file - if it exists
the status errno code is zero. The status subcode
is implementation-specific and usually matches the
file access permission bits of the filesystem.
primitive code = [p4_file_status]
FLUSH-FILE ( some-file* -- some-errno# ) [ANS] => "[ANS] FORTH"
flush all unsaved buffers of the file to disk.
A status code of zero means success.
primitive code = [p4_flush_file]
RENAME-FILE ( oldname-ptr oldname-len newname-ptr newname-len -- newname-errno# ) [ANS] => "[ANS] FORTH"
rename the file named by "oldname" to the name of "newname"
returns a status-code where zero means success.
primitive code = [p4_rename_file]
FILE-Misc
Compatibility words
INCLUDE ( "filename" -- ??? ) [FTH] => [FORTH]
load the specified file, see also LOAD" filename"
primitive code = [p4_include]
COPY-FILE ( src-ptr src-len dst-ptr dst-len -- copy-errno# ) [FTH] => [FORTH]
like RENAME-FILE , copies the file from src-name to dst-name
and returns an error-code or null
primitive code = [p4_copy_file]
MOVE-FILE ( src-ptr src-len dst-ptr dst-len -- move-errno# ) [FTH] => [FORTH]
like RENAME-FILE , but also across-volumes
moves the file from src-name to dst-name and returns an
error-code or null
primitive code = [p4_move_file]
FILE-R/W ( buffer* use-block# flag? some-file* -- ) [FTH] => [FORTH]
like FIG-Forth R/W
primitive code = [p4_file_rw]
FILE-BLOCK ( use-block# some-file* -- buffer* ) [FTH] => [FORTH]
-
primitive code = [p4_file_block]
FILE-BUFFER ( use-block# some-file* -- buffer* ) [FTH] => [FORTH]
-
primitive code = [p4_file_buffer]
FILE-EMPTY-BUFFERS ( some-file* -- ) [FTH] => [FORTH]
-
primitive code = [p4_file_empty_buffers]
FILE-FLUSH ( some-file* -- ) [FTH] => [FORTH]
simulate : FILE-FLUSH DUP FILE-SAVE-BUFFERS FILE-EMTPY-BUFFERS ;
primitive code = [p4_file_flush]
FILE-LIST ( use-block# some-file* -- ) [FTH] => [FORTH]
-
primitive code = [p4_file_list]
FILE-LOAD ( use-block# some-file* -- ) [FTH] => [FORTH]
-
primitive code = [p4_file_load]
FILE-SAVE-BUFFERS ( some-file* -- ) [FTH] => [FORTH]
-
primitive code = [p4_file_save_buffers]
FILE-THRU ( lo-block# hi-block# some-file* -- ) [FTH] => [FORTH]
see THRU
primitive code = [p4_file_thru]
FILE-UPDATE ( some-file* -- ) [FTH] => [FORTH]
-
primitive code = [p4_file_update]
Floating
point + extensions
>FLOAT => "[ANS] FORTH"
(no description)
primitive code = [p4_to_float]
D>F => "[ANS] FORTH"
(no description)
primitive code = [p4_d_to_f]
F! => "[ANS] FORTH"
(no description)
primitive code = [p4_f_store]
F* => "[ANS] FORTH"
(no description)
primitive code = [p4_f_star]
F+ => "[ANS] FORTH"
(no description)
primitive code = [p4_f_plus]
F- => "[ANS] FORTH"
(no description)
primitive code = [p4_f_minus]
F/ => "[ANS] FORTH"
(no description)
primitive code = [p4_f_slash]
F0< => "[ANS] FORTH"
(no description)
primitive code = [p4_f_zero_less]
F0= => "[ANS] FORTH"
(no description)
primitive code = [p4_f_zero_equal]
F< => "[ANS] FORTH"
(no description)
primitive code = [p4_f_less_than]
F>D => "[ANS] FORTH"
(no description)
primitive code = [p4_f_to_d]
F@ => "[ANS] FORTH"
(no description)
primitive code = [p4_f_fetch]
FALIGN => "[ANS] FORTH"
(no description)
primitive code = [p4_d_f_align]
FALIGNED => "[ANS] FORTH"
(no description)
primitive code = [p4_d_f_aligned]
FDEPTH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_depth]
FDROP => "[ANS] FORTH"
(no description)
primitive code = [p4_f_drop]
FDUP => "[ANS] FORTH"
(no description)
primitive code = [p4_f_dup]
FLITERAL => "[ANS] FORTH"
(no description)
compiling word = [p4_f_literal]
FLOAT+ => "[ANS] FORTH"
(no description)
primitive code = [p4_d_float_plus]
FLOATS => "[ANS] FORTH"
(no description)
primitive code = [p4_d_floats]
FLOOR => "[ANS] FORTH"
(no description)
primitive code = [p4_floor]
FMAX => "[ANS] FORTH"
(no description)
primitive code = [p4_f_max]
FMIN => "[ANS] FORTH"
(no description)
primitive code = [p4_f_min]
FNEGATE => "[ANS] FORTH"
(no description)
primitive code = [p4_f_negate]
FOVER => "[ANS] FORTH"
(no description)
primitive code = [p4_f_over]
FROT => "[ANS] FORTH"
(no description)
primitive code = [p4_f_rot]
FROUND => "[ANS] FORTH"
(no description)
primitive code = [p4_f_round]
FSWAP => "[ANS] FORTH"
(no description)
primitive code = [p4_f_swap]
REPRESENT => "[ANS] FORTH"
(no description)
primitive code = [p4_represent]
DF! => "[ANS] FORTH"
(no description)
primitive code = [p4_f_store]
DF@ => "[ANS] FORTH"
(no description)
primitive code = [p4_f_fetch]
DFALIGN => "[ANS] FORTH"
(no description)
primitive code = [p4_d_f_align]
DFALIGNED => "[ANS] FORTH"
(no description)
primitive code = [p4_d_f_aligned]
DFLOAT+ => "[ANS] FORTH"
(no description)
primitive code = [p4_d_float_plus]
DFLOATS => "[ANS] FORTH"
(no description)
primitive code = [p4_d_floats]
F** => "[ANS] FORTH"
(no description)
primitive code = [p4_f_star_star]
F. => "[ANS] FORTH"
(no description)
primitive code = [p4_f_dot]
FABS => "[ANS] FORTH"
(no description)
primitive code = [p4_f_abs]
FACOS => "[ANS] FORTH"
(no description)
primitive code = [p4_f_acos]
FACOSH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_acosh]
FALOG => "[ANS] FORTH"
(no description)
primitive code = [p4_f_alog]
FASIN => "[ANS] FORTH"
(no description)
primitive code = [p4_f_asin]
FASINH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_asinh]
FATAN => "[ANS] FORTH"
(no description)
primitive code = [p4_f_atan]
FATAN2 => "[ANS] FORTH"
(no description)
primitive code = [p4_f_atan2]
FATANH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_atanh]
FCOS => "[ANS] FORTH"
(no description)
primitive code = [p4_f_cos]
FCOSH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_cosh]
FE. => "[ANS] FORTH"
(no description)
primitive code = [p4_f_e_dot]
FEXP => "[ANS] FORTH"
(no description)
primitive code = [p4_f_exp]
FEXPM1 => "[ANS] FORTH"
(no description)
primitive code = [p4_f_expm1]
FLN => "[ANS] FORTH"
(no description)
primitive code = [p4_f_ln]
FLNP1 => "[ANS] FORTH"
(no description)
primitive code = [p4_f_lnp1]
FLOG => "[ANS] FORTH"
(no description)
primitive code = [p4_f_log]
FS. => "[ANS] FORTH"
(no description)
primitive code = [p4_f_s_dot]
FSIN => "[ANS] FORTH"
(no description)
primitive code = [p4_f_sin]
FSINCOS => "[ANS] FORTH"
(no description)
primitive code = [p4_f_sincos]
FSINH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_sinh]
FSQRT => "[ANS] FORTH"
(no description)
primitive code = [p4_f_sqrt]
FTAN => "[ANS] FORTH"
(no description)
primitive code = [p4_f_tan]
FTANH => "[ANS] FORTH"
(no description)
primitive code = [p4_f_tanh]
F~ => "[ANS] FORTH"
(no description)
primitive code = [p4_f_proximate]
SET-PRECISION => "[ANS] FORTH"
(no description)
primitive code = [p4_set_precision]
SF! => "[ANS] FORTH"
(no description)
primitive code = [p4_s_f_store]
SF@ => "[ANS] FORTH"
(no description)
primitive code = [p4_s_f_fetch]
SFALIGN => "[ANS] FORTH"
(no description)
primitive code = [p4_align]
SFALIGNED => "[ANS] FORTH"
(no description)
primitive code = [p4_aligned]
SFLOAT+ => "[ANS] FORTH"
(no description)
primitive code = [p4_s_float_plus]
SFLOATS => "[ANS] FORTH"
(no description)
primitive code = [p4_s_floats]
FLOATING-STACK => "[ANS] FORTH"
(no description)
primitive code = [p__floating_stack]
MAX-FLOAT => "[ANS] FORTH"
(no description)
primitive code = [p__max_float]
INTERPRET-FLOAT ( CS: dest* -- dest* ) executes ( -- F: f# ) experimental => "[ANS] FORTH"
check the next word from QUERY and try to parse it as a
floating number - if parseable then postpone the value on the
floating stack and branch out of the loop body (usually do it AGAIN )
compiling word = [p4_interpret_float]
FLOATING-Misc
Compatibility words
FLIT => "FORTH"
(no description)
primitive code = [p4_f_literal_execution]
FP@ ( -- addr ) => "FORTH"
returns the floating point stack pointer
primitive code = [p4_f_p_fetch]
FP! ( addr -- ) => "FORTH"
sets the floating point stack pointer -
this is the inverse of FP@
primitive code = [p4_f_p_store]
F= => "FORTH"
(no description)
primitive code = [p4_f_equal]
F<> ( f: a b -- s: a!=b ) => "FORTH"
-
primitive code = [p4_f_not_equal]
F> => "FORTH"
(no description)
primitive code = [p4_f_greater_than]
F<= => "FORTH"
(no description)
primitive code = [p4_f_less_than_or_equal]
F>= => "FORTH"
(no description)
primitive code = [p4_f_greater_than_or_equal]
S>F ( n -- f: x ) => "FORTH"
it's inverse is F>S - convert a cell parameter to floating-point.
primitive code = [p4_s_to_f]
FTRUNC>S (f: x -- s: n ) => "FORTH"
The word F>S was sometimes defined with a different behavior
than FTRUNC>S which is the type-cast behaviour of C according
to C99 section 6.3.1.4 - truncation would also match the ANS-Forth
specification for F>D .
Some systems used F>S defined to FROUND>S instead. The pfe
provides explicit words for both conversions, the word FROUND>S
and FTRUNC>S which return single-cell parameters for a floating
point number with the conversion method of FTRUNC or FROUND .
In PFE, F>S is a synonym pointing to FTRUNC>S in analogy
of the behavior of F>D where no explicit word exists. The
inverse of F>S is the cast conversion of S>F .
primitive code = [p4_f_trunc_to_s]
FROUND>S (f: x -- s: n) => "FORTH"
complements FTRUNC>S for applications that expect F>S to
be defined with a rounding behavior like
: FROUND>S FROUND FTRUNC>S ;
primitive code = [p4_f_round_to_s]
FTRUNC (f: x -- x' ) => "FORTH"
truncate towards zero, discard a fractional part. See also FTRUNC>S
conversion and the FROUND and FLOOR adaptors.
: FTRUNC FDUP F0< IF FCEIL ELSE FLOOR THEN ;
(When available, uses a single call to C99 trunc() internally)
primitive code = [p4_f_trunc]
-FROT (f: x1 x2 x3 -- x3 x1 x2 ) => "FORTH"
F-stack equivalent of -ROT
note, some systems call this work F-ROT,
here it is the inverse of FROT
primitive code = [p4_minus_f_rot]
FNIP (f: x1 x2 -- x2 ) => "FORTH"
F-stack equivalent of NIP
primitive code = [p4_f_nip]
FTUCK (f: x1 x2 -- x2 x1 x2 ) => "FORTH"
F-stack equivalent of TUCK
primitive code = [p4_f_tuck]
1/F (f: x -- 1/x ) => "FORTH"
-
primitive code = [p4_one_over_f]
F^2 (f: x -- x^2 ) => "FORTH"
-
primitive code = [p4_f_square]
F^N ( u f: x -- x^u ) => "FORTH"
For large exponents, use F** instead. Of course u=-1 is large.
primitive code = [p4_f_power_n]
F2/ (f: x -- x/2 ) => "FORTH"
-
primitive code = [p4_f_two_slash]
F2* (f: x -- x*2 ) => "FORTH"
-
primitive code = [p4_f_two_star]
F0> (f: x -- s: flag ) => "FORTH"
-
primitive code = [p4_f_zero_greater]
F0<> (f: x -- s: flag ) => "FORTH"
-
primitive code = [p4_f_zero_not_equal]
forth_83 forth wordset page
2+ ( a# -- a#' | a* -- a*' | a -- a' [??] ) [FTH] => [FORTH]
add 2 to the value on stack (and leave the result there)
simulate:
: 2+ 2 + ;
primitive code = [p4_two_plus]
2- ( a# -- a#' | a* -- a*' | a -- a' [??] ) [FTH] => [FORTH]
substract 2 from the value on stack (and leave the result there)
simulate:
: 2- 2 - ;
primitive code = [p4_two_minus]
?TERMINAL => [FORTH]
(no description)
primitive code = [p4_key_question]
COMPILE ( "word" -- ) [FTH] => [FORTH]
compile the next word. The next word should not be immediate,
in which case you would have to use [COMPILE] . For this
reason, you should use the word POSTPONE , which takes care
it.
simulate:
: COMPILE R> DUP @ , CELL+ >R ; ( not immediate !!! )
compiling word = [p4_compile]
--> ( -- ) [FTH] => [FORTH]
does increase BLK and refills the input-buffer
from there. Does hence break interpretation of the
current BLK and starts with the next. Old-style
forth mechanism. You should use INCLUDE
: --> ?LOADING REFILL ;
immediate code = [p4_next_block]
INTERPRET => [FORTH]
(no description)
primitive code = [p4_interpret]
K ( -- k# ) [FTH] => [FORTH]
the 3rd loop index just like I and J
compiling word = [p4_k]
OCTAL ( -- ) [FTH] => [FORTH]
sets BASE to 8. Compare with HEX and DECIMAL
simulate:
: OCTAL 8 BASE ! ;
primitive code = [p4_octal]
SP@ ( -- sp-cell* ) [FTH] => [FORTH]
the address of the top of stack. Does save it onto
the stack. You could do
: DUP SP@ @ ;
primitive code = [p4_s_p_fetch]
!BITS ( x-bits# x-addr mask# -- ) [FTH] => [FORTH]
at the cell pointed to by addr, change only the bits that
are enabled in mask
simulate:
: !BITS >R 2DUP @ R NOT AND SWAP R> AND OR SWAP ! DROP ;
primitive code = [p4_store_bits]
@BITS ( x-addr mask# -- x-value# ) [FTH] => [FORTH]
see the companion word => !BITS
simulate:
: @BITS SWAP @ AND ;
primitive code = [p4_fetch_bits]
>< ( a -- a' ) [FTH] [OLD] => [FORTH]
byte-swap a word
depracated: use NTOHS which does the same as this word when
the local byte-order seems to have no match, and be otherwise
a no-op. Note that only the two lower bytes of the top-of-cell
are swapped.
primitive code = [p4_byte_swap]
>MOVE< ( from-addr* to-addr* count# -- ) [FTH] [OLD] => [FORTH]
see MOVE , does byte-swap for each word underway.
depracated: this word has not been very useful lately. It does
still stem from times of 16bit forth systems that wanted to
interchange data blocks. It is better to use functionality
based on NTOHS or NTOHL . Note that this word >MOVE<
does swap each 2byte. It is not useful for byte-swapping
WCHAR strings as the count is given in bytes, not wchar items.
primitive code = [p4_byte_swap_move]
** ( a# b# -- power-a# ) [FTH] => [FORTH]
raise second to top power
primitive code = [p4_power]
SEAL ( -- ) [FTH] => [FORTH]
looks through the search-order and kills the ONLY wordset -
hence you can't access the primary vocabularies from there.
primitive code = [p4_seal]
Usual
Forth extensions
C+! ( n addr -- ) => "FORTH"
Add the low-order byte of _n_ to the byte at _addr_,
removing both from the stack.
primitive code = [p4_c_plus_store]
VOCABULARY ( "name" -- ) [FTH] => "FORTH"
create a vocabulary of that name. If the named vocabulary
is called later, it will run ((VOCABULARY)) , thereby
putting it into the current search order.
Special pfe-extensions are accessible via
CASE-SENSITIVE-VOC and SEARCH-ALSO-VOC
simulate:
: VOCABULARY CREATE ALLOT-WORDLIST
DOES> ( the ((VOCABULARY)) runtime )
CONTEXT !
; IMMEDIATE
primitive code = [p4_vocabulary]
BOUNDS ( str len -- str+len str ) => "FORTH"
Convert _str len_ to range for DO-loop.
: BOUNDS ( str len -- str+len str ) OVER + SWAP ;
primitive code = [p4_bounds]
OFF! => "FORTH"
(no description)
primitive code = [p4_off_store]
ON! ( addr -- ) => "FORTH"
Store -1 at _addr_. Defined in f83 as ON . See antonym OFF! .
: ON! ( addr -- ) -1 SWAP ! ;
primitive code = [p4_on_store]
PLACE ( str len addr -- ) => "FORTH"
Place the string _str len_ at _addr_, formatting it as a
counted string.
: PLACE 2DUP 2>R 1+ SWAP MOVE 2R> C! ;
: PLACE 2DUP C! 1+ SWAP CMOVE ;
primitive code = [p4_place]
+PLACE ( str len add2 -- ) => "FORTH"
Append string _str len_ to the counted string at _addr_.
a.k.a. APPEND (being a SYNONYM now)
: +PLACE 2DUP 2>R COUNT + SWAP MOVE ( ) 2R> C+! ;
primitive code = [p4_append]
C+PLACE ( char addr -- ) => "FORTH"
Append _char_ to the counted string at _addr_.
a.k.a. APPEND-CHAR (being a SYNONYM now)
: C+PLACE DUP >R COUNT DUP 1+ R> C! + C! ;
primitive code = [p4_append_char]
@EXECUTE ( xt -- ? ) => "FORTH"
same as @ EXECUTE , but checks for null as xt and
silently ignores it. Same as in most forths where defined.
simulate:
: @EXECUTE @ ?DUP IF EXECUTE THEN ;
primitive code = [p4_fetch_execute]
?LEAVE ( cond -- ) => "FORTH"
leave a (innermost) loop if condition is true
compiling word = [p4_question_leave]
NOOP ( -- ) => "FORTH"
do nothing, used as a place-holder where
an execution word is needed
primitive code = [p4_noop]
RP@ ( -- addr ) => "FORTH"
returns the return stack pointer
example:
: R@ RP@ @ ;
compiling word = [p4_r_p_fetch]
RP! ( addr -- ) => "FORTH"
sets the return stack pointer, reverse of RP@
primitive code = [p4_r_p_store]
SP! ( ... addr -- ) => "FORTH"
sets the stack pointer, reverse of SP@
primitive code = [p4_s_p_store]
-ROT ( a b c -- c a b ) => "FORTH"
inverse of ROT
primitive code = [p4_dash_rot]
CSET ( n addr -- ) => "FORTH"
set bits in byte at given address
simulate:
: CSET TUCK @ SWAP OR SWAP ! ;
primitive code = [p4_c_set]
CRESET ( n addr -- ) => "FORTH"
reset bits in byte at given address
simulate:
: CRESET TUCK @ SWAP NOT AND SWAP ! ;
primitive code = [p4_c_reset]
CTOGGLE ( n addr -- ) => "FORTH"
toggle bits in byte at given address
simulate:
: CTOGGLE TUCK @ SWAP XOR SWAP ! ;
primitive code = [p4_c_toggle]
TOGGLE ( c-addr charmask -- ) => "FORTH"
toggle the bits given in charmask, see also SMUDGE and = UNSMUDGE
example: the fig-style SMUDGE had been defined such
: FIG-SMUDGE LATEST >FFA (SMUDGE#) TOGGLE ;
primitive code = [p4_toggle]
3DUP ( x y z -- x y z x y z ) => "FORTH"
Copy top three elements on the stack onto top of stack.
: 3DUP THIRD THIRD THIRD ;
or
: 3DUP 3 PICK 3 PICK 3 PICK ;
primitive code = [p4_three_dup]
3DROP ( x y z -- ) => "FORTH"
Drop the top three elements from the stack.
: 3DROP DROP 2DROP ;
primitive code = [p4_three_drop]
4DUP ( a b c d -- a b c d a b c d ) => "FORTH"
simulate:
: 4DUP 4 PICK 4 PICK 4 PICK 4 PICK ;
primitive code = [p4_four_dup]
4DROP ( x y z -- ) => "FORTH"
Drop the top three elements from the stack.
: 4DROP 2DROP 2DROP ;
primitive code = [p4_four_drop]
TOUPPER ( c1 -- c2 ) => "FORTH"
convert a single character to upper case
: TOUPPER >R _toupper ;
primitive code = [p4_toupper]
UPPER ( addr cnt -- ) => "FORTH"
convert string to upper case
simulate:
: UPPER 0 DO DUP I + DUP C@ UPC SWAP C! LOOP DROP ;
primitive code = [p4_upper]
LOWER ( addr cnt -- ) => "FORTH"
convert string to lower case
This is not in L&P's F83 but provided for symmetry
simulate:
: LOWER 0 DO DUP I + DUP C@ >R _tolower SWAP C! LOOP DROP ;
primitive code = [p4_lower]
ASCII ( [word] -- val ) => "FORTH"
state smart version of CHAR or [CHAR] resp.
simulate:
: ASCII [COMPILE] [CHAR]
STATE @ IF [COMPILE] LITERAL THEN ;
compiling word = [p4_ascii]
CONTROL ( [word] -- val ) => "FORTH"
see ASCII , but returns char - '@'
simulate:
: CONTROL [COMPILE] [CHAR] [CHAR] @ -
STATE @ IF [COMPILE] LITERAL THEN ;
compiling word = [p4_control]
NUMBER? ( addr -- d flag ) => "FORTH"
convert counted string to number - used in inner interpreter
( INTERPRET ), flags if conversion was successful
example:
BL WORD HERE NUMBER? 0= IF ." not a number " THEN .
primitive code = [p4_number_question]
VOCS ( -- ) => "FORTH"
list all vocabularies in the system
simulate:
: VOCS VOC-LINK @ BEGIN DUP WHILE
DUP ->WORDLIST.NAME @ ID.
->WORDLIST.LINK @
REPEAT DROP ;
primitive code = [p4_vocs]
EMITS ( n char -- ) => "FORTH"
Emit _char_ _n_ times.
: EMITS ( n char -- )
SWAP 0 ?DO DUP EMIT LOOP DROP ;
also compare
: SPACES BL EMITS ;
: SPACE BL EMIT ;
primitive code = [p4_emits]
FILE-CHECK ( n -- ) => "FORTH"
Check for file access error.
\ : FILE-CHECK ( n -- ) THROW ;
: FILE-CHECK ( n -- ) ABORT" File Access Error " ;
primitive code = [p4_file_check]
MEMORY-CHECK ( n -- ) => "FORTH"
Check for memory allocation error.
\ : MEMORY-CHECK ( n -- ) THROW ;
: MEMORY-CHECK ( n -- ) ABORT" Memory Allocation Error " ;
primitive code = [p4_memory_check]
++ ( addr -- ) => "FORTH"
Increment the value at _addr_.
: ++ ( addr -- ) 1 SWAP +! ;
primitive code = [p4_plus_plus]
@++ ( addr -- addr' x ) => "FORTH"
Fetch the value _x_ from _addr_, and increment the address
by one cell.
: @++ ( addr -- addr' x ) DUP CELL+ SWAP @ ;
primitive code = [p4_fetch_plus_plus]
!++ ( addr x -- addr' ) => "FORTH"
Store the value _x_ into _addr_, and increment the address
by one cell.
: !++ ( addr x -- addr' ) OVER ! CELL+ ;
primitive code = [p4_store_plus_plus]
>WORDLIST ( xt -- wordl* ) => "EXTENSIONS"
convert a VOCABULARY -xt into its wordlist reference
(as in win32forth)
primitive code = [p4_to_wordlist]
FpNoStack
Floating point + extensions
>FLOAT => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_to_float]
D>F => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_to_f]
F! => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_store]
F* => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_star]
F+ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_plus]
F- => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_minus]
F/ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_slash]
F0< => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_zero_less]
F0= => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_zero_equal]
F< => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_less_than]
F> => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_greater_than]
F= => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_equal]
F<> ( f: a b -- s: a!=b ) => "EXTENSIONS"
-
primitive code = [p4_nofp_f_not_equal]
F<= => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_less_than_or_equal]
F>= => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_greater_than_or_equal]
F>D => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_to_d]
F@ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_fetch]
FALIGN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_f_align]
FALIGNED => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_f_aligned]
FDEPTH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_depth]
FDROP => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_drop]
FDUP => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_dup]
FLITERAL => "EXTENSIONS"
(no description)
compiling word = [p4_nofp_f_literal]
FLOAT+ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_float_plus]
FLOATS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_floats]
FLOOR => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_floor]
FMAX => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_max]
FMIN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_min]
FNEGATE => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_negate]
FOVER => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_over]
FROT => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_rot]
FROUND => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_round]
FSWAP => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_swap]
REPRESENT => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_represent]
DF! => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_store]
DF@ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_fetch]
DFALIGN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_f_align]
DFALIGNED => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_f_aligned]
DFLOAT+ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_float_plus]
DFLOATS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_d_floats]
F** => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_star_star]
F. => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_dot]
FABS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_abs]
FACOS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_acos]
FACOSH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_acosh]
FALOG => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_alog]
FASIN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_asin]
FASINH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_asinh]
FATAN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_atan]
FATAN2 => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_atan2]
FATANH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_atanh]
FCOS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_cos]
FCOSH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_cosh]
FE. => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_e_dot]
FEXP => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_exp]
FEXPM1 => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_expm1]
FLN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_ln]
FLNP1 => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_lnp1]
FLOG => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_log]
FS. => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_s_dot]
FSIN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_sin]
FSINCOS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_sincos]
FSINH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_sinh]
FSQRT => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_sqrt]
FTAN => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_tan]
FTANH => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_tanh]
F~ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_f_proximate]
SET-PRECISION => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_set_precision]
SF! => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_s_f_store]
SF@ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_s_f_fetch]
SFALIGN => "EXTENSIONS"
(no description)
primitive code = [p4_align]
SFALIGNED => "EXTENSIONS"
(no description)
primitive code = [p4_aligned]
SFLOAT+ => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_s_float_plus]
SFLOATS => "EXTENSIONS"
(no description)
primitive code = [p4_nofp_s_floats]
S>F ( n -- f: x ) => "EXTENSIONS"
it's inverse is F>S - convert a cell parameter to floating-point.
primitive code = [p4_nofp_s_to_f]
FTRUNC>S (f: x -- s: n ) => "EXTENSIONS"
The word F>S was sometimes defined with a different behavior
than FTRUNC>S which is the type-cast behaviour of C according
to C99 section 6.3.1.4 - truncation would also match the ANS-Forth
specification for F>D .
Some systems used F>S defined to FROUND>S instead. The pfe
provides explicit words for both conversions, the word FROUND>S
and FTRUNC>S which return single-cell parameters for a floating
point number with the conversion method of FTRUNC or FROUND .
In PFE, F>S is a synonym pointing to FTRUNC>S in analogy
of the behavior of F>D where no explicit word exists. The
inverse of F>S is the cast conversion of S>F .
primitive code = [p4_nofp_f_trunc_to_s]
FROUND>S (f: x -- s: n) => "EXTENSIONS"
complements FTRUNC>S for applications that expect F>S to
be defined with a rounding behavior like
: FROUND>S FROUND FTRUNC>S ;
primitive code = [p4_nofp_f_round_to_s]
FTRUNC (f: x -- x' ) => "EXTENSIONS"
truncate towards zero, discard a fractional part. See also FTRUNC>S
conversion and the FROUND and FLOOR adaptors.
: FTRUNC FDUP F0< IF FCEIL ELSE FLOOR THEN ;
(When available, uses a single call to C99 trunc() internally)
primitive code = [p4_nofp_f_trunc]
-FROT (f: x1 x2 x3 -- x3 x1 x2 ) => "EXTENSIONS"
F-stack equivalent of -ROT
note, some systems call this work F-ROT,
here it is the inverse of FROT
primitive code = [p4_nofp_minus_f_rot]
FNIP (f: x1 x2 -- x2 ) => "EXTENSIONS"
F-stack equivalent of NIP
primitive code = [p4_nofp_f_nip]
FTUCK (f: x1 x2 -- x2 x1 x2 ) => "EXTENSIONS"
F-stack equivalent of TUCK
primitive code = [p4_nofp_f_tuck]
1/F (f: x -- 1/x ) => "EXTENSIONS"
-
primitive code = [p4_nofp_one_over_f]
F^2 (f: x -- x^2 ) => "EXTENSIONS"
-
primitive code = [p4_nofp_f_square]
F^N ( u f: x -- x^u ) => "EXTENSIONS"
For large exponents, use F** instead. Of course u=-1 is large.
primitive code = [p4_nofp_f_power_n]
F2/ (f: x -- x/2 ) => "EXTENSIONS"
-
primitive code = [p4_nofp_f_two_slash]
F2* (f: x -- x*2 ) => "EXTENSIONS"
-
primitive code = [p4_nofp_f_two_star]
F0> (f: x -- s: flag ) => "EXTENSIONS"
-
primitive code = [p4_nofp_f_zero_greater]
F0<> (f: x -- s: flag ) => "EXTENSIONS"
-
primitive code = [p4_nofp_f_zero_not_equal]
MAX-FLOAT => "EXTENSIONS"
(no description)
primitive code = [p__nofp_max_float]
gforth forth wordset page
GFORTH => "ENVIRONMENT"
(no description)
primitive code = [p__gforth]
Header
Navigation
BODY> ( pfa -- cfa ) => [FORTH]
trying to convert a pointer to the parameter-field (PFA) to point
then to the corresponding code-field (CFA) - note that this is not
necessarily the inverse of >BODY instead it is a fast implementation
assuming a VARIABLE thing had been used. Every use of "BODY>" is
warned in the logfile.
implementation-specific simulation:
: BODY> CELL - ;
primitive code = [p4_body_from]
>LINK ( cfa -- lfa ) => [FORTH]
converts a pointer to the code-field (CFA) to point
then to the corresponding link-field (LFA) - in some configurations
this can be a very slow operation since the system might need to walk
through all header-words in the system, looking for a >NAME that
has the cfa and *then* returning the "N>LINK" result here - which might
be none at all if the word is a :NONAME . Use always >NAME and
treat this word as non-portable just like any assumption about the
contents of the >LINK -field.
Only in fig-mode and for traditional fig-mode programs, this word may
possibly have enough extra assertions to be somewhat reliable.
(and fig-mode did not know about SYNONYM s - see note at LINK> ).
primitive code = [p4_to_link]
LINK> ( lfa -- cfa ) => [FORTH]
converts a pointer to the link-field (LFA) to point
then to the corresponding code-field (CFA)
BEWARE: this one does not care about SYNONYM s and it is the
only way to get at the data of a SYNONYM . Therefore, if you have
a synonym called A for an old word B then there is a different
result using "NAME>" on an A-nfa or using "N>LINK LINK>" since the
first "NAME>" will return the xt of B while the latter will return
the xt of A - but executing an xt of A is an error and it will THROW
this difference is intentional to allow knowledgable persons to
do weird things looking around in the dictionary. The forth standard
words will not give you much of a chance to get hold of the nfa of
a SYNONYM word anyway - asking FIND for a word A will return
the execution token of B immediatly and "NAME>" on that one lead to
the nfa of B and not that of A.
primitive code = [p4_link_from]
>NAME ( cfa -- nfa ) => [FORTH]
converts a pointer to the code-field (CFA) to point
then to the corresponding name-field (NFA)
implementation-specific simulation:
: >NAME >LINK L>NAME ;
primitive code = [p4_to_name]
NAME> ( nfa -- cfa ) => [FORTH]
converts a pointer to the name-field (NFA) to point
then to the corresponding code-field (CFA)
In all cases but a SYNONYM the pfe will behave not unlike the
original fig-forth did - being identical to N>LINK LINK> .
primitive code = [p4_name_from]
L>NAME ( lfa -- nfa ) => [FORTH]
converts a pointer to the link-field (LFA) to point
then to the corresponding name-field (CFA) - this one is one of
the slowest operation available. One should always use the inverse
operation N>LINK and cache an older value if that is needed.
Some words might be linked but they do not have a name-field (just
the other fields) but this word can not detect that and will try to look
into the bits of the dictionary anway in the assumption that there is
something - and if done in the wrong place it might even segfault.
Only in fig-mode and for traditional fig-mode programs, this word may
possibly have enough extra assertions to be somewhat reliable.
(and fig-mode did not know about SYNONYM s - see note at LINK> ).
implementation-specific configure-dependent fig-only simulation:
: L>NAME BEGIN DUP C@ 128 AND 0= WHILE 1- REPEAT ;
primitive code = [p4_l_to_name]
N>LINK ( nfa -- lfa ) => [FORTH]
converts a pointer to the name-field (NFA) to point
then to the corresponding link-field (LFA) - this operation
is quicker than the inverse L>NAME . This word is a specific
implementation detail and should not be used by normal users - instead
use always NAME> which is much more portable. Many systems may
possibly not even have a >LINK -field in the sense that a @ on
this adress will lead to another >NAME . Any operation on the
resulting >LINK -adress is even dependent on the current configuration
of PFE - only in fig-mode you are asserted to have the classic detail.
(and fig-mode did not know about SYNONYM s - see note at LINK> ).
implementation-specific configure-dependent fig-only simulation:
: N>LINK C@ + ;
primitive code = [p4_n_to_link]
NAME>STRING ( name-token -- str-ptr str-len ) => [FORTH]
convert a name-token into a string-span, used to detect the
name for a word and print it. The word ID. can be defined as
: ID. NAME>STRING TYPE ;
the implementation of NAME>STRING depends on the header layout
that is defined during the configuration of the forth system.
: NAME>STRING COUNT 31 AND ; ( for fig-like names )
: NAME>STRING COUNT ; ( default, name is a simple counted string )
: NAME>STRING @ ZCOUNT ; ( name-token is a pointer to a C-level string )
: NAME>STRING COUNT 31 AND ( hybrid of fig-like and zero-terminated )
DUP 31 = IF DROP 1+ ZCOUNT THEN
;
: NAME>STRING HEAD:: COUNT CODE:: PAD PLACE PAD ; ( different i86 segments )
primitive code = [p4_name_to_string]
LATEST ( -- nfa ) => [FORTH]
return the NFA of the lateset definition in the
CURRENT vocabulary
primitive code = [p4_latest]
>FFA ( nfa -- ffa ) obsolete => [FORTH]
converts a pointer to the name-field (NFA) to point
then to the corresponding flag-field (FFA) - in traditinal
Forth this is the same address. pfe _can_ do different.
implementation-specific configure-dependent simulation:
: FFA 1- ;
primitive code = [p4_to_ffa]
FFA> ( ffa -- nfa ) obsolete => [FORTH]
converts a pointer to the flag-field (FFA) to point
then to the corresponding name-field (NFA) - in traditinal
Forth this is the same address. pfe _can_ do different.
implementation-specific configure-dependent simulation:
: FFA 1+ ;
primitive code = [p4_ffa_from]
NAME-FLAGS@ ( nfa -- nfa-flags ) => [FORTH]
get the nfa-flags that corresponds to the nfa given. Note that
in the fig-style would include the nfa-count in the lower bits.
(see NAME-FLAGS! )
primitive code = [p4_name_flags_fetch]
NAME-FLAGS! ( nfa-flags nfa -- ) => [FORTH]
set the nfa-flags of nfa given. Note that in the fig-style the nfa-flags
would include the nfa-count in the lower bits - therefore this should only
set bits that had been previously retrieved with NAME-FLAGS@
: IMMEDIATE LAST @ NAME-FLAGS@ IMMEDIATE-MASK OR LAST @ NAME-FLAGS! ;
primitive code = [p4_name_flags_store]
HEADER, ( str-ptr str-len -- ) => [FORTH]
CREATE a new header in the dictionary from the given string, without CFA
usage: : VARIABLE BL WORD COUNT HEADER, DOVAR , ;
primitive code = [p4_header_comma]
$HEADER ( bstring -- ) => [FORTH]
CREATE a new header in the dictionary from the given string
with the variable runtime (see HEADER, and CREATE: )
usage: : VARIABLE BL WORD $HEADER ;
primitive code = [p4_str_header]
SMUDGE => [FORTH]
(no description)
primitive code = [p4_smudge]
HIDE ( -- ) => [FORTH]
the FIG definition toggles the SMUDGE bit, and not all systems have
a smudge bit - instead one should use REVEAL or HIDE
: HIDE LAST @ FLAGS@ SMUDGE-MASK XOR LAST @ FLAGS! ;
primitive code = [p4_hide]
REVEAL ( -- ) => [FORTH]
the FIG definition toggles the SMUDGE bit, and not all systems have
a smudge bit - instead one should use REVEAL or HIDE
: REVEAL LAST @ FLAGS@ SMUDGE-MASK INVERT AND LAST @ FLAGS! ;
: REVEAL LAST @ CHAIN-INTO-CURRENT ;
primitive code = [p4_reveal]
RECURSIVE ( -- ) => [FORTH]
REVEAL the current definition making it RECURSIVE by its
own name instead of using the ans-forth word to RECURSE .
' REVEAL ALIAS RECURSIVE IMMEDIATE
immediate code = [p4_reveal]
(CHECK-DEPRECATED:) => [FORTH]
(no description)
primitive code = [p4_check_deprecated]
ALIAS ( some-xt* "name" -- ) [EXT] => [FORTH]
create a defer word that is initialized with the given x-token.
DO-ALIAS
primitive code = [p4_alias]
IS ( xt-value [word] -- ) => [FORTH]
set a DEFER word
(in pfe: set the DOES-field - which is the BODY-field in ans-mode
and therefore the same as TO / in fig-mode the DOES-field is
one cell higher up than for a CREATE: VARIABLE
Use IS freely on each DOES-words in both modes).
: IS '
STATE @ IF LITERAL, POSTPONE >DOES-BODY POSTPONE !
ELSE >DOES-BODY ! THEN
; IMMEDIATE
compiling word = [p4_is]
DEFER! ( xt-value xt-defer -- ) => [FORTH]
A Forth200x definition that is not very useful.
primitive code = [p4_defer_store]
DEFER@ ( xt1 -- xt2 ) => [FORTH]
get the execution token xt2 that would be executed by the DEFER
identified by xt1.
This command is used to obtain the execution contents of a deferred
word. A typical use would be to retrieve and save the execution
behavior of the deferred word, set the deferred word to a new behavior,
and then later restore the old behavior.
If the deferred word identified by _xt1_ is associated with some
other deferred word, _xt2_ is the execution token of that other
deferred word. To retrieve the execution token of the word currently
associated with that other deferred word, use the phrase DEFER@ DEFER@ .
Experience:
BEHAVIOR was used many years in OpenBoot and OpenFirmware systems.
In PFE it is the inverse of an IS operation and it will never fail
if applied to a word with atleast a body. That's just like IS can
be applied to almost every DOES> word where DEFER@ will get
the value back.
primitive code = [p4_defer_fetch]
ACTION-OF ( [word] -- xt-value ) => [FORTH]
get the BEHAVIOR of a DEFER word when executed. If being
compiled then the ACTION-OF will be the value of [word] at the
time of execution and not that of compilation time (non-constant).
In PFE it does actually pick whatever is stored in the DOES-field
of a word and therefore ACTION-OF may applied to all DOES-words.
compiling word = [p4_action_of]
HELP
System with Headers
(HELP) => [FORTH]
(no description)
primitive code = [p4_paren_help]
HOST-K12
extensions
OPEN-TERMINAL-LOGFILE ( s-buf s-len -- ) => "FORTH"
open terminal logfile named by the string-buffer
all further output to the terminal window is also logged into
this file. This is especially useful in embedded environments
where the terminal connection is often not used or it is
directed to a different location that does not easily allow to
redirect the forth output to a file for further examination.
primitive code = [p4_open_terminal_logfile]
CLOSE-TERMINAL-LOGFILE ( -- ) => "FORTH"
close terminal logfile opened with OPEN-TERMINAL-LOGFILE
primitive code = [p4_close_terminal_logfile]
TERMINAL-EMULATION-STATE ( -- state* ) => "FORTH"
returns the address of the emulations state variable so it can be
read and explicitly changed to another value from forth text. This is
a very questionable thing to do as the emulation-state is actually
an enumerated value, the ESE will just show question-marks setting
this variable to something not understood.
primitive code = [p4_terminal_emulation_state]
TERMINAL-ANSWER-LINK ( -- sap#* ) => "FORTH"
send terminal-output as a data-message to the specified link sap.
Unlike TERMINAL-OUTPUT-LINK the data-messages are in line-mode.
The flushed characters are buffered until a non-printable character
is seen. This is somewhat more useful when treating pfe as a print
service and testing machine, but can not provide for interactivity.
60 TERMINAL-ANSWER-LINK !
...
TERMINAL-ANSWER-LINK OFF
primitive code = [p4_terminal_answer_link]
TERMINAL-OUTPUT-LINK ( -- sap#* ) => "FORTH"
send terminal-output as a data-message to the specified link sap.
This can be used in an embedded systems for a terminal session simulation.
setting zero-sap will disable sending message-frames (the zero sap is
therefore not usable for output-to-link). The startup default is zero.
60 TERMINAL-OUTPUT-LINK !
...
TERMINAL-OUTPUT-LINK OFF
primitive code = [p4_terminal_output_link]
TERMINAL-INPUT-LINK ( -- sap#* ) => "FORTH"
let the forth stdin-handling look for data-messages on this link too.
These will be interpreted like messages that come from the interactive
forth terminal. This can be used in an embedded systems for a terminal
session simulation. setting zero-sap will disable interpreting these
incoming data-frames as keyboard-strings (so that the zero sap is
therefore not usable for an input-link!). The startup default is zero.
60 TERMINAL-INPUT-LINK !
...
TERMINAL-INPUT-LINK OFF
primitive code = [p4_terminal_input_link]
Locals
+ extensions
(LOCAL) => "[ANS] FORTH"
(no description)
primitive code = [p4_paren_local]
LOCALS| ( xN ... x2 x1 [name1 .. nameN <|>] -- ) => "[ANS] FORTH"
create local identifiers to be used in the current definition.
At runtime, each identifier will be assigned a value from
the parameter stack.
The identifiers may be treated as if being a VALUE , it does
also implement the ansi TO extensions for locals. Note that
the identifiers are only valid inside the currently compiled
word, the SEE decompiled word will show them as
<A> <B> ... <N> a.s.o.
see also LVALUE
compiling word = [p4_locals_bar]
LVALUE ( value [name] -- ) => "EXTENSIONS"
declares a single local VALUE using (LOCAL) - a
sequence of LVALUE declarations can replace a
LOCALS| argument, ie. LOCALS| a b c |
is the same as LVALUE a LVALUE b LVALUE c .
This should also clarify the runtime stack behaviour of
LOCALS| where the stack parameters seem to be
assigned in reverse order as opposed to their textual
identifier declarations.
compare with VALUE and the pfe's convenience word
VAR .
: LVALUE
STATE @ IF
VALUE
ELSE
BL WORD COUNT DUP (LOCAL) (TO)
THEN
; IMMEDIATE
compiling word = [p4_local_value]
LBUFFER: ( size [name] -- ) => "EXTENSIONS"
declares a single local VALUE using (LOCAL) - which
will hold the address of an area like BUFFER: but carved
from the return-stack (as in C with alloca). This local buffer
will be automatically given up at the end of the word. The
return-stack-pointer will be increased only at the time of
this function (and the address assigned to the LVALUE )
so that the provided size gets determined at runtime. Note
that in some configurations the forth-return-stack area is
quite small - for large string operations you should consider
to use a POCKET-PAD in pfe.
: LBUFFER:
STATE @ IF
BUFFER:
ELSE
:NONAME ( size -- rp* ) R> RP@ - DUP RP! SWAP >R ;NONAME
COMPILE, POSTPONE LVALUE
THEN
; IMMEDIATE
compiling word = [p4_local_buffer_var]
Memory-Alloc
extension
ALLOCATE ( size# -- alloc*! 0 | 0 errno#! ) [ANS] => "[ANS] FORTH"
Allocate a chunk of memory from the system heap.
use FREE to release the memory area back to the system.
A code of zero means success.
primitive code = [p4_allocate]
FREE ( alloc* -- errno# ) [ANS] => "[ANS] FORTH"
Free the memory from ALLOCATE
A code of zero means success.
primitive code = [p4_free]
RESIZE ( alloc* newsize# -- alloc*' errno# ) [ANS] => "[ANS] FORTH"
Resize the system memory chunk. A code of zero means success.
Our implementation returns the old pointer on failure.
primitive code = [p4_resize]
Compatibility
Miscellaneous words
ok => "FORTH"
(no description)
primitive code = [p4_ok]
COLD ( -- ) [FTH] => "FORTH"
cold abort - reinitialize everything and go to QUIT routine
... this routine is implemented as a warm-boot in pfe.
: COLD [ ALSO ENVIRONMENT ] EMPTY SCRIPT-FILE INCLUDED QUIT ;
primitive code = [p4_cold]
LIT => "FORTH"
(no description)
primitive code = [p4_literal_execution]
.LINE ( line# block# -- ) [FTH] => "FORTH"
-
primitive code = [p4_dot_line]
UD.R ( x,x# r# -- ) [FTH] => "FORTH"
-
primitive code = [p4_u_d_dot_r]
UD. ( x,x# -- ) [FTH] => "FORTH"
see also UD .R
primitive code = [p4_u_d_dot]
ID. ( some-nfa* -- ) [FTH] => "FORTH"
print the name-field pointed to by the nfa-argument.
a synonym for .NAME - but this word is more portable due its
heritage from fig-forth.
in fig-forth the name-field is effectivly a bstring with some flags,
so the nfa's count has to be masked out, e.g.
: .NAME COUNT 32 AND TYPE ;
in other pfe configurations, the name might not contain the flags it
it just a counted string - and there may be even more possibilities.
: .NAME COUNT TYPE ;
you should more and more convert your code to use the sequence
NAME>STRING TYPE which is widely regarded as the better
variant.
primitive code = [p4_id_dot]
-ROLL ( x...[n-1] y n# -- y x...[n-1] | num# -- ) [FTH] => "FORTH"
the inverse of ROLL
primitive code = [p4_dash_roll]
RANDOM ( n# -- random# ) [FTH] => "FORTH"
returns random number with 0 <= n2 < n1)
: RANDOM ?DUP IF _random SWAP MOD ELSE _random THEN ;
primitive code = [p4_random]
SRAND ( seed# -- ) [FTH] => "FORTH"
-
primitive code = [p4_srand]
(UNDER+) ( n1 n2 -- n1+n2 n2 ) [FTH] => "FORTH"
quicker than
: (UNDER+) TUCK + SWAP ; or : (UNDER+) DUP UNDER+ ;
primitive code = [p4_under_plus]
+TO ( val [name] -- ) [FTH] => "FORTH"
add the val to the named VALUE or LOCALS| value
compiling word = [p4_plus_to]
BUILD-ARRAY ( x#...[dim] dim# -- memsize# ) [FTH] => "FORTH"
writes X, n1, ... nX into the dictionary -
returns product n1 * n2 * ... * nX
primitive code = [p4_build_array]
ACCESS-ARRAY ( x#...[dim#] array* --- array* value# ) [FTH] => "FORTH"
see BUILD-ARRAY
primitive code = [p4_access_array]
.STATUS ( -- ) [FTH] => "FORTH"
display internal variables
: .STATUS .VERSION .CVERSION .MEMORY .SEARCHPATHS .DICTVARS .REGSUSED ;
primitive code = [p4_dot_status]
SOURCE-LINE ( -- source-line# ) [FTH] => "FORTH"
if SOURCE is from EVALUATE (or QUERY ) then
the result is 0 else the line-numbers start from 1
primitive code = [p4_source_line]
SOURCE-NAME ( -- source-name-ptr source-name-len ) [FTH] => "FORTH"
if SOURCE is from INCLUDE then the result is the filename,
otherwise a generic name for the SOURCE-ID is given.
primitive code = [p4_source_name]
TH'POCKET ( pocket# -- pocket-ptr pocket-len ) [FTH] => "FORTH"
returns the specified pocket as a S" string reference
primitive code = [p4_th_pocket]
POCKET-PAD ( -- pocket-ptr ) [FTH] => "FORTH"
This function Returns the next pocket.
A pocket has usually the size of a maxstring, see ENVIRONMENT /STRING
(but can be configured to be different, mostly when MAXPATH > /STRING )
Note that a pocket is a temporary and forth internal functions do
sometimes call POCKET-PAD too, especially when building filenames
and getting a literal (but temporary) string from the keyboard.
Functions are not expected to hold references to this transient
area any longer than building a name and calling another word with it.
Usage of a pocket pad is a good way to make local temporary buffers
superfluous that are only used to construct a temporary string that
usually gets swallowed by another function.
depracated code:
create temp-buffer 255 allot
: make-temp ( str buf )
temp-buffer place " .tmp" count temp-buffer append
temp-buffer count make-file ;
replace with this:
: make-temp ( str buf )
pocket-pad >r
r place " .tmp" count r append
r> count make-file
;
primitive code = [p4_pocket_pad]
W@ ( some-wchar* -- some-wchar# | some* -- some# [?] ) [FTH] => "FORTH"
fetch a 2byte-val from address
primitive code = [p4_w_fetch]
W! ( value# some-wchar* -- | value# wchar* -- [?] ) [FTH] => "FORTH"
store a 2byte-val at addressed 2byte-value
primitive code = [p4_w_store]
W+! ( value# some-wchar* -- | value# wchar* -- [?] ) [FTH] => "FORTH"
add a 2byte-val to addressed 2byte-value
primitive code = [p4_w_plus_store]
WL-HASH ( buf-ptr buf-len -- buf-hash# ) [FTH] => "FORTH"
calc hash-code for selection of thread
in a threaded-vocabulary
primitive code = [p4_wl_hash]
TOPMOST ( some-wordlist* -- some-topmost-nfa* ) [FTH] => "FORTH"
that last valid word in the specified vocabulary
primitive code = [p4_topmost]
LS.WORDS ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_words]
LS.PRIMITIVES ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_primitives]
LS.COLON-DEFS ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_cdefs]
LS.DOES-DEFS ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_ddefs]
LS.CONSTANTS ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_constants]
LS.VARIABLES ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_variables]
LS.VOCABULARIES ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_vocabularies]
LS.MARKERS ( -- ) [FTH] => "FORTH"
see WORDS
primitive code = [p4_ls_markers]
TAB ( tab-n# -- ) [FTH] => "FORTH"
jump to next column divisible by n
primitive code = [p4_tab]
BACKSPACE ( -- ) [FTH] => "FORTH"
reverse of SPACE
primitive code = [p4_backspace]
?STOP ( -- stop-flag ) [FTH] => "FORTH"
check for 'q' pressed
- see => ?CR
primitive code = [p4_Q_stop]
START?CR ( -- ) [FTH] => "FORTH"
initialized for more-like effect
- see => ?CR
primitive code = [p4_start_Q_cr]
?CR ( -- cr-flag ) [FTH] => "FORTH"
like CR , stop 25 lines past START ?CR
primitive code = [p4_Q_cr]
CLOSE-ALL-FILES ( -- ) [FTH] => "FORTH"
-
primitive code = [p4_close_all_files]
.MEMORY ( -- ) [FTH] => "FORTH"
-
primitive code = [p4_dot_memory]
(EMIT) => "FORTH"
(no description)
primitive code = [p4_paren_emit]
(EXPECT) => "FORTH"
(no description)
primitive code = [p4_paren_expect]
(KEY) => "FORTH"
(no description)
primitive code = [p4_paren_key]
(TYPE) => "FORTH"
(no description)
primitive code = [p4_paren_type]
STANDARD-I/O ( -- ) [FTH] => "FORTH"
initialize *TYPE* , *EMIT* , *EXPECT* and *KEY*
to point directly to the screen I/O routines,
namely (TYPE) , (EMIT) , (EXPECT) , (KEY)
primitive code = [p4_standard_io]
HELP ( "name" -- ) [FTH] [EXEC] => "FORTH"
will load the help module in the background and hand over the
parsed name to (HELP) to be resolved. If no (HELP) word
can be loaded, nothing will happen.
primitive code = [p4_help]
EDIT-BLOCKFILE ( "name" -- ) [FTH] [EXEC] => "FORTH"
will load the edit module in the background and look for a word
called EDIT-BLOCK that could be used to edit the blockfile.
If no EDIT-BLOCKFILE word can be loaded, nothing will happen.
Otherwise, OPEN-BLOCKFILE is called followed by 0 EDIT-BLOCK
to start editing the file at the first block.
primitive code = [p4_edit_blockfile]
ARGC ( -- arg-count ) [FTH] => "FORTH"
-
primitive code = [p4_argc]
ARGV ( arg-n# -- arg-ptr arg-len ) [FTH] => "FORTH"
-
primitive code = [p4_argv]
EXPAND-FN ( name-ptr name-len buf-ptr -- buf-ptr buf-len ) [FTH] => "FORTH"
: e.g. s" includefile" POCKET-PAD EXPAND-FN ;
primitive code = [p4_expand_fn]
LOAD" ( [filename<">] -- ??? ) [FTH] [OLD] => "FORTH"
load the specified file - this word can be compiled into a word-definition
obsolete! use OPEN-BLOCKFILE name LOAD
compiling word = [p4_load_quote]
SYSTEM ( command-ptr command-len -- command-exitcode# ) [FTH] => "FORTH"
run a shell command (note: embedded systems have no shell)
primitive code = [p4_system]
SYSTEM" ( [command-line<">] -- command-exitcode# ) [FTH] [OLD] => "FORTH"
run a shell command (note:embedded systems have no shell)
obsolete! use S" string" SYSTEM
compiling word = [p4_system_quote]
CREATE: ( "name" -- ) [FTH] => "FORTH"
this creates a name with the VARIABLE runtime.
Note that this is the FIG-implemenation of CREATE whereas in
ANS-Forth mode we have a CREATE identical to FIG-style
: CREATE: BL WORD $HEADER DOVAR A, ;
primitive code = [p4_create_var]
BUFFER: ( size# "name" -- ) [FTH] => "FORTH"
this creates a name with the VARIABLE runtime and ALLOT s memory
: BUFFER: BL WORD $HEADER DOVAR A, ALLOT ;
primitive code = [p4_buffer_var]
R'@ ( R: a b -- a R: a b ) [FTH] => "FORTH"
fetch the next-under value from the returnstack.
used to interpret the returnstack to hold two LOCALS| values.
( R@ / 2R@ / R>DROP / R"@ )
compiling word = [p4_r_tick_fetch]
R'! ( x R: a b -- R: x b ) [FTH] => "FORTH"
store the value into the next-under value in the returnstack.
used to interpret the returnstack to hold two LOCALS| values.
see R'@ for inverse operation
compiling word = [p4_r_tick_store]
R"@ ( R: a b c -- a R: a b c ) [FTH] => "FORTH"
fetch the second-under value from the returnstack.
used to interpret the returnstack to hold three LOCALS| values.
see R"! for inverse operation ( R'@ R@ / 2R@ / R>DROP )
compiling word = [p4_r_quote_fetch]
R"! ( x R: a b c -- R: x b c ) [FTH] => "FORTH"
store the value into the second-under value in the returnstack.
used to interpret the returnstack to hold three LOCALS| values.
see R"@ for inverse operation
compiling word = [p4_r_quote_store]
R! ( x R: a -- R: x ) [FTH] => "FORTH"
store the value as the topmost value in the returnstack.
see R@ for inverse operation ( R'@ / R"@ / 2R@ / 2R! )
compiling word = [p4_r_store]
2R! ( x y R: a b -- R: x y ) [FTH] => "FORTH"
store the value as the topmost value in the returnstack.
see 2R@ for inverse operation ( R'@ / R"@ / 2R@ / 2R! )
compiling word = [p4_two_r_store]
DUP>R ( val -- val R: val ) [FTH] => "FORTH"
shortcut, see R>DROP
note again that the following will fail:
: DUP>R DUP >R ;
compiling word = [p4_dup_to_r]
R>DROP ( R: val -- R: ) [FTH] => "FORTH"
shortcut (e.g. in CSI-Forth)
note that the access to R is configuration dependent - only in
a traditional fig-forth each NEST will be one cell wide - in case that
there are no LOCALS| of course. And remember, the word above reads
like the sequence R> and DROP but that is not quite true.
: R>DROP R> DROP ; ( is bad - correct might be ) : R>DROP R> R> DROP >R ;
compiling word = [p4_r_from_drop]
2R>2DROP ( R: a b -- R: ) [FTH] => "FORTH"
this is two times R>DROP but a bit quicker.
it is however really quick compared to the sequence 2R> and 2DROP
compiling word = [p4_two_r_from_drop]
CLEARSTACK ( -- ) [FTH] => "FORTH"
reset the parameter stack to be empty
: CLEARSTACK S0 SP! ;
primitive code = [p4_clearstack]
+UNDER ( n1 x n2 -- n1+n2 x ) [EXT] => "FORTH"
quicker than
: UNDER+ ROT + SWAP ;
Note: the old pfe version of UNDER+ is obsolete as it is in conflict
with a comus word of the same name. The behavior of this word will
continue to exist under the name of (UNDER+) . Users are encouraged
to use the comus behavior of UNDER+ which does already exist under
the name of +UNDER . In the future pfe will be changed to pick up
the comus behavior making UNDER+ and +UNDER to be synonyms. In the
current version there will be load-time warning on usages of "UNDER+".
primitive code = [p4_plus_under]
EXECUTES ( fkey# [word] -- ) [EXT] => "FORTH"
stores the execution token of following word into
the callback pointer for the specified function-key
primitive code = [p4_executes]
MODULE
- simple module implementation
MODULE ( "name" -- old-current ) => "EXTENSIONS"
create a new WORDLIST with the given name. It
will also have an implicit hidden vocabulary just as
well and all DEFINITIONS will go into that
hidden wordlist. Therefore the old CURRENT is
memorized on the cs-stack.
effectivly, CONTEXT[1] will have the wordlist-id
of the public wordlist "name" and CONTEXT[0] will
have the hidden wordlist contained in "name" - the
hidden wordlist will always be known as HIDDEN' so
that it can be re-referenced without need to use
ALSO just to access a single definition from
just another vocabulary. Note that HIDDEN' is
defined immediate (a VOCABULARY' ) to modify
the ORDER inside a colon definition.
: MODULE
CURRENT @ ( -- old-current )
VOCABULARY
ALSO LATEST NAME> EXECUTE ALSO DEFINITIONS
C" HIDDEN'" $CREATE WORDLIST CONTEXT !
;
primitive code = [p4_module]
END-MODULE ( old-current -- ) => "EXTENSIONS"
clean up the cs-stack from the last MODULE
definition. Effectivly, MODULE definitions can
be nested.
: END-MODULE ( old-current )
PREVIOUS PREVIOUS CURRENT !
primitive code = [p4_end_module]
EXPORT ( old-current "name" -- old-current ) => "EXTENSIONS"
the named word in the hidden dictionary (i.e.
the wordlist referenced in CURRENT ) is exported
into the public wordlist of it (i.e. which is in
this implementation CONTEXT [1]). The actual
implemenation will create a DEFER -word in the
public wordlist withits parameter area pointing
to the cfa of the hidden implementation.
: EXPORT
CURRENT @ CONTEXT CELL+ @ CURRENT !
DEFER CURRENT !
LATEST COUNT CURRENT @ SEARCH-WORDLIST
IF LATEST NAME> >BODY ! ELSE ABORT" can't find word to export" THEN
;
primitive code = [p4_export]
EXPOSE-MODULE ( "name" -- ) => "EXTENSIONS"
affects the search order, ALSO module-wid CONTEXT ! hidden'
: EXPOSE-MODULE
ALSO S" HIDDEN'"
' DUP VOC? ABORT?" is no vocabulary" >VOC
SEARCH-WORDLIST 0= IF " no hidden vocabulary found" THEN
DUP VOC? ABORT?" hidden is no vocabulary" EXECUTE
;
primitive code = [p4_expose_module]
ALSO-MODULE ( "name" -- ) => "EXTENSIONS"
affects the search-order, ALSO module-wid CONTEXT !
: ALSO-MODULE
' DUP VOC? ABORT?" is no vocabulary"
ALSO EXECUTE
;
primitive code = [p4_also_module]
Option
Words For Almost-Non-Volatile Environment
NVRAM,WORDS ( -- ) => "EXTENSIONS"
Print a list of WORDS in the NVRAM buffer. Try to show also the
current value, atleast for NVRAM numbers and strings. Words can be
added or changed with the help of NVRAM ,SET or NVRAM ,USE
Values in the NVRAM buffer will survive a COLD reboot, in many
hosted environments however the NVRAM will be lost on program exit.
primitive code = [p4_nvram_words]
NVRAM,Z@ ( "varname" -- z-str ) => "EXTENSIONS"
Return the string pointer of the NVRAM string item, or null if no
such item exists.
primitive code = [p4_nvram_z_fetch]
NVRAM,S@ ( "varname" -- str-ptr str-len ) => "EXTENSIONS"
Return the string span of the NVRAM string item, or double null if no
such item exists.
primitive code = [p4_nvram_s_fetch]
NVRAM,?@ ( number "varname" -- number' ) => "EXTENSIONS"
Return the value of the NVRAM value item, or leave the original
number untouched (i.e. the default value for your option).
primitive code = [p4_nvram_Q_fetch]
NVRAM,AS ( str-ptr str-len "varname" -- ) => "EXTENSIONS"
set the NVRAM variable to the specified string.
Some NVRAM strings do not take effect until next COLD reboot.
primitive code = [p4_nvram_as]
NVRAM,TO ( number "varname" -- ) => "EXTENSIONS"
set the NVRAM variable to the specified number.
Most NVRAM numbers do not take effect until next COLD reboot.
primitive code = [p4_nvram_to]
posix forth wordset page
NTOHL ( l -- l' ) => "EXTENSIONS"
if current host-encoding is bigendian, this is a NOOP
otherwise byteswap the lower 32-bit bits of the topofstack.
see L@ and L! (being usually just @ and ! )
(on some platforms, the upper bits are erased, on others not)
primitive code = [p4_ntohl]
HTONL => "EXTENSIONS"
(no description)
primitive code = [p4_ntohl]
NTOHS ( w -- w' ) => "EXTENSIONS"
if current host-encoding is bigendian, this is a NOOP
otherwise byteswap the lower 16-bit bits of the topofstack.
see W@ and W!
(on some platforms, the upper bits are erased, on others not)
primitive code = [p4_ntohs]
HTONS => "EXTENSIONS"
(no description)
primitive code = [p4_ntohs]
Search-order
+ extensions
DEFINITIONS ( -- ) => "[ANS] FORTH"
make the current context-vocabulary the definition-vocabulary,
that is where new names are declared in. see ORDER
primitive code = [p4_definitions]
GET-CURRENT ( -- voc ) => "[ANS] FORTH"
return the current definition vocabulary, see DEFINITIONS
primitive code = [p4_get_current]
GET-ORDER ( -- vocn ... voc1 n ) => "[ANS] FORTH"
get the current search order onto the stack, see SET-ORDER
primitive code = [p4_get_order]
SEARCH-WORDLIST ( str-ptr str-len voc -- 0 | xt 1 | xt -1 ) => "[ANS] FORTH"
almost like FIND or (FIND) -- but searches only the
specified vocabulary.
primitive code = [p4_search_wordlist]
SET-CURRENT ( voc -- ) => "[ANS] FORTH"
set the definition-vocabulary. see DEFINITIONS
primitive code = [p4_set_current]
SET-ORDER ( vocn ... voc1 n -- ) => "[ANS] FORTH"
set the search-order -- probably saved beforehand using
GET-ORDER
primitive code = [p4_set_order]
WORDLIST ( -- voc ) => "[ANS] FORTH"
return a new vocabulary-body for private definitions.
primitive code = [p4_wordlist]
ALSO ( -- ) => "[ANS] FORTH"
a DUP on the search ORDER - each named vocabulary
replaces the topmost ORDER vocabulary. Using ALSO
will make it fixed to the search-order. (but it is
not nailed in trap-conditions as if using DEFAULT-ORDER )
order: vocn ... voc2 voc1 -- vocn ... voc2 voc1 voc1
primitive code = [p4_also]
ORDER ( -- ) => "[ANS] FORTH"
show the current search-order, followed by
the CURRENT DEFINITIONS vocabulary
and the ONLY base vocabulary
primitive code = [p4_order]
PREVIOUS ( -- ) => "[ANS] FORTH"
the invers of ALSO , does a DROP on the search ORDER
of vocabularies.
order: vocn ... voc2 voc1 -- vocn ... voc2
example: ALSO PRIVATE-VOC DEFINTIONS (...do some...) PREVIOUS DEFINITIONS
primitive code = [p4_previous]
DEFAULT-ORDER ( -- ) => "FORTH"
nail the current search ORDER so that it will even
survive a trap-condition. This default-order can be
explicitly loaded with RESET-ORDER
primitive code = [p4_default_order]
RESET-ORDER ( -- ) => "FORTH"
load the DEFAULT-ORDER into the current search ORDER
- this is implicitly done when a trap is encountered.
primitive code = [p4_reset_order]
Shell
like words
$PID ( -- pid ) => "EXTENSIONS"
calls system's getpid
primitive code = [p4_getpid]
$UID ( -- val ) => "EXTENSIONS"
calls system's getuid
primitive code = [p4_getuid]
$EUID ( -- val ) => "EXTENSIONS"
calls system's geteuid
primitive code = [p4_geteuid]
$GID ( -- val ) => "EXTENSIONS"
calls system's getgid
primitive code = [p4_getgid]
UMASK ( val -- ret ) => "EXTENSIONS"
calls system's umask
primitive code = [p4_umask]
$HOME ( -- str-ptr str-len ) => "EXTENSIONS"
calls system's getenv(HOME)
primitive code = [p4_home]
$USER ( -- str-ptr str-len ) => "EXTENSIONS"
calls system's getenv(USER)
primitive code = [p4_user]
$CWD ( -- str-ptr str-len ) => "EXTENSIONS"
calls system's getcwd
primitive code = [p4_cwd]
PWD ( -- ) => "EXTENSIONS"
calls system's getcwd and prints it to the screen
: PWD $CWD TYPE ;
primitive code = [p4_pwd]
RM => "EXTENSIONS"
(no description)
compiling word = [p4_remove]
TOUCH => "EXTENSIONS"
(no description)
compiling word = [p4_touch]
CHDIR ( bstring -- ) => "EXTENSIONS"
change the current directory.
( (under VxWorks it is global! do not use in scripts!!) )
primitive code = [p4_chdir]
RMDIR => "EXTENSIONS"
(no description)
compiling word = [p4_rmdir]
MKDIR => "EXTENSIONS"
(no description)
compiling word = [p4_md]
LN => "EXTENSIONS"
(no description)
compiling word = [p4_link]
MV => "EXTENSIONS"
(no description)
compiling word = [p4_mv]
LL => "EXTENSIONS"
(no description)
compiling word = [p4_ll]
LS => "EXTENSIONS"
(no description)
compiling word = [p4_ls]
CP => "EXTENSIONS"
(no description)
compiling word = [p4_cp]
Signals
Extension
RAISE-SIGNAL ( signal# -- ior ) [FTH] => "FORTH"
-
primitive code = [p4_raise_signal]
FORTH-SIGNAL ( handler-xt* signal# -- old-signal-xt* ) [FTH] => "FORTH"
install signal handler
- return old signal handler
primitive code = [p4_forth_signal]
RAISE-SIGNAL.DROP => "FORTH"
(no description)
primitive code = [p4_raise]
smart-go
interpreter
SMART-INTERPRET-INIT ( -- ) => "EXTENSIONS"
creates a set of interpret-words that are used in the inner
interpreter, so if a word is unknown to the interpreter-loop
it will use the first char of that word, attach it to an
"interpret-" prefix, and tries to use that IMMEDIATE -=>'DEFER'-word
on the rest of the word. This SMART-INTERPRET-INIT will set up
words like interpret-" so you can write
"hello" instead of " hello"
and it creates interpret-\ so that words like \if-unix are
ignoring the line if the word \if-unknown is unknown in itself.
This is usually not activated on startup.
primitive code = [p4_smart_interpret_init]
SMART-INTERPRET! ( -- ) => "EXTENSIONS"
enables/disables the SMART-INTERPRET extension in INTERPRET ,
(actually stores an XT in DEFER inside the mainloop interpreter)
primitive code = [p4_smart_interpret_store]
StackHelp
TypeChecking extension
|( ( [string<rp>] -- ) [EXT] => "EXTENSIONS"
add a checkstack notation for the LAST word or just try to
match the given notation with the stacklayout traced so
far - possibly casting a few types as needed.
immediate code = [p4_stackhelpcomment]
STACKHELP ( [name] -- ) [EXT] => "EXTENSIONS"
show the stackhelp info registered for this name.
immediate code = [p4_stackhelp]
STACKHELPS ( [name] -- ) [EXT] => "EXTENSIONS"
show all possible stackhelps for this name.
immediate code = [p4_stackhelps]
STACKHELP-DEBUG => "EXTENSIONS"
(no description)
primitive code = [stackhelp_debug]
NARROW-CHANGER( ( changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_changer]
NARROW-INPUTLIST( ( changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_inputlist]
NARROW-OUTPUTLIST( ( changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_outputlist]
NARROW-INPUT-VARIANT( ( variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
0 = default, 1 = 'S', 2 = 'R', ... 4 = 'P', ... 7 = 'M', .. 14 = 'F'
primitive code = [p4_narrow_input_variant]
NARROW-OUTPUT-VARIANT( ( variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_output_variant]
NARROW-INPUT-STACK( ( stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
0 = default, 1 = 'S', 2 = 'R', ... 4 = 'P', ... 7 = 'M', .. 14 = 'F'
primitive code = [p4_narrow_input_stack]
NARROW-OUTPUT-STACK( ( stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_output_stack]
NARROW-INPUT-ARGUMENT( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
0 = default, 1 = 'S', 2 = 'R', ... 4 = 'P', ... 7 = 'M', .. 14 = 'F'
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_narrow_input_argument]
NARROW-OUTPUT-ARGUMENT( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_narrow_output_argument]
NARROW-INPUT-ARGUMENT-NAME( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
0 = default, 1 = 'S', 2 = 'R', ... 4 = 'P', ... 7 = 'M', .. 14 = 'F'
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_narrow_input_argument_name]
NARROW-OUTPUT-ARGUMENT-NAME( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_narrow_output_argument_name]
NARROW-INPUT-ARGUMENT-TYPE( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
0 = default, 1 = 'S', 2 = 'R', ... 4 = 'P', ... 7 = 'M', .. 14 = 'F'
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_narrow_input_argument_type]
NARROW-OUTPUT-ARGUMENT-TYPE( ( arg# stk-char which# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_narrow_output_argument_type]
CANONIC-INPUT-TYPE( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
0 = default, 1 = 'S', 2 = 'R', ... 4 = 'P', ... 7 = 'M', .. 14 = 'F'
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_canonic_input_type]
CANONIC-OUTPUT-TYPE( ( arg# stk-char variant# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
arg# is [0] = TOS and [1] = UNDER, same as the pick values where
3 2 1 0 2 pick . =:= 2
primitive code = [p4_canonic_output_type]
REWRITER-TEST( ( "tracked-stack -- input-stack<rp>" -- ) [EXT] => "EXTENSIONS"
suppose that the left side is a tracked stack line during compiling
and the right side is a candidate changer input stack. Test whethr
the candidate does match and the complete changer would be allowed
to run a rewrite in the track stack buffer.
Possible conditions include:
the left side has not enough arguments or...
any argument on the right side has a type specialization
that does not match as a valid suffix to their counterpart
on the left side.
primitive code = [p4_rewriter_test]
REWRITER-INPUT-ARG( ( arg# "tracked-stack -- changer<rp>" -- ) [EXT] => "EXTENSIONS"
suppose that the left side is a tracked stack line during compiling
and the right side is a candidate changer input stack. Assume the
righthand candidate does match - look at the given argument on the
left side and show the prefix being copied to the output trackstack
when the rewrite-rule is gettin applied later.
primitive code = [p4_rewriter_input_arg]
REWRITE-LINE( ( "stack-layout<rp>" -- ) [EXT] => "EXTENSIONS"
fill rewrite-buffer with a stack-layout to be processed.
see REWRITE-SHOW.
primitive code = [p4_rewrite_line]
REWRITE-SHOW. ( -- ) [EXT] => "EXTENSIONS"
show current rewrite-buffer.
primitive code = [p4_rewrite_show]
REWRITE-STACK-TEST( ( "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
check whether this stackhelp does match on current rewrite-buffer
and say oK/No respectivly.
primitive code = [p4_rewrite_stack_test]
REWRITE-INPUT-ARG( ( arg# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
check whether this stackhelp does match on current rewrite-buffer
and in the given input match show us the argument but only the
good prefix i.e. the type constraint being cut off already.
primitive code = [p4_rewrite_input_arg]
REWRITE-STACK-RESULT( ( "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
rewrite the current rewrite-buffer and show the result that
would occur with this stackhelp being applied.
primitive code = [p4_rewrite_stack_result]
NARROW-INPUT-NOTATION( ( notation# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_input_notation]
NARROW-OUTPUT-NOTATION( ( notation# changer# "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
-
primitive code = [p4_narrow_output_notation]
REWRITE-STACKDEF-TEST( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_stackdef_test]
REWRITE-STACKDEF-RESULT( ( "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
assume:
only one changer (if more are provided then only the first is used)
only one stackdef variant in inputlist
primitive code = [p4_rewrite_stackdef_result]
REWRITE-CHANGER-SELECT( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_changer_select]
REWRITE-CHANGER-EXPAND( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_changer_expand]
REWRITE-CHANGER-RESULT( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_changer_result]
REWRITE-TEST( ( "stackhelp<rp>" -- ) [EXT] => "EXTENSIONS"
Test whether the given changer would match the current line.
assume:
only one changer (if more are provided then only the first is used)
primitive code = [p4_rewrite_test]
REWRITE-SELECT( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_select]
REWRITE-EXPAND( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_expand]
REWRITE-RESULT( => "EXTENSIONS"
(no description)
primitive code = [p4_rewrite_result]
String
+ extensions
-TRAILING ( str-ptr str-len -- str-ptr str-len' ) => "[ANS] FORTH"
check the given buffer if it contains whitespace at its end.
If so, shorten str-len to meet the last non-whitespace
character in the buffer.
primitive code = [p4_dash_trailing]
/STRING ( str-ptr str-len n -- str-ptr' str-len' ) => "[ANS] FORTH"
shorten the buffer from the beginning by n characters, i.e.
str-ptr += n ;
str-len -= n;
primitive code = [p4_slash_string]
BLANK ( str-ptr str-len -- ) => "[ANS] FORTH"
FILL a given buffer with BL blanks
primitive code = [p4_blank]
CMOVE ( from-ptr to-ptr len# -- ) => "[ANS] FORTH"
memcpy an area from->to for len bytes, starting at
the lower addresses, see CMOVE>
primitive code = [p4_cmove]
CMOVE> ( from-ptr to-ptr len# -- ) => "[ANS] FORTH"
memcpy an area from->to for len bytes, starting
with the higher addresses, see CMOVE
primitive code = [p4_cmove_up]
COMPARE ( str1-ptr str1-len str2-ptr str2-len -- diff# ) => "[ANS] FORTH"
compare both str-buffers, return 0 if they are equal,
-1 if lower or shorter, and 1 if greater or longer
primitive code = [p4_compare]
SEARCH ( str1-ptr str1-len str2-ptr str2-len -- str1-ptr' str1-len' flag ) => "[ANS] FORTH"
search the str-buffer1 for the text of str-buffer2,
if it is contained return TRUE and return buffer-values that
point to the contained string, otherwise return FALSE and
leave the original str-buffer1.
primitive code = [p4_search]
SLITERAL ( C: str-ptr str-len -- S: str-ptr str-len ) => "[ANS] FORTH"
this word does almost the same as LITERAL - it takes
an S" string as specified in the CS-STACK at compile
time and compiles into the current definition where it is
returned as if there were a direct string-literal. This
can be used to compute a string-literal at compile-time
and hardwire it.
example:
: ORIGINAL-HOME [ $HOME COUNT ] SLITERAL ; ( -- str-ptr str-len )
compiling word = [p4_sliteral]
STRUCT
- simple struct implementation
STRUCT ( "name" -- here zero-offset ) => "EXTENSIONS"
begin definition of a new structure (mpe.000)
: STRUCT CREATE !CSP
HERE
0 DUP ,
DOES>
@
;
primitive code = [p4_struct]
END-STRUCT ( here some-offset -- ) => "EXTENSIONS"
terminate definition of a new structure (mpe.000)
: END-STRUCT SWAP ! ?CSP ;
primitive code = [p4_end_struct]
SUBRECORD ( outer-offset "name" -- outer-offset here zero-offset ) => "EXTENSIONS"
begin definition of a subrecord (mpe.000)
: STRUCT CREATE
HERE
0 DUP ,
DOES>
@
;
primitive code = [p4_subrecord]
END-SUBRECORD ( outer-offset here some-offset -- outer-offset+some ) => "EXTENSIONS"
end definition of a subrecord (mpe.000)
: END-SUBRECORD TUCK SWAP ! + ;
primitive code = [p4_end_subrecord]
ARRAY-OF ( some-offset n len "name" -- some-offset ) => "EXTENSIONS"
a FIELD -array
: ARRAY-OF * FIELD ;
primitive code = [p4_array_of]
VARIANT ( outer-offset "name" -- outer-offset here zero-offset ) => "EXTENSIONS"
Variant records describe an alternative view of the
current record or subrecord from the start to the current point.
The variant need not be of the same length, but the larger is taken
: VARIANT SUBRECORD ;
primitive code = [p4_variant]
END-VARIANT ( outer-offset here some-offset -- outer-offset ) => "EXTENSIONS"
terminate definition of a new variant (mpe.000)
: END-STRUCT TUCK SWAP ! 2DUP < IF NIP ELSE DROP THEN ;
primitive code = [p4_end_variant]
INSTANCE ( len "name" -- ) => "EXTENSIONS"
Create a named instance of a named structure.
: INSTANCE CREATE ALLOT ;
primitive code = [p4_instance]
INSTANCE-ADDR ( len -- addr ) => "EXTENSIONS"
Create nameless instance of a structure and return base address.
: INSTANCE-ADDR HERE SWAP ALLOT ;
primitive code = [p4_instance_addr]
ENDSTRUCTURE ( here some-offset -- ) => "EXTENSIONS"
finalize a previously started STRUCTURE definition
: ENDSTRUCTURE SWAP ! ?CSP ;
primitive code = [p4_endstructure]
SIZEOF ( "name" -- size ) => "EXTENSIONS"
get the size-value from a previous structure definition
: SIZEOF ' >BODY @ STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE
compiling word = [p4_sizeof]
CHAR% => "EXTENSIONS"
(no description)
primitive code = [p4_char_mod]
CELL% => "EXTENSIONS"
(no description)
primitive code = [p4_cell_mod]
WCHAR% => "EXTENSIONS"
(no description)
primitive code = [p4_wchar_mod]
DOUBLE% => "EXTENSIONS"
(no description)
primitive code = [p4_double_mod]
FLOAT% => "EXTENSIONS"
(no description)
primitive code = [p4_float_mod]
SFLOAT% => "EXTENSIONS"
(no description)
primitive code = [p4_sfloat_mod]
DFLOAT% => "EXTENSIONS"
(no description)
primitive code = [p4_dfloat_mod]
STRUCTS
- simple structure implementation 0
STRUCTURE: => "EXTENSIONS"
(no description)
primitive code = [p4_structure]
;STRUCTURE => "EXTENSIONS"
(no description)
primitive code = [p4_endstructure]
CHAR: => "EXTENSIONS"
(no description)
primitive code = [p4_char_colon]
WCHAR: => "EXTENSIONS"
(no description)
primitive code = [p4_wchar_colon]
CELL: => "EXTENSIONS"
(no description)
primitive code = [p4_cell_colon]
DOUBLE: => "EXTENSIONS"
(no description)
primitive code = [p4_two_cell_colon]
FLOAT: => "EXTENSIONS"
(no description)
primitive code = [p4_float_colon]
CHARS: => "EXTENSIONS"
(no description)
primitive code = [p4_chars_colon]
WCHARS: => "EXTENSIONS"
(no description)
primitive code = [p4_wchars_colon]
CELLS: => "EXTENSIONS"
(no description)
primitive code = [p4_cells_colon]
INTEGER: => "EXTENSIONS"
(no description)
primitive code = [p4_cell_colon]
POINTER: => "EXTENSIONS"
(no description)
primitive code = [p4_cell_colon]
STRUCT: => "EXTENSIONS"
(no description)
primitive code = [p4_field]
ARRAY: => "EXTENSIONS"
(no description)
primitive code = [p4_array_of]
System-extension
wordset from forth-83
<MARK ( -- DP-mark ) compile-only => "FORTH"
memorizes the current DP on the CS-STACK
used for later. Useful for creation of
compiling words, eg. BEGIN , see AHEAD
simulate:
: <MARK ?COMP HERE ;
primitive code = [p4_backward_mark]
<RESOLVE ( DP-mark -- ) compile-only => "FORTH"
resolves a previous , actually pushes
the DP-address memorized at BRANCH or => ?BRANCH in compiling
words like UNTIL
simulate:
: <RESOLVE ?COMP , ;
primitive code = [p4_backward_resolve]
MARK> ( -- DP-mark ) compile-only => "FORTH"
makes room for a pointer in the dictionary to
be resolved through RESOLVE> and does therefore
memorize that cell's address on the CS-STACK
Mostly used after BRANCH or => ?BRANCH in compiling
words like IF or ELSE
simulate:
: MARK> ?COMP HERE 0 , ;
primitive code = [p4_forward_mark]
RESOLVE> ( DP-mark -- ) compile-only => "FORTH"
resolves a pointer created by MARK>
Mostly used in compiling words like THEN
simulate:
: RESOLVE> ?COMP HERE SWAP ! ;
primitive code = [p4_forward_resolve]
BRANCH ( -- ) => "FORTH"
compiles a branch-runtime into the dictionary that
can be resolved with MARK< d or <RESOLVE .
Usage:
BRANCH MARK< or
BRANCH >RESOLVE or ...
this is the runtime-portion of ELSE - the use of
ELSE should be preferred. See also => ?BRANCH
: BRANCH COMPILE (BRANCH) ;
immediate code = [p4_branch]
?BRANCH ( -- ) => "FORTH"
compiles a cond-branch-runtime into the dictionary that
can be resolved with >MARK& d or RESOLVE> .
Usage:
?BRANCH MARK< or
?BRANCH >RESOLVE or ...
this is the runtime-portion of IF - the use of
IF should be preferred. See also BRANCH
: ?BRANCH COMPILE (?BRANCH) ;
immediate code = [p4_q_branch]
TERMCATCH
support for testing
TERM-CAPTURE-CONTROLS ( -- var-ptr ) => [FORTH]
enable/disable common visualization of terminal control sequences.
primitive code = [p4_term_capture_controls]
(TERM-CAPTURE-ON) => [FORTH]
(no description)
primitive code = [p4_paren_term_capture_on]
(TERM-CAPTURE-OFF) => [FORTH]
(no description)
primitive code = [p4_paren_term_capture_off]
(TERM-CAPTURE-BUFFER) => [FORTH]
(no description)
primitive code = [p4_paren_term_capture_buffer]
(TERM-CAPTURE-RESULT) => [FORTH]
(no description)
primitive code = [p4_paren_term_capture_result]
TERM-CAPTURE-ON ( capturebuffer-ptr capturebuffer-len -- ) => [FORTH]
init/start capturing terminal output
: TERM-CAPTURE-ON (TERM-CAPTURE-BUFFER) (TERM-CAPTURE-ON) ;
primitive code = [p4_term_capture_on]
TERM-CAPTURE-OFF ( -- capturebuffer-ptr capturebuffer-len ) => [FORTH]
shutdown capturing terminal output
: TERM-CAPTURE-OFF (TERM-CAPTURE-OFF) (TERM-CAPTURE-RESULT) ;
primitive code = [p4_term_capture_off]
TERMCATCH ( str-ptr str-len some-xt* -- str-ptr str-len' catch-code# ) => [FORTH]
create a catch-domain around the token to be executed. This works
the same as CATCH . Additionally all terminal output of that word
is being captured to the buffer being provided as an argument. The
maximum length input argument is modified flagging the actual length
of captured output stream as the output argument. Note that in most
cases a POCKET-PAD is just not big enough, atleast many error
condition notifications tend to be quite lengthy for byte counted
forth strings.
: TERMCATCH TERM-CAPTURE-ON CATCH >R TERM-CAPTURE-OFF R> ;
primitive code = [p4_termcatch]
Terminal
Interface extensions
SHOW-TERMCAP ( -- ) for debugging => "EXTENSIONS"
print the termcap strings used for input and output
may give hints about what is wrong if the terminal
seems to miss some functionality
primitive code = [p4_show_termcap]
SHOW-TERM-CONTROLS ( -- ) for debugging => "EXTENSIONS"
show the current mappings for the terminal output
may give hints about what is wrong if the output
seems to miss some functionality
primitive code = [p4_show_control_strings]
SHOW-TERM-ESC-KEYS ( -- ) for debugging => "EXTENSIONS"
show the current mappings for the terminal input
may give hints about what is wrong if the input
seems to miss some functionality
primitive code = [p4_show_rawkey_strings]
ASSUME_VT100 ( -- ) => "EXTENSIONS"
load hardwired VT100-termcap into the terminal-driver
primitive code = [p4_assume_vt100]
ASSUME_DUMBTERM ( -- ) => "EXTENSIONS"
load hardwired DUMBTERM-termcap into the terminal-driver
primitive code = [p4_assume_dumbterm]
GOTOXY ( x y -- ) => "EXTENSIONS"
move the cursor to the specified position on the screen -
this is usually done by sending a corresponding esc-sequence
to the terminal.
primitive code = [p4_gotoxy]
?XY ( -- x y ) => "EXTENSIONS"
returns the cursor position on screen, on a real unix system
this includes a special call to the screen driver, in remote
systems this can be the expected position as seen on the
client side's terminal driver.
primitive code = [p4_question_xy]
CLS => "EXTENSIONS"
(no description)
primitive code = [p4_dot_clrscr]
.CLRSCR => "EXTENSIONS"
(no description)
primitive code = [p4_dot_clrscr]
.CLREOL => "EXTENSIONS"
(no description)
primitive code = [p4_dot_clreol]
.HOME => "EXTENSIONS"
(no description)
primitive code = [p4_dot_home]
.HIGHLIGHT => "EXTENSIONS"
(no description)
primitive code = [p4_dot_highlight]
.HIGHLIGHT.OFF => "EXTENSIONS"
(no description)
primitive code = [p4_dot_highlight_off]
.UNDERLINE => "EXTENSIONS"
(no description)
primitive code = [p4_dot_underline]
.UNDERLINE.OFF => "EXTENSIONS"
(no description)
primitive code = [p4_dot_underline_off]
.INTENSITY => "EXTENSIONS"
(no description)
primitive code = [p4_dot_intensity]
.INTENSITY.OFF => "EXTENSIONS"
(no description)
primitive code = [p4_dot_intensity_off]
.BLINKING => "EXTENSIONS"
(no description)
primitive code = [p4_dot_blink]
.BLINKING.OFF => "EXTENSIONS"
(no description)
primitive code = [p4_dot_blink_off]
.REVERSE => "EXTENSIONS"
(no description)
primitive code = [p4_dot_reverse]
.REVERSE.OFF => "EXTENSIONS"
(no description)
primitive code = [p4_dot_reverse_off]
.NORMAL => "EXTENSIONS"
(no description)
primitive code = [p4_dot_normal]
.BELL => "EXTENSIONS"
(no description)
primitive code = [p4_dot_bell]
EKEY>FKEY ( key-code# -- key-code# 0 | fkey-code# true! ) => "EXTENSIONS"
If the input ekey value was not an extended key
then flag is set to FALSE and the value is left
unchanged. Compare to EKEY>CHAR for the inverse.
If the input eky was an extended key then the value
will be modified such that shifted values are transposed
to their base EKEY plus K-SHIFT-MASK - therefore the
K-SHIFT-MASK is only apropriate for the result fkey-code
values of this function.
primitive code = [p4_ekey_to_fkey]
TOOLBELT
- Neil Bawd's common extensions
[DEFINED] ( "name" -- flag ) => [FORTH]
Search the dictionary for _name_. If _name_ is found,
return TRUE; otherwise return FALSE. Immediate for use in
definitions.
[DEFINED] word ( -- nfa|0 ) immediate
does check for the word using find (so it does not throw like ' )
and puts it on stack. As it is immediate it does work in compile-mode
too, so it places its argument in the cs-stack then. This is most
useful with a directly following [IF] clause, so that sth. like
an [IFDEF] word can be simulated through [DEFINED] word [IF]
: [DEFINED] BL WORD FIND NIP ; IMMEDIATE
immediate code = [p4_defined]
[UNDEFINED] ( "name" -- flag ) => [FORTH]
Search the dictionary for _name_. If _name_ is found,
return FALSE; otherwise return TRUE. Immediate for use in
definitions.
see [DEFINED]
immediate code = [p4_undefined]
NOT ( x -- flag ) => [FORTH]
Identical to `0=`, used for program clarity to reverse the
result of a previous test.
WARNING: PFE's NOT uses bitwise complement INVERT
instead of the logical complement 0= , so
that loading TOOLBELT will change semantics.
... this difference in semantics has caused dpans94 to
depracate the word. Only if TRUE is -1 it would be identical
but not all words return -1 for true.
primitive code = [p4_zero_equal]
C+! ( n addr -- ) => [FORTH]
Add the low-order byte of _n_ to the byte at _addr_,
removing both from the stack.
primitive code = [p4_c_plus_store]
EMPTY ( -- ) => [FORTH]
Reset the dictionary to a predefined golden state,
discarding all definitions and releasing all allocated
data space beyond that state.
primitive code = [p4_empty]
VOCABULARY ( "name" -- ) [FTH] => [FORTH]
create a vocabulary of that name. If the named vocabulary
is called later, it will run ((VOCABULARY)) , thereby
putting it into the current search order.
Special pfe-extensions are accessible via
CASE-SENSITIVE-VOC and SEARCH-ALSO-VOC
simulate:
: VOCABULARY CREATE ALLOT-WORDLIST
DOES> ( the ((VOCABULARY)) runtime )
CONTEXT !
; IMMEDIATE
primitive code = [p4_vocabulary]
BOUNDS ( str len -- str+len str ) => [FORTH]
Convert _str len_ to range for DO-loop.
: BOUNDS ( str len -- str+len str ) OVER + SWAP ;
primitive code = [p4_bounds]
OFF ( addr -- ) => [FORTH]
Store 0 at _addr_. Defined in f84 as OFF . See antonym ON! .
: OFF ( addr -- ) 0 SWAP ! ;
primitive code = [p4_off_store]
ON ( addr -- ) => [FORTH]
Store -1 at _addr_. See `OFF`.
: ON ( addr -- ) -1 SWAP ! ;
primitive code = [p4_on_store]
APPEND ( str len add2 -- ) => [FORTH]
Append string _str len_ to the counted string at _addr_.
a.k.a. +PLACE of the PLACE family
: APPEND 2DUP 2>R COUNT + SWAP MOVE ( ) 2R> C+! ;
primitive code = [p4_append]
APPEND-CHAR ( char addr -- ) => [FORTH]
Append _char_ to the counted string at _addr_.
a.k.a. C+PLACE of the PLACE family
: APPEND-CHAR DUP >R COUNT DUP 1+ R> C! + C! ;
primitive code = [p4_append_char]
PLACE ( str len addr -- ) => [FORTH]
Place the string _str len_ at _addr_, formatting it as a
counted string.
: PLACE 2DUP 2>R 1+ SWAP MOVE 2R> C! ;
: PLACE 2DUP C! 1+ SWAP CMOVE ;
primitive code = [p4_place]
STRING, ( str len -- ) => [FORTH]
Store a string in data space as a counted string.
: STRING, HERE OVER 1+ ALLOT PLACE ;
primitive code = [p4_parse_comma]
," ( "<ccc><quote>" -- ) => [FORTH]
Store a quote-delimited string in data space as a counted
string.
: ," [CHAR] " PARSE STRING, ; IMMEDIATE
immediate code = [p4_parse_comma_quote]
THIRD ( x y z -- x y z x ) => [FORTH]
Copy third element on the stack onto top of stack.
: THIRD 2 PICK ;
primitive code = [p4_third]
FOURTH ( w x y z -- w x y z w ) => [FORTH]
Copy fourth element on the stack onto top of stack.
: FOURTH 3 PICK ;
primitive code = [p4_fourth]
3DUP ( x y z -- x y z x y z ) => [FORTH]
Copy top three elements on the stack onto top of stack.
: 3DUP THIRD THIRD THIRD ;
or
: 3DUP 3 PICK 3 PICK 3 PICK ;
primitive code = [p4_three_dup]
3DROP ( x y z -- ) => [FORTH]
Drop the top three elements from the stack.
: 3DROP DROP 2DROP ;
primitive code = [p4_three_drop]
2NIP ( w x y z -- y z ) => [FORTH]
Drop the third and fourth elements from the stack.
: 2NIP 2SWAP 2DROP ;
primitive code = [p4_two_nip]
R'@ ( R: a b -- a R: a b ) [FTH] => [FORTH]
fetch the next-under value from the returnstack.
used to interpret the returnstack to hold two LOCALS| values.
( R@ / 2R@ / R>DROP / R"@ )
primitive code = [p4_r_tick_fetch]
ANDIF ( p ... -- flag ) => [FORTH]
Given `p ANDIF q THEN`, _q_ will not be performed if
_p_ is false.
: ANDIF S" DUP IF DROP " EVALUATE ; IMMEDIATE
compiling word = [p4_andif]
ORIF ( p ... -- flag ) => [FORTH]
Given `p ORIF q THEN`, _q_ will not be performed if
_p_ is true.
: ORIF S" DUP 0= IF DROP " EVALUATE ; IMMEDIATE
compiling word = [p4_orif]
SCAN ( str len char -- str+i len-i ) => [FORTH]
Look for a particular character in the specified string.
: SCAN
>R BEGIN DUP WHILE OVER C@ R@ -
WHILE 1 /STRING REPEAT THEN
R> DROP ;
ie.
scan for first occurence of c in string
: SCAN >R BEGIN DUP OVER C@ R@ = 0= OR WHILE
1- SWAP 1- SWAP REPEAT R> DROP ;
primitive code = [p4_scan]
SKIP ( str len char -- str+i len-i ) => [FORTH]
Advance past leading characters in the specified string.
: SKIP
>R BEGIN DUP WHILE OVER C@ R@ =
WHILE 1 /STRING REPEAT THEN
R> DROP ;
ie.
skip leading characters c
: SKIP >R BEGIN DUP OVER C@ R@ = OR WHILE
1- SWAP 1- SWAP REPEAT R> DROP ;
primitive code = [p4_skip]
BACK ( str len char -- str len-i ) => [FORTH]
Look for a particular character in the string from the
back toward the front.
: BACK
>R BEGIN DUP WHILE
1- 2DUP + C@ R@ =
UNTIL 1+ THEN
R> DROP ;
primitive code = [p4_back]
/SPLIT ( a m a+i m-i -- a+i m-i a i ) => [FORTH]
Split a character string _a m_ at place given by _a+i m-i_.
Called "cut-split" because "slash-split" is a tongue
twister.
: /SPLIT DUP >R 2SWAP R> - ;
primitive code = [p4_div_split]
IS-WHITE ( char -- flag ) => [FORTH]
Test char for white space.
: IS-WHITE 33 - 0< ;
primitive code = [p4_is_white]
TRIM ( str len -- str len-i ) => [FORTH]
Trim white space from end of string.
: TRIM
BEGIN DUP WHILE
1- 2DUP + C@ IS-WHITE NOT
UNTIL 1+ THEN ;
primitive code = [p4_trim]
BL-SCAN ( str len -- str+i len-i ) => [FORTH]
Look for white space from start of string
: BL-SCAN
BEGIN DUP WHILE OVER C@ IS-WHITE NOT
WHILE 1 /STRING REPEAT THEN ;
primitive code = [p4_bl_scan]
BL-SKIP ( str len -- str+i len-i ) => [FORTH]
Skip over white space at start of string.
: BL-SKIP
BEGIN DUP WHILE OVER C@ IS-WHITE
WHILE 1 /STRING REPEAT THEN ;
primitive code = [p4_bl_skip]
STARTS? ( str len pattern len2 -- str len flag ) => [FORTH]
Check start of string.
: STARTS? DUP >R 2OVER R> MIN COMPARE 0= ;
primitive code = [p4_starts_Q]
ENDS? ( str len pattern len2 -- str len flag ) => [FORTH]
Check end of string.
: ENDS? DUP >R 2OVER DUP R> - /STRING COMPARE 0= ;
primitive code = [p4_ends_Q]
IS-DIGIT ( char -- flag ) => [FORTH]
Test _char_ for digit [0-9].
: IS-DIGIT [CHAR] 0 - 10 U< ;
primitive code = [p4_is_digit]
IS-ALPHA ( char -- flag ) => [FORTH]
Test _char_ for alphabetic [A-Za-z].
: IS-ALPHA 32 OR [CHAR] a - 26 U< ;
primitive code = [p4_is_alpha]
IS-ALNUM ( char -- flag ) => [FORTH]
Test _char_ for alphanumeric [A-Za-z0-9].
: IS-ALNUM
DUP IS-ALPHA ORIF DUP IS-DIGIT THEN NIP ;
primitive code = [p4_is_alnum]
SPLIT-NEXT-LINE ( src . -- src' . str len ) => [FORTH]
Split the next line from the string.
: SPLIT-NEXT-LINE
2DUP #EOL-CHAR SCAN
DUP >R 1 /STRING 2SWAP R> - ;
FIXME: inform Neil Bawd that this is probably
not what he wanted. replace /STRING with /SPLIT here.
primitive code = [p4_split_next_line]
VIEW-NEXT-LINE ( src . str len -- src . str len str2 len2 ) => [FORTH]
Copy next line above current line.
: VIEW-NEXT-LINE
2OVER 2DUP #EOL-CHAR SCAN NIP - ;
primitive code = [p4_view_next_line]
NEXT-WORD ( -- str len ) => [FORTH]
Get the next word across line breaks as a character
string. _len_ will be 0 at end of file.
: NEXT-WORD
BEGIN BL WORD COUNT ( str len )
DUP IF EXIT THEN
REFILL
WHILE 2DROP ( ) REPEAT ;
primitive code = [p4_next_word]
LEXEME ( "name" -- str len ) => [FORTH]
Get the next word on the line as a character string.
If it's a single character, use it as the delimiter to
get a phrase.
: LEXEME
BL WORD ( addr) DUP C@ 1 =
IF CHAR+ C@ WORD THEN
COUNT ;
primitive code = [p4_lexeme]
H# ( "hexnumber" -- n ) => [FORTH]
Get the next word in the input stream as a hex
single-number literal. (Adopted from Open Firmware.)
: H# ( "hexnumber" -- n ) \ Simplified for easy porting.
0 0 BL WORD COUNT
BASE @ >R HEX >NUMBER R> BASE !
ABORT" Not Hex " 2DROP ( n)
STATE @ IF POSTPONE LITERAL THEN
; IMMEDIATE
immediate code = [p4_h_sh]
\\ ( "...<eof>" -- ) => [FORTH]
Ignore the rest of the input stream.
: \\ BEGIN -1 PARSE 2DROP REFILL 0= UNTIL ;
primitive code = [p4_backslash_backslash]
FILE-CHECK ( n -- ) => [FORTH]
Check for file access error.
\ : FILE-CHECK ( n -- ) THROW ;
: FILE-CHECK ( n -- ) ABORT" File Access Error " ;
primitive code = [p4_file_check]
MEMORY-CHECK ( n -- ) => [FORTH]
Check for memory allocation error.
\ : MEMORY-CHECK ( n -- ) THROW ;
: MEMORY-CHECK ( n -- ) ABORT" Memory Allocation Error " ;
primitive code = [p4_memory_check]
++ ( addr -- ) => [FORTH]
Increment the value at _addr_.
: ++ ( addr -- ) 1 SWAP +! ;
primitive code = [p4_plus_plus]
@+ ( addr -- addr' x ) => [FORTH]
Fetch the value _x_ from _addr_, and increment the address
by one cell.
: @+ ( addr -- addr' x ) DUP CELL+ SWAP @ ;
primitive code = [p4_fetch_plus_plus]
!+ ( addr x -- addr' ) => [FORTH]
Store the value _x_ into _addr_, and increment the address
by one cell.
: !+ ( addr x -- addr' ) OVER ! CELL+ ;
primitive code = [p4_store_plus_plus]
'th ( n "addr" -- &addr[n] ) => [FORTH]
Address `n CELLS addr +`.
: 'th ( n "addr" -- &addr[n] )
S" 2 LSHIFT " EVALUATE
BL WORD COUNT EVALUATE
S" + " EVALUATE
; IMMEDIATE
compiling word = [p4_tick_th]
(.) => [FORTH]
(no description)
primitive code = [p4_paren_dot]
CELL- ( addr -- addr' ) => [FORTH]
Decrement address by one cell
: CELL- ( addr -- addr' ) CELL - ;
primitive code = [p4_cell_minus]
EMITS ( n char -- ) => [FORTH]
Emit _char_ _n_ times.
: EMITS ( n char -- )
SWAP 0 ?DO DUP EMIT LOOP DROP ;
also compare
: SPACES BL EMITS ;
: SPACE BL EMIT ;
primitive code = [p4_emits]
HIWORD ( xxyy -- xx ) => [FORTH]
The high half of the value.
: HIWORD ( xxyy -- xx ) 16 RSHIFT ;
primitive code = [p4_hiword]
LOWORD ( xxyy -- yy ) => [FORTH]
The low half of the value.
: LOWORD ( xxyy -- yy ) 65535 AND ;
primitive code = [p4_loword]
REWIND-FILE ( file-id -- ior ) => [FORTH]
Rewind the file.
: REWIND-FILE ( file-id -- ior )
0 0 ROT REPOSITION-FILE ;
primitive code = [p4_rewind_file]
TOOLS
Programming-Tools (without ASSEMBLER)
.S ( -- ) => "[ANS] FORTH"
print the stack content in vertical nice format.
tries to show cell-stack and float-stack side-by-side,
Depending on configuration,
there are two parameter stacks: for integers and for
floating point operations. If both stacks are empty, .S
will display the message <stacks empty> .
If only the floating point stack is empty, .S displays
the integer stack items in one column, one item per line,
both in hex and in decimal like this (the first item is topmost):
12345 HEX 67890 .S
424080 [00067890]
12345 [00003039] ok
If both stacks ar not empty, => .S displays both stacks, in two
columns, one item per line
HEX 123456.78E90 ok
DECIMAL 123456.78E90 .S
291 [00000123] 1.234568E+95
1164414608 [45678E90] ok
Confusing example? Remember that floating point input only works
when the BASE number is DECIMAL . The first number looks like
a floating point but it is a goodhex double integer too - the number
base is HEX . Thus it is accepted as a hex number. Second try
with a decimal base will input the floating point number.
If only the integer stack is empty, => .S shows two columns, but
he first columns is called <stack empty>, and the
second column is the floating point stack, topmost item first.
primitive code = [p4_dot_s]
DUMP ( addr len -- ) => "[ANS] FORTH"
show a hex-dump of the given area, if it's more than a screenful
it will ask using => ?CR
You can easily cause a segmentation fault of something like that
by accessing memory that does not belong to the pfe-process.
primitive code = [p4_dump]
SEE ( "word" -- ) => "[ANS] FORTH"
decompile word - tries to show it in re-compilable form.
(SEE) tries to display the word as a reasonable indented
source text. If you defined your own control structures or
use extended control-flow patterns, the indentation may be
suboptimal.
simulate:
: SEE [COMPILE] ' (SEE) ;
primitive code = [p4_see]
WORDS ( -- ) => "[ANS] FORTH"
uses CONTEXT and lists the words defined in that vocabulary.
usually the vocabulary to list is named directly in before.
example:
FORTH WORDS or LOADED WORDS
primitive code = [p4_words]
AHEAD ( -- DP-mark ORIG-magic ) compile-only => "[ANS] FORTH"
simulate:
: AHEAD BRANCH MARK> (ORIG#) ;
compiling word = [p4_new_ahead]
BYE ( -- ) no-return => "[ANS] FORTH"
should quit the forth environment completly
primitive code = [p4_bye]
CS-PICK ( 2a 2b 2c ... n -- 2a 2b 2c ... 2a ) => "[ANS] FORTH"
pick a value in the compilation-stack - note that the compilation
stack _can_ be seperate in some forth-implemenations. In PFE
the parameter-stack is used in a double-cell fashion, so CS-PICK
would 2PICK a DP-mark and a COMP-magic, see PICK
primitive code = [p4_cs_pick]
CS-ROLL ( 2a 2b 2c ... n -- 2b 2c ... 2a ) => "[ANS] FORTH"
roll a value in the compilation-stack - note that the compilation
stack _can_ be seperate in some forth-implemenations. In PFE
the parameter-stack is used in a double-cell fashion, so CS-ROLL
would 2ROLL a DP-mark and a COMP-magic, see ROLL
primitive code = [p4_cs_roll]
FORGET ( "word" -- ) => "[ANS] FORTH"
simulate:
: FORGET [COMPILE] ' >NAME (FORGET) ; IMMEDIATE
primitive code = [p4_forget]
[ELSE] ( -- ) => "[ANS] FORTH"
eat up everything upto and including the next [THEN]. count
nested [IF] ... [THEN] constructs. see [IF]
this word provides a simple pre-compiler mechanism
immediate code = [p4_bracket_else]
[IF] ( flag -- ) => "[ANS] FORTH"
check the condition in the CS-STACK. If true let the following
text flow into INTERPRET , otherwise eat up everything upto
and including the next [ELSE] or [THEN] . In case of
skipping, count nested [IF] ... [THEN] constructs.
this word provides a simple pre-compiler mechanism
immediate code = [p4_bracket_if]
[THEN] => "[ANS] FORTH"
(no description)
immediate code = [p4_noop]
? ( addr -- ) => "[ANS] FORTH"
Display the (integer) content of at address addr.
This word is sensitive to BASE
simulate:
: ? @ . ;
primitive code = [p4_question]
CODE ( "name" -- ) => "[ANS] FORTH"
call ALSO and add ASSEMBLER wordlist if available. Add PROC ENTER
assembler snippet as needed for the architecture into the PFA. The
CFA is setup (a) with the PFA adress in traditional ITC or (b)
with an infoblock as for sbr-coded colon words.
Remember that not all architectures are support and that the
ASSEMBLER wordset is not compiled into pfe by default. Use always
the corresponding END-CODE for each CODE start. The new
word name is not smudged.
primitive code = [p4_create_code]
;CODE ( -- ) => "[ANS] FORTH"
Does end the latest word (being usually some DOES> part) and enters
machine-level (in EXEC-mode).
BE AWARE:
The TOOLS-EXT will not provide an END-CODE or any other word in the
ASSEMBLER wordlist which is required to start any useful assembler
programming. After requiring ASSEMBLER-EXT you will see a second ";CODE"
in the EXTENSIONS wordlist that will also provide an optimized execution
than the result of this standard-forth implemenation.
The Standard-Forth implementation will actually compile a derivate of
BRANCH into the dictionary followed by ; . The compiled word
will not jump to the target adress (following the execution token)
but it will call the target adress via the host C stack. The target
machine level word (C domain) will just return here for being
returned (Forth domain). Hence END-CODE may be a simple RET, comma!
compiling word = [p4_semicolon_code]
END-CODE ( "name" -- ) => "ASSEMBLER"
call PREVIOUS and add PROC LEAVE assembler snippet as needed
for the architecture - usually includes bits to "return from
subroutine". Remember that not all architectures are support and
PFE usually does only do variants of call-threading with a separate
loop for the inner interpreter that does "call into subroutine".
Some forth implementations do "jump into routine" and the PROC
LEAVE part would do "jump to next routine" also known as
next-threading. The sbr-call-threading is usually similar to the
native subroutine-coding of the host operating system. See CODE
primitive code = [p4_end_code]
TOOLS-Misc
Compatibility words
VLIST ( -- ) => [FORTH]
The VLIST command had been present in FIG and other forth
implementations. It has to list all accessible words. In PFE
it list all words in the search order. Well, the point is,
that we do really just look into the search order and are
then calling WORDS on that Wordl. That way you can see
all accessible words in the order they might be found.
Uses => ?CR
primitive code = [p4_vlist]
!CSP ( -- ) => [FORTH]
put SP into CSP
used in control-words
primitive code = [p4_store_csp]
?CSP ( -- ) => [FORTH]
check that SP == CSP otherwise THROW
used in control-words
primitive code = [p4_Q_csp]
CS-SWAP => [FORTH]
(no description)
primitive code = [p4_two_swap]
CS-DROP => [FORTH]
(no description)
primitive code = [p4_two_drop]
?COMP ( -- ) => [FORTH]
check that the current STATE is compiling
otherwise THROW
often used in control-words
primitive code = [p4_Q_comp]
?EXEC ( -- ) => [FORTH]
check that the current STATE is executing
otherwise THROW
often used in control-words
primitive code = [p4_Q_exec]
?FILE ( file-id -- ) => [FORTH]
check the file-id otherwise (fixme)
primitive code = [p4_Q_file]
?LOADING ( -- ) => [FORTH]
check that the currently interpreted text is
from a file/block, otherwise THROW
primitive code = [p4_Q_loading]
?PAIRS ( a b -- ) => [FORTH]
if compiling, check that the two magics on
the CS-STACK are identical, otherwise throw
used in control-words
primitive code = [p4_Q_pairs]
?STACK ( -- ) => [FORTH]
check all stacks for underflow and overflow conditions,
and if such an error condition is detected THROW
primitive code = [p4_Q_stack]
DEFINED ( "name" -- flag ) => [FORTH]
Search the dictionary for _name_. If _name_ is found,
return TRUE; otherwise return FALSE. Immediate for use in
definitions.
This word will actually return what FIND returns (the NFA).
does check for the word using find (so it does not throw like ' )
and puts it on stack. As it is immediate it does work in compile-mode
too, so it places its argument in the cs-stack then. This is most
useful with a directly following [IF] clause, so that sth. like
an [IFDEF] word can be simulated through [DEFINED] word [IF]
: DEFINED BL WORD COUNT (FIND-NFA) ;
primitive code = [p4_defined]
[DEFINED] ( "name" -- flag ) => [FORTH]
Search the dictionary for _name_. If _name_ is found,
return TRUE; otherwise return FALSE. Immediate for use in
definitions.
[DEFINED] word ( -- nfa|0 ) immediate
does check for the word using find (so it does not throw like ' )
and puts it on stack. As it is immediate it does work in compile-mode
too, so it places its argument in the cs-stack then. This is most
useful with a directly following [IF] clause, so that sth. like
an [IFDEF] word can be simulated through [DEFINED] word [IF]
: [DEFINED] BL WORD FIND NIP ; IMMEDIATE
immediate code = [p4_defined]
[UNDEFINED] ( "name" -- flag ) => [FORTH]
Search the dictionary for _name_. If _name_ is found,
return FALSE; otherwise return TRUE. Immediate for use in
definitions.
see [DEFINED]
immediate code = [p4_undefined]
(FORGET) => "EXTENSIONS"
(no description)
primitive code = [p4_paren_forget]
(DICTLIMIT) => "EXTENSIONS"
(no description)
primitive code = [p4_paren_dictlimit]
(DICTFENCE) => "EXTENSIONS"
(no description)
primitive code = [p4_paren_dictfence]
Useful
kernel extensions
_like:COMPILE, => "EXTENSIONS"
(no description)
primitive code = [p4_to_compile]
($ ( [word] -- cs-token ) compile-only => "EXTENSIONS"
takes the execution token of the following word and
saves it on the compile-stack. The correspondig closing
) will then feed it into >COMPILE - so this pair
of word provides you with a prefix-operation syntax
that you may have been seen in lisp-like languages.
($ IF ($ 0= A1 @ )) ($ THEN ." hello " )
Note that an opening simple ( paren is a comment.
immediate code = [p4_prefix_begin]
) ( cs-token -- ) => "EXTENSIONS"
takes the execution-token from ($ and compiles
it using >COMPILE
immediate code = [p4_prefix_end]
PFE-PRINTF ( args ... format$ -- ) => "EXTENSIONS"
uses SPRINTF to print to a temporary 256-char buffer
and prints it to stdout afterwards. See the example
at SPRINTF of what it does internally.
primitive code = [p4_printf]
PFE-SPRINTF ( args ... format$ dest$ -- len-dest ) => "EXTENSIONS"
just like the standard sprintf() function in C, but
the format is a counted string and accepts %#s to
be the format-symbol for a forth-counted string.
The result is a zeroterminated string at dest$ having
a length being returned. To create a forth-counted
string, you could use:
variable A 256 ALLOT
15 " example" " the %#s value is %i" A 1+ SPRINTF A C!
A COUNT TYPE
primitive code = [p4_sprintf]
LOADF ( "filename" -- ) => "EXTENSIONS"
loads a file just like INCLUDE but does also put
a MARKER in the LOADED dictionary that you can
do a FORGET on to kill everything being loaded
from that file.
primitive code = [p4_loadf]
DOER ( word -- ) => "EXTENSIONS"
In PFE it is a synonym to DEFER which a semistandard word.
Unlike DEFER , the DOER -vector was set with an a small
piece of code between MAKE and ;AND . The "DOER"-word
should be replaced with DEFER IS , which is easy since
the DEFER and DOER point to the same internal runtime.
primitive code = [p4_defer]
MAKE ( [word] -- ) ... ;AND => "EXTENSIONS"
make a seperated piece of code between MAKE and ;AND
and on execution of the MAKE the named word is twisted
to point to this piece of code. The word is usually
a DOER but the current implementation works
on DEFER just as well, just as it does on other words who
expect to find an execution-token in its PFA. You could even
create a colon-word that starts with NOOP and can then make
that colon-word be prefixed with the execution of the code piece.
This MAKE
does even work on LOCALS| and VAR but it is uncertain
what that is good for.
compiling word = [p4_make]
;AND ( -- ) => "EXTENSIONS"
For the code piece between MAKE and ;AND , this word
will do just an EXIT . For the code outside of
the MAKE construct a branch-around must be resolved then.
compiling word = [p4_semicolon_and]
[NOT] ( a -- a' ) => "EXTENSIONS"
executes 0= but this word is immediate so that it does
affect the cs-stack while compiling rather than compiling
anything. This is useful just before words like [IF] to
provide semantics of an [IFNOT] . It is most useful in
conjunction with "=> [DEFINED] word" as it the sequence
"[DEFINED] word [NOT] [IF] " can simulate "[IFNOTDEF] word "
immediate code = [p4_bracket_not]
+FIELD: ( offset "name" -- offset ) => "EXTENSIONS"
created a new name with an OFFSET-RT runtime using the given offset.
Leave the offset-value untouched, so it can be modified with words
like CHAR+ and CELL+ and SFLOAT+ ; This word is the simplest way
to declared structure access words in forth - the two STRUCT modules
contain a more elaborate series of words. Use this one like:
0 ( a fresh definition is started )
+FIELD: zapp.a+ CHAR+ ( zero offset from the base of the struct )
+FIELD: zapp.b+ CELL+ ( no alignment, starts off at 1 from base )
+FIELD: zapp+ DROP ( store size of complete zap structure )
0 zapp+ ( extend the zap structure )
+FIELD: zappx.c+ CELL+ ( a new field )
+FIELD: zappx+ DROP ( and save it again )
CREATE zapp1 0 zapp+ ALLOT ( a way to allocate a strucutre )
zapp2 zapp.b+ @ ( read a value from the field )
16 zapp2 zapp.b+ ! ( store a value in there )
this form is not the traditional form used in forth, it is however
quite simple. Use the simplefield declaration with /FIELD to
be compatible with traditional styles that build on top of sizeof
constants in forth (which are not part of the ANS Forth standard).
primitive code = [p4_plus_field]
/FIELD ( offset size "name" -- offset+size ) => "EXTENSIONS"
created a new +FIELD name with an OFFSET-RT
of offset. Then add the size value to the offset so that
the next /FIELD declaration will start at the end of the
field currently declared. This word is the simplest way to
declared structure access words in forth - the two STRUCT modules
contain a more elaborate series of words. This one is used like:
0 ( a fresh definition is started )
/CHAR /FIELD ->zapp.a ( zero offset from the base of the struct )
/CELL /FIELD ->zapp.b ( no alignment, starts off at 1 from base )
CONSTANT /zapp ( store size of complete zap structure )
/zapp ( extend the zap structure )
/CELL /FIELD ->zappx.c ( a new field )
CONSTANT /zappx ( and save it again )
CREATE zapp1 /zapp ALLOT ( a way to allocate a strucutre )
/zapp BUFFER: zapp2 ( another way to do it, semi-standard )
zapp2 ->zapp.b @ ( read a value from the field )
16 zapp2 ->zapp.b ! ( store a value in there )
compare also with /CHAR /WCHAR /CELL /DCELL
and use +FIELD as the lowlevel word, can simulate as
: /FIELD SWAP +FIELD + ;
primitive code = [p4_slash_field]
REPLACE-IN ( to-xt from-xt n "name" -- ) => "EXTENSIONS"
will handle the body of the named word as a sequence of cells (or tokens)
and replaces the n'th occurences of from-xt into to-xt. A negative value
will change all occurences. A zero value will not change any.
primitive code = [p4_replace_in]
(LOADF-LOCATE) ( xt -- nfa ) => "EXTENSIONS"
the implementation of LOADF-LOCATE
primitive code = [p4_paren_loadf_locate]
LOADF-LOCATE ( "name" -- ) => "EXTENSIONS"
look for the filename created by LOADF that had been
defining the given name. LOADF has created a marker
that is above the INCLUDED file and that
marker has a body-value just below the
INCLUDED file. Hence the symbol was defined during
LOADF execution of that file.
: LOADF-LOCATE ?EXEC POSTPONE ' (LOADF-LOCATE) .NAME ;
primitive code = [p4_loadf_locate]
X" ( "hex-q" -- bstring ) => "EXTENSIONS"
places a counted string on stack
containing bytes specified by hex-string
- the hex string may contain spaces which will delimit the bytes
example:
X" 41 42 4344" COUNT TYPE ( shows ABCD )
compiling word = [p4_x_quote]
EVALUATE-WITH ( i*x addr len xt[i*x--j*x] -- j*x ) => "EXTENSIONS"
added to be visible on the forth command line on request by MLG,
he has explained the usage before a lot, you can get an idea from:
: EVALUATE ['] INTERPRET EVALUATE-WITH ;
The word is used internally in PFE for the loadlist evaluation of
the binary modules: where previously each loadercode had its own
CREATE-execution we do now call the original forthish CREATE-word
like, so bootstrapping a VARIABLE will now call VARIABLE itself
and of course we need to set up the TIB-area to point to the name
of the variable that shall be created in the forth dictionary:
: LOAD-WORD ( arg-value str-ptr str-len loader-code -- )
CASE
#LOAD-VARIABLE OF ['] VARIABLE EVALUATE-WITH ENDOF
....
ENDCASE
CLEARSTACK
;
primitive code = [p4_evaluate_with]
[POSSIBLY] ( [name] -- ?? ) => "EXTENSIONS"
check if the name exists, and execute it immediatly
if found. Derived from POSSIBLY as seen in other forth systems.
: [POSSIBLY] (') ?DUP IF EXECUTE THEN ; IMMEDIATE
immediate code = [p4_bracket_possibly]
[VOCABULARY] ( "name" -- ) => "EXTENSIONS"
create an immediate vocabulary. Provides for basic
modularization.
: [VOCABULARY] VOCABULARY IMMEDIATE ;
primitive code = [p4_bracket_vocabulary]
[DEF] ( -- ) => "EXTENSIONS"
immediatly set topmost CONTEXT voc to CURRENT compilation voc.
: DEF' CURRENT @ CONTEXT ! ; IMMEDIATE
note that in PFE most basic vocabularies are immediate, so that
you can use a sequence of
FORTH ALSO DEFINITIONS
[DEF] : GET-FIND-3 [ANS] ['] FIND [FIG] ['] FIND [DEF] ['] FIND ;
where the first wordlist to be searched via the search order are
[ANS] and [FIG] and FORTH (in this order) and which may or may not
yield different flavours of the FIND routine (i.e. different XTs)
immediate code = [p4_bracket_def]
CONTEXT? ( -- number ) => "EXTENSIONS"
GET-CONTEXT and count how many times it is in the order but
the CONTEXT variable itself. The returned number is therefore
minus one the occurences in the complete search-order.
usage:
ALSO EXTENSIONS CONTEXT? [IF] PREVIOUS [THEN]
ALSO DEF' DEFAULT-ORDER
: CONTEXT?
0 LVALUE _count
GET-ORDER 1- SWAP LVALUE _context
0 ?DO _context = IF 1 +TO _count THEN LOOP
_count
;
primitive code = [p4_context_Q]
CASE-SENSITIVE-VOC ( -- ) => "EXTENSIONS"
accesses CONTEXT which is generally the last named VOCABULARY .
sets a flag in the vocabulary-definition so that words are matched
case-sensitive.
example:
VOCABULARY MY-VOC MY-VOC CASE-SENSITIVE-VOC
OBSOLETE! use DEFS-ARE-CASE-SENSITIVE
primitive code = [p4_case_sensitive_voc]
DEFS-ARE-CASE-SENSITIVE ( -- ) => "EXTENSIONS"
accesses CURRENT which is generally the last wordlist that the
DEFINITIONS shall go in. sets there a flag in the vocabulary-definition
so that words are matched case-sensitive.
example:
VOCABULARY MY-VOC MY-VOC DEFINITIONS DEFS-ARE-CASE-SENSITIVE
primitive code = [p4_defs_are_case_sensitive]
DEFS-ARE-SEARCHED-ALSO ( -- ) => "EXTENSIONS"
binds CONTEXT with CURRENT . If the CURRENT VOCABULARY is in
the search-order (later), then the CONTEXT vocabulary will
be searched also. If the result of this word could lead into
a recursive lookup with FIND it will throw CURRENT_DELETED
and leave the CURRENT VOCABULARY unaltered.
example:
MY-VOC DEFINITIONS MY-VOC-PRIVATE DEFS-ARE-SEARCHED-ALSO
primitive code = [p4_defs_are_searched_also]
WITH-SPY
kernel extension
SPY-EXIT ( -- ) => "EXTENSIONS"
will unnest the current colon-word so it will actually
return the word calling it. This can be found in the
middle of a colon-sequence between : and ;
primitive code = [p4_spy_exit]
;SPY ( -- ) => "EXTENSIONS"
compiles ((;)) which does EXIT the current
colon-definition. It does then end compile-mode
and returns to execute-mode. See : and :NONAME
compiling word = [p4_spy_semicolon]
SPY_ON ( -- ) => "EXTENSIONS"
change the runtime-code of (NEST)
to call a special word that prints info
to the screen whenever a colon word is
entered. It will print the name and
the current stack, and results in a kind
of execution trace over SPY' : -colon nested
words.
primitive code = [p4_spy_on]
SPY_OFF ( -- ) => "EXTENSIONS"
disable SPY_ON nest-trace.
primitive code = [p4_spy_off]
YOUR
kernel extensions
@> ( [name] -- value ) => "EXTENSIONS"
does fetch the value from the PFA of the named item, which
may be about everything, including a VARIABLE , VALUE
LVALUE , LOCALS| , VAR , DEFER , DOER , DOES>
and more.
compiling word = [p4_fetch_from]
'> ( [name] -- xt ) => "EXTENSIONS"
get the execution-token, ie the CFA, of the word following.
This word is fully state-smart while the ANSI standard words
namely ' and ['] are not.
compiling word = [p4_tick_from]
INTO ( [name] -- pfa ) => "EXTENSIONS"
will return the parameter-field address of the following word.
Unlike others, this word will also return the address of
LOCALS| and local LVALUE - so in fact a TO A and
INTO A ! are the same. This word is most useful when calling
C-exported function with a temporary local-VAR as a return-place
argument - so the address of a local has to be given as an arg.
Beware that you should not try to save the address anywhere else,
since a local's address does always depend of the RP-depth -
EXIT from a colon-word and the value may soon get overwritten.
(see also TO )
compiling word = [p4_into]
.H2 ( value -- ) => "EXTENSIONS"
print hexadecimal, but with per-byte 0-padding
0x0 -> 00
0xf -> 0f
0x12 -> 12
0x123 -> 0123
0x1234 -> 1234
0x12345 -> 012345
primitive code = [p4_dot_h2]
HERE-WORD ( char "name<char>" -- ) => "EXTENSIONS"
a FIG-compatible WORD. Where ANSI says "skip leading delimiters"
this one acts as "skip leading whitespace". And it will not return
anything and have the string parsed to HERE
primitive code = [p4_here_word]
ZCHAR-EXT
- zero-terminated C-like charstrings
Z" ( [chars<">] -- z* ) => [FORTH]
scan the input to the next doublequote and create a buffer
that holds the chars - return the address of that zero-terminated
string-buffer, either POCKET-PAD or ALLOT ed into the dictionary.
compiling word = [p4_z_quote]
ZCOUNT ( z* -- z* len ) => [FORTH]
push length of z-string, additionally to the string addr itself.
: ZSTRLEN ZCOUNT NIP ;
(see libc strlen(3)) / compare with COUNT / ZSTRLEN
primitive code = [p4_zcount]
ZSTRLEN ( z* -- len ) => [FORTH]
push length of z-string.
: ZSTRLEN ZCOUNT NIP ;
(see libc strlen(3)) / compare with ZMOVE / CMOVE
primitive code = [p4_zstrlen]
ZMOVE ( zsrc* zdest* -- ) => [FORTH]
copy a zero terminated string
(see libc strcpy(3)) / compare with ZSTRLEN / COUNT
primitive code = [p4_zmove]
ZPLACE ( addr* len zaddr* -- ) => [FORTH]
copy string and place as 0 terminated
(see libc strncpy(3)) / see also +ZPLACE / Z+PLACE
primitive code = [p4_zplace]
+ZPLACE ( caddr* u zdest* -- ) => [FORTH]
Add the string defined by CADDR LEN to the zero terminated string
at ZDEST - (for older scripts the SYNONYM named APPENDZ exists)
(see libc strncat(3)) / compare with ZPLACE / +PLACE
primitive code = [p4_appendz]
S\" ( [backslashed-strings_<">] -- str cnt ) => [FORTH]
scan the following text to create a literal just
like S" does, but backslashes can be used to
escape special chars. The rules for the backslashes
follow C literals, implemented techniques are
\n \r \b \a \f \v \e \777
and all non-alnum chars represent themselves, esp.
\" \' \ \? \! \% \( \) \[ \] \{ \} etcetera.
most importantly the doublequote itself can be escaped.
but be also informed that the usage of \' and \" is not
portable as some systems preferred to map [\'] into ["].
Here I use the experimental addition to map [\q] to ["] and [\i] to [']
compiling word = [p4_s_backslash_quote]
C\" ( [backslashed-strings_<">] -- bstr* ) => [FORTH]
scan the following text to create a literal just
like C" does, but backslashes can be used to
escape special chars. The rules for the backslashes
follow C literals, implemented techniques are
\n \r \b \a \f \v \e \777
and all non-alnum chars represent themselves, esp.
\" \' \ \? \! \% \( \) \[ \] \{ \} etcetera.
most importantly the doublequote itself can be escaped.
but be also informed that the usage of \' and \" is not
portable as some systems preferred to map [\'] into ["].
Here I use the experimental addition to map [\q] to ["] and [\i] to [']
compiling word = [p4_c_backslash_quote]
Z\" ( [backslashed-strings_<">] -- zstr* ) => [FORTH]
scan the following text to create a literal just
like Z" does, but backslashes can be used to
escape special chars. The rules for the backslashes
follow C literals, implemented techniques are
\n \r \b \a \f \v \e \777
and all non-alnum chars represent themselves, esp.
\" \' \ \? \! \% \( \) \[ \] \{ \} etcetera.
most importantly the doublequote itself can be escaped
but be also informed that the usage of \' and \" is not
portable as some systems preferred to map [\'] into ["].
Here I use the experimental addition to map [\q] to ["] and [\i] to [']
compiling word = [p4_z_backslash_quote]
|