forth5mx_fvm.opp

Descripción del contenido de la página

Uno de los ficheros fuentes principales (la máquina virtual) de Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.

Etiquetas:

Código fuente

// forth5mx_fvm.opp

// Copyright (C) 2004-2010 Marcos Cruz (http://programandala.net)

// This file is part of Forth 5mx.

// Forth 5mx is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License
// as published by the Free Software Foundation; either version 2
// of the License, or (at your option) any later version.

// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.

// You should have received a copy of the GNU General Public License
// along with this program. If not, see <http://gnu.org/licenses>.

// -------------------------------------------------------
// Comment marks
// -------------------------------------------------------

// :!!! = not finished
// ?!!! = to be explored
// *!!! = temporal for debugging
// x!!! = obsolete
// b!!! = benchmark to decide

// -------------------------------------------------------
// Forth Virtual Machine
// -------------------------------------------------------


onerr oplerror // *!!!

    // Virtual machine init

xcold::
    // cold  \ Common use
    // ( -- )
    randomize day*86400.0+hour*1440.0+minute*60.0+second
    #ifndef _DSOURCE
        ib_opl_addr& = addr(ib$)
        ib_addr& = ib_opl_addr&+1
        temp% = KMaxSourceRecursions%
        while temp% // :!!! ?!!!
            recursive_ib$(temp%) = ""
            recursive_path$(temp%) = ""
            temp% = temp%-1
        endwh
    #endif
    dp& = dp0&

    // Autoexec

    ip& = xcoldstart& // point to the address of the next xt of the next word
    wp& = xautoexec& // ?!!!
    if wp&
        goto xvector
    endif

    gcls
    cls
    setfont:(font%,fontattr%)
    hello:
    goto xnext

    // EXIT is placed here for speed, to save one "goto xnext" in every high level word.
xexit::
    // EXIT  \ Core
    // ( -- ) ( R: nest-sys -- )
    ip& = peekl(rp&)
    _RDROP
    // this goes on to xnext...

    // Some primitives that ***do nothing***

xnoop::
    // noop  \ Common use
    // ( -- )

xchars::
    // CHARS  \ Core
    // ( n -- n )

    // Primitive dispatch

xnext::
    // NEXT \ PsiForth
    // ( -- )
//_DEBUG_NEXT?("en NEXT antes de actualizar wp&")
    wp& = peekl(ip&) // xt of the word to execute
//_DEBUG_NEXT?("en NEXT antes de actualizar ip&")
    ip& = ip&+KCell& // point to the address of the next xt

    // Input: wp& has the xt of the word to execute.
xvector::
//_DEBUG_VECTOR?("xvector")
    vector peekl(wp&) // nt of the word to execute
        xbrcolonbr
        xbrvariablebr
        xbrprimitivevariablebr
        xbrconstantbr
        xbr2constantbr
        xbrdoesbr
        xbrdeferbr
        xdouser
        xdoarray
        xdotable
        xdocode
        xbrcreatebr
        xbrvaluebr
        xbrmarkerbr
        xcold
        xexit
        xbrliteralbr
        xsliteral
        xnext
        xnoop
        xdup
        xdrop
        xswap
        xover
        xnip
        xtuck
        xqdup
        xpick
        xroll
        xrfetch
        xbranch
        x0branch
        xtor
        xrfrom
        x0equal
        x0notequal
        ximmediate
        ximmediateq
        xexecute
        xequal
        xnot
        xlatest
        xleftbracket
        xrightbracket
        xfetch
        xstore
        xkey
        xemit
        xdot
        xcr
        xtype
        xrefill
        xword
        xhere
        xfind
        xnamefrom
        xname
        xallot
        xerror
        xbye
        xinclude
        xnumberq
        xnumber
        xabort
        xplus
        xminus
        xdepth
        xstarslash
        x_and
        x_or
        x_xor
        xless
        xrot
        xminusrot
        xcmove
        xfill
        xatxy
        xemit
        x2drop
        x0less
        x1minus
        x1plus
        xcharminus
        xcharplus
        xcellminus
        xcellplus
        x2star
        x2div
        x2dup
        xexchange
        xcfetch
        xcstore
        xccomma
        xpad
        xtobody
        xscomma
        xmin
        xmax
        xdotname
        xbrdobr
        xbrloopbr
        xi
        xj
        xk
        xleave
        xbrplusloopbr
        xbrminusloopbr
        xthread
        xdown
        label00
        label01
        label02
        label03  // evaluate :!!!
        xinterpret
        xbrdebugquotebr
        xdebugquote
        xdebugnumber
        xdebug
        xcomma
        xcreate
        xcolon
        xsemicolon
        xprompt
        xcount
        xskim
        xspace
        xspaces
        xgat
        xgline
        xsquote
        xcompile
        xhome
        xfont
        xgbox
        xgcircle
        xgcolor
        xgellipse
        xgfill
        xgmode
        xgmove
        xgxy
        xbracketnumber
        xnumbersign
        xnumbersigns
        xnumberbracket
        xhold
        xsign
        xexit
        xkeyq
        xcells
        xchars
        xstar
        xdivide
        xnotequal
        xgreater
        xqabort
        xtasks
        xlookup
        xmod
        xslashmod
        xcolormode
        xaccept
        xcatch
        xthrow
        xbeep
        xbusy
        xabs
        xdays
        xday
        xmonth
        xyear
        xhour
        xminute
        xsecond
        xscreen
        xscreeninfo
        xgcls
        xsetcontrast
        xweek
        xthrow0
        xpluck
        xrp
        xsp
        xr0
        xs0
        xqcompiling
        xqexecuting
        xnegate
        xbold
        xthin
        xdotr
        xplusstore
        xcplusstore
        x0greater
        xunused
        xbodyfrom
        xindicator
        xplay
        x2over
        x2swap
        xdump
        xopenfile
        xclosefile
        xreadfile
        xwritefile
        xseekfile
        xmkdir
        xparsefile
        xpath
        xdeletefile
        xdirectory
        xallocate
        xresize
        xfree
        xdinit
        xdbutton
        xdbuttons
        xdcheckbox
        xdialog
        xdposition
        xdtext
        xdchoice
        xgetevent
        xevent
        xbrofbr
        xalign
        xaligned
        xrun
        xbacklight
        xbacklightq
        xrnd
        xminustrailing
        xsearch
        xcompare
        xparenthesis
        xbackslash
        xdotparenthesis
        xreadline
        xwriteline
        xcreatefile
        xrenamefile
        x2tor
        x2rfrom
        x2rfetch
        xdatetosecs
        xsecstodate
        xudot
        xpage
        xinvert
        x2plus
        x2minus
        xcompilecomma
        xlessorequal
        xgreaterorequal
        xsourceid
        xsource
        xsourcestore
        xsaveinput
        xrestoreinput
        xparse
        xupper
        xlower
        xincluded
        xincludefile
        xchdir
        xchdirq
        xdirstr
        xsetpath
        xbrsliteralbr
        xtosbuffer
        xplussbuffer
        xsbuffer
        xsbufferplusstore
        xsbufferplus
        xuless
        xmove
        xbrcompilebr
        xpostpone
        xsmove
        xbrleavebr
        xquit
        xudotr
        xumore
        xparseword
        xvariable
        xconstant
        xextend
        xcquote
        xbrcsliteralbr
        xnumbertib
        xtib
        xexpect
        xcolonnoname
        xlshift
        xrshift
        xstarstar
        xmarker
        xunloop
        xfilestatus
        xgetfilesize
        xbrqdobr
        xssquote
        xalias
        xquery
        xevaluate
        xcmoveback
//      xstarslashmod // */MOD
        xrdrop
        x2rdrop
        xtoupper
        xtolower
        xmcdrop
        x2constant
        xsbufferfree
        xms
        xfindname
        xdequal

        // new_primitives_here

    endv

    _REPORT_ERROR?("execution attempt of undefined primitive "+num$(peekl(wp&),5))
    goto xabort

    // Primitives

xms::
    // MS  \ Facility Ext
    // ( u -- )
    // :!!! Provisional implementation:
    // The OPL pause parameter is 1/20 seconds!
    // The Forth MS parameter is 1/1000 seconds!
    // No sign check (the action of pause depends on the sign)!
    // This word should be implemented in assembler.
#ifdef _TOS
    pause max(1,tos&/50)
#else
    pause max(1,peekl(sp&)/50)
#endif
    goto xdrop

xswap::
    // SWAP  \ Core
    // ( x1 x2 -- x2 x1 )
#ifdef _TOS
    temp& = peekl(sp&)
    pokel sp&,tos&
    tos& = temp&
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&+KCell&)
        MCPokeL&:(sp&+KCell&,MCPeekl&:(sp&))
        MCPokeL&:(sp&,temp&)
    #else
        temp& = peekl(sp&+KCell&)
        pokel sp&+KCell&,peekl(sp&)
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xtor::
    // >R  \ Core
    // ( x -- )
    // ( R: -- x )
#ifdef _TOS
    _RPUSH?(tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        _RPUSH?(MCPeekL&:(sp&))
    #else
        _RPUSH?(peekl(sp&))
    #endif
#endif

xdrop::
    // DROP  \ Core
    // ( x -- )
    _DROP
    goto xnext

xmcdrop::
    #ifdef _ASM
    print MCCall&:(mc_handle&,mc_xdrop&,0,0,0,0)
    #endif
    goto xnext

xnip::
    // NIP  \ Core Ext
    // ( x1 x2 -- x2 )
    _NIP
    goto xnext

x2tor::
    // 2>R  \ Core Ext
    // ( x1 x2 -- )
    // ( R: -- x1 x2 )
    _2INCREASE_RSTACK
#ifdef _TOS
    pokel rp&,tos&
    pokel rp&+KCell&,peekl(sp&)
#else
    #ifdef _ASM
        _FETCH_SP :\
        pokel rp&,MCPeekL&:(sp&)
        pokel rp&+KCell&,MCPeekL&:(sp&+KCell&)
    #else
        pokel rp&,peekl(sp&)
        pokel rp&+KCell&,peekl(sp&+KCell&)
    #endif
#endif
    _2DROP
#ifdef _ASM
    _STORE_SP
#endif
    goto xnext

xrfrom::
    // R>  \ Core
    // ( -- x )
    // ( R: x -- )
    _PUSH?(peekl(rp&))
    _RDROP
    goto xnext

x2rfrom::
    // 2R>  \ Core Ext
    // ( -- x1 x2 )
    // ( R: x1 x2 -- )
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,peekl(rp&+KCell&)
    tos& = peekl(rp&)
#else
    #ifdef _ASM
        MCPokeL&:(sp&+KCell&,peekl(rp&+KCell&))
        MCPokeL&:(sp&,peekl(rp&))
    #else
        pokel sp&+KCell&,peekl(rp&+KCell&)
        pokel sp&,peekl(rp&)
    #endif
#endif
    _2RDROP
    goto xnext

xi::
    // I  \ Core
    // ( R: branch limit index -- )
    // ( -- index )

xrfetch::
    // R@  \ Core
    // ( -- x )
    // ( R: x -- x )
    _PUSH?(peekl(rp&))
    goto xnext

x2rfetch::
    // 2R@  \ Core Ext
    // ( -- x1 x2 )
    // ( R: x1 x2 -- x1 x2 )
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,peekl(rp&+KCell&)
    tos& = peekl(rp&)
#else
    #ifdef _ASM
        // note: sp is already fetched by _2INCREASE_STACK
        MCPokeL&:(sp&+KCell&,peekl(rp&+KCell&))
        MCPokeL&:(sp&,peekl(rp&))
    #else
        pokel sp&+KCell&,peekl(rp&+KCell&)
        pokel sp&,peekl(rp&)
    #endif
#endif
    goto xnext

xqdup::
    // ?DUP  \ Core
    // ( x -- 0 | x x )
#ifdef _TOS
    if tos&
        _DUP
    endif
#else
    #ifdef _ASM
        _FETCH_SP
        if MCPeekL&:(sp&)
            _INCREASE_STACK_KERNEL
            MCPokeL&:(sp&,MCPeekL&:(sp&+KCell&))
            _STORE_SP
        endif
    #else
        if peekl(sp&)
            _DUP
        endif
    #endif
#endif
    goto xnext

xdup::
    // DUP \ Core
    // ( x -- x x )
    _DUP
    goto xnext

xover::
    // OVER  \ Core
    // ( x1 x2 -- x1 x2 x1 )
#ifdef _TOS
    _PUSH?(peekl(sp&+KCell&))
#else
    #ifdef _ASM
        _FETCH_SP :\
        _INCREASE_STACK_KERNEL :\
        MCPokeL&:(sp&,MCPeekL&:(sp&+K2Cells&)) :\
        _STORE_SP
    #else
        _PUSH?(peekl(sp&+K2Cells&))
    #endif
#endif
    goto xnext

xrot::
    // ROT  \ Core
    // ( x1 x2 x3 -- x2 x3 x1 )
#ifdef _TOS
    temp& = tos&
    tos& = peekl(sp&+KCell&)
    pokel sp&+KCell&,peekl(sp&)
    pokel sp&,temp&
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&)  // save x3
        MCPokeL&:(sp&, MCPeekL&:(sp&+K2Cells&))  // store x1
        MCPokeL&:(sp&+K2Cells&,MCPeekL&:(sp&+KCell&))  // store x2
        MCPokeL&:(sp&+KCell&,temp&)  // store x3
    #else
        temp& = peekl(sp&)  // save x3
        pokel sp&, peekl(sp&+K2Cells&)  // store x1
        pokel sp&+K2Cells&,peekl(sp&+KCell&)  // store x2
        pokel sp&+KCell&,temp&  // store x3
    #endif
#endif
    goto xnext

xminusrot::
    // -rot  \ PsiForth
    // ( x1 x2 x3 -- x3 x1 x2 )
#ifdef _TOS
    temp& = tos&
    tos& = peekl(sp&)
    pokel sp&,peekl(sp&+KCell&)
    pokel sp&+KCell&,temp&
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&)  // save x3
        MCPokeL&:(sp&,MCPeekL&:(sp&+KCell&))  // store x2
        MCPokeL&:(sp&+KCell&,MCPeekL&:(sp&+K2Cells&))  // store x1
        MCPokeL&:(sp&+K2Cells&,temp&)  // store x3
    #else
        temp& = peekl(sp&)  // save x3
        pokel sp&,peekl(sp&+KCell&)  // store x2
        pokel sp&+KCell&,peekl(sp&+K2Cells&)  // store x1
        pokel sp&+K2Cells&,temp&  // store x3
    #endif
#endif
    goto xnext

xtuck::
    // TUCK  \ Core Ext
    // ( x1 x2 -- x2 x1 x2 )
#ifdef _TOS
    sp& = sp&-KCell&
    pokel sp&,peekl(sp&+KCell&)
    pokel sp&+KCell&,tos&
#else
    #ifdef _ASM
        _FETCH_SP
        temp&=MCPeekL&:(sp&)
        _INCREASE_STACK_KERNEL
        _STORE_SP
        MCPokeL&:(sp&,temp&)
        MCPokeL&:(sp&+KCell&,MCPeekL&:(sp&+K2Cells&))
        MCPokeL&:(sp&+K2Cells&,temp&)
    #else
        temp&=peekl(sp&)
        _INCREASE_STACK
        pokel sp&,temp&
        pokel sp&+KCell&,peekl(sp&+K2Cells&)
        pokel sp&+K2Cells&,temp&
    #endif
#endif
    goto xnext

xpluck::
    // pluck  \ PsiForth
    // ( x1 x2 x3 -- x1 x2 x3 x1 )
    // ?!!! test
