forth5mx_macros.opp
Descripción del contenido de la página
Fichero fuente de Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.
Este fichero contiene la definición de las macros de OPL+ del programa. Las macros fueron una de las mayores ventajas de usar OPL+ respecto a OPL. Me permitieron definir bloques de código con otros bloques de código, todos ellos condicionados por cálculos hechos en el momento de preprocesar el código fuente.
Este fichero contiene también las variables del prepocesador definidas para elegir opciones importantes de compilación (por ejemplo, dónde se guardará la pila de datos, o cómo se cargarán los ficheros fuente de Forth).
Código fuente
// forth5mx_macros.opp
// Copyright (C) 2004-2009 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>.
// -------------------------------------------------------
// Macros
// -------------------------------------------------------
// -------------------------------------------------------
// Flags
// _TOS
// Flag to select the TOS (top of stack) store:
// If defined, TOS is stored in the variable tos&, not in (sp&); this is the original PsiForth method, and it's faster.
// If not defined, TOS is stored in the address pointed by sp&; this is the transition method before migrating to machine code all stack operations.
// #define _TOS
// _DSOURCE
// Flag to select the way to load the source files.
// If defined, the whole source files are loaded
// into a C Descriptor buffer and manipulated with
// a Lexical Analyser object, using the COPX extension.
// If not defined, the source file is opened in text mode
// and loaded line after line as needed,
// what is much slower and can not manage lines longer than 256 chars.
// This flag affects the definition of
// all source loading primitives, related macros, REFILL
// and the arrays of data that make source recursion possible.
// #define _DSOURCE
// _DSBUFFER
// Flag to select the way to internally manage the circular string buffer.
// If defined, a C Descriptor object is used on the OPL allocated memory.
// If not defined, only the OPL allocated memory is used.
// The C Descriptor version of the code is not fully implemented yet, so the flag can not be activated.
// #define _DSBUFFER
// _ASM
// Flag to choose if machine code extensions are used.
// If defined, OCX extensions are loaded,
// stacks are defined in the machine code workspace
// and words written in assembler are called.
// If not defined, all work is done by OPL as before.
// All this is not implemented yet.
//#define _ASM
#ifdef _ASM
#ifdef _TOS
ERROR: _ASM macro flag should not be defined if _TOS macro flag has been defined
#endif
#endif
// _WARNING
// Flag to compile and use the WARNING flag variable.
// If defined and the WARNING Forth variable is not zero, a warning will be shown when a word is redefined.
// If not defined, the Forth WARNING variable will not be created and no checking will be done.
#define _WARNING
// Flags to select debug actions:
// #define _DEBUG1
// #define _DEBUG_DSOURCE
// #define _DEBUG_FIND
// -------------------------------------------------------
// Debug macros
// Copy all variables used by the debug proc
// to the global versions.
#define _BEFORE_DEBUG :\
g_dp& = dp& :\
g_ib$ = ib$ :\
g_ib_addr& = ib_addr& :\
g_ib_len& = ib_len& :\
g_ip& = ip& :\
g_last_nt& = last_nt& :\
g_parsed_word$ = parsed_word$ :\
g_rp& = rp& :\
g_rp0& = rp0& :\
g_source_recursion% = source_recursion% :\
g_sourceid& = sourceid& :\
g_sp& = sp& :\
g_sp0& = sp0& :\
g_toin& = toin& :\
g_wp& = wp& :\
g_context& = context& :\
g_current& = current&
#ifdef _TOS
#define _BEFORE_DEBUG :\
_BEFORE_DEBUG :\
g_tos& = tos&
#endif
#define _DEBUG?(breakpoint) :\
_BEFORE_DEBUG :\
debug:(breakpoint)
#define _REPORT_ERROR?(message) :\
_BEFORE_DEBUG :\
report_error:(message)
#define _DEBUG_NEXT?(title) _DEBUG?(title)
#define _DEBUG_VECTOR?(title) _DEBUG?(title)
#define _DEBUG2?(title) _DEBUG?(title)
// -------------------------------------------------------
// Constant macros
#define _TRUE -1
#define _FALSE 0
// -------------------------------------------------------
// Low level macros to manipulate the stacks
#ifdef _ASM
#define _FETCH_SP sp&=MCPeekL&:(sp_addr&)
#define _STORE_SP MCPokeL&:(sp_addr&,sp&)
#endif
#define _2INCREASE_RSTACK \
rp& = rp&-K2Cells&
#define _3DECREASE_STACK_KERNEL \
sp& = sp&+K3Cells&
#ifdef _TOS
#define _3DROP \
tos& = peekl(sp& + K2Cells&) :\
_3DECREASE_STACK_KERNEL
#else
#ifdef _ASM
#define _3DROP \
_FETCH_SP: \
_3DECREASE_STACK_KERNEL: \
_STORE_SP
#else
#define _3DROP \
_3DECREASE_STACK_KERNEL
#endif
#endif
#define _INCREASE_STACK_KERNEL \
sp& = sp&-KCell&
#ifdef _TOS
#define _INCREASE_STACK \
_INCREASE_STACK_KERNEL :\
pokel sp&,tos&
#else
#ifdef _ASM
#define _INCREASE_STACK \
_FETCH_SP :\
_INCREASE_STACK_KERNEL :\
_STORE_SP
#else
#define _INCREASE_STACK \
_INCREASE_STACK_KERNEL
#endif
#endif
#define _2INCREASE_STACK_KERNEL \
sp& = sp&-K2Cells&
#ifdef _TOS
#define _2INCREASE_STACK \
_2INCREASE_STACK_KERNEL :\
pokel sp&+KCell&,tos&
#else
#ifdef _ASM
#define _2INCREASE_STACK \
_FETCH_SP :\
_2INCREASE_STACK_KERNEL :\
_STORE_SP
#else
#define _2INCREASE_STACK \
_2INCREASE_STACK_KERNEL
#endif
#endif
#define _DECREASE_STACK_KERNEL \
sp& = sp&+KCell&
#ifdef _TOS
#define _DECREASE_STACK \
tos& = peekl(sp&) :\
_DECREASE_STACK_KERNEL
#else
#ifdef _ASM
#define _DECREASE_STACK \
_FETCH_SP :\
_DECREASE_STACK_KERNEL :\
_STORE_SP
#else
#define _DECREASE_STACK \
_DECREASE_STACK_KERNEL
#endif
#endif
#define _INCREASE_RSTACK \
rp& = rp&-KCell&
#ifdef _TOS
#define _PUSH?(x) \
_INCREASE_STACK :\
tos&=x
#else
#ifdef _ASM
#define _PUSH?(x) \
_FETCH_SP :\
_INCREASE_STACK_KERNEL :\
MCPokel&:(sp&,x) :\
_STORE_SP
#else
#define _PUSH?(x) \
_INCREASE_STACK :\
pokel sp&,x
#endif
#endif
#define _RPUSH?(x) \
_INCREASE_RSTACK : pokel(rp&),x
// -------------------------------------------------------
// Simple Forth words macros
#define _2DROP_KERNEL :\
sp& = sp&+K2Cells&
#ifdef _TOS
#define _2DROP \
tos& = peekl(sp&+KCell&) :\
_2DROP_KERNEL
#else
#ifdef _ASM
#define _2DROP \
_FETCH_SP :\
_2DROP_KERNEL :\
_STORE_SP
#else
#define _2DROP \
_2DROP_KERNEL
#endif
#endif
#define _2RDROP \
rp& = rp&+K2Cells&
#define _ALIGNED?(addr) \
((addr-1) or (KCell&-1)) + 1
#define _COMMA?(x) \
pokel dp&,x : dp& = dp&+KCell&
#define _DROP \
_DECREASE_STACK
#ifdef _TOS
#define _DUP \
_INCREASE_STACK
#else
#ifdef _ASM
#define _DUP \
_INCREASE_STACK :\
MCPokeL&:(sp&,MCPeekL&:(sp&+KCell&))
#else
#define _DUP \
_INCREASE_STACK :\
pokel sp&,peekl(sp&+KCell&)
#endif
#endif
#ifdef _TOS
#define _NIP \
sp& = sp&+KCell&
#else
#ifdef _ASM
#define _NIP \
_FETCH_SP :\
MLPokeL&:(sp&+KCell&,MCPeekL&:(sp&)) : \
_DECREASE_STACK :\
_STORE_SP
#else
#define _NIP \
pokel(sp&+KCell&),peekl(sp&) : \
_DECREASE_STACK
#endif
#endif
#define _RDROP \
rp& = rp&+KCell&
#ifdef _TOS
#define _DEPTH \
(sp0&-sp&-KCell&)/KCell&
#else
#define _DEPTH \
(sp0&-sp&)/KCell&
#endif
// -------------------------------------------------------
// Hash function
#define _CALCULATE_HASH_LOCALS \
local hash%, hash_value&, hash_i%, word$(KMaxNameSize%), hash_addr&
// _CALCULATE_HASH
// input: word$
// output: hash%
// hash_value& has to be initialized because this macro is used also outside a proc
#define _CALCULATE_HASH \
hash_value&=0 :\
hash_addr& = addr(word$) :\
hash_i% = peekb(hash_addr&) :\
while hash_i% :\
hash_value& = hash_value& + peekb(hash_addr&+hash_i%) * (hash_i% * 2 + 1) :\
hash_i%-- :\
endwh :\
hash% = (hash_value& and KThreadMask%) + 1
// -------------------------------------------------------
// Macros to make a call to a Forth word from inside the OPL virtual machine.
// The xt of the word to be called must be in the variable wp&.
// The parameter is a label that must be in the vector list. These are named label00, label01...
// The macro makes, from the label name, the name of the variable that contents xt of a primitive Forth word that has been created with no name, only to jumps to that label. These variables are named xlabel00&, xlabel01&...
#define _CALL_WP?(label) \
/* Input: wp& = xt of the word to be called */ :\
rp& = rp&-K2Cells& :\
pokel rp&+KCell&,x!!label!!& :\
pokel rp&,ip& :\
ip& = rp&+KCell& :\
goto xvector /* jump out */ :\
!!label!!:: /* come back here */ :\
ip& = peekl(rp&) :\
_2RDROP
// Other version with a different parameter: the xt of the word to be called.
#define _CALL_XT?(xt,label) \
wp& = xt :\
_CALL_WP?(label)
// Other version with a different parameter: the nt of the word to be called.
#define _CALL_NT?(nt,label) \
wp& = _XT?(nt) :\
_CALL_WP?(label)
// -------------------------------------------------------
// Get packed
#ifdef _TOS
#define _GET_PACKED_LOCALS \
local packed$(KMaxStringLen%), packed_addr&
#else
#define _GET_PACKED_LOCALS \
local packed$(KMaxStringLen%), packed_addr&,packed_i&
#endif
#define _GET_PACKED_INIT \
packed$=""
#ifdef _TOS
#define _GET_PACKED_CODE \
packed_addr& = peekl(sp&) :\
while tos& :\
packed$ = packed$+chr$(peekb(packed_addr&)) :\
tos&-- :\
packed_addr&++ :\
endwh :\
_2DROP
#else
#define _GET_PACKED_CODE \
packed_addr& = peekl(sp&+KCell&) :\
packed_i& = peekl(sp&) :\
while packed_i& :\
packed$ = packed$+chr$(peekb(packed_addr&)) :\
packed_i&-- :\
packed_addr&++ :\
endwh :\
_2DROP
#endif
#define _GET_PACKED \
_GET_PACKED_INIT : _GET_PACKED_CODE
// -------------------------------------------------------
// Headers
#define _HEADER_ADDRESS?(nt) \
headers&+(nt*KHeaderSize%)
#define _NAME_ADDRESS?(nt) \
_HEADER_ADDRESS?(nt)
#define _XT_ADDRESS?(nt) \
_HEADER_ADDRESS?(nt)+KExecutionTokenOffset%
#define _CONTROL_BITS_ADDRESS?(nt) \
_HEADER_ADDRESS?(nt)+KControlBitsOffset%
#define _NAME?(nt) \
peek$(_NAME_ADDRESS?(nt))
#define _XT?(nt) \
peekl(_XT_ADDRESS?(nt))
#define _CONTROL_BITS?(nt) \
peekb(_CONTROL_BITS_ADDRESS?(nt))
// -------------------------------------------------------
// Parsing
/*
_PARSED
Parse the input buffer like the ANS Forth PARSE ,
but return the string in the OPL variable parsed$.
*/
#ifdef _DSOURCE
#define _PARSED_LOCALS \
local parsed$(KMaxStringLen%)
#define _PARSED_CODE?(delimiter) \
while not LexEos%:(ib_lex&) and LexGet%:(ib_lex&)<>delimiter :\
parsed$=parsed$+chr$(LexGet%:(ib_lex&)) :\
endwh :\
if not LexEos%:(ib_lex&) // ?!!! neeed :\
LexInc:(ib_lex&,1) // skip delimiter :\
endif
#define _PARSED?(delimiter) \
_PARSED_CODE?(delimiter)
#else
#define _PARSED_LOCALS \
local p_first_char%, p_len%, parsed$(KMaxStringLen%)
#define _PARSED_INIT \
p_first_char%=0 : p_len%=0
#define _PARSED_CODE?(delimiter) \
if toin&<ib_len& :\
p_first_char% = toin& :\
while peekb(ib_addr&+toin&)<>delimiter and toin&<ib_len& :\
toin&++ :\
endwh :\
p_len% = toin&-p_first_char% :\
toin&++ /* point to the char after the delimiter or after the buffer */ :\
endif :\
parsed$=mid$(ib$,p_first_char%+1,p_len%)
#define _PARSED?(delimiter) \
_PARSE_INIT : _PARSED_CODE?(delimiter)
#endif
/*
_PARSE_OFF
Parse the input buffer like the ANS Forth PARSE ,
but don't return the parsed string.
It is a bit faster than _PARSED and _PARSE .
It is used in words that don't need the parsed string, like ( and \ .
*/
#ifdef _DSOURCE
#define _PARSE_OFF?(delimiter) \
while LexGet%:(ib_lex&)<>delimiter and not LexEos%:(ib_lex&) :\
endwh
#else
#define _PARSE_OFF?(delimiter) \
if toin&<ib_len& :\
while peekb(ib_addr&+toin&)<>delimiter and toin&<ib_len& :\
toin&++ :\
endwh :\
toin&++ /* point to the char after the delimiter or after the buffer */ :\
endif
#endif
/*
_PARSE
Return the result as a string in the stack.
The string address is *inside the input buffer*.
That is what the ANS Standard says.
*/
#define _PARSE_LOCALS \
local p_addr&, p_len&
#define _PARSE_INIT \
p_addr&=0 : p_len&=0
#ifdef _DSOURCE
#define _PARSE_KERNEL_CODE?(delimiter) \
if not LexEos%:(ib_lex&) :\
pw_addr& = ib_addr&+LexOffset&:(ib_lex&) :\
while LexGet%:(ib_lex&)<>delimiter and not LexEos%:(ib_lex&) :\
endwh :\
pw_len& = LexOffset&:(ib_lex&)-pw_addr& :\
pw_addr& = ib_addr&+pw_addr& :\
if not LexEos%:(ib_lex&) // ?!!! neeed :\
LexInc:(ib_lex&,1) // skip delimiter :\
endif :\
endif
#else
#define _PARSE_KERNEL_CODE?(delimiter) \
if toin&<ib_len& :\
p_addr& = ib_addr&+toin& :\
while peekb(ib_addr&+toin&)<>delimiter and toin&<ib_len& :\
toin&++ :\
endwh :\
p_len& = ib_addr&+toin&-p_addr& :\
toin&++ /* point to the char after the delimiter or after the buffer */ :\
endif :\
#endif
#ifdef _TOS
#define _PARSE_CODE?(delimiter) \
_PARSE_KERNEL_CODE?(delimiter) :\
_2INCREASE_STACK :\
pokel(sp&),p_addr& :\
tos&=p_len&
#else
#define _PARSE_CODE?(delimiter) \
_PARSE_KERNEL_CODE?(delimiter) :\
_2INCREASE_STACK :\
pokel sp&+KCell&,p_addr& :\
pokel sp&,p_len&
#endif
#define _PARSE?(delimiter) \
_PARSE_INIT : _PARSE_CODE?(delimiter)
/*
_PARSE_TOS
Return the result as a string in the stack.
The string address is *inside the input buffer*.
That is what the ANS Standard says.
This version of _PARSE takes the delimiter from the stack,
thus avoiding some steps in the calling Forth primitive PARSE
to get and return the parameters. It is a bit faster.
*/
#define _PARSE_TOS_LOCALS \
local p_delimiter%
#ifdef _TOS
#define _PARSE_TOS_CODE \
p_delimiter%=tos& :\
_PARSE_KERNEL_CODE?(p_delimiter%) :\
sp& = sp&-KCell& :\
pokel sp&,p_addr& :\
tos&=p_len&
#else
#define _PARSE_TOS_CODE \
p_delimiter%=peekb(sp&) :\
_PARSE_KERNEL_CODE?(p_delimiter%) :\
pokel sp&,p_addr& :\
sp& = sp&-KCell& :\
pokel sp&,p_len&
#endif
#define _PARSE_TOS \
_PARSE_INIT : _PARSE_TOS_CODE
/*
_PARSED_WORD
Parse the input buffer like the ANS Forth WORD ,
but return the string in the OPL variable parsed_word$.
*/
#ifdef _DSOURCE
#define _PARSED_WORD_LOCALS
#define _PARSED_WORD \
parsed_word$=LexNextTokenStr$:(ib_lex&)
#else
#define _PARSED_WORD_LOCALS \
local pw_first_char%,pw_len%
#define _PARSED_WORD_INIT \
pw_first_char%=0 : pw_len%=0
#define _PARSED_WORD_CODE \
while peekb(ib_addr&+toin&)=KKeySpace% :\
toin&++ :\
endwh :\
if toin&<ib_len& :\
pw_first_char% = toin& :\
while peekb(ib_addr&+toin&)<>KKeySpace% and toin&<ib_len& :\
toin&++ :\
endwh :\
pw_len% = toin&-pw_first_char% :\
toin&++ /* point to the char after the delimiter or after the buffer */ :\
endif :\
parsed_word$ = mid$(ib$,pw_first_char%+1,pw_len%)
#define _PARSED_WORD \
_PARSED_WORD_INIT : _PARSED_WORD_CODE
#endif
/*
_PARSE_WORD
Return the result as a string in the stack.
The string address is *inside the input buffer*.
That is what the ANS Standard says, though PARSE-WORD doesn't belong to the Standard.
*/
#define _PARSE_WORD_LOCALS \
local pw_addr&, pw_len&
#define _PARSE_WORD_INIT \
pw_addr&=0 : pw_len&=0
#ifdef _DSOURCE
#define _PARSE_WORD_KERNEL_CODE \
while LexGet%:(ib_lex&)=KKeySpace% and not LexEos%:(ib_lex&) :\
endwh :\
if not LexEos%:(ib_lex&) :\
pw_addr& = ib_addr&+LexOffset&:(ib_lex&) :\
while LexGet%:(ib_lex&)<>KKeySpace% and not LexEos%:(ib_lex&) :\
endwh :\
pw_len& = LexOffset&:(ib_lex&)-pw_addr& :\
pw_addr& = ib_addr&+pw_addr& :\
if not LexEos%:(ib_lex&) // ?!!! neeed :\
LexInc:(ib_lex&,1) // skip delimiter :\
endif :\
endif
#else
#define _PARSE_WORD_KERNEL_CODE \
while peekb(ib_addr&+toin&)=KKeySpace% :\
toin&++ :\
endwh :\
if toin&<ib_len& :\
pw_addr& = ib_addr&+toin& :\
while peekb(ib_addr&+toin&)<>KKeySpace% and toin&<ib_len& :\
toin&++ :\
endwh :\
pw_len& = ib_addr&+toin&-pw_addr& :\
toin&++ /* point to the char after the delimiter or after the buffer */ :\
endif :\
#endif
#ifdef _TOS
#define _PARSE_WORD_CODE \
_PARSE_WORD_KERNEL_CODE :\
_2INCREASE_STACK :\
pokel(sp&),pw_addr& :\
tos&=pw_len&
#else
#define _PARSE_WORD_CODE \
_PARSE_WORD_KERNEL_CODE :\
_2INCREASE_STACK :\
pokel sp&+KCell&,pw_addr& :\
pokel sp&,pw_len&
#endif
#define _PARSE_WORD? \
_PARSE_WORD_INIT : _PARSE_WORD_CODE
// Locals used in forth5mx_inc_find.opp
// Needed in the main file forth5mx.opp
// and in the proc header& (in the file forth5mx_procs.opp).
#define _FIND_LOCALS \
local nt& :\
local nametofind$(KMaxStringLen%) :\
local link&
// -------------------------------------------------------
// File input-output
#ifdef _TOS
#define _RESTORE_INPUT \
if _DEPTH<5 :\
_PUSH?(KTrue%) :\
elseif tos&<>4 :\
_PUSH?(KTrue%) :\
elseif peekl(sp&)<>sourceid& :\
sp& = sp&+K4Cells& :\
tos& = KTrue% :\
else :\
sourceid& = peekl(sp&) :\
toin& = peekl(sp&+KCell&) :\
ib_len& = peekl(sp&+K2Cells&) :\
ib_addr&=peekl(sp&+K3Cells&) :\
sp& = sp&+K4Cells& :\
tos& = KFalse& :\
endif
#else
#define _RESTORE_INPUT \
if _DEPTH<5 :\
_PUSH?(KTrue%) :\
elseif peekl(sp&)<>4 :\
_PUSH?(KTrue%) :\
elseif peekl(sp&+KCell&)<>sourceid& :\
sp& = sp&+K4Cells& :\
pokel sp&,KTrue% :\
else :\
sourceid& = peekl(sp&+KCell&) :\
toin& = peekl(sp&+K2Cells&) :\
ib_len& = peekl(sp&+K3Cells&) :\
ib_addr&=peekl(sp&+K4Cells&) :\
sp& = sp&+K4Cells& :\
pokel sp&,KFalse& :\
endif
#endif
#ifdef _TOS
#define _SAVE_INPUT \
sp& = sp&-K5Cells& :\
pokel sp&+K4Cells&,tos& :\
pokel sp&+K3Cells&,ib_addr& :\
pokel sp&+K2Cells&,ib_len& :\
pokel sp&+KCell&,toin& :\
pokel sp&,sourceid& :\
tos& = 4
#else
#define _SAVE_INPUT \
sp& = sp&-K5Cells& :\
pokel sp&+K4Cells&,ib_addr& :\
pokel sp&+K3Cells&,ib_len& :\
pokel sp&+K2Cells&,toin& :\
pokel sp&+KCell&,sourceid& :\
pokel sp&,4
#endif
// -------------------------------------------------------
// String buffer
/*
_SBUFFER_FREE
Calculation to return the free buffer space.
*/
#ifdef _DSBUFFER
#define _SBUFFER_FREE (sbuffer_end&-DesLength&:(sbuffer_descriptor&))
#else
#define _SBUFFER_FREE (sbuffer_end&-sbuffer_current&)
#endif
/*
_PLUS_SBUFFER
Verify the buffer space and update the current address if needed.
Calcute sbuffer_reserved&, the same lenght or the maximun possible.
*/
#ifdef _DSBUFFER
#define _PLUS_SBUFFER?(len) \
if len+1 >= _SBUFFER_FREE :\
DesZero:(sbuffer_descriptor&) :\
endif :\
sbuffer_reserved& = min(len,KSBufferSize&-1)
#else
#define _PLUS_SBUFFER?(len) \
if len+1 >= _SBUFFER_FREE :\
sbuffer_current& = sbuffer_start& :\
endif :\
sbuffer_reserved& = min(len,KSBufferSize&-1)
#endif
/*
_SBUFFER_PLUS
Update sbuffer_current&.
*/
#ifdef _DSBUFFER
#define _SBUFFER_PLUS // no op needed
#else
#define _SBUFFER_PLUS \
sbuffer_current& = sbuffer_current& + sbuffer_reserved&+1
#endif
// -------------------------------------------------------
// Control structures
#define _UNLOOP \
rp& = rp&+K3Cells&
// -------------------------------------------------------
// Strings
/* ************ unused ************
// Store string$ in addr& and return the string on the stack.
// input: string$, addr&
// stack: ( -- c-addr u )
#define _STORE_STRING : \
_2INCREASE_STACK : \
poke$ addr&, string$ :\
tos& = len(string$) :\
pokel sp&,addr&+1
*/
/* ************ unused ************
// first version, that returned the string on the stack,
// but it was not needed:
// Store parsed$ in dp& and return the string on the stack.
// input: parsed$, dp&
// stack: ( -- c-addr u )
#define _COMPILE_PARSED : \
_2INCREASE_STACK : \
poke$ dp&, parsed$ :\
tos& = len(parsed$) :\
pokel sp&,dp&+1 :\
dp& = _ALIGNED?(dp&+len(parsed$)+1)
*/
// Store parsed$ in dp&.
// input: parsed$, dp&
#define _COMPILE_PARSED : \
poke$ dp&, parsed$ :\
dp& = _ALIGNED?(dp&+len(parsed$)+1)
// -------------------------------------------------------
// Variables and constants
// Create a constant or a variable
#define _VALUE?(name,value,xt) :\
header&:(name,0) :\
_COMMA?(xt) :\
_COMMA?(value)
// Create a constant
#define _CONSTANT?(name,value) :\
_VALUE?(name,value,xbrconstantbr&)
// Create a variable
#define _VARIABLE?(name,value) :\
_VALUE?(name,value,xbrprimitivevariablebr&)
// -------------------------------------------------------
// Prompt
#define _OK :\
print " ok",
// Old version.
// When the first prompt had to be shown,
// the stack pointers were not initialized
// and this didn't work:
// print "ok";rept$(".",(sp0&-sp&)/KCell&),
#define _PROMPT :\
if (state& or sourceid&)=0 : _OK : endif
// -------------------------------------------------------
// Input buffers
#define _INDICATE_SOURCE :\
if sourceid&=KSourceIDKeyboard% :\
indicate:("") :\
elseif sourceid&=KSourceIDString% :\
indicate:("evaluating") :\
else :\
indicate:("loading") :\
endif
#ifdef _DSOURCE
#define _NEW_LEX :\
DesFill:(ib_descriptor&,KKeySpace&) :\
ib_lex&=NewLex&: :\
LexAssignDes:(ib_lex&,ib_descriptor&)
#define _NEW_TERMINAL_IB :\
sourceid&=KSourceIDKeyboard% :\
ib_len&=KMaxStringLength% :\
ib_addr&=alloc(ib_len&) :\
ib_descriptor&=NewDes&:(ib_addr&,0,ib_len&) :\
_NEW_LEX
#define _NEW_EVALUATE_IB?(string) :\
sourceid&=KSourceIDKeyboard% :\
ib_len&=KMaxStringLength% :\
ib_addr&=alloc(ib_len&) :\
ib_descriptor&=NewDes&:(ib_addr&,0,ib_len&) :\
DesCopyStr:(ib_descriptor&,string) :\
_NEW_LEX
#endif