Received: by NDSUVM1 (Mailer R2.07) id 4614; Thu, 23 Aug 90 23:25:42 CDT
Date:         Fri, 24 Aug 90 00:23:02 EDT
Reply-To:     Apple II List <APPLE2-L@BROWNVM.BITNET>
Sender:       Apple II List <APPLE2-L@BROWNVM.BITNET>
From:         "Comp.Binaries.Apple2 Forwarding" <delaneyg@wnre.aecl.ca>
Subject:      QForth Seive Demo
To:           "Steven E. Nelson" <CMDSENPG@UIAMVS.BITNET>
 
Sieve demo for QForth.
 
10000 constant size
 
create flags size 1+ allot
 
variable count
variable prime
variable ref
 
: sieve
 
  cr ." Sieve x 10... " cr
 
  10 0
    do
 
      0 count !
      flags size 1+ 1 fill
 
      size 1+ 1
        do
          flags i + c@
            if
              i dup + 2+ 1+ prime !
              i prime @ + ref !
                begin
                  ref @ size <
                while
                  0 flags ref @ + c!
                  ref @ prime @ + ref !
                repeat
              count @ 1+ count !
            else
            then
        loop
 
   loop
 
  ." ...done. " cr count ? ." primes. "
 
;