Unit List4;
   Interface
Const   ListOk          = 0;
        ListNotMem      = 1;
        ListUnder       = 2;
        ListEnd         = 3;
        SizeList        = 100;
Type    BaseType        = Pointer;
        Index     = 0..SizeList;
        PtrEl   = Index;
        Element = Record
                        Data : BaseType;
                        Next : PtrEl;
                        Flag : Boolean {TRUE, если элемент    }
                                        {принадлежит ОЛС       }
                  End;              {FALSE, если "свободен"}
        List     = Record
                        Start,Ptr : PtrEl;
                        N : Word
                   End;
Var     MemList: array[Index] of Element;
        ListError : 0..3;
Procedure InitList(var L:List);
Procedure PutList(var L:List; E:BaseType);
{Procedure GetList(var L:List; var E:BaseType);
Function  ReadList(var L:List):Pointer;}
Function  EmptyList(var L:List):boolean;
Function  EndList(var L:List):boolean;
Function  Count(var L:List):Word;
Procedure BeginPtr(var L:List);
Procedure EndPtr(var L:List);
Procedure MovePtr(var L:List);
{Procedure MoveTo(var L:List; N:word);
Procedure DoneList(var L:List);
Procedure CopyList(var L1,L2:List);}

Implementation
Procedure InitMem;
 {устанавливает Flag каждoго элемента
 в FALSE, вызывается в разделе операторов модуля}
var i:word;
begin
     for i:=0 to SizeList do
        MemList[i].Flag:=false;
end;

Function  NewMem: word;
{возвращает номер свободного элемента}
var i:word;
begin
     i:=0;
     while (not MemList[i].Flag) and (i<=SizeList) do
        inc(i);
     NewMem:= i;
end;

Function  EmptyMem: boolean;
{возвращает TRUE, если в
массиве нет свободных элементов}
begin
     EmptyMem:= NewMem>SizeList;
end;

Procedure DisposeMem(n:word);
{делает n-й элемент мас-сива свободным}
begin
     MemList[n].Flag:=false;
end;

Procedure InitList(var L:List);
begin
     L.Start:=0;
     L.Ptr:=0;
     L.N:=0;
end;

Procedure PutList(var L:List; E:BaseType);
begin

end;

{Procedure GetList(var L:List; var E:BaseType);
Function  ReadList(var L:List):Pointer;}

Function  EmptyList(var L:List):boolean;
begin
  EmptyList:=L.start=0;
end; { FullList }

Function  EndList(var L:List):boolean;
begin
  EndList:=MemList[L.ptr].next=0;
end; { EndList }

Function  Count(var L:List):Word;
begin
  Count:=L.N-1
end; { Count }

Procedure BeginPtr(var L:List);
begin
  L.ptr:=L.start
end; { BeginPtr }

Procedure MovePtr(var L:List);
begin
 if MemList[L.ptr].next=0 then
   ListError:=ListEnd
 else
  L.ptr:=MemList[L.ptr].next;
end; { MovePtr }

Procedure EndPtr(var L:List);
begin
     repeat
        MovePtr(L);
     until ListError=ListEnd;
end;

{Procedure MoveTo(var L:List; N:word);
Procedure DoneList(var L:List);
Procedure CopyList(var L1,L2:List);}

end.

unit stack8;
interface
uses list4; {см лаб.раб. №5}
const StackOk=ListOk;
      StackUnder=ListUnder;
      StackOver=ListNotMem;
type stack=list;

procedure InitStack(var s : stack); {инициализация стека}
procedure PutStack(var s : stack; b : basetype);
                               {поместить элемент в стек}
procedure GetStack(var s : stack; var b : basetype);
                              {извлечь элемент из стека }
function  EmptyStack(s : stack):boolean; {стек пуст}
procedure ReadStack(s:Stack;var b : basetype); {прочитать
                                элемент из вершины стека}
procedure DoneStack(var s:Stack);{разрушить стек}
var stackerror:byte;

implementation

Function  NewMem: word;
{возвращает номер свободного элемента}
var i:PtrEl;
begin
     i:=0;
     while (not MemList[i].Flag) and (i<=SizeList) do
        inc(i);
     NewMem:= i;
