csb2
Descripción del contenido de la página
Utilidad en Forth para implementar un almacén circular de cadenas de texto.
csb2 es una reescritura y ampliación de una pequeña utilidad escrita por Wil Baden en 1996, a la que yo había hecho unos pequeños retoques en su día.
Un «almacén circular de cadenas» es propiamente un espacio para almacenar las cadenas de texto según se van definiendo o manipulando; también es la herramienta que permite implementarlo y usarlo. «Circular» quiere decir que cuando el espacio reservado se agota, la siguiente cadena ocupa el espacio de la primera. Forth dispone de un espacio temporal para el almacenamiento de las cadenas de texto, pero en muchos sistemas Forth cada nueva cadena encontrada en el código fuente sobreescribe la anterior, pues todas se guardan temporalmente en el mismo espacio, lo que es un inconveniente para hacer ciertas manipulaciones. Para hacer un programa independiente de las interioridades del sistema Forth sobre el que se ejecute (y hacerlo así más portable), una utilidad de este tipo es muy útil.
A mediados de 2011, durante el desarrollo de un proyecto en Forth, necesité una versión más versátil y potente que la que ya tenía tras modificar el original de Wil Baden. Ese fue el origen de csb2, que posteriormente he utilizado también en otro proyecto: Asalto y castigo en Forth.
Código fuente
csb
La versión original de Wil Baden, con algunos retoques míos:
\ Circular string buffer
\ (c) 1996 Wil Baden
\ Forth Dimensions, volume XVIII, number 2 (July/August 1996), page 6
\ http://forth.org/FD/
\ Modified by Marcos Cruz (programandala.net)
\ 2008-04-27
200000 CONSTANT /csb \ size of the buffer
/csb CELL+ ALLOCATE [IF]
\ ALLOCATE error
DROP CREATE csb 0 , /csb CHARS ALLOT
[ELSE]
CONSTANT csb 0 csb !
[THEN]
\ : (>csb) ( u -- c-addr )
: +sbuffer ( u -- c-addr )
\ Take a number and return
\ a character address in the buffer
\ to store a string of that lenght.
DUP csb @ >
IF /csb csb ! THEN
NEGATE csb +!
csb CELL+ csb @ CHARS +
;
\ : >csb ( c-addr1 u -- c-addr2 u )
: >sbuffer ( c-addr1 u -- c-addr2 u )
\ Find room for a string in the buffer,
\ copy it there and return its address and length.
\ DUP (>csb) SWAP
DUP +sbuffer SWAP
2DUP >R >R
CHARS MOVE
R> R>
;
: str+ ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Concatenate two strings and move the
\ result into the buffer.
2 PICK OVER + >R ( R: u1+u2 )
\ R@ (>csb) >R ( R: u1+u2 c-addr3 )
R@ +sbuffer >R ( R: u1+u2 c-addr3 )
2 PICK CHARS R@ + ( . . c-addr2 u2 c-addr3+u1)
SWAP CHARS CMOVE ( c-addr1 u1 )
R@ SWAP ( c-addr1 c-addr3 u1 )
CHARS CMOVE ( )
R> R>
;
\ ' s+ alias str+
csb2
La versión reescrita y mejorada, adaptada a mis necesidades:
\ csb2
\ ("Circular String Buffer 2")
\ ("Almacén Circular de Textos 2")
\ Copyright (C) 2011,2012 Marcos Cruz (programandala.net)
\ License: http://programandala.net/license
\ Licencia: http://programandala.net/licencia
\ http://programandala.net/es.programa.csb2.html
\ Basado en parte en el código publicado por Wil Baden
\ en Forth Dimensions en julio-agosto de 1996
\ (volumen 18, número 2, página 6).
\ Probado con: Gforth, SP-Forth y lina.
\ Historial:
\ 2011-06-14: Primera versión.
\ 2011-07-24: Cambiado MOVE por CMOVE en SMOVE .
\ 2011-12-08: Añadido CHARS en varios cálculos.
\ Falta confirmar si debería estar en todos,
\ aunque en la práctica CHARS no hace nada
\ en la mayoría de sistemas Forth.
\ 2011-12-24: Versión opcional para sistemas
\ Forth que no tienen las palabras ALLOCATE ,
\ RESIZE y FREE . Creada la palabra >BYTES/CSB .
\ 2012-02-05: Unificado el formato de los comentarios.
\ 2012-02-05: Los comandos principales pasan a ser vectores,
\ y nuevas palabras permiten reasignarlos a una de las dos
\ versiones: memoria y diccionario. Esto facilita cambiar
\ de modalidad.
\ 2012-04-07: Corrección de la puntuación de los comentarios.
\ 2015-01-29: Sustitución de los tabuladores por espacios.
: >bytes/csb ( u1 -- u2 )
\ Convierte un número de caracteres en el número de octetos necesarios.
\ u1 = Caracteres
\ u2 = Octetos necesarios para guardarlos,
\ más una celda para guardar el puntero
chars cell+
;
\ Número máximo predeterminado de caracteres en el almacén:
1024 >bytes/csb value /csb
\ Dirección del almacén (cero hasta que se cree el almacén):
0 value csb
: csb_set ( u a -- )
\ Guarda la dirección y longitud de la zona a usar como almacén.
2dup ! \ Guardar en la primera celda del almacén
\ el número de caracteres libres.
to csb to /csb
;
\ Vectores de los comandos principales
defer free_csb
defer allocate_csb
defer resize_csb
\ Versión para usar la memoria como almacenamiento
: heap_free_csb
\ Libera la zona de memoria del almacén.
csb free throw
;
: heap_allocate_csb ( u -- )
\ Crea un almacén para u caracteres.
csb if free_csb then \ Si ya existe un almacén creado, borrarlo.
dup >bytes/csb allocate throw
csb_set
;
: heap_resize_csb ( u -- )
\ Cambia el tamaño del almacén para u caracteres.
dup >bytes/csb csb swap resize throw
csb_set
;
\ Versión limitada, que utiliza el espacio del diccionario
: dictionary_free_csb ;
: dictionary_allocate_csb ( u -- ) here over >bytes/csb allot csb_set ;
: dictionary_resize_csb ( u -- ) allocate_csb ;
\ Asignación de los vectores
: heap_csb ( -- )
\ Activa la versión que utiliza la memoria.
['] heap_resize_csb is resize_csb
['] heap_free_csb is free_csb
['] heap_allocate_csb is allocate_csb
;
: dictionary_csb ( -- )
\ Activa la versión que utiliza el diccionario.
['] dictionary_resize_csb is resize_csb
['] dictionary_free_csb is free_csb
['] dictionary_allocate_csb is allocate_csb
;
[defined] allocate [defined] resize [defined] free and and
[IF] heap_csb
[ELSE] dictionary_csb
[THEN]
/csb allocate_csb \ Crear el almacén con el tamaño predeterminado.
: csb_check ( u -- )
\ Si no queda espacio libre para u caracteres en el almacén,
\ reinicia el puntero.
chars csb @ > if /csb csb ! then
;
: csb- ( u -- )
\ Reduce el espacio disponible en el almacén en u caracteres.
chars negate csb +!
;
: 'csb ( u -- a )
\ Devuelve una dirección libre en el almacén para almacenar u caracteres.
chars dup csb_check csb- \ Comprobar y preparar el almacén.
csb cell+ csb @ chars + \ Calcular la dirección libre.
;
: >csb ( a1 u -- a2 u )
\ Guarda una cadena en el almacén y la devuelve con su nueva dirección.
dup 'csb swap \ Calcular la dirección y disponer parámetros para MOVE .
2dup >r >r \ Preservar la cadena en la pila de retornos.
chars move \ Copiar la cadena en el almacén.
r> r> \ Recuperar la cadena.
;
: (s) ( a u -- | a2 u )
\ Almacena una cadena en el sistema.
state @
if postpone sliteral \ En modo de compilación, en el diccionario.
else >csb \ En modo de interpretación, al almacén.
then
;
: s| ( "ccc<|>" -- a u )
\ Interpreta una cadena de forma análoga a la palabra S"
\ pero usando la barra vertical como separador,
\ lo que permite usar comillas dobles en las cadenas.
[char] | parse \ Buscar siguiente barra vertical en flujo de entrada.
(s) \ Almacenar la cadena.
; immediate
: s" ( "ccc<doublequote>" -- a u )
\ Interpreta una cadena de forma análoga a la palabra S" .
\ Esta palabra sustituye a la homónima estándar;
\ hace la misma función pero devuelve el resultado en el almacén.
[char] " parse \ Buscar siguiente comilla doble en flujo de entrada.
(s) \ Almacenar la cadena.
; immediate
: lengths ( a1 u1 a2 u2 -- a1 u1 a2 u2 u1 u2 )
\ Duplica en la pila las longitudes de dos cadenas.
2 pick over
;
: smove ( a1 u a2 -- )
\ Copia una cadena a una dirección.
swap chars cmove
;
: s+ ( a1 u1 a2 u2 -- a3 u3 )
\ Concatena dos cadenas y devuelve el resultado en el almacén.
\ Calcular y preservar la longitud total:
lengths + >r ( a1 u2 a2 u2 ) ( R: u3 )
\ Calcular y preservar la dirección en el almacén:
r@ 'csb >r ( R: u3 a3 )
\ Calcular la dirección de la segunda cadena
\ dentro de la cadena final (u1+a3):
2 pick chars r@ + ( a1 u1 a2 u2 u1+a3 )
smove ( a1 u1 ) \ Copiar la segunda cadena al almacén.
r@ smove \ Copiar la primera cadena al almacén.
r> r> \ Recuperar de la pila de retornos los datos de la cadena final.
;
: c!++ ( a1 c -- a2 )
\ Guarda un caracter en una dirección de memoria
\ y devuelve la dirección incrementada.
over c! char+
;
: (s&) ( a1 u1 a2 u2 -- a3 u3 )
\ Concatena dos cadenas con un espacio intermedio
\ y devuelve el resultado en el almacén.
\ Calcular y preservar la longitud total:
lengths + 1+ >r ( a1 u2 a2 u2 ) ( R: u3 )
\ Calcular y preservar la dirección en el almacén:
r@ 'csb >r ( R: u3 a3 )
\ Calcular la dirección de la segunda cadena
\ dentro de la cadena final (u1+a3):
2 pick chars r@ + ( a1 u1 a2 u2 u1+a3 )
bl c!++ \ Guardar un espacio en esa posición y la incrementa.
smove ( a1 u1 ) \ Copiar la segunda cadena al almacén.
r@ smove \ Copiar la primera cadena al almacén.
r> r> \ Recuperar de la pila de retornos los datos de la cadena final.
;
: any_empty_string? ( a1 u1 a2 u2 -- a1 u1 a2 u2 f )
\ ¿Alguna de las dos cadenas está vacía?
lengths 0= swap 0= or
;
: s& ( a1 u1 a2 u2 -- a3 u3 )
\ Concatena dos cadenas (con un espacio intermedio si ninguna está vacía)
\ y devuelve el resultado en el almacén.
any_empty_string? if s+ else (s&) then
;
: count ( a -- a2 u )
\ Sustituye a la palabra homónima estándar;
\ hace la misma función pero devuelve el resultado en el almacén.
count >csb
;