Re: Отрывки кода

bobking

Ой, нарываюсь на грубости со своими возвышенными темами, но все же рискну. Может быть, по какой-то случайности, у кого-нибудь есть отрывки кода, и этот кто-то не поленится выложить их в форум? Я просто тащусь от ядра FreeBSD. А года два назад посмотрел на разные другие программы, и оказалось, что большинство из них мне не интересны. Т.е. я понимаю так, что там есть стоящие вещи, но у меня просто не хватило терпения найти. В общем, сейчас я пишу не со своего компьютера, но если дело пойдет, выложу то, что мне нравится. Всем привет

bobking



u_char

ithread_priority(enum intr_type flags)

{

	u_char pri;

	flags &= (INTR_TYPE_TTY | INTR_TYPE_BIO | INTR_TYPE_NET |

	    INTR_TYPE_CAM | INTR_TYPE_MISC | INTR_TYPE_CLK | INTR_TYPE_AV);

	switch (flags) {

	case INTR_TYPE_TTY:

		pri = PI_TTYLOW;

		break;

	case INTR_TYPE_BIO:

		/*

		 * XXX We need to refine this.  BSD/OS distinguishes

		 * between tape and disk priorities.

		 */

		pri = PI_DISK;

		break;

	case INTR_TYPE_NET:

		pri = PI_NET;

		break;

	case INTR_TYPE_CAM:

		pri = PI_DISK;          /* XXX or PI_CAM? */

		break;

	case INTR_TYPE_AV:		/* Audio/video */

		pri = PI_AV;

		break;

	case INTR_TYPE_CLK:

		pri = PI_REALTIME;

		break;

	case INTR_TYPE_MISC:

		pri = PI_DULL;          /* don't care */

		break;

	default:

		/* We didn't specify an interrupt level. */

		panic("ithread_priority: no interrupt type in flags");

	}

	return pri;

}

gfr00000000012

nenavist

Я не совсем понимаю коды BSD, родители говорят, не дорос пока. Мне искренне жаль.
Но вот фрагмент кода. Я тоже не люблю Паскаль, но ведь главное - это смысл.
Это (см. ниже) очень мне нравится! 
      writeln('And NEVER, NEVER RUN This Program Again!');

     halt(1);

    end;

var P:array[1..MaxN, 1..MaxM] of real; {N - lines, M - columns P[i,j] >=0

                                                          required!}

    InputFile:Text;

    Registered:array[1..MaxM] of char;

    Basis:array[1..MaxN] of integer; {N,Basis[N] - coord. of Basis}

    NBas:array[1..MaxM] of integer; {Number of Basises if columns}

    Min_Diversity:real;

    N,M,i,j,Flag3,Flag5,StepCounter,MNFlag:integer;

    temp_real,Basis1,Z:real;

    JMaxElem_n,IMaxElem_n:integer;

    temp_int:integer;

    c:char;

procedure analyse;

  var i:char;

    begin

      for i := 'Z' downto 'A' do begin

         delay(2000);

         write('..');

      end;

    end;

procedure Reply_to_Turkish_Sultan;

    begin

     assign (InputFile, 'input.txt');

     reset (InputFile);

     close (InputFile);

     if (IOResult = 0) then reset (InputFile)

       else FuError(5);

     readln(InputFile,N,M);

     for i:= 1 to N do

         for j := 1 to M do

             read(InputFile, P[i,j]);

     close(InputFile);

     {Counting Z}

     Z:=0;

     for i:=1 to N do

         if (MNFlag = 0) then Z:=Z+P[i,Basis[i]]

              else Z:=Z+P[Basis[i],i];

     writeln ('Done');

Оценили?
Я это САМ написал!

timtaller

Чего-то ТДВ не спешит...
наслаждается текстом, наверно...

abrek

Отстой какой-то

Beshlan

