home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyReferences.p < prev    next >
Encoding:
Text File  |  1996-10-20  |  5.7 KB  |  198 lines  |  [TEXT/CWIE]
  1. unit MyReferences;
  2.  
  3. interface
  4.  
  5.     const
  6.         nil_reference = 0;
  7.         
  8.     type
  9.         ReferenceID = longint;
  10.         ReferenceData = longint;
  11.     
  12.     procedure StartupReferences;
  13.     
  14.     procedure MakeNewReference(var ref:ReferenceID; data:univ ReferenceData);
  15.     function GetReferenceInfo(ref:ReferenceID; var data:univ ReferenceData):Boolean;
  16.     procedure GetReferenceData(ref:ReferenceID; var data:univ ReferenceData); { defaults to -1 if not found }
  17.     procedure GetReferenceDataPtr(ref:ReferenceID; var data:univ ReferenceData); { defaults to nil if not found }
  18.     procedure SetReferenceData(ref:ReferenceID; data:univ ReferenceData);
  19.     
  20. {
  21.     References thast have not been used/accessed in over five minutes are deleted
  22.     Reference IDs will almost never be resused
  23.     MakeNewReference must not be called at interupt time, and make take some time (<1 tick), and may allocate memory
  24.     Get/SetReferenceData/DataPtr can be called at interupt time, but requires A5 valid, and are very fast
  25. }
  26.     
  27. implementation
  28.  
  29.     uses
  30.         Events, LowMem, MyMemory, MyStartup;
  31.     
  32.     const
  33.         minimum_life_time = 5*60{*60};
  34.     const
  35.         entries_array_bits = 6;
  36.         entries_array_array_bits = 6;
  37.         unique_bits = 32 - entries_array_array_bits - entries_array_bits;
  38.     const
  39.         entries_array_array_bit_pos = 32 - entries_array_array_bits;
  40.         entries_array_bit_pos = entries_array_array_bit_pos - entries_array_bits;
  41.         unqiue_bit_pos = 0;
  42.     const
  43.         entries_array_array_count = longint(2)**entries_array_array_bits;
  44.         entries_array_count = longint(2)**entries_array_bits;
  45.         unique_count = longint(2)**unique_bits;
  46.         
  47.     type
  48.         EntryRecord = record
  49.             ref:ReferenceID;
  50.             data:ReferenceData;
  51.             last_access_time:longint;
  52.         end;
  53.         EntryArray = array[0..entries_array_count-1] of EntryRecord;
  54.         EntryArrayPtr = ^EntryArray;
  55.         EntryArrayArray = array[0..entries_array_array_count-1] of EntryArrayPtr;
  56.     
  57.     var
  58.         arrayarray:EntryArrayArray;
  59.     
  60.     procedure SplitRef(ref:ReferenceID; var i, j, unique:longint);
  61.     begin
  62.         i := BAND(BSR(ref, entries_array_array_bit_pos),entries_array_array_count-1);
  63.         j := BAND(BSR(ref, entries_array_bit_pos),entries_array_count-1);
  64.         unique := BAND(BSR(ref, unqiue_bit_pos),unique_count-1);
  65.     end;
  66.     
  67.     procedure JoinRef(i, j, unique:longint; var ref:ReferenceID);
  68.     begin
  69.         ref := BSL(i, entries_array_array_bit_pos) + BSL(j, entries_array_bit_pos) + BSL(unique, unqiue_bit_pos);
  70.     end;
  71.     
  72.     procedure MakeNewReference(var ref:ReferenceID; data:univ ReferenceData);
  73.         var
  74.             index_i, index_j, i, j, unique, time_minus_5, best_time, current_time:longint;
  75.     begin
  76.         ref := nil_reference;
  77.         current_time := LMGetTicks;
  78.         time_minus_5 := current_time - minimum_life_time;
  79.         best_time := time_minus_5;
  80.         index_i := -1;
  81.         while index_i < 0 do begin
  82.             for i := 0 to entries_array_array_count - 1 do begin
  83.                 if arrayarray[i] = nil then begin
  84.                     leave;
  85.                 end;
  86.                 for j := 0 to entries_array_count - 1 do begin
  87.                     if arrayarray[i]^[j].last_access_time < best_time then begin
  88.                         best_time := arrayarray[i]^[j].last_access_time;
  89.                         index_i := i;
  90.                         index_j := j;
  91.                     end;
  92.                 end;
  93.             end;
  94.             if index_i < 0 then begin
  95.                 for i := 0 to entries_array_array_count - 1 do begin
  96.                     if arrayarray[i] = nil then begin
  97.                         index_i := i;
  98.                         leave;
  99.                     end;
  100.                 end;
  101.                 if index_i >= 0 then begin
  102.                     if MNewPtr(arrayarray[i], SizeOf(EntryArray)) <> noErr then begin
  103.                         index_i := -1;
  104.                     end else begin
  105.                         for j := 0 to entries_array_count - 1 do begin
  106.                             arrayarray[index_i]^[j].ref := nil_reference;
  107.                             arrayarray[index_i]^[j].last_access_time := time_minus_5 - 1;
  108.                         end;
  109.                         index_j := 0;
  110.                     end;
  111.                 end;
  112.                 if index_i < 0 then begin
  113.                     best_time := current_time + 1; { this is not good, but is pratcially impossible }
  114.                 end;
  115.             end;
  116.         end;
  117.         ref := arrayarray[index_i]^[index_j].ref;
  118.         if ref = nil_reference then begin
  119.             unique := 1;
  120.         end else begin
  121.             SplitRef(ref, i, j, unique);
  122.             if unique = unique_count - 1 then begin
  123.                 unique := 1;
  124.             end else begin
  125.                 unique := unique + 1;
  126.             end;
  127.         end;
  128.         JoinRef(index_i, index_j, unique, ref);
  129.         arrayarray[index_i]^[index_j].ref := ref;
  130.         arrayarray[index_i]^[index_j].data := data;
  131.         arrayarray[index_i]^[index_j].last_access_time := current_time;        
  132.     end;
  133.     
  134.     function ValidReference(ref:ReferenceID; var i, j, unique:longint):Boolean;
  135.     begin
  136.         ValidReference := false;
  137.         if ref <> nil_reference then begin
  138.             SplitRef(ref, i, j, unique);
  139.             if (0 <= i) & (i < entries_array_array_count) & (arrayarray[i] <> nil) then begin
  140.                 if (0 <= j) & (j < entries_array_count) & (arrayarray[i]^[j].ref = ref) then begin
  141.                     arrayarray[i]^[j].last_access_time := LMGetTicks;
  142.                     ValidReference := true;
  143.                 end;
  144.             end;
  145.         end;
  146.     end;
  147.     
  148.     function GetReferenceInfo(ref:ReferenceID; var data:univ ReferenceData):Boolean;
  149.         var
  150.             i, j, unique:longint;
  151.     begin
  152.         GetReferenceInfo := false;
  153.         data := 0;
  154.         if ValidReference(ref, i, j, unique) then begin
  155.             data := arrayarray[i]^[j].data;
  156.         end;
  157.     end;
  158.     
  159.     procedure GetReferenceData(ref:ReferenceID; var data:univ ReferenceData); { defaults to -1 if not found }
  160.         var
  161.             i, j, unique:longint;
  162.     begin
  163.         data := -1;
  164.         if ValidReference(ref, i, j, unique) then begin
  165.             data := arrayarray[i]^[j].data;
  166.         end;
  167.     end;
  168.     
  169.     procedure GetReferenceDataPtr(ref:ReferenceID; var data:univ ReferenceData); { defaults to nil if not found }
  170.         var
  171.             i, j, unique:longint;
  172.     begin
  173.         data := 0;
  174.         if ValidReference(ref, i, j, unique) then begin
  175.             data := arrayarray[i]^[j].data;
  176.         end;
  177.     end;
  178.     
  179.     procedure SetReferenceData(ref:ReferenceID; data:univ ReferenceData);
  180.         var
  181.             i, j, unique:longint;
  182.     begin
  183.         if ValidReference(ref, i, j, unique) then begin
  184.             arrayarray[i]^[j].data := data;
  185.         end;
  186.     end;
  187.  
  188.     procedure StartupReferences;
  189.         var
  190.             i:longint;
  191.     begin
  192.         for i := 0 to entries_array_array_count - 1 do begin
  193.             arrayarray[i] := nil;
  194.         end;
  195.     end;
  196.     
  197. end.
  198.