forth5mx.opp

Descripción del contenido de la página

Fichero fuente principal de Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.

Etiquetas:

Este fichero es el principal de Forth 5mx. Define los parámetros de la aplicación para su instalación; define las palabras primitivas de Forth y alberga (la incluye desde un fichero independiente) la máquina virtual del sistema.

Código fuente

// forth5mx.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>.

// Forth 5mx
// A Forth for the Psion 5mx

// Based on:
// PsiForth v0.225 27feb2000,01mar2000
// Copyright © 1999 by Integrated Services
// Arnhem, The Netherlands

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

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

// -------------------------------------------------------
// Notation for the data stack arguments
// -------------------------------------------------------

// a-addr = cell-aligned address
// addr = address
// b = byte
// c = printable character
// char = printable character
// c-addr = character-aligned address
// f = flag
// fam = file access method
// fid = file identifier
// ior = input/output result
// n = signed number
// +n = positive number
// nt = name token
// pfa = parameter field address (data field)
// d = double number
// u = unsigned number
// ud = unsigned double number
// x = unspecified cell
// xt = execution token

// -------------------------------------------------------
// Version
// -------------------------------------------------------

#define _VERSION "0.0.20110104 beta"

// -------------------------------------------------------
// Preprocessor
// -------------------------------------------------------

// Keep the resulting OPL.
// It is needed to be compiled in a second step because, for some unknown reason,
// the executable created by OPL+ doesn't work.

#pragma to_file forth5mx.opl.txt

// -------------------------------------------------------
// Application header
// -------------------------------------------------------

app Forth5mx,&20001DFD // name and uid&, unique Psion app ID
	caption "Forth 5mx",1 // KLangEnglish%
	caption "Forth 5mx",4 // KLangSpanish%
	icon "forth5mx_icon48.mbm" // icon
	icon "forth5mx_icon48.mbm" // mask
	icon "forth5mx_icon32.mbm" // icon
	icon "forth5mx_icon32.mbm" // mask
	icon "forth5mx_icon24.mbm" // icon
	icon "forth5mx_icon24.mbm" // mask
enda

// -------------------------------------------------------
// Required files
// -------------------------------------------------------

#include "forth5mx_macros.opp"

// Include files must be in the local directory or in the directory /System/OPL of any drive.
include "Const.oph"
include "System.oxh"
include "CE32Base.oxh"
include "CDescriptor.oxh"
// include "CFile.oxh"
#ifdef _ASM
include "mc.oxh"
#endif
include "Sysram1.oxh" // needed for getfilesize$


// -------------------------------------------------------
// Constants
// -------------------------------------------------------

// Path
const KIncludePath$ = "c:\doc\comp\forth\forth5mx\"

// Flags
const KTrue& = _TRUE
const KFalse& = _FALSE
const KCompiling& = _TRUE
const KInterpreting& = _FALSE

// ANS Forth
const KSourceIDKeyboard% = 0
const KSourceIDString% = -1


// bytes/cell
const KCell& = 4
const K2Cells& = 8
const K3Cells& = 12
const K4Cells& = 16
const K5Cells& = 20
const K6Cells& = 24

// Memory
const KMemSize& = 393216 // bytes (program + stack space)
const KStackSize& = 512 // data stack size in cells
const KRStackSize& = 512 // return stack size in cells
const KSBufferSize& = 65536 // bytes of the circular string buffer

// Environment
const KCountedString% = 255 // bytes, /COUNTED-STRING
const KPadSize% = 255 // bytes, /PAD
const KMaxChar% = 255 // bytes, MAX-CHAR

// Dictionary
const KMaxHeaders% = 2500
const KMaxNameSize% = 49 // max chars/name
const KExecutionTokenOffset% = 50 // max chars/header plus one byte for the len; must be cell aligned
const KControlBitsOffset% = 54 // KExecutionTokenOffset% + KCell%
const KHeaderSize%= 58 // must be cell aligned
const KImmediate% = 64 // bit mask
const KThreads% = 2500 // must be power of 2
const KThreadMask% = 2499 // threads - 1
const KThreadMem% =  7500 // 2*KMaxHeaders%+KThreads%
const KWordLists% = 8  // ANS minimum

// Other about Forth 5mx
// const KRelease% = 0 // obsolete!!!
const KExtendFile$ = "forth5mx/forth5mx_extend.fs"
const KFonts% = 8
const KMaxSourceRecursions% = 8 // max number of source recursions
const KMaxHistory%=32

// EPOC
const KClipboardFile$="C:\System\Data\Clpboard.cbd"

// Key codes
const KKeySpace& = 32
const KKeyEsc& = 27
const KKeyEnter& = 13
const KKeyLineFeed& = 10
const KCharBackSlash% = 92

// Machine code extensions

#ifdef _ASM
	
