sbuffer

Description of the page content

Circular string buffer in Forth.

Tags:

I wrote this circular string buffer implementation in 2001, based on the code of a similar code for kForth I rewrote it also in OPL+ as part of Forth 5mx. Finally I wrote csb2, an improved implementation.

Source code

\ *******************
CR .( sbuffer )
\ *******************

\ Copyright (C) 2001,2005,2008 Marcos Cruz (programandala.net)
\ License: http://programandala.net/license

\ Programa escrito en ANS Forth.
\ Programo verkita en ANS-Fortho.
\ Program written in ANS Forth.

\ Búfer circular para cadenas de texto.
\ Cirkla tekstochena bufro.
\ Circular text string buffer.

\ ***************************************************************

\ Algunas de las palabras están tomadas y adaptadas de:
\ Iuj el la vortoj estas adapte prenitaj el:
\ Some of the words are taken and adapted from:

\ strings.4th (String utility words for kForth, 1999)

\ ***************************************************************

\ Por hacer / Farenda / To do :

\ Comprobar la longitud máxima de las cadenas del sistema antes de almacenar una en el búfer.
\ Probar si se aprovecha hasta el último octeto.

\ ***************************************************************

\ Historial / Historio / History :

\ 2015-01-29:

\ Tabs changed to spaces in the source.

\ 2012-02-12:

\ 2- removed; 2 - used instead. It was a rest from Forth 5mx.

\ 2009-09-18:

\ SBUFFER# had to be increased from 500000 to 690000 because of a special operation needed
\ in my app alinome-bici-cua.fs.

\ 2008-04-27:

\ In >SBUFFER : CHARS added; CHAR+ used instead of 1+ .
\ In >CSBUFFER : 1 CHARS - used instead of 1- .
\ In +SBUFFER : CHAR+ used instead of 1+ .

\ 2008-01-20:

\ Bugs fixed in +BUFFER .
\ They were not discovered until this code was used in gforth
\ (Win32Forth suffered from the same bugs, but its error messages
\ are less verbose and the problem coud not be found).
\ Forth 5mx worked right because this app is written as a primitive in the system.

\ 2005-10-19:

\  +SBUFFER improved to avoid lengths greater than the buffer.

\ 2005-10-18:

\  Espacio en el búfer reservado con ALLOT si ALLOCATE da error.
\  Bufrospaco rezerivita per ALLOT se ALLOCATE fiaskas.
\  If ALLOCATE returns an error, the buffer space is reserved with ALLOT.

\  Todos los comentarios en los tres idiomas.
\  Chiuj notoj en la tri lingvoj.
\  All comments in the three languages.

\  Todas las palabras renombradas en inglés.
\  Chiuj vortoj angle renomitaj.
\  All words renamed into English.

\  Mejorados las palabras del interfaz y el funcionamiento interno general.
\  Plibonigitaj la interfacvortoj kaj la ena funkciado.
\  Interface words and inner working improved.

\  Se almacena también la longitud del texto en el búfer.
\  Ankaw la tekstolongo enmetitas en la bufron.
\  The text lenght is stored in the buffer too.

\  Nueva palabra >CSBUFFER .
\  Nova vorto >CSBUFFER .
\  New wod >CSBUFFER .

\ 2005-03-13:

\  Espacio en el búfer reservado con ALLOCATE en lugar de ALLOT .
\  Bufrospaco rezervita per ALLOCATE anstataw ALLOT .
\  Buffer space reserved with ALLOCATE instead of ALLOT .

\ 2001:

\  Primera versión.
\  Unua versio.
\  First version.

\ ***************************************************************

800000 CONSTANT sbuffer#

sbuffer# ALLOCATE  [IF]
  \ ALLOCATE error
  DROP CREATE 'sbuffer sbuffer# CHARS ALLOT
[ELSE]
  CONSTANT 'sbuffer
[THEN]

'sbuffer sbuffer# 1- + CONSTANT 'sbuffer;

\ Variable que apuntará al espacio libre del búfer:
\ Variablo celumonta la bufran liberan spacon:
\ Variable that will point to the buffer free space:

VARIABLE (sbuffer)  'sbuffer (sbuffer) !
VARIABLE /sbuffer

: sbuffer  ( -- addr )

  \ Devuelve la dirección actual del espacio libre del búfer.
  \ Redonu la nuna adreson de la libera bufrospaco.
  \ Return the current address of the free buffer space.

  (sbuffer) @

;

: sbuffer-free  ( -- u )

  \ Return the free bytes in the buffer.

  \ 2008-01-21

  'sbuffer; sbuffer - 1-

  ;

: +sbuffer  ( u -- c-addr )

  \ Apunta a un espacio libre del búfer para una cadena de texto de u caracteres.
  \ Celumigu al libera bufra spaco por tekstocheno u bitokojn longa.
  \ Point to a free buffer space for a text string u bytes long.

  [ FALSE ] [IF]

  \ First buggy version.

  sbuffer# 1- MIN
  DUP 1+ /sbuffer !
  'sbuffer; 'sbuffer - >
  IF
    \ Espacio insuficiente; mueve el puntero al comienzo del búfer.
    \ Nesuficha spaco; movu la celumilon bufrokomencen.
    \ Not enough space; move the pointer to the buffer start.
    'sbuffer (sbuffer) !
  THEN
  sbuffer

  [THEN]

  \ 2008-01-20 Bugs fixed.
  \ 2008-01-21 Factored with SBUFFER-FREE .

  sbuffer# 2 - MIN
  CHAR+ DUP /sbuffer !
  sbuffer-free >
  IF
    \ Espacio insuficiente; mueve el puntero al comienzo del búfer.
    \ Nesuficha spaco; movu la celumilon bufrokomencen.
    \ Not enough space; move the pointer to the buffer start.
    'sbuffer (sbuffer) !
  THEN
  sbuffer

;

: sbuffer+!  ( u -- )

  \ Suma u octetos al puntero del búfer.
  \ Sumu u bitokojn al la bufro-celumilo.
  \ Add u bytes to the buffer pointer.

  (sbuffer) +!
;

: sbuffer+  ( -- )

  \ Suma al puntero del búfer los octetos reservados por +sbuffer .
  \ Sumu al la bufro-celumilo la bitokojn rezervitajn de +sbuffer .
  \ Add to the buffer pointer the bytes reserved by +sbuffer .

  /sbuffer @ sbuffer+!

;

: >sbuffer ( c-addr1 u -- c-addr2 u )

  \ Copia una cadena de texto en el búfer.
  \ Kopiu tekstochenon bufren.
  \ Copy a text string into the buffer.

  DUP +sbuffer
  2DUP C! CHAR+
  SWAP 2DUP 2>R CHARS CMOVE 2R>
  sbuffer+

;

: >csbuffer  ( c-addr1 u -- c-addr2 )

  \ Copia una cadena de texto en el búfer.
  \ Kopiu tekstochenon bufren.
  \ Copy a text string into the buffer.

  >sbuffer DROP 1 CHARS -

;

.(  sbuffer ok!)

Downloads

sbuffer.fs (5.64 KiB)

Related pages

csb2
Circular string buffer in Forth.
csb8
Model of circular string buffer for an 8-bit Forth.
Forth 5mx
Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.