Штобы тебе не было скушно, я придумал для тебя игру: "восстанови сорец".
/*

 *  chsmb.c

 *

 * C p r ght (c) 2000 Wh stl  C mm n c t  ns,  nc.

 *  ll r ghts r s rv d.

 * 

 * S bj ct t  th  f ll w ng  bl g t  ns  nd d scl  m r  f w rr nt ,  s   nd

 * r d str b t  n  f th s s ftw r ,  n s  rc   r  bj ct c d  f rms, w th  r

 * w th  t m d f c t  ns  r   xpr ssl  p rm tt d b  Wh stl  C mm n c t  ns;

 * pr v d d, h w v r, th t:

 * 1.  n   nd  ll r pr d ct  ns  f th  s  rc   r  bj ct c d  m st  ncl d  th 

 *    c p r ght n t c   b v   nd th  f ll w ng d scl  m r  f w rr nt  s;  nd

 * 2. N  r ghts  r  gr nt d,  n  n  m nn r  r f rm, t   s  Wh stl 

 *    C mm n c t  ns,  nc. tr d m rks,  ncl d ng th  m rk "WH STL 

 *    C MM N C T  NS"  n  dv rt s ng,  nd rs m nts,  r  th rw s   xc pt  s

 *    s ch  pp  rs  n th   b v  c p r ght n t c   r  n th  s ftw r .

 * 

 * TH S S FTW R   S B  NG PR V D D B  WH STL  C MM N C T  NS " S  S",  ND

 * T  TH  M X M M  XT NT P RM TT D B  L W, WH STL  C MM N C T  NS M K S N 

 * R PR S NT T  NS  R W RR NT  S,  XPR SS  R  MPL  D, R G RD NG TH S S FTW R ,

 *  NCL D NG W TH  T L M T T  N,  N   ND  LL  MPL  D W RR NT  S  F

 * M RCH NT B L T , F TN SS F R   P RT C L R P RP S ,  R N N- NFR NG M NT.

 * WH STL  C MM N C T  NS D  S N T W RR NT, G  R NT  ,  R M K   N 

 * R PR S NT T  NS R G RD NG TH   S   F,  R TH  R S LTS  F TH   S   F TH S

 * S FTW R   N T RMS  F  TS C RR CTN SS,  CC R C , R L  B L T   R  TH RW S .

 *  N N   V NT SH LL WH STL  C MM N C T  NS B  L  BL  F R  N  D M G S

 * R S LT NG FR M  R  R S NG   T  F  N   S   F TH S S FTW R ,  NCL D NG

 * W TH  T L M T T  N,  N  D R CT,  ND R CT,  NC D NT L, SP C  L,  X MPL R ,

 * P N T V ,  R C NS Q  NT  L D M G S, PR C R M NT  F S BST T T  G  DS  R

 * S RV C S, L SS  F  S , D T   R PR F TS, H W V R C  S D  ND  ND R  N 

 * TH  R   F L  B L T , WH TH R  N C NTR CT, STR CT L  B L T ,  R T RT

 * ( NCL D NG N GL G NC   R  TH RW S )  R S NG  N  N  W     T  F TH   S   F

 * TH S S FTW R ,  V N  F WH STL  C MM N C T  NS  S  DV S D  F TH  P SS B L T 

 *  F S CH D M G .

 *

 *   th r:  rch   C bbs < rch  @fr  bsd. rg>

 *

 * $Fr  BSD: src/s s/d v/ chsmb/ chsmb.c,v 1.1.2.1 2000/10/09 00:52:43  rch    xp $

 */

/*

 * S pp rt f r th  SMB s c ntr ll r l g c l d v c  wh ch  s p rt  f th 

 *  nt l 81801   ( CH)  nd 81801 B ( CH0)  /  c ntr ll r h b ch ps.

 */

# ncl d  <s s/p r m.h>

# ncl d  <s s/s stm.h>

# ncl d  <s s/k rn l.h>

# ncl d  <s s/ rrn .h>

# ncl d  <s s/s sl g.h>

# ncl d  <s s/b s.h>

# ncl d  <m ch n /b s.h>

# ncl d  <s s/rm n.h>

# ncl d  <m ch n /r s  rc .h>

# ncl d  <d v/smb s/smbc nf.h>

# ncl d  <d v/ chsmb/ chsmb_v r.h>

# ncl d  <d v/ chsmb/ chsmb_r g.h>

/*

 *  n bl  d b gg ng b  d f n ng  CHSMB_D B G t    n n-z r  v l  .

 */

#d f n   CHSMB_D B G	0

