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