end;

Procedure DisposeMem(n:PtrEl);
{делает n-й элемент мас-сива свободным}
begin
     MemList[n].Flag:=false;
end;

procedure InitStack(var s : stack);
begin
     InitList(s);
end;

procedure PutStack(var s : stack; b : basetype);
var i:PtrEl;
begin
     i:=NewMem;
     if i>SizeList
     then stackerror:=ListNotMem
     else begin
          MemList[i].next:=s.ptr;
          MemList[i].Data:=b;
          s.ptr:=i;
     end;
end;

procedure GetStack(var s : stack; var b : basetype);
var i:PtrEl;
begin
 if s.ptr=0 then
   ListError:=ListEnd
 else  begin
     i:=s.ptr;
     b:=MemList[s.ptr].Data;
     MovePtr(s);
     DisposeMem(i);
 end;
end;

function  EmptyStack(s : stack):boolean;
begin
     EmptyStack:=EmptyList(s);
end;

procedure ReadStack(s:Stack;var b : basetype);
begin
 if s.ptr=0 then
   ListError:=ListEnd
 else  b:=MemList[s.ptr].Data;
end;

procedure DoneStack(var s:Stack);{разрушить стек}
var i,j:PtrEl;
begin
     i:=s.start;
     while i<>0 do
     begin
          {Dispose(MemList[i].Data);}
          {Тут по идее надо удалять данные.
          Но голый pointer удалять нельзя.
          А чтобы знать размер данных, они должны быть
          определены раньше этого модуля. Как-то нелогично.}
          DisposeMem(i);
          i:=MemList[i].next;
     end;
     s.ptr:=0;
     s.start:=0;
end;

end.

Unit Fifo9;
    Interface
Const
  FifoOk   = 0;
  FifoOver = 1;
  FifoUnder= 2;
var  FifoError:0..2;
Type
  BaseType =  TInquiry;

  TInquiry= record
                  Name: String[10]; {имя запроса}
                  Р: Byte; {приоритет}
                  Time1: Word; {время выполнения
                               задачи процессором P1}
                  Time2: Word; {время выполнения
                               задачи процессором P2}
                             end;
Const
  FifoSize = 65520 div sizeof(BaseType);
Type
  Index    = 0..FifoSize;
  TBuf = array[Index] of BaseType;
  Fifo = record
    PBuf: ^TBuf;
    SizeBuf: word; {количество элементов в массиве}
    Uk1 : Index; {указывает на "голову" очереди}
    Uk2 : Index; {указывает на "хвост" очереди}
end;
procedure InitFifo(var f : fifo; size: word);
                                  {инициализация очереди}
procedure PutFifo(var f : fifo; b : basetype);
                            {поместить элемент в очередь}
procedure GetFifo(var f : fifo; var b : basetype);
                             {извлечь элемент из очереди}
function  EmptyFifo(f : fifo):boolean; {очередь пуста}
procedure DoneFifo(var f: fifo);{разрушить очередь}

implementation

procedure InitFifo(var f : fifo; size: word);
begin
     new(f.PBuf);
     f.SizeBuf:=0;
     f.Uk1:=0;
     f.Uk2:=0;
end;

procedure incFifo(var Uk:Index);
begin
     if Uk<FifoSize
     then inc(Uk)
     else Uk:=0;
end;

procedure PutFifo(var f : fifo; b : basetype);
begin
     if f.SizeBuf>=FifoSize+1
     then FifoError:=FifoOver
     else begin
          inc(f.SizeBuf);
          incFifo(f.Uk1);
          f.PBuf^[f.Uk1]:=b;
     end;
end;

procedure GetFifo(var f : fifo; var b : basetype);
begin
     if f.SizeBuf<=0
     then FifoError:=FifoUnder
     else begin
          b:=f.PBuf^[f.Uk2];
          dec(f.SizeBuf);
          incFifo(f.Uk2);
     end;
end;

function  EmptyFifo(f : fifo):boolean; {очередь пуста}
begin
     EmptyFifo:= f.SizeBuf = 0;
end;

