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+.
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