old/PAS/!SPbSTU/Win2k2/CORE.PAS

unit CORE; {Ÿ¤à® ¬®¤¥«¨ á¨áâ¥¬ë ¬ áᮢ®£® ®¡á«ã¦¨¢ ­¨ï}
                            INTERFACE
type       
 PSource  = ^CSource; {“ª § â¥«ì ­  ¨áâ®ç­¨ª}
 PDevice  = ^CDevice; {“ª § â¥«ì ­  á¨á⥬㠮¡à ¡®âª¨ (ãáâனá⢮) }
 PBuffer  = ^CBuffer; {“ª § â¥«ì ­  ¡ãä¥à § ¯à®á®¢}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

TReq = record  {‡ ¯à®á ­  ®¡á«ã¦¨¢ ­¨¥}
  Birth : real; {‚à¥¬ï ¯®ï¢«¥­¨ï § ¯à®á }
  Death : real; {‚६ï ᬥà⨠§ ¯à®á  (®¡à ¡®â ­, «¨¡® ®âª«®­¥­)}
  FromSource : PSource; {Šâ® ¯à®á¨«-â® ?}
  ToDevice   : PDevice; {€ ᮡá⢥­­® ªã¤  ?}
end;
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}


{$R-}
TReqArray = array [0..1000] of TReq;
PReqArray = ^TReqArray;
TSourceArr = array [0..1000] of PSource;
PSourceArr = ^TSourceArr;
PReq = ^TReq;
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}


ESOURCES = (SOURCE_DUMMY,SOURCE_EASIEST,SOURCE_ERLANG); {’¨¯ë ¨áâ®ç­¨ª®¢}

CSource = object   {Ž¡ê¥ªâ - ¯à®á⥩訩 ¨áâ®ç­¨ª}
  SType : ESOURCES; {Š ª®¢ ­ è ¨áâ®ç­¨ª? }
  Name  : integer;  {€ ª ª ¥£® §®¢ãâ ?}

  LastTime : real;  {‚à¥¬ï £¥­¥à æ¨¨ ¯®á«¥¤­¥£® § ¯à®á }
  LastReq  : TReq;  {�®á«¥¤­¨© ᣥ­¥à¨à®¢ ­­ë© § ¯à®á}

  NewTime  : real;  {Œ®¬¥­â £¥­¥à æ¨¨ ­®¢®£® § ¯à®á }
  Lambda   : real;

  TotalReq : longInt; {Ž¡é¥¥ ç¨á«® § ï¢®ª ®â ¨áâ®ç­¨ª }
  DoneReq : longInt; {ç¨á«® ®¡à ¡®â ­­ëå § ï¢®ª ®â ¨áâ®ç­¨ª }  
  RefusedReq:LongInt; {—¨á«® ®âª«®­¥­­ëå § ï¢®ª}
  WaitTime : real; {Ž¡é¥¥ ¢à¥¬ï ¯à¥¡ë¢ ­¨ï ¢ á¨á⥬¥}
  ProbRefuse:real; {‚¥à®ïâ­®áâì ®âª § } 
  MatWait  : real; {Œ â¥¬ â¨ç¥áª®¥ ®¦¨¤ ­¨¥ ¢ ¡ãä¥à¥}

  Constructor Init(aName : Integer;aLambda:real); {Š®­áâàãªâ®à á ¨¬¥­¥¬}
  Procedure Reset; {‘¡à®á ¢á¥å áç¥â稪®¢}
  Procedure GenNewReq; {ƒ¥­¥à æ¨ï ­®¢®£® § ¯à®á }
  Destructor Done;virtual;
end;{CSource}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

CDevice = object   {Ž¡ê¥ªâ - ¯à®á⥩襥 ãá⮩á⢮ ¬ áᮢ®£® ®¡á«ã¦¨¢ ­¨ï}
  LastTime : real; {‚à¥¬ï ¯®á«¥¤­¥£® § ¢¥à襭¨ï ®¡á«ã¦¨¢ ­¨ï}

  BegTime  : real; {‚à¥¬ï ­ ç «  ®¡á«ã¦¨¢ ­¨ï}
  DoneTime : real; {‚६ï, ¢ ª®â®à®¥ § ª®­ç¨âáï ®¡à ¡®âª }

  Stoppage : real; {Ž¡é¥¥ ¢à¥¬ï ¯à®áâ®ï ¯à¨¡®à }

  IsWorking : boolean; {Žáãé¥á⢫ï¥âáï «¨ ®¡á«ã¦¨¢ ­¨¥ ?}
  CurWorking : TReq; {’¥ªã騩 ®¡à ¡ â뢠¥¬ë© § ¯à®á}
  Lambda   : real; 

  Constructor Init(aLambda:real); {}
  Function AddReq(aCurReq : PReq;aCurTime:real):boolean; {� ç «® ®¡à ¡®âª  § ¯à®á }
  Procedure Reset; {‘¡à®á ãáâà-¢ }
  Function DoneWork:PReq; {‡ ¢¥à襭¨¥ ®¡à ¡®âª¨ ⥪ã饣® § ¯à®á , á ¥£® ¢®§¢à â®¬}
  Destructor Done;