const K_sp_ws_offset% = 0  // this is the macro _SP_WS_OFFSET in the assembler code

#endif

// -------------------------------------------------------
// Main
// -------------------------------------------------------

// declare external
// external state&

proc Forth:

	// Global variables *******************************

	// Debug 
	
	global aborted%  // flag returned by the _DEBUG macro.

	// General variables:

	local mem& // memory heap address for the Forth system
	// global names& // memory heap address for the word names. Used in header:.  // x!!! obsolete
	global headers& // memory heap address for the word headers. Used in header:.

	local uid& // unique Psion app ID, also in APP

	// Virtual machine variables:

	global last_nt& // the last name token used
	local dp0& // address of the first cell of the dictionary or data space before loading the extend file
	global dp& // dictionary or data space pointer, returned by HERE
	global thread&(KThreadMem%)
	global thread_pointer%
//	global name&(KMaxHeaders%) // addresses of word names, indexed by last_nt&
//	global control_bits%(KMaxHeaders%) // predence bit, hide/reveal flags, indexed by last_nt&. Used in header&.
//	global xt&(KMaxHeaders%) // execution tokens, indexed by last_nt&
	global base& // BASE
	local state& // STATE
	local sp0& // address of the first cell of the data stack
	local sp& // data stack pointer (to the last but one element in case the macro flag _TOS is defined)
#ifdef _ASM
	local sp_addr& // real address, in the machine code extension, of the stack pointer
#endif
#ifdef _TOS
	local tos& // top of stack