#ifdef _TOS
    _PUSH?(peekl(sp&+K2Cells&))
#else
    #ifdef _ASM
        _PUSH?(MCPeekL&:(sp&+K3Cells&))
    #else
        _PUSH?(peekl(sp&+K3Cells&))
    #endif
#endif
    goto xnext

xpick::
    // PICK  \ Core Ext
    // ( +n -- x )
#ifdef _TOS
    tos& = peekl(sp&+tos&*KCell&)
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&+(MCPeekL&:(sp&)*KCell&)+KCell&))
    #else
        pokel sp&,peekl(sp&+(peekl(sp&)*KCell&)+KCell&)
    #endif
#endif
    goto xnext

xroll::
    // ROLL  \ Core Ext
    // ( +n -- )
#ifdef _TOS
    temp& = tos&
    tos& = peekl(sp&+tos&*KCell&)
    while temp&
        pokel sp&+temp&*KCell&,peekl(sp&+(temp&-1)*KCell&)
        temp&--
    endwh
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        i& = MCPeekL&:(sp&)
        _DECREASE_STACK_KERNEL
        temp& = MCPeekL&:(sp&+i&*KCell&)
        while i&
            MCPokeL&:(sp&+i&*KCell&,MCPeekL&:(sp&+(i&-1)*KCell&))
            i&--
        endwh
        MCPokeL&:(sp&, temp&)
    #else
        i& = peekl(sp&)
        _DROP
        temp& = peekl(sp&+i&*KCell&)
        while i&
            pokel sp&+i&*KCell&,peekl(sp&+(i&-1)*KCell&)
            i&--
        endwh
        pokel sp&, temp&
    #endif
#endif
    goto xnext

xbrliteralbr::
    // (literal)  \ Forth 5mx
    // ( -- x )
    _PUSH?(peekl(ip&))
    ip& = ip&+KCell&
    goto xnext

xvariable::
    // VARIABLE  \ Core
    // ( "<spaces>name" -- )
    _PARSED_WORD
    _VALUE?(parsed_word$,0,xbrvariablebr&)
    goto xnext

xbrvariablebr::
    // (variable)
    // Run time code for words created by VARIABLE .
    _PUSH?(wp&+KCell&)
    goto xnext

xconstant::
    // CONSTANT  \ Core
    // ( "<spaces>name" n -- )
    _PARSED_WORD
#ifdef _TOS
    _CONSTANT?(parsed_word$,tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        _CONSTANT?(parsed_word$,MCPeekL&:(sp&))
    #else
        _CONSTANT?(parsed_word$,peekl(sp&))
    #endif
#endif
    _DROP
    goto xnext

x2constant::
    // 2CONSTANT  \ Double
    // ( "<spaces>name" n1 n2 -- )
    _PARSED_WORD
    header&:(parsed_word$,0)
    _COMMA?(xbr2constantbr&)
#ifdef _TOS
    _COMMA?(tos&)
    _COMMA?(peekl(sp&))
#else
    #ifdef _ASM
        _FETCH_SP
        _COMMA?(MCPeekL&:(sp&))
        _COMMA?(MCPeekL&:(sp&+KCell&))
    #else
        _COMMA?(peekl(sp&))
        _COMMA?(peekl(sp&+KCell&))
    #endif
#endif
    _2DROP
    goto xnext

xbrprimitivevariablebr::
    // (primitive-variable)
    // Run time code for variables created by the OPL proc variable:().
    // It uses the code of (constant) :

xbrconstantbr::
    // (constant)
    // ( -- x )
    // Run time code for words created by CONSTANT .
    _PUSH?(peekl(wp&+KCell&))
    goto xnext

xbr2constantbr::
    // (2constant)
    // ( -- x1 x2 )
    // Run time code for words created by 2CONSTANT .
    _PUSH?(peekl(wp&+K2Cells&))
    _PUSH?(peekl(wp&+KCell&))
    goto xnext

xbrvaluebr::
    // (value)
    // ( -- x )
    // Run time code for words created by VALUE .
    _PUSH?(peekl(wp&+K2Cells&))  // extra cell of CREATE
    goto xnext

xdotable::
    // dotable  \ PsiForth
    // ?!!!
    // tos& = peekl(wp& + (tos&+1) * KCell&)
    // :!!!create
#ifdef _TOS
    tos& = peekl(wp& + (tos&+2) * KCell&)
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,peekl(wp& + (MCPeekL&:(sp&)+2) * KCell&))
    #else
        pokel sp&,peekl(wp& + (peekl(sp&)+2) * KCell&)
    #endif
#endif
    goto xnext

xdoarray::
    // doarray  \ PsiForth
    // ?!!!
    // tos& = wp& + (tos&+1) * KCell&
    // :!!!create
#ifdef _TOS
    tos& = wp& + (tos&+2) * KCell&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&, wp& + (MCPeekL&:(sp&)+2) * KCell&)
    #else
        pokel sp&, wp& + (peekl(sp&)+2) * KCell&
    #endif
#endif
    goto xnext

xbrdoesbr::
    // (does>)  \ Forth 5mx
    // Run time of words modified by DOES> .
    _PUSH?(wp&+K2Cells&) // pfa
    _RPUSH?(ip&)
    ip& = peekl(wp&+KCell&)
    goto xnext

xbrdeferbr::
    // brdeferbr  \ Forth 5mx
    wp& = peekl(wp&+K2Cells&)
    goto xvector

xdouser::
    // douser  \ PsiForth
    // ?!!!
    _PUSH?(peekl(wp&+KCell&) + xuser&)
    goto xnext

xbrcolonbr::
    // (:)
    // ( -- ) ( R: -- nest-sys )
    // Run time code for words created by : .
    _RPUSH?(ip&)
    ip& = wp&+KCell&
    goto xnext

xj::
    // J  \ Core
    // ( R: branch1 limit1 index1 branch2 limit2 index2 -- )
    // ( -- index1 )
    _PUSH?(peekl(rp&+K3Cells&))
    goto xnext

xk::
    // k  \ PsiForth
    // ( R: branch1 limit1 index1 branch2 limit2 index2 branch3 limit3 index3 -- )
    // ( -- index1 )
    _PUSH?(peekl(rp&+K6Cells&))
    goto xnext

xplus::
    // +  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = tos&+peekl(sp&)
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&+KCell&, MCPeekL&:(sp&)+MCPeekL&:(sp&+KCell&))
        _DECREASE_STACK_KERNEL
        _STORE_SP
    #else
        pokel sp&+KCell&, peekl(sp&)+peekl(sp&+KCell&)
        _DECREASE_STACK_KERNEL
    #endif
#endif
    goto xnext

xminus::
    // -  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = peekl(sp&)-tos&
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&+KCell&, MCPeekL&:(sp&+KCell&)-MCPeekL&:(sp&))
        _DECREASE_STACK_KERNEL
        _STORE_SP
    #else
        pokel sp&+KCell&, peekl(sp&+KCell&)-peekl(sp&)
        _DECREASE_STACK_KERNEL
    #endif
#endif
    goto xnext

xbodyfrom::
    // body>  \ PsiForth
    // ( pfa -- xt )
    // An ambiguous condition exists if pfa is not for a word defined via CREATE.
#ifdef _TOS
    tos& = tos&-K2Cells&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL(sp&)-K2Cells&)
    #else
        pokel sp&,peekl(sp&)-K2Cells&
    #endif
#endif
    goto xnext

xcellminus::
    // cell-  \ PsiForth
    // ( a-addr1 -- a-addr2 )
#ifdef _TOS
    tos& = tos&-KCell&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)-KCell&)
    #else
        pokel sp&,peekl(sp&)-KCell&
    #endif
#endif
    goto xnext

xcharminus::
    // char-  \ Forth 5mx
    // ( n1 -- n2 )

x1minus::
    // 1-  \ Core
    // ( n1 -- n2 )
#ifdef _TOS
    tos& = tos&-1
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)-1)
    #else
        pokel sp&,peekl(sp&)-1
    #endif
#endif
    goto xnext

x2minus::
    // 2-  \ Core
    // ( n1 -- n2 )
#ifdef _TOS
    tos& = tos&-2
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)-2)
    #else
        pokel sp&,peekl(sp&)-2
    #endif
#endif
    goto xnext

xtobody::
    // >BODY  \ Core
    // ( xt -- pfa )
    // Note from the ANS Standard: An ambiguous condition exists if xt is not for a word defined via CREATE.
#ifdef _TOS
    tos& = tos&+K2Cells&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)+K2Cells&)
    #else
        pokel sp&,peekl(sp&)+K2Cells&
    #endif
#endif
    goto xnext

xcellplus::
    // CELL+  \ Core
    // ( a-addr1 -- a-addr2 )
#ifdef _TOS
    tos& = tos&+KCell&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)+KCell&)
    #else
        pokel sp&,peekl(sp&)+KCell&
    #endif
#endif
    goto xnext

xcharplus::
    // CHAR+  \ Core
    // ( n1 -- n2 )

x1plus::
    // 1+  \ Core
    // ( n1 -- n2 )
#ifdef _TOS
    tos& = tos&+1
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)+1)
    #else
        pokel sp&,peekl(sp&)+1
    #endif
#endif
    goto xnext

x2plus::
    // 2+  \ Forth 5mx
    // ( n1 -- n2 )
#ifdef _TOS
    tos& = tos&+2
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)+2)
    #else
        pokel sp&,peekl(sp&)+2
    #endif
#endif
    goto xnext

x2star::
    // 2*  \ Core
    // ( x1 -- x2 )
#ifdef _TOS
    tos& = tos&+tos&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)+MCPeekL&:(sp&))
    #else
        pokel sp&,peekl(sp&)+peekl(sp&)
    #endif
#endif
    goto xnext

x2div::
    // 2/  \ Core
    // ( x1 -- x2 )
#ifdef _TOS
    tos& = tos&/2
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)/2)
    #else
        pokel sp&,peekl(sp&)/2
    #endif
#endif
    goto xnext

xcells::
    // CELLS  \ Core
    // ( n1 -- n2 )
#ifdef _TOS
    tos& = tos&*KCell&
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,MCPeekL&:(sp&)*KCell&)
    #else
        pokel sp&,peekl(sp&)*KCell&
    #endif
#endif
    goto xnext

xstarslash::
    // */  \ Core
    // ( n1 n2 n3 -- n4 )
#ifdef _TOS
    tos& = peekl(sp&+KCell&)*peekl(sp&)/tos&
    sp& = sp&+K2Cells&
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&+K2Cells&)*MCPeekL&:(sp&+KCell&)/MCPeekL&:(sp&)
        _2DROP_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = peekl(sp&+K2Cells&)*peekl(sp&+KCell&)/peekl(sp&)
        _2DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xstar::
    // *  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = peekl(sp&)*tos&
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&+KCell&)*MCPeekL&:(sp&)
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = peekl(sp&+KCell&)*peekl(sp&)
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xdivide::
    // /  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = peekl(sp&)/tos&
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&+KCell&)/MCPeekL&:(sp&)
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = peekl(sp&+KCell&)/peekl(sp&)
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xslashmod::
    // /MOD  \ Core
    // ( n1 n2 -- n3 n4 )
#ifdef _TOS
    temp& = peekl(sp&)
    pokel sp&,mod&:(temp&,tos&)
    tos& = temp&/tos&
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&+KCell&)
        MCPokeL&:(sp&+KCell&,mod&:(temp&,MCPeekL&:(sp&)))
        MCPokeL&:(sp&,temp&/MCPeekL&:(sp&))
    #else
        temp& = peekl(sp&+KCell&)
        pokel sp&+KCell&,mod&:(temp&,peekl(sp&))
        pokel sp&,temp&/peekl(sp&)
    #endif
#endif
    goto xnext

xmod::
    // MOD  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = mod&:(peekl(sp&),tos&)
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = mod&:(MCPeekL&:(sp&+KCell&),MCPeekL&:(sp&))
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = mod&:(peekl(sp&+KCell&),peekl(sp&))
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

// xstarslashmod::
    // */MOD  \ Core
    // ( n1 n2 n3 -- n4 n5 )
//  print "*/MOD not implemented yet" // :!!!
//  goto xnext

xmin::
    // MIN  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = min(tos&,peekl(sp&))
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp&=min(MCPeekL&:(sp&),MCPeekL&:(sp&+KCell&))
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp&=min(peekl(sp&),peekl(sp&+KCell&))
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xmax::
    // MAX  \ Core
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = max(tos&,peekl(sp&))
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp&=max(MCPeekL&:(sp&),MCPeekL&:(sp&+KCell&))
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp&=max(peekl(sp&),peekl(sp&+KCell&))
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xabs::
    // ABS  \ Core
    // ( n -- +n )
#ifdef _TOS
    tos& = unsigned:(tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&,unsigned:(MCPeekL&:(sp&))
    #else
        pokel sp&,unsigned:(peekl(sp&))
    #endif
#endif
    goto xnext

x_and::
    // AND  \ Core
    // ( x1 x2 -- x3 )
#ifdef _TOS
    tos& = tos& and peekl(sp&)
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&) and MCPeekL&:(sp&+KCell&)
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = peekl(sp&) and peekl(sp&+KCell&)
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

x_or::
    // OR  \ Core
    // ( x1 x2 -- x3 )
#ifdef _TOS
    tos& = tos& or peekl(sp&)
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = MCPeekL&:(sp&) or MCPeekL&:(sp&+KCell&)
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = peekl(sp&) or peekl(sp&+KCell&)
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

x_xor::
    // XOR  \ Core
    // ( x1 x2 -- x3 )
#ifdef _TOS
    tos& = xor&:(tos&,peekl(sp&))
    _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        temp& = xor&:(MCPeekL&:(sp&),MCPeekL&:(sp&+KCell&))
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,temp&)
        _STORE_SP
    #else
        temp& = xor&:(peekl(sp&),peekl(sp&+KCell&))
        _DROP
        pokel sp&,temp&
    #endif
#endif
    goto xnext

xcfetch::
    // C@  \ Core
    // ( c-addr -- b )
#ifdef _TOS
    tos& = peekb(tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&, peekb(MCPeekL&:(sp&)))
    #else
        pokel sp&, peekb(peekl(sp&))
    #endif
#endif
    goto xnext

xfetch::
    // @  \ Core
    // ( a-addr -- x )
