removed local copy of dmustache

This commit is contained in:
Daniele Teti 2023-02-27 12:30:19 +01:00
parent 548367cc68
commit 03a9b43a54
11 changed files with 0 additions and 88411 deletions

View File

@ -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*

View File

@ -1,282 +0,0 @@
Synopse mORMot framework
An Open Source Client-Server ORM/SOA framework
(c) 2008-2021 Synopse Informatique
https://synopse.info
http://mormot.net
Contributors
Alan Chate
Alexander (sha)
Alexander (volax)
AlexPirate
Alfred Glaenzer (alf)
Andre Heider (dhewg)
Antoine Simard (AntoineGS)
Arnaud Bouchez
ASiwon
Aweste
Bas Schouten
BigStar
BugsDigger
Cheemeng
CoMPi
Damien (ddemars)
Darian Miller
Daniel Kuettner
David Mead (MDW)
Delphinium (louisyeow)
DigDiver
Dominikcz
EgorovAlex
Emanuele (lele9)
Eric Grange
Esmond
Esteban Martin (EMartin)
Eugene Ilyin
Eva Freimann (EVaF)
F-Vicente
Goran Despalatovic (gigo)
Jean-Baptiste Roussia (jbroussia)
Joe (jokusoft)
Johan Bontes
Jordi Tudela
Kevin Chen
Lagodny
Leon Oosthuizen
Macc2010
Maciej Izak (hnb)
Marcos Douglas B. Santos (mdbs99)
Mario Moretti
Marius Maximus (mariuszekpl)
Martin Eckes
Martin Suer
Mapes
Matkov
Maxim Masiutin
Mazinsw
MChaos
Miab3
Michael (EgonHugeist)
Michalis Kamburelis
MilesYou
Mingda
Mr Yang (ysair)
Nicolas Marchand (MC)
Nortg
Nzsolt
Oleg Tretyakov
Ondrej (reddwarf)
Pavel Mashlyakovskii (mpv)
Pierre le Riche
RalfS
Richard6688
Sabbiolina
Sanyin
Sinisa (sinisav)
Sllimr7139
SSoftPro
Stefan (itSDS)
Svetozar Belic (transmogrifix)
Transmogrifix
Uian2000
Vaclav
Vadim Orel
Willo vd Merwe
Win2014
Wloochacz
Wolfgang Ehrhardt
Yoanq
Ysair
Zed
[See below if you upgrade from 1.17 revision]
Synopse mORMot is an Open Source Client-Server ORM SOA MVC framework
for Delphi 6 up to Delphi 10.3 Rio and FPC, targeting Windows/Linux
for servers, and any platform for clients (including mobile or AJAX).
The main features of mORMot are therefore:
- ORM/ODM: objects persistence on almost any database (SQL or NoSQL);
- SOA: organize your business logic into REST services;
- Clients: consume your data or services from any platform, via ORM/SOA APIs;
- Web MVC: publish your ORM/SOA process as responsive Web Applications.
With local or remote access, via an auto-configuring Client-Server REST design.
Due to its modular design, switch from a Client-Server architecture over
HTTP, named pipes or GDI messages into a stand-alone application is just
a matter of mORMot classes initialization.
For instance, the very same executable can even be running stand-alone,
as a server, as a service, or a client, depending on some run-time parameters!
Emphasizing simplicity, speed and versatility, mORMot is a incredibly well
documented Open Source project easy enough to add basic ORM or Client-Server
features to simple applications for hobbyists, or let experienced users
develop scaling and strong service-based projects for their customers, with
the advantages of native code and easy-to-deploy solutions, reducing
deployment cost and increasing ROI.
It provides an Open Source self-sufficient set of units (even Delphi starter
edition is enough) for creating any application, from a stand-alone solution
up to the most complex Domain-Driven Design (DDD):
- Presentation layer featuring MVC UI generation with i18n and reporting
(with pdf export) for rich Delphi clients, MVC web clients (with logic-less
Mustache templates) or rich AJAX clients (via native JSON/REST access);
- Application layer implementing Service Oriented Architecture via
interface-based services (like WCF) and Client-Server ORM (including
method-based services) - following a RESTful model using JSON over several
communication protocols (e.g. HTTP/1.1);
- Domain Model layer handling all the needed business logic in plain Delphi
objects, including high-level managed types like dynamic arrays or records
for Value Objects, dedicated classes for Entities or Aggregates, and variant
storage with late-binding for dynamic documents;
- Data persistence infrastructure layer with ORM operations on direct
Oracle, MS SQL, OleDB, ODBC, ZEOS/ZDBC access or any TDataSet provider (e.g.
FireDAC/AnyDAC, UniDAC, NexusDB, BDE...), with a powerful SQLite3 kernel,
and optional SQL access if needed, with amazing performance and advanced
features like Array DML, auto-generating SQL for SQLite3, Oracle,
Jet/MSAccess, MS SQL, Firebird, DB2, PostgreSQL, MySQL and NexusDB - and
alternative high-speed MongoDB NoSQL database access for ODM persistence;
- Cross-Cutting infrastructure layers for handling data filtering and
validation, security (e.g. Windows authentication or any custom model),
caching, logging and testing (framework uses test-driven approach and
features interface stubbing and mocking).
With mORMot, ORM/ODM is not used only for data persistence of objects (like
in other implementations), but as part of a global n-Tier, Service Oriented
Architecture (SOA), ready to implement Domain-Driven solutions. This
framework is not an ORM on which a transmission layer has been added, like
almost everything existing in Delphi, C# or Java: this is a full Client-Server
ORM/SOA from the ground up.
This really makes the difference.
The business logic of your applications will be easily exposed as Services,
and will be accessible from light clients (written in Delphi or any other
mean, including AJAX).
The SpiderMonkey JavaScript engine has been integrated on the server side
and can be used to define business rules or any process (including MVC web
rendering) - just like node.js, but with a multi-threaded core, and the
full power of our optimized Delphi libraries at hand.
The framework Core is non-visual: you will get everything you need in a
consistent set of classes to be used from code. In order to let you focus
on your business, using mORMot's KISS/DRY/SOC/YAGNI/TDD and Convention Over
Configuration patterns. But you have also some UI units available (including
screen auto-generation, reporting and ribbon GUI), and you can use it from
any RAD, web, or AJAX clients (via JavaScript or Smart Mobile Studio).
No dependency is needed on the client side (no DB driver, or third-party
runtime): it is able to connect via standard HTTP, even through a corporate
proxy or a VPN. Rich Delphi clients can be deployed just by copying and running
a stand-alone small executable, with no installation process. Stream can be
encrypted via HTTS or with proven SHA/AES-256. Endpoints are configured
automatically for each published interface on both server and client sides,
and creating a load-balancing proxy is a matter of one method call.
Speed and scalability has been implemented from the ground up: a genuine
optimized multi-threaded core let a single server handle more than 50,000
concurrent clients, faster than DataSnap, WCF or node.js, and our rich SOA
design is able to implement both vertical and horizontal scalable hosting,
using recognized enterprise-level SQL or NoSQL databases for storage.
Even if mORMot will be more easily used in a project designed from scratch,
it fits very well the purpose of evolving any existing Delphi project, or
creating the server side part of an AJAX application.
Licensed under a 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 copy-left on code we wrote.
Main project page:
http://mORMot.net
Documentation:
https://synopse.info/files/html/Synopse%20mORMot%20Framework%20SAD%201.18.html
Installation:
https://synopse.info/files/html/Synopse%20mORMot%20Framework%20SAD%201.18.html#TITL_113
FAQ:
https://synopse.info/files/html/Synopse%20mORMot%20Framework%20SAD%201.18.html#TITL_123
How to get the source:
https://synopse.info/fossil/wiki?name=Get+the+source
A forum is dedicated to support:
https://synopse.info
A blog is available:
http://blog.synopse.info
Issues and feature requests can be posted (take a look at the forums
and latest unstable version first!):
https://synopse.info/fossil/reportlist
You can also monitor/fork our projects on GitHub:
https://github.com/synopse/mORMot
You may also install it as a Delphinus package: Delphinus-Support
Don't forget to download the documentation (available online or as pdf files,
created by our SynProject tool).
In particular, you should take a look at all general introduction chapters
of the SAD document. It will cover all key-concepts and code modelling
used by the framework.
A developer guide is included in this SAD document, in its 2nd part. You'll
get good practice guidance, presentation of the ORM/SOA approach and other
underlying concepts.
Feel free to contribute by posting enhancements and patches to this
quickly evolving project.
Enjoy!
Some units (e.g. SynPdf, SynGdiPlus, SynBigTable, SynCommons, SynCrypto,
SynDB*, SynSQLite3, SynMongoDB, SynMustache, SynSM, mORMotReport) are used
by mORMot, but do not require the whole framework to be linked.
That is, you can use e.g. only PDF generation, SynDB fast database
access, a static-linked SQLite3 engine, direct MongoDB access, Mustache
templates, SpiderMonkey JavaSCript engine, code-generated reports, or
the TDocVariant, TDynArray, TSynLog classes of SynCommons, without using
the main mORMot units and features (ORM, Client-Server, services, UI).
Some of those units can even be compiled with Delphi 5 (e.g. SynPdf, SynDB).
Quick Steps when upgrading from a previous 1.17 revision:
1) Note that some units where renamed, and some breaking changes introduced
by some enhanced features, therefore a direct update is not possible
2) Erase or rename your whole previous #\Lib directory
3) Download latest 1.18 revision files as stated just above
4) Change your references to mORMot units:
- Add in your uses clause SynLog.pas and/or SynTests.pas if needed;
- Rename in your uses clause any SQLite3Commons reference into mORmot;
- Rename in your uses clause any SQLite3 reference into mORMotSQLite3;
- Rename in your uses clause any other SQlite3* reference into mORMot*;
- Add in one uses clause a link to SynSQLite3Static (for Win32).
5) Consult the units headers about 1.18 for breaking changes, mainly:
- TSQLRecord.ID: TID primary key, TIDDynArray, and TRecordReference are now Int64;
- Renamed Iso8601 low-level structure as TTimeLogBits;
- TJSONSerializerCustomReader/Writer callbacks changed;
- TSQLRestServerCallBackParams replaced by TSQLRestServerURIContext class;
- TSQLRestServerStatic* classes renamed as TSQLRestStorage*;
- rmJSON* enums replaced by TSQLRestRoutingREST/JSON_RPC classes;
- Changed '¤' into '~' character for mORMoti18n language files.

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

View File

@ -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}

View File

@ -1 +0,0 @@
'1.18.6381'