* ---------------------------------------------------------------------------- *
*                                                                              *
*          flp1_forth_asm - .hpr'93 - (glossary)                               *
*          extended f.i.g.-forth system, based on laurence reeves' "QF"        *
*          for the Sinclair QL, rom-ver. JM, JS, MGG, Minerva 1.93, QXL        *
*                                                                              *
*          h.-peter recktenwald, albestr. 21, d-12159 berlin                   *
*          t.: ++49 30 8520413  e-mail: phpr@berlin.snafu.de                   *
*                                                                              *
*          v1.0 * 24.3.93       * 64K codespace extended                       *
*          v2.0 * 15.6.93       * debugging & °P-exceptions                    *
*          v3.0 * 17.7.93       * library load, bugs fixed                     *
*          v4.0 *  4.8.93       * extd. debugging, compatibility               *
*          v7.1 *  8.8.94       * longword system addressing, qxl-adaptation   *
*          v7.2 *  1.1.95       * 2ndary job for <break> & safety, locals      *
*          v8.0 *  1.7.95       * version for public distribution              *
*          v8.07  14.8.96       * GNU version, bugs fixed                      *
*                                                                              *
* ------------------------------ copyright ----------------------------------- *

  - Copyright (C) 1996 by H.-Peter Recktenwald, D-12159 Berlin, Albestr. 21 -

  - GARANTIE f‡r irgendwas GIBT ES NICHT.
  - WARRANTY there simply IS NONE.

  - Ausf‡hrliche & aktuelle deutschsprachige Beschreibung in "F6WORDS_txt"

* ---------------------------------------------------------------------------- *

   Pse, bear in mind that english is not the authors native language, which
   accidentally might cause misunderstandings, mainly when it comes to the
   precise descriptions of some facts. Whenever in doubt, ask the author, or,
   at least, thoroughly test before using a not fully understood feature.

* ------------------------- started 01.03.1993 ------------------------------- *

  This description applies to the 1st 'public' versions 6.xx of F6 and more or
  less occasionally is extended by some remarks concerning the newer versions.
  For the more recent and much enhanced ones re "F6CHG_txt" and "F6WORDS_txt".

* ---------------------------------------------------------------------------- *

F6 is an experimental f.i.g.-style forth system.

"experimental" in so far it may not be one of the fastest forth systems, it
certainly will be a most error proof ram resident system, though, suitable
to extensively playing around by the unexperienced user who likes to learn
forth by experimentally programming. - Nevertheless, this system has been
successfully used to efficiently solve quite big tasks, thus it is much more
than just an experiment...

Another most important goal was to get independent of the still developing
conditions and restrictions of the different new QDOS style OS versions.
The F6 system enables identical programming with ALL those versions known to
the author, which are JM, JS, MGG, MINERVA (1.93), Atari-QL (e.32) and even
the old SMSQs of the qxl-card (2.16...2.57) and SMSQ/E (currently 2.75).

Speed compared to safety matters much less if it is taken into account how
long it needs e.g. to recover data lost due to a simple error like entering
an odd address and the system responding with a complete breakdown. The very
few seconds gained by aligned addressing are nothing compared to the many
hours needed to recover lost data. Such thaughts were the reason to designing
the F6 system as safe as possible, while considering the excution speed less
important. Despite, recent tests proved it being about 25 times faster than
Basic in a Minerva and Gold Card equipped standard QL.

Also, while maintaining the well defined structures of the f.i.g. forth, in
combination with some of the (remarkably few) sensical concepts of the more
recent standards, and still being compatible, it introduces powerful new con-
cepts described below; full access to qdos and hardware facilities inclusive,
plus the pointer i.f. routines and a few selected calls of the thing and hotkey
systems.
The system is fully documented with no hidden nor tricky details, and with all
sources supplied, ready to (re-)assemble with the quanta gst macro assembler;
thus being open to the user and any kind of modification.
A 680xx assembler (currently for the 68000 and 68008 only) is also availiable,
and an extension to run forth words as independent qdos jobs.

There is nor would be no comprehensive Forth "tutorial" as many such literature
already exists. Where the most instructive books seem to me these two, written
by Ronald Zech:
        "Die Programmiersprache Forth", 1983, Franzis Verlag, M‡nchen,
and,
        "Forth 83", 1984, Franzis.
There is also an englisch book available, "Professional Forth Programming",
which I don't know, but assume it as highly instructive as the above ones.

Both of which are not a beginners guide in the sense of a description of how to
plug the mains connector in, setting up your tv set, or explaining what an ascii
code is. The 'fundamentals' are assumed to be known - and the contents of these
books to the explantions to follow. All of which plus some knowledge of the qdos
system should enable you to using the system to its full capabilities.

It has been tried to make this system as safe as possible to ease 'going forth'
for the novice. Despite no code nor memory extensions are needed generally,
the TK2 will be helpful - and necessary for certain actions. The same applies
to the 'Pointer I.F.'. The system was tested with JM, JS, MGG & MINERVA 1.93
roms and the Gold Card, it did also work with the atari-QL-emulator (e.32).
JM has been tested compiling the editor, which then worked well. Operations
relying on the JS+ extended window definition block wouldn't work, though.


