gforth
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[gforth] Strange behavior of f! etc.


From: Marcel Hendrix
Subject: [gforth] Strange behavior of f! etc.
Date: Mon, 13 Feb 2012 00:22:20 +0100 (CET)

What has changed? It appears something is wrong with array indexing.
However, the official Gforth files from the FSL 
(http://www.taygeta.com/fsl/scilib.html) are used?
X-Online-Scanned: by Cloudmark authority (on smtp09.online.nl)

I have append all three files under question.

Sequences of  pi xx{ 1 } f!  xx{ 1 } f@ f. seem to work.
Putting it inside a do loop in a definition fails as shown.

-marcel

-- ----------------
C:\gforth>gforth-fast
Gforth 0.7.0, Copyright (C) 1995-2008 Free Software Foundation, Inc.
Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
Type `bye' to exit
include fsl-utilg.fth
 fsl-utilg.fth     V2.0         Thursday 16 October 2008  redefined s>f  
redefined f>s   ok
include dynmem.seq  ok
include walsh.fs
WALSH             V1.1           30 March 1998   EFC  ok
6 set-precision  ok
cr 32 xx{ }fprint 
0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0.
0. 0.  ok
32 wtest-init  ok
cr 32 xx{ }fprint 
195.09 NaN0.00000886728 NaN0.0000147788 NaN
0.0000206903 NaN0.0000266018 NaN0.0000325134 NaN
0.0000384249 NaN0.0000443364 NaN0.0000502479 NaN
0.0000561595 NaN0.000062071 NaN0.0000679825 NaN
0.000073894 NaN0.0000798055 NaN0.0000857171 NaN
0.0000916286 NaN ok
xx{ 0 } f@ f. 195.09  ok
xx{ 1 } f@ f. NaN ok
xx{ 2 } f@ f. 0.00000886728  ok

-- fsl-utilg.fth -----------------
\ fsl-utilg.fth      An auxiliary file for the Forth Scientific Library
\                    For GForth

\ Contains commonly needed definitions for the FSL modules.

\ S>F  F>S                 conversion between (single) integer and float
\ -FROT                    reverse the effect of FROT
\ cell-                    back up one cell
\ F2DUP                    FDUP two floats
\ F2DROP                   FDROP two floats
\ PI  F1.0                 floating point constants
\ dxor, dor, dand          double xor, or, and
\ sd*                      single * double = double_product
\ %                        parse next token as a FLOAT
\ v: defines use( &        for defining and settting execution vectors
\ Public: Private: Reset_Search_Order   control the visibility of words
\ INTEGER, DOUBLE          for setting up array types
\ ARRAY DARRAY             for declaring static and dynamic arrays
\ }                        for getting an ARRAY or DARRAY element address
\ &!                       for storing ARRAY aliases in a DARRAY
\ PRINT-WIDTH              number of elements per line for printing arrays
\ }IPRINT  }FPRINT         print out integer or fp arrays
\ }FCOPY                   copy one array into another
\ }FPUT                    move values from fp stack into an array
\ MATRIX  DMATRIX          for declaring a static or dynamic 2-D array
\ }}                       gets a Matrix element address
\ }}IPRINT  }}FPRINT       print out an integer or fp matrix
\ }}FCOPY                  copy one matrix into another
\ }}FPUT                   move values from fp stack into a matrix
\ FRAME| |FRAME            set up/remove a local variable frame
\ a b c d e f g h          local FVARIABLE values
\ &a &b &c &d &e &f &g &h  local FVARIABLE addresses
\    The words  F,  F=  F2*  F2/  PI  FLOAT  are already present in Gforth

\ This code is released to the public domain Everett Carter July 1994

\ CR .( FSL-UTILG.FTH    V1.17        12 Jun 1996 10:13:12      EFC )
CR .(  fsl-utilg.fth     V2.0         Thursday 16 October 2008  )
\    cgm:   reorganized file,
\           removed words already in Gforth,
\           Gforth DEFER and IS used for vectoring,
\           alternative definition for fp locals.

\ The code conforms with ANS requiring:
\   1. Words from the wordsets CORE, CORE-EXT, BLOCK-EXT, EXCEPTION-EXT,
\       FILE, FLOAT, FLOAT-EXT, LOCAL, SEARCH, SEARCH-EXT, and TOOLS-EXT
\   2. Gforth words  Defer  Alias  -rot  float  f,
\

BASE @ DECIMAL

\ ================= compilation control =============================

\ for control of conditional compilation of test code
FALSE VALUE TEST-CODE?
FALSE VALUE ?TEST-CODE          \ obsolete, for backward compatibility

\ for control of conditional compilation of Dynamic memory
TRUE CONSTANT HAS-MEMORY-WORDS?

\ ================= FSL NonANS words ================================

: s>f   S>D D>F    ;
: f>s   F>D DROP   ;
: -frot FROT FROT  ;
: cell-  [ 1 CELLS ] LITERAL - ;   \ back up one cell
: F2DUP   FOVER FOVER ;
: F2DROP  FDROP FDROP ;
1.0E0 FCONSTANT F1.0

: dxor  ( d1 d2 -- d )  ROT XOR >R XOR R>  ;          \ double xor
: dor   ( d1 d2 -- d )  ROT OR >R OR R>    ;          \ double or
: dand  ( d1 d2 -- d )  ROT AND >R AND R>  ;          \ double and

: sd*   ( multiplicand multiplier_double -- product_double )
      2 PICK * >R   UM*   R> +  ;                \ single * double = double

: % BL WORD COUNT >FLOAT 0= ABORT" NAN"
                  STATE @ IF POSTPONE FLITERAL THEN ; IMMEDIATE

\ ================= function vector definition ======================
\  use Forth200x words  DEFER  and  IS  for FSL words  v: and  defines
\  defines  is already a synonym for  IS  in Gforth

' Defer Alias v:

: use(  STATE @ IF POSTPONE ['] ELSE ' THEN ;  IMMEDIATE
: &     POSTPONE use( ; IMMEDIATE

\ ================= vocabulary management ===========================

WORDLIST CONSTANT hidden-wordlist

: Reset-Search-Order
        FORTH-WORDLIST 1 SET-ORDER
        FORTH-WORDLIST SET-CURRENT
;

: Public:
        FORTH-WORDLIST hidden-wordlist 2 SET-ORDER
        FORTH-WORDLIST SET-CURRENT
;

: Private:
        FORTH-WORDLIST hidden-wordlist 2 SET-ORDER
        hidden-wordlist SET-CURRENT
;

: Reset_Search_Order   Reset-Search-Order ;     \ for backward compatibility

\ ================= array words =====================================

0 VALUE TYPE-ID               \ for building structures
FALSE VALUE STRUCT-ARRAY?

\ for dynamically allocating a structure or array
TRUE  VALUE is-static?     \ TRUE for statically allocated structs and arrays
: dynamic ( -- )     FALSE TO is-static? ;

1 CELLS CONSTANT INTEGER        \ size of a regular integer
2 CELLS CONSTANT DOUBLE         \ size of a double integer
\  1 FLOATS CONSTANT FLOAT      \ size of a regular float
1 CELLS CONSTANT POINTER        \ size of a pointer (for readability)

\ 1-D array definition
\    -----------------------------
\    | cell_size | data area     |
\    -----------------------------

: MARRAY ( n cell_size -- | -- addr )             \ monotype array
     CREATE
       DUP , * ALLOT
     DOES> CELL+
;

\    -----------------------------
\    | id | cell_size | data area |
\    -----------------------------

: SARRAY ( n cell_size -- | -- id addr )          \ structure array
     CREATE
       TYPE-ID ,
       DUP , * ALLOT
     DOES> DUP @ SWAP [ 2 CELLS ] LITERAL +
;

: ARRAY
     STRUCT-ARRAY? IF   SARRAY FALSE TO STRUCT-ARRAY?
                   ELSE MARRAY
                   THEN
;

\ word for creation of a dynamic array (no memory allocated)

\ Monotype
\    ------------------------
\    | data_ptr | cell_size |
\    ------------------------

: DMARRAY   ( cell_size -- )  CREATE  0 , ,
                              DOES>
                                    @ CELL+
;

\ Structures
\    ----------------------------
\    | data_ptr | cell_size | id |
\    ----------------------------

: DSARRAY   ( cell_size -- )  CREATE  0 , , TYPE-ID ,
                              DOES>
                                    DUP [ 2 CELLS ] LITERAL + @ SWAP
                                    @ CELL+
;

: DARRAY   ( cell_size -- )
     STRUCT-ARRAY? IF   DSARRAY FALSE TO STRUCT-ARRAY?
                   ELSE DMARRAY
                   THEN
;

\ word for aliasing arrays,
\  typical usage:  a{ & b{ &!  sets b{ to point to a{'s data

: &!    ( addr_a &b -- )
        SWAP cell- SWAP >BODY  !
;


: }   ( addr n -- addr[n])       \ word that fetches 1-D array addresses
          OVER [ 1 CELLS ] LITERAL -  @ * + 
;

VARIABLE print-width      6 print-width !

: }iprint ( n addr -- )       \ print n elements of an integer array
        SWAP 0 DO I print-width @ MOD 0= I AND IF CR THEN
                  DUP I } @ . LOOP
        DROP
;

: }fprint ( n addr -- )       \ print n elements of a float array
        SWAP 0 DO I print-width @ MOD 0= I AND IF CR THEN
                  DUP I } F@ F. LOOP
        DROP
;

: }fcopy ( 'src 'dest n -- )         \ copy one array into another
     0 DO      OVER I } F@     DUP  I } F!    LOOP
        2DROP
;

: }fput ( r1 ... r_n n 'a -- )   \ store r1 ... r_n into array of size n
     SWAP DUP 0 ?DO   1- 2DUP 2>R } F! 2R>   LOOP  2DROP ;

\ 2-D array definition,

\ Monotype
\    ------------------------------
\    | m | cell_size |  data area |
\    ------------------------------

: MMATRIX  ( n m size -- )           \ defining word for a 2-d matrix
        CREATE
           OVER , DUP ,
           * * ALLOT
        DOES>  [ 2 CELLS ] LITERAL +
;

\ Structures
\    -----------------------------------
\    | id | m | cell_size |  data area |
\    -----------------------------------

: SMATRIX  ( n m size -- )           \ defining word for a 2-d matrix
        CREATE TYPE-ID ,
           OVER , DUP ,
           * * ALLOT
        DOES>  DUP @ TO TYPE-ID
               [ 3 CELLS ] LITERAL +
;


: MATRIX  ( n m size -- )           \ defining word for a 2-d matrix
     STRUCT-ARRAY? IF   SMATRIX FALSE TO STRUCT-ARRAY?
                   ELSE MMATRIX
                   THEN
;

: DMATRIX ( size -- )      DARRAY ;

: }}    ( addr i j -- addr[i][j] )    \ word to fetch 2-D array addresses
               >R >R
               DUP cell- cell- 2@     \ &a[0][0] size m
               R> * R> + *
               +
;

: }}iprint ( n m addr -- )       \ print nXm elements of an integer 2-D array
        ROT ROT SWAP 0 DO    DUP 0 DO    OVER J I  }} @ .
                                   LOOP
                             CR
                       LOOP
        2DROP
;


: }}fprint ( n m addr -- )       \ print nXm elements of a float 2-D array
        ROT ROT SWAP 0 DO    DUP 0 DO    OVER J I  }} F@ F.
                                   LOOP
                             CR
                       LOOP
        2DROP
;

: }}fcopy ( 'src 'dest n m  -- )      \ copy nXm elements of 2-D array src to 
dest
        SWAP 0 DO    DUP 0 DO    2 PICK J I  }} F@
                                 OVER   J I  }} F!
                           LOOP
               LOOP
        DROP 2DROP
;

: }}fput ( r11 r12 ... r_nm  n m 'A -- | store r11 ... r_nm into nxm matrix )
      -ROT 2DUP * >R 1- SWAP 1- SWAP }} R> 
      0 ?DO  DUP >R F! R> FLOAT -  LOOP  DROP ;

\ ================= Floating-point local variables ==================
(
  loosely based upon Wil Baden's idea presented at FORML 1992.
  The idea is to have a fixed number of variables with fixed names.

  example:  : test  2e 3e FRAME| a b |  a F. b F. |FRAME ;
            test <cr> 3.0000 2.0000 ok

  Don't forget to use |FRAME before leaving a word that uses FRAME|.
)

8 CONSTANT /FLOCALS       \ number of variables provided

: (frame) ( n -- ) FLOATS ALLOT ;
: (unframe) ( addr -- ) HERE - ALLOT ;

: FRAME|
        POSTPONE HERE POSTPONE FALIGN POSTPONE >R
        0 >R
        BEGIN   BL WORD  COUNT  1 =
                SWAP C@  [CHAR] | =
                AND 0=
        WHILE   POSTPONE F,  R> 1+ >R
        REPEAT
        /FLOCALS R> - DUP 0< ABORT" too many flocals"
        POSTPONE LITERAL  POSTPONE (frame) ; IMMEDIATE

: |FRAME ( -- ) POSTPONE R> POSTPONE  (unframe) ; IMMEDIATE

\ use a defining word to build locals   cgm
: lcl  ( n -- ) CREATE ,
                DOES>  @ FLOATS NEGATE HERE +
;

8 lcl &a      7 lcl &b      6 lcl &c      5 lcl &d
  : a &a F@ ;   : b &b F@ ;   : c &c F@ ;   : d &d F@ ; 
4 lcl &e      3 lcl &f      2 lcl &g      1 lcl &h
  : e &e F@ ;   : f &f F@ ;   : g &g F@ ;   : h &h F@ ; 

BASE !
\                   end of file

-- dynmem.seq ------------------------------------------------
\ dynmem.seq                Dynamic Memory Allocation package
\                      this code is an adaptation of the routines by
\         Dreas Nielson, 1990; Dynamic Memory Allocation;
\         Forth Dimensions, V. XII, No. 3, pp. 17-27
\
\ This is an ANS Forth program requiring:
\      1. The Memory-Allocation wordset, or the implementations below of
\         ALLOCATE and FREE
\      2. The compilation of the local ALLOCATE and FREE is controlled by
\          the VALUE HAS-MEMORY-WORDS?
\         and the conditional compilation words in the Programming-Tools wordset
\
\ This code is designed to work in conjunction with the FSL implementation
\ of arrays as given in the file, 'fsl-util'.
\
\ The words ALLOCATE and FREE are implementations of the ANS Forth
\ words from the Memory-Allocation wordset.  If your Forth system
\ has the Memory-Allocation wordset the following words can be eliminated from 
here:
\       freelist
\       Dynamic-Mem
\       ALLOCATE
\       FREE
\
\
\  To use dynamic memory, a dynamic memory pool needs to be created and
\  initialized. The dynamic memory pool needs to be initialized before it is 
ever
\  used.  IF THIS IS NOT DONE, ALLOCATE will abort with a message
\  complaining about the lack of initialization.  Typically
\  the initialization would look like,
\
\
\       CREATE POOL   #bytes  ALLOT
\       POOL #bytes Dynamic-Mem
\
\       (any other way of allocating space for the pool will also work, one
\       just has to pass the starting address of some contigous memory and the
\       number of bytes to Dynamic-Mem).  If there are alignment requirements
\       for the data space, this should be satisfied BEFORE the address is
\       passed to Dynamic-Mem.
\
\       If your application ends up using more bytes than are in the memory
\       pool ( #bytes ) then the internal pointer will be NULL when }malloc
\       fails.  You can detect this by invoking  malloc-fail?,
\
\               malloc-fail?
\
\       If there is a true on the stack at this point, then the allocation
\       failed. This allows the following usage,
\
\               malloc-fail? ABORT" ALLOCATE failed "
\
\       The allocation and freeing of dynamic memory can be done in any order.
\       Since this can be done in any order, there is a possiblity that the
\       pool will become fragemented.   It is then possible that a }malloc
\       will fail if the memory pool is very fragmented.
\
\       The current version of the dynamic memory package can have
\       only one memory pool.
\
\       For dynamically allocated arrays, the delcaration looks like,
\
\       element_size DARRAY name{
\
\       where element_size is the number of cells that the data type occupies
\       just as for static arrays.
\
\       To allocate space for a dynamic array (this can be done at runtime),
\
\       & name{ #elements }malloc
\
\       If it succeeds then there will have been contiguous space allocated
\       for the required number of elements.
\
\       To release the space (this can also be done at runtime) use,
\
\       & name{ }free
\
\
\       A dynamic array name can be re-used by calling }free to release
\       the old space and then calling }malloc again to reallocate it.

\ CR .( DYNMEM            V1.9            4 January 1995   EFC )
\                         V2.0 fixed bug in }}free  Feb 2008 cgm
Private:

HAS-MEMORY-WORDS? 0= [IF]

\ pointer to beginning of free space
variable freelist  0 ,     0 freelist !

[THEN]

Public:

\ memory allocation status variable, 0 for OK
0 VALUE malloc-fail?

: cell_size ( addr -- n )      >BODY CELL+ @ ;       \ gets array cell size

HAS-MEMORY-WORDS? 0= [IF]

\ initialize memory pool at ALIGNED address 'start_addr'
: Dynamic-Mem ( start_addr length -- )
          OVER DUP freelist !
          0 SWAP !
          SWAP CELL+ !
;

: ALLOCATE ( u -- addr ior )      \ allocate n bytes, return pointer to block
                                  \ and result flag ( 0 for success )

         \ check to see if pool has been initialized first
         freelist @ 0= ABORT" ALLOCATE::memory pool not initialized! "

         CELL+ freelist DUP
         BEGIN
           WHILE DUP @ CELL+ @ 2 PICK U<
                 IF @ @ DUP   \ get new link
                 ELSE   DUP @ CELL+ @ 2 PICK - 2 CELLS MAX DUP 2 CELLS =
                        IF DROP DUP @ DUP @ ROT !
                        ELSE  OVER OVER SWAP @ CELL+ !   SWAP @ +
                        THEN
                        OVER OVER ! CELL+ 0       \ store size, bump pointer
                 THEN                             \ and set exit flag
           REPEAT

          SWAP DROP

          DUP 0=
          
;

: FREE ( ptr -- ior )           \ free space at ptr, return status ( 0 for 
success )
           1 CELLS - DUP @ SWAP OVER OVER CELL+ ! freelist DUP
           BEGIN
             DUP 3 PICK U< AND
           WHILE
             @ DUP @
           REPEAT

           DUP @ DUP 3 PICK ! ?DUP
           IF DUP 3 PICK 5 PICK + =
              IF DUP CELL+ @ 4 PICK + 3 PICK CELL+ ! @ 2 PICK !
              ELSE   DROP THEN
           THEN

           DUP CELL+ @ OVER + 2 PICK =
           IF  OVER CELL+ @ OVER CELL+ DUP @ ROT + SWAP ! SWAP @ SWAP !
           ELSE !
           THEN

           DROP
           0           \ this code ALWAYS returns a success flag
;

[THEN]

\ word for allocation of a dynamic 1-D array memory
\ typical usage:  & a{ #elements }malloc
                                      \ ---------------------
: }malloc ( addr n -- )               \ | size | data area
                                      \ ---------------------
          OVER cell_size DUP >R *        \ save extra cell_size on rstack
          \ now add space for the cell_size entry
          CELL+ ALLOCATE
          TO malloc-fail?
          OVER >BODY !

          \ now store the cell size in the beginning of the block
          >BODY @ R> SWAP !
;

\ word to release dynamic array memory, typical usage:  & a{ }free

: }free   ( addr -- )
        >BODY DUP
        @ FREE
        TO malloc-fail?
        0 SWAP !
;

\ word for allocation of a dynamic 2-D array memory
\ typical usage:  & a{{ #rows #cols }}malloc
                                       \  -------------------------
: }}malloc ( addr n m -- )             \  | m | size | data area 
                                       \  -------------------------
          2 PICK cell_size DUP
          >R OVER >R         \ save extra cell_size and m on rstack
          * *                \ calculate the space needed
          \ now add space for the cell_size entry and m
          CELL+ CELL+ ALLOCATE
          TO malloc-fail?

          SWAP OVER CELL+ SWAP >BODY !    \ store pointer to allocated space
                                          \ Note: pointing to size field not m

          \ now store m and cell size in the beginning of the block
          R> OVER !
          R> SWAP CELL+ !

;

: }}free  ( addr -- )
        >BODY DUP @
        1 CELLS - 
        FREE
        TO malloc-fail?
        0 SWAP !
;

Reset_Search_Order

-- walsh.fs -------------------------------------------
\ Walsh                      Fast Walsh Transform
\ Perform the Walsh Transform on an array whose length is a power of two,
\ with or without normalization.
\
\      Forth Scientific Library Algorithm #50

\ Note: This algorithm is also practical for use in INTEGER ONLY applications.
\       To do so, change the floating point operations to integer ones, and the
\       arrays to INTEGER type.

\ This code is an ANS Forth program requiring:
\      1. The Floating-Point word set
\      2. Uses S>F, ARRAY, DARRAY as defined in 'fsl-util'
\      3. Uses the dynamic array memory allocation in 'dynmem'
\      4. Uses words 'Private:', 'Public:' and 'Reset_Search_Order'
\         to control the visibility of internal code.
\      5. The compilation of the test code is controlled by VALUE TEST-CODE?
\         and the conditional compilation words in the Programming-Tools
\         wordset
\      6. The test code uses the floating point constant PI
\         3.1415926536E0 FCONSTANT PI
\
\ See: Harmuth, H.F., 1969; Applications of Walsh functions in
\      communications, IEEE Spectrum, Nov. pp. 82-91
\ 
\ Based upon the algorithm and code described in:
\ Witkov, C., 1990; The Fastest Transform of All, Embedded Systems
\ Programming, October, pp. 30 - 35

\  (c) Copyright 1994 Everett F. Carter.  Permission is granted by the
\  author to use this software for any application provided the
\  copyright notice is preserved.
 

CR .( WALSH             V1.1           30 March 1998   EFC )

Private:

VARIABLE b
VARIABLE k
VARIABLE l
VARIABLE m

FLOAT DARRAY x{
FLOAT DARRAY z{

: NOT_POWER_OF_TWO? ( n -- t/f )      \ true of n not a power of 2 (or < 2)
    DUP DUP 1- AND
    SWAP 2 < OR
;

: ** ( n1 n2 -- n1^n2 )
       1 SWAP ?DUP IF 0 DO OVER * LOOP
                   THEN

       SWAP DROP
;

: fwt_initialize ( n -- )
       0 DO
           x{ I } F@   x{ I 1+ } F@ F+            x{ I    } F!
           x{ I } F@   x{ I 1+ } F@ 2.0E0 F* F-   x{ I 1+ } F!
       2 +LOOP
;

: fwt_normalize ( n -- )
        DUP S>F 0 DO
                    x{ I } DUP F@ FOVER F/ F!
        LOOP

        FDROP
;

Public:

\ do an N point Fast Walsh Transform of data in X
\ Normalize the transform if t/f is set (normally done on the forward
\ transform and not on the inverse transform)

: }FWT ( &x n t/f -- )
      OVER NOT_POWER_OF_TWO? ABORT" Invalid array size"
      
      ROT
      & x{ &!
      SWAP

      & z{ OVER }malloc

      0 l !

      DUP fwt_initialize
      
      BEGIN
        l @ 1+ DUP l !
        2 SWAP ** DUP m !
        OVER - 0<
      WHILE
        0 b !   0 k !
        BEGIN
          m @ 0 DO
                   b @ I +
                   x{ OVER } F@ x{ OVER m @ + } F@ F+  z{ k @ } F!
                   x{ OVER } F@ x{ OVER m @ + } F@ F-  z{ k @ 1+ } F!
                   1+
                   x{ OVER } F@ x{ OVER m @ + } F@ F-  z{ k @ 2 + } F!
                   x{ OVER } F@ x{ SWAP m @ + } F@ F+  z{ k @ 3 + } F!

                        k @ 4 + k !
                2 +LOOP

                m @ 2* b @ + b !
                k @ OVER - 0< 0=
        UNTIL

           \ transfer the result back to x{}
           DUP 0 DO   z{ I } F@   x{ I } F!   LOOP
      REPEAT
      
      SWAP IF fwt_normalize ELSE DROP THEN

      & z{ }free
      
;

Reset_Search_Order


\ TEST-CODE?
1 [IF]     \ test code =============================================

32 FLOAT ARRAY xx{

: wtest-init ( n -- )
       DUP 0 DO
             I 1+ 2* S>F DUP S>F F/ PI F* FSIN
             1000 S>F F*
             xx{ I } F!           
       LOOP
       DROP
;

: walsh-test ( -- )

    CR
    32 wtest-init
    ." Initial array: " 32 xx{ }fprint CR

    xx{ 32 1 }FWT                \ forward transform

    ." Transformed array: " 32 xx{ }fprint CR
    ." Should be: 0 634.57 62.5 0 0 -262.85 25.89 0 0 -52.28 -5.15 0 " CR
    ."     0 -126.22 12.43 0 0 -12.43 -1.22 0 0 5.15 -0.51 0 0 -25.89 -2.55 " CR
    ."     0 0 -62.5 6.16 0 " CR

    xx{ 32 0 }FWT                \ inverse transform

    ." Inverse transformed array (should be same as original): "
    32 xx{ }fprint CR

;

[THEN]




reply via email to

[Prev in Thread] Current Thread [Next in Thread]