---

flog

En su día necesité obtener en un fichero todo lo que cierto programa en Forth imprimía en la pantalla. Entonces se me ocurrió que bastaría con redefinir las palabras originales de Forth que se ocupan de la impresión en pantalla para que enviaran sus datos también a un fichero de texto. Así nació flog (por Forth log). Cualquier programa que carguemos después de flog usará las nuevas palabras en lugar de las originales y eso nos permitirá dirigir su salida.

El programa puede que necesite este otro para funcionar: n2str.

Código fuente

\ ---------------------------------------------------------------
CR .( flog )
\ ---------------------------------------------------------------

\ Copyright (C) 2005,2006,2007,2008 Marcos Cruz (http://programandala.net)
\ Licencia/License/Permesilo: http://programandala.net/license

\ Herramienta para imprimir la salida en pantalla de un programa en Forth a un fichero de registro.
\ Ilo por printi la ekranprinton de Forth-programo en registrodosieron.
\ Tool to write the screen output of a Forth program into a log file.

\ Programa escrito en Forth; probado en Gforth y Forth 5mx.
\ Programo verkita en Fortho; provita per Gforth kaj Forth 5mx.
\ Program written in ANS Forth; tested with Gforth and Forth 5mx.

\ ---------------------------------------------------------------

\ History

\ 2008-04-29
\ Fixed the problem in ." and standard_." .

\ 2008-04-26
\ Strange problem in ." . I modify the word and comment out STANDARD_." .

\ 2007-08-03
\ Some comments added.
\ Changed INCLUDE to INCLUDED .

\ 2006-09-14
\ S-1 renamed to B>STR .

\ 2006-02-16
\ Litle bug fixed: the log code for . didn't print a space after the number.

\ 2006-02-15
\ >LOG divided into two words: >LOG and >>LOG .
\ New word LOG-ERROR? .
\ Words like (X) renamed to STANDARD_X to avoid eventual conflicts.
\ Bug fixed: The word . printed twice onscreen because it called the new TYPE instead of >>LOG .
\ New words STANDARD_." and ." .

\ 2005-10-26
\ Bug fixed: LOG has to be initialized with zero.
\ Bug fixed: CR called itself. New word (CR) to solve it.
\ Bug fixed: . called itself. New word (.) to solve it.
\ Bug fixed: TYPE called itself. New word (TYPE) to solve it.
\ New words SPACE and SPACES .

\ 2005-10-24
\ Start.

\ ---------------------------------------------------------------

\ To do

\ Use the standard words <# #S #> instead of N>STR . <# #S #> are not yet finished in Forth 5mx.
\ Write .(
\ bug?: error if LOG is ON but no log file is opened

\ ---------------------------------------------------------------

MARKER flog

[undefined] n>str [IF]
  S" n2str.fs" INCLUDED
[THEN]

[undefined] b>str [IF]

: b>str
  ( c -- c-addr 1 )
  PAD C! PAD 1
;

[THEN]

\ ---------------------------------------------------------------

VARIABlE log-fid  \ to keep the log file identifier
VARIABLE log  log off  \ to turn on and off the logging

: log?  ( -- flag )  log @  ;

: open-log  ( c-addr u -- )
  \ Open a log file and start logging.
  W/O CREATE-FILE
  ABORT" log file open error"
  log-fid !  log on
  ;

: close-log  ( -- )
  \ Close the last log file and finish logging.
  log-fid @ CLOSE-FILE
  ABORT" log file close error"
  log off
  ;


: log-error?  ( flag -- ) ABORT" log file write error"  ;

: >>log  ( c-addr u -- )
  log-fid @ WRITE-FILE log-error?
  ;

: >log  ( c-addr u -- )
  log-fid @ WRITE-LINE log-error?
  ;

: standard_type  ( c-addr u -- )
  TYPE
  ;

: type  ( c-addr u -- )
  log?  IF  2DUP >>log  THEN
  standard_type
  ;

: emit ( c -- )  b>str type  ;

: standard_cr  ( -- )  CR  ;

: cr  ( -- )
  log?  IF  S" " >log  THEN
  standard_cr
  ;

: space  ( -- )  BL emit  ;

: spaces  ( n -- )  0 DO space LOOP  ;

: standard_.  ( n -- )  .  ;

: .  ( n -- )
  log?  IF  DUP n>str >>log space THEN
  standard_.
  ;

: ?  ( addr -- )  @ .  ;

: standard_."  POSTPONE ."  ; IMMEDIATE

: ."  ( "text<double quote>" -- )

  [ FALSE ] [IF]  \ old buggy version
  ?compiling
  log?  IF  POSTPONE S"  POSTPONE type  THEN
  \ 2008-04-26 Modified:
  \ standard_."  \ Does not work any more in Forth 5mx, don't know why. It makes the system halt with an error.
  POSTPONE ."  \ Use this instead.
  [THEN]

  \ 2008-04-29 New version.

  ?compiling
  log?
  IF  POSTPONE S"  POSTPONE type
  ELSE POSTPONE standard_."
  THEN

  ; IMMEDIATE

.(  flog ok!)

Descargas

flog.fs (3.81 KiB)