regex-dna ATS #2 program | Computer Language Benchmarks Game

performance measurements

Each table row shows performance measurements for this ATS program with a particular command-line input value N.

N	CPU secs	Elapsed secs	Memory KB	Code B	≈ CPU Load
50,000	0.26	0.28	412	3474	0% 7% 0% 100%
500,000	2.48	2.58	17,368	3474	0% 0% 0% 100%
5,000,000	24.75	24.77	224,896	3474	0% 0% 0% 100%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read regex-dna benchmark to see what this program should do.

notes

ATS/Anairiats version 0.2.9

regex-dna ATS #2 program source code

(*
** The Computer Language Benchmarks Game
** http://benchmarksgame.alioth.debian.org/
** contributed by Hongwei Xi
**
** multicore version of regex-dna benchmark using PCRE
**
** compilation command:
**   atscc -D_ATS_MULTITHREAD -O3 -fomit-frame-pointer regex-dna_smp.dats -o regex-dna_smp -lpthread -lpcre
*)

(* ****** ****** *)

%{^
#include <pcre.h>
#include <pthread.h>
%} // end of [%{^]

(* ****** ****** *)

staload _(*anonymous*) = "prelude/DATS/array.dats"

(* ****** ****** *)

extern fun malloc_atm {n:nat}
  (n: int n): [l:addr] @(bytes n @ l | ptr l) = "malloc_atm"
extern fun free_atm {n:nat} {l:addr}
  (pf: bytes n @ l | p: ptr l): void = "free_atm"

%{^

ATSinline()
ats_ptr_type malloc_atm (ats_int_type n) {
  ats_ptr_type p = malloc (n) ;
  if (!p) {
    fprintf (stderr, "Exit: [malloc_atm] failed.\n") ; exit (1) ;
  }
  return p ;
}

ATSinline()
ats_void_type free_atm (ats_ptr_type p) { free (p) ; return ; }

%}

(* ****** ****** *)

viewdef block_v (sz:int, l:addr) = bytes (sz) @ l
dataviewtype blocklst (int) =
  | {n:nat} {sz:nat} {l:addr} blocklst_cons (n+1) of
      (block_v (sz, l) | int sz, ptr l, blocklst n)
  | blocklst_nil (0)
viewtypedef blocklst = [n:nat] blocklst (n)

(* ****** ****** *)

extern typedef "blocklst_cons_pstruct" =
  blocklst_cons_pstruct (void | int, ptr, blocklst)

(* ****** ****** *)

extern fun fread_stdin_block {sz:nat} {l:addr}
  (pf: !block_v (sz, l) | sz: int sz, p: ptr l): natLte sz
  = "fread_stdin_block"

%{$

ats_int_type
fread_stdin_block (ats_int_type sz0, ats_ptr_type p0) {
  char *p ; int nread, sz ;
  p = p0; sz = sz0 ;
  while (sz > 0) {
    nread = fread (p, 1, sz, stdin) ;
    if (nread > 0) { p += nread ; sz -= nread ; continue ; }
    if (feof (stdin)) break ;
  }
  return (sz0 - sz) ;
}

%} // end of [%{$]

(* ****** ****** *)

fn fread_stdin_blocklst {sz:nat}
  (sz: int sz, tot: &int): blocklst = let
  fun loop {tot: addr} (
      pf_tot: !int @ tot |
      sz: int sz, p_tot: ptr tot, res: &blocklst? >> blocklst
    ) : void = let
    val (pf | p) = malloc_atm (sz)
    val n = fread_stdin_block (pf | sz, p); val () = !p_tot := !p_tot + n
    val () = (res := blocklst_cons {0} (pf | sz, p, ?))
    val+ blocklst_cons (_ | _, _, !res1) = res
  in
    if n < sz then begin
      !res1 := blocklst_nil (); fold@ res
    end else begin
      loop (pf_tot | sz, p_tot, !res1); fold@ res
    end // end of [if]
  end // end of [loop]
  var res: blocklst; val () = loop (view@ tot | sz, &tot, res)