end; {CDevice}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
EBuffers = (BUFFER_DUMMY, BUFFER_FIFO, BUFFER_LIFO);

CBuffer = object      {�ãää¥à § ¯à®á®¢}
  BufType      : EBuffers; {’¨¯ ¡ãä¥à }
  BufferLength : integer; {„«¨­  ¡ãä¥à }
  CellCount    : integer; {ˆ­¤¥ªá ⥪ã饩 ᢮¡®¤­®© ï祩ª¨}
  Data         : PReqArray; {‘®¡á⢥­­® á ¬ ¡ãä¥à}
  Constructor Init(aBufLen:integer); {ˆ­¨æ¨ «¨§ æ¨ï ¡ãä¥à }
  Destructor Done;virtual;{„¥áâàãªâ®à, ®­ ¨ ¥áâì}
  Function SetBufferSize(aNewSize:integer):boolean;{ˆ§¬¥­¥­¨¥ à §¬¥à  ¡ãä¥à }
  Procedure FreeBuffer; {Žá¢®¡®¦¤¥­¨¥ ¢á¥£® ¡ãä¥à  áà §ã}
  Function AddReq(var aNew, rKicked:TReq):boolean; {„®¡ ¢«ï¥âáï § ¯à®á ¢ ¡ãä¥à.
   …᫨ ¨§ ¡ãä¥à  ª ª®©-â® § ¯à®á 㤠«¥­, â® ä-æ¨ï ¢®§¢à. false, ¨ ¢ rKicked -
   § ¯à®á, ª®â®àë© ®âª«®­¥­}
  Function GetReq(var rReq:TReq):boolean;virtual; {‚ëâ é¨âì ¨§ ¡ãä¥à  § ¯à®á,
        ¥á«¨ ãᯥ譮 - true}
end; {CBuffer}
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

CModel = object {� è  ¬®¤¥«ì ‘ŒŽ} 
 Sources  : PSourceArr; {ˆáâ®ç­¨ª¨} 
 SourceCnt: integer;    {—¨á«® ¨áâ®ç­¨ª®¢}
 MaxSrc   : integer;    {� §¬¥à­®áâì ¬ áᨢ  ¨áâ®ç­¨ª®¢}

 Buffer   : PBuffer;    {�ãä¥à}
 Device   : PDevice;    {“áâனá⢮}

 CurTime  : real;       {’¥ªã騩 ¬®¬¥­â ¢à¥¬¥­¨}
 Delta    : real;
 DovInt   : real;

 NextSource:integer;    {Š ª®© ¨§ ¨áâ®ç­¨ª®¢ - ¡ëáâ॥}
 RealizSteps:LongInt;   {�¥®¡å. ç¨á«® ॠ«¨§ æ¨©}
 CurStep  : LongInt;    {’¥ªã騩 è £}
{}
 DoneCount,             {—¨á«® ®¡à ¡®â ­­ëå § ï¢®ª}
 RefusedCount,           {—¨á«® ®âª«®­¥­­ëå § ï¢®ª}
 TotalCount : integer;  {Ž¡é¥¥ ç¨á«® § ï¢®ª}

 Working  : boolean;    {� ¡®â ¥â «¨ ¬®¤¥«ì ?}
 WorkReq  : TReq;

 CalcVer  : boolean;    {�㦭® «¨ ¯®¤áç¨â뢠âì KMIN ¢ § ¢. ®â ¢¥à ?}

 Constructor Init(aBegSrcCnt:integer;aDev:PDevice;aBuf:PBuffer;
                  aDel,aDov:Real);
 Function SetSourceCount(aNewCnt:integer):boolean; {“áâ ­®¢ª  ­®¢®£® ç¨á« 
                                              ¨áâ®ç­¨ª®¢, á á®åà ­¥­¨¥¬ áâ àëå}
 Function AddNewSource(aNewSrc:PSource):boolean; {„®¡ ¢«¥­¨¥ ­®¢®£® ¨áâ®ç­¨ª }
 Procedure SetNextSource; {� å®¤¨â NextSource}
 Function TestVer:boolean; {}
 Function RemoveSource(aName:integer):boolean; {“¤ «¥­¨¥ ¨áâ®ç­¨ª  ¨§ ¬®¤¥«¨}
 Procedure Reset; {‘¡à®á ¢á¥å áç¥â稪®¢}
 Procedure Start;
 Procedure PrintValues(var F:TEXT);
 Function Step:boolean; {Œ®¤¥«¨àã¥â á«¥¤ãî騩 è £, ¥á«¨ ¢ }
 Destructor Done;
