IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Простые числа - многопоточная реализация, Не могу понять что не так...
сообщение
Сообщение #1


Гость






Есть два процесса - один производит простые числа и заносит в буфер, другой выводит их на экран. Вроде бы все правильно, посмотрите пожалуйста почему все зависает.. буду очень благодарна.

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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Michael_Rybak
*****

Группа: Пользователи
Сообщений: 1 046
Пол: Мужской
Реальное имя: Michael_Rybak

Репутация: -  32  +


Конечно, выкладывай весь код.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


 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

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


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Вот полный код...

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.

 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


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


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 2.10.2020 2:26
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name