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