* ------------------------------ contents ------------------------------------ *

        0.      * --- notation
        1.      * --- glossary
                vocabularies
                compiler words
                defining words
                error handling & system safety
                dictionary, {forget}ting words
                system
                text / io
                number conversion and i/o
                stack data and associated operations
                integer arithmetic & cons
                f.p. defining, arithmetic & cons
                system constants
                user variables
                memory
                qdos trap operations
                   device allocation (trap #2)
                   processor mode    (trap #0, safe emulation)
                   system managing   (trap #1)
                   i/o-operations    (trap #3)
                pointer-i.f. definitions (and hotkey-buffer)
                processor mode, vector-call
                file / virtual memory / interpreting
                structures
                timing
                extras (experimental)
        2.      * --- compiling (loading) selectively from a library file
                the editor
        3.      * --- 4th different standards reference
        4.      * --- environmental dependency, system compatibility
                why the f.i.g.-standard was taken
        5.      * --- how to use some of the more special features
                system safety, trap redirection
                qdos
                words type (immediate or not, etc.)
                arithmetic (floored), logic, quad numbers (64-bit)
                runtime optimization
                multiway decision - ASSOCIATIVE CASE RANGE
                deferred words safety with forget
                vocabulary search
                forgetting action
                program security, initial loading/executing
                hi-/lo-level mix
                channels
                programmed interpreting
                local variables - STACK LOCAL
                conditional compiling
                debugging
                a word on character strings
        6.      * --- system information
                F6 system versions
                standard word and vocabulary headers
                assembly characteristics
                deferred control chars execution

* ------------------------------- notation ----------------------------------- *

4th-word names appear surrounded by curly brackets throughout this text.
A comprehensive list with regard to the latest F6 version can be found in
"F6WORDS_txt".

* preferred use of names:
?{name}         abort (with an error message) if a condition is not met
{name}?         print some information and/or execute conditionally
-{name}         execute if a condition is met
.{name}         output to screen
;{name}         terminate a secondary (part of a definition)
{(name)}        runtime executive or vector
{name[}         word enters the executing state
{name:}         defining word

{names} may not contain the <nul> char. nor <bl> - and don't 160 < char < 256.
        To prevent the system getting stuck the latter will be filtered out
        by zeroeing the high bit when {create}ing a standard word header.
{bl}    is the standard delimiter
ascii <nul> the unconditonal delimiter (and 4th-word) which under no circum-
        stances can be overridden.
        Also the forth word to fetch the next portion of the input stream.

* a few forth specific termini:
hi-level words
         or 'secondaries', are defined in terms of forth words.
lo-level words
         or 'primitives', are defined by executable code of the host processor.

nfa      namefield address, where the name of a forth words starts, may be odd;
         the 1st byte contains the word names count (bits 0..4) and some flags:
precedence bit
         when set depicts an immediate word, bit #6 = 1 at nfa
smudge bit
         clearance for execution when definition completed, bit #5 = 0 at nfa
lfa      linkfield a., ptr to the preceding words lfa of the same vocabulary
cfa      codefield a., ptr to executable code which determines the pfa useage
pfa      parameterfield a., contains any kind of data, executable code, or wa's
wa       word address fetched from a parameterfield, the called words cfa

[ip]     instruction ptr, the forth program counter, A4 in the F6 system
[rp]     return stack ptr, as in any (usual) processor, reg A7
[dp]     data stack ptr, a special (not only) forth asset, reg A5
[up]     [bp]-relative ptr into user area, reg D7
[w]      word ptr, the ptr where the current wa was fetched from, reg A2,
         incremented by the size of one cell (two bytes in this system)
[t]      temporary storage register, A1 in this system, to calculate
         the true address of executable code to jump to.

* notation & abbreviations:
(n.i.)          not implemented / not used
f1              fp-number
c1 n1 dn1 qn1   signed byte-value / single / double / qadruple length numbers
uc1 un1 ...     full range unsigned ...
+c1 +n1 +d1 +q1 valid operations only when top bit unset
8b 16b 32b 64b  bitwise
f ff tf         flag / false flag (0) / true flag (1) [ not the f83-style -1 ]
ptr             pointer to a 4th-location (rel to the base register A6)
true address    a double length true memory address
4th address     a (double length) memory address rel to the 4th-codebase
cell            the even aligned address space of a (16-bit) data item
sys:            compiler data on stack while compiling
tos             top of data-stack
cons 2cons fcons constant / double cell constant / f.p.-constant
voc             vocabulary
{...}           ... representing a 4th-name
:=>             initially defined 2nd search order
(I)             immediate
(C)             compiling only
(D)             deferred
(F)             cons/vari which may be defaulted, and restored by {default-is}
(r) (h) (q) (f) word belongs to the root, hidden, qdos, fp vocabulary
(e) (p) (m) (l) word belongs to the editor, pif, minerva, local vocabulary

Any address or memory pointer may be odd if not stated otherwise.
New words will be compiled such that from the LFA on the cell boundaries are
at even aligned addresses, i.e. NFAs may be odd, depending on previous HERE.

Unless stated the words belong to the forth vocabulary (fth) and are not
immediate and not restricted to either, compiling or executing state; the
predefined vocabularies, though, are immediate by convention, according
to the f.i.g. standard, and their most frequent (and sensical) use.

* ------------------------------- glossary ----------------------------------- *

{4th-name}  vocabulary/parameters/use

*** vocabularies

* initial current and context vocs are forth
root           :=> »
forth          :=> »
hidden         :=> forth
qdos           :=> pif
fp             :=> qdos
editor         :=> forth
pif         (q):=> forth
minerva        :=> fp
asm68       (r):=>        for the assembler, initial action of {assembler}

also        (r)(I)push the current voc to the search order stack
only        (r)(I)reset the search order to {root} only
search      (r)(I)set 2nd order searching to context-voc, use: search {name}
previous    (r)(I)drop the latest voc. from the search order stack
rvoc        (r)(I)restore context to the previous context voc.

latest         (-- nn) nfa of the last word in the context vocabulary
last           (-- ptr)vari, stores the nfa of the very last word in
               the dictionary regardless of the vocabularies

definitions    (--) current becomes context
prevdef        (--) restore previous context (one level only)

*** compiler

*> (a) assembler words, referring to the cfa, runtime code or interpreter calls
[docall]       wa to call RTS-terminated subroutines with return to [next]
[docol]        wa, points to colon-definition runtime code
[dodefer]      deferred word cfa
[dojump]       wa to fetch and execute a longword-primitive
[donext]       next-entry, where 4th would fetch the next cfa to jump to
[dosemis]      wa to return from a 4th word, the RTS equivalent

*> runtime executives
lit            fetch a single literal from dictionary space
lit         (f)fetch a fp literal from dictionary space
dlit           fetch a double cell literal
(")         (h)(-- ptr) fetch a string
(.")        (h)(--)print a string

branch      (h)(--)    branch unconditionally
0branch     (h)(n1 --) branch if n1 = 0
?0branch    (h)(tf -- tf ) ( ff -- )
               branch if ff, otherwise keep flag value and continue
?1branch    (h)(n1 n2 -- n1 | -- )
               leave n1 on tos and branch if n1 =/= n2, else drop n1 & continue
-branch     (h)(n1 --) branch if n1 =/= 0
0<branch    (h)(n1 --) branch if n1  <  0
0>branch    (h)(n1 --) branch if n1  >  0
0-branch    (h)(n1 --) branch if n1  <= 0
+branch     (h)(n1 --) branch if n1  >= 0

(loop)      (h)
(+loop)     (h)
(do)        (h)
(find)      (h)(stg vocnfa - pfa count tf | ff)

(;code)     (h) lo-level compiled runtime-entry of a defining word

*> (h) compiling and runtimes for case:
(csel)  (case)  (cfa@)  (cfa,)
*> (h) compiling and runtimes for associative: and range:
(asvl)  (asvr)  (asv@)  (asv,)

*> compiling / interpreting

-find    (D)use: -find {name} -- pfa count tf| ff
            search the stacked vocs. for a word by its name.
w-find   (D)(ptr  -- pfa count tf| ff)
            as find, ptr points to the count (b/w) of the name to search for
(find)   (h)(ptr voc.nfa -- pfa count tf | ff)
            search a single vocabulary by its voc.nfa for the name at ptr
            used by (-ffind) for the single {root} searching.
(wffind) (h)initial action of w-find
(-ffind) (h)initial action of -find, searching all stacked vocs, and {root}
[find]   (h)(D)(ptr voc.nfa -- ptr voc.nfa )
            user definable 1st action of {(-find)}, preset to noop.
single      restrict the single next voc-search to the current voc.

'        (I)use: ' {name} -- pfa | message) find a words pfa by its name,
            tick executes {abort} on error when compiling, else {warm}

lfa         (pfa -- lfa)
cfa         (pfa -- cfa)
nfa         (pfa -- nfa) or (cfa -- nfa)
pfa         (nfa -- pfa)

execute     (cfa --) execute a word by its cfa (as from a compiled wordlist)
perform     (ptr --) execute a word by its pfa fetched from a variable:
                        ' {name} {variable} !
                     and         {variable} perform
                     execution takes place with NO extra safety checks.

[        (I)enter interpreting state
]           enter compiling state
|        (I)temp. compiling, use: | .. words .. | <enter>
            to execute any structure by keybord input

allot       (n1 --) de-/allocate dictionary space
            -ve values of n1 should be used with great care not to
            de-allocating any space already used by a compiled definition.
,           (n1 --) compile one cell, the dictionary ptr may be odd.
c,          (c1 --) compile a byte

literal   (I)(n1 --)compile a literal
dliteral} (I)(dn1 -)compile a double literal

compile     compile the following word to compile at runtime
[compile] (I)compile the following immediate word to execute at runtime

<builds     compile the following words into a defining word
            to execute when defining
does>    (I)compile the runtime-executive of a defining word
            to execute by the word just being defined
;does>   (I) the 79-standard (and later) version of DOES> which can be
            used with {create} and saves the extra cell of {<builds..does>}.
;code    (I)begin compiling a primitive runtime-executive
;c          continue hi-level 4th after code compiling
code     (I)continue code compiling after hi-level words
;s          exit a word unconditionally.
-exit    (I)( nn --) exit on true flag.
;        (I)terminate a colon definition
recurse (I)(C)compile a call to the word just being defined

smudge      toggle the latest word in-/visible for -find
immediate (r)declare latest word to execute immediately, also while compiling

*** defining words

create      compile a (primitive) word header, with the smudge bit set
:           enter the colon compiler to start a (hi-level) definition,
            set {current} to the {context} voc.
vocabulary (r) vocabularies usually would be declared immediate
            v8.xx: sub-vocs of {fp} inherit fp-literal-compiling

constant (F)(-- nn) single cell, could be defaulted to the value
            stored in the next cell and restored by {default-is}
constant (f)(-- fn)
2constant   (-- dn)

variable (F)(-- ptr)
            defining: initial.integer VARIABLE {name}
            may be defaulted and restored by {default-is} to the value
            of the following cell
variable (f)there is no extra f.p.-variable as this can be substituted by
                initial.number  variable , ,
2variable   as above, can be substituted by
                initial.double  variable ,
user        (-- ptr)
            defining: offset USER {name}
            where offset is the displacement to the baseptr of the user area
            any data size may be accieved by adding the extra user memory
            requirement to {up}, e.g.
                : 2user up @ user 2 up +! ;
            which is to be called with no offset parameter.

*> locals (examples)
local abcd| (n1 n2 n3 n4 --)
            initiating 4 single cell local variables from tos
local ABCD| (dn1 dn2 dn3 dn4 --)
            initiating double cell values when all(!) chars are uppercase
local a     (-- n1) fetching the content of a single cell local vari
local A     (-- dn1) ..double..
-loc a      (-- ptr) the local variable ptr
-loc A      (-- ptr) singles and doubles treated differently!

defer       use: DEFER {name} to later define it's action
            a default action can be set by:
            ' {default} cfa ' {name} 2+ !
            otherwise the 2nd cell remains set to non-operational.
default-is (I)
            restore the default action of a deferred word,
            may also be used on single length cons and vari:
                123 constant test 456 ,
                test . default-is test test . test . default is test test .
            prints 123 456 456 456
is       (I)(pfa --)
            use: ' {name} IS {deferred}
            or: -find {name} if-found drop IS {deferred}
pfa/nn/dn/fp IS {name   also may be used to store a value to the datatypes:
    case:           associative:    range:   (index new-pfa IS list-name)
    constant        variable        user
    2constant       2variable       constant (of the fp-voc.)
IS always takes some extra time, thus for runtime optimization it would be
adviseable to use the non-standard operators for direct storage "!" and "2!".

*> (I) multiway decisive structures (see description below)
case:       define: case: name ..cases.. ; independent index-cases
            use: (n1 --) executes the n1-th word if n1 within the range
            alternative defining and using within a colon definition:
            ..words.. case: 1stcase ..cases.. ; ..more.words..
#case       ( -- nn )
            when called as the very first word within a case:-ed word
            returns the index at which it was found to execute.
associative: similarly defines an independent associative list
            use: (n1 -- n2) returns the position of n1 or max.index+1
            {associative:}-lists may also appear within a colon definition.
range:      builds a list like {associative:}, being interpreted as
            a set of consecutive ranges with the result
            n1 {name} -- n2      such that n2 is the index to the
            interval [rn(n2),rn(n2+1)], rn(n2+1) not inclusive:
            range: {name} rn1  rn2  rn3 ..  rn(n-1) rn(n) ;
            (index:  ¼ 0 [ 1  [ 2  [ 3  [  [  n    [  n+1 ½ )
            the lower border inclusive, the higher border exclusive.
            the zero index indicates a value below the bottom number,
            the index of 1+(no. of items) indicates the top verflow.
            {range:}-lists may also appear within a colon definition.

case of endof default endcase
            the "eaker"-cases may be compiled from "forth_scr".

case?       ( n1 n2 -- | n1 )   -  executed by {of} of the 'eaker'-cases.
            continue executing the words following immediately if n1 = n2,
            else leave n1 on stack and proceed to the next {else} or {endif}.

* text, comment, error handling

"        (I)(-- ptr) compile / fetch (executing) a string, leave its 4th-address
text     (I)(c1 -- ptr) as {"} with the delimiting char c1
."       (I)(--)                     printing a string
.(       (I)(--) print a string immediately
(        (I)(--) comment until ')' found or e.o.l.
id.         (nfa --) print a words name, highlighted if immediate

* {x} the uncondintional delimiter for text input is compiled as ascii <nul>
x   ascii <nul>  (r)(I)(D) interpret next block or tib until input exhausted
[nul]     (h) the initial action of <nul>
[nul-pfa] (h) the pfa of the deferred <nul>-word.

state@      (-- n1) state @ =/= 0 when compiling
blk@        (-- n1) blk @   loadblock or 0 on tib-input

?error      (f n1 -- n2 n3) report n1, row/col of current block on stack
?numerr  (D)(f -- | abort) the error action when interpreting a word which
            has not been found and couldn't be interpreted as a number.
            might be re-vectored to automatically load a missing word.
            initially set to: 0 ?error
?comp       (--) abort if not compiling
?exec       (--) abort if not executing
?pairs      (--) abort if compiler flags don't match (structures)
?loading    (--) abort if not loading
?stack      (--) abort if stack out of bounds (i.e. below pad+81 or above tib-3)
?csp        (--) abort if stack-ptr doesn't match csp-stored value
!csp        (--) store stack-ptr (compiler safety)
csp!        (--) restore stack-ptr from csp

hld?        (-- ff|-4) tf (-4) if less than 3 bytes on top of here for number
            conversion, ff otherwise.

quit     (D)the outer interpreter or "program" loop: (quit) @ execute
abort       execute deferred {(abort)}, then {quit}
abort"   (I)on tf would print the following {"}-delimited text and execute abort
cold        jump into the restart code at 0 +origin (cold is not always safe!)
warm                                      4 +origin

error    (D)may be disabled by setting its execution vector to an odd address:
            disable  :    ' error dup @ 1 or swap !
            re-enable:    ' error dup @ -2 and swap !
            restore  :    default-is error
[error]  (h)intial action of {error}, sets 4th-err to =/= 0 on error
message     (n1 --) n1 may be any number, texts are prepared in the range
            of 0 to 32, negative numbers correspond to the qdos system
            messages down to -27, the text being sent only if its length
            doesn't exceed 127 bytes. The remaining error codes are printed as
               msg #n1

safety      (-- ptr)vari, determines the state of the inner interpreter
            safety testing for odd word-ptrs & other addresses (which was
            introduced for address safety with the 68040 host processor)
            and globally dis-/enables the {break}-key actions.
            any -ve: no address tests, {break}-test disabled
                 0 : no address tests, {break}-test enabled
            any +ve: address tests and {break}-test enabled

break       (-- ptr)vari, defines the key code which may be used to interrupt
            a running word sequence. Disabled when set to -1.

*> dictionary

safe!       store the nfa of the {last} word to {fence} (which is the very
            last one, that has been defined, regardless of the vocabulary
            being {current}), sealing the dictionary up to that word.

forget      use: forget {name}
            Release dictionary space downto {name} inclusive,
            {name} will be found regardles of the then valid search order.
w-forget    (pfa --) forget the word identified by its pfa

-forget  (I)forget, can be compiled with the name to forget at runtime;
            no abort if {name} was not found; -forget will search the context
            vocabulary, {root} and {local} only.

* when forgetting words, some action might be necessary, e.g. linking back a
* memory section to the memory heap or else. This is prepared by (see below):
doforget (h)(D)( nfa -- nfa } search routine for forget action
forgets> (D)(n.i.) linking in the following words for a forget action
forget-lk   user variable, forget-action link

empty       forget anything beyond the address stored in {fence} and prepare
            the system to restart orderly when {cold} was called.

seal     (h)seal the {context} voc., i.e. pretend it to be an empty voc.
            The ptrs. are NOT RECOVERABLE, the words of this vocabulary
            will not be found any more.
            This would seal a vocabulary against an attempt to de-compile
            its words, or, (accidentally) calling a word, which is not made
            for independent use, etc.
            It also considerably could accelerate compiling, as those words
            no longer will be searched for or tested.

***  system

.cpu        (--) installation identifier

+origin     (n1 -- n2)  add n1 to the base of initial 4th-vari
qsys+       (n1 -- dn2) add n1 to base of qdos sysvari

base+       (n1 -- dn2) convert 4th-ptr to d.memory address
            The address of a primitive longword-cfa can be found:
                ' name 2@ 0 base+ d+
2base+      (dn1 -- dn2) with double disp. as {base+}
disp+       (n1 -- dn2) convert 4th-ptr to disp to codebase
code+       (n1 -- dn2) convert disp to codebase to d.mem addr
            The displacement to the F6-jobs true base-address can be found:
                ' name base+ 0 code+ d-

*> error code pseudo-constants (which will be reset once read)
4th-err     (-- nn) set by:     [error] qm/mod uqm/mod #s hld?
              and reset by:     <# (and, therefore, all number output words)
fp-err      (-- nn) qdos error after fp operations.
io-err      (-- nn) ernum of 4th std-i/o-operations.
ernum       (-- dn) qdos error of trap#3/#2.

*** text / io

expect   (D)(ptr cnt --) receive data from keyboard input
query       (--) fetch up to {tib-max} characters to tib
            reset {in} (to start interpreting)
edline   (q)(bufptr maxcount -- charptr count)
            This simplified call to the qdos-trap io.edlin expects edittable
            input to bufptr with default text and count.w at bufptr;
            it leaves the ptr to the 1st char of input text and its length,
            also inserts the count.w and new text at bufptr.
tib-max  (h)cons, defaulting and initially set to 171

word        (c1 --) fetch a byte counted string delimited by c1 to {here}
\name       (c1 --) word counted strg until char(c1) or <nl> to pad
name     (I)(-- ptr) word counted strg until <bl> or <nl>
            to pad or compiled into the codbody
s#          (-- n1) signed single cell number from keybd input
s@          (c1 --) 4th-string from kbd to pad, until <c1> or <nl>
w@          (c1 --) word counted (qdos-type) string s@

enclose     (ptr1 c1 -- ptr1 n1 n2 n3)
            scan for c1 from ptr1 on following a (group of)
            char(s) =/= c1, skip leading chars c1.
            leaves the displacement n1 to the 1st char =/= c1,
            n2 the disp. to the 1st char = c1 following ptr1+n1,
            n3 disp to the next char after n2 (normally n2+1 or n2).
skip        (ptr1 n1 c1 -- ptr2 n2)
            Skip all chars (c1), leaving ptr2 and n2 as the address of the
            1st char =/= c1 and the remaining string count.
scan        (ptr1 n1 c1 -- ptr2 n2)
            Scan n1 chars from ptr1 on until the 1st char(c1) found,
            leaving ptr2 and n2 as the address of the 1st char = c1
            and the remaining string count.

traverse    (ptr1 n1 -- ptr2)  scan in the direction determined by
            n1 (+/-1) from ptr1 on until a byte > 127 is found
            This is limited by the value to which {width} was set

key      (D)(-- n1) receive one char from terminal input
                n1 -ve(char) on ALT/key, $8000 when timeout elapsed
?key     (D)(-- n1) as {key}, not waiting for input
?terminal (D)(-- f) check for pending terminal input,
                    leave the keyed-in char to be fetched.
?esc        ( -- f) ff and not waiting if no key pressed - as {?key};
                    tf on ESC (no ALT-key), waiting on any other key
keyrow      (c1 -- c2) test keyrow no. c1, fetch column value c2

count       (ptr1 -- ptr2 c1) fetch countbyte c1 of 4th-string at
            ptr1, advance ptr2 to the 1st character, redy to {type}
count-l     (daddr -- daddr+ c1) {count} on abs. memory address
-count      (ptr1 -- ptr2 c1)    {count} to detect count.b or .w
type     (D)(ptr n1 --) print no of n1 char from ptr
emit     (D)(c1 --)     print a char to console
prompt   (D)(c1 --)     echo a char to console with zero timeout
echo     (D){ptr1 n1 --){type} to the in-cons channel with zero timeout}
space       (--)        emit a blank char
spaces      (n1 --)     n1 times emit a blank char
.(r)        (n1 n2 -- n1)
            emit n2-n1 chars of (r) if +ve, else do nothing, thus
            right-justify any text output when n1=strg length and n2:=column
-print      ( ptr --)   does: -count type
            used to output a string regardless of it being a byte counted
            4th-string or word counted qdos-style of up to 255 bytes.
-trailing   (ptr1 n1 -- ptr1 n2)  adjust n1 to discard trailing spaces

*> io-control to out-cons
cr       (D)<cr>
-cr         (nn --) cr if nn =/= 0
bs       (D)output a backspace
del      (D)delete one char to the left
ctrl        (c1 .. cn - ff/-1) control-code execution (s. below)
cc-4th      a case:-list of {ctrl}-actions, index 0..31; code 127,1..31
(ctl)       vari lo.byte=0: no ctrl-action, hi.byte=0:send true char
bell
cls      (D)

*** number conversion and i/o
* NOTE: when the fp vocabulary or one of its sub-vocabularies are in {current}
* use a literal number will be fetched in the f.p. format. standard integers
* can be forced preceeding them by one of the base affixes.

d->q        (dn1 -- qn1) sign extend double to quad integer
s->d        (n1 -- dn1)  single to double
c->s        (c1 -- n1)   byte (char) to single
h>a         (c1 -- c2)   sedecimal digit to the corresponding ascii char
a>h         (c1 -- c2)   ascii char to sedecimal digit
$>f         ($ptr --- fp 0 <or, on error> 1 ) string to f.p.
f>$         (fp -- ptr len | addr ff)         f.p. to string
d>f         (dn -- fp) (simplified fast conversion)
s>f         (nn -- fp) ( " )
q>f         (qn -- fp) quad (64bit-)integer to f.p.
f>d         (fp -- dn) (more accurate & faster than the qdos call)
f>q         (fp -- qn) fp to quad integer
* the f>s conversion can be defined:
* : f>s f>d 7 ?error ;  ( fn1 -- n2 | abort )

digit       (chr base - ff | digit tf)
[convert] (h)(D)(ptr1 --) compile/fetch a literal from byte counted text at
             ptr1, delimited by a blank space; the last interpreteer action
(number) (h)(ptr1 -- ptr2) convert the string at ptr into a number
            until 1st char which is not a digit to the current base
number   (D)(ptr -- dn | abort) convert 4th-string at ptr into double number
[number]    (ptr -- dn|fp ff | tf) converting action of the deferred {number}
            an error condition exists if the string at ptr doesn't end with
            at least one blank char or, if the string contains any non-numeric
            char except the decimal fraction marks which are "," and ".".
            Optional leading chars for temp. number base:
            ¶ 12  h 24  ' 50  " 60  ! 4  % 2  # 10  & 8  $ 16
            { takes the 1st ascii char. as its code
            \fn  decimal fp-number
            \fn% or, in fp-voc fn%, fp percentage

<#          (-- ptr) clr {4th-err} and ret the ptr to the number-conv. buffer
#>          (dn -- ptr len) find convverted number ready to type
#           (dn1 -- dn2) convert one digit, leave remainder on stack
#s          (dn1 -- 0.)  convert all remaining digts
            leave double zero if the memory used by {hold} would overflow
            into the dictionary space. This condition will also be reflected
            to {4th-err} being set to =/= 0.
hold        (c1 --) insert char(c1) at current position to number output
sign        (nn dn -- dn) insert sign char of nn into string

(d#)     (h)(dn1 n2 -- adr count) convert a double number to string
            dn1 read as a signed number when n2 =/= 0, unsigned otherwise
(d.r)    (h)(dn1 n2.chars n3.flg -- adr cnt)

d.r         (dn1 n2 --)  print dn1 right justified to n2 length
ud.r        (udn1 n2 --) print unsigned dn1 right justified
.r          (n1 n2 --)   print single number rigth justified
d.          (dn1 --)     print signed double number
ud.         (udn1 --)    print unsigned double number
.           (n1 --)      print signed number
u.          (un1 --)     print unsigned number
#.          (un1 --)     print decimal unsigned number
$.          (un1 --)           sedecimal
d$.         (udn1 --)       $. double number
&.          (un1 --)           octal
%.          (un1 --)           binary
\.          (f1 --)            fp signed
.        (f)(f1 --)            fp if fp-vocabulary is in {current} use
?           (ptr --)     print the signed single cell contents at ptr

*> quad number conversion may be compiled from "forth_scr" by: l-load q.
q.          (qn1 --)     print a 64-bit signed number

*** stack data and associated operations

roll & pick count the 1st item from tos beginning with zero index:
        1 roll          equals: swap
        1 nswap                 swap
        2 roll                  rot
       -2 roll                  -rot
        1 pick                  over
                but
        4 ndup                  2over 2over
        1 ndrop                 drop

*> rp operators (keeping the same order as on the data stack)
rp!         (--)     restore the returnstack-ptr from user-vari r0
rp@         (-- ptr) running retunstack-ptr
*> single integers
>r          (nn --)  push to returnstack
n>r         (n0 n1 n2 .. n[nn] +nn -- n0) push nn cells to returnstack
>rr         (n1 -- n1 & n1 on r-tos) copy
r>          (-- nn)  pop from returnstack
nr>         (+nn -- n1 n2 ... n[nn] ) pop nn cells from returnstack
r           (-- nn)  fetch top number from returnstack
rdrop       (--)     drop single cell from return-stack
m>r         (n1 n2 --) fetch n2 bytes from memory at ptr n1 to returnstack
r>m         (n1 n2 --) store n2 bytes from returnstack to memory at ptr n1

r+       (C)(-- nn)  fetch the word where rp points to, advance rp@ by two.
            May be used to fetch inline words (which are compiled after the
            word which incorporates {r+}. Those could be any data or might
            be interpreted and executed as 4th-word cfa's: r+ execute
            thus enabling standard procedure 'frames' with different calls
            incorporated, many examples to which can be found in the {printer}
            definitions of "forth_scr".

*> double
2r          (-- dn)  copy
2>r         (dn --)  push
2r>         (-- dn)  pop

*> quad
* re "F6CHG_txt" or explanations below

*> datastack operators
sp!         (--) restore the datastack-ptr from user-vari s0
sp@         (-- ptr) running datastack-ptr
depth       (-- n1)  number of numbers on stack

*> bitwise
shift       ( n1 n2 -- n3 n4 ) shift n1 by n2 bits to the left (-ve right),
            leaving the shifted n1 as n3 and the overflow bits as n4.
btst        (dn1 n2 -- f)       tf if bit n2 of dn1 is set.
bset        (n1 n2 --)          set bit n2 of dn1.
bclr        (dn1 n2 --)         clear bit n2 of dn1.

*> single integers
drop        (n1 --)  remove top number from stack
0drop       (n1 n2 -- n1 | n1 n2 (n2=/=0)   drop if zero
ndrop       (n1 --)  drop n1 cells from stack, plus n1 itself
            -ve n1 can be used to reserve 2*n1 bytes space on stack
pick        (... n1 -- .. n(n1) )fetch the n1-th number to tos
over        (n1 n2 -- n1 n2 n1) equivalent to: 1 pick
sdrop       (n1 n2 -- n2 )      swap drop
sover       (n1 n2 -- n2 n1 n2) swap over
swap        (n1 n2 -- n2 n1)    exchange to two topmost numbers
><          (n1 -- n2)          swap bytes of n1
dup         (n1 -- n1 n1)       duplicate
ndup        (n1..nx nn - n1..nx n1..nx) duplicate a block of nn cells
-dup        (0 -- 0 | n1 -- n1 n1 )dup if non-zero
roll        (.. n1 -- .. n(n1) ) n1 +ve: fetch n1-th number to tos
            and move all items one cell up
            n1 -ve: insert the number from tos to the n1-th
            position, after moving the remaining numbers down to tos
rot         (n1 n2 n3 -- n2 n3 n1) fast version of:  2 roll
-rot        (n1 n2 n3 -- n3 n2 n1)                : -2 roll
*> double
2drop       (dn1 --)             drop double number
2dup        (dn1 -- dn1 dn1)     over over
2swap       (dn1 dn2 -- dn2 dn1) rot >r rot r>
2over       (dn1 dn2 -- dn1 dn2 dn1)
2rot        (dn1 dn2 dn3 -- dn2 dn3 dn1)
*> quad
4drop       (qn --)      drop a quadruple number
4dup        (qn -- qn qn)duplicate a quad. number

*> bitwise
and         (n1 n2 -- n3)
or          (n1 n2 -- n3)
xor         (n1 n2 -- n3)
not         (n1 -- n2)   one's complement
2and        (dn1 dn2 -- dn3) double {and}

** logic operators leave a true flag = 1 or false = 0 respectively

*> for the many new quad operators re "F6CHG_txt"

*> monadic single
0=          (n1 -- f) ff if n1 non-zero
0=/=                  tf if n1 non-zero
0<
0>
within?     (n1 n2 n3 -- f} tf if n1 within the range of {n2,<n3}
            tf if  n2 <= n1 < n3, the 3rd parameter NOT inclusive!
*> double
d0=         (dn1 -- f)
d0<

*> dyadic single
=           (n1 n2 -- f)
=/=
u<
uc<         (c1 c2 -- f) compare byte values
<
>
*> double
d=          (dn1 dn2 -- f)
d<
du<

*** arithmetic

*> single
+           (n1 n2 -- n3) add
-                         subtract
minus       (n1 -- n2)    negate
sgn         (n1 -- n2)    n2 := 1 if n1 > 0, -1 when -ve , else zero
abs         (n1 -- n2)    n2 := sgn(n1) * n1
+-          (n1 n2 -- n3) n3 := sgn(n2) * n1 applies the sign of n2 to n1
umin        (u1 u2 -- u3) u3 the 16bit number which is the smallest of u1 & u2
umax        (u1 u2 -- u3) unsigned maximum
min         (n1 n2 -- n3) signed minimum
max         (n1 n2 -- n3) signed maximum
within      (n1 n2 n3 -- n4} adjust n1 to n4 such that n2<=n4<=n3
            does: n1 n2 max n3 min
wraps       (n1 n2 n3 -- n4) adjust n1 such that n4 equals n1
            if being within the bounds of n2,n3 (inclusive),
            otherwise wrapping to the opposite bound.
bounds      (ptr1 n1 -- ptr2 ptr3) leave ptr2 & ptr3 adjusted to the range
            from ptr1 to ptr1+n1 ready to DO..LOOP with these ptrs.

*> double
d+          (dn1 dn2 -- dn3)
d-
dminus      (dn1 -- dn2)    negate dn1
2sgn        (dn1 -- nn2)    sgn of a double integer
d+-         (dn1 n2 -- dn2) multiply dn1 by the sign of n2
dabs        (dn1 -- dn2)    dn2 := sgn(dn1) * dn1
2within     (dn1 dn2 dn3 -- dn4) double {within}

*> quad
q+
q-
q+-
qminus
qabs

*> mixed
m+          (dn1 n2 -- dn3) add signed single to double
qm+         (qn1 n2 -- qn3) add signed single to quad

** multiplication, division

*> single
*           (n1 n2 -- n3)  multiply
/           (n1 n2 -- n3q) divide
u/          (n1 n2 -- n3q) unsigned
*> double
d*          (dn1 dn3 -- dn3 | ovf) signed multiply
ud*         (du1 du2 -- du3)       unsigned
d/          (dn1 dn2 -- d3q)       signed quotient

*> mixed precision multiply
m*          (n1 n2 -- dn3)   signed singles to double
u*          (u1 u2 -- du3)   unsigned sing's to double
s*          (dn1 n2 -- dn3)  signed double by single to double
dm*         (dn1 dn2 -- qn3) signed doubles to quadruple
udm*        (du1 du2 -- qu3) unsigned doubles to quad

*> mixed precision division with remainder
uqm/mod     (+q1 +d2 -- d3r q4q)   63bit/31bit => 63qot 32rmd unsigned
qm/mod      (+q1 dn2 -- d3r q4q)   63bit/32bit => 63qot 32rmd signed floor
uq/mod      (+q1 +d2 -- d3r d4q)   64bit/32bit => 32qot 32rmd
m/mod       (dn1 n2 -- n3r dn4q)   32bit/16bit => 32qot 16rmd
m/          (dn1 n2 -- n3r n4q)    double by single => singles
um/mod      (du1 u2 -- u3r u4q)    unsigned
*> single
/mod        (n1 n2 -- n3r n4q)     signed
u/mod       (n1 n2 -- un3r un4q)   unsigned /mod
mod         (n1 n2 -- n3r)         remainder only

*> bytewise
>|<         (n1 -- n2 n3)   n2 lo-byte, n3 hi-byte of n1 ( equals: n1 256 /mod )

*> intermediate double precision scaling:
* multiply 1st times 2nd and divide intermediate extended result by 3rd
ud*/mod     (du1 du2 du3 -- du4r du5q) doubles with remainder
            calculates: du1 du2 udm* du3 uq/mod
*/mod       (n1 n2 n3 -- n4r n5q)    singles with remainder
*/          (n1 n2 n3 -- n4)         singles

* integer division error returns:
*          +/- by 0        +/-ovf
*          0 by 0          1

* special fast op's {1+}...{8+} {1-}...{8-} are all present,
* where some of which are of special use also:
1+          character increment
2+          cell increment
3+          to adjust a string to even length + count.w: nn 3+ even
4+          double cell increment
6+          f.p. size increment
8+          quad cells increment, qdos pixel-graphic/window group of parameters
1-          char
2-          cell
4-          double
6-          f.p.-size, vocabulary-ptrs

*> (fairly) fast signed operators
4/          (n1 -- n2)
2/
16*
10*
6*
5*
4*
2*
d4*         (dn1 -- dn2)
d2*

even        (n1 - n2)    floor to even number
align       (n1 n2 - n3) set the ls n2 bits of n1 to zero

*** constants (shorter compiling, but executing slower(!) than literals)
0.          (-- dn)
0           (-- nn)
1
2
3
-1

*> disk related constants designed to be re-/set from {xinf} or {mdinf} data:
name         purpose         default val.    at ptr+disp
f/n         len of filenames       38
b/hed       len of fileheader      64      $2A (28.l)
b/sec       bytes/disksector       512    (with 2 bytes sector read)
b/alc       allocation unit        1536    $1E
a/drv       a.units/drive          480.    $20 ( 2constant )
a/fre       free a.units           480.    $24 ( 2constant )
d/wpt       write protect flag     0       $1D (byte)
d/num       drive number           1       $1C (byte)

*> system constants & vari
+nul        variable containing two Zeroes
[nul]      (h)initial action of <nul>
[nul-pfa]  (h)ptr to the deferred <nul> word
[th-entry] (p)ptr to the thing vector

*** -- f.p. words -- *

@           (ptr -- fp )
!           (fp ptr -- )

* the stack operations might substitute operations on groups of three integers
* fp word   does the 4th single cell sequence:
@           dup @ swap 2+ 2@ rot  ==>  count-w swap 2@ rot
!           swap over ! 2+ 2!
drop        drop 2drop
dup         2 pick 2 pick 2 pick
swap        5 roll 5 roll 5 roll
2swap       0 6 DO 11 roll LOOP
over        5 pick 5 pick 5 pick
pick        3 * 2+ >r r pick r pick r> pick
rot         8 roll 8 roll 8 roll
-rot
roll        3 * 2+ >r r roll r roll r> roll
>r          -rot 2>r >r   ( unchanged order such that
r>          r> 2r> rot    ( fp >r rp@ @ r> = rvoc   is true

*> fp ri-exec qdos op's (same as the standard QL SBasic keywords)
asin
acos
atan
acot
sqrt
ln
log10
exp
^
*
nint        (the qdos format conversion is not precise
int         (nor very fast, thus the above mentioned
nlint       (4th operators
float       (may be preferred
+
-
/
abs
neg
cos
sin
tan
cot

*/          (f1 f2 f3 -- f4) does: f1 f2 * f3 /
2*          fast multiply:         forth 1+ $0fff and
2/          fast divide:           forth 1- $0fff and

*> fp monadic/dyadic comparisons leave a single integer flag
0=          (fn1 -- f)
0<
0>
=           ( fn1 fn2 -- f)

ri-exec     (+n1 -- fp..)  single ri.exec operation according to +n1
            (ptr1 ptr2 -n3 -- fp..) ri.execb operations with ptr1 pointing
            to the list of opcodes and ptr2 pointing to the variable area.

*> minerva only fp extensions execute {noop} if not in a minerva system
* and leave err.ni (-19) in {fp-err}.
* this would leave a true flag when in a minerva system:
*     sysflg drop >|< drop 0=/=
* minerva words omitted from v7.24 on, left to be compiled from "forth_scr".
flong    (m)(fn -- dn)     does the same conversion as {f>d}
1/       (m)(f1 -- f2)     works: 1 swap /
arg      (m)(f1 f2 -- f3)
avg      (m)(f1 f2 -- f3)  works: f1 dup * f2 dup * + sqrt
^2       (m)(f1 -- f2)     works: f1 dup *
m^       (m)(f1 n2 -- f3)  works: f1 n2 s>f ^

*** fp constants

literal  (I)( fp --) compile a literal
lit         (-- fp) runtime executive
constant

0
1
2
3
1/2
1/4
-1
-2
pi

*** system single integer constants (and default values)

baud        (19200) default baud rate
bl          (32) ascii-value of a blank char
c/l         (64) characters / line of the screen display
first       block-table bottom ptr
limit                   top
b/buf       (64) bytes / block-buffer
b/scr       (16) blocks / screen
dr0ch       location (byte) of dr0 channel number - {screen}
dr1ch                          dr1                - {file}
(screen)    location of screenfile name parsed by {using}
(file)      location of alternate filename
(prt)       location of the {prt} device name ( 3rd i/o)
(dir)       location of the directory name used by {dir}
(boot)      location of the filename used by {s-load} and {l-load}

(quit)   (F)(h)vari, initial execution vector, defaults to {quit}
(abort)  (h)(D)deferred action in abort

*** user variables, single cells, offset to {u0}
*> some selected user vari have been extended to doubles, re "F6CHG_txt".

last        backup wordptr
(bs)     (h)key-code for the cursor left and delete char
u0          baseptr to user area
s0          default datastack ptr
r0                  returnstack
tib         terminal input buffer
width       max wordlength
warning     flag for the source of error messages, if any
            0: kernal/system texts  1:dr0 scr# 3+  -1: execute (abort)
fence       border for forget
dp          dictionary-ptr
voc-link    ptr to last vocabulary
blk         block counter
in          disp to next text input re block or tib
out         emit-counter, reset by <nl>
row         row counter, counts the <nl>s
scr         screen no.
offset      offset of the content of {scr} to the real screen posn
context     ptr to the context vocabulary lfa
current                current
ocurrent (h)ptr to previously current voc
ocontext (h)ptr to previously context voc
state       compiler flag, 0 if interpreting
base        number conversion radix
dpl         decimal point position in latest (literal) number
fld         - standard spare variable -
csp         stack ptr safety when compiling
r#          ptr to error position in screefile when loading
hld         running ptr when number converting to string
span        stg count after {expect}
io-time     (better don't change)!
cc4th       points to the pfa of the case:-list used by {ctrl}
(r)         leading char of formatted number output by {.r} and {d.r}
up          running ptr to topmost uservari offset
forget-lk   for {forgets>} runtime procedure (n.i)

base@       (-- n1) base @
base!       (n1 --) base !
hex         #16 base!  default to sedecimal number base
decimal     #10 base!             decimal

here        (-- n1) dp @  current dictionary ptr
pad         next even location 80 bytes on top of here, all purpose
            intermediate memory area, safe within the next 80 bytes

*** memory
* the memory operations work on any address,
* even or odd, and relative to the 4th base-ptr, if not stated otherwise.

off         (ptr --) set a variable to  0
2off        (ptr --)      double var to 0.
on          (ptr --) set a variable to  1
never       (ptr --) set a variable to -1
1on         (ptr --) set bit#0 of byte at ptr
             may be used to de-activate a {defer}red execution vector.
1off        (ptr --) re-set byte at ptr to all zeroes

toggle      (ptr c1 --) eor c1 to the char at ptr
             This is the only storage word where the data is on tos with
             the address ptr being next on stack, unchanged due to 'historical'
             reasons since the 1st 4th-standard appeared.

c@          (ptr -- cn) fetch char from ptr
@           (ptr -- nn)       single cell at ptr
2@          (ptr -- dn)       double
4@          (ptr -- qn)       quad
c!          (cn ptr --) store 8-bit-byte sized data to ptr
!           (nn ptr --)       integer
2!          (dn ptr --)       double
4!          (qn ptr --)       quad

+!          (n1 ptr --) add n1 to the cell at 4th-address ptr
2+!         (dn1 ptr --) add dn1 to the double cell at ptr

*> referring to true memory addresses
2@l         (dadr -- n1) fetch double
@l                             single
c@l                            char
2!l         (dn1 dadr --) store double
!l                             single
c!l                            char

+!l         (n1 dadr --) add n1 to the cell at dadr
2+!l        (dn1 dadr --) double +!l

*> some of the above operators for aligned ptrs/addresses which execute slightly
* faster and should be applied only when no address errors may be expected:
!a
2!a
@a
2@a
+!a

*> memory preserving byte move
cmove-l     (dadr1 dadr2 n1 --) move n1 bytes from adr1.l to adr1.l
cmove       (ptr1 ptr2 n3 --) move n3 8-bit bytes between 4th-ptrs
move-mem    (dadr1 dadr2 count len -- dadr1+ dadr2+ )
            move count blocks of len (max. 32K) bytes from dadr1 to dadr2

*> overwriting
<cmove   (h) move 4th-memory top down
fill        (ptr1 n2 c3 --) fill a 4th-area with n2 chars c3
blanks      (ptr1 n2 --)    fill with blanks (ascii $20)
erase       (ptr1 n2 --)    fill with zeroes (bytes)

* -- device de-/allocation -- * forth words *

* fop-dir and fmake-dir need a post-TK2.21 system ("level 2"-device-handler)
* to be present, such as the gold card or the atari-ql/smsq/qxl.
fopen    (I) use: fopen name -- dn (qdos error code)
fop-in   (I)      to assign a new channel to {work}
fop-new  (I)
fop-over (I) (by first deleting the named file, then re-creating it)
fop-dir  (I)
fdelete  (I) delete a file
fmake-dir (I)build a new directory: fmake-dir {dirname}

#chan       (dn --) defining a channel-name by #chan {name}
            calling {name} will then set in-cons, out-cons & work
            to the channel which was in work when defining it.
            use: fopen {devicename} #chan {channelname}
            designed to be used immediately after fopen (etc.),
            otherwise dn should be a dummy error code.

open        (name open.type ch -- d.err)
open-link   (name link.id ch -- d.err) where ch is a temporary channel

close       (ch --) close the channel from location c1
            work also will be closed if set to the same channel-id
delet       (ptr --) delete file, ptr points to the name
formt       (ptr -- secnum free ernum) ptr points to the mediumname

* -- qdos-io -- * forth words

screen      (-- c1) screenfile channel-location no.
file                secondary file channel
in-cons             input console (terminal)
out-cons            ouput
work        work-window for qdos-trap text/graphics
prt         secondary in/output (n.i., may be activated from "forth_scr")

* moving a channel-id to an id-location. if the destination locn contains the
* id of an open channel this should be closed first or the id stored elswhere
* because it will be overwritten and might get lost otherwise.
is-chan     (c1 --)     put work-id to the channel-id location of c1
to-work     (c1 --)     put channel-id of c1 to work-location
to-chan     (c1 c2 --)  put channel-id of c1 to the location of c2
set-work    (dn --)     put id dn to workchannel location
set-chan    (dn1 c1 --) put the id dn1 to the location of c1
>chan<      (c1 c2 --)  exchange the channel-id's (not closing)

new-chan    (-- c1|ff)  find the next free channel number
            c1 being the new no., else ff (zero)
            screen, file, print, work, out-/in-cons are protected
ch-id       (c1 -- dn1) find id dn1 of channel no. c1
            this is also a word to find the qdos channel number, as this
            is equal to the ls. word of the channel id.
work-id     (-- dn)     workchannel id
cdt      (q)(ch -- dadr f| -1. -1) qdos-cdt-address abs long
            (flag: -1 no channel, 0 no window, 1 normal, >1 pif-window)
            dadr will be the cdt base address, a windows parameterbase
            would be found:
            (ch -- dn) cdt dup 0> IF 1- m+ ELSE IF 2drop 0. ENDIF ENDIF
            leaving the parameter-address or a double false flag
chp      (h)(ch -- ptr) where the 4th-channel-id is stored
-window     (ch -- f)   test wether channel is a window
            (flag: 0 no window, 1 normal, >1 pif-window)
is-open     (ch -- ff | tf) tf if chan is open
is-ochan    (c1 -- f) true if channel c1 is open and an own channel
ch-num      (dn1 -- ch | -1 ) ch is the highest F6-channel-no representing
            the dn1 identified own qdos-channel
work-num    ( -- ch )
            the highest F6-channel-no which bears the the current work-channel.

*> (re)defining the channel-id location numbers
* these words re-assign the id storage ptr's and should be used carefully
is-work  (h)(c1 --) store work-channel no.
* further channel redirection includes a check if the channel is still open
is-in     (h)(c1 --)
is-out    (h)(c1 --)
is-screen (h)(c1 --)
is-file   (h)(c1 --)
is-prt    (h)(c1 --)
is-io     (h)(c1 --) set both, in-cons and out-cons, to c1

*** call, qdos-traps #0, #1 and #3
* for detailed descriptions refer to the relevant qdos documentations,

* fetch register contents set by the qdos-trap #1 & #3 calls
* valid for trap3 as stated, t1: different for trap1
d1l@        (-- dn) fetch d1.l returned by the latest trap#3 call
d1h@        (-- nn) read d1.w hi word
d1w@        (-- nn)      d1.w lo word
d1b@        (-- cn)      d1.b lo word lo byte
a1w@        (-- nn)         t1: d2.lo
a1l@        (-- dn)         t1: d3.l
a2l@        (-- dn)         t1: a0.l

*> store register contents used by the qdos-trap #1 & #3 calls
d1l!        (dn --) put d1.l for use with the next trap#3-call
d2l!
d1h!
d1w!
d2w!
d0w!                 t1:     d3.hi
d3w!                 t1:     d3.lo
a1w!                 t1:     a0.hi
a1l!                 t1: a0.l
a2w!                 t1:     a0.lo
a2l!                 t1: a1.l
d3t!        (--) save current timeout to temporary mem
d3r         (--) restore timeout from temp.

*> general call routine
call     (q)(dn1..dn10 dn11 -- dn12..dn22)
            where dn11 is the absolute long call address and
            dn1..dn10 are the d0-d4/a0-a4 longword register values;
            when calling a6 will zeroed, d7 set to the value of d0 (dn1)
            dn12..dn22 are the return values of d0-d4/a0-a4

*> processor mode (always safe at any state with any 680xx-processors)
trap0       (-- n1) enter supervisor mode, push prev. status code
sr@         (-- n1) read current status code
sr!         (n1 --) store n1 to processor statusregister
trap0s      (--)    enter supervisor mode
trap0r)     (--)    enter user mode

*> trap #1 qdos calls

trap1       (dn1 dn2 -- dn3) trap#1 call
            puts dn1 to d1,a0 and dn2 to d2,d3,a1

alchp       (dn1 dn2 -- dn3 dn4) job len -- len adr
baud        (dn --) NOTE: this also is a single constant in the forth vocabulary
set-baud    (n1 -- n2) read old and set new baudrate
            read only if n1 is not a valid number
            rates may be passed to different ports determined by the ls.digit
            (2, 1, or 0) when supported by the system (hermes, or qxl)
free        (-- dn)      biggest free heap segment
frjob       (dn1 dn2 --) expects job-id and d.ernum
ipcom       (ptr -- c1)  ipc-command, ret response byte
jinf        (dn1 dn2 -- dn3 dn4 n5 dn6)
mode        dn -- dn) set mode d1.w 0 - read mode d1.w, TV/monitor always zero
mt-inf      (-- dn1 dn2 dn3) sysaddr qdosid jobid
4th-id      (-- dn) own job-id
prior       (dn1 dn2 -- dn3 dn4) job pri -- id jdt
rechp       (dn --)
rclck       (-- dn) date
reljb       (dn -- dn) job/-1 -- id & {a2l?} jdt
sclck       (dn --)
tra         (dn1 dn2 --) true memory addresses dn1 chartab and dn2 messagetab

*> trap #3 qdos calls
* all of them (no exception!) operate on a currently open {work}-channel,

* the generalised trap-calls fetch their data from the register storage space
trap3       (-- f) execute a trap#3 call to the work-channel
t3do     (h)(dn1 --) execute a trap#3 call to the channel dn1 (id)

*> predefined qdos calls
pend        (timo -- f)  f: input pending / ready
fbyte       (-- char f)
fline       (ptr len -- len f)
fstrg       (ptr len -- f)
fstrg-l     (daddr len --) receive len bytes to memory-d.address
edlin       ($len $cursr ptr buf.len -- $len $cursr f)
            edit a string at ptr beginning at $col of it's len $len
            to the maximum of buf.len, ret. final len & cursorposn
edline      (ptr.w maxcount -- ptr.$ count )  simplified call of {edlin}
            editting the string at ptr (count.w) up to the len of maxcount,
            ret ptr.$ to 1st char & count, ready to {type}
            also puts the count.w at -2(ptr.$); ptr's may be odd.
sbyte       (char --)
sstrg       (ptr len -- f) send len bytes of string from 4th-ptr
sstrg-l     (daddr len --) send len bytes from memory d.address

pxenq       (-- y x height width)
chenq       (-- y x height width)

border      (width colour --)
wdef        (y x height width bwid bcol --)
window (fth)(y x height width --)

cursen      (--)
curdis      (--)

at          (row col --)
tab         (col --)
nl          (--)
pcol        (--)
ncol        (--)
prow        (--)
nrow        (--)

pixp        (y x --)

scroll      (dist --)
scrtp       (dist --)
scrbt       (dist --)
pan         (dist --)
panln       (dist --)
panrt       (dist --)

clscr       (--)

clrtp       (--)
clrbt       (--)
clrln       (--)
clrrt       (--)

fount       (1stfount 2ndfount -- f) with true memory addresses

recol       (ptr --)  8 colour bytes at ptr
paper       (colour --)
strip       (colour --)
ink         (colour --)
flash       (flg --)
under       (flg --)
setmd       (flg --)   basic OVER
csize       (height width --)     ( ! JS will crash with wrong parameters ! )
bfill       (y x height width colour --) basic BLOCK

* the graphic calls expect floating point parameters
* and leave the stack data remaining for further operations
point       (fx fy -- fx fy)
line        (fxs fys fxe fye -- x y x y) line {xs ys} to {xe ye}
arc         (fxs fys fxe fye frc -- ..)
elips       (fxc fyc frt fax frc -- ..)
scale       (fsc fxc fyc -- s x y)       scale {size xorigin yorigin}
gcur        (fypx fxpx fygc fxgc -- ..)  {pix-cur gaphic-cur}

flood       (flag --)                    fill on/off

fscheck     (-- f)
fsflush     (--)
** immediately after any of the pos calls, d1l? will give the current position
** there is no error trapping, leaving tf|ff on stack and ernum readable
posab       (d.pos -- f)
posre       (d.disp -- f)
poseof      (--)
fpos        (-- d.fpos)
flen        (-- d.flen)   fpos restored
mdinf       (ptr -- good empty f) 10 bytes of medium name to ptr
heads       (ptr -- len f)        send 14 bytes from ptr
headr       (ptr -- len f)        read no. of {d2w!}-stored bytes to ptr
fsload      (dadr --)     load all file to abs. dadr
fssave      (dadr dn --)  save dn bytes from abs. dadr to file
fsrename    (ptr --)      rename work-file
fstrunc     (--)          trucate file at current fpos
fsmkdr      (--)          modify the work-file to be a directory
fsvers      (d.vernum --) set/read the file version
xinf        (ptr -- f)    64(100) bytes device info to ptr

eof         (-- eofflag )
inkey       (time -- +char | -ALTchar | -1 )

*** pif definitions (and hotkey-buffer)
* for (more less than more) detailed information re "qptr" description,

* the error codes can be read (once only) in  {ernum}

pick-4th (fth) to activate the own forth-job
flim        (-- y0 x0 height width) outline info
            returns the standard screen sizes if no pif installed
qflim       executes just the pif-trap, doesn't return a default value
svpw        (y x 0/hgt.wdt d.mem.adr sizes.ptr -- d.sav.adr)
rspw        (y x flag 0 sizes.ptr d.memaddr --)
slnk        (d.data.ptr d.num.bytes d.posn --)
pinf        (-- d.pif-version d.wman-vector)
rptr        (y x tab(.b) 0 d.rcd.ptr -- y x)
rpxl        (y x d2.code -- colr posn)
wblb        (y x d.blob.adr d.pat.adr --)
lblb        (y.s x.s y.e x.e d.adr1.blb d.adr2.pat --)
wspt        (y x d.adr.sprt --)
spry        (y x d(.w)pix d.adr.blb d.adr.pat -- y x)
outl        (y x hgt wdt set/mov.flag --)
sptr        (y.pix x.pix flag -- y.pos x.pos)
pick-job    (d.job.id --)
pick-4th    (--) pick the own 4th job
swdf        (d.adr --)
wsav        (d.adr d.len --)
wrst        (d.adr flag --)

hot!        (ptr +n2 -- f) +n2 chars text from ptr)+ to hk-buffer
hot@        (ptr -n2 -- f) n2-nd string from hk-buffer to ptr
                          (n2 zero 1st $, or -n2-nd next)

* window moving/resizing
wmov        (c1 --)interactively resize window, c1 being its channel no.
            if c1 is the main (primary) window all other windows currently
            open to the f6-job get adjusted accordingly (at best).
      cursor          origin
      SH/cursor       sizes
      ALT/..          double steps
      CTR/..          4 pixel steps
      A/C/..          8 pixel steps
      SPC             shrink to cursor size
      <esc>           resize but leave the previous "outline"
      <enter>         ready with the new outline set

* -- file / virtual memory / interpreting -- * forth words

ert         (d.ernum --       if d.ernum =/= 0 print message and {quit}
(ert)       (-- ptr)cons, points to a vari which enables {ert} messsageing.

use         (-- ptr)vari, the current screen block-no. to be used next
prev        (-- ptr)vari, the block just used
update      (--) mark current block to store back before re-using it's memory
update-off  (--) clear update-flag
flush       (--) store updated blocks back to disk

empty-buffers (--) clear all block-buffers not saving their contents

dr0         (--) set offset to the 1st screen-file
dr1         (--)                   2nd

source      (-- ptr nn) ptr to and size of the current input buffer
blk+        (-- f) f: -1 input from tib, 0 new screenfile, +ve next block no.
            (proceed to) the next input buffer (executed by <nul> at e.o.l.)
#tib        (-- nn) number of chars fetched from terminal/(block)file input.

+buf        (ptr1 -- ptr) find the ptr to the next buffer
buffer      (n1 -- ptr1)  assure buffer no. n1 at ptr1 free to use
                          save old contents if updated
block       (n1 -- ptr1)  fetch screen-block n1 to ptr1
                          save old contents if updated
r/w         (ptr n2 f --) block n2 read f=0 from / write f=1 to ptr

interpret   (--) interpret text from tib/screen-block until
            semis {;s} or the <nul> word will be executed.
            [interpret] and [cpl] may be used to modify or partially disable
            the (outer) interpreter (for numbers re {[convert]}):
[interpret] (h)(pfa c1 -- pfa c1)
             preprocessing before interpreting a 4th-word, default {noop}
[cpl]       (h)(cfa -- cfa)
            user definable preprocessing before compiling a cfa, default {noop}

load        (n1 --)  interpret input from screen no. n1
            Displays a ":" before loading, may be nested to about 90 levels.
\        (I)(--)     don't interpret till e.o.l.
+continue   (+nn --) skip the next +nn blocks (until screen ends)
-->      (I)(--) load next screen
            Displays a "." before going to load the next screen, the call
            also includes some data stack control, displaying the stack depth
            after the screen number, if a difference was detected.
            Unless the load sequence ends at e.o.f it should be terminated by
            semis {;s} to prevent repetetive loading the same group of screens.
s-load   (I)1st use: +nn S-LOAD filename
            next   : +nn S-LOAD       (the filename may be dispensed with)
            Selectively load screen no. +nn from (different) screenfiles
            s-load may be nested up to about 30 levels
cs-load     from "forth_scr"; defines a simplified multiple S-LOADing call
l-load      from "forth_scr"; further modifies S-LOAD to library loading,
            description see further below.
chain       use: chain name
            from "forth_scr"; to load text from 'normal' files (cr at e.o.l.),
            the line length should be less than 160 chars ea.
            May be one level nested, input returns to in-cons at last e.o.f.

*> comment/compile/execute conditionally:
if-true     (f --)   skip input text till e.o.l. if false flag
if-found  (I)use: if-found {name} words to interpret if {name} found
if-nfound (I)as if-found, with the opposite condition
+continue   (n1 --) skip the next n1 blocks. n1 may be -ve, which then will
            lead interpreting back to a preceeding line. In either case the
            lines to skip count from the line after {+continue} was placed.

(line)      (n1 n2 -- n3 n4) count n4 of line n1 in screen n2 at ptr n3
.line       (n1 n2 --) print line, found by (line)

w-save      (I) use: w-save (name)
            save system with current in-cons window sizes & origin.
dataspace   (h) (-- ptr) variable
            prior to {w-save} may be used to restrict the dataspace of the
            thus produced new f6-jobs. Default value calculated by
                here minus 72 $8000 or -
            {dataspace} should never be set to less than 4K bytes.

* structures - the number of nested structured constructs is limited by the
* datastack free space at compiletime: each loop occupies two cells on stack.
* re {associative:} {case:} {range:}

back     (h)(n1 --) compile the branch-distance back to the label n1 at here
>resolve    (n1 --) compile the branch-distance from label n1 to here at n1

do       (C)(I)(n1 n2 --)       (sys: -- here 3)
            compile a looping structure, store n2 & n1
loop     (C)(I)(--)             (sys: label 3 --)
            compile end of a loop, set increment to 1
+loop    (C)(I)(n1 --)          (sys: label 3 --)
            set increment to n1
leave       (--)
            unconditionally leave a do...loop structure
-leave      (n1 --)
            leave a do...loop structure if n1 =/= 0
i           (-- n1) fetch the 1st loop index - equivalent to {r}
j           (-- n1)           2nd loop index
                              1st when in a separate {case:}-call
ni          (n1 -- n2)        n1-th loop index (n1=0 returns i)
                              (n1-1) when in a separate {case:}-call
l<i      (C)(-- d1) when compiled it immediately after I, J, NI, R, LEAVE,
            -LEAVE repeats the actual looop index, or the number to follow
            if called after LOOP or +LOOP. This may help to determine wether
            a loop was exhausted or left early due to some extra action.
            Actually it is the value of the processor register D0 and may
            also be used to repeat the results of:
                CACHE BLK+ NEW-CHAN DEPTH !CSP CSP! RP!
                SWAP SOVER SGN 2SGN 2WITHIN BOUNDS CHK
                NFA PFA TRAVERSE PAD
                D4* +!A * */MOD U* D* UM/MOD
            the value of hld after
                <# #> HLD HOLD
            remaining space till {here} after
                #S ?HLD
            the dictionary pointer after
                HERE ALLOT C, ,
            ernum of
                all qdos-fp-operations and the manager-trap-calls

begin   (C)(I)(--)      (sys: -- here 1)
            mark the start of a repetetive loop structure
while   (C)(I)(n1 --)   (sys: label1 1 -- label1 1 label2 4)
            mark the start of the conditional part of the loop structure
            execute: if n1=0 exit the begin..WHILE..REPEAT-structure, else
            enter the conditionally executing part of ..WHILE..REPEAT
repeat  (C)(I)(--)      (sys: label1 1 label2 4 --)
            mark the end of  BEGIN ... while ... REPEAT
            compile the branch back to after BEGIN,
            resolve conditional forward branch of WHILE to after REPEAT
until   (C)(I)(n1 --)   (sys: label 1 --) or,
            after WHILE (sys: label1 1 label2 4 --)
            resolve the conditional branch back to BEGIN.
            execute: if n1=/=0 conditionally exit a BEGIN ... UNTIL loop;
            may also be used instead of REPEAT to conditionally leaving the
            conditional part of a BEGIN...WHILE.. construct.
0= until    when written this way compiles a modified {until} to branch back on
            false flag when executing.
again   (C)(I)(--)      (sys: label 1 --)
            resolve the unconditional branch back to BEGIN.

if      (C)(I)(n1 --)   (sys: -- here 2)
            mark the 'true'-part of a decisive structure
            execute: if n1 =/= 0 continue immediately,
            otherwise branch to after the next endif-/else clause
else    (C)(I)(--)      (sys: label 2 -- here -2)
            resolve the branch into the 'fals'-part after IF
            execute: 'false' part of if..(true).. ELSE..(false)..ENDIF
endif   (C)(I)(--)      (sys: label 2 --) or,
             after ELSE (sys: label -2 --)
            resolve the forward branches after IF or ELSE

* modified conditional branches:

case?   (C)(I)(n1 n2 -- | n1 if n1=/=n2)
            compiles to continue if n1=n2, leaving n1 on stack otherwise
            A {case?}-clause will be terminated as any {if}-like word.

if else ...
0= if
0< 0= if
0> 0= if    and the like will be optimized, re explanations below.


*> timing (for a simple profiler re below)

ti-cal      (-- dn1) 68000 effective cpu timing, 1/10 cpu c/s
            ti-cal 54. 30. ud*/mod 2swap 2drop  adjustment for the 68008 cpu
            ti-cal 24. 30. ud*/mod 2swap 2drop  should suit the qxl-card timing
set-cal     (--) count the actual timing constant
tick        (-- dn1) current timer count

d>date   (q)(dn1 -- ptr c2 )
d>day    (q)(dn1 -- ptr c2 )

date$       (-- ptr cnt ) date$
day$        (-- ptr cnt ) day$

*> miscellaneous

sysflg      (-- dn) dn being a packed four bytes flag:
            hi.w hi.b   -1 68010+ processors, 0 otherwise
                 lo.b   -2 qxl-card, -1 atari-ql, 1 pre-JS, 0 otherwise
            lo.w hi.b   char, qdos nation mark (G german, '.' standard UK)
                 lo.b   -1 minerva (flag for ri.exec), 0 otherwise

cache       (-- f)  true if the processor cache is active,
            false when inactive, or called within a non-qxl system
cache-on    call the corresponding basic command
cache-off                       when in a qxl/smsq-system. noop otherwise.

bye         giving up the system - end a 4th job.

local       up to 26 local variables (within each word, singles or doubles)
            may be defined - explained in "f6chg_txt".

stack       a universal stack/parameter arranging operator -
            explained in "f6chg_txt".

vlist       show the context words, immediate definitions being highlighted

.s          show datastack contents: [numberbase depth] tos nos ...
            i.e., if one would like to see what {sdup} does:
                1 2 .s cr sdup .s               <enter>
            Another means to show what happens on stack will be explained
            further below:
                4 is db-on | 1 2 sdup |         <enter>
            From v7.24 on this word is moved to "forth_scr".

using       using {name}
            to immediately open the screenfile {name}
edit     (D)(load and) activate the editor edit an already open screenfile,
            or ask for a filename to open, or create from new, as a screenfile.
l-load      with no names tries to load the library load extension which is
            explained further below. After the extended definition has been
            loaded the parameterless call will fetch the 1st lines of each
            screen of the current library-file to display (v7.24+).

*> debugging (see description below) functionally moved to "forth_scr" from
*  v7.24 on, until then the debugging words listed below remain inactive.
debug    (h)(cfa nn -- ) {case:}-vectored
            list to execute the {db-on}th debugging routine
db-on    (F)(-- nn) constant, toggling the debugging on/off, defaults to 'off'

*> string words
non-standard string comparison modified such that a character {joker} would be
applied to the string to search for in the place where a match doesn't care.
(joker)  (F)(-- nn)constant, pre-set to -1 for standard (true) search
            applies to -text, w= and match, defaults to -1
(upper)  (F)(-- nn)constant, mask -33 for case independent or -1 for true
            charcters comparison; applies to -text, w=, s=, s== and match.
            defaults to -33 for case independent comparison.
                (when set to 0 or 32 the {words} procedure from "forth_scr"
                (would sort by name-length or length and char. cases only.
-text    (e)(ptr1 c1 ptr2 -- f)
            compare the characters at ptr2 with c1 chars at ptr1, tf if matched
w=          4th-voc alias {-text}
s=       (e)(joker dadr1 c1 dadr --) -text to true memory addr.
match    (e)(ptr1 umaxcnt ptr2 cnt -- udisp f)
            find string {ptr2,cnt} in 4th-memory at ptr1, maxcnt bytes
            ret disp to ptr1 and ff/tf if not/found
s==      (e)(joker dadr1 umaxcnt dadr2 cnt -- f disp)
            searches max 64K as match, with true memory addr.
!name       (ptr1 n1 ptr2 --)
            erase n1+2 bytes at ptr1 (string length following the count word),
            store up to n1 chars from word counted string at ptr2 to ptr1.
            both the ptrs may be even or odd,
            n1 and the the count at ptr2 being less than 32K bytes each.
+text       (ptr1 ptr2 --)
            append word counted string from ptr2 to word counted string at ptr1.
            both the ptrs may be even or odd,
            the counts accumulating to less than 32K bytes.

task        the last forth word does nothing
noop        one of the very 1st also does nothing.

*> experimental (subject to change)

clone-4th   set up and activate a copy of the current 4th-job
            whereafter the job-id and cdt-address may be read
            by {d1l@} and {a2l@}
(exec)   (h)(dadr1 dn2 ptr3 n4 -- dn5) leaved dn5 the job-id of the job
            created from dn2 bytes data at dadr1 with ptr3 pointing to
            a 4th-addres 6 bytes less than the storage address of the
            double cell dataspace for the job, the job execution mode
            signalled by n4 (0 concurrently, -1 exclusively operating).
clone-jdt (h)(D)( d.jobid -- d.jobid )
            called by {(exec)} immediately after job-creation
            & before moving code & data. this call must preserve
            the job-id. the jdt might be fetched by {a2l@}

basic    (h)(ptr -- f) ff if executed successfully, tf otherwise.
            ptr points to the word counted name of a parameterless
            executeable resident superbasic-procedure. The following
            being predefined because of frequent use when LIGHTNING
            is active:   hidden " _lngbad" basic rvoc drop
lngbad      to cure the untidy print positioning after _lngON
* some more example {basic}-calls :
 tk2:           DEL_DEFB DUP    FSERVE  PRT_ABT
 basic:         BEEP
 lightning:     _LNGON  _LNGOFF _LNGGOOD _LNGBAD _LNGDOMODE _LNGNOMODE
 pex:           PEON    PEOFF
 qxl:           CACHE_OFF       CACHE_ON
                the two of which already are predefined in the kernal words.
* of no use for 4th, but doing something with the (main) basic-job
                CLS     DIR     EDIT    AUTO    STOP
* most probably crashing the system
                LIST    RENUM

*> only if the MEM-device from "dvs_byt" of "IO2" is installed
memvec   (h)(nn - d.addr | d.-ve )
            fetch a vector to the special MEM-device routines
>fount      (n1 ch --)
            attach one of the four predefined character founts to a channel,
            n1 ranging from -12 to -16, otherwise the rom-fount will be re-
            installed - which might be necessary for rom versions up to JS
            when displaying in MODE 8, where the new 8-bit-characters reading
            can end up in an address error.


* 2. --------------------------- library load -------------------------------- *

There is a screenfile "forth_scr", defining a DIRectory call, BACKUP
procedures, memory and stack DUMPs and many more utility words.

{screenfile} in this particular description is any name that may be used to
open a screenfile where the extensions concerned might be compiled from, or,
which is the name of the screenfile already in use for library compiling.
Any other text instead will be recovered and tried to interprete after loading.

s-load      ( +nn S-LOAD {screenfile} )
         load screen no. +nn from {screenfile} or, if no name was passed
         try loading from the file the name of which is stored in {(boot)}.
         s-load is a kernal word from v7.00 on.

l-load      ( L-LOAD {forthword} {screenfile} )
         find where {forthword} is defined and load it from {screenfile}.
         {screenfile} may be any source, the current screenfile inclusive.
         If the file wasn't found another attempt will be taken with the
         filename found in (boot).
         If a name was passed and the file successfully opened, this name
         will be stored in {(boot)} for the nameless calls to both, s-load
         and l-load, to follow.

         The files will be opened read only. If not explicitly closed
         and if s-load was taken from the current load-file, or, if any
         mistake did halt the loading/compiling procedure, it would be
         left in the read/write state regardless of its original open mode.

s-load   and
l-load   may dispense with the filename as long as the source file remains
         unchanged. This enables source device independent loading from within
         a screenfile once the source is known:
                1 S-LOAD flp1_forth_scr
                  L-LOAD .vocs flp2_forth_scr
         from now on
               n1 S-LOAD
                  L-LOAD {name1}
               n2 S-LOAD flp3_t‡t‡_scr
                  L-LOAD {name2}
               n3 S-LOAD
         the l-load commands always compile from "flp2_forth_scr", while
         the 2nd call to s-load compiles from the filename passed, NOT
         changing the default name for the nameless calls.

l-load {screenfile}
l-load   initial loading will be accomplished if the full definition from
         "forth_scr" was not present. For the very 1st call to l-load the
         wordname will be discarded and just the extension loaded from the
         predefined libray file, or the optionally passed screenfile-name.
         Any call to {l-load} with neither the wordname nor the filename
         would try this initial loading or, if already done, return at once.
         If {screenfile} has been passed, i.e. any name that successfully
         was used to compile the extended {l-load} definition, this becomes
         the default name for the filename-less calls to {l-load} to follow.

         Any number of consecutive calls and an average number of up to
         30 nested calls to any no. of different files would be possible:

         1040 bytes is the combined terminal input buffer ( tib ) and
         returnstack space. thus depending on how long the keybord input
         line was (or the EX parameterstring) about 900 bytes may be
         used safely, still leaving some workspace for the system.
         if this wouldn't be sufficient re-assemble the 4th-system with
         <tibrp> set to your requirements.

         A call to a 4th-word occupies 2 bytes on the returnstack.
         additionally {s-load} puts 8 bytes of channel information, the
         name length and the even (up) aligned no. of characters of the
         filename to the returnstack:
                        16 s-load flp2_forth_scr <enter>
         would use 26 bytes of {tib}, leaving 1000+ bytes for loading,
         compiling and system data, where in this example 26 bytes
         would be occupied by the call to {s-load}

+continue   (+nn -- )
         skip the next +nn lines while loading to continue compiling
         from the (1+nn)th line (block) _after_ the above statement.
         {+continue} should not be used to go to the last line of the
         current screen, not to pass interpretation to another screen,
         which, both, could lead to an endless loop.

And, to avoid multiply defining already known words use the kernal definitions

if-found    use: IF-FOUND {name} ..words..
         skip this single line (block) of the current screen if {name}
         is unknown within the current vocabulary search order.
if-nfound   use: IF-NFOUND {name} ..words..
         skip if {name} is already known

Combining {if-found} and {+continue} leads to a structure of IF-NOT .. ELSE ..
        if-found {name} 3 +continue
        : name ..words..                \ these lines execute if
               ..words.. ;              \ {name} wasn't found
                        1 +continue     \ and the next line sikipped
        : next-name ..words.. ;         \ this executes if {name} was found
               ..words..                \ common again


* ------------------------------ the editor --------------------------------- *

- For the Editor refer to the screenfile "ed_gls" or, german, "ed_gls_g". -

* 3. ------------------- different 4th's reference -------------------------- *

* any standard          vs.     F6
previous (f.i.g.)               previous (and rvoc)
postpone (f.83, ans)            [_]

* f83 p.d. forth by l&p vs.     F6
nip                             sdrop   (swap drop)
tuck                            sover   (swap over)
under                           sdup    (swap dup)

* f83                   vs.     F6 and l.m.i.
flip                            ><  (dup 256 * swap 256 / or) swap bytes

* f.83 (or 79-standard) ++  vs.  equivalents to F6
*               tick is an immediate word in the f.i.g.-standard:
[']                             [ ' cfa ] literal
'                               [compile] ' cfa
>body                           2+ nfa pfa         (convert cfa to pfa)
>link                           2+ nfa pfa lfa     (cfa to lfa)
>name                           2+ nfa             (cfa to nfa)
   (the word reference of fig-4th is the pfa which in this installation
   (currently is two bytes 'above' the cfa, while it is the cfa in f.83.
?terminal                       ?key of F6 also returns ALT/keys by
   IF ?key ELSE $8000 ENDIF       the negative code of the key pressed
bl word find                    -find IF $c0 < 2* 1- ELSE here 0 ENDIF
create                          0 variable -2 allot
create.. does>                  <builds ... does>
: {name} [ context @ current ! ]  colon setting current to the context voc.
(byte ptr --) ctoggle           (ptr byte --) toggle
last @                          latest (last word in the CONTEXT vocabulary)
                                       (last @ returns the last name in
                                       (dictionary regardless of CONTEXT
state @ IF literal ENDIF        literal  (is a "state smart" word)
logical true flag: -1           (+)1
negate 1-                       not      (one's complement)
sp0 @ sp!                       sp!      (there is no equivalent to rp!)
perform                         perform  (executes: @ cfa execute )
span                            not necessary, supplied just for compliance
tib                             tib@     (tib @ :tib is a user variable)
variable                        0 variable
within                          within?
word                            word here
?key                            ?terminal IF key ELSE $8000 ENDIF
0= if                           0if
if else                         0if
cell                            2
cell+                           2+
r> dup cell+ >r                 r+


* the end of the input stream
* in f83 etc. has to be determined separately while in the f.i.g.-standard this
* will be recognized by itself, the unconditional delimiting ascii <nul> then
* executing as a forth word part of which is similar to this sequence:
end?                            blk@ -dup IF block ELSE tib@ ENDIF in @ + c@ 0=
nuf?    (not a medical disease; might have the same meaning as {end?} )

* there is another significant difference in the actions of {word} and {tib}
* f83 (the p.d. sytem by l&p)  | fig-4th and l.m.i. forth 83
                               |
{tib} ACCORDING to the current | {tib} won't be changed by the system, it
input source IS the ACTUAL ptr | always POINTS to the TERMINAL input buffer
                               |
{word} ALWAYS works on {tib}   | {word} ACCORDING to {blk @} acts on {tib @}
and leaves the ptr to the      | or {blk @ block} of the actual blockfile,
separated string, the count    | fetching the separated counted string to {here}
can be read from {#tib}        | later standards leave the count in {span}.

* f.83, f83, ansi        vs.    79-standard equivalents
body>                           cfa
?branch                         0branch
convert                         (number)
create ... does>                <builds ... does> (functionally equivalent)
?dup                            -dup
exit                            ;s
>in                             in
invert                          not
negate                          minus
?negate                         +-
not                             0=
postpone                        compile or, on immediate words, [compile]
r@                              r
rp0                             r0
sp0                             s0
s>d                             s->d
'tib                            tib
#tib                            span
then                            endif
words                           vlist - a much more elaborate {words}
                                        can be compiled from "forth_scr".

* 4. --------------------- environmental dependency -------------------------- *

There are many reasons (to the author) to preferring the f.i.g.-Forth model:

The f.i.g.-Forth is very easy to handle and precisely documented, source listigs
are availiable for nearly any host processor or operating system. The 6800x
processor installation fits into 6K bytes, even that tiny thing providing the
kernal wordset of the most versatile computer language for microprocessors.

It ist not a subject to frequent changes by some rather obscure 'conference'
where as many people as possible seem to put as many thaughts as possible to
the least use as possible, most probably just caring to later stating their
own system being far superior to the recent standards. The fifteen years passed
braught up very few really advantageous ideas and features to the language of
Forth, and even less to its (partly) inbuilt operating system.

"Virtual memories', 'structured' or 'object orientated programming', 'hidden
informations' might all be quite impressive new words, what they describe
is not that new, and immanent to Forth since its days of the 1977(?) f.i.g-
quasi-standard - where the F6 system is developed from.

The threaded code type forth was considered more 'up to date' than ever. With
processors facilitating different indexed addressing modes the 'next'-call,
which is the PC of forth, and the 'nest' and 'unnest' procedures, can be pro-
grammed very efficiently with very little runtime penalty. And the extremely
compact coding result to programs that short, that even quite big applications
completely can be fetched into the processor caches, speeding up the execution
times much more than any highly optimized bulk of other 'languages' products.

The vocabulary structure, where each vocabulary is owned by the one where it
was defined in, has been maintained; extended to the new concept of stacking
a selected search order of multiple (up to 16 by default) vocabularies.

Heritage of newly defined properties partly is maintained by the way how 'does>'
works, where any defining word may define the defining part and pass its own
defining behaviour to the new group of words:
        : 1st-type ..preparing.. <builds ..somehow.. does> ..something-1st.. ;
        ( data-for-1st )              1st-type 1st-word
        : 2nd-type ... 1st-type ..extra-data/words.. does> ..something-2nd ;
        ( data-for-2nd data-for-1st ) 2nd-type 2nd-word
The defining rules of any other defining word can also be built into a new
defining word by the F6-word {<with}:
        : 3rd-type CREATE <WITH 1st-type ... ;DOES> ... ;
wich only(!) works with the CREATE/;DOES> combination of F6.

There are so many strictly (?) "portable" systems, but none of them therefore
would put the facilities of the QL to efficient use. The latter has been tried
with this system, to the expense of non trivial portable programming. Those
programs, nevertheless, could be easily translated to any other forth dialect.
Despite, each standard f.i.g.-forth word works as defined by that standard and
thus there is no problem writing or compiling strictly portable programms -
which then may not use many of the F6 extended features.

The F6 system has been tested with the JM, JS, MGG and MINERVA (1.93) roms by
compiling and running the editor, assembler and single 4th-words-multitasker.
It was developed using the MINERVA system.
F6 with all its data- and programming space fits into about 80K bytes, thus
it should run in any standard QL, wether memory extended or not, and programs
written with F6 normally should not need the programmer to taking care of
the different QL system versions.

The final and comprehensive tests have been carried out with a business
accounting programm, about 30K of size, when compiling and successfully doing
the regular book-keeping for different clients. It by now is in use for about
four years. Thus the system worked out to be safely useable on Minerva(1.93)-,
MGG- and JS- Systems, and with the Atari-QL and its e32 softare.
Recent tests (10/1994) were successful with the QXL-system(s) also.

Some filing words of the "qdos"-vocabulary need the extended set of trap #3
calls, supplied with the TK2, Gold Card or the 'Level xx' device handlers:
        fsrename  (tk2, also supplied by minerva)
        fstrunc   (tk2 and minerva)
        fsdate  fsmkdr  fsvers  xinf (all level 2...)
and the associated hi-level 4th-word
        fop-dir

The only (known) system related dependency will be found concerning the
extended window definition block where sd.linel (the number of bytes in a
display line), at $64(a0) in an sd.extop call, and the 4+ longword positions
after, where the keyboard queue would be expected. The latter address in JM
being 4 bytes 'lower' than in the later systems, while sd.linel is missing.
No particular routine of the supplied F6 version depends on these variables.

Also a program intended for general use shoudn't rely on the (few) additional
ri.exec-vectors which minerva supplies (and the more recent SMSQs).

Further there are the words of the "pif"-vocabulary and the hotkey-words
which, of course, all depend on the appropriate system extensions.


* 5. ----------- how to use some of the more special features ---------------- *

*** system versions
The F6 forth system will be subject to modification to achieve the highest
level of safety and efficiency as possible while maintaining compatibility
throughout the different versions. Nevertheless the latter might not always
have been possible and therefore the user should read the file
        F6CHG_txt

*** system safety

Generally the system is planned for the highest degree of safety which could be
achieved with reasonable expenses. The next priority was to make the system
most easy to use, its extended facilities like easy and simple access to the
qdos routines or the pointer i.f. and the like inclusive. Compliance to the
f.i.g.-Forth model was another goal, which (hopefully) has been acchieved,
taking the recent standards into account as much as possible, if reasonable.

Another forth-immanent feature is the extensive user definable error handling.
The system would halt executing only when itself or its data could be damaged,
anything else is left to the user, aided by several means to detect wether an
error occurred, and if so, where it happened. This concept has been extended.

The qdos trap redirection by the manger trap mt_trapv is used to facilitate a
very high degree of safety when trying to execute from odd addresses.
Such easily could happen, e.g., if accidentally an item was left on the return
stack or, a mistyped forth-word unpurposely might do something on this stack.

When running in a qxl-system or in an atari-ql with a processor 68020+ the odd
adress trap won't work on fetching an execution address as that will be handled
as 'data reference', where these processors would always read or store without
an address error. Therefore in those systems address error safety will be
maintained by the secondary job which controls some different safety aspects.

Another facility will make the system even safer: It enables a user definable
break-key, which, when pressed, will halt execution by entering {quit}, or,
together with the ALT-key, initiates the {warm}-start sequence.
        1 break         sets the break-key to CTRL/A,
and
        -1 break        disables the break sequence (default).

While first controlling <break> and address aligments by an extended <next>
call from v7.20 on safety handling is left to a secondary job the priority of
which initially is set to 1, thus taking very little processor time, speeding
up the F6 system to working about that fast as if the extra features were all
set to inactive. The executional speed now is much superior to the C1-4th, and
nearly equals that of d.p.-s "Super Forth".

The processor execption traps are redirected to the 4th jobs own vector table;
where by now the "address error", "illegal code" & "chk" vectors are redefined.
This may cause errors with the QXL-systems (where 2.16 & 2.31 have been tested)
as the SMSQ doesn't handle the QDOS-call to mt_trapv properly.
"address error"
        displays the (hex) register values D0-D7, A0-A7 and SR, PC,
        and the two extra longwords delivered on stack.
        In the qxl- and other 68010+ systems the latter two items
        are taken from stack at offset 10 and 14.
        Depending on the error state the system will restart from the
        {warm} or {cold} entrypoints respectively.
        Due to different error handling of the 68010+ processors the
        inner interpreter carries out a much extended check for odd
        values of the instruction ptr [ip], the return ptr [rp], the
        data stack ptr [sp] and the word ptr [w] just fetched - the
        register names according to the f.i.g. virtual processor model.
        Only the actual wa is left to the address error trap procedure.

"illegal"
        is used to replace the regular trap#0 qdos call and push the
        statusregister to the datastack, which otherwise would result in
        a "privilege violation" exception with 68010+ processors.

"chk"   used when initiating the F6 system.

"illegal" was changed to be executed by "chk" as it otherwise might
        interfere with some monitor programs which use the "illegal"
        exception for breakpoints. The previous functionality of "chk"
        was dispensed with, as it proved very inefficient. - F6 v8.08.


*** qdos-traps
There is no call to trap#4 provided because in a job A6 could easily be added
to the concerning register value without risk - executing much faster.

* qdos error-codes
are put separately into the (once only) read only pseudo-constants
        io-err  standard 4th-io
        fp-err  error code of the ri.exec-vectors or string conversion
        ernum   trap#1 and {work}-channel 4th and trap#3 operations

*** Valid forth-names
It appears most ridiculous, when highly skilled taks get managed aided by
computers, but, still, some computer 'languages' cannot cope with accented
letters or umlauts. - This rarely is a problem with the F6 forth system,
wherein the 4th-word names can be made up of any characters in the range
of 0 to 255. The 7th bit will be masked off, though, which otherwise would
confuse {traverse} & {(find)}, where the search is terminated by characters
with the top bit set.
Thus a name             {±±±}
compiles as             {111}
which, at least, is less worse than the (in many 4th-systems) usual system
crash. This applies to chars > 160 while the system will recover the chars
128 to 160 from the codes of 0 to 32 when found in the name field.
 : H NSEL [ latest ] literal id. ." und GRETEL " ;
 h€nsel ' h€nsel nfa count 31 and type
would print
 H NSEL und GRETEL H NSEL
the "H NSEL" because the " " was stored as char 32.
Despite, {±±±} also will correctly be recognised and executed as long as
there is no other word with the name {111}.

* A words type can be found as follows:
 : ?prim dup cfa @ over =
   IF ." standard primitive at " @ dup base+ $. ." mem:" d$. ;s
   ELSE dup cfa @ also assembler [dojump] previous =
    IF 2@ 2dup 0 base+ d+ ." longjump primitive at "2swap d$. ." mem:"d$. ;s
   ENDIF ENDIF drop ." not a standard/longjump primitive word" ;
 : .TYP -find dup 0=
   swap IF rot ?prim cr swap $c0 < minus or ENDIF
   dup IF ." not " ENDIF
   0> IF ." found" ELSE ." immediate" ENDIF ;
Then {.typ} gives the message wether the word is a standard or a special
longword-cfa primitive and wether it is an immediate word, or not found.
        .TYP {name}
Furthermore an immediate word can be detected by {vlist} and {id.} which
would print such names with INK and PAPER exchanged:
  ' {name} nfa id.

words   from "forth_scr" displays the {context} vocabulary words:
                forth words                     all words of {forth}
        and may be modified to select certain groups of words:
                selected imed forth words       the immediate words only
                selected prim       words       standard & longjump primitives
                selected wtyp cr hidden words   the words of {hidden} which
                                                correspond to the defining type
                                                of {cr}: the deferred words.
                selected wtyp bl   forth words  all forth constants
                selected wtyp base       words  the user variables
                selected wtyp task       words  the colon-defined words
                selected wtyp fopen      words  the {does>}-defined words
                selected defn fopen      words  the words being defined by
                                                the same hi-level defining
                                                word, e.g. with the same does>
                                                routine as {fopen}
        while
                selected wtyp -          words  displays {-} only, due to the
                                                fact of this lo-level words cfa
                                                pointing to some unique address
                                                in the dictionary.
        In fact, {wtyp} modifies {words} to test for the cfa's being the
        same as the example word passed after {wtyp}, and with {defn} the
        corresponding pfa contents will be tested. Finally
                selected b               words  displays the words the names of
                                                which begin with the letter "b"
                selected {up-to-7-chars}        can be used for alphabetic
                                                selecting the words to display.
        and
                selected xtra ... ...           is a user definable deferred
                                                procedure which receives the
                                                words' nfa and is expected to
                                                leave a flag on stack instead.

* A simple discompiling utility to start with will be compiled when loading
* {.s} or the debugging words from "forth_scr" where
   .dcm {forthword}
or
   ( pfa ) #dcm
would show the words where {forthword} was compiled with, step by step when
a key was pressed, being terminated by the <ESC> key.

* floating point vocabulary
Forth words with different actions in the fp-vocabulary may be found in the
words alphabetical list; some of which are:
 -2 -1 3 2 1 0 . @ ! constant lit literal + - * / */
 >r r> rot -rot pick over swap 2swap dup drop 0> 0= 0<

* NOTE on fp numbers:
Regardless of the vocabularies currently in the search order literal numbers
will be fetched as f.p.-numbers ONLY if the fp vocabulary is context or, if one
of its sub-vocabularies is context. Standard integer numbers may then be forced
by preceeding them by one of the base affixes:
        #  %  &  $  '  "  h  d  ¶  {

A trailing "%" can be used to convert a f.p.-number into its percentage.
 fp  123%  .     displays:       1.23

A single cell drop can be maintained by:
        #1 ndrop
or
        0. drop
or, with no runtime penalty for compiled words:
        also forth drop previous

* arithmetic
The system incorporates the full range of single and double precision
operators, also the mixed ones of singles and doubles. Additionally from
v7.23 on some quadruple precision operators are provided for:
        4dup    4drop   duplicate/drop a quad integer (4 cells)
        4swap           swap two quad integers
        q+      q-      add, subtract
        qabs    qminus  absolute/negative value
        qm+             add a single integer sign extended to a quad integer
        q+-             apply the sign of a single integer to a quad integer
        udm*    dm*     multiply two un/signed doubles to quad
        uqm/mod qm/mod  un/signed quad by double to quad quotient, double rmd.
and the mixed one
        ud*/mod         multiply 1st double number times 2nd and divide the
                        intermediate quad precision result by the 3rd double
                        leaving the double quotient and remainder.
printing a quad number
        q.      uq.     can be compiled from "forth_scr".

The only arithmetic operation with results floored to negative infinity is
        qm/mod
dividing a 64-bit signed quad integer by a 32-bit signed double integer:
        dividend   /    divisor   =     quotient   &    remainder
        +ve             +ve             +ve             +ve
        +ve             -ve             -ve             -ve floor
        -ve             -ve             +ve             -ve
        -ve             +ve             -ve             +ve floor
all of which equate
        dvd / dvs = qot * dvs + rmd
the remainder carrying the sign of the divisor.

* logic
The logic flag values (in f.i.g.-style forth systems) are
        true     1  an integer with only the l.s.b. set
        false    0  an integer with all bits reset
This might cause some confusion when translating from/to other systems,
where the flag values most certainly will be defined as
        true    -1, a standard cell with all bits set
        false    0, a standard cell with all bits reset


By purpose NOT the full range of comparison operators was supplied:
In many cases the missing ones can be substituted by others, which is
the reason of minimum standard systems supplying just
        <  u<  0=
where any other operations can be built with - very often at the cost of
runtime efficiency. Therefore some more operators are pre-defined.
As very often an IF will follow, the missing ones easily may be resolved by
the F6 additional IF compiling, with different conditional branches leading
to more compact (and faster!) code than one operator for each case possible,
signed and unsigned, single and double, float and standard...
       nn 0<=    IF       can be substituted by
       nn 0> 0=  IF
or,
       nn 0>=    IF       can be substituted by
       nn 0< 0=  IF
or,
       dn d0>        IF   by the standard sequence
       dn dminus d0< IF
or,
       dn d0>=   IF       which F6 also doesn't supply, by
       dn d0< 0= IF

* runtime optimization
in general is not provided for. This would complicate the threaded code compiler
of F6 to an expense considered unreasonably high for this forth system. From
version 7.15 on, nevertheless, a few conditionals will compile a short form,
omitting one 4th-word, when immediately preceeded by {0=}, which also may be
preceeded by {0<} or {0>}, being contracted to one appropriate branch code:
       nn 0= IF ..      nn 0< IF ..     nn 0< 0= IF ..          (see above)
       nn 0= WHILE ..
       nn 0= UNTIL ..

There is another approach to a combined un/conditional loop as defined by
{begin .. while .. repeat}, which executes faster, mainly when using very
short loops:
        BEGIN   ..unconditional.. exitcond WHILE ..conditional.. REPEAT
instead
        ENTER BEGIN ..conditional.. ENTRY ..unconditional.. exitcond 0= UNTIL
where the entrypoint when starting into the loop is from ENTER to ENTRY, then
conditionally branching back to BEGIN as usual.

ENTER & ENTRY can be compiled from "forth_scr", it may be nested but not
interleaved with each other, i.e. ENTER BEGIN may be seen as one word where
somewhere before the next WHILE, REPEAT or UNTIL, whichever comes first, the
corresponding ENTRY is expected.

These examples
        : t1 $7fff $8000 DO i drop LOOP ;
        : t2 ENTER BEGIN 1+ ENTRY dup 0= UNTIL ;
        : t3 BEGIN dup WHILE 1+ REPEAT ;
execute (ticks) JS/TC           Minerva/GC      qxl 2.31  +cache
        t1      319             49               70        17
      1 t2      256             47               80        20
      1 t3      271             58              110        28

{r+} is a very special non-standard word of universal use, which also may
help to optimizing some words, mainly those which contain a generally appli-
cable sequence of words, differing by just one or two which may follow a
generalized main routine and execute:
        : 'general bell r+ execute bell ;
then
        | 'general .s |
would execute
        bell .s bell
A such defined sequence may only be compiled, or temporary compiled, as above!
If called by direct keyboard input the system would re-start after an address
error, or, on bad luck, lock up or worse. The hi-level equivalent is:
        : r+ r> dup 2+ >r @ ;

Furthermore the words {rdrop} and {;s} might be used to drop the return to
the calling word, or immeadiately leaving the word just executing. This in
many cases considerably could reduce the execution time. Where {rdrop} should
be used with great care, to prevent return to some data which don't represent
a forth-address suitable to be used by the instruction pointer.

When {local}s have been initiated in a word, {;s} or {-exit} should not be
used, otherwise the locals space won't be released - only {cold} or other very
special calls would re-gain the lost memory in such events.

* Multiway decision
The very safe special constructs for fast multiway decisions {associative:}
{case:} {range:} are "state smart" and may be defined as named "stand alone"
active words or may be part of a high level word:

associative:
        use: associative: {name} n1 n2 n3 .. nn ;
                or, within a colon definition
        use: ..words.. associative: n1 n2 n3 .. nn ; ..words.. ;
        compiles: the true numbers, or the 4th-words pfa if found in the
                context vocabulary
        executes: (nn -- index)
                whith the index to the position where nn was found in the list,
                the number of items otherwise, the index starting with zero.
case:   use: as {associative}
        compiles: the 4th-words cfa or the number values if the word wasn't
                found in the context voc. and successfully has been converted
                into a single integer
        executes: (index -- executing | nn)
                the indexed cfa will be executed if the list was built of all
                4th-words. If there was at least one number given when defining
                it will be handled as a list of integers to be pushed to the
                datastack corresponding to the indexed position, instead.
                Case numbers will then be returned by their true value, and 4th-
                words by their cfa, ready to {execute}.
range:  use: as {associative}
        executes: much the like associative, giving the index of the range
                from the number one less than the next higer item till the
                number below or equal to the next lower item in the list.
                Returns zero on underflow, and the number of items+1 on ovf.

Each word builds a list of numbers, the list input being terminated by ";".
In the case of {case:} numbers will be compiled if at least one list item
wasn't found in the context voc. and successfully was converted to a number.
Executing words are compiled only if all were found in the context vocabulary
(or its search order, {root} inclusive). {associative:} compiles to return
single numbers, in the case of 4th-words their pfa, a number otherwise.
Thus the predefined constants (-1,0,1,2,3) should be forced to be interpreted
as numbers by one of the number-base affixes (%,!,&,#,¶,$,{,",') to preventing
them erroneously being compiled as pfa instead of their value.
An error condition exists if a word can't be found and is not a number.

While defining a list structure the vocabulary search will be limited to
current and context, regardless of the additional search order selected,.
The vocabulary inherent 2nd search order - if enabled - remains active.

While any other immediate word would be executed {;} is used to terminate the
list compiling phase. Thus {-->} continues compiling the current list on the
next screen. No comments nor intermediate calculations may be inserted when
compiling. Intermediate operations would be possible, though, if they are
executed by and completely in a single (specially defined) immediate word.

A such defined ASSOCIATIVE: list returns the highest index of where a number
parameter was found or, if there was no match, the top index + 1.
The opposite action could be forced by CASE: if at least one number was found
in the input list which was not a word in one of the then valid vocabularies.

At run-time the CASE: construct fetches the parameter as an index to its list
and executes the word found at the corresponding position. If the index was
greater than the number of list entries, the last word gets executed or, if
the index was negative, the first. Thus the top and the first entries can be
utilized as error handlers or for some default action.
If compiled as a list of numbers the indexed number will be pushed to the stack.
Examples can be found in the editor accompanying this 4th system ("fig_scr").

Compiling and executing/fetching is very safe. It is not possible, to get a cfa
that wouldn't be executeable, or is beyond the current dictionary pointer, due
to the word having been discarded by {forget}; nor a number from an address
which is not within the index range.

Both the associative and case constructs may be combined in a colon definition:
        : NAME .. words ..
          ASSOCIATIVE: 60 30 90 ; CASE: word1 word2 word3 overflow ;
          .. words .. ;
which would be similar to the commonly known case/of/endcase contruct, though
compiling shorter and executing much faster because of the precompiled lists
where after the 1st search no consecutive comparisons will be necessary.

RANGE: also may be used inline or as a stand alone named forth-word. It works
much like {associative:}, very efficiently associating an index to a range of
numbers with the result of
        n1 {name} -- n2
such that n2 would be the index to the interval [rn(n2),rn(n2+1)-1]
        range: {name} rn1  rn2  rn3  ..  rn(n-1) rn(n) ;
       (index:     ¼ 0 [ 1  [ 2  [ 3 [ .. [  n-1  [  n ½ )
the lower border inclusive, the higher border exclusive. The zero index
indicates any value below the bottom number, the index of (no. of items)
indicates top verflow.
An example to this word can be found in "fig_scr" where the tabulating
distance for the TAB keys is calculated from the RANGE:-list {tb}.

Using very long ASSOCIATIVE: lists the most frequently used codes should
best be put last because the search begins at the end of the list.
CASE: always executes with the same speed, consuming about the same time as
one single {false IF .. ELSE} decision.
RANGE: at any condition would work out to executing much faster than the
standard words approach.

* compiling special "hand made" lists:
        associative: special ;  \ empty list, ready and safe
        here 2-                 \ limit pointer
        1st.no.  ,              \ compiling any kind
        next.no. ,              \ of integer values
        ...                     \ up to 16382 items
        last.no. ,
        >resolve                \ adjust & store the list limit

* A sine translation could be built
 case: sintab ; here dup 2- off                         setup a number table
   182 over 4- +!                                       enter max. index-pointer
   182 allot                                            reserve dictionary space
   fp pi 180 / -1 forth                                 prepare constants
   | 182 0                                              temporarily compile the
        DO fp 1 + over over * sin 10000 * f>d           loop structure to build
           forth drop 7 pick i + ! 2 +LOOP drop |       the table entries
 : sinus 0 360 um/ drop dup 180 > minus swap 180 mod
       dup 90 > IF 180 swap - ENDIF sintab swap +- ;    calculation ready

* The more conventional CASE OF ENDOF DEFAULT construct
   : name ..words..
        CASE
         n1  OF ..words..  ENDOF
         n2  OF ..words..  ENDOF
         n3  OF ..words..  ENDOF
         DEFAULT ..words.. ENDCASE ..words.. ;
* could be transposed, even this short a sequence executing much faster:
        : 1stcase ..words.. ;
        : 2ndcase ..words.. ;
        : 3rdcase ..words.. ;
        : nocase  ..words.. ;
   : name ..words..
        ASSOCIATIVE: #-1 n1 n2 n3 ;
        CASE: nocase 1stcase 2ndcase 3rdcase nocase ; .words.. ;

* deferred vectoring
   case: casename bell bell bell bell bell ;
where each case defaults to bell and later might be redirected to execute
any other word
   2 ' vlist IS casename
would do
   1 casename           rings the bell,
  99 casename           also,
   2 casename           executes vlist.
The re-defining also applies to the other list-structures which are the
{case:}-lists of number values, {associative:} and {range:}.

If one cannot dispense with the above (fairly inefficient) Eaker's cases
the words concerned may be compiled from "forth_scr".

*
IS can be used as a general operator to store a value to the datatypes
   case:           defer           constant        variable        user
   2constant       2variable       constant (fp)   associative:    range:
* examples
   (base already defined user-vari)  #12  is base
        123   constant shortcons     999  is shortcons
        123   variable shortvari     999  is shortvari
        123. 2constant longcons      999. is longcons
        123. 2variable longvari      999. is longvari
     fp 123   constant fpcons rvoc  \999  is fpcons
        whereafter              would display
           base@ hex . base!           C
           shortcons .               999
           shortvari ?               999
           longcons  d.              999
           longvari 2@ d.            999
           fpcons    \.              999
* Storing and fetching a value this way would execute
        nn IS cons      about 10% slower than   nn vari !
        nn ' cons !      exactly the same as    nn vari !
        cons                  40% faster than   vari @

* deferred words
may temporarily be toggled non-/operational by setting/resetting
the l.s. bit of the execution vector (thus leaving an even/odd address)
   off:  ' {name} dup @ 1 or swap !
        : ?vec @ dup dup + 0= over 0= or swap 1 and or 0= ;
                                     wherafter ' {name} ?vec returns 0
    on:  ' {name} dup @ -2 and swap !   (if =/= 0)      ?vec         1
off/on:  ' {name} 1+ 1 toggle
   off:  ' {name} never
         ' {name} 1+ 1on             which may be restored with {toggle}

Don't:
         ' {name} 2+ off
A zero vector will execute because with the base address displacement used
within the F6 system this works out to an address right in the middle of the
dictionary space.

* deferred words safety
{defer} compiles an additional {noop} behind the standard pfa to facilitate some
in a way automatic safety if the deferred action became invalid by {forget}.
This doesn't apply to an odd vector, leaving the fast on-/off-facility as it is.
Defining both the deferred and the default action
        ' {action} IS {name} ' {default} cfa ' {name} 2+ !
The default action would then be restored by the system itself as soon as the
current action is no longer valid. Which could be forced by
        default-is {name}
which compiles (or executes)
        ' {name} dup 2+ @ swap !
{default-is} can also be applied to a single {constant} or {variable} where it
will restore the standard value from the cell immediately after:
        144 dup constant lines/page ,
which, eg.g., might be set to another value by some printing utility, finally
to be re-set to the default value by
        default-is lines/page

* case: cfa-list safety
{case:} wouldn't execute an address which is beyond {here}, nor a -ve zero
($8000) or an odd address.

*** vocabulary searching - (as modified in versions 6.00+)

This system provides both, the classic f.i.g.-forth vocabularies, where other
vocabularies will be defined as subsets of the vocabularies where they are
defined in, and the stack structured search order of the more recent standards.
Additionally the fp-literal compiling facility when {fp} is current will be
inherited by the sub-vocabularies of {fp}.

The stacked search order is structured slightly different to the f-83 type
to maintain compatibility with the f.i.g.-forth model and the special 2nd
order vocabularies described below:

also     (r)(I)push the previous context voc. to search order stack
previous (r)(I)pop context out of the current search order, move ocontext
            to context, and the vocabulary prior to ocontext out of the
            search order stack to become the new ocontext.
only     (r)(I) only root will be searched
#vocs       the maximum number of vocs. to be stacked in the search order.

This might explain the rank of the vocabularies:

(lower memory             usage)
        ocurrent        where {definitions} saves the previously current voc.
  ½¾    current         valid {current} voc.

 prevdef                restores the previously valid {current}

(vocabulary stack bottom  usage)
  ½¿    context         valid search vocabulary - after {current}
   ¿    ocontext        1st storage, old {context}, but not stacked yet
   ¿    [ ...           up to {#vocs}-2 deep vocabulary stack where
            ...]        {ocontext} will be pushed to after each {also}
end of voc.stack

As long as no extra user-variables have been defined the vocabulary stack
may be extended as follows:
        8                       \ no. of additional stack items
        dup #vocs + IS #vocs    \ calculate new maximum
        dup + up +!             \ reserve space in user area
        w-save flp1_f6          \ save the modified system

An example sequence:
        only            \ clear search oder, leave only {root} in {context}
        forth hidden    \ search order now: 1.{hidden} 2.{forth}
        forth           \ search order    : 1.{forth} 2.{hidden}
        definitions     \ {forth} becomes {current}, search remains the same
                        \ {root} will always be the last voc. searched
        editor          \ {hidden} disappears and leaves: {editor} {forth}
        also            \ push all vocs. one item up
                        \ the search order to become: {editor} {editor} {forth}
                        \ which changes within a {:} colon definition to
                        \           {forth} {editor forth}
                        \ this also is the thereafter valid search order
Or,
        only forth fp editor also forth also also definitions
produces the search order
        forth forth forth editor fp
where whenever a new voc. was called the previous {current} would move to the
2nd position, while the other items remain unchanged and accessible. The latter
facility to prevent a carefully selected search order to step by step getting
pushed out of the stack when frequently changing the {current} vocabulary to
compile selected words from other vocs, still leaving the main voc. active.

                             forth   forth   forth  editor fp
        forth        =>      forth   forth   forth  editor fp
        forth        =>      forth   forth   forth  editor fp
new vocs leave the 3rd+ search-vocs as they are:
        qdos         =>      qdos    forth   forth  editor fp
        pif          =>      pif     qdos    forth  editor fp
        minerva      =>      minerva pif     forth  editor fp
and:
        rvoc         =>      pif     pif     forth  editor fp
        rvoc         =>      pif     pif     forth  editor fp
but:
        previous     =>      pif     forth   editor fp
        previous     =>      forth   editor  fp
and:
        also         =>      forth   forth   editor fp
        assembler    =>      asm68   forth   editor fp
        definitions  =>      (no change in the search order)
        forth        =>      forth   asm68   editor fp
        also         =>      forth   forth   asm68  editor fp

Another procdure, e.g.,
        also {1st.voc} also {2nd.voc} also context 4+ off
will restrict the voc. search to the most recently called two vocabularies
while maintaining the previously valid search order recoverable simply by
        previous previous previous
{single} when compiled will restrict the immediatly following voc. search
to the then current vocabulary only.

For safety reasons the {root} vocabulary under all circumstances will be
searched. Thus it is adviseable to include only the most important system
calls which always need to be availiable in that vocabulary.

* inherent 2nd search order
Additionally another vocabulary can be liked each one to be searched after a
word was not found in the one called. Thus calling a vocabulary may invoke
a 2nd search order inherent to that one. This may be dis- or (re-)enabled.

The link to search multiple vocs is prepared at
 ' {voc.name} 8 +
linking in a new vocabulary:
 ' {2nd-voc} ' {1st-voc} 8 + !

A search in {1st-voc} will then continue in {2nd-voc}, thereafter probably in a
3rd voc, if the 2nd one had an own 2nd search set, and so on, until a loop back
to the same vocabulary or a zero link was found, before searching 'latest @ @'
(again 2nd search inclusive) and, finally, root.
Use the words
   search {name}   to attach a 2nd search vocabulary to the context voc.
   no-search       to unlink the 2nd voc. of the context voc.
   rvoc            to re-install the previous context search order.
   2nd-voc off     to disable the inherent 2nd order searching (default),
   2nd-voc on      to re-enable all previously defined 2nd search orders.
The 2nd search order is initially set to the vocabulary where it was defined in.
It shouldn't be applied to root itself as that would lead to an endless search!

As no vocabulary will be searched twice the inherent order can be suppressed
by setting it to the own name:
        forth definitions search forth


Finally, which is a f.i.g.-4th feature, {forget} goes through all vocabularies
of the current search order defined in the (f83-style) search order stack.
It will unlink whatever has been defined from the word to forget on, regardless
of the vocabulary where it belongs to, also removing vocabularies in that area.
Even forgetting the current or context vocabularies doesn't cause a problem. If
a vocabulary was forgotten, the procedure will end up with {forth} being both,
current and context.


*** program security by sealing an application:

seal    will hide all words currently existent in the {current} vocabulary,
        while other vocabularys may be sealed by
                ' {vocabulary} 2+ dup 2+ !
        Those vocs remain accessible, with the old words UNRECOVERABLE forever.

A few examples of how the condition to giving away the F6 system mentioned by
the author could be met:

By inhibiting new colon definitions:
        $C180 ' : nfa !

Sealing an own application and the system, depending on the inbuilt bound, by
disabling the detection of new words:
        : [fnd] [ -find @ , ] dup
          IF 2 pick ' task >            \ this might be changed
            IF 2drop 0= ENDIF
          ENDIF ;
        ' [fnd] dup cfa ' -find 2+ ! is -find

or, completely disabling the access to any new input very rigidly by forced
giving up the F6 job when trying to interpret:
        ' bye cfa ' interpret !


*** "turnkey application"
        ' {initial-word} cfa (quit) !
setting up an F6-job will then start executing {initial-word}

*** active {forget}ting (just an idea, not implemented yet:)
Special actions on forget might be necessary e.g. when a memory segment
was allocated and the words concerning are to become forgotten. this
is taken provision for by the words
  forget-lk   (-- ptr)          linkage through the relevent words
  doforget    (nfa -- nfa)      deferred empty, for the scanning procedure
  forgets>    (--)              linking in the following words
The structure:
 : name ..words.. <builds ..words.. does> ..words.. forgets> ..words.. ;
where {forgets>} terminates the {does>}-part and compiles the link to
the latest forget-active word or zero. {forget-lk} then would keep the
topmost link ptr:
               forgets>                       ;
 [nfa]..     ..[link][docolon][cfa][cfa].. [semis]
The - not yet defined - procedure of {doforget} should read and compare the
linkage with the nfa delivered by the call to {forget} and execute whatever
follows a link ptr which is greater than this nfa.
{forget} itself is prepared such that it calls {doforget} first, before any
other action, delivering the nfa of the word to forget to {doforget} and
dropping one item from the datastack afterwards

*** Access to the SuperBASIC (1st) interpreter
        {sbasic-name} basic ( ernum )
wil execute a parameterless call to any resident SBasic procedure.
        BASICV" sbasic-vari-name"
will fetch the pointer to any variable defined within that SBasic interpreter,
re to "forth_scr" for further explanation.

*** EX/EW from Basic - initial commands
any valid sequence of f6 words can be passed up to a maximum of 1K bytes with
the EX-command parameter-string. If "pex" for hidden window operations was
installed, using a minerva-rom, this example will set up the 4th job, return
to basic and back into the editor after compilation:
   EX'qf';'cr bell using flp2_fig_scr 1 load pick-4th edit' : n=PICK%

Self-start might be controlled by setting (quit) to any other main procedure,
where then no parameters would be recognised if not explictly called by the
application. The command string then might be passed to the interpreter:
   #16 hidden chp rvoc 2+ dup 2- @ dup
   IF tib @ swap 2dup + off cmove in off ELSE 2drop ENDIF

The Hotkey-System supplied commands
   EXEP         HOT_CHP         HOT_RES
modify the F6 (or any other) jobs own register values and therefore should,
if ever, be used very carefully.

*** 'multitasking' windows
Provided the supplied code extension "dvs_byt" was loaded the windows could be
set to the globally multitasking (hidden operating) mode by directly accessing
(any parameterless callable) resident Basic-commands:
   " peon" basic drop
and, switching the windows multitasking off
   " peoff" basic drop

*** "profiling"
an example of comparing execution times using the inbuilt timer {tick}:
   ti-cal               \ calibrate no. of loops/sec  (1/10 68000 cpu clock)
   : nothing ;          \ which executes: docol semis
   | tick 1000 0 do 1000 0 do nothing loop loop tick d- dminus d. |
                        => 856*20ms => 17.1 °s ea. <nothing> + loop-overhead
                                                             + other jobs
wich could be built into a set of new words
   0. 2constant cal             \ for the "empty" loop
      defer (t)                 \ to contain the word under test
   : test tick !csp 30000 0 DO i i (t) csp! LOOP tick d- dminus cal d- ;
   : trial test 2. 3. ud*/mod d. ." ms" 2drop ;
1st run to find the empty loop time:
   ' noop is (t)                \ executes just a jump to the 'next' location
   0. is cal ti-cal test is cal \ find and memorize the empty loop time
now deriving the execution time in milliseconds
   ' {word-under-test} is (t) trial
translating to 68008-timing:
   tick 5. 3. ud*/mod 2sdrop

Furthermore the debug facility could be used to a more elaborate analysis,
such as sending the word names to a file, and the {tick} count at that moment.
This later could be evaluated to gain the statistics of how often a word was
called and what its (relative, because of the additional runtime overhead)
execution time was.

* another example executing direct input:
   | 33 -28 do cr i i . message key drop loop | <enter>
will show the available messages.

* mixing hi-level & lo-level
   : .NUM dup code $3b15 , $3b15 , ;c $. &. %. #. ;
which would print a number from stack sedecimal, octal, binary and decimal.
There is no limitaion on the number of consecutive {code} and {;c} sequences.
A hi-level word may end primitive code compiling terminated by a jump to
{[dosemis]} and {smudge}d explicitly to enable {-find} later detecting it.
A primitive word may end up executing hi-evel words
    create .NUM $3b15 dup dup , , , ;c $. &. %. #. ;

* channels
A new channel can be opened as follows; the example being a 4th screenfile,
which gets compiled if the attempt to open was successful. Otherwise abort
will be executed with the appropriate error message.
   fopen flp2_fig_scr screen is-chan 0 load

* interpreting any text input
   : do-text 1+ count tib @ 2dup swap + off swap cmove 0 in ! interpret ;
do-text         (ptr --) where ptr is the location of a word-counted string
   " vlist " do-text       interpretes from pad and executes {vlist}

*** Local variables (from vers 7.24 on):

local   (I)  entry:             LOCAL ABC..|
             compiling:         ( ptr 9 -- ) resolved by {;}
             calling:           LOCAL B
-loc    (I)  ( | name -- ptr )
             re-assigning:      ( nn ) -loc B ! ( -- )

        Each high level word may contain up to 26 local variables, regardless
        of their size (single or double integers). There is no other limit to
        the number of words where locals are defined in as the availiable
        dictionary space and runtime memory.

        This definition is fully transparent to the system, not restricting
        any one of the standard 4th-operations, both the stacks inclusive!
        Access to the DO-loop indices therefore is unchanged, as is any other
        stack manipulation. Even such "dirty" tricks as "rdrop" to return one
        level back might be used (under certain precautions).
        Local variables may be used recursively and multitasking.
        Limitations are when exiting a word in an unstructured manner, where
        the locally reserved dataspace would not always be assigned back to
        the system, i.e. when leaving a word by {exit} or {;s}.

        {warm} and {cold} clear the local area and reassign their dataspace
        back to the system, while {abort} and {error} don't.

        {tib} initially contains the same address as {s0}, determining the
        top of the empty datastack. With each new block of local data that
        stack-top will be moved "down", with all its items which might have
        been stacked previously, the local data being inserted on top of
        the datastack (or, with stack terms, below the bottom of stack).
        The structures being:
        [ returnstack =>  <= tib | locals => | datastack =>  <= dictionary ]
                                tib         s0
        where s0 moving "down" with each newly assigned block of local data.

        The locals safely can be discarded by {s0} restoring to the contents
        of {tib}, as that is the initial pointer to both the empty datastack
        and the empty local area.

        Locals will be accessed the same manner as contants, calling the
        word {local} followed by a letter ranging from a to z, or A to Z,
        respectively, where capital letters indicate double sized integers.
        There is no limit control when reading, thus previously defined locals
        may be acessed by indices on top of the topmost own locals index.

        Initiating a number of locals is done en block at the beginning of a
        high level definition ( any place as long as no other compiling data
        have been feched to the stack ). At runtime successive stack data
        will be assigned to the locals, from tos to local in ascending alpha-
        betic order.

local abc..|                            sys: --  stringptr 9
local ABC..|    ( nX.. nC nB nA -- nX ) loc: ..nn  -- ..nn nC nB nA
        Locals defining. The delimiting "|" mustn't be left off, otherwise
        the system might crash!
local |
        Just compiles to enable access to the local area, the locals of parent
        words being accessible by the same names as valid in the calling word.

IF .. local .. ELSE                     sys: nn -- nn
        cannot be used to define a local list,
        compiles reading or re-initiating existing locals.

local a                                 sys: nn -- nn   (single integer)
local A                                 sys: nn -- nn   (double integer)
        Only the very first {local} can be used to define a list of locals.
        Any consecutive call will compile reading its contents.
local a ( -- nn )
        reads a single integer local, regardles of how it was defined.
local A ( -- dn )
        reads a double integer local, regardles of how it was defined.

-loc A  (I)( -- ptr )                   sys: nn -- nn   ( nn beliebig )
-loc a
        pushes the memory ptr of the local concerned to the data stack,
        enabling locals manipulation as usual with variables.

;       (I)( -- ) modified              sys: -- | stringptr 9 --
        semis has been modified to resolve the words local area and reassign
        its memory back to the system. This additional action will be compiled
        if in compilestate at least one item on stack is left and suits to the
        test pattern. An error occurs if no match was found or the expected
        additional ptr to the local-defining list is missing.

>loc    ( n1 -- )                       F6 8.07+
        for "dynamic" (runtime) allocation of n1 bytes(!) of local memory.
loc>    ( n1 -- )
        links n1 bytes of local memory back to the stack/dictionary space.

end-loc may be used prior to unstructured leaving a high level word.
        It is not provided by the system but may be defined as
                : end-loc [ ' -loc nfa even 6-  ] literal , , ; immediate
        which enables
                : probe local ABC| ...
                        ... IF ... [ 12 ] end-loc ;s ENDIF ... ;

* a recursive example
                : fak local A|
                  local A -1 m+ 2dup -2 m+ d0< 0= IF recurse ENDIF local A d* ;
                12. fak d.
        returns
                479001600.

*** compiling conditionally (when loading from screenfiles):
Single commands may be managed conditionally by {if-true}, {if-found}
or {if-nfound}, and {+continue}. for intermediate calculations more
flexible structures would be possible between single-line-{|}s.

 ..words..
 if-found hallo -->                   ( continue next screen )
 : hallo ." hallo " ;
or
 ..words..
 if-nfound hallo : hallo ." hallo " ; ( compile conditionally )
 ..words..
or
 ..words..
 if-found hallo   2 +continue        ( continue 2nd block (this one exclusive)
 : hallo ." hallo" ;                 \
 ..words..                           \
                                     (this will be the block to continue with)
or
 | scr @ 1+ -find hallo
 0= if drop 99 else 2drop endif |
 dup load       \ load scr 99 or next
 | 99 = if [compile] --> endif |
 ..words..      \ to compile if {hallo} was
 ..words..      \ not loaded from scr 99

or, an example fetching the no. of bytes per disc allocation unit
 b/alc pad                      ( default and temp. memory )
 qdos xinf rvoc                 ( try fs.xinf of the level2 device handler)
  0=                            ( prepare ok/error )
  if-true drop pad $1e + @      ( if xinf was ok fetch the actual size )
 constant cbyt                  ( put it into a constant )

*** debugging
* From v7.24 on the active debugging words have been moved to "forth_scr"
* where they can be compiled from by { l-load debugger }.
There is a simple DEBUGGING facility which, if active, compiles an additional
cfa for each executeable word to display, if active, its name (if it has one):

{debug} ( cfa nn -- ) {case:}-vectored list to execute the {db-on}th debugging
        procedure. Currently defined for values of {db-on} = 1, 2, 3, 4; may
        be extended to up to 9 vectors ( 1 to 9), where the 'empty' ones are
        pre-set to {drop}, executing the 'do nothing'-condition. - the value
        of 'nn' would be consumed by the {case:} decision. Within the runtime
        procedures 'cfa' would be the cfa of the word to execute next.
        (pse, don't use no. 9 as this later might become a discompiler call)
{debug} ( cfa nn -- ) for testing purposes may be called on its own.
        At runtime {debug} will only be called on values of {db-on} =/= 0, the
        runtime procedure being hidden and empty-named such that the debugging
        could not (endless) debug itself.
re-vectoring the usual way:
                1 ' drop is debug
        would set the debugging procedure on {db-on} = 1 to 'do nothing'.

{db-on} (-- nn) constant, toggling the debugging on/off
        1 is db-on
        : pp ." TEST" first last $. $. ;
        pp
would display
        (.")  TESTfirst limit $. 7F86 $. 7B46 ;s
alternatively line by line, waiting for a keypress to continue, and
also displaying the stack contents from before entering the word shown:
        4 is db-on pp
        [10 0] (.")
        TEST[10 1] 30598 first
        [10 2] 31686 30598 limit
        [10 2] 31686 30598 $.
        7F68 [10 1] 30598 $.
        7B46 [10 0] ;s
(The display would be indented by one space when calling a secondary word.)
or
        3 is db-on              as 4, not waiting
or
        2 is db-on
which does the same, not waiting, and printing consecutively with no {cr}s.
The extra printing might be switched off. The words then appear as normal:
        0 is db-on
        test
        TEST7F68 7B46
A section of hi-level code may be monitored
        0 is db-on
        : test ." Test: " 10 0 DO [ 1 is db-on ] ... [ 0 is db-on ] LOOP ;
        2 is db-on test
would then display what happens within the loop only.
Conditional debugging:
        2 is db-on
        : test ." Test: " tick db-on
          200 0 DO
           tick or >|< xor i * dup 2dup ' tick 2+! or 0< minus is db-on
          LOOP is db-on is tick ;                             ( ¾ )
        0 is db-on test

during debugging pressing the ESC key would abort the debugging process and
leave to {quit}, while CTR/ESC (or CTR/` with english keyboards) toggles the
displaying procedures on or off.

*** strings
There are no extra words provided for string processing. Forth has no inherent
datatypes and as such any data may be treated as string data. Thus the multiple
move and the double integer processing words may also be used for strings:
        ( ptr count --) bounds DO i c@ LOOP     \ fetch all chars to datastack
        ( ptr count --) dup 1+ 2/ minus ndrop sp@ swap cmove \ packed chars
        ( ptr count --) m>r                     \ push them to the returnstack
        ( ptr count --) r>m                     \ store them to 4th-memory
        ( count -- chars ) nr>                  \ transfer to the datastack
        ( count -- )    ndrop                   \ drop all string chars
        ( ptr count len ) swap drop             \ truncate string to len chars
        ( ptr count num ) dup minus d+          \ leave trailing count-num chars

Thus printing the time out of the QDOS date$ string:
        date$ 11 -11 d+ type            \ SBasic:       PRINT DATE$(12 TO);
or, the date only:
        date$ drop 11 type              \ SBasic:       PRINT DATE$(1 TO 11);

Where in these examples, as usual in 4th, {ptr} points to the 1st character of
the string, {count} determining its full length, commonly of up to 255 bytes.

Text output formatting is supported by:
        .(r)   (n1 n2 -- n1)
which expects the charcter count n1 of some output data to be printed right
justified and the full length of their display field n2; it will send as many
characters the code of which is stored in the user-vari (r) to reach a position,
where the following text output then will end at the n2-th charcter position.
{.(r)} is the formatting procedure of {.r} and {d.r}. To demonstrate:
        123.456 10 d.r
or
        date$ 30 .(r) type {, emit day$ 5 .(r) type

Despite, there are the multiple data comparing words like {s=} which, certainly,
have their most important use when searching and comparing string data.


* 7. ----------- system information - (subject to change) -------------------- *
        For the current version refer to the assembler source,
        which accompanies the each version of the F6 system.

* f.i.g.-standard word header

 [ 1 s p c c c c c ][ name!$80 ][ link ][ ptr ][ parameter ][ wa ][ wa ] ...
 ¾nfa                           ¾lfa    ¾cfa   ¾pfa
nfa     namefield address
        the name with bit 7 of its last char set,
        preceeded by a byte with also the 7th bit set,
        the precedence-bit (6), smudge-bit (5), and the l.s. 5-bit word count
lfa     linkfield address
        points to the nfa of the preceeding word of the current vocabulary
cfa     codefield address ( or: compilefield )
        points to executeable processor code which determines the nature of
        this word or would be the processor code entry of a primitive word.
        the cfa will be compiled into the parameter field of a calling word.
pfa     parameterfield address
        list of any data corresponding to what the cfa-procedure needs
wa      word address, the cfa of an executable 4th-word

When {create}ing a word the nfa would be aligned such that the last byte of
the name comes to end at an odd address, in the case of even name-length
leaving the byte at nfa-1 unused, set to the same content as (nfa).

* the structure of the vocabulary definition

 [name][lfa][dovoc][vocnfa][voctop][voclink][search][xx]

vocnfa  the 1st (dummy) word of a vocabulary
voctop  the dummy linkfield points to the latest (top) word of this vocabulary
voclink the dummy codefield links this vocabulary to the preceeding one,
        the latest voclink is stored in the variable {voc-link}
search  determines the 2nd search order
xx      the hi.byte contains the fp-literal fetching flag
        the lo.byte is reserved for the {-find} already-searched flag

forth {forth} dodoesgreat
        dc.w dovoc-Z    pfa
        dc.w $81A0      this is the 1st (dummy) namefield of the vocabulary
        dc.w fthtop-Z   points to its latest cfa
[prevlab]v dc.w [lastvoc]-Z  ((voc-link)) ½ (voc-link), last link is zero
        dc.w $8000      may become ptr to pfa of 2nd search order voc.
        dc.w 0          flag used by {-find}
lastvoc setstr [prevlab]v

* primitives
In case the assembler is not loaded, some easy means of mixing hi-level and
lo-level compiling is provided by the above mentioned words {code} and {;c}
and the following locations. Some may be found in the {asm68}-vocabulary
(which in the current assembler source - 7.14 - are outcommented).

* "long" primitives
Most of the kernal words are defined as primitives (directly executing some
processor code). Normally those would mess up much of the valuable addressable
dictionary space which is restricted to 64K bytes. Thus, whenever possible,
the code was put outside, to be called by a 32-bit displacement call. These
primitives have a special cfa and a double integer wa:
        {safe!}         nfa: with count.b and the name
        link            lfa: as usual
        [dojump]        cfa: ptr to longword-pfa execution code
        Xsafesto-bp     double pfa: longword 4th-ptr to the runtimecode

* the next-entry will be found at {[donext]}
donext  move.w    ([ip])+,[w]     <jmp ([nx]) to here
next1   add.l     [bp],[w]        <execute
next2   move.w    ([w])+,a1
        jmp       0([bp],a1.w)

* "long" primitive entry
dojump  move.l  ([w])+,a1
        jmp     0([bp],a1.l)

* calling a deferred word
Cdefer  pea     ([ip])
        lea     c4thret(pc),[ip]
        jmp     dodefer(pc)

* hi-level subroutine call
* use: create {name} docall - to execute a subroutine with return to next
docall  pea     ([nx])            push 'rts'-destination
        move.w  ([w])+,a1         <hi- to lo-level entry
        jmp     0([bp],a1.w)

* lo-level to hi-level
* use: ..code.. bsr docontinue dc.w nextwa-Z .. dc.w semis-Z (for hi-level def)
docontinue move.l (a7)+,[ip]      advance ip to parameterfield
        [next]

* 4th memory

The bottom address of this system is at (signed 16-bit) $8000 relative to the
centre of the 4th address space, ranging from $8000(BP) to $7fff(BP), where
BP is the 4th address base pointer (processor register A6) of the system.

------------------------ v7.20+
4th-top    = +$8000+BP =    top of id table, bot. parameters of the EX command
                        16 langword items of channel-id's ( -1. if unused )
           limit            top of block buffer area, bot. of channel-id table
                        16 blocks of 2+64+2 bytes
           first            bottom of the block buffer area
                        256 bytes user-variable area
           (u0)¾ and (r0)¿
                        1088 bytes returnstack, downwards growing
                         170 bytes upwards terminal input buffer
           (s0)¿ and (tib)¾
           ............. <= this is where the v7.24+ locals will be inserted
                        free dictionary and datastack
                        (about 45K bytes for the virgin system)
           .............
           pad          80+ bytes of temp. workspace 80 bytes on top of here
           here         1st free space in dictionary
           .............
                        kernal 4th definitions and data
                        (about 17K bytes)
           .............
4th-bottom = -$8000+BP = bottom of 64K 4th-adress area
           .............
            code area   12K+ bytes of processor-code for the primitive
                        words, to start up the system and for the secondary
                        job. Not designed to be accessible by the user.
           .............
job base  - qdos-header jump into the system
------------------------

* {ctrl} vectored actions of the control-codes (0 to 31)
*   #parameters code   executing
                  0       send the next char's true value
                  6       cur. right & wrap
                  7 <bel>
                  8 <bs>  i/o-posn one step back - not <del> !
                 10 <lf>  & scroll up
                 11       cur. up & wrap
                 12 <ff>  clearscreen & home
                 14       cur. enable
                 15       cur. disable
        1        18 <tab> to (c1)pos and wrap on line
                 23       cur. left
                 24       cur. down
                 29       get wdw size & cur.pos
                 30       cur. home
        2        31       go to {x,y} no wrap ( col row -- )
                127 <del> one to the left of cur.pos

* Assembler source - F6 vers. 6.14 - subject to change -

The gst-assembler doesn't accept the left bracket within strings. Therefore
the create macro compiles the "`" as "[" instead, if "`" is the only, the 1st
or the last character of a name.

Building a (colon definition) word header is very simple (see assembly):
voc setstr vocabulary                           define context globally
label create {forth-name} docolon V: pif        V: optional local context

dataspace equ $8000-dptop-$404  max size ./. 1K parameterspace
        data  dataspace

* Registers: (D)estroyable, (I)nput only, (F)orth reserved
     ;          d0-d5     (D)
os      setstr  d6 (n.i.) (F) bank-offset rel(a6)
up      setstr  d7        (F) user pointer, needing offset by a6
id      setstr  a0        (D)
t       setstr  a1        (I) sometimes the absolute address of entered code
w       setstr  a2        (I) parameter field pointer
nx      setstr  a3        (F) jump address to next, leaving assembler
ip      setstr  a4        (F) forth next instruction pointer
sp      setstr  a5        (F) forth datastack pointer
bp      setstr  a6        (F) base ptr
rp      setstr  a7        (F) return stack pointer
* This is a hint because of own errors experienced:
When adding/changing any routines in the assembler source always watch the
registers to be written correctly, that one leading to desastrous mistakes:
        [sp]    for the data stack, never forget the brackets!

* ------------- ver. 6.14 forth-words in alpabetical order ------------------- *

This table is omitted to reduce the file length, it may be read and printed
when fetched as the screenfile "f6_gls" into the editor "f6ed".

 » .hpr'93/94/95/96 » eof »
