-
-
Notifications
You must be signed in to change notification settings - Fork 3
/
FastLocks.pas
1530 lines (1269 loc) · 56.5 KB
/
FastLocks.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-------------------------------------------------------------------------------
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at http://mozilla.org/MPL/2.0/.
-------------------------------------------------------------------------------}
{===============================================================================
FastLocks
Simple non-blocking synchronization objects based on interlocked functions
operating on locking counters.
WARNING >>>
This library was written for a specific scenario, where there was tens
of thousand of separate data structures, each of which could have been
accessed by several threads, and where concurrent access was rare but
very possible and dangerous. When a simultaneous access occured, it was
almost always reading.
Creating RW lock for each of the structure was unfeasible, so this
library was written to provide some light-weight locking mechanism with
minimal memory and OS resources footprint. Implementation is therefore
maximally simple, which causes many limitations.
<<< WARNING
Non-blocking behaviour means that any attempt to acquire lock will return
immediatelly, and resulting value of this attempt indicates whether the
lock was really acquired or not.
At this point, only two synchronization primitives/objects are implenented,
critical section and an RW lock (multiple-read exclusive-write
synchronizer). More might be added later, but currently it is unlikely.
For details about how any of the object works and what are its limitations,
refer to its declaration.
In its basic form, each in-here implemented synchronizer is just an integer
residing in the memory. Within this library, this integer is called sync
word.
It is used to store the locking counters and interlocked functions are used
to atomically change and probe stored values and to decide state of the
object and required action.
WARNING - all implemented synchronizers are operating on the same sync
word type (TFLSyncWord), but they are not mutually compatible.
So always use one sync word for only one type of synchronizer,
never mix them on one variable.
All synchronizers can be used either directly, where you allocate a variable
of type TFLSyncWord and then operate on it using procedural interface (eg.
FastCriticalSectionEnter, FastMREWBeginRead, ...), or indirectly,
by creating an instance of provided class and using its methods.
When creating the class instance, you can either provide preallocated sync
word variable or leave its complete management on the instance itself.
This gives you more freedom in deciding how to use the sychnonization - you
can either allocate common sync word and create new instance for each
syhcnronizing thread, or you can create one common instance and use >it< in
all threads.
NOTE - if the sync word variable is located in a shared memory, the
synchronizers can then be used for inter-process synchronization.
Here is a small example how a non-blocking synchronization can be used:
<unsynchronized_code>
--> If CritSect.Enter then
| try
| <synchronized_code>
| finally
| CritSect.Leave;
| end
| else
| begin
| <code_not_needing_sync>
| synchronization not possible, do other things that
| do not need to be synchronized
| end;
-- repeat from start and try synchronization again if needed
<unsynchronized_code>
If you want to use wating, do the following:
<unsynchronized_code>
--> If CritSect.WaitToEnter(500) = wrAcquired then
| try
| <synchronized_code>
| finally
| CritSect.Leave;
| end
| else
| begin
| <code_not_needing_sync>
| end;
-- <repeat_if_needed>
<unsynchronized_code>
Some more important notes on the implementation and use:
- none of the provided synchronizers is robust (when a thread holding
a lock ends without releasing it, it will stay locked indefinitely)
- none of the provided synchronizers is recursive (when attempting to
acquire a lock second time in the same thread, it will always fail)
- there is absolutely no deadlock prevention - be extremely carefull when
trying to acquire synchronizer in more than one place in a single thread
(trying to acquire synchronizer second time in the same thread will
always fail, with exception being MREW reading, which is given by
concept of multiple readers access)
- use provided waiting and spinning only when necessary - synchronizers
are intended to be used as non-blocking
- waiting is always active (spinning) - do not wait for prolonged time
intervals as it might starve other threads, use infinite waiting only
in extreme cases and only when really necessary
- use synchronization by provided objects only on very short (in time,
not code) routines - do not use to synchronize code that is executing
longer than few milliseconds
- every successful acquire of a synchronizer MUST be paired by a release,
synhronizers are not automalically released
Version 1.3.2 (2024-05-02)
Last change 2024-05-02
©2016-2024 František Milt
Contacts:
František Milt: [email protected]
Support:
If you find this code useful, please consider supporting its author(s) by
making a small donation using the following link(s):
https://www.paypal.me/FMilt
Changelog:
For detailed changelog and history please refer to this git repository:
github.com/TheLazyTomcat/Lib.FastLocks
Dependencies:
AuxClasses - github.com/TheLazyTomcat/Lib.AuxClasses
* AuxExceptions - github.com/TheLazyTomcat/Lib.AuxExceptions
AuxTypes - github.com/TheLazyTomcat/Lib.AuxTypes
InterlockedOps - github.com/TheLazyTomcat/Lib.InterlockedOps
Library AuxExceptions is required only when rebasing local exception classes
(see symbol FastLocks_UseAuxExceptions for details).
Library AuxExceptions might also be required as an indirect dependency.
Indirect dependencies:
SimpleCPUID - github.com/TheLazyTomcat/Lib.SimpleCPUID
StrRect - github.com/TheLazyTomcat/Lib.StrRect
UInt64Utils - github.com/TheLazyTomcat/Lib.UInt64Utils
WinFileInfo - github.com/TheLazyTomcat/Lib.WinFileInfo
===============================================================================}
unit FastLocks;
{
FastLocks_UseAuxExceptions
If you want library-specific exceptions to be based on more advanced classes
provided by AuxExceptions library instead of basic Exception class, and don't
want to or cannot change code in this unit, you can define global symbol
FastLocks_UseAuxExceptions to achieve this.
}
{$IF Defined(FastLocks_UseAuxExceptions)}
{$DEFINE UseAuxExceptions}
{$IFEND}
//------------------------------------------------------------------------------
{$IF Defined(WINDOWS) or Defined(MSWINDOWS)}
{$DEFINE Windows}
{$ELSEIF Defined(LINUX) and Defined(FPC)}
{$DEFINE Linux}
{$ELSE}
{$MESSAGE FATAL 'Unsupported operating system.'}
{$IFEND}
{$IFDEF FPC}
{$MODE ObjFPC}
{$MODESWITCH ClassicProcVars+}
{$DEFINE FPC_DisableWarns}
{$INLINE ON}
{$DEFINE CanInline}
{$MACRO ON}
{$ELSE}
{$IF CompilerVersion >= 17} // Delphi 2005+
{$DEFINE CanInline}
{$ELSE}
{$UNDEF CanInline}
{$IFEND}
{$ENDIF}
{$H+}
//------------------------------------------------------------------------------
{
SyncWord64
When this symbol is defined, the type used for sync word (TFLSyncWord), and
therefore the sync word itself, is 64 bits wide, otherwise it is 32 bits wide.
This holds true on all systems.
By default NOT defined.
To enable/define this symbol in a project without changing this library,
define project-wide symbol FastLocks_SyncWord64_On.
}
{.$DEFINE SyncWord64}
{$IFDEF FastLocks_SyncWord64_On}
{$DEFINE SyncWord64}
{$ENDIF}
interface
uses
SysUtils,
AuxTypes, AuxClasses{$IFDEF UseAuxExceptions}, AuxExceptions{$ENDIF};
{===============================================================================
Library-specific exceptions
===============================================================================}
type
EFLException = class({$IFDEF UseAuxExceptions}EAEGeneralException{$ELSE}Exception{$ENDIF});
EFLCounterError = class(EFLException);
EFLInvalidValue = class(EFLException);
{===============================================================================
--------------------------------------------------------------------------------
Fast locks
--------------------------------------------------------------------------------
===============================================================================}
const
FL_DEF_SPIN_DELAY_CNT = 1000; // default value of SpinDelayCount
FL_DEF_WAIT_SPIN_CNT = 1500; // default value of WaitSpinCount
INFINITE = UInt32(-1); // infinite timeout interval
type
TFLSyncWord = {$IFDEF SyncWord64}UInt64{$ELSE}UInt32{$ENDIF};
PFLSyncWord = ^TFLSyncWord;
{
Returned as a result of spinning or waiting.
Informs whether the object was acquired and locked, and if not, for what
reason the locking failed.
wrAcquired - The object was acquired and is now locked. Remember to release
it after the lock is no longer needed.
wrTimeout - Spinning/waiting timed-out, ie. locking was not successful in
a given timeout period.
wrReserved - Spinning/waiting failed and the object was not locked because
it was reserved or the reserve count reached its maximum.
This is not an error, just a limitation of this implementation,
you should try the waiting again after some time.
wrError - Unknown or external error has ocurred, the object might be in
an inconsistent state and should not be used anymore.
}
TFLWaitResult = (wrAcquired,wrTimeout,wrReserved,wrError);
{
In waiting, the function blocks by executing a cycle. Each iteration of this
cycle contains a try to acquire the lock, a check for timeout and a delaying
part that prevents rapid calls to acquire and timers.
TFLWaitDelayMethod enumeration is here to select a method used for this
delaying.
wdNone No delaying action is performed.
wdSpin A spinning will be performed. This is the default operation.
wdYield An attempt to yield execution of current thread is made.
If system has another thread that can be run, the current
thread is suspended, rescheduled and the next thread is run.
If there is no thread awaiting execution, then the current
thread is not suspended and continues execution and pretty
much performs spinning.
WARNING - use with caution, as it can cause spinning with
rapid calls to thread yielding on uncontested CPU.
wdSleep The current thread stops execution (call to Sleep) for no
less than 10ms. Note that this time might actually be longer
because of granularity of scheduling timers, resulting in
slightly longer wait time than is requested.
wdSleepEx Behaves the same as wdSleep, but the thread can be awakened
by APC or I/O completion calls.
NOTE - works only on Windows, everywhere else it behaves
the same as wdSleep.
wdYieldSleep Combination od wdYield and wdSleep - when the thread is not
yielded (eg. because no thread is waiting execution), a sleep
is performed.
NOTE - works only on Windows, everywhere else it behaves
the same as wdSleep.
}
TFLWaitDelayMethod = (wdNone,wdSpin,wdYield,wdSleep,wdSleepEx,wdYieldSleep);
{===============================================================================
--------------------------------------------------------------------------------
TFastLock
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
TFastLock - class declaration
===============================================================================}
type
TFastLock = class(TCustomObject)
protected
fSyncWord: TFLSyncWord;
fSyncWordPtr: PFLSyncWord;
fOwnsSyncWord: Boolean;
fWaitDelayMethod: UInt32;
fWaitSpinCount: UInt32;
fSpinDelayCount: UInt32;
fCounterFreq: Int64;
Function GetWaitDelayMethod: TFLWaitDelayMethod; virtual;
procedure SetWaitDelayMethod(Value: TFLWaitDelayMethod); virtual;
Function GetWaitSpinCount: UInt32; virtual;
procedure SetWaitSpinCount(Value: UInt32); virtual;
Function GetSpinDelayCount: UInt32; virtual;
procedure SetSpinDelayCount(Value: UInt32); virtual;
procedure Initialize(SyncWordPtr: PFLSyncWord); virtual;
procedure Finalize; virtual;
public
constructor Create(var SyncWord: TFLSyncWord); overload; virtual;
constructor Create; overload; virtual;
destructor Destroy; override;
property OwnsSyncWord: Boolean read fOwnsSyncWord;
property WaitDelayMethod: TFLWaitDelayMethod read GetWaitDelayMethod write SetWaitDelayMethod;
property WaitSpinCount: UInt32 read GetWaitSpinCount write SetWaitSpinCount;
property SpinDelayCount: UInt32 read GetSpinDelayCount write SetSpinDelayCount;
end;
{===============================================================================
--------------------------------------------------------------------------------
Fast critical section
--------------------------------------------------------------------------------
===============================================================================}
{
Classical critical section - only one thread can acquire the object, and
while it is locked all subsequent attemps to acquire it will fail.
When spinning or waiting, there is no guarantee that the first thread that
entered this cycle will also acquire the object. The order in which waiting
threads enter the section is undefined and more or less random.
Note that while any thread is in spinning or waiting cycle, the section can
only be entered by spinning or waiting threads, not by a call to enter. This
assures that blocked threads are served before threads which are using the
object asynchronously (as it should be).
}
{===============================================================================
Fast critical section - procedural interface declaration
===============================================================================}
procedure FastCriticalSectionInit(out SyncWord: TFLSyncWord);
procedure FastCriticalSectionFinal(var SyncWord: TFLSyncWord);
Function FastCriticalSectionEnter(var SyncWord: TFLSyncWord): Boolean;
procedure FastCriticalSectionLeave(var SyncWord: TFLSyncWord);
{
A small note on spinning and waiting implementation...
Spinning:
In spinning, a cycle is performed. In each iteration of this cycle, an
attempt to acquire the object is tried. If it is not successful, a delaying
action is executed and then the cycle repeats.
Maximum number of iterations is limited by a parameter SpinCount, unless it
is set to INFINITE, in which case the cycle never terminates.
The delaying action is a small piece of code with no external effects that
is executed multiple times to make this delaying longer. Number of
executions is given in parameter SpinDelayCount.
Waiting:
Waiting is very similar to spinning in that it runs in a cycle, but the
number of iteration is not given explicitly, it depends on a timeout
interval.
In each iteration, and attempt to acquire is made, and when not successful
a delaying action is performed. Nature of this action can be selected by
a parameter WaitDelayMethod.
One possible delaying action is spinning. In this case, a spin as described
above is performed, with a spin count set to WaitSpinCount.
}
Function FastCriticalSectionSpinToEnter(var SyncWord: TFLSyncWord; SpinCount: UInt32; SpinDelayCount: UInt32 = FL_DEF_SPIN_DELAY_CNT): TFLWaitResult;
Function FastCriticalSectionWaitToEnter(var SyncWord: TFLSyncWord; Timeout: UInt32; WaitDelayMethod: TFLWaitDelayMethod = wdSpin;
WaitSpinCount: UInt32 = FL_DEF_WAIT_SPIN_CNT; SpinDelayCount: UInt32 = FL_DEF_SPIN_DELAY_CNT): TFLWaitResult;
{===============================================================================
--------------------------------------------------------------------------------
TFastCriticalSection
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
TFastCriticalSection - class declaration
===============================================================================}
type
TFastCriticalSection = class(TFastLock)
protected
procedure Initialize(SyncWordPtr: PFLSyncWord); override;
procedure Finalize; override;
public
Function Enter: Boolean; virtual;
procedure Leave; virtual;
Function SpinToEnter(SpinCount: UInt32): TFLWaitResult; virtual;
Function WaitToEnter(Timeout: UInt32): TFLWaitResult; virtual;
end;
{===============================================================================
--------------------------------------------------------------------------------
Fast MREW
--------------------------------------------------------------------------------
===============================================================================}
{
This object can be locked in two principal ways - for reading (read lock) or
for writing (write lock).
Unlike for write lock, where only one can be present at a time, read locks
have counter that allows multiple readers to acquire a read lock.
Acquiring the object for write can only be successful if no reader have a
read lock.
No reader can acquire read lock while the object is locked for writing, or
any thread is spinning or waiting for a write lock (this prevents starving
of writers by readers - waiting writer excludes any reader to acquire read
lock).
The read lock cannot be promoted to write lock - an attempt to acquire write
lock while there is any read lock will always fail.
While waiting for a read lock, it is entirely possible the object will be
locked by other thread for writing. But, as mentioned before, during wait for
write lock, no reader can acquire read lock, even through waiting to read.
The order in which waiting or spinning threads acquire their locks is
undefined.
WARNING - number of readers is limited, 2047 for 32bit sync words (default),
2147483647 for 64bit sync words.
}
{===============================================================================
Fast MREW - procedural interface declaration
===============================================================================}
procedure FastMREWInit(out SyncWord: TFLSyncWord);
procedure FastMREWFinal(var SyncWord: TFLSyncWord);
Function FastMREWBeginRead(var SyncWord: TFLSyncWord): Boolean;
procedure FastMREWEndRead(var SyncWord: TFLSyncWord);
Function FastMREWSpinToRead(var SyncWord: TFLSyncWord; SpinCount: UInt32; SpinDelayCount: UInt32 = FL_DEF_SPIN_DELAY_CNT): TFLWaitResult;
Function FastMREWWaitToRead(var SyncWord: TFLSyncWord; Timeout: UInt32; WaitDelayMethod: TFLWaitDelayMethod = wdSpin;
WaitSpinCount: UInt32 = FL_DEF_WAIT_SPIN_CNT; SpinDelayCount: UInt32 = FL_DEF_SPIN_DELAY_CNT): TFLWaitResult;
Function FastMREWBeginWrite(var SyncWord: TFLSyncWord): Boolean;
procedure FastMREWEndWrite(var SyncWord: TFLSyncWord);
Function FastMREWSpinToWrite(var SyncWord: TFLSyncWord; SpinCount: UInt32; SpinDelayCount: UInt32 = FL_DEF_SPIN_DELAY_CNT): TFLWaitResult;
Function FastMREWWaitToWrite(var SyncWord: TFLSyncWord; Timeout: UInt32; WaitDelayMethod: TFLWaitDelayMethod = wdSpin;
WaitSpinCount: UInt32 = FL_DEF_WAIT_SPIN_CNT; SpinDelayCount: UInt32 = FL_DEF_SPIN_DELAY_CNT): TFLWaitResult;
{===============================================================================
--------------------------------------------------------------------------------
TFastMREW
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
TFastMREW - class declaration
===============================================================================}
type
TFastMREW = class(TFastLock)
protected
procedure Initialize(SyncWordPtr: PFLSyncWord); override;
procedure Finalize; override;
public
Function BeginRead: Boolean; virtual;
procedure EndRead; virtual;
Function BeginWrite: Boolean; virtual;
procedure EndWrite; virtual;
Function SpinToRead(SpinCount: UInt32): TFLWaitResult; virtual;
Function WaitToRead(Timeout: UInt32): TFLWaitResult; virtual;
Function SpinToWrite(SpinCount: UInt32): TFLWaitResult; virtual;
Function WaitToWrite(Timeout: UInt32): TFLWaitResult; virtual;
end;
// full-name alias
TFastMultiReadExclusiveWriteSynchronizer = TFastMREW;
implementation
uses
{$IFDEF Windows}
Windows,
{$ELSE}
baseunix, linux,
{$ENDIF}
InterlockedOps;
{$IFDEF FPC_DisableWarns}
{$DEFINE FPCDWM}
{$DEFINE W5024:={$WARN 5024 OFF}} // Parameter "$1" not used
{$ENDIF}
{===============================================================================
--------------------------------------------------------------------------------
Fast locks
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
Fast locks - internal functions
===============================================================================}
Function SpinDelay(Divisor: UInt32): UInt32; // do not inline
begin
// just some contained, relatively long, but othervise pointless operation
Result := UInt32(3895731025) div Divisor;
end;
//------------------------------------------------------------------------------
Function GetCounterFrequency(out Freq: Int64): Boolean;
{$IFNDEF Windows}
var
Time: TTimeSpec;
{$ENDIF}
begin
{$IFDEF Windows}
Freq := 0;
Result := QueryPerformanceFrequency(Freq);
{$ELSE}
Freq := 1000000000{ns};
Result := clock_getres(CLOCK_MONOTONIC_RAW,@Time) = 0;
{$ENDIF}
If Freq and Int64($1000000000000000) <> 0 then
raise EFLInvalidValue.CreateFmt('GetCounterFrequency: Unsupported frequency value (0x%.16x)',[Freq]);
end;
//------------------------------------------------------------------------------
Function GetCounterValue(out Count: Int64): Boolean;
{$IFNDEF Windows}
var
Time: TTimeSpec;
{$ENDIF}
begin
{$IFDEF Windows}
Count := 0;
Result := QueryPerformanceCounter(Count);
{$ELSE}
Result := clock_gettime(CLOCK_MONOTONIC_RAW,@Time) = 0;
Count := Int64(Time.tv_sec) * 1000000000 + Time.tv_nsec;
{$ENDIF}
// mask out bit 63 to prevent problems with signed 64bit integer
Count := Count and Int64($7FFFFFFFFFFFFFFF);
end;
//------------------------------------------------------------------------------
{$IFDEF Windows}
{$IF not Declared(SwitchToThread)}
Function SwitchToThread: BOOL; stdcall; external kernel32;
{$IFEND}
{$ELSE}
{
FPC declares sched_yield as procedure without result, which afaik does not
correspond to linux man.
}
Function sched_yield: cint; cdecl; external;
{$ENDIF}
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function YieldThread: Boolean;{$IFDEF CanInline} inline;{$ENDIF}
begin
{$IFDEF Windows}
Result := SwitchToThread;
{$ELSE}
Result := sched_yield = 0;
{$ENDIF}
end;
{===============================================================================
Fast locks - imlementation constants
===============================================================================}
const
FL_UNLOCKED = TFLSyncWord(0);
FL_INVALID = TFLSyncWord(-1); // used to finalize the objects
{===============================================================================
Fast locks - waiting and spinning implementation
===============================================================================}
type
TFLSpinParams = record
SyncWordPtr: PFLSyncWord;
SpinCount: UInt32;
SpinDelayCount: UInt32;
Reserve: Boolean;
Reserved: Boolean;
FceReserve: Function(var SyncWord: TFLSyncWord): Boolean;
FceUnreserve: procedure(var SyncWord: TFLSyncWord);
FceAcquire: Function(var SyncWord: TFLSyncWord; Reserved: Boolean; out FailedDueToReservation: Boolean): Boolean;
end;
//------------------------------------------------------------------------------
Function _DoSpin(Params: TFLSpinParams): TFLWaitResult;
Function InternalSpin(Reserved: Boolean): TFLWaitResult;
Function SpinDelayAndCount: Boolean;
var
i: Integer;
begin
// do some delaying and decrease spin count if not in infinite spinning
For i := 1 to Params.SpinDelayCount do
SpinDelay(i);
If Params.SpinCount <> INFINITE then
Dec(Params.SpinCount);
Result := Params.SpinCount > 0;
end;
var
FailedDueToReservation: Boolean;
begin
while not Params.FceAcquire(Params.SyncWordPtr^,Reserved,FailedDueToReservation) do
If not FailedDueToReservation then
begin
// acquire failed for other reason than reservation
If not SpinDelayAndCount then
begin
// spin count reached zero
Result := wrTimeout;
Exit;
end;
end
else
begin
// acquire failed due to reservation
Result := wrReserved;
Exit;
end;
// if we are here, acquire was successful
Result := wrAcquired;
end;
begin
try
If Params.Reserve then
begin
If Params.FceReserve(Params.SyncWordPtr^) then
try
Result := InternalSpin(True);
finally
Params.FceUnreserve(Params.SyncWordPtr^);
end
else Result := wrReserved;
end
else Result := InternalSpin(Params.Reserved);
except
Result := wrError;
end;
end;
//==============================================================================
type
TFLWaitParams = record
SyncWordPtr: PFLSyncWord;
Timeout: UInt32;
WaitDelayMethod: TFLWaitDelayMethod;
WaitSpinCount: UInt32;
SpinDelayCount: UInt32;
Reserve: Boolean;
FceReserve: Function(var SyncWord: TFLSyncWord): Boolean;
FceUnreserve: procedure(var SyncWord: TFLSyncWord);
FceAcquire: Function(var SyncWord: TFLSyncWord; Reserved: Boolean; out FailedDueToReservation: Boolean): Boolean;
CounterFrequency: Int64;
StartCount: Int64;
end;
//------------------------------------------------------------------------------
Function _DoWait(Params: TFLWaitParams): TFLWaitResult;
Function InternalWait(Reserved: Boolean): TFLWaitResult;
Function GetElapsedMillis: UInt32;
var
CurrentCount: Int64;
begin
If GetCounterValue(CurrentCount) then
begin
If CurrentCount < Params.StartCount then
Result := ((High(Int64) - Params.StartCount + CurrentCount) * 1000) div Params.CounterFrequency
else
Result := ((CurrentCount - Params.StartCount) * 1000) div Params.CounterFrequency;
end
else Result := UInt32(-1);
end;
var
FailedDueToReservation: Boolean;
SpinParams: TFLSpinParams;
begin
while not Params.FceAcquire(Params.SyncWordPtr^,Reserved,FailedDueToReservation) do
If not FailedDueToReservation then
begin
// acquire failed for other reason than reservation, check elapsed time
If (Params.TimeOut <> INFINITE) and (GetElapsedMillis >= Params.TimeOut) then
begin
// timeout elapsed
Result := wrTimeout;
Exit;
end
else
begin
// still in timeout period, do delaying
case Params.WaitDelayMethod of
wdNone:; // do nothing;
wdYield: YieldThread;
{$IFDEF Windows}
wdSleep: Sleep(10);
wdSleepEx: SleepEx(10,True);
wdYieldSleep: If not YieldThread then
Sleep(10);
{$ELSE}
wdSleep,
wdSleepEx,
wdYieldSleep: Sleep(10);
{$ENDIF}
else
{wdSpin}
// fill parameters for spinning
SpinParams.SyncWordPtr := Params.SyncWordPtr;
SpinParams.SpinCount := Params.WaitSpinCount;
SpinParams.SpinDelayCount := Params.SpinDelayCount;
SpinParams.Reserve := False;
SpinParams.Reserved := Reserved;
SpinParams.FceReserve := Params.FceReserve;
SpinParams.FceUnreserve := Params.FceUnreserve;
SpinParams.FceAcquire := Params.FceAcquire;
case _DoSpin(SpinParams) of
wrAcquired: Break{while};
wrTimeout:; // just continue, spinning completed without acquire
wrReserved: begin
Result := wrReserved;
Exit;
end;
else
Result := wrError;
Exit;
end;
end
end;
end
else
begin
// acquire failed due to reservation
Result := wrReserved;
Exit;
end;
Result := wrAcquired;
end;
begin
If GetCounterValue(Params.StartCount) then
begin
If Params.Reserve then
begin
If Params.FceReserve(Params.SyncWordPtr^) then
try
Result := InternalWait(True);
finally
Params.FceUnreserve(Params.SyncWordPtr^);
end
else Result := wrReserved;
end
else Result := InternalWait(False);
end
else Result := wrError;
end;
{===============================================================================
--------------------------------------------------------------------------------
TFastLock
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
TFastLock - class implementation
===============================================================================}
{-------------------------------------------------------------------------------
TFastLock - protected methods
-------------------------------------------------------------------------------}
Function TFastLock.GetWaitDelayMethod: TFLWaitDelayMethod;
begin
Result := TFLWaitDelayMethod(InterlockedLoad(fWaitDelayMethod));
end;
//------------------------------------------------------------------------------
procedure TFastLock.SetWaitDelayMethod(Value: TFLWaitDelayMethod);
begin
InterlockedStore(fWaitDelayMethod,UInt32(Ord(Value)));
end;
//------------------------------------------------------------------------------
Function TFastLock.GetWaitSpinCount: UInt32;
begin
Result := InterlockedLoad(fWaitSpinCount);
end;
//------------------------------------------------------------------------------
procedure TFastLock.SetWaitSpinCount(Value: UInt32);
begin
InterlockedStore(fWaitSpinCount,Value);
end;
//------------------------------------------------------------------------------
Function TFastLock.GetSpinDelayCount: UInt32;
begin
Result := InterlockedLoad(fSpinDelayCount);
end;
//------------------------------------------------------------------------------
procedure TFastLock.SetSpinDelayCount(Value: UInt32);
begin
InterlockedStore(fSpinDelayCount,Value);
end;
//------------------------------------------------------------------------------
procedure TFastLock.Initialize(SyncWordPtr: PFLSyncWord);
begin
fSyncWord := FL_UNLOCKED;
fSyncWordPtr := SyncWordPtr;
fOwnsSyncWord := fSyncWordPtr = Addr(fSyncWord);
SetWaitDelayMethod(wdSpin);
SetWaitSpinCount(FL_DEF_WAIT_SPIN_CNT);
SetSpinDelayCount(FL_DEF_SPIN_DELAY_CNT);
If not GetCounterFrequency(fCounterFreq) then
raise EFLCounterError.CreateFmt('TFastLock.Initialize: Cannot obtain counter frequency (0x%.8x).',
[{$IFDEF Windows}GetLastError{$ELSE}errno{$ENDIF}]);
end;
//------------------------------------------------------------------------------
procedure TFastLock.Finalize;
begin
fSyncWordPtr := nil;
end;
{-------------------------------------------------------------------------------
TFastLock - public methods
-------------------------------------------------------------------------------}
constructor TFastLock.Create(var SyncWord: TFLSyncWord);
begin
inherited Create;
Initialize(@SyncWord);
end;
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
constructor TFastLock.Create;
begin
inherited Create;
Initialize(@fSyncWord);
end;
//------------------------------------------------------------------------------
destructor TFastLock.Destroy;
begin
Finalize;
inherited
end;
{===============================================================================
--------------------------------------------------------------------------------
Fast critical section
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
Fast critical section - imlementation constants
===============================================================================}
{
Meaning of bits in sync word for fast critical section:
32bit 64bit
0..15 0..31 - acquire count
16..31 32..63 - reserve count
}
const
{$IFDEF SyncWord64}
FL_CS_ACQUIRE_DELTA = TFLSyncWord($0000000000000001);
FL_CS_ACQUIRE_MASK = TFLSyncWord($00000000FFFFFFFF);
FL_CS_ACQUIRE_MAX = TFLSyncWord(2147483647); // 0x7FFFFFFF
FL_CS_ACQUIRE_SHIFT = 0;
FL_CS_RESERVE_DELTA = TFLSyncWord($0000000100000000);
FL_CS_RESERVE_MASK = TFLSyncWord($FFFFFFFF00000000);
FL_CS_RESERVE_MAX = TFLSyncWord(2147483647); // 0x7FFFFFFF
FL_CS_RESERVE_SHIFT = 32;
{$ELSE} //- - - - - - - - - - - - - - - - - - - - - - - -
FL_CS_ACQUIRE_DELTA = TFLSyncWord($00000001);
FL_CS_ACQUIRE_MASK = TFLSyncWord($0000FFFF);
FL_CS_ACQUIRE_MAX = TFLSyncWord(32767); // 0x7FFF
FL_CS_ACQUIRE_SHIFT = 0;
FL_CS_RESERVE_DELTA = TFLSyncWord($00010000);
FL_CS_RESERVE_MASK = TFLSyncWord($FFFF0000);
FL_CS_RESERVE_MAX = TFLSyncWord(32767); // 0x7FFF
FL_CS_RESERVE_SHIFT = 16;
{$ENDIF}
{===============================================================================
Fast critical section - procedural interface implementation
===============================================================================}
{-------------------------------------------------------------------------------
Fast critical section - internal functions
-------------------------------------------------------------------------------}
Function _FastCriticalSectionReserve(var SyncWord: TFLSyncWord): Boolean;
var
OldSyncWord: TFLSyncWord;
begin
OldSyncWord := InterlockedExchangeAdd(SyncWord,FL_CS_RESERVE_DELTA);
Result := ((OldSyncWord and FL_CS_RESERVE_MASK) shr FL_CS_RESERVE_SHIFT) < FL_CS_RESERVE_MAX;
If not Result then
InterlockedExchangeSub(SyncWord,FL_CS_RESERVE_DELTA);
end;
//------------------------------------------------------------------------------
procedure _FastCriticalSectionUnreserve(var SyncWord: TFLSyncWord);
begin
InterlockedExchangeSub(SyncWord,FL_CS_RESERVE_DELTA);
end;
//------------------------------------------------------------------------------
Function _FastCriticalSectionEnter(var SyncWord: TFLSyncWord; Reserved: Boolean; out FailedDueToReservation: Boolean): Boolean;
var
OldSyncWord: TFLSyncWord;
begin
FailedDueToReservation := False;
OldSyncWord := InterlockedExchangeAdd(SyncWord,FL_CS_ACQUIRE_DELTA);
If ((OldSyncWord and FL_CS_ACQUIRE_MASK) shr FL_CS_ACQUIRE_SHIFT) < FL_CS_ACQUIRE_MAX then
begin
If Reserved then
Result := (((OldSyncWord and FL_CS_RESERVE_MASK) shr FL_CS_RESERVE_SHIFT) <> 0) and
(((OldSyncWord and FL_CS_ACQUIRE_MASK) shr FL_CS_ACQUIRE_SHIFT) = 0)
else
Result := OldSyncWord = 0;
end
else Result := False;
If not Result then
InterlockedExchangeSub(SyncWord,FL_CS_ACQUIRE_DELTA);
end;
//------------------------------------------------------------------------------