procedure DoneFifo(var f: fifo);{разрушить очередь}
begin
     dispose(f.PBuf);
     f.SizeBuf:=0;
     f.Uk1:=0;
     f.Uk2:=0;
end;

end.

uses stack8,Fifo9,list4;

const Phigh=0.3; {veroyatnost postupleniya zadach s vysokim prioritetom}
      Tinqmax=10; {maksimalnoe vremy vypolneniya protsessorom}
      dTg=8; {srednee vremia intervala mezhdu zadachami v generatore}



type TProc = record
                   inq:TInquiry; {ispoliaemaya zadacha}
                   pinq:^TInquiry; {dlia otpravki v steka}
                   S:stack;
                   Tstart:Word;
             end;

var F1,F2,F3,F4:Fifo;
    P1,P2:TProc;
    T,Tg:Word;
    ri:word;
    r:real;
    G:TInquiry;


function RandName:string;
var i:integer;
    s:string[10];
begin
     for i:=1 to 10 do
         s[i]:=chr(ord('a') + random(26));
     RandName:=s;
end;

begin
     InitFifo(F1,0);
     InitFifo(F2,0);
     InitFifo(F3,0);
     InitFifo(F4,0);
     InitStack(P1.S);
     P1.Tstart:=65535;
     P1.inq.Name:='';
     InitStack(P2.S);
     P2.Tstart:=65535;
     P2.inq.Name:='';

     Tg:=1000; {vremia raboty generatora }
     T:=0;
     randomize;
     repeat
           {rabota generatora}
           r:=random;
           if r< 1/dTg
           then begin
                G.Name:=RandName;
                G.Time1:=random(Tinqmax)+1;
                G.Time2:=random(Tinqmax)+1;
                if random < Phigh
                then begin
                     G.P:=0;
                     PutFifo(F1,G);
                end
                else begin
                     G.P:=1;
                     PutFifo(F2,G);
                end
           end;

           {protsessor P1}
           with P1 do
           begin
                if (inq.Name<>'') and (T>Tstart + inq.Time1)
                then begin
                     if inq.P=0 then PutFifo(F3,inq)
                                else PutFifo(F4,inq);
                     inq.Name:='';
                end;

                if not EmptyFifo(F1)
                then begin
                     if (inq.Name<>'') and (inq.P=1)
                     then begin
                          inq.Time1:=inq.Time1 - (T - Tstart);
                          new(pinq);
                          pinq^:=inq;
                          PutStack(S,pinq);
                          inq.Name:='';
                     end;
                     GetFifo(F1,inq);
                     Tstart:=T;
                end;

                if inq.Name<>''
                then begin
                     if not EmptyFifo(F2)
                     then begin
                          GetFifo(F2,inq);
                          Tstart:=T;
                     end
                     else if not EmptyStack(S)
                          then begin
                               GetStack(S,pinq);
                               inq:=pinq^;
                               dispose(pinq);
                               Tstart:=T;
                          end;
                end;

           {protsessor P2}
           with P2 do
           begin
                if (inq.Name<>'') and (T>Tstart + inq.Time2)
                then begin
                     {if inq.P=0 then PutFifo(F3,inq)
                                else PutFifo(F4,inq);
                                OUT}
                     inq.Name:='';
                end;

                if not EmptyFifo(F3)
                then begin
                     if (inq.Name<>'') and (inq.P=1)
                     then begin
                          inq.Time2:=inq.Time2 - (T - Tstart);
                          new(pinq);
                          pinq^:=inq;
                          PutStack(S,pinq);
                          inq.Name:='';
                     end;
                     GetFifo(F3,inq);
                     Tstart:=T;
                end;

                if inq.Name<>''
                then begin
                     if not EmptyFifo(F4)
                     then begin
                          GetFifo(F4,inq);
                          Tstart:=T;
                     end
                     else if not EmptyStack(S)
                          then begin
                               GetStack(S,pinq);
                               inq:=pinq^;
                               dispose(pinq);
                               Tstart:=T;
                          end;
                end;
           end;
     until EmptyFifo(F1) and EmptyFifo(F2) and EmptyFifo(F3)
           and EmptyFifo(F4) and EmptyStack(P1.S) and EmptyStack(P2.S);
end.

uses stack8,Fifo9,list4;

const Phigh=0.3; {veroyatnost postupleniya zadach s vysokim prioritetom}
      Tinqmax=10; {maksimalnoe vremy vypolneniya protsessorom}
      dTg=8; {srednee vremia intervala mezhdu zadachami v generatore}



type TProc = record
                   inq:TInquiry; {ispoliaemaya zadacha}
                   pinq:^TInquiry; {dlia otpravki v steka}
                   S:stack;
                   Tstart:Word;
             end;

var F1,F2,F3,F4:Fifo;
    P1,P2:TProc;
    T,Tg:Word;
    ri:word;
    r:real;
    G:TInquiry;


function RandName:string;
var i:integer;
    s:string[10];
begin
     for i:=1 to 10 do
         s[i]:=chr(ord('a') + random(26));
     RandName:=s;
end;

begin
     InitFifo(F1,0);
     InitFifo(F2,0);
     InitFifo(F3,0);
     InitFifo(F4,0);
     InitStack(P1.S);
     P1.Tstart:=65535;
     P1.inq.Name:='';
     InitStack(P2.S);
     P2.Tstart:=65535;
     P2.inq.Name:='';

     Tg:=1000; {vremia raboty generatora }
     T:=0;
     randomize;
     repeat
           {rabota generatora}
           r:=random;
           if r< 1/dTg
           then begin
                G.Name:=RandName;
                G.Time1:=random(Tinqmax)+1;
                G.Time2:=random(Tinqmax)+1;
                if random < Phigh
                then begin
                     G.P:=0;
                     PutFifo(F1,G);
                end
                else begin
                     G.P:=1;
                     PutFifo(F2,G);
                end
           end;

           {protsessor P1}
           with P1 do
           begin
                if (inq.Name<>'') and (T>Tstart + inq.Time1)
                then begin
                     if inq.P=0 then PutFifo(F3,inq)
                                else PutFifo(F4,inq);
                     inq.Name:='';
                end;

                if not EmptyFifo(F1)
                then begin
                     if (inq.Name<>'') and (inq.P=1)
                     then begin
                          inq.Time1:=inq.Time1 - (T - Tstart);
                          new(pinq);
                          pinq^:=inq;
                          PutStack(S,pinq);
                          inq.Name:='';
                     end;
                     GetFifo(F1,inq);
                     Tstart:=T;
                end;

                if inq.Name<>''
                then begin
                     if not EmptyFifo(F2)
                     then begin
                          GetFifo(F2,inq);
                          Tstart:=T;
                     end
                     else if not EmptyStack(S)
                          then begin
                               GetStack(S,pinq);
                               inq:=pinq^;
                               dispose(pinq);
                               Tstart:=T;
                          end;
                end;

           {protsessor P2}
           with P2 do
           begin
                if (inq.Name<>'') and (T>Tstart + inq.Time2)
                then begin
                     {if inq.P=0 then PutFifo(F3,inq)
                                else PutFifo(F4,inq);
                                OUT}
                     inq.Name:='';
                end;

                if not EmptyFifo(F3)
                then begin
                     if (inq.Name<>'') and (inq.P=1)
                     then begin
                          inq.Time2:=inq.Time2 - (T - Tstart);
                          new(pinq);
                          pinq^:=inq;
                          PutStack(S,pinq);
                          inq.Name:='';
                     end;
                     GetFifo(F3,inq);
                     Tstart:=T;
                end;

                if inq.Name<>''
                then begin
                     if not EmptyFifo(F4)
                     then begin
                          GetFifo(F4,inq);
                          Tstart:=T;
                     end
                     else if not EmptyStack(S)
                          then begin
                               GetStack(S,pinq);
                               inq:=pinq^;
                               dispose(pinq);
                               Tstart:=T;
                          end;
                end;
           end;
     end;
 until (EmptyFifo(F1) and EmptyFifo(F2) and EmptyFifo(F3) and EmptyFifo(F4) and EmptyStack(P1.S) and EmptyStack(P2.S));
end.

Unit List4;
   Interface
Const   ListOk          = 0;
        ListNotMem      = 1;
        ListUnder       = 2;
        ListEnd         = 3;
        SizeList        = 100;
