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

Etiquetas:

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