#endif
	local wp& // current word pointer
	local ip& // interpretive pointer
	local rp0& // address of the first cell of the return stack 
	local rp& // return stack pointer

	#ifdef _DSOURCE
		global ib_descriptor& // input buffer descriptor
		global ib_lex& // input buffer lexical analyser
	#else
		global ib$(KMaxStringLen%) // input buffer
		local ib_opl_addr& // address of the ib$ variable. It is a bit faster peekb(ib_opl_addr&) than len(ib$)
		global toin& // >IN
		// local toin_back& // obsolete!!!
	#endif
	local ib_addr& // input buffer address = addr(ib$)+1
	// local ib_addr_back& // obsolete!!!
	global ib_len& // max lenght of the current input buffer // :!!!
	// local ib_len_back& // obsolete!!
	global sourceid& // SOURCE-ID
	// local sourceid_back& // obsolete!!!

	local span& // SPAN
	local numbertib& // #TIB
	global history$(KMaxHistory%,KMaxStringLen%) // copies of the input line
	global HistoryFile$(KMaxStringLen%) // copies of the input line beetwen sessions
	global LastHistory% // pointer to the last line entered
	global MaxLastHistory%  // max LastHistory% reached
	local pad$(KPadSize%) // scratch pad
	global pad& // address of pad$. Used in hold&:.
	local parsed_word$(KMaxNameSize%) // this can not be local because it is used in report_error:()

	// Screen attributes variables:

	global font%
	global fontattr%

	// Path variables:

	global forth5mx_path$(KMaxStringLen%) // the path to the Forth 5mx directory (now sources, maybe app in the future) :!!!
	global path$(KMaxStringLen%) // the current path for any file operation
	global include_path$(KMaxStringLen%) // the temporal path while including source (it is that of the included file), to make nested included file paths relatives
	global home_path$(KMaxStringLen%) // home directory to translate ~/ into.
	
	// Circular string buffer variables:
	
	global sbuffer_start& // first address
	global sbuffer_length& // length in bytes, later calculated from KSBufferSize&
	global sbuffer_end& // last address
	global sbuffer_reserved& // reserved bytes for the string to be stored ?!!! unnecessary if the buffer is at least 256 bytes long?
	#ifdef _DSBUFFER
		global sbuffer_descriptor&  // C descriptor object to manipulate the string buffer
	#else
		global sbuffer_current& // address of the free space
	#endif

	// Source recursion variables:

	local file_id%
	global source_recursion% // current source recursion
	global recursive_sourceid&(KMaxSourceRecursions%) // SOURCE-ID store for recursive source
	global recursive_path$(KMaxSourceRecursions%,KMaxStringLen%) // path for recursive source
	#ifdef _DESCRIPTOR_SOURCE
		global recursive_ib_addr&(KMaxSourceRecursions%) // input buffer
		global recursive_ib_descriptor&(KMaxSourceRecursions%) // descriptor object
		global recursive_ib_lex&(KMaxSourceRecursions%) // lexical analyser object
	#else
		global recursive_ib$(KMaxSourceRecursions%,KMaxStringLen%) // input buffer store for recursive source
		global recursive_toin&(KMaxSourceRecursions%) // >IN store for recursive source
	#endif

	// Variables for screen attributes:

	global thinfont&(KFonts%)
	global boldfont&(KFonts%)
	global thinattr%(KFonts%)
	global boldattr%(KFonts%)
	global screeninfo%(10) // used by the word SCREENINFO to call the OPL command screeninfo.
	global indicator$(KBusyMaxText%) // busy/battery indicator

	// Variables for execution tokens used in high level definitions:

	local xlabel00&
	local xlabel01&
	local xlabel02&
	local xlabel03&
	local xabort&
	local xbr2constantbr&
	local xbranch&
	local xbrcolonbr&
	local xbrconstantbr&
	local xbrcreatebr&
	local xbrcsliteralbr&
	local xbrdebugquotebr&
	local xbrleavebr&
	local xbrliteralbr&
	local xbrmarkerbr&
	local xbrprimitivevariablebr&
	local xbrsliteralbr&
	local xbrvariablebr&
	local xcold&
	local xcoldstart&
	local xcompile&
	local xcr&
	local xexit&
	local xextend&
	local xinterpret&
	local xnext& // needed? *!!! :!!! ?!!!
	local xprompt&
	local xquit&
	local xsliteral&
	local xthrow0&
	
	// Word lists
	global warning&  // Common use flag to check already defined words.
	local current& // Common use to point to the current compilation word list.
	local context& // Common use to point to the context word list. It is not used as the corresponding Forth variable, but will point to the address of the CONTEXT word, defined in OPL as a high level Forth variable.
	local last_wordlist&  // Point to the most recently defined word list.

	// Other variables:

	global line_terminator$(2)
	local xautoexec&
	local battstat& // obsolet x!!!
	// global xkeytable&
	global xuser& // ?!!!
	local volume&
	global debug&  // flag to turn debugging on and off
	global error_sound&  // flag to keep the state of the error sound
	// global error_sound_xt&  // xt of the word that produces the debug sound :!!!

	// Global copies of local variables used in the debug procedures.
	// They are updated by the _BEFORE_DEBUG macro.
	
	global g_dp&
	#ifndef _DSOURCE
		global g_ib$(KMaxStringLen%)
		global g_ib_addr&
	#endif
	global g_ib_len&
	global g_ip&
	global g_last_nt&
	global g_parsed_word$(KMaxStringLen%)
	global g_rp&
	global g_rp0&
	global g_source_recursion%
	global g_sourceid&
	global g_sp&
	#ifdef _ASM
		global g_sp_addr& // :!!! ?!!!
	#endif
	global g_sp0&
	#ifndef _DSOURCE
		global g_toin&
	#endif
	#ifdef _TOS
		global g_tos&
	#endif
	global g_wp&
	
	global g_context&
	global g_current&
	
	// temporal variables
	
	local successful&  // to return flags from included code
	local i& // general use index
	local i% // general use index
	local source&, destination& // for string moves
	local char%
	local fam% // file access method, for file operations
	local temp, temp1, temp2
	local temp&,temp0&,temp1&,temp2&,temp3&
	local temp%,temp0%,temp1%,temp2%,temp3%,temp4%,temp5%,temp6%
	local temp$(KMaxStringLen%), temp1$(KMaxStringLen%), temp2$(KMaxStringLen%)
	local filename$(KMaxStringLen%)
	local number$(KMaxStringLen%)
	local digit&
	local a1&,u1&,a2&,u2& // for stack parameters
	_GET_PACKED_LOCALS
	_PARSED_WORD_LOCALS
	_PARSE_WORD_LOCALS
	_PARSED_LOCALS
	_PARSE_LOCALS
	_PARSE_TOS_LOCALS
	_CALCULATE_HASH_LOCALS
	
	local first_char%,len%,delimiter%  // used in xword
	local string$(KMaxStringLen%), len&  // used in forth5mx_inc_to_sbuffer.opp and _STORE_STRING
	local addr&  // used in _STORE_STRING

	_FIND_LOCALS // locals needed in the included file forth5mx_inc_find.opp

	// ?!!! PsiForth
	local keywaiting%
	local nbuttons%
	local dbutton%(5),dbutton$(5,128)
	local eventstat%,eventbuf&(16)

	#ifdef _ASM
	
	// machine code variables
	local mc_workspacesize&
	local mc_workspace&
	local mc_handle&

	// machine code functions

	// local mc_initws&
	local mc_xdrop&

	#endif
	
	// Init *******************************

	// Init the memory:

	mem& = alloc(KMemSize&)
	if mem&=0
		raise KErrNoMemory%
	endif
	
	headers& = alloc(int(KMaxHeaders%)*KHeaderSize%)
	if headers&=0
		raise KErrNoMemory%
	endif