in
  res
end // end of [fread_stdin_blocklst]

(* ****** ****** *)

extern fun blocklst_concat_and_free
  {n:nat} (n: int n, blks: blocklst): [l:addr] @(bytes (n) @ l | ptr l)
  = "blocklst_concat_and_free"

%{$

ats_ptr_type
blocklst_concat_and_free
  (ats_int_type tot, ats_ptr_type blks) {
  char *res0, *res, *p_blk ;
  int lft, sz ; blocklst_cons_pstruct blks_nxt ;

  lft = tot ; res0 = res = malloc_atm (tot) ;

  while (blks) {
    sz = ((blocklst_cons_pstruct)blks)->atslab_0 ;
    p_blk = ((blocklst_cons_pstruct)blks)->atslab_1 ;
    if (sz < lft) {
      memcpy (res, p_blk, sz) ;
    } else {
      memcpy (res, p_blk, lft) ; lft = 0 ; break ;
    }
    res += sz ; lft -= sz ;
    blks_nxt = ((blocklst_cons_pstruct)blks)->atslab_2 ;
    free_atm (p_blk) ; ATS_FREE (blks) ;
    blks = blks_nxt ;
  }
  return res0 ;
}

%} // end of [%{$]

(* ****** ****** *)

%{$

ats_int_type count_pattern_match
  (ats_int_type nsrc, ats_ptr_type src, ats_ptr_type pat) {
  int count ;
  pcre *re; pcre_extra *re_ex ; const char *re_e ;
  int err, re_eo, m[3], pos ;
  re = pcre_compile
    ((char*)pat, PCRE_CASELESS, &re_e, &re_eo, NULL) ;
  if (!re) exit (1) ;
  re_ex = pcre_study (re, 0, &re_e);  
  for (count = 0, pos = 0 ; ; ) {
    err = pcre_exec (re, re_ex, (char*)src, nsrc, pos, 0, m, 3) ;
    if (err < 0) break ; count += 1 ; pos = m[1] ;
  }
  return count ;
}

%} // end of [%{$]

(* ****** ****** *)

extern fun count_pattern_match {n:nat} {l:addr}
  (pf: !bytes n @ l | n: int n, p: ptr l, pat: string): int
  = "count_pattern_match"

(* ****** ****** *)

#define variants_length 9
val variants = array_make_arrsz{string} $arrsz(
  "agggtaaa|tttaccct"
, "[cgt]gggtaaa|tttaccc[acg]"
, "a[act]ggtaaa|tttacc[agt]t"
, "ag[act]gtaaa|tttac[agt]ct"
, "agg[act]taaa|ttta[agt]cct"
, "aggg[acg]aaa|ttt[cgt]ccct"
, "agggt[cgt]aa|tt[acg]accct"
, "agggta[cgt]a|t[acg]taccct"
, "agggtaa[cgt]|[acg]ttaccct"
)

// a linear list would be better, but ...
val answers: array (int, variants_length) = array_make_elt<int> (variants_length, ~1)

(* ****** ****** *)

%{^

// this is all standard and should probably go into a library
static pthread_mutex_t mutex_fin = PTHREAD_MUTEX_INITIALIZER;

ATSinline()
ats_void_type finlock_lock () {
  pthread_mutex_lock (&mutex_fin) ; return ;
}

static the_nticket ; static the_nthread ;
static pthread_mutex_t mutex_nticket = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t mutex_nthread = PTHREAD_MUTEX_INITIALIZER;

ATSinline()
ats_void_type thread_v_return () {
  int n ;
  pthread_mutex_lock (&mutex_nthread) ;
  n = the_nthread ; the_nthread = n - 1;
  pthread_mutex_unlock (&mutex_nthread) ;
  if (n == 1) {
    pthread_mutex_unlock (&mutex_fin) ; // conditional wait?
  } // end of [if]
  return ;
}

ats_int_type nticket_get () {
  int n ;
  pthread_mutex_lock (&mutex_nticket) ;
  n = the_nticket ; the_nticket = n + 1 ;
  pthread_mutex_unlock (&mutex_nticket) ;
  return n ;
}

ATSinline()
ats_void_type main_init () {
  pthread_mutex_lock (&mutex_fin) ; return ;
}

ATSinline()
ats_void_type nthread_init (ats_int_type n) {
  the_nticket = 0 ; the_nthread = n ; return ;
}

%}