Type    BaseType        = Pointer;
        Index     = 0..SizeList;
        PtrEl   = Index;
        Element = Record
                        Data : BaseType;
                        Next : PtrEl;
                        Flag : Boolean {TRUE, если элемент    }
                                        {принадлежит ОЛС       }
                  End;              {FALSE, если "свободен"}
        List     = Record
                        Start,Ptr : PtrEl;
                        N : Word
                   End;
Var     MemList: array[Index] of Element;
        ListError : 0..3;
Procedure InitList(var L:List);
Procedure PutList(var L:List; E:BaseType);
{Procedure GetList(var L:List; var E:BaseType);
Function  ReadList(var L:List):Pointer;}
Function  EmptyList(var L:List):boolean;
Function  EndList(var L:List):boolean;
Function  Count(var L:List):Word;
Procedure BeginPtr(var L:List);
Procedure EndPtr(var L:List);
Procedure MovePtr(var L:List);
{Procedure MoveTo(var L:List; N:word);
Procedure DoneList(var L:List);
Procedure CopyList(var L1,L2:List);}

Implementation
Procedure InitMem;
 {устанавливает Flag каждoго элемента
 в FALSE, вызывается в разделе операторов модуля}
var i:word;
begin
     for i:=0 to SizeList do
        MemList[i].Flag:=false;
end;

Function  NewMem: word;
{возвращает номер свободного элемента}
var i:word;
begin
     i:=0;
     while (not MemList[i].Flag) and (i<=SizeList) do
        inc(i);
     NewMem:= i;
end;

Function  EmptyMem: boolean;
{возвращает TRUE, если в
массиве нет свободных элементов}
begin
     EmptyMem:= NewMem>SizeList;
end;

Procedure DisposeMem(n:word);
{делает n-й элемент мас-сива свободным}
begin
     MemList[n].Flag:=false;
end;

Procedure InitList(var L:List);
begin
     L.Start:=0;
     L.Ptr:=0;
     L.N:=0;
end;

Procedure PutList(var L:List; E:BaseType);
begin

end;

{Procedure GetList(var L:List; var E:BaseType);
Function  ReadList(var L:List):Pointer;}

Function  EmptyList(var L:List):boolean;
begin
  EmptyList:=L.start=0;
end; { FullList }

Function  EndList(var L:List):boolean;
begin
  EndList:=MemList[L.ptr].next=0;
end; { EndList }

Function  Count(var L:List):Word;
begin
  Count:=L.N-1
end; { Count }

Procedure BeginPtr(var L:List);
begin
  L.ptr:=L.start
end; { BeginPtr }

Procedure MovePtr(var L:List);
begin
 if MemList[L.ptr].next=0 then
   ListError:=ListEnd
 else
  L.ptr:=MemList[L.ptr].next;
end; { MovePtr }

Procedure EndPtr(var L:List);
begin
     repeat
        MovePtr(L);
     until ListError=ListEnd;
end;

{Procedure MoveTo(var L:List; N:word);
Procedure DoneList(var L:List);
Procedure CopyList(var L1,L2:List);}

end.

unit stack8;
interface
uses list4; {см лаб.раб. №5}
const StackOk=ListOk;
      StackUnder=ListUnder;
      StackOver=ListNotMem;
type stack=list;

procedure InitStack(var s : stack); {инициализация стека}
procedure PutStack(var s : stack; b : basetype);
                               {поместить элемент в стек}
procedure GetStack(var s : stack; var b : basetype);
                              {извлечь элемент из стека }
function  EmptyStack(s : stack):boolean; {стек пуст}
procedure ReadStack(s:Stack;var b : basetype); {прочитать
                                элемент из вершины стека}
procedure DoneStack(var s:Stack);{разрушить стек}
var stackerror:byte;

implementation

Function  NewMem: word;
{возвращает номер свободного элемента}
var i:PtrEl;
begin
     i:=0;
     while (not MemList[i].Flag) and (i<=SizeList) do
        inc(i);
     NewMem:= i;
end;

Procedure DisposeMem(n:PtrEl);
{делает n-й элемент мас-сива свободным}
begin
     MemList[n].Flag:=false;
