home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MySimpleProfile.p < prev    next >
Encoding:
Text File  |  1995-11-02  |  2.0 KB  |  95 lines  |  [TEXT/CWIE]
  1. unit MySimpleProfile;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.     
  8.     type
  9.         MarkString = string[9];
  10.     
  11.     procedure StartupSimpleProfile;
  12.     procedure MarkProfile(mark:MarkString);
  13.     
  14. implementation
  15.  
  16.     uses
  17.         Files,Timer,ToolUtils, MyMemory, MyStartup;
  18.     
  19.     const
  20.         max_profile_marks = 1000;
  21.     
  22.     type
  23.         ProfileMark=record
  24.             mark:MarkString;
  25.             time:longInt;
  26.         end;
  27.         ProfileMarksArray=array[1..max_profile_marks] of ProfileMark;
  28.         ProfileMarksArrayPtr=^ProfileMarksArray;
  29.         
  30.     var
  31.         start_time: UnsignedWide;
  32.         profile_mark:longInt;
  33.         profile_marks:ProfileMarksArrayPtr;
  34.     
  35.     procedure MarkProfile(mark:MarkString);
  36.         var
  37.             current_time: UnsignedWide;
  38.     begin
  39.         if (profile_marks<>nil) & (profile_mark<max_profile_marks) then begin
  40.             Microseconds(current_time);
  41.             Inc(profile_mark);
  42.             profile_marks^[profile_mark].mark := mark;
  43.             profile_marks^[profile_mark].time := current_time.lo - start_time.lo;
  44.         end;
  45.     end;
  46.     
  47.     function InitSimpleProfile(var msg: integer): OSStatus;
  48.     begin
  49.         msg := msg; { Unused }
  50.         profile_mark := 0;
  51.         InitSimpleProfile := MNewPtr(profile_marks, SizeOf(ProfileMarksArray));
  52.     end;
  53.     
  54.     procedure FinishSimpleProfile;
  55.         var
  56.             fs:FSSpec;
  57.             junk,err:OSErr;
  58.             i:longInt;
  59.             rn:integer;
  60.             s,t:Str255;
  61.             lasttime,thistime:longInt;
  62.             count:longInt;
  63.     begin
  64.         junk:=FSMakeFSSpec(-1,2,'Profile Dump',fs);
  65.         junk:=FSpDelete(fs);
  66.         if profile_mark > 0 then begin
  67.             err := FSpCreate(fs,'R*ch','TEXT',0);
  68.             err := FSpOpenDF(fs,fsRdWrPerm,rn);
  69.             if err=noErr then begin
  70.                 lasttime := profile_marks^[1].time;
  71.                 for i := 1 to profile_mark do begin
  72.                     s := profile_marks^[i].mark;
  73.                     thistime := profile_marks^[i].time;
  74.                     NumToString(thistime,t);
  75.                     s := concat(s, chr(9), t);
  76.                     NumToString(thistime-lasttime,t);
  77.                     s := concat(s, chr(9), t);
  78.                     lasttime := thistime;
  79.                     s := concat(s, chr(13));
  80.                     count := length(s);
  81.                     err := FSWrite(rn, count, @s[1]);
  82.                 end;
  83.                 junk := FSClose(rn);
  84.             end;
  85.         end;
  86.         MDisposePtr(profile_marks);
  87.     end;
  88.     
  89.     procedure StartupSimpleProfile;
  90.     begin
  91.         SetStartup(InitSimpleProfile, nil, 0, FinishSimpleProfile);
  92.     end;
  93.     
  94. end.
  95.