absview thread_v; absview nthread_v (int)

extern fun thread_v_return
  (pf: thread_v | (*none*)): void = "thread_v_return"
extern praxi nthread_v_take {n:pos}
  (pf: !nthread_v n >> nthread_v (n-1)): thread_v
extern praxi nthread_v_elim (pf: nthread_v 0):<> void
extern fun nticket_get
  (pf: !thread_v | (*none*)): Nat = "nticket_get"
  
// [!ref] prevents it from being called in a thread
extern fun nthread_init {n:nat} (n: int n):<!ref> (nthread_v n | void)
  = "nthread_init"

(* ****** ****** *)

staload "libc/SATS/pthread.sats"

(* ****** ****** *)

#define NTHREAD variants_length // does not have be exactly the same

(* ****** ****** *)

fun count_worker {n:nat} {l:addr}
  (pf1: thread_v, pf2: bytes n @ l | n: int n, p: ptr l): void = let
  extern praxi bytes_v_elim (pf: bytes n @ l): void
  val i = nticket_get (pf1 | (*none*))
in
  case+ 0 of
  | _ when i < variants_length => let
      val () = answers[i] := count_pattern_match (pf2 | n, p, variants[i])
    in
      count_worker (pf1, pf2 | n, p)
    end // end of [_ when ...]
  | _ => let
      prval () = bytes_v_elim (pf2) in thread_v_return (pf1 | (*none*))
    end // end of [_]
end // end of [count_one]

(* ****** ****** *)

fun count_all {n:nat} {l:addr}
  (pf: !bytes n @ l | n: int n, p: ptr l): void = let
  extern praxi bytes_v_make (): bytes n @ l
  fun workerlst_gen {t:nat}
    (pf_nthread: nthread_v t | t: int t):<cloref1> void =
    if t > 0 then let
      prval pf2 = bytes_v_make ()
      prval pf1 = nthread_v_take (pf_nthread)
      var tid: pthread_t // uninitialized
      val () = pthread_create_detached_cloptr (
        lam () =<lin,cloptr1> count_worker (pf1, pf2 | n, p), tid
      ) // end of [pthread_create_detached_cloptr]
    in
      workerlst_gen (pf_nthread | t-1)
    end else begin
      let prval () = nthread_v_elim (pf_nthread) in () end
    end // end of [if]
  val (pf_nthread | ()) = nthread_init (NTHREAD)
  val () = workerlst_gen (pf_nthread | NTHREAD)  
in
  // empty
end // end of [count_all]
  
(* ****** ****** *)

fn count_print () = loop (0) where {
  fun loop {i:nat | i <= variants_length} (i: int i):<cloref1> void =
    if i < variants_length then let
      val pat = variants[i] and cnt = answers[i]
      val () = (print pat ; print ' '; print cnt ; print_newline ())
    in
      loop (i + 1)
    end // end of [if]
} // end of [count_print]

(* ****** ****** *)

datatype seglst (int) =
  | {n:nat} seglst_cons (n+1) of (int(*beg*), int(*len*), seglst n)
  | seglst_nil (0)
typedef seglst0 = seglst 0
typedef seglst = [n:nat] seglst (n)

extern typedef "seglst_cons_pstruct" =
  seglst_cons_pstruct (int, int, seglst)

extern fun seglst_cons_make
  (beg: int, len: int): seglst_cons_pstruct (int, int, seglst0?)
  = "seglst_cons_make"

