Lluís Published on February 25, 08
by Lluís

Lluís's blog

Browse posts
Nova laborejo
Posted on April 5, 08
Tradukpeto de teksteto por serboj
Posted on March 2nd, 08
Sony PRS 505? PDF. Do, JBIG2.
Posted on February 27, 08
1 comment (latest 3 months ago)
Nova aĉeto, multekosta
Posted on February 26, 08
2 comments (latest 3 months ago)
Mia unua programo en Forth
Pli komputike: Forth
Posted on February 22, 08
Komputike, mi volas provi...
Posted on February 18, 08
2 comments (latest 4 months ago)
Por kio demokratio?
Posted on February 17, 08
14 comments (latest 5 months ago)
The Money Masters - spektu - mireu-lo!
Posted on February 16, 08

Keyword tags

ca
forth
programado
eo

More information

This post is public
© Free use
  1. 197 visits

Mia unua programo en Forth

Monday February 25, 2008 at 10:41PM

[ca] A veure si sabeu què fa el programa.

[eo] Jen. Mi uzis iom da gforth-aj aferoj, jes. Provu diveni, kion la programo faras.

#! /usr/bin/gforth

create stat-array 256 cells allot

4000 constant buffersize
create cbuffer buffersize chars allot

: count-char ( c -- )  \ Updates the stat-array according to the new character read
  cells stat-array + 1 swap +! ;

: read-chars ( -- u2 wior ) \ read chars from the file, and put them into cbuffer
  cbuffer buffersize stdin read-file ;

: clear-stat ( -- ) \ resets the char statistics to 0 for each char
  stat-array 
  256 0 do
    dup 0 swap !
    1 cells +
  loop
  drop ;

: count-chars ( n -- ) \ counts the given amount of chars from the cbuffer
  cbuffer swap 0 do
     dup c@ count-char
    1 chars +
  loop drop ;

: eat-file ( -- ) \ reads chars from a file, and counts them
  begin
    read-chars over swap 0= swap 0> and while
    count-chars
  repeat ;

: show-char ( c -- ) \ shows a character if printable, and outputs its ascii value in []
  dup dup 32 > swap 127 < and if
    dup emit space else 2 spaces then
  [char] [ emit 3 .r [char] ] emit space ;

: show-results ( -- ) \ shows the results of characters counted
  stat-array 
  256 0 do
    dup @ dup 0 if 
    s" Char " type
    i show-char
    s" has occurrences: " type
    . cr
    else drop
    then
    1 cells +
  loop ;

: get-stat ( -- ) \ counts the statistics in stdin, and shows the results.
  clear-stat eat-file show-results ;

get-stat bye

Add your comment

Reply to this comment

Edit your comment

Please sign in to post a comment Sign in now?


rss Latest comments – Subscribe to the feed of this post comments.