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