end;

procedure InitStack(var s : stack);
begin
     InitList(s);
end;

procedure PutStack(var s : stack; b : basetype);
var i:PtrEl;
begin
     i:=NewMem;
     if i>SizeList
     then stackerror:=ListNotMem
     else begin
          MemList[i].next:=s.ptr;
          MemList[i].Data:=b;
          s.ptr:=i;
     end;
end;

procedure GetStack(var s : stack; var b : basetype);
var i:PtrEl;
begin
 if s.ptr=0 then
   ListError:=ListEnd
 else  begin
     i:=s.ptr;
     b:=MemList[s.ptr].Data;
     MovePtr(s);
     DisposeMem(i);
 end;
end;

function  EmptyStack(s : stack):boolean;
begin
     EmptyStack:=EmptyList(s);
end;

procedure ReadStack(s:Stack;var b : basetype);
begin
 if s.ptr=0 then
   ListError:=ListEnd
 else  b:=MemList[s.ptr].Data;
end;

procedure DoneStack(var s:Stack);{разрушить стек}
var i,j:PtrEl;
begin
     i:=s.start;
     while i<>0 do
     begin
          {Dispose(MemList[i].Data);}
          {Тут по идее надо удалять данные.
          Но голый pointer удалять нельзя.
          А чтобы знать размер данных, они должны быть
          определены раньше этого модуля. Как-то нелогично.}
          DisposeMem(i);
          i:=MemList[i].next;
     end;
     s.ptr:=0;
     s.start:=0;
end;

end.

Unit Fifo9;
    Interface
uses stack8,list4;
Const
  FifoOk   = 0;
  FifoOver = 1;
  FifoUnder= 2;
var  FifoError:0..2;
Type
  TInquiry= record
                  Name: String[10]; {имя запроса}
                  P: Byte; {приоритет}
                  Time1: Word; {время выполнения
                               задачи процессором P1}
                  Time2: Word; {время выполнения
                               задачи процессором P2}
                             end;
  BaseType =  TInquiry;
Const
  FifoSize = 65520 div sizeof(BaseType);
Type
  Index    = 0..FifoSize;
  TBuf = array[Index] of BaseType;
  Fifo = record
    PBuf: ^TBuf;
    SizeBuf: word; {количество элементов в массиве}
    Uk1 : Index; {указывает на "голову" очереди}
    Uk2 : Index; {указывает на "хвост" очереди}
end;
procedure InitFifo(var f : fifo; size: word);
                                  {инициализация очереди}
procedure PutFifo(var f : fifo; b : basetype);
                            {поместить элемент в очередь}
procedure GetFifo(var f : fifo; var b : basetype);
                             {извлечь элемент из очереди}
function  EmptyFifo(f : fifo):boolean; {очередь пуста}
procedure DoneFifo(var f: fifo);{разрушить очередь}

implementation

procedure InitFifo(var f : fifo; size: word);
begin
     new(f.PBuf);
     f.SizeBuf:=0;
     f.Uk1:=0;
     f.Uk2:=0;
end;

procedure incFifo(var Uk:Index);
begin
     if Uk<FifoSize
     then inc(Uk)
     else Uk:=0;
end;

procedure PutFifo(var f : fifo; b : basetype);
begin
     if f.SizeBuf>=FifoSize+1
     then FifoError:=FifoOver
     else begin
          inc(f.SizeBuf);
          incFifo(f.Uk1);
          f.PBuf^[f.Uk1]:=b;
     end;
end;

procedure GetFifo(var f : fifo; var b : basetype);
begin
     if f.SizeBuf<=0
     then FifoError:=FifoUnder
     else begin
          b:=f.PBuf^[f.Uk2];
          dec(f.SizeBuf);
          incFifo(f.Uk2);
     end;
end;

function  EmptyFifo(f : fifo):boolean; {очередь пуста}
begin
     EmptyFifo:= f.SizeBuf = 0;
end;

procedure DoneFifo(var f: fifo);{разрушить очередь}
begin
     dispose(f.PBuf);
     f.SizeBuf:=0;
     f.Uk1:=0;
     f.Uk2:=0;
end;

end.