mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 07:45:54 +01:00
Updated dmustache to version 2
This commit is contained in:
Daniele Teti
parent
493d2f21ae
commit
d743333741
22
lib/dmustache/.gitattributes
vendored
22
lib/dmustache/.gitattributes
vendored
@ -1,22 +0,0 @@
|
|||||||
# Auto detect text files and perform no LF normalization
|
|
||||||
* binary
|
|
||||||
|
|
||||||
# Custom for Visual Studio
|
|
||||||
*.cs diff=csharp
|
|
||||||
*.sln merge=union
|
|
||||||
*.csproj merge=union
|
|
||||||
*.vbproj merge=union
|
|
||||||
*.fsproj merge=union
|
|
||||||
*.dbproj merge=union
|
|
||||||
|
|
||||||
# Standard to msysgit
|
|
||||||
*.doc diff=astextplain
|
|
||||||
*.DOC diff=astextplain
|
|
||||||
*.docx diff=astextplain
|
|
||||||
*.DOCX diff=astextplain
|
|
||||||
*.dot diff=astextplain
|
|
||||||
*.DOT diff=astextplain
|
|
||||||
*.pdf diff=astextplain
|
|
||||||
*.PDF diff=astextplain
|
|
||||||
*.rtf diff=astextplain
|
|
||||||
*.RTF diff=astextplain
|
|
||||||
88
lib/dmustache/.gitignore
vendored
88
lib/dmustache/.gitignore
vendored
@ -1,88 +0,0 @@
|
|||||||
# Uncomment these types if you want even more clean repository. But be careful.
|
|
||||||
# It can make harm to an existing project source. Read explanations below.
|
|
||||||
#
|
|
||||||
# Resource files are binaries containing manifest, project icon and version info.
|
|
||||||
# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
|
|
||||||
#*.res
|
|
||||||
#
|
|
||||||
# Type library file (binary). In old Delphi versions it should be stored.
|
|
||||||
# Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
|
|
||||||
#*.tlb
|
|
||||||
#
|
|
||||||
# Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
|
|
||||||
# Uncomment this if you are not using diagrams or use newer Delphi version.
|
|
||||||
*.ddp
|
|
||||||
*.dof
|
|
||||||
#
|
|
||||||
# Visual LiveBindings file. Added in Delphi XE2.
|
|
||||||
# Uncomment this if you are not using LiveBindings Designer.
|
|
||||||
#*.vlb
|
|
||||||
#
|
|
||||||
# Deployment Manager configuration file for your project. Added in Delphi XE2.
|
|
||||||
# Uncomment this if it is not mobile development and you do not use remote debug feature.
|
|
||||||
#*.deployproj
|
|
||||||
#
|
|
||||||
# C++ object files produced when C/C++ Output file generation is configured.
|
|
||||||
# Uncomment this if you are not using external objects (zlib library for example).
|
|
||||||
#*.obj
|
|
||||||
#
|
|
||||||
|
|
||||||
# Delphi compiler-generated binaries (safe to delete)
|
|
||||||
*.exe
|
|
||||||
*.dll
|
|
||||||
*.bpl
|
|
||||||
*.bpi
|
|
||||||
*.dcp
|
|
||||||
*.so
|
|
||||||
*.apk
|
|
||||||
*.drc
|
|
||||||
*.map
|
|
||||||
*.dres
|
|
||||||
*.rsm
|
|
||||||
*.tds
|
|
||||||
*.dcu
|
|
||||||
*.lib
|
|
||||||
*.a
|
|
||||||
*.o
|
|
||||||
*.ocx
|
|
||||||
|
|
||||||
# FreePascal compiler
|
|
||||||
*.com
|
|
||||||
*.class
|
|
||||||
*.ppu
|
|
||||||
*.compiled
|
|
||||||
*.rsj
|
|
||||||
*.or
|
|
||||||
*.lps
|
|
||||||
*.db
|
|
||||||
fpc/
|
|
||||||
|
|
||||||
# Delphi autogenerated files (duplicated info)
|
|
||||||
*.cfg
|
|
||||||
*.hpp
|
|
||||||
*Resource.rc
|
|
||||||
|
|
||||||
# Delphi local files (user-specific info)
|
|
||||||
*.local
|
|
||||||
*.identcache
|
|
||||||
*.projdata
|
|
||||||
*.tvsconfig
|
|
||||||
*.dsk
|
|
||||||
|
|
||||||
# Delphi history and backups
|
|
||||||
__history/
|
|
||||||
__recovery/
|
|
||||||
*.~*
|
|
||||||
*.bak
|
|
||||||
|
|
||||||
# Castalia statistics file (since XE7 Castalia is distributed with Delphi)
|
|
||||||
*.stat
|
|
||||||
|
|
||||||
#other VCS
|
|
||||||
_FOSSIL_
|
|
||||||
.svn/
|
|
||||||
# SourceCodeRep artifact
|
|
||||||
*.txt
|
|
||||||
|
|
||||||
backup/
|
|
||||||
.idea/
|
|
||||||
@ -1,201 +0,0 @@
|
|||||||
`SynMustache` is a Delphi/FPC implementation of the [Mustache template language](http://mustache.github.io/).
|
|
||||||
|
|
||||||
|
|
||||||
Presentation
|
|
||||||
============
|
|
||||||
|
|
||||||
* SynMustache is the first Delphi implementation of Mustache, supporting Delphi 6 up to latest Delphi, and FPC/Lazarus;
|
|
||||||
* It has a separate parser and renderer (so you can compile your templates ahead of time);
|
|
||||||
* The parser features a shared cache of compiled templates;
|
|
||||||
* It [passes all official Mustache specification tests](https://github.com/mustache/spec) - including all weird whitespace process;
|
|
||||||
* External partials can be supplied as `TSynMustachePartials` dictionaries;
|
|
||||||
* `{{.}}`, `{{-index}}` and `{{"some text}}` pseudo-variables were added to the standard Mustache syntax;
|
|
||||||
* `{{#-first}}`, `{{#-last}}` and `{{#-odd}}` pseudo-sections were added to the standard Mustache syntax;
|
|
||||||
* `{{helperName value}}` *Expression Helpers* were added to the standard Mustache syntax;
|
|
||||||
* `{{if value<=>value}}` *Expression Helper* for conditional sections;
|
|
||||||
* Internal partials can be defined via `{{<partial}}` - also a nice addition to the standard Mustache syntax;
|
|
||||||
* It allows the data context to be supplied as JSON or our `TDocVariant` custom variant type;
|
|
||||||
* Almost no memory allocation is performed during the rendering;
|
|
||||||
* It is natively UTF-8, from the ground up, with optimized conversion of any string data;
|
|
||||||
* Performance has been tuned, with benefit from `SynCommons` optimized code;
|
|
||||||
* Each parsed template is thread-safe and re-entrant;
|
|
||||||
* It follows the SOLID Open/Close principle so that any aspect of the process can be customized and extended (e.g. for any kind of data context);
|
|
||||||
* It is perfectly integrated with the other bricks of our *mORMot* framework, ready to implement dynamic web sites with true MVC design, and full separation of concerns in the views written in Mustache, the controllers being e.g. interface-based services;
|
|
||||||
* API is flexible and easy to use.
|
|
||||||
|
|
||||||
Get It
|
|
||||||
======
|
|
||||||
|
|
||||||
The version here on GitHub should be in synch with our main repository.
|
|
||||||
|
|
||||||
In fact, this repository is a miror of the following files extracted from our [Synopse Open Source code repository](http://synopse.info/fossil/):
|
|
||||||
|
|
||||||
* `SynMustache.pas`
|
|
||||||
* `SynCommons.pas`
|
|
||||||
* `SynLz.pas`
|
|
||||||
* `Synopse.inc`
|
|
||||||
* `SynopseCommit.inc`
|
|
||||||
|
|
||||||
Note that even if `SynMustache` is part of the [mORMot Open Source framework](http://mormot.net/), it is just one brick of it, so you can use this unit with any of your projects, without the need to use either the database, ORM, SOA or other features of *mORMot*.
|
|
||||||
|
|
||||||
If you download the whole *mORMot* source code, you do not need this separate package: ensure you get rid of any existing separated `SynMustache` installation, and use the units as available in the main *mORMot* trunk.
|
|
||||||
This *DMustache* distribution/GitHub account targets only people needing an optimized *Mustache* template, without other *mORMot* features.
|
|
||||||
|
|
||||||
License
|
|
||||||
=======
|
|
||||||
|
|
||||||
This library is part of the Open Source *mORMot* framework, so is released under the same disjunctive tri-license giving you the choice of one of the three following sets of free software/open source licensing terms:
|
|
||||||
|
|
||||||
* Mozilla Public License, version 1.1 or later;
|
|
||||||
* GNU General Public License, version 2.0 or later;
|
|
||||||
* GNU Lesser General Public License, version 2.1 or later.
|
|
||||||
|
|
||||||
This allows the use of our code in as wide a variety of software projects as possible, while still maintaining copyleft on code we wrote.
|
|
||||||
|
|
||||||
|
|
||||||
Sample Code
|
|
||||||
===========
|
|
||||||
|
|
||||||
Variables
|
|
||||||
---------
|
|
||||||
|
|
||||||
First, we define our needed variables:
|
|
||||||
|
|
||||||
var mustache: TSynMustache;
|
|
||||||
doc: variant;
|
|
||||||
|
|
||||||
In order to parse a template, you just need to call:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse(
|
|
||||||
'Hello {{name}}'#13#10'You have just won {{value}} dollars!');
|
|
||||||
|
|
||||||
It will return a compiled instance of the template.
|
|
||||||
|
|
||||||
The `Parse()` class method will use the shared cache, so you won't need to release the mustache instance once you are done with it: no need to write a `try ... finally mustache.Free; end` block.
|
|
||||||
|
|
||||||
You can use a `TDocVariant` custom variant type (defined in `SynCommons.pas`) to supply the context data (with late-binding):
|
|
||||||
|
|
||||||
TDocVariant.New(doc);
|
|
||||||
doc.name := 'Chris';
|
|
||||||
doc.value := 10000;
|
|
||||||
|
|
||||||
As an alternative, you may have defined the context data as such:
|
|
||||||
|
|
||||||
doc := _ObjFast(['name','Chris','value',1000]);
|
|
||||||
|
|
||||||
Now you can render the template with this context:
|
|
||||||
|
|
||||||
html := mustache.Render(doc);
|
|
||||||
// now html='Hello Chris'#13#10'You have just won 10000 dollars!'
|
|
||||||
|
|
||||||
If you want to supply the context data as JSON, then render it, you may write:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse(
|
|
||||||
'Hello {{value.name}}'#13#10'You have just won {{value.value}} dollars!');
|
|
||||||
html := mustache.RenderJSON('{value:{name:"Chris",value:10000}}');
|
|
||||||
// now html='Hello Chris'#13#10'You have just won 10000 dollars!'
|
|
||||||
|
|
||||||
Note that here, the JSON is supplied with an extended syntax (i.e. field names are unquoted), and that `TSynMustache` is able to identify a dotted-named variable within the execution context.
|
|
||||||
|
|
||||||
As an alternative, you could use the following syntax to create the data context as JSON, with a set of parameters, therefore easier to work with in real code storing data in variables (for instance, any string variable is quoted as expected by JSON, and converted into UTF-8):
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse(
|
|
||||||
'Hello {{name}}'#13#10'You have just won {{value}} dollars!');
|
|
||||||
html := mustache.RenderJSON('{name:?,value:?}',[],['Chris',10000]);
|
|
||||||
html='Hello Chris'#13#10'You have just won 10000 dollars!'
|
|
||||||
|
|
||||||
You can find in the `mORMot.pas` unit the `ObjectToJSON()` function which is able to transform any `TPersistent` instance into valid JSON content, ready to be supplied to a `TSynMustache` compiled instance.
|
|
||||||
|
|
||||||
If the object's published properties have some getter functions, they will be called on the fly to process the data (e.g. returning 'FirstName Name' as FullName by concatenating both sub-fields).
|
|
||||||
|
|
||||||
Sections
|
|
||||||
--------
|
|
||||||
|
|
||||||
Sections are handled as expected:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse('Shown.{{#person}}As {{name}}!{{/person}}end{{name}}');
|
|
||||||
html := mustache.RenderJSON('{person:{age:?,name:?}}',[10,'toto']);
|
|
||||||
// now html='Shown.As toto!end'
|
|
||||||
|
|
||||||
Note that the sections change the data context, so that within the #person section, you can directly access to the data context person member, i.e. writing directly name
|
|
||||||
|
|
||||||
It supports also inverted sections:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse('Shown.{{^person}}Never shown!{{/person}}end');
|
|
||||||
html := mustache.RenderJSON('{person:true}');
|
|
||||||
// now html='Shown.end'
|
|
||||||
|
|
||||||
To render a list of items, you can write for instance (using the `{{.}}` pseudo-variable):
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse('{{#things}}{{.}}{{/things}}');
|
|
||||||
html := mustache.RenderJSON('{things:["one", "two", "three"]}');
|
|
||||||
// now html='onetwothree'
|
|
||||||
|
|
||||||
The `{{-index]}}` pseudo-variable allows to numerate the list items, when rendering:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse(
|
|
||||||
'My favorite things:'#$A'{{#things}}{{-index}}. {{.}}'#$A'{{/things}}');
|
|
||||||
html := mustache.RenderJSON('{things:["Peanut butter", "Pen spinning", "Handstands"]}');
|
|
||||||
// now html='My favorite things:'#$A'1. Peanut butter'#$A'2. Pen spinning'#$A+
|
|
||||||
// '3. Handstands'#$A,'-index pseudo variable'
|
|
||||||
|
|
||||||
Partials
|
|
||||||
--------
|
|
||||||
|
|
||||||
External partials (i.e. standard Mustache partials) can be defined using `TSynMustachePartials`.
|
|
||||||
You can define and maintain a list of TSynMustachePartials instances, or you can use a one-time partial, for a given rendering process, as such:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse('{{>partial}}'#$A'3');
|
|
||||||
html := mustache.RenderJSON('{}',TSynMustachePartials.CreateOwned(['partial','1'#$A'2']));
|
|
||||||
// now html='1'#$A'23','external partials'
|
|
||||||
|
|
||||||
Here `TSynMustachePartials.CreateOwned()` expects the partials to be supplied as name/value pairs.
|
|
||||||
|
|
||||||
Internal partials (one of the SynMustache extensions), can be defined directly in the main template:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse('{{<partial}}1'#$A'2{{name}}{{/partial}}{{>partial}}4');
|
|
||||||
html := mustache.RenderJSON('{name:3}');
|
|
||||||
// now html='1'#$A'234','internal partials'
|
|
||||||
|
|
||||||
Internationalization
|
|
||||||
--------------------
|
|
||||||
|
|
||||||
You can define `{{"some text}}` pseudo-variables in your templates, which text will be supplied to a callback, ready to be transformed on the fly: it may be convenient for i18n of web applications.
|
|
||||||
|
|
||||||
By default, the text will be written directly to the output buffer, but you can define a callback which may be used e.g. for text translation:
|
|
||||||
|
|
||||||
procedure TTestLowLevelTypes.MustacheTranslate(var English: string);
|
|
||||||
begin
|
|
||||||
if English='Hello' then
|
|
||||||
English := 'Bonjour' else
|
|
||||||
if English='You have just won' then
|
|
||||||
English := 'Vous venez de gagner';
|
|
||||||
end;
|
|
||||||
|
|
||||||
Of course, in a real application, you may assign one `TLanguageFile.Translate(var English: string)` method, as defined in the `mORMoti18n.pas` unit.
|
|
||||||
|
|
||||||
Then, you will be able to define your template as such:
|
|
||||||
|
|
||||||
mustache := TSynMustache.Parse(
|
|
||||||
'{{"Hello}} {{name}}'#13#10'{{"You have just won}} {{value}} {{"dollars}}!');
|
|
||||||
html := mustache.RenderJSON('{name:?,value:?}',[],['Chris',10000],nil,MustacheTranslate);
|
|
||||||
// now html='Bonjour Chris'#$D#$A'Vous venez de gagner 10000 dollars!'
|
|
||||||
|
|
||||||
All text has indeed been translated as expected.
|
|
||||||
|
|
||||||
|
|
||||||
Some Links
|
|
||||||
==========
|
|
||||||
|
|
||||||
We wrote a series of blog articles, about Mustache in general, and `SynMustache` unit in particular:
|
|
||||||
|
|
||||||
* [Mustache Logic-less templates for Delphi - part 1: general presentation of Mustache](https://blog.synopse.info/?post/2014/04/28/Mustache-Logic-less-templates-for-Delphi-part-1);
|
|
||||||
* [Mustache Logic-less templates for Delphi - part 2: the Mustache syntax](https://blog.synopse.info/?post/2014/04/28/Mustache-Logic-less-templates-for-Delphi-part-2);
|
|
||||||
* [Mustache Logic-less templates for Delphi - part 3: SynMustache implementation](https://blog.synopse.info/?post/2014/04/28/Mustache-Logic-less-templates-for-Delphi-part-3).
|
|
||||||
|
|
||||||
You can use also [Synopse forums](http://synopse.info/forum/viewtopic.php?id=1720) to obtain direct support from the developpers, or send your feedback.
|
|
||||||
|
|
||||||
The documentation is [available as a single pdf file](http://blog.synopse.info/public/Documents/SynMustache.pdf), if needed. Note that this `pdf` can be outdated, so you should better consult the "Mustache" part of the *mORMot* SAD pdf, which should be more accurate.
|
|
||||||
|
|
||||||
|
|
||||||
*The Synopse team*
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -1,950 +0,0 @@
|
|||||||
/// efficient double to text conversion using the GRISU-1 algorithm
|
|
||||||
// - as a complement to SynCommons, which tended to increase too much
|
|
||||||
// - licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
||||||
|
|
||||||
{
|
|
||||||
Implement 64-bit floating point (double) to ASCII conversion using the
|
|
||||||
GRISU-1 efficient algorithm.
|
|
||||||
|
|
||||||
Original Code in flt_core.inc flt_conv.inc flt_pack.inc from FPC RTL.
|
|
||||||
Copyright (C) 2013 by Max Nazhalov
|
|
||||||
Licenced with LGPL 2 with the linking exception.
|
|
||||||
If you don't agree with these License terms, disable this feature
|
|
||||||
by undefining DOUBLETOSHORT_USEGRISU in Synopse.inc
|
|
||||||
|
|
||||||
GRISU Original Algorithm
|
|
||||||
Copyright (c) 2009 Florian Loitsch
|
|
||||||
|
|
||||||
We extracted a double-to-ascii only cut-down version of those files,
|
|
||||||
and made a huge refactoring to reach the best performance, especially
|
|
||||||
tuning the Intel target with some dedicated asm and code rewrite.
|
|
||||||
|
|
||||||
With Delphi 10.3 on Win32: (no benefit)
|
|
||||||
100000 FloatToText in 38.11ms i.e. 2,623,570/s, aver. 0us, 47.5 MB/s
|
|
||||||
100000 str in 43.19ms i.e. 2,315,082/s, aver. 0us, 50.7 MB/s
|
|
||||||
100000 DoubleToShort in 45.50ms i.e. 2,197,367/s, aver. 0us, 43.8 MB/s
|
|
||||||
100000 DoubleToAscii in 42.44ms i.e. 2,356,045/s, aver. 0us, 47.8 MB/s
|
|
||||||
|
|
||||||
With Delphi 10.3 on Win64:
|
|
||||||
100000 FloatToText in 61.83ms i.e. 1,617,233/s, aver. 0us, 29.3 MB/s
|
|
||||||
100000 str in 53.20ms i.e. 1,879,663/s, aver. 0us, 41.2 MB/s
|
|
||||||
100000 DoubleToShort in 18.45ms i.e. 5,417,998/s, aver. 0us, 108 MB/s
|
|
||||||
100000 DoubleToAscii in 18.19ms i.e. 5,496,921/s, aver. 0us, 111.5 MB/s
|
|
||||||
|
|
||||||
With FPC on Win32:
|
|
||||||
100000 FloatToText in 115.62ms i.e. 864,842/s, aver. 1us, 15.6 MB/s
|
|
||||||
100000 str in 57.30ms i.e. 1,745,109/s, aver. 0us, 39.9 MB/s
|
|
||||||
100000 DoubleToShort in 23.88ms i.e. 4,187,078/s, aver. 0us, 83.5 MB/s
|
|
||||||
100000 DoubleToAscii in 23.34ms i.e. 4,284,490/s, aver. 0us, 86.9 MB/s
|
|
||||||
|
|
||||||
With FPC on Win64:
|
|
||||||
100000 FloatToText in 76.92ms i.e. 1,300,052/s, aver. 0us, 23.5 MB/s
|
|
||||||
100000 str in 27.70ms i.e. 3,609,456/s, aver. 0us, 82.6 MB/s
|
|
||||||
100000 DoubleToShort in 14.73ms i.e. 6,787,944/s, aver. 0us, 135.4 MB/s
|
|
||||||
100000 DoubleToAscii in 13.78ms i.e. 7,253,735/s, aver. 0us, 147.2 MB/s
|
|
||||||
|
|
||||||
With FPC on Linux x86_64:
|
|
||||||
100000 FloatToText in 81.48ms i.e. 1,227,249/s, aver. 0us, 22.2 MB/s
|
|
||||||
100000 str in 36.98ms i.e. 2,703,871/s, aver. 0us, 61.8 MB/s
|
|
||||||
100000 DoubleToShort in 13.11ms i.e. 7,626,601/s, aver. 0us, 152.1 MB/s
|
|
||||||
100000 DoubleToAscii in 12.59ms i.e. 7,942,180/s, aver. 0us, 161.2 MB/s
|
|
||||||
|
|
||||||
- Our rewrite is twice faster than original flt_conv.inc from FPC RTL (str)
|
|
||||||
- Delphi Win32 has trouble making 64-bit computation - no benefit since it
|
|
||||||
has good optimized i87 asm (but slower than our code with FPC/Win32)
|
|
||||||
- FPC is more efficient when compiling integer arithmetic; we avoided slow
|
|
||||||
division by calling our Div100(), but Delphi Win64 is still far behind
|
|
||||||
- Delphi Win64 has very slow FloatToText and str()
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
// Controls printing of NaN-sign.
|
|
||||||
// Undefine to print NaN sign during float->ASCII conversion.
|
|
||||||
// IEEE does not interpret the sign of a NaN, so leave it defined.
|
|
||||||
{$define GRISU1_F2A_NAN_SIGNLESS}
|
|
||||||
|
|
||||||
// Controls rounding of generated digits when formatting with narrowed
|
|
||||||
// width (either fixed or exponential notation).
|
|
||||||
// Traditionally, FPC and BP7/Delphi use "roundTiesToAway" mode.
|
|
||||||
// Undefine to use "roundTiesToEven" approach.
|
|
||||||
{$define GRISU1_F2A_HALF_ROUNDUP}
|
|
||||||
|
|
||||||
// This one is a hack against Grusu sub-optimality.
|
|
||||||
// It may be used only strictly together with GRISU1_F2A_HALF_ROUNDUP.
|
|
||||||
// It does not violate most general rules due to the fact that it is
|
|
||||||
// applicable only when formatting with narrowed width, where the fine
|
|
||||||
// view is more desirable, and the precision is already lost, so it can
|
|
||||||
// be used in general-purpose applications.
|
|
||||||
// Refer to its implementation.
|
|
||||||
{$define GRISU1_F2A_AGRESSIVE_ROUNDUP} // Defining this fixes several tests.
|
|
||||||
|
|
||||||
// Undefine to enable SNaN support.
|
|
||||||
// Note: IEEE [754-2008, page 31] requires (1) to recognize "SNaN" during
|
|
||||||
// ASCII->float, and (2) to generate the "invalid FP operation" exception
|
|
||||||
// either when SNaN is printed as "NaN", or "SNaN" is evaluated to QNaN,
|
|
||||||
// so it would be preferable to undefine these settings,
|
|
||||||
// but the FPC RTL is not ready for this right now..
|
|
||||||
{$define GRISU1_F2A_NO_SNAN}
|
|
||||||
|
|
||||||
/// If Value=0 would just store '0', whatever frac_digits is supplied.
|
|
||||||
{$define GRISU1_F2A_ZERONOFRACT}
|
|
||||||
|
|
||||||
|
|
||||||
{$ifndef FPC}
|
|
||||||
|
|
||||||
// those functions are intrinsics with FPC :)
|
|
||||||
|
|
||||||
function BSRdword(c: cardinal): cardinal;
|
|
||||||
asm
|
|
||||||
{$ifdef CPU64}
|
|
||||||
.noframe
|
|
||||||
mov eax, c
|
|
||||||
{$endif}
|
|
||||||
bsr eax, eax
|
|
||||||
end; // in our code below, we are sure that c<>0
|
|
||||||
|
|
||||||
function BSRqword(const q: qword): cardinal;
|
|
||||||
asm
|
|
||||||
{$ifdef CPU32}
|
|
||||||
bsr eax, [esp + 8]
|
|
||||||
jz @1
|
|
||||||
add eax, 32
|
|
||||||
ret
|
|
||||||
@1: bsr eax, [esp + 4]
|
|
||||||
@2: {$else}
|
|
||||||
.noframe
|
|
||||||
mov rax, q
|
|
||||||
bsr rax, rax
|
|
||||||
{$endif}
|
|
||||||
end; // in our code below, we are sure that q<>0
|
|
||||||
|
|
||||||
|
|
||||||
{$endif FPC}
|
|
||||||
|
|
||||||
const
|
|
||||||
// TFloatFormatProfile for double
|
|
||||||
nDig_mantissa = 17;
|
|
||||||
nDig_exp10 = 3;
|
|
||||||
|
|
||||||
type
|
|
||||||
// "Do-It-Yourself Floating Point" structures
|
|
||||||
TDIY_FP = record
|
|
||||||
f: qword;
|
|
||||||
e: integer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TDIY_FP_Power_of_10 = record
|
|
||||||
c: TDIY_FP;
|
|
||||||
e10: integer;
|
|
||||||
end;
|
|
||||||
PDIY_FP_Power_of_10 = ^TDIY_FP_Power_of_10;
|
|
||||||
|
|
||||||
const
|
|
||||||
ROUNDER = $80000000;
|
|
||||||
|
|
||||||
{$ifdef CPUINTEL} // our faster version using 128-bit x86_64 multiplication
|
|
||||||
|
|
||||||
procedure d2a_diy_fp_multiply(var x, y: TDIY_FP; normalize: boolean;
|
|
||||||
out result: TDIY_FP); {$ifdef HASINLINE} inline; {$endif}
|
|
||||||
var
|
|
||||||
p: THash128Rec;
|
|
||||||
begin
|
|
||||||
mul64x64(x.f, y.f, p); // fast x86_64 / i386 asm
|
|
||||||
if (p.c1 and ROUNDER) <> 0 then
|
|
||||||
inc(p.h);
|
|
||||||
result.f := p.h;
|
|
||||||
result.e := PtrInt(x.e) + PtrInt(y.e) + 64;
|
|
||||||
if normalize then
|
|
||||||
if (PQWordRec(@result.f)^.h and ROUNDER) = 0 then
|
|
||||||
begin
|
|
||||||
result.f := result.f * 2;
|
|
||||||
dec(result.e);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$else} // regular Grisu method - optimized for 32-bit CPUs
|
|
||||||
|
|
||||||
procedure d2a_diy_fp_multiply(var x, y: TDIY_FP; normalize: boolean; out result: TDIY_FP);
|
|
||||||
var
|
|
||||||
_x: TQWordRec absolute x;
|
|
||||||
_y: TQWordRec absolute y;
|
|
||||||
r: TQWordRec absolute result;
|
|
||||||
ac, bc, ad, bd, t1: TQWordRec;
|
|
||||||
begin
|
|
||||||
ac.v := qword(_x.h) * _y.h;
|
|
||||||
bc.v := qword(_x.l) * _y.h;
|
|
||||||
ad.v := qword(_x.h) * _y.l;
|
|
||||||
bd.v := qword(_x.l) * _y.l;
|
|
||||||
t1.v := qword(ROUNDER) + bd.h + bc.l + ad.l;
|
|
||||||
result.f := ac.v + ad.h + bc.h + t1.h;
|
|
||||||
result.e := x.e + y.e + 64;
|
|
||||||
if normalize then
|
|
||||||
if (r.h and ROUNDER) = 0 then
|
|
||||||
begin
|
|
||||||
inc(result.f, result.f);
|
|
||||||
dec(result.e);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$endif CPUINTEL}
|
|
||||||
|
|
||||||
const
|
|
||||||
// alpha =-61; gamma = 0
|
|
||||||
// full cache: 1E-450 .. 1E+432, step = 1E+18
|
|
||||||
// sparse = 1/10
|
|
||||||
C_PWR10_DELTA = 18;
|
|
||||||
C_PWR10_COUNT = 50;
|
|
||||||
|
|
||||||
type
|
|
||||||
TDIY_FP_Cached_Power10 = record
|
|
||||||
base: array [ 0 .. 9 ] of TDIY_FP_Power_of_10;
|
|
||||||
factor_plus: array [ 0 .. 1 ] of TDIY_FP_Power_of_10;
|
|
||||||
factor_minus: array [ 0 .. 1 ] of TDIY_FP_Power_of_10;
|
|
||||||
// extra mantissa correction [ulp; signed]
|
|
||||||
corrector: array [ 0 .. C_PWR10_COUNT - 1 ] of shortint;
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
|
||||||
CACHED_POWER10: TDIY_FP_Cached_Power10 = (
|
|
||||||
base: (
|
|
||||||
( c: ( f: qword($825ECC24C8737830); e: -362 ); e10: -90 ),
|
|
||||||
( c: ( f: qword($E2280B6C20DD5232); e: -303 ); e10: -72 ),
|
|
||||||
( c: ( f: qword($C428D05AA4751E4D); e: -243 ); e10: -54 ),
|
|
||||||
( c: ( f: qword($AA242499697392D3); e: -183 ); e10: -36 ),
|
|
||||||
( c: ( f: qword($9392EE8E921D5D07); e: -123 ); e10: -18 ),
|
|
||||||
( c: ( f: qword($8000000000000000); e: -63 ); e10: 0 ),
|
|
||||||
( c: ( f: qword($DE0B6B3A76400000); e: -4 ); e10: 18 ),
|
|
||||||
( c: ( f: qword($C097CE7BC90715B3); e: 56 ); e10: 36 ),
|
|
||||||
( c: ( f: qword($A70C3C40A64E6C52); e: 116 ); e10: 54 ),
|
|
||||||
( c: ( f: qword($90E40FBEEA1D3A4B); e: 176 ); e10: 72 )
|
|
||||||
);
|
|
||||||
factor_plus: (
|
|
||||||
( c: ( f: qword($F6C69A72A3989F5C); e: 534 ); e10: 180 ),
|
|
||||||
( c: ( f: qword($EDE24AE798EC8284); e: 1132 ); e10: 360 )
|
|
||||||
);
|
|
||||||
factor_minus: (
|
|
||||||
( c: ( f: qword($84C8D4DFD2C63F3B); e: -661 ); e10: -180 ),
|
|
||||||
( c: ( f: qword($89BF722840327F82); e: -1259 ); e10: -360 )
|
|
||||||
);
|
|
||||||
corrector: (
|
|
||||||
0, 0, 0, 0, 1, 0, 0, 0, 1, -1,
|
|
||||||
0, 1, 1, 1, -1, 0, 0, 1, 0, -1,
|
|
||||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
||||||
-1, 0, 0, -1, 0, 0, 0, 0, 0, -1,
|
|
||||||
0, 0, 0, 0, 1, 0, 0, 0, -1, 0
|
|
||||||
));
|
|
||||||
CACHED_POWER10_MIN10 = -90 -360;
|
|
||||||
// = ref.base[low(ref.base)].e10 + ref.factor_minus[high(ref.factor_minus)].e10
|
|
||||||
|
|
||||||
// return normalized correctly rounded approximation of the power of 10
|
|
||||||
// scaling factor, intended to shift a binary exponent of the original number
|
|
||||||
// into selected [ alpha .. gamma ] range
|
|
||||||
procedure d2a_diy_fp_cached_power10(exp10: integer; out factor: TDIY_FP_Power_of_10);
|
|
||||||
var
|
|
||||||
i, xmul: integer;
|
|
||||||
A, B: PDIY_FP_Power_of_10;
|
|
||||||
cx: PtrInt;
|
|
||||||
ref: ^TDIY_FP_Cached_Power10;
|
|
||||||
begin
|
|
||||||
ref := @CACHED_POWER10; // much better code generation on PIC/x86_64
|
|
||||||
// find non-sparse index
|
|
||||||
if exp10 <= CACHED_POWER10_MIN10 then
|
|
||||||
i := 0
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
i := (exp10 - CACHED_POWER10_MIN10) div C_PWR10_DELTA;
|
|
||||||
if i * C_PWR10_DELTA + CACHED_POWER10_MIN10 <> exp10 then
|
|
||||||
inc(i); // round-up
|
|
||||||
if i > C_PWR10_COUNT - 1 then
|
|
||||||
i := C_PWR10_COUNT - 1;
|
|
||||||
end;
|
|
||||||
// generate result
|
|
||||||
xmul := i div length(ref.base);
|
|
||||||
A := @ref.base[i - (xmul * length(ref.base))]; // fast mod
|
|
||||||
dec(xmul, length(ref.factor_minus));
|
|
||||||
if xmul = 0 then
|
|
||||||
begin
|
|
||||||
// base
|
|
||||||
factor := A^;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
// surrogate
|
|
||||||
if xmul > 0 then
|
|
||||||
begin
|
|
||||||
dec(xmul);
|
|
||||||
B := @ref.factor_plus[xmul];
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
xmul := -(xmul + 1);
|
|
||||||
B := @ref.factor_minus[xmul];
|
|
||||||
end;
|
|
||||||
factor.e10 := A.e10 + B.e10;
|
|
||||||
if A.e10 <> 0 then
|
|
||||||
begin
|
|
||||||
d2a_diy_fp_multiply(A.c, B.c, true, factor.c);
|
|
||||||
// adjust mantissa
|
|
||||||
cx := ref.corrector[i];
|
|
||||||
if cx <> 0 then
|
|
||||||
inc(int64(factor.c.f), int64(cx));
|
|
||||||
end
|
|
||||||
else
|
|
||||||
// exact
|
|
||||||
factor.c := B^.c;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure d2a_unpack_float(const f: double; out minus: boolean; out result: TDIY_FP);
|
|
||||||
{$ifdef HASINLINE} inline;{$endif}
|
|
||||||
type
|
|
||||||
TSplitFloat = packed record
|
|
||||||
case byte of
|
|
||||||
0: (f: double);
|
|
||||||
1: (b: array[0..7] of byte);
|
|
||||||
2: (w: array[0..3] of word);
|
|
||||||
3: (d: array[0..1] of cardinal);
|
|
||||||
4: (l: qword);
|
|
||||||
end;
|
|
||||||
var
|
|
||||||
doublebits: TSplitFloat;
|
|
||||||
begin
|
|
||||||
{$ifdef FPC_DOUBLE_HILO_SWAPPED}
|
|
||||||
// high and low cardinal are swapped when using the arm fpa
|
|
||||||
doublebits.d[0] := TSplitFloat(f).d[1];
|
|
||||||
doublebits.d[1] := TSplitFloat(f).d[0];
|
|
||||||
{$else not FPC_DOUBLE_HILO_SWAPPED}
|
|
||||||
doublebits.f := f;
|
|
||||||
{$endif FPC_DOUBLE_HILO_SWAPPED}
|
|
||||||
{$ifdef endian_big}
|
|
||||||
minus := (doublebits.b[0] and $80 <> 0);
|
|
||||||
result.e := (doublebits.w[0] shr 4) and $7FF;
|
|
||||||
{$else endian_little}
|
|
||||||
minus := (doublebits.b[7] and $80 <> 0);
|
|
||||||
result.e := (doublebits.w[3] shr 4) and $7FF;
|
|
||||||
{$endif endian}
|
|
||||||
result.f := doublebits.l and $000FFFFFFFFFFFFF;
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
|
||||||
C_FRAC2_BITS = 52;
|
|
||||||
C_EXP2_BIAS = 1023;
|
|
||||||
C_DIY_FP_Q = 64;
|
|
||||||
C_GRISU_ALPHA = -61;
|
|
||||||
C_GRISU_GAMMA = 0;
|
|
||||||
|
|
||||||
C_EXP2_SPECIAL = C_EXP2_BIAS * 2 + 1;
|
|
||||||
C_MANT2_INTEGER = qword(1) shl C_FRAC2_BITS;
|
|
||||||
|
|
||||||
type
|
|
||||||
TAsciiDigits = array[0..47] of byte;
|
|
||||||
PAsciiDigits = ^TAsciiDigits;
|
|
||||||
|
|
||||||
// convert unsigned integers into decimal digits
|
|
||||||
|
|
||||||
{$ifdef FPC_64} // leverage efficient FPC 64-bit division as mul reciprocal
|
|
||||||
|
|
||||||
function d2a_gen_digits_64(buf: PAsciiDigits; x: qword): PtrInt;
|
|
||||||
var
|
|
||||||
tab: PWordArray;
|
|
||||||
P: PAnsiChar;
|
|
||||||
c100: qword;
|
|
||||||
begin
|
|
||||||
tab := @TwoDigitByteLookupW; // 0..99 value -> two byte digits (0..9)
|
|
||||||
P := PAnsiChar(@buf[24]); // append backwards
|
|
||||||
repeat
|
|
||||||
if x >= 100 then
|
|
||||||
begin
|
|
||||||
dec(P, 2);
|
|
||||||
c100 := x div 100;
|
|
||||||
dec(x, c100 * 100);
|
|
||||||
PWord(P)^ := tab[x];
|
|
||||||
if c100 = 0 then
|
|
||||||
break;
|
|
||||||
x := c100;
|
|
||||||
continue;
|
|
||||||
end;
|
|
||||||
if x < 10 then
|
|
||||||
begin
|
|
||||||
dec(P);
|
|
||||||
P^ := AnsiChar(x);
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
dec(P, 2);
|
|
||||||
PWord(P)^ := tab[x];
|
|
||||||
break;
|
|
||||||
until false;
|
|
||||||
PQWordArray(buf)[0] := PQWordArray(P)[0]; // faster than MoveSmall(P,buf,result)
|
|
||||||
PQWordArray(buf)[1] := PQWordArray(P)[1];
|
|
||||||
PQWordArray(buf)[2] := PQWordArray(P)[2];
|
|
||||||
result := PAnsiChar(@buf[24]) - P;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$else not FPC_64} // use three 32-bit groups of digit
|
|
||||||
|
|
||||||
function d2a_gen_digits_32(buf: PAsciiDigits; x: dword; pad_9zero: boolean): PtrInt;
|
|
||||||
const
|
|
||||||
digits: array[0..9] of cardinal = (
|
|
||||||
0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000);
|
|
||||||
var
|
|
||||||
n: PtrInt;
|
|
||||||
m: cardinal;
|
|
||||||
{$ifdef FPC}
|
|
||||||
z: cardinal;
|
|
||||||
{$else}
|
|
||||||
d100: TDiv100Rec;
|
|
||||||
{$endif FPC}
|
|
||||||
tab: PWordArray;
|
|
||||||
begin
|
|
||||||
// Calculate amount of digits
|
|
||||||
if x = 0 then
|
|
||||||
n := 0 // emit nothing if padding is not required
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
n := integer((BSRdword(x) + 1) * 1233) shr 12;
|
|
||||||
if x >= digits[n] then
|
|
||||||
inc(n);
|
|
||||||
end;
|
|
||||||
if pad_9zero and (n < 9) then
|
|
||||||
n := 9;
|
|
||||||
result := n;
|
|
||||||
if n = 0 then
|
|
||||||
exit;
|
|
||||||
// Emit digits
|
|
||||||
dec(PByte(buf));
|
|
||||||
tab := @TwoDigitByteLookupW;
|
|
||||||
m := x;
|
|
||||||
while (n >= 2) and (m <> 0) do
|
|
||||||
begin
|
|
||||||
dec(n);
|
|
||||||
{$ifdef FPC} // FPC will use fast mul reciprocal
|
|
||||||
z := m div 100; // compute two 0..9 digits
|
|
||||||
PWord(@buf[n])^ := tab^[m - z * 100];
|
|
||||||
m := z;
|
|
||||||
{$else}
|
|
||||||
Div100(m, d100); // our asm is faster than Delphi div operation
|
|
||||||
PWord(@buf[n])^ := tab^[d100.M];
|
|
||||||
m := d100.D;
|
|
||||||
{$endif FPC}
|
|
||||||
dec(n);
|
|
||||||
end;
|
|
||||||
if n = 0 then
|
|
||||||
exit;
|
|
||||||
if m <> 0 then
|
|
||||||
begin
|
|
||||||
if m > 9 then
|
|
||||||
m := m mod 10; // compute last 0..9 digit
|
|
||||||
buf[n] := m;
|
|
||||||
dec(n);
|
|
||||||
if n = 0 then
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
repeat
|
|
||||||
buf[n] := 0; // padding with 0
|
|
||||||
dec(n);
|
|
||||||
until n = 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function d2a_gen_digits_64(buf: PAsciiDigits; const x: qword): PtrInt;
|
|
||||||
var
|
|
||||||
n_digits: PtrInt;
|
|
||||||
temp: qword;
|
|
||||||
splitl, splitm, splith: cardinal;
|
|
||||||
begin
|
|
||||||
// Split X into 3 unsigned 32-bit integers; lower two should be < 10 digits long
|
|
||||||
n_digits := 0;
|
|
||||||
if x < 1000000000 then
|
|
||||||
splitl := x
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
temp := x div 1000000000;
|
|
||||||
splitl := x - temp * 1000000000;
|
|
||||||
if temp < 1000000000 then
|
|
||||||
splitm := temp
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
splith := temp div 1000000000;
|
|
||||||
splitm := cardinal(temp) - splith * 1000000000;
|
|
||||||
n_digits := d2a_gen_digits_32(buf, splith, false); // Generate hi digits
|
|
||||||
end;
|
|
||||||
inc(n_digits, d2a_gen_digits_32(@buf[n_digits], splitm, n_digits <> 0));
|
|
||||||
end;
|
|
||||||
// Generate digits
|
|
||||||
inc(n_digits, d2a_gen_digits_32(@buf[n_digits], splitl, n_digits <> 0));
|
|
||||||
result := n_digits;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$endif FPC_64}
|
|
||||||
|
|
||||||
// Performs digit sequence rounding, returns decimal point correction
|
|
||||||
function d2a_round_digits(var buf: TAsciiDigits; var n_current: integer;
|
|
||||||
n_max: PtrInt; half_round_to_even: boolean = true): PtrInt;
|
|
||||||
var
|
|
||||||
n: PtrInt;
|
|
||||||
dig_round, dig_sticky: byte;
|
|
||||||
{$ifdef GRISU1_F2A_AGRESSIVE_ROUNDUP}
|
|
||||||
i: PtrInt;
|
|
||||||
{$endif}
|
|
||||||
begin
|
|
||||||
result := 0;
|
|
||||||
n := n_current;
|
|
||||||
n_current := n_max;
|
|
||||||
// Get round digit
|
|
||||||
dig_round := buf[n_max];
|
|
||||||
{$ifdef GRISU1_F2A_AGRESSIVE_ROUNDUP}
|
|
||||||
// Detect if rounding-up the second last digit turns the "dig_round"
|
|
||||||
// into "5"; also make sure we have at least 1 digit between "dig_round"
|
|
||||||
// and the second last.
|
|
||||||
if not half_round_to_even then
|
|
||||||
if (dig_round = 4) and (n_max < n - 3) then
|
|
||||||
if buf[n - 2] >= 8 then // somewhat arbitrary...
|
|
||||||
begin
|
|
||||||
// check for only "9" are in between
|
|
||||||
i := n - 2;
|
|
||||||
repeat
|
|
||||||
dec(i);
|
|
||||||
until (i = n_max) or (buf[i] <> 9);
|
|
||||||
if i = n_max then
|
|
||||||
// force round-up
|
|
||||||
dig_round := 9; // any value ">=5"
|
|
||||||
end;
|
|
||||||
{$endif GRISU1_F2A_AGRESSIVE_ROUNDUP}
|
|
||||||
if dig_round < 5 then
|
|
||||||
exit;
|
|
||||||
// Handle "round half to even" case
|
|
||||||
if (dig_round = 5) and half_round_to_even and
|
|
||||||
((n_max = 0) or (buf[n_max - 1] and 1 = 0)) then
|
|
||||||
begin
|
|
||||||
// even and a half: check if exactly the half
|
|
||||||
dig_sticky := 0;
|
|
||||||
while (n > n_max + 1) and (dig_sticky = 0) do
|
|
||||||
begin
|
|
||||||
dec(n);
|
|
||||||
dig_sticky := buf[n];
|
|
||||||
end;
|
|
||||||
if dig_sticky = 0 then
|
|
||||||
exit; // exactly a half -> no rounding is required
|
|
||||||
end;
|
|
||||||
// Round-up
|
|
||||||
while n_max > 0 do
|
|
||||||
begin
|
|
||||||
dec(n_max);
|
|
||||||
inc(buf[n_max]);
|
|
||||||
if buf[n_max] < 10 then
|
|
||||||
begin
|
|
||||||
// no more overflow: stop now
|
|
||||||
n_current := n_max + 1;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
// continue rounding
|
|
||||||
end;
|
|
||||||
// Overflow out of the 1st digit, all n_max digits became 0
|
|
||||||
buf[0] := 1;
|
|
||||||
n_current := 1;
|
|
||||||
result := 1;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
// format the number in the fixed-point representation
|
|
||||||
procedure d2a_return_fixed(str: PAnsiChar; minus: boolean; var digits: TAsciiDigits;
|
|
||||||
n_digits_have, fixed_dot_pos, frac_digits: integer);
|
|
||||||
var
|
|
||||||
p: PAnsiChar;
|
|
||||||
d: PByte;
|
|
||||||
cut_digits_at, n_before_dot, n_before_dot_pad0, n_after_dot_pad0,
|
|
||||||
n_after_dot, n_tail_pad0: integer;
|
|
||||||
begin
|
|
||||||
// Round digits if necessary
|
|
||||||
cut_digits_at := fixed_dot_pos + frac_digits;
|
|
||||||
if cut_digits_at < 0 then
|
|
||||||
// zero
|
|
||||||
n_digits_have := 0
|
|
||||||
else if cut_digits_at < n_digits_have then
|
|
||||||
// round digits
|
|
||||||
inc(fixed_dot_pos, d2a_round_digits(digits, n_digits_have, cut_digits_at
|
|
||||||
{$ifdef GRISU1_F2A_HALF_ROUNDUP}, false {$endif} ));
|
|
||||||
// Before dot: digits, pad0
|
|
||||||
if (fixed_dot_pos <= 0) or (n_digits_have = 0) then
|
|
||||||
begin
|
|
||||||
n_before_dot := 0;
|
|
||||||
n_before_dot_pad0 := 1;
|
|
||||||
end
|
|
||||||
else if fixed_dot_pos > n_digits_have then
|
|
||||||
begin
|
|
||||||
n_before_dot := n_digits_have;
|
|
||||||
n_before_dot_pad0 := fixed_dot_pos - n_digits_have;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
n_before_dot := fixed_dot_pos;
|
|
||||||
n_before_dot_pad0 := 0;
|
|
||||||
end;
|
|
||||||
// After dot: pad0, digits, pad0
|
|
||||||
if fixed_dot_pos < 0 then
|
|
||||||
n_after_dot_pad0 := -fixed_dot_pos
|
|
||||||
else
|
|
||||||
n_after_dot_pad0 := 0;
|
|
||||||
if n_after_dot_pad0 > frac_digits then
|
|
||||||
n_after_dot_pad0 := frac_digits;
|
|
||||||
n_after_dot := n_digits_have - n_before_dot;
|
|
||||||
n_tail_pad0 := frac_digits - n_after_dot - n_after_dot_pad0;
|
|
||||||
p := str + 1;
|
|
||||||
// Sign
|
|
||||||
if minus then
|
|
||||||
begin
|
|
||||||
p^ := '-';
|
|
||||||
inc(p);
|
|
||||||
end;
|
|
||||||
// Integer significant digits
|
|
||||||
d := @digits;
|
|
||||||
if n_before_dot > 0 then
|
|
||||||
repeat
|
|
||||||
p^ := AnsiChar(d^ + ord('0'));
|
|
||||||
inc(p);
|
|
||||||
inc(d);
|
|
||||||
dec(n_before_dot);
|
|
||||||
until n_before_dot = 0;
|
|
||||||
// Integer 0-padding
|
|
||||||
if n_before_dot_pad0 > 0 then
|
|
||||||
repeat
|
|
||||||
p^ := '0';
|
|
||||||
inc(p);
|
|
||||||
dec(n_before_dot_pad0);
|
|
||||||
until n_before_dot_pad0 = 0;
|
|
||||||
//
|
|
||||||
if frac_digits <> 0 then
|
|
||||||
begin
|
|
||||||
// Dot
|
|
||||||
p^ := '.';
|
|
||||||
inc(p);
|
|
||||||
// Pre-fraction 0-padding
|
|
||||||
if n_after_dot_pad0 > 0 then
|
|
||||||
repeat
|
|
||||||
p^ := '0';
|
|
||||||
inc(p);
|
|
||||||
dec(n_after_dot_pad0);
|
|
||||||
until n_after_dot_pad0 = 0;
|
|
||||||
// Fraction significant digits
|
|
||||||
if n_after_dot > 0 then
|
|
||||||
repeat
|
|
||||||
p^ := AnsiChar(d^ + ord('0'));
|
|
||||||
inc(p);
|
|
||||||
inc(d);
|
|
||||||
dec(n_after_dot);
|
|
||||||
until n_after_dot = 0;
|
|
||||||
// Tail 0-padding
|
|
||||||
if n_tail_pad0 > 0 then
|
|
||||||
repeat
|
|
||||||
p^ := '0';
|
|
||||||
inc(p);
|
|
||||||
dec(n_tail_pad0);
|
|
||||||
until n_tail_pad0 = 0;
|
|
||||||
end;
|
|
||||||
// Store length
|
|
||||||
str[0] := AnsiChar(p - str - 1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
// formats the number as exponential representation
|
|
||||||
procedure d2a_return_exponential(str: PAnsiChar; minus: boolean;
|
|
||||||
digits: PByte; n_digits_have, n_digits_req, d_exp: PtrInt);
|
|
||||||
var
|
|
||||||
p, exp: PAnsiChar;
|
|
||||||
begin
|
|
||||||
p := str + 1;
|
|
||||||
// Sign
|
|
||||||
if minus then
|
|
||||||
begin
|
|
||||||
p^ := '-';
|
|
||||||
inc(p);
|
|
||||||
end;
|
|
||||||
// Integer part
|
|
||||||
if n_digits_have > 0 then
|
|
||||||
begin
|
|
||||||
p^ := AnsiChar(digits^ + ord('0'));
|
|
||||||
dec(n_digits_have);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
p^ := '0';
|
|
||||||
inc(p);
|
|
||||||
// Dot
|
|
||||||
if n_digits_req > 1 then
|
|
||||||
begin
|
|
||||||
p^ := '.';
|
|
||||||
inc(p);
|
|
||||||
end;
|
|
||||||
// Fraction significant digits
|
|
||||||
if n_digits_req < n_digits_have then
|
|
||||||
n_digits_have := n_digits_req;
|
|
||||||
if n_digits_have > 0 then
|
|
||||||
begin
|
|
||||||
repeat
|
|
||||||
inc(digits);
|
|
||||||
p^ := AnsiChar(digits^ + ord('0'));
|
|
||||||
inc(p);
|
|
||||||
dec(n_digits_have);
|
|
||||||
until n_digits_have = 0;
|
|
||||||
while p[-1] = '0' do
|
|
||||||
dec(p); // trim #.###00000 -> #.###
|
|
||||||
if p[-1] = '.' then
|
|
||||||
dec(p); // #.0 -> #
|
|
||||||
end;
|
|
||||||
// Exponent designator
|
|
||||||
p^ := 'E';
|
|
||||||
inc(p);
|
|
||||||
// Exponent sign (+ is not stored, as in Delphi)
|
|
||||||
if d_exp < 0 then
|
|
||||||
begin
|
|
||||||
p^ := '-';
|
|
||||||
d_exp := -d_exp;
|
|
||||||
inc(p);
|
|
||||||
end;
|
|
||||||
// Exponent digits
|
|
||||||
exp := pointer(SmallUInt32UTF8[d_exp]); // 0..999 range is fine
|
|
||||||
PCardinal(p)^ := PCardinal(exp)^;
|
|
||||||
inc(p, PStrLen(exp - _STRLEN)^);
|
|
||||||
// Store length
|
|
||||||
str[0] := AnsiChar(p - str - 1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
/// set one of special results with proper sign
|
|
||||||
procedure d2a_return_special(str: PAnsiChar; sign: integer; const spec: shortstring);
|
|
||||||
begin
|
|
||||||
// Compute length
|
|
||||||
str[0] := spec[0];
|
|
||||||
if sign <> 0 then
|
|
||||||
inc(str[0]);
|
|
||||||
inc(str);
|
|
||||||
// Sign
|
|
||||||
if sign <> 0 then
|
|
||||||
begin
|
|
||||||
if sign > 0 then
|
|
||||||
str^ := '+'
|
|
||||||
else
|
|
||||||
str^ := '-';
|
|
||||||
inc(str);
|
|
||||||
end;
|
|
||||||
// Special text (3 chars)
|
|
||||||
PCardinal(str)^ := PCardinal(@spec[1])^;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
// Calculates the exp10 of a factor required to bring the binary exponent
|
|
||||||
// of the original number into selected [ alpha .. gamma ] range:
|
|
||||||
// result := ceiling[ ( alpha - e ) * log10(2) ]
|
|
||||||
function d2a_k_comp(e, alpha{, gamma}: integer): integer;
|
|
||||||
var
|
|
||||||
dexp: double;
|
|
||||||
const
|
|
||||||
D_LOG10_2: double = 0.301029995663981195213738894724493027; // log10(2)
|
|
||||||
var
|
|
||||||
x, n: integer;
|
|
||||||
begin
|
|
||||||
x := alpha - e;
|
|
||||||
dexp := x * D_LOG10_2;
|
|
||||||
// ceil( dexp )
|
|
||||||
n := trunc(dexp);
|
|
||||||
if x > 0 then
|
|
||||||
if dexp <> n then
|
|
||||||
inc(n); // round-up
|
|
||||||
result := n;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
/// raw function to convert a 64-bit double into a shortstring, stored in str
|
|
||||||
// - implements Fabian Loitsch's Grisu algorithm dedicated to double values
|
|
||||||
// - currently, SynCommnons only set min_width=0 (for DoubleToShortNoExp to avoid
|
|
||||||
// any scientific notation ) or min_width=C_NO_MIN_WIDTH (for DoubleToShort to
|
|
||||||
// force the scientific notation when the double cannot be represented as
|
|
||||||
// a simple fractinal number)
|
|
||||||
procedure DoubleToAscii(min_width, frac_digits: integer; const v: double; str: PAnsiChar);
|
|
||||||
var
|
|
||||||
w, D: TDIY_FP;
|
|
||||||
c_mk: TDIY_FP_Power_of_10;
|
|
||||||
n, mk, dot_pos, n_digits_need, n_digits_have: integer;
|
|
||||||
n_digits_req, n_digits_sci: integer;
|
|
||||||
minus: boolean;
|
|
||||||
fl, one_maskl: qword;
|
|
||||||
one_e: integer;
|
|
||||||
{$ifdef CPU32}
|
|
||||||
one_mask, f: cardinal; // run a 2nd loop with 32-bit range
|
|
||||||
{$endif CPU32}
|
|
||||||
buf: TAsciiDigits;
|
|
||||||
begin
|
|
||||||
// Limit parameters
|
|
||||||
if frac_digits > 216 then
|
|
||||||
frac_digits := 216; // Delphi compatible
|
|
||||||
if min_width <= C_NO_MIN_WIDTH then
|
|
||||||
min_width := -1 // no minimal width
|
|
||||||
else if min_width < 0 then
|
|
||||||
min_width := 0; // minimal width is as short as possible
|
|
||||||
// Format profile: select "n_digits_need" (and "n_digits_exp")
|
|
||||||
n_digits_req := nDig_mantissa;
|
|
||||||
// number of digits to be calculated by Grisu
|
|
||||||
n_digits_need := nDig_mantissa;
|
|
||||||
if n_digits_req < n_digits_need then
|
|
||||||
n_digits_need := n_digits_req;
|
|
||||||
// number of mantissa digits to be printed in exponential notation
|
|
||||||
if min_width < 0 then
|
|
||||||
n_digits_sci := n_digits_req
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
n_digits_sci := min_width -1 {sign} -1 {dot} -1 {E} -1 {E-sign} - nDig_exp10;
|
|
||||||
if n_digits_sci < 2 then
|
|
||||||
n_digits_sci := 2; // at least 2 digits
|
|
||||||
if n_digits_sci > n_digits_req then
|
|
||||||
n_digits_sci := n_digits_req; // at most requested by real_type
|
|
||||||
end;
|
|
||||||
// Float -> DIY_FP
|
|
||||||
d2a_unpack_float(v, minus, w);
|
|
||||||
// Handle Zero
|
|
||||||
if (w.e = 0) and (w.f = 0) then
|
|
||||||
begin
|
|
||||||
{$ifdef GRISU1_F2A_ZERONOFRACT}
|
|
||||||
PWord(str)^ := 1 + ord('0') shl 8; // just return '0'
|
|
||||||
{$else}
|
|
||||||
if frac_digits >= 0 then
|
|
||||||
d2a_return_fixed(str, minus, buf, 0, 1, frac_digits)
|
|
||||||
else
|
|
||||||
d2a_return_exponential(str, minus, @buf, 0, n_digits_sci, 0);
|
|
||||||
{$endif GRISU1_F2A_ZERONOFRACT}
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
// Handle specials
|
|
||||||
if w.e = C_EXP2_SPECIAL then
|
|
||||||
begin
|
|
||||||
n := 1 - ord(minus) * 2; // default special sign [-1|+1]
|
|
||||||
if w.f = 0 then
|
|
||||||
d2a_return_special(str, n, C_STR_INF)
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
// NaN [also pseudo-NaN, pseudo-Inf, non-normal for floatx80]
|
|
||||||
{$ifdef GRISU1_F2A_NAN_SIGNLESS}
|
|
||||||
n := 0;
|
|
||||||
{$endif}
|
|
||||||
{$ifndef GRISU1_F2A_NO_SNAN}
|
|
||||||
if (w.f and (C_MANT2_INTEGER shr 1)) = 0 then
|
|
||||||
return_special(str, n, C_STR_SNAN)
|
|
||||||
else
|
|
||||||
{$endif GRISU1_F2A_NO_SNAN}
|
|
||||||
d2a_return_special(str, n, C_STR_QNAN);
|
|
||||||
end;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
// Handle denormals
|
|
||||||
if w.e <> 0 then
|
|
||||||
begin
|
|
||||||
// normal
|
|
||||||
w.f := w.f or C_MANT2_INTEGER;
|
|
||||||
n := C_DIY_FP_Q - C_FRAC2_BITS - 1;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
// denormal (w.e=0)
|
|
||||||
n := 63 - BSRqword(w.f); // we are sure that w.f<>0 - see Handle Zero above
|
|
||||||
inc(w.e);
|
|
||||||
end;
|
|
||||||
// Final normalization
|
|
||||||
w.f := w.f shl n;
|
|
||||||
dec(w.e, C_EXP2_BIAS + n + C_FRAC2_BITS);
|
|
||||||
// 1. Find the normalized "c_mk = f_c * 2^e_c" such that
|
|
||||||
// "alpha <= e_c + e_w + q <= gamma"
|
|
||||||
// 2. Define "V = D * 10^k": multiply the input number by "c_mk", do not
|
|
||||||
// normalize to land into [ alpha .. gamma ]
|
|
||||||
// 3. Generate digits ( n_digits_need + "round" )
|
|
||||||
if (C_GRISU_ALPHA <= w.e) and (w.e <= C_GRISU_GAMMA) then
|
|
||||||
begin
|
|
||||||
// no scaling required
|
|
||||||
D := w;
|
|
||||||
c_mk.e10 := 0;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
mk := d2a_k_comp(w.e, C_GRISU_ALPHA{, C_GRISU_GAMMA} );
|
|
||||||
d2a_diy_fp_cached_power10(mk, c_mk);
|
|
||||||
// Let "D = f_D * 2^e_D := w (*) c_mk"
|
|
||||||
if c_mk.e10 = 0 then
|
|
||||||
D := w
|
|
||||||
else
|
|
||||||
d2a_diy_fp_multiply(w, c_mk.c, false, D);
|
|
||||||
end;
|
|
||||||
// Generate digits: integer part
|
|
||||||
n_digits_have := d2a_gen_digits_64(@buf, D.f shr (-D.e));
|
|
||||||
dot_pos := n_digits_have;
|
|
||||||
// Generate digits: fractional part
|
|
||||||
{$ifdef CPU32}
|
|
||||||
f := 0; // "sticky" digit
|
|
||||||
{$endif CPU32}
|
|
||||||
if D.e < 0 then
|
|
||||||
repeat
|
|
||||||
// MOD by ONE
|
|
||||||
one_e := D.e;
|
|
||||||
one_maskl := qword(1) shl (-D.e) - 1;
|
|
||||||
fl := D.f and one_maskl;
|
|
||||||
// 64-bit loop (very efficient on x86_64, slower on i386)
|
|
||||||
while {$ifdef CPU32} (one_e < -29) and {$endif}
|
|
||||||
(n_digits_have < n_digits_need + 1) and (fl <> 0) do
|
|
||||||
begin
|
|
||||||
// f := f * 5;
|
|
||||||
inc(fl, fl shl 2);
|
|
||||||
// one := one / 2
|
|
||||||
one_maskl := one_maskl shr 1;
|
|
||||||
inc(one_e);
|
|
||||||
// DIV by one
|
|
||||||
buf[n_digits_have] := fl shr (-one_e);
|
|
||||||
// MOD by one
|
|
||||||
fl := fl and one_maskl;
|
|
||||||
// next
|
|
||||||
inc(n_digits_have);
|
|
||||||
end;
|
|
||||||
{$ifdef CPU32}
|
|
||||||
if n_digits_have >= n_digits_need + 1 then
|
|
||||||
begin
|
|
||||||
// only "sticky" digit remains
|
|
||||||
f := ord(fl <> 0);
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
one_mask := cardinal(one_maskl);
|
|
||||||
f := cardinal(fl);
|
|
||||||
// 32-bit loop
|
|
||||||
while (n_digits_have < n_digits_need + 1) and (f <> 0) do
|
|
||||||
begin
|
|
||||||
// f := f * 5;
|
|
||||||
inc(f, f shl 2);
|
|
||||||
// one := one / 2
|
|
||||||
one_mask := one_mask shr 1;
|
|
||||||
inc(one_e);
|
|
||||||
// DIV by one
|
|
||||||
buf[n_digits_have] := f shr (-one_e);
|
|
||||||
// MOD by one
|
|
||||||
f := f and one_mask;
|
|
||||||
// next
|
|
||||||
inc(n_digits_have);
|
|
||||||
end;
|
|
||||||
{$endif CPU32}
|
|
||||||
until true;
|
|
||||||
{$ifdef CPU32}
|
|
||||||
// Append "sticky" digit if any
|
|
||||||
if (f <> 0) and (n_digits_have >= n_digits_need + 1) then
|
|
||||||
begin
|
|
||||||
// single "<>0" digit is enough
|
|
||||||
n_digits_have := n_digits_need + 2;
|
|
||||||
buf[n_digits_need + 1] := 1;
|
|
||||||
end;
|
|
||||||
{$endif CPU32}
|
|
||||||
// Round to n_digits_need using "roundTiesToEven"
|
|
||||||
if n_digits_have > n_digits_need then
|
|
||||||
inc(dot_pos, d2a_round_digits(buf, n_digits_have, n_digits_need));
|
|
||||||
// Generate output
|
|
||||||
if frac_digits >= 0 then
|
|
||||||
begin
|
|
||||||
d2a_return_fixed(str, minus, buf, n_digits_have, dot_pos - c_mk.e10,
|
|
||||||
frac_digits);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if n_digits_have > n_digits_sci then
|
|
||||||
inc(dot_pos, d2a_round_digits(buf, n_digits_have, n_digits_sci
|
|
||||||
{$ifdef GRISU1_F2A_HALF_ROUNDUP}, false {$endif} ));
|
|
||||||
d2a_return_exponential(str, minus, @buf, n_digits_have, n_digits_sci,
|
|
||||||
dot_pos - c_mk.e10 - 1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -1,200 +0,0 @@
|
|||||||
/// wrapper around FPC typinfo.pp unit for SynCommons.pas and mORMot.pas
|
|
||||||
// - this unit is a part of the freeware Synopse mORMot framework,
|
|
||||||
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
||||||
unit SynFPCTypInfo;
|
|
||||||
|
|
||||||
{
|
|
||||||
This file is part of Synopse mORMot framework.
|
|
||||||
|
|
||||||
Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
|
|
||||||
Synopse Informatique - https://synopse.info
|
|
||||||
|
|
||||||
*** BEGIN LICENSE BLOCK *****
|
|
||||||
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
||||||
|
|
||||||
The contents of this file are subject to the Mozilla Public License Version
|
|
||||||
1.1 (the "License"); you may not use this file except in compliance with
|
|
||||||
the License. You may obtain a copy of the License at
|
|
||||||
http://www.mozilla.org/MPL
|
|
||||||
|
|
||||||
Software distributed under the License is distributed on an "AS IS" basis,
|
|
||||||
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
||||||
for the specific language governing rights and limitations under the License.
|
|
||||||
|
|
||||||
The Original Code is Synopse mORMot framework.
|
|
||||||
|
|
||||||
The Initial Developer of the Original Code is Alfred Glaenzer.
|
|
||||||
|
|
||||||
Portions created by the Initial Developer are Copyright (C) 2022
|
|
||||||
the Initial Developer. All Rights Reserved.
|
|
||||||
|
|
||||||
Contributor(s):
|
|
||||||
- Arnaud Bouchez
|
|
||||||
|
|
||||||
|
|
||||||
Alternatively, the contents of this file may be used under the terms of
|
|
||||||
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
||||||
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
||||||
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
||||||
of those above. if you wish to allow use of your version of this file only
|
|
||||||
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
||||||
use your version of this file under the terms of the MPL, indicate your
|
|
||||||
decision by deleting the provisions above and replace them with the notice
|
|
||||||
and other provisions required by the GPL or the LGPL. if you do not delete
|
|
||||||
the provisions above, a recipient may use your version of this file under
|
|
||||||
the terms of any one of the MPL, the GPL or the LGPL.
|
|
||||||
|
|
||||||
***** END LICENSE BLOCK *****
|
|
||||||
|
|
||||||
Unit created to avoid polluting the SynCommons.pas/mORMot.pas namespace
|
|
||||||
with overloaded typinfo.pp types.
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
interface
|
|
||||||
|
|
||||||
{$ifndef FPC}
|
|
||||||
'this unit is for FPC only - do not include it in any Delphi project!'
|
|
||||||
{$endif FPC}
|
|
||||||
|
|
||||||
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
|
||||||
|
|
||||||
uses
|
|
||||||
SysUtils,
|
|
||||||
TypInfo;
|
|
||||||
|
|
||||||
{$ifdef FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
type
|
|
||||||
// if you have a compilation error here, your FPC trunk is too old
|
|
||||||
// - TTypeData.AttributeTable was introduced in SVN 42356-42411 (2019/07)
|
|
||||||
// -> undefine FPC_PROVIDE_ATTR_TABLE in Synopse.inc and recompile
|
|
||||||
PFPCAttributeTable = TypInfo.PAttributeTable;
|
|
||||||
{$endif FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
|
|
||||||
{$ifdef HASALIGNTYPEDATA}
|
|
||||||
function AlignTypeData(p: pointer): pointer; inline;
|
|
||||||
function AlignTypeDataClean(p: pointer): pointer; inline;
|
|
||||||
{$else}
|
|
||||||
type
|
|
||||||
AlignTypeData = pointer;
|
|
||||||
AlignTypeDataClean = pointer;
|
|
||||||
{$endif HASALIGNTYPEDATA}
|
|
||||||
|
|
||||||
|
|
||||||
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
function AlignToPtr(p: pointer): pointer; inline;
|
|
||||||
function AlignPTypeInfo(p: pointer): pointer; inline;
|
|
||||||
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
type
|
|
||||||
AlignToPtr = pointer;
|
|
||||||
AlignPTypeInfo = pointer;
|
|
||||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
|
|
||||||
type
|
|
||||||
/// some type definition to avoid inclusion of TypInfo in SynCommons/mORMot.pas
|
|
||||||
PFPCInterfaceData = TypInfo.PInterfaceData;
|
|
||||||
PFPCVmtMethodParam = TypInfo.PVmtMethodParam;
|
|
||||||
PFPCIntfMethodTable = TypInfo.PIntfMethodTable;
|
|
||||||
PFPCIntfMethodEntry = TypInfo.PIntfMethodEntry;
|
|
||||||
{$ifdef FPC_NEWRTTI}
|
|
||||||
PFPCRecInitData = TypInfo.PRecInitData;
|
|
||||||
|
|
||||||
{$endif FPC_NEWRTTI}
|
|
||||||
|
|
||||||
procedure FPCDynArrayClear(var a: Pointer; TypeInfo: Pointer);
|
|
||||||
procedure FPCFinalizeArray(p: Pointer; TypeInfo: Pointer; elemCount: PtrUInt);
|
|
||||||
procedure FPCFinalize(Data: Pointer; TypeInfo: Pointer);
|
|
||||||
procedure FPCRecordCopy(const Source; var Dest; TypeInfo: pointer);
|
|
||||||
procedure FPCRecordAddRef(var Data; TypeInfo : pointer);
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
|
||||||
|
|
||||||
procedure FPCDynArrayClear(var a: Pointer; TypeInfo: Pointer);
|
|
||||||
external name 'FPC_DYNARRAY_CLEAR';
|
|
||||||
procedure FPCFinalizeArray(p: Pointer; TypeInfo: Pointer; elemCount: PtrUInt);
|
|
||||||
external name 'FPC_FINALIZE_ARRAY';
|
|
||||||
procedure FPCFinalize(Data: Pointer; TypeInfo: Pointer);
|
|
||||||
external name 'FPC_FINALIZE';
|
|
||||||
procedure FPCRecordCopy(const Source; var Dest; TypeInfo: pointer);
|
|
||||||
external name 'FPC_COPY';
|
|
||||||
procedure FPCRecordAddRef(var Data; TypeInfo : pointer);
|
|
||||||
external name 'FPC_ADDREF';
|
|
||||||
|
|
||||||
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} // copied from latest typinfo.pp
|
|
||||||
function AlignToPtr(p: pointer): pointer;
|
|
||||||
begin
|
|
||||||
result := align(p,sizeof(p));
|
|
||||||
end;
|
|
||||||
|
|
||||||
function AlignTypeData(p: pointer): pointer;
|
|
||||||
{$packrecords c}
|
|
||||||
type
|
|
||||||
TAlignCheck = record // match RTTI TTypeInfo definition
|
|
||||||
b : byte; // = TTypeKind
|
|
||||||
q : qword; // = this is where the PTypeData begins
|
|
||||||
end;
|
|
||||||
{$packrecords default}
|
|
||||||
begin
|
|
||||||
{$ifdef VER3_0}
|
|
||||||
result := Pointer(align(p,SizeOf(Pointer)));
|
|
||||||
{$else VER3_0}
|
|
||||||
result := Pointer(align(p,PtrInt(@TAlignCheck(nil^).q)));
|
|
||||||
{$endif VER3_0}
|
|
||||||
{$ifdef FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
inc(PByte(result),SizeOf(PFPCAttributeTable)); // ignore attributes table
|
|
||||||
result := Pointer(align(result,PtrInt(@TAlignCheck(nil^).q)));
|
|
||||||
{$endif FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
end;
|
|
||||||
{$else}
|
|
||||||
{$ifdef FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
function AlignTypeData(p: pointer): pointer;
|
|
||||||
begin
|
|
||||||
result := p;
|
|
||||||
inc(PByte(result),SizeOf(PFPCAttributeTable)); // ignore attributes table
|
|
||||||
end;
|
|
||||||
{$endif FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
|
|
||||||
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} // copied from latest typinfo.pp
|
|
||||||
|
|
||||||
function AlignTypeDataClean(p: pointer): pointer;
|
|
||||||
{$packrecords c}
|
|
||||||
type
|
|
||||||
TAlignCheck = record // match RTTI TTypeInfo definition
|
|
||||||
b : byte; // = TTypeKind
|
|
||||||
q : qword; // = this is where the PTypeData begins
|
|
||||||
end;
|
|
||||||
{$packrecords default}
|
|
||||||
begin
|
|
||||||
{$ifdef VER3_0}
|
|
||||||
result := Pointer(align(p,SizeOf(Pointer)));
|
|
||||||
{$else VER3_0}
|
|
||||||
result := Pointer(align(p,PtrInt(@TAlignCheck(nil^).q)));
|
|
||||||
{$endif VER3_0}
|
|
||||||
end;
|
|
||||||
|
|
||||||
function AlignPTypeInfo(p: pointer): pointer; inline;
|
|
||||||
{$packrecords c}
|
|
||||||
type
|
|
||||||
TAlignCheck = record
|
|
||||||
b : byte;
|
|
||||||
p : pointer;
|
|
||||||
end;
|
|
||||||
{$packrecords default}
|
|
||||||
begin
|
|
||||||
Result := Pointer(align(p,PtrInt(@TAlignCheck(nil^).p)))
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$else}
|
|
||||||
{$ifdef HASALIGNTYPEDATA}
|
|
||||||
function AlignTypeDataClean(p: pointer): pointer;
|
|
||||||
begin
|
|
||||||
result := p;
|
|
||||||
end;
|
|
||||||
{$endif HASALIGNTYPEDATA}
|
|
||||||
|
|
||||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
|
|
||||||
end.
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,736 +0,0 @@
|
|||||||
{
|
|
||||||
This file is part of Synopse framework.
|
|
||||||
|
|
||||||
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
|
|
||||||
Synopse Informatique - https://synopse.info
|
|
||||||
|
|
||||||
*** BEGIN LICENSE BLOCK *****
|
|
||||||
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
||||||
|
|
||||||
The contents of this file are subject to the Mozilla Public License Version
|
|
||||||
1.1 (the "License"); you may not use this file except in compliance with
|
|
||||||
the License. You may obtain a copy of the License at
|
|
||||||
http://www.mozilla.org/MPL
|
|
||||||
|
|
||||||
Software distributed under the License is distributed on an "AS IS" basis,
|
|
||||||
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
||||||
for the specific language governing rights and limitations under the License.
|
|
||||||
|
|
||||||
The Original Code is Synopse framework.
|
|
||||||
|
|
||||||
The Initial Developer of the Original Code is Arnaud Bouchez.
|
|
||||||
|
|
||||||
Portions created by the Initial Developer are Copyright (C) 2022
|
|
||||||
the Initial Developer. All Rights Reserved.
|
|
||||||
|
|
||||||
Contributor(s):
|
|
||||||
Alfred Glaenzer (alf)
|
|
||||||
|
|
||||||
Alternatively, the contents of this file may be used under the terms of
|
|
||||||
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
||||||
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
||||||
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
||||||
of those above. If you wish to allow use of your version of this file only
|
|
||||||
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
||||||
use your version of this file under the terms of the MPL, indicate your
|
|
||||||
decision by deleting the provisions above and replace them with the notice
|
|
||||||
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
||||||
the provisions above, a recipient may use your version of this file under
|
|
||||||
the terms of any one of the MPL, the GPL or the LGPL.
|
|
||||||
|
|
||||||
***** END LICENSE BLOCK *****
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
(********************** User-Trigerred Conditionals **********************)
|
|
||||||
|
|
||||||
{ Those conditionals below can be enabled in your project Options,
|
|
||||||
to tune the compilation depending your setup or your project expectations. }
|
|
||||||
|
|
||||||
{.$define PUREPASCAL}
|
|
||||||
// define this if your compiler doesn't support Delphi's x86 asm
|
|
||||||
// - is set automaticaly in case of a 64 bits compiler (only FPC exists now)
|
|
||||||
|
|
||||||
{$define USENORMTOUPPER}
|
|
||||||
// if defined, text functions will use the NormToUpper[] array, as defined
|
|
||||||
// in our custom SysUtils.pas (not the LVCL version) -> when using LVCL,
|
|
||||||
// define the global LVCL compiler directive, and this unit will initialize
|
|
||||||
// its own NormToUpper[] array
|
|
||||||
// -> define ENHANCEDRTL conditional below if our Enhanced RTL IS installed
|
|
||||||
// -> in practice, this conditional is ALWAYS DEFINED, since needed by SQLite3
|
|
||||||
|
|
||||||
{.$define ENHANCEDRTL}
|
|
||||||
// define this if you DID install our Enhanced Runtime library or the LVCL:
|
|
||||||
// - it's better to define this conditional globaly in the Project/Options window
|
|
||||||
// - we need to hack the "legacy" LoadResString() procedure and add a
|
|
||||||
// LoadResStringTranslate() function, for on the fly resourcestring i18n
|
|
||||||
// - it will also define the TwoDigitLookup[] array and some very fast x86 asm
|
|
||||||
// IntToStr() and other functions, available in our Enhanced Runtime library
|
|
||||||
// (and our LVCL library)
|
|
||||||
// - it will be unset automaticaly (see below) for Delphi 2009 and up
|
|
||||||
// - this conditional must be defined in both SQLite3Commons and SQLite3i18n units,
|
|
||||||
// or (even better) globally in the Project options
|
|
||||||
|
|
||||||
{.$define USEPACKAGES}
|
|
||||||
// define this if you compile the unit within a Delphi package
|
|
||||||
// - it will avoid error like "[DCC Error] E2201 Need imported data reference ($G)
|
|
||||||
// to access 'VarCopyProc' from unit 'SynCommons'"
|
|
||||||
// - shall be set at the package options level, and left untouched by default
|
|
||||||
// - note: you should probably also set "Generate DCUs only" in Project Options
|
|
||||||
// -> Delphi Compiler -> Output C/C++ -> C/C++ output file generation
|
|
||||||
|
|
||||||
{.$define DOPATCHTRTL}
|
|
||||||
// if defined, some low-level patches are applied to Delphi or FPC RTL
|
|
||||||
// - you should better use it, but we have unset it by default
|
|
||||||
|
|
||||||
{.$define NEWRTTINOTUSED}
|
|
||||||
// if defined, the new RTTI (available since Delphi 2010) won't be linked to
|
|
||||||
// the executable: resulting file size will be much smaller, and mORMot won't
|
|
||||||
// be affected (unless you use the enhanced RTTI for record/dynamic array JSON
|
|
||||||
// serialization) - left undefined by default to ensure minimal impact
|
|
||||||
|
|
||||||
{.$define NOSETTHREADNAME}
|
|
||||||
// if defined, SetThreadName() would not raise the exception used to set the
|
|
||||||
// thread name: to be defined if you have issues when debugging your application
|
|
||||||
|
|
||||||
{.$define NOEXCEPTIONINTERCEPT}
|
|
||||||
// if defined, exceptions shall not be intercepted and logged
|
|
||||||
|
|
||||||
{.$define USELOCKERDEBUG}
|
|
||||||
// by default, some IAutoLocker instances would use TAutoLocker, unless this
|
|
||||||
// conditional is defined to use more verbose TAutoLockerDebug
|
|
||||||
// (may be used for race condition debugging, in multi-threaded apps)
|
|
||||||
|
|
||||||
{.$define OLDTEXTWRITERFORMAT}
|
|
||||||
// force TTextWriter.Add(Format) to handle the alternate deprecated $ % tags
|
|
||||||
|
|
||||||
{.$define FORCE_STRSSE42}
|
|
||||||
// sse4.2 string instructions may read up to 16 bytes after the actual end buffer
|
|
||||||
// -> define this if you want StrLen/StrComp/strspn/strcspn to use SSE4.2 opcodes
|
|
||||||
// but you would eventually experiment weird random GPF in your project, raising
|
|
||||||
// unexpected SIGABRT/SIGSEGV under POSIX system: so is disabled below for our
|
|
||||||
// LINUX conditional - and use at your own risk under Windows!
|
|
||||||
|
|
||||||
{.$define DISABLE_SSE42}
|
|
||||||
// if defined, no SSE4.2 nor AES-NI instruction will be used, i.e. disable
|
|
||||||
// FORCE_STRSSE42 and all crc32c opcodes - is set for FPC DARWIN target
|
|
||||||
|
|
||||||
{.$define WITH_ERMS}
|
|
||||||
// you may define this to enable REP MOVSB/STOSB for Fillchar/Move if cfERMS
|
|
||||||
// flag is available in Intel's CpuFeatures
|
|
||||||
// -> disabled by default, since in practice it is (much) slower for small blocks
|
|
||||||
|
|
||||||
{.$define NOXPOWEREDNAME}
|
|
||||||
// define this to avoid sending "X-Powered-By: Synopse mORMot" HTTP header
|
|
||||||
|
|
||||||
{.$define SQLVIRTUALLOGS}
|
|
||||||
// enable low-level logging of SQlite3 virtual table query planner costs
|
|
||||||
// -> to be defined only for internal debugging
|
|
||||||
|
|
||||||
{.$define NOSYNDBZEOS}
|
|
||||||
// made SynDBZeos.pas a "void" unit - defined for FPC/Lazarus packages only
|
|
||||||
|
|
||||||
{.$define DDDNOSYNDB}
|
|
||||||
// SynDB / external SQL DB won't be linked to the executable by dddInfraSettings
|
|
||||||
{.$define DDDNOMONGODB}
|
|
||||||
// Mongo DB client won't be linked to the executable by dddInfraSettings
|
|
||||||
|
|
||||||
|
|
||||||
{$ifdef FPC}
|
|
||||||
|
|
||||||
(********************** FPC Conditionals **********************)
|
|
||||||
|
|
||||||
{ Free Pascal adaptation notes:
|
|
||||||
- we use the Delphi compatibility mode
|
|
||||||
- from system.pp use these constants (Win32/64 values listed):
|
|
||||||
LineEnding = #13#10;
|
|
||||||
DirectorySeparator = '\';
|
|
||||||
- for Cross-Platform and all CPU:
|
|
||||||
integer is NOT CPU-dependent (thanks to objpas), i.e. always 32 bits
|
|
||||||
cardinal is NOT CPU-dependent (thanks to objpas), i.e. always 32 bits
|
|
||||||
PtrUInt is an unsigned integer type of same size as a pointer / register
|
|
||||||
-> must be used for pointer arithmetic
|
|
||||||
-> may be used in loops
|
|
||||||
PtrInt is a signed integer type of same size as a pointer / register
|
|
||||||
-> must be used for pointer arithmetic
|
|
||||||
-> may be used in loops
|
|
||||||
all 32 bits x86 asm code is replaced by a pascal only version, if the
|
|
||||||
conditional PUREPASCAL is defined (e.g. for CPUX64)
|
|
||||||
}
|
|
||||||
|
|
||||||
{$ifndef FPC_DELPHI}
|
|
||||||
{$MODE DELPHI} // e.g. for asm syntax - disabled for FPC 2.6 compatibility
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$INLINE ON}
|
|
||||||
{$MINENUMSIZE 1}
|
|
||||||
{$PACKRECORDS DEFAULT} // force normal alignment
|
|
||||||
{$PACKSET 1}
|
|
||||||
{$PACKENUM 1}
|
|
||||||
{$CODEPAGE UTF8} // otherwise unexpected behavior occurs in most cases
|
|
||||||
|
|
||||||
{$undef ENHANCEDRTL} // there is no version of our Enhanced RTL for FPC
|
|
||||||
{$define HASINLINE}
|
|
||||||
{$define HASUINT64}
|
|
||||||
{$define HASINLINENOTX86}
|
|
||||||
{$define NODELPHIASM} // ignore low-level System.@LStrFromPCharLen calls
|
|
||||||
{$define HASTTHREADSTART}
|
|
||||||
{$define HASINTERFACEASTOBJECT}
|
|
||||||
{$define EXTENDEDTOSHORT_USESTR} // FloatToText uses str() in FPC
|
|
||||||
{$define DOUBLETOSHORT_USEGRISU} // fast double to text
|
|
||||||
{$define DELPHI5ORFPC}
|
|
||||||
{$define FPC_OR_PUREPASCAL}
|
|
||||||
{$define FPC_OR_KYLIX}
|
|
||||||
{$define FPC_OR_UNICODE}
|
|
||||||
{$define USERECORDWITHMETHODS}
|
|
||||||
{$define FPC_OR_DELPHIXE}
|
|
||||||
{$define FPC_OR_DELPHIXE4}
|
|
||||||
{$define FPC_ENUMHASINNER}
|
|
||||||
{$define USE_VTYPE_STATIC} // in our inlined VarClear()
|
|
||||||
|
|
||||||
// $if FPC_FULLVERSION>20700 breaks Delphi 6-7 and SynProject :(
|
|
||||||
{$ifdef VER2_7}
|
|
||||||
{$define ISFPC27}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER3_0}
|
|
||||||
{$define ISFPC27}
|
|
||||||
{$define ISFPC30}
|
|
||||||
{$define HASDIRECTTYPEINFO}
|
|
||||||
// PTypeInfo would be stored with no pointer de-reference
|
|
||||||
// => Delphi and newer FPC uses a pointer reference to ease exe linking
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER3_1} // trunk before 3.2
|
|
||||||
{$define ISFPC27}
|
|
||||||
{$define ISFPC30}
|
|
||||||
{.$define HASDIRECTTYPEINFO}
|
|
||||||
// define this for trunk revisions older than June 2016 - see
|
|
||||||
// http://wiki.freepascal.org/User_Changes_Trunk#RTTI_Binary_format_change
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER3_1_1} // if FPC_FULLVERSION>30100 ... ifend is not Delphi 5 compatible :(
|
|
||||||
{$define ISFPC32}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER3_2}
|
|
||||||
{$define ISFPC27}
|
|
||||||
{$define ISFPC30}
|
|
||||||
{$define ISFPC32}
|
|
||||||
{$ifdef VER3_2_2}
|
|
||||||
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
|
||||||
{$endif VER3_2_2}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER3_3} // trunk before 3.4
|
|
||||||
{$define ISFPC27}
|
|
||||||
{$define ISFPC30}
|
|
||||||
{$define ISFPC32}
|
|
||||||
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER3_4}
|
|
||||||
{$define ISFPC27}
|
|
||||||
{$define ISFPC30}
|
|
||||||
{$define ISFPC32}
|
|
||||||
{$define ISFPC34}
|
|
||||||
{$define FPC_PROVIDE_ATTR_TABLE} // introducing TTypeData.AttributeTable
|
|
||||||
{$define STRCNT32} // 32-bit TAnsiRec.RefCnt even on 64-bit CPU
|
|
||||||
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
|
||||||
{$endif}
|
|
||||||
{$if not defined(VER3_0) and not defined(VER3_2) and not defined(VER2)}
|
|
||||||
{.$define FPC_PROVIDE_ATTR_TABLE} // to be defined since SVN 42356-42411
|
|
||||||
// on compilation error in SynFPCTypInfo, undefine the above conditional
|
|
||||||
// see https://lists.freepascal.org/pipermail/fpc-announce/2019-July/000612.html
|
|
||||||
{$define STRCNT32} // 32-bit TAnsiRec.RefCnt even on 64-bit CPU
|
|
||||||
// see https://gitlab.com/freepascal.org/fpc/source/-/issues/38018
|
|
||||||
{$ifend}
|
|
||||||
|
|
||||||
{$ifdef ANDROID}
|
|
||||||
{$define LINUX} // a Linux-based system
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
// define FPCSQLITE3STATIC to enable static-linked SQLite3 engine for FPC
|
|
||||||
// -> expect *.o files download from https://synopse.info/files/sqlite3fpc.7z
|
|
||||||
// -> could be disabled to force external .so/.dll linking
|
|
||||||
{$ifdef MSWINDOWS}
|
|
||||||
{$ifdef CPUX86}
|
|
||||||
{$define FPCSQLITE3STATIC} // use static\i386-win32\sqlite3.o
|
|
||||||
{$else}
|
|
||||||
{$define FPCSQLITE3STATIC} // use static\x86_64-win64\sqlite3.o
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef LINUX}
|
|
||||||
{$ifdef CPUX86}
|
|
||||||
{$define FPCSQLITE3STATIC} // use static/i386-linux\sqlite3.o
|
|
||||||
{$endif}
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$define FPCSQLITE3STATIC} // use static/x86_64-linux\sqlite3.o
|
|
||||||
{$endif}
|
|
||||||
{$ifdef CPUARM}
|
|
||||||
{$define FPCSQLITE3STATIC} // use static/arm-linux\sqlite3.o
|
|
||||||
{$endif}
|
|
||||||
{$ifdef CPUAARCH64}
|
|
||||||
{$define FPCSQLITE3STATIC} // use:static/aarch64-linux\sqlite3.o
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$ifdef BSD}
|
|
||||||
// LINUX conditional includes Darwin and BSD family like FreeBSD
|
|
||||||
{$define LINUX} // not true, but a POSIX/BSD system - see LINUXNOTBSD
|
|
||||||
{$undef FORCE_STRSSE42} // fails otherwise for sure
|
|
||||||
{$define ABSOLUTEPASCAL} // NO asm nor redirection (until stabilized)
|
|
||||||
{$ifdef DARWIN}
|
|
||||||
{$define FPCSQLITE3STATIC} // we supply Darwin static libs
|
|
||||||
{$ifdef CPUINTEL}
|
|
||||||
{$define FPC_PIC} // may have not be defined by the compiler options
|
|
||||||
{$endif}
|
|
||||||
{$else}
|
|
||||||
{$define BSDNOTDARWIN} // OSX has some non-standard API calls
|
|
||||||
{$endif}
|
|
||||||
{$ifdef FREEBSD}
|
|
||||||
{$ifdef CPUX86}
|
|
||||||
{$define FPCSQLITE3STATIC} // we supply i386 static libs
|
|
||||||
{$endif CPUX86}
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$define FPCSQLITE3STATIC} // we supply x64 static libs
|
|
||||||
{$endif CPUX64}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef OPENBSD}
|
|
||||||
{$ifdef CPUX86}
|
|
||||||
{$define FPCSQLITE3STATIC} // we supply i386 static libs
|
|
||||||
{$endif CPUX86}
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$define FPCSQLITE3STATIC} // we supply x64 static libs
|
|
||||||
{$endif CPUX64}
|
|
||||||
{$endif}
|
|
||||||
{$else}
|
|
||||||
{$ifdef LINUX}
|
|
||||||
{$define LINUXNOTBSD} // e.g. to disable epoll API
|
|
||||||
{$define FPCLINUXNOTBSD}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$ifdef LINUX}
|
|
||||||
{$undef FORCE_STRSSE42} // avoid fatal SIGABRT/SIGSEGV on POSIX systems
|
|
||||||
{$define FPCLINUX}
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$define CPUX64LINUX} // e.g. for tuned server-side asm
|
|
||||||
{$endif CPUX64}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef FPC_PIC}
|
|
||||||
{$define PUREPASCAL} // most asm code is not PIC-safe with global constants
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$ifdef MSWINDOWS}
|
|
||||||
{$ifdef FPC_X64MM}
|
|
||||||
{$ifndef FPC_X64MM_WIN} // SynFPCx64MM not yet fully validated on Windows
|
|
||||||
{$undef FPC_X64MM}
|
|
||||||
{$endif FPC_X64MM_WIN}
|
|
||||||
{$endif FPC_X64MM}
|
|
||||||
{$endif MSWINDOWS}
|
|
||||||
|
|
||||||
{$ifdef CPU64}
|
|
||||||
{$define FPC_64}
|
|
||||||
{$define PUREPASCAL} // e.g. x64, AARCH64
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$define CPUINTEL}
|
|
||||||
{$define FPC_CPUINTEL}
|
|
||||||
{$ifndef BSD}
|
|
||||||
{$define CPUX64ASM} // Delphi XE4 or Darwin asm are buggy :(
|
|
||||||
{$define ASMX64AVX} // only FPC supports AVX/AVX2/AVX512
|
|
||||||
{$define HASAESNI} // SynCrypto rejected by Darwin asm
|
|
||||||
{$endif BSD}
|
|
||||||
{$define FPC_X64} // supports AVX/AVX2/AVX512 - which Delphi doesn't
|
|
||||||
{$ASMMODE INTEL} // to share asm code with Delphi
|
|
||||||
{$endif CPUX64}
|
|
||||||
{$ifdef CPUAARCH64}
|
|
||||||
{$define CPUARM3264}
|
|
||||||
{$endif CPUAARCH64}
|
|
||||||
{$else}
|
|
||||||
{$define FPC_32}
|
|
||||||
{$define STRCNT32} // 32-bit TAnsiRec.RefCnt on 32-bit CPU
|
|
||||||
{$define DACNT32} // 32-bit dynarray refcnt on 32-bit CPU
|
|
||||||
{$ifdef CPUARM}
|
|
||||||
{$define PUREPASCAL} // ARM32
|
|
||||||
{$define CPUARM3264}
|
|
||||||
{$endif CPUARM}
|
|
||||||
{$ifdef CPUX86}
|
|
||||||
{$define CPUINTEL}
|
|
||||||
{$define FPC_CPUINTEL}
|
|
||||||
{$define FPC_X86}
|
|
||||||
{$define TSYNEXTENDED80} // only 32-bit has a true x87 extended type
|
|
||||||
{$ASMMODE INTEL} // as Delphi expects
|
|
||||||
{$define HASAESNI} // should be commented to test project with valgrind
|
|
||||||
{$ifndef FPC_PIC}
|
|
||||||
{$define CPUX86NOTPIC} // use "absolute" instead of local register
|
|
||||||
{$endif FPC_PIC}
|
|
||||||
{$ifndef OPENBSD}
|
|
||||||
{$define FPC_X86ASM} // if assembler knows popcnt/crc32c opcodes
|
|
||||||
{$endif OPENBSD}
|
|
||||||
{$endif CPUX86}
|
|
||||||
{$endif CPU64}
|
|
||||||
|
|
||||||
{$ifdef CPUARM3264}
|
|
||||||
{$ifdef BSD}
|
|
||||||
{$undef USE_VTYPE_STATIC} // circumvent bug in VarClear() on BSD + ARM
|
|
||||||
{$endif BSD}
|
|
||||||
{$endif CPUARM3264}
|
|
||||||
|
|
||||||
{$ifdef ISFPC30}
|
|
||||||
{$ifndef MSWINDOWS}
|
|
||||||
// define FPCUSEVERSIONINFO to link low-level executable file information
|
|
||||||
// units in SynCommons.pas
|
|
||||||
// => disabled by default, to reduce the executable overhead
|
|
||||||
{.$define FPCUSEVERSIONINFO}
|
|
||||||
{$endif MSWINDOWS}
|
|
||||||
{$endif ISFPC30}
|
|
||||||
|
|
||||||
{$ifdef ISFPC32}
|
|
||||||
// FPC has its own RTTI layout only since late 3.x
|
|
||||||
{$define FPC_NEWRTTI}
|
|
||||||
// when http://bugs.freepascal.org/view.php?id=26774 has been fixed
|
|
||||||
{$ifdef CPUINTEL}
|
|
||||||
{$define HASINTERFACERTTI}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef CPUARM3264}
|
|
||||||
{$define HASINTERFACERTTI}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
{$ifdef FPC_NEWRTTI}
|
|
||||||
{$define ISDELPHI2010_OR_FPC_NEWRTTI}
|
|
||||||
{$else}
|
|
||||||
{$define DELPHI_OR_FPC_OLDRTTI}
|
|
||||||
{$define FPC_OLDRTTI}
|
|
||||||
{$endif}
|
|
||||||
{$define ISDELPHI2010_OR_FPC} // eltype2 field
|
|
||||||
|
|
||||||
{$ifdef FPC_HAS_CPSTRING}
|
|
||||||
// see http://wiki.freepascal.org/FPC_Unicode_support
|
|
||||||
{$define HASCODEPAGE} // UNICODE means {$mode delphiunicode}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef ISFPC27}
|
|
||||||
{$define ISFPC271}
|
|
||||||
{$define HASVARUSTRING}
|
|
||||||
{$define HASVARUSTRARG}
|
|
||||||
// defined if the http://mantis.freepascal.org/view.php?id=26773 bug is fixed
|
|
||||||
// you should use 2.7.1/trunk branch in revision 28995 from 2014-11-05T22:17:54
|
|
||||||
// => this will change the TInvokeableVariantType.SetProperty() signature
|
|
||||||
{$define FPC_VARIANTSETVAR}
|
|
||||||
{$endif ISFPC27}
|
|
||||||
{$ifdef FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
{$define HASALIGNTYPEDATA} // to ignore attributes RTTI table
|
|
||||||
{$endif FPC_PROVIDE_ATTR_TABLE}
|
|
||||||
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
{$define FPC_ENUMHASINNER}
|
|
||||||
{$define HASALIGNTYPEDATA} // to ensure proper RTTI alignment
|
|
||||||
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
||||||
|
|
||||||
|
|
||||||
{$else FPC}
|
|
||||||
|
|
||||||
(********************** Delphi Conditionals **********************)
|
|
||||||
|
|
||||||
{$define DELPHI_OR_FPC_OLDRTTI}
|
|
||||||
{$define USE_VTYPE_STATIC} // "and VTYPE_STATIC" test before VarClear()
|
|
||||||
{$define STRCNT32} // always 32-bit TAnsiRec.RefCnt on Delphi
|
|
||||||
{$define DACNT32} // always 32-bit dynarray refcnt on Delphi
|
|
||||||
{$undef FPC_X64MM} // this is a FPC-specific memory manager
|
|
||||||
|
|
||||||
{$A+} // force normal alignment
|
|
||||||
|
|
||||||
{$ifdef LVCL}
|
|
||||||
{$define OWNNORMTOUPPER} // NormToUpper[] exists only in our enhanced RTL
|
|
||||||
{$define NOVARIANTS} // LVCL does not support variants
|
|
||||||
{$define EXTENDEDTOSHORT_USESTR} // no FloatToText implemented in LVCL
|
|
||||||
{$endif LVCL}
|
|
||||||
|
|
||||||
{$ifdef UNICODE}
|
|
||||||
{$undef ENHANCEDRTL} // Delphi 2009 and up don't have our Enhanced Runtime library
|
|
||||||
{$define HASVARUSTRING}
|
|
||||||
{$define HASCODEPAGE}
|
|
||||||
{$define FPC_OR_UNICODE}
|
|
||||||
{$define USERECORDWITHMETHODS}
|
|
||||||
{ due to a bug in Delphi 2009+, we need to fake inheritance of record,
|
|
||||||
since TDynArrayHashed = object(TDynArray) fails to initialize
|
|
||||||
http://blog.synopse.info/post/2011/01/29/record-and-object-issue-in-Delphi-2010 }
|
|
||||||
{$define UNDIRECTDYNARRAY}
|
|
||||||
{$endif UNICODE}
|
|
||||||
|
|
||||||
{$ifndef PUREPASCAL}
|
|
||||||
{$define CPUINTEL} // Delphi only for Intel by now
|
|
||||||
{$endif}
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$define CPU64} // Delphi compiler for 64 bit CPU
|
|
||||||
{$define CPU64DELPHI}
|
|
||||||
{$undef CPU32}
|
|
||||||
{$define PUREPASCAL} // no x86 32 bit asm to be used
|
|
||||||
{$define EXTENDEDTOSHORT_USESTR} // FloatToText() much slower in x64 mode
|
|
||||||
{$define DOUBLETOSHORT_USEGRISU} // fast double to text
|
|
||||||
{$else CPUX64}
|
|
||||||
{$define CPU32} // Delphi compiler for 32 bit CPU
|
|
||||||
{$define CPU32DELPHI}
|
|
||||||
{$undef CPU64}
|
|
||||||
{$define CPUX86} // for compatibility with older versions of Delphi
|
|
||||||
{$define CPUX86NOTPIC} // use "absolute" instead of local register
|
|
||||||
{$define TSYNEXTENDED80} // only 32-bit has a true x87 extended type
|
|
||||||
{$endif CPUX64}
|
|
||||||
|
|
||||||
{$IFDEF CONDITIONALEXPRESSIONS} // Delphi 6 or newer
|
|
||||||
{$define HASINTERFACERTTI} // interface RTTI (not FPC)
|
|
||||||
{$ifdef LINUX}
|
|
||||||
{$if RTLVersion = 14.5}
|
|
||||||
{$define KYLIX3}
|
|
||||||
{$define FPC_OR_KYLIX}
|
|
||||||
// Kylix 3 will be handled just like Delphi 7
|
|
||||||
{$undef ENHANCEDRTL} // Enhanced Runtime library not fully tested yet
|
|
||||||
{$define EXTENDEDTOSHORT_USESTR}
|
|
||||||
{$define DOPATCHTRTL} // nice speed up for server apps
|
|
||||||
{$define NOVARCOPYPROC}
|
|
||||||
{$define NOSQLITE3STATIC} // Kylix will use external sqlite3.so
|
|
||||||
{$define LINUXNOTBSD} // e.g. to disable epoll API
|
|
||||||
{$else}
|
|
||||||
Kylix1/2 or Delphi Tokyo/ARC are unsupported
|
|
||||||
{$ifend}
|
|
||||||
{$else}
|
|
||||||
{$ifdef VER140}
|
|
||||||
{$define ISDELPHI6ANDUP} // Delphi 6 or newer
|
|
||||||
{$define DELPHI6OROLDER}
|
|
||||||
{$define NOVARCOPYPROC}
|
|
||||||
{$undef ENHANCEDRTL} // Delphi 6 doesn't have our Enhanced Runtime library
|
|
||||||
{$define EXTENDEDTOSHORT_USESTR} // no TFormatSettings before Delphi 7
|
|
||||||
{$else}
|
|
||||||
{$define ISDELPHI7ANDUP} // Delphi 7 or newer
|
|
||||||
{$define WITHUXTHEME} // VCL handle UI theming
|
|
||||||
{$define HASUINT64}
|
|
||||||
{$warn UNSAFE_CODE OFF} // Delphi for .Net does not exist any more!
|
|
||||||
{$warn UNSAFE_TYPE OFF}
|
|
||||||
{$warn UNSAFE_CAST OFF}
|
|
||||||
{$warn DUPLICATE_CTOR_DTOR OFF} // avoid W1029 unneeded hints
|
|
||||||
{$endif}
|
|
||||||
{$ifdef USEPACKAGES}
|
|
||||||
{$undef DOPATCHTRTL}
|
|
||||||
{$endif}
|
|
||||||
{$endif LINUX}
|
|
||||||
{$if CompilerVersion >= 17}
|
|
||||||
{$define ISDELPHI2005ANDUP} // Delphi 2005 or newer
|
|
||||||
{$if CompilerVersion >= 18}
|
|
||||||
{$define ISDELPHI2006ANDUP} // Delphi 2006 or newer
|
|
||||||
{$define HASNEWFILEAGE}
|
|
||||||
{$define HASINLINE}
|
|
||||||
{$define HASINLINEDELPHI}
|
|
||||||
{$define HASINLINENOTX86}
|
|
||||||
{$define HASREGION}
|
|
||||||
{$define HASFASTMM4}
|
|
||||||
// try to define this so that GetMemoryInfo/TSynMonitorMemory returns
|
|
||||||
// low-level FastMM4 information
|
|
||||||
{.$define WITH_FASTMM4STATS}
|
|
||||||
{$ifend}
|
|
||||||
{$ifdef VER180}
|
|
||||||
{$define ISDELPHI20062007} // to circumvent some specific bugs
|
|
||||||
{$endif}
|
|
||||||
{$ifdef VER185}
|
|
||||||
{$define ISDELPHI20062007}
|
|
||||||
{$endif}
|
|
||||||
{$if CompilerVersion > 18}
|
|
||||||
{$define ISDELPHI2007ANDUP} // Delphi 2007 or newer
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion = 20}
|
|
||||||
{$define ISDELPHI20092010} // specific compilation issues
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion = 21}
|
|
||||||
{$define ISDELPHI20092010} //specific compilation issues
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 21.0}
|
|
||||||
{$define ISDELPHI2010}
|
|
||||||
{$define ISDELPHI2010_OR_FPC} // eltype2 field
|
|
||||||
{$define ISDELPHI2010_OR_FPC_NEWRTTI}
|
|
||||||
{$define HASTTHREADSTART}
|
|
||||||
{$define HASINTERFACEASTOBJECT}
|
|
||||||
{$ifdef NEWRTTINOTUSED} // option reduce EXE size by disabling much RTTI
|
|
||||||
{$WEAKLINKRTTI ON}
|
|
||||||
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
|
|
||||||
{$endif NEWRTTINOTUSED}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 22.0}
|
|
||||||
{$define FPC_OR_DELPHIXE} // Delphi 2007/2009/2010 inlining bugs
|
|
||||||
{$define ISDELPHIXE}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 23.0}
|
|
||||||
// Delphi XE2 has some cross-platform features
|
|
||||||
// e.g. {$ifdef ISDELPHIXE2}VCL.Graphics{$else}Graphics{$endif}
|
|
||||||
{$define ISDELPHIXE2}
|
|
||||||
{$define HASVARUSTRARG}
|
|
||||||
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 24.0}
|
|
||||||
{$define ISDELPHIXE3}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 25.0}
|
|
||||||
{$define ISDELPHIXE4}
|
|
||||||
{$define FPC_OR_DELPHIXE4} // circumvent Internal Error: C2130 on XE3
|
|
||||||
{$define HASAESNI}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 26.0}
|
|
||||||
{$define ISDELPHIXE5}
|
|
||||||
{$define PUBLISHRECORD}
|
|
||||||
// if defined, will handle RTTI available only since Delphi XE5 for
|
|
||||||
// record published properties
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 27.0}
|
|
||||||
{$define ISDELPHIXE6}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 28.0}
|
|
||||||
{$define ISDELPHIXE7}
|
|
||||||
{$ifdef CPU64}
|
|
||||||
{$define CPUX64ASM} // e.g. Delphi XE4 SSE asm is buggy :(
|
|
||||||
{$endif}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 29.0}
|
|
||||||
{$define ISDELPHIXE8}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 30.0}
|
|
||||||
{$define ISDELPHI10}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 31.0}
|
|
||||||
{$define ISDELPHI101}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 32.0}
|
|
||||||
{$define ISDELPHI102}
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$ifdef VER320withoutAprilUpdate}
|
|
||||||
// circumvent early Delphi 10.2 Tokyo Win64 compiler bug
|
|
||||||
{$undef HASINLINE}
|
|
||||||
{$define HASINLINENOTX86}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 33.0}
|
|
||||||
{$define ISDELPHI103}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 34.0}
|
|
||||||
{$define ISDELPHI104}
|
|
||||||
{$ifend}
|
|
||||||
{$if CompilerVersion >= 35.0}
|
|
||||||
{$define ISDELPHI11}
|
|
||||||
{$ifend}
|
|
||||||
{$ifend CompilerVersion >= 17}
|
|
||||||
{$ifopt O-} // if we don't expect fast code, don't optimize the framework
|
|
||||||
{$undef ENHANCEDRTL}
|
|
||||||
{$undef DOPATCHTRTL}
|
|
||||||
{$endif}
|
|
||||||
{$ELSE}
|
|
||||||
// Delphi 5 or older
|
|
||||||
{$define DELPHI6OROLDER}
|
|
||||||
{$define DELPHI5OROLDER}
|
|
||||||
{$define DELPHI5ORFPC}
|
|
||||||
{$define MSWINDOWS}
|
|
||||||
{$define NOVARIANTS}
|
|
||||||
{$define NOVARCOPYPROC}
|
|
||||||
{$undef ENHANCEDRTL} // Delphi 5 doesn't have our Enhanced Runtime library
|
|
||||||
{$define EXTENDEDTOSHORT_USESTR} // no TFormatSettings before Delphi 7
|
|
||||||
{$undef DOPATCHTRTL}
|
|
||||||
{$ENDIF CONDITIONALEXPRESSIONS}
|
|
||||||
|
|
||||||
{$endif FPC}
|
|
||||||
|
|
||||||
|
|
||||||
(********************** Shared Conditionals **********************)
|
|
||||||
|
|
||||||
{$ifdef PUREPASCAL}
|
|
||||||
{$define NODELPHIASM}
|
|
||||||
{$define FPC_OR_PUREPASCAL}
|
|
||||||
{$else}
|
|
||||||
{$endif PUREPASCAL}
|
|
||||||
|
|
||||||
{$H+} // we use long strings
|
|
||||||
{$R-} // disable Range checking in our code
|
|
||||||
{$S-} // disable Stack checking in our code
|
|
||||||
{$X+} // expect extended syntax
|
|
||||||
{$W-} // disable stack frame generation
|
|
||||||
{$Q-} // disable overflow checking in our code
|
|
||||||
{$B-} // expect short circuit boolean
|
|
||||||
{$V-} // disable Var-String Checking
|
|
||||||
{$T-} // Typed @ operator
|
|
||||||
{$Z1} // enumerators stored as byte by default
|
|
||||||
|
|
||||||
{$ifndef FPC}
|
|
||||||
{$P+} // Open string params
|
|
||||||
{$ifdef VER150}
|
|
||||||
{$WARN SYMBOL_DEPRECATED OFF}
|
|
||||||
{$WARN UNSAFE_TYPE OFF}
|
|
||||||
{$WARN UNSAFE_CODE OFF}
|
|
||||||
{$WARN UNSAFE_CAST OFF}
|
|
||||||
{$ENDIF}
|
|
||||||
{$ifdef CONDITIONALEXPRESSIONS} // Delphi 6 or newer
|
|
||||||
{$WARN SYMBOL_PLATFORM OFF}
|
|
||||||
{$WARN UNIT_PLATFORM OFF}
|
|
||||||
{$endif}
|
|
||||||
{$endif FPC}
|
|
||||||
|
|
||||||
{$ifdef CPUINTEL}
|
|
||||||
{$ifdef CPUX86} // safest to reset x87 exceptions
|
|
||||||
{$ifndef PUREPASCAL}
|
|
||||||
{$ifndef DELPHI5OROLDER}
|
|
||||||
{$define RESETFPUEXCEPTION}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef DISABLE_SSE42}
|
|
||||||
{$undef FORCE_STRSSE42}
|
|
||||||
{$endif DISABLE_SSE42}
|
|
||||||
{$else}
|
|
||||||
{$undef HASAESNI} // AES-NI is an Intel-specific feature
|
|
||||||
{$define ABSOLUTEPASCALORNOTINTEL}
|
|
||||||
{$endif CPUINTEL}
|
|
||||||
|
|
||||||
{$ifdef ABSOLUTEPASCAL}
|
|
||||||
{$define ABSOLUTEORPUREPASCAL}
|
|
||||||
{$define ABSOLUTEPASCALORNOTINTEL}
|
|
||||||
{$define PUREPASCAL}
|
|
||||||
{$endif ABSOLUTEPASCAL}
|
|
||||||
{$ifdef PUREPASCAL}
|
|
||||||
{$define ABSOLUTEORPUREPASCAL}
|
|
||||||
{$endif PUREPASCAL}
|
|
||||||
|
|
||||||
{$define WITHLOG}
|
|
||||||
// if defined, logging will be supported via the TSQLLog family
|
|
||||||
// - should be left defined: TSQLog.Family.Level default setting won't log
|
|
||||||
// anything, so there won't be any noticeable performance penalty to have
|
|
||||||
// this WITHLOG conditional defined, which is expected by high-level part
|
|
||||||
// of the framework, like DDD or UI units
|
|
||||||
|
|
||||||
{$ifdef FPC}
|
|
||||||
{$ifndef FPCSQLITE3STATIC} // see above about this FPC-specific conditional
|
|
||||||
{$define NOSQLITE3STATIC}
|
|
||||||
{$endif}
|
|
||||||
{$else}
|
|
||||||
// there is a linking bug with Delphi XE4 on Win64
|
|
||||||
{$ifdef CPUX64}
|
|
||||||
{$if CompilerVersion = 25.0} // exactly XE4
|
|
||||||
{$define NOSQLITE3STATIC}
|
|
||||||
// :( to avoid "Fatal: F2084 Internal Error: AV004A7B1F-R03BDA7B0-0"
|
|
||||||
{$ifend}
|
|
||||||
{$endif} // other Win32/Win64 Delphi platforms should work as expected
|
|
||||||
{$endif FPC}
|
|
||||||
|
|
||||||
{$ifdef NOSQLITE3STATIC}
|
|
||||||
// our proprietary crypto expects a statically linked custom sqlite3.c
|
|
||||||
{$define NOSQLITE3ENCRYPT}
|
|
||||||
{$endif NOSQLITE3STATIC}
|
|
||||||
|
|
||||||
{$ifdef MSWINDOWS}
|
|
||||||
{$define USEWININET} // publish TWinINet/TWinHttp/TWinHttpAPI classes
|
|
||||||
{.$define ONLYUSEHTTPSOCKET} // for testing (no benefit vs http.sys)
|
|
||||||
{.$define USELIBCURL} // for testing (no benefit vs WinHTTP)
|
|
||||||
{$else}
|
|
||||||
{$define ONLYUSEHTTPSOCKET} // http.sys server is Windows-specific
|
|
||||||
// cross-platform libcurl for https -> TCurlHttp and TSQLHttpClientCurl
|
|
||||||
{$define USELIBCURL}
|
|
||||||
{$ifdef ANDROID}
|
|
||||||
// for Android, consider using https://github.com/gcesarmza/curl-android-ios
|
|
||||||
// static libraries and force USELIBCURL in the project conditionals
|
|
||||||
{$define LIBCURLSTATIC}
|
|
||||||
{$endif ANDROID}
|
|
||||||
{$endif MSWINDOWS}
|
|
||||||
|
|
||||||
{$ifdef USELIBCURL}
|
|
||||||
{.$define LIBCURLMULTI}
|
|
||||||
// enable https://curl.haxx.se/libcurl/c/libcurl-multi.html interface
|
|
||||||
{$endif USELIBCURL}
|
|
||||||
|
|
||||||
@ -1 +0,0 @@
|
|||||||
'1.18.6381'
|
|
||||||
1
lib/dmustache/mormot.commit.inc
Normal file
1
lib/dmustache/mormot.commit.inc
Normal file
@ -0,0 +1 @@
|
|||||||
|
'2.2.7423'
|
||||||
2939
lib/dmustache/mormot.core.base.asmx64.inc
Normal file
2939
lib/dmustache/mormot.core.base.asmx64.inc
Normal file
File diff suppressed because it is too large
Load Diff
2602
lib/dmustache/mormot.core.base.asmx86.inc
Normal file
2602
lib/dmustache/mormot.core.base.asmx86.inc
Normal file
File diff suppressed because it is too large
Load Diff
12238
lib/dmustache/mormot.core.base.pas
Normal file
12238
lib/dmustache/mormot.core.base.pas
Normal file
File diff suppressed because it is too large
Load Diff
11414
lib/dmustache/mormot.core.buffers.pas
Normal file
11414
lib/dmustache/mormot.core.buffers.pas
Normal file
File diff suppressed because it is too large
Load Diff
11523
lib/dmustache/mormot.core.data.pas
Normal file
11523
lib/dmustache/mormot.core.data.pas
Normal file
File diff suppressed because it is too large
Load Diff
3652
lib/dmustache/mormot.core.datetime.pas
Normal file
3652
lib/dmustache/mormot.core.datetime.pas
Normal file
File diff suppressed because it is too large
Load Diff
11904
lib/dmustache/mormot.core.json.pas
Normal file
11904
lib/dmustache/mormot.core.json.pas
Normal file
File diff suppressed because it is too large
Load Diff
2563
lib/dmustache/mormot.core.mustache.pas
Normal file
2563
lib/dmustache/mormot.core.mustache.pas
Normal file
File diff suppressed because it is too large
Load Diff
10857
lib/dmustache/mormot.core.os.pas
Normal file
10857
lib/dmustache/mormot.core.os.pas
Normal file
File diff suppressed because it is too large
Load Diff
4311
lib/dmustache/mormot.core.os.posix.inc
Normal file
4311
lib/dmustache/mormot.core.os.posix.inc
Normal file
File diff suppressed because it is too large
Load Diff
5614
lib/dmustache/mormot.core.os.windows.inc
Normal file
5614
lib/dmustache/mormot.core.os.windows.inc
Normal file
File diff suppressed because it is too large
Load Diff
788
lib/dmustache/mormot.core.rtti.delphi.inc
Normal file
788
lib/dmustache/mormot.core.rtti.delphi.inc
Normal file
@ -0,0 +1,788 @@
|
|||||||
|
{
|
||||||
|
This file is a part of the Open Source Synopse mORMot framework 2,
|
||||||
|
licensed under a MPL/GPL/LGPL three license - see LICENSE.md
|
||||||
|
|
||||||
|
Delphi specific definitions used by mormot.core.rtti.pas implementation
|
||||||
|
}
|
||||||
|
|
||||||
|
type
|
||||||
|
AlignToPtr = Pointer;
|
||||||
|
|
||||||
|
{$ifdef HASINLINE} // Delphi RTL TypInfo.GetTypeData() is awful on x86_64
|
||||||
|
|
||||||
|
function GetTypeData(TypeInfo: pointer): PTypeData;
|
||||||
|
begin
|
||||||
|
// weird code which compiles and inlines best on Delphi Win32 and Win64
|
||||||
|
{$ifdef CPU64}
|
||||||
|
result := pointer(PtrInt(TypeInfo) + ord(PRttiInfo(TypeInfo)^.RawName[0]) + 2);
|
||||||
|
{$else}
|
||||||
|
result := TypeInfo;
|
||||||
|
inc(PByte(result), ord(PRttiInfo(result)^.RawName[0]) + 2);
|
||||||
|
{$endif CPU64}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
function GetTypeData(TypeInfo: pointer): PTypeData;
|
||||||
|
asm
|
||||||
|
// faster code for oldest Delphi
|
||||||
|
movzx edx, byte ptr [eax].TTypeInfo.Name
|
||||||
|
lea eax, [eax + edx].TTypeInfo.Name[1]
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif HASINLINE}
|
||||||
|
|
||||||
|
function TRttiInfo.RttiClass: PRttiClass; // for proper inlining below
|
||||||
|
begin
|
||||||
|
if @self <> nil then
|
||||||
|
result := pointer(GetTypeData(@self))
|
||||||
|
else
|
||||||
|
result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.RttiNonVoidClass: PRttiClass;
|
||||||
|
begin
|
||||||
|
result := pointer(GetTypeData(@self))
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiClass.PropCount: integer;
|
||||||
|
begin
|
||||||
|
result := PTypeData(@self)^.PropCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiClass.ParentInfo: PRttiInfo;
|
||||||
|
begin
|
||||||
|
result := pointer(PTypeData(@self)^.ParentInfo);
|
||||||
|
if result <> nil then
|
||||||
|
result := PPointer(result)^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiClass.RttiProps: PRttiProps;
|
||||||
|
begin
|
||||||
|
result := @self;
|
||||||
|
if result <> nil then
|
||||||
|
with PTypeData(result)^ do
|
||||||
|
result := @UnitName[ord(UnitName[0]) + 1];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetRttiProps(RttiClass: TClass): PRttiProps;
|
||||||
|
var
|
||||||
|
p: PTypeInfo;
|
||||||
|
begin
|
||||||
|
// code is a bit abstract, but compiles very well
|
||||||
|
p := PPointer(PtrInt(RttiClass) + vmtTypeInfo)^;
|
||||||
|
if p <> nil then // avoid GPF if no RTTI available for this class
|
||||||
|
with PTypeData(@p^.Name[ord(p^.Name[0]) + 1])^ do
|
||||||
|
result := @UnitName[ord(UnitName[0]) + 1]
|
||||||
|
else
|
||||||
|
result := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProps.PropCount: integer;
|
||||||
|
begin
|
||||||
|
result := PPropData(@self)^.PropCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProps.PropList: PRttiProp;
|
||||||
|
begin
|
||||||
|
result := pointer(@PPropData(@self)^.PropList);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetRttiProp(C: TClass; out PropInfo: PRttiProp): integer;
|
||||||
|
var
|
||||||
|
p: PTypeInfo;
|
||||||
|
begin
|
||||||
|
if C <> nil then
|
||||||
|
begin
|
||||||
|
p := PPointer(PtrInt(C) + vmtTypeInfo)^;
|
||||||
|
if p <> nil then // avoid GPF if no RTTI available
|
||||||
|
with PTypeData(@p^.Name[ord(p^.Name[0]) + 1])^,
|
||||||
|
PPropData(@UnitName[ord(UnitName[0]) + 1])^ do
|
||||||
|
begin
|
||||||
|
PropInfo := @PropList;
|
||||||
|
result := PropCount;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiEnumType.EnumBaseType: PRttiEnumType;
|
||||||
|
begin
|
||||||
|
with PTypeData(@self).BaseType^^ do
|
||||||
|
result := @Name[ord(Name[0]) + 1];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiEnumType.SetBaseType: PRttiEnumType;
|
||||||
|
begin
|
||||||
|
with PTypeData(@self).CompType^^ do
|
||||||
|
result := @Name[ord(Name[0]) + 1];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiEnumType.GetEnumNameOrd(Value: cardinal): PShortString;
|
||||||
|
begin
|
||||||
|
if Value <= cardinal(PTypeData(@self).MaxValue) then
|
||||||
|
begin
|
||||||
|
result := @PTypeData(@self).NameList;
|
||||||
|
if Value > 0 then
|
||||||
|
repeat
|
||||||
|
inc(PByte(result), PByte(result)^ + 1); // next
|
||||||
|
dec(Value);
|
||||||
|
if Value = 0 then
|
||||||
|
break;
|
||||||
|
inc(PByte(result), PByte(result)^ + 1); // unrolled twice
|
||||||
|
dec(Value);
|
||||||
|
until Value = 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
result := @NULCHAR;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef CPUX86} // Delphi is not efficient when inlining code :(
|
||||||
|
|
||||||
|
function GetEnumName(aTypeInfo: PRttiInfo; aIndex: integer): PShortString;
|
||||||
|
asm // eax=aTypeInfo edx=aIndex
|
||||||
|
test eax, eax
|
||||||
|
jz @0
|
||||||
|
cmp byte ptr [eax], tkEnumeration
|
||||||
|
jnz @0
|
||||||
|
movzx ecx, byte ptr [eax + TTypeInfo.Name]
|
||||||
|
mov eax, [eax + ecx + TTypeData.BaseType + 2]
|
||||||
|
mov eax, [eax]
|
||||||
|
movzx ecx, byte ptr [eax + TTypeInfo.Name]
|
||||||
|
cmp edx, [eax + ecx + TTypeData.MaxValue + 2]
|
||||||
|
ja @0
|
||||||
|
lea eax, [eax + ecx + TTypeData.NameList + 2]
|
||||||
|
test edx, edx
|
||||||
|
jz @z
|
||||||
|
push edx
|
||||||
|
shr edx, 2 // fast by-four scanning
|
||||||
|
jz @1
|
||||||
|
@4: movzx ecx, byte ptr [eax]
|
||||||
|
lea eax, [eax + ecx + 1]
|
||||||
|
movzx ecx, byte ptr [eax]
|
||||||
|
lea eax, [eax + ecx + 1]
|
||||||
|
movzx ecx, byte ptr [eax]
|
||||||
|
lea eax, [eax + ecx + 1]
|
||||||
|
movzx ecx, byte ptr [eax]
|
||||||
|
lea eax, [eax + ecx + 1]
|
||||||
|
dec edx
|
||||||
|
jnz @4
|
||||||
|
pop edx
|
||||||
|
and edx, 3
|
||||||
|
jnz @s
|
||||||
|
ret
|
||||||
|
@1: pop edx
|
||||||
|
@s: movzx ecx, byte ptr [eax]
|
||||||
|
lea eax, [eax + ecx + 1] // last 1..3 iterations
|
||||||
|
dec edx
|
||||||
|
jnz @s
|
||||||
|
@z: ret
|
||||||
|
@void: db 0
|
||||||
|
@0: lea eax, @void
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
function GetEnumName(aTypeInfo: PRttiInfo; aIndex: integer): PShortString;
|
||||||
|
begin
|
||||||
|
if PRttiKind(aTypeInfo)^ = rkEnumeration then
|
||||||
|
with GetTypeData(aTypeInfo).BaseType^^ do
|
||||||
|
result := PRttiEnumType(@Name[ord(Name[0]) + 1])^.GetEnumNameOrd(aIndex)
|
||||||
|
else
|
||||||
|
result := @NULCHAR;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif ASMX86}
|
||||||
|
|
||||||
|
|
||||||
|
function TRttiInterfaceTypeData.IntfGuid: PGuid;
|
||||||
|
begin
|
||||||
|
{$ifdef ISDELPHI102} // adapt to latest TypInfo.pas changes
|
||||||
|
result := @PTypeData(@self)^.IntfGuid;
|
||||||
|
{$else}
|
||||||
|
result := @PTypeData(@self)^.Guid;
|
||||||
|
{$endif ISDELPHI102}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInterfaceTypeData.IntfParent: PRttiInfo;
|
||||||
|
begin
|
||||||
|
result := Pointer(PTypeData(@self)^.IntfParent^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function InterfaceEntryIsStandard(Entry: PInterfaceEntry): boolean;
|
||||||
|
begin
|
||||||
|
result := Entry^.IOffset <> 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.TypeInfo: PRttiInfo;
|
||||||
|
begin
|
||||||
|
result := pointer(PPropInfo(@self)^.PropType^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.GetterIsField: boolean;
|
||||||
|
begin
|
||||||
|
result := PropWrap(PPropInfo(@self)^.GetProc).Kind = ptField;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.SetterIsField: boolean;
|
||||||
|
begin
|
||||||
|
result := PropWrap(PPropInfo(@self)^.SetProc).Kind = ptField;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.WriteIsDefined: boolean;
|
||||||
|
begin
|
||||||
|
result := PtrUInt(PPropInfo(@self)^.SetProc) <> 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.IsStored(Instance: TObject): boolean;
|
||||||
|
begin
|
||||||
|
if (PtrUInt(PPropInfo(@self)^.StoredProc) and
|
||||||
|
(not PtrUInt($ff))) = 0 then
|
||||||
|
result := boolean(PtrUInt(PPropInfo(@self)^.StoredProc))
|
||||||
|
else
|
||||||
|
result := IsStoredGetter(Instance);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.IsStoredKind: TRttiPropStored;
|
||||||
|
begin
|
||||||
|
if (PtrUInt(PPropInfo(@self)^.StoredProc) and
|
||||||
|
(not PtrUInt($ff))) = 0 then
|
||||||
|
if boolean(PtrUInt(PPropInfo(@self)^.StoredProc)) then
|
||||||
|
result := rpsTrue
|
||||||
|
else
|
||||||
|
result := rpsFalse
|
||||||
|
else
|
||||||
|
result := rpsGetter;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.IsStoredGetter(Instance: TObject): boolean;
|
||||||
|
type
|
||||||
|
TGetProc = function: boolean of object;
|
||||||
|
TGetIndexed = function(Index: integer): boolean of object;
|
||||||
|
var
|
||||||
|
call: TMethod;
|
||||||
|
begin
|
||||||
|
if @self = nil then
|
||||||
|
result := true
|
||||||
|
else
|
||||||
|
with PPropInfo(@self)^ do
|
||||||
|
if (PtrUInt(StoredProc) and
|
||||||
|
(not PtrUInt($ff))) = 0 then
|
||||||
|
result := boolean(PtrUInt(StoredProc))
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
case PropWrap(StoredProc).Kind of
|
||||||
|
ptField:
|
||||||
|
begin
|
||||||
|
result := PBoolean(
|
||||||
|
PtrUInt(Instance) + PtrUInt(StoredProc) and $00ffffff)^;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
ptVirtual:
|
||||||
|
call.Code := PPointer(
|
||||||
|
PPtrUInt(Instance)^ + PtrUInt(StoredProc) and $00ffffff)^;
|
||||||
|
else
|
||||||
|
call.Code := pointer(StoredProc);
|
||||||
|
end;
|
||||||
|
call.Data := Instance;
|
||||||
|
if Index <> NO_INDEX then
|
||||||
|
result := TGetIndexed(call)(Index)
|
||||||
|
else
|
||||||
|
result := TGetProc(call);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.Getter(Instance: TObject; Call: PMethod): TRttiPropCall;
|
||||||
|
begin
|
||||||
|
with PPropInfo(@self)^ do
|
||||||
|
begin
|
||||||
|
if GetProc = nil then
|
||||||
|
begin
|
||||||
|
// no 'read' was defined -> try from 'write' field
|
||||||
|
if (SetProc <> nil) and
|
||||||
|
(PropWrap(SetProc).Kind = ptField) then
|
||||||
|
begin
|
||||||
|
Call.Data := pointer(
|
||||||
|
PtrUInt(Instance) + PtrUInt(SetProc) and $00ffffff);
|
||||||
|
result := rpcField;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
result := rpcNone;
|
||||||
|
exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
case PropWrap(GetProc).Kind of
|
||||||
|
ptField:
|
||||||
|
begin
|
||||||
|
// GetProc is an offset to the instance fields
|
||||||
|
Call.Data := pointer(
|
||||||
|
PtrUInt(Instance) + PtrUInt(GetProc) and $00ffffff);
|
||||||
|
result := rpcField;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
ptVirtual:
|
||||||
|
// GetProc is an offset to the class VMT
|
||||||
|
if Instance <> nil then // e.g. from GetterCall()
|
||||||
|
Call.Code := PPointer(
|
||||||
|
PPtrUInt(Instance)^ + PtrUInt(GetProc) and $00ffffff)^;
|
||||||
|
else
|
||||||
|
// ptStatic: GetProc is the method code itself
|
||||||
|
Call.Code := pointer(GetProc);
|
||||||
|
end;
|
||||||
|
Call.Data := Instance;
|
||||||
|
result := rpcMethod;
|
||||||
|
if Index <> NO_INDEX then
|
||||||
|
result := rpcIndexed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiProp.Setter(Instance: TObject; Call: PMethod): TRttiPropCall;
|
||||||
|
begin
|
||||||
|
with PPropInfo(@self)^ do
|
||||||
|
begin
|
||||||
|
if SetProc = nil then
|
||||||
|
begin
|
||||||
|
// no 'write' was defined -> try from 'read' field
|
||||||
|
if (GetProc <> nil) and
|
||||||
|
(PropWrap(GetProc).Kind = ptField) then
|
||||||
|
begin
|
||||||
|
Call.Data := pointer(
|
||||||
|
PtrUInt(Instance) + PtrUInt(GetProc) and $00ffffff);
|
||||||
|
result := rpcField;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
result := rpcNone;
|
||||||
|
exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
case PropWrap(SetProc).Kind of
|
||||||
|
ptField:
|
||||||
|
begin
|
||||||
|
// SetProc is an offset to the instance fields
|
||||||
|
Call.Data := pointer(
|
||||||
|
PtrUInt(Instance) + PtrUInt(SetProc) and $00ffffff);
|
||||||
|
result := rpcField;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
ptVirtual:
|
||||||
|
// SetProc is an offset to the class VMT
|
||||||
|
if Instance <> nil then // e.g. from SetterCall()
|
||||||
|
Call.Code := PPointer(
|
||||||
|
PPtrUInt(Instance)^ + PtrUInt(SetProc) and $00ffffff)^;
|
||||||
|
else
|
||||||
|
// ptStatic: SetProc is the method code itself
|
||||||
|
Call.Code := pointer(SetProc);
|
||||||
|
end;
|
||||||
|
Call.Data := Instance;
|
||||||
|
result := rpcMethod;
|
||||||
|
if Index <> NO_INDEX then
|
||||||
|
result := rpcIndexed;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
// RawUtf8 is defined as weak system.UTF8String type in mormot.core.base
|
||||||
|
UTF8_NAME: string[7] = 'RawUtf8';
|
||||||
|
|
||||||
|
function TRttiInfo.Name: PShortString;
|
||||||
|
begin
|
||||||
|
result := pointer(@self);
|
||||||
|
if result <> nil then
|
||||||
|
if result <> TypeInfo(RawUtf8) then
|
||||||
|
result := @RawName // as stored in RTTI
|
||||||
|
else
|
||||||
|
result := @UTF8_NAME // instead of 'UTF8String'
|
||||||
|
else
|
||||||
|
result := @NULCHAR;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.RecordSize: PtrInt;
|
||||||
|
begin
|
||||||
|
result := PRecordInfo(GetTypeData(@self))^.RecSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRttiInfo.RecordManagedFields(out Fields: TRttiRecordManagedFields);
|
||||||
|
var
|
||||||
|
nfo: PRecordInfo;
|
||||||
|
begin
|
||||||
|
nfo := pointer(GetTypeData(@self));
|
||||||
|
Fields.Size := nfo^.RecSize;
|
||||||
|
Fields.Count := nfo^.ManagedFldCount;
|
||||||
|
Fields.Fields := @PIntegerArray(@nfo^.ManagedFldCount)[1];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.RecordManagedFieldsCount: integer;
|
||||||
|
begin
|
||||||
|
result := PRecordInfo(GetTypeData(@self))^.ManagedFldCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef HASEXTRECORDRTTI} // read enhanced RTTI available since Delphi 2010
|
||||||
|
|
||||||
|
type
|
||||||
|
/// map Delphi tkRecord TypeInfo with enhanced RTTI
|
||||||
|
TRecordEnhancedTypeData = packed record
|
||||||
|
RecSize: cardinal;
|
||||||
|
ManagedCount: integer;
|
||||||
|
// ManagedFields: array[0..0] of TManagedField;
|
||||||
|
NumOps: byte;
|
||||||
|
// RecOps: array[0..0] of pointer;
|
||||||
|
AllCount: integer; // !!!! may need $RTTI EXPLICIT FIELDS([vcPublic])
|
||||||
|
AllFields: array[0..0] of TRecordTypeField; // as defined in TypInfo.pas
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.RecordAllFields(out RecSize: PtrInt): TRttiRecordAllFields;
|
||||||
|
var
|
||||||
|
info: ^TRecordEnhancedTypeData;
|
||||||
|
p: PRecordTypeField;
|
||||||
|
f: PtrInt;
|
||||||
|
begin
|
||||||
|
result := nil; // don't reallocate previous answer
|
||||||
|
info := pointer(GetTypeData(@self));
|
||||||
|
RecSize := info^.RecSize;
|
||||||
|
inc(PByte(info), info^.ManagedCount * SizeOf(TManagedField));
|
||||||
|
inc(PByte(info), info^.NumOps * SizeOf(pointer));
|
||||||
|
SetLength(result, info^.AllCount);
|
||||||
|
p := @info^.AllFields[0];
|
||||||
|
for f := 0 to info^.AllCount - 1 do
|
||||||
|
begin
|
||||||
|
with result[f] do
|
||||||
|
begin
|
||||||
|
TypeInfo := pointer(p^.Field.TypeRef);
|
||||||
|
if TypeInfo = nil then
|
||||||
|
begin
|
||||||
|
// this field has no RTTI -> we can't trust it for serialization
|
||||||
|
result := nil;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
TypeInfo := PPointer(TypeInfo)^;
|
||||||
|
Offset := p^.Field.FldOffset;
|
||||||
|
Name := @p^.Name;
|
||||||
|
end;
|
||||||
|
p := pointer(PtrInt(@p^.Name[1]) + ord(p^.Name[0]));
|
||||||
|
inc(PByte(p), PWord(p)^); // jump attributes
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
function TRttiInfo.RecordAllFields(out RecSize: PtrInt): TRttiRecordAllFields;
|
||||||
|
begin
|
||||||
|
RecSize := self.RecordSize;
|
||||||
|
result := nil; // extended record information not available before Delphi 2010
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif HASEXTRECORDRTTI}
|
||||||
|
|
||||||
|
function TRttiInfo.IsQWord: boolean;
|
||||||
|
begin
|
||||||
|
if @self = TypeInfo(QWord) then
|
||||||
|
result := true
|
||||||
|
else
|
||||||
|
{$ifdef UNICODE}
|
||||||
|
if Kind = rkInt64 then
|
||||||
|
with PHash128Rec(PAnsiChar(@RawName[1]) + ord(RawName[0]))^ do
|
||||||
|
result := Lo > Hi // check MinInt64Value>MaxInt64Value
|
||||||
|
else
|
||||||
|
{$endif UNICODE}
|
||||||
|
result := false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.IsBoolean: boolean;
|
||||||
|
begin
|
||||||
|
result := (@self = TypeInfo(boolean)) or
|
||||||
|
(@self = TypeInfo(wordbool));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.EnumBaseType: PRttiEnumType;
|
||||||
|
begin
|
||||||
|
result := pointer(GetTypeData(@self));
|
||||||
|
result := result^.EnumBaseType;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.DynArrayItemType: PRttiInfo;
|
||||||
|
begin
|
||||||
|
result := pointer(GetTypeData(@self)^.elType);
|
||||||
|
if result <> nil then // nil e.g. for TIntegerDynArray or T*ObjArray
|
||||||
|
result := PPointer(result)^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.DynArrayItemTypeExtended: PRttiInfo;
|
||||||
|
begin
|
||||||
|
with GetTypeData(@self)^ do
|
||||||
|
begin
|
||||||
|
result := pointer(elType);
|
||||||
|
if result <> nil then // nil e.g. for TIntegerDynArray or T*ObjArray
|
||||||
|
result := PPointer(result)^;
|
||||||
|
{$ifdef HASDYNARRAYTYPE}
|
||||||
|
if result = nil then
|
||||||
|
begin
|
||||||
|
// try the second slot, which may be set even for unmanaged types
|
||||||
|
result := pointer(elType2);
|
||||||
|
if result <> nil then
|
||||||
|
result := PPointer(result)^;
|
||||||
|
end;
|
||||||
|
{$endif HASDYNARRAYTYPE}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.DynArrayItemType(out aDataSize: PtrInt): PRttiInfo;
|
||||||
|
begin
|
||||||
|
with GetTypeData(@self)^ do
|
||||||
|
begin
|
||||||
|
aDataSize := elSize;
|
||||||
|
result := pointer(elType);
|
||||||
|
if result <> nil then
|
||||||
|
result := PPointer(result)^;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.ArrayItemType(out aDataCount, aDataSize: PtrInt): PRttiInfo;
|
||||||
|
var
|
||||||
|
nfo: PArrayInfo;
|
||||||
|
begin
|
||||||
|
// nfo^.DimCount=1 is not tested explicitly -> assume single dimension array
|
||||||
|
nfo := pointer(GetTypeData(@self));
|
||||||
|
aDataCount := nfo^.ElCount;
|
||||||
|
aDataSize := nfo^.ArraySize;
|
||||||
|
result := pointer(nfo^.ArrayType);
|
||||||
|
if result <> nil then
|
||||||
|
result := PPointer(result)^;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TRttiInfo.ArraySize: PtrInt;
|
||||||
|
begin
|
||||||
|
result := PArrayInfo(GetTypeData(@self))^.ArraySize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetPublishedMethods(Instance: TObject;
|
||||||
|
out Methods: TPublishedMethodInfoDynArray; aClass: TClass): integer;
|
||||||
|
|
||||||
|
procedure AddParentsFirst(C: TClass);
|
||||||
|
type
|
||||||
|
TMethodInfo = packed record
|
||||||
|
Len: Word;
|
||||||
|
Addr: Pointer;
|
||||||
|
Name: ShortString;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
Table: PWordArray;
|
||||||
|
M: ^TMethodInfo;
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
if C = nil then
|
||||||
|
exit;
|
||||||
|
AddParentsFirst(GetClassParent(C)); // put children published methods afterward
|
||||||
|
Table := PPointer(PtrUInt(C) + PtrUInt(vmtMethodTable))^;
|
||||||
|
if Table = nil then
|
||||||
|
exit;
|
||||||
|
SetLength(Methods, result + Table^[0]);
|
||||||
|
M := @Table^[1];
|
||||||
|
for i := 1 to Table^[0] do // Table^[0] = methods count
|
||||||
|
with Methods[result] do
|
||||||
|
begin
|
||||||
|
ShortStringToAnsi7String(M^.Name, Name);
|
||||||
|
Method.Data := Instance;
|
||||||
|
Method.Code := M^.Addr;
|
||||||
|
inc(PByte(M), M^.Len);
|
||||||
|
inc(result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
result := 0;
|
||||||
|
if aClass <> nil then
|
||||||
|
AddParentsFirst(aClass)
|
||||||
|
else if Instance <> nil then
|
||||||
|
AddParentsFirst(PPointer(Instance)^); // use recursion for adding
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifndef ISDELPHI2010} // not defined on Delphi 7/2007/2009
|
||||||
|
type
|
||||||
|
TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall);
|
||||||
|
{$endif ISDELPHI2010}
|
||||||
|
|
||||||
|
/// fake TTypeInfo RTTI used for TGuid/THash128... on Delphi 7/2007
|
||||||
|
{$ifdef HASNOSTATICRTTI}
|
||||||
|
|
||||||
|
type
|
||||||
|
// enough Delphi RTTI for TRttiInfo.RecordManagedFields
|
||||||
|
TFakeTypeInfo = packed record
|
||||||
|
Kind: TTypeKind;
|
||||||
|
case integer of
|
||||||
|
5: (
|
||||||
|
Name5: string[5];
|
||||||
|
RecSize5: cardinal;
|
||||||
|
ManagedCount5: integer);
|
||||||
|
8: (
|
||||||
|
Name8: string[8];
|
||||||
|
RecSize8: cardinal;
|
||||||
|
ManagedCount8: integer);
|
||||||
|
9: (
|
||||||
|
Name9: string[9];
|
||||||
|
RecSize9: cardinal;
|
||||||
|
ManagedCount9: integer);
|
||||||
|
end;
|
||||||
|
const
|
||||||
|
_TGUID: TFakeTypeInfo = ( // stored in PT_INFO[ptGuid]
|
||||||
|
Kind: tkRecord;
|
||||||
|
Name5: 'TGUID';
|
||||||
|
RecSize5: SizeOf(TGUID);
|
||||||
|
ManagedCount5: 0);
|
||||||
|
|
||||||
|
_THASH128: TFakeTypeInfo = ( // stored in PT_INFO[ptHash128]
|
||||||
|
Kind: tkRecord; // note: is a tkArray when HASNOSTATICRTTI
|
||||||
|
Name8: 'THash128';
|
||||||
|
RecSize8: SizeOf(THash128);
|
||||||
|
ManagedCount8: 0);
|
||||||
|
|
||||||
|
_THASH256: TFakeTypeInfo = ( // stored in PT_INFO[ptHash256]
|
||||||
|
Kind: tkRecord;
|
||||||
|
Name8: 'THash256';
|
||||||
|
RecSize8: SizeOf(THash256);
|
||||||
|
ManagedCount8: 0);
|
||||||
|
|
||||||
|
_THASH512: TFakeTypeInfo = ( // stored in PT_INFO[ptHash512]
|
||||||
|
Kind: tkRecord;
|
||||||
|
Name8: 'THash512';
|
||||||
|
RecSize8: SizeOf(THash512);
|
||||||
|
ManagedCount8: 0);
|
||||||
|
|
||||||
|
_PUTF8CHAR: TFakeTypeInfo = ( // stored in PT_INFO[ptPUtf8Char]
|
||||||
|
Kind: tkRecord; // don't mess with ordinals - just a record with a pointer
|
||||||
|
Name9: 'PUtf8Char';
|
||||||
|
RecSize9: SizeOf(pointer);
|
||||||
|
ManagedCount9: 0);
|
||||||
|
|
||||||
|
{$endif HASNOSTATICRTTI}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TGetRttiInterface.AddMethodsFromTypeInfo(aInterface: PTypeInfo);
|
||||||
|
var
|
||||||
|
mn, an: integer;
|
||||||
|
ancestor: PTypeInfo;
|
||||||
|
kind: TMethodKind;
|
||||||
|
cc: TCallConv;
|
||||||
|
flags: ^TParamFlags;
|
||||||
|
name: PShortString;
|
||||||
|
p: PByte;
|
||||||
|
pw: PWord absolute p;
|
||||||
|
pi: PTypeData absolute p;
|
||||||
|
ps: PShortString absolute p;
|
||||||
|
|
||||||
|
procedure AddArgFromRtti;
|
||||||
|
var
|
||||||
|
pp: ^PPRttiInfo absolute p;
|
||||||
|
argtypnfo: PRttiInfo;
|
||||||
|
argtypnam: PShortString;
|
||||||
|
{$ifdef HASNOSTATICRTTI}
|
||||||
|
rc: TRttiCustom;
|
||||||
|
{$endif HASNOSTATICRTTI}
|
||||||
|
begin
|
||||||
|
argtypnam := ps;
|
||||||
|
ps := @ps^[ord(ps^[0]) + 1];
|
||||||
|
argtypnfo := pp^^;
|
||||||
|
if pp^ = nil then
|
||||||
|
begin
|
||||||
|
{$ifdef HASNOSTATICRTTI} // detect e.g. TGuid/THash128 -> fake TypeInfo()
|
||||||
|
rc := Rtti.FindName(argtypnam^, []);
|
||||||
|
if rc <> nil then
|
||||||
|
argtypnfo := rc.Info
|
||||||
|
else
|
||||||
|
{$endif HASNOSTATICRTTI}
|
||||||
|
RaiseError('"%: %" parameter has no RTTI', [name^, argtypnam^]);
|
||||||
|
end;
|
||||||
|
inc(pp);
|
||||||
|
AddArgument(name, argtypnam, argtypnfo, flags^);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
pi := GetTypeData(aInterface);
|
||||||
|
if IdemPropName(pi^.IntfUnit, 'System') then
|
||||||
|
exit;
|
||||||
|
if Definition.Name = '' then
|
||||||
|
begin
|
||||||
|
ShortStringToAnsi7String(aInterface^.Name, Definition.Name);
|
||||||
|
ShortStringToAnsi7String(pi^.IntfUnit, Definition.UnitName);
|
||||||
|
Definition.Guid := pi^.Guid;
|
||||||
|
end;
|
||||||
|
ancestor := pi^.IntfParent^;
|
||||||
|
if ancestor <> nil then
|
||||||
|
begin
|
||||||
|
AddMethodsFromTypeInfo(ancestor); // recursive call of parents
|
||||||
|
inc(Level);
|
||||||
|
end;
|
||||||
|
p := @pi^.IntfUnit[ord(pi^.IntfUnit[0]) + 1];
|
||||||
|
mn := pw^;
|
||||||
|
inc(pw);
|
||||||
|
if (pw^ = $ffff) or
|
||||||
|
(mn = 0) then
|
||||||
|
exit; // no method
|
||||||
|
inc(pw);
|
||||||
|
SetLength(Definition.Methods, MethodCount + mn);
|
||||||
|
repeat
|
||||||
|
name := ps;
|
||||||
|
ps := @ps^[ord(ps^[0]) + 1];
|
||||||
|
kind := TMethodKind(p^);
|
||||||
|
inc(p);
|
||||||
|
cc := TCallConv(p^);
|
||||||
|
inc(p);
|
||||||
|
an := p^;
|
||||||
|
inc(p);
|
||||||
|
AddMethod(name^, an, kind);
|
||||||
|
if cc <> ccReg then
|
||||||
|
RaiseError('unsupported %', [GetEnumName(TypeInfo(TCallConv), ord(cc))^]);
|
||||||
|
while an > 0 do
|
||||||
|
begin
|
||||||
|
flags := pointer(p);
|
||||||
|
inc(p, SizeOf(flags^));
|
||||||
|
name := ps;
|
||||||
|
ps := @ps^[ord(ps^[0]) + 1];
|
||||||
|
AddArgFromRtti;
|
||||||
|
{$ifdef ISDELPHIXE}
|
||||||
|
inc(p, pw^); // skip custom attributes
|
||||||
|
{$endif ISDELPHIXE}
|
||||||
|
dec(an);
|
||||||
|
end;
|
||||||
|
name := nil;
|
||||||
|
if kind = mkFunction then
|
||||||
|
AddArgFromRtti;
|
||||||
|
{$ifdef ISDELPHIXE}
|
||||||
|
inc(p, pw^); // skip custom attributes
|
||||||
|
{$endif ISDELPHIXE}
|
||||||
|
dec(mn);
|
||||||
|
until mn = 0;
|
||||||
|
CurrentMethod := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
// gather rk* to reduce number of TRttiCustomListPairs hash slots in memory
|
||||||
|
RK_TOSLOT_MAX = 12;
|
||||||
|
RK_TOSLOT: array[TRttiKind] of byte = (
|
||||||
|
0, // rkUnknown
|
||||||
|
1, // rkInteger
|
||||||
|
2, // rkChar
|
||||||
|
3, // rkEnumeration
|
||||||
|
4, // rkFloat
|
||||||
|
0, // rkSString
|
||||||
|
5, // rkSet
|
||||||
|
6, // rkClass
|
||||||
|
0, // rkMethod
|
||||||
|
7, // rkWChar
|
||||||
|
8, // rkLString
|
||||||
|
7, // rkWString
|
||||||
|
9, // rkVariant
|
||||||
|
2, // rkArray
|
||||||
|
10, // rkRecord
|
||||||
|
9, // rkInterface
|
||||||
|
11, // rkInt64
|
||||||
|
12 // rkDynArray
|
||||||
|
{$ifdef UNICODE} ,
|
||||||
|
7, // rkUString
|
||||||
|
0, // rkClassRef
|
||||||
|
0, // rkPointer
|
||||||
|
0, // rkProcedure
|
||||||
|
0 // rkMRecord
|
||||||
|
{$endif UNICODE});
|
||||||
|
|
||||||
9888
lib/dmustache/mormot.core.rtti.pas
Normal file
9888
lib/dmustache/mormot.core.rtti.pas
Normal file
File diff suppressed because it is too large
Load Diff
6328
lib/dmustache/mormot.core.search.pas
Normal file
6328
lib/dmustache/mormot.core.search.pas
Normal file
File diff suppressed because it is too large
Load Diff
10325
lib/dmustache/mormot.core.text.pas
Normal file
10325
lib/dmustache/mormot.core.text.pas
Normal file
File diff suppressed because it is too large
Load Diff
10431
lib/dmustache/mormot.core.unicode.pas
Normal file
10431
lib/dmustache/mormot.core.unicode.pas
Normal file
File diff suppressed because it is too large
Load Diff
12030
lib/dmustache/mormot.core.variants.pas
Normal file
12030
lib/dmustache/mormot.core.variants.pas
Normal file
File diff suppressed because it is too large
Load Diff
790
lib/dmustache/mormot.defines.inc
Normal file
790
lib/dmustache/mormot.defines.inc
Normal file
@ -0,0 +1,790 @@
|
|||||||
|
{
|
||||||
|
This file is a part of the Open Source Synopse mORMot framework 2,
|
||||||
|
licensed under a MPL/GPL/LGPL three license - see LICENSE.md
|
||||||
|
|
||||||
|
Define a centralized set of conditional defines, included in all our
|
||||||
|
framework units, and could be used also for your own private units.
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
(********************** User-Trigerred Conditionals **********************)
|
||||||
|
|
||||||
|
{ Those conditionals below can be enabled in your project Options,
|
||||||
|
to tune the compilation depending your setup or your project expectations. }
|
||||||
|
|
||||||
|
{.$define USEPACKAGES}
|
||||||
|
// define this if you compile the unit within a Delphi package
|
||||||
|
// - it will avoid error like "[DCC Error] E2201 Need imported data reference
|
||||||
|
// ($G) to access 'VarCopyProc'"
|
||||||
|
// - shall be set at the package options level, and left untouched by default
|
||||||
|
// - note: you should probably also set "Generate DCUs only" in Project Options
|
||||||
|
// -> Delphi Compiler -> Output C/C++ -> C/C++ output file generation
|
||||||
|
|
||||||
|
{.$define PUREMORMOT2}
|
||||||
|
// if defined, no mORMot 1.18 compatilibity types nor functions would be enabled
|
||||||
|
// - by default, existing projects should (almost) compile with mORMot 2
|
||||||
|
// - you should eventually define this conditional to make a perfect code
|
||||||
|
// conversion to the new types and methods definitions
|
||||||
|
|
||||||
|
{.$define NEWRTTINOTUSED}
|
||||||
|
// if defined, the new RTTI (available since Delphi 2010) won't be linked to
|
||||||
|
// the executable: resulting file size will be much smaller, and mORMot won't
|
||||||
|
// be affected (unless you use the enhanced RTTI for record/dynamic array JSON
|
||||||
|
// serialization) - left undefined by default to ensure minimal impact
|
||||||
|
|
||||||
|
{.$define FPCUSEVERSIONINFO}
|
||||||
|
// link low-level fileinfo/machoreader/elfreader for TFileVersion/TExeVersion
|
||||||
|
// from mormot.core.os.pas => disabled by default, to preserve code size
|
||||||
|
|
||||||
|
{.$define NOSETTHREADNAME}
|
||||||
|
// if defined, SetThreadName() would not raise the exception used to set the
|
||||||
|
// thread name: to be defined if you have issues when debugging your application
|
||||||
|
|
||||||
|
{.$define NODIRECTTHREADMANAGER}
|
||||||
|
// on POSIX, omit direct GetThreadManager() API calls and just use RTL functions
|
||||||
|
|
||||||
|
{.$define NOEXCEPTIONINTERCEPT}
|
||||||
|
// if defined, exceptions shall not be intercepted nor logged
|
||||||
|
|
||||||
|
{.$define NOPATCHVMT}
|
||||||
|
// disable the vmtAutoTable slot runtime patch, replacing it with Rtti.FindType
|
||||||
|
// - is likely to be defined with the NOPATCHRTL conditional
|
||||||
|
// - could be used e.g. when in-memory executables can't be patched (e.g. on
|
||||||
|
// security constrained systems, or on OS without any mmap support)
|
||||||
|
|
||||||
|
{.$define NOPATCHRTL}
|
||||||
|
// if defined, FPC RTL won't be patched on x86_64 with optimized asm
|
||||||
|
// - is likely to be defined with the NOPATCHVMT conditional
|
||||||
|
// - you can enable it if you find out some compatibility problem
|
||||||
|
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{.$define HASNOSSE2} // force x87 code on very very old CPU
|
||||||
|
{$endif CPUX86}
|
||||||
|
|
||||||
|
{.$define NOSYNDBZEOS}
|
||||||
|
// make mormot.db.sql.zeos.pas a "void" unit - defined for FPC/Lazarus packages only
|
||||||
|
|
||||||
|
{.$define NOSYNDBIBX}
|
||||||
|
// make mormot.db.sql.ibx.pas a "void" unit - defined for FPC/Lazarus packages only
|
||||||
|
|
||||||
|
{.$define MONGO_OLDPROTOCOL}
|
||||||
|
// may be used with old MongoDB instances < 3.6 with no OP_MSG in Wire protocol
|
||||||
|
|
||||||
|
{.$define DISABLEAPPSQL}
|
||||||
|
// mormot.db.sql external DB won't be linked to the executable by mormot.app
|
||||||
|
|
||||||
|
{.$define DISABLEAPPNOSQL}
|
||||||
|
// Mongo DB client won't be linked to the executable by mormot.app
|
||||||
|
|
||||||
|
{.$define NOSSPIAUTH}
|
||||||
|
// disable Windows mormot.lib.sspi support in mormot.rest.client/server units
|
||||||
|
|
||||||
|
{.$define NOGSSAPIAUTH}
|
||||||
|
// disable Posix mormot.lib.gsssapi support in mormot.rest.client/server units
|
||||||
|
|
||||||
|
{.$define NOPOINTEROFFSET}
|
||||||
|
// disable TOrmTable offsets on 64-bit if your memory is huge or fragmented
|
||||||
|
// note: FPCMM_MEDIUM32BIT may need this for data >256KB
|
||||||
|
|
||||||
|
{.$define NOTORMTABLELEN}
|
||||||
|
// disable TOrmTable internal fLen[] pre-computed table - slower but less memory
|
||||||
|
|
||||||
|
{.$define NOSQLITE3STATIC}
|
||||||
|
// disable static SQlite3 linking - to force use external dll/so library
|
||||||
|
|
||||||
|
{.$define NOSQLITE3FPUSAVE}
|
||||||
|
// disable SetFpuFlags() calls during SQlite3 engine - may enhance performance
|
||||||
|
|
||||||
|
{.$define DEBUGSTORAGELOCK}
|
||||||
|
// could be defined to force verbose log of StorageLock/StorageUnLock
|
||||||
|
|
||||||
|
{.$define DEBUGSQLVIRTUALTABLE}
|
||||||
|
// could be defined to force verbose log of SQlite3 virtual table query planner costs
|
||||||
|
|
||||||
|
{.$define ONLYUSEHTTPSOCKET}
|
||||||
|
// is defined on POSIX but may be enabled on Windows if socket+SChannel is enough
|
||||||
|
|
||||||
|
{.$define OLDLIBC}
|
||||||
|
// use only oldest libc API, e.g. accept() instead of accept4()
|
||||||
|
|
||||||
|
{.$define OLDLINUXKERNEL}
|
||||||
|
// use only oldest Linux syscalls - as in FPC RTL
|
||||||
|
|
||||||
|
{.$define USE_OPENSSL}
|
||||||
|
// is defined on POSIX (with late binding) but may be enabled on Windows too
|
||||||
|
|
||||||
|
{.$define USELIBCURL}
|
||||||
|
// define cross-platform libcurl for https
|
||||||
|
// (when our native socket+OpenSSL/SChannel doesn't seem to be good enough)
|
||||||
|
|
||||||
|
{.$define LIBCURLMULTI}
|
||||||
|
// enable the more advanced "multi session" API functions of mormot.lib.curl
|
||||||
|
// see https://curl.haxx.se/libcurl/c/libcurl-multi.html interface
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef FPC}
|
||||||
|
|
||||||
|
(********************** FPC Conditionals **********************)
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- global code generation conditionals
|
||||||
|
|
||||||
|
// note: you may remove all unexpexted hints by setting in your project options
|
||||||
|
// -vm11047,6058,5092,5091,5060,5058,5057,5028,5024,5023,4081,4079,4055,3187,3124,3123
|
||||||
|
|
||||||
|
// disable some no-brainer warnings - let FPC align with Delphi in that matter
|
||||||
|
{$WARN 5089 off} // uninitialized managed variables 1
|
||||||
|
{$WARN 5091 off} // uninitialized managed variables 2
|
||||||
|
{$WARN 5093 off} // function result variable of a managed uninitialized 1
|
||||||
|
{$WARN 5094 off} // function result variable of a managed uninitialized 2
|
||||||
|
{$WARN 6058 off} // call to subroutine marked as inline is not inlined
|
||||||
|
|
||||||
|
{$ifndef FPC_DELPHI}
|
||||||
|
{$MODE DELPHI} // e.g. for asm syntax - disabled for FPC 2.6 compatibility
|
||||||
|
{$endif FPC_DELPHI}
|
||||||
|
|
||||||
|
{$INLINE ON}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$PACKRECORDS DEFAULT} // force normal alignment
|
||||||
|
{$PACKSET 1}
|
||||||
|
{$PACKENUM 1}
|
||||||
|
{$CODEPAGE UTF8} // otherwise unexpected behavior occurs in most cases
|
||||||
|
{$OBJECTCHECKS OFF} // as expected e.g. when hooking classes
|
||||||
|
|
||||||
|
{$define HASINLINE}
|
||||||
|
{$define HASINLINEWINAPI} // Delphi has troubles inlining Windows API calls
|
||||||
|
{$define HASSAFEINLINE} // Delphi 2007-2009 have troubles inlining
|
||||||
|
{$define NODELPHIASM} // avoid e.g. low-level System.@LStrFromPCharLen
|
||||||
|
{$define HASDYNARRAYTYPE} // eltype2 field, used e.g. for T*ObjArray
|
||||||
|
{$define HASITERATORS}
|
||||||
|
{$define HASIMPLICITOPERATOR}
|
||||||
|
{$define HASDBFTWIDE}
|
||||||
|
{$define HASTTHREADSTART}
|
||||||
|
{$define HASINTERFACEASTOBJECT}
|
||||||
|
{$define EXTENDEDTOSHORT_USESTR} // FloatToText uses str() in FPC
|
||||||
|
{$define DOUBLETOSHORT_USEGRISU} // fast DoubleToAscii()
|
||||||
|
{$define USERECORDWITHMETHODS} // use "object" only for Delphi 7
|
||||||
|
{$define FPC_OR_UNICODE}
|
||||||
|
{$define FPC_OR_DELPHIXE} // to circumvent Delphi internal errors
|
||||||
|
{$define FPC_OR_DELPHIXE4}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- identify FPC versions
|
||||||
|
|
||||||
|
// $if FPC_FULLVERSION>20700 breaks Delphi 6-7 and SynProject :(
|
||||||
|
{$ifdef VER2_7}
|
||||||
|
{$define ISFPC27}
|
||||||
|
{$endif VER2_7}
|
||||||
|
{$ifdef VER3_0}
|
||||||
|
{$define ISFPC27}
|
||||||
|
{$define ISFPC30}
|
||||||
|
{$define HASDIRECTTYPEINFO}
|
||||||
|
// PTypeInfo would be stored with no pointer de-reference
|
||||||
|
// => Delphi and newer FPC uses a pointer reference to ease exe linking
|
||||||
|
{$endif VER3_0}
|
||||||
|
{$ifdef VER3_1} // trunk before 3.2
|
||||||
|
{$define ISFPC27}
|
||||||
|
{$define ISFPC30}
|
||||||
|
{.$define HASDIRECTTYPEINFO}
|
||||||
|
// define this for trunk revisions older than June 2016 - see
|
||||||
|
// http://wiki.freepascal.org/User_Changes_Trunk#RTTI_Binary_format_change
|
||||||
|
{$endif VER3_1}
|
||||||
|
{$ifdef VER3_1_1}
|
||||||
|
{$define ISFPC32}
|
||||||
|
{$endif VER3_1_1}
|
||||||
|
{$ifdef VER3_2}
|
||||||
|
{$define ISFPC27}
|
||||||
|
{$define ISFPC30}
|
||||||
|
{$define ISFPC32}
|
||||||
|
{$define HASGETTYPEKIND}
|
||||||
|
{$ifdef VER3_2_2}
|
||||||
|
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
||||||
|
{$endif VER3_2_2}
|
||||||
|
{$ifdef VER3_2_3}
|
||||||
|
{$define HASTTHREADTERMINATESET}
|
||||||
|
{$endif VER3_2_3}
|
||||||
|
{$endif VER3_2}
|
||||||
|
{$ifdef VER3_3} // trunk before 3.2
|
||||||
|
{$define ISFPC27}
|
||||||
|
{$define ISFPC30}
|
||||||
|
{$define ISFPC32}
|
||||||
|
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
||||||
|
{$endif VER3_3}
|
||||||
|
{$ifdef VER3_4}
|
||||||
|
{$define ISFPC27}
|
||||||
|
{$define ISFPC30}
|
||||||
|
{$define ISFPC32}
|
||||||
|
{$define ISFPC34}
|
||||||
|
{$define FPC_PROVIDE_ATTR_TABLE} // introducing TTypeData.AttributeTable
|
||||||
|
{$define STRCNT32} // 32-bit TAnsiRec.Ref even on 64-bit CPU
|
||||||
|
// see https://gitlab.com/freepascal.org/fpc/source/-/issues/38018
|
||||||
|
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
||||||
|
{$endif VER3_4}
|
||||||
|
{$if not defined(VER3_0) and not defined(VER3_2) and not defined(VER2)}
|
||||||
|
{.$define FPC_PROVIDE_ATTR_TABLE} // to be defined since SVN 42356-42411
|
||||||
|
// on compilation error in mormot.core.Rtti, undefine the above conditional
|
||||||
|
// see https://lists.freepascal.org/pipermail/fpc-announce/2019-July/000612.html
|
||||||
|
{$define STRCNT32} // new trunk feature: 32-bit TAnsiRec.Ref even on 64-bit CPU
|
||||||
|
{$ifend}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- identify Operating Systems
|
||||||
|
|
||||||
|
// mainly OSWINDOWS or OSPOSIX (OSLINUX, OSBSD, OSDARWIN, OSANDROID)
|
||||||
|
|
||||||
|
{$ifdef MSWINDOWS}
|
||||||
|
// conditionals for Windows
|
||||||
|
{$define OSWINDOWS}
|
||||||
|
{$define FPCWINDOWS}
|
||||||
|
{$else}
|
||||||
|
{$define OSPOSIX} // a POSIX/BSD system
|
||||||
|
{$define FPCPOSIX}
|
||||||
|
{$ifdef BSD}
|
||||||
|
// conditionals for Darwin and BSD family like OpenBSD/FreeBSD
|
||||||
|
{$define OSBSDDARWIN} // OSBSDDARWIN = OSBSD + OSDARWIN
|
||||||
|
{$ifdef DARWIN}
|
||||||
|
{$define OSDARWIN}
|
||||||
|
{$define FPCDARWIN}
|
||||||
|
{$ifdef CPUINTEL}
|
||||||
|
{$define FPC_PIC} // may have not be defined in compiler options
|
||||||
|
{$endif CPUINTEL}
|
||||||
|
{$define NOPATCHRTL} // don't mess with asm stuff
|
||||||
|
{$define DISABLE_SSE42} // circumvent clang asm bugs
|
||||||
|
{$else}
|
||||||
|
{$define OSBSD} // OSX has some non-standard API calls
|
||||||
|
{$define FPCBSD}
|
||||||
|
{$ifdef OPENBSD}
|
||||||
|
{$define OSOPENBSD} // OSBDS = OSOPENBSD + OSFREEBSD
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{$define FPC_PIC}
|
||||||
|
{$endif CPUX86}
|
||||||
|
{$endif OPENBSD}
|
||||||
|
{$ifdef FREEBSD}
|
||||||
|
{$define OSFREEBSD}
|
||||||
|
{$endif FREEBSD}
|
||||||
|
{$endif DARWIN}
|
||||||
|
{$else}
|
||||||
|
{$ifdef LINUX}
|
||||||
|
// conditionals for Linux
|
||||||
|
{$define OSLINUX} // e.g. to disable epoll API
|
||||||
|
{$define FPCLINUX}
|
||||||
|
{$define OSLINUXANDROID}
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$define OSLINUXINTEL}
|
||||||
|
{$define OSLINUXX64}
|
||||||
|
{$endif CPUX64}
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{$define OSLINUXINTEL}
|
||||||
|
{$define OSLINUXX86}
|
||||||
|
{$endif CPUX86}
|
||||||
|
{$else}
|
||||||
|
{$ifdef ANDROID}
|
||||||
|
// conditionals for Android
|
||||||
|
{$define OSANDROID}
|
||||||
|
{$define FPCANDROID}
|
||||||
|
{$define OSLINUXANDROID}
|
||||||
|
{$define NOPATCHRTL} // don't mess with asm stuff
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{$define FPC_PIC}
|
||||||
|
{$endif CPUX86}
|
||||||
|
{$ifdef CPUAARCH64}
|
||||||
|
{$define OSANDROIDARM64}
|
||||||
|
{$endif CPUAARCH64}
|
||||||
|
{$else}
|
||||||
|
'Unsupported Operating System - yet'
|
||||||
|
{$endif ANDROID}
|
||||||
|
{$endif LINUX}
|
||||||
|
{$endif BSD}
|
||||||
|
{$endif MSWINDOWS}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- identify CPU Architectures
|
||||||
|
|
||||||
|
{$define FPC_SINGLEABI} // only on i386 default ABI <> cdecl
|
||||||
|
{$ifdef CPU64}
|
||||||
|
// 64-bit Architecture
|
||||||
|
{$define FPC_64}
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$ASMMODE INTEL} // as Delphi expects
|
||||||
|
{$define CPUINTEL}
|
||||||
|
{$define FPC_CPUINTEL}
|
||||||
|
{$define FPC_CPUX64}
|
||||||
|
{$ifndef OSDARWIN} // MachOS has troubles with our asm
|
||||||
|
{$define FPC_ASMX64}
|
||||||
|
{$define ASMX64} // supports asm with globals
|
||||||
|
{$define ASMINTEL} // either ASMX86 or ASMX64
|
||||||
|
{$define ASMX64AVX} // supports AVX/AVX2/AVX512
|
||||||
|
{$define ASMX64AVXNOCONST} // supports AVX with no align32 constant load
|
||||||
|
{$define CPUX64ASM} // FPC has no problem (not Delphi prior XE7)
|
||||||
|
{$define HASAESNI} // mormot.crypt.core rejected by Darwin asm
|
||||||
|
{$endif OSDARWIN}
|
||||||
|
{$endif CPUX64}
|
||||||
|
{$ifdef CPUAARCH64}
|
||||||
|
{$define CPUARM3264}
|
||||||
|
{$endif CPUAARCH64}
|
||||||
|
{$else}
|
||||||
|
// 32-bit Architecture
|
||||||
|
{$define FPC_32}
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{$ASMMODE INTEL} // as Delphi expects
|
||||||
|
{$define CPUINTEL}
|
||||||
|
{$define FPC_CPUINTEL}
|
||||||
|
{$define FPC_X86}
|
||||||
|
{$ifndef FPC_PIC} // MachOS/OpenBSD/Android require PIC on i386
|
||||||
|
{$define ASMX86} // supports asm with globals
|
||||||
|
{$define ASMINTEL} // either ASMX86 or ASMX64
|
||||||
|
{$define CPUX86NOTPIC} // use "absolute" instead of local register
|
||||||
|
{$define HASAESNI}
|
||||||
|
{$endif FPC_PIC}
|
||||||
|
{$define TSYNEXTENDED80} // only 32-bit has a true x87 extended type
|
||||||
|
{$undef FPC_SINGLEABI} // on i386, cdecl <> register convention
|
||||||
|
{$endif CPUX86}
|
||||||
|
{$ifdef CPUARM}
|
||||||
|
{$define CPUARM3264}
|
||||||
|
{$endif CPUARM}
|
||||||
|
{$define STRCNT32} // 32-bit TAnsiRec.Ref
|
||||||
|
{$define DACNT32} // 32-bit TDynArrayRec.refCnt
|
||||||
|
{$endif CPU64}
|
||||||
|
{$ifndef CPUX64}
|
||||||
|
{$undef FPC_X64MM} // x86_64 only unit
|
||||||
|
{$endif CPUX64}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- compiler-specific code generation conditionals
|
||||||
|
|
||||||
|
{$ifdef ISFPC32}
|
||||||
|
// FPC has its own RTTI layout only since late 3.x
|
||||||
|
{$define FPC_NEWRTTI}
|
||||||
|
// when http://bugs.freepascal.org/view.php?id=26774 has been fixed
|
||||||
|
{$define HASINTERFACERTTI}
|
||||||
|
// generics support seems good in FPC 3.2+ but triggers linking issues
|
||||||
|
{$define HASGENERICS}
|
||||||
|
{$define ORMGENERICS}
|
||||||
|
{$define FPCGENERICS}
|
||||||
|
{$endif}
|
||||||
|
// FPC generics (aka parameterized types) are available since 2.6
|
||||||
|
{$define HASGENERICSSYNTAX}
|
||||||
|
|
||||||
|
{$ifdef FPC_NEWRTTI}
|
||||||
|
{$define ISDELPHI2010_OR_FPC_NEWRTTI}
|
||||||
|
{$else}
|
||||||
|
{$define DELPHI_OR_FPC_OLDRTTI}
|
||||||
|
{$define FPC_OLDRTTI}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef FPC_HAS_CPSTRING}
|
||||||
|
// see http://wiki.freepascal.org/FPC_Unicode_support
|
||||||
|
{$define HASCODEPAGE} // UNICODE means {$mode delphiunicode}
|
||||||
|
{$endif FPC_HAS_CPSTRING}
|
||||||
|
|
||||||
|
{$ifdef ISFPC27}
|
||||||
|
{$define ISFPC271}
|
||||||
|
{$define HASVARUSTRING}
|
||||||
|
{$define HASVARUSTRARG}
|
||||||
|
// defined if the http://mantis.freepascal.org/view.php?id=26773 bug is fixed
|
||||||
|
// you should use 2.7.1/trunk branch in revision 28995 from 2014-11-05T22:17:54
|
||||||
|
// => this will change the TInvokeableVariantType.SetProperty() signature
|
||||||
|
{$define FPC_VARIANTSETVAR}
|
||||||
|
{$endif ISFPC27}
|
||||||
|
|
||||||
|
{$if defined(FPC_USE_WIN32_SEH) or defined(FPC_USE_WIN64_SEH)}
|
||||||
|
{.$define HASFASTTRYFINALLY}
|
||||||
|
// FPC SEH is not fully efficient and generate some additional code/calls
|
||||||
|
{$ifend}
|
||||||
|
|
||||||
|
{$else FPC}
|
||||||
|
|
||||||
|
(********************** Delphi Conditionals **********************)
|
||||||
|
|
||||||
|
{$ifndef MSWINDOWS}
|
||||||
|
'Kylix or Delphi for MacOS/Linux/Mobile are unsupported'
|
||||||
|
'-> we recommend using FPC for POSIX platforms'
|
||||||
|
{$endif MSWINDOWS}
|
||||||
|
|
||||||
|
{$define OSWINDOWS}
|
||||||
|
|
||||||
|
{$ifndef CONDITIONALEXPRESSIONS}
|
||||||
|
'Delphi 2-5 are not supported'
|
||||||
|
{$endif CONDITIONALEXPRESSIONS}
|
||||||
|
{$ifdef VER140}
|
||||||
|
'Delphi 6 is not supported'
|
||||||
|
{$endif VER140}
|
||||||
|
|
||||||
|
{$A+} // force normal alignment, as expected by our units
|
||||||
|
|
||||||
|
{$ifdef UNICODE}
|
||||||
|
{$define HASVARUSTRING}
|
||||||
|
{$define HASCODEPAGE}
|
||||||
|
{$define FPC_OR_UNICODE}
|
||||||
|
{$define USERECORDWITHMETHODS}
|
||||||
|
{$define HASGENERICSSYNTAX} // Delphi 2009+ compiler has TArray<>
|
||||||
|
{ due to a bug in Delphi 2009+, we need to fake inheritance of record,
|
||||||
|
since TDynArrayHashed = object(TDynArray) fails to initialize
|
||||||
|
http://blog.synopse.info/post/2011/01/29/record-and-object-issue-in-Delphi-2010 }
|
||||||
|
{$define UNDIRECTDYNARRAY}
|
||||||
|
{$else}
|
||||||
|
{$define HASNOSTATICRTTI} // Delphi 7/2007 has no TypeInfo(TGuid)
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$define ISDELPHI}
|
||||||
|
{$define CPUINTEL} // Delphi only for Intel by now
|
||||||
|
{$define ASMINTEL} // either ASMX86 or ASMX64
|
||||||
|
{$undef FPC_X64MM} // FPC only unit
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$undef CPU32}
|
||||||
|
{$define CPU64} // Delphi compiler for 64 bit CPU
|
||||||
|
{$define CPU64DELPHI}
|
||||||
|
{$define ASMX64} // supports asm with globals
|
||||||
|
{$define EXTENDEDTOSHORT_USESTR} // FloatToText() slower in Delphi Win64
|
||||||
|
{$define DOUBLETOSHORT_USEGRISU} // fast DoubleToAscii() - not Delphi Win32
|
||||||
|
{$else CPUX64}
|
||||||
|
{$define CPU32} // Delphi compiler for 32 bit CPU
|
||||||
|
{$undef CPU64}
|
||||||
|
{$define CPU32DELPHI}
|
||||||
|
{$define CPUX86} // for compatibility with older versions of Delphi
|
||||||
|
{$define ASMX86} // supports asm with globals
|
||||||
|
{$define CPUX86NOTPIC} // use "absolute" instead of local register
|
||||||
|
{$define TSYNEXTENDED80} // only 32-bit has a true x87 extended type
|
||||||
|
{$endif CPUX64}
|
||||||
|
|
||||||
|
{$define DELPHI_OR_FPC_OLDRTTI}
|
||||||
|
{$define HASINTERFACERTTI} // interface RTTI (not oldest FPC)
|
||||||
|
{$define HASFASTTRYFINALLY} // Delphi Win32/Win64 efficiently uses SEH
|
||||||
|
{$define STRCNT32} // 32-bit TStrRec.refCnt even on 64-bit CPU
|
||||||
|
{$define DACNT32} // 32-bit TDynArrayRec.refCnt even on 64-bit CPU
|
||||||
|
{$warn UNSAFE_CODE OFF} // Delphi for .Net does not exist any more!
|
||||||
|
{$warn UNSAFE_TYPE OFF}
|
||||||
|
{$warn UNSAFE_CAST OFF}
|
||||||
|
{$warn DUPLICATE_CTOR_DTOR OFF} // avoid W1029 unneeded hints
|
||||||
|
{$warn SYMBOL_PLATFORM OFF}
|
||||||
|
{$warn SYMBOL_DEPRECATED OFF} // for faVolumeID
|
||||||
|
{$warn UNIT_PLATFORM OFF}
|
||||||
|
|
||||||
|
{$if CompilerVersion >= 17} // = Delphi 2005
|
||||||
|
{$define ISDELPHI2005ANDUP}
|
||||||
|
{$if CompilerVersion >= 18}
|
||||||
|
{$define ISDELPHI2006ANDUP} // = Delphi 2006
|
||||||
|
{$define HASNEWFILEAGE}
|
||||||
|
{$define HASINLINE}
|
||||||
|
{$define HASINLINEDELPHI}
|
||||||
|
{$define HASREGION}
|
||||||
|
{$define HASFASTMM4}
|
||||||
|
// you can define this so that GetMemoryInfo/TSynMonitorMemory returns
|
||||||
|
// low-level FastMM4 information
|
||||||
|
{.$define WITH_FASTMM4STATS}
|
||||||
|
{$ifend}
|
||||||
|
{$ifdef VER180} // = Delphi 2006
|
||||||
|
{$define ISDELPHI20062007} // to circumvent some specific bugs
|
||||||
|
{$endif}
|
||||||
|
{$ifdef VER185} // = Delphi 2007
|
||||||
|
{$define ISDELPHI20062007}
|
||||||
|
{$endif}
|
||||||
|
{$if CompilerVersion > 18}
|
||||||
|
{$define ISDELPHI2007ANDUP} // = Delphi 2007 or newer
|
||||||
|
{$define HASITERATORS}
|
||||||
|
{$define HASDBFTWIDE}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion = 20} // = Delphi 2009
|
||||||
|
{$define ISDELPHI2009} // to circumvent some specific bugs
|
||||||
|
{$define ISDELPHI20092010}
|
||||||
|
{$define HASNOSTATICRTTI} // has no TypeInfo(TGuid)
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion = 21} // = Delphi 2010
|
||||||
|
{$define ISDELPHI20092010} // to circumvent some specific bugs
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 21.0}
|
||||||
|
{$define HASSAFEINLINE} // Delphi 2007-2009 have troubles inlining :(
|
||||||
|
{$define ISDELPHI2010}
|
||||||
|
{$define HASDYNARRAYTYPE} // eltype2 field, used e.g. for T*ObjArray
|
||||||
|
{$define HASEXTRECORDRTTI}
|
||||||
|
{$define HASIMPLICITOPERATOR} // Delphi 2010+ "implicit operator" is ok
|
||||||
|
{$define ISDELPHI2010_OR_FPC_NEWRTTI}
|
||||||
|
{$define HASTTHREADSTART}
|
||||||
|
{$define HASINTERFACEASTOBJECT}
|
||||||
|
{$ifdef NEWRTTINOTUSED} // to reduce EXE size by disabling some RTTI
|
||||||
|
{$WEAKLINKRTTI ON}
|
||||||
|
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
|
||||||
|
{$endif NEWRTTINOTUSED}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 22.0} // = Delphi XE
|
||||||
|
{$define FPC_OR_DELPHIXE} // Delphi 2007/2009/2010 inlining bugs
|
||||||
|
{$define ISDELPHIXE}
|
||||||
|
{$define HASGENERICS} // somewhat unusable generics (?)
|
||||||
|
{$define ORMGENERICS}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 23.0} // = Delphi XE2
|
||||||
|
{$define ISDELPHIXE2}
|
||||||
|
// Delphi XE2 has some cross-platform features
|
||||||
|
// e.g. {$ifdef NEEDVCLPREFIX}VCL.Graphics{$else}Graphics{$endif}
|
||||||
|
{$define NEEDVCLPREFIX}
|
||||||
|
{$define HASVARUSTRARG}
|
||||||
|
{$define HASTTHREADTERMINATESET} // introduced TThread.TerminateSet
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 24.0} // = Delphi XE3
|
||||||
|
{$define ISDELPHIXE3}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 25.0} // = Delphi XE4
|
||||||
|
{$define ISDELPHIXE4}
|
||||||
|
{$define FPC_OR_DELPHIXE4} // circumvent Internal Error: C2130 on XE3
|
||||||
|
{$define HASAESNI}
|
||||||
|
{$define HASALIGN} // .align ### inline assembler directive
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 26.0} // = Delphi XE5
|
||||||
|
{$define ISDELPHIXE5}
|
||||||
|
{$define PUBLISHRECORD}
|
||||||
|
// if defined, will handle RTTI available only since Delphi XE5 for
|
||||||
|
// record published properties
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 27.0} // = Delphi XE6
|
||||||
|
{$define ISDELPHIXE6}
|
||||||
|
{$ifend}
|
||||||
|
{$if (CompilerVersion = 27.0) or
|
||||||
|
(CompilerVersion = 28.0)} // = Delphi XE6 or XE7
|
||||||
|
// avoid internal error G2515 or F2084 AV0044FF4E-R00000008-0
|
||||||
|
{$undef HASGENERICS}
|
||||||
|
{$undef ORMGENERICS}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 28.0}
|
||||||
|
{$define ISDELPHIXE7}
|
||||||
|
{$ifdef CPU64}
|
||||||
|
{$define CPUX64ASM} // e.g. XE4 SSE asm is buggy :(
|
||||||
|
{$endif CPU64}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 29.0} // = Delphi XE8
|
||||||
|
{$define ISDELPHIXE8}
|
||||||
|
{$define HASGETTYPEKIND} // generics intrinsics are buggy before XE8
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 30.0} // = Delphi 10
|
||||||
|
{$define ISDELPHI10}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 31.0} // = Delphi 10.1
|
||||||
|
{$define ISDELPHI101}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 32.0} // = Delphi 10.2
|
||||||
|
{$define ISDELPHI102}
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$ifdef VER320withoutAprilUpdate}
|
||||||
|
// circumvent early Delphi 10.2 Tokyo Win64 compiler bug
|
||||||
|
{$undef HASINLINE}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 33.0} // = Delphi 10.3
|
||||||
|
{$define ISDELPHI103}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 34.0} // = Delphi 10.4
|
||||||
|
{$define ISDELPHI104}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 35.0} // = Delphi 11.x Alexandria
|
||||||
|
{$define ISDELPHI11}
|
||||||
|
{$ifdef CPU64}
|
||||||
|
{.$define ASMX64AVX} // initial AVX/AVX2/AVX512 support - but broken
|
||||||
|
{$define ASMX64AVXNOCONST} // supports AVX with no align32 constant load
|
||||||
|
{$endif CPU64}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 36.0} // = Delphi 12 Athens
|
||||||
|
{$define ISDELPHI12}
|
||||||
|
{$ifend}
|
||||||
|
{$if CompilerVersion >= 37.0} // = Delphi 13 Next
|
||||||
|
{$define ISDELPHI13}
|
||||||
|
{$ifend}
|
||||||
|
{$else}
|
||||||
|
{$define ISDELPHI7}
|
||||||
|
{$ifend CompilerVersion >= 17}
|
||||||
|
|
||||||
|
{$endif FPC}
|
||||||
|
|
||||||
|
|
||||||
|
(********************** Shared Conditionals **********************)
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- about pascal code expectations
|
||||||
|
|
||||||
|
{$H+} // we use long strings
|
||||||
|
{$R-} // disable Range checking in our code
|
||||||
|
{$S-} // disable Stack checking in our code
|
||||||
|
{$X+} // expect extended syntax
|
||||||
|
{$W-} // disable stack frame generation
|
||||||
|
{$Q-} // disable overflow checking in our code
|
||||||
|
{$B-} // expect short circuit boolean
|
||||||
|
{$V-} // disable Var-String Checking
|
||||||
|
{$T-} // Typed @ operator
|
||||||
|
{$Z1} // enumerators stored as byte by default
|
||||||
|
{$P+} // Open string params
|
||||||
|
|
||||||
|
{$ifdef DEBUG}
|
||||||
|
{$assertions on} // assert() may be disabled, e.g. on FPC
|
||||||
|
{$endif DEBUG}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- CPU specific conditionals
|
||||||
|
|
||||||
|
{$ifdef CPUINTEL}
|
||||||
|
{$ifdef OSWINDOWS}
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$define WIN64ABI} // for asm on x86_64
|
||||||
|
{$define OSWINDOWS64} // Win64
|
||||||
|
{$else}
|
||||||
|
{$define OSWINDOWS32} // Win32
|
||||||
|
{$endif CPUX64}
|
||||||
|
{$define THREADID32} // TThreadID = 32-bit DWORD on Win32 and Win64
|
||||||
|
{$endif OSWINDOWS}
|
||||||
|
{$ifdef OSPOSIX}
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$define SYSVABI} // for asm on x86_64
|
||||||
|
{$else}
|
||||||
|
{$define THREADID32} // TThreadID = PtrUInt/pointer on pthread
|
||||||
|
{$endif CPUX64}
|
||||||
|
{$endif OSPOSIX}
|
||||||
|
{$define CPUINTELARM}
|
||||||
|
{$else}
|
||||||
|
{$undef HASAESNI} // AES-NI is an Intel-specific feature
|
||||||
|
{$ifdef CPUARM3264}
|
||||||
|
{$define CPUINTELARM}
|
||||||
|
{$endif CPUARM3264}
|
||||||
|
{$ifdef CPU32}
|
||||||
|
{$define THREADID32} // TThreadID = PtrUInt/pointer on pthread
|
||||||
|
{$endif CPU32}
|
||||||
|
{$endif CPUINTEL}
|
||||||
|
|
||||||
|
{$ifdef CPU32}
|
||||||
|
{$define NOPOINTEROFFSET} // 32-bit CPU will always store pointers
|
||||||
|
{$endif CPU32}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- Libraries linking
|
||||||
|
|
||||||
|
// some static linked files are to be downloaded from
|
||||||
|
// https://github.com/synopse/mORMot2/releases
|
||||||
|
|
||||||
|
{$ifdef FPC}
|
||||||
|
// Delphi doesn't accept GCC object files and libdeflate requires GCC
|
||||||
|
{$if defined(OSOPENBSD) and defined(FPC_CROSSCOMPILING)}
|
||||||
|
{$define NOSQLITE3STATIC} // OpenBSD problems with fpcupdeluxe libgcc.a
|
||||||
|
{$ifend}
|
||||||
|
{$define LIZARD_EXTERNALONLY} // Lizard is disabled but on some targets
|
||||||
|
{$ifdef OSLINUX}
|
||||||
|
{$ifdef CPUINTEL}
|
||||||
|
{$define LIBDEFLATESTATIC} // libdeflate static binding
|
||||||
|
{$define LIBQUICKJSSTATIC} // quickjs static binding
|
||||||
|
{$undef LIZARD_EXTERNALONLY} // static liblizard.a
|
||||||
|
{$endif CPUINTEL}
|
||||||
|
{$ifdef CPUARM}
|
||||||
|
{.$undef LIZARD_EXTERNALONLY} // static liblizard.a is not tested
|
||||||
|
{.$define LIBDEFLATESTATIC} // compiles, but untested
|
||||||
|
{.$define LIBQUICKJSSTATIC} // compiles, but untested
|
||||||
|
{$endif CPUARM}
|
||||||
|
{$ifdef CPUAARCH64}
|
||||||
|
{$define LIBDEFLATESTATIC}
|
||||||
|
{$undef LIZARD_EXTERNALONLY} // static liblizard.a seems OK
|
||||||
|
{.$define LIBQUICKJSSTATIC} // compiles, but access violations
|
||||||
|
{$endif CPUAARCH64}
|
||||||
|
{$endif OSLINUX}
|
||||||
|
{$ifdef OSWINDOWS}
|
||||||
|
{$undef LIZARD_EXTERNALONLY} // static liblizard.a
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{$define LIBDEFLATESTATIC}
|
||||||
|
{$define LIBQUICKJSSTATIC}
|
||||||
|
{$endif CPUX86}
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{.$define LIBDEFLATESTATIC} // Win64 + FPC 3.2 = internal error 200603061
|
||||||
|
{$define LIBQUICKJSSTATIC}
|
||||||
|
{$endif CPUX64}
|
||||||
|
{$endif OSWINDOWS}
|
||||||
|
{$ifdef CPUARM3264}
|
||||||
|
{$ifdef OSDARWIN} // unsupported arch (e.g. Aarch64-Darwin)
|
||||||
|
{$define OSDARWINARM}
|
||||||
|
{$define LIZARD_EXTERNALONLY}
|
||||||
|
{$define NOLIBCSTATIC}
|
||||||
|
{$endif OSDWARWIN}
|
||||||
|
{$endif CPUARM3264}
|
||||||
|
{$else}
|
||||||
|
{$define LIZARD_EXTERNALONLY} // no static .obj for Delphi Win32/Win64 yet
|
||||||
|
{$ifdef CPUX86}
|
||||||
|
{$define LIBQUICKJSSTATIC} // our quickjs.obj seems fine on Win32 :)
|
||||||
|
{$endif CPUX86}
|
||||||
|
// there is a linking bug with Delphi XE4 on Win64
|
||||||
|
{$ifdef CPUX64}
|
||||||
|
{$if (CompilerVersion = 25.0) or
|
||||||
|
(CompilerVersion = 28.0) or
|
||||||
|
(CompilerVersion = 29.0)} // exactly XE4, XE7 or XE8 are known to GPF
|
||||||
|
// other Win32/Win64 Delphi platforms "should work" (tm) as expected
|
||||||
|
{$define NOSQLITE3STATIC}
|
||||||
|
{$ifend}
|
||||||
|
{$define LIBQUICKJSSTATIC} // seems fine BUT on Delphi 10.4+ Win64
|
||||||
|
{$if CompilerVersion >= 34.0} // = Delphi 10.4 and later
|
||||||
|
{$undef LIBQUICKJSSTATIC}
|
||||||
|
{$ifend}
|
||||||
|
{$endif}
|
||||||
|
{$endif FPC}
|
||||||
|
|
||||||
|
{$ifdef OSWINDOWS}
|
||||||
|
// on Windows: enable Microsoft AES Cryptographic Provider (XP SP3 and up)
|
||||||
|
// - even if those AES engines are slower and closed source (so should better
|
||||||
|
// be avoided), we use it for TAesPrng.GetEntropy, as it can't hurt
|
||||||
|
{$define USE_PROV_RSA_AES}
|
||||||
|
// define at your own risk, if you have the good libraries ;)
|
||||||
|
{.$define USE_OPENSSL}
|
||||||
|
{$else}
|
||||||
|
{$ifndef OSANDROID}
|
||||||
|
// try OpenSSL on POSIX systems where likely to be unique and maintained
|
||||||
|
{$define USE_OPENSSL}
|
||||||
|
{$endif OSANDROID}
|
||||||
|
{$endif OSWINDOWS}
|
||||||
|
{$ifdef FORCE_OPENSSL}
|
||||||
|
{$define USE_OPENSSL} // if you think you are a lucky enough guy
|
||||||
|
{$endif FORCE_OPENSSL}
|
||||||
|
|
||||||
|
|
||||||
|
// -----------
|
||||||
|
// -- Per-platform Client-Server abilities
|
||||||
|
|
||||||
|
{$ifdef OSWINDOWS}
|
||||||
|
|
||||||
|
{$ifndef ONLYUSEHTTPSOCKET}
|
||||||
|
{$define USEWININET} // publish TWinINet/TWinHttp/TWinHttpAPI classes
|
||||||
|
{$define USEHTTPSYS} // enable http.sys kernel-mode Web server
|
||||||
|
{$endif ONLYUSEHTTPSOCKET}
|
||||||
|
|
||||||
|
{$define USE_WINIOCP} // I/O completion ports API is fine under Windows
|
||||||
|
// (as used by mormot.core.threads and mormot.net.async)
|
||||||
|
// (under Linux/POSIX, we fallback to a classical event-driven pool)
|
||||||
|
|
||||||
|
{$ifndef NOSSPIAUTH} // from mormot.lib.sspi
|
||||||
|
{$define DOMAINRESTAUTH} // enable SSPI in mormot.rest.client/server
|
||||||
|
{$endif NOSSPIAUTH}
|
||||||
|
|
||||||
|
{$endif OSWINDOWS}
|
||||||
|
|
||||||
|
{$ifdef OSPOSIX}
|
||||||
|
|
||||||
|
{$define ONLYUSEHTTPSOCKET} // efficient cross-platform Socket + OpenSSL API
|
||||||
|
{$undef USE_WINIOCP} // disable any Windows-specific code
|
||||||
|
|
||||||
|
{$ifdef OSANDROID}
|
||||||
|
|
||||||
|
// for Android, consider using https://github.com/gcesarmza/curl-android-ios
|
||||||
|
// static libraries and force USELIBCURL in the project conditionals
|
||||||
|
{$define LIBCURLSTATIC}
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
{$ifndef USE_OPENSSL} // if OpenSSL is not available on this platform
|
||||||
|
{$define USELIBCURL} // try cross-platform libcurl for https
|
||||||
|
{$endif USE_OPENSSL}
|
||||||
|
|
||||||
|
{$ifndef NOGSSAPIAUTH} // mormot.lib.gssapi is not Android compatible
|
||||||
|
{$define DOMAINRESTAUTH} // enable libgss in mormot.rest.client/server
|
||||||
|
{$endif NOGSSAPIAUTH}
|
||||||
|
|
||||||
|
{$endif OSANDROID}
|
||||||
|
|
||||||
|
{$endif OSPOSIX}
|
||||||
|
|
||||||
|
|
||||||
@ -9,15 +9,11 @@
|
|||||||
<TargetedPlatforms>2</TargetedPlatforms>
|
<TargetedPlatforms>2</TargetedPlatforms>
|
||||||
<AppType>Console</AppType>
|
<AppType>Console</AppType>
|
||||||
<MainSource>HTMX_Sample.dpr</MainSource>
|
<MainSource>HTMX_Sample.dpr</MainSource>
|
||||||
|
<ProjectName Condition="'$(ProjectName)'==''">HTMX_Sample</ProjectName>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
<Base>true</Base>
|
<Base>true</Base>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="('$(Platform)'=='Linux64' and '$(Base)'=='true') or '$(Base_Linux64)'!=''">
|
|
||||||
<Base_Linux64>true</Base_Linux64>
|
|
||||||
<CfgParent>Base</CfgParent>
|
|
||||||
<Base>true</Base>
|
|
||||||
</PropertyGroup>
|
|
||||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
<Base_Win32>true</Base_Win32>
|
<Base_Win32>true</Base_Win32>
|
||||||
<CfgParent>Base</CfgParent>
|
<CfgParent>Base</CfgParent>
|
||||||
@ -68,9 +64,6 @@
|
|||||||
<VerInfo_Locale>5129</VerInfo_Locale>
|
<VerInfo_Locale>5129</VerInfo_Locale>
|
||||||
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Base_Linux64)'!=''">
|
|
||||||
<DCC_UsePackage>DataSnapServer;fmx;emshosting;DbxCommonDriver;bindengine;FireDACCommonODBC;emsclient;FireDACCommonDriver;IndyProtocols;dbxcds;emsedge;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;dbexpress;FireDACInfxDriver;inet;DataSnapCommon;dbrtl;FireDACOracleDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;dsnapxml;DataSnapClient;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;xmlrtl;dsnap;CloudService;FireDACDb2Driver;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
|
|
||||||
</PropertyGroup>
|
|
||||||
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
<DCC_UsePackage>vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;EurekaLogCore;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;OmniThreadLibraryRuntime;FireDACMongoDBDriver;IndySystem;BossExperts;FireDACTDataDriver;vcldb;ibxbindings;ADOCluster_RT;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;dmvcframeworkDT;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
|
<DCC_UsePackage>vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;EurekaLogCore;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;OmniThreadLibraryRuntime;FireDACMongoDBDriver;IndySystem;BossExperts;FireDACTDataDriver;vcldb;ibxbindings;ADOCluster_RT;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;dmvcframeworkDT;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
@ -104,8 +97,8 @@
|
|||||||
<AppDPIAwarenessMode>none</AppDPIAwarenessMode>
|
<AppDPIAwarenessMode>none</AppDPIAwarenessMode>
|
||||||
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
<VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
|
<VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
|
||||||
<VerInfo_Build>4</VerInfo_Build>
|
<VerInfo_Build>5</VerInfo_Build>
|
||||||
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.5;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
@ -778,6 +771,9 @@
|
|||||||
<Platform Name="Win64">
|
<Platform Name="Win64">
|
||||||
<Operation>1</Operation>
|
<Operation>1</Operation>
|
||||||
</Platform>
|
</Platform>
|
||||||
|
<Platform Name="Win64x">
|
||||||
|
<Operation>1</Operation>
|
||||||
|
</Platform>
|
||||||
</DeployClass>
|
</DeployClass>
|
||||||
<DeployClass Name="ProjectiOSDeviceDebug">
|
<DeployClass Name="ProjectiOSDeviceDebug">
|
||||||
<Platform Name="iOSDevice32">
|
<Platform Name="iOSDevice32">
|
||||||
@ -1038,9 +1034,9 @@
|
|||||||
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
|
||||||
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
||||||
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
||||||
|
<ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/>
|
||||||
</Deployment>
|
</Deployment>
|
||||||
<Platforms>
|
<Platforms>
|
||||||
<Platform value="Linux64">False</Platform>
|
|
||||||
<Platform value="Win32">False</Platform>
|
<Platform value="Win32">False</Platform>
|
||||||
<Platform value="Win64">True</Platform>
|
<Platform value="Win64">True</Platform>
|
||||||
</Platforms>
|
</Platforms>
|
||||||
|
|||||||
@ -65,22 +65,6 @@ begin
|
|||||||
try
|
try
|
||||||
if WebRequestHandler <> nil then
|
if WebRequestHandler <> nil then
|
||||||
WebRequestHandler.WebModuleClass := WebModuleClass;
|
WebRequestHandler.WebModuleClass := WebModuleClass;
|
||||||
|
|
||||||
dotEnvConfigure(
|
|
||||||
function: IMVCDotEnv
|
|
||||||
begin
|
|
||||||
Result := NewDotEnv
|
|
||||||
.UseStrategy(TMVCDotEnvPriority.FileThenEnv)
|
|
||||||
//if available, by default, loads default environment (.env)
|
|
||||||
.UseProfile('test') //if available loads the test environment (.env.test)
|
|
||||||
.UseProfile('prod') //if available loads the prod environment (.env.prod)
|
|
||||||
.UseLogger(procedure(LogItem: String)
|
|
||||||
begin
|
|
||||||
LogW('dotEnv: ' + LogItem);
|
|
||||||
end)
|
|
||||||
.Build(); //uses the executable folder to look for .env* files
|
|
||||||
end);
|
|
||||||
|
|
||||||
WebRequestHandlerProc.MaxConnections := dotEnv.Env('dmvc.handler.max_connections', 1024);
|
WebRequestHandlerProc.MaxConnections := dotEnv.Env('dmvc.handler.max_connections', 1024);
|
||||||
RunServer(dotEnv.Env('dmvc.server.port', 8080));
|
RunServer(dotEnv.Env('dmvc.server.port', 8080));
|
||||||
except
|
except
|
||||||
|
|||||||
@ -9,6 +9,7 @@
|
|||||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
<TargetedPlatforms>1</TargetedPlatforms>
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
<AppType>Console</AppType>
|
<AppType>Console</AppType>
|
||||||
|
<ProjectName Condition="'$(ProjectName)'==''">htmx_mustache</ProjectName>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
<Base>true</Base>
|
<Base>true</Base>
|
||||||
@ -73,8 +74,9 @@
|
|||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
<Manifest_File>None</Manifest_File>
|
|
||||||
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
|
||||||
|
<AppDPIAwarenessMode>none</AppDPIAwarenessMode>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
@ -118,9 +120,10 @@
|
|||||||
<Source Name="MainSource">htmx_mustache.dpr</Source>
|
<Source Name="MainSource">htmx_mustache.dpr</Source>
|
||||||
</Source>
|
</Source>
|
||||||
<Excluded_Packages>
|
<Excluded_Packages>
|
||||||
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k230.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp230.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k230.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k290.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp290.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
||||||
</Excluded_Packages>
|
</Excluded_Packages>
|
||||||
</Delphi.Personality>
|
</Delphi.Personality>
|
||||||
<Deployment Version="4">
|
<Deployment Version="4">
|
||||||
@ -724,6 +727,9 @@
|
|||||||
<Platform Name="Win64">
|
<Platform Name="Win64">
|
||||||
<Operation>1</Operation>
|
<Operation>1</Operation>
|
||||||
</Platform>
|
</Platform>
|
||||||
|
<Platform Name="Win64x">
|
||||||
|
<Operation>1</Operation>
|
||||||
|
</Platform>
|
||||||
</DeployClass>
|
</DeployClass>
|
||||||
<DeployClass Name="ProjectiOSDeviceDebug">
|
<DeployClass Name="ProjectiOSDeviceDebug">
|
||||||
<Platform Name="iOSDevice32">
|
<Platform Name="iOSDevice32">
|
||||||
@ -985,6 +991,7 @@
|
|||||||
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
|
||||||
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
||||||
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
||||||
|
<ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/>
|
||||||
</Deployment>
|
</Deployment>
|
||||||
<Platforms>
|
<Platforms>
|
||||||
<Platform value="Win32">True</Platform>
|
<Platform value="Win32">True</Platform>
|
||||||
|
|||||||
@ -27,7 +27,7 @@ unit CustomMustacheHelpersU;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
SynMustache;
|
mormot.core.mustache;
|
||||||
|
|
||||||
type
|
type
|
||||||
TMyMustacheHelpers = class sealed
|
TMyMustacheHelpers = class sealed
|
||||||
|
|||||||
@ -19,8 +19,8 @@ uses
|
|||||||
DAL in 'DAL.pas',
|
DAL in 'DAL.pas',
|
||||||
MyDataModuleU in '..\renders\MyDataModuleU.pas' {MyDataModule: TDataModule},
|
MyDataModuleU in '..\renders\MyDataModuleU.pas' {MyDataModule: TDataModule},
|
||||||
CustomMustacheHelpersU in 'CustomMustacheHelpersU.pas',
|
CustomMustacheHelpersU in 'CustomMustacheHelpersU.pas',
|
||||||
SynMustache,
|
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas',
|
||||||
MVCFramework.Serializer.URLEncoded in '..\..\sources\MVCFramework.Serializer.URLEncoded.pas';
|
mormot.core.mustache;
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
|
|||||||
@ -9,6 +9,7 @@
|
|||||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
<TargetedPlatforms>1</TargetedPlatforms>
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
<AppType>Console</AppType>
|
<AppType>Console</AppType>
|
||||||
|
<ProjectName Condition="'$(ProjectName)'==''">ServerSideViewsMustache</ProjectName>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
<Base>true</Base>
|
<Base>true</Base>
|
||||||
@ -725,6 +726,9 @@
|
|||||||
<Platform Name="Win64">
|
<Platform Name="Win64">
|
||||||
<Operation>1</Operation>
|
<Operation>1</Operation>
|
||||||
</Platform>
|
</Platform>
|
||||||
|
<Platform Name="Win64x">
|
||||||
|
<Operation>1</Operation>
|
||||||
|
</Platform>
|
||||||
</DeployClass>
|
</DeployClass>
|
||||||
<DeployClass Name="ProjectiOSDeviceDebug">
|
<DeployClass Name="ProjectiOSDeviceDebug">
|
||||||
<Platform Name="iOSDevice32">
|
<Platform Name="iOSDevice32">
|
||||||
@ -986,6 +990,7 @@
|
|||||||
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
|
||||||
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
|
||||||
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
|
||||||
|
<ProjectRoot Platform="Win64x" Name="$(PROJECTNAME)"/>
|
||||||
</Deployment>
|
</Deployment>
|
||||||
<Platforms>
|
<Platforms>
|
||||||
<Platform value="Win32">True</Platform>
|
<Platform value="Win32">True</Platform>
|
||||||
|
|||||||
@ -28,7 +28,8 @@ uses
|
|||||||
WebSiteControllerU,
|
WebSiteControllerU,
|
||||||
System.IOUtils,
|
System.IOUtils,
|
||||||
MVCFramework.Commons,
|
MVCFramework.Commons,
|
||||||
MVCFramework.Middleware.StaticFiles, SynMustache, CustomMustacheHelpersU,
|
MVCFramework.Middleware.StaticFiles,
|
||||||
|
CustomMustacheHelpersU,
|
||||||
MVCFramework.Serializer.URLEncoded;
|
MVCFramework.Serializer.URLEncoded;
|
||||||
|
|
||||||
{ %CLASSGROUP 'Vcl.Controls.TControl' }
|
{ %CLASSGROUP 'Vcl.Controls.TControl' }
|
||||||
|
|||||||
@ -1373,7 +1373,7 @@ begin
|
|||||||
for lPair in fTableMap.fMap do
|
for lPair in fTableMap.fMap do
|
||||||
begin
|
begin
|
||||||
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
|
||||||
if (lPar <> nil) and lpair.Value.Writeable then
|
if (lPar <> nil) and (lpair.Value.Insertable or lpair.Value.Updatable) then
|
||||||
begin
|
begin
|
||||||
lValue := lPair.Key.GetValue(Self);
|
lValue := lPair.Key.GetValue(Self);
|
||||||
lPar.DataTypeName := fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
|
lPar.DataTypeName := fTableMap.fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
|
||||||
|
|||||||
@ -296,7 +296,7 @@ var
|
|||||||
AuthAccessToken: string;
|
AuthAccessToken: string;
|
||||||
AuthToken: string;
|
AuthToken: string;
|
||||||
ErrorMsg: string;
|
ErrorMsg: string;
|
||||||
cookieToken: string;
|
CookieToken: string;
|
||||||
begin
|
begin
|
||||||
// check if the resource is protected
|
// check if the resource is protected
|
||||||
if Assigned(FAuthenticationHandler) then
|
if Assigned(FAuthenticationHandler) then
|
||||||
@ -377,10 +377,10 @@ begin
|
|||||||
begin
|
begin
|
||||||
if FUseHttpOnly then
|
if FUseHttpOnly then
|
||||||
begin
|
begin
|
||||||
cookieToken := AContext.Request.Cookie('token');
|
CookieToken := AContext.Request.Cookie('token');
|
||||||
if (not cookieToken.IsEmpty) then
|
if (not CookieToken.IsEmpty) then
|
||||||
begin
|
begin
|
||||||
AuthToken := cookieToken.Trim;
|
AuthToken := CookieToken.Trim;
|
||||||
AuthToken := Trim(TNetEncoding.URL.Decode(AuthToken));
|
AuthToken := Trim(TNetEncoding.URL.Decode(AuthToken));
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|||||||
@ -32,7 +32,8 @@ interface
|
|||||||
uses
|
uses
|
||||||
MVCFramework, System.SysUtils, System.Generics.Collections,
|
MVCFramework, System.SysUtils, System.Generics.Collections,
|
||||||
MVCFramework.Commons, System.IOUtils, System.RTTI,
|
MVCFramework.Commons, System.IOUtils, System.RTTI,
|
||||||
System.Classes, Data.DB, SynMustache, SynCommons, MVCFramework.IntfObjectPool;
|
System.Classes, Data.DB, MVCFramework.IntfObjectPool,
|
||||||
|
mormot.core.mustache, mormot.core.unicode;
|
||||||
|
|
||||||
type
|
type
|
||||||
{ This class implements the mustache view engine for server side views }
|
{ This class implements the mustache view engine for server side views }
|
||||||
@ -48,8 +49,8 @@ type
|
|||||||
procedure LoadPartials;
|
procedure LoadPartials;
|
||||||
procedure LoadHelpers;
|
procedure LoadHelpers;
|
||||||
protected
|
protected
|
||||||
function RenderJSON(lViewEngine: TSynMustache; const JSON: RawUTF8; Partials: TSynMustachePartials;
|
function RenderJSON(lViewEngine: TSynMustache; const JSON: UTF8String; Partials: TSynMustachePartials;
|
||||||
Helpers: TSynMustacheHelpers; OnTranslate: TOnStringTranslate; EscapeInvert: boolean): RawUTF8; virtual;
|
Helpers: TSynMustacheHelpers; OnTranslate: TOnStringTranslate; EscapeInvert: boolean): UTF8String; virtual;
|
||||||
public
|
public
|
||||||
procedure Execute(const ViewName: string; const OutputStream: TStream); override;
|
procedure Execute(const ViewName: string; const OutputStream: TStream); override;
|
||||||
constructor Create(const AEngine: TMVCEngine; const AWebContext: TWebContext;
|
constructor Create(const AEngine: TMVCEngine; const AWebContext: TWebContext;
|
||||||
@ -124,8 +125,8 @@ begin
|
|||||||
fPartials.Free;
|
fPartials.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TMVCMustacheViewEngine.RenderJSON(lViewEngine: TSynMustache; const JSON: RawUTF8; Partials: TSynMustachePartials;
|
function TMVCMustacheViewEngine.RenderJSON(lViewEngine: TSynMustache; const JSON: UTF8String; Partials: TSynMustachePartials;
|
||||||
Helpers: TSynMustacheHelpers; OnTranslate: TOnStringTranslate; EscapeInvert: boolean): RawUTF8;
|
Helpers: TSynMustacheHelpers; OnTranslate: TOnStringTranslate; EscapeInvert: boolean): UTF8String;
|
||||||
begin
|
begin
|
||||||
Result := lViewEngine.RenderJSON(JSON, Partials, Helpers, OnTranslate, EscapeInvert);
|
Result := lViewEngine.RenderJSON(JSON, Partials, Helpers, OnTranslate, EscapeInvert);
|
||||||
end;
|
end;
|
||||||
@ -133,7 +134,7 @@ end;
|
|||||||
procedure TMVCMustacheViewEngine.Execute(const ViewName: string; const OutputStream: TStream);
|
procedure TMVCMustacheViewEngine.Execute(const ViewName: string; const OutputStream: TStream);
|
||||||
var
|
var
|
||||||
lViewFileName: string;
|
lViewFileName: string;
|
||||||
lViewTemplate: RawUTF8;
|
lViewTemplate: UTF8String;
|
||||||
lViewEngine: TSynMustache;
|
lViewEngine: TSynMustache;
|
||||||
lSW: TStreamWriter;
|
lSW: TStreamWriter;
|
||||||
begin
|
begin
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user