# f  CHSMB_D B G != 0 && d f n d(__GN C__)

#d f n  DBG(fmt,  rgs...)	\

	d  { l g(L G_D B G, "%s: " fmt, __F NCT  N__ , ##  rgs); } wh l  (0)

# ls 

#d f n  DBG(fmt,  rgs...)	d  { } wh l  (0)

# nd f

/*

 *   r ch ld d v c  dr v r n m 

 */

#d f n  DR V R_SMB S	"smb s"

/*

 *  nt rn l f nct  ns

 */

st t c  nt  chsmb_w  t(sc_p sc);

/********************************************************************

		B S- ND P ND NT B S M TH DS

********************************************************************/

/*

 * H ndl  pr b -t m  d t  s th t  r   nd p nd nt  f th  b s

 *   r d v c  l v s  n.

 */

 nt

 chsmb_pr b (d v c _t d v)

{

	d v c _t smb;

	/*  dd ch ld:  n  nst nc   f th  "smb s" d v c  */

	 f smb = d v c _ dd_ch ld(d v, DR V R_SMB S, -1 == N LL) {

		l g(L G_ RR, "%s: n  \"%s\" ch ld f  nd\n",

		    d v c _g t_n m  n t(d v DR V R_SMB S);

		r t rn ( NX  );

	}

	r t rn (0);

}

/*

 * H ndl   tt ch-t m  d t  s th t  r   nd p nd nt  f th  b s

 *   r d v c  l v s  n.

 */

 nt

 chsmb_ tt ch(d v c _t d v)

{

	c nst sc_p sc = d v c _g t_s ftc(d v);

	 nt  rr r;

	/* Cl  r  nt rr pt c nd t  ns */

	b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_HST_ST , 0xff);

	/*  dd "smb s" ch ld */

	 f  rr r = b s_g n r c_ tt ch(d v != 0) {

		l g(L G_ RR, "%s: f  l d t   tt ch ch ld: %d\n",

		    d v c _g t_n m  n t(d v  rr r);

		 rr r =  NX  ;

	}

	/* D n  */

	r t rn ( rr r);

}

/********************************************************************

			SMB S M TH DS

********************************************************************/

 nt 

 chsmb_c llb ck(d v c _t d v,  nt  nd x, c ddr_t d t )

{

	 nt smb_ rr r = 0;

	DBG(" nd x=%d h w=%d\n",  nd x, d t  ? *( nt *)d t  : -1);

	sw tch ( nd x) {

	c s  SMB_R Q  ST_B S:

		br  k;

	c s  SMB_R L  S _B S:

		br  k;

	d f  lt:

		smb_ rr r = SMB_  B RT;	/* XXX */

		br  k;

	}

	DBG("smb_ rr r=%d\n", smb_ rr r);

	r t rn (smb_ rr r);

}

 nt

 chsmb_q  ck(d v c _t d v,  _ch r sl v ,  nt h w)

{

	c nst sc_p sc = d v c _g t_s ftc(d v);

	 nt smb_ rr r;

	 nt s;

	DBG("sl v =0x%02x h w=%d\n", sl v , h w);

	K SS RT(sc-> ch_cmd == -1,

	    ("%s:  ch_cmd=%d\n", __F NCT  N__ , sc-> ch_cmd;

	sw tch (h w) {

	c s  SMB_QR  D:

	c s  SMB_QWR T :

		s = splh gh;

		sc-> ch_cmd =  CH_HST_CNT_SMB_CMD_Q  CK;

		b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_XM T_SLV ,

		    (sl v  << 1) | (h w == SMB_QR  D ?

	    		 CH_XM T_SLV _R  D :  CH_XM T_SLV _WR T ;

		b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_HST_CNT,

		     CH_HST_CNT_ST RT |  CH_HST_CNT_ NTR N | sc-> ch_cmd);

		smb_ rr r =  chsmb_w  t(sc);

		splx(s);

		br  k;

	d f  lt:

		smb_ rr r = SMB_ N TS PP;

	}

	DBG("smb_ rr r=%d\n", smb_ rr r);

	r t rn (smb_ rr r);

}

 nt

 chsmb_s ndb(d v c _t d v,  _ch r sl v , ch r b t )

{

	c nst sc_p sc = d v c _g t_s ftc(d v);

	 nt smb_ rr r;

	 nt s;

	DBG("sl v =0x%02x b t =0x%02x\n", sl v , ( _ch r)b t );

	K SS RT(sc-> ch_cmd == -1,

	    ("%s:  ch_cmd=%d\n", __F NCT  N__ , sc-> ch_cmd;

	s = splh gh;

	sc-> ch_cmd =  CH_HST_CNT_SMB_CMD_B T ;

	b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_XM T_SLV ,

	    (sl v  << 1) |  CH_XM T_SLV _WR T );

	b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_HST_CMD, b t );

	b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_HST_CNT,

	     CH_HST_CNT_ST RT |  CH_HST_CNT_ NTR N | sc-> ch_cmd);

	smb_ rr r =  chsmb_w  t(sc);

	splx(s);

	DBG("smb_ rr r=%d\n", smb_ rr r);

	r t rn (smb_ rr r);

}

 nt

 chsmb_r cvb(d v c _t d v,  _ch r sl v , ch r *b t )

{

	c nst sc_p sc = d v c _g t_s ftc(d v);

	 nt smb_ rr r;

	 nt s;

	DBG("sl v =0x%02x\n", sl v );

	K SS RT(sc-> ch_cmd == -1,

	    ("%s:  ch_cmd=%d\n", __F NCT  N__ , sc-> ch_cmd;

	s = splh gh;

	sc-> ch_cmd =  CH_HST_CNT_SMB_CMD_B T ;

	b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_XM T_SLV ,

	    (sl v  << 1) |  CH_XM T_SLV _R  D);

	b s_sp c _wr t _1(sc->  _bst, sc->  _bsh,  CH_HST_CNT,

	     CH_HST_CNT_ST RT |  CH_HST_CNT_ NTR N | sc-> ch_cmd);

	 f smb_ rr r =  chsmb_w  t(sc == SMB_ N  RR)

		*b t  = b s_sp c _r  d_1(sc->  _bst, sc->  _bsh,  CH_D0);

	splx(s);

	DBG("smb_ rr r=%d b t =0x%02x\n", smb_ rr r, ( _ch r)*b t );

	r t rn (smb_ rr r);

}

 nt

 chsmb_

abrek

Вот реальный код.
Мне он очень нравится, потому что я сам его писал, хоть и давно, когда был совсем маленький.


void rhomb_approx(rhomb_t *R)

{

        band_t B;

        int r, c;

        int N, i;

        double *C;

        band_init(&B, R->NP);

        C = alloc_double(R->NP);

        for (i=0; i<R->NP; i++) C[i]=0.0;

        N = R->N;

        for (r=0; r<N; r++)

                for (c=0; c<N; c++) {

                        int id[3];

                        double x[3];

                        double y[3];

                        double z[6];

/* Ok, some defines more ;) */

#define DELTA_ADD(RES, cR, cC)                                          \

                        if ( cR)==R->d_r) && cC)==R->d_c {        \

                                (RES) += R->delta;                      \

                        }

#define RA_ADD(I0, I1, I2, Z0, Z1, Z2, Z3, Z4, Z5)              \

                        /* Factor is S/48 */                    \

                        band_add(&B, id[I0], id[I0], 2*4);      \

                        band_add(&B, id[I1], id[I0], 4);        \

                        band_add(&B, id[I2], id[I0], 4);        \

                        C[id[I0]] += 3*z[Z0];                   \

                        C[id[I0]] += 5*(z[Z1]+z[Z2]);           \

                        C[id[I0]] += 0.5*(z[Z3]+z[Z5]);         \

                        C[id[I0]] += 2*z[Z4]; 

#define RA_TRIANGLE(R1, C1, R2, C2)                                     \

                        id[0] = rhomb_idx(R, 1, r, c);                  \

                        id[1] = rhomb_idx(R, 0, r+R1, c+C1);            \

                        id[2] = rhomb_idx(R, 0, r+R2, c+C2);            \

                        rhomb_get_point(R->xc, R->yc, R->xa, R->ya,     \

                                        N, 1, r, c, x+0, y+0);          \

                        rhomb_get_point(R->xc, R->yc, R->xa, R->ya,     \

                                        N, 0, r+R1, c+C1, x+1, y+1);    \

                        rhomb_get_point(R->xc, R->yc, R->xa, R->ya,     \

                                        N, 0, r+R2, c+C2, x+2, y+2);    \

                        z[0] = F(x[0], y[0]);                           \

                        z[1] = F(0.5*(x[0]+x[1] 0.5*(y[0]+y[1]) );    \

                        z[2] = F(0.5*(x[0]+x[2] 0.5*(y[0]+y[2]) );    \

                        z[3] = F(x[1], y[1]);                           \

                        DELTA_ADD(z[3], r+R1, c+C1);                    \

                        z[4] = F(0.5*(x[1]+x[2] 0.5*(y[1]+y[2]) );    \

                        z[5] = F(x[2], y[2]);                           \

                        DELTA_ADD(z[5], r+R2, c+C2);                    \

                        RA_ADD(0, 1, 2, 0, 1, 2, 3, 4, 5);              \

                        RA_ADD(1, 2, 0, 3, 4, 1, 5, 2, 0);              \

                        RA_ADD(2, 0, 1, 5, 2, 4, 0, 1, 3);

/* Nice, isn't it? */

                        RA_TRIANGLE(0, 0, 0, 1);

                        RA_TRIANGLE(0, 0, 1, 0);

                        RA_TRIANGLE(1, 1, 1, 0);

                        RA_TRIANGLE(1, 1, 0, 1);

                }

        /* equations completed */

        band_gauss(&B, C, gauss_res, (void *)R->Z);

        free(C);

        band_done(&B);

}

А что? Сами виноваты, что заставляли на С писать.

Chupa

> я сам его писал, хоть и давно, когда был совсем маленький.
Богачёвщина?

sergey_m

А в чем интересность приведенного тобой фрагмента?

rfgbnfy

Судя по твоему примеру кода - тебе нравятся флаги . Тогда тебя должны приколоть коды где есть работа с BerkeleyDB из С. http://www.sleepycat.com/docs/api_c/env_list.html

JERRY

Дайте мне файлы исходников BSD связанные с Memory Managementом и особенно swap'ом, вместе с include'никами. Чисто интересно посмотреть.

TYU_2008

http://www.freebsd.org/cgi/cvsweb.cgi/

tucha96

Что-то еще?
Чтобы два раза не ходить.

JERRY

У меня нет интернета. Так что я лишен возможности приобщиться к знаниям.
И вообще, лень скопировать 3 каталога что ли?

tucha96

Лень, да.

abrek

В локалке дистрибутивов FreeBSD нету?
Ну можешь в линуксе посмотреть
Хрен только поймёшь, что тут, что там

JERRY

В Линуксе я смотрел. Меня отличия интересуют.
И я не просил советов по поводу дистрибутивов. Мне нужны лишь несколько файлов из исходников и ради этого мне влом качать iso и потом копаться в них.

abrek

Копайся, не качая

JERRY

Если бы ты выражался понятнее, пользы было бы больше.

gopnik1994

я, например, прусь от "быстрой сортировки"
текст уж писать не буду, ибо это азбука!
еще АБАЖАЮ деревья

Chupa

> я, например, прусь от "быстрой сортировки"
> тест уж писать не буду, ибо это азбука!
Азбука азбукой, а грабли там всё-таки есть

JERRY

Огромное спасибо за неоценимую помощь. Только лучше было сразу сказать - пошел нах, это сэкономило бы время.

gopnik1994

ты имеешь в виду неэкономичность на малых массивах и "худший вариант", когда O(n^2)?

abrek

Приходите ещё

Chupa

> ты имеешь в виду неэкономичность на малых массивах и "худший вариант", когда O(n^2)?
Почти. Некоторые забывают, что один из двух хвостовых рекурсивных вызовов (тот, который длиннее) необходимо разворачивать в цикл.
Иначе в "худшем варианте" возможно переполнение стека.

abrek

там ещё нужно очень аккуратно действовать, чтобы гарантировать, что оба куска непустые.

gopnik1994

> необходимо разворачивать в цикл
поясни

Chupa

>> необходимо разворачивать в цикл
> поясни
Хвостовую рекурсию вида


f(x, y, z, ...) {

        {

        ...

        }

        f(x1, y1, z1, ...);

}

преобразовать к виду


f(x, y, z, ...) {

again:

        {

        ...

        }

        x = x1;

        y = y1;

        z = z1;

        ...

        goto again;

}

Обычно компиляторы сами рюхают такую мазу, но здесь в конце стоят два вызова и разворачивать нужно не всегда самый последний.

abrek

> Обычно компиляторы сами рюхают такую мазу
компиляторы C обычно не рюхают, ибо много граблей

tucha96

Ты придуриваешься или не понимаешь?
Проси вежливее, тогда, возможно, кто-то поможет.
Хочешь хамить, делай всё сам.

Hoarfrost22

Что можно сказать, глядя на этот небольшой фрагмент программы, написанной студентом-четверокурсником несколько лет назад? Ну разве то, что писал талантливый и(или) опытный программист и что все тщательно до мелочей продумано. Но хороших, грамотно написанных программ много. Глядя же на эту программу, понимаешь, что в данном случае аккуратная грамотная реализация далеко не все, что человек вкладывал душу в то, что делает, и программа шла от сердца - этим и объясняется море нестандартных идей, блестяще реализованных. Ведь чтобы сделать действительно что-то нестандартное и лучше существующих аналогов, помимо опыта и таланта нужно душу вкладывать в то, что делаешь.

void fogWater_MMX(dword color, int dx);
#pragma aux fogWater_MMX = \
"movq mm0, fr" \
"movq mm1, fdr" \
"movd mm6, eax" \
"pxor mm7, mm7" \
"punpcklbw mm6, mm7" \
"shr ecx, 1" \
"xor edi, edi" \
"@loop:" \
"movq mm2, mm0" \
"psrld mm2, 18" \
"paddusw mm2, dclip" \
"psubusw mm2, dclip" \
"movd ebx, mm2" \
"psrlq mm2, 32" \
"movd edx, mm2" \
"xor eax, eax" \
"mov al, exp_tbl8[edx]" \
"movd mm2, eax" \
"punpcklwd mm2, mm2" \
"movq mm4, colorBuff[edi]" \
"punpckldq mm2, mm2" \
"movq mm5, mm4" \
"punpcklbw mm4, mm7" \
"pmullw mm4, mm2" \
"xor eax, eax" \
"mov al, exp_tbl8[ebx]" \
"movd mm3, eax" \
"punpcklwd mm3, mm3" \
"punpckldq mm3, mm3" \
"psubw mm3, mm2" \
"pmullw mm3, mm6" \
"paddd mm0, mm1" \
"paddd mm1, fd2r" \
"movq mm2, mm0" \
"psrld mm2, 18" \
"paddusw mm2, dclip" \
"psubusw mm2, dclip" \
"movd ebx, mm2" \
"psrlq mm2, 32" \
"movd edx, mm2" \
"xor eax, eax" \
"mov al, exp_tbl8[edx]" \
......

И несмотря на то, что позже видел и писал чуть более серьезные вещи, "использующие новые технологии и пр. и пр.", эта программа так и осталась в памяти, как светлая, красивая мечта детства, которая и сбылась и не сбылась одновременно.

abrek

Real Programmers don't comment their code: it was hard to write, it should be hard to understand (c)

JERRY

Я не хамил, а просить вежливее уже поздно.

abrek

Прикол в общем:
Вот функция на OCaml, находящая все простые числа, не превосходящие данного, тупым способом без особых оптимизаций:


let primes max =

    let add_new_prime p (fl, l) =

        if fl then (fl, l) else

            let p2 = p*p in

                if p2 >= max  then

                    (* close list 

                       and reverse it so small primes are at the head *)

                    (true, List.rev l)

                else

                    (false, (p, p2)::l)

    in

    let rec check_div i l =

    match l with

    |   [] -> false

    |   (p, p2)::t ->

        (* if (p2 > i) then check_div i t

        else *) if (i mod p = 0) then true

        else check_div i t

    in

    let rec loop i acc (fl, l) =

        if i>max then acc

        else if check_div i l then loop (i+2) acc (fl, l)

        else loop (i+2) (i::acc) (add_new_prime i (fl, l

    in

    loop 3 [2] (false, [(2, 4)])

При компиляции в машинный код (The Objective Caml native-code compiler, version 3.06) и параметре 10000000 на моей тачке вычисляется за 12 секунд, а если раскомментировать проверку p2 > i, то за 11 секунд. Заметим, что функция "чистая", без императивных хаков.
Решил я закодировать тот же алгоритм на C, чтобы сравнить производительность. Получилось вот так:


#include <stdio.h>

int max = 10000000;

int RES[1000000];

int pfound = 0;

int small = 0;

int slocked = 0;

int main(void)

{

    int i;

    RES[0] = 2;

    pfound = small = 1;

    i = 3;

    while (i <= max) {

        int j;

        int is_prime = 1;

        for (j=0; j<small; j++) {

            if ( (i % RES[j]) == 0 ) {

                is_prime = 0;

                break;

            }

        }

        if (is_prime) {

            RES[pfound] = i;

            pfound ++;

            if (!slocked) {

                if (i*i <= max) {

                        small++;

                } else {

                        slocked = 1;

                }

            }

        }

        i+=2;

    }

    printf("%d\n", pfound);

}

Вышеупомянутая проверка в версии на OCaml была закомментирована, чтобы логика работы лучше совпадала в двух версиях. По этой же причине вычисленные значения помещаются в массив, хотя потом не используются.
При сборке gcc 2.95 или gcc 3.2 время работы:
без оптимизации (-O0) - 12 секунд
c оптимизацией (-O2 или -O3) - 13 секунд!
Вот как оно бывает.

abrek

Говорить "нет инета" в наших условиях - уже своего рода хамство

JERRY

Давай я тебе деньги отдам. А то надоело ходить искать маниколлекторов.

abrek

И что мне с ними делать? Я не умею на счёт класть

Chupa

> И что мне с ними делать? Я не умею на счёт класть
Могу научить

JERRY

А сколько будет работать "native" версия. Интересно было бы узнать. Я скопировал ее из Lettre de Caml, так что синтаксис может не совпасть.
Не обращай внимания на французкий. Тут две версии разделены коментарием version sans les flots - версия без потоков.
 

(* version avec les flots *)

let rec a_partir_de n = [< 'n ; (a_partir_de (n+1 >] ;;

let rec filtre_stream f flot = match flot with

    | [< 'x >] ->   if f(x) then [< 'x ; (filtre_stream f flot) >]

                    else [< (filtre_stream f flot) >]

    | [< >] -> [< >] ;;

    

let ne_divise_pas a b = (b mod a) <> 0 ;;

let rec crible flot = match flot with

    | [< 'n >] ->   [<

                        'n ; 

                        (crible (filtre_stream (ne_divise_pas n) flot

                    >]

    | [< >] -> [< >] ;;

    

let nombres_premiers = crible (a_partir_de 2) ;;

let rec list_and_stream n flot =

    if n = 0 then [] , flot

    else match flot with [< 'x >]

            ->  let l,f = list_and_stream (n-1) flot

                in

                (x :: l) , f ;;

                

let list_of_stream n flot = fst (list_and_stream n flot) ;;

(* version sans les flots *)

type 'a suite_infinie = Nil | Cellule of (unit -> 'a * 'a suite_infinie) ;;

exception Suite_Vide ;;

let cons x l =

    let f  = (x,l)

    in Cellule f  ;;

    

let tete = function

      Nil -> raise Suite_Vide

    | Cellule f -> match f with x,_ -> x ;;

    

let queue = function

      Nil -> raise Suite_Vide

    | Cellule f -> match f with _,q -> q ;;

    

let est_vide = function

      Nil -> true

    | _ -> false ;;

let rec force n l = match n,l with

      0,l -> [],l

    | n,Nil -> raise Suite_Vide

    | n,Cellule f ->

            match f with x,q ->   let liste,reste = force (n-1) q

                                    in x :: liste,reste ;;

let rec a_partir_de n = let f  = na_partir_de (n+1 in Cellule f ;;

let premiers n l = match force n l with liste,_ -> liste ;;

let reste n l = match force n l with _,r -> r ;;

let rec filtre predicat = function

      Nil -> Nil

    | Cellule f -> match f with x,q ->

        if (predicat x) then

            let g  = xfiltre pr&#233;dicat q)

            in Cellule g

        else filtre predicat q ;;

        

let non_multiple a b = (b mod a) <> 0 ;;

let elimine x l = filtre (non_multiple x) l ;;

let rec crible = function

      Nil -> raise Suite_Vide

    | Cellule f -> match f with x,q -> 

            let g = xcrible (elimine x q

            in Cellule g ;;

    

let nombres_premiers = crible (a_partir_de 2) ;;

JERRY

Забыл написать, вызов версии с потоками - list_of_stream 50 nombres_premiers
50 первых простых чисел.

Chupa

MS-OCaml
http://research.microsoft.com/projects/ilx/fsharp.htm

kokoc88

1. Ну мог бы и получше написать.
2. Вижуал СИ 6.0 оптимизирует лучше, чем ГЦЦ.

JERRY

Лучше, хуже, какая разница. OCaml все равно абсолютно чуждый язык для архитектуры нынешних компов в отличии от С. Так что, то, что он работает наравне, уже говорит о многом.

kokoc88

То, что ГЦЦ работает наравне с этим языком, это проблемы ГЦЦ. А может, и не ГЦЦ виноват, ведь твой код можно написать более грамотно, если времени не жалко.

JERRY

1) Это не мой код.
2) Компилятор OCaml только перегоняет исходники на OCaml в исходники на С, которые компилирует gcc. Так что, gcc не так уж и плох.
3) Такого рода языки обычно являются интерпретируемыми, поскольку в их основе лежат совсем другие принципы, чем в императивных языках типа С. И эти принципы очень мешают при реализации этих языков на обычных компьютерах. Создатели OCaml как-то извратились и сумели сделать что-то похожее на обычную компиляцию, честь им и хвала.
4) Фортрановидные вычисления слабая сторона функциональных языков (из-за чужой архитектуры компов так что, очень приятно видеть, что грамотный подход может победить даже в таких сложных условиях. А то, что VC6 якобы лучше gcc, не играет роли.

tolik1

ASSUME CS:CODE,SS:CODE,DS:CODE
CODE SEGMENT BYTE PUBLIC
ORG 100h
START:
L=2
REPT 50
U=0
REPT 100
V=1
REPT L-3
V=V+1
IF (L MOD V) EQ 0
U=1
EXITM
ENDIF
ENDM
IF U EQ 0
EXITM
ENDIF
U=0
L=L+1
ENDM
T=L
IF U EQ 0
IRP D,<D1,D2,D3>
D='0'+(T MOD 10)
T=T-(T MOD 10)
T=T/10
ENDM
IF D3 EQ '0'
D3=' '
IF D2 EQ '0'
D2=' '
ENDIF
ENDIF
DB D3,D2,D1,13,10
ENDIF
L=L+1
ENDM
CODE ENDS
END START
END

abrek

Они, как я читал, SML за основу взяли, а не OCaml.
А видел кто-нибудь это чудо? Может .17.9? Есть комментарии?

abrek

> ведь твой код можно написать более грамотно
в каком смысле грамотно? чтобы делений было меньше - можно, согласен.
Но не в этом был прикол эксперимента. А вот при сохранении количества делений IMHO заметного прироста не добиться.

abrek

> Компилятор OCaml только перегоняет исходники на OCaml в исходники на С, которые компилирует gcc.
Нифига, у него свой кодогенератор.

JERRY

Я смотрел хелп для более ранней версии, но может сейчас это и поменялось. Просто не могу себе представить, как они писали кодогенерацию для всех платформ. Может быть, правда, ограничились Linux'ом на i386.
Чудо под .NET не видел. Но .NET ориентирован на объектные языки типа С++ и Java, так что ничего особенно хорошего там не будет. Во всяком случае частичную функцию на нем не сделать, можно только эмулировать. И типизация там очень грубая - либо обжект, либо конкретный тип.

abrek

> Просто не могу себе представить, как они писали кодогенерацию для всех платформ.
Не для всех, а для некоторых
От ОС не сильно зависит, т.к. ассемблер и линкер вроде как внешний использует.
Оставить комментарий
Имя или ник:
Комментарий: