mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 07:45:54 +01:00
removed local copy of dmustache
This commit is contained in:
parent
548367cc68
commit
03a9b43a54
@ -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*
|
@ -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
@ -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'
|
Loading…
Reference in New Issue
Block a user