end;
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
                        IMPLEMENTATION

Constructor CSource.Init(aName : Integer;aLambda:real);
Begin
  Name := aName;
  SType := SOURCE_EASIEST;
  Lambda := aLambda;
  Reset;
end;{CSource.Init}
{-------------------------------------------------------------------------}
Procedure CSource.Reset;
Begin
  LastTime :=0; NewTime:=0;
  TotalReq :=0;
  DoneReq :=0;
  RefusedReq:=0;
  WaitTime :=0;
  ProbRefuse:=0;
  MatWait  :=0;
end;{CSource.Reset}
{-------------------------------------------------------------------------}
Procedure CSource.GenNewReq;
Begin
  LastTime := NewTime; 
  NewTime := LastTime - Ln(Random)/Lambda;
  Inc(TotalReq);
  LastReq.Birth := NewTime;
  LastReq.Death := -1.0;
  LastReq.FromSource := @Self;
end;{CSource.GenNewReq}
{-------------------------------------------------------------------------}
Destructor CSource.Done;
begin
end;
{-------------------------------------------------------------------------}
{    CDevice    }
Constructor CDevice.Init(aLambda:real);
begin
  Lambda := aLambda;
  Reset;
end;{CDevice.Init}
{=========================================}
Procedure CDevice.Reset;
begin
  LastTime := 0;
  DoneTime := 0;
  Stoppage := 0;
  IsWorking := false;
end;{CDevice.Reset}
{---------------------------}
Function CDevice.AddReq(aCurReq : PReq;aCurTime:real):boolean; {� ç «® ®¡à ¡®âª  § ¯à®á }
begin
  AddReq := false;
  if not isWorking then
   begin
    BegTime   := aCurTime;
    Stoppage  := Stoppage + (BegTime-LastTime);
    DoneTime  := BegTime - Ln(Random)/Lambda;
    IsWorking := true;
    CurWorking := aCurReq^;
    CurWorking.ToDevice := @Self;
    AddReq    := true;      
   end;
end;{CDevice.AddReq}
{=========================================}
Function CDevice.DoneWork:PReq; 
begin
  DoneWork := nil;
  if isWorking then   
   begin
     LastTime := DoneTime;
     CurWorking.Death := DoneTime;
     DoneWork := @CurWorking;
     isWorking := false;
   end;
end;{CDevice.DoneWork}
{=========================================}
Destructor CDevice.Done;
begin
end;{CDevice.Done}
{=========================================}

{  CBuffer  } 
Constructor CBuffer.Init(aBufLen:integer); 
begin
  BufType := BUFFER_LIFO;
  BufferLength := aBufLen;
  CellCount := 0;
  GetMem(Data,Sizeof(TReq)*BufferLength);
  FillChar(Data^,Sizeof(TReq)*BufferLength,0);
end;{CBuffer.Init}
{-----------------------}
Destructor CBuffer.Done;
begin
  FreeMem(Data,Sizeof(TReq)*BufferLength); {Dispose(data)}
  BufferLength:=0;
end;{CBuffer.Done}
{-----------------------}
Function CBuffer.SetBufferSize(aNewSize:integer):boolean;
var
 NewBuf : PReqArray;
begin
 SetBufferSize := false;
 if aNewSize > BufferLength then
  begin
   GetMem(NewBuf,Sizeof(TReq)*aNewSize);
   FillChar(NewBuf^,Sizeof(TReq)*aNewSize,0);
   Move(Data^,NewBuf^,Sizeof(TReq)*BufferLength);
   FreeMem(Data,Sizeof(TReq)*BufferLength);
   Data := NewBuf;
   BufferLength := aNewSize;
   SetBufferSize := true;
  end;