//	names& = alloc(int(KMaxHeaders%)*KMaxHeaderSize1%)
//	if names&=0
//		raise KErrNoMemory%
//	endif
//	names& = names&-KMaxHeaderSize1%  // because the first nt will be 1, not 0, and this way we don't have to do a -1 in header%:() // x!!!

	#ifdef _ASM
	
	// Init the machine code extensions:

	// find out how much memory is needed
	mc_workspacesize&=MCPreLoadExt&:(KIncludePath$+"forth5mx.mcx")
	// allocate that memory from OPLs heap
	mc_workspace&=ALLOC(mc_workspacesize&)
	if mc_workspace&=0
		raise KErrNoMemory%
	endif
	// load and initialise the extension
	trace_message:("before MCLoadExt&") // d!!!
	mc_handle&=MCLoadExt&:(mc_workspace&,KIncludePath$+"forth5mx.mcx",0)
	trace_message:("after MCLoadExt&") // d!!!

	// lookup the functions defined in the extension:
	trace_message:("before MCLookup") // d!!!
	// mc_initws& =	MCLookup&:(mc_handle&,"initws")
	// if mc_initws&=-1
	//	_REPORT_ERROR?("MCX MCLookup error: initws function not found")
	// endif
	mc_xdrop& =	MCLookup&:(mc_handle&,"xdrop")
	print "mc_xdrop& = ";mc_xdrop&
	if mc_xdrop&=-1
		_REPORT_ERROR?("MCX MCLookup error: xdrop function not found")
	endif
	trace_message:("after MCLookup") // d!!!

	#endif

	// Init the circular string buffer:
	
	sbuffer_length&=max(512,KSBufferSize&)
	sbuffer_start& = alloc(sbuffer_length&)
	if sbuffer_start&=0
		raise KErrNoMemory%
	endif
	sbuffer_end&=sbuffer_start&+sbuffer_length&-1
	#ifndef _DSBUFFER
		sbuffer_current&=sbuffer_start&
	#else
		sbuffer_descriptor&=NewDes&:(sbuffer_start&,sbuffer_length&,sbuffer_length&)
	#endif
	
	// Init the Forth virtual machine variables:
	
	rp0& = _ALIGNED?(mem&+KMemSize&-1)
	rp& = rp0&
	#ifdef _ASM
		sp_addr&=mc_handle& rem real address
		sp0& = sp_addr&+KCell&+KRStackSize&*KCell&
		MCPokeL&:(sp_addr&,sp0&)
		sp& = MCPeekL&:(sp_addr&)
	#else
		sp0& = rp0&-KRStackSize&*KCell&
		sp& = sp0&
	#endif
	dp& = _ALIGNED?(mem&)
	thread_pointer% = Kthreads%+1
	last_nt& = 0
	base& = 10
	state& = KInterpreting&
	//	xkeytable& = 0
	pad& = addr(pad$)

	// Init the paths:

	forth5mx_path$ = "c:\doc\comp\forth\forth5mx\" // :!!!
	path$ = "c:\doc\comp\forth\" // :!!!
	include_path$ = path$
	home_path$="c:\doc\" // :!!!

	// Init the command history:

	HistoryFile$=forth5mx_path$+"forth5mx_comand_line_history"
	read_history:

	// Init screen attributes variables:

	font% = 3
	fontattr% = 1
	thinfont&(1)	=	KFontCourierNormal8&	: thinattr%(1)	=	0
	thinfont&(2)	=	KFontCourierNormal11&	: thinattr%(2)	=	0
	thinfont&(3)	=	KFontCourierNormal13&	: thinattr%(3)	=	0
	thinfont&(4)	=	KFontCourierNormal15&	: thinattr%(4)	=	0
	thinfont&(5)	=	KFontCourierNormal18&	: thinattr%(5)	=	0
	thinfont&(6)	=	KFontCourierNormal22&	: thinattr%(6)	=	0
	thinfont&(7)	=	KFontCourierNormal27&	: thinattr%(7)	=	0
	thinfont&(8)	=	KFontCourierNormal32&	: thinattr%(8)	=	0
	boldfont&(1)	=	KFontCourierBold8&		: boldattr%(1)	=	0
	boldfont&(2)	=	KFontCourierBold11&		: boldattr%(2)	=	0
	boldfont&(3)	=	KFontCourierBold13&		: boldattr%(3)	=	0
	boldfont&(4)	=	KFontCourierNormal15&	: boldattr%(4)	=	1
	boldfont&(5)	=	KFontCourierNormal18&	: boldattr%(5)	=	1
	boldfont&(6)	=	KFontCourierNormal22&	: boldattr%(6)	=	1
	boldfont&(7)	=	KFontCourierNormal27&	: boldattr%(7)	=	1
	boldfont&(8)	=	KFontCourierNormal32&	: boldattr%(8)	=	1

	// Init other variables:

	source_recursion% = 1
	line_terminator$ = chr$(KKeyEnter&)+chr$(KKeyLineFeed&)
	uid& = &10007777 // unique Psion app ID
	xautoexec& = 0
	battstat& = KTrue&
	volume& = 3
	debug& = KTrue&
	error_sound& = KFalse&
	
	// Build primitives

	xbrcolonbr& = primitive&:("(:)",0)
	xbrvariablebr& = primitive&:("(variable)",0)
	xbrprimitivevariablebr& = primitive&:("(primitive-variable)",0)
	xbrconstantbr& = primitive&:("(constant)",0)
	xbr2constantbr& = primitive&:("(2constant)",0)
	primitive&:("(does>)",0)
	primitive&:("(defer)",0)
	primitive&:("douser",0)
	primitive&:("doarray",0)
	primitive&:("dotable",0)
	primitive&:("docode",0)
	xbrcreatebr&=primitive&:("(create)",0)
	primitive&:("(value)",0)
	xbrmarkerbr&=primitive&:("(marker)",0)

	primitive&:("cold",0)
	xexit& = _XT?(primitive&:("EXIT",0))
	xbrliteralbr& = _XT?(primitive&:("(literal)",0))
	xsliteral& = _XT?(primitive&:("SLITERAL",KImmediate%))
	xnext& = _XT?(primitive&:("next",0))
	primitive&:("noop",0)
	primitive&:("DUP",0)
	primitive&:("DROP",0)
	primitive&:("SWAP",0)
	primitive&:("OVER",0)
	primitive&:("NIP",0)
	primitive&:("TUCK",0)
	primitive&:("?DUP",0)
	primitive&:("PICK",0)
	primitive&:("ROLL",0)
	primitive&:("R@",0)
	xbranch& = _XT?(primitive&:("branch",0))
	primitive&:("0branch",0)
	primitive&:(">R",0)
	primitive&:("R>",0)
	primitive&:("0=",0)
	primitive&:("0<>",0)
	primitive&:("IMMEDIATE",0)
	primitive&:("immediate?",0)
	primitive&:("EXECUTE",0)
	primitive&:("=",0)
	primitive&:("not",0)
	primitive&:("latest",0)
	primitive&:("[",KImmediate%)
	primitive&:("]",0)
	primitive&:("@",0)
	primitive&:("!",0)
	primitive&:("KEY",0)
	primitive&:("EMIT",0)
	primitive&:(".",0)
	xcr& = _XT?(primitive&:("CR",0))
	primitive&:("TYPE",0)
	primitive&:("REFILL",0)
	primitive&:("WORD",0)
	primitive&:("HERE",0)
	primitive&:("FIND",0)
	primitive&:("name>",0)
	primitive&:("name",0)
	primitive&:("ALLOT",0)
	primitive&:("error",0)
	primitive&:("BYE",0)
	primitive&:("include",0)
	primitive&:("number?",0)
	primitive&:("number",0)
	xabort& = _XT?(primitive&:("ABORT",0))
	primitive&:("+",0)
	primitive&:("-",0)
	primitive&:("DEPTH",0)
	primitive&:("*/",0)
	primitive&:("AND",0)
	primitive&:("OR",0)
	primitive&:("XOR",0)
	primitive&:("<",0)
	primitive&:("ROT",0)
	primitive&:("-rot",0)
	primitive&:("CMOVE",0)
	primitive&:("FILL",0)
	primitive&:("AT-XY",0)
	primitive&:("emits",0)
	primitive&:("2DROP",0)
	primitive&:("0<",0)
	primitive&:("1-",0)
	primitive&:("1+",0)
	primitive&:("char-",0)
	primitive&:("CHAR+",0)
	primitive&:("cell-",0)
	primitive&:("CELL+",0)
	primitive&:("2*",0)
	primitive&:("2/",0)
	primitive&:("2DUP",0)
	primitive&:("exchange",0) // ?!!!
	primitive&:("C@",0)
	primitive&:("C!",0)
	primitive&:("C,",0)
	primitive&:("PAD",0)
	primitive&:(">BODY",0)
	primitive&:("s,",0)
	primitive&:("MIN",0)
	primitive&:("MAX",0)
	primitive&:(".name",0)
	primitive&:("(do)",0)
	primitive&:("(loop)",0)
	primitive&:("I",0)
	primitive&:("J",0)
	primitive&:("k",0)
	primitive&:("LEAVE",Kimmediate%)
	primitive&:("(+loop)",0)
	primitive&:("(-loop)",0)
	primitive&:("thread",0)
	primitive&:("down",0) // ?!!!
	xlabel00& = _XT?(primitive&:("",0))
	xlabel01& = _XT?(primitive&:("",0))
	xlabel02& = _XT?(primitive&:("",0))
	xlabel03& = _XT?(primitive&:("",0))  // :!!! used in old evaluate
	xinterpret& = _XT?(primitive&:("interpret",0))
	xbrdebugquotebr& = _XT?(primitive&:("(debug"+chr$(%")+")",0))
	primitive&:("debug"+chr$(%"),Kimmediate%)
	primitive&:("debug#",0)
	primitive&:("debug",0)
	primitive&:(",",0)
	primitive&:("CREATE",0)
	primitive&:(":",Kimmediate%)
	primitive&:(";",KImmediate%)
	xprompt& = _XT?(primitive&:("prompt",0))
	primitive&:("COUNT",0)
	primitive&:("skim",0) // ?!!!
	primitive&:("SPACE",0)
	primitive&:("SPACES",0)
	primitive&:("gat",0)
	primitive&:("gline",0)
	primitive&:("S"+chr$(%"),KImmediate%)
	xcompile& = _XT?(primitive&:("compile",0))
	primitive&:("home",0)
	primitive&:("font",0)
	primitive&:("gbox",0)
	primitive&:("gcircle",0)
	primitive&:("gcolor",0)
	primitive&:("gellipse",0)
	primitive&:("gfill",0)
	primitive&:("gmode",0)
	primitive&:("gmove",0)
	primitive&:("gxy",0)
	primitive&:("<#",0)
	primitive&:("#",0)
	primitive&:("#S",0)
	primitive&:("#>",0)
	primitive&:("HOLD",0)
	primitive&:("SIGN",0)
	primitive&:("exit",0)
	primitive&:("KEY?",0)
	primitive&:("CELLS",0)
	primitive&:("CHARS",KImmediate%)
	primitive&:("*",0)
	primitive&:("/",0)
	primitive&:("<>",0)
	primitive&:(">",0)
	primitive&:("?abort",0)
	primitive&:("tasks",0)
	primitive&:("lookup",0)
	primitive&:("MOD",0)
	primitive&:("/MOD",0)
	primitive&:("colormode",0)
	primitive&:("ACCEPT",0)
	primitive&:("CATCH",0) // ?!!!
	primitive&:("THROW",0) // ?!!!
	primitive&:("beep",0)
	primitive&:("busy",0)
	primitive&:("ABS",0)
	primitive&:("days",0)
	primitive&:("day",0)
	primitive&:("month",0)
	primitive&:("year",0)
	primitive&:("hour",0)
	primitive&:("minute",0)
	primitive&:("second",0)
	primitive&:("screen",0)
	primitive&:("screeninfo",0)
	primitive&:("gcls",0)
	primitive&:("setcontrast",0)
	primitive&:("week",0)
	xthrow0& = _XT?(primitive&:("0throw",0))
	_COMMA?(xthrow0&) // ?!!!
	primitive&:("pluck",0)
	primitive&:("rp",0)
	primitive&:("sp",0)
	primitive&:("rp0",0)
	primitive&:("sp0",0)
	primitive&:("?compiling",0)
	primitive&:("?executing",0)
	primitive&:("NEGATE",0)
	primitive&:("bold",0)
	primitive&:("thin",0)
	primitive&:(".R",0)
	primitive&:("+!",0)
	primitive&:("C+!",0)
	primitive&:("0>",0)
	primitive&:("UNUSED",0)
	primitive&:("body>",0)
	primitive&:("indicator",0) // ?!!!
	primitive&:("play",0)
	primitive&:("2OVER",0)
	primitive&:("2SWAP",0)
	primitive&:("DUMP",0)
	primitive&:("OPEN-FILE",0)
	primitive&:("CLOSE-FILE",0)
	primitive&:("READ-FILE",0)
	primitive&:("WRITE-FILE",0)
	primitive&:("seek-file",0)
	primitive&:("mkdir",0)
	primitive&:("parse-file",0) // ?!!!
	primitive&:("path",0)
	primitive&:("DELETE-FILE",0)
	primitive&:("directory",0)
	primitive&:("ALLOCATE",0)
	primitive&:("RESIZE",0)
	primitive&:("FREE",0)
	primitive&:("dinit",0)
	primitive&:("dbutton",0)
	primitive&:("dbuttons",0)
	primitive&:("dcheckbox",0)
	primitive&:("dialog",0)
	primitive&:("dposition",0)
	primitive&:("dtext",0)
	primitive&:("dchoice",0)
	primitive&:("getevent",0)
	primitive&:("event",0)
	primitive&:("(of)",0)
	primitive&:("ALIGN",0)
	primitive&:("ALIGNED",0)
	primitive&:("run",0)
	primitive&:("backlight",0)
	primitive&:("backlight?",0)
	primitive&:("rnd",0)
	primitive&:("-TRAILING",0)
	primitive&:("SEARCH",0)
	primitive&:("COMPARE",0)
	primitive&:("(",KImmediate%)
	primitive&:("\",KImmediate%)
	primitive&:(".(",KImmediate%)
	primitive&:("READ-LINE",0)
	primitive&:("WRITE-LINE",0)
	primitive&:("CREATE-FILE",0)
	primitive&:("RENAME-FILE",0)
	primitive&:("2>R",0)
	primitive&:("2R>",0)
	primitive&:("2R@",0)
	primitive&:("date>secs",0)
	primitive&:("secs>date",0)
	primitive&:("U.",0)
	primitive&:("PAGE",0)
	primitive&:("INVERT",0)
	primitive&:("2+",0)
	primitive&:("2-",0)
	primitive&:("COMPILE,",0)
	primitive&:("<=",0)
	primitive&:(">=",0)
	primitive&:("SOURCE-ID",0)
	primitive&:("SOURCE",0)
	primitive&:("SOURCE!",0)
	primitive&:("SAVE-INPUT",0)
	primitive&:("RESTORE-INPUT",0)
	primitive&:("PARSE",0)
	primitive&:("upper",0)
	primitive&:("lower",0)
	primitive&:("INCLUDED",0)
	primitive&:("INCLUDE-FILE",0)
	primitive&:("chdir",0)
	primitive&:("chdir"+chr$(34),0)
	primitive&:("dir$",0)
	primitive&:("setpath",0)
	xbrsliteralbr&=_XT?(primitive&:("(sliteral)",0))
	primitive&:(">sbuffer",0)
	primitive&:("+sbuffer",0)
	primitive&:("sbuffer",0)
	primitive&:("sbuffer+!",0)
	primitive&:("sbuffer+",0)
	primitive&:("U<",0)
	primitive&:("MOVE",0)
	primitive&:("[compile]",KImmediate%)
	primitive&:("POSTPONE",KImmediate%)
	primitive&:("smove",0)
	xbrleavebr&=_XT?(primitive&:("(leave)",0))
	xquit&=_XT?(primitive&:("QUIT",0))
	primitive&:("U.R",0)
	primitive&:("U>",0)
	primitive&:("parse-word",0)
	primitive&:("VARIABLE",0)
	primitive&:("CONSTANT",0)
	xextend&=_XT?(primitive&:("extend",0))
	primitive&:("C"+chr$(%"),KImmediate%)
	xbrcsliteralbr&=_XT?(primitive&:("(csliteral)",0))
	primitive&:("#TIB",0)
	primitive&:("TIB",0)
	primitive&:("EXPECT",0)
	primitive&:(":NONAME",0)
	primitive&:("LSHIFT",0)
	primitive&:("RSHIFT",0)
	primitive&:("**",0)
	primitive&:("MARKER",0)
	primitive&:("UNLOOP",0)
	primitive&:("FILE-STATUS",0)
	primitive&:("getfilesize",0)
	primitive&:("(?do)",0)
	primitive&:("s'",KImmediate%)
	primitive&:("alias",0)
	primitive&:("QUERY",0)
	primitive&:("EVALUATE",0)
	primitive&:("CMOVE>",0)
//	primitive&:("*/MOD",0)
	primitive&:("rdrop",0)
	primitive&:("2rdrop",0)
	primitive&:("toupper",0)
	primitive&:("tolower",0)
	primitive&:("mcdrop",0)
	primitive&:("2CONSTANT",0)
	primitive&:("sbuffer-free",0)
	primitive&:("MS",0)
	primitive&:("find-name",0)
	primitive&:("D=",0)

	// new_primitives_here
	
	// environment constants:
	// unfinished!!! These should be defined in environment-wordlist .

	_CONSTANT?("/COUNTED-STRING",KCountedString%) // \ Core
	_CONSTANT?("MAX-CHAR",KMaxChar%) // \ Core
	_CONSTANT?("/PAD",KPadSize%) // \ Core
	_CONSTANT?("RETURN-STACK-CELLS",KRStackSize&) // \ Core
	_CONSTANT?("STACK-CELLS",KStackSize&) // \ Core
	_CONSTANT?("WORDLISTS",KWordLists%) // \ Core

	// build constants:

	_CONSTANT?("esc",KKeyEsc&) // esc  \ PsiForth
	_CONSTANT?("BL",KKeySpace&) // BL  \ Core
	_CONSTANT?("TRUE",Ktrue&) // TRUE  \ Core Ext
	_CONSTANT?("FALSE",KFalse&) // FALSE  \ Core Ext
	_CONSTANT?("cell",KCell&) // cell  \ PsiForth
	_CONSTANT?("#threads",KThreads%) // #threads  \ PsiForth
	// _CONSTANT?("release",KRelease%) // release  \ Forth 5mx // obsolete!!!

	// IOOPEN mode category 1
	_CONSTANT?("KIoOpenModeOpen",KIoOpenModeOpen%) // KIoOpenModeOpen  \ Forth 5mx
	_CONSTANT?("KIoOpenModeCreate",KIoOpenModeCreate%) // KIoOpenModeCreate  \ Forth 5mx
	_CONSTANT?("KIoOpenModeReplace",KIoOpenModeReplace%) // KIoOpenModeReplace  \ Forth 5mx
	_CONSTANT?("KIoOpenModeAppend",KIoOpenModeAppend%) // KIoOpenModeAppend  \ Forth 5mx
	_CONSTANT?("KIoOpenModeUnique",KIoOpenModeUnique%) // KIoOpenModeUnique  \ Forth 5mx
	// IOOPEN mode category 2
	_CONSTANT?("KIoOpenFormatBinary",KIoOpenFormatBinary%) // KIoOpenFormatBinary  \ Forth 5mx
	_CONSTANT?("KIoOpenFormatText",KIoOpenFormatText%) // KIoOpenFormatText  \ Forth 5mx
	// IOOPEN mode category 3
	_CONSTANT?("KIoOpenAccessUpdate",KIoOpenAccessUpdate%) // KIoOpenAccessUpdate  \ Forth 5mx
	_CONSTANT?("KIoOpenAccessRandom",KIoOpenAccessRandom%) // KIoOpenAccessRandom  \ Forth 5mx
	_CONSTANT?("KIoOpenAccessShare",KIoOpenAccessShare%) // KIoOpenAccessShare  \ Forth 5mx

	// circular string buffer
	_CONSTANT?("'sbuffer",sbuffer_start&) // 'sbuffer  \ Forth 5mx
	_CONSTANT?("'sbuffer;",sbuffer_end&) // 'sbuffer;  \ Forth 5mx
	_CONSTANT?("sbuffer#",KSBufferSize&) // sbuffer#  \ Forth 5mx

	// build variables:

	_VARIABLE?("STATE",addr(state&)) // STATE  \ Core
	_VARIABLE?("BASE",addr(base&)) // BASE  \ Core
	_VARIABLE?(">IN",addr(toin&)) // >IN  \ Core
	_VARIABLE?("SPAN",addr(span&)) // SPAN  \ Core ext
	_VARIABLE?("(SOURCE-ID)",addr(sourceid&)) // SOURCE-ID  \ Forth 5mx

	_VARIABLE?("dp",addr(dp&))  // DP  \ Forth 5mx
	_VARIABLE?("tp",addr(thread_pointer%))  // tp  \ Forth 5mx
	_VARIABLE?("(latest)",addr(last_nt&)) // (latest)  \ Forth 5mx
	_VARIABLE?("autoexec",addr(xautoexec&)) // autoexec  \ PsiForth ?!!!
	_VARIABLE?("batterystate",addr(battstat&)) // batterystate  \ OPL ?!!!
	// _VARIABLE?("keytable",addr(xkeytable&)) // keytable  \ PsiForth ?!!!
	// _VARIABLE?("systembegin",addr(uid&)) // systembegin  \ PsiForth ?!!!
	_VARIABLE?("user",addr(xuser&)) // user  \ PsiForth // ?!!!
	_VARIABLE?("volume",addr(volume&)) // volume  \ PsiForth
	_VARIABLE?("debug?",addr(debug&)) // debug?  \ Forth 5mx
	_VARIABLE?("error-sound?",addr(error_sound&)) // error-sound?  \ Forth 5mx
	// _VARIABLE?("error-sound",addr(error_sound_xt&)) // error-sound  \ Forth 5mx :!!!
	_VARIABLE?("last-wordlist",addr(last_wordlist&)) // last word list defined (called voc-link in F83)
	_VARIABLE?("current",addr(current&)) // Common use to point to the current compilation word list
	_VARIABLE?("warning",addr(warning&)) // Common use flag to check already defined words

	
	#ifndef _DSBUFFER
		_VARIABLE?("(sbuffer)",addr(sbuffer_current&)) // (sbuffer) \ Forth 5mx
	#endif
	_VARIABLE?("/sbuffer",addr(sbuffer_reserved&)) // /sbuffer \ Forth 5mx

	// build high level words:

	// headerless word to boot the system:
	xcoldstart& = dp&
	_COMMA?(xextend&)
	_COMMA?(xcr&)
	_COMMA?(xprompt&)
	_COMMA?(xquit&)

	// Variable to hold the contexts word lists.
	// It cannot be defined as a primitive variable, as CURRENT ,
	// because in that case the data of the variable is in the OPL data area,
	// not in the Forth data space.
	header&:("context",0)
	_COMMA?(xbrvariablebr&)
	context& = dp& // to use this word's data in OPL
	dp& = dp&+KWordLists%*KCell&  // reserve space to hold all the context word lists
	
	dp0& = dp& // store DP for COLD

	// Forth virtual machine code:
	#include "forth5mx_fvm.opp"


endp

// Forth:  // start

#include "forth5mx_procs.opp"

// End of the file forth5mx.opp