-
-
Notifications
You must be signed in to change notification settings - Fork 3
/
ProcessGlobalVars.pas
3160 lines (2701 loc) · 105 KB
/
ProcessGlobalVars.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/.
-------------------------------------------------------------------------------}
{===============================================================================
Process-Global Variables
This library provides a way of sharing global variables across different
modules loaded within single process without a need for explicit
cooperation.
One might ask why is this needed - in the end, all code loaded in one
virtual address space can see everything thereof, including not only global
variables, but even the local ones (unless they are register-only) and more.
This is true, but there are several problems with that, namely:
- module cannot find any specific variable within the memory that was
allocated in a different module without communicating/receiving its
address
- if some variable is to be shared, it must be created only once per
entire process and then kept alive the entire time it is needed
- the variable cannot be statically allocated (ie. defined), because
the moment its parent module is unloaded, it dissapears or becomes
inaccessible
- whatewer the implementation, it cannot reference anything within any
module (code, data, resources, nothing...), including its own (so no
classes), because you never know who created what a who will be
unloaded and when
- allocation cannot be done using integrated memory manager, simply
because every module can use a different one and what's more, each
is running separately from managers in other modules
Most of the mentioned problems can be solved by implementing the sharing
and allocating mechanism in a separate dynamic library (DLL/SO) - but that
is exactly what I wanted to avoid, because it requires that this dynamic
library is deployed with every single program or library that uses such
system. This unit implements standalone solution - no external DLL/SO is
needed.
Another possible solution is also to use memory-mapped files, but that is
too heavy-weight for envisioned common use cases (sharing few numbers or
maybe some limited resources).
I will not delve into implementation details (read the code if you are
interested and brave enough - note that the mechanisms used are the same
both in Windows and Linux), but some things need to be clarified...
To sum what this library does - it allows you to allocate a global
variable that can then be found by and accessed in completely different
module within the same process. It can be used eg. for sharing information
that needs to be global within the entire program.
Entire interface is procedural (so no objects), see above why. It can
be wrapped in classes/objects, but those would be local-only to module
running them.
The variables are distinguished and searched for by their 32bit numeral
identifiers (meaning there is a technical limit of about four billion
distinct variables).
There are functions accepting string identifiers, but those are only
for the sake of convenience - the strings are always converted to
integers using Alder32 checksum algorithm and these integer values are
then used as identifiers. This means, among others, that two different
strings can point to the same variable.
The implementation also contains what is called "internal compatibility
version" (ICV) - only libraries with the same version can share data.
This mechanism is here to prevent problems when/if this library changes
its internal workings, so libraries with incompatible code do not access
the same internal state and inadvertently corrupt it.
For more information about this library, refer to description of provided
procedural interface and its types.
Version 1.1 (2024-10-25)
Internal compatibility version 1
Last change 2024-10-25
©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.ProcessGlobalVars
Dependencies:
Adler32 - github.com/TheLazyTomcat/Lib.Adler32
* AuxExceptions - github.com/TheLazyTomcat/Lib.AuxExceptions
AuxMath - github.com/TheLazyTomcat/Lib.AuxMath
AuxTypes - github.com/TheLazyTomcat/Lib.AuxTypes
StrRect - github.com/TheLazyTomcat/Lib.StrRect
Library AuxExceptions is required only when rebasing local exception classes
(see symbol ProcessGlobalVars_UseAuxExceptions for details).
Library AuxExceptions might also be required as an indirect dependency.
Indirect dependencies:
AuxClasses - github.com/TheLazyTomcat/Lib.AuxClasses
HashBase - github.com/TheLazyTomcat/Lib.HashBase
SimpleCPUID - github.com/TheLazyTomcat/Lib.SimpleCPUID
StaticMemoryStream - github.com/TheLazyTomcat/Lib.StaticMemoryStream
UInt64Utils - github.com/TheLazyTomcat/Lib.UInt64Utils
WinFileInfo - github.com/TheLazyTomcat/Lib.WinFileInfo
===============================================================================}
unit ProcessGlobalVars;
{
ProcessGlobalVars_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
ProcessGlobalVars_UseAuxExceptions to achieve this.
}
{$IF Defined(ProcessGlobalVars_UseAuxExceptions)}
{$DEFINE UseAuxExceptions}
{$IFEND}
//------------------------------------------------------------------------------
{$IF defined(CPU64) or defined(CPU64BITS)}
{$DEFINE CPU64bit}
{$ELSEIF defined(CPU16)}
{$MESSAGE FATAL '16bit CPU not supported'}
{$ELSE}
{$DEFINE CPU32bit}
{$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}
{$DEFINE FPC_DisableWarns}
{$MACRO ON}
{$INLINE ON}
{$DEFINE CanInline}
{$ELSE}
{$IF CompilerVersion >= 17} // Delphi 2005+
{$DEFINE CanInline}
{$ELSE}
{$UNDEF CanInline}
{$IFEND}
{$ENDIF}
{$H+}
interface
uses
SysUtils,
AuxTypes {$IFDEF UseAuxExceptions}, AuxExceptions{$ENDIF};
{===============================================================================
Library-specific exceptions
===============================================================================}
type
EPGVException = class({$IFDEF UseAuxExceptions}EAEGeneralException{$ELSE}Exception{$ENDIF});
EPGVModuleEnumerationError = class(EPGVException);
EPGVHeapAllocationError = class(EPGVException);
EPGVInvalidValue = class(EPGVException);
EPGVInvalidState = class(EPGVException);
EPGVInvalidVariable = class(EPGVException);
EPGVUnknownVariable = class(EPGVException);
EPGVDuplicateVariable = class(EPGVException);
EPGVMutexError = class(EPGVException);
EPGVSystemError = class(EPGVException);
{===============================================================================
--------------------------------------------------------------------------------
PGV public interface declaration
--------------------------------------------------------------------------------
===============================================================================}
type
{
TPGVIdentifier
This type is used within this library as a numerical identifier of variables
managed here.
It is always an unsigned 32bit-wide integer (with system endianness).
}
TPGVIdentifier = UInt32;
{
TPGVIdentifierArray
This is only used when enumerating existing variables.
}
TPGVIdentifierArray = array of TPGVIdentifier;
{
TPGVVariable
This type is used as a reference to existing variables. It is returned by
functions searching for and/or (re)allocating managed variables.
This type is a two-level pointer (pointer to pointer), meaning it points to
a pointer and only that second-level pointer points to memory occupied by the
referenced variable. Therefore, to directly access the variable, you have to
dereference it twice (eg. SomeVar^^)!
It is two-level to allow relocation of memory without affecting the reference.
For example, you search for some variable you want to use - this reference is
returned and you store it for further use. This stored reference will be valid
for the entire lifetime of the variable, even if it is reallocated and moved
to a different memory address (value of the second-level pointer changes, but
the stored reference is still pointing to it).
WARNING - whenever accessing the variable, use the provided two-level
reference, never use the second-level pointer as other threads
can change it without you knowing.
NOTE - unless you are absolutely sure the variable will not be reallocated
once it exists, you should lock the state (using GlobVarLock and
GlobVarUnlock) when directly accessing the variable (dereferencing
it instead of calling GlobVarStore and GlobVarLoad) - this avoids
potential problems when the variable is accessed by multiple threads
(eg. one thread might reallocate it while other thread is writing
something to it - you do NOT want this to happen).
Note on functions accepting parameter of type TPGVVariable as their input...
All functions operating on variables that accept either numeral or string
identifiers have one unfortunate thing in common - everytime they are
called, they search the entire internal state for the requested variable,
and this searching cannot be much optimized.
To improve performance, you can call functions accepting direct variable
reference (provided you already have it, eg. from allocation) - these
functions are not searching the state, but insteady operate directly on the
provided memory reference. That being said, make sure you provide a valid
reference (if nil is passed, then these functions just raise an exception
of class EPGVInvalidValue, if non-nil invalid pointer is used, then better
be ready for nasty bugs).
}
TPGVVariable = PPointer;
PPGVVariable = ^TPGVVariable;
//------------------------------------------------------------------------------
{
GlobVarInternalCompatibilityVersion
Returns internal compatibility version (an integer number in effect for
current implementation).
This number is used only internally so this call is here only for informative
purposes.
WARNING - in 64bit systems, the highest bit of the result will be set,
making the number a large negative integer. This is to separate
64bit and 32bit implementations in case they meet in one process
(should not be possible, but better be safe than sorry).
}
Function GlobVarInternalCompatibilityVersion: Int32;
{
GlobVarTranslateIdentifier
Converts string identifier to numeral identifier used to distinguish
individual variables.
The string is converted to a WideString (to minimize potential problems with
encodings - but even then, you should avoid non-ASCII characters) and an
Adler32 checksum is calculated for it. This sum is then casted directly to
the resulting identifier. This means, among other things, that there is a
posibility that two different strings produce the same identifier and
therefore, when used, will reference the same variable - be aware of this.
String identifiers are case sensitive ("abc" is NOT the same as "ABC").
NOTE - further functions that are accepting string identifiers are calling
this routine to convert the provided string. Although the Adler32
checksum is fast, the effect of calculating it many times over might
be noticeable. Therefore, in case you make a lot of calls with the
same string identifier, you should consider converting it to numeral
identifier at the start and then use only this numeral instead of
the string.
}
Function GlobVarTranslateIdentifier(const Identifier: String): TPGVIdentifier;{$IF Defined(FPC) and Defined(CanInline)} inline;{$IFEND}
//------------------------------------------------------------------------------
{
GlobVarLock
Locks internal state of this library for the calling thread, making sure no
other thread(s) can manipulate it while the lock is in effect. This lock is
process-wide.
It can be called multiple times, but each call to it must be paired by a call
to GlobVarUnlock to unlock the state when you are done using it.
If one thread holds the lock, all attempts to acquire the lock from other
threads will block until the lock is released.
All functions declared in this procedural interface, with notable exceptions
being these:
GlobVarInternalCompatibilityVersion
GlobVarTranslateIdentifier
GlobVarLock
GlobVarUnlock
...are acquiring the lock during their execution. This means that all these
functions are serialized (ie. only one call can be running at a time).
It is here mainly to protect the state when making complex operations
involving multiple calls to interface functions. Let's have an example:
GlobVarLock;
try
If GlobVarFind('abc',Ptr) then
begin
If GlobVarSize('abc') <> 1 then
Ptr := GlobVarRealloc('abc',1);
end
else Ptr := GlobVarAlloc('abc',1);
Boolean(Ptr^^) := True;
finally
GlobVarUnlock;
end;
...this all will be executed in a thread safe manner.
It can also be used to protect individual variables when accesing them
directly, without using provided load and store functions (which are
serialized too).
WARNING - do not hold the lock for prolonged time periods, since those
locks are also acquired during module loading and unloading,
it can cause serious problems at unpredictable times.
}
procedure GlobVarLock;
{
GlobVarUnlock
Unlocks the internal state. This function must be called as many times as
GlobVarLock was called to achieve proper unlocking.
}
procedure GlobVarUnlock;
//------------------------------------------------------------------------------
{
GlobVarCount
Returns number of variables managed by this library.
}
Function GlobVarCount: Integer;
{
GlobVarMemory
Returs an amount of global memory (number of bytes) used by this library and
allocated variables.
When IncludeOverhead is False, then only memory used by the variables (all
of them, including those stored in-situ - see GlobVarHeapStored for
explanation) is returned.
When set to True, then it returns size of all memory allocated for internal
state plus memory allocated on the heap for individual variables (note that
variables stored in the state are not counted, as their memory is already
included as part of the state itself).
}
Function GlobVarMemory(IncludeOverhead: Boolean = False): TMemSize;
{
GlobVarEnumerate
Returns an array enumerating identifiers of all managed variables (an empty
array is returned if no variable is present).
}
Function GlobVarEnumerate: TPGVIdentifierArray;
//------------------------------------------------------------------------------
{
GlobVarFind
Searches the internal state for a variable of given identifier.
When it is found, then True is returned, output parameter Variable contains
its reference and Size contains actual size of it.
If not found then False is returned, Variable is set to nil and Size to zero.
}
Function GlobVarFind(Identifier: TPGVIdentifier; out Variable: TPGVVariable): Boolean; overload;
Function GlobVarFind(const Identifier: String; out Variable: TPGVVariable): Boolean; overload;{$IFDEF CanInline} inline;{$ENDIF}
Function GlobVarFind(Identifier: TPGVIdentifier; out Variable: TPGVVariable; out Size: TMemSize): Boolean; overload;
Function GlobVarFind(const Identifier: String; out Variable: TPGVVariable; out Size: TMemSize): Boolean; overload;{$IFDEF CanInline} inline;{$ENDIF}
type
{
TPGVGetResult
Type used by some overloads of function GlobVarGet to inform the caller
about the result of operation.
vgrCreated - requested variable have not existed prior the call and
was allocated by it
vgrOpened - variable existed and its size matched the requested one
vgrSizeMismatch - variable exists but its size do not match
vgrError - some unspecified error occured
}
TPGVGetResult = (vgrCreated,vgrOpened,vgrSizeMismatch,vgrError);
{
GlobVarGet
First version (overloads returning type TPGVVariable)
Returns a reference to variable of given identifier. If the variable cannot
be found, then these functions raise an EPGVUnknownVariable exception.
Second version (returning type TPGVGetResult)
Tries to find variable of given identifier. If it is not found, then it
allocates it.
When the wanted variable exists, its size is compared to whatever is given
in parameter Size. If they match, then parameter Size is left unchanged,
output parameter Variable is set to a reference to the existing variable
and result is set to vgrOpened. If the sizes do not match, then parameter
Size is set to actual size of the variable, Variable contains reference to
the variable and result is set to vgrSizeMismatch.
If variable of given identifier does not exist, then it is allocated using
Size parameter (this parameter is not changed). Variable then contains
reference to the newly created entry and result is set to vgrCreated.
If these functions return vgrError, then value of Size and Variable is
undefined (but this result should not be ever returned, as exceptions are
raised on errors).
}
Function GlobVarGet(Identifier: TPGVIdentifier): TPGVVariable; overload;
Function GlobVarGet(const Identifier: String): TPGVVariable; overload;
Function GlobVarGet(Identifier: TPGVIdentifier; var Size: TMemSize; out Variable: TPGVVariable): TPGVGetResult; overload;
Function GlobVarGet(const Identifier: String; var Size: TMemSize; out Variable: TPGVVariable): TPGVGetResult; overload;{$IFDEF CanInline} inline;{$ENDIF}
{
GlobVarRename
Changes identifier of selected variable to a new one. No existing references
are affected by this operation.
If variable with OldIdentifier does not exist, then ans EPGVUnknownVariable
exception is raised. Overload accepting variable reference will raise an
EPGVInvalidVariable exception if the reference is not valid.
If old and new identifiers match (two different strings can produce the same
identifier and therefore be considered equal - see GlobVarTranslateIdentifier
for details), then nothing is done. But note that the variable is still
searched for, and if it does not exist then an exception is raised.
If a variable with NewIdentifier already exists, and it is not the one that
is being renamed, then an EPGVDuplicateVariable exception is raised.
}
Function GlobVarRename(OldIdentifier,NewIdentifier: TPGVIdentifier): TPGVVariable; overload;
Function GlobVarRename(OldIdentifier: TPGVIdentifier; const NewIdentifier: String): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
Function GlobVarRename(const OldIdentifier: String; NewIdentifier: TPGVIdentifier): TPGVVariable; overload;
Function GlobVarRename(const OldIdentifier,NewIdentifier: String): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
procedure GlobVarRename(Variable: TPGVVariable; NewIdentifier: TPGVIdentifier); overload;
procedure GlobVarRename(Variable: TPGVVariable; NewIdentifier: String); overload;{$IFDEF CanInline} inline;{$ENDIF}
//------------------------------------------------------------------------------
{
GlobVarIsValid
Returns true when the given variable reference is assigned and references
a valid allocated variable, false otherwise.
If CheckAddress is set to True, then a check whether the reference address
actually points to a correct place in internal state is also performed.
If set to False, then no such check is done and the reference is assumed to
be pointing to a correct place (and you better make sure it does...).
}
Function GlobVarIsValid(Variable: TPGVVariable; CheckAddress: Boolean = True): Boolean;
{
GlobVarIdentifier
Returns identifier of variable whose reference is given.
This is intended for situations where one needs an identifier of unknown
variable or of a variable that might have been renamed.
Raises an EPGVInvalidVariable exception if the reference is not valid.
}
Function GlobVarIdentifier(Variable: TPGVVariable): TPGVIdentifier;
{
GlobVarExists
Indicates whether the requested variable exists. When it exists, it will
return true, when it does not exist, then it will return false.
}
Function GlobVarExists(Identifier: TPGVIdentifier): Boolean; overload;
Function GlobVarExists(const Identifier: String): Boolean; overload;{$IFDEF CanInline} inline;{$ENDIF}
{
GlobVarSize
Returns size of the given variable.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
NOTE - existing variables cannot have size of zero.
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
}
Function GlobVarSize(Identifier: TPGVIdentifier): TMemSize; overload;
Function GlobVarSize(const Identifier: String): TMemSize; overload;
Function GlobVarSize(Variable: TPGVVariable): TMemSize; overload;
{
GlobVarHeapStored
Indicates whether the given variable is stored on the heap (true is returned)
or in-situ (false is returned).
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
Variables stored on the heap reside in a memory that is obtained from
(allocated by) a global memory manager (usually provided by operating system
or system library).
To limit memory fragmentation and use of resources, small variables (smaller
or equal in size to a pointer) are stored directly in the internal state that
manages those variables (this is called in-situ).
WARNING - Abovementioned means you should never assume anything about
position of any variable in memory and certainly avoid writing
outside its boundaries (you could corrupt the state).
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
}
Function GlobVarHeapStored(Identifier: TPGVIdentifier): Boolean; overload;
Function GlobVarHeapStored(const Identifier: String): Boolean; overload;
Function GlobVarHeapStored(Variable: TPGVVariable): Boolean; overload;
//------------------------------------------------------------------------------
type
{
TPGVVariableFlag
TPGVVariableFlags
Used when returning flags of selected variable. If the flag is set, then
the corresponding enum value will be included in the TPGVVariableFlags set,
otherwise it will be excluded from that set.
vfRealocated - variable was reallocated at least once during its life (only
true reallocations set this flag, call to GlobVarRealloc(ate)
might not actually perform it if not needed)
vfRenamed - variable was renamed at least once (only true renamings
count)
}
TPGVVariableFlag = (vfReallocated,vfRenamed);
TPGVVariableFlags = set of TPGVVariableFlag;
{
GlobVarGetFlags
Returns a set type indicating which flags are set in the internal state of
given variable. See types TPGVVariableFlag and TPGVVariableFlags for details.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
}
Function GlobVarGetFlags(Identifier: TPGVIdentifier): TPGVVariableFlags; overload;
Function GlobVarGetFlags(const Identifier: String): TPGVVariableFlags; overload;
Function GlobVarGetFlags(Variable: TPGVVariable): TPGVVariableFlags; overload;
{
GlobVarSetFlags
Sets flags according to the passed Flags set parameter and returns previous
state of flags for the given variable.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier). Overload
accepting variable reference will raise an EPGVInvalidVariable exception
if the reference is not valid.
}
Function GlobVarSetFlags(Identifier: TPGVIdentifier; Flags: TPGVVariableFlags): TPGVVariableFlags; overload;
Function GlobVarSetFlags(const Identifier: String; Flags: TPGVVariableFlags): TPGVVariableFlags; overload;
Function GlobVarSetFlags(Variable: TPGVVariable; Flags: TPGVVariableFlags): TPGVVariableFlags; overload;
{
GlobVarGetFlag
Returns state of selected flag for given variable. True means the flag is
set (1), flase means it is clear (0).
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier). Overload
accepting variable reference will raise an EPGVInvalidVariable exception
if the reference is not valid.
}
Function GlobVarGetFlag(Identifier: TPGVIdentifier; Flag: TPGVVariableFlag): Boolean; overload;
Function GlobVarGetFlag(const Identifier: String; Flag: TPGVVariableFlag): Boolean; overload;
Function GlobVarGetFlag(Variable: TPGVVariable; Flag: TPGVVariableFlag): Boolean; overload;
{
GlobVarSetFlag
Sets state of selected flag for given variable to Value and returns its
previous state.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier). Overload
accepting variable reference will raise an EPGVInvalidVariable exception
if the reference is not valid.
}
Function GlobVarSetFlag(Identifier: TPGVIdentifier; Flag: TPGVVariableFlag; Value: Boolean): Boolean; overload;
Function GlobVarSetFlag(const Identifier: String; Flag: TPGVVariableFlag; Value: Boolean): Boolean; overload;
Function GlobVarSetFlag(Variable: TPGVVariable; Flag: TPGVVariableFlag; Value: Boolean): Boolean; overload;
//------------------------------------------------------------------------------
{
GlobVarRefCount
Returns current reference count of given variable.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
Reference counting overview
Reference counting of individual variables is NOT automatic - it is provided
only to help with variable lifetime in multi-threaded and multi-module
environment, where implementation cannot be sure whether it can free the
variable or not (ie. whether it is still used by someone).
WARNING - other functions operating on variables, other than those
explicitly accessing reference count, completely ignore it,
it is provided only for user code convenience.
When a new variable is allocated, its reference count is set to zero.
To increment or decrement it, you need to call funtions GlobVarAcquire or
GlobVarRelease respectively.
GlobVarRelease can be also used to automatically free the variable when
its reference count drops to zero - see there for details.
}
Function GlobVarRefCount(Identifier: TPGVIdentifier): UInt32; overload;
Function GlobVarRefCount(const Identifier: String): UInt32; overload;
Function GlobVarRefCount(Variable: TPGVVariable): UInt32; overload;
{
GlobVarAcquire
Increments reference count of the given variable by one and returns the new
count. Nothing else is changed about the variable.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
If the reference count is already at High(UInt32), then an EPGVInvalidState
exception is raised.
}
Function GlobVarAcquire(Identifier: TPGVIdentifier): UInt32; overload;
Function GlobVarAcquire(const Identifier: String): UInt32; overload;
Function GlobVarAcquire(Variable: TPGVVariable): UInt32; overload;
{
GlobVarRelease
Decrements reference count of the given variable by one and returns its new
value. If the count already is zero, then it is NOT decremented.
If the reference count drops to zero or already is zero and argument CanFree
is set to True, then the function also frees and removes the variable before
returning (equivalent to calling GlobVarFree).
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised.
Note that overload accepting variable reference is not provided because
the reference cannot provide all information necessary for freeing.
}
Function GlobVarRelease(Identifier: TPGVIdentifier; CanFree: Boolean = False): UInt32; overload;
Function GlobVarRelease(const Identifier: String; CanFree: Boolean = False): UInt32; overload;
//------------------------------------------------------------------------------
{
GlobVarAllocate
GlobVarAlloc
Allocates variable of given identifier and size.
If variable with given identifier already exists, then an exception of class
EPGVDuplicateVariable is raised.
If size is set to zero, then no variable is allocated and the function will
return nil (note that even in this case, the function will raise an exception
if the variable already exists).
Memory of the newly allocated variable is initialized to all zero.
}
Function GlobVarAllocate(Identifier: TPGVIdentifier; Size: TMemSize): TPGVVariable; overload;
Function GlobVarAllocate(const Identifier: String; Size: TMemSize): TPGVVariable; overload;
Function GlobVarAlloc(Identifier: TPGVIdentifier; Size: TMemSize): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
Function GlobVarAlloc(const Identifier: String; Size: TMemSize): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
{
GlobVarReallocate
GlobVarRealloc
Operation of these functions depends on whether the requested variable exists
and also on the value of paramer NewSize.
Variable exists
If NewSize is above zero, then the variable is reallocated. If NewSize is
the same as current size, then this reallocation does nothing. If NewSize
is larger than current size, then the newly added memory space is zeroed.
And finally, if NewSize is smaller than current size, then the data are
truncated to fit the new size.
When NewSize is zero then the variable is freed (equivalent to calling
GlobVarFree - variable's reference count is ignored).
NOTE - when the reallocation is performed, the variable's data might be
relocated to a different memory address (whether this happens or
not depends on many things, none of which is important here, you
just remember that it CAN happen).
Variable does not exist
If NewSize is above zero, then new variable of given identifier and size is
allocated (equivalent to calling GlobVarAllocate).
When NewSize is zero, then nil is returned and nothing is allocated.
}
Function GlobVarReallocate(Identifier: TPGVIdentifier; NewSize: TMemSize): TPGVVariable; overload;
Function GlobVarReallocate(const Identifier: String; NewSize: TMemSize): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
Function GlobVarRealloc(Identifier: TPGVIdentifier; NewSize: TMemSize): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
Function GlobVarRealloc(const Identifier: String; NewSize: TMemSize): TPGVVariable; overload;{$IFDEF CanInline} inline;{$ENDIF}
{
GlobVarFree
Frees memory allocated for a given variable and removes it from the internal
state - so it cannot be obtained or accessed again.
If no variable of given name exists, then an EPGVUnknownVariable exception is
raised.
WARNING - if you still have references to removed variables, they will be
corrupted, or, in the worst case, will point to a different
variable. Therefore make sure you discard all existing references
to variable that is being freed.
WARNING - this function ignores variable's reference count and always
frees it.
}
procedure GlobVarFree(Identifier: TPGVIdentifier); overload;
procedure GlobVarFree(const Identifier: String); overload;
//------------------------------------------------------------------------------
{
GlobVarStore
Writes up-to Count bytes from the provided buffer (Buffer) to a memory of
given variable.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
If the variable is smaller than is Count, then only number of bytes
corresponding to actual variable's size will be written.
If the variable is larger than is the Count, then bytes beyond the Count are
not affected.
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
NOTE - this function locks the internal state while writing, so you do not
need to do it explicitly.
}
Function GlobVarStore(Identifier: TPGVIdentifier; const Buffer; Count: TMemSize): TMemSize; overload;
Function GlobVarStore(const Identifier: String; const Buffer; Count: TMemSize): TMemSize; overload;
Function GlobVarStore(Variable: TPGVVariable; const Buffer; Count: TMemSize): TMemSize; overload;
{
GlobVarLoad
Reads up to Count bytes from the requested variable into the provided Buffer.
The buffer must be prepared by the caller and must be large enough to hold
at least Count number of bytes.
If the requested variable does not exist, then an EPGVUnknownVariable
exception will be raised (overloads accepting indetifier).
If the variable is smaller than is Count, then only number of bytes
corresponding to actual variable's size will be read. Content of buffer
beyond actually copied data is unaffected.
If the variable is larger than is the Count, then only Count bytes will be
read (filling the buffer), data beyond that are not copied and are not
affected (but in rare circumstances might be accessed by the function).
Overload accepting variable reference can also raise an EPGVInvalidVariable
exception if the reference is not valid.
NOTE - this function locks the internal state while reading, so you do not
need to do it explicitly.
}
Function GlobVarLoad(Identifier: TPGVIdentifier; out Buffer; Count: TMemSize): TMemSize; overload;
Function GlobVarLoad(const Identifier: String; out Buffer; Count: TMemSize): TMemSize; overload;
Function GlobVarLoad(Variable: TPGVVariable; out Buffer; Count: TMemSize): TMemSize; overload;
implementation
uses
{$IFDEF Windows}Windows,{$ELSE}UnixType, BaseUnix,{$ENDIF}
Adler32, AuxMath, StrRect;
{$IFDEF FPC_DisableWarns}
{$DEFINE FPCDWM}
{$DEFINE W4055:={$WARN 4055 OFF}} // Conversion between ordinals and pointers is not portable
{$DEFINE W4056:={$WARN 4056 OFF}} // Conversion between ordinals and pointers is not portable
{$ENDIF}
{===============================================================================
--------------------------------------------------------------------------------
PGV internal implementation
--------------------------------------------------------------------------------
===============================================================================}
{===============================================================================
PGV internal implementation - constants and types
===============================================================================}
type
TPGVHead = packed record
RefCount: Integer;
Flags: UInt32;
{$IFDEF Windows}
Lock: TRTLCriticalSection;
{$ELSE}
Lock: pthread_mutex_t;
Allocator: record
LibHandle: Pointer;
AllocFunc: Function(size: size_t): Pointer; cdecl;
ReallocFunc: Function(ptr: Pointer; size: size_t): Pointer; cdecl;
FreeFunc: procedure(ptr: Pointer); cdecl;
end;
{$ENDIF}
FirstSegment: Pointer;
LastSegment: Pointer;
end;
PPGVHead = ^TPGVHead;
var
// main global variable
VAR_HeadPtr: PPGVHead = nil;
//------------------------------------------------------------------------------
type
TPGVSegmentHead = packed record
Flags: UInt32;
AllocCount: Integer;
NextSegment: Pointer;
PrevSegment: Pointer;
end;
TPGVSegmentEntry = packed record
Identifier: TPGVIdentifier;
Flags: UInt32;
RefCount: UInt32;
Address: Pointer;
Size: TMemSize;
end;
PPGVSegmentEntry = ^TPGVSegmentEntry;
const
// SEFLAG = segment entry flag
PGV_SEFLAG_USED = UInt32($00000100);
PGV_SEFLAG_REALLOCATED = UInt32($00000200);
PGV_SEFLAG_RENAMED = UInt32($00000400);
PGV_SEFLAG_SMLSIZE_MASK = UInt32($0000000F);
//------------------------------------------------------------------------------
const
PGV_SEGMENT_SIZE = 4096; // one memory page, usually
// helper constants (so that further declarations are shorter)
PGV_SEGMENT_ENTRYCOUNT = (PGV_SEGMENT_SIZE - SizeOf(TPGVSegmentHead)) div SizeOf(TPGVSegmentEntry);
PGV_SEGMENT_ENTRIESSIZE = PGV_SEGMENT_ENTRYCOUNT * SizeOf(TPGVSegmentEntry);
PGV_SEGMENT_PADDINGSIZE = PGV_SEGMENT_SIZE - PGV_SEGMENT_ENTRIESSIZE - SizeOf(TPGVSegmentHead);
type
TPGVSegment = packed record
Head: TPGVSegmentHead;
// add padding to ensure the type has exactly segment-size bytes
{$IF PGV_SEGMENT_PADDINGSIZE > 0}
Padding: packed array[0..Pred(PGV_SEGMENT_PADDINGSIZE)] of Byte;
{$IFEND}
Entries: packed array[0..Pred(PGV_SEGMENT_ENTRYCOUNT)] of TPGVSegmentEntry;
end;
PPGVSegment = ^TPGVSegment;
{$IF SizeOf(TPGVSegment) <> PGV_SEGMENT_SIZE}
{$MESSAGE FATAL 'Invalid size of type TPGVSegment.'}
{$IFEND}
{===============================================================================
PGV internal implementation - externals, system stuff
===============================================================================}
{$IFDEF Windows}
// Windows...
const
HEAP_ZERO_MEMORY = $00000008;
Function EnumProcessModules(hProcess: THandle; lphModules: PHandle; cb: DWORD; lpcbNeeded: LPDWORD): BOOL; stdcall; external 'psapi.dll';
{$ELSE}//=======================================================================
// Linux...
type
pthread_mutexattr_p = ^pthread_mutexattr_t;
pthread_mutex_p = ^pthread_mutex_t;
const
PTHREAD_MUTEX_RECURSIVE = 1;
PTHREAD_MUTEX_ROBUST = 1;
Function pthread_mutexattr_init(attr: pthread_mutexattr_p): cint; cdecl; external;
Function pthread_mutexattr_destroy(attr: pthread_mutexattr_p): cint; cdecl; external;
Function pthread_mutexattr_settype(attr: pthread_mutexattr_p; _type: cint): cint; cdecl; external;
Function pthread_mutexattr_setrobust(attr: pthread_mutexattr_p; robustness: cint): cint; cdecl; external;
Function pthread_mutex_init(mutex: pthread_mutex_p; attr: pthread_mutexattr_p): cint; cdecl; external;
Function pthread_mutex_destroy(mutex: pthread_mutex_p): cint; cdecl; external;
Function pthread_mutex_trylock(mutex: pthread_mutex_p): cint; cdecl; external;
Function pthread_mutex_lock(mutex: pthread_mutex_p): cint; cdecl; external;
Function pthread_mutex_unlock(mutex: pthread_mutex_p): cint; cdecl; external;
Function pthread_mutex_consistent(mutex: pthread_mutex_p): cint; cdecl; external;
//------------------------------------------------------------------------------
const
libc = 'libc.so.6';
RTLD_LAZY = $001;
RTLD_NOW = $002;
Function errno_ptr: pcint; cdecl; external name '__errno_location';
Function lin_malloc(size: size_t): Pointer; cdecl; external libc name 'malloc';
Function lin_realloc(ptr: Pointer; size: size_t): Pointer; cdecl; external libc name 'realloc';
procedure lin_free(ptr: Pointer); cdecl; external libc name 'free';
Function dlopen(filename: PChar; flags: cInt): Pointer; cdecl; external;
Function dlclose(handle: Pointer): cInt; cdecl; external;