end;{CBuffer.SetBufferSize}
{-----------------------}
Function CBuffer.AddReq(var aNew, rKicked:TReq):boolean;
begin
  if CellCount=BufferLength then {�  á ¬®¬ ¤¥«¥, â.ª á 0, â® ¡®«ìè¥}
   begin
     AddReq := false;
     rKicked := Data^[0];
     rKicked.Death := aNew.Birth; {‡ ¯à®á ®âª«®­¥­, ¢ ¬®¬¥­â, ª®£¤  ­®¢ë© ¯à¨¡ë«,
                                    â.¥. ª®£¤  â®â ¡ë« ᮧ¤ ­}
     Move(Data^[1],Data^[0], SizeOf(TReq) * (BufferLength-1));
     Data^[CellCount-1] := aNew;
   end
  else
   begin
     AddReq := true;
     Data^[CellCount] := aNew;
     Inc(CellCount);
   end;
end;{CBuffer.AddReq}
{-----------------------}
Function CBuffer.GetReq(var rReq:TReq):boolean;
begin
 GetReq := false;
 if CellCount > 0 then
  begin
   rReq := Data^[CellCount-1];
   Dec(CellCount);
   GetReq := true;
  end;
end;{CBuffer.GetReq}
{---------------------------------------------}
Procedure CBuffer.FreeBuffer;
begin
 CellCount := 0;
