Петрозаводский государственный университет
Кафедра информационно-измерительных систем и физической электроники
Изучение алгоритмов реализации и использования сопрограмм
Выполнила:
Студентка ФТФ
Группы 21402
Куусинен Е.В.
Проверил:
Соловьёв А. В.
Петрозаводск, 2012
Оглавление
1 ТЕХНИЧЕСКОЕ ЗАДАНИЕ 4
1.1 Назначение программы 4
1.2 Требования к входным и выходным данным 4
1.3 Требования к информационной совместимости 4
1.4 Требования к техническим средствам 4
1.5 Требования к программной документации 4
1.6 Срок сдачи программы 4
2 ТЕКСТ ПРОГРАММЫ 5
program ex2; 5
uses mcorss, crt, Dos,Graph; 5
var 5
x, y, x1, x2, x3, x4, x5, y1, y2, y3, y4, y5, Mode, Driver: integer; 5
const c = 60; 5
procedure Proc1; far; 5
begin 5
repeat 5
SetColor(red); 5
x1 := 100; 5
y1 := 70; 5
circle(x1, y1, c); 5
delay(500); 5
SetColor(black); x1 := 100; 5
y1 := 200; 5
circle(x1, y1, c); 5
until keypressed; 5
Stop; 5
end; 6
procedure Proc2; far; 6
begin 6
repeat 6
SetColor(yellow); 6
x2 := 100; 6
y2 := 200; 6
circle(x2, y2, c); 6
delay(500); 6
SetColor(black); x1 := 100; 6
y1 := 200; 6
circle(x1, y1, c); 6
until keypressed; 6
Stop; 6
end; 6
procedure Proc3; far; 7
begin 7
repeat 7
SetColor(green); 7
x3 := 100; 7
y3 := 350; 7
circle(x3, y3, c); 7
delay(500); 7
SetColor(black); x1 := 100; 7
y1 := 200; 7
circle(x1, y1, c); 7
until keypressed; 7
Stop; 7
end; 7
Begin 8
clrscr; 8
ClrScr; 8
Mode:=0; 8
Driver:=Detect; 8
InitGraph(Mode, Driver, ''); 8
NewProcess(@Proc1); 8
NewProcess(@Proc2); 8
NewProcess(@Proc3); 8
StartProcess(@Proc1); 8
StartProcess(@Proc2); 8
StartProcess(@Proc3); 8
start; 8
End. 8
4 ОПИСАНИЕ ПРОГРАММЫ 12
4.1 Общее описание 12
4.2 Логическая структура программы 12
4.3 Запуск программы 12
1 Техническое задание
1.1 Назначение программы
Программа ex2.pas предназначена для иллюстрации методов реализации очередей многозадачного ядра и диспетчеризации процессов.
1.2 Требования к входным и выходным данным
Результат работы программы выводится на экран. Сообщения об ошибках в ходе выполнения программы также выводятся на экран.
1.3 Требования к информационной совместимости
Программа разрабатывается на языке высокого уровня Turbo Pascal с использованием стандартных модулей Crt, Dos, Graph и модуля Mcorss. Для компиляции программы необходим компилятор среды разработки Turbo Pascal v 7.0.
1.4 Требования к техническим средствам
Программа должна запускаться на ЭВМ, технические характеристики которой позволяют работать в операционной системе MS-DOS.
1.5 Требования к программной документации
Программная документация должна содержать:
- Текст программы;
- Описание программы.
1.6 Срок сдачи программы
Срок сдачи программы – 31.12.2012.
2 ТЕКСТ ПРОГРАММЫ
program ex2;
uses mcorss, crt, Dos,Graph;
var
x, y, x1, x2, x3, x4, x5, y1, y2, y3, y4, y5, Mode, Driver: integer;
const c = 60;
procedure Proc1; far;
begin
repeat
SetColor(red);
x1 := 100;
y1 := 70;
circle(x1, y1, c);
delay(500);
SetColor(black); x1 := 100;
y1 := 200;
circle(x1, y1, c);
until keypressed;
Stop;
end;
procedure Proc2; far;
begin
repeat
SetColor(yellow);
x2 := 100;
y2 := 200;
circle(x2, y2, c);
delay(500);
SetColor(black); x1 := 100;
y1 := 200;
circle(x1, y1, c);
until keypressed;
Stop;
end;
procedure Proc3; far;
begin
repeat
SetColor(green);
x3 := 100;
y3 := 350;
circle(x3, y3, c);
delay(500);
SetColor(black); x1 := 100;
y1 := 200;
circle(x1, y1, c);
until keypressed;
Stop;
end;
Begin
clrscr;
ClrScr;
Mode:=0;
Driver:=Detect;
InitGraph(Mode, Driver, '');
NewProcess(@Proc1);
NewProcess(@Proc2);
NewProcess(@Proc3);
StartProcess(@Proc1);
StartProcess(@Proc2);
StartProcess(@Proc3);
start;
End.
3 ТЕКСТ МОДУЛЯ MCORSS
Unit MCORSS;
Interface
uses Dos,Crt;
type
Myproc = pointer;
Artype = array [0..999] of word; {под стек- 1000 слов}
ArStack = ^Artype;
Process = ^Procdesc;
Procdesc = record
ssreg, spreg : word;
Stack : ArStack;
Name : pointer;
next : Process;
end;
procedure NewProcess(body: Myproc);
procedure StartProcess(body: Myproc);
procedure Transfer(var OldProc, NewProc: Procdesc);
procedure Start;
procedure Stop;
Implementation
var R, {указатель на очередь готовых процессов}
A, {указатель на активный процесс}
C : Process; {указатель на список созданных, но не запущенных процессов}
Vector: pointer;
Main : Procdesc;
procedure NewProcess (body: MyProc);
var Proc: Process;
begin
New(Proc); {выделение памяти под дескриптор Proc^}
with Proc^ do begin
New(Stack); {выделение памяти под стек}
ssreg := seg(Stack^[0]); {получаем в ssreg сегмент стека}
spreg := ofs(Stack^[0]) + 1998 - 12; {получаем в spreg указатель стека}
memw[ssreg:spreg+2] := ofs(body^); {записываем точку возврата}
memw[ssreg:spreg+4] := seg (body^);
Name := body;
next := nil
end; {with}
If C <> nil then Proc^.next:= C;
C:= Proc; {включили созданный процесс в список созданных}
end; {NewProcess}
Procedure Transfer (Var OldProc, NewProc: Procdesc); assembler;
asm
cli
les si, OldProc; {получаем адрес дескриптора процесса OldProc в регистры es:di}
mov es:[di], ss; {заносим текущее значение сегмента стека в дескриптор}
mov es:[di+2], sp; {заносим текущее значение указателя стека в дескриптор}
les di, NewProc; {получаем адрес дескриптора NewProc – процесса, которому передается управление}
mov ss, es:[di]; {заносим в сегмент стека сохраненное в дескрипторе NewProc значение сегмента} {стека процесса NewProc}
mov sp, es:[di+2]; {заносим в указатель стека сохраненное в дескрипторе NewProc значение указателя} {стека процесса NewProc }
sti
end; {Transfer}
procedure Clim; assembler; {запрет прерываний}
asm cli end;
procedure Stim; assembler; {разрешение прерываний}
asm sti end;
procedure StartError;
begin
writeln('Start process mistake');
end;
procedure StartProcess (body: Myproc);
var rc,rp,cc,cp: Process; { процесс, описанный посредством процедуры body, ставится в очередь} {процессов, готовых к выполнению}
begin
if C=nil then StartError
else begin
cc:= C; cp:= nil;
while (cc^.Name <> body) and (cc^.next <> nil) do begin {проходим по очереди, пока не найдем} {нужный процесс}
cp:= cc; cc:= cc^.next
end; {while}
{В конце: в cc – указатель на процесс, описанный в процедуре body и готов к выполнению и ждет его}
if cc^.Name <> body then StartError {если процесс не найден, выводится сообщение об ошибке}
else begin
if cp=nil then {если в очереди один процесс, то C – указатель на дескриптор этого процесса}
C:= cc^.next
else cp^.next:= cc^.next; {в cp.next сохраняем cc.next }
cc^.next:=nil; {обнуляем cc.next. cc указывает на процесс, подлежащий запуску}
Clim; {запрещаем прерывания}
if R=nil then {если готовых процессов нет, то}
R:= cc {заносим в очередь готовых процессов cc}
else begin
rc:=R; rp:= nil; {иначе – в rc заносим очередь готовых процессов}
while rc^.next <> nil do begin
rp:= rc; RC:= rc^.next {пока не дойдем до конца очереди готовых процессов}
end; {while}
rc^.next := cc {заносим cc в очередь готовых процессов}
end; {if}
Stim {разрешаем прерывания}
end; {if}
end; {if}
end; {StartProcess}
procedure Handler; interrupt;
var rp: Process; { процедура диспетчеризации процессов }
Reg : Registers;
begin
intr($78,Reg); {обработка прерываний от таймера}
if R <> nil then begin {если очередь готовых процессов не пуста, то }
Clim; rp:=A; {запрещаем прерывания, Заносим указатель на активный процесс }
if A^.next = nil then {если этот процесс один, то}
A:= R {в A заносим очередь готовых процессов}
else begin
A:= A^.next; {если нет, то заносим в A следующий активный процесс}
end; {if}
Transfer(rp^,A^) {передаем управление из предыдущего активного процесса в следующий}
end {if}
end; {Handler}
procedure Start; {запуск процессов, активизация процедуры диспетчеризации}
begin
if R=nil then StartError
else begin
A:= R;
GetIntVec($8,Vector); {возвращает адрес, сохраненный в векторе прерывания}
SetIntVec($8,@Handler); {устанавливает вектор прерывания на указанный адрес}
SetIntVec($78,Vector);
Transfer(Main, A^) {передаем управление}
end; {if}
end; {Start}
procedure Stop; {остановка процедуры диспетчеризации}
begin
SetIntVec($8,Vector);
Transfer(A^,Main);
end; {Stop}
Begin
R:=nil; A:= nil; C:=nil;
End.