Procedimientos repetidos de Forth 5mx
Descripción del contenido de la página
Ficheros fuente de varios procedimientos de Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.
Para lograr un ligero aumento de velocidad, extraje algunos procedimientos del programa principal y los convertí en ficheros independientes (que llevan _inc_ en el nombre) para ser insertados cada vez en el código fuente principal por el preprocesador. De esta manera evitaba llamadas a procedimientos, a cambio de un mayor tamaño del código objeto.
Código fuente
forth5mx_inc_find.opp
// forth5mx_inc_find.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>.
// code for FIND
// used six times in the program
// input:
// nametofind$ = name of the word to find
// output:
// nt& = name token of the word found or 0
nt& = 0
#ifdef _DEBUG_FIND
print "****** find"
print "nametofind$=";nametofind$
#endif
word$ = lower$(left$(nametofind$,KMaxNameSize%))
// input: word$
_CALCULATE_HASH
// output: hash%
#ifdef _DEBUG_FIND
print "hash%=";hash%
#endif
#ifdef _DEBUG_FIND
// if word$="drop"
// print "DROP hash=";hash%
// get
// endif
#endif
link& = thread&(hash%)
while link& and (nt&=0)
#ifdef _DEBUG_FIND
print "link&= ";link&
print "name = ";_NAME?(thread&(link&+1))
#endif
// maybe faster not repeating thread&(link&+1) // :!!!
if _NAME?(thread&(link&+1)) = word$
#ifdef _DEBUG_FIND
print "equal! word$=";word$;" name=";_NAME?(thread&(link&+1))
#endif
nt& = thread&(link&+1)
endif
link& = thread&(link&)
endwh
#ifdef _DEBUG_FIND
print "****** fin de find"
print "nt&=";nt&
// print "press any key"
print "****** "
// get
#endif
forth5mx_inc_find_locals.opp
Este breve fichero contiene la declaración de variables locales usadas por forth5mx_inc_find.opp. Está separado porque, depende del contexto, es necesario o no definir las variables.
// forth5mx_inc_find_locals.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>.
// code for FIND
// used when the file forth_inc_find.opp
// is included into the proc header&:()
local nametofind$
local nt&
local word$
local link&
forth5mx_inc_refill.opp
// forth5mx_inc_refill.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>.
// code for refill
if sourceid&>0
// input from file
#ifdef _DSOURCE
successful& = false&
#else
// load line:
temp% = ioread(sourceid&,ib_addr&,KMaxStringLen%)
if temp% < 0
// end of the included file
pokeb ib_opl_addr&,0 // ?!!!
ib_len& = 0
else
pokeb ib_opl_addr&,temp%
ib_len& = temp%
endif
successful& = (temp%>=0)
// end of load line
if successful& // *!!! ?!!!
// erase control chars
// i% = peekb(ib_opl_addr&) // x!!!
i& = ib_len&
while i&
if peekb(ib_opl_addr&+i&)<KKeySpace%
pokeb ib_opl_addr&+i&,KKeySpace%
endif
i&--
endwh
endif
#endif
elseif sourceid& = KSourceIDString%
// input from a string
successful& = KFalse&
else
// input from the keyboard
#ifdef _DSOURCE
DesCopyStr:(ib_descriptor&,lineedit$:("",int(80),KTrue&))
#else
ib$ = lineedit$:("",int(80),KTrue&)
ib_len& = len(ib$)
#endif
successful& = KTrue&
endif
#ifndef _DSOURCE
toin&=0
#endif
forth5mx_inc_save_source.opp
// forth5mx_inc_save_source.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>.
if source_recursion%=KMaxSourceRecursions%
// error :!!!
_REPORT_ERROR?("too many source recursions")
else
recursive_sourceid&(source_recursion%)=sourceid&
recursive_path$(source_recursion%)=path$
#ifdef _DSOURCE
recursive_ib_addr&(source_recursion%)=ib_addr&
recursive_ib_len&(source_recursion%)=ib_len&
recursive_ib_descriptor&(source_recursion%)=ib_descriptor&
recursive_ib_lex&(source_recursion%)=ib_lex&
#else
recursive_ib$(source_recursion%)=ib$
recursive_toin&(source_recursion%)=toin&
#endif
source_recursion%=source_recursion%+1
endif
forth5mx_inc_restore_source.opp
// forth5mx_inc_restore_source.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>.
#ifdef _DSOURCE
DeleteLex:(ib_lex&)
DeleteDes:(ib_descriptor&)
freealloc(ib_addr&)
#endif
if source_recursion%=1
// error :!!!
report_error:("no source recursion to restore")
else
source_recursion%=source_recursion%-1
#ifdef _DSOURCE
ib_addr&=recursive_ib_addr&(source_recursion%)
ib_len&=recursive_ib_len&(source_recursion%)
ib_descriptor&=recursive_ib_descriptor&(source_recursion%)
ib_lex&=recursive_ib_lex&(source_recursion%)
#else
ib$=recursive_ib$(source_recursion%)
ib_len&=len(ib$)
toin&=recursive_toin&(source_recursion%)
#endif
sourceid&=recursive_sourceid&(source_recursion%)
file_id%=sourceid&
path$=recursive_path$(source_recursion%)
endif
_INDICATE_SOURCE
forth5mx_inc_to_sbuffer.opp
Este módulo almacena una cadena en el búfer circular de texto que implementé de forma nativa en Forth 5mx. Escribí también una versión del búfer circular de texto en Forth, para utilizarla con otros sistemas Forth.
// forth5mx_inc_to_sbuffer.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>.
// to_sbuffer code
// input:
// string$ = string to move into the string buffer
_2INCREASE_STACK
len& = len(string$)
_PLUS_SBUFFER?(len&)
#ifdef _DSBUFFER
#ifdef _TOS
tos& = len&
pokel sp&,sbuffer_start&+DesLength&:(sbuffer_descriptor&)+1
#else
pokel sp&,len&
pokel sp&+KCell&,sbuffer_start&+DesLength&:(sbuffer_descriptor&)+1
#endif
DesAppendChar:(sbuffer_descriptor&,len&)
DesAppendStr:(sbuffer_descriptor&,string$)
#else
#ifdef _TOS
tos& = sbuffer_reserved&
pokel sp&,sbuffer_current&+1
#else
pokel sp&,sbuffer_reserved&
pokel sp&+KCell&,sbuffer_current&+1
#endif
poke$ sbuffer_current&,string$
#endif
_SBUFFER_PLUS