implement seglst_cons_make (beg, len) = seglst_cons {0} (beg, len, ?)

extern typedef "int_ptr_type" = @(void | int, ptr)

%{$

ats_void_type subst_copy (
  char *dst, char *src, int nsrc
, seglst_cons_pstruct sgs, char *sub, int nsub
) {
  int ofs, beg, len ; seglst_cons_pstruct sgs_nxt ;
  for (ofs = 0 ; ; ) {
    if (!sgs) break ;
    beg = sgs->atslab_0 ; len = beg - ofs ;
    memcpy (dst, src, len) ; dst += len ; src += len ; ofs = beg ;
    len = sgs->atslab_1 ;
    memcpy (dst, sub, nsub) ; dst += nsub ; src += len ; ofs += len ;
    sgs_nxt = sgs->atslab_2 ; ATS_FREE (sgs); sgs = sgs_nxt ;
  }
  len = nsrc - ofs ;  memcpy (dst, src, len) ; return ;
}

int_ptr_type subst_pattern_string
  (ats_int_type nsrc, ats_ptr_type src, ats_ptr_type pat, ats_ptr_type sub) {
  char *dst ; int ndst, nsub ; int beg, len, nxt ;
  pcre *re; pcre_extra *re_ex ; const char *re_e ;
  int err, re_eo, m[3], pos ;
  seglst_cons_pstruct sgs0, sgs, *sgs_ptr ;
  int_ptr_type ans ;

  ndst = nsrc ; nsub = strlen ((char*)sub) ;
  re = pcre_compile
    ((char*)pat, PCRE_CASELESS, &re_e, &re_eo, NULL) ;
  if (!re) exit (1) ;
  re_ex = pcre_study (re, 0, &re_e);  
  for (pos = 0, sgs_ptr = &sgs0 ; ; ) {
    err = pcre_exec (re, re_ex, (char*)src, nsrc, pos, 0, m, 3) ;
    if (err >= 0) {
      beg = m[0] ; pos = m[1] ;
      len = pos - beg ; ndst -= len ; ndst += nsub ;
      sgs = (seglst_cons_pstruct)seglst_cons_make (beg, len) ;
      *sgs_ptr = sgs ; sgs_ptr = (seglst_cons_pstruct*)&(sgs->atslab_2) ;
    } else {
     *sgs_ptr = (seglst_cons_pstruct)0 ; break ;
    }
  } // end of [for]
  dst = malloc_atm (ndst) ;
  ans.atslab_1 = ndst ; ans.atslab_2 = dst ;
  subst_copy (dst, src, nsrc, sgs0, sub, nsub) ;
  return ans ;
}

%} // end of [%{$]

(* ****** ****** *)

extern
fun subst_pattern_string
  {n:nat} {l:addr} (
  pf: !bytes n @ l | n: int n, p: ptr l, pat: string, sub: string
) : [n:nat] [l:addr] @(bytes n @ l | int n, ptr l)
  = "subst_pattern_string"
// end of [subst_pattern_string]

(* ****** ****** *)

#define subst_length 22
val subst = array_make_arrsz{string} $arrsz(
  "B", "(c|g|t)"
, "D", "(a|g|t)"
, "H", "(a|c|t)"
, "K", "(g|t)"
, "M", "(a|c)"
, "N", "(a|c|g|t)"
, "R", "(a|g)"
, "S", "(c|g)"
, "V", "(a|c|g)"
, "W", "(a|t)"
, "Y", "(c|t)"
) // end of [val]

(* ****** ****** *)

fun subst_loop {i:nat} {n:nat} {l:addr}
  (pf: bytes n @ l | n: int n, p: ptr l, i: int i): int =
  if i < subst_length - 1 then let
    val pat = subst[i]; val sub = subst[i+1]
    val (pf1 | n1, p1) = subst_pattern_string (pf | n, p, pat, sub)
    val () = free_atm (pf | p)
  in
    subst_loop (pf1 | n1, p1, i + 2)
  end else begin
    let val () = free_atm (pf | p) in n end
  end // end of [if]
  