end;
{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

Constructor CModel.Init(aBegSrcCnt:integer;aDev:PDevice;aBuf:PBuffer;
                       aDel,aDov:Real);
Begin
  MaxSrc := aBegSrcCnt;
  GetMem(Sources,Sizeof(PSource)*MaxSrc);
  SourceCnt := 0;
  CalcVer := true;
  RealizSteps := 100;
  Buffer := aBuf;
  Device := aDev;
  Delta := aDel;
  DovInt := aDov;
  Reset;
end;{CModel.Init}
{---------------------------------------------------------}
Procedure CModel.Reset;
begin
  NextSource:=0;
  CurTime := 0;
  CurStep := 0;
  DoneCount := 0;
  RefusedCount := 0;
  RealizSteps := 100;
  TotalCount := 0;
  Working := false;
end;{CModel.Reset}
{------------------------------------------------------------------}
Function CModel.SetSourceCount(aNewCnt:integer):boolean;
var
 NewBuf : PSourceArr;
Begin
 SetSourceCount := false;
 if aNewCnt > MaxSrc then
  begin
   GetMem(NewBuf,Sizeof(PSource)*aNewCnt);
   Move(Sources^,NewBuf^,Sizeof(PSource)*MaxSrc);
   FreeMem(Sources,Sizeof(PSource)*MaxSrc);
   Sources := NewBuf;
   MaxSrc := aNewCnt;
   SetSourceCount := true;
  end;
end;{CModel.SetSourceCount}
{------------------------------------------------------------------}
Function CModel.AddNewSource(aNewSrc:PSource):boolean;
Begin
  if SourceCnt >= MaxSrc then AddNewSource := SetSourceCount(MaxSrc+1);
  Sources^[SourceCnt] := aNewSrc;
  Inc(SourceCnt);
end;{CModel.AddNewSource}
{------------------------------------------------------------------}
Function CModel.RemoveSource(aName:integer):boolean;
var
 c : integer;
Begin
  RemoveSource := false;
  if SourceCnt = 1 then exit;  
  for c := 0 to SourceCnt-1 do if Sources^[c]^.Name = aName then break;
  if c = SourceCnt-1 then exit;
  Dispose(Sources^[c],Done);
  while c <> SourceCnt-1 do
   begin
    Sources^[c] := Sources^[c+1];
    inc(c);
   end;
  Dec(SourceCnt);
end;{CModel.RemoveSource}
{------------------------------------------------------------------}
Procedure CModel.SetNextSource; {� å®¤¨â NextSource}
var
 c      : integer;
begin
 NextSource := 0;
 for c := 0 to SourceCnt-1 do
 begin
  if (Sources^[c]^.NewTime < Sources^[NextSource]^.NewTime) then
   NextSource := c;
 end;
end;{CModel.SetNextSource}
{------------------------------------------------------------------}
Procedure CModel.Start;
var
 c,First : integer;
begin
 if (Device=nil) or (Buffer=nil) or (SourceCnt=0) then exit;
 Reset;
 Device^.Reset;
 Buffer^.FreeBuffer;

 First := 0;
 for c := 0 to SourceCnt-1 do
 begin
  Sources^[c]^.Reset;
  Sources^[c]^.GenNewReq;
  if (Sources^[c]^.NewTime < Sources^[First]^.NewTime) then
    First := c;
 end;
 WorkReq := Sources^[First]^.LastReq;
 Device^.AddReq(@WorkReq,Sources^[First]^.NewTime);
 Sources^[First]^.GenNewReq;

 SetNextSource;

 Working := true;
end;
{------------------------------------------------------------------}
Function CModel.TestVer:boolean;
var
 NewV,c,p:real;
 i : integer;
begin
 NewV:=0;
 TestVer:=true;
 for i := 0 to SourceCnt-1 do if Sources^[i]^.RefusedReq <> 0 then
  begin
   p := 1.0 * Sources^[i]^.RefusedReq / Sources^[i]^.TotalReq;
   c := (DovInt*(1-p))/(Delta*Delta*p);
   if c > NewV then NewV := c;
  end;
 if NewV > RealizSteps then
  begin
   RealizSteps := round(NewV);
   TestVer := false;
  end;
end;{CModel.TextVer}
{------------------------------------------------------------------}
Function CModel.Step:boolean;
var
 Kicked : TReq;
 i      : integer;
 ret    : boolean;
Begin
 Step := false;
 if Not Working then exit;
 ret := false; {‘ç¨â ¥¬, çâ® ¯à®¤®«¦ âì ­¥ ¡ã¤¥¬}

 if (not CalcVer) AND (CurStep > RealizSteps) then exit;

 for i:=0 to SourceCnt-1 do if Sources^[i]^.TotalReq < RealizSteps then
   ret:=true;

 if (not ret) AND CalcVer then ret := not TestVer;
  if Device^.DoneTime < Sources^[NextSource]^.NewTime then
   begin
    CurTime := Device^.DoneTime;
    WorkReq := Device^.DoneWork^;
    inc(DoneCount);
    inc(TotalCount);
    inc(WorkReq.FromSource^.DoneReq);

    WorkReq.FromSource^.WaitTime := WorkReq.FromSource^.WaitTime +
      WorkReq.Death - WorkReq.Birth;

    if Buffer^.GetReq(WorkReq) then
     begin {‚ ¡ãä¥à¥ ­ å®¤¨« áì § ï¢ª }
       WorkReq.FromSource^.MatWait := WorkReq.FromSource^.MatWait +
        CurTime-WorkReq.Birth;
       Device^.AddReq(@WorkReq,CurTime);
     end
    else {Need to gen new req}
     begin
       Device^.AddReq(@Sources^[NextSource]^.LastReq,Sources^[NextSource]^.LastReq.Birth);
       Sources^[NextSource]^.GenNewReq;
       SetNextSource;
     end;
   end
  else {�«¨¦ ©è¥¥ ᮡë⨥ - £¥­¥à æ¨ï § ¯à®á }
   begin
     CurTime := Sources^[NextSource]^.NewTime;
     if not Buffer^.AddReq(Sources^[NextSource]^.LastReq,Kicked) then
      begin
        inc(Kicked.FromSource^.RefusedReq);

        {Kicked.FromSource^.WaitTime := Kicked.FromSource^.WaitTime +
         Kicked.Death-Kicked.Birth;}

        Inc(RefusedCount);
        Inc(TotalCount);
      end;
     Sources^[NextSource]^.GenNewReq;
     SetNextSource;
   end; {}
 inc(CurStep);
 Step := ret;
end;{CModel.Step}
{------------------------------------------------------------------}
Procedure CModel.PrintValues(var F:Text);
var
 i : integer;
begin
  WriteLn(F,'Žâ­. â®ç­®áâì - ',Delta*100:0:0,'%, ¤®¢. ¨­â ¢ ª¢. - ',DovInt:0:2);
  WriteLn(F,'• à-ª  ¯®â®ª  ¯à¨¡®à  - ', Device^.Lambda:0:2);
  WriteLn(F,'ˆáâ.|‚ᣠ§ ï¢.|Žâª § ï¢.|‚ë¯ § ï¢.|P ®âª.  |Œ â. ®¦ | Ž¡é. ¢à.');
  for i := 0 to SourceCnt-1 do with Sources^[i]^ do
  begin
    write(F,Name:4,' ',TotalReq:9,' ',RefusedReq:9,' ',DoneReq:9,' ',100.0*RefusedReq/TotalReq:6:2,'%  ');
    if DoneReq <> 0 then Write(F,MatWait/DoneReq:8:3,' ') else Write(F,'  ---    ');
    WriteLN(F,WaitTime:0:2);
  end;
  WriteLn(F,'Š®íää¨æ¨¥­â ¯à®áâ®ï ¯à¨¡®à  - ',100*Device^.Stoppage/CurTime:0:2,'%');
  WriteLN(F,'---')
end;{CModel.PrintValues}
{------------------------------------------------------------------}
Destructor CModel.Done;
var
 c : integer;
Begin
  for c:= 0 to SourceCnt-1 do Dispose(Sources^[c],Done);
  FreeMem(Sources,Sizeof(PSource)*MaxSrc);
end;{CModel.Done}
{------------------------------------------------------------------}
END. {EOF}