Помощь - Поиск - Пользователи - Календарь
Полная версия: Простые числа - многопоточная реализация
Форум «Всё о Паскале» > 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 ('”®а¬ в ўлў®¤ : turbo.exe [p1] [p2] [p3] [p4]');
writeln;
writeln ('p1: ‚лў®¤ ЎҐЈг饩 бва®ЄЁ ўўҐаег нЄа ­  ');
writeln (' 1 ўўҐаег нЄа ­  ');
writeln (' other ў­Ё§г нЄа ­  ');
writeln ('p2: — бл Ї® X');
writeln (' 1 ўўҐаег нЄа ­  ');
writeln (' other ў­Ё§г нЄа ­  ');
writeln ('p3: — бл Ї® 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-файлом. ну неудобно же такое копировать! еще и кодировка сбивается.
правда, для этого, видимо, придется зарегистрироваться.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.