Помощь - Поиск - Пользователи - Календарь
Полная версия: Простые числа - многопоточная реализация
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
-Yupi-
Есть два процесса - один производит простые числа и заносит в буфер, другой выводит их на экран. Вроде бы все правильно, посмотрите пожалуйста почему все зависает.. буду очень благодарна.

q:=3, w:=1;

procedure in_buf;
var j : word;
begin
  if free>0 then
    begin
    For j:=2 to q-1 do
      If (q mod j) = 0 then
      begin
	inc (q);
      end;
      inc (w);
    for j:=w downto 2 do Buffer_Sqrt[j]:=Buffer_Sqrt[j-1];
    Buffer_Sqrt[1]:=w;
    inc(w);
    end;
end;
procedure out_buf;
begin
  if ((Free<max) and (free<>max)) then
    Begin
      if buf_x>60 then begin buf_x:=45;inc(buf_y); end;
      if buf_y=21 then buf_y:=15;
      i:=max-Free;
      GotoXY(buf_x,buf_y);
      Write(Buffer_Sqrt[i]:4);
      Free:=Free+1;
      buf_x:=buf_x+4;
      Delay(10);
    End;
end;


Может проблема более глобальная? Если так то покажу всю прогу..
Всем заранее спасибо.

 ! 
-Yupi-, заголовок темы должен быть информативным (правила, п.1)

Michael_Rybak
Конечно, выкладывай весь код.
мисс_граффити
 if ((Free<max) and (free<>max)) then

можно в 2 словах, чем обусловлено написание такого интересного условия?
    For j:=2 to q-1 do
      If (q mod j) = 0 then
      begin
inc (q);
      end;

при изменении q границы цикла не меняются...

шаманство с w вообще не поняла sad.gif

возможно, выложенный полный код прояснит ситуацию.
Гость
Вот полный код...

uses dos,crt;
const max=20;
var s_x,s_y : byte;
    ver,gor : boolean;
    time_y,time_x : byte;
    cnt,cnt2, free : integer;
    Buffer_Sqrt: Array [1..max] Of word;
    buf_x,buf_y : byte;
    i : integer;
    oldklava,Oldhandler:procedure;
    diskret,time1 : integer;
    w,q,temp_sec,h, m, sec, Sec100 : Word;
    cod1,cod2,cod3,cod4, speed_ob,speed_str,rez,rez2 : integer;
    ox,oy,count1,count2 : integer;
    n1,n2,n3,n4 : integer; {znachenie diskreta}
    cs,in_b,out_b,exit1,clock,stroka,objekt : boolean;
    time_v : array[1..4] of byte;
procedure error;
begin
     clrscr;
     writeln ('”(r)а¬ в ўлў(r)¤ : turbo.exe [p1] [p2] [p3] [p4]');
     writeln;
     writeln ('p1:  ‚лў(r)¤ ЎҐЈгйҐ(c) бва(r)ЄЁ ўўҐаег нЄа ­  ');
     writeln ('      1  ўўҐаег нЄа ­  ');
     writeln ('  other  ў­Ё§г  нЄа ­  ');
     writeln ('p2: — бл Ї(r) X');
     writeln ('      1  ўўҐаег нЄа ­  ');
     writeln ('  other  ў­Ё§г  нЄа ­  ');
     writeln ('p3: — бл Ї(r) Y');
     writeln ('      1  ўўҐаег нЄа ­  ');
     writeln ('  other  ў­Ё§г  нЄа ­  ');
     writeln ('p4:      ‡­ 祭ЁҐ ¤ЁбЄаҐв ');
     writeln;
     writeln ('ЏаЁ¬Ґа: turbo 0 1 1 1');
end;
procedure klava;
interrupt;
begin
     if port[$60]=59 then
	{F1}
	 if (clock) then
	   begin
	     clock:=(not clock);
	     gotoxy(59,6);
	     write('off');
	   end
	 else
	   begin
	     clock:=true;
	     gotoxy(59,6);
	     write('on  ');
	   end;
     if port[$60]=60 then
	{F2}
	 if (stroka) then
	   begin
	     stroka:=(not stroka);
	     gotoxy(59,7);
	     write('off');
	   end
	 else
	   begin
	     stroka:=true;
	     gotoxy(59,7);
	     write('on  ');
	   end;
     if port[$60]=61 then
	{F3}
	 if (objekt) then
	   begin
	     objekt:=(not objekt);
	     gotoxy(59,8);
	     write('off');
	   end
	 else
	   begin
	     objekt:=true;
	     gotoxy(59,8);
	     write('on  ');
	   end;
     if port[$60]=62 then
	{F4}
	 if (in_b) then
	   begin
	     in_b:=(not in_b);
	     gotoxy(59,9);
	     write('off');
	   end
	 else
	   begin
	     in_b:=true;
	     gotoxy(59,9);
	     write('on  ');
	   end;
     if port[$60]=63 then
	{F5}
	 if (out_b) then
	   begin
	     out_b:=(not out_b);
	     gotoxy(59,10);
	     write('off');
	   end
	 else
	   begin
	     out_b:=true;
	     gotoxy(59,10);
	     write('on  ');
	   end;
     if port[$60]=64 then
	{F6}
	begin
	speed_ob:=speed_ob-1000;
	inc(cnt);
	gotoxy(65,11);
	write(cnt-1);
	if speed_ob<=1000 then
		begin
		speed_ob:=1000;
		cnt:=9;
		end;
	end;
     if port[$60]=65 then
	{F7}
	begin
	speed_ob:=speed_ob+1000;
	dec(cnt);
	gotoxy(65,11);
	write(cnt);
	if speed_ob>=9000 then
		begin
		speed_ob:=9000;
		cnt:=1;
		end;
	end;
	if port[$60]=66 then
	{F8}
	begin
	speed_str:=speed_str-1000;
	inc(cnt2);
	gotoxy(65,12);
	write(cnt2-1);
	if speed_str<=1000 then
		begin
		speed_str:=1000;
		cnt2:=9;
		end;
	end;
     if port[$60]=67 then
	{F9}
	begin
	speed_str:=speed_str+1000;
	dec(cnt2);
	gotoxy(65,12);
	write(cnt2);
	if speed_str>=9000 then
		begin
		speed_str:=9000;
		cnt2:=1;
		end;
	end;

     if port[$60]=1 then exit1:=true;
     inline($9C);
     oldklava;
end;
procedure Time; interrupt;
var c1,c2,c3 : string;
temp_sec : word;
begin
  time1:=time1+1;
  count2:=0;
  count1:=count1+1;

  if(count1 mod 18 = 0) then
    begin
      sec:=sec+1;
      inc(count2);
      if (count2 = 5) then
	begin
	  dec(count1);
	  count2:=0;
	end;
      if(sec mod n4 = 0) then  diskret:=diskret+n4;
      if (sec >= 60) then
	begin
	  sec:=0;
	  diskret:=sec;
	  m:=m+1;
	  if(m>=60) then
	    begin
	      m:=0;
	      h:=h+1;
	      if(h>=24) then h:=0;
	    end;
	end;
    end;

  str(h,c1);
  str(m,c2);
  str(diskret,c3);
  if(Length(c1)=1) then c1:='0'+c1;
  if(Length(c2)=1) then c2:='0'+c2;
  if(Length(c3)=1) then c3:='0'+c3;
  if (clock and (temp_sec<>sec) and not(cs)) then
    begin
      cs:=true;
      TextColor(9);
      gotoxy(time_x,time_y);
      write(c1,':',c2,':',c3);
      textcolor(15);
      cs:=false;
    end;
  temp_sec:=sec;
  inline($9C);
  oldhandler;
end;
procedure menu;
begin
  gotoxy(45,6);
  write('Clock(F1)   : on');
  gotoxy(45,7);
  write('Stroka(F2)  : on');
  gotoxy(45,8);
  write('Object(F3)  : on');
  gotoxy(45,9);
  write('In buf(F4)  : on');
  gotoxy(45,10);
  write('Out buf(F5) : on');
  gotoxy(45,11);
  write('Speed object F6/F7');
  gotoxy(45,12);
  write('Speed stroka F8/F9');
end;
procedure dvig;
var dx,dy : integer;

begin
      textcolor(15);
      gotoxy(ox,oy);
      write(' ');
      dx:=random(2);
      dy:=random(2);
      if gor then ox:=ox+dx else ox:=ox-dx;
      if ver then oy:=oy+dy else oy:=oy-dy;
      if ox>40 then begin ox:=ox-dx; gor:=false;end;
      if ox<3 then begin ox:=ox+dx; gor:=true;     end;
      if oy>20 then begin oy:=oy-dy; ver:=false;    end;
      if oy<6 then begin oy:=oy+dy; ver:=true;     end;
      if not(cs) then begin
	cs:=true;
	gotoxy(ox,oy);
	write('*');
	cs:=false;
      end;
end;
procedure ramka;
begin
  for i:=5 to 20 do
    begin
      gotoxy(2,i);
      write('є');
      gotoxy(41,i);
      write('є');
    end;
  gotoxy(2,5);
  write(& #39;ЙННННННННННННННННННННННННННННННННННННН
Н»');
  gotoxy(2,21);
  write(& #39;ИННННННННННННННННННННННННННННННННННННН
Нј');

  for i:=15 to 20 do
    begin
      gotoxy(44,i);
      write('є');
      gotoxy(61,i);
      write('є');
    end;
  gotoxy(44,14);
  write('ЙНННННННННННННННН»');
  gotoxy(44,21);
  write('ИННННННННННННННННј');
end;
procedure in_buf;
var j : word;
begin
  if free>0 then
    begin
    For j:=2 to q-1 do
      If (q mod j) = 0 then
      begin
	inc (q);
      end;
      inc (w);
    for j:=w downto 2 do Buffer_Sqrt[j]:=Buffer_Sqrt[j-1];
    Buffer_Sqrt[1]:=w;
    inc(w);
    end;
end;
procedure out_buf;
begin
  if ((Free<max) and (free<>max)) then
    Begin
      if buf_x>60 then begin buf_x:=45;inc(buf_y); end;
      if buf_y=21 then buf_y:=15;
      i:=max-Free;
      GotoXY(buf_x,buf_y);
      Write(Buffer_Sqrt[i]:4);
      Free:=Free+1;
      buf_x:=buf_x+4;
      Delay(10);
    End;
end;
procedure strka;
begin
  gotoxy(s_x,s_y);
  write('                ');
  dec(s_x);
  if s_x<1 then s_x:=62;
  if not(cs) then
    begin
      textcolor(15);
      cs:=true;
      gotoxy(s_x,s_y);
      write('Isakova Mila');
      cs:=false;
    end;

end;
begin
  asm
    mov  ah,01
    mov  cx,0FFFFh
    int  10h
  end
  if paramCount<>4 then
     begin
       error;
       exit;
     end;
   val(paramStr(1), n1, cod1);
   val(paramstr(2), n2, cod2);
   val(paramstr(3), n3, cod3);
   val(paramstr(4), n4, cod4);
   if (cod1<>0) or (cod2<>0) or (cod3<>0) or (cod4<>0)   then
     begin
       error;
       exit;
     end;
  if ((n4<1) or (n3>2) or (n3<1) or (n1>2) or (n1<1) or (n2>2) or (n2<1)) then
     begin
       error;
       exit;
     end;
  if n1=1 then s_y:=3 else s_y:=22;
  if n2=1 then time_x:=2 else time_x:=70;
  if n3=1 then time_y:=2 else time_y:=24;

  clrscr;
  menu;
  ramka;
  w:=1; q:=3;
  ver:=true;
  gor:=true;
  exit1:=false;
  stroka:=true;
  clock:=true;
  objekt:=true;
  in_b:=true;
  out_b:=true;
  speed_ob:=9000;
  cnt:=1; cnt2:=1;
  speed_str:=9000;
  n1:=1;
  free:=max;
  buf_x:=45;
  buf_y:=15;
  s_x:=10;
  ox:=12;
  oy:=20;
  cs:=false;
  GetTime(h, m, sec, sec100);
  temp_sec:=sec;
  GetIntVec($1C,@oldhandler);
  SetIntVec($1C,addr(Time));
  GetIntVec($9,@oldklava);
  SetIntVec($9,addr(klava));

  repeat
    for i:=1 to 4 do
      time_v[i]:=random(3);

    while (time_v[1]>=time1 ) do
      if (stroka and not(cs)) then begin strka;delay(speed_str); end;
    time1:=0;

    while (time_v[2]>=time1) do
      if (objekt and not(cs)) then begin dvig;delay(speed_ob); end;
    time1:=0;

    while (time_v[3]>=time1) do
      if (in_b) then begin in_buf; end;
    time1:=0;   while (time_v[4]>=time1) do
      if (out_b and not(cs)) then begin out_buf; end;
    time1:=0;

  until ((not(stroka) and not(clock) and not(objekt) and not(in_b) and not(out_b))or exit1);

end.

мисс_граффити
1) вопросы игнорируешь?
2) пожалуйста, выложи pas-файлом. ну неудобно же такое копировать! еще и кодировка сбивается.
правда, для этого, видимо, придется зарегистрироваться.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.