fn subst_top {n:nat} {l:addr}
  (pf: !bytes n @ l | n: int n, p: ptr l): int = let
  val pat = subst[0]; val sub = subst[1]
  val (pf1 | n1, p1) = subst_pattern_string (pf | n, p, pat, sub)
in
  subst_loop (pf1 | n1, p1, 2)
end // end of [subst_top]
  
(* ****** ****** *)

#define BLOCKSIZE 0x10000

implement main () = let
  var n0: int = 0
  val blks = fread_stdin_blocklst (BLOCKSIZE, n0)
  val n0 = int1_of_int (n0); val () = assert (n0 >= 0)
  val (pf_bytes | p0) = blocklst_concat_and_free (n0, blks)
  val (pf1_bytes | n1, p1) =
    subst_pattern_string (pf_bytes | n0, p0, ">.*|\n", "")
  val () = free_atm (pf_bytes | p0)
  val () = main_init () where {
    extern fun main_init (): void = "main_init"
  }
  val () = count_all (pf1_bytes | n1, p1)
  val n_last = subst_top (pf1_bytes | n1, p1)
  val () = finlock_lock () where {
    extern fun finlock_lock (): void = "finlock_lock"
  }
  val () = free_atm (pf1_bytes | p1)
  val () = count_print ()
in
  printf ("\n%i\n%i\n%i\n", @(n0, n1, n_last))
end // end of [main]

(* ****** ****** *)

(* end of [regex-dna_smp.dats] *)

make, command-line, and program output logs

Wed, 23 Jan 2013 00:02:49 GMT

MAKE:
/usr/local/src/ats-lang-anairiats-0.2.9/bin/atscc -D_GNU_SOURCE -D_ATS_MULTITHREAD -lpcre -lpthread -pipe -Wall -O3 -fomit-frame-pointer -march=native  regexdna.dats -o regexdna.ats-2.ats_run -lpcre
/usr/local/src/ats-lang-anairiats-0.2.9/bin/atsopt --output regexdna_dats.c --dynamic regexdna.dats
In file included from regexdna_dats.c:19:0:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/basics.cats: In function ‘atspre_fprint_newline’:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/basics.cats:271:11: warning: variable ‘n2’ set but not used [-Wunused-but-set-variable]
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/basics.cats:271:7: warning: variable ‘n1’ set but not used [-Wunused-but-set-variable]
regexdna_dats.c: At top level:
regexdna_dats.c:70:8: warning: type defaults to ‘int’ in declaration of ‘the_nticket’ [-Wimplicit-int]
regexdna_dats.c:70:29: warning: type defaults to ‘int’ in declaration of ‘the_nthread’ [-Wimplicit-int]
regexdna_dats.c: In function ‘fread_stdin_blocklst_0’:
regexdna_dats.c:327:1: warning: label ‘__ats_lab_fread_stdin_blocklst_0’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘array_ptr_initialize_elt_01308_ats_int_type’:
regexdna_dats.c:371:1: warning: label ‘__ats_lab_array_ptr_initialize_elt_01308_ats_int_type’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘array_make_elt_01347_ats_int_type’:
regexdna_dats.c:390:1: warning: label ‘__ats_lab_array_make_elt_01347_ats_int_type’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘array_set_elt_at__intsz_01356_ats_int_type’:
regexdna_dats.c:411:1: warning: label ‘__ats_lab_array_set_elt_at__intsz_01356_ats_int_type’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘array_get_elt_at__intsz_01355_ats_ptr_type’:
regexdna_dats.c:429:1: warning: label ‘__ats_lab_array_get_elt_at__intsz_01355_ats_ptr_type’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘count_worker_5’:
regexdna_dats.c:467:1: warning: label ‘__ats_lab_1_0’ defined but not used [-Wunused-label]
regexdna_dats.c:455:1: warning: label ‘__ats_lab_0_1’ defined but not used [-Wunused-label]
regexdna_dats.c:454:1: warning: label ‘__ats_lab_0_0’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘__ats_fun_10’:
regexdna_dats.c:484:1: warning: label ‘__ats_lab___ats_fun_10’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘count_all_8’:
regexdna_dats.c:581:1: warning: label ‘__ats_lab_count_all_8’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘array_get_elt_at__intsz_01355_ats_int_type’:
regexdna_dats.c:599:1: warning: label ‘__ats_lab_array_get_elt_at__intsz_01355_ats_int_type’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘count_print_11’:
regexdna_dats.c:673:1: warning: label ‘__ats_lab_count_print_11’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘seglst_cons_make’:
regexdna_dats.c:687:1: warning: label ‘__ats_lab_seglst_cons_make’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘subst_top_16’:
regexdna_dats.c:751:1: warning: label ‘__ats_lab_subst_top_16’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘mainats’:
regexdna_dats.c:787:1: warning: label ‘__ats_lab_mainats’ defined but not used [-Wunused-label]
regexdna_dats.c: In function ‘subst_pattern_string’:
regexdna_dats.c:996:46: warning: unused variable ‘nxt’ [-Wunused-variable]
In file included from regexdna_dats.c:29:0:
regexdna_dats.c: At top level:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/pointer.cats:52:14: warning: ‘atspre_null_ptr’ defined but not used [-Wunused-variable]
In file included from regexdna_dats.c:30:0:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/printf.cats:57:1: warning: ‘atspre_fprintf_err’ defined but not used [-Wunused-function]
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/printf.cats:69:1: warning: ‘atspre_fprintf_exn’ defined but not used [-Wunused-function]
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/printf.cats:105:1: warning: ‘atspre_prerrf_exn’ defined but not used [-Wunused-function]
In file included from regexdna_dats.c:33:0:
/usr/local/src/ats-lang-anairiats-0.2.9/prelude/CATS/string.cats:351:14: warning: ‘atspre_stropt_none’ defined but not used [-Wunused-variable]
regexdna_dats.c:564:1: warning: ‘workerlst_gen_9_closure_make’ defined but not used [-Wunused-function]
regexdna_dats.c:658:1: warning: ‘loop_12_closure_make’ defined but not used [-Wunused-function]
gcc -I/usr/local/src/ats-lang-anairiats-0.2.9/ -I/usr/local/src/ats-lang-anairiats-0.2.9/ccomp/runtime/ -L/usr/local/src/ats-lang-anairiats-0.2.9/ccomp/lib64/ /usr/local/src/ats-lang-anairiats-0.2.9/ccomp/runtime/ats_prelude.c -D_GNU_SOURCE -D_ATS_MULTITHREAD -lpcre -lpthread -pipe -Wall -O3 -fomit-frame-pointer -march=native regexdna_dats.c -o regexdna.ats-2.ats_run -lpcre -lats_mt -lats 
0.50s to complete and log all make actions

COMMAND LINE:
./regexdna.ats-2.ats_run 0 < regexdna-input5000000.txt

PROGRAM OUTPUT:
agggtaaa|tttaccct 356
[cgt]gggtaaa|tttaccc[acg] 1250
a[act]ggtaaa|tttacc[agt]t 4252
ag[act]gtaaa|tttac[agt]ct 2894
agg[act]taaa|ttta[agt]cct 5435
aggg[acg]aaa|ttt[cgt]ccct 1537
agggt[cgt]aa|tt[acg]accct 1431
agggta[cgt]a|t[acg]taccct 1608
agggtaa[cgt]|[acg]ttaccct 2178

50833411
50000000
66800214

Home Conclusions License Play

x64 Ubuntu : Intel® Q6600® one coreComputer Language Benchmarks Game [[ Play ]]

performance measurements

notes

regex-dna ATS #2 program source code

make, command-line, and program output logs

x64 Ubuntu : Intel® Q6600® one core
Computer Language Benchmarks Game [[ Play ]]