#ifdef _TOS
    tos& = peekl(tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        MCPokeL&:(sp&, peekl(MCPeekL&:(sp&)))
    #else
//      print "Fetched=";peekl(peekl(sp&)) // d!!!
        pokel sp&,peekl(peekl(sp&))
//      print "ReFetched=";peekl(sp&) // d!!!
    #endif
#endif
    goto xnext

xcstore::
    // C!  \ Core
    // ( b c-addr -- )
#ifdef _TOS
    pokeb tos&,peekb(sp&)
    _2DROP
#else
    #ifdef _ASM
        _FETCH_SP
        pokeb MCPeekL&:(sp&),MCPeekB(sp&+KCell&)
        _2DROP_KERNEL
        _STORE_SP
    #else
//      print peekl(sp&),peekb(sp&+KCell&) // d!!!
        pokeb peekl(sp&),peekb(sp&+KCell&)
        _2DROP
    #endif
#endif
    goto xnext

xstore::
    // !  \ Core
    // ( x a-addr -- )
#ifdef _TOS
    pokel tos&,peekl(sp&)
#else
    #ifdef _ASM
        _FETCH_SP
        poke MCPeekL&:(sp&),MCPeekL(sp&+KCell&)
        _2DROP_KERNEL
        _STORE_SP
        goto xnext
    #else
        pokel peekl(sp&),peekl(sp&+KCell&)
    #endif
#endif

x2drop::
    // 2DROP  \ Core
    // ( x1 x2 -- )
    _2DROP
    goto xnext

xplusstore::
    // +!  \ Core
    // ( n a-addr -- )
#ifdef _TOS
    pokel tos&,peekl(sp&)+peekl(tos&)
    _2DROP
#else
    #ifdef _ASM
        _FETCH_SP
        pokel MCPeekl&:(sp&),MCPeekL&:(sp&+KCell&)+peekl(MCPeekL&:(sp&))
        _2DROP_KERNEL
        _STORE_SP
    #else
//      print peekl(sp&+KCell&);"+";peekl(peekl(sp&));"=";peekl(sp&+KCell&)+peekl(peekl(sp&)) // d!!!
//      temp1&=peekl(sp&+KCell&)
//      temp2&=peekl(peekl(sp&))
//      temp3&=temp1&+temp2&
//      print temp1&;"+";temp2&;"+";temp3&
        pokel peekl(sp&),peekl(sp&+KCell&)+peekl(peekl(sp&))
        _2DROP
    #endif
#endif
    goto xnext

xcplusstore::
    // C+!  \ Commn Use
    // ( b c-addr -- )
#ifdef _TOS
    pokeb tos&,peekb(sp&)+peekb(tos&)
    _2DROP
#else
    #ifdef _ASM
        _FETCH_SP
        // d!!! test
        pokeb MCPeekL&:(sp&),MCPeekB&:(sp&+KCell&)+peekb(MCPeekL&:(sp&))
        _2DROP_KERNEL
        _STORE_SP
    #else
        pokeb peekl(sp&),peekb(sp&+KCell&)+peekb(peekl(sp&))
        _2DROP
    #endif
#endif
    goto xnext

xcount::
    // COUNT  \ Core
    // ( addr1 -- addr2 n ) ?!!!
    // ( c-addr1 -- c-addr2 n )
#ifdef _TOS
    sp& = sp&-KCell&
    pokel sp&,tos&+1
    tos& = peekb(tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        temp&=MCPeekL&:(sp&)
        _INCREASE_STACK_KERNEL
        MCPokeL&:(sp&+KCell&,temp&+1)
        MCPokeL&:(sp&,peekb(temp&))
        _STORE_SP
    #else
        temp&=peekl(sp&)
        _INCREASE_STACK
        pokel sp&+KCell&,temp&+1
        pokel sp&,peekb(temp&)
    #endif
#endif
    goto xnext

xskim::
    // skim  \ PsiForth
    // ( a-addr1 -- a-addr2 n )
    // a-addr2 = a-addr1 + cell
    // n = (a-addr)
#ifdef _TOS
    _INCREASE_STACK_KERNEL
    pokel sp&,tos&+KCell&
    tos& = peekl(tos&)
#else
    #ifdef _ASM
        _FETCH_SP
        temp&=MCPeekL&:(sp&)
        _INCREASE_STACK_KERNEL
        MCPokeL&:(sp&+KCell&,temp&+KCell&)
        MCPokel&:(sp&,peekl(temp&))
        _STORE_SP
    #else
        temp&=peekl(sp&)
        _INCREASE_STACK
        pokel sp&+KCell&,temp&+KCell&
        pokel sp&,peekl(temp&)
    #endif
#endif
    goto xnext

xexchange::
    // exchange  \ PsiForth
    // ( addr1 addr2 -- u2 )
    // ?!!! used only in the unused LINK
#ifdef _TOS
    temp& = peekl(tos&)
    pokel tos&,peekl(sp&)
    tos& = temp&
    _NIP
#else
    #ifdef _ASM
        print "EXCHANGE not implemented" // :!!!
    #else
        temp&=peekl(peekl(sp&))
        pokel peekl(sp&),peekl(sp&+KCell&)
        pokel sp&,temp&
        _NIP
    #endif
#endif
    goto xnext

x2dup::
    // 2DUP  \ Core
    // ( x1 x2 -- x1 x2 x1 x2 )
#ifdef _TOS
    _2INCREASE_STACK_KERNEL
    pokel sp&,peekl(sp&+K2Cells&)
    pokel sp&+KCell&,tos&
#else
    #ifdef _ASM
        _FETCH_SP
        _2INCREASE_STACK_KERNEL
        MCPokeL&:(sp&,MCPeekL&:(sp&+K2Cells&))
        MCPokeL&:(sp&+KCell&,MCPeekL&:(sp&+K3Cells&))
        _STORE_SP
    #else
        _2INCREASE_STACK_KERNEL
        pokel sp&,peekl(sp&+K2Cells&)
        pokel sp&+KCell&,peekl(sp&+K3Cells&)
    #endif
#endif
    goto xnext

xbrcsliteralbr::
    // (csliteral)  \ Forth 5mx
    // ( -- c-addr )
    _PUSH?(ip&) // string address
#ifdef _TOS
    ip& = _ALIGNED?(ip&+peekb(tos&)+1)
#else
    #ifdef _ASM
        ip& = _ALIGNED?(ip&+peekb(MCPeekL&:(sp&))+1)
    #else
        ip& = _ALIGNED?(ip&+peekb(peekl(sp&))+1)
    #endif
#endif
    goto xnext

xbrsliteralbr::
    // (sliteral)  \ Forth 5mx
    // ( -- c-addr u )
#ifdef _TOS
    _2INCREASE_STACK
    pokel sp&,ip&+1 // string address
    tos& = peekb(ip&) // string length
    ip& = _ALIGNED?(ip&+tos&+1)
#else
    #ifdef _ASM
        _PUSH?(ip&+1) // string address
        _PUSH?(peekb(ip&)) // string length
        ip& = _ALIGNED?(ip&+MCPeekL&:(sp&)+1)
    #else
        _PUSH?(ip&+1) // string address
        _PUSH?(peekb(ip&)) // string length
        ip& = _ALIGNED?(ip&+peekl(sp&)+1)
    #endif
#endif
    goto xnext

xsliteral::
    // SLITERAL  \ String
    // Compile time: ( c-addr u -- )
    // Run time: ( -- c-addr u )
#ifdef _TOS
    if state& // compiling
        // compile (SLITERAL) into the dicionary:
        pokel dp&,xbrsliteralbr&
        dp& = dp&+KCell&
        // store the string into the dictionary:
        // (this is the same code of S, , but we have to duplicate it here
        // because S, does not align the dicionary pointer)
        _PUSH?(dp&)
        dp& = _ALIGNED?(dp&+peekl(sp&)+1)
        goto xsmove
    endif
#else
    #ifdef _ASM
        // :!!! this code is the same than the #else part
        if state& // compiling
            // compile (SLITERAL) into the dicionary:
            pokel dp&,xbrsliteralbr&
            dp& = dp&+KCell&
            // store the string into the dictionary:
            // (this is the same code of S, , but we have to duplicate it here
            // because S, does not align the dicionary pointer)
            _PUSH?(dp&)
            // sp& is already fetched by _PUSH
            dp& = _ALIGNED?(dp&+MCPeekL&:(sp&+KCell&)+1)
            goto xsmove
        endif
    #else
        if state& // compiling
            // compile (SLITERAL) into the dicionary:
            pokel dp&,xbrsliteralbr&
            dp& = dp&+KCell&
            // store the string into the dictionary:
            // (this is the same code of S, , but we have to duplicate it here
            // because S, does not align the dicionary pointer)
            _PUSH?(dp&)
            dp& = _ALIGNED?(dp&+peekl(sp&+KCell&)+1)
            goto xsmove
        endif
    #endif
#endif
    goto xnext

xssquote::
    // s'  \ Forth 5mx
    // ( -- c-addr u )
    _PARSED?(39)  // 39 = char code of '
    goto xsquote0

xsquote::
    // S"  \ Core
    // ( -- c-addr u )
    _PARSED?(34) // 34 = double quote char code
xsquote0::
    // Input: parsed$ = text parsed
    if state& = KInterpreting&
        string$=parsed$
        #include "forth5mx_inc_to_sbuffer.opp"
        goto xnext
    endif
    _COMMA?(xbrsliteralbr&)
    _COMPILE_PARSED
    goto xnext

xcquote::
    // C"  \ Core Ext
    // ( -- c-addr )
    _PARSED?(34) // 34 = double quote char code
    if state& = KInterpreting&
        string$=parsed$
        #include "forth5mx_inc_to_sbuffer.opp"
#ifdef _TOS
        tos& = peekl(sp&)-1
        _NIP
#else
    #ifdef _ASM
        _FETCH_SP
        _DECREASE_STACK_KERNEL
        MCPokeL&:(sp&,MCPeekL&:(sp&+KCell&)-1)
        _STORE_SP
    #else
        pokel sp&,peekl(sp&+KCell&)-1
        _NIP
    #endif
#endif
        goto xnext
    endif
    _COMMA?(xbrcsliteralbr&)
    _COMPILE_PARSED
    goto xnext

xscomma::
    // S,  \ Forth 5mx
    // ( c-addr u -- )
    _PUSH?(dp&)
#ifdef _TOS
    dp& = dp&+peekl(sp&)+1
#else
    #ifdef _ASM
        _FETCH_SP
        dp& = dp&+MCPeekL&:(sp&+KCell&)+1
    #else
        dp& = dp&+peekl(sp&+KCell&)+1
    #endif
#endif

xsmove::
    // smove  \ Forth 5mx
    // ( c-addr1 u1 c-addr2 -- )
#ifdef _TOS
    source& = peekl(sp&+KCell&)
    destination& = tos&+1
    i& = peekl(sp&) // char count
    temp% = i& // keep
    temp& = tos& // keep
#else
    #ifdef _ASM
        _FETCH_SP
        source& = MCPeekL&:(sp&+K2Cells&)
        destination& = MCPeekL&:(sp&)+1
        i& = MCPeekL&:(sp&+KCell&) // char count
        temp% = i& // keep
        temp& = MCPeekL&:(sp&) // keep
    #else
        source& = peekl(sp&+K2Cells&)
        destination& = peekl(sp&)+1
        i& = peekl(sp&+KCell&) // char count
        temp% = i& // keep
        temp& = peekl(sp&) // keep
    #endif
#endif
    if destination&<source&
        while i&
            pokeb destination&,peekb(source&)
            destination&++
            source&++
            i&--
        endwh
    else
        source& = source&+i&
        destination& = destination&+i&
        while i&
            destination&--
            source&--
            pokeb destination&,peekb(source&)
            i&--
        endwh
    endif
    pokeb temp&,temp%
    _3DROP
    goto xnext

xmove::
    // MOVE  \ Core
    // ( addr1 addr2 u -- )
    // :!!! In practice, this does the same as CMOVE 
/*
#ifdef _TOS
    destination& = peekl(sp&)
    source& = peekl(sp&+KCell&)
    if destination&<source&
        while tos&
            pokeb destination&,peekb(source&)
            destination&++
            source&++
            tos&--
        endwh
    else
        source& = source&+tos&
        destination& = destination&+tos&
        while tos&
            destination&--
            source&--
            pokeb destination&,peekb(source&)
            tos&--
        endwh
    endif
#else
    destination& = peekl(sp&+KCell&)
    source& = peekl(sp&+K2Cells&)
    i& = peekl(sp&)
    if destination&<source&
        while i&
            pokeb destination&,peekb(source&)
            destination&++
            source&++
            i&--
        endwh
    else
        source& = source&+i&
        destination& = destination&+i&
        while i&
            destination&--
            source&--
            pokeb destination&,peekb(source&)
            i&--
        endwh
    endif
#endif
    _3DROP
    goto xnext
*/

xcmove::
    // CMOVE  \ String
    // ( c-addr1 c-addr2 u -- )
#ifdef _TOS
    source& = peekl(sp&+KCell&)
    destination& = peekl(sp&)
    while tos&
        pokeb destination&,peekb(source&)
        destination&++
        source&++
        tos&--
    endwh
    _3DROP
#else
    source& = peekl(sp&+K2Cells&)
    destination& = peekl(sp&+KCell&)
    temp& = peekl(sp&)
    while temp&
        pokeb destination&,peekb(source&)
        destination&++
        source&++
        temp&--
    endwh
    #ifdef _ASM
        _DECREASE
        _STORE_SP
    #else
        _3DROP
    #endif
#endif
    goto xnext

xcmoveback::
    // CMOVE>  \ String
    // ( c-addr1 c-addr2 u -- )
#ifdef _TOS
    source& = peekl(sp&+KCell&)+tos&
    destination& = peekl(sp&)+tos&
    while tos&
        destination&--
        source&--
        pokeb destination&,peekb(source&)
        tos&--
    endwh
#else
    source& = peekl(sp&+K2Cells&)+peekl(sp&)
    destination& = peekl(sp&+KCell&)+peekl(sp&)
    temp&=peekl(sp&)
    while temp&
        destination&--
        source&--
        pokeb destination&,peekb(source&)
        temp&--
    endwh
#endif
    _3DROP
    goto xnext

xfill::
    // FILL  \ Core
    // ( c-addr u b -- )
#ifdef _TOS
    i& = peekl(sp&)
    temp& = peekl(sp& + KCell&)
    while i&
        pokeb temp&,tos&
        temp&++
        i&--
    endwh
#else
    i& = peekl(sp&+KCell&)
    temp& = peekl(sp& + K2Cells&)
    char% = peekb(sp&)
    while i&
        pokeb temp&,char%
        temp&++
        i&--
    endwh
#endif
    _3DROP
    goto xnext

xlatest::
    // latest  \ PsiForth
    // ( -- nt )
    _PUSH?(last_nt&)
    goto xnext

ximmediate::
    // IMMEDIATE  \ Core
    // ( -- )
    pokeb _CONTROL_BITS_ADDRESS?(last_nt&), _CONTROL_BITS?(last_nt&) or KImmediate%
    goto xnext

ximmediateq::
    // immediate?  \ PsiForth
    // ( nt -- flag )
#ifdef _TOS
    tos& = (_CONTROL_BITS?(tos&) and KImmediate%) <> 0
#else
    pokel sp&,(_CONTROL_BITS?(peekl(sp&)) and KImmediate%) <> 0
#endif
    goto xnext

xequal::
    // =  \ Core
    // ( n1 n2 -- flag )
#ifdef _TOS
    tos& = (tos&=peekl(sp&))
#else
    pokel sp&, (peekl(sp&)=peekl(sp&+KCell&))
#endif
    _NIP
    goto xnext

xnotequal::
    // <>  \ Core
    // ( n1 n2 -- flag )
#ifdef _TOS
    tos& = (tos&<>peekl(sp&))
#else
    pokel sp&,(peekl(sp&)<>peekl(sp&+KCell&))
#endif
    _NIP
    goto xnext

xlessorequal::
    // <=  \ Forth 5mx
    // ( n1 n2 -- flag )
#ifdef _TOS
    tos& = (peekl(sp&)<=tos&)
#else
    pokel sp&,(peekl(sp&+KCell&)<=peekl(sp&))
#endif
    _NIP
    goto xnext

xgreaterorequal::
    // >=  \ Forth 5mx
    // ( n1 n2 -- flag )
#ifdef _TOS
    tos& = (peekl(sp&)>=tos&)
#else
    pokel sp&,(peekl(sp&+KCell&)>=peekl(sp&))
#endif
    _NIP
    goto xnext

xnot::
    // not  \ Forth 5mx

x0equal::
    // 0=  \ Core
    // (flag1 -- flag2 )
#ifdef _TOS
    tos& = (tos&=0)
#else
    pokel sp&,(peekl(sp&)=0)
#endif
    goto xnext

x0notequal::
    // 0<>  \ Core Ext
    // (flag1 -- flag2 )
#ifdef _TOS
    tos& = (tos&<>0)
#else
    pokel sp&, (peekl(sp&)<>0)
#endif
    goto xnext

xuless::
    // U<  \ Core
    // ( u1 u2 -- flag )
#ifdef _TOS
    temp1 = unsigned:(peekl(sp&))
    temp2 = unsigned:(tos&)
    tos& = temp1<temp2
#else
    temp1 = unsigned:(peekl(sp&+KCell&))
    temp2 = unsigned:(peekl(sp&))
    pokel sp&, temp1<temp2
#endif
    _NIP
    goto xnext

xumore::
    // U>  \ Core Ext
    // ( u1 u2 -- flag )
#ifdef _TOS
    temp1 = unsigned:(peekl(sp&))
    temp2 = unsigned:(tos&)
    tos& = temp1>temp2
#else
    temp1 = unsigned:(peekl(sp&+KCell&))
    temp2 = unsigned:(peekl(sp&))
    pokel sp&, temp1>temp2
#endif
    _NIP
    goto xnext

xless::
    // <  \ Core
    // ( n1 n2 -- flag )
#ifdef _TOS
    tos& = (peekl(sp&) < tos&)
#else
    pokel sp&, (peekl(sp&+KCell&) < peekl(sp&))
#endif
    _NIP
    goto xnext

xgreater::
    // >  \ Core
#ifdef _TOS
    tos& = (peekl(sp&) > tos&)
#else
    pokel sp&, (peekl(sp&+KCell&) > peekl(sp&))
#endif
    _NIP
    goto xnext

x0less::
    // 0<  \ Core
    // (flag1 -- flag2 )
#ifdef _TOS
    tos& = (tos& < 0)
#else
    pokel sp&, (peekl(sp&) < 0)
#endif
    goto xnext

x0greater::
    // 0>  \ Core Ext
    // (flag1 -- flag2 )
#ifdef _TOS
    tos& = (tos& > 0)
#else
    pokel sp&, (peekl(sp&) > 0)
#endif
    goto xnext

x0branch::
    // 0branch  \ PsiForth
    // ( flag -- )
    // ?!!!
#ifdef _TOS
    temp& = tos&
#else
    temp& = peekl(sp&)
#endif
    _DROP
    if temp&
        ip& = ip&+KCell&
        goto xnext
    endif

xbranch::
    // branch  \ PsiForth
    // ?!!!
    ip& = ip&+peekl(ip&)+KCell&
    goto xnext

xbrofbr::
    // (of)  \ PsiForth
    // ?!!!
    // runtime code for OF
#ifdef _TOS
    if peekl(sp&) = tos&
#else
    if peekl(sp&+KCell&)=peekl(sp&)
#endif
        _2DROP
        ip& = ip&+KCell&
    else
        _DROP
        ip& = ip&+peekl(ip&)+KCell&
    endif
    goto xnext

xbrqdobr::
    // (?do)  \ Forth 5mx
    // ( limit first -- )
#ifdef _TOS
    if peekl(sp&)=tos&
#else
    if peekl(sp&+KCell&)=peekl(sp&)
#endif
        _2DROP
        ip& = ip&+peekl(ip&)+KCell&
        goto xnext
    endif

xbrdobr::
    // (do)  \ PsiForth
    // ( limit first -- )
    // ( R: -- branch limit first )
    temp& = peekl(ip&)
    ip& = ip&+KCell&
    rp& = rp&-K3Cells&
    pokel rp&+K2Cells&,temp&+ip&
#ifdef _TOS
    pokel rp&+KCell&,peekl(sp&)
    pokel rp&,tos&
#else
    pokel rp&+KCell&,peekl(sp&+KCell&)
    pokel rp&,peekl(sp&)
#endif
    _2DROP
    goto xnext

xbrloopbr::
    // (loop)  \ Forth 5mx
    // ( R: branch limit first -- )
    // ?!!!
    pokel rp&,peekl(rp&)+1
    if peekl(rp&) = peekl(rp&+KCell&)
        // limit reached
        _UNLOOP
        ip& = ip&+KCell&
    else
        ip& = ip&+peekl(ip&)+KCell&
    endif
    goto xnext

xunloop::
    // UNLOOP  \ Core
    // (R: x1 x2 x3 -- )
    _UNLOOP
    goto xnext

xbrplusloopbr::
    // (+loop)  \ Forth 5mx
    // ( n -- )
#ifdef _TOS
    pokel rp&,peekl(rp&)+tos&
#else
    pokel rp&,peekl(rp&)+peekl(sp&)
#endif
    _DROP
    if peekl(rp&) > (peekl(rp&+KCell&)-1)
        // boundary crossed
        _UNLOOP
        ip& = ip&+KCell&
    else
        ip& = ip&+peekl(ip&)+KCell&
    endif

    goto xnext

xbrminusloopbr::
    // (-loop)  \ Forth 5mx
    // ( n -- )
    // :!!! *!!! experimental
#ifdef _TOS
    pokel rp&,peekl(rp&)-tos&
#else
    pokel rp&,peekl(rp&)-peekl(sp&)
#endif
    _DROP
    if peekl(rp&) < (peekl(rp&+KCell&)+1)
        // boundary crossed
        _UNLOOP
        ip& = ip&+KCell&
    else
        ip& = ip&+peekl(ip&)+KCell&
    endif

    goto xnext

xleave::
    // LEAVE  \ Core
    // ( -- )
    if state& = KInterpreting&
        goto compile_only
    endif
    _COMMA?(xbrleavebr&)
    goto xnext

xbrleavebr::
    // (leave)  \ Forth 5mx
    // ( -- )
    // ( R: branch limit index -- )
    ip& = peekl(rp&+K2Cells&)
    _UNLOOP
    goto xnext

xccomma::
    // C,  \ Core
    // ( b -- )
#ifdef _TOS
    pokeb dp&,tos& AND 255
#else
    pokeb dp&,peekb(sp&)
#endif
    dp& = dp&+1
    _DROP
    goto xnext

xcompilecomma::
    // COMPILE,  \ Core
    // ( xt -- )
    if state& = KInterpreting&
            goto compile_only
    endif

xcomma::
    // ,  \ Core
    // ( x -- )
#ifdef _TOS
    _COMMA?(tos&)
#else
    _COMMA?(peekl(sp&))
#endif
    _DROP
    goto xnext

xkeyq::
    // KEY?  \ Facility
    // ( -- flag )
    _INCREASE_STACK
    if keywaiting% = 0
        keywaiting% = key
    endif
#ifdef _TOS
    tos& = (keywaiting%<>0)
#else
    pokel sp&, (keywaiting%<>0)
#endif
    goto xnext

xkey::
    // KEY  \ Core
    // ( -- b )
    _PUSH?(keywaiting%)
#ifdef _TOS
    if tos&
        keywaiting% = 0
    else
        tos& = get
    endif
#else
    if peekl(sp&)
        keywaiting% = 0
    else
        pokel sp&,get
    endif
#endif
    goto xnext

xemit::
    // EMIT  \ Core
    // ( b -- )
#ifdef _TOS
    print chr$(tos&);
#else
    print chr$(peekb(sp&));
#endif
    _DROP
    goto xnext

xemits::
    // emits  \ PsiForth
    // ( b n -- )
#ifdef _TOS
    print rept$(chr$(peekb(sp&)),tos&);
#else
    print rept$(chr$(peekb(sp&+KCell&)),peekl(sp&));
#endif
    _2DROP
    goto xnext

xatxy::
    // AT-XY  \ Facility
    // ( u1 u2 -- )
    // u1 = x = column
    // u2 = y = row
#ifdef _TOS
    at peekl(sp&)+1,tos&+1
#else
    at peekl(sp&+KCell&)+1,peekl(sp&)+1
#endif
    _2DROP
    goto xnext

xbracketnumber::
    // <#  \ Core
    // ?!!!
    // ( ud -- ud ) ( n ud -- n ud )
#ifdef _TOS
    temp& = pad&
    pokel temp&,temp&
    _INCREASE_STACK
#else
    temp& = pad&
    pokel temp&,temp&
    temp& = peekl(sp&)
    _PUSH?(temp&)
#endif
    goto xnext

xnumbersign::
    // #  \ Core
    // ?!!!
    // ( ud1 -- ud2 )
    digit:
    goto xnext

xnumbersigns::
    // #S  \ Core
    // ( ud1 -- ud2 )
#ifdef _TOS
    while tos&
        digit:
    endwh
#else
    while peekl(sp&)
        digit:
    endwh
#endif
    goto xnext

xnumberbracket::
    // #>  \ Core
    // ?!!!
    // ( ud -- c-addr u )
#ifdef _TOS
    temp& = pad&
    tos& = temp& - peekl(temp&)
    pokel sp&,peekl(temp&)
#else
    temp& = pad&
    pokel sp&, temp& - peekl(temp&)
    pokel sp&+KCell&,peekl(temp&)
#endif
    goto xnext

xhold::
    // HOLD  \ Core
    // ( char -- )
    // ?!!!
#ifdef _TOS
    temp& = pad&
    hold: (tos&)
#else
    temp& = pad&
    hold: (peekb(sp&))
#endif
    _DROP
    goto xnext

xsign::
    // SIGN  \ Core
    // ?!!!
    // ( n1 n2 -- )
#ifdef _TOS
    if peekl(sp&) < 0
        hold:(%-)
    endif
#else
    if peekl(peekl(sp&+KCell&)) < 0
        hold:(%-)
    endif
#endif
    goto xnext

xudot::
    // U.  \ Core
    // ( u -- )
    _PUSH?(0)
    temp1$=" " // trailing space
    goto udotr2

xudotr::
    // U.R  / Core Ext
    // ( u +n -- )
    temp1$="" // trailing space
#ifdef _TOS
udotr2::
    temp = unsigned:(peekl(sp&))
    temp$="" // output string
    do
        temp1 = temp
        temp = intf(temp1/base&)
        temp1 = temp1-temp*base&
        temp1 = temp1+%0
        temp1 = temp1+(temp1>%9 and 39)
        temp$ = chr$(temp1)+temp$
    until (temp=0)
    print rept$(" ",max(0,tos&-len(temp$)));temp$;temp1$;
#else
udotr2::
    temp = unsigned:(peekl(sp&+KCell&))
    temp$="" // output string
    do
        temp1 = temp
        temp = intf(temp1/base&)
        temp1 = temp1-temp*base&
        temp1 = temp1+%0
        temp1 = temp1+(temp1>%9 and 39)
        temp$ = chr$(temp1)+temp$
    until (temp=0)
    print rept$(" ",max(0,peekl(sp&)-len(temp$)));temp$;temp1$;
#endif
    _2DROP
    goto xnext

xdot::
    // .  \ Core
    // ( n -- )
    _PUSH?(0)
    temp1$=" " // trailing space
    goto dotr2

xdotr::
    // .R  / Core Ext
    // ( n1 +n2 -- )
    temp1$="" // trailing space
dotr2::
#ifdef _TOS
    // temp = unsigned:(peekl(sp&))
    temp& = abs(peekl(sp&))
    number$="" // output string
    do
        digit& = temp&
// print digit&;"->";
        temp& = digit&/base&
        digit& = digit&-temp&*base&
// print digit&;"->";
        digit& = digit&+%0
// print "'";chr$(digit&);"'->";
        digit& = digit&+(digit&>%9 and 39)
// print "'";chr$(digit&);"'"
        number$ = chr$(digit&)+number$
    until (temp&=0)
    if peekl(sp&)<0
        number$ = "-"+number$
    endif
    print rept$(" ",max(0,tos&-len(number$)));number$;temp1$;
#else
    // temp = unsigned:(peekl(sp&+KCell&))
    temp& = abs(peekl(sp&+KCell&))
    number$="" // output string
    do
        digit& = temp&
// print digit&;"->";
        temp& = digit&/base&
        digit& = digit&-temp&*base&
// print digit&;"->";
        digit& = digit&+%0
// print "'";chr$(digit&);"'->";
        digit& = digit&+(digit&>%9 and 39)
// print "'";chr$(digit&);"'"
        number$ = chr$(digit&)+number$
    until (temp&=0)
    if peekl(sp&+KCell&)<0
        number$ = "-"+number$
    endif
    print rept$(" ",max(0,peekl(sp&)-len(number$)));number$;temp1$;
#endif
    _2DROP
    goto xnext

xcr::
    // CR  \ Core
    // ( -- )
    print
    goto xnext

xdotparenthesis::
    // .(  \ Core Ext
    // ( -- )
    _PARSE?(41)  // 41 = char code of )
//  _DEBUG2?(".(")

xtype::
    // TYPE  \ Core
    // ( c-addr u -- )

    // print packed$:; // original PsiForth version

    // New version without strings (no length limit, although slower):
#ifdef _TOS
    temp&=peekl(sp&)
    while tos&
        print chr$(peekb(temp&));
        temp&++
        tos&--
    endwh
#else
    temp&=peekl(sp&+KCell&)
    i& = peekl(sp&)
    while i&
        print chr$(peekb(temp&));
        temp&++
        i&--
    endwh
#endif
    _2DROP
    goto xnext

xspace::
    // SPACE  \ Core
    // ( -- )
    print " ";
    goto xnext

xspaces::
    // SPACES  \ Core
    // ( u -- )
#ifdef _TOS
    print rept$(" ",tos&);
#else
    print rept$(" ",peekl(sp&));
#endif
    _DROP
    goto xnext

xgcls::
    // gcls  \ OPL
    // ( -- )
    gcls
    goto xnext

xpage::
    // PAGE  \ Facility
    // ( -- )
    cls

xhome::
    // home  \ PsiForth
    at 1,1
    goto xnext

xextend::
    // extend  \ Forth 5mx
    // ( -- )
    //*!!!
    temp$=KExtendFile$
    goto include0

xincluded::
    // INCLUDED  \ File
    // ( c-addr u -- )
    _GET_PACKED
    temp$ = packed$
    goto include0

xinclude::
    // include  \ Forth 5mx
    // ( -- )
    _PARSED_WORD
    temp$ = parsed_word$
include0::
    // Input: temp$ = file name
    temp$ = whole_path$:(temp$)
    include_path$ = only_path$:(temp$)
    #ifdef _DSOURCE
    if ioopen(file_id%,temp$,KIoOpenModeOpen%+KIoOpenFormatBinary%+KIoOpenAccessRandom%)
    #else
    if ioopen(file_id%,temp$,KIoOpenModeOpen%+KIoOpenFormatText%)
    #endif
        _REPORT_ERROR?("can't open "+temp$)
        goto xabort
    endif
    goto includefile0

xincludefile::
    // INCLUDE-FILE  \ File
    // ( fid -- )
#ifdef _TOS
    file_id% = tos&
#else
    file_id% = peekl(sp&)
#endif
    _DROP
    include_path$ = path$ // ?!!! why?
includefile0::
    // Input: file_id%

    #include "forth5mx_inc_save_source.opp"
    path$ = include_path$
    setpath path$
    sourceid& = file_id%
    // blk& = 0 :!!!
    _INDICATE_SOURCE

    #ifdef _DSOURCE

    // new way

    // Just interpret the input buffer,where the whole file has been read.
    // No need for REFILL.
    _CALL_XT?(xinterpret&,label01)

    #else

    // classic way

    toin&=ib_len& // for REFILL to load a line of the opened file.
while00::
    #include "forth5mx_inc_refill.opp"
    // output: successful&
    if successful&
        _CALL_XT?(xinterpret&,label01)
        goto while00 // :!!! use a good control structure here
    endif

    #endif

    if ioclose(file_id%)
        _REPORT_ERROR?("error closing source file")
    endif

    #include "forth5mx_inc_restore_source.opp"

    goto xnext

xrefill::
    // REFILL  \ File Ext
    // ( -- flag )
    #include "forth5mx_inc_refill.opp"
    // output: successful&
    _PUSH?(successful&)
    goto xnext

xaccept::
    // ACCEPT  \ Core
    // (c-addr +n1 -- +n2 )
#ifdef _TOS
    temp$ = lineedit$:("",tos&,KFalse&)
    move:(temp$,peekl(sp&))
    tos& = len(temp$)
#else
    temp$ = lineedit$:("",peekl(sp&),KFalse&)
    move:(temp$,peekl(sp&+KCell&))
    pokel sp&,len(temp$)
#endif
    _NIP
    goto xnext

xexpect::
    // EXPECT  \ Core Ext
    // (c-addr +n -- )
#ifdef _TOS
    temp$ = lineedit$:("",tos&,KFalse&)
    span& = len(temp$)  // update SPAN
    move:(temp$,peekl(sp&))
#else
    temp$ = lineedit$:("",peekl(sp&),KFalse&)
    span& = len(temp$)  // update SPAN
    move:(temp$,peekl(sp&+KCell&))
#endif
    _2DROP
    goto xnext

xquery::
    // QUERY  \ Core Ext
    // ( -- )
    // :!!! no source save and restore!!!
    sourceid&=KSourceIDKeyboard%
    ib$ = lineedit$:("",KMaxStringLen%,KFalse&)
    ib_len& = len(ib$)
    toin& = 0
    _2DROP // ?!!!
    goto xnext

xword::
    // WORD  \ Core
    // ( char -- c-addr )

#ifdef _TOS
    delimiter% = tos&
#else
    delimiter% = peekb(sp&)
#endif

#ifdef  _DSOURCE

    string$=""
    do
        tmp%=LexGet%:(lex&)
    until tmp%<>delimiter%
    if tmp%<>0
        do
            string$=string$+chr$(char%) // :!!! test speed, compare to pokeb inside the string
            tmp%=LexGet%:(lex&)
        until tmp%=delimiter% or tmp%=0
    endif

#else

    // old way
    first_char%=0
    len%=0
    while peekb(ib_addr&+toin&)=delimiter%
        toin&++
    endwh
    if toin&<ib_len&
        first_char% = toin&
        while peekb(ib_addr&+toin&)<>delimiter% and toin&<ib_len&
            toin&++
        endwh
        len% = toin&-first_char%
        toin&++ // point to the char after the delimiter or after the buffer
    endif
    #ifdef _DEBUG_WORD
        print ">>";ib$;"<<"
        print "first_char%+1=";first_char%+1
        print "len%=";len%
    #endif
    string$=mid$(ib$,first_char%+1,len%)

#endif // _DSOURCE

    // input: string$
    #include "forth5mx_inc_to_sbuffer.opp"

#ifdef _TOS
    tos& = peekl(sp&)-1
    sp& = sp&+K2Cells&
#else
    sp& = sp&+K2Cells&
    pokel sp&, peekl(sp&-KCell&)-1
#endif
    goto xnext

xparseword::
    // parse-word  \ Forth 5mx
    // ( -- c-addr u )
    _PARSED_WORD
    string$=parsed_word$
    #include "forth5mx_inc_to_sbuffer.opp"
    goto xnext

xhere::
    // HERE  \ Core
    // ( -- addr )
    _PUSH?(dp&)
    goto xnext

xpad::
    // PAD  \ Core Ext
    // ( -- addr )
    _PUSH?(pad&)
    goto xnext

xallot::
    // ALLOT  \ Core
    // ( n -- )
#ifdef _TOS
    dp& = dp&+tos&
#else
    dp& = dp&+peekl(sp&)
#endif
    _DROP
    goto xnext

xcreate::
    // CREATE  \ Core
    // ( "<spaces>name" -- )
    _PARSED_WORD
    header&:(parsed_word$,0)
    _COMMA?(xbrcreatebr&) // (create)
    _COMMA?(0) // extra cell used by DOES> .
    goto xnext

xbrcreatebr::
    // (create)  \ Forth 5mx
    // ( -- pfa )
    // Run time code for words created by CREATE .
    _PUSH?(wp&+K2Cells&)
    goto xnext

xcolonnoname::
    // :NONAME  \ Core Ext
    // ( -- xt )
    dp& = _ALIGNED?(dp&)
    _PUSH?(dp&)
    goto xcolon0

xcolon::
    // :  \ Core
    // ( -- )
    if state& // compiling
        goto interpret_only
    endif
    _PARSED_WORD
// print parsed_word$, // d!!!
    header&:(parsed_word$,0)
xcolon0::
    _COMMA?(xbrcolonbr&)

xrightbracket::
    // ]  \ Core
    // ( -- )
    state& = KTrue&
    goto xnext

xsemicolon::
    // ;  \ Core
    // ( -- )
    _COMMA?(xexit&)

xleftbracket::
    // [  \ Core
    // ( -- )
    state& = KInterpreting&
    goto xnext

xfind::
    // FIND  \ Core
    // ( c-addr --  c-addr 0 | xt 1 | xt -1 )
#ifdef _TOS
    nametofind$=peek$(tos&)
#else
    nametofind$=peek$(peekl(sp&))
#endif
    // input:nametofind$
    #include "forth5mx_inc_find.opp"
    // output: nt& = nt or 0
    _INCREASE_STACK
#ifdef _TOS
    if nt&
        pokel sp&,_XT?(nt&)
        tos& = 1+2*((_CONTROL_BITS?(nt&) and KImmediate%)=0)
    else
        tos& = 0
    endif
#else
    if nt&
        pokel sp&+KCell&,_XT?(nt&)
        pokel sp&,1+2*((_CONTROL_BITS?(nt&) and KImmediate%)=0)
    else
        pokel sp&, 0
    endif
#endif
    goto xnext

xfindname::
    // find-name  \ Gforth
    // ( c-addr u -- nt | 0 )
    _GET_PACKED
    nametofind$=packed$
    // input:nametofind$
    #include "forth5mx_inc_find.opp"
    // output: nt& = nt or 0
    _PUSH?(nt&)
    goto xnext

xnamefrom::
    // name>  \ PsiForth
    // ( nt -- xt )
#ifdef _TOS
    tos& = _XT?(tos&)
#else
    pokel sp&, _XT?(peekl(sp&))
#endif
    goto xnext

xname::
    // name  \ PsiForth
    // ( nt -- c-addr u )
#ifdef _TOS
    sp& = sp&-KCell&
    pokel sp&,_NAME_ADDRESS?(tos&)+1
    tos& = peekb(_NAME_ADDRESS?(tos&))
#else
    temp&=peekl(sp&)
    _INCREASE_STACK
    pokel sp&+KCell&,_NAME_ADDRESS?(temp&)+1
    pokel sp&,peekb(_NAME_ADDRESS?(temp&))
#endif
    goto xnext

xdotname::
    // .name  \ PsiForth
    // ( nt -- )
#ifdef _TOS
    print _NAME?(tos&);
#else
    print _NAME?(peekl(sp&));
#endif
    _DROP
    goto xnext

xdepth::
    // DEPTH  \ Core
    // ( -- +n )
#ifdef _TOS
    _PUSH?(_DEPTH)
#else
    _PUSH?(_DEPTH-1)
#endif
    goto xnext

xcatch::
    // CATCH  \ Exception
    // It does not the same in ANS: ?!!!
    _2INCREASE_RSTACK
    pokel rp&,ip&
    pokel rp&+KCell&,sp&
    ip& = xthrow0&+KCell&

xexecute::
    // EXECUTE  \ Core
    // ( i*x xt -- j*x )
#ifdef _TOS
    wp& = tos&
#else
    wp& = peekl(sp&)
#endif
    _DROP
    goto xvector

xthrow::
    // THROW  \ Exception
    // ( R: x -- )
    // It does not the same in ANS: ?!!!
    _RDROP
    goto xthrow1
xthrow0::
#ifdef _TOS
    tos& = 0
#else
    pokel sp&,0
#endif
xthrow1::
    ip& = peekl(rp&)
    sp& = peekl(rp&+KCell&)
    _2RDROP
    goto xnext

xnumberq::
    // number?  \ PsiForth
    // ( c-addr u -- flag )
    _GET_PACKED
    _PUSH?(numberq%:(packed$))
    goto xnext

xnumber::
    // number  \ PsiForth
    // ( c-addr u -- n )
    _GET_PACKED
    _PUSH?(number&:(packed$))
    goto xnext

xqabort::
    // ?abort  \ Forth 5mx
    // ( flag c-addr u -- )
    _GET_PACKED
#ifdef _TOS
    temp& = tos&
#else
    temp& = peekl(sp&)
#endif
    _DROP
    if temp&
        packed$ = gen$(temp&,3)+" "+packed$
        goto error0
    endif
    goto xnext

xerror::
    // error  \ PsiForth
    // ?!!!
    // ( i*x c-addr u -- )
    _GET_PACKED
error0::
    // Input: packed$ = error message
    _REPORT_ERROR?(packed$)

xabort::
    // ABORT  \ Core
    // ( i*x -- ) ( R: j*x -- )

xquit::
    // QUIT  \ Core Ext
    // ( i*x -- ) ( R: j*x -- )
    sp& = sp0&
    rp& = rp0&
    state& = KInterpreting&

// print "let's close all" // *!!!
// press_key:
    while source_recursion% >1
// print "source_recursion% =",source_recursion% // *!!!
// press_key:
        if sourceid&>0
// print "closing sourceid&=",sourceid& // *!!!
// press_key:
            if ioclose(sourceid&)
                _REPORT_ERROR?("error closing source file in QUIT")
            endif
        endif

        #include "forth5mx_inc_restore_source.opp"

    endwh

    source_recursion%=1

    #ifdef _DSOURCE

    _NEW_TERMINAL_IB

    #else

    sourceid&=KSourceIDKeyboard%

    #endif

    do
        // _DEBUG?("in QUIT before refill")
        #include "forth5mx_inc_refill.opp"
        // output: successful&
        // _DEBUG?("in QUIT after refill, before INTERPRET")
        _CALL_XT?(xinterpret&,label02)
        // _DEBUG?("in QUIT after INTERPRET")
        _PROMPT
    until KFalse% // endless loop

xdebugnumber::
    // debug#  \ Forth 5mx
    // ( n -- )
#ifdef _TOS
    temp& = tos&
#else
    temp& = peekl(sp&)
#endif
    _DROP
    _DEBUG?(gen$(temp&,7))
    // output: aborted%
    if aborted%
        goto xabort
    endif
    goto xnext

xdebug::
    // debug  \ Forth 5mx
    // ( -- )
    _DEBUG?("")
    // output: aborted%
    if aborted%
        goto xabort
    endif
    goto xnext

xbrdebugquotebr::
    // (debug")  \ Forth 5mx
    // ( c-addr u -- )
    _GET_PACKED
    _DEBUG?(packed$)
    // output: aborted%
    if aborted%
        goto xabort
    endif
    goto xnext

xdebugquote::
    // debug"  \ Forth 5mx
    // ( "<spaces>name<quote>" -- )
    _PARSED?(34)  // 34 = code of "
    if state& // compiling
        _COMMA?(xbrsliteralbr&)
        _COMPILE_PARSED
        _COMMA?(xbrdebugquotebr&)
        goto xnext
    endif
    _DEBUG?(parsed$)
    // output: aborted%
    if aborted%
        goto xabort
    endif
    goto xnext

xprompt::
    // prompt  \ PsiForth
    // ( -- )
    _PROMPT
    goto xnext

xgat::
    // gat  \ OPL
    // ( u1 u2 -- )
    // u1 = x
    // u2 = y
#ifdef _TOS
    gat peekl(sp&),tos&
#else
    gat peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xgline::
    // gline  \ OPL
    // ( u1 u2 -- )
    // u1 = x
    // u2 = y
#ifdef _TOS
    glineto peekl(sp&),tos&
#else
    glineto peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xpostpone::
    // POSTPONE  \ Core
    // Compile time: ( <stream> -- )
    if state& = KInterpreting&
print "POSTPONE no está en compilación"
        goto compile_only
    endif
    _PARSED_WORD
    nametofind$ = parsed_word$
    //input: nametofind$
    #include "forth5mx_inc_find.opp"
    // output: nt& = nt or 0
    if nt&=0
        _REPORT_ERROR?("not found")
        goto xabort
    endif
    if (_CONTROL_BITS?(nt&) and KImmediate%) = 0
        _COMMA?(xcompile&)
    endif
    _COMMA?(_XT?(nt&))
    goto xnext

xcompile::
    // COMPILE  \ Not ANS
    // ( -- )
    if state& = KInterpreting&
        goto compile_only
    endif
    pokel dp&,peekl(ip&)
    ip& = ip&+KCell&
    dp& = dp&+KCell&
    goto xnext

xbrcompilebr::
    // [COMPILE]  \ Core Ext
    if state& = KInterpreting&
        goto compile_only
    endif
    _PARSED_WORD
    nametofind$ = parsed_word$
    // input: nametofind$
    #include "forth5mx_inc_find.opp"
    // output: nt& = nt or 0
    if nt&=0
        _REPORT_ERROR?("not found")
        goto xabort
    endif
    _COMMA?(_XT?(nt&))
    goto xnext

xfont::
    // font  \ OPL
    // ( u1 u2 -- )
#ifdef _TOS
    font% = peekl(sp&)
    fontattr% = tos&
#else
    font% = peekl(sp&+KCell&)
    fontattr% = peekl(sp&)
#endif
    setfont:(font%,fontattr%)
    _2DROP
    goto xnext

xbold::
    // bold  \ OPL
    // ( -- )
    setfont:(font%,fontattr% or 1)
    goto xnext

xthin::
    // thin  \ OPL
    // ( -- )
    setfont:(font%,0)
    goto xnext

xgbox::
    // gbox  \ OPL
    // ( u1 u2 -- )
    // u1 = width
    // u2 = height
#ifdef _TOS
    gbox peekl(sp&),tos&
#else
    gbox peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xgcircle::
    // gcircle  \ OPL
    // ( n flag -- )
    // n = radius
    // flag = fill?
#ifdef
    gcircle peekl(sp&),tos&
#else
    gcircle peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xgcolor::
    // gcolor  \ OPL
    // ( n1 n2 n3 -- )
    // n1 = red
    // n2 = green
    // n3 = blue
#ifdef _TOS
    gcolor peekl(sp&+KCell&),peekl(sp&),tos&
#else
    gcolor peekl(sp&+K2Cells&),peekl(sp&+KCell&),peekl(sp&)
#endif
    _3DROP
    goto xnext

xgellipse::
    // gellipse  \ OPL
    // ( n1 n2 flag -- )
    // n1 = horizontal radius
    // n2 = vertical radius
    // flag = fill?
#ifdef _TOS
    gellipse peekl(sp&+KCell&),peekl(sp&),tos&
#else
    gellipse peekl(sp&+K2Cells&),peekl(sp&+KCell&),peekl(sp&)
#endif
    _3DROP
    goto xnext

xgfill::
    // gfill  \ OPL
    // ( n1 n2 n3 -- )
    // n1 = width
    // n2 = height
    // n3 = graphics mode
#ifdef _TOS
    gfill peekl(sp&+KCell&),peekl(sp&),tos&
#else
    gfill peekl(sp&+K2Cells&),peekl(sp&+KCell&),peekl(sp&)
#endif
    _3DROP
    goto xnext

xgmode::
    // gmode  \ OPL
    // ( n -- )
    // n = 0 = pixels will be set
    // n = 1 = pixels will be cleared
    // n = 2 = pixels will be inverted
#ifdef _TOS
    ggmode tos&
#else
    ggmode peekl(sp&)
#endif
    _DROP
    goto xnext

xgmove::
    // gmove  \ OPL
    // ( n1 n2 -- )
    // n1 = x offset
    // n2 = y offset
#ifdef _TOS
    gmove peekl(sp&),tos&
#else
    gmove peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xgxy::
    // gxy  \ OPL
    // ( -- n1 n2 )
    // n1 = x
    // n2 = y
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,gx
    tos& = gy
#else
    pokel sp&+KCell&,gx
    pokel sp&,gy
#endif
    goto xnext

xtasks::
    // tasks  \ OPL
    DisplayTaskList:
    goto xnext

xlookup::
    // lookup  \ PsiForth
    // ?!!!
#ifdef _TOS
    i& = peekl(tos&)
    temp& = tos&+KCell&
    tos& = 0
    while i& and (tos&=0)
        if peekl(temp&) = peekl(sp&)
            tos& = peekl(temp&+KCell&)
        endif
        i&--
        temp& = temp&+K2Cells&
    endwh
#else
    i& = peekl(peekl(sp&))
    temp& = peekl(sp&)+KCell&
    pokel sp&, 0
    while i& and (peekl(sp&)=0)
        if peekl(temp&) = peekl(sp&+KCell&)
            pokel sp&, peekl(temp&+KCell&)
        endif
        i&--
        temp& = temp&+K2Cells&
    endwh
#endif
    _NIP
    goto xnext

xcolormode::
    // colormode  \ OPL
    // ( n -- )
    // n = 0 = 2-colour mode
    // n = 1 = 4-colour mode (default)
    // n = 2 = 16-color mode
#ifdef _TOS
    defaultwin tos&
#else
    defaultwin peekl(sp&)
#endif
    _DROP
    goto xnext

xbeep::
    // ?!!!
    // beep  \ OPL 
    // ( n1 n2 -- )
    // n1 = time = 1/32 seconds
    // n2 = pitch = 512/(pitch+1) KHz
    // beep (tos&-1)/50+1,512000/(peekl(sp&)+1) // ?!!!
#ifdef _TOS
    beep peekl(sp&),tos&
#else
    beep peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xbusy::
    // busy  \ OPL
    // ( c-addr u -- )
    _GET_PACKED
    indicate:(packed$)
    goto xnext

xindicator::
    // indicator  \ PsiForth
    // ( -- c-addr u )
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,addr(indicator$)+1
    tos& = len(indicator$)
#else
    pokel sp&+KCell&,addr(indicator$)+1
    pokel sp&,len(indicator$)
#endif
    goto xnext

xdays::
    // days  \ OPL
    // ( n1 n2 n3 -- )
#ifdef _TOS
    tos& = days(peekl(sp&+KCell&),peekl(sp&),tos&)
    sp& = sp&+K2Cells&
#else
    temp& = days(peekl(sp&+K2Cells&),peekl(sp&+KCell&),peekl(sp&))
    _2DROP
    pokel sp&,temp&
#endif
    goto xnext

xday::
    // day  \ OPL
    // ( -- n )
    _PUSH?(day)
    goto xnext

xmonth::
    // month  \ OPL
    // ( -- n )
    _PUSH?(month)
    goto xnext

xyear::
    // year  \ OPL
    // ( -- n )
    _PUSH?(year)
    goto xnext

xhour::
    // hour  \ OPL
    // ( -- n )
    _PUSH?(hour)
    goto xnext

xminute::
    // minute  \ OPL
    // ( -- n )
    _PUSH?(minute)
    goto xnext

xsecond::
    // second  \ OPL
    // ( -- n )
    _PUSH?(second)
    goto xnext

xscreen::
    // screen  \ OPL
    // ( n1 n2 n3 n4 -- )
    // n1 = width
    // n2 = height
    // n3 = x = column
    // n4 = y = line
#ifdef _TOS
    screen peekl(sp&+K2Cells&),peekl(sp&+KCell&),peekl(sp&),tos&
    tos& = peekl(sp&+K3Cells&)
    sp& = sp&+K4Cells&
#else
    screen peekl(sp&+K3Cells&),peekl(sp&+K2Cells&),peekl(sp&+KCell&),peekl(sp&)
    sp& = sp&+K4Cells&
#endif
    goto xnext

xscreeninfo::
    // screeninfo  \ OPL
    // ( -- n1 n2 n3 n4 n5 n6 n7 n8 n9 n10 )
    // ?!!!
#ifdef _TOS
    sp& = sp& - 10*KCell&
    pokel sp&+9*KCell&,tos&
    screeninfo screeninfo%()
    pokel sp&+8*KCell&,screeninfo%(10)
    pokel sp&+7*KCell&,screeninfo%(9)
    pokel sp&+K6Cells&,screeninfo%(8)
    pokel sp&+K5Cells&,screeninfo%(7)
    pokel sp&+K4Cells&,screeninfo%(6)
    pokel sp&+K3Cells&,screeninfo%(5)
    pokel sp&+K2Cells&,screeninfo%(4)
    pokel sp&+KCell&,screeninfo%(3)
    pokel sp&,screeninfo%(2)
    tos& = screeninfo%(1)
#else
    sp& = sp& - 10*KCell&
    screeninfo screeninfo%()
    pokel sp&+9*KCell&,screeninfo%(10)
    pokel sp&+8*KCell&,screeninfo%(9)
    pokel sp&+7*KCell&,screeninfo%(8)
    pokel sp&+K6Cells&,screeninfo%(7)
    pokel sp&+K5Cells&,screeninfo%(6)
    pokel sp&+K4Cells&,screeninfo%(5)
    pokel sp&+K3Cells&,screeninfo%(4)
    pokel sp&+K2Cells&,screeninfo%(3)
    pokel sp&+KCell&,screeninfo%(2)
    pokel sp&,screeninfo%(1)
#endif
    goto xnext

xsetcontrast::
    // setcontrast  \ OPL
    // ( n -- )
#ifdef _TOS
    setdisplaycontrast:(tos&)
#else
    setdisplaycontrast:(peekl(sp&))
#endif
    _DROP
    goto xnext

xweek::
    // week  \ OPL
    // ( -- n )
    _PUSH?(week(day,month,year))
    goto xnext

xrp::
    // rp  \ PsiForth
    // ( -- addr )
    _PUSH?(rp&)
    goto xnext

xsp::
    // sp  \ PsiForth
    // ( -- addr )
    _PUSH?(sp&)
    // this PsiForth word returned the address of the element under top of stack
    goto xnext

xr0::
    // 
    // r0  \ PsiForth
    // ( -- addr )
    _PUSH?(rp0&)
    goto xnext

xs0::
    // s0  \ PsiForth
    // ( -- addr )
    _PUSH?(sp0&)
    goto xnext

xqcompiling::
    // ?compiling  \ PsiForth
    // ( -- )
    if state& = KInterpreting&
        goto compile_only
    endif
    goto xnext

xqexecuting::
    // ?executing  \ PsiForth
    // ( -- )
    if state& // compiling
        goto interpret_only
    endif
    goto xnext

xnegate::
    // NEGATE  \ Core
    // ( n -- -n )
#ifdef _TOS
    tos& = (not tos&) + 1
#else
    pokel sp&,(not peekl(sp&)) + 1
#endif
    goto xnext

xinvert::
    // INVERT  \ Core
    // ( x1 -- x2 )
#ifdef _TOS
    tos& = not tos&
#else
    pokel sp&,not peekl(sp&)
#endif
    goto xnext

xunused::
    // UNUSED  \ Core Ext
    // ( -- u )
    _PUSH?((sp0& - KStackSize&) - dp&)
    goto xnext

xplay::
    // play  \ OPL
    // ( c-addr u -- )
    // ?!!!
    _GET_PACKED
    playsound:(packed$,volume&)
    goto xnext

x2over::
    // 2OVER  \ Core
    // ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,peekl(sp&+K4Cells&)
    tos& = peekl(sp&+K3Cells&)
#else
    pokel sp&+KCell&,peekl(sp&+K5Cells&)
    pokel sp&,peekl(sp&+K4Cells&)
#endif
    goto xnext

x2swap::
    // 2SWAP  \ Core
    // ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
#ifdef _TOS
    temp& = tos&
    tos& = peekl(sp&+KCell&)
    pokel sp&+KCell&,temp&
    temp& = peekl(sp&+K2Cells&)
    pokel sp&+K2Cells&,peekl(sp&)
    pokel sp&,temp&
#else
    temp& = peekl(sp&)
    pokel sp&, peekl(sp&+K2Cells&)
    pokel sp&+K2Cells&,temp&
    temp& = peekl(sp&+K3Cells&)
    pokel sp&+K3Cells&,peekl(sp&+KCell&)
    pokel sp&+KCell&,temp&
#endif
    goto xnext

xdump::
    // DUMP  \ Tools
    // ( addr +n -- )
    print
#ifdef _TOS
    dump:(peekl(sp&),tos&)
#else
    dump:(peekl(sp&+KCell&),peekl(sp&))
#endif
    _2DROP
    goto xnext

xrenamefile::
    // RENAME-FILE \ File Ext
    // ( c-addr1 u1 c-addr2 u2 -- ior )
    // :!!! ior is not yet calculated
    _GET_PACKED
    temp2$ = packed$
    _GET_PACKED
    rename packed$,temp2$
    _PUSH?(KFalse&) // false ior :!!!
    goto xnext

xcreatefile::
    // CREATE-FILE \ Core
    // ( c-addr u fam -- fileid ior )
#ifdef _TOS
    tos& = tos& and $ff0 or KIoOpenModeReplace% or KIoOpenAccessUpdate%
#else
    pokel sp&, peekl(sp&) and $ff0 or KIoOpenModeReplace% or KIoOpenAccessUpdate%
#endif

xopenfile::
    // OPEN-FILE \ File
    // ( c-addr u fam -- fileid ior )
#ifdef _TOS
    fam% = tos&
    _DROP
    _GET_PACKED
    _2INCREASE_STACK
    tos& = ioopen(temp%,packed$,fam%)
    pokel sp&,temp% // fileid
#else
    fam% = peekl(sp&)
    _DROP
    _GET_PACKED
    _2INCREASE_STACK
    pokel sp&, ioopen(temp%,packed$,fam%)
    pokel sp&+KCell&,temp% // fileid
#endif
    goto xnext

xclosefile::
    // CLOSE-FILE  \ File
    // ( fileid -- ior )
#ifdef _TOS
    tos& = ioclose(tos&)
#else
    pokel sp&, ioclose(peekl(sp&))
#endif
    goto xnext

xfilestatus::
    // FILE-STATUS  \ File Ext
    // ( c-addr u -- x ior )
    _GET_PACKED
    _2INCREASE_STACK
#ifdef _TOS
    if exist(filename$)
        temp0% = iabs(isreadonly&:(packed$))
        temp1% = iabs(ishidden&:(packed$))
        temp2% = iabs(issystem&:(packed$))
        pokel(sp&),temp0%+2*temp1%+4*temp2%
        tos& = 0
    else
        tos& = -33 // "File does not exist" OPL error code
    endif
#else
    if exist(filename$)
        temp0% = iabs(isreadonly&:(packed$))
        temp1% = iabs(ishidden&:(packed$))
        temp2% = iabs(issystem&:(packed$))
        pokel(sp&+KCell&),temp0%+2*temp1%+4*temp2%
        pokel sp&,0
    else
        pokel sp&, -33 // "File does not exist" OPL error code
    endif
#endif
    goto xnext

xreadline::
    // READ-LINE \ File
    // ( c-addr u1 fileid -- u2 flag ior )

#ifndef _DEBUG_DSOURCE // d!!!

    // Note from the OPL documentation for files opened in text mode:
    // If maxLen% exceeds the current record length, data only up to the end of the record is read into the buffer. No error is returned and the file position is set to the next record.
    // If a record is longer than maxLen%, the error value ‘Record too large’ (-43) is returned. In this case the data read is valid but is truncated to length maxLen%, and the file position is set to the next record.

    // Note from the OPL documentation for files opened in binary mode:
    // If you request more bytes than are left in the file, the number of bytes actually read (even zero) will be less than the number requested.
    // So if ret%<maxLen%, end of file has been reached. No error is returned by IOREAD in this case, but the next IOREAD would return the error value ‘End of file’ (-36).

    // First version, for files opened in text mode:

//  tos& = ioread(tos&,peekl(sp&+KCell&),peekl(sp&))
//  pokel sp&+KCell&,tos&*iabs(tos&>=0) // u2
//  pokel sp&,tos&<>-36 // flag
//  tos& = tos&*iabs(tos&<0 and tos&<>-36) // ior
//  goto xnext

    // Second version, for files opened in binary mode:

#ifdef _TOS
    temp& = tos& // fileid
    a1& = peekl(sp&+KCell&)
    u1& = peekl(sp&)
#else
    temp& = peekl(sp&) // fileid
    a1& = peekl(sp&+K2Cells&)
    u1& = peekl(sp&+KCell&)
#endif
    u2& = 0 // char count
    temp1& = KFalse& // line terminator first char found?
    temp2& = -1 // offset

    do
#ifdef _TOS
        tos& = ioread(temp&,a1&+u2&,1)
        if tos&<0
#else
        pokel sp&, ioread(temp&,a1&+u2&,1)
        if peekl(sp&)<0
#endif
            break
        endif
        temp1$ = chr$(peekb(a1&+u2&)) // char read
        if temp1&
            // The first line terminator char was found in the past loop.
            if temp1$<>right$(line_terminator$,1)
                // This char is not the second terminator char.
                // It can be the first line terminator char again or any other char.
                ioseek(temp&,3,temp2&) // one char back
            endif
            break
        else
            // The first line terminator char was not found yet.
            if temp1$=left$(line_terminator$,1)
                // This char is the first line terminator char.
                temp1&=KTrue&
            elseif temp1$=right$(line_terminator$,1)
                // This char is the second line terminator char.
                break
            else
                // This char is not part of the line terminator.
                u2&=u2&+1
            endif
        endif
    until u2&=u1&

#ifdef _TOS
    pokel sp&+KCell&,u2& // u2
    pokel sp&,tos&<>-36 // flag
    tos& = tos&*iabs(tos&<0 and tos&<>-36) // ior
#else
    pokel sp&+K2Cells&,u2& // u2
    pokel sp&+KCell&,peekl(sp&)<>-36 // flag
    pokel sp&,peekl(sp&)*iabs(peekl(sp&)<0 and peekl(sp&)<>-36) // ior
#endif

#endif // _DEBUG_DSOURCE

    goto xnext

xreadfile::
    // READ-FILE \ File
    // ( c-addr u1 fileid -- u2 ior )

    // Notes from the OPL documentation:
    // No more than 16K bytes can be read at a time.
    // And for files opened in binary mode:
    // If you request more bytes than are left in the file,
    // the number of bytes actually read (even zero)
    // will be less than the number requested.
    // So if ret%<maxLen%, end of file has been reached.
    // No error is returned by IOREAD in this case,
    // but the next IOREAD would return the error value ‘End of file’ (-36).

#ifdef _TOS
    // tos& = ioread(tos&,peekl(sp&+KCell&),peekl(sp&))
    tos& = unlimited_ioread&:(tos&,peekl(sp&+KCell&),peekl(sp&))
    _NIP
    pokel sp&,tos&*iabs(tos&>=0) // u2
    tos& = tos&*iabs(tos&<0) // ior
#else
    // temp& = ioread(peekl(sp&),peekl(sp&+K2Cells&),peekl(sp&+KCell&))
    temp& = unlimited_ioread&:(peekl(sp&),peekl(sp&+K2Cells&),peekl(sp&+KCell&))
    _DROP
    pokel sp&+KCell&,temp&*iabs(temp&>=0) // u2
    pokel sp&,temp&*iabs(temp&<0) // ior
#endif
    goto xnext

xwriteline::
    // WRITE-LINE \ File
    // ( c-addr u fileid -- ior )

    // Note from the OPL documentation:
    // When a file is opened as a binary file, the data written by IOWRITE overwrites data at the current position.
    // When a file is opened as a text file, IOWRITE writes a single record; the closing CR/LF is automatically added.  

    // All files (but the source files) are opened by Forth 5mx in binary mode,
    // so we have to write the line terminator.

#ifdef _TOS
    temp& = tos&
    tos& = iowrite(temp&,peekl(sp&+KCell&),peekl(sp&))
    sp& = sp& + K2Cells&
    if not tos&
        tos& = iowrite(temp&,addr(line_terminator$)+1,len(line_terminator$))
    endif
#else
    temp1& = peekl(sp&)
    temp2& = iowrite(temp1&,peekl(sp&+K2Cells&),peekl(sp&+KCell&))
    if not temp2&
        temp2& = iowrite(temp1&,addr(line_terminator$)+1,len(line_terminator$))
    endif
    _2DROP
    pokel sp&,temp2&
#endif
    goto xnext

xwritefile::
    // WRITE-FILE \ File
    // ( c-addr u fileid -- ior )

    // Note from the OPL documentation:
    // When a file is opened as a binary file, the data written by IOWRITE overwrites data at the current position.
    // When a file is opened as a text file, IOWRITE writes a single record; the closing CR/LF is automatically added.  

    // All files are opened by Forth 5mx in binary mode,
    // so write-file doesn't add the line terminator. That is right.

#ifdef _TOS
    tos& = iowrite(tos&,peekl(sp&+KCell&),peekl(sp&))
    sp& = sp& + K2Cells&
#else
    temp& = iowrite(peekl(sp&),peekl(sp&+K2Cells&),peekl(sp&+KCell&))
    _2DROP
    pokel sp&,temp&
#endif
    goto xnext

xseekfile::
    // seek-file \ OPL
    // ( n1 n2 fileid -- +n ior )
    // ( offset mode fileid -- absolute-position ior )
    // Mode can be one of these:
    // 1= Set position in a binary file to the absolute value specified in offset, with 0 for the first byte in the file
    // 2= Set position in a binary file to offset bytes from the end of the file 
    // 3= Set position in a binary file to offset bytes relative to the current position
    // 6= Rewind a text file to the first record. offset is not used, but you must still pass it as a argument, for compatibility with the other cases.

#ifdef _TOS
    temp1& = peekl(sp&+KCell&) // offset
    temp& = ioseek(tos&,peekl(sp&),temp1&)
    _NIP
    pokel sp&,temp1&
    tos& = temp&
#else
    temp1& = peekl(sp&+K2Cells&) // offset
    temp& = ioseek(peekl(sp&),peekl(sp&+KCell&),temp1&)
    _DROP
    pokel sp&+KCell&,temp1&
    pokel sp&,temp&
#endif
    goto xnext

xmkdir::
    // MKDIR \ OPL
    // ( c-addr u -- )
    _GET_PACKED
    mkdir file_name$:(packed$)
    goto xnext

xparsefile::
    // parse-file  \ PsiForth
    // ?!!!
    // ( handle addr n delimiter -- n status )
#ifdef _TOS
    temp% = tos& // delimiter
    i& = peekl(sp&) // max len
    temp& = peekl(sp& + KCell&) // addr
    _NIP
    while i& and (tos& >= 0)
        tos& = ioread(peekl(sp&+KCell&),temp&,1)
        if tos& > 0
            if peekb(temp&) = temp%
                i& = 0
            else
                i& = i&-1
                temp& = temp& + 1
            endif
        endif
    endwh
    if tos& > 0
        tos& = temp&-peekl(sp&)
    endif
    sp& = sp& + K2Cells&
#else
    print "SP CODE MISSING"
#endif
    goto xnext

xdeletefile::
    // DELETE-FILE \ File
    // ( c-addr u -- ior )
    _GET_PACKED
    delete packed$
    _PUSH?(KFalse&) // false ior
    goto xnext

xdirectory::
    // directory  \ PsiForth, OPL dir$
    // ( c-addr u -- )
    _GET_PACKED
    print
    packed$ = dir$(packed$)
    while len(packed$)
        print packed$
        packed$ = dir$("")
    endwh
    goto xnext

xdocode::
    // ?!!!
    print "would execute code at addr",wp&+KCell&
    goto xnext

xpath::
    // path  \ Forth 5mx
    // ( -- c-addr u )
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,addr(path$)+1
    tos& = len(path$)
#else
    pokel sp&+KCell&,addr(path$)+1
    pokel sp&,len(path$)
#endif
    goto xnext

xchdirq::
    // chdir"  \ Forth 5mx
    // ( -- )
    _PARSED?(34)  // 34 = code of "
    // :!!! ?!!! _PARSE could be used here instead, and save the following two lines:
    packed$ = parsed$
    goto xchdir0::

xchdir::
    // chdir  \ Forth 5mx
    // ( c-addr u -- )
    _GET_PACKED
xchdir0::
    path$=whole_path$:(packed$)
    if right$(path$,1)<>"\"     // :!!! perhaps with temp$ before whole_path$
        path$=path$+"\"
    endif
    goto xnext

xdinit::
    // dinit  \ OPL
    // ( c-addr u n -- )
#ifdef _TOS
    i& = tos&
#else
    i& = peekl(sp&)
#endif
    _DROP
    _GET_PACKED
    dinit packed$,i&
    nbuttons% = 0
    goto xnext

xdbutton::
    // dbutton  \ OPL
    // ?!!!
    nbuttons% = nbuttons% + 1
#ifdef _TOS
    dbutton%(nbuttons%) = tos&
#else
    dbutton%(nbuttons%) = peekl(sp&)
#endif
    _DROP
    _GET_PACKED
    dbutton$(nbuttons%) = packed$
    goto xnext

xdbuttons::
    // dbuttons  \ OPL
    // ?!!!
    vector nbuttons%
        button1
        button2
        button3
        button4
        button5
    endv

button1::
    dbuttons dbutton$(1),dbutton%(1)
    goto xnext

button2::
    dbuttons dbutton$(1),dbutton%(1),dbutton$(2),dbutton%(2)
    goto xnext

button3::
    dbuttons dbutton$(1),dbutton%(1),dbutton$(2),dbutton%(2),dbutton$(3),dbutton%(3)
    goto xnext

button4::
    dbuttons dbutton$(1),dbutton%(1),dbutton$(2),dbutton%(2),dbutton$(3),dbutton%(3),dbutton$(4),dbutton%(4)
    goto xnext

button5::
    dbuttons dbutton$(1),dbutton%(1),dbutton$(2),dbutton%(2),dbutton$(3),dbutton%(3),dbutton$(4),dbutton%(4),dbutton$(5),dbutton%(5)
    goto xnext

xdcheckbox::
    // dcheckbox  \ OPL
    // ?!!!
#ifdef _TOS
    temp% = tos&
#else
    temp% = peekl(sp&)
#endif
    _DROP
    _GET_PACKED
    dcheckbox temp%,packed$
    goto xnext

xdialog::
    // dialog  \ OPL
    // ?!!!
    _PUSH?(dialog)
    goto xnext

xdposition::
    // position  \ OPL
    // ?!!!
#ifdef _TOS
    dposition peekl(sp&),tos&
#else
    dposition peekl(sp&+KCell&),peekl(sp&)
#endif
    _2DROP
    goto xnext

xdtext::
    // dtext  \ OPL
    // ?!!!
#ifdef _TOS
    i& = tos&
#else
    i& = peekl(sp&)
#endif
    _DROP
    _GET_PACKED
    temp$ = packed$
    _GET_PACKED
    dtext temp$,packed$,i&
    goto xnext

xdchoice::
    // dchoice  \ OPL
    // ?!!!
#ifdef _TOS
    temp% = tos&
#else
    temp% = peekl(sp&)
#endif
    _DROP
    _GET_PACKED
    temp$=packed$
    _GET_PACKED
    dchoice temp%,temp$,packed$
    goto xnext

xallocate::
    // ALLOCATE  \ Memory
    // ( u -- a-addr ior )
#ifdef _TOS
    sp& = sp&-KCell&
    temp& = alloc(tos&)
    pokel(sp&), temp&
    tos& = (temp&=0)
#else
    temp& = alloc(peekl(sp&))
    _INCREASE_STACK
    pokel(sp&+KCell&), temp&
    pokel sp&, (temp&=0)
#endif
    goto xnext

xresize::
    // RESIZE  \ Memory
    // ( a-addr1 u -- a-addr2 ior )
#ifdef _TOS
    temp& = realloc(peekl(sp&),tos&)
    pokel (sp&),temp&
    tos& = (temp&=0)
#else
    temp& = realloc(peekl(sp&+KCell&),peekl(sp&))
    pokel sp&+KCell&,temp&
    pokel sp&, (temp&=0)
#endif
    goto xnext

xfree::
    // FREE  \ Memory
    // ( a-addr -- ior )
#ifdef _TOS
    freealloc tos&
    tos& = 0
#else
    freealloc peekl(sp&)
    pokel sp&,0
#endif
    goto xnext

xgetevent::
    // getevent  \ OPL
    // ?!!!
    geteventa32 eventstat%,eventbuf&()
    goto xnext

xevent::
    // event  \ OPL
    // ?!!!
#ifdef _TOS
    if tos&
        tos& = eventbuf&(tos&)
    else
        tos& = eventstat%
        eventstat% = 0
    endif
#else
    if peekl(sp&)
        pokel sp&,eventbuf&(peekl(sp&))
    else
        pokel sp&, eventstat%
        eventstat% = 0
    endif
#endif
    goto xnext

xalign::
    // ALIGN  \ Core
    // ( -- )
    dp& = _ALIGNED?(dp&)
    goto xnext

xaligned::
    // ALIGNED  \ Core
    // ( addr -- a-addr )
#ifdef _TOS
    tos& = _ALIGNED?(tos&)
#else
    pokel sp&,_ALIGNED?(peekl(sp&))
#endif
    goto xnext

xrun::
    // run  \ OPL
    // ( c-addr u -- )
    // ?!!!
    _GET_PACKED
    runapp&:(packed$,"","",2)
    goto xnext

xbacklight::
    // backlight  \ OPL
    // ( flag -- )
#ifdef _TOS
    setbacklighton:((tos&<>0) and 1)
#else
    setbacklighton:((peekl(sp&)<>0) and 1)
#endif
    _DROP
    goto xnext

xbacklightq::
    // backlight?  \ OPL
    // ( -- flag )
    _PUSH?(backlighton&:)
    goto xnext

xrnd::
    // rnd  \ OPL
    // ( x1 -- x2 )
    // ?!!!
#ifdef _TOS
    tos& = int(rnd*tos&)
#else
    pokel sp&,int(rnd*peekl(sp&))
#endif
    goto xnext

xthread::
    // thread
    // ( +u1 -- u2 )
#ifdef _TOS
    tos& = thread&(tos&)
#else
    pokel sp&,thread&(peekl(sp&))
#endif
    goto xnext

xdown::
    // down  \ OPL
    // ( -- )
    off
    goto xnext

xbye::
    // BYE
    // ( -- )
    bye:

xminustrailing::
    // -TRAILING  \ String
    // ( c-addr u1 -- c-addr2 u2 )

    // 2005.01.13, version with strings (max 255 chars):

/*
    pad$=packed$:
    while right$(pad$,1)=" "
        pad$=left$(pad$,len(pad$)-1)
    endwh
    string$ = pad$
    addr& = dp&+KPadSize&
    // input: string$ to store
    // input: addr& to store the string in
    // stack output: ( -- c-addr u )
    _STORE_STRING
    goto xnext
*/

    // 2005.01.28, version without strings (no length limit):

#ifdef _TOS
    temp& = peekl(sp&)-1
    i% = tos&
#else
    temp& = peekl(sp&+KCell&)-1
    i%=peekl(sp&)
#endif
//  while i% and (peekb(temp&+i%)=KKeySpace%)
    while i% and CharIsSpace%:(peekb(temp&+i%))
        i% = i% - 1
    endwh
#ifdef _TOS
    tos& = i%
#else
    pokel sp&,i%
#endif
    goto xnext

xsearch::
    // SEARCH  \ String
    // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )

    // version with strings (max 255 chars):

#ifdef _TOS
    a1&=peekl(sp&+K2Cells&)
    u1&=peekl(sp&+KCell&)
    u2&=tos&
    _GET_PACKED
    temp2$ = packed$ // searched string
    _GET_PACKED
    temp1$ = packed$ // longer string to search in
    temp& = loc(temp1$,temp2$)
    sp& = sp&-K3Cells&
    pokel sp&+K2Cells&,tos&
    if temp&
        pokel sp&+KCell&,a1&+temp&-1
        pokel sp&,u1&-temp&+1
        tos& = KTrue&
    else
        pokel sp&+KCell&,a1&
        pokel sp&,u1&
        tos& = KFalse&
    endif
#else
    a1&=peekl(sp&+K3Cells&)
    u1&=peekl(sp&+K2Cells&)
    u2&=peekl(sp&)
    _GET_PACKED
    temp2$ = packed$ // searched string
    _GET_PACKED
    temp1$ = packed$ // longer string to search in
    temp& = loc(temp1$,temp2$)
    sp& = sp&-K3Cells&
    if temp&
        pokel sp&+K2Cells&,a1&+temp&-1
        pokel sp&+KCell&,u1&-temp&+1
        pokel sp&,KTrue&
    else
        pokel sp&+K2Cells&,a1&
        pokel sp&+KCell&,u1&
        pokel sp&,KFalse&
    endif
#endif
    goto xnext

xcompare::
    // COMPARE  \ String
    // ( c-addr1 u1 c-addr u2 -- n )

#ifndef _DEBUG_DSOURCE

    // 2004.01.13, version with strings (max 255 chars):

/*
    u1&=peekl(sp&+KCell&)
    u2&=tos&
    temp2$ = packed$:
    temp1$ = packed$:
    _INCREASE_STACK
    // are the two strings identical?
    if temp1$=temp2$
        tos& = 0
        goto xnext
    endif
    // are they identical up to the length of the shorter string?
    temp&=min(u1&,u2&)
    temp1$=left$(temp1$,temp&)
    temp2$=left$(temp2$,temp&)
    if temp1$=temp2$
        tos& = -1 + 2*iabs(u1&>=u2&)
        goto xnext
    endif
    // they are different up to the length of the shorter one
    i&=1
    while i&<=temp&
        if mid$(temp1$,i&,1)<>mid$(temp2$,i&,1)
            tos& = -1 + 2*iabs(mid$(temp1$,i&,1)>mid$(temp2$,i&,1))
            break
        endif
        i&=i&+1
    endwh
    goto xnext

*/

    // 2005.01.29, version without strings (no length limit):

#ifdef _TOS
    a1&=peekl(sp&+K2Cells&)
    u1&=peekl(sp&+KCell&)
    a2&=peekl(sp&)
    u2&=tos&
    sp& = sp&+K3Cells&
    tos& = 0
    temp1& = min(u1&,u2&)
    temp2& = max(u1&,u2&)
    i& = 0
    while i&<temp2&
        if peekb(a1&+i&)<>peekb(a2&+i&)
            tos& = -1 + 2*iabs(peekb(a1&+i&)>peekb(a2&+i&))
            break
        endif
        i& = i&+1
        if i&=temp1& and i&<>temp2&
            tos& = -1 + 2*iabs(u1&>u2&)
            break
        endif
    endwh
#else
    a1&=peekl(sp&+K3Cells&)
    u1&=peekl(sp&+K2Cells&)
    a2&=peekl(sp&+KCell&)
    u2&=peekl(sp&)
    sp& = sp&+K3Cells&
    pokel sp&,0
    temp1& = min(u1&,u2&)
    temp2& = max(u1&,u2&)
    i& = 0
    while i&<temp2&
        if peekb(a1&+i&)<>peekb(a2&+i&)
            pokel sp&, -1 + 2*iabs(peekb(a1&+i&)>peekb(a2&+i&))
            break
        endif
        i& = i&+1
        if i&=temp1& and i&<>temp2&
            pokel sp&, -1 + 2*iabs(u1&>u2&)
            break
        endif
    endwh
#endif

#endif // _DEBUG_DSOURCE

    goto xnext

xparenthesis::
    // (  \ Core
    // ( -- )
    _PARSE_OFF?(41) // 41 = code of the char )
    goto xnext

xbackslash::
    // \  \ Core Ext
    // ( -- )
    _PARSE_OFF?(0)
    goto xnext

xdatetosecs::
    // date>secs  \ OPL
    // ( second minute hour day month year -- secs )
    // secs = seconds since 1970.01.01 00:00
#ifdef _TOS
    tos& = datetosecs(tos&,peekl(sp&),peekl(sp&+KCell&),peekl(sp&+K2Cells&),peekl(sp&+K3Cells&),peekl(sp&+K4Cells&))
    sp& = sp&+K5Cells&
#else
    temp&=datetosecs(peekl(sp&),peekl(sp&+KCell&),peekl(sp&+K2Cells&),peekl(sp&+K3Cells&),peekl(sp&+K4Cells&),peekl(sp&+K5Cells&))
    sp& = sp&+K5Cells&
    pokel sp&,temp&
#endif
    goto xnext

xsecstodate::
    // secs>date  \ OPL
    // ( secs -- second minute hour day month year)
    // secs = seconds since 1970.01.01 00:00
#ifdef _TOS
    secstodate tos&,temp0%,temp1%,temp2%,temp3%,temp4%,temp5%,temp6%
    tos& = temp0%
    sp& = sp&-K5Cells&
    pokel sp&,temp1%
    pokel sp&+KCell&,temp2%
    pokel sp&+K2Cells&,temp3%
    pokel sp&+K3Cells&,temp4%
    pokel sp&+K4Cells&,temp5%
#else
    secstodate peekl(sp&),temp0%,temp1%,temp2%,temp3%,temp4%,temp5%,temp6%
    sp& = sp&-K5Cells&
    pokel sp&,temp0%
    pokel sp&+KCell&,temp1%
    pokel sp&+K2Cells&,temp2%
    pokel sp&+K3Cells&,temp3%
    pokel sp&+K4Cells&,temp4%
    pokel sp&+K5Cells&,temp5%
#endif
    goto xnext

xsourceid::
    // SOURCE-ID  \ Core Ext
    // ( -- n )
    _PUSH?(sourceid&)
    goto xnext

xsource::
    // SOURCE  \ Core
    // ( -- c-addr u )
    _2INCREASE_STACK
#ifdef _TOS
    pokel sp&,ib_addr&
    tos& = ib_len&
#else
    pokel sp&+KCell&,ib_addr&
    pokel sp&, ib_len&
#endif
    goto xnext

xsourcestore::
    // SOURCE!  \ Forth 5mx
    // ( c-addr u -- )
#ifdef _TOS
    ib_addr& = peekl(sp&)
    ib_len& = tos&
#else
    ib_addr& = peekl(sp&+KCell&)
    ib_len& = peekl(sp&)
#endif
    _2DROP
    goto xnext

xsaveinput::
    // SAVE-INPUT  \ Core Ext
    // ( -- n1 n2 n3 n4 4 )
    // n1 = ib_addr&
    // n2 = ib_len&
    // n3 = >IN = toin&
    // n4 = SOURCE-ID
    _SAVE_INPUT
    goto xnext

xrestoreinput::
    // RESTORE-INPUT  \ Core Ext
    // ( n1 n2 n3 n4 4 -- flag )
    // n1 = ib_addr&
    // n2 = ib_len&
    // n3 = >IN = toin&
    // n4 = SOURCE-ID
    _RESTORE_INPUT
    goto xnext

xparse::
    // PARSE  \ Core Ext
    // ( char "ccc<char>" -- c-addr u )
#ifndef _DEBUG_DSOURCE // d!!!
    _PARSE_TOS
#endif // _DEBUG_DSOURCE
    goto xnext

xtoupper::
    // toupper  \ gforth
    // ( c1 -- c2 )
#ifdef _TOS
    tos&=asc(upper$(chr$(tos&)))
#else
    pokel sp&,asc(upper$(chr$(peekb(sp&))))
#endif
    goto xnext

xupper::
    // upper  \ Forth 5mx
    // ( c-addr1 u -- )
#ifdef _TOS
    temp&=peekl(sp&)
    while tos&
        tos&--
        pokeb temp&+tos&,asc(upper$(chr$(peekb(temp&+tos&))))
    endwh
    _2DROP
    // old version until 2006-12-30:
    // ( c-addr1 u -- c-addr2 u )
//  _GET_PACKED
//  to_sbuffer:(upper$(packed$))
#else
    temp&=peekl(sp&+KCell&)
    i&=peekl(sp&)
    while i&
        i&--
        pokeb temp&+i&,asc(upper$(chr$(peekb(temp&+i&))))
    endwh
    _2DROP
#endif
    goto xnext

xtolower::
    // tolower  \ gforth
    // ( c1 -- c2 )
#ifdef _TOS
    tos&=asc(lower$(chr$(tos&)))
#else
    pokel sp&,asc(lower$(chr$(peekb(sp&))))
#endif
    goto xnext

xlower::
    // lower  \ Forth 5mx
    // ( c-addr u -- )
#ifdef
    temp&=peekl(sp&)
    while tos&
        tos&--
        pokeb temp&+tos&,asc(lower$(chr$(peekb(temp&+tos&))))
    endwh
    _2DROP
    // old version until 2006-12-31:
    // ( c-addr1 u -- c-addr2 u )
//  _GET_PACKED
//  to_sbuffer:(lower$(packed$))
#else
    temp&=peekl(sp&+KCell&)
    i&=peekl(sp&)
    while i&
        i&--
        pokeb temp&+i&,asc(lower$(chr$(peekb(temp&+i&))))
    endwh
    _2DROP
#endif
    goto xnext

xdirstr::
    // dir$  \ OPL
    // ( c-addr1 u1 -- c-addr2 u2 )
    _GET_PACKED
    string$ = dir$(packed$)
    #include "forth5mx_inc_to_sbuffer.opp"
    goto xnext

xsetpath::
    // setpath  \ OPL
    // ( c-addr u -- )
    _GET_PACKED
    path$ = whole_path$:(packed$)
    setpath path$
    goto xnext

xtosbuffer::
    // >sbuffer  \ Forth 5mx
    // ( c-addr1 u -- c-addr2 u )
    // Store a string in the string buffer and return it with its new address.
    _GET_PACKED
    string$=packed$
    #include "forth5mx_inc_to_sbuffer.opp"
    goto xnext

xplussbuffer::
    // +sbuffer  \ Forth 5mx
    // ( u -- c-addr )

#ifdef _TOS
    _PLUS_SBUFFER?(tos&)
#else
    _PLUS_SBUFFER?(peekl(sp&))
#endif

#ifdef _DSBUFFER

#ifdef _TOS
    tos&=sbuffer_start&+DesLength&:(sbuffer_descriptor&)
#else
    pokel sp&,sbuffer_start&+DesLength&:(sbuffer_descriptor&)
#endif

#else

#ifdef _TOS
    tos&=sbuffer_current&
#else
    pokel sp&,sbuffer_current&
#endif

#endif

    goto xnext


xsbuffer::
    // sbuffer  \ Forth 5mx
    // ( -- c-addr)
    #ifdef _DSBUFFER
        _PUSH?(sbuffer_start&+DesLength&:(sbuffer_descriptor&))
    #else
        _PUSH?(sbuffer_current&)
    #endif
    goto xnext

xsbufferfree::
    // sbuffer-free  \ Forth 5mx
    // ( -- u)
    _PUSH?(_SBUFFER_FREE)
    goto xnext

xsbufferplusstore::
    // sbuffer+!  \ Forth 5mx
    // ( u -- )
#ifdef _DSBUFFER

#ifdef _TOS
    DesSetLength:(sbuffer_descriptor&,DesLength&:(sbuffer_descriptor&)+tos&)
#else
    DesSetLength:(sbuffer_descriptor&,DesLength&:(sbuffer_descriptor&)+peekl(sp&))
#endif

#else

#ifdef _TOS
    sbuffer_current&=sbuffer_current&+tos&
#else
    sbuffer_current&=sbuffer_current&+peekl(sp&)
#endif

#endif

    _DROP
    goto xnext

xsbufferplus::
    // sbuffer+  \ Forth 5mx
    // ( -- )
    _SBUFFER_PLUS
    goto xnext

xnumbertib::
    // #TIB  \ Core Ext
    // ( -- a-addr)
    _INCREASE_STACK
    numbertib& = len(ib$)
#ifdef _TOS
    tos& = addr(numbertib&)
#else
    pokel sp&,addr(numbertib&)
#endif
    goto xnext

xtib::
    // TIB  \ Core Ext
    // ( -- c-addr)
    _INCREASE_STACK
#ifdef _TOS
    tos& = ib_addr&
#else
    pokel sp&,ib_addr&
#endif
    goto xnext

xlshift::
    // LSHIFT  \ Core
    // ( x1 u -- x2 )
    // first try:
#ifdef _TOS
    temp& = tos&
    temp = peekl(sp&)
    while temp&
        temp = temp*2
        temp&=temp&-1
    endwh
    tos& = signed&:(temp)
#else
    temp& = peekl(sp&)
    temp = peekl(sp&+KCell&)
    while temp&
        temp = temp*2
        temp&=temp&-1
    endwh
    // print signed&:(temp)
    pokel sp&, signed&:(temp)
#endif
    _NIP
    goto xnext

xrshift::
    // RSHIFT  \ Core
    // ( x1 u -- x2 )
    // fisrt try:
#ifdef _TOS
    temp& = tos&
    tos& = peekl(sp&)
    while temp&
        tos& = tos&/2
        temp&=temp&-1
    endwh
#else
    temp& = peekl(sp&)
    temp1& = peekl(sp&+Kcell&)
    while temp&
        temp1& = temp1&/2
        temp&=temp&-1
    endwh
    pokel sp&,temp1&
#endif
    _NIP
    goto xnext

xstarstar::
    // **  \ Forth 5mx
    // ( n1 n2 -- n3 )
#ifdef _TOS
    tos& = peekl(sp&)**tos&
    _NIP
#else
    pokel sp&+KCell&, peekl(sp&+KCell&)**peekl(sp&)
    _DROP
#endif
    goto xnext

xmarker::
    // MARKER  \ Core Ext
    // ( "<spaces>name" -- )
    temp& = dp&
    temp1& = last_nt&
    temp2& = thread_pointer%
    // Store also the threads:
    temp3& = alloc(KThreads%*KCell&)
    if temp3&=0
        raise KErrNoMemory%
    endif
    temp0&=temp3&
    i%=KThreads%
    while i%
        pokel temp0&,thread&(i%)
        temp0&+=KCell&
        i%--
    endwh
    _PARSED_WORD
    header&:(parsed_word$,0)
    _COMMA?(xbrmarkerbr&) // (marker)
    _COMMA?(temp&)
    _COMMA?(temp1&)
    _COMMA?(temp2&)
    _COMMA?(temp3&)
    goto xnext

xbrmarkerbr::
    // (marker)  \ Forth 5mx
    // Run time code for words created by MARKER .
    dp& = peekl(wp&+KCell&)
    last_nt& = peekl(wp&+K2Cells&)
    thread_pointer% = peekl(wp&+K3Cells&)
    // Restore the threads:
    temp0&=peekl(wp&+K4Cells&)
    temp&=temp0&
    i%=KThreads%
    while i%
        thread&(i%)=peekl(temp&)
        temp&+=KCell&
        i%--
    endwh
    freealloc temp0&
    goto xnext

xgetfilesize::
    // getfilesize  \ OPL   
    // ( c-addr u -- u2 )
    _GET_PACKED
    temp$ = whole_path$:(packed$)
    _PUSH?(GetFileSize&:(temp$))
    goto xnext

xalias::
    // alias  \ Common use
    // ( xt "<spaces>name" -- )
    _PARSED_WORD
    header&:(parsed_word$,0)
#ifdef _TOS
    pokel _XT_ADDRESS?(last_nt&), tos&
#else
    pokel _XT_ADDRESS?(last_nt&), peekl(sp&)
#endif
    _DROP
    goto xnext


xevaluate::
    // EVALUATE  \ Core
    // ( i*x c-addr u -- j*x )
    _GET_PACKED
    #include "forth5mx_inc_save_source.opp"
    #ifdef _DSOURCE
        _NEW_EVALUATE_IB?(packed$)
    #else
        ib$=packed$
        ib_len& = len(ib$)
        sourceid& = KSourceIDString%
        toin&=0
    #endif
    _INDICATE_SOURCE
    _CALL_XT?(xinterpret&,label03)
    #include "forth5mx_inc_restore_source.opp"
    goto xnext

xinterpret::
    // interpret  \ Forth 5mx
    // ( -- )

    do
        _PARSED_WORD
        if len(parsed_word$)
            nametofind$=parsed_word$
            // input: nametofind$
            #include "forth5mx_inc_find.opp"
            // output: nt& = nt or 0
            if nt&
                // found
                if state& and ((_CONTROL_BITS?(nt&) and KImmediate%)=0)
                    // compile
                    _COMMA?(_XT?(nt&))
                else
                    // execute
                    _CALL_NT?(nt&,label00)
                endif
                if sp0&-sp& < 0
                    _REPORT_ERROR?("stack underflow")
                    goto xabort
                endif
            elseif numberq%:(parsed_word$)
                if state& // compiling
                    pokel dp&,xbrliteralbr&
                    pokel dp&+KCell&,number&:(parsed_word$)
                    dp& = dp& + K2Cells&
                    // maybe faster with _COMMA? b!!!
                else
                    // interpreting
                    _PUSH?(number&:(parsed_word$))
                endif
            else
                _REPORT_ERROR?("not found")
                goto xabort
            endif
        endif
    until toin&>=ib_len&
    ib_len&=0
// _DEBUG?("en INTERPRET ante goto xnext")
    goto xnext

xrdrop::
    // rdrop  \ Common use
    // ( R: x -- )
    _RDROP
    goto xnext

x2rdrop::
    // 2rdrop  \ Common use
    // ( R: x1 x2 -- )
    _2RDROP
    goto xnext

xdequal::
    // D=  \ Double
    // ( d1 d2 -- f )
    // :!!! 
    goto xnext


// new_primitives_here

oplerror::
    onerr off // :!!! *!!!
    _REPORT_ERROR?( err$(err) + " (opl error #" + num$(iabs(err),4) + ")" )
    onerr oplerror // :!!! *!!!
    goto xabort

interpret_only::
    _REPORT_ERROR?("use only during interpretation")
    goto xabort

compile_only::
    _REPORT_ERROR?("use only during compilation")
    goto xabort

// End of the